Generate Typeable info at definition sites

This is the second attempt at merging D757.

This patch implements the idea floated in Trac #9858, namely that we
should generate type-representation information at the data type
declaration site, rather than when solving a Typeable constraint.

However, this turned out quite a bit harder than I expected. I still
think it's the right thing to do, and it's done now, but it was quite
a struggle.

See particularly

 * Note [Grand plan for Typeable] in TcTypeable (which is a new module)
 * Note [The overall promotion story] in DataCon (clarifies existing
stuff)

The most painful bit was that to generate Typeable instances (ie
TyConRepName bindings) for every TyCon is tricky for types in ghc-prim
etc:

 * We need to have enough data types around to *define* a TyCon
 * Many of these types are wired-in

Also, to minimise the code generated for each data type, I wanted to
generate pure data, not CAFs with unpackCString# stuff floating about.

Performance
~~~~~~~~~~~
Three perf/compiler tests start to allocate quite a bit more. This isn't
surprising, because they all allocate zillions of data types, with
practically no other code, esp. T1969

 * T1969:    GHC allocates 19% more
 * T4801:    GHC allocates 13% more
 * T5321FD:  GHC allocates 13% more
 * T9675:    GHC allocates 11% more
 * T783:     GHC allocates 11% more
 * T5642:    GHC allocates 10% more

I'm treating this as acceptable. The payoff comes in Typeable-heavy
code.

Remaining to do
~~~~~~~~~~~~~~~

 * I think that "TyCon" and "Module" are over-generic names to use for
   the runtime type representations used in GHC.Typeable. Better might
be
   "TrTyCon" and "TrModule". But I have not yet done this

 * Add more info the the "TyCon" e.g. source location where it was
   defined

 * Use the new "Module" type to help with Trac Trac #10068

 * It would be possible to generate TyConRepName (ie Typeable
   instances) selectively rather than all the time. We'd need to persist
   the information in interface files. Lacking a motivating reason I
have
   not done this, but it would not be difficult.

Refactoring
~~~~~~~~~~~
As is so often the case, I ended up refactoring more than I intended.
In particular

 * In TyCon, a type *family* (whether type or data) is repesented by a
   FamilyTyCon
     * a algebraic data type (including data/newtype instances) is
       represented by AlgTyCon This wasn't true before; a data family
       was represented as an AlgTyCon. There are some corresponding
       changes in IfaceSyn.

     * Also get rid of the (unhelpfully named) tyConParent.

 * In TyCon define 'Promoted', isomorphic to Maybe, used when things are
   optionally promoted; and use it elsewhere in GHC.

 * Cleanup handling of knownKeyNames

 * Each TyCon, including promoted TyCons, contains its TyConRepName, if
   it has one. This is, in effect, the name of its Typeable instance.

Updates haddock submodule

Test Plan: Let Harbormaster validate

Reviewers: austin, hvr, goldfire

Subscribers: goldfire, thomie

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

GHC Trac Issues: #9858

9 files changed, 345 insertions, 117 deletions

diff --git a/libraries/base/Data/Typeable.hs b/libraries/base/Data/Typeable.hs
index c30a43dd65..1afc6a9563 100644
--- a/libraries/base/Data/Typeable.hs
+++ b/libraries/base/Data/Typeable.hs
@@ -58,7 +58,7 @@ module Data.Typeable
 
         -- * A canonical proxy type
         Proxy (..),
-        
+
         -- * Type representations
         TypeRep,        -- abstract, instance of: Eq, Show, Typeable
         typeRepFingerprint,
@@ -66,6 +66,7 @@ module Data.Typeable
         showsTypeRep,
 
         TyCon,          -- abstract, instance of: Eq, Show, Typeable
+                        -- For now don't export Module, to avoid name clashes
         tyConFingerprint,
         tyConString,
         tyConPackage,
@@ -87,7 +88,7 @@ module Data.Typeable
         typeRepArgs,    -- :: TypeRep -> [TypeRep]
   ) where
 
-import Data.Typeable.Internal hiding (mkTyCon)
+import Data.Typeable.Internal
 import Data.Type.Equality
 
 import Unsafe.Coerce
