Typeable: Fix module locations of some definitions in GHC.Typeswip/t25510

There was some confusion in Data.Typeable about which module certain
wired-in things were defined in. Just because something is wired-in
doesn't mean it comes from GHC.Prim, in particular things like LiftedRep
and RuntimeRep are defined in GHC.Types and that's the end of the story.

Things like Int#, Float# etc are defined in GHC.Prim as they have no
Haskell definition site at all so we need to generate type
representations for them (which live in GHC.Types).

Fixes #22510

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, [''])