Rework derivation of type representations for wired-in things

Previously types defined by `GHC.Types` and `GHC.Prim` had their
`Typeable` representations manually defined in `GHC.Typeable.Internals`.
This was terrible, resulting in a great deal of boilerplate and a number
of bugs due to missing or inconsistent representations (see #11120).

Here we take a different tack, initially proposed by Richard Eisenberg:
We wire-in the `Module`, `TrName`, and `TyCon` types, allowing them to
be used in `GHC.Types`. We then allow the usual type representation
generation logic to handle this module.

`GHC.Prim`, on the other hand, is a bit tricky as it has no object code
of its own.  To handle this we instead place the type representations
for the types defined here in `GHC.Types`.

On the whole this eliminates several special-cases as well as a fair
amount of boilerplate from hand-written representations. Moreover, we
get full coverage of primitive types for free.

Test Plan: Validate

Reviewers: goldfire, simonpj, austin, hvr

Subscribers: goldfire, simonpj, thomie

Differential Revision: https://phabricator.haskell.org/D1774

GHC Trac Issues: #11120

10 files changed, 223 insertions, 160 deletions

diff --git a/compiler/basicTypes/OccName.hs b/compiler/basicTypes/OccName.hs
index f7020a95f4..28256fb67b 100644
--- a/compiler/basicTypes/OccName.hs
+++ b/compiler/basicTypes/OccName.hs
@@ -71,7 +71,7 @@ module OccName (
         mkPReprTyConOcc,
         mkPADFunOcc,
         mkRecFldSelOcc,
-        mkTyConRepUserOcc, mkTyConRepSysOcc,
+        mkTyConRepOcc,
 
         -- ** Deconstruction
         occNameFS, occNameString, occNameSpace,
@@ -591,7 +591,7 @@ mkDataConWrapperOcc, mkWorkerOcc,
         mkDataTOcc, mkDataCOcc, mkDataConWorkerOcc, mkNewTyCoOcc,
         mkInstTyCoOcc, mkEqPredCoOcc, mkClassOpAuxOcc,
         mkCon2TagOcc, mkTag2ConOcc, mkMaxTagOcc,
-        mkTyConRepUserOcc, mkTyConRepSysOcc
+        mkTyConRepOcc
    :: OccName -> OccName
 
 -- These derived variables have a prefix that no Haskell value could have
@@ -617,18 +617,11 @@ mkTag2ConOcc        = mk_simple_deriv varName  "$tag2con_"
 mkMaxTagOcc         = mk_simple_deriv varName  "$maxtag_"
 
 -- TyConRepName stuff; see Note [Grand plan for Typeable] in TcTypeable
--- incluing the wrinkle about mkSpecialTyConRepName
-mkTyConRepSysOcc occ = mk_simple_deriv varName prefix occ
+mkTyConRepOcc occ = mk_simple_deriv varName prefix occ
   where
     prefix | isDataOcc occ = "$tc'"
            | otherwise     = "$tc"
 
-mkTyConRepUserOcc occ = mk_simple_deriv varName prefix occ
-  where
-    -- *User-writable* prefix, for types in gHC_TYPES
-    prefix | isDataOcc occ = "tc'"
-           | otherwise     = "tc"
-
 -- Generic deriving mechanism
 
 -- | Generate a module-unique name, to be used e.g. while generating new names
diff --git a/compiler/basicTypes/Unique.hs b/compiler/basicTypes/Unique.hs
index c9c2240490..e330aedb28 100644
--- a/compiler/basicTypes/Unique.hs
+++ b/compiler/basicTypes/Unique.hs
@@ -317,15 +317,13 @@ mkCoVarUnique        i = mkUnique 'g' i
 mkPreludeClassUnique i = mkUnique '2' i
 
 --------------------------------------------------
--- Wired-in data constructor keys occupy *three* slots:
---    * u: the DataCon itself
---    * u+1: its worker Id
---    * u+2: the TyConRepName of the promoted TyCon
--- Prelude data constructors are too simple to need wrappers.
-mkPreludeTyConUnique i                = mkUnique '3' (3*i)
-mkTupleTyConUnique Boxed           a  = mkUnique '4' (3*a)
-mkTupleTyConUnique Unboxed         a  = mkUnique '5' (3*a)
-mkCTupleTyConUnique                a  = mkUnique 'k' (3*a)
+-- Wired-in type constructor keys occupy *two* slots:
+--    * u: the TyCon itself
+--    * u+1: the TyConRepName of the TyCon
+mkPreludeTyConUnique i                = mkUnique '3' (2*i)
+mkTupleTyConUnique Boxed           a  = mkUnique '4' (2*a)
+mkTupleTyConUnique Unboxed         a  = mkUnique '5' (2*a)
+mkCTupleTyConUnique                a  = mkUnique 'k' (2*a)
 
 tyConRepNameUnique :: Unique -> Unique
 tyConRepNameUnique  u = incrUnique u
diff --git a/compiler/iface/BuildTyCl.hs b/compiler/iface/BuildTyCl.hs
index 75e8875d59..699fd5d366 100644
--- a/compiler/iface/BuildTyCl.hs
+++ b/compiler/iface/BuildTyCl.hs
@@ -18,7 +18,7 @@ module BuildTyCl (
 
 import IfaceEnv
 import FamInstEnv( FamInstEnvs, mkNewTypeCoAxiom )
-import TysWiredIn( isCTupleTyConName, tyConRepModOcc )
+import TysWiredIn( isCTupleTyConName )
 import DataCon
 import PatSyn
 import Var
@@ -357,4 +357,4 @@ newTyConRepName tc_name
   , (mod, occ) <- tyConRepModOcc mod (nameOccName tc_name)
   = newGlobalBinder mod occ noSrcSpan
   | otherwise
-  = newImplicitBinder tc_name mkTyConRepUserOcc
+  = newImplicitBinder tc_name mkTyConRepOcc
diff --git a/compiler/prelude/PrelNames.hs b/compiler/prelude/PrelNames.hs
index bc7951a5ec..609ac03ad1 100644
--- a/compiler/prelude/PrelNames.hs
+++ b/compiler/prelude/PrelNames.hs
@@ -208,13 +208,11 @@ basicKnownKeyNames
         -- Typeable
         typeableClassName,
         typeRepTyConName,
-        trTyConDataConName,
-        trModuleDataConName,
-        trNameSDataConName,
         typeRepIdName,
         mkPolyTyConAppName,
         mkAppTyName,
         typeSymbolTypeRepName, typeNatTypeRepName,
+        trGhcPrimModuleName,
 
         -- Dynamic
         toDynName,
@@ -818,16 +816,6 @@ and it's convenient to write them all down in one place.
 -- guys as well (perhaps) e.g. see  trueDataConName     below
 -}
 
--- | Build a 'Name' for the 'Typeable' representation of the given special 'TyCon'.
--- Special 'TyCon's include @(->)@, @BOX@, @Constraint@, etc. See 'TysPrim'.
-mkSpecialTyConRepName :: FastString -> Name -> Name
--- See Note [Grand plan for Typeable] in 'TcTypeable' in TcTypeable.
-mkSpecialTyConRepName fs tc_name
-  = mkExternalName (tyConRepNameUnique (nameUnique tc_name))
-                   tYPEABLE_INTERNAL
-                   (mkVarOccFS fs)
-                   wiredInSrcSpan
-
 wildCardName :: Name
 wildCardName = mkSystemVarName wildCardKey (fsLit "wild")
 
@@ -1145,25 +1133,23 @@ ixClassName = clsQual gHC_ARR (fsLit "Ix") ixClassKey
 -- Class Typeable, and functions for constructing `Typeable` dictionaries
 typeableClassName
   , typeRepTyConName
-  , trTyConDataConName
-  , trModuleDataConName
-  , trNameSDataConName
   , mkPolyTyConAppName
   , mkAppTyName
   , typeRepIdName
   , typeNatTypeRepName
   , typeSymbolTypeRepName
+  , trGhcPrimModuleName
   :: Name
 typeableClassName     = clsQual tYPEABLE_INTERNAL (fsLit "Typeable")       typeableClassKey
 typeRepTyConName      = tcQual  tYPEABLE_INTERNAL (fsLit "TypeRep")        typeRepTyConKey
-trTyConDataConName    = dcQual  gHC_TYPES         (fsLit "TyCon")          trTyConDataConKey
-trModuleDataConName   = dcQual  gHC_TYPES         (fsLit "Module")         trModuleDataConKey
-trNameSDataConName    = dcQual  gHC_TYPES         (fsLit "TrNameS")        trNameSDataConKey
 typeRepIdName         = varQual tYPEABLE_INTERNAL (fsLit "typeRep#")       typeRepIdKey
 mkPolyTyConAppName    = varQual tYPEABLE_INTERNAL (fsLit "mkPolyTyConApp") mkPolyTyConAppKey
 mkAppTyName           = varQual tYPEABLE_INTERNAL (fsLit "mkAppTy")        mkAppTyKey
 typeNatTypeRepName    = varQual tYPEABLE_INTERNAL (fsLit "typeNatTypeRep") typeNatTypeRepKey
 typeSymbolTypeRepName = varQual tYPEABLE_INTERNAL (fsLit "typeSymbolTypeRep") typeSymbolTypeRepKey
+-- this is the Typeable 'Module' for GHC.Prim (which has no code, so we place in GHC.Types)
+-- See Note [Grand plan for Typeable] in TcTypeable.
+trGhcPrimModuleName   = varQual gHC_TYPES         (fsLit "tr$ModuleGHCPrim")  trGhcPrimModuleKey
 
 -- Custom type errors
 errorMessageTypeErrorFamName
@@ -1805,10 +1791,18 @@ liftedDataConKey, unliftedDataConKey :: Unique
 liftedDataConKey                        = mkPreludeDataConUnique 39
 unliftedDataConKey                      = mkPreludeDataConUnique 40
 
-trTyConDataConKey, trModuleDataConKey, trNameSDataConKey :: Unique
-trTyConDataConKey                       = mkPreludeDataConUnique 41
-trModuleDataConKey                      = mkPreludeDataConUnique 42
-trNameSDataConKey                       = mkPreludeDataConUnique 43
+trTyConTyConKey, trTyConDataConKey,
+  trModuleTyConKey, trModuleDataConKey,
+  trNameTyConKey, trNameSDataConKey, trNameDDataConKey,
+  trGhcPrimModuleKey :: Unique
+trTyConTyConKey                         = mkPreludeDataConUnique 41
+trTyConDataConKey                       = mkPreludeDataConUnique 42
+trModuleTyConKey                        = mkPreludeDataConUnique 43
+trModuleDataConKey                      = mkPreludeDataConUnique 44
+trNameTyConKey                          = mkPreludeDataConUnique 45
+trNameSDataConKey                       = mkPreludeDataConUnique 46
+trNameDDataConKey                       = mkPreludeDataConUnique 47
+trGhcPrimModuleKey                      = mkPreludeDataConUnique 48
 
 typeErrorTextDataConKey,
   typeErrorAppendDataConKey,
diff --git a/compiler/prelude/TysPrim.hs b/compiler/prelude/TysPrim.hs
index 14505850fd..d1e42d5a10 100644
--- a/compiler/prelude/TysPrim.hs
+++ b/compiler/prelude/TysPrim.hs
@@ -272,7 +272,7 @@ funTyCon = mkFunTyCon funTyConName kind tc_rep_nm
         -- a prefix way, thus:  (->) Int# Int#.  And this is unusual.
         -- because they are never in scope in the source
 
-    tc_rep_nm = mkSpecialTyConRepName (fsLit "tcFun") funTyConName
+    tc_rep_nm = mkPrelTyConRepName funTyConName
 
 -- One step to remove subkinding.
 -- (->) :: * -> * -> *
@@ -329,7 +329,7 @@ tYPETyConName, unliftedTypeKindTyConName :: Name
 tYPETyCon = mkKindTyCon tYPETyConName
                         (ForAllTy (Anon levityTy) liftedTypeKind)
                         [Nominal]
-                        (mkSpecialTyConRepName (fsLit "tcTYPE") tYPETyConName)
+                        (mkPrelTyConRepName tYPETyConName)
 
    -- See Note [TYPE]
    -- NB: unlifted is wired in because there is no way to parse it in
diff --git a/compiler/prelude/TysWiredIn.hs b/compiler/prelude/TysWiredIn.hs
index 3b2213d359..cb9438a1ad 100644
--- a/compiler/prelude/TysWiredIn.hs
+++ b/compiler/prelude/TysWiredIn.hs
@@ -88,17 +88,20 @@ module TysWiredIn (
 
         mkWiredInIdName,    -- used in MkId
 
+        -- * Type representations
+        trModuleTyCon, trModuleDataCon,
+        trNameTyCon, trNameSDataCon, trNameDDataCon,
+        trTyConTyCon, trTyConDataCon,
+
         -- * Levity
         levityTy, levityTyCon, liftedDataCon, unliftedDataCon,
         liftedPromDataCon, unliftedPromDataCon,
         liftedDataConTy, unliftedDataConTy,
         liftedDataConName, unliftedDataConName,
-
-        -- * Helpers for building type representations
-        tyConRepModOcc
     ) where
 
 #include "HsVersions.h"
+#include "MachDeps.h"
 
 import {-# SOURCE #-} MkId( mkDataConWorkId, mkDictSelId )
 
@@ -120,7 +123,7 @@ import RdrName
 import Name
 import NameSet          ( NameSet, mkNameSet, elemNameSet )
 import BasicTypes       ( Arity, RecFlag(..), Boxity(..),
-                           TupleSort(..) )
+                          TupleSort(..) )
 import ForeignCall
 import SrcLoc           ( noSrcSpan )
 import Unique
@@ -136,48 +139,6 @@ alpha_tyvar = [alphaTyVar]
 alpha_ty :: [Type]
 alpha_ty = [alphaTy]
 
--- * Some helpers for generating type representations
-
--- | Make a 'Name' for the 'Typeable' representation of the given wired-in type
-mkPrelTyConRepName :: Name -> Name
--- See Note [Grand plan for Typeable] in 'TcTypeable' in TcTypeable.
--- This doesn't really belong here but a refactoring of this code eliminating
--- these manually-defined representations is imminent
-mkPrelTyConRepName tc_name  -- Prelude tc_name is always External,
-                            -- so nameModule will work
-  = mkExternalName rep_uniq rep_mod rep_occ (nameSrcSpan tc_name)
-  where
-    name_occ  = nameOccName tc_name
-    name_mod  = nameModule  tc_name
-    name_uniq = nameUnique  tc_name
-    rep_uniq | isTcOcc name_occ = tyConRepNameUnique   name_uniq
-             | otherwise        = dataConRepNameUnique name_uniq
-    (rep_mod, rep_occ) = tyConRepModOcc name_mod name_occ
-
--- | The name (and defining module) for the Typeable representation (TyCon) of a
--- type constructor.
---
--- See Note [Grand plan for Typeable] in 'TcTypeable' in TcTypeable.
-tyConRepModOcc :: Module -> OccName -> (Module, OccName)
-tyConRepModOcc tc_module tc_occ
-  -- The list type is defined in GHC.Types and therefore must have its
-  -- representations defined manually in Data.Typeable.Internal.
-  -- However, $tc': isn't a valid Haskell identifier, so we override the derived
-  -- name here.
-  | is_wired_in promotedConsDataCon
-  = (tYPEABLE_INTERNAL, mkOccName varName "tc'Cons")
-  | is_wired_in promotedNilDataCon
-  = (tYPEABLE_INTERNAL, mkOccName varName "tc'Nil")
-
-  | tc_module == gHC_TYPES
-  = (tYPEABLE_INTERNAL, mkTyConRepUserOcc tc_occ)
-  | otherwise
-  = (tc_module,         mkTyConRepSysOcc tc_occ)
-  where
-    is_wired_in :: TyCon -> Bool
-    is_wired_in tc =
-      tc_module == gHC_TYPES && tc_occ == nameOccName (tyConName tc)
-
 {-
 ************************************************************************
 *                                                                      *
@@ -227,6 +188,9 @@ wiredInTyCons = [ unitTyCon     -- Not treated like other tuples, because
               , liftedTypeKindTyCon
               , starKindTyCon
               , unicodeStarKindTyCon
+              , trModuleTyCon
+              , trTyConTyCon
+              , trNameTyCon
               ]
 
 mkWiredInTyConName :: BuiltInSyntax -> Module -> FastString -> Unique -> TyCon -> Name
@@ -661,7 +625,7 @@ heqSCSelId, coercibleSCSelId :: Id
   where
     tycon     = mkClassTyCon heqTyConName kind tvs roles
                              rhs klass NonRecursive
-                             (mkSpecialTyConRepName (fsLit "tcHEq") heqTyConName)
+                             (mkPrelTyConRepName heqTyConName)
     klass     = mkClass tvs [] [sc_pred] [sc_sel_id] [] [] (mkAnd []) tycon
     datacon   = pcDataCon heqDataConName tvs [sc_pred] tycon
 
@@ -912,7 +876,7 @@ listTyCon = buildAlgTyCon listTyConName alpha_tyvar [Representational]
                           Nothing []
                           (DataTyCon [nilDataCon, consDataCon] False )
                           Recursive False
-                          (VanillaAlgTyCon (mkSpecialTyConRepName (fsLit "tcList") listTyConName))
+                          (VanillaAlgTyCon $ mkPrelTyConRepName listTyConName)
 
 nilDataCon :: DataCon
 nilDataCon  = pcDataCon nilDataConName alpha_tyvar [] listTyCon
@@ -1099,3 +1063,56 @@ promotedGTDataCon     = promoteDataCon gtDataCon
 promotedConsDataCon, promotedNilDataCon :: TyCon
 promotedConsDataCon   = promoteDataCon consDataCon
 promotedNilDataCon    = promoteDataCon nilDataCon
+
+-- * Type representation types
+-- See Note [Grand plan for Typable] in TcTypeable.
+trModuleTyConName, trNameTyConName, trTyConTyConName :: Name
+trModuleTyConName   = mkWiredInTyConName UserSyntax gHC_TYPES (fsLit "Module")
+                        trModuleTyConKey trModuleTyCon
+trNameTyConName     = mkWiredInTyConName UserSyntax gHC_TYPES (fsLit "TrName")
+                        trNameTyConKey trNameTyCon
+trTyConTyConName    = mkWiredInTyConName UserSyntax gHC_TYPES (fsLit "TyCon")
+                        trTyConTyConKey trTyConTyCon
+
+trModuleDataConName, trTyConDataConName,
+  trNameSDataConName, trNameDDataConName :: Name
+trModuleDataConName = mkWiredInDataConName UserSyntax gHC_TYPES (fsLit "Module")
+                        trModuleDataConKey trModuleDataCon
+trTyConDataConName  = mkWiredInDataConName UserSyntax gHC_TYPES (fsLit "TyCon")
+                        trTyConDataConKey trTyConDataCon
+trNameSDataConName  = mkWiredInDataConName UserSyntax gHC_TYPES (fsLit "TrNameS")
+                        trNameSDataConKey trNameSDataCon
+trNameDDataConName  = mkWiredInDataConName UserSyntax gHC_TYPES (fsLit "TrNameD")
+                        trNameDDataConKey trNameDDataCon
+
+trModuleTyCon :: TyCon
+trModuleTyCon = pcNonRecDataTyCon trModuleTyConName Nothing [] [trModuleDataCon]
+
+trModuleDataCon :: DataCon
+trModuleDataCon = pcDataCon trModuleDataConName [] [trNameTy, trNameTy] trModuleTyCon
+
+trModuleTy :: Type
+trModuleTy = mkTyConTy trModuleTyCon
+
+trNameTyCon :: TyCon
+trNameTyCon = pcNonRecDataTyCon trNameTyConName Nothing [] [trNameSDataCon, trNameDDataCon]
+
+trNameSDataCon, trNameDDataCon :: DataCon
+trNameSDataCon = pcDataCon trNameSDataConName [] [addrPrimTy] trNameTyCon
+trNameDDataCon = pcDataCon trNameDDataConName [] [stringTy] trNameTyCon
+
+trNameTy :: Type
+trNameTy = mkTyConTy trNameTyCon
+
+trTyConTyCon :: TyCon
+trTyConTyCon = pcNonRecDataTyCon trTyConTyConName Nothing [] [trTyConDataCon]
+
+trTyConDataCon :: DataCon
+trTyConDataCon = pcDataCon trTyConDataConName [] [fprint, fprint, trModuleTy, trNameTy] trTyConTyCon
+  where
+    -- TODO: This should be for the target, no?
+#if WORD_SIZE_IN_BITS < 64
+    fprint = word64PrimTy
+#else
+    fprint = wordPrimTy
+#endif
diff --git a/compiler/typecheck/TcRnDriver.hs b/compiler/typecheck/TcRnDriver.hs
index 90d07a33da..efb703c953 100644
--- a/compiler/typecheck/TcRnDriver.hs
+++ b/compiler/typecheck/TcRnDriver.hs
@@ -71,7 +71,7 @@ import TcType
 import MkIface
 import TcSimplify
 import TcTyClsDecls
-import TcTypeable( mkModIdBindings )
+import TcTypeable( mkModIdBindings, mkPrimTypeableBinds )
 import LoadIface
 import TidyPgm    ( mkBootModDetailsTc )
 import RnNames
@@ -475,8 +475,9 @@ tcRnSrcDecls explicit_mod_hdr decls
         -- Do this before processing any data type declarations,
         -- which need tcg_tr_module to be initialised
       ; tcg_env <- mkModIdBindings
+      ; tcg_env <- setGblEnv tcg_env mkPrimTypeableBinds
 
-                -- Do all the declarations
+        -- Do all the declarations
       ; ((tcg_env, tcl_env), lie) <- setGblEnv tcg_env  $
                                      captureConstraints $
               do { (tcg_env, tcl_env) <- tc_rn_src_decls decls ;
diff --git a/compiler/typecheck/TcTypeable.hs b/compiler/typecheck/TcTypeable.hs
index b750340720..0be765c949 100644
--- a/compiler/typecheck/TcTypeable.hs
+++ b/compiler/typecheck/TcTypeable.hs
@@ -4,7 +4,7 @@
 -}
 
 module TcTypeable(
-    mkTypeableBinds, mkModIdBindings
+    mkTypeableBinds, mkPrimTypeableBinds, mkModIdBindings
   ) where
 
 
@@ -12,7 +12,10 @@ import TcBinds( addTypecheckedBinds )
 import IfaceEnv( newGlobalBinder )
 import TcEnv
 import TcRnMonad
-import PrelNames( gHC_TYPES, trModuleDataConName, trTyConDataConName, trNameSDataConName )
+import PrelNames
+import TysPrim ( primTyCons )
+import TysWiredIn ( trModuleTyCon, trModuleDataCon, trTyConTyCon
+                  , trTyConDataCon, trNameSDataCon )
 import Id
 import Type
 import TyCon
@@ -55,45 +58,32 @@ The overall plan is this:
 3. Record the TyConRepName in T's TyCon, including for promoted
    data and type constructors, and kinds like * and #.
 
-   The TyConRepNaem is not an "implicit Id".  It's more like a record
+   The TyConRepName is not an "implicit Id".  It's more like a record
    selector: the TyCon knows its name but you have to go to the
    interface file to find its type, value, etc
 
-4. Solve Typeable costraints.  This is done by a custom Typeable solver,
+4. Solve Typeable constraints.  This is done by a custom Typeable solver,
    currently in TcInteract, that use M.$tcT so solve (Typeable T).
 
 There are many wrinkles:
 
 * Since we generate $tcT for every data type T, the types TyCon and
-  Module must be available right from the start; so they are defined
-  in ghc-prim:GHC.Types
+  Module must be available right from the start; so they are wired in (and
+  defined in ghc-prim:GHC.Types).
+
+* GHC.Prim doesn't have any associated object code, so we need to put the
+  representations for types defined in this module elsewhere. We put these
+  in GHC.Types. TcTypeable.mkPrimTypeableBinds is responsible for injecting
+  the bindings for the GHC.Prim representions when compiling GHC.Types.
+
+* TyCon.tyConRepModOcc is responsible for determining where to find
+  the representation binding for a given type. This is where we handle
+  the special case for GHC.Prim.
 
 * To save space and reduce dependencies, we need use quite low-level
   representations for TyCon and Module.  See GHC.Types
   Note [Runtime representation of modules and tycons]
 
-* It's hard to generate the TyCon/Module bindings when the types TyCon
-  and Module aren't yet available; i.e. when compiling GHC.Types
-  itself.  So we *don't* generate them for types in GHC.Types.  Instead
-  we write them by hand in base:GHC.Typeable.Internal.
-
-* To be able to define them by hand, they need to have user-writable
-  names, thus
-        tcBool    not $tcBool    for the type-rep TyCon for Bool
-  Hence PrelNames.tyConRepModOcc
-
-* Moreover for type constructors with special syntax, they need to have
-  completely hand-crafted names
-    lists    tcList         not $tc[]   for the type-rep TyCon for []
-    kinds    tcLiftedKind   not $tc*    for the type-rep TyCon for *
-  Hence PrelNames.mkSpecialTyConRepName, which takes an extra FastString
-  to use for the TyConRepName
-
-* Since listTyCon, boolTyCon etd are wired in, their TyConRepNames must
-  be wired in as well.  For these wired-in TyCons we generate the
-  TyConRepName's unique from that of the TyCon; see
-  Unique.tyConRepNameUnique, dataConRepNameUnique.
-
 -}
 
 {- *********************************************************************
@@ -105,24 +95,21 @@ There are many wrinkles:
 mkModIdBindings :: TcM TcGblEnv
 mkModIdBindings
   = do { mod <- getModule
-       ; if mod == gHC_TYPES
-         then getGblEnv  -- Do not generate bindings for modules in GHC.Types
-         else
-    do { loc <- getSrcSpanM
-       ; tr_mod_dc  <- tcLookupDataCon trModuleDataConName
-       ; tr_name_dc <- tcLookupDataCon trNameSDataConName
+       ; loc <- getSrcSpanM
        ; mod_nm     <- newGlobalBinder mod (mkVarOcc "$trModule") loc
-       ; let mod_ty   = mkTyConApp (dataConTyCon tr_mod_dc) []
-             mod_id   = mkExportedVanillaId mod_nm mod_ty
-             mod_bind = mkVarBind mod_id mod_rhs
-             mod_rhs  = nlHsApps (dataConWrapId tr_mod_dc)
-                           [ trNameLit tr_name_dc (unitIdFS (moduleUnitId mod))
-                           , trNameLit tr_name_dc (moduleNameFS (moduleName mod)) ]
+       ; let mod_id   = mkExportedVanillaId mod_nm
+                                            (mkTyConApp trModuleTyCon [])
+             mod_bind = mkVarBind mod_id (mkModIdRHS mod)
 
        ; tcg_env <- tcExtendGlobalValEnv [mod_id] getGblEnv
        ; return (tcg_env { tcg_tr_module = Just mod_id }
-                 `addTypecheckedBinds` [unitBag mod_bind]) } }
+                 `addTypecheckedBinds` [unitBag mod_bind]) }
 
+mkModIdRHS :: Module -> LHsExpr Id
+mkModIdRHS mod
+  = nlHsApps (dataConWrapId trModuleDataCon)
+             [ trNameLit (unitIdFS (moduleUnitId mod))
+             , trNameLit (moduleNameFS (moduleName mod)) ]
 
 {- *********************************************************************
 *                                                                      *
@@ -132,40 +119,79 @@ mkModIdBindings
 
 mkTypeableBinds :: [TyCon] -> TcM TcGblEnv
 mkTypeableBinds tycons
-  = do { dflags  <- getDynFlags
+  = do { dflags <- getDynFlags
        ; gbl_env <- getGblEnv
        ; mod <- getModule
-       ; if mod == gHC_TYPES
-         then return gbl_env  -- Do not generate bindings for modules in GHC.Types
-         else
-    do { tr_datacon  <- tcLookupDataCon trTyConDataConName
-       ; trn_datacon <- tcLookupDataCon trNameSDataConName
        ; let pkg_str  = unitIdString (moduleUnitId mod)
              mod_str  = moduleNameString (moduleName mod)
              mod_expr = case tcg_tr_module gbl_env of  -- Should be set by now
                            Just mod_id -> nlHsVar mod_id
                            Nothing     -> pprPanic "tcMkTypeableBinds" (ppr tycons)
-             stuff    = (dflags, mod_expr, pkg_str, mod_str, tr_datacon, trn_datacon)
+             stuff    = (dflags, mod_expr, pkg_str, mod_str)
              all_tycons = [ tc' | tc <- tycons, tc' <- tc : tyConATs tc ]
                              -- We need type representations for any associated types
              tc_binds = map (mk_typeable_binds stuff) all_tycons
              tycon_rep_ids = foldr ((++) . collectHsBindsBinders) [] tc_binds
 
        ; gbl_env <- tcExtendGlobalValEnv tycon_rep_ids getGblEnv
-       ; return (gbl_env `addTypecheckedBinds` tc_binds) } }
+       ; return (gbl_env `addTypecheckedBinds` tc_binds) }
+
+-- | Generate bindings for the type representation of a wired-in TyCon defined
+-- by the virtual "GHC.Prim" module. This is where we inject the representation
+-- bindings for primitive types into "GHC.Types"
+--
+-- See Note [Grand plan for Typeable] in this module.
+mkPrimTypeableBinds :: TcM TcGblEnv
+mkPrimTypeableBinds
+  = do { dflags <- getDynFlags
+       ; mod <- getModule
+       ; let prim_binds :: LHsBinds Id
+             prim_binds
+               | mod == gHC_TYPES = ghcPrimTypeableBinds dflags
+               | otherwise        = emptyBag
+             prim_rep_ids = collectHsBindsBinders prim_binds
+       ; gbl_env <- tcExtendGlobalValEnv prim_rep_ids getGblEnv
+       ; return (gbl_env `addTypecheckedBinds` [prim_binds]) }
+
+-- | Generate bindings for the type representation of the wired-in TyCons defined
+-- by the virtual "GHC.Prim" module. This differs from the usual
+-- @mkTypeableBinds@ path in that here we need to lie to 'mk_typeable_binds'
+-- about the module we are compiling (since we are currently compiling
+-- "GHC.Types" yet are producing representations for types in "GHC.Prim").
+--
+-- See Note [Grand plan for Typeable] in this module.
+ghcPrimTypeableBinds :: DynFlags -> LHsBinds Id
+ghcPrimTypeableBinds dflags
+  = ghc_prim_module_bind `unionBags` unionManyBags (map mkBind all_prim_tys)
+  where
+    all_prim_tys :: [TyCon]
+    all_prim_tys = [ tc' | tc <- funTyCon : primTyCons
+                         , tc' <- tc : tyConATs tc ]
+
+    ghc_prim_module_id =
+        mkExportedVanillaId trGhcPrimModuleName (mkTyConTy trModuleTyCon)
+    ghc_prim_module_bind =
+        unitBag $ mkVarBind ghc_prim_module_id (mkModIdRHS gHC_PRIM)
+
+    stuff :: TypeableStuff
+    stuff = (dflags, nlHsVar ghc_prim_module_id, "ghc-prim", "GHC.Prim")
 
-trNameLit :: DataCon -> FastString -> LHsExpr Id
-trNameLit tr_name_dc fs
-  = nlHsApps (dataConWrapId tr_name_dc) [nlHsLit (mkHsStringPrimLit fs)]
+    mkBind :: TyCon -> LHsBinds Id
+    mkBind = mk_typeable_binds stuff
+
+trNameLit :: FastString -> LHsExpr Id
+trNameLit fs
+  = nlHsApps (dataConWrapId trNameSDataCon) [nlHsLit (mkHsStringPrimLit fs)]
 
 type TypeableStuff
   = ( DynFlags
     , LHsExpr Id  -- Of type GHC.Types.Module
     , String      -- Package name
     , String      -- Module name
-    , DataCon     -- Data constructor GHC.Types.TyCon
-    , DataCon )   -- Data constructor GHC.Types.TrNameS
+    )
 
+-- | Make bindings for the type representations of a 'TyCon' and its
+-- promoted constructors.
 mk_typeable_binds :: TypeableStuff -> TyCon -> LHsBinds Id
 mk_typeable_binds stuff tycon
   = mkTyConRepBinds stuff tycon
@@ -173,18 +199,26 @@ mk_typeable_binds stuff tycon
     unionManyBags (map (mkTypeableDataConBinds stuff) (tyConDataCons tycon))
 
 mkTyConRepBinds :: TypeableStuff -> TyCon -> LHsBinds Id
-mkTyConRepBinds (dflags, mod_expr, pkg_str, mod_str, tr_datacon, trn_datacon) tycon
+mkTyConRepBinds stuff tycon
   = case tyConRepName_maybe tycon of
       Just rep_name -> unitBag (mkVarBind rep_id rep_rhs)
          where
-           rep_id  = mkExportedVanillaId rep_name (mkTyConApp tr_tycon [])
+           rep_id  = mkExportedVanillaId rep_name (mkTyConApp trTyConTyCon [])
+           rep_rhs = mkTyConRepRHS stuff tycon
       _ -> emptyBag
+
+-- | Produce typeable binds for the promoted 'TyCon' of a data constructor
+mkTypeableDataConBinds :: TypeableStuff -> DataCon -> LHsBinds Id
+mkTypeableDataConBinds stuff dc
+  = mkTyConRepBinds stuff (promoteDataCon dc)
+
+mkTyConRepRHS :: TypeableStuff -> TyCon -> LHsExpr Id
+mkTyConRepRHS (dflags, mod_expr, pkg_str, mod_str) tycon = rep_rhs
   where
-    tr_tycon = dataConTyCon tr_datacon
-    rep_rhs = nlHsApps (dataConWrapId tr_datacon)
+    rep_rhs = nlHsApps (dataConWrapId trTyConDataCon)
                        [ nlHsLit (word64 high), nlHsLit (word64 low)
                        , mod_expr
-                       , trNameLit trn_datacon (mkFastString tycon_str) ]
+                       , trNameLit (mkFastString tycon_str) ]
 
     tycon_str = add_tick (occNameString (getOccName tycon))
     add_tick s | isPromotedDataCon tycon = '\'' : s
@@ -199,6 +233,3 @@ mkTyConRepBinds (dflags, mod_expr, pkg_str, mod_str, tr_datacon, trn_datacon) ty
     word64 | wORD_SIZE dflags == 4 = \n -> HsWord64Prim (show n) (toInteger n)
            | otherwise             = \n -> HsWordPrim   (show n) (toInteger n)
 
-mkTypeableDataConBinds :: TypeableStuff -> DataCon -> LHsBinds Id
-mkTypeableDataConBinds stuff dc
-  = mkTyConRepBinds stuff (promoteDataCon dc)
diff --git a/compiler/types/TyCon.hs b/compiler/types/TyCon.hs
index 0f64cf91cb..676d2f9a52 100644
--- a/compiler/types/TyCon.hs
+++ b/compiler/types/TyCon.hs
@@ -91,6 +91,8 @@ module TyCon(
 
         -- * Runtime type representation
         TyConRepName, tyConRepName_maybe,
+        mkPrelTyConRepName,
+        tyConRepModOcc,
 
         -- * Primitive representations of Types
         PrimRep(..), PrimElemRep(..),
@@ -124,6 +126,8 @@ import FastStringEnv
 import FieldLabel
 import Constants
 import Util
+import Unique( tyConRepNameUnique, dataConRepNameUnique )
+import Module
 
 import qualified Data.Data as Data
 import Data.Typeable (Typeable)
@@ -914,6 +918,31 @@ tyConRepName_maybe (PromotedDataCon { tcRepName = rep_nm })
   = Just rep_nm
 tyConRepName_maybe _ = Nothing
 
+-- | Make a 'Name' for the 'Typeable' representation of the given wired-in type
+mkPrelTyConRepName :: Name -> TyConRepName
+-- See Note [Grand plan for Typeable] in 'TcTypeable' in TcTypeable.
+mkPrelTyConRepName tc_name  -- Prelude tc_name is always External,
+                            -- so nameModule will work
+  = mkExternalName rep_uniq rep_mod rep_occ (nameSrcSpan tc_name)
+  where
+    name_occ  = nameOccName tc_name
+    name_mod  = nameModule  tc_name
+    name_uniq = nameUnique  tc_name
+    rep_uniq | isTcOcc name_occ = tyConRepNameUnique   name_uniq
+             | otherwise        = dataConRepNameUnique name_uniq
+    (rep_mod, rep_occ) = tyConRepModOcc name_mod name_occ
+
+-- | The name (and defining module) for the Typeable representation (TyCon) of a
+-- type constructor.
+--
+-- See Note [Grand plan for Typeable] in 'TcTypeable' in TcTypeable.
+tyConRepModOcc :: Module -> OccName -> (Module, OccName)
+tyConRepModOcc tc_module tc_occ = (rep_module, mkTyConRepOcc tc_occ)
+  where
+    rep_module
+      | tc_module == gHC_PRIM = gHC_TYPES
+      | otherwise             = tc_module
+
 
 {- *********************************************************************
 *                                                                      *
@@ -1196,7 +1225,7 @@ mkTcTyCon name kind
 -- | Create an unlifted primitive 'TyCon', such as @Int#@
 mkPrimTyCon :: Name  -> Kind -> [Role] -> PrimRep -> TyCon
 mkPrimTyCon name kind roles rep
-  = mkPrimTyCon' name kind roles rep True Nothing
+  = mkPrimTyCon' name kind roles rep True (Just $ mkPrelTyConRepName name)
 
 -- | Kind constructors
 mkKindTyCon :: Name -> Kind -> [Role] -> Name -> TyCon
diff --git a/compiler/vectorise/Vectorise/Type/TyConDecl.hs b/compiler/vectorise/Vectorise/Type/TyConDecl.hs
index 859df3749b..03e7d27d0e 100644
--- a/compiler/vectorise/Vectorise/Type/TyConDecl.hs
+++ b/compiler/vectorise/Vectorise/Type/TyConDecl.hs
@@ -100,7 +100,7 @@ vectTyConDecl tycon name'
              gadt_flag = isGadtSyntaxTyCon tycon
 
            -- build the vectorised type constructor
-       ; tc_rep_name <- mkDerivedName mkTyConRepUserOcc name'
+       ; tc_rep_name <- mkDerivedName mkTyConRepOcc name'
        ; return $ mkAlgTyCon
                     name'                   -- new name
                     (tyConKind tycon)       -- keep original kind