diff --git a/libraries/template-haskell/Language/Haskell/TH/Lib/Syntax.hs b/libraries/template-haskell/Language/Haskell/TH/Lib/Syntax.hs index 59d58aab5cf5db52dd394b6a2635fc1d35f5a060..64b9655de53fdb43c42f3e7da52d39bc6908fe94 100644 --- a/libraries/template-haskell/Language/Haskell/TH/Lib/Syntax.hs +++ b/libraries/template-haskell/Language/Haskell/TH/Lib/Syntax.hs @@ -1955,7 +1955,7 @@ unboxedSumDataName alt arity | otherwise = Name (mkOccName sum_occ) - (NameG DataName (mkPkgName "ghc-prim") (mkModName "GHC.Prim")) + (NameG DataName (mkPkgName "ghc-prim") (mkModName "GHC.Types")) where prefix = "unboxedSumDataName: " @@ -1974,11 +1974,11 @@ unboxedSumTypeName arity | otherwise = Name (mkOccName sum_occ) - (NameG TcClsName (mkPkgName "ghc-prim") (mkModName "GHC.Prim")) + (NameG TcClsName (mkPkgName "ghc-prim") (mkModName "GHC.Types")) where -- Synced with the definition of mkSumTyConOcc in GHC.Builtin.Types - sum_occ = '(' : '#' : replicate (arity - 1) '|' ++ "#)" + sum_occ = "Sum" ++ show arity ++ "#" ----------------------------------------------------- -- Locations diff --git a/testsuite/tests/quotes/T24750.hs b/testsuite/tests/quotes/T24750.hs new file mode 100644 index 0000000000000000000000000000000000000000..51593cc8d65e95005df1137c64bfffec4d6d2720 --- /dev/null +++ b/testsuite/tests/quotes/T24750.hs @@ -0,0 +1,35 @@ +{-# LANGUAGE MagicHash #-} +{-# LANGUAGE TemplateHaskellQuotes #-} +{-# LANGUAGE UnboxedTuples #-} +-- A regression test for #24750. This test ensures that a family of functions +-- from the `template-haskell` library (tupeTypeName, tupleDataName, etc.) +-- returns the same Names as when you manually quote the names using +-- TemplateHaskellQuotes. +module Main (main) where + +import Control.Monad (unless) +import GHC.Tuple (Tuple2) +import GHC.Types (Sum2#, Tuple2#) +import Language.Haskell.TH + +test :: Name -> Name -> IO () +test n1 n2 = + unless (n1 == n2) $ + fail $ unlines + [ "Names are not equal" + , "LHS name: " ++ show n1 + , "RHS name: " ++ show n2 + ] + +main :: IO () +main = do + test (tupleTypeName 2) ''(,) + test (tupleTypeName 2) ''Tuple2 + test (tupleDataName 2) '(,) + test (unboxedTupleTypeName 2) ''(#,#) + test (unboxedTupleTypeName 2) ''Tuple2# + test (unboxedTupleDataName 2) '(#,#) + test (unboxedSumTypeName 2) ''Sum2# + -- There is currently no way to manually quote an unboxed sum data constructor + -- Name, as you cannot write unboxed sum data constructors in prefix form. As + -- such, a test case for `unboxedSumDataName` is omitted. diff --git a/testsuite/tests/quotes/all.T b/testsuite/tests/quotes/all.T index 4fa5d13d559aeb2cc9cbdfbada14eab5020092d9..1d923dc0e028e73c0c2bc7acac9a9a3917e83b95 100644 --- a/testsuite/tests/quotes/all.T +++ b/testsuite/tests/quotes/all.T @@ -42,3 +42,4 @@ test('T20688', normal, compile, ['-Wimplicit-lift -Werror']) test('T20893', normal, compile_and_run, ['']) test('T21619', normal, compile, ['']) test('T20472_quotes', normal, compile, ['']) +test('T24750', normal, compile_and_run, [''])