Generate Typeable info at definition sites

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

 * T3294:   GHC allocates 110% more (filed #11030 to track this)
 * T1969:   GHC allocates 30% more
 * T4801:   GHC allocates 14% more
 * T5321FD: GHC allocates 13% more
 * T783:    GHC allocates 12% more
 * T9675:   GHC allocates 12% more
 * T5642:   GHC allocates 10% more
 * T9961:   GHC allocates 6% more

 * T9203:   Program allocates 54% less

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.

Requires update of the haddock submodule.

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

5 files changed, 251 insertions, 146 deletions

diff --git a/compiler/prelude/PrelInfo.hs b/compiler/prelude/PrelInfo.hs
index f79b6b1e7f..f76b62ee00 100644
--- a/compiler/prelude/PrelInfo.hs
+++ b/compiler/prelude/PrelInfo.hs
@@ -10,7 +10,7 @@ module PrelInfo (
         primOpRules, builtinRules,
 
         ghcPrimExports,
-        wiredInThings, knownKeyNames,
+        knownKeyNames,
         primOpId,
 
         -- Random other things
@@ -23,56 +23,31 @@ module PrelInfo (
 
 #include "HsVersions.h"
 
+import Constants        ( mAX_TUPLE_SIZE )
+import BasicTypes       ( Boxity(..) )
+import ConLike          ( ConLike(..) )
 import PrelNames
 import PrelRules
 import Avail
 import PrimOp
 import DataCon
 import Id
+import Name
 import MkId
-import Name( Name, getName )
 import TysPrim
 import TysWiredIn
 import HscTypes
 import Class
 import TyCon
-import Outputable
-import UniqFM
 import Util
 import {-# SOURCE #-} TcTypeNats ( typeNatTyCons )
 
-#ifdef GHCI
-import THNames
-#endif
-
 import Data.Array
 
-
-{- *********************************************************************
-*                                                                      *
-                Known key things
-*                                                                      *
-********************************************************************* -}
-
-knownKeyNames :: [Name]
-knownKeyNames =
-  ASSERT2( isNullUFM badNamesUFM, text "badknownKeyNames" <+> ppr badNamesUFM )
-  names
-  where
-  badNamesUFM = filterUFM (\ns -> length ns > 1) namesUFM
-  namesUFM = foldl (\m n -> addToUFM_Acc (:) singleton m n n) emptyUFM names
-  names = concat
-    [ map getName wiredInThings
-    , cTupleTyConNames
-    , basicKnownKeyNames
-#ifdef GHCI
-    , templateHaskellNames
-#endif
-    ]
-
-{- *********************************************************************
+{-
+************************************************************************
 *                                                                      *
-                Wired in things
+\subsection[builtinNameInfo]{Lookup built-in names}
 *                                                                      *
 ************************************************************************
 
@@ -87,33 +62,61 @@ Notes about wired in things
 
 * The name cache is initialised with (the names of) all wired-in things
 
-* The type checker sees if the Name is wired in before looking up
-  the name in the type environment.  So the type envt itself contains
-  no wired in things.
+* The type environment itself contains no wired in things. The type
+  checker sees if the Name is wired in before looking up the name in
+  the type environment.
 
 * MkIface prunes out wired-in things before putting them in an interface file.
   So interface files never contain wired-in things.
 -}
 
-wiredInThings :: [TyThing]
--- This list is used only to initialise HscMain.knownKeyNames
--- to ensure that when you say "Prelude.map" in your source code, you
--- get a Name with the correct known key (See Note [Known-key names])
-wiredInThings
-  = concat
-    [           -- Wired in TyCons and their implicit Ids
-          tycon_things
-        , concatMap implicitTyThings tycon_things
-
-                -- Wired in Ids
-        , map AnId wiredInIds
-
-                -- PrimOps
-        , map (AnId . primOpId) allThePrimOps
-    ]
+
+knownKeyNames :: [Name]
+-- This list is used to ensure that when you say "Prelude.map"
+--  in your source code, or in an interface file,
+-- you get a Name with the correct known key
+-- (See Note [Known-key names] in PrelNames)
+knownKeyNames
+  = concat [ tycon_kk_names funTyCon
+           , concatMap tycon_kk_names primTyCons
+
+           , concatMap tycon_kk_names wiredInTyCons
+             -- Does not include tuples
+
+           , concatMap tycon_kk_names typeNatTyCons
+
+           , concatMap (rep_names . tupleTyCon Boxed) [2..mAX_TUPLE_SIZE]  -- Yuk
+
+           , cTupleTyConNames
+             -- Constraint tuples are known-key but not wired-in
+             -- They can't show up in source code, but can appear
+             -- in intreface files
+
+           , map idName wiredInIds
+           , map (idName . primOpId) allThePrimOps
+           , basicKnownKeyNames ]
   where
-    tycon_things = map ATyCon ([funTyCon] ++ primTyCons ++ wiredInTyCons
-                                    ++ typeNatTyCons)
+    -- "kk" short for "known-key"
+    tycon_kk_names :: TyCon -> [Name]
+    tycon_kk_names tc = tyConName tc : (rep_names tc ++ concatMap thing_kk_names (implicitTyConThings tc))
+
+    datacon_kk_names dc
+      | Promoted tc <- promoteDataCon_maybe dc = dataConName dc : rep_names tc
+      | otherwise                              = [dataConName dc]
+
+    thing_kk_names :: TyThing -> [Name]
+    thing_kk_names (ATyCon tc)                 = tycon_kk_names tc
+    thing_kk_names (AConLike (RealDataCon dc)) = datacon_kk_names dc
+    thing_kk_names thing                       = [getName thing]
+
+    -- The TyConRepName for a known-key TyCon has a known key,
+    -- but isn't itself an implicit thing.  Yurgh.
+    -- NB: if any of the wired-in TyCons had record fields, the record
+    --     field names would be in a similar situation.  Ditto class ops.
+    --     But it happens that there aren't any
+    rep_names tc = case tyConRepName_maybe tc of
+                         Just n  -> [n]
+                         Nothing -> []
 
 {-
 We let a lot of "non-standard" values be visible, so that we can make
diff --git a/compiler/prelude/PrelNames.hs b/compiler/prelude/PrelNames.hs
index 30d11fef59..05a38ffec9 100644
--- a/compiler/prelude/PrelNames.hs
+++ b/compiler/prelude/PrelNames.hs
@@ -206,11 +206,13 @@ basicKnownKeyNames
         -- Typeable
         typeableClassName,
         typeRepTyConName,
-        mkTyConName,
+        trTyConDataConName,
+        trModuleDataConName,
+        trNameSDataConName,
+        typeRepIdName,
         mkPolyTyConAppName,
         mkAppTyName,
-        typeNatTypeRepName,
-        typeSymbolTypeRepName,
+        typeSymbolTypeRepName, typeNatTypeRepName,
 
         -- Dynamic
         toDynName,
@@ -226,7 +228,6 @@ basicKnownKeyNames
         fromIntegralName, realToFracName,
 
         -- String stuff
-        stringTyConName,
         fromStringName,
 
         -- Enum stuff
@@ -607,7 +608,8 @@ toInteger_RDR           = nameRdrName toIntegerName
 toRational_RDR          = nameRdrName toRationalName
 fromIntegral_RDR        = nameRdrName fromIntegralName
 
-fromString_RDR :: RdrName
+stringTy_RDR, fromString_RDR :: RdrName
+stringTy_RDR            = tcQual_RDR gHC_BASE (fsLit "String")
 fromString_RDR          = nameRdrName fromStringName
 
 fromList_RDR, fromListN_RDR, toList_RDR :: RdrName
@@ -668,11 +670,6 @@ showString_RDR          = varQual_RDR gHC_SHOW (fsLit "showString")
 showSpace_RDR           = varQual_RDR gHC_SHOW (fsLit "showSpace")
 showParen_RDR           = varQual_RDR gHC_SHOW (fsLit "showParen")
 
-typeRep_RDR, mkTyCon_RDR, mkTyConApp_RDR :: RdrName
-typeRep_RDR       = varQual_RDR tYPEABLE_INTERNAL    (fsLit "typeRep#")
-mkTyCon_RDR       = varQual_RDR tYPEABLE_INTERNAL    (fsLit "mkTyCon")
-mkTyConApp_RDR    = varQual_RDR tYPEABLE_INTERNAL    (fsLit "mkTyConApp")
-
 undefined_RDR :: RdrName
 undefined_RDR = varQual_RDR gHC_ERR (fsLit "undefined")
 
@@ -782,6 +779,39 @@ 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
+
+-- | 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.
+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
+
+-- | TODO
+-- See Note [Grand plan for Typeable] in 'TcTypeable' in TcTypeable.
+tyConRepModOcc :: Module -> OccName -> (Module, OccName)
+tyConRepModOcc tc_module tc_occ
+  | tc_module == gHC_TYPES
+  = (tYPEABLE_INTERNAL, mkTyConRepUserOcc tc_occ)
+  | otherwise
+  = (tc_module,         mkTyConRepSysOcc tc_occ)
+
 wildCardName :: Name
 wildCardName = mkSystemVarName wildCardKey (fsLit "wild")
 
@@ -849,12 +879,11 @@ uWordTyConName     = tcQual gHC_GENERICS (fsLit "UWord") uWordTyConKey
 
 -- Base strings Strings
 unpackCStringName, unpackCStringFoldrName,
-    unpackCStringUtf8Name, eqStringName, stringTyConName :: Name
+    unpackCStringUtf8Name, eqStringName :: Name
 unpackCStringName       = varQual gHC_CSTRING (fsLit "unpackCString#") unpackCStringIdKey
 unpackCStringFoldrName  = varQual gHC_CSTRING (fsLit "unpackFoldrCString#") unpackCStringFoldrIdKey
 unpackCStringUtf8Name   = varQual gHC_CSTRING (fsLit "unpackCStringUtf8#") unpackCStringUtf8IdKey
 eqStringName            = varQual gHC_BASE (fsLit "eqString")  eqStringIdKey
-stringTyConName         = tcQual  gHC_BASE (fsLit "String") stringTyConKey
 
 -- The 'inline' function
 inlineIdName :: Name
@@ -1053,15 +1082,21 @@ ixClassName = clsQual gHC_ARR (fsLit "Ix") ixClassKey
 -- Class Typeable, and functions for constructing `Typeable` dictionaries
 typeableClassName
   , typeRepTyConName
-  , mkTyConName
+  , trTyConDataConName
+  , trModuleDataConName
+  , trNameSDataConName
   , mkPolyTyConAppName
   , mkAppTyName
+  , typeRepIdName
   , typeNatTypeRepName
   , typeSymbolTypeRepName
   :: Name
 typeableClassName     = clsQual tYPEABLE_INTERNAL (fsLit "Typeable")       typeableClassKey
 typeRepTyConName      = tcQual  tYPEABLE_INTERNAL (fsLit "TypeRep")        typeRepTyConKey
-mkTyConName           = varQual tYPEABLE_INTERNAL (fsLit "mkTyCon")        mkTyConKey
+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
@@ -1342,7 +1377,7 @@ ghciIoClassKey :: Unique
 ghciIoClassKey = mkPreludeClassUnique 44
 
 ---------------- Template Haskell -------------------
---      USES ClassUniques 200-299
+--      THNames.hs: USES ClassUniques 200-299
 -----------------------------------------------------
 
 {-
@@ -1489,9 +1524,6 @@ unknown2TyConKey                        = mkPreludeTyConUnique 131
 unknown3TyConKey                        = mkPreludeTyConUnique 132
 opaqueTyConKey                          = mkPreludeTyConUnique 133
 
-stringTyConKey :: Unique
-stringTyConKey                          = mkPreludeTyConUnique 134
-
 -- Generics (Unique keys)
 v1TyConKey, u1TyConKey, par1TyConKey, rec1TyConKey,
   k1TyConKey, m1TyConKey, sumTyConKey, prodTyConKey,
@@ -1589,7 +1621,7 @@ ipCoNameKey = mkPreludeTyConUnique 185
 
 
 ---------------- Template Haskell -------------------
---      USES TyConUniques 200-299
+--      THNames.hs: USES TyConUniques 200-299
 -----------------------------------------------------
 
 ----------------------- SIMD ------------------------
@@ -1668,6 +1700,16 @@ srcLocDataConKey                        = mkPreludeDataConUnique 37
 ipDataConKey :: Unique
 ipDataConKey                            = mkPreludeDataConUnique 38
 
+trTyConDataConKey, trModuleDataConKey, trNameSDataConKey :: Unique
+trTyConDataConKey                       = mkPreludeDataConUnique 40
+trModuleDataConKey                      = mkPreludeDataConUnique 41
+trNameSDataConKey                       = mkPreludeDataConUnique 42
+
+---------------- Template Haskell -------------------
+--      THNames.hs: USES DataUniques 100-150
+-----------------------------------------------------
+
+
 {-
 ************************************************************************
 *                                                                      *
@@ -1922,7 +1964,7 @@ proxyHashKey :: Unique
 proxyHashKey = mkPreludeMiscIdUnique 502
 
 ---------------- Template Haskell -------------------
---      USES IdUniques 200-499
+--      THNames.hs: USES IdUniques 200-499
 -----------------------------------------------------
 
 -- Used to make `Typeable` dictionaries
@@ -1931,19 +1973,21 @@ mkTyConKey
   , mkAppTyKey
   , typeNatTypeRepKey
   , typeSymbolTypeRepKey
+  , typeRepIdKey
   :: Unique
 mkTyConKey            = mkPreludeMiscIdUnique 503
 mkPolyTyConAppKey     = mkPreludeMiscIdUnique 504
 mkAppTyKey            = mkPreludeMiscIdUnique 505
 typeNatTypeRepKey     = mkPreludeMiscIdUnique 506
 typeSymbolTypeRepKey  = mkPreludeMiscIdUnique 507
+typeRepIdKey          = mkPreludeMiscIdUnique 508
 
 -- Dynamic
 toDynIdKey :: Unique
-toDynIdKey = mkPreludeMiscIdUnique 508
+toDynIdKey            = mkPreludeMiscIdUnique 509
 
 bitIntegerIdKey :: Unique
-bitIntegerIdKey       = mkPreludeMiscIdUnique 509
+bitIntegerIdKey       = mkPreludeMiscIdUnique 510
 
 {-
 ************************************************************************
diff --git a/compiler/prelude/THNames.hs b/compiler/prelude/THNames.hs
index 062f9577e7..571487a274 100644
--- a/compiler/prelude/THNames.hs
+++ b/compiler/prelude/THNames.hs
@@ -448,23 +448,6 @@ unsafeName     = libFun (fsLit "unsafe") unsafeIdKey
 safeName       = libFun (fsLit "safe") safeIdKey
 interruptibleName = libFun (fsLit "interruptible") interruptibleIdKey
 
--- data Inline = ...
-noInlineDataConName, inlineDataConName, inlinableDataConName :: Name
-noInlineDataConName  = thCon (fsLit "NoInline")  noInlineDataConKey
-inlineDataConName    = thCon (fsLit "Inline")    inlineDataConKey
-inlinableDataConName = thCon (fsLit "Inlinable") inlinableDataConKey
-
--- data RuleMatch = ...
-conLikeDataConName, funLikeDataConName :: Name
-conLikeDataConName = thCon (fsLit "ConLike") conLikeDataConKey
-funLikeDataConName = thCon (fsLit "FunLike") funLikeDataConKey
-
--- data Phases = ...
-allPhasesDataConName, fromPhaseDataConName, beforePhaseDataConName :: Name
-allPhasesDataConName   = thCon (fsLit "AllPhases")   allPhasesDataConKey
-fromPhaseDataConName   = thCon (fsLit "FromPhase")   fromPhaseDataConKey
-beforePhaseDataConName = thCon (fsLit "BeforePhase") beforePhaseDataConKey
-
 -- newtype TExp a = ...
 tExpDataConName :: Name
 tExpDataConName = thCon (fsLit "TExp") tExpDataConKey
@@ -523,12 +506,42 @@ quotePatName        = qqFun (fsLit "quotePat")  quotePatKey
 quoteDecName        = qqFun (fsLit "quoteDec")  quoteDecKey
 quoteTypeName       = qqFun (fsLit "quoteType") quoteTypeKey
 
+-- data Inline = ...
+noInlineDataConName, inlineDataConName, inlinableDataConName :: Name
+noInlineDataConName  = thCon (fsLit "NoInline")  noInlineDataConKey
+inlineDataConName    = thCon (fsLit "Inline")    inlineDataConKey
+inlinableDataConName = thCon (fsLit "Inlinable") inlinableDataConKey
+
+-- data RuleMatch = ...
+conLikeDataConName, funLikeDataConName :: Name
+conLikeDataConName = thCon (fsLit "ConLike") conLikeDataConKey
+funLikeDataConName = thCon (fsLit "FunLike") funLikeDataConKey
+
+-- data Phases = ...
+allPhasesDataConName, fromPhaseDataConName, beforePhaseDataConName :: Name
+allPhasesDataConName   = thCon (fsLit "AllPhases")   allPhasesDataConKey
+fromPhaseDataConName   = thCon (fsLit "FromPhase")   fromPhaseDataConKey
+beforePhaseDataConName = thCon (fsLit "BeforePhase") beforePhaseDataConKey
+
+
+{- *********************************************************************
+*                                                                      *
+                     Class keys
+*                                                                      *
+********************************************************************* -}
+
 -- ClassUniques available: 200-299
 -- Check in PrelNames if you want to change this
 
 liftClassKey :: Unique
 liftClassKey = mkPreludeClassUnique 200
 
+{- *********************************************************************
+*                                                                      *
+                     TyCon keys
+*                                                                      *
+********************************************************************* -}
+
 -- TyConUniques available: 200-299
 -- Check in PrelNames if you want to change this
 
@@ -574,6 +587,43 @@ tExpTyConKey            = mkPreludeTyConUnique 230
 injAnnTyConKey          = mkPreludeTyConUnique 231
 kindTyConKey            = mkPreludeTyConUnique 232
 
+{- *********************************************************************
+*                                                                      *
+                     DataCon keys
+*                                                                      *
+********************************************************************* -}
+
+-- DataConUniques available: 100-150
+-- If you want to change this, make sure you check in PrelNames
+
+-- data Inline = ...
+noInlineDataConKey, inlineDataConKey, inlinableDataConKey :: Unique
+noInlineDataConKey  = mkPreludeDataConUnique 100
+inlineDataConKey    = mkPreludeDataConUnique 101
+inlinableDataConKey = mkPreludeDataConUnique 102
+
+-- data RuleMatch = ...
+conLikeDataConKey, funLikeDataConKey :: Unique
+conLikeDataConKey = mkPreludeDataConUnique 103
+funLikeDataConKey = mkPreludeDataConUnique 104
+
+-- data Phases = ...
+allPhasesDataConKey, fromPhaseDataConKey, beforePhaseDataConKey :: Unique
+allPhasesDataConKey   = mkPreludeDataConUnique 105
+fromPhaseDataConKey   = mkPreludeDataConUnique 106
+beforePhaseDataConKey = mkPreludeDataConUnique 107
+
+-- newtype TExp a = ...
+tExpDataConKey :: Unique
+tExpDataConKey = mkPreludeDataConUnique 108
+
+
+{- *********************************************************************
+*                                                                      *
+                     Id keys
+*                                                                      *
+********************************************************************* -}
+
 -- IdUniques available: 200-499
 -- If you want to change this, make sure you check in PrelNames
 
@@ -843,27 +893,6 @@ unsafeIdKey        = mkPreludeMiscIdUnique 430
 safeIdKey          = mkPreludeMiscIdUnique 431
 interruptibleIdKey = mkPreludeMiscIdUnique 432
 
--- data Inline = ...
-noInlineDataConKey, inlineDataConKey, inlinableDataConKey :: Unique
-noInlineDataConKey  = mkPreludeDataConUnique 40
-inlineDataConKey    = mkPreludeDataConUnique 41
-inlinableDataConKey = mkPreludeDataConUnique 42
-
--- data RuleMatch = ...
-conLikeDataConKey, funLikeDataConKey :: Unique
-conLikeDataConKey = mkPreludeDataConUnique 43
-funLikeDataConKey = mkPreludeDataConUnique 44
-
--- data Phases = ...
-allPhasesDataConKey, fromPhaseDataConKey, beforePhaseDataConKey :: Unique
-allPhasesDataConKey   = mkPreludeDataConUnique 45
-fromPhaseDataConKey   = mkPreludeDataConUnique 46
-beforePhaseDataConKey = mkPreludeDataConUnique 47
-
--- newtype TExp a = ...
-tExpDataConKey :: Unique
-tExpDataConKey = mkPreludeDataConUnique 48
-
 -- data FunDep = ...
 funDepIdKey :: Unique
 funDepIdKey = mkPreludeMiscIdUnique 440
diff --git a/compiler/prelude/TysPrim.hs b/compiler/prelude/TysPrim.hs
index d66b48e3b7..3a6dd0341e 100644
--- a/compiler/prelude/TysPrim.hs
+++ b/compiler/prelude/TysPrim.hs
@@ -10,6 +10,8 @@
 -- | This module defines TyCons that can't be expressed in Haskell.
 --   They are all, therefore, wired-in TyCons.  C.f module TysWiredIn
 module TysPrim(
+        mkPrimTyConName, -- For implicit parameters in TysWiredIn only
+
         mkTemplateTyVars,
         alphaTyVars, betaTyVars, alphaTyVar, betaTyVar, gammaTyVar, deltaTyVar,
         alphaTy, betaTy, gammaTy, deltaTy,
@@ -81,12 +83,11 @@ module TysPrim(
 #include "HsVersions.h"
 
 import Var              ( TyVar, KindVar, mkTyVar )
-import Name             ( Name, BuiltInSyntax(..), mkInternalName, mkWiredInName )
-import OccName          ( mkTyVarOccFS, mkTcOccFS )
+import Name
 import TyCon
 import TypeRep
 import SrcLoc
-import Unique           ( mkAlphaTyVarUnique )
+import Unique
 import PrelNames
 import FastString
 
@@ -258,8 +259,9 @@ funTyConName :: Name
 funTyConName = mkPrimTyConName (fsLit "(->)") funTyConKey funTyCon
 
 funTyCon :: TyCon
-funTyCon = mkFunTyCon funTyConName $
-           mkArrowKinds [liftedTypeKind, liftedTypeKind] liftedTypeKind
+funTyCon = mkFunTyCon funTyConName kind tc_rep_nm
+  where
+    kind = mkArrowKinds [liftedTypeKind, liftedTypeKind] liftedTypeKind
         -- You might think that (->) should have type (?? -> ? -> *), and you'd be right
         -- But if we do that we get kind errors when saying
         --      instance Control.Arrow (->)
@@ -269,6 +271,8 @@ funTyCon = mkFunTyCon funTyConName $
         -- 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
+
 -- One step to remove subkinding.
 -- (->) :: * -> * -> *
 -- but we should have (and want) the following typing rule for fully applied arrows
@@ -318,14 +322,21 @@ superKindTyConName, anyKindTyConName, liftedTypeKindTyConName,
       constraintKindTyConName
    :: Name
 
-superKindTyCon        = mkKindTyCon superKindTyConName        superKind
-   -- See Note [SuperKind (BOX)]
+mk_kind_tycon :: Name        -- ^ Name of the kind constructor, e.g. @*@
+              -> FastString  -- ^ Name of the 'TyConRepName' function,
+                             -- e.g. @tcLiftedKind :: TyCon@
+              -> TyCon       -- ^ The kind constructor
+mk_kind_tycon tc_name rep_fs
+  = mkKindTyCon tc_name superKind (mkSpecialTyConRepName rep_fs tc_name)
+
+superKindTyCon = mk_kind_tycon superKindTyConName (fsLit "tcBOX")
+    -- See Note [SuperKind (BOX)]
 
-anyKindTyCon          = mkKindTyCon anyKindTyConName          superKind
-liftedTypeKindTyCon   = mkKindTyCon liftedTypeKindTyConName   superKind
-openTypeKindTyCon     = mkKindTyCon openTypeKindTyConName     superKind
-unliftedTypeKindTyCon = mkKindTyCon unliftedTypeKindTyConName superKind
-constraintKindTyCon   = mkKindTyCon constraintKindTyConName   superKind
+anyKindTyCon          = mk_kind_tycon anyKindTyConName          (fsLit "tcAnyK")
+constraintKindTyCon   = mk_kind_tycon constraintKindTyConName   (fsLit "tcConstraint")
+liftedTypeKindTyCon   = mk_kind_tycon liftedTypeKindTyConName   (fsLit "tcLiftedKind")
+openTypeKindTyCon     = mk_kind_tycon openTypeKindTyConName     (fsLit "tcOpenKind")
+unliftedTypeKindTyCon = mk_kind_tycon unliftedTypeKindTyConName (fsLit "tcUnliftedKind")
 
 --------------------------
 -- ... and now their names
@@ -736,6 +747,7 @@ variables with no constraints on them. It appears in similar circumstances to
 Any, but at the kind level. For example:
 
   type family Length (l :: [k]) :: Nat
+  type instance Length [] = Zero
 
   f :: Proxy (Length []) -> Int
   f = ....
@@ -776,7 +788,7 @@ anyTy = mkTyConTy anyTyCon
 anyTyCon :: TyCon
 anyTyCon = mkFamilyTyCon anyTyConName kind [kKiVar] Nothing
                          (ClosedSynFamilyTyCon Nothing)
-                         NoParentTyCon
+                         Nothing
                          NotInjective
   where
     kind = ForAllTy kKiVar (mkTyVarTy kKiVar)
diff --git a/compiler/prelude/TysWiredIn.hs b/compiler/prelude/TysWiredIn.hs
index e8a06e7ad4..067700f120 100644
--- a/compiler/prelude/TysWiredIn.hs
+++ b/compiler/prelude/TysWiredIn.hs
@@ -99,6 +99,7 @@ import TysPrim
 -- others:
 import CoAxiom
 import Coercion
+import Id
 import Constants        ( mAX_TUPLE_SIZE, mAX_CTUPLE_SIZE )
 import Module           ( Module )
 import Type             ( mkTyConApp )
@@ -289,7 +290,7 @@ pcTyCon is_enum is_rec is_prom name cType tyvars cons
         is_rec
         is_prom
         False           -- Not in GADT syntax
-        NoParentTyCon
+        (VanillaAlgTyCon (mkPrelTyConRepName name))
 
 pcDataCon :: Name -> [TyVar] -> [Type] -> TyCon -> DataCon
 pcDataCon = pcDataConWithFixity False
@@ -310,7 +311,7 @@ pcDataConWithFixity' :: Bool -> Name -> Unique -> [TyVar] -> [Type] -> TyCon ->
 pcDataConWithFixity' declared_infix dc_name wrk_key tyvars arg_tys tycon
   = data_con
   where
-    data_con = mkDataCon dc_name declared_infix
+    data_con = mkDataCon dc_name declared_infix prom_info
                 (map (const no_bang) arg_tys)
                 []      -- No labelled fields
                 tyvars
@@ -327,10 +328,16 @@ pcDataConWithFixity' declared_infix dc_name wrk_key tyvars arg_tys tycon
 
     modu     = ASSERT( isExternalName dc_name )
                nameModule dc_name
-    wrk_occ  = mkDataConWorkerOcc (nameOccName dc_name)
+    dc_occ   = nameOccName dc_name
+    wrk_occ  = mkDataConWorkerOcc dc_occ
     wrk_name = mkWiredInName modu wrk_occ wrk_key
                              (AnId (dataConWorkId data_con)) UserSyntax
 
+    prom_info | Promoted {} <- promotableTyCon_maybe tycon  -- Knot-tied
+              = Promoted (mkPrelTyConRepName dc_name)
+              | otherwise
+              = NotPromoted
+
 {-
 ************************************************************************
 *                                                                      *
@@ -498,15 +505,19 @@ mk_tuple boxity arity = (tycon, tuple_con)
   where
         tycon   = mkTupleTyCon tc_name tc_kind arity tyvars tuple_con
                                tup_sort
-                               prom_tc NoParentTyCon
+                               prom_tc flavour
+
+        flavour = case boxity of
+                    Boxed   -> VanillaAlgTyCon (mkPrelTyConRepName tc_name)
+                    Unboxed -> UnboxedAlgTyCon
 
         tup_sort = case boxity of
                       Boxed   -> BoxedTuple
                       Unboxed -> UnboxedTuple
 
         prom_tc = case boxity of
-                    Boxed   -> Just (mkPromotedTyCon tycon (promoteKind tc_kind))
-                    Unboxed -> Nothing
+                    Boxed   -> Promoted (mkPromotedTyCon tycon (promoteKind tc_kind))
+                    Unboxed -> NotPromoted
 
         modu = case boxity of
                     Boxed -> gHC_TUPLE
@@ -732,8 +743,11 @@ mkListTy :: Type -> Type
 mkListTy ty = mkTyConApp listTyCon [ty]
 
 listTyCon :: TyCon
-listTyCon = pcTyCon False Recursive True
-                    listTyConName Nothing alpha_tyvar [nilDataCon, consDataCon]
+listTyCon = buildAlgTyCon listTyConName alpha_tyvar [Representational]
+                          Nothing []
+                          (DataTyCon [nilDataCon, consDataCon] False )
+                          Recursive True False
+                          (VanillaAlgTyCon (mkSpecialTyConRepName (fsLit "tcList") listTyConName))
 
 mkPromotedListTy :: Type -> Type
 mkPromotedListTy ty = mkTyConApp promotedListTyCon [ty]
@@ -930,10 +944,10 @@ eqTyCon = mkAlgTyCon eqTyConName
             Nothing
             []      -- No stupid theta
             (DataTyCon [eqBoxDataCon] False)
-            NoParentTyCon
+            (VanillaAlgTyCon (mkSpecialTyConRepName (fsLit "tcEq") eqTyConName))
             NonRecursive
             False
-            Nothing   -- No parent for constraint-kinded types
+            NotPromoted
   where
     kv = kKiVar
     k = mkTyVarTy kv
@@ -949,15 +963,17 @@ eqBoxDataCon = pcDataCon eqBoxDataConName args [TyConApp eqPrimTyCon (map mkTyVa
 
 
 coercibleTyCon :: TyCon
-coercibleTyCon = mkClassTyCon
-    coercibleTyConName kind tvs [Nominal, Representational, Representational]
-    rhs coercibleClass NonRecursive
-  where kind = (ForAllTy kv $ mkArrowKinds [k, k] constraintKind)
-        kv = kKiVar
-        k = mkTyVarTy kv
-        [a,b] = mkTemplateTyVars [k,k]
-        tvs = [kv, a, b]
-        rhs = DataTyCon [coercibleDataCon] False
+coercibleTyCon = mkClassTyCon coercibleTyConName kind tvs
+                              [Nominal, Representational, Representational]
+                              rhs coercibleClass NonRecursive
+                              (mkPrelTyConRepName coercibleTyConName)
+  where
+     kind = (ForAllTy kv $ mkArrowKinds [k, k] constraintKind)
+     kv = kKiVar
+     k = mkTyVarTy kv
+     [a,b] = mkTemplateTyVars [k,k]
+     tvs = [kv, a, b]
+     rhs = DataTyCon [coercibleDataCon] False
 
 coercibleDataCon :: DataCon
 coercibleDataCon = pcDataCon coercibleDataConName args [TyConApp eqReprPrimTyCon (map mkTyVarTy args)] coercibleTyCon
@@ -994,6 +1010,7 @@ ipCoName      = mkWiredInCoAxiomName BuiltInSyntax gHC_CLASSES (fsLit "NTCo:IP")
 -- See Note [The Implicit Parameter class]
 ipTyCon :: TyCon
 ipTyCon = mkClassTyCon ipTyConName kind [ip,a] [] rhs ipClass NonRecursive
+                       (mkPrelTyConRepName ipTyConName)
   where
     kind = mkArrowKinds [typeSymbolKind, liftedTypeKind] constraintKind
     [ip,a] = mkTemplateTyVars [typeSymbolKind, liftedTypeKind]