diff --git a/libraries/base/Data/Typeable/Internal.hs b/libraries/base/Data/Typeable/Internal.hs
index e35d794a62..4379155c57 100644
--- a/libraries/base/Data/Typeable/Internal.hs
+++ b/libraries/base/Data/Typeable/Internal.hs
@@ -25,15 +25,34 @@
 
 module Data.Typeable.Internal (
     Proxy (..),
-    TypeRep(..),
-    KindRep,
     Fingerprint(..),
+
+    -- * Typeable class
     typeOf, typeOf1, typeOf2, typeOf3, typeOf4, typeOf5, typeOf6, typeOf7,
     Typeable1, Typeable2, Typeable3, Typeable4, Typeable5, Typeable6, Typeable7,
-    TyCon(..),
+
+    -- * Module
+    Module,  -- Abstract
+    moduleName, modulePackage,
+
+    -- * TyCon
+    TyCon,   -- Abstract
+    tyConPackage, tyConModule, tyConName, tyConString, tyConFingerprint,
+    mkTyCon3, mkTyCon3#,
+    rnfTyCon,
+
+    tcBool, tc'True, tc'False,
+    tcOrdering, tc'LT, tc'EQ, tc'GT,
+    tcChar, tcInt, tcWord, tcFloat, tcDouble, tcFun,
+    tcIO, tcSPEC, tcTyCon, tcModule,
+    tcCoercible, tcList, tcEq,
+    tcLiftedKind, tcUnliftedKind, tcOpenKind, tcBOX, tcConstraint, tcAnyK,
+
+    funTc,  -- ToDo
+
+    -- * TypeRep
+    TypeRep(..), KindRep,
     typeRep,
-    mkTyCon,
-    mkTyCon3,
     mkTyConApp,
     mkPolyTyConApp,
     mkAppTy,
@@ -47,19 +66,15 @@ module Data.Typeable.Internal (
     typeRepFingerprint,
     rnfTypeRep,
     showsTypeRep,
-    tyConString,
-    rnfTyCon,
-    listTc, funTc,
     typeRepKinds,
-    typeNatTypeRep,
-    typeSymbolTypeRep
+    typeSymbolTypeRep, typeNatTypeRep
   ) where
 
 import GHC.Base
 import GHC.Word
 import GHC.Show
-import GHC.TypeLits
 import Data.Proxy
+import GHC.TypeLits( KnownNat, KnownSymbol, natVal', symbolVal' )
 
 import GHC.Fingerprint.Type
 import {-# SOURCE #-} GHC.Fingerprint
@@ -68,9 +83,106 @@ import {-# SOURCE #-} GHC.Fingerprint
    -- of Data.Typeable as much as possible so we can optimise the derived
    -- instances.
 
--- | A concrete representation of a (monomorphic) type.  'TypeRep'
--- supports reasonably efficient equality.
+#include "MachDeps.h"
+
+{- *********************************************************************
+*                                                                      *
+                The TyCon type
+*                                                                      *
+********************************************************************* -}
+
+modulePackage :: Module -> String
+modulePackage (Module p _) = trNameString p
+
+moduleName :: Module -> String
+moduleName (Module _ m) = trNameString m
+
+tyConPackage :: TyCon -> String
+tyConPackage (TyCon _ _ m _) = modulePackage m
+
+tyConModule :: TyCon -> String
+tyConModule (TyCon _ _ m _) = moduleName m
+
+tyConName :: TyCon -> String
+tyConName (TyCon _ _ _ n) = trNameString n
+
+trNameString :: TrName -> String
+trNameString (TrNameS s) = unpackCString# s
+trNameString (TrNameD s) = s
+
+-- | Observe string encoding of a type representation
+{-# DEPRECATED tyConString "renamed to 'tyConName'; 'tyConModule' and 'tyConPackage' are also available." #-}
+-- deprecated in 7.4
+tyConString :: TyCon   -> String
+tyConString = tyConName
+
+tyConFingerprint :: TyCon -> Fingerprint
+tyConFingerprint (TyCon hi lo _ _)
+  = Fingerprint (W64# hi) (W64# lo)
+
+mkTyCon3# :: Addr#       -- ^ package name
+          -> Addr#       -- ^ module name
+          -> Addr#       -- ^ the name of the type constructor
+          -> TyCon       -- ^ A unique 'TyCon' object
+mkTyCon3# pkg modl name
+  | Fingerprint (W64# hi) (W64# lo) <- fingerprint
+  = TyCon hi lo (Module (TrNameS pkg) (TrNameS modl)) (TrNameS name)
+  where
+    fingerprint :: Fingerprint
+    fingerprint = fingerprintString (unpackCString# pkg
+                                    ++ (' ': unpackCString# modl)
+                                    ++ (' ' : unpackCString# name))
+
+mkTyCon3 :: String       -- ^ package name
+         -> String       -- ^ module name
+         -> String       -- ^ the name of the type constructor
+         -> TyCon        -- ^ A unique 'TyCon' object
+-- Used when the strings are dynamically allocated,
+-- eg from binary deserialisation
+mkTyCon3 pkg modl name
+  | Fingerprint (W64# hi) (W64# lo) <- fingerprint
+  = TyCon hi lo (Module (TrNameD pkg) (TrNameD modl)) (TrNameD name)
+  where
+    fingerprint :: Fingerprint
+    fingerprint = fingerprintString (pkg ++ (' ':modl) ++ (' ':name))
+
+isTupleTyCon :: TyCon -> Bool
+isTupleTyCon tc
+  | ('(':',':_) <- tyConName tc = True
+  | otherwise                   = False
+
+-- | Helper to fully evaluate 'TyCon' for use as @NFData(rnf)@ implementation
+--
+-- @since 4.8.0.0
+rnfModule :: Module -> ()
+rnfModule (Module p m) = rnfTrName p `seq` rnfTrName m
+
+rnfTrName :: TrName -> ()
+rnfTrName (TrNameS _) = ()
+rnfTrName (TrNameD n) = rnfString n
+
+rnfTyCon :: TyCon -> ()
+rnfTyCon (TyCon _ _ m n) = rnfModule m `seq` rnfTrName n
+
+rnfString :: [Char] -> ()
+rnfString [] = ()
+rnfString (c:cs) = c `seq` rnfString cs
+
+
+{- *********************************************************************
+*                                                                      *
+                The TypeRep type
+*                                                                      *
+********************************************************************* -}
+
+-- | A concrete representation of a (monomorphic) type.
+-- 'TypeRep' supports reasonably efficient equality.
 data TypeRep = TypeRep {-# UNPACK #-} !Fingerprint TyCon [KindRep] [TypeRep]
+     -- NB: For now I've made this lazy so that it's easy to
+     -- optimise code that constructs and deconstructs TypeReps
+     -- perf/should_run/T9203 is a good example
+     -- Also note that mkAppTy does discards the fingerprint,
+     -- so it's a waste to compute it
 
 type KindRep = TypeRep
 
@@ -81,56 +193,42 @@ instance Eq TypeRep where
 instance Ord TypeRep where
   TypeRep x _ _ _ <= TypeRep y _ _ _ = x <= y
 
+-- | Observe the 'Fingerprint' of a type representation
+--
+-- @since 4.8.0.0
+typeRepFingerprint :: TypeRep -> Fingerprint
+typeRepFingerprint (TypeRep fpr _ _ _) = fpr
 
--- | An abstract representation of a type constructor.  'TyCon' objects can
--- be built using 'mkTyCon'.
-data TyCon = TyCon {
-   tyConFingerprint :: {-# UNPACK #-} !Fingerprint, -- ^ @since 4.8.0.0
-   tyConPackage :: String, -- ^ @since 4.5.0.0
-   tyConModule  :: String, -- ^ @since 4.5.0.0
-   tyConName    :: String  -- ^ @since 4.5.0.0
- }
-
-instance Eq TyCon where
-  (TyCon t1 _ _ _) == (TyCon t2 _ _ _) = t1 == t2
-
-instance Ord TyCon where
-  (TyCon k1 _ _ _) <= (TyCon k2 _ _ _) = k1 <= k2
-
------------------ Construction --------------------
-
-#include "MachDeps.h"
-
--- mkTyCon is an internal function to make it easier for GHC to
--- generate derived instances.  GHC precomputes the MD5 hash for the
--- TyCon and passes it as two separate 64-bit values to mkTyCon.  The
--- TyCon for a derived Typeable instance will end up being statically
--- allocated.
-
-#if WORD_SIZE_IN_BITS < 64
-mkTyCon :: Word64# -> Word64# -> String -> String -> String -> TyCon
-#else
-mkTyCon :: Word#   -> Word#   -> String -> String -> String -> TyCon
-#endif
-mkTyCon high# low# pkg modl name
-  = TyCon (Fingerprint (W64# high#) (W64# low#)) pkg modl name
-
--- | Applies a polymorhic type constructor to a sequence of kinds and types
+-- | Applies a kind-polymorphic type constructor to a sequence of kinds and
+-- types
 mkPolyTyConApp :: TyCon -> [KindRep] -> [TypeRep] -> TypeRep
-mkPolyTyConApp tc@(TyCon tc_k _ _ _) [] [] = TypeRep tc_k tc [] []
-mkPolyTyConApp tc@(TyCon tc_k _ _ _) kinds types =
-  TypeRep (fingerprintFingerprints (tc_k : arg_ks)) tc kinds types
+{-# INLINE mkPolyTyConApp #-}
+mkPolyTyConApp tc kinds types
+  = TypeRep (fingerprintFingerprints sub_fps) tc kinds types
   where
-  arg_ks = [ k | TypeRep k _ _ _ <- kinds ++ types ]
+    !kt_fps = typeRepFingerprints kinds types
+    sub_fps = tyConFingerprint tc : kt_fps
 
--- | Applies a monomorphic type constructor to a sequence of types
+typeRepFingerprints :: [KindRep] -> [TypeRep] -> [Fingerprint]
+-- Builds no thunks
+typeRepFingerprints kinds types
+  = go1 [] kinds
+  where
+    go1 acc []     = go2 acc types
+    go1 acc (k:ks) = let !fp = typeRepFingerprint k
+                     in go1 (fp:acc) ks
+    go2 acc []     = acc
+    go2 acc (t:ts) = let !fp = typeRepFingerprint t
+                     in go2 (fp:acc) ts
+
+-- | Applies a kind-monomorphic type constructor to a sequence of types
 mkTyConApp  :: TyCon -> [TypeRep] -> TypeRep
 mkTyConApp tc = mkPolyTyConApp tc []
 
 -- | A special case of 'mkTyConApp', which applies the function
 -- type constructor to a pair of types.
 mkFunTy  :: TypeRep -> TypeRep -> TypeRep
-mkFunTy f a = mkTyConApp funTc [f,a]
+mkFunTy f a = mkTyConApp tcFun [f,a]
 
 -- | Splits a type constructor application.
 -- Note that if the type construcotr is polymorphic, this will
@@ -150,11 +248,12 @@ splitPolyTyConApp (TypeRep _ tc ks trs) = (tc,ks,trs)
 funResultTy :: TypeRep -> TypeRep -> Maybe TypeRep
 funResultTy trFun trArg
   = case splitTyConApp trFun of
-      (tc, [t1,t2]) | tc == funTc && t1 == trArg -> Just t2
+      (tc, [t1,t2]) | tc == tcFun && t1 == trArg -> Just t2
       _ -> Nothing
 
 -- | Adds a TypeRep argument to a TypeRep.
 mkAppTy :: TypeRep -> TypeRep -> TypeRep
+{-# INLINE mkAppTy #-}
 mkAppTy (TypeRep _ tc ks trs) arg_tr = mkPolyTyConApp tc ks (trs ++ [arg_tr])
    -- Notice that we call mkTyConApp to construct the fingerprint from tc and
    -- the arg fingerprints.  Simply combining the current fingerprint with
@@ -162,20 +261,6 @@ mkAppTy (TypeRep _ tc ks trs) arg_tr = mkPolyTyConApp tc ks (trs ++ [arg_tr])
    -- ensure that a TypeRep of the same shape has the same fingerprint!
    -- See Trac #5962
 
--- | Builds a 'TyCon' object representing a type constructor.  An
--- implementation of "Data.Typeable" should ensure that the following holds:
---
--- >  A==A' ^ B==B' ^ C==C' ==> mkTyCon A B C == mkTyCon A' B' C'
---
-
---
-mkTyCon3 :: String       -- ^ package name
-         -> String       -- ^ module name
-         -> String       -- ^ the name of the type constructor
-         -> TyCon        -- ^ A unique 'TyCon' object
-mkTyCon3 pkg modl name =
-  TyCon (fingerprintString (pkg ++ (' ':modl) ++ (' ':name))) pkg modl name
-
 ----------------- Observation ---------------------
 
 -- | Observe the type constructor of a type representation
@@ -190,16 +275,12 @@ typeRepArgs (TypeRep _ _ _ tys) = tys
 typeRepKinds :: TypeRep -> [KindRep]
 typeRepKinds (TypeRep _ _ ks _) = ks
 
--- | Observe string encoding of a type representation
-{-# DEPRECATED tyConString "renamed to 'tyConName'; 'tyConModule' and 'tyConPackage' are also available." #-} -- deprecated in 7.4
-tyConString :: TyCon   -> String
-tyConString = tyConName
 
--- | Observe the 'Fingerprint' of a type representation
---
--- @since 4.8.0.0
-typeRepFingerprint :: TypeRep -> Fingerprint
-typeRepFingerprint (TypeRep fpr _ _ _) = fpr
+{- *********************************************************************
+*                                                                      *
+                The Typeable class
+*                                                                      *
+********************************************************************* -}
 
 -------------------------------------------------------------
 --
@@ -273,8 +354,8 @@ instance Show TypeRep where
   showsPrec p (TypeRep _ tycon kinds tys) =
     case tys of
       [] -> showsPrec p tycon
-      [x]   | tycon == listTc -> showChar '[' . shows x . showChar ']'
-      [a,r] | tycon == funTc  -> showParen (p > 8) $
+      [x]   | tycon == tcList -> showChar '[' . shows x . showChar ']'
+      [a,r] | tycon == tcFun  -> showParen (p > 8) $
                                  showsPrec 9 a .
                                  showString " -> " .
                                  showsPrec 8 r
@@ -288,13 +369,6 @@ instance Show TypeRep where
 showsTypeRep :: TypeRep -> ShowS
 showsTypeRep = shows
 
-instance Show TyCon where
-  showsPrec _ t = showString (tyConName t)
-
-isTupleTyCon :: TyCon -> Bool
-isTupleTyCon (TyCon _ _ _ ('(':',':_)) = True
-isTupleTyCon _                         = False
-
 -- | Helper to fully evaluate 'TypeRep' for use as @NFData(rnf)@ implementation
 --
 -- @since 4.8.0.0
@@ -304,15 +378,6 @@ rnfTypeRep (TypeRep _ tyc krs tyrs) = rnfTyCon tyc `seq` go krs `seq` go tyrs
     go [] = ()
     go (x:xs) = rnfTypeRep x `seq` go xs
 
--- | Helper to fully evaluate 'TyCon' for use as @NFData(rnf)@ implementation
---
--- @since 4.8.0.0
-rnfTyCon :: TyCon -> ()
-rnfTyCon (TyCon _ tcp tcm tcn) = go tcp `seq` go tcm `seq` go tcn
-  where
-    go [] = ()
-    go (x:xs) = x `seq` go xs
-
 -- Some (Show.TypeRep) helpers:
 
 showArgs :: Show a => ShowS -> [a] -> ShowS
@@ -325,13 +390,68 @@ showTuple args = showChar '('
                . showArgs (showChar ',') args
                . showChar ')'
 
-listTc :: TyCon
-listTc = typeRepTyCon (typeOf [()])
+{- *********************************************************
+*                                                          *
+*            TyCon definitions for GHC.Types               *
+*                                                          *
+********************************************************* -}
+
+mkGhcTypesTyCon :: Addr# -> TyCon
+{-# INLINE mkGhcTypesTyCon #-}
+mkGhcTypesTyCon name = mkTyCon3# "ghc-prim"# "GHC.Types"# name
+
+tcBool, tc'True, tc'False,
+  tcOrdering, tc'GT, tc'EQ, tc'LT,
+  tcChar, tcInt, tcWord, tcFloat, tcDouble, tcFun,
+  tcIO, tcSPEC, tcTyCon, tcModule,
+  tcCoercible, tcEq, tcList :: TyCon
+
+tcBool      = mkGhcTypesTyCon "Bool"#      -- Bool is promotable
+tc'True     = mkGhcTypesTyCon "'True"#
+tc'False    = mkGhcTypesTyCon "'False"#
+tcOrdering  = mkGhcTypesTyCon "Ordering"#  -- Ordering is promotable
+tc'GT       = mkGhcTypesTyCon "'GT"#
+tc'EQ       = mkGhcTypesTyCon "'EQ"#
+tc'LT       = mkGhcTypesTyCon "'LT"#
+
+-- None of the rest are promotable (see TysWiredIn)
+tcChar      = mkGhcTypesTyCon "Char"#
+tcInt       = mkGhcTypesTyCon "Int"#
+tcWord      = mkGhcTypesTyCon "Word"#
+tcFloat     = mkGhcTypesTyCon "Float"#
+tcDouble    = mkGhcTypesTyCon "Double"#
+tcSPEC      = mkGhcTypesTyCon "SPEC"#
+tcIO        = mkGhcTypesTyCon "IO"#
+tcTyCon     = mkGhcTypesTyCon "TyCon"#
+tcModule    = mkGhcTypesTyCon "Module"#
+tcCoercible = mkGhcTypesTyCon "Coercible"#
+
+tcFun       = mkGhcTypesTyCon "->"#
+tcList      = mkGhcTypesTyCon "[]"#   -- Type rep for the list type constructor
+tcEq        = mkGhcTypesTyCon "~"#    -- Type rep for the (~) type constructor
+
+tcLiftedKind, tcUnliftedKind, tcOpenKind, tcBOX, tcConstraint, tcAnyK :: TyCon
+tcLiftedKind   = mkGhcTypesTyCon "*"#
+tcUnliftedKind = mkGhcTypesTyCon "#"#
+tcOpenKind     = mkGhcTypesTyCon "#"#
+tcBOX          = mkGhcTypesTyCon "BOX"#
+tcAnyK         = mkGhcTypesTyCon "AnyK"#
+tcConstraint   = mkGhcTypesTyCon "Constraint"#
 
 funTc :: TyCon
-funTc = typeRepTyCon (typeRep (Proxy :: Proxy (->)))
+funTc = tcFun   -- Legacy
+
+{- *********************************************************
+*                                                          *
+*       TyCon/TypeRep definitions for type literals        *
+*              (Symbol and Nat)                            *
+*                                                          *
+********************************************************* -}
 
 
+mkTypeLitTyCon :: String -> TyCon
+mkTypeLitTyCon name = mkTyCon3 "base" "GHC.TypeLits" name
+
 -- | Used to make `'Typeable' instance for things of kind Nat
 typeNatTypeRep :: KnownNat a => Proxy# a -> TypeRep
 typeNatTypeRep p = typeLitTypeRep (show (natVal' p))
@@ -342,17 +462,5 @@ typeSymbolTypeRep p = typeLitTypeRep (show (symbolVal' p))
 
 -- | An internal function, to make representations for type literals.
 typeLitTypeRep :: String -> TypeRep
-typeLitTypeRep nm = rep
-    where
-    rep = mkTyConApp tc []
-    tc = TyCon
-           { tyConFingerprint = fingerprintString (mk pack modu nm)
-           , tyConPackage  = pack
-           , tyConModule   = modu
-           , tyConName     = nm
-           }
-    pack = "base"
-    modu = "GHC.TypeLits"
-    mk a b c = a ++ " " ++ b ++ " " ++ c
-
+typeLitTypeRep nm = mkTyConApp (mkTypeLitTyCon nm) []
 
diff --git a/libraries/base/GHC/Show.hs b/libraries/base/GHC/Show.hs
index 4aeecb15f3..879d666bb0 100644
--- a/libraries/base/GHC/Show.hs
+++ b/libraries/base/GHC/Show.hs
@@ -194,6 +194,16 @@ showWord w# cs
 
 deriving instance Show a => Show (Maybe a)
 
+instance Show TyCon where
+  showsPrec p (TyCon _ _ _ tc_name) = showsPrec p tc_name
+
+instance Show TrName where
+  showsPrec _ (TrNameS s) = showString (unpackCString# s)
+  showsPrec _ (TrNameD s) = showString s
+
+instance Show Module where
+  showsPrec _ (Module p m) = shows p . (':' :) . shows m
+
 --------------------------------------------------------------
 -- Show instances for the first few tuple
 --------------------------------------------------------------
diff --git a/libraries/base/GHC/Stack/Types.hs b/libraries/base/GHC/Stack/Types.hs
index 5c37f64713..d3ea1d2147 100644
--- a/libraries/base/GHC/Stack/Types.hs
+++ b/libraries/base/GHC/Stack/Types.hs
@@ -21,6 +21,19 @@ module GHC.Stack.Types (
     SrcLoc(..), CallStack(..),
   ) where
 
+{-
+Ideally these would live in GHC.Stack but sadly they can't due to this
+import cycle,
+
+    Module imports form a cycle:
+           module ‘Data.Maybe’ (libraries/base/Data/Maybe.hs)
+          imports ‘GHC.Base’ (libraries/base/GHC/Base.hs)
+    which imports ‘GHC.Err’ (libraries/base/GHC/Err.hs)
+    which imports ‘GHC.Stack’ (libraries/base/dist-install/build/GHC/Stack.hs)
+    which imports ‘GHC.Foreign’ (libraries/base/GHC/Foreign.hs)
+    which imports ‘Data.Maybe’ (libraries/base/Data/Maybe.hs)
+-}
+
 import GHC.Types
 
 -- Make implicit dependency known to build system
diff --git a/libraries/ghc-prim/GHC/Classes.hs b/libraries/ghc-prim/GHC/Classes.hs
index 18662ad539..12fe65f322 100644
--- a/libraries/ghc-prim/GHC/Classes.hs
+++ b/libraries/ghc-prim/GHC/Classes.hs
@@ -1,4 +1,4 @@
-{-# LANGUAGE Trustworthy #-}
+{-# LANGUAGE CPP, Trustworthy #-}
 {-# LANGUAGE NoImplicitPrelude, MagicHash, StandaloneDeriving, BangPatterns,
              KindSignatures, DataKinds, ConstraintKinds,
               MultiParamTypeClasses, FunctionalDependencies #-}
@@ -28,19 +28,28 @@
 -----------------------------------------------------------------------------
 
 module GHC.Classes(
+    -- * Implicit paramaters
     IP(..),
+
+    -- * Equality and ordering
     Eq(..), eqInt, neInt,
     Ord(..), gtInt, geInt, leInt, ltInt, compareInt, compareInt#,
+
+    -- * Functions over Bool
     (&&), (||), not,
+
+    -- * Integer arithmetic
     divInt#, modInt#
  ) where
 
 -- GHC.Magic is used in some derived instances
 import GHC.Magic ()
+import GHC.IntWord64
 import GHC.Prim
 import GHC.Tuple
 import GHC.Types
 
+#include "MachDeps.h"
 
 infix  4  ==, /=, <, <=, >=, >
 infixr 3  &&
@@ -137,6 +146,31 @@ eqInt, neInt :: Int -> Int -> Bool
 (I# x) `eqInt` (I# y) = isTrue# (x ==# y)
 (I# x) `neInt` (I# y) = isTrue# (x /=# y)
 
+#if WORD_SIZE_IN_BITS < 64
+instance Eq TyCon where
+  (==) (TyCon hi1 lo1 _ _) (TyCon hi2 lo2 _ _)
+       = isTrue# (hi1 `eqWord64#` hi2) && isTrue# (lo1 `eqWord64#` lo2)
+instance Ord TyCon where
+  compare (TyCon hi1 lo1 _ _) (TyCon hi2 lo2 _ _)
+    | isTrue# (hi1 `gtWord64#` hi2) = GT
+    | isTrue# (hi1 `ltWord64#` hi2) = LT
+    | isTrue# (lo1 `gtWord64#` lo2) = GT
+    | isTrue# (lo1 `ltWord64#` lo2) = LT
+    | True                = EQ
+#else
+instance Eq TyCon where
+  (==) (TyCon hi1 lo1 _ _) (TyCon hi2 lo2 _ _)
+       = isTrue# (hi1 `eqWord#` hi2) && isTrue# (lo1 `eqWord#` lo2)
+instance Ord TyCon where
+  compare (TyCon hi1 lo1 _ _) (TyCon hi2 lo2 _ _)
+    | isTrue# (hi1 `gtWord#` hi2) = GT
+    | isTrue# (hi1 `ltWord#` hi2) = LT
+    | isTrue# (lo1 `gtWord#` lo2) = GT
+    | isTrue# (lo1 `ltWord#` lo2) = LT
+    | True              = EQ
+#endif
+
+
 -- | The 'Ord' class is used for totally ordered datatypes.
 --
 -- Instances of 'Ord' can be derived for any user-defined
diff --git a/libraries/ghc-prim/GHC/IntWord64.hs b/libraries/ghc-prim/GHC/IntWord64.hs
index 52dc08efc5..35bbfd886f 100644
--- a/libraries/ghc-prim/GHC/IntWord64.hs
+++ b/libraries/ghc-prim/GHC/IntWord64.hs
@@ -23,7 +23,10 @@ module GHC.IntWord64 (
 #endif
     ) where
 
+import GHC.Types () -- Make implicit dependency known to build system
+
 #if WORD_SIZE_IN_BITS < 64
+
 import GHC.Prim
 
 foreign import ccall unsafe "hs_eqWord64"    eqWord64#     :: Word64# -> Word64# -> Int#
diff --git a/libraries/ghc-prim/GHC/Magic.hs b/libraries/ghc-prim/GHC/Magic.hs
index 22db69f2ae..740abb729e 100644
--- a/libraries/ghc-prim/GHC/Magic.hs
+++ b/libraries/ghc-prim/GHC/Magic.hs
@@ -19,6 +19,8 @@
 
 module GHC.Magic ( inline, lazy, oneShot ) where
 
+import GHC.CString ()
+
 -- | The call @inline f@ arranges that 'f' is inlined, regardless of
 -- its size. More precisely, the call @inline f@ rewrites to the
 -- right-hand side of @f@'s definition. This allows the programmer to
diff --git a/libraries/ghc-prim/GHC/Tuple.hs b/libraries/ghc-prim/GHC/Tuple.hs
index 4ebda15d84..b08d0b4fee 100644
--- a/libraries/ghc-prim/GHC/Tuple.hs
+++ b/libraries/ghc-prim/GHC/Tuple.hs
@@ -16,6 +16,9 @@
 
 module GHC.Tuple where
 
+import GHC.CString ()  -- Make sure we do it first, so that the
+                       -- implicit Typeable stuff can see GHC.Types.TyCon
+                       -- and unpackCString# etc
 
 default () -- Double and Integer aren't available yet
 
diff --git a/libraries/ghc-prim/GHC/Types.hs b/libraries/ghc-prim/GHC/Types.hs
index 294f15e6e4..63b4f0508f 100644
--- a/libraries/ghc-prim/GHC/Types.hs
+++ b/libraries/ghc-prim/GHC/Types.hs
@@ -1,5 +1,5 @@
 {-# LANGUAGE MagicHash, NoImplicitPrelude, TypeFamilies, UnboxedTuples,
-             MultiParamTypeClasses, RoleAnnotations #-}
+             MultiParamTypeClasses, RoleAnnotations, CPP #-}
 -----------------------------------------------------------------------------
 -- |
 -- Module      :  GHC.Types
@@ -29,11 +29,12 @@ module GHC.Types (
         isTrue#,
         SPEC(..),
         Nat, Symbol,
-        Coercible
+        Coercible,
+        -- * Runtime type representation
+        Module(..), TrName(..), TyCon(..)
     ) where
 
 import GHC.Prim
-import GHC.Tuple ()
 
 infixr 5 :
 
@@ -308,3 +309,56 @@ you're reading this in 2023 then things went wrong). See #8326.
 -- Libraries can specify this by using 'SPEC' data type to inform which
 -- loops should be aggressively specialized.
 data SPEC = SPEC | SPEC2
+
+{- *********************************************************************
+*                                                                      *
+             Runtime represntation of TyCon
+*                                                                      *
+********************************************************************* -}
+
+{- Note [Runtime representation of modules and tycons]
+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+We generate a binding for M.$modName and M.$tcT for every module M and
+data type T.  Things to think about
+
+  - We want them to be economical on space; ideally pure data with no thunks.
+
+  - We do this for every module (except this module GHC.Types), so we can't
+    depend on anything else (eg string unpacking code)
+
+That's why we have these terribly low-level repesentations.  The TrName
+type lets us use the TrNameS constructor when allocating static data;
+but we also need TrNameD for the case where we are deserialising a TyCon
+or Module (for example when deserialising a TypeRep), in which case we
+can't conveniently come up with an Addr#.
+
+
+Note [Representations of types defined in GHC.Types]
+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+
+The representations for the types defined in GHC.Types are
+defined in GHC.Typeable.Internal.
+
+-}
+
+#include "MachDeps.h"
+
+data Module = Module
+                TrName   -- Package name
+                TrName   -- Module name
+
+data TrName
+  = TrNameS Addr#  -- Static
+  | TrNameD [Char] -- Dynamic
+
+#if WORD_SIZE_IN_BITS < 64
+data TyCon = TyCon
+                Word64#  Word64#   -- Fingerprint
+                Module             -- Module in which this is defined
+                TrName              -- Type constructor name
+#else
+data TyCon = TyCon
+                Word#    Word#
+                Module
+                TrName
+#endif