diff options
| -rw-r--r-- | compiler/GHC/Tc/Instance/Typeable.hs | 21 | ||||
| -rw-r--r-- | testsuite/tests/typecheck/should_run/T22510.hs | 36 | ||||
| -rw-r--r-- | testsuite/tests/typecheck/should_run/T22510.stdout | 16 | ||||
| -rwxr-xr-x | testsuite/tests/typecheck/should_run/all.T | 1 |
4 files changed, 70 insertions, 4 deletions
diff --git a/compiler/GHC/Tc/Instance/Typeable.hs b/compiler/GHC/Tc/Instance/Typeable.hs index 9de6aa9e94..74e3cd84b8 100644 --- a/compiler/GHC/Tc/Instance/Typeable.hs +++ b/compiler/GHC/Tc/Instance/Typeable.hs @@ -172,7 +172,7 @@ mkTypeableBinds } } } where needs_typeable_binds tc - | tc `elem` [runtimeRepTyCon, levityTyCon, vecCountTyCon, vecElemTyCon] + | tc `elem` ghcTypesTypeableTyCons = False | otherwise = isAlgTyCon tc @@ -335,7 +335,14 @@ mkPrimTypeableTodos ; todo2 <- todoForTyCons gHC_PRIM ghc_prim_module_id ghcPrimTypeableTyCons - ; return ( gbl_env' , [todo1, todo2]) + ; tcg_env <- getGblEnv + ; let mod_id = case tcg_tr_module tcg_env of -- Should be set by now + Just mod_id -> mod_id + Nothing -> pprPanic "tcMkTypeableBinds" empty + + ; todo3 <- todoForTyCons gHC_TYPES mod_id ghcTypesTypeableTyCons + + ; return ( gbl_env' , [todo1, todo2, todo3]) } else do gbl_env <- getGblEnv return (gbl_env, []) @@ -350,12 +357,18 @@ mkPrimTypeableTodos -- Note [Built-in syntax and the OrigNameCache] in "GHC.Iface.Env" for more. ghcPrimTypeableTyCons :: [TyCon] ghcPrimTypeableTyCons = concat - [ [ runtimeRepTyCon, levityTyCon, vecCountTyCon, vecElemTyCon ] - , map (tupleTyCon Unboxed) [0..mAX_TUPLE_SIZE] + [ map (tupleTyCon Unboxed) [0..mAX_TUPLE_SIZE] , map sumTyCon [2..mAX_SUM_SIZE] , primTyCons ] +-- | These are types which are defined in GHC.Types but are needed in order to +-- typecheck the other generated bindings, therefore to avoid ordering issues we +-- generate them up-front along with the bindings from GHC.Prim. +ghcTypesTypeableTyCons :: [TyCon] +ghcTypesTypeableTyCons = [ runtimeRepTyCon, levityTyCon + , vecCountTyCon, vecElemTyCon ] + data TypeableStuff = Stuff { platform :: Platform -- ^ Target platform , trTyConDataCon :: DataCon -- ^ of @TyCon@ diff --git a/testsuite/tests/typecheck/should_run/T22510.hs b/testsuite/tests/typecheck/should_run/T22510.hs new file mode 100644 index 0000000000..201e7da742 --- /dev/null +++ b/testsuite/tests/typecheck/should_run/T22510.hs @@ -0,0 +1,36 @@ +{-# LANGUAGE MagicHash, UnboxedTuples, UnboxedSums, ScopedTypeVariables, TypeApplications, AllowAmbiguousTypes #-} +module Main where + +import Type.Reflection +import Data.Proxy +import GHC.Types +import GHC.Prim + +moduleOf :: forall a . Typeable a => String +moduleOf = case someTypeRep (Proxy @a) of + SomeTypeRep tr -> (show tr ++ ": " ++ (tyConModule $ typeRepTyCon tr)) + +main = do + -- These are in GHC.Types + putStrLn $ moduleOf @Levity + putStrLn $ moduleOf @'Lifted + putStrLn $ moduleOf @RuntimeRep + putStrLn $ moduleOf @'IntRep + putStrLn $ moduleOf @'BoxedRep + putStrLn $ moduleOf @'Lifted + putStrLn $ moduleOf @VecCount + putStrLn $ moduleOf @'Vec2 + putStrLn $ moduleOf @VecElem + putStrLn $ moduleOf @'Int8ElemRep + + -- This is from GHC.Tuple + putStrLn $ moduleOf @((),()) + + -- These are in GHC.Prim + putStrLn $ moduleOf @(# () , () #) +-- putStrLn $ moduleOf @(# () | () #) +-- + putStrLn $ moduleOf @(Int64#) + putStrLn $ moduleOf @(Word64#) + putStrLn $ moduleOf @TYPE + putStrLn $ moduleOf @CONSTRAINT diff --git a/testsuite/tests/typecheck/should_run/T22510.stdout b/testsuite/tests/typecheck/should_run/T22510.stdout new file mode 100644 index 0000000000..56f6aa096c --- /dev/null +++ b/testsuite/tests/typecheck/should_run/T22510.stdout @@ -0,0 +1,16 @@ +Levity: GHC.Types +'Lifted: GHC.Types +RuntimeRep: GHC.Types +'IntRep: GHC.Types +'BoxedRep: GHC.Types +'Lifted: GHC.Types +VecCount: GHC.Types +'Vec2: GHC.Types +VecElem: GHC.Types +'Int8ElemRep: GHC.Types +((),()): GHC.Tuple.Prim +(#,#) ('BoxedRep 'Lifted) ('BoxedRep 'Lifted) () (): GHC.Prim +Int64#: GHC.Prim +Word64#: GHC.Prim +TYPE: GHC.Prim +CONSTRAINT: GHC.Prim diff --git a/testsuite/tests/typecheck/should_run/all.T b/testsuite/tests/typecheck/should_run/all.T index b4e04a118c..b99efb15c2 100755 --- a/testsuite/tests/typecheck/should_run/all.T +++ b/testsuite/tests/typecheck/should_run/all.T @@ -163,3 +163,4 @@ test('T19397M3', extra_files(['T19397S.hs']), compile_and_run, ['-main-is foo']) test('T19397M4', extra_files(['T19397S.hs']), compile_and_run, ['-main-is foo']) test('T19667', normal, compile_and_run, ['-fhpc']) test('T20768', normal, compile_and_run, ['']) +test('T22510', normal, compile_and_run, ['']) |