Unwire Typeable representation types

In order to make this work I needed to shuffle around typechecking a bit
such that `TyCon` and friends are available during compilation of
GHC.Types.  I also did a bit of refactoring of `TcTypeable`.

Test Plan: Validate

Reviewers: simonpj, austin

Subscribers: simonpj, thomie

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

GHC Trac Issues: #11120

compiler/prelude/PrelNames.hs

@@ -205,6 +205,11 @@ basicKnownKeyNames
         ioTyConName, ioDataConName,
         runMainIOName,
 
+        -- Type representation types
+        trModuleTyConName, trModuleDataConName,
+        trNameTyConName, trNameSDataConName, trNameDDataConName,
+        trTyConTyConName, trTyConDataConName,
+
         -- Typeable
         typeableClassName,
         typeRepTyConName,
@@ -1130,6 +1135,23 @@ rationalToDoubleName = varQual gHC_FLOAT (fsLit "rationalToDouble") rationalToDo
 ixClassName :: Name
 ixClassName = clsQual gHC_ARR (fsLit "Ix") ixClassKey
 
+-- Typeable representation types
+trModuleTyConName
+  , trModuleDataConName
+  , trNameTyConName
+  , trNameSDataConName
+  , trNameDDataConName
+  , trTyConTyConName
+  , trTyConDataConName
+  :: Name
+trModuleTyConName     = tcQual gHC_TYPES          (fsLit "Module")         trModuleTyConKey
+trModuleDataConName   = dcQual gHC_TYPES          (fsLit "Module")         trModuleDataConKey
+trNameTyConName       = tcQual gHC_TYPES          (fsLit "TrName")         trNameTyConKey
+trNameSDataConName    = dcQual gHC_TYPES          (fsLit "TrNameS")        trNameSDataConKey
+trNameDDataConName    = dcQual gHC_TYPES          (fsLit "TrNameD")        trNameDDataConKey
+trTyConTyConName      = tcQual gHC_TYPES          (fsLit "TyCon")          trTyConTyConKey
+trTyConDataConName    = dcQual gHC_TYPES          (fsLit "TyCon")          trTyConDataConKey
+
 -- Class Typeable, and functions for constructing `Typeable` dictionaries
 typeableClassName
   , typeRepTyConName

compiler/prelude/TysWiredIn.hs

@@ -88,11 +88,6 @@ module TysWiredIn (
 
         mkWiredInIdName,    -- used in MkId
 
-        -- * Type representations
-        trModuleTyCon, trModuleDataCon,
-        trNameTyCon, trNameSDataCon, trNameDDataCon,
-        trTyConTyCon, trTyConDataCon,
-
         -- * Levity
         levityTy, levityTyCon, liftedDataCon, unliftedDataCon,
         liftedPromDataCon, unliftedPromDataCon,
@@ -188,9 +183,6 @@ wiredInTyCons = [ unitTyCon     -- Not treated like other tuples, because
               , liftedTypeKindTyCon
               , starKindTyCon
               , unicodeStarKindTyCon
-              , trModuleTyCon
-              , trTyConTyCon
-              , trNameTyCon
               ]
 
 mkWiredInTyConName :: BuiltInSyntax -> Module -> FastString -> Unique -> TyCon -> Name
@@ -615,6 +607,7 @@ unboxedUnitDataCon = tupleDataCon   Unboxed 0
 ********************************************************************* -}
 
 -- See Note [The equality types story] in TysPrim
+-- (:~~: :: forall k1 k2 (a :: k1) (b :: k2). a -> b -> Constraint)
 heqTyCon, coercibleTyCon :: TyCon
 heqClass, coercibleClass :: Class
 heqDataCon, coercibleDataCon :: DataCon
@@ -1063,56 +1056,3 @@ 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

compiler/typecheck/TcRnDriver.hs

@@ -71,7 +71,7 @@ import TcType
 import MkIface
 import TcSimplify
 import TcTyClsDecls
-import TcTypeable( mkModIdBindings, mkPrimTypeableBinds )
+import TcTypeable ( mkTypeableBinds )
 import LoadIface
 import TidyPgm    ( mkBootModDetailsTc )
 import RnNames
@@ -471,21 +471,19 @@ tcRnSrcDecls :: Bool  -- False => no 'module M(..) where' header at all
         -- Returns the variables free in the decls
         -- Reason: solely to report unused imports and bindings
 tcRnSrcDecls explicit_mod_hdr decls
- = do { -- Create a binding for $trModule
-        -- 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
-      ; ((tcg_env, tcl_env), lie) <- setGblEnv tcg_env  $
-                                     captureConstraints $
+ = do { -- Do all the declarations
+      ; ((tcg_env, tcl_env), lie) <- captureConstraints $
               do { (tcg_env, tcl_env) <- tc_rn_src_decls decls ;
                  ; tcg_env <- setEnvs (tcg_env, tcl_env) $
                               checkMain explicit_mod_hdr
                  ; return (tcg_env, tcl_env) }
       ; setEnvs (tcg_env, tcl_env) $ do {
 
+        -- Emit Typeable bindings
+      ; tcg_env <- setGblEnv tcg_env mkTypeableBinds
+
+      ; setGblEnv tcg_env $ do {
+
 #ifdef GHCI
       ; finishTH
 #endif /* GHCI */
@@ -544,7 +542,7 @@ tcRnSrcDecls explicit_mod_hdr decls
 
       ; setGlobalTypeEnv tcg_env' final_type_env
 
-   } }
+   } } }
 
 tc_rn_src_decls :: [LHsDecl RdrName]
                 -> TcM (TcGblEnv, TcLclEnv)

compiler/typecheck/TcTyDecls.hs

@@ -30,7 +30,6 @@ module TcTyDecls(
 
 import TcRnMonad
 import TcEnv
-import TcTypeable( mkTypeableBinds )
 import TcBinds( tcRecSelBinds )
 import TyCoRep( Type(..), TyBinder(..), delBinderVar )
 import TcType
@@ -863,10 +862,7 @@ tcAddImplicits tycons
     do { traceTc "tcAddImplicits" $ vcat
             [ text "tycons" <+> ppr tycons
             , text "implicits" <+> ppr implicit_things ]
-       ; gbl_env <- mkTypeableBinds tycons
-       ; gbl_env <- setGblEnv gbl_env $
-                    tcRecSelBinds (mkRecSelBinds tycons)
-       ; return gbl_env }
+       ; tcRecSelBinds (mkRecSelBinds tycons) }
  where
    implicit_things = concatMap implicitTyConThings tycons
    def_meth_ids    = mkDefaultMethodIds tycons