Revert "Generate Typeable info at definition sites"

This reverts commit bef2f03e4d56d88a7e9752a7afd6a0a35616da6c.

This merge was botched

Also reverts haddock submodule.

43 files changed, 1116 insertions, 1713 deletions

diff --git a/compiler/basicTypes/DataCon.hs b/compiler/basicTypes/DataCon.hs
index 9a827e03ee..76bdaa0a80 100644
--- a/compiler/basicTypes/DataCon.hs
+++ b/compiler/basicTypes/DataCon.hs
@@ -35,8 +35,7 @@ module DataCon (
         dataConSrcBangs,
         dataConSourceArity, dataConRepArity, dataConRepRepArity,
         dataConIsInfix,
-        dataConWorkId, dataConWrapId, dataConWrapId_maybe,
-        dataConImplicitTyThings,
+        dataConWorkId, dataConWrapId, dataConWrapId_maybe, dataConImplicitIds,
         dataConRepStrictness, dataConImplBangs, dataConBoxer,
 
         splitDataProductType_maybe,
@@ -47,18 +46,16 @@ module DataCon (
         isBanged, isMarkedStrict, eqHsBang, isSrcStrict, isSrcUnpacked,
 
         -- ** Promotion related functions
-        promoteDataCon, promoteDataCon_maybe,
-        promoteType, promoteKind,
-        isPromotableType, computeTyConPromotability,
+        promoteKind, promoteDataCon, promoteDataCon_maybe
     ) where
 
 #include "HsVersions.h"
 
 import {-# SOURCE #-} MkId( DataConBoxer )
 import Type
-import ForeignCall( CType )
 import TypeRep( Type(..) )  -- Used in promoteType
 import PrelNames( liftedTypeKindTyConKey )
+import ForeignCall( CType )
 import Coercion
 import Kind
 import Unify
@@ -75,11 +72,11 @@ import BasicTypes
 import FastString
 import Module
 import VarEnv
-import NameSet
 import Binary
 
 import qualified Data.Data as Data
 import qualified Data.Typeable
+import Data.Maybe
 import Data.Char
 import Data.Word
 import Data.List( mapAccumL, find )
@@ -402,8 +399,8 @@ data DataCon
                                 -- Used for Template Haskell and 'deriving' only
                                 -- The actual fixity is stored elsewhere
 
-        dcPromoted :: Promoted TyCon    -- The promoted TyCon if this DataCon is promotable
-                                        -- See Note [Promoted data constructors] in TyCon
+        dcPromoted :: Maybe TyCon    -- The promoted TyCon if this DataCon is promotable
+                                     -- See Note [Promoted data constructors] in TyCon
   }
   deriving Data.Typeable.Typeable
 
@@ -674,9 +671,7 @@ isMarkedStrict _               = True   -- All others are strict
 -- | Build a new data constructor
 mkDataCon :: Name
           -> Bool           -- ^ Is the constructor declared infix?
-          -> Promoted TyConRepName -- ^ Whether promoted, and if so the TyConRepName
-                                   --   for the promoted TyCon
-          -> [HsSrcBang]    -- ^ Strictness/unpack annotations, from user
+          -> [HsSrcBang]       -- ^ Strictness/unpack annotations, from user
           -> [FieldLabel]   -- ^ Field labels for the constructor,
                             -- if it is a record, otherwise empty
           -> [TyVar]        -- ^ Universally quantified type variables
@@ -693,7 +688,7 @@ mkDataCon :: Name
           -> DataCon
   -- Can get the tag from the TyCon
 
-mkDataCon name declared_infix prom_info
+mkDataCon name declared_infix
           arg_stricts   -- Must match orig_arg_tys 1-1
           fields
           univ_tvs ex_tvs
@@ -738,12 +733,15 @@ mkDataCon name declared_infix prom_info
              mkTyConApp rep_tycon (mkTyVarTys univ_tvs)
 
     mb_promoted   -- See Note [Promoted data constructors] in TyCon
-      = case prom_info of
-          NotPromoted     -> NotPromoted
-          Promoted rep_nm -> Promoted (mkPromotedDataCon con name rep_nm prom_kind prom_roles)
-    prom_kind  = promoteType (dataConUserType con)
-    prom_roles = map (const Nominal)          (univ_tvs ++ ex_tvs) ++
-                 map (const Representational) orig_arg_tys
+      | isJust (promotableTyCon_maybe rep_tycon)
+          -- The TyCon is promotable only if all its datacons
+          -- are, so the promoteType for prom_kind should succeed
+      = Just (mkPromotedDataCon con name (getUnique name) prom_kind roles)
+      | otherwise
+      = Nothing
+    prom_kind = promoteType (dataConUserType con)
+    roles = map (const Nominal)          (univ_tvs ++ ex_tvs) ++
+            map (const Representational) orig_arg_tys
 
 eqSpecPreds :: [(TyVar,Type)] -> ThetaType
 eqSpecPreds spec = [ mkEqPred (mkTyVarTy tv) ty | (tv,ty) <- spec ]
@@ -826,13 +824,11 @@ dataConWrapId dc = case dcRep dc of
 
 -- | Find all the 'Id's implicitly brought into scope by the data constructor. Currently,
 -- the union of the 'dataConWorkId' and the 'dataConWrapId'
-dataConImplicitTyThings :: DataCon -> [TyThing]
-dataConImplicitTyThings (MkData { dcWorkId = work, dcRep = rep })
-  = [AnId work] ++ wrap_ids
-  where
-    wrap_ids = case rep of
-                 NoDataConRep               -> []
-                 DCR { dcr_wrap_id = wrap } -> [AnId wrap]
+dataConImplicitIds :: DataCon -> [Id]
+dataConImplicitIds (MkData { dcWorkId = work, dcRep = rep})
+  = case rep of
+       NoDataConRep               -> [work]
+       DCR { dcr_wrap_id = wrap } -> [wrap,work]
 
 -- | The labels for the fields of this particular 'DataCon'
 dataConFieldLabels :: DataCon -> [FieldLabel]
@@ -1077,112 +1073,60 @@ dataConCannotMatch tys con
 {-
 ************************************************************************
 *                                                                      *
-                 Promotion
-
-   These functions are here becuase
-   - isPromotableTyCon calls dataConFullSig
-   - mkDataCon calls promoteType
-   - It's nice to keep the promotion stuff together
+              Building an algebraic data type
 *                                                                      *
 ************************************************************************
 
-Note [The overall promotion story]
-~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
-Here is the overall plan.
-
-* Compared to a TyCon T, the promoted 'T has
-     same Name (and hence Unique)
-     same TyConRepName
-  In future the two will collapse into one anyhow.
-
-* Compared to a DataCon K, the promoted 'K (a type constructor) has
-      same Name (and hence Unique)
-  But it has a fresh TyConRepName; after all, the DataCon doesn't have
-  a TyConRepName at all.  (See Note [Grand plan for Typeable] in TcTypeable
-  for TyConRepName.)
-
-  Why does 'K have the same unique as K?  It's acceptable because we don't
-  mix types and terms, so we won't get them confused.  And it's helpful mainly
-  so that we know when to print 'K as a qualified name in error message. The
-  PrintUnqualified stuff depends on whether K is lexically in scope.. but 'K
-  never is!
-
-* It follows that the tick-mark (eg 'K) is not part of the Occ name of
-  either promoted data constructors or type constructors. Instead,
-  pretty-printing: the pretty-printer prints a tick in front of
-     - promoted DataCons (always)
-     - promoted TyCons (with -dppr-debug)
-  See TyCon.pprPromotionQuote
-
-* For a promoted data constructor K, the pipeline goes like this:
-    User writes (in a type):      K or 'K
-    Parser produces OccName:      K{tc} or K{d}, respectively
-    Renamer makes Name:           M.K{d}_r62   (i.e. same unique as DataCon K)
-                                     and K{tc} has been turned into K{d}
-                                     provided it was unambiguous
-    Typechecker makes TyCon:      PromotedDataCon MK{d}_r62
-
-
-Note [Checking whether a group is promotable]
-~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
-We only want to promote a TyCon if all its data constructors
-are promotable; it'd be very odd to promote some but not others.
+buildAlgTyCon is here because it is called from TysWiredIn, which in turn
+depends on DataCon, but not on BuildTyCl.
+-}
+
+buildAlgTyCon :: Name
+              -> [TyVar]               -- ^ Kind variables and type variables
+              -> [Role]
+              -> Maybe CType
+              -> ThetaType             -- ^ Stupid theta
+              -> AlgTyConRhs
+              -> RecFlag
+              -> Bool                  -- ^ True <=> this TyCon is promotable
+              -> Bool                  -- ^ True <=> was declared in GADT syntax
+              -> TyConParent
+              -> TyCon
+
+buildAlgTyCon tc_name ktvs roles cType stupid_theta rhs
+              is_rec is_promotable gadt_syn parent
+  = tc
+  where
+    kind = mkPiKinds ktvs liftedTypeKind
+
+    -- tc and mb_promoted_tc are mutually recursive
+    tc = mkAlgTyCon tc_name kind ktvs roles cType stupid_theta
+                    rhs parent is_rec gadt_syn
+                    mb_promoted_tc
 
-But the data constructors may mention this or other TyCons.
+    mb_promoted_tc
+      | is_promotable = Just (mkPromotedTyCon tc (promoteKind kind))
+      | otherwise     = Nothing
 
-So we treat the recursive uses as all OK (ie promotable) and
-do one pass to check that each TyCon is promotable.
+{-
+************************************************************************
+*                                                                      *
+        Promoting of data types to the kind level
+*                                                                      *
+************************************************************************
 
-Currently type synonyms are not promotable, though that
-could change.
+These two 'promoted..' functions are here because
+ * They belong together
+ * 'promoteDataCon' depends on DataCon stuff
 -}
 
 promoteDataCon :: DataCon -> TyCon
-promoteDataCon (MkData { dcPromoted = Promoted tc }) = tc
+promoteDataCon (MkData { dcPromoted = Just tc }) = tc
 promoteDataCon dc = pprPanic "promoteDataCon" (ppr dc)
 
-promoteDataCon_maybe :: DataCon -> Promoted TyCon
+promoteDataCon_maybe :: DataCon -> Maybe TyCon
 promoteDataCon_maybe (MkData { dcPromoted = mb_tc }) = mb_tc
 
-computeTyConPromotability :: NameSet -> TyCon -> Bool
-computeTyConPromotability rec_tycons tc
-  =  isAlgTyCon tc    -- Only algebraic; not even synonyms
-                     -- (we could reconsider the latter)
-  && ok_kind (tyConKind tc)
-  && case algTyConRhs tc of
-       DataTyCon { data_cons = cs } -> all ok_con cs
-       TupleTyCon { data_con = c }  -> ok_con c
-       NewTyCon { data_con = c }    -> ok_con c
-       AbstractTyCon {}             -> False
-  where
-    ok_kind kind = all isLiftedTypeKind args && isLiftedTypeKind res
-            where  -- Checks for * -> ... -> * -> *
-              (args, res) = splitKindFunTys kind
-
-    -- See Note [Promoted data constructors] in TyCon
-    ok_con con = all (isLiftedTypeKind . tyVarKind) ex_tvs
-              && null eq_spec   -- No constraints
-              && null theta
-              && all (isPromotableType rec_tycons) orig_arg_tys
-       where
-         (_, ex_tvs, eq_spec, theta, orig_arg_tys, _) = dataConFullSig con
-
-
-isPromotableType :: NameSet -> Type -> Bool
--- Must line up with promoteType
--- But the function lives here because we must treat the
--- *recursive* tycons as promotable
-isPromotableType rec_tcs con_arg_ty
-  = go con_arg_ty
-  where
-    go (TyConApp tc tys) =  tys `lengthIs` tyConArity tc
-                         && (tyConName tc `elemNameSet` rec_tcs
-                             || isPromotableTyCon tc)
-                         && all go tys
-    go (FunTy arg res)   = go arg && go res
-    go (TyVarTy {})      = True
-    go _                 = False
-
 {-
 Note [Promoting a Type to a Kind]
 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
@@ -1212,7 +1156,7 @@ promoteType ty
     kvs = [ mkKindVar (tyVarName tv) superKind | tv <- tvs ]
     env = zipVarEnv tvs kvs
 
-    go (TyConApp tc tys) | Promoted prom_tc <- promotableTyCon_maybe tc
+    go (TyConApp tc tys) | Just prom_tc <- promotableTyCon_maybe tc
                          = mkTyConApp prom_tc (map go tys)
     go (FunTy arg res)   = mkArrowKind (go arg) (go res)
     go (TyVarTy tv)      | Just kv <- lookupVarEnv env tv
@@ -1264,41 +1208,3 @@ splitDataProductType_maybe ty
   = Just (tycon, ty_args, con, dataConInstArgTys con ty_args)
   | otherwise
   = Nothing
-
-{-
-************************************************************************
-*                                                                      *
-              Building an algebraic data type
-*                                                                      *
-************************************************************************
-
-buildAlgTyCon is here because it is called from TysWiredIn, which can
-depend on this module, but not on BuildTyCl.
--}
-
-buildAlgTyCon :: Name
-              -> [TyVar]               -- ^ Kind variables and type variables
-              -> [Role]
-              -> Maybe CType
-              -> ThetaType             -- ^ Stupid theta
-              -> AlgTyConRhs
-              -> RecFlag
-              -> Bool                  -- ^ True <=> this TyCon is promotable
-              -> Bool                  -- ^ True <=> was declared in GADT syntax
-              -> AlgTyConFlav
-              -> TyCon
-
-buildAlgTyCon tc_name ktvs roles cType stupid_theta rhs
-              is_rec is_promotable gadt_syn parent
-  = tc
-  where
-    kind = mkPiKinds ktvs liftedTypeKind
-
-    -- tc and mb_promoted_tc are mutually recursive
-    tc = mkAlgTyCon tc_name kind ktvs roles cType stupid_theta
-                    rhs parent is_rec gadt_syn
-                    mb_promoted_tc
-
-    mb_promoted_tc
-      | is_promotable = Promoted (mkPromotedTyCon tc (promoteKind kind))
-      | otherwise     = NotPromoted
diff --git a/compiler/basicTypes/OccName.hs b/compiler/basicTypes/OccName.hs
index e2997096aa..67942df518 100644
--- a/compiler/basicTypes/OccName.hs
+++ b/compiler/basicTypes/OccName.hs
@@ -72,7 +72,6 @@ module OccName (
         mkPReprTyConOcc,
         mkPADFunOcc,
         mkRecFldSelOcc,
-        mkTyConRepUserOcc, mkTyConRepSysOcc,
 
         -- ** Deconstruction
         occNameFS, occNameString, occNameSpace,
@@ -587,8 +586,7 @@ mkDataConWrapperOcc, mkWorkerOcc,
         mkGenR, mkGen1R, mkGenRCo,
         mkDataTOcc, mkDataCOcc, mkDataConWorkerOcc, mkNewTyCoOcc,
         mkInstTyCoOcc, mkEqPredCoOcc, mkClassOpAuxOcc,
-        mkCon2TagOcc, mkTag2ConOcc, mkMaxTagOcc,
-        mkTyConRepUserOcc, mkTyConRepSysOcc
+        mkCon2TagOcc, mkTag2ConOcc, mkMaxTagOcc
    :: OccName -> OccName
 
 -- These derived variables have a prefix that no Haskell value could have
@@ -611,24 +609,11 @@ mkNewTyCoOcc        = mk_simple_deriv tcName   "NTCo:"  -- Coercion for newtypes
 mkInstTyCoOcc       = mk_simple_deriv tcName   "TFCo:"   -- Coercion for type functions
 mkEqPredCoOcc       = mk_simple_deriv tcName   "$co"
 
--- Used in derived instances
+-- used in derived instances
 mkCon2TagOcc        = mk_simple_deriv varName  "$con2tag_"
 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
-  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 5705c6fbaf..12629ff91a 100644
--- a/compiler/basicTypes/Unique.hs
+++ b/compiler/basicTypes/Unique.hs
@@ -48,13 +48,10 @@ module Unique (
         mkPreludeTyConUnique, mkPreludeClassUnique,
         mkPArrDataConUnique,
 
-        mkVarOccUnique, mkDataOccUnique, mkTvOccUnique, mkTcOccUnique,
+    mkVarOccUnique, mkDataOccUnique, mkTvOccUnique, mkTcOccUnique,
         mkRegSingleUnique, mkRegPairUnique, mkRegClassUnique, mkRegSubUnique,
         mkCostCentreUnique,
 
-        tyConRepNameUnique,
-        dataConWorkerUnique, dataConRepNameUnique,
-
         mkBuiltinUnique,
         mkPseudoUniqueD,
         mkPseudoUniqueE,
@@ -102,10 +99,9 @@ unpkUnique      :: Unique -> (Char, Int)        -- The reverse
 mkUniqueGrimily :: Int -> Unique                -- A trap-door for UniqSupply
 getKey          :: Unique -> Int                -- for Var
 
-incrUnique   :: Unique -> Unique
-stepUnique   :: Unique -> Int -> Unique
-deriveUnique :: Unique -> Int -> Unique
-newTagUnique :: Unique -> Char -> Unique
+incrUnique      :: Unique -> Unique
+deriveUnique    :: Unique -> Int -> Unique
+newTagUnique    :: Unique -> Char -> Unique
 
 mkUniqueGrimily = MkUnique
 
@@ -113,11 +109,9 @@ mkUniqueGrimily = MkUnique
 getKey (MkUnique x) = x
 
 incrUnique (MkUnique i) = MkUnique (i + 1)
-stepUnique (MkUnique i) n = MkUnique (i + n)
 
 -- deriveUnique uses an 'X' tag so that it won't clash with
 -- any of the uniques produced any other way
--- SPJ says: this looks terribly smelly to me!
 deriveUnique (MkUnique i) delta = mkUnique 'X' (i + delta)
 
 -- newTagUnique changes the "domain" of a unique to a different char
@@ -311,19 +305,14 @@ mkPArrDataConUnique    :: Int -> Unique
 mkAlphaTyVarUnique   i = mkUnique '1' 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)
+-- Prelude type constructors occupy *three* slots.
+-- The first is for the tycon itself; the latter two
+-- are for the generic to/from Ids.  See TysWiredIn.mk_tc_gen_info.
 
-tyConRepNameUnique :: Unique -> Unique
-tyConRepNameUnique  u = incrUnique u
+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)
 
 -- Data constructor keys occupy *two* slots.  The first is used for the
 -- data constructor itself and its wrapper function (the function that
@@ -331,22 +320,10 @@ tyConRepNameUnique  u = incrUnique u
 -- used for the worker function (the function that builds the constructor
 -- representation).
 
---------------------------------------------------
--- 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.
-
-mkPreludeDataConUnique i              = mkUnique '6' (3*i)    -- Must be alphabetic
-mkTupleDataConUnique Boxed          a = mkUnique '7' (3*a)    -- ditto (*may* be used in C labels)
-mkTupleDataConUnique Unboxed        a = mkUnique '8' (3*a)
-
-dataConRepNameUnique, dataConWorkerUnique :: Unique -> Unique
-dataConWorkerUnique  u = incrUnique u
-dataConRepNameUnique u = stepUnique u 2
+mkPreludeDataConUnique i       = mkUnique '6' (2*i)    -- Must be alphabetic
+mkTupleDataConUnique Boxed   a = mkUnique '7' (2*a)        -- ditto (*may* be used in C labels)
+mkTupleDataConUnique Unboxed a = mkUnique '8' (2*a)
 
---------------------------------------------------
 mkPrimOpIdUnique op         = mkUnique '9' op
 mkPreludeMiscIdUnique  i    = mkUnique '0' i
 
diff --git a/compiler/coreSyn/MkCore.hs b/compiler/coreSyn/MkCore.hs
index 8670e2104e..fb797f11ce 100644
--- a/compiler/coreSyn/MkCore.hs
+++ b/compiler/coreSyn/MkCore.hs
@@ -126,12 +126,12 @@ mkCoreLets binds body = foldr mkCoreLet body binds
 
 -- | Construct an expression which represents the application of one expression
 -- to the other
-mkCoreApp :: SDoc -> CoreExpr -> CoreExpr -> CoreExpr
+mkCoreApp :: CoreExpr -> CoreExpr -> CoreExpr
 -- Respects the let/app invariant by building a case expression where necessary
 --   See CoreSyn Note [CoreSyn let/app invariant]
-mkCoreApp _ fun (Type ty) = App fun (Type ty)
-mkCoreApp _ fun (Coercion co) = App fun (Coercion co)
-mkCoreApp d fun arg       = ASSERT2( isFunTy fun_ty, ppr fun $$ ppr arg $$ d )
+mkCoreApp fun (Type ty) = App fun (Type ty)
+mkCoreApp fun (Coercion co) = App fun (Coercion co)
+mkCoreApp fun arg       = ASSERT2( isFunTy fun_ty, ppr fun $$ ppr arg )
                           mk_val_app fun arg arg_ty res_ty
                       where
                         fun_ty = exprType fun
diff --git a/compiler/deSugar/DsBinds.hs b/compiler/deSugar/DsBinds.hs
index 93b50dfc7c..4fa09cb42a 100644
--- a/compiler/deSugar/DsBinds.hs
+++ b/compiler/deSugar/DsBinds.hs
@@ -44,11 +44,10 @@ import TyCon
 import TcEvidence
 import TcType
 import Type
-import Kind( isKind )
+import Kind (returnsConstraintKind)
 import Coercion hiding (substCo)
 import TysWiredIn ( eqBoxDataCon, coercibleDataCon, mkListTy
-                  , mkBoxedTupleTy, charTy
-                  , typeNatKind, typeSymbolKind )
+                  , mkBoxedTupleTy, charTy, typeNatKind, typeSymbolKind )
 import Id
 import MkId(proxyHashId)
 import Class
@@ -71,12 +70,15 @@ import FastString
 import Util
 import MonadUtils
 import Control.Monad(liftM,when)
+import Fingerprint(Fingerprint(..), fingerprintString)
 
-{-**********************************************************************
+{-
+************************************************************************
 *                                                                      *
-           Desugaring a MonoBinds
+\subsection[dsMonoBinds]{Desugaring a @MonoBinds@}
 *                                                                      *
-**********************************************************************-}
+************************************************************************
+-}
 
 dsTopLHsBinds :: LHsBinds Id -> DsM (OrdList (Id,CoreExpr))
 dsTopLHsBinds binds = ds_lhs_binds binds
@@ -813,7 +815,7 @@ dsHsWrapper (WpCompose c1 c2) e = do { e1 <- dsHsWrapper c2 e
                                      ; dsHsWrapper c1 e1 }
 dsHsWrapper (WpFun c1 c2 t1 _) e = do { x <- newSysLocalDs t1
                                       ; e1 <- dsHsWrapper c1 (Var x)
-                                      ; e2 <- dsHsWrapper c2 (mkCoreAppDs (text "dsHsWrapper") e e1)
+                                      ; e2 <- dsHsWrapper c2 (e `mkCoreAppDs` e1)
                                       ; return (Lam x e2) }
 dsHsWrapper (WpCast co)       e = ASSERT(tcCoercionRole co == Representational)
                                   dsTcCoercion co (mkCastDs e)
@@ -851,145 +853,154 @@ sccEvBinds bs = stronglyConnCompFromEdgedVertices edges
        = (b, var, varSetElems (evVarsOfTerm term))
 
 
-{-**********************************************************************
-*                                                                      *
-           Desugaring EvTerms
-*                                                                      *
-**********************************************************************-}
-
+---------------------------------------
 dsEvTerm :: EvTerm -> DsM CoreExpr
-dsEvTerm (EvId v)           = return (Var v)
-dsEvTerm (EvCallStack cs)   = dsEvCallStack cs
-dsEvTerm (EvTypeable ty ev) = dsEvTypeable ty ev
-dsEvTerm (EvLit (EvNum n))  = mkIntegerExpr n
-dsEvTerm (EvLit (EvStr s))  = mkStringExprFS s
+dsEvTerm (EvId v) = return (Var v)
 
 dsEvTerm (EvCast tm co)
   = do { tm' <- dsEvTerm tm
        ; dsTcCoercion co $ mkCastDs tm' }
-         -- 'v' is always a lifted evidence variable so it is
-         -- unnecessary to call varToCoreExpr v here.
-
-dsEvTerm (EvDFunApp df tys tms)
-  = return (Var df `mkTyApps` tys `mkApps` (map Var tms))
+                        -- 'v' is always a lifted evidence variable so it is
+                        -- unnecessary to call varToCoreExpr v here.
 
+dsEvTerm (EvDFunApp df tys tms)     = return (Var df `mkTyApps` tys `mkApps` (map Var tms))
 dsEvTerm (EvCoercion (TcCoVarCo v)) = return (Var v)  -- See Note [Simple coercions]
 dsEvTerm (EvCoercion co)            = dsTcCoercion co mkEqBox
-
 dsEvTerm (EvSuperClass d n)
   = do { d' <- dsEvTerm d
        ; let (cls, tys) = getClassPredTys (exprType d')
              sc_sel_id  = classSCSelId cls n    -- Zero-indexed
        ; return $ Var sc_sel_id `mkTyApps` tys `App` d' }
 
-dsEvTerm (EvDelayedError ty msg)
-  = return $ Var errorId `mkTyApps` [ty] `mkApps` [litMsg]
+dsEvTerm (EvDelayedError ty msg) = return $ Var errorId `mkTyApps` [ty] `mkApps` [litMsg]
   where
     errorId = tYPE_ERROR_ID
     litMsg  = Lit (MachStr (fastStringToByteString msg))
 
-{-**********************************************************************
-*                                                                      *
-           Desugaring Typeable dictionaries
-*                                                                      *
-**********************************************************************-}
-
-dsEvTypeable :: Type -> EvTypeable -> DsM CoreExpr
--- Return a CoreExpr :: Typeable ty
--- This code is tightly coupled to the representation
--- of TypeRep, in base library Data.Typeable.Internals
-dsEvTypeable ty ev
-  = do { tyCl <- dsLookupTyCon typeableClassName   -- Typeable
-       ; let kind = typeKind ty
-             Just typeable_data_con
-                 = tyConSingleDataCon_maybe tyCl      -- "Data constructor"
-                                                      -- for Typeable
-
-       ; rep_expr <- ds_ev_typeable ty ev
-
-       -- Build Core for (let r::TypeRep = rep in \proxy. rep)
-       -- See Note [Memoising typeOf]
-       ; repName <- newSysLocalDs (exprType rep_expr)
-       ; let proxyT = mkProxyPrimTy kind ty
-             method = bindNonRec repName rep_expr
-                      $ mkLams [mkWildValBinder proxyT] (Var repName)
-
-       -- Package up the method as `Typeable` dictionary
-       ; return $ mkConApp typeable_data_con [Type kind, Type ty, method] }
-
-
-ds_ev_typeable :: Type -> EvTypeable -> DsM CoreExpr
--- Returns a CoreExpr :: TypeRep ty
-ds_ev_typeable ty EvTypeableTyCon
-  | Just (tc, ks) <- splitTyConApp_maybe ty
-  = ASSERT( all isKind ks )
-    do { ctr <- dsLookupGlobalId mkPolyTyConAppName
-                    -- mkPolyTyConApp :: TyCon -> [KindRep] -> [TypeRep] -> TypeRep
-       ; tyRepTc <- dsLookupTyCon typeRepTyConName  -- TypeRep (the TyCon)
-       ; let tyRepType = mkTyConApp tyRepTc []      -- TypeRep (the Type)
-             mkRep cRep kReps tReps
-               = mkApps (Var ctr) [ cRep
-                                  , mkListExpr tyRepType kReps
-                                  , mkListExpr tyRepType tReps ]
-
-             kindRep k  -- Returns CoreExpr :: TypeRep for that kind k
-               = case splitTyConApp_maybe k of
-                   Nothing -> panic "dsEvTypeable: not a kind constructor"
-                   Just (kc,ks) -> do { kcRep <- tyConRep kc
-                                      ; reps  <- mapM kindRep ks
-                                      ; return (mkRep kcRep [] reps) }
-
-       ; tcRep <- tyConRep tc
-       ; kReps <- mapM kindRep ks
-       ; return (mkRep tcRep kReps []) }
-
-ds_ev_typeable ty (EvTypeableTyApp ev1 ev2)
-  | Just (t1,t2) <- splitAppTy_maybe ty
-  = do { e1  <- getRep ev1 t1
-       ; e2  <- getRep ev2 t2
-       ; ctr <- dsLookupGlobalId mkAppTyName
-       ; return ( mkApps (Var ctr) [ e1, e2 ] ) }
-
-ds_ev_typeable ty (EvTypeableTyLit ev)
-  = do { fun  <- dsLookupGlobalId tr_fun
-       ; dict <- dsEvTerm ev       -- Of type KnownNat/KnownSym
-       ; let proxy = mkTyApps (Var proxyHashId) [ty_kind, ty]
-       ; return (mkApps (mkTyApps (Var fun) [ty]) [ dict, proxy ]) }
+dsEvTerm (EvLit l) =
+  case l of
+    EvNum n -> mkIntegerExpr n
+    EvStr s -> mkStringExprFS s
+
+dsEvTerm (EvCallStack cs) = dsEvCallStack cs
+
+dsEvTerm (EvTypeable ev) = dsEvTypeable ev
+
+dsEvTypeable :: EvTypeable -> DsM CoreExpr
+dsEvTypeable ev =
+  do tyCl      <- dsLookupTyCon typeableClassName
+     typeRepTc <- dsLookupTyCon typeRepTyConName
+     let tyRepType = mkTyConApp typeRepTc []
+
+     (ty, rep) <-
+        case ev of
+
+          EvTypeableTyCon tc ks ->
+            do ctr       <- dsLookupGlobalId mkPolyTyConAppName
+               mkTyCon   <- dsLookupGlobalId mkTyConName
+               dflags    <- getDynFlags
+               let mkRep cRep kReps tReps =
+                     mkApps (Var ctr) [ cRep, mkListExpr tyRepType kReps
+                                            , mkListExpr tyRepType tReps ]
+
+               let kindRep k =
+                     case splitTyConApp_maybe k of
+                       Nothing -> panic "dsEvTypeable: not a kind constructor"
+                       Just (kc,ks) ->
+                         do kcRep <- tyConRep dflags mkTyCon kc
+                            reps  <- mapM kindRep ks
+                            return (mkRep kcRep [] reps)
+
+               tcRep     <- tyConRep dflags mkTyCon tc
+
+               kReps     <- mapM kindRep ks
+
+               return ( mkTyConApp tc ks
+                      , mkRep tcRep kReps []
+                      )
+
+          EvTypeableTyApp t1 t2 ->
+            do e1  <- getRep tyCl t1
+               e2  <- getRep tyCl t2
+               ctr <- dsLookupGlobalId mkAppTyName
+
+               return ( mkAppTy (snd t1) (snd t2)
+                      , mkApps (Var ctr) [ e1, e2 ]
+                      )
+
+          EvTypeableTyLit t ->
+            do e <- tyLitRep t
+               return (snd t, e)
+
+     -- TyRep -> Typeable t
+     -- see also: Note [Memoising typeOf]
+     repName <- newSysLocalDs tyRepType
+     let proxyT = mkProxyPrimTy (typeKind ty) ty
+         method = bindNonRec repName rep
+                $ mkLams [mkWildValBinder proxyT] (Var repName)
+
+     -- package up the method as `Typeable` dictionary
+     return $ mkCastDs method $ mkSymCo $ getTypeableCo tyCl ty
+
   where
-    ty_kind = typeKind ty
-
-    -- tr_fun is the Name of
-    --       typeNatTypeRep    :: KnownNat    a => Proxy# a -> TypeRep
-    -- of    typeSymbolTypeRep :: KnownSymbol a => Proxy# a -> TypeRep
-    tr_fun | ty_kind `eqType` typeNatKind    = typeNatTypeRepName
-           | ty_kind `eqType` typeSymbolKind = typeSymbolTypeRepName
-           | otherwise = panic "dsEvTypeable: unknown type lit kind"
-
-
-ds_ev_typeable ty ev
-  = pprPanic "dsEvTypeable" (ppr ty $$ ppr ev)
-
-getRep :: EvTerm -> Type  -- EvTerm for Typeable ty, and ty
-       -> DsM CoreExpr    -- Return CoreExpr :: TypeRep (of ty)
-                          -- namely (typeRep# dict proxy)
--- Remember that
---   typeRep# :: forall k (a::k). Typeable k a -> Proxy k a -> TypeRep
-getRep ev ty
-  = do { typeable_expr <- dsEvTerm ev
-       ; typeRepId     <- dsLookupGlobalId typeRepIdName
-       ; let ty_args = [typeKind ty, ty]
-       ; return (mkApps (mkTyApps (Var typeRepId) ty_args)
-                        [ typeable_expr
-                        , mkTyApps (Var proxyHashId) ty_args ]) }
-
-tyConRep :: TyCon -> DsM CoreExpr
--- Returns CoreExpr :: TyCon
-tyConRep tc
-  | Just tc_rep_nm <- tyConRepName_maybe tc
-  = do { tc_rep_id <- dsLookupGlobalId tc_rep_nm
-       ; return (Var tc_rep_id) }
-  | otherwise
-  = pprPanic "tyConRep" (ppr tc)
+  -- co: method -> Typeable k t
+  getTypeableCo tc t =
+    case instNewTyCon_maybe tc [typeKind t, t] of
+      Just (_,co) -> co
+      _           -> panic "Class `Typeable` is not a `newtype`."
+
+  -- Typeable t -> TyRep
+  getRep tc (ev,t) =
+    do typeableExpr <- dsEvTerm ev
+       let co     = getTypeableCo tc t
+           method = mkCastDs typeableExpr co
+           proxy  = mkTyApps (Var proxyHashId) [typeKind t, t]
+       return (mkApps method [proxy])
+
+  -- KnownNat t -> TyRep      (also used for KnownSymbol)
+  tyLitRep (ev,t) =
+    do dict <- dsEvTerm ev
+       fun  <- dsLookupGlobalId $
+               case typeKind t of
+                 k | eqType k typeNatKind    -> typeNatTypeRepName
+                   | eqType k typeSymbolKind -> typeSymbolTypeRepName
+                   | otherwise -> panic "dsEvTypeable: unknown type lit kind"
+       let finst  = mkTyApps (Var fun) [t]
+           proxy  = mkTyApps (Var proxyHashId) [typeKind t, t]
+       return (mkApps finst [ dict, proxy ])
+
+  -- This part could be cached
+  tyConRep dflags mkTyCon tc =
+    do pkgStr  <- mkStringExprFS pkg_fs
+       modStr  <- mkStringExprFS modl_fs
+       nameStr <- mkStringExprFS name_fs
+       return (mkApps (Var mkTyCon) [ int64 high, int64 low
+                                    , pkgStr, modStr, nameStr
+                                    ])
+    where
+    tycon_name                = tyConName tc
+    modl                      = nameModule tycon_name
+    pkg                       = moduleUnitId modl
+
+    modl_fs                   = moduleNameFS (moduleName modl)
+    pkg_fs                    = unitIdFS pkg
+    name_fs                   = occNameFS (nameOccName tycon_name)
+    hash_name_fs
+      | isPromotedTyCon tc    = appendFS (mkFastString "$k") name_fs
+      | isPromotedDataCon tc  = appendFS (mkFastString "$c") name_fs
+      | isTupleTyCon tc &&
+        returnsConstraintKind (tyConKind tc)
+                              = appendFS (mkFastString "$p") name_fs
+      | otherwise             = name_fs
+
+    hashThis = unwords $ map unpackFS [pkg_fs, modl_fs, hash_name_fs]
+    Fingerprint high low = fingerprintString hashThis
+
+    int64
+      | wORD_SIZE dflags == 4 = mkWord64LitWord64
+      | otherwise             = mkWordLit dflags . fromIntegral
+
+
 
 {- Note [Memoising typeOf]
 ~~~~~~~~~~~~~~~~~~~~~~~~~~
@@ -1001,11 +1012,8 @@ help GHC by manually keeping the 'rep' *outside* the lambda.
 -}
 
 
-{-**********************************************************************
-*                                                                      *
-           Desugaring EvCallStack evidence
-*                                                                      *
-**********************************************************************-}
+
+
 
 dsEvCallStack :: EvCallStack -> DsM CoreExpr
 -- See Note [Overview of implicit CallStacks] in TcEvidence.hs
@@ -1017,7 +1025,7 @@ dsEvCallStack cs = do
   let srcLocTy     = mkTyConTy srcLocTyCon
   let mkSrcLoc l =
         liftM (mkCoreConApps srcLocDataCon)
-              (sequence [ mkStringExprFS (unitIdFS $ moduleUnitId m)
+              (sequence [ mkStringExpr (showPpr df $ moduleUnitId m)
                         , mkStringExprFS (moduleNameFS $ moduleName m)
                         , mkStringExprFS (srcSpanFile l)
                         , return $ mkIntExprInt df (srcSpanStartLine l)
@@ -1063,12 +1071,7 @@ dsEvCallStack cs = do
     EvCsPushCall name loc tm -> mkPush (occNameFS $ getOccName name) loc tm
     EvCsEmpty -> panic "Cannot have an empty CallStack"
 
-{-**********************************************************************
-*                                                                      *
-           Desugaring Coercions
-*                                                                      *
-**********************************************************************-}
-
+---------------------------------------
 dsTcCoercion :: TcCoercion -> (Coercion -> CoreExpr) -> DsM CoreExpr
 -- This is the crucial function that moves
 -- from TcCoercions to Coercions; see Note [TcCoercions] in Coercion
diff --git a/compiler/deSugar/DsExpr.hs b/compiler/deSugar/DsExpr.hs
index 6e415d7b4c..f47843aa06 100644
--- a/compiler/deSugar/DsExpr.hs
+++ b/compiler/deSugar/DsExpr.hs
@@ -217,8 +217,8 @@ dsExpr (HsLamCase arg matches)
        ; ([discrim_var], matching_code) <- matchWrapper CaseAlt matches
        ; return $ Lam arg_var $ bindNonRec discrim_var (Var arg_var) matching_code }
 
-dsExpr e@(HsApp fun arg)
-  = mkCoreAppDs (text "HsApp" <+> ppr e) <$> dsLExpr fun <*>  dsLExpr arg
+dsExpr (HsApp fun arg)
+  = mkCoreAppDs <$> dsLExpr fun <*>  dsLExpr arg
 
 
 {-
@@ -260,15 +260,15 @@ If \tr{expr} is actually just a variable, say, then the simplifier
 will sort it out.
 -}
 
-dsExpr e@(OpApp e1 op _ e2)
+dsExpr (OpApp e1 op _ e2)
   = -- for the type of y, we need the type of op's 2nd argument
-    mkCoreAppsDs (text "opapp" <+> ppr e) <$> dsLExpr op <*> mapM dsLExpr [e1, e2]
+    mkCoreAppsDs <$> dsLExpr op <*> mapM dsLExpr [e1, e2]
 
 dsExpr (SectionL expr op)       -- Desugar (e !) to ((!) e)
-  = mkCoreAppDs (text "sectionl" <+> ppr expr) <$> dsLExpr op <*> dsLExpr expr
+  = mkCoreAppDs <$> dsLExpr op <*> dsLExpr expr
 
 -- dsLExpr (SectionR op expr)   -- \ x -> op x expr
-dsExpr e@(SectionR op expr) = do
+dsExpr (SectionR op expr) = do
     core_op <- dsLExpr op
     -- for the type of x, we need the type of op's 2nd argument
     let (x_ty:y_ty:_, _) = splitFunTys (exprType core_op)
@@ -277,7 +277,7 @@ dsExpr e@(SectionR op expr) = do
     x_id <- newSysLocalDs x_ty
     y_id <- newSysLocalDs y_ty
     return (bindNonRec y_id y_core $
-            Lam x_id (mkCoreAppsDs (text "sectionr" <+> ppr e) core_op [Var x_id, Var y_id]))
+            Lam x_id (mkCoreAppsDs core_op [Var x_id, Var y_id]))
 
 dsExpr (ExplicitTuple tup_args boxity)
   = do { let go (lam_vars, args) (L _ (Missing ty))
diff --git a/compiler/deSugar/DsUtils.hs b/compiler/deSugar/DsUtils.hs
index 503e29de46..bce5186f08 100644
--- a/compiler/deSugar/DsUtils.hs
+++ b/compiler/deSugar/DsUtils.hs
@@ -241,7 +241,7 @@ mkCoLetMatchResult bind = adjustMatchResult (mkCoreLet bind)
 -- let var' = viewExpr var in mr
 mkViewMatchResult :: Id -> CoreExpr -> Id -> MatchResult -> MatchResult
 mkViewMatchResult var' viewExpr var =
-    adjustMatchResult (mkCoreLet (NonRec var' (mkCoreAppDs (text "mkView" <+> ppr var') viewExpr (Var var))))
+    adjustMatchResult (mkCoreLet (NonRec var' (mkCoreAppDs viewExpr (Var var))))
 
 mkEvalMatchResult :: Id -> Type -> MatchResult -> MatchResult
 mkEvalMatchResult var ty
@@ -343,7 +343,7 @@ mkPatSynCase var ty alt fail = do
     matcher <- dsLExpr $ mkLHsWrap wrapper $ nlHsTyApp matcher [ty]
     let MatchResult _ mkCont = match_result
     cont <- mkCoreLams bndrs <$> mkCont fail
-    return $ mkCoreAppsDs (text "patsyn" <+> ppr var) matcher [Var var, ensure_unstrict cont, Lam voidArgId fail]
+    return $ mkCoreAppsDs matcher [Var var, ensure_unstrict cont, Lam voidArgId fail]
   where
     MkCaseAlt{ alt_pat = psyn,
                alt_bndrs = bndrs,
@@ -536,8 +536,8 @@ into
 which stupidly tries to bind the datacon 'True'.
 -}
 
-mkCoreAppDs  :: SDoc -> CoreExpr -> CoreExpr -> CoreExpr
-mkCoreAppDs _ (Var f `App` Type ty1 `App` Type ty2 `App` arg1) arg2
+mkCoreAppDs  :: CoreExpr -> CoreExpr -> CoreExpr
+mkCoreAppDs (Var f `App` Type ty1 `App` Type ty2 `App` arg1) arg2
   | f `hasKey` seqIdKey            -- Note [Desugaring seq (1), (2)]
   = Case arg1 case_bndr ty2 [(DEFAULT,[],arg2)]
   where
@@ -545,10 +545,10 @@ mkCoreAppDs _ (Var f `App` Type ty1 `App` Type ty2 `App` arg1) arg2
                    Var v1 | isLocalId v1 -> v1        -- Note [Desugaring seq (2) and (3)]
                    _                     -> mkWildValBinder ty1
 
-mkCoreAppDs s fun arg = mkCoreApp s fun arg  -- The rest is done in MkCore
+mkCoreAppDs fun arg = mkCoreApp fun arg  -- The rest is done in MkCore
 
-mkCoreAppsDs :: SDoc -> CoreExpr -> [CoreExpr] -> CoreExpr
-mkCoreAppsDs s fun args = foldl (mkCoreAppDs s) fun args
+mkCoreAppsDs :: CoreExpr -> [CoreExpr] -> CoreExpr
+mkCoreAppsDs fun args = foldl mkCoreAppDs fun args
 
 mkCastDs :: CoreExpr -> Coercion -> CoreExpr
 -- We define a desugarer-specific verison of CoreUtils.mkCast,
diff --git a/compiler/ghc.cabal.in b/compiler/ghc.cabal.in
index 5506078004..e31d848a08 100644
--- a/compiler/ghc.cabal.in
+++ b/compiler/ghc.cabal.in
@@ -414,7 +414,6 @@ Library
         TcErrors
         TcTyClsDecls
         TcTyDecls
-        TcTypeable
         TcType
         TcEvidence
         TcUnify
diff --git a/compiler/hsSyn/HsUtils.hs b/compiler/hsSyn/HsUtils.hs
index a2ed9488b8..be01baa4ea 100644
--- a/compiler/hsSyn/HsUtils.hs
+++ b/compiler/hsSyn/HsUtils.hs
@@ -41,7 +41,7 @@ module HsUtils(
   mkPatSynBind,
 
   -- Literals
-  mkHsIntegral, mkHsFractional, mkHsIsString, mkHsString, mkHsStringPrimLit,
+  mkHsIntegral, mkHsFractional, mkHsIsString, mkHsString,
 
   -- Patterns
   mkNPat, mkNPlusKPat, nlVarPat, nlLitPat, nlConVarPat, nlConVarPatName, nlConPat,
@@ -319,10 +319,6 @@ unqualQuasiQuote = mkRdrUnqual (mkVarOccFS (fsLit "quasiquote"))
 mkHsString :: String -> HsLit
 mkHsString s = HsString s (mkFastString s)
 
-mkHsStringPrimLit :: FastString -> HsLit
-mkHsStringPrimLit fs
-  = HsStringPrim (unpackFS fs) (fastStringToByteString fs)
-
 -------------
 userHsTyVarBndrs :: SrcSpan -> [name] -> [Located (HsTyVarBndr name)]
 -- Caller sets location
diff --git a/compiler/iface/BuildTyCl.hs b/compiler/iface/BuildTyCl.hs
index 6085b0cc3c..11873077ce 100644
--- a/compiler/iface/BuildTyCl.hs
+++ b/compiler/iface/BuildTyCl.hs
@@ -14,7 +14,7 @@ module BuildTyCl (
         TcMethInfo, buildClass,
         distinctAbstractTyConRhs, totallyAbstractTyConRhs,
         mkNewTyConRhs, mkDataTyConRhs,
-        newImplicitBinder, newTyConRepName
+        newImplicitBinder
     ) where
 
 #include "HsVersions.h"
@@ -22,7 +22,6 @@ module BuildTyCl (
 import IfaceEnv
 import FamInstEnv( FamInstEnvs )
 import TysWiredIn( isCTupleTyConName )
-import PrelNames( tyConRepModOcc )
 import DataCon
 import PatSyn
 import Var
@@ -37,7 +36,6 @@ import Id
 import Coercion
 import TcType
 
-import SrcLoc( noSrcSpan )
 import DynFlags
 import TcRnMonad
 import UniqSupply
@@ -51,8 +49,7 @@ buildSynonymTyCon :: Name -> [TyVar] -> [Role]
                   -> TyCon
 buildSynonymTyCon tc_name tvs roles rhs rhs_kind
   = mkSynonymTyCon tc_name kind tvs roles rhs
-  where
-    kind = mkPiKinds tvs rhs_kind
+  where kind = mkPiKinds tvs rhs_kind
 
 
 buildFamilyTyCon :: Name         -- ^ Type family name
@@ -60,7 +57,7 @@ buildFamilyTyCon :: Name         -- ^ Type family name
                  -> Maybe Name   -- ^ Result variable name
                  -> FamTyConFlav -- ^ Open, closed or in a boot file?
                  -> Kind         -- ^ Kind of the RHS
-                 -> Maybe Class  -- ^ Parent, if exists
+                 -> TyConParent  -- ^ Parent, if exists
                  -> Injectivity  -- ^ Injectivity annotation
                                  -- See [Injectivity annotation] in HsDecls
                  -> TyCon
@@ -135,9 +132,7 @@ mkNewTyConRhs tycon_name tycon con
 
 ------------------------------------------------------
 buildDataCon :: FamInstEnvs
-            -> Name
-            -> Bool                     -- Declared infix
-            -> Promoted TyConRepName    -- Promotable
+            -> Name -> Bool
             -> [HsSrcBang]
             -> Maybe [HsImplBang]
                 -- See Note [Bangs on imported data constructors] in MkId
@@ -153,7 +148,7 @@ buildDataCon :: FamInstEnvs
 --   a) makes the worker Id
 --   b) makes the wrapper Id if necessary, including
 --      allocating its unique (hence monadic)
-buildDataCon fam_envs src_name declared_infix prom_info src_bangs impl_bangs field_lbls
+buildDataCon fam_envs src_name declared_infix src_bangs impl_bangs field_lbls
              univ_tvs ex_tvs eq_spec ctxt arg_tys res_ty rep_tycon
   = do  { wrap_name <- newImplicitBinder src_name mkDataConWrapperOcc
         ; work_name <- newImplicitBinder src_name mkDataConWorkerOcc
@@ -161,12 +156,11 @@ buildDataCon fam_envs src_name declared_infix prom_info src_bangs impl_bangs fie
         -- code, which (for Haskell source anyway) will be in the DataName name
         -- space, and puts it into the VarName name space
 
-        ; traceIf (text "buildDataCon 1" <+> ppr src_name)
         ; us <- newUniqueSupply
         ; dflags <- getDynFlags
         ; let
                 stupid_ctxt = mkDataConStupidTheta rep_tycon arg_tys univ_tvs
-                data_con = mkDataCon src_name declared_infix prom_info
+                data_con = mkDataCon src_name declared_infix
                                      src_bangs field_lbls
                                      univ_tvs ex_tvs eq_spec ctxt
                                      arg_tys res_ty rep_tycon
@@ -175,7 +169,6 @@ buildDataCon fam_envs src_name declared_infix prom_info src_bangs impl_bangs fie
                 dc_rep = initUs_ us (mkDataConRep dflags fam_envs wrap_name
                                                   impl_bangs data_con)
 
-        ; traceIf (text "buildDataCon 2" <+> ppr src_name)
         ; return data_con }
 
 
@@ -234,8 +227,7 @@ type TcMethInfo = (Name, DefMethSpec, Type)
         -- A temporary intermediate, to communicate between
         -- tcClassSigs and buildClass.
 
-buildClass :: Name     -- Name of the class/tycon (they have the same Name)
-           -> [TyVar] -> [Role] -> ThetaType
+buildClass :: Name -> [TyVar] -> [Role] -> ThetaType
            -> [FunDep TyVar]               -- Functional dependencies
            -> [ClassATItem]                -- Associated types
            -> [TcMethInfo]                 -- Method info
@@ -248,7 +240,10 @@ buildClass tycon_name tvs roles sc_theta fds at_items sig_stuff mindef tc_isrec
     do  { traceIf (text "buildClass")
 
         ; datacon_name <- newImplicitBinder tycon_name mkClassDataConOcc
-        ; tc_rep_name  <- newTyConRepName tycon_name
+                -- The class name is the 'parent' for this datacon, not its tycon,
+                -- because one should import the class to get the binding for
+                -- the datacon
+
 
         ; op_items <- mapM (mk_op_item rec_clas) sig_stuff
                         -- Build the selector id and default method id
@@ -287,7 +282,6 @@ buildClass tycon_name tvs roles sc_theta fds at_items sig_stuff mindef tc_isrec
         ; dict_con <- buildDataCon (panic "buildClass: FamInstEnvs")
                                    datacon_name
                                    False        -- Not declared infix
-                                   NotPromoted  -- Class tycons are not promoted
                                    (map (const no_bang) args)
                                    (Just (map (const HsLazy) args))
                                    [{- No fields -}]
@@ -306,8 +300,9 @@ buildClass tycon_name tvs roles sc_theta fds at_items sig_stuff mindef tc_isrec
                  else return (mkDataTyConRhs [dict_con])
 
         ; let { clas_kind = mkPiKinds tvs constraintKind
-              ; tycon     = mkClassTyCon tycon_name clas_kind tvs roles
-                                         rhs rec_clas tc_isrec tc_rep_name
+
+              ; tycon = mkClassTyCon tycon_name clas_kind tvs roles
+                                     rhs rec_clas tc_isrec
                 -- A class can be recursive, and in the case of newtypes
                 -- this matters.  For example
                 --      class C a where { op :: C b => a -> b -> Int }
@@ -371,12 +366,3 @@ newImplicitBinder base_name mk_sys_occ
   where
     occ = mk_sys_occ (nameOccName base_name)
     loc = nameSrcSpan base_name
-
--- | Make the 'TyConRepName' for this 'TyCon'
-newTyConRepName :: Name -> TcRnIf gbl lcl TyConRepName
-newTyConRepName tc_name
-  | Just mod <- nameModule_maybe tc_name
-  , (mod, occ) <- tyConRepModOcc mod (nameOccName tc_name)
-  = newGlobalBinder mod occ noSrcSpan
-  | otherwise
-  = newImplicitBinder tc_name mkTyConRepUserOcc
diff --git a/compiler/iface/IfaceSyn.hs b/compiler/iface/IfaceSyn.hs
index 3911786594..8bf744f0c7 100644
--- a/compiler/iface/IfaceSyn.hs
+++ b/compiler/iface/IfaceSyn.hs
@@ -165,8 +165,7 @@ data IfaceTyConParent
                    IfaceTcArgs
 
 data IfaceFamTyConFlav
-  = IfaceDataFamilyTyCon                      -- Data family
-  | IfaceOpenSynFamilyTyCon
+  = IfaceOpenSynFamilyTyCon
   | IfaceClosedSynFamilyTyCon (Maybe (IfExtName, [IfaceAxBranch]))
     -- ^ Name of associated axiom and branches for pretty printing purposes,
     -- or 'Nothing' for an empty closed family without an axiom
@@ -193,6 +192,7 @@ data IfaceAxBranch = IfaceAxBranch { ifaxbTyVars  :: [IfaceTvBndr]
 
 data IfaceConDecls
   = IfAbstractTyCon Bool                          -- c.f TyCon.AbstractTyCon
+  | IfDataFamTyCon                                -- Data family
   | IfDataTyCon [IfaceConDecl] Bool [FieldLabelString] -- Data type decls
   | IfNewTyCon  IfaceConDecl   Bool [FieldLabelString] -- Newtype decls
 
@@ -343,12 +343,14 @@ See [http://ghc.haskell.org/trac/ghc/wiki/Commentary/Compiler/RecompilationAvoid
 
 visibleIfConDecls :: IfaceConDecls -> [IfaceConDecl]
 visibleIfConDecls (IfAbstractTyCon {}) = []
+visibleIfConDecls IfDataFamTyCon       = []
 visibleIfConDecls (IfDataTyCon cs _ _) = cs
 visibleIfConDecls (IfNewTyCon c   _ _) = [c]
 
 ifaceConDeclFields :: IfaceConDecls -> [FieldLbl OccName]
 ifaceConDeclFields x = case x of
     IfAbstractTyCon {}              -> []
+    IfDataFamTyCon  {}              -> []
     IfDataTyCon cons is_over labels -> map (help cons  is_over) labels
     IfNewTyCon  con  is_over labels -> map (help [con] is_over) labels
   where
@@ -366,15 +368,35 @@ ifaceDeclImplicitBndrs :: IfaceDecl -> [OccName]
 -- TyThing.getOccName should define a bijection between the two lists.
 -- This invariant is used in LoadIface.loadDecl (see note [Tricky iface loop])
 -- The order of the list does not matter.
-
-ifaceDeclImplicitBndrs (IfaceData {ifName = tc_occ, ifCons = cons })
-  = case cons of
-      IfAbstractTyCon {}  -> []
-      IfNewTyCon  cd  _ _ -> mkNewTyCoOcc tc_occ : ifaceConDeclImplicitBndrs cd
-      IfDataTyCon cds _ _ -> concatMap ifaceConDeclImplicitBndrs cds
-
-ifaceDeclImplicitBndrs (IfaceClass { ifCtxt = sc_ctxt, ifName = cls_tc_occ
-                                   , ifSigs = sigs, ifATs = ats })
+ifaceDeclImplicitBndrs IfaceData {ifCons = IfAbstractTyCon {}}  = []
+
+-- Newtype
+ifaceDeclImplicitBndrs (IfaceData {ifName = tc_occ,
+                              ifCons = IfNewTyCon (IfCon { ifConOcc = con_occ }) _ _})
+  =   -- implicit newtype coercion
+    (mkNewTyCoOcc tc_occ) : -- JPM: newtype coercions shouldn't be implicit
+      -- data constructor and worker (newtypes don't have a wrapper)
+    [con_occ, mkDataConWorkerOcc con_occ]
+
+
+ifaceDeclImplicitBndrs (IfaceData {ifName = _tc_occ,
+                              ifCons = IfDataTyCon cons _ _ })
+  = -- for each data constructor in order,
+    --    data constructor, worker, and (possibly) wrapper
+    concatMap dc_occs cons
+  where
+    dc_occs con_decl
+        | has_wrapper = [con_occ, work_occ, wrap_occ]
+        | otherwise   = [con_occ, work_occ]
+        where
+          con_occ  = ifConOcc con_decl            -- DataCon namespace
+          wrap_occ = mkDataConWrapperOcc con_occ  -- Id namespace
+          work_occ = mkDataConWorkerOcc con_occ   -- Id namespace
+          has_wrapper = ifConWrapper con_decl     -- This is the reason for
+                                                  -- having the ifConWrapper field!
+
+ifaceDeclImplicitBndrs (IfaceClass {ifCtxt = sc_ctxt, ifName = cls_tc_occ,
+                               ifSigs = sigs, ifATs = ats })
   = --   (possibly) newtype coercion
     co_occs ++
     --    data constructor (DataCon namespace)
@@ -398,14 +420,6 @@ ifaceDeclImplicitBndrs (IfaceClass { ifCtxt = sc_ctxt, ifName = cls_tc_occ
 
 ifaceDeclImplicitBndrs _ = []
 
-ifaceConDeclImplicitBndrs :: IfaceConDecl -> [OccName]
-ifaceConDeclImplicitBndrs (IfCon { ifConWrapper = has_wrapper, ifConOcc = con_occ })
-  = [con_occ, work_occ] ++ wrap_occs
-  where
-    work_occ  = mkDataConWorkerOcc con_occ                   -- Id namespace
-    wrap_occs | has_wrapper = [mkDataConWrapperOcc con_occ]  -- Id namespace
-              | otherwise   = []
-
 -- -----------------------------------------------------------------------------
 -- The fingerprints of an IfaceDecl
 
@@ -671,6 +685,7 @@ pprIfaceDecl ss (IfaceData { ifName = tycon, ifCType = ctype,
 
     pp_nd = case condecls of
               IfAbstractTyCon d -> ptext (sLit "abstract") <> ppShowIface ss (parens (ppr d))
+              IfDataFamTyCon    -> ptext (sLit "data family")
               IfDataTyCon{}     -> ptext (sLit "data")
               IfNewTyCon{}      -> ptext (sLit "newtype")
 
@@ -679,7 +694,6 @@ pprIfaceDecl ss (IfaceData { ifName = tycon, ifCType = ctype,
     pp_prom | is_prom   = ptext (sLit "Promotable")
             | otherwise = Outputable.empty
 
-
 pprIfaceDecl ss (IfaceClass { ifATs = ats, ifSigs = sigs, ifRec = isrec
                             , ifCtxt   = context, ifName  = clas
                             , ifTyVars = tyvars,  ifRoles = roles
@@ -724,12 +738,7 @@ pprIfaceDecl ss (IfaceSynonym { ifName   = tc
 pprIfaceDecl ss (IfaceFamily { ifName = tycon, ifTyVars = tyvars
                              , ifFamFlav = rhs, ifFamKind = kind
                              , ifResVar = res_var, ifFamInj = inj })
-  | IfaceDataFamilyTyCon <- rhs
-  = ptext (sLit "data family") <+> pprIfaceDeclHead [] ss tycon tyvars
-
-  | otherwise
-  = vcat [ hang (ptext (sLit "type family")
-                 <+> pprIfaceDeclHead [] ss tycon tyvars)
+  = vcat [ hang (text "type family" <+> pprIfaceDeclHead [] ss tycon tyvars)
               2 (pp_inj res_var inj <+> ppShowRhs ss (pp_rhs rhs))
          , ppShowRhs ss (nest 2 (pp_branches rhs)) ]
   where
@@ -743,13 +752,11 @@ pprIfaceDecl ss (IfaceFamily { ifName = tycon, ifTyVars = tyvars
        []  -> empty
        tvs -> hsep [text "|", ppr res, text "->", interppSP (map fst tvs)]
 
-    pp_rhs IfaceDataFamilyTyCon
-      = ppShowIface ss (ptext (sLit "data"))
     pp_rhs IfaceOpenSynFamilyTyCon
       = ppShowIface ss (ptext (sLit "open"))
     pp_rhs IfaceAbstractClosedSynFamilyTyCon
       = ppShowIface ss (ptext (sLit "closed, abstract"))
-    pp_rhs (IfaceClosedSynFamilyTyCon {})
+    pp_rhs (IfaceClosedSynFamilyTyCon _)
       = ptext (sLit "where")
     pp_rhs IfaceBuiltInSynFamTyCon
       = ppShowIface ss (ptext (sLit "built-in"))
@@ -1163,13 +1170,12 @@ freeNamesIfIdDetails _                 = emptyNameSet
 
 -- All other changes are handled via the version info on the tycon
 freeNamesIfFamFlav :: IfaceFamTyConFlav -> NameSet
-freeNamesIfFamFlav IfaceOpenSynFamilyTyCon             = emptyNameSet
-freeNamesIfFamFlav IfaceDataFamilyTyCon                = emptyNameSet
+freeNamesIfFamFlav IfaceOpenSynFamilyTyCon           = emptyNameSet
 freeNamesIfFamFlav (IfaceClosedSynFamilyTyCon (Just (ax, br)))
   = unitNameSet ax &&& fnList freeNamesIfAxBranch br
 freeNamesIfFamFlav (IfaceClosedSynFamilyTyCon Nothing) = emptyNameSet
-freeNamesIfFamFlav IfaceAbstractClosedSynFamilyTyCon   = emptyNameSet
-freeNamesIfFamFlav IfaceBuiltInSynFamTyCon             = emptyNameSet
+freeNamesIfFamFlav IfaceAbstractClosedSynFamilyTyCon = emptyNameSet
+freeNamesIfFamFlav IfaceBuiltInSynFamTyCon = emptyNameSet
 
 freeNamesIfContext :: IfaceContext -> NameSet
 freeNamesIfContext = fnList freeNamesIfType
@@ -1520,22 +1526,18 @@ instance Binary IfaceDecl where
             _ -> panic (unwords ["Unknown IfaceDecl tag:", show h])
 
 instance Binary IfaceFamTyConFlav where
-    put_ bh IfaceDataFamilyTyCon              = putByte bh 0
-    put_ bh IfaceOpenSynFamilyTyCon           = putByte bh 1
-    put_ bh (IfaceClosedSynFamilyTyCon mb)    = putByte bh 2 >> put_ bh mb
-    put_ bh IfaceAbstractClosedSynFamilyTyCon = putByte bh 3
+    put_ bh IfaceOpenSynFamilyTyCon           = putByte bh 0
+    put_ bh (IfaceClosedSynFamilyTyCon mb)    = putByte bh 1 >> put_ bh mb
+    put_ bh IfaceAbstractClosedSynFamilyTyCon = putByte bh 2
     put_ _ IfaceBuiltInSynFamTyCon
         = pprPanic "Cannot serialize IfaceBuiltInSynFamTyCon, used for pretty-printing only" Outputable.empty
 
     get bh = do { h <- getByte bh
                 ; case h of
-                    0 -> return IfaceDataFamilyTyCon
-                    1 -> return IfaceOpenSynFamilyTyCon
-                    2 -> do { mb <- get bh
+                    0 -> return IfaceOpenSynFamilyTyCon
+                    1 -> do { mb <- get bh
                             ; return (IfaceClosedSynFamilyTyCon mb) }
-                    3 -> return IfaceAbstractClosedSynFamilyTyCon
-                    _ -> pprPanic "Binary.get(IfaceFamTyConFlav): Invalid tag"
-                                  (ppr (fromIntegral h :: Int)) }
+                    _ -> return IfaceAbstractClosedSynFamilyTyCon }
 
 instance Binary IfaceClassOp where
     put_ bh (IfaceClassOp n def ty) = do
@@ -1574,16 +1576,17 @@ instance Binary IfaceAxBranch where
         return (IfaceAxBranch a1 a2 a3 a4 a5)
 
 instance Binary IfaceConDecls where
-    put_ bh (IfAbstractTyCon d)   = putByte bh 0 >> put_ bh d
-    put_ bh (IfDataTyCon cs b fs) = putByte bh 1 >> put_ bh cs >> put_ bh b >> put_ bh fs
-    put_ bh (IfNewTyCon c b fs)   = putByte bh 2 >> put_ bh c >> put_ bh b >> put_ bh fs
+    put_ bh (IfAbstractTyCon d) = putByte bh 0 >> put_ bh d
+    put_ bh IfDataFamTyCon      = putByte bh 1
+    put_ bh (IfDataTyCon cs b fs) = putByte bh 2 >> put_ bh cs >> put_ bh b >> put_ bh fs
+    put_ bh (IfNewTyCon c b fs)   = putByte bh 3 >> put_ bh c >> put_ bh b >> put_ bh fs
     get bh = do
         h <- getByte bh
         case h of
             0 -> liftM IfAbstractTyCon $ get bh
-            1 -> liftM3 IfDataTyCon (get bh) (get bh) (get bh)
-            2 -> liftM3 IfNewTyCon (get bh) (get bh) (get bh)
-            _ -> error "Binary(IfaceConDecls).get: Invalid IfaceConDecls"
+            1 -> return IfDataFamTyCon
+            2 -> liftM3 IfDataTyCon (get bh) (get bh) (get bh)
+            _ -> liftM3 IfNewTyCon (get bh) (get bh) (get bh)
 
 instance Binary IfaceConDecl where
     put_ bh (IfCon a1 a2 a3 a4 a5 a6 a7 a8 a9 a10) = do
diff --git a/compiler/iface/MkIface.hs b/compiler/iface/MkIface.hs
index b7bdc38ae5..df96f6a4af 100644
--- a/compiler/iface/MkIface.hs
+++ b/compiler/iface/MkIface.hs
@@ -1611,7 +1611,7 @@ tyConToIfaceDecl env tycon
                   ifCons    = ifaceConDecls (algTyConRhs tycon) (algTcFields tycon),
                   ifRec     = boolToRecFlag (isRecursiveTyCon tycon),
                   ifGadtSyntax = isGadtSyntaxTyCon tycon,
-                  ifPromotable = isPromotableTyCon tycon,
+                  ifPromotable = isJust (promotableTyCon_maybe tycon),
                   ifParent  = parent })
 
   | otherwise  -- FunTyCon, PrimTyCon, promoted TyCon/DataCon
@@ -1649,14 +1649,16 @@ tyConToIfaceDecl env tycon
             axn  = coAxiomName ax
     to_if_fam_flav (ClosedSynFamilyTyCon Nothing)
       = IfaceClosedSynFamilyTyCon Nothing
-    to_if_fam_flav AbstractClosedSynFamilyTyCon = IfaceAbstractClosedSynFamilyTyCon
-    to_if_fam_flav (DataFamilyTyCon {})         = IfaceDataFamilyTyCon
-    to_if_fam_flav (BuiltInSynFamTyCon {})      = IfaceBuiltInSynFamTyCon
+    to_if_fam_flav AbstractClosedSynFamilyTyCon
+      = IfaceAbstractClosedSynFamilyTyCon
 
+    to_if_fam_flav (BuiltInSynFamTyCon {})
+      = IfaceBuiltInSynFamTyCon
 
 
     ifaceConDecls (NewTyCon { data_con = con })    flds = IfNewTyCon  (ifaceConDecl con) (ifaceOverloaded flds) (ifaceFields flds)
     ifaceConDecls (DataTyCon { data_cons = cons }) flds = IfDataTyCon (map ifaceConDecl cons) (ifaceOverloaded flds) (ifaceFields flds)
+    ifaceConDecls (DataFamilyTyCon {})             _    = IfDataFamTyCon
     ifaceConDecls (TupleTyCon { data_con = con })  _    = IfDataTyCon [ifaceConDecl con] False []
     ifaceConDecls (AbstractTyCon distinct)         _    = IfAbstractTyCon distinct
         -- The AbstractTyCon case happens when a TyCon has been trimmed
diff --git a/compiler/iface/TcIface.hs b/compiler/iface/TcIface.hs
index 80de36e82d..1328b3c002 100644
--- a/compiler/iface/TcIface.hs
+++ b/compiler/iface/TcIface.hs
@@ -297,13 +297,13 @@ What this means is that the implicitTyThings MUST NOT DEPEND on any of
 the forkM stuff.
 -}
 
-tcIfaceDecl :: Bool     -- ^ True <=> discard IdInfo on IfaceId bindings
+tcIfaceDecl :: Bool     -- True <=> discard IdInfo on IfaceId bindings
             -> IfaceDecl
             -> IfL TyThing
-tcIfaceDecl = tc_iface_decl Nothing
+tcIfaceDecl = tc_iface_decl NoParentTyCon
 
-tc_iface_decl :: Maybe Class  -- ^ For associated type/data family declarations
-              -> Bool         -- ^ True <=> discard IdInfo on IfaceId bindings
+tc_iface_decl :: TyConParent    -- For nested declarations
+              -> Bool   -- True <=> discard IdInfo on IfaceId bindings
               -> IfaceDecl
               -> IfL TyThing
 tc_iface_decl _ ignore_prags (IfaceId {ifName = occ_name, ifType = iface_type,
@@ -314,7 +314,7 @@ tc_iface_decl _ ignore_prags (IfaceId {ifName = occ_name, ifType = iface_type,
         ; info <- tcIdInfo ignore_prags name ty info
         ; return (AnId (mkGlobalId details name ty info)) }
 
-tc_iface_decl _ _ (IfaceData {ifName = occ_name,
+tc_iface_decl parent _ (IfaceData {ifName = occ_name,
                           ifCType = cType,
                           ifTyVars = tv_bndrs,
                           ifRoles = roles,
@@ -326,23 +326,22 @@ tc_iface_decl _ _ (IfaceData {ifName = occ_name,
     { tc_name <- lookupIfaceTop occ_name
     ; tycon <- fixM $ \ tycon -> do
             { stupid_theta <- tcIfaceCtxt ctxt
-            ; parent' <- tc_parent tc_name mb_parent
-            ; cons <- tcIfaceDataCons tc_name tycon tyvars rdr_cons is_prom
+            ; parent' <- tc_parent mb_parent
+            ; cons <- tcIfaceDataCons tc_name tycon tyvars rdr_cons
             ; return (buildAlgTyCon tc_name tyvars roles cType stupid_theta
                                     cons is_rec is_prom gadt_syn parent') }
     ; traceIf (text "tcIfaceDecl4" <+> ppr tycon)
     ; return (ATyCon tycon) }
   where
-    tc_parent :: Name -> IfaceTyConParent -> IfL AlgTyConFlav
-    tc_parent tc_name IfNoParent
-      = do { tc_rep_name <- newTyConRepName tc_name
-           ; return (VanillaAlgTyCon tc_rep_name) }
-    tc_parent _ (IfDataInstance ax_name _ arg_tys)
-      = do { ax <- tcIfaceCoAxiom ax_name
+    tc_parent :: IfaceTyConParent -> IfL TyConParent
+    tc_parent IfNoParent = return parent
+    tc_parent (IfDataInstance ax_name _ arg_tys)
+      = ASSERT( isNoParent parent )
+        do { ax <- tcIfaceCoAxiom ax_name
            ; let fam_tc  = coAxiomTyCon ax
                  ax_unbr = toUnbranchedAxiom ax
            ; lhs_tys <- tcIfaceTcArgs arg_tys
-           ; return (DataFamInstTyCon ax_unbr fam_tc lhs_tys) }
+           ; return (FamInstTyCon ax_unbr fam_tc lhs_tys) }
 
 tc_iface_decl _ _ (IfaceSynonym {ifName = occ_name, ifTyVars = tv_bndrs,
                                       ifRoles = roles,
@@ -366,25 +365,20 @@ tc_iface_decl parent _ (IfaceFamily {ifName = occ_name, ifTyVars = tv_bndrs,
      { tc_name  <- lookupIfaceTop occ_name
      ; rhs_kind <- tcIfaceKind kind     -- Note [Synonym kind loop]
      ; rhs      <- forkM (mk_doc tc_name) $
-                   tc_fam_flav tc_name fam_flav
+                   tc_fam_flav fam_flav
      ; res_name <- traverse (newIfaceName . mkTyVarOccFS) res
      ; let tycon = buildFamilyTyCon tc_name tyvars res_name rhs rhs_kind
                                     parent inj
      ; return (ATyCon tycon) }
    where
      mk_doc n = ptext (sLit "Type synonym") <+> ppr n
-
-     tc_fam_flav :: Name -> IfaceFamTyConFlav -> IfL FamTyConFlav
-     tc_fam_flav tc_name IfaceDataFamilyTyCon
-       = do { tc_rep_name <- newTyConRepName tc_name
-            ; return (DataFamilyTyCon tc_rep_name) }
-     tc_fam_flav _ IfaceOpenSynFamilyTyCon= return OpenSynFamilyTyCon
-     tc_fam_flav _ (IfaceClosedSynFamilyTyCon mb_ax_name_branches)
+     tc_fam_flav IfaceOpenSynFamilyTyCon   = return OpenSynFamilyTyCon
+     tc_fam_flav (IfaceClosedSynFamilyTyCon mb_ax_name_branches)
        = do { ax <- traverse (tcIfaceCoAxiom . fst) mb_ax_name_branches
             ; return (ClosedSynFamilyTyCon ax) }
-     tc_fam_flav _ IfaceAbstractClosedSynFamilyTyCon
+     tc_fam_flav IfaceAbstractClosedSynFamilyTyCon
          = return AbstractClosedSynFamilyTyCon
-     tc_fam_flav _ IfaceBuiltInSynFamTyCon
+     tc_fam_flav IfaceBuiltInSynFamTyCon
          = pprPanic "tc_iface_decl"
                     (text "IfaceBuiltInSynFamTyCon in interface file")
 
@@ -428,7 +422,7 @@ tc_iface_decl _parent ignore_prags
           ; return (op_name, dm, op_ty) }
 
    tc_at cls (IfaceAT tc_decl if_def)
-     = do ATyCon tc <- tc_iface_decl (Just cls) ignore_prags tc_decl
+     = do ATyCon tc <- tc_iface_decl (AssocFamilyTyCon cls) ignore_prags tc_decl
           mb_def <- case if_def of
                       Nothing  -> return Nothing
                       Just def -> forkM (mk_at_doc tc)                 $
@@ -512,10 +506,11 @@ tc_ax_branch prev_branches
                           , cab_incomps = map (prev_branches !!) incomps }
     ; return (prev_branches ++ [br]) }
 
-tcIfaceDataCons :: Name -> TyCon -> [TyVar] -> IfaceConDecls -> Bool -> IfL AlgTyConRhs
-tcIfaceDataCons tycon_name tycon tc_tyvars if_cons is_prom
+tcIfaceDataCons :: Name -> TyCon -> [TyVar] -> IfaceConDecls -> IfL AlgTyConRhs
+tcIfaceDataCons tycon_name tycon tc_tyvars if_cons
   = case if_cons of
         IfAbstractTyCon dis -> return (AbstractTyCon dis)
+        IfDataFamTyCon  -> return DataFamilyTyCon
         IfDataTyCon cons _ _ -> do  { field_lbls <- mapM (traverse lookupIfaceTop) (ifaceConDeclFields if_cons)
                                     ; data_cons  <- mapM (tc_con_decl field_lbls) cons
                                     ; return (mkDataTyConRhs data_cons) }
@@ -533,14 +528,14 @@ tcIfaceDataCons tycon_name tycon tc_tyvars if_cons is_prom
        -- parent TyCon, and are alrady in scope
        bindIfaceTyVars ex_tvs    $ \ ex_tyvars -> do
         { traceIf (text "Start interface-file tc_con_decl" <+> ppr occ)
-        ; dc_name  <- lookupIfaceTop occ
+        ; name  <- lookupIfaceTop occ
 
         -- Read the context and argument types, but lazily for two reasons
         -- (a) to avoid looking tugging on a recursive use of
         --     the type itself, which is knot-tied
         -- (b) to avoid faulting in the component types unless
         --     they are really needed
-        ; ~(eq_spec, theta, arg_tys, stricts) <- forkM (mk_doc dc_name) $
+        ; ~(eq_spec, theta, arg_tys, stricts) <- forkM (mk_doc name) $
              do { eq_spec <- tcIfaceEqSpec spec
                 ; theta   <- tcIfaceCtxt ctxt
                 ; arg_tys <- mapM tcIfaceType args
@@ -560,24 +555,20 @@ tcIfaceDataCons tycon_name tycon tc_tyvars if_cons is_prom
         ; let orig_res_ty = mkFamilyTyConApp tycon
                                 (substTyVars (mkTopTvSubst eq_spec) tc_tyvars)
 
-        ; prom_info <- if is_prom then do { n <- newTyConRepName dc_name
-                                          ; return (Promoted n) }
-                                  else return NotPromoted
-
-        ; con <- buildDataCon (pprPanic "tcIfaceDataCons: FamInstEnvs" (ppr dc_name))
-                       dc_name is_infix prom_info
-                       (map src_strict if_src_stricts)
-                       (Just stricts)
-                       -- Pass the HsImplBangs (i.e. final
-                       -- decisions) to buildDataCon; it'll use
-                       -- these to guide the construction of a
-                       -- worker.
-                       -- See Note [Bangs on imported data constructors] in MkId
-                       lbl_names
-                       tc_tyvars ex_tyvars
-                       eq_spec theta
-                       arg_tys orig_res_ty tycon
-        ; traceIf (text "Done interface-file tc_con_decl" <+> ppr dc_name)
+        ; con <- buildDataCon (pprPanic "tcIfaceDataCons: FamInstEnvs" (ppr name))
+                   name is_infix
+                   (map src_strict if_src_stricts)
+                   (Just stricts)
+                     -- Pass the HsImplBangs (i.e. final
+                     -- decisions) to buildDataCon; it'll use
+                     -- these to guide the construction of a
+                     -- worker.
+                     -- See Note [Bangs on imported data constructors] in MkId
+                   lbl_names
+                   tc_tyvars ex_tyvars
+                   eq_spec theta
+                   arg_tys orig_res_ty tycon
+        ; traceIf (text "Done interface-file tc_con_decl" <+> ppr name)
         ; return con }
     mk_doc con_name = ptext (sLit "Constructor") <+> ppr con_name
 
@@ -898,7 +889,7 @@ tcIfaceTupleTy sort info args
             -> return (mkTyConApp base_tc args')
 
           IfacePromotedTyCon
-            | Promoted tc <- promotableTyCon_maybe base_tc
+            | Just tc <- promotableTyCon_maybe base_tc
             -> return (mkTyConApp tc args')
             | otherwise
             -> panic "tcIfaceTupleTy" (ppr base_tc)
@@ -1375,7 +1366,7 @@ tcIfaceTyCon (IfaceTyCon name info)
                                    -- Same Name as its underlying TyCon
   where
     promote_tc tc
-      | Promoted prom_tc <- promotableTyCon_maybe tc = prom_tc
+      | Just prom_tc <- promotableTyCon_maybe tc = prom_tc
       | isSuperKind (tyConKind tc)               = tc
       | otherwise = pprPanic "tcIfaceTyCon" (ppr name $$ ppr tc)
 
diff --git a/compiler/main/HscMain.hs b/compiler/main/HscMain.hs
index 95cb5f222f..64143e0c03 100644
--- a/compiler/main/HscMain.hs
+++ b/compiler/main/HscMain.hs
@@ -94,11 +94,9 @@ import BasicTypes       ( HValue )
 import ByteCodeGen      ( byteCodeGen, coreExprToBCOs )
 import Linker
 import CoreTidy         ( tidyExpr )
-import Type             ( Type )
-import {- Kind parts of -} Type         ( Kind )
+import Type             ( Type, Kind )
 import CoreLint         ( lintInteractiveExpr )
 import VarEnv           ( emptyTidyEnv )
-import THNames          ( templateHaskellNames )
 import ConLike
 
 import GHC.Exts
@@ -183,7 +181,7 @@ newHscEnv :: DynFlags -> IO HscEnv
 newHscEnv dflags = do
     eps_var <- newIORef initExternalPackageState
     us      <- mkSplitUniqSupply 'r'
-    nc_var  <- newIORef (initNameCache us allKnownKeyNames)
+    nc_var  <- newIORef (initNameCache us knownKeyNames)
     fc_var  <- newIORef emptyModuleEnv
     return HscEnv {  hsc_dflags       = dflags,
                      hsc_targets      = [],
@@ -196,13 +194,6 @@ newHscEnv dflags = do
                      hsc_type_env_var = Nothing }
 
 
-allKnownKeyNames :: [Name]      -- Put here to avoid loops involving DsMeta,
-allKnownKeyNames =              -- where templateHaskellNames are defined
-    knownKeyNames
-#ifdef GHCI
-        ++ templateHaskellNames
-#endif
-
 -- -----------------------------------------------------------------------------
 
 getWarnings :: Hsc WarningMessages
diff --git a/compiler/main/HscTypes.hs b/compiler/main/HscTypes.hs
index b711ffea51..fb65a67e6e 100644
--- a/compiler/main/HscTypes.hs
+++ b/compiler/main/HscTypes.hs
@@ -1689,8 +1689,8 @@ implicitTyThings (AConLike cl)  = implicitConLikeThings cl
 
 implicitConLikeThings :: ConLike -> [TyThing]
 implicitConLikeThings (RealDataCon dc)
-  = dataConImplicitTyThings dc
-
+  = map AnId (dataConImplicitIds dc)
+    -- For data cons add the worker and (possibly) wrapper
 implicitConLikeThings (PatSynCon {})
   = []  -- Pattern synonyms have no implicit Ids; the wrapper and matcher
         -- are not "implicit"; they are simply new top-level bindings,
@@ -1705,7 +1705,7 @@ implicitClassThings cl
   = -- Does not include default methods, because those Ids may have
     --    their own pragmas, unfoldings etc, not derived from the Class object
     -- associated types
-    --    No recursive call for the classATs, because they
+    --    No extras_plus (recursive call) for the classATs, because they
     --    are only the family decls; they have no implicit things
     map ATyCon (classATs cl) ++
     -- superclass and operation selectors
@@ -1721,8 +1721,7 @@ implicitTyConThings tc
 
       -- for each data constructor in order,
       --   the contructor, worker, and (possibly) wrapper
-    [ thing | dc    <- tyConDataCons tc
-            , thing <- AConLike (RealDataCon dc) : dataConImplicitTyThings dc ]
+    concatMap (extras_plus . AConLike . RealDataCon) (tyConDataCons tc)
       -- NB. record selectors are *not* implicit, they have fully-fledged
       -- bindings that pass through the compilation pipeline as normal.
   where
@@ -1730,6 +1729,10 @@ implicitTyConThings tc
         Nothing -> []
         Just cl -> implicitClassThings cl
 
+-- add a thing and recursive call
+extras_plus :: TyThing -> [TyThing]
+extras_plus thing = thing : implicitTyThings thing
+
 -- For newtypes and closed type families (only) add the implicit coercion tycon
 implicitCoTyCon :: TyCon -> [TyThing]
 implicitCoTyCon tc
diff --git a/compiler/prelude/PrelInfo.hs b/compiler/prelude/PrelInfo.hs
index f76b62ee00..f79b6b1e7f 100644
--- a/compiler/prelude/PrelInfo.hs
+++ b/compiler/prelude/PrelInfo.hs
@@ -10,7 +10,7 @@ module PrelInfo (
         primOpRules, builtinRules,
 
         ghcPrimExports,
-        knownKeyNames,
+        wiredInThings, knownKeyNames,
         primOpId,
 
         -- Random other things
@@ -23,31 +23,56 @@ 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
+    ]
+
+{- *********************************************************************
 *                                                                      *
-\subsection[builtinNameInfo]{Lookup built-in names}
+                Wired in things
 *                                                                      *
 ************************************************************************
 
@@ -62,61 +87,33 @@ Notes about wired in things
 
 * The name cache is initialised with (the names of) all 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.
+* 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.
 
 * MkIface prunes out wired-in things before putting them in an interface file.
   So interface files never contain wired-in things.
 -}
 
-
-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 ]
+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
+    ]
   where
-    -- "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 -> []
+    tycon_things = map ATyCon ([funTyCon] ++ primTyCons ++ wiredInTyCons
+                                    ++ typeNatTyCons)
 
 {-
 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 05a38ffec9..30d11fef59 100644
--- a/compiler/prelude/PrelNames.hs
+++ b/compiler/prelude/PrelNames.hs
@@ -206,13 +206,11 @@ basicKnownKeyNames
         -- Typeable
         typeableClassName,
         typeRepTyConName,
-        trTyConDataConName,
-        trModuleDataConName,
-        trNameSDataConName,
-        typeRepIdName,
+        mkTyConName,
         mkPolyTyConAppName,
         mkAppTyName,
-        typeSymbolTypeRepName, typeNatTypeRepName,
+        typeNatTypeRepName,
+        typeSymbolTypeRepName,
 
         -- Dynamic
         toDynName,
@@ -228,6 +226,7 @@ basicKnownKeyNames
         fromIntegralName, realToFracName,
 
         -- String stuff
+        stringTyConName,
         fromStringName,
 
         -- Enum stuff
@@ -608,8 +607,7 @@ toInteger_RDR           = nameRdrName toIntegerName
 toRational_RDR          = nameRdrName toRationalName
 fromIntegral_RDR        = nameRdrName fromIntegralName
 
-stringTy_RDR, fromString_RDR :: RdrName
-stringTy_RDR            = tcQual_RDR gHC_BASE (fsLit "String")
+fromString_RDR :: RdrName
 fromString_RDR          = nameRdrName fromStringName
 
 fromList_RDR, fromListN_RDR, toList_RDR :: RdrName
@@ -670,6 +668,11 @@ 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")
 
@@ -779,39 +782,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
-
--- | 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")
 
@@ -879,11 +849,12 @@ uWordTyConName     = tcQual gHC_GENERICS (fsLit "UWord") uWordTyConKey
 
 -- Base strings Strings
 unpackCStringName, unpackCStringFoldrName,
-    unpackCStringUtf8Name, eqStringName :: Name
+    unpackCStringUtf8Name, eqStringName, stringTyConName :: 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
@@ -1082,21 +1053,15 @@ ixClassName = clsQual gHC_ARR (fsLit "Ix") ixClassKey
 -- Class Typeable, and functions for constructing `Typeable` dictionaries
 typeableClassName
   , typeRepTyConName
-  , trTyConDataConName
-  , trModuleDataConName
-  , trNameSDataConName
+  , mkTyConName
   , mkPolyTyConAppName
   , mkAppTyName
-  , typeRepIdName
   , typeNatTypeRepName
   , typeSymbolTypeRepName
   :: 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
+mkTyConName           = varQual tYPEABLE_INTERNAL (fsLit "mkTyCon")        mkTyConKey
 mkPolyTyConAppName    = varQual tYPEABLE_INTERNAL (fsLit "mkPolyTyConApp") mkPolyTyConAppKey
 mkAppTyName           = varQual tYPEABLE_INTERNAL (fsLit "mkAppTy")        mkAppTyKey
 typeNatTypeRepName    = varQual tYPEABLE_INTERNAL (fsLit "typeNatTypeRep") typeNatTypeRepKey
@@ -1377,7 +1342,7 @@ ghciIoClassKey :: Unique
 ghciIoClassKey = mkPreludeClassUnique 44
 
 ---------------- Template Haskell -------------------
---      THNames.hs: USES ClassUniques 200-299
+--      USES ClassUniques 200-299
 -----------------------------------------------------
 
 {-
@@ -1524,6 +1489,9 @@ 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,
@@ -1621,7 +1589,7 @@ ipCoNameKey = mkPreludeTyConUnique 185
 
 
 ---------------- Template Haskell -------------------
---      THNames.hs: USES TyConUniques 200-299
+--      USES TyConUniques 200-299
 -----------------------------------------------------
 
 ----------------------- SIMD ------------------------
@@ -1700,16 +1668,6 @@ 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
------------------------------------------------------
-
-
 {-
 ************************************************************************
 *                                                                      *
@@ -1964,7 +1922,7 @@ proxyHashKey :: Unique
 proxyHashKey = mkPreludeMiscIdUnique 502
 
 ---------------- Template Haskell -------------------
---      THNames.hs: USES IdUniques 200-499
+--      USES IdUniques 200-499
 -----------------------------------------------------
 
 -- Used to make `Typeable` dictionaries
@@ -1973,21 +1931,19 @@ 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 509
+toDynIdKey = mkPreludeMiscIdUnique 508
 
 bitIntegerIdKey :: Unique
-bitIntegerIdKey       = mkPreludeMiscIdUnique 510
+bitIntegerIdKey       = mkPreludeMiscIdUnique 509
 
 {-
 ************************************************************************
diff --git a/compiler/prelude/THNames.hs b/compiler/prelude/THNames.hs
index 571487a274..062f9577e7 100644
--- a/compiler/prelude/THNames.hs
+++ b/compiler/prelude/THNames.hs
@@ -448,6 +448,23 @@ 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
@@ -506,42 +523,12 @@ 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
 
@@ -587,43 +574,6 @@ 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
 
@@ -893,6 +843,27 @@ 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 3a6dd0341e..d66b48e3b7 100644
--- a/compiler/prelude/TysPrim.hs
+++ b/compiler/prelude/TysPrim.hs
@@ -10,8 +10,6 @@
 -- | 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,
@@ -83,11 +81,12 @@ module TysPrim(
 #include "HsVersions.h"
 
 import Var              ( TyVar, KindVar, mkTyVar )
-import Name
+import Name             ( Name, BuiltInSyntax(..), mkInternalName, mkWiredInName )
+import OccName          ( mkTyVarOccFS, mkTcOccFS )
 import TyCon
 import TypeRep
 import SrcLoc
-import Unique
+import Unique           ( mkAlphaTyVarUnique )
 import PrelNames
 import FastString
 
@@ -259,9 +258,8 @@ funTyConName :: Name
 funTyConName = mkPrimTyConName (fsLit "(->)") funTyConKey funTyCon
 
 funTyCon :: TyCon
-funTyCon = mkFunTyCon funTyConName kind tc_rep_nm
-  where
-    kind = mkArrowKinds [liftedTypeKind, liftedTypeKind] liftedTypeKind
+funTyCon = mkFunTyCon funTyConName $
+           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 (->)
@@ -271,8 +269,6 @@ 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
-
 -- One step to remove subkinding.
 -- (->) :: * -> * -> *
 -- but we should have (and want) the following typing rule for fully applied arrows
@@ -322,21 +318,14 @@ superKindTyConName, anyKindTyConName, liftedTypeKindTyConName,
       constraintKindTyConName
    :: Name
 
-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)]
+superKindTyCon        = mkKindTyCon superKindTyConName        superKind
+   -- See Note [SuperKind (BOX)]
 
-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")
+anyKindTyCon          = mkKindTyCon anyKindTyConName          superKind
+liftedTypeKindTyCon   = mkKindTyCon liftedTypeKindTyConName   superKind
+openTypeKindTyCon     = mkKindTyCon openTypeKindTyConName     superKind
+unliftedTypeKindTyCon = mkKindTyCon unliftedTypeKindTyConName superKind
+constraintKindTyCon   = mkKindTyCon constraintKindTyConName   superKind
 
 --------------------------
 -- ... and now their names
@@ -747,7 +736,6 @@ 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 = ....
@@ -788,7 +776,7 @@ anyTy = mkTyConTy anyTyCon
 anyTyCon :: TyCon
 anyTyCon = mkFamilyTyCon anyTyConName kind [kKiVar] Nothing
                          (ClosedSynFamilyTyCon Nothing)
-                         Nothing
+                         NoParentTyCon
                          NotInjective
   where
     kind = ForAllTy kKiVar (mkTyVarTy kKiVar)
diff --git a/compiler/prelude/TysWiredIn.hs b/compiler/prelude/TysWiredIn.hs
index 067700f120..e8a06e7ad4 100644
--- a/compiler/prelude/TysWiredIn.hs
+++ b/compiler/prelude/TysWiredIn.hs
@@ -99,7 +99,6 @@ import TysPrim
 -- others:
 import CoAxiom
 import Coercion
-import Id
 import Constants        ( mAX_TUPLE_SIZE, mAX_CTUPLE_SIZE )
 import Module           ( Module )
 import Type             ( mkTyConApp )
@@ -290,7 +289,7 @@ pcTyCon is_enum is_rec is_prom name cType tyvars cons
         is_rec
         is_prom
         False           -- Not in GADT syntax
-        (VanillaAlgTyCon (mkPrelTyConRepName name))
+        NoParentTyCon
 
 pcDataCon :: Name -> [TyVar] -> [Type] -> TyCon -> DataCon
 pcDataCon = pcDataConWithFixity False
@@ -311,7 +310,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 prom_info
+    data_con = mkDataCon dc_name declared_infix
                 (map (const no_bang) arg_tys)
                 []      -- No labelled fields
                 tyvars
@@ -328,16 +327,10 @@ pcDataConWithFixity' declared_infix dc_name wrk_key tyvars arg_tys tycon
 
     modu     = ASSERT( isExternalName dc_name )
                nameModule dc_name
-    dc_occ   = nameOccName dc_name
-    wrk_occ  = mkDataConWorkerOcc dc_occ
+    wrk_occ  = mkDataConWorkerOcc (nameOccName dc_name)
     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
-
 {-
 ************************************************************************
 *                                                                      *
@@ -505,19 +498,15 @@ mk_tuple boxity arity = (tycon, tuple_con)
   where
         tycon   = mkTupleTyCon tc_name tc_kind arity tyvars tuple_con
                                tup_sort
-                               prom_tc flavour
-
-        flavour = case boxity of
-                    Boxed   -> VanillaAlgTyCon (mkPrelTyConRepName tc_name)
-                    Unboxed -> UnboxedAlgTyCon
+                               prom_tc NoParentTyCon
 
         tup_sort = case boxity of
                       Boxed   -> BoxedTuple
                       Unboxed -> UnboxedTuple
 
         prom_tc = case boxity of
-                    Boxed   -> Promoted (mkPromotedTyCon tycon (promoteKind tc_kind))
-                    Unboxed -> NotPromoted
+                    Boxed   -> Just (mkPromotedTyCon tycon (promoteKind tc_kind))
+                    Unboxed -> Nothing
 
         modu = case boxity of
                     Boxed -> gHC_TUPLE
@@ -743,11 +732,8 @@ mkListTy :: Type -> Type
 mkListTy ty = mkTyConApp listTyCon [ty]
 
 listTyCon :: TyCon
-listTyCon = buildAlgTyCon listTyConName alpha_tyvar [Representational]
-                          Nothing []
-                          (DataTyCon [nilDataCon, consDataCon] False )
-                          Recursive True False
-                          (VanillaAlgTyCon (mkSpecialTyConRepName (fsLit "tcList") listTyConName))
+listTyCon = pcTyCon False Recursive True
+                    listTyConName Nothing alpha_tyvar [nilDataCon, consDataCon]
 
 mkPromotedListTy :: Type -> Type
 mkPromotedListTy ty = mkTyConApp promotedListTyCon [ty]
@@ -944,10 +930,10 @@ eqTyCon = mkAlgTyCon eqTyConName
             Nothing
             []      -- No stupid theta
             (DataTyCon [eqBoxDataCon] False)
-            (VanillaAlgTyCon (mkSpecialTyConRepName (fsLit "tcEq") eqTyConName))
+            NoParentTyCon
             NonRecursive
             False
-            NotPromoted
+            Nothing   -- No parent for constraint-kinded types
   where
     kv = kKiVar
     k = mkTyVarTy kv
@@ -963,17 +949,15 @@ eqBoxDataCon = pcDataCon eqBoxDataConName args [TyConApp eqPrimTyCon (map mkTyVa
 
 
 coercibleTyCon :: TyCon
-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
+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
 
 coercibleDataCon :: DataCon
 coercibleDataCon = pcDataCon coercibleDataConName args [TyConApp eqReprPrimTyCon (map mkTyVarTy args)] coercibleTyCon
@@ -1010,7 +994,6 @@ 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]
diff --git a/compiler/simplCore/FloatIn.hs b/compiler/simplCore/FloatIn.hs
index 412125ae3e..5390c48dd3 100644
--- a/compiler/simplCore/FloatIn.hs
+++ b/compiler/simplCore/FloatIn.hs
@@ -25,7 +25,7 @@ import CoreUtils        ( exprIsDupable, exprIsExpandable, exprType,
 import CoreFVs          ( CoreExprWithFVs, freeVars, freeVarsOf, idRuleAndUnfoldingVars )
 import Id               ( isOneShotBndr, idType )
 import Var
-import Type             ( Type, isUnLiftedType, isFunTy, splitFunTy, applyTy )
+import Type             ( Type, isUnLiftedType, splitFunTy, applyTy )
 import VarSet
 import Util
 import UniqFM
@@ -168,7 +168,7 @@ fiExpr dflags to_drop ann_expr@(_,AnnApp {})
       = ((applyTy fun_ty ty, extra_fvs), emptyVarSet)
 
     mk_arg_fvs (fun_ty, extra_fvs) (arg_fvs, ann_arg)
-      | ASSERT( isFunTy fun_ty ) noFloatIntoRhs ann_arg arg_ty
+      | noFloatIntoRhs ann_arg arg_ty
       = ((res_ty, extra_fvs `unionVarSet` arg_fvs), emptyVarSet)
       | otherwise
       = ((res_ty, extra_fvs), arg_fvs)
diff --git a/compiler/typecheck/TcBinds.hs b/compiler/typecheck/TcBinds.hs
index d8c0350096..217739201b 100644
--- a/compiler/typecheck/TcBinds.hs
+++ b/compiler/typecheck/TcBinds.hs
@@ -8,9 +8,9 @@
 {-# LANGUAGE CPP, RankNTypes, ScopedTypeVariables #-}
 
 module TcBinds ( tcLocalBinds, tcTopBinds, tcRecSelBinds,
-                 tcValBinds, tcHsBootSigs, tcPolyCheck,
+                 tcHsBootSigs, tcPolyCheck,
                  tcSpecPrags, tcSpecWrapper,
-                 tcVectDecls, addTypecheckedBinds,
+                 tcVectDecls,
                  TcSigInfo(..), TcSigFun,
                  TcPragEnv, mkPragEnv,
                  instTcTySig, instTcTySigFromId, findScopedTyVars,
@@ -66,21 +66,6 @@ import Data.List (partition)
 
 #include "HsVersions.h"
 
-{- *********************************************************************
-*                                                                      *
-               A useful helper function
-*                                                                      *
-********************************************************************* -}
-
-addTypecheckedBinds :: TcGblEnv -> [LHsBinds Id] -> TcGblEnv
-addTypecheckedBinds tcg_env binds
-  | isHsBoot (tcg_src tcg_env) = tcg_env
-    -- Do not add the code for record-selector bindings
-    -- when compiling hs-boot files
-  | otherwise = tcg_env { tcg_binds = foldr unionBags
-                                            (tcg_binds tcg_env)
-                                            binds }
-
 {-
 ************************************************************************
 *                                                                      *
@@ -184,8 +169,10 @@ tcTopBinds (ValBindsOut binds sigs)
                ; return (gbl, lcl) }
         ; specs <- tcImpPrags sigs   -- SPECIALISE prags for imported Ids
 
-        ; let { tcg_env' = tcg_env { tcg_imp_specs = specs ++ tcg_imp_specs tcg_env }
-                           `addTypecheckedBinds` map snd binds' }
+        ; let { tcg_env' = tcg_env { tcg_binds = foldr (unionBags . snd)
+                                                       (tcg_binds tcg_env)
+                                                       binds'
+                                   , tcg_imp_specs = specs ++ tcg_imp_specs tcg_env } }
 
         ; return (tcg_env', tcl_env) }
         -- The top level bindings are flattened into a giant
@@ -195,17 +182,15 @@ tcTopBinds (ValBindsIn {}) = panic "tcTopBinds"
 
 tcRecSelBinds :: HsValBinds Name -> TcM TcGblEnv
 tcRecSelBinds (ValBindsOut binds sigs)
-  = -- tcExtendGlobalValEnv [sel_id | L _ (IdSig sel_id) <- sigs] $
-    -- this envt extension happens in tcValBinds
-    do { (rec_sel_binds, tcg_env) <- discardWarnings $
-                                     tcValBinds TopLevel binds sigs getGblEnv
+  = tcExtendGlobalValEnv [sel_id | L _ (IdSig sel_id) <- sigs] $
+    do { (rec_sel_binds, tcg_env) <- discardWarnings (tcValBinds TopLevel binds sigs getGblEnv)
        ; let tcg_env'
               | isHsBoot (tcg_src tcg_env) = tcg_env
               | otherwise = tcg_env { tcg_binds = foldr (unionBags . snd)
                                                         (tcg_binds tcg_env)
                                                         rec_sel_binds }
-              -- Do not add the code for record-selector bindings
-              -- when compiling hs-boot files
+              -- Do not add the code for record-selector bindings when
+              -- compiling hs-boot files
        ; return tcg_env' }
 tcRecSelBinds (ValBindsIn {}) = panic "tcRecSelBinds"
 
diff --git a/compiler/typecheck/TcEnv.hs b/compiler/typecheck/TcEnv.hs
index 3bb2703104..5d1c1be3ad 100644
--- a/compiler/typecheck/TcEnv.hs
+++ b/compiler/typecheck/TcEnv.hs
@@ -631,12 +631,13 @@ tcGetDefaultTys
         -- No use-supplied default
         -- Use [Integer, Double], plus modifications
         { integer_ty <- tcMetaTy integerTyConName
-        ; list_ty <- tcMetaTy listTyConName
         ; checkWiredInTyCon doubleTyCon
+        ; string_ty <- tcMetaTy stringTyConName
+        ; list_ty <- tcMetaTy listTyConName
         ; let deflt_tys = opt_deflt extended_defaults [unitTy, list_ty]
                           -- Note [Extended defaults]
                           ++ [integer_ty, doubleTy]
-                          ++ opt_deflt ovl_strings [stringTy]
+                          ++ opt_deflt ovl_strings [string_ty]
         ; return (deflt_tys, flags) } } }
   where
     opt_deflt True  xs = xs
diff --git a/compiler/typecheck/TcEvidence.hs b/compiler/typecheck/TcEvidence.hs
index 1cfa351125..83bbcca1b7 100644
--- a/compiler/typecheck/TcEvidence.hs
+++ b/compiler/typecheck/TcEvidence.hs
@@ -730,27 +730,24 @@ data EvTerm
   | EvLit EvLit       -- Dictionary for KnownNat and KnownSymbol classes.
                       -- Note [KnownNat & KnownSymbol and EvLit]
 
-  | EvCallStack EvCallStack      -- Dictionary for CallStack implicit parameters
+  | EvCallStack EvCallStack -- Dictionary for CallStack implicit parameters
 
-  | EvTypeable Type EvTypeable   -- Dictionary for (Typeable ty)
+  | EvTypeable EvTypeable   -- Dictionary for `Typeable`
 
   deriving( Data.Data, Data.Typeable )
 
 
 -- | Instructions on how to make a 'Typeable' dictionary.
--- See Note [Typeable evidence terms]
 data EvTypeable
-  = EvTypeableTyCon -- ^ Dictionary for @Typeable (T k1..kn)@
+  = EvTypeableTyCon TyCon [Kind]
+    -- ^ Dictionary for concrete type constructors.
 
-  | EvTypeableTyApp EvTerm EvTerm
-    -- ^ Dictionary for @Typeable (s t)@,
-    -- given a dictionaries for @s@ and @t@
+  | EvTypeableTyApp (EvTerm,Type) (EvTerm,Type)
+    -- ^ Dictionary for type applications;  this is used when we have
+    -- a type expression starting with a type variable (e.g., @Typeable (f a)@)
 
-  | EvTypeableTyLit EvTerm
-    -- ^ Dictionary for a type literal,
-    -- e.g. @Typeable "foo"@ or @Typeable 3@
-    -- The 'EvTerm' is evidence of, e.g., @KnownNat 3@
-    -- (see Trac #10348)
+  | EvTypeableTyLit (EvTerm,Type)
+    -- ^ Dictionary for a type literal.
 
   deriving ( Data.Data, Data.Typeable )
 
@@ -772,20 +769,6 @@ data EvCallStack
   deriving( Data.Data, Data.Typeable )
 
 {-
-Note [Typeable evidence terms]
-~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
-The EvTypeable data type looks isomorphic to Type, but the EvTerms
-inside can be EvIds.  Eg
-    f :: forall a. Typeable a => a -> TypeRep
-    f x = typeRep (undefined :: Proxy [a])
-Here for the (Typeable [a]) dictionary passed to typeRep we make
-evidence
-    dl :: Typeable [a] = EvTypeable [a]
-                            (EvTypeableTyApp EvTypeableTyCon (EvId d))
-where
-    d :: Typable a
-is the lambda-bound dictionary passed into f.
-
 Note [Coercion evidence terms]
 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
 A "coercion evidence term" takes one of these forms
@@ -1026,7 +1009,7 @@ evVarsOfTerm (EvCast tm co)       = evVarsOfTerm tm `unionVarSet` coVarsOfTcCo c
 evVarsOfTerm (EvDelayedError _ _) = emptyVarSet
 evVarsOfTerm (EvLit _)            = emptyVarSet
 evVarsOfTerm (EvCallStack cs)     = evVarsOfCallStack cs
-evVarsOfTerm (EvTypeable _ ev)    = evVarsOfTypeable ev
+evVarsOfTerm (EvTypeable ev)      = evVarsOfTypeable ev
 
 evVarsOfTerms :: [EvTerm] -> VarSet
 evVarsOfTerms = mapUnionVarSet evVarsOfTerm
@@ -1040,9 +1023,9 @@ evVarsOfCallStack cs = case cs of
 evVarsOfTypeable :: EvTypeable -> VarSet
 evVarsOfTypeable ev =
   case ev of
-    EvTypeableTyCon       -> emptyVarSet
-    EvTypeableTyApp e1 e2 -> evVarsOfTerms [e1,e2]
-    EvTypeableTyLit e     -> evVarsOfTerm e
+    EvTypeableTyCon _ _    -> emptyVarSet
+    EvTypeableTyApp e1 e2  -> evVarsOfTerms (map fst [e1,e2])
+    EvTypeableTyLit e      -> evVarsOfTerm (fst e)
 
 {-
 ************************************************************************
@@ -1099,16 +1082,16 @@ instance Outputable EvBind where
    -- We cheat a bit and pretend EqVars are CoVars for the purposes of pretty printing
 
 instance Outputable EvTerm where
-  ppr (EvId v)                = ppr v
-  ppr (EvCast v co)           = ppr v <+> (ptext (sLit "`cast`")) <+> pprParendTcCo co
-  ppr (EvCoercion co)         = ptext (sLit "CO") <+> ppr co
-  ppr (EvSuperClass d n)      = ptext (sLit "sc") <> parens (ppr (d,n))
-  ppr (EvDFunApp df tys ts)   = ppr df <+> sep [ char '@' <> ppr tys, ppr ts ]
-  ppr (EvLit l)               = ppr l
-  ppr (EvCallStack cs)        = ppr cs
-  ppr (EvDelayedError ty msg) = ptext (sLit "error")
+  ppr (EvId v)              = ppr v
+  ppr (EvCast v co)         = ppr v <+> (ptext (sLit "`cast`")) <+> pprParendTcCo co
+  ppr (EvCoercion co)       = ptext (sLit "CO") <+> ppr co
+  ppr (EvSuperClass d n)    = ptext (sLit "sc") <> parens (ppr (d,n))
+  ppr (EvDFunApp df tys ts) = ppr df <+> sep [ char '@' <> ppr tys, ppr ts ]
+  ppr (EvLit l)             = ppr l
+  ppr (EvCallStack cs)      = ppr cs
+  ppr (EvDelayedError ty msg) =     ptext (sLit "error")
                                 <+> sep [ char '@' <> ppr ty, ppr msg ]
-  ppr (EvTypeable ty ev)      = ppr ev <+> dcolon <+> ptext (sLit "Typeable") <+> ppr ty
+  ppr (EvTypeable ev)    = ppr ev
 
 instance Outputable EvLit where
   ppr (EvNum n) = integer n
@@ -1123,9 +1106,11 @@ instance Outputable EvCallStack where
     = angleBrackets (ppr (name,loc)) <+> ptext (sLit ":") <+> ppr tm
 
 instance Outputable EvTypeable where
-  ppr EvTypeableTyCon         = ptext (sLit "TC")
-  ppr (EvTypeableTyApp t1 t2) = parens (ppr t1 <+> ppr t2)
-  ppr (EvTypeableTyLit t1)    = ptext (sLit "TyLit") <> ppr t1
+  ppr ev =
+    case ev of
+      EvTypeableTyCon tc ks    -> parens (ppr tc <+> sep (map ppr ks))
+      EvTypeableTyApp t1 t2    -> parens (ppr (fst t1) <+> ppr (fst t2))
+      EvTypeableTyLit x        -> ppr (fst x)
 
 
 ----------------------------------------------------------------------
diff --git a/compiler/typecheck/TcGenGenerics.hs b/compiler/typecheck/TcGenGenerics.hs
index 9a1c506b33..f69c137762 100644
--- a/compiler/typecheck/TcGenGenerics.hs
+++ b/compiler/typecheck/TcGenGenerics.hs
@@ -73,23 +73,23 @@ gen_Generic_binds gk tc metaTyCons mod = do
 
 genGenericMetaTyCons :: TyCon -> TcM (MetaTyCons, BagDerivStuff)
 genGenericMetaTyCons tc =
-  do  let tc_name   = tyConName tc
-      ty_rep_name <- newTyConRepName tc_name
-      let mod       = nameModule tc_name
-          tc_cons   = tyConDataCons tc
-          tc_arits  = map dataConSourceArity tc_cons
-
-          tc_occ    = nameOccName tc_name
-          d_occ     = mkGenD mod tc_occ
-          c_occ m   = mkGenC mod tc_occ m
-          s_occ m n = mkGenS mod tc_occ m n
-
-          mkTyCon name = ASSERT( isExternalName name )
-                         buildAlgTyCon name [] [] Nothing [] distinctAbstractTyConRhs
-                                            NonRecursive
-                                            False          -- Not promotable
-                                            False          -- Not GADT syntax
-                                            (VanillaAlgTyCon ty_rep_name)
+  do  let
+        tc_name   = tyConName tc
+        mod       = nameModule tc_name
+        tc_cons   = tyConDataCons tc
+        tc_arits  = map dataConSourceArity tc_cons
+
+        tc_occ    = nameOccName tc_name
+        d_occ     = mkGenD mod tc_occ
+        c_occ m   = mkGenC mod tc_occ m
+        s_occ m n = mkGenS mod tc_occ m n
+
+        mkTyCon name = ASSERT( isExternalName name )
+                       buildAlgTyCon name [] [] Nothing [] distinctAbstractTyConRhs
+                                          NonRecursive
+                                          False          -- Not promotable
+                                          False          -- Not GADT syntax
+                                          NoParentTyCon
 
       loc <- getSrcSpanM
       -- we generate new names in current module
@@ -265,9 +265,10 @@ canDoGenerics tc tc_args
   where
     -- The tc can be a representation tycon. When we want to display it to the
     -- user (in an error message) we should print its parent
-    (tc_name, tc_tys) = case tyConFamInst_maybe tc of
-        Just (ptc, tys) -> (ppr ptc, hsep (map ppr (tys ++ drop (length tys) tc_args)))
-        _               -> (ppr tc, hsep (map ppr (tyConTyVars tc)))
+    (tc_name, tc_tys) = case tyConParent tc of
+        FamInstTyCon _ ptc tys -> (ppr ptc, hsep (map ppr
+                                            (tys ++ drop (length tys) tc_args)))
+        _                      -> (ppr tc, hsep (map ppr (tyConTyVars tc)))
 
         -- Check (d) from Note [Requirements for deriving Generic and Rep].
         --
diff --git a/compiler/typecheck/TcHsSyn.hs b/compiler/typecheck/TcHsSyn.hs
index ddf9c4ff36..5aa797c4c2 100644
--- a/compiler/typecheck/TcHsSyn.hs
+++ b/compiler/typecheck/TcHsSyn.hs
@@ -1282,10 +1282,19 @@ zonkEvTerm env (EvCast tm co)     = do { tm' <- zonkEvTerm env tm
                                        ; return (mkEvCast tm' co') }
 zonkEvTerm _   (EvLit l)          = return (EvLit l)
 
-zonkEvTerm env (EvTypeable ty ev) =
-  do { ev' <- zonkEvTypeable env ev
-     ; ty' <- zonkTcTypeToType env ty
-     ; return (EvTypeable ty' ev') }
+zonkEvTerm env (EvTypeable ev) =
+  fmap EvTypeable $
+  case ev of
+    EvTypeableTyCon tc ks    -> return (EvTypeableTyCon tc ks)
+    EvTypeableTyApp t1 t2    -> do e1 <- zonk t1
+                                   e2 <- zonk t2
+                                   return (EvTypeableTyApp e1 e2)
+    EvTypeableTyLit t        -> EvTypeableTyLit `fmap` zonk t
+  where
+  zonk (ev,t) = do ev' <- zonkEvTerm env ev
+                   t'  <- zonkTcTypeToType env t
+                   return (ev',t')
+
 zonkEvTerm env (EvCallStack cs)
   = case cs of
       EvCsEmpty -> return (EvCallStack cs)
@@ -1303,16 +1312,6 @@ zonkEvTerm env (EvDelayedError ty msg)
   = do { ty' <- zonkTcTypeToType env ty
        ; return (EvDelayedError ty' msg) }
 
-zonkEvTypeable :: ZonkEnv -> EvTypeable -> TcM EvTypeable
-zonkEvTypeable _ EvTypeableTyCon
-  = return EvTypeableTyCon
-zonkEvTypeable env (EvTypeableTyApp t1 t2)
-  = do { t1' <- zonkEvTerm env t1
-       ; t2' <- zonkEvTerm env t2
-       ; return (EvTypeableTyApp t1' t2') }
-zonkEvTypeable _ (EvTypeableTyLit t1)
-  = return (EvTypeableTyLit t1)
-
 zonkTcEvBinds_s :: ZonkEnv -> [TcEvBinds] -> TcM (ZonkEnv, [TcEvBinds])
 zonkTcEvBinds_s env bs = do { (env, bs') <- mapAccumLM zonk_tc_ev_binds env bs
                             ; return (env, [EvBinds (unionManyBags bs')]) }
diff --git a/compiler/typecheck/TcHsType.hs b/compiler/typecheck/TcHsType.hs
index 191756ac7a..2f427916b4 100644
--- a/compiler/typecheck/TcHsType.hs
+++ b/compiler/typecheck/TcHsType.hs
@@ -659,7 +659,7 @@ tcTyVar name         -- Could be a tyvar, a tycon, or a datacon
            AGlobal (ATyCon tc) -> inst_tycon (mkTyConApp tc) (tyConKind tc)
 
            AGlobal (AConLike (RealDataCon dc))
-             | Promoted tc <- promoteDataCon_maybe dc
+             | Just tc <- promoteDataCon_maybe dc
              -> do { data_kinds <- xoptM Opt_DataKinds
                    ; unless data_kinds $ promotionErr name NoDataKinds
                    ; inst_tycon (mkTyConApp tc) (tyConKind tc) }
@@ -1619,10 +1619,10 @@ tc_kind_var_app name arg_kis
              -> do { data_kinds <- xoptM Opt_DataKinds
                    ; unless data_kinds $ addErr (dataKindsErr name)
                    ; case promotableTyCon_maybe tc of
-                       Promoted prom_tc | arg_kis `lengthIs` tyConArity prom_tc
+                       Just prom_tc | arg_kis `lengthIs` tyConArity prom_tc
                                -> return (mkTyConApp prom_tc arg_kis)
-                       Promoted _  -> tycon_err tc "is not fully applied"
-                       NotPromoted -> tycon_err tc "is not promotable" }
+                       Just _  -> tycon_err tc "is not fully applied"
+                       Nothing -> tycon_err tc "is not promotable" }
 
            -- A lexically scoped kind variable
            ATyVar _ kind_var
diff --git a/compiler/typecheck/TcInstDcls.hs b/compiler/typecheck/TcInstDcls.hs
index ef0c4b6c8f..c97e4e128c 100644
--- a/compiler/typecheck/TcInstDcls.hs
+++ b/compiler/typecheck/TcInstDcls.hs
@@ -434,7 +434,7 @@ tcInstDecls1 tycl_decls inst_decls deriv_decls
                          ptext (sLit "Replace the following instance:"))
                      2 (pprInstanceHdr (iSpec i))
 
-    -- Report an error or a warning for a Typeable instances.
+    -- Report an error or a warning for a `Typeable` instances.
     -- If we are working on an .hs-boot file, we just report a warning,
     -- and ignore the instance.  We do this, to give users a chance to fix
     -- their code.
@@ -445,13 +445,10 @@ tcInstDecls1 tycl_decls inst_decls deriv_decls
              then
                do warn <- woptM Opt_WarnDerivingTypeable
                   when warn $ addWarnTc $ vcat
-                    [ ppTypeable <+> ptext (sLit "instances in .hs-boot files are ignored")
-                    , ptext (sLit "This warning will become an error in future versions of the compiler")
+                    [ ptext (sLit "`Typeable` instances in .hs-boot files are ignored.")
+                    , ptext (sLit "This warning will become an error in future versions of the compiler.")
                     ]
-             else addErrTc $ ptext (sLit "Class") <+> ppTypeable
-                             <+> ptext (sLit "does not support user-specified instances")
-    ppTypeable :: SDoc
-    ppTypeable = quotes (ppr typeableClassName)
+             else addErrTc $ ptext (sLit "Class `Typeable` does not support user-specified instances.")
 
 addClsInsts :: [InstInfo Name] -> TcM a -> TcM a
 addClsInsts infos thing_inside
@@ -636,7 +633,7 @@ tcDataFamInstDecl mb_clsinfo
 
          -- Check that the family declaration is for the right kind
        ; checkTc (isFamilyTyCon fam_tc) (notFamily fam_tc)
-       ; checkTc (isDataFamilyTyCon fam_tc) (wrongKindOfFamily fam_tc)
+       ; checkTc (isAlgTyCon fam_tc) (wrongKindOfFamily fam_tc)
 
          -- Kind check type patterns
        ; tcFamTyPats (famTyConShape fam_tc) mb_clsinfo pats
@@ -662,9 +659,7 @@ tcDataFamInstDecl mb_clsinfo
        ; let orig_res_ty = mkTyConApp fam_tc pats'
 
        ; (rep_tc, fam_inst) <- fixM $ \ ~(rec_rep_tc, _) ->
-           do { data_cons <- tcConDecls new_or_data
-                                        False   -- Not promotable
-                                        rec_rep_tc
+           do { data_cons <- tcConDecls new_or_data rec_rep_tc
                                         (tvs', orig_res_ty) cons
               ; tc_rhs <- case new_or_data of
                      DataType -> return (mkDataTyConRhs data_cons)
@@ -675,7 +670,7 @@ tcDataFamInstDecl mb_clsinfo
                     axiom    = mkSingleCoAxiom Representational
                                                axiom_name eta_tvs fam_tc eta_pats
                                                (mkTyConApp rep_tc (mkTyVarTys eta_tvs))
-                    parent   = DataFamInstTyCon axiom fam_tc pats'
+                    parent   = FamInstTyCon axiom fam_tc pats'
                     roles    = map (const Nominal) tvs'
 
                       -- NB: Use the tvs' from the pats. See bullet toward
diff --git a/compiler/typecheck/TcInteract.hs b/compiler/typecheck/TcInteract.hs
index 47147d7a4d..49a5d4cc09 100644
--- a/compiler/typecheck/TcInteract.hs
+++ b/compiler/typecheck/TcInteract.hs
@@ -16,11 +16,10 @@ import VarSet
 import Type
 import Kind ( isKind )
 import InstEnv( DFunInstType, lookupInstEnv, instanceDFunId )
-import CoAxiom( sfInteractTop, sfInteractInert )
+import CoAxiom(sfInteractTop, sfInteractInert)
 
 import Var
 import TcType
-import Name
 import PrelNames ( knownNatClassName, knownSymbolClassName,
                    callStackTyConKey, typeableClassName )
 import TysWiredIn ( ipClass, typeNatKind, typeSymbolKind )
@@ -744,11 +743,11 @@ addFunDepWork inerts work_ev cls
                                                             inert_pred inert_loc }
 
 {-
-**********************************************************************
-*                                                                    *
+*********************************************************************************
+*                                                                               *
                    Implicit parameters
-*                                                                    *
-**********************************************************************
+*                                                                               *
+*********************************************************************************
 -}
 
 interactGivenIP :: InertCans -> Ct -> TcS (StopOrContinue Ct)
@@ -771,26 +770,6 @@ interactGivenIP inerts workItem@(CDictCan { cc_ev = ev, cc_class = cls
 
 interactGivenIP _ wi = pprPanic "interactGivenIP" (ppr wi)
 
--- | Is the constraint for an implicit CallStack parameter?
--- i.e.   (IP "name" CallStack)
-isCallStackIP :: CtLoc -> Class -> [Type] -> Maybe (EvTerm -> EvCallStack)
-isCallStackIP loc cls tys
-  | cls == ipClass
-  , [_ip_name, ty] <- tys
-  , Just (tc, _) <- splitTyConApp_maybe ty
-  , tc `hasKey` callStackTyConKey
-  = occOrigin (ctLocOrigin loc)
-  | otherwise
-  = Nothing
-  where
-    locSpan = ctLocSpan loc
-
-    -- We only want to grab constraints that arose due to the use of an IP or a
-    -- function call. See Note [Overview of implicit CallStacks]
-    occOrigin (OccurrenceOf n) = Just (EvCsPushCall n locSpan)
-    occOrigin (IPOccOrigin n)  = Just (EvCsTop ('?' `consFS` hsIPNameFS n) locSpan)
-    occOrigin _                = Nothing
-
 {-
 Note [Shadowing of Implicit Parameters]
 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
@@ -842,11 +821,11 @@ I can think of two ways to fix this:
      error if we get multiple givens for the same implicit parameter.
 
 
-**********************************************************************
-*                                                                    *
+*********************************************************************************
+*                                                                               *
                    interactFunEq
-*                                                                    *
-**********************************************************************
+*                                                                               *
+*********************************************************************************
 -}
 
 interactFunEq :: InertCans -> Ct -> TcS (StopOrContinue Ct)
@@ -1077,11 +1056,11 @@ The second is the right thing to do.  Hence the isMetaTyVarTy
 test when solving pairwise CFunEqCan.
 
 
-**********************************************************************
-*                                                                    *
+*********************************************************************************
+*                                                                               *
                    interactTyVarEq
-*                                                                    *
-**********************************************************************
+*                                                                               *
+*********************************************************************************
 -}
 
 interactTyVarEq :: InertCans -> Ct -> TcS (StopOrContinue Ct)
@@ -1254,11 +1233,11 @@ emitFunDepDeriveds fd_eqns
          Pair (Type.substTy subst ty1) (Type.substTy subst ty2)
 
 {-
-**********************************************************************
-*                                                                    *
+*********************************************************************************
+*                                                                               *
                        The top-reaction Stage
-*                                                                    *
-**********************************************************************
+*                                                                               *
+*********************************************************************************
 -}
 
 topReactionsStage :: WorkItem -> TcS (StopOrContinue Ct)
@@ -1737,12 +1716,6 @@ So the inner binding for ?x::Bool *overrides* the outer one.
 Hence a work-item Given overrides an inert-item Given.
 -}
 
-{- *******************************************************************
-*                                                                    *
-                       Class lookup
-*                                                                    *
-**********************************************************************-}
-
 -- | Indicates if Instance met the Safe Haskell overlapping instances safety
 -- check.
 --
@@ -1760,36 +1733,116 @@ instance Outputable LookupInstResult where
     where ss = text $ if s then "[safe]" else "[unsafe]"
 
 
-matchClassInst :: DynFlags -> InertSet -> Class -> [Type] -> CtLoc -> TcS LookupInstResult
+matchClassInst, match_class_inst
+   :: DynFlags -> InertSet -> Class -> [Type] -> CtLoc -> TcS LookupInstResult
+
 matchClassInst dflags inerts clas tys loc
+ = do { traceTcS "matchClassInst" $ vcat [ text "pred =" <+> ppr (mkClassPred clas tys) ]
+      ; res <- match_class_inst dflags inerts clas tys loc
+      ; traceTcS "matchClassInst result" $ ppr res
+      ; return res }
+
 -- First check whether there is an in-scope Given that could
 -- match this constraint.  In that case, do not use top-level
 -- instances.  See Note [Instance and Given overlap]
+match_class_inst dflags inerts clas tys loc
   | not (xopt Opt_IncoherentInstances dflags)
   , let matchable_givens = matchableGivens loc pred inerts
   , not (isEmptyBag matchable_givens)
   = do { traceTcS "Delaying instance application" $
-           vcat [ text "Work item=" <+> pprClassPred clas tys
+           vcat [ text "Work item=" <+> pprType pred
                 , text "Potential matching givens:" <+> ppr matchable_givens ]
        ; return NoInstance }
   where
      pred = mkClassPred clas tys
 
-matchClassInst dflags _ clas tys loc
- = do { traceTcS "matchClassInst" $ vcat [ text "pred =" <+> ppr (mkClassPred clas tys) ]
-      ; res <- match_class_inst dflags clas tys loc
-      ; traceTcS "matchClassInst result" $ ppr res
-      ; return res }
+match_class_inst _ _ clas [ ty ] _
+  | className clas == knownNatClassName
+  , Just n <- isNumLitTy ty = makeDict (EvNum n)
+
+  | className clas == knownSymbolClassName
+  , Just s <- isStrLitTy ty = makeDict (EvStr s)
 
-match_class_inst :: DynFlags -> Class -> [Type] -> CtLoc -> TcS LookupInstResult
-match_class_inst dflags clas tys loc
-  | cls_name == knownNatClassName    = matchKnownNat       clas tys
-  | cls_name == knownSymbolClassName = matchKnownSymbol    clas tys
-  | isCTupleClass clas               = matchCTuple         clas tys
-  | cls_name == typeableClassName    = matchTypeable       clas tys
-  | otherwise                        = matchInstEnv dflags clas tys loc
   where
-    cls_name = className clas
+  {- This adds a coercion that will convert the literal into a dictionary
+     of the appropriate type.  See Note [KnownNat & KnownSymbol and EvLit]
+     in TcEvidence.  The coercion happens in 2 steps:
+
+     Integer -> SNat n     -- representation of literal to singleton
+     SNat n  -> KnownNat n -- singleton to dictionary
+
+     The process is mirrored for Symbols:
+     String    -> SSymbol n
+     SSymbol n -> KnownSymbol n
+  -}
+  makeDict evLit
+    | Just (_, co_dict) <- tcInstNewTyCon_maybe (classTyCon clas) [ty]
+          -- co_dict :: KnownNat n ~ SNat n
+    , [ meth ]   <- classMethods clas
+    , Just tcRep <- tyConAppTyCon_maybe -- SNat
+                      $ funResultTy         -- SNat n
+                      $ dropForAlls         -- KnownNat n => SNat n
+                      $ idType meth         -- forall n. KnownNat n => SNat n
+    , Just (_, co_rep) <- tcInstNewTyCon_maybe tcRep [ty]
+          -- SNat n ~ Integer
+    , let ev_tm = mkEvCast (EvLit evLit) (mkTcSymCo (mkTcTransCo co_dict co_rep))
+    = return $ GenInst [] (\_ -> ev_tm) True
+
+    | otherwise
+    = panicTcS (text "Unexpected evidence for" <+> ppr (className clas)
+                     $$ vcat (map (ppr . idType) (classMethods clas)))
+
+match_class_inst _ _ clas ts _
+  | isCTupleClass clas
+  , let data_con = tyConSingleDataCon (classTyCon clas)
+        tuple_ev = EvDFunApp (dataConWrapId data_con) ts
+  = return (GenInst ts tuple_ev True)
+            -- The dfun is the data constructor!
+
+match_class_inst _ _ clas [k,t] _
+  | className clas == typeableClassName
+  = matchTypeableClass clas k t
+
+match_class_inst dflags _ clas tys loc
+   = do { instEnvs <- getInstEnvs
+        ; let safeOverlapCheck = safeHaskell dflags `elem` [Sf_Safe, Sf_Trustworthy]
+              (matches, unify, unsafeOverlaps) = lookupInstEnv True instEnvs clas tys
+              safeHaskFail = safeOverlapCheck && not (null unsafeOverlaps)
+        ; case (matches, unify, safeHaskFail) of
+
+            -- Nothing matches
+            ([], _, _)
+                -> do { traceTcS "matchClass not matching" $
+                        vcat [ text "dict" <+> ppr pred ]
+                      ; return NoInstance }
+
+            -- A single match (& no safe haskell failure)
+            ([(ispec, inst_tys)], [], False)
+                -> do   { let dfun_id = instanceDFunId ispec
+                        ; traceTcS "matchClass success" $
+                          vcat [text "dict" <+> ppr pred,
+                                text "witness" <+> ppr dfun_id
+                                               <+> ppr (idType dfun_id) ]
+                                  -- Record that this dfun is needed
+                        ; match_one (null unsafeOverlaps) dfun_id inst_tys }
+
+            -- More than one matches (or Safe Haskell fail!). Defer any
+            -- reactions of a multitude until we learn more about the reagent
+            (matches, _, _)
+                -> do   { traceTcS "matchClass multiple matches, deferring choice" $
+                          vcat [text "dict" <+> ppr pred,
+                                text "matches" <+> ppr matches]
+                        ; return NoInstance } }
+   where
+     pred = mkClassPred clas tys
+
+     match_one :: SafeOverlapping -> DFunId -> [DFunInstType] -> TcS LookupInstResult
+                  -- See Note [DFunInstType: instantiating types] in InstEnv
+     match_one so dfun_id mb_inst_tys
+       = do { checkWellStagedDFun pred dfun_id loc
+            ; (tys, theta) <- instDFunType dfun_id mb_inst_tys
+            ; return $ GenInst theta (EvDFunApp dfun_id tys) so }
+
 
 {- Note [Instance and Given overlap]
 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
@@ -1854,202 +1907,89 @@ Other notes:
   constraint solving.
 -}
 
+-- | Is the constraint for an implicit CallStack parameter?
+-- i.e.   (IP "name" CallStack)
+isCallStackIP :: CtLoc -> Class -> [Type] -> Maybe (EvTerm -> EvCallStack)
+isCallStackIP loc cls tys
+  | cls == ipClass
+  , [_ip_name, ty] <- tys
+  , Just (tc, _) <- splitTyConApp_maybe ty
+  , tc `hasKey` callStackTyConKey
+  = occOrigin (ctLocOrigin loc)
+  | otherwise
+  = Nothing
+  where
+    locSpan = ctLocSpan loc
 
-{- *******************************************************************
-*                                                                    *
-                Class lookup in the instance environment
-*                                                                    *
-**********************************************************************-}
-
-matchInstEnv :: DynFlags -> Class -> [Type] -> CtLoc -> TcS LookupInstResult
-matchInstEnv dflags clas tys loc
-   = do { instEnvs <- getInstEnvs
-        ; let safeOverlapCheck = safeHaskell dflags `elem` [Sf_Safe, Sf_Trustworthy]
-              (matches, unify, unsafeOverlaps) = lookupInstEnv True instEnvs clas tys
-              safeHaskFail = safeOverlapCheck && not (null unsafeOverlaps)
-        ; case (matches, unify, safeHaskFail) of
+    -- We only want to grab constraints that arose due to the use of an IP or a
+    -- function call. See Note [Overview of implicit CallStacks]
+    occOrigin (OccurrenceOf n) = Just (EvCsPushCall n locSpan)
+    occOrigin (IPOccOrigin n)  = Just (EvCsTop ('?' `consFS` hsIPNameFS n) locSpan)
+    occOrigin _                = Nothing
 
-            -- Nothing matches
-            ([], _, _)
-                -> do { traceTcS "matchClass not matching" $
-                        vcat [ text "dict" <+> ppr pred ]
-                      ; return NoInstance }
+-- | Assumes that we've checked that this is the 'Typeable' class,
+-- and it was applied to the correct argument.
+matchTypeableClass :: Class -> Kind -> Type -> TcS LookupInstResult
+matchTypeableClass clas k t
 
-            -- A single match (& no safe haskell failure)
-            ([(ispec, inst_tys)], [], False)
-                -> do   { let dfun_id = instanceDFunId ispec
-                        ; traceTcS "matchClass success" $
-                          vcat [text "dict" <+> ppr pred,
-                                text "witness" <+> ppr dfun_id
-                                               <+> ppr (idType dfun_id) ]
-                                  -- Record that this dfun is needed
-                        ; match_one (null unsafeOverlaps) dfun_id inst_tys }
+  -- See Note [No Typeable for qualified types]
+  | isForAllTy t                               = return NoInstance
 
-            -- More than one matches (or Safe Haskell fail!). Defer any
-            -- reactions of a multitude until we learn more about the reagent
-            (matches, _, _)
-                -> do   { traceTcS "matchClass multiple matches, deferring choice" $
-                          vcat [text "dict" <+> ppr pred,
-                                text "matches" <+> ppr matches]
-                        ; return NoInstance } }
-   where
-     pred = mkClassPred clas tys
+  -- Is the type of the form `C => t`?
+  | isJust (tcSplitPredFunTy_maybe t)          = return NoInstance
 
-     match_one :: SafeOverlapping -> DFunId -> [DFunInstType] -> TcS LookupInstResult
-                  -- See Note [DFunInstType: instantiating types] in InstEnv
-     match_one so dfun_id mb_inst_tys
-       = do { checkWellStagedDFun pred dfun_id loc
-            ; (tys, theta) <- instDFunType dfun_id mb_inst_tys
-            ; return $ GenInst theta (EvDFunApp dfun_id tys) so }
+  | eqType k typeNatKind                       = doTyLit knownNatClassName
+  | eqType k typeSymbolKind                    = doTyLit knownSymbolClassName
 
+  | Just (tc, ks) <- splitTyConApp_maybe t
+  , all isKind ks                              = doTyCon tc ks
 
-{- ********************************************************************
-*                                                                     *
-                   Class lookup for CTuples
-*                                                                     *
-***********************************************************************-}
+  | Just (f,kt)       <- splitAppTy_maybe t    = doTyApp f kt
+  | otherwise                                  = return NoInstance
 
-matchCTuple :: Class -> [Type] -> TcS LookupInstResult
-matchCTuple clas tys   -- (isCTupleClass clas) holds
-  = return (GenInst tys tuple_ev True)
-            -- The dfun *is* the data constructor!
   where
-     data_con = tyConSingleDataCon (classTyCon clas)
-     tuple_ev = EvDFunApp (dataConWrapId data_con) tys
-
-{- ********************************************************************
-*                                                                     *
-                   Class lookup for Literals
-*                                                                     *
-***********************************************************************-}
-
-matchKnownNat :: Class -> [Type] -> TcS LookupInstResult
-matchKnownNat clas [ty]     -- clas = KnownNat
-  | Just n <- isNumLitTy ty = makeLitDict clas ty (EvNum n)
-matchKnownNat _ _           = return NoInstance
-
-matchKnownSymbol :: Class -> [Type] -> TcS LookupInstResult
-matchKnownSymbol clas [ty]  -- clas = KnownSymbol
-  | Just n <- isStrLitTy ty = makeLitDict clas ty (EvStr n)
-matchKnownSymbol _ _       = return NoInstance
-
-
-makeLitDict :: Class -> Type -> EvLit -> TcS LookupInstResult
--- makeLitDict adds a coercion that will convert the literal into a dictionary
--- of the appropriate type.  See Note [KnownNat & KnownSymbol and EvLit]
--- in TcEvidence.  The coercion happens in 2 steps:
---
---     Integer -> SNat n     -- representation of literal to singleton
---     SNat n  -> KnownNat n -- singleton to dictionary
---
---     The process is mirrored for Symbols:
---     String    -> SSymbol n
---     SSymbol n -> KnownSymbol n -}
-makeLitDict clas ty evLit
-    | Just (_, co_dict) <- tcInstNewTyCon_maybe (classTyCon clas) [ty]
-          -- co_dict :: KnownNat n ~ SNat n
-    , [ meth ]   <- classMethods clas
-    , Just tcRep <- tyConAppTyCon_maybe -- SNat
-                      $ funResultTy         -- SNat n
-                      $ dropForAlls         -- KnownNat n => SNat n
-                      $ idType meth         -- forall n. KnownNat n => SNat n
-    , Just (_, co_rep) <- tcInstNewTyCon_maybe tcRep [ty]
-          -- SNat n ~ Integer
-    , let ev_tm = mkEvCast (EvLit evLit) (mkTcSymCo (mkTcTransCo co_dict co_rep))
-    = return $ GenInst [] (\_ -> ev_tm) True
-
+  -- Representation for type constructor applied to some kinds
+  doTyCon tc ks =
+    case mapM kindRep ks of
+      Nothing    -> return NoInstance
+      Just kReps ->
+        return $ GenInst [] (\_ -> EvTypeable (EvTypeableTyCon tc kReps) ) True
+
+  {- Representation for an application of a type to a type-or-kind.
+  This may happen when the type expression starts with a type variable.
+  Example (ignoring kind parameter):
+    Typeable (f Int Char)                      -->
+    (Typeable (f Int), Typeable Char)          -->
+    (Typeable f, Typeable Int, Typeable Char)  --> (after some simp. steps)
+    Typeable f
+  -}
+  doTyApp f tk
+    | isKind tk
+    = return NoInstance -- We can't solve until we know the ctr.
     | otherwise
-    = panicTcS (text "Unexpected evidence for" <+> ppr (className clas)
-                     $$ vcat (map (ppr . idType) (classMethods clas)))
-
-
-{- ********************************************************************
-*                                                                     *
-                   Class lookup for Typeable
-*                                                                     *
-***********************************************************************-}
-
--- | Assumes that we've checked that this is the 'Typeable' class,
--- and it was applied to the correct argument.
-matchTypeable :: Class -> [Type] -> TcS LookupInstResult
-matchTypeable clas [k,t]  -- clas = Typeable
-  -- For the first two cases, See Note [No Typeable for polytypes or qualified types]
-  | isForAllTy k                      = return NoInstance   -- Polytype
-  | isJust (tcSplitPredFunTy_maybe t) = return NoInstance   -- Qualified type
-
-  -- Now cases that do work
-  | k `eqType` typeNatKind                 = doTyLit knownNatClassName    t
-  | k `eqType` typeSymbolKind              = doTyLit knownSymbolClassName t
-  | Just (_, ks) <- splitTyConApp_maybe t -- See Note [Typeable (T a b c)]
-  , all isGroundKind ks                    = doTyConApp t
-  | Just (f,kt)   <- splitAppTy_maybe t    = doTyApp    clas t f kt
-
-matchTypeable _ _ = return NoInstance
-
-doTyConApp :: Type -> TcS LookupInstResult
--- Representation for type constructor applied to some (ground) kinds
-doTyConApp ty = return $ GenInst [] (\_ -> EvTypeable ty EvTypeableTyCon) True
-
--- Representation for concrete kinds.  We just use the kind itself,
--- but first check to make sure that it is "simple" (i.e., made entirely
--- out of kind constructors).
-isGroundKind :: KindOrType -> Bool
--- Return True if (a) k is a kind and (b) it is a ground kind
-isGroundKind k
- = isKind k && is_ground k
- where
-   is_ground k | Just (_, ks) <- splitTyConApp_maybe k
-               = all is_ground ks
-               | otherwise
-               = False
-
-doTyApp :: Class -> Type -> Type -> KindOrType -> TcS LookupInstResult
--- Representation for an application of a type to a type-or-kind.
---  This may happen when the type expression starts with a type variable.
---  Example (ignoring kind parameter):
---    Typeable (f Int Char)                      -->
---    (Typeable (f Int), Typeable Char)          -->
---    (Typeable f, Typeable Int, Typeable Char)  --> (after some simp. steps)
---    Typeable f
-doTyApp clas ty f tk
-  | isKind tk
-  = return NoInstance -- We can't solve until we know the ctr.
-  | otherwise
-  = return $ GenInst [mk_typeable_pred clas f, mk_typeable_pred clas tk]
-                     (\[t1,t2] -> EvTypeable ty $ EvTypeableTyApp (EvId t1) (EvId t2))
-                     True
-
--- Emit a `Typeable` constraint for the given type.
-mk_typeable_pred :: Class -> Type -> PredType
-mk_typeable_pred clas ty = mkClassPred clas [ typeKind ty, ty ]
-
-  -- Typeable is implied by KnownNat/KnownSymbol. In the case of a type literal
-  -- we generate a sub-goal for the appropriate class. See #10348 for what
-  -- happens when we fail to do this.
-doTyLit :: Name -> Type -> TcS LookupInstResult
-doTyLit kc t = do { kc_clas <- tcLookupClass kc
-                  ; let kc_pred    = mkClassPred kc_clas [ t ]
-                        mk_ev [ev] = EvTypeable t $ EvTypeableTyLit $ EvId ev
-                        mk_ev _    = panic "doTyLit"
-                  ; return (GenInst [kc_pred] mk_ev True) }
-
-{- Note [Typeable (T a b c)]
-~~~~~~~~~~~~~~~~~~~~~~~~~~~~
-For type applications we always decompose using binary application,
-vai doTyApp, until we get to a *kind* instantiation.  Exmaple
-   Proxy :: forall k. k -> *
-
-To solve Typeable (Proxy (* -> *) Maybe) we
-  - First decompose with doTyApp,
-    to get (Typeable (Proxy (* -> *))) and Typeable Maybe
-  - Then sovle (Typeable (Proxy (* -> *))) with doTyConApp
-
-If we attempt to short-cut by solving it all at once, via
-doTyCOnAPp
-
-
-Note [No Typeable for polytypes or qualified types]
-~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+    = return $ GenInst [mk_typeable_pred f, mk_typeable_pred tk]
+                       (\[t1,t2] -> EvTypeable $ EvTypeableTyApp (EvId t1,f) (EvId t2,tk))
+                       True
+
+  -- Representation for concrete kinds.  We just use the kind itself,
+  -- but first check to make sure that it is "simple" (i.e., made entirely
+  -- out of kind constructors).
+  kindRep ki = do (_,ks) <- splitTyConApp_maybe ki
+                  mapM_ kindRep ks
+                  return ki
+
+  -- Emit a `Typeable` constraint for the given type.
+  mk_typeable_pred ty = mkClassPred clas [ typeKind ty, ty ]
+
+  -- Given KnownNat / KnownSymbol, generate appropriate sub-goal
+  -- and make evidence for a type-level literal.
+  doTyLit c = do clas <- tcLookupClass c
+                 let p = mkClassPred clas [ t ]
+                 return $ GenInst [p] (\[i] -> EvTypeable
+                                             $ EvTypeableTyLit (EvId i,t)) True
+
+{- Note [No Typeable for polytype or for constraints]
+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
 We do not support impredicative typeable, such as
    Typeable (forall a. a->a)
    Typeable (Eq a => a -> a)
@@ -2063,9 +2003,9 @@ a TypeRep for them.  For qualified but not polymorphic types, like
  * We don't need a TypeRep for these things.  TypeReps are for
    monotypes only.
 
- * Perhaps we could treat `=>` as another type constructor for `Typeable`
-   purposes, and thus support things like `Eq Int => Int`, however,
-   at the current state of affairs this would be an odd exception as
-   no other class works with impredicative types.
-   For now we leave it off, until we have a better story for impredicativity.
+  * Perhaps we could treat `=>` as another type constructor for `Typeable`
+    purposes, and thus support things like `Eq Int => Int`, however,
+    at the current state of affairs this would be an odd exception as
+    no other class works with impredicative types.
+    For now we leave it off, until we have a better story for impredicativity.
 -}
diff --git a/compiler/typecheck/TcPatSyn.hs b/compiler/typecheck/TcPatSyn.hs
index 5c55fcef2f..f1db883509 100644
--- a/compiler/typecheck/TcPatSyn.hs
+++ b/compiler/typecheck/TcPatSyn.hs
@@ -314,7 +314,7 @@ tcPatSynMatcher (L loc name) lpat
 
        ; let matcher_tau   = mkFunTys [pat_ty, cont_ty, fail_ty] res_ty
              matcher_sigma = mkSigmaTy (res_tv:univ_tvs) req_theta matcher_tau
-             matcher_id    = mkExportedLocalId PatSynId matcher_name matcher_sigma
+             matcher_id    = mkExportedLocalId VanillaId matcher_name matcher_sigma
                              -- See Note [Exported LocalIds] in Id
 
              cont_dicts = map nlHsVar prov_dicts
diff --git a/compiler/typecheck/TcRnDriver.hs b/compiler/typecheck/TcRnDriver.hs
index 4e6b1d3db7..45c25e4942 100644
--- a/compiler/typecheck/TcRnDriver.hs
+++ b/compiler/typecheck/TcRnDriver.hs
@@ -68,7 +68,6 @@ import TcMType
 import MkIface
 import TcSimplify
 import TcTyClsDecls
-import TcTypeable( mkModIdBindings )
 import LoadIface
 import TidyPgm    ( mkBootModDetailsTc )
 import RnNames
@@ -461,14 +460,8 @@ 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 exports 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
-
-                -- 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
@@ -968,13 +961,12 @@ checkBootTyCon tc1 tc2
   | Just fam_flav1 <- famTyConFlav_maybe tc1
   , Just fam_flav2 <- famTyConFlav_maybe tc2
   = ASSERT(tc1 == tc2)
-    let eqFamFlav OpenSynFamilyTyCon   OpenSynFamilyTyCon = True
-        eqFamFlav (DataFamilyTyCon {}) (DataFamilyTyCon {}) = True
+    let eqFamFlav OpenSynFamilyTyCon OpenSynFamilyTyCon = True
         eqFamFlav AbstractClosedSynFamilyTyCon (ClosedSynFamilyTyCon {}) = True
         eqFamFlav (ClosedSynFamilyTyCon {}) AbstractClosedSynFamilyTyCon = True
         eqFamFlav (ClosedSynFamilyTyCon ax1) (ClosedSynFamilyTyCon ax2)
             = eqClosedFamilyAx ax1 ax2
-        eqFamFlav (BuiltInSynFamTyCon {}) (BuiltInSynFamTyCon {}) = tc1 == tc2
+        eqFamFlav (BuiltInSynFamTyCon _) (BuiltInSynFamTyCon _) = tc1 == tc2
         eqFamFlav _ _ = False
         injInfo1 = familyTyConInjectivityInfo tc1
         injInfo2 = familyTyConInjectivityInfo tc2
@@ -1006,6 +998,7 @@ checkBootTyCon tc1 tc2
                           (text "The natures of the declarations for" <+>
                            quotes (ppr tc) <+> text "are different")
       | otherwise = checkSuccess
+    eqAlgRhs _  DataFamilyTyCon{} DataFamilyTyCon{} = checkSuccess
     eqAlgRhs _  tc1@DataTyCon{} tc2@DataTyCon{} =
         checkListBy eqCon (data_cons tc1) (data_cons tc2) (text "constructors")
     eqAlgRhs _  tc1@NewTyCon{} tc2@NewTyCon{} =
@@ -2070,7 +2063,7 @@ pprTcGblEnv (TcGblEnv { tcg_type_env  = type_env,
                         tcg_rules     = rules,
                         tcg_vects     = vects,
                         tcg_imports   = imports })
-  = vcat [ ppr_types type_env
+  = vcat [ ppr_types insts type_env
          , ppr_tycons fam_insts type_env
          , ppr_insts insts
          , ppr_fam_insts fam_insts
@@ -2087,19 +2080,20 @@ pprTcGblEnv (TcGblEnv { tcg_type_env  = type_env,
                   `thenCmp`
           (is_boot1 `compare` is_boot2)
 
-ppr_types :: TypeEnv -> SDoc
-ppr_types type_env
+ppr_types :: [ClsInst] -> TypeEnv -> SDoc
+ppr_types insts type_env
   = text "TYPE SIGNATURES" $$ nest 2 (ppr_sigs ids)
   where
+    dfun_ids = map instanceDFunId insts
     ids = [id | id <- typeEnvIds type_env, want_sig id]
-    want_sig id | opt_PprStyle_Debug
-                = True
-                | otherwise
-                = isExternalName (idName id) &&
-                  (case idDetails id of { VanillaId -> True; _ -> False })
-        -- Looking for VanillaId ignores data constructors, records selectors etc.
-        -- The isExternalName ignores local evidence bindings that the type checker
-        -- has invented.  Top-level user-defined things have External names.
+    want_sig id | opt_PprStyle_Debug = True
+                | otherwise          = isLocalId id &&
+                                       isExternalName (idName id) &&
+                                       not (id `elem` dfun_ids)
+        -- isLocalId ignores data constructors, records selectors etc.
+        -- The isExternalName ignores local dictionary and method bindings
+        -- that the type checker has invented.  Top-level user-defined things
+        -- have External names.
 
 ppr_tycons :: [FamInst] -> TypeEnv -> SDoc
 ppr_tycons fam_insts type_env
diff --git a/compiler/typecheck/TcRnMonad.hs b/compiler/typecheck/TcRnMonad.hs
index 19055647bd..601b030f74 100644
--- a/compiler/typecheck/TcRnMonad.hs
+++ b/compiler/typecheck/TcRnMonad.hs
@@ -144,7 +144,7 @@ initTc hsc_env hsc_src keep_rn_syntax mod loc do_this
                 tcg_rn_imports     = [],
                 tcg_rn_exports     = maybe_rn_syntax [],
                 tcg_rn_decls       = maybe_rn_syntax emptyRnGroup,
-                tcg_tr_module      = Nothing,
+
                 tcg_binds          = emptyLHsBinds,
                 tcg_imp_specs      = [],
                 tcg_sigs           = emptyNameSet,
diff --git a/compiler/typecheck/TcRnTypes.hs b/compiler/typecheck/TcRnTypes.hs
index 7375a8c66e..c046704643 100644
--- a/compiler/typecheck/TcRnTypes.hs
+++ b/compiler/typecheck/TcRnTypes.hs
@@ -477,9 +477,6 @@ data TcGblEnv
         -- Things defined in this module, or (in GHCi)
         -- in the declarations for a single GHCi command.
         -- For the latter, see Note [The interactive package] in HscTypes
-        tcg_tr_module :: Maybe Id,           -- Id for $trModule :: GHC.Types.Module
-                                             -- for which every module has a top-level defn
-                                             -- except in GHCi in which case we have Nothing
         tcg_binds     :: LHsBinds Id,        -- Value bindings in this module
         tcg_sigs      :: NameSet,            -- ...Top-level names that *lack* a signature
         tcg_imp_specs :: [LTcSpecPrag],      -- ...SPECIALISE prags for imported Ids
@@ -901,7 +898,7 @@ pprPECategory RecDataConPE = ptext (sLit "Data constructor")
 pprPECategory NoDataKinds  = ptext (sLit "Data constructor")
 
 {- Note [Bindings with closed types]
-~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
 Consider
 
   f x = let g ys = map not ys
@@ -918,8 +915,6 @@ iff
    a) all its free variables are imported, or are let-bound with closed types
    b) generalisation is not restricted by the monomorphism restriction
 
-Invariant: a closed variable has no free type variables in its type.
-
 Under OutsideIn we are free to generalise a closed let-binding.
 This is an extension compared to the JFP paper on OutsideIn, which
 used "top-level" as a proxy for "closed".  (It's not a good proxy
diff --git a/compiler/typecheck/TcTyClsDecls.hs b/compiler/typecheck/TcTyClsDecls.hs
index 78f1d35e5c..34b2585b4d 100644
--- a/compiler/typecheck/TcTyClsDecls.hs
+++ b/compiler/typecheck/TcTyClsDecls.hs
@@ -16,7 +16,7 @@ module TcTyClsDecls (
         kcDataDefn, tcConDecls, dataDeclChecks, checkValidTyCon,
         tcFamTyPats, tcTyFamInstEqn, famTyConShape,
         tcAddTyFamInstCtxt, tcMkDataFamInstCtxt, tcAddDataFamInstCtxt,
-        wrongKindOfFamily, dataConCtxt, badDataConTyCon, mkOneRecordSelector
+        wrongKindOfFamily, dataConCtxt, badDataConTyCon
     ) where
 
 #include "HsVersions.h"
@@ -28,6 +28,7 @@ import TcRnMonad
 import TcEnv
 import TcValidity
 import TcHsSyn
+import TcBinds( tcRecSelBinds )
 import TcTyDecls
 import TcClassDcl
 import TcHsType
@@ -43,7 +44,6 @@ import Class
 import CoAxiom
 import TyCon
 import DataCon
-import ConLike
 import Id
 import IdInfo
 import Var
@@ -53,7 +53,6 @@ import Module
 import Name
 import NameSet
 import NameEnv
-import RdrName
 import RnEnv
 import Outputable
 import Maybes
@@ -64,10 +63,8 @@ import ListSetOps
 import Digraph
 import DynFlags
 import FastString
-import Unique           ( mkBuiltinUnique )
 import BasicTypes
 
-import Bag
 import Control.Monad
 import Data.List
 
@@ -170,7 +167,16 @@ tcTyClGroup tyclds
            -- Step 4: Add the implicit things;
            -- we want them in the environment because
            -- they may be mentioned in interface files
-       ; tcAddImplicits tyclss } }
+       ; tcExtendGlobalValEnv (mkDefaultMethodIds tyclss) $
+         tcAddImplicits tyclss } }
+
+tcAddImplicits :: [TyThing] -> TcM TcGblEnv
+tcAddImplicits tyclss
+ = tcExtendGlobalEnvImplicit implicit_things $
+   tcRecSelBinds rec_sel_binds
+ where
+   implicit_things = concatMap implicitTyThings tyclss
+   rec_sel_binds   = mkRecSelBinds tyclss
 
 zipRecTyClss :: [(Name, Kind)]
              -> [TyThing]           -- Knot-tied
diff --git a/compiler/typecheck/TcTyDecls.hs b/compiler/typecheck/TcTyDecls.hs
index bba808063c..0da0cb1382 100644
--- a/compiler/typecheck/TcTyDecls.hs
+++ b/compiler/typecheck/TcTyDecls.hs
@@ -14,33 +14,28 @@ files for imported data types.
 module TcTyDecls(
         calcRecFlags, RecTyInfo(..),
         calcSynCycles, calcClassCycles,
-
-        -- * Roles
         RoleAnnots, extractRoleAnnots, emptyRoleAnnots, lookupRoleAnnots,
-
-        -- * Implicits
-        tcAddImplicits
+        mkDefaultMethodIds, mkRecSelBinds, mkOneRecordSelector
     ) where
 
 #include "HsVersions.h"
 
 import TcRnMonad
 import TcEnv
-import TcTypeable( mkTypeableBinds )
-import TcBinds( tcValBinds, addTypecheckedBinds )
-import TypeRep( Type(..) )
 import TcType
 import TysWiredIn( unitTy )
 import MkCore( rEC_SEL_ERROR_ID )
+import TypeRep
 import HsSyn
 import Class
 import Type
-import HscTypes
 import TyCon
+import ConLike
 import DataCon
 import Name
 import NameEnv
 import RdrName ( mkVarUnqual )
+import Var ( tyVarKind )
 import Id
 import IdInfo
 import VarEnv
@@ -384,7 +379,7 @@ calcRecFlags boot_details is_boot mrole_env tyclss
                    -- Recursion of newtypes/data types can happen via
                    -- the class TyCon, so tyclss includes the class tycons
 
-    is_promotable = all (computeTyConPromotability rec_tycon_names) all_tycons
+    is_promotable = all (isPromotableTyCon rec_tycon_names) all_tycons
 
     roles = inferRoles is_boot mrole_env all_tycons
 
@@ -478,6 +473,70 @@ findLoopBreakers deps
 {-
 ************************************************************************
 *                                                                      *
+                  Promotion calculation
+*                                                                      *
+************************************************************************
+
+See Note [Checking whether a group is promotable]
+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+We only want to promote a TyCon if all its data constructors
+are promotable; it'd be very odd to promote some but not others.
+
+But the data constructors may mention this or other TyCons.
+
+So we treat the recursive uses as all OK (ie promotable) and
+do one pass to check that each TyCon is promotable.
+
+Currently type synonyms are not promotable, though that
+could change.
+-}
+
+isPromotableTyCon :: NameSet -> TyCon -> Bool
+isPromotableTyCon rec_tycons tc
+  =  isAlgTyCon tc    -- Only algebraic; not even synonyms
+                      -- (we could reconsider the latter)
+  && ok_kind (tyConKind tc)
+  && case algTyConRhs tc of
+       DataTyCon { data_cons = cs }   -> all ok_con cs
+       NewTyCon { data_con = c }      -> ok_con c
+       AbstractTyCon {}               -> False
+       DataFamilyTyCon {}             -> False
+       TupleTyCon { tup_sort = sort } -> case sort of
+                                           BoxedTuple      -> True
+                                           UnboxedTuple    -> False
+                                           ConstraintTuple -> False
+  where
+    ok_kind kind = all isLiftedTypeKind args && isLiftedTypeKind res
+            where  -- Checks for * -> ... -> * -> *
+              (args, res) = splitKindFunTys kind
+
+    -- See Note [Promoted data constructors] in TyCon
+    ok_con con = all (isLiftedTypeKind . tyVarKind) ex_tvs
+              && null eq_spec   -- No constraints
+              && null theta
+              && all (isPromotableType rec_tycons) orig_arg_tys
+       where
+         (_, ex_tvs, eq_spec, theta, orig_arg_tys, _) = dataConFullSig con
+
+
+isPromotableType :: NameSet -> Type -> Bool
+-- Must line up with DataCon.promoteType
+-- But the function lives here because we must treat the
+-- *recursive* tycons as promotable
+isPromotableType rec_tcs con_arg_ty
+  = go con_arg_ty
+  where
+    go (TyConApp tc tys) =  tys `lengthIs` tyConArity tc
+                         && (tyConName tc `elemNameSet` rec_tcs
+                             || isJust (promotableTyCon_maybe tc))
+                         && all go tys
+    go (FunTy arg res)   = go arg && go res
+    go (TyVarTy {})      = True
+    go _                 = False
+
+{-
+************************************************************************
+*                                                                      *
         Role annotations
 *                                                                      *
 ************************************************************************
@@ -800,27 +859,6 @@ updateRoleEnv name n role
                               RIS { role_env = role_env', update = True }
                          else state )
 
-
-{- *********************************************************************
-*                                                                      *
-                Building implicits
-*                                                                      *
-********************************************************************* -}
-
-tcAddImplicits :: [TyThing] -> TcM TcGblEnv
-tcAddImplicits tyclss
-  = discardWarnings $
-    tcExtendGlobalEnvImplicit implicit_things  $
-    tcExtendGlobalValEnv def_meth_ids          $
-    do { (rec_sel_ids, rec_sel_binds)   <- mkRecSelBinds tycons
-       ; (typeable_ids, typeable_binds) <- mkTypeableBinds tycons
-       ; gbl_env <- tcExtendGlobalValEnv (rec_sel_ids ++ typeable_ids) getGblEnv
-       ; return (gbl_env `addTypecheckedBinds` (rec_sel_binds ++ typeable_binds)) }
- where
-   implicit_things = concatMap implicitTyThings tyclss
-   tycons          = [tc | ATyCon tc <- tyclss]
-   def_meth_ids    = mkDefaultMethodIds tyclss
-
 {-
 ************************************************************************
 *                                                                      *
@@ -855,49 +893,53 @@ must bring the default method Ids into scope first (so they can be seen
 when typechecking the [d| .. |] quote, and typecheck them later.
 -}
 
-mkRecSelBinds :: [TyCon] -> TcM ([Id], [LHsBinds Id])
+mkRecSelBinds :: [TyThing] -> HsValBinds Name
+-- NB We produce *un-typechecked* bindings, rather like 'deriving'
+--    This makes life easier, because the later type checking will add
+--    all necessary type abstractions and applications
 mkRecSelBinds tycons
-  = do { -- We generate *un-typechecked* bindings in mkRecSelBind, and
-         -- then typecheck them, rather like 'deriving'. This makes life
-         -- easier, because the later type checking will add all necessary
-         -- type abstractions and applications
-
-         let sel_binds :: [(RecFlag, LHsBinds Name)]
-             sel_sigs  :: [LSig Name]
-             (sel_sigs, sel_binds)
-                = mapAndUnzip mkRecSelBind [ (tc,fld)
-                                           | tc <- tycons
-                                           , fld <- tyConFieldLabels tc ]
-             sel_ids = [sel_id | L _ (IdSig sel_id) <- sel_sigs]
-       ; (sel_binds, _) <- tcValBinds TopLevel sel_binds sel_sigs (return ())
-       ; return (sel_ids, map snd sel_binds) }
-
-mkRecSelBind :: (TyCon, FieldLabel) -> (LSig Name, (RecFlag, LHsBinds Name))
+  = ValBindsOut [(NonRecursive, b) | b <- binds] sigs
+  where
+    (sigs, binds) = unzip rec_sels
+    rec_sels = map mkRecSelBind [ (tc,fld)
+                                | ATyCon tc <- tycons
+                                , fld <- tyConFieldLabels tc ]
+
+
+mkRecSelBind :: (TyCon, FieldLabel) -> (LSig Name, LHsBinds Name)
 mkRecSelBind (tycon, fl)
-  = (L loc (IdSig sel_id), (NonRecursive, unitBag (L loc sel_bind)))
+  = mkOneRecordSelector all_cons (RecSelData tycon) fl
+  where
+    all_cons     = map RealDataCon (tyConDataCons tycon)
+
+mkOneRecordSelector :: [ConLike] -> RecSelParent -> FieldLabel
+              -> (LSig Name, LHsBinds Name)
+mkOneRecordSelector all_cons idDetails fl =
+    (L loc (IdSig sel_id), unitBag (L loc sel_bind))
   where
     loc    = getSrcSpan sel_name
-    sel_id = mkExportedLocalId rec_details sel_name sel_ty
     lbl      = flLabel fl
     sel_name = flSelector fl
-    rec_details = RecSelId { sel_tycon = tycon, sel_naughty = is_naughty }
+
+    sel_id = mkExportedLocalId rec_details sel_name sel_ty
+    rec_details = RecSelId { sel_tycon = idDetails, sel_naughty = is_naughty }
 
     -- Find a representative constructor, con1
-    all_cons     = tyConDataCons tycon
-    cons_w_field = tyConDataConsWithFields tycon [lbl]
-    con1 = ASSERT( not (null cons_w_field) ) head cons_w_field
 
+    cons_w_field = conLikesWithFields all_cons [lbl]
+    con1 = ASSERT( not (null cons_w_field) ) head cons_w_field
     -- Selector type; Note [Polymorphic selectors]
-    field_ty   = dataConFieldType con1 lbl
-    data_ty    = dataConOrigResTy con1
+    field_ty   = conLikeFieldType con1 lbl
     data_tvs   = tyVarsOfType data_ty
     is_naughty = not (tyVarsOfType field_ty `subVarSet` data_tvs)
     (field_tvs, field_theta, field_tau) = tcSplitSigmaTy field_ty
     sel_ty | is_naughty = unitTy  -- See Note [Naughty record selectors]
            | otherwise  = mkForAllTys (varSetElemsKvsFirst $
                                        data_tvs `extendVarSetList` field_tvs) $
-                          mkPhiTy (dataConStupidTheta con1) $   -- Urgh!
+                          mkPhiTy (conLikeStupidTheta con1) $   -- Urgh!
                           mkPhiTy field_theta               $   -- Urgh!
+                          -- req_theta is empty for normal DataCon
+                          mkPhiTy req_theta                 $
                           mkFunTy data_ty field_tau
 
     -- Make the binding: sel (C2 { fld = x }) = x
@@ -934,8 +976,14 @@ mkRecSelBind (tycon, fl)
         --              data instance T Int a where
         --                 A :: { fld :: Int } -> T Int Bool
         --                 B :: { fld :: Int } -> T Int Char
-    dealt_with con = con `elem` cons_w_field || dataConCannotMatch inst_tys con
-    inst_tys = substTyVars (mkTopTvSubst (dataConEqSpec con1)) (dataConUnivTyVars con1)
+    dealt_with :: ConLike -> Bool
+    dealt_with (PatSynCon _) = False -- We can't predict overlap
+    dealt_with con@(RealDataCon dc) =
+      con `elem` cons_w_field || dataConCannotMatch inst_tys dc
+
+    (univ_tvs, _, eq_spec, _, req_theta, _, data_ty) = conLikeFullSig con1
+
+    inst_tys = substTyVars (mkTopTvSubst eq_spec) univ_tvs
 
     unit_rhs = mkLHsTupleExpr []
     msg_lit = HsStringPrim "" (fastStringToByteString lbl)
diff --git a/compiler/typecheck/TcTypeNats.hs b/compiler/typecheck/TcTypeNats.hs
index e64f43a9ba..1f31d5666a 100644
--- a/compiler/typecheck/TcTypeNats.hs
+++ b/compiler/typecheck/TcTypeNats.hs
@@ -16,7 +16,7 @@ import Type
 import Pair
 import TcType     ( TcType, tcEqType )
 import TyCon      ( TyCon, FamTyConFlav(..), mkFamilyTyCon
-                  , Injectivity(..) )
+                  , Injectivity(..), TyConParent(..)  )
 import Coercion   ( Role(..) )
 import TcRnTypes  ( Xi )
 import CoAxiom    ( CoAxiomRule(..), BuiltInSynFamily(..) )
@@ -45,7 +45,7 @@ import qualified Data.Map as Map
 import Data.Maybe ( isJust )
 
 {-------------------------------------------------------------------------------
-Built-in type constructors for functions on type-level nats
+Built-in type constructors for functions on type-lelve nats
 -}
 
 typeNatTyCons :: [TyCon]
@@ -110,7 +110,7 @@ typeNatLeqTyCon =
     (mkTemplateTyVars [ typeNatKind, typeNatKind ])
     Nothing
     (BuiltInSynFamTyCon ops)
-    Nothing
+    NoParentTyCon
     NotInjective
 
   where
@@ -129,7 +129,7 @@ typeNatCmpTyCon =
     (mkTemplateTyVars [ typeNatKind, typeNatKind ])
     Nothing
     (BuiltInSynFamTyCon ops)
-    Nothing
+    NoParentTyCon
     NotInjective
 
   where
@@ -148,7 +148,7 @@ typeSymbolCmpTyCon =
     (mkTemplateTyVars [ typeSymbolKind, typeSymbolKind ])
     Nothing
     (BuiltInSynFamTyCon ops)
-    Nothing
+    NoParentTyCon
     NotInjective
 
   where
@@ -172,7 +172,7 @@ mkTypeNatFunTyCon2 op tcb =
     (mkTemplateTyVars [ typeNatKind, typeNatKind ])
     Nothing
     (BuiltInSynFamTyCon tcb)
-    Nothing
+    NoParentTyCon
     NotInjective
 
 
diff --git a/compiler/typecheck/TcTypeable.hs b/compiler/typecheck/TcTypeable.hs
deleted file mode 100644
index f015eec79f..0000000000
--- a/compiler/typecheck/TcTypeable.hs
+++ /dev/null
@@ -1,206 +0,0 @@
-{-
-(c) The University of Glasgow 2006
-(c) The GRASP/AQUA Project, Glasgow University, 1992-1999
--}
-
-module TcTypeable(
-    mkTypeableBinds, mkModIdBindings
-  ) where
-
-
-import TcBinds( addTypecheckedBinds )
-import IfaceEnv( newGlobalBinder )
-import TcEnv
-import TcRnMonad
-import PrelNames( gHC_TYPES, trModuleDataConName, trTyConDataConName, trNameSDataConName )
-import Id
-import IdInfo( IdDetails(..) )
-import Type
-import TyCon
-import DataCon
-import Name( getOccName )
-import OccName
-import Module
-import HsSyn
-import DynFlags
-import Bag
-import Fingerprint(Fingerprint(..), fingerprintString)
-import Outputable
-import Data.Word( Word64 )
-import FastString ( FastString, mkFastString )
-
-{- Note [Grand plan for Typeable]
-~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
-The overall plan is this:
-
-1. Generate a binding for each module p:M
-   (done in TcTypeable by mkModIdBindings)
-       M.$trModule :: GHC.Types.Module
-       M.$trModule = Module "p" "M"
-   ("tr" is short for "type representation"; see GHC.Types)
-
-   We might want to add the filename too.
-   This can be used for the lightweight stack-tracing stuff too
-
-   Record the Name M.$trModule in the tcg_tr_module field of TcGblEnv
-
-2. Generate a binding for every data type declaration T in module M,
-       M.$tcT :: GHC.Types.TyCon
-       M.$tcT = TyCon ...fingerprint info...
-                      $trModule
-                      "T"
-   We define (in TyCon)
-      type TyConRepName = Name
-   to use for these M.$tcT "tycon rep names".
-
-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
-   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,
-   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
-
-* 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.
-
--}
-
-{- *********************************************************************
-*                                                                      *
-            Building top-level binding for $trModule
-*                                                                      *
-********************************************************************* -}
-
-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
-       ; mod_nm     <- newGlobalBinder mod (mkVarOcc "$trModule") loc
-       ; let mod_id   = mkExportedLocalId ReflectionId mod_nm
-                                          (mkTyConApp (dataConTyCon tr_mod_dc) [])
-             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)) ]
-
-       ; tcg_env <- tcExtendGlobalValEnv [mod_id] getGblEnv
-       ; return (tcg_env { tcg_tr_module = Just mod_id }
-                 `addTypecheckedBinds` [unitBag mod_bind]) } }
-
-
-{- *********************************************************************
-*                                                                      *
-                Building type-representation bindings
-*                                                                      *
-********************************************************************* -}
-
-mkTypeableBinds :: [TyCon] -> TcM ([Id], [LHsBinds Id])
-mkTypeableBinds tycons
-  = do { dflags  <- getDynFlags
-       ; gbl_env <- getGblEnv
-       ; mod <- getModule
-       ; if mod == gHC_TYPES
-         then return ([], [])  -- 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)
-             tc_binds = map (mk_typeable_binds stuff) tycons
-             tycon_rep_ids = foldr ((++) . collectHsBindsBinders) [] tc_binds
-       ; return (tycon_rep_ids, tc_binds) } }
-
-trNameLit :: DataCon -> FastString -> LHsExpr Id
-trNameLit tr_name_dc fs
-  = nlHsApps (dataConWrapId tr_name_dc) [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
-
-mk_typeable_binds :: TypeableStuff -> TyCon -> LHsBinds Id
-mk_typeable_binds stuff tycon
-  = mkTyConRepBinds stuff tycon
-    `unionBags`
-    unionManyBags (map (mkTypeableDataConBinds stuff) (tyConDataCons tycon))
-
-mkTyConRepBinds :: TypeableStuff -> TyCon -> LHsBinds Id
-mkTyConRepBinds (dflags, mod_expr, pkg_str, mod_str, tr_datacon, trn_datacon) tycon
-  = case tyConRepName_maybe tycon of
-      Just rep_name -> unitBag (mkVarBind rep_id rep_rhs)
-         where
-           rep_id  = mkExportedLocalId ReflectionId rep_name (mkTyConApp tr_tycon [])
-      _ -> emptyBag
-  where
-    tr_tycon = dataConTyCon tr_datacon
-    rep_rhs = nlHsApps (dataConWrapId tr_datacon)
-                       [ nlHsLit (word64 high), nlHsLit (word64 low)
-                       , mod_expr
-                       , trNameLit trn_datacon (mkFastString tycon_str) ]
-
-    tycon_str = add_tick (occNameString (getOccName tycon))
-    add_tick s | isPromotedDataCon tycon = '\'' : s
-               | isPromotedTyCon   tycon = '\'' : s
-               | otherwise               = s
-
-    hashThis :: String
-    hashThis = unwords [pkg_str, mod_str, tycon_str]
-
-    Fingerprint high low
-       | gopt Opt_SuppressUniques dflags = Fingerprint 0 0
-       | otherwise                       = fingerprintString hashThis
-
-    word64 :: Word64 -> HsLit
-    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
-  = case promoteDataCon_maybe dc of
-      Promoted tc -> mkTyConRepBinds stuff tc
-      NotPromoted -> emptyBag
diff --git a/compiler/types/TyCon.hs b/compiler/types/TyCon.hs
index 21598450c2..465ccb14b6 100644
--- a/compiler/types/TyCon.hs
+++ b/compiler/types/TyCon.hs
@@ -13,8 +13,8 @@ module TyCon(
         TyCon,
 
         AlgTyConRhs(..), visibleDataCons,
-        AlgTyConFlav(..), isNoParent,
-        FamTyConFlav(..), Role(..), Promoted(..), Injectivity(..),
+        TyConParent(..), isNoParent,
+        FamTyConFlav(..), Role(..), Injectivity(..),
 
         -- ** Field labels
         tyConFieldLabels, tyConFieldLabelEnv,
@@ -42,7 +42,7 @@ module TyCon(
         mightBeUnsaturatedTyCon,
         isPromotedDataCon, isPromotedTyCon,
         isPromotedDataCon_maybe, isPromotedTyCon_maybe,
-        promotableTyCon_maybe, isPromotableTyCon, promoteTyCon,
+        promotableTyCon_maybe, promoteTyCon,
 
         isDataTyCon, isProductTyCon, isDataProductTyCon_maybe,
         isEnumerationTyCon,
@@ -71,6 +71,7 @@ module TyCon(
         tyConStupidTheta,
         tyConArity,
         tyConRoles,
+        tyConParent,
         tyConFlavour,
         tyConTuple_maybe, tyConClass_maybe,
         tyConFamInst_maybe, tyConFamInstSig_maybe, tyConFamilyCoercion_maybe,
@@ -88,9 +89,6 @@ module TyCon(
         newTyConCo, newTyConCo_maybe,
         pprPromotionQuote,
 
-        -- * Runtime type representation
-        TyConRepName, tyConRepName_maybe,
-
         -- * Primitive representations of Types
         PrimRep(..), PrimElemRep(..),
         tyConPrimRep, isVoidRep, isGcPtrRep,
@@ -192,8 +190,8 @@ See also Note [Wrappers for data instance tycons] in MkId.hs
 
   Note that this is a *representational* coercion
   The R:TInt is the "representation TyCons".
-  It has an AlgTyConFlav of
-        DataFamInstTyCon T [Int] ax_ti
+  It has an AlgTyConParent of
+        FamInstTyCon T [Int] ax_ti
 
 * The axiom ax_ti may be eta-reduced; see
   Note [Eta reduction for data family axioms] in TcInstDcls
@@ -225,9 +223,9 @@ See also Note [Wrappers for data instance tycons] in MkId.hs
   data instance declaration for T (a,b), to get the result type in the
   representation; e.g.  T (a,b) --> R:TPair a b
 
-  The representation TyCon R:TList, has an AlgTyConFlav of
+  The representation TyCon R:TList, has an AlgTyConParent of
 
-        DataFamInstTyCon T [(a,b)] ax_pr
+        FamInstTyCon T [(a,b)] ax_pr
 
 * Notice that T is NOT translated to a FC type function; it just
   becomes a "data type" with no constructors, which can be coerced inot
@@ -271,7 +269,7 @@ See also Note [Wrappers for data instance tycons] in MkId.hs
 Note [Associated families and their parent class]
 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
 *Associated* families are just like *non-associated* families, except
-that they have a famTcParent field of (Just cls), which identifies the
+that they have a TyConParent of AssocFamilyTyCon, which identifies the
 parent class.
 
 However there is an important sharing relationship between
@@ -377,26 +375,15 @@ data TyCon
         tyConKind   :: Kind,     -- ^ Kind of this TyCon (full kind, not just
                                  -- the return kind)
 
-        tyConArity  :: Arity,    -- ^ Number of arguments this TyCon must
+        tyConArity  :: Arity     -- ^ Number of arguments this TyCon must
                                  -- receive to be considered saturated
                                  -- (including implicit kind variables)
-
-        tcRepName :: TyConRepName
     }
 
-  -- | Algebraic data types, from
-  --     - @data@ declararations
-  --     - @newtype@ declarations
-  --     - data instance declarations
-  --     - type instance declarations
-  --     - the TyCon generated by a class declaration
-  --     - boxed tuples
-  --     - unboxed tuples
-  --     - constraint tuples
-  -- All these constructors are lifted and boxed except unboxed tuples
-  -- which should have an 'UnboxedAlgTyCon' parent.
-  -- Data/newtype/type /families/ are handled by 'FamilyTyCon'.
-  -- See 'AlgTyConRhs' for more information.
+  -- | Algebraic type constructors, which are defined to be those
+  -- arising @data@ type and @newtype@ declarations.  All these
+  -- constructors are lifted and boxed. See 'AlgTyConRhs' for more
+  -- information.
   | AlgTyCon {
         tyConUnique  :: Unique,  -- ^ A Unique of this TyCon. Invariant:
                                  -- identical to Unique of Name stored in
@@ -453,11 +440,12 @@ data TyCon
         algTcRec    :: RecFlag,     -- ^ Tells us whether the data type is part
                                     -- of a mutually-recursive group or not
 
-        algTcParent :: AlgTyConFlav, -- ^ Gives the class or family declaration
-                                       -- 'TyCon' for derived 'TyCon's representing
-                                       -- class or family instances, respectively.
+        algTcParent :: TyConParent, -- ^ Gives the class or family declaration
+                                    -- 'TyCon' for derived 'TyCon's representing
+                                    -- class or family instances, respectively.
+                                    -- See also 'synTcParent'
 
-        tcPromoted  :: Promoted TyCon  -- ^ Promoted TyCon, if any
+        tcPromoted  :: Maybe TyCon  -- ^ Promoted TyCon, if any
     }
 
   -- | Represents type synonyms
@@ -487,8 +475,7 @@ data TyCon
                                  -- of the synonym
     }
 
-  -- | Represents families (both type and data)
-  -- Argument roles are all Nominal
+  -- | Represents type families
   | FamilyTyCon {
         tyConUnique  :: Unique,  -- ^ A Unique of this TyCon. Invariant:
                                  -- identical to Unique of Name stored in
@@ -509,7 +496,7 @@ data TyCon
                                  -- Precisely, this list scopes over:
                                  --
                                  -- 1. The 'algTcStupidTheta'
-                                 -- 2. The cached types in 'algTyConRhs.NewTyCon'
+                                 -- 2. The cached types in algTyConRhs.NewTyCon
                                  -- 3. The family instance types if present
                                  --
                                  -- Note that it does /not/ scope over the data
@@ -524,9 +511,8 @@ data TyCon
                                       -- abstract, built-in. See comments for
                                       -- FamTyConFlav
 
-        famTcParent  :: Maybe Class,  -- ^ For *associated* type/data families
-                                      -- The class in whose declaration the family is declared
-                                      -- See Note [Associated families and their parent class]
+        famTcParent  :: TyConParent,  -- ^ TyCon of enclosing class for
+                                      -- associated type families
 
         famTcInj     :: Injectivity   -- ^ is this a type family injective in
                                       -- its type variables? Nothing if no
@@ -535,7 +521,7 @@ data TyCon
 
   -- | Primitive types; cannot be defined in Haskell. This includes
   -- the usual suspects (such as @Int#@) as well as foreign-imported
-  -- types and kinds (@*@, @#@, and @?@)
+  -- types and kinds
   | PrimTyCon {
         tyConUnique   :: Unique, -- ^ A Unique of this TyCon. Invariant:
                                  -- identical to Unique of Name stored in
@@ -559,13 +545,9 @@ data TyCon
                                  -- pointers). This 'PrimRep' holds that
                                  -- information.  Only relevant if tyConKind = *
 
-        isUnLifted   :: Bool,    -- ^ Most primitive tycons are unlifted (may
+        isUnLifted   :: Bool     -- ^ Most primitive tycons are unlifted (may
                                  -- not contain bottom) but other are lifted,
                                  -- e.g. @RealWorld@
-                                 -- Only relevant if tyConKind = *
-
-        primRepName :: Maybe TyConRepName   -- Only relevant for kind TyCons
-                                            -- i.e, *, #, ?
     }
 
   -- | Represents promoted data constructor.
@@ -575,8 +557,7 @@ data TyCon
         tyConArity  :: Arity,
         tyConKind   :: Kind,   -- ^ Translated type of the data constructor
         tcRoles     :: [Role], -- ^ Roles: N for kind vars, R for type vars
-        dataCon     :: DataCon,-- ^ Corresponding data constructor
-        tcRepName   :: TyConRepName
+        dataCon     :: DataCon -- ^ Corresponding data constructor
     }
 
   -- | Represents promoted type constructor.
@@ -585,8 +566,7 @@ data TyCon
         tyConName   :: Name,   -- ^ Same Name as the type constructor
         tyConArity  :: Arity,  -- ^ n if ty_con :: * -> ... -> *  n times
         tyConKind   :: Kind,   -- ^ Always TysPrim.superKind
-        ty_con      :: TyCon,  -- ^ Corresponding type constructor
-        tcRepName   :: TyConRepName
+        ty_con      :: TyCon   -- ^ Corresponding type constructor
     }
 
   deriving Typeable
@@ -602,6 +582,20 @@ data AlgTyConRhs
       Bool      -- True  <=> It's definitely a distinct data type,
                 --           equal only to itself; ie not a newtype
                 -- False <=> Not sure
+                -- See Note [AbstractTyCon and type equality]
+
+    -- | Represents an open type family without a fixed right hand
+    -- side.  Additional instances can appear at any time.
+    --
+    -- These are introduced by either a top level declaration:
+    --
+    -- > data T a :: *
+    --
+    -- Or an associated data type declaration, within a class declaration:
+    --
+    -- > class C a b where
+    -- >   data T b :: *
+  | DataFamilyTyCon
 
     -- | Information about those 'TyCon's derived from a @data@
     -- declaration. This includes data types with no constructors at
@@ -655,15 +649,18 @@ data AlgTyConRhs
                              -- again check Trac #1072.
     }
 
--- | Isomorphic to Maybe, but used when the question is
--- whether or not something is promoted
-data Promoted a = NotPromoted | Promoted a
+{-
+Note [AbstractTyCon and type equality]
+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+TODO
+-}
 
 -- | Extract those 'DataCon's that we are able to learn about.  Note
 -- that visibility in this sense does not correspond to visibility in
 -- the context of any particular user program!
 visibleDataCons :: AlgTyConRhs -> [DataCon]
 visibleDataCons (AbstractTyCon {})            = []
+visibleDataCons DataFamilyTyCon {}            = []
 visibleDataCons (DataTyCon{ data_cons = cs }) = cs
 visibleDataCons (NewTyCon{ data_con = c })    = [c]
 visibleDataCons (TupleTyCon{ data_con = c })  = [c]
@@ -671,35 +668,26 @@ visibleDataCons (TupleTyCon{ data_con = c })  = [c]
 -- ^ Both type classes as well as family instances imply implicit
 -- type constructors.  These implicit type constructors refer to their parent
 -- structure (ie, the class or family from which they derive) using a type of
--- the following form.
-data AlgTyConFlav
+-- the following form.  We use 'TyConParent' for both algebraic and synonym
+-- types, but the variant 'ClassTyCon' will only be used by algebraic 'TyCon's.
+data TyConParent
   = -- | An ordinary type constructor has no parent.
-    VanillaAlgTyCon
-       TyConRepName
-
-    -- | An unboxed type constructor. Note that this carries no TyConRepName
-    -- as it is not representable.
-  | UnboxedAlgTyCon
+    NoParentTyCon
 
   -- | Type constructors representing a class dictionary.
   -- See Note [ATyCon for classes] in TypeRep
   | ClassTyCon
         Class           -- INVARIANT: the classTyCon of this Class is the
                         -- current tycon
-        TyConRepName
-
-  -- | Type constructors representing an *instance* of a *data* family.
-  -- Parameters:
-  --
-  --  1) The type family in question
-  --
-  --  2) Instance types; free variables are the 'tyConTyVars'
-  --  of the current 'TyCon' (not the family one). INVARIANT:
-  --  the number of types matches the arity of the family 'TyCon'
-  --
-  --  3) A 'CoTyCon' identifying the representation
-  --  type with the type instance family
-  | DataFamInstTyCon          -- See Note [Data type families]
+
+  -- | An *associated* type of a class.
+  | AssocFamilyTyCon
+        Class           -- The class in whose declaration the family is declared
+                        -- See Note [Associated families and their parent class]
+
+  -- | Type constructors representing an instance of a *data* family.
+  -- See Note [Data type families] and source comments for more info.
+  | FamInstTyCon          -- See Note [Data type families]
         (CoAxiom Unbranched)  -- The coercion axiom.
                -- A *Representational* coercion,
                -- of kind   T ty1 ty2   ~R   R:T a b c
@@ -720,26 +708,27 @@ data AlgTyConFlav
         -- gives a representation tycon:
         --      data R:TList a = ...
         --      axiom co a :: T [a] ~ R:TList a
-        -- with R:TList's algTcParent = DataFamInstTyCon T [a] co
-
-instance Outputable AlgTyConFlav where
-    ppr (VanillaAlgTyCon {})        = text "Vanilla ADT"
-    ppr (UnboxedAlgTyCon {})        = text "Unboxed ADT"
-    ppr (ClassTyCon cls _)          = text "Class parent" <+> ppr cls
-    ppr (DataFamInstTyCon _ tc tys) =
+        -- with R:TList's algTcParent = FamInstTyCon T [a] co
+
+instance Outputable TyConParent where
+    ppr NoParentTyCon           = text "No parent"
+    ppr (ClassTyCon cls)        = text "Class parent" <+> ppr cls
+    ppr (AssocFamilyTyCon cls)  =
+        text "Class parent (assoc. family)" <+> ppr cls
+    ppr (FamInstTyCon _ tc tys) =
         text "Family parent (family instance)" <+> ppr tc <+> sep (map ppr tys)
 
--- | Checks the invariants of a 'AlgTyConFlav' given the appropriate type class
+-- | Checks the invariants of a 'TyConParent' given the appropriate type class
 -- name, if any
-okParent :: Name -> AlgTyConFlav -> Bool
-okParent _       (VanillaAlgTyCon {})            = True
-okParent _       (UnboxedAlgTyCon)               = True
-okParent tc_name (ClassTyCon cls _)              = tc_name == tyConName (classTyCon cls)
-okParent _       (DataFamInstTyCon _ fam_tc tys) = tyConArity fam_tc == length tys
+okParent :: Name -> TyConParent -> Bool
+okParent _       NoParentTyCon               = True
+okParent tc_name (AssocFamilyTyCon cls)      = tc_name `elem` map tyConName (classATs cls)
+okParent tc_name (ClassTyCon cls)            = tc_name == tyConName (classTyCon cls)
+okParent _       (FamInstTyCon _ fam_tc tys) = tyConArity fam_tc == length tys
 
-isNoParent :: AlgTyConFlav -> Bool
-isNoParent (VanillaAlgTyCon {}) = True
-isNoParent _                   = False
+isNoParent :: TyConParent -> Bool
+isNoParent NoParentTyCon = True
+isNoParent _             = False
 
 --------------------
 
@@ -750,22 +739,8 @@ data Injectivity
 
 -- | Information pertaining to the expansion of a type synonym (@type@)
 data FamTyConFlav
-  = -- | Represents an open type family without a fixed right hand
-    -- side.  Additional instances can appear at any time.
-    --
-    -- These are introduced by either a top level declaration:
-    --
-    -- > data T a :: *
-    --
-    -- Or an associated data type declaration, within a class declaration:
-    --
-    -- > class C a b where
-    -- >   data T b :: *
-     DataFamilyTyCon
-       TyConRepName
-
-     -- | An open type synonym family  e.g. @type family F x y :: * -> *@
-   | OpenSynFamilyTyCon
+  = -- | An open type synonym family  e.g. @type family F x y :: * -> *@
+     OpenSynFamilyTyCon
 
    -- | A closed type synonym family  e.g.
    -- @type family F x where { F Int = Bool }@
@@ -903,34 +878,7 @@ so the coercion tycon CoT must have
 
 ************************************************************************
 *                                                                      *
-                 TyConRepName
-*                                                                      *
-********************************************************************* -}
-
-type TyConRepName = Name -- The Name of the top-level declaration
-                         --    $tcMaybe :: Data.Typeable.Internal.TyCon
-                         --    $tcMaybe = TyCon { tyConName = "Maybe", ... }
-
-tyConRepName_maybe :: TyCon -> Maybe TyConRepName
-tyConRepName_maybe (FunTyCon   { tcRepName = rep_nm })
-  = Just rep_nm
-tyConRepName_maybe (PrimTyCon  { primRepName = mb_rep_nm })
-  = mb_rep_nm
-tyConRepName_maybe (AlgTyCon { algTcParent = parent })
-  | VanillaAlgTyCon rep_nm <- parent = Just rep_nm
-  | ClassTyCon _ rep_nm    <- parent = Just rep_nm
-tyConRepName_maybe (FamilyTyCon { famTcFlav = DataFamilyTyCon rep_nm })
-  = Just rep_nm
-tyConRepName_maybe (PromotedDataCon { tcRepName = rep_nm })
-  = Just rep_nm
-tyConRepName_maybe (PromotedTyCon { tcRepName = rep_nm })
-  = Just rep_nm
-tyConRepName_maybe _ = Nothing
-
-
-{- *********************************************************************
-*                                                                      *
-                 PrimRep
+\subsection{PrimRep}
 *                                                                      *
 ************************************************************************
 
@@ -1114,14 +1062,13 @@ So we compromise, and move their Kind calculation to the call site.
 -- | Given the name of the function type constructor and it's kind, create the
 -- corresponding 'TyCon'. It is reccomended to use 'TypeRep.funTyCon' if you want
 -- this functionality
-mkFunTyCon :: Name -> Kind -> Name -> TyCon
-mkFunTyCon name kind rep_nm
+mkFunTyCon :: Name -> Kind -> TyCon
+mkFunTyCon name kind
   = FunTyCon {
         tyConUnique = nameUnique name,
         tyConName   = name,
         tyConKind   = kind,
-        tyConArity  = 2,
-        tcRepName   = rep_nm
+        tyConArity  = 2
     }
 
 -- | This is the making of an algebraic 'TyCon'. Notably, you have to
@@ -1137,12 +1084,11 @@ mkAlgTyCon :: Name
            -> Maybe CType       -- ^ The C type this type corresponds to
                                 --   when using the CAPI FFI
            -> [PredType]        -- ^ Stupid theta: see 'algTcStupidTheta'
-           -> AlgTyConRhs       -- ^ Information about data constructors
-           -> AlgTyConFlav      -- ^ What flavour is it?
-                                -- (e.g. vanilla, type family)
+           -> AlgTyConRhs       -- ^ Information about dat aconstructors
+           -> TyConParent
            -> RecFlag           -- ^ Is the 'TyCon' recursive?
            -> Bool              -- ^ Was the 'TyCon' declared with GADT syntax?
-           -> Promoted TyCon    -- ^ Promoted version
+           -> Maybe TyCon       -- ^ Promoted version
            -> TyCon
 mkAlgTyCon name kind tyvars roles cType stupid rhs parent is_rec gadt_syn prom_tc
   = AlgTyCon {
@@ -1164,12 +1110,11 @@ mkAlgTyCon name kind tyvars roles cType stupid rhs parent is_rec gadt_syn prom_t
 
 -- | Simpler specialization of 'mkAlgTyCon' for classes
 mkClassTyCon :: Name -> Kind -> [TyVar] -> [Role] -> AlgTyConRhs -> Class
-             -> RecFlag -> Name -> TyCon
-mkClassTyCon name kind tyvars roles rhs clas is_rec tc_rep_name
-  = mkAlgTyCon name kind tyvars roles Nothing [] rhs
-               (ClassTyCon clas tc_rep_name)
+             -> RecFlag -> TyCon
+mkClassTyCon name kind tyvars roles rhs clas is_rec
+  = mkAlgTyCon name kind tyvars roles Nothing [] rhs (ClassTyCon clas)
                is_rec False
-               NotPromoted    -- Class TyCons are not promoted
+               Nothing    -- Class TyCons are not promoted
 
 mkTupleTyCon :: Name
              -> Kind    -- ^ Kind of the resulting 'TyCon'
@@ -1177,8 +1122,8 @@ mkTupleTyCon :: Name
              -> [TyVar] -- ^ 'TyVar's scoped over: see 'tyConTyVars'
              -> DataCon
              -> TupleSort    -- ^ Whether the tuple is boxed or unboxed
-             -> Promoted TyCon  -- ^ Promoted version
-             -> AlgTyConFlav
+             -> Maybe TyCon  -- ^ Promoted version
+             -> TyConParent
              -> TyCon
 mkTupleTyCon name kind arity tyvars con sort prom_tc parent
   = AlgTyCon {
@@ -1190,8 +1135,7 @@ mkTupleTyCon name kind arity tyvars con sort prom_tc parent
         tcRoles          = replicate arity Representational,
         tyConCType       = Nothing,
         algTcStupidTheta = [],
-        algTcRhs         = TupleTyCon { data_con = con,
-                                        tup_sort = sort },
+        algTcRhs         = TupleTyCon { data_con = con, tup_sort = sort },
         algTcFields      = emptyFsEnv,
         algTcParent      = parent,
         algTcRec         = NonRecursive,
@@ -1202,21 +1146,20 @@ mkTupleTyCon name kind arity tyvars con sort prom_tc parent
 -- | 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
 
 -- | Kind constructors
-mkKindTyCon :: Name -> Kind -> Name -> TyCon
-mkKindTyCon name kind rep_nm
-  = mkPrimTyCon' name kind [] VoidRep True (Just rep_nm)
+mkKindTyCon :: Name -> Kind -> TyCon
+mkKindTyCon name kind
+  = mkPrimTyCon' name kind [] VoidRep True
 
 -- | Create a lifted primitive 'TyCon' such as @RealWorld@
 mkLiftedPrimTyCon :: Name  -> Kind -> [Role] -> PrimRep -> TyCon
 mkLiftedPrimTyCon name kind roles rep
-  = mkPrimTyCon' name kind roles rep False Nothing
+  = mkPrimTyCon' name kind roles rep False
 
-mkPrimTyCon' :: Name  -> Kind -> [Role] -> PrimRep
-             -> Bool -> Maybe TyConRepName -> TyCon
-mkPrimTyCon' name kind roles rep is_unlifted rep_nm
+mkPrimTyCon' :: Name  -> Kind -> [Role] -> PrimRep -> Bool -> TyCon
+mkPrimTyCon' name kind roles rep is_unlifted
   = PrimTyCon {
         tyConName    = name,
         tyConUnique  = nameUnique name,
@@ -1224,8 +1167,7 @@ mkPrimTyCon' name kind roles rep is_unlifted rep_nm
         tyConArity   = length roles,
         tcRoles      = roles,
         primTyConRep = rep,
-        isUnLifted   = is_unlifted,
-        primRepName  = rep_nm
+        isUnLifted   = is_unlifted
     }
 
 -- | Create a type synonym 'TyCon'
@@ -1243,7 +1185,7 @@ mkSynonymTyCon name kind tyvars roles rhs
 
 -- | Create a type family 'TyCon'
 mkFamilyTyCon:: Name -> Kind -> [TyVar] -> Maybe Name -> FamTyConFlav
-             -> Maybe Class -> Injectivity -> TyCon
+             -> TyConParent -> Injectivity -> TyCon
 mkFamilyTyCon name kind tyvars resVar flav parent inj
   = FamilyTyCon
       { tyConUnique = nameUnique name
@@ -1262,16 +1204,15 @@ mkFamilyTyCon name kind tyvars resVar flav parent inj
 -- Somewhat dodgily, we give it the same Name
 -- as the data constructor itself; when we pretty-print
 -- the TyCon we add a quote; see the Outputable TyCon instance
-mkPromotedDataCon :: DataCon -> Name -> TyConRepName -> Kind -> [Role] -> TyCon
-mkPromotedDataCon con name rep_name kind roles
+mkPromotedDataCon :: DataCon -> Name -> Unique -> Kind -> [Role] -> TyCon
+mkPromotedDataCon con name unique kind roles
   = PromotedDataCon {
-        tyConUnique = nameUnique name,
         tyConName   = name,
+        tyConUnique = unique,
         tyConArity  = arity,
         tcRoles     = roles,
         tyConKind   = kind,
-        dataCon     = con,
-        tcRepName   = rep_name
+        dataCon     = con
   }
   where
     arity = length roles
@@ -1286,11 +1227,7 @@ mkPromotedTyCon tc kind
         tyConUnique = getUnique tc,
         tyConArity  = tyConArity tc,
         tyConKind   = kind,
-        ty_con      = tc,
-        tcRepName   = case tyConRepName_maybe tc of
-                        Just rep_nm -> rep_nm
-                        Nothing     -> pprPanic "mkPromotedTyCon" (ppr tc)
-                      -- Promoted TyCons always have a TyConRepName
+        ty_con      = tc
   }
 
 isFunTyCon :: TyCon -> Bool
@@ -1347,6 +1284,7 @@ isDataTyCon (AlgTyCon {algTcRhs = rhs})
                            -> isBoxed (tupleSortBoxity sort)
         DataTyCon {}       -> True
         NewTyCon {}        -> False
+        DataFamilyTyCon {} -> False
         AbstractTyCon {}   -> False      -- We don't know, so return False
 isDataTyCon _ = False
 
@@ -1362,8 +1300,7 @@ isInjectiveTyCon (AlgTyCon {})                 Nominal          = True
 isInjectiveTyCon (AlgTyCon {algTcRhs = rhs})   Representational
   = isGenInjAlgRhs rhs
 isInjectiveTyCon (SynonymTyCon {})             _                = False
-isInjectiveTyCon (FamilyTyCon {famTcFlav = flav}) Nominal       = isDataFamFlav flav
-isInjectiveTyCon (FamilyTyCon {})              Representational = False
+isInjectiveTyCon (FamilyTyCon {})              _                = False
 isInjectiveTyCon (PrimTyCon {})                _                = True
 isInjectiveTyCon (PromotedDataCon {})          _                = True
 isInjectiveTyCon (PromotedTyCon {ty_con = tc}) r
@@ -1383,6 +1320,7 @@ isGenerativeTyCon = isInjectiveTyCon
 isGenInjAlgRhs :: AlgTyConRhs -> Bool
 isGenInjAlgRhs (TupleTyCon {})          = True
 isGenInjAlgRhs (DataTyCon {})           = True
+isGenInjAlgRhs (DataFamilyTyCon {})     = False
 isGenInjAlgRhs (AbstractTyCon distinct) = distinct
 isGenInjAlgRhs (NewTyCon {})            = False
 
@@ -1471,7 +1409,8 @@ isTypeSynonymTyCon _                 = False
 -- right hand side to which a synonym family application can expand.
 --
 
--- | True iff we can decompose (T a b c) into ((T a b) c)
+mightBeUnsaturatedTyCon :: TyCon -> Bool
+-- True iff we can decompose (T a b c) into ((T a b) c)
 --   I.e. is it injective and generative w.r.t nominal equality?
 --   That is, if (T a b) ~N d e f, is it always the case that
 --            (T ~N d), (a ~N e) and (b ~N f)?
@@ -1480,9 +1419,8 @@ isTypeSynonymTyCon _                 = False
 -- It'd be unusual to call mightBeUnsaturatedTyCon on a regular H98
 -- type synonym, because you should probably have expanded it first
 -- But regardless, it's not decomposable
-mightBeUnsaturatedTyCon :: TyCon -> Bool
 mightBeUnsaturatedTyCon (SynonymTyCon {}) = False
-mightBeUnsaturatedTyCon (FamilyTyCon  { famTcFlav = flav}) = isDataFamFlav flav
+mightBeUnsaturatedTyCon (FamilyTyCon  {}) = False
 mightBeUnsaturatedTyCon _other            = True
 
 -- | Is this an algebraic 'TyCon' declared with the GADT syntax?
@@ -1502,26 +1440,21 @@ isEnumerationTyCon _ = False
 
 -- | Is this a 'TyCon', synonym or otherwise, that defines a family?
 isFamilyTyCon :: TyCon -> Bool
-isFamilyTyCon (FamilyTyCon {}) = True
-isFamilyTyCon _                = False
+isFamilyTyCon (FamilyTyCon {})                           = True
+isFamilyTyCon (AlgTyCon {algTcRhs = DataFamilyTyCon {}}) = True
+isFamilyTyCon _                                          = False
 
 -- | Is this a 'TyCon', synonym or otherwise, that defines a family with
 -- instances?
 isOpenFamilyTyCon :: TyCon -> Bool
-isOpenFamilyTyCon (FamilyTyCon {famTcFlav = flav })
-  | OpenSynFamilyTyCon <- flav = True
-  | DataFamilyTyCon {} <- flav = True
-isOpenFamilyTyCon _            = False
+isOpenFamilyTyCon (FamilyTyCon {famTcFlav = OpenSynFamilyTyCon }) = True
+isOpenFamilyTyCon (AlgTyCon    {algTcRhs  = DataFamilyTyCon    }) = True
+isOpenFamilyTyCon _                                               = False
 
 -- | Is this a synonym 'TyCon' that can have may have further instances appear?
 isTypeFamilyTyCon :: TyCon -> Bool
-isTypeFamilyTyCon (FamilyTyCon { famTcFlav = flav }) = not (isDataFamFlav flav)
-isTypeFamilyTyCon _                                  = False
-
--- | Is this a synonym 'TyCon' that can have may have further instances appear?
-isDataFamilyTyCon :: TyCon -> Bool
-isDataFamilyTyCon (FamilyTyCon { famTcFlav = flav }) = isDataFamFlav flav
-isDataFamilyTyCon _                                  = False
+isTypeFamilyTyCon (FamilyTyCon {}) = True
+isTypeFamilyTyCon _                = False
 
 -- | Is this an open type family TyCon?
 isOpenTypeFamilyTyCon :: TyCon -> Bool
@@ -1546,9 +1479,10 @@ isBuiltInSynFamTyCon_maybe
   (FamilyTyCon {famTcFlav = BuiltInSynFamTyCon ops }) = Just ops
 isBuiltInSynFamTyCon_maybe _                          = Nothing
 
-isDataFamFlav :: FamTyConFlav -> Bool
-isDataFamFlav (DataFamilyTyCon {}) = True   -- Data family
-isDataFamFlav _                    = False  -- Type synonym family
+-- | Is this a synonym 'TyCon' that can have may have further instances appear?
+isDataFamilyTyCon :: TyCon -> Bool
+isDataFamilyTyCon (AlgTyCon {algTcRhs = DataFamilyTyCon {}}) = True
+isDataFamilyTyCon _ = False
 
 -- | Are we able to extract information 'TyVar' to class argument list
 -- mapping from a given 'TyCon'?
@@ -1556,8 +1490,9 @@ isTyConAssoc :: TyCon -> Bool
 isTyConAssoc tc = isJust (tyConAssoc_maybe tc)
 
 tyConAssoc_maybe :: TyCon -> Maybe Class
-tyConAssoc_maybe (FamilyTyCon { famTcParent = mb_cls }) = mb_cls
-tyConAssoc_maybe _                                      = Nothing
+tyConAssoc_maybe tc = case tyConParent tc of
+                        AssocFamilyTyCon cls -> Just cls
+                        _                    -> Nothing
 
 -- The unit tycon didn't used to be classed as a tuple tycon
 -- but I thought that was silly so I've undone it
@@ -1596,19 +1531,14 @@ isRecursiveTyCon :: TyCon -> Bool
 isRecursiveTyCon (AlgTyCon {algTcRec = Recursive}) = True
 isRecursiveTyCon _                                 = False
 
-promotableTyCon_maybe :: TyCon -> Promoted TyCon
+promotableTyCon_maybe :: TyCon -> Maybe TyCon
 promotableTyCon_maybe (AlgTyCon { tcPromoted = prom })   = prom
-promotableTyCon_maybe _                                  = NotPromoted
-
-isPromotableTyCon :: TyCon -> Bool
-isPromotableTyCon tc = case promotableTyCon_maybe tc of
-                         Promoted {} -> True
-                         NotPromoted -> False
+promotableTyCon_maybe _                                  = Nothing
 
 promoteTyCon :: TyCon -> TyCon
 promoteTyCon tc = case promotableTyCon_maybe tc of
-                    Promoted prom_tc -> prom_tc
-                    NotPromoted      -> pprPanic "promoteTyCon" (ppr tc)
+                    Just prom_tc -> prom_tc
+                    Nothing      -> pprPanic "promoteTyCon" (ppr tc)
 
 -- | Is this a PromotedTyCon?
 isPromotedTyCon :: TyCon -> Bool
@@ -1650,10 +1580,13 @@ isImplicitTyCon (FunTyCon {})        = True
 isImplicitTyCon (PrimTyCon {})       = True
 isImplicitTyCon (PromotedDataCon {}) = True
 isImplicitTyCon (PromotedTyCon {})   = True
-isImplicitTyCon (AlgTyCon { algTcRhs = rhs, tyConName = name })
+isImplicitTyCon (AlgTyCon { algTcRhs = rhs, algTcParent = parent, tyConName = name })
   | TupleTyCon {} <- rhs             = isWiredInName name
+  | AssocFamilyTyCon {} <- parent    = True
+  | otherwise                        = False
+isImplicitTyCon (FamilyTyCon { famTcParent = parent })
+  | AssocFamilyTyCon {} <- parent    = True
   | otherwise                        = False
-isImplicitTyCon (FamilyTyCon { famTcParent = parent }) = isJust parent
 isImplicitTyCon (SynonymTyCon {})    = False
 
 tyConCType_maybe :: TyCon -> Maybe CType
@@ -1746,6 +1679,7 @@ tyConFamilySize tc@(AlgTyCon { algTcRhs = rhs })
       DataTyCon { data_cons = cons } -> length cons
       NewTyCon {}                    -> 1
       TupleTyCon {}                  -> 1
+      DataFamilyTyCon {}             -> 0
       _                              -> pprPanic "tyConFamilySize 1" (ppr tc)
 tyConFamilySize tc = pprPanic "tyConFamilySize 2" (ppr tc)
 
@@ -1842,41 +1776,50 @@ famTyConFlav_maybe _                                = Nothing
 
 -- | Is this 'TyCon' that for a class instance?
 isClassTyCon :: TyCon -> Bool
-isClassTyCon (AlgTyCon {algTcParent = ClassTyCon {}}) = True
-isClassTyCon _                                        = False
+isClassTyCon (AlgTyCon {algTcParent = ClassTyCon _}) = True
+isClassTyCon _                                       = False
 
 -- | If this 'TyCon' is that for a class instance, return the class it is for.
 -- Otherwise returns @Nothing@
 tyConClass_maybe :: TyCon -> Maybe Class
-tyConClass_maybe (AlgTyCon {algTcParent = ClassTyCon clas _}) = Just clas
-tyConClass_maybe _                                            = Nothing
+tyConClass_maybe (AlgTyCon {algTcParent = ClassTyCon clas}) = Just clas
+tyConClass_maybe _                                          = Nothing
+
+----------------------------------------------------------------------------
+tyConParent :: TyCon -> TyConParent
+tyConParent (AlgTyCon    {algTcParent = parent}) = parent
+tyConParent (FamilyTyCon {famTcParent = parent}) = parent
+tyConParent _                                    = NoParentTyCon
 
 ----------------------------------------------------------------------------
 -- | Is this 'TyCon' that for a data family instance?
 isFamInstTyCon :: TyCon -> Bool
-isFamInstTyCon (AlgTyCon {algTcParent = DataFamInstTyCon {} })
-  = True
-isFamInstTyCon _ = False
+isFamInstTyCon tc = case tyConParent tc of
+                      FamInstTyCon {} -> True
+                      _               -> False
 
 tyConFamInstSig_maybe :: TyCon -> Maybe (TyCon, [Type], CoAxiom Unbranched)
-tyConFamInstSig_maybe (AlgTyCon {algTcParent = DataFamInstTyCon ax f ts })
-  = Just (f, ts, ax)
-tyConFamInstSig_maybe _ = Nothing
+tyConFamInstSig_maybe tc
+  = case tyConParent tc of
+      FamInstTyCon ax f ts -> Just (f, ts, ax)
+      _                    -> Nothing
 
--- | If this 'TyCon' is that of a data family instance, return the family in question
+-- | If this 'TyCon' is that of a family instance, return the family in question
 -- and the instance types. Otherwise, return @Nothing@
 tyConFamInst_maybe :: TyCon -> Maybe (TyCon, [Type])
-tyConFamInst_maybe (AlgTyCon {algTcParent = DataFamInstTyCon _ f ts })
-  = Just (f, ts)
-tyConFamInst_maybe _ = Nothing
+tyConFamInst_maybe tc
+  = case tyConParent tc of
+      FamInstTyCon _ f ts -> Just (f, ts)
+      _                   -> Nothing
 
--- | If this 'TyCon' is that of a data family instance, return a 'TyCon' which
+-- | If this 'TyCon' is that of a family instance, return a 'TyCon' which
 -- represents a coercion identifying the representation type with the type
 -- instance family.  Otherwise, return @Nothing@
 tyConFamilyCoercion_maybe :: TyCon -> Maybe (CoAxiom Unbranched)
-tyConFamilyCoercion_maybe (AlgTyCon {algTcParent = DataFamInstTyCon ax _ _ })
-  = Just ax
-tyConFamilyCoercion_maybe _ = Nothing
+tyConFamilyCoercion_maybe tc
+  = case tyConParent tc of
+      FamInstTyCon co _ _ -> Just co
+      _                   -> Nothing
 
 {-
 ************************************************************************
@@ -1912,17 +1855,16 @@ instance Outputable TyCon where
 
 tyConFlavour :: TyCon -> String
 tyConFlavour (AlgTyCon { algTcParent = parent, algTcRhs = rhs })
-  | ClassTyCon _ _ <- parent = "class"
+  | ClassTyCon _ <- parent = "class"
   | otherwise = case rhs of
                   TupleTyCon { tup_sort = sort }
                      | isBoxed (tupleSortBoxity sort) -> "tuple"
                      | otherwise                      -> "unboxed tuple"
                   DataTyCon {}       -> "data type"
                   NewTyCon {}        -> "newtype"
+                  DataFamilyTyCon {} -> "data family"
                   AbstractTyCon {}   -> "abstract type"
-tyConFlavour (FamilyTyCon { famTcFlav = flav })
-  | isDataFamFlav flav            = "data family"
-  | otherwise                     = "type family"
+tyConFlavour (FamilyTyCon {})     = "type family"
 tyConFlavour (SynonymTyCon {})    = "type synonym"
 tyConFlavour (FunTyCon {})        = "built-in type"
 tyConFlavour (PrimTyCon {})       = "built-in type"
@@ -1930,16 +1872,14 @@ tyConFlavour (PromotedDataCon {}) = "promoted data constructor"
 tyConFlavour (PromotedTyCon {})   = "promoted type constructor"
 
 pprPromotionQuote :: TyCon -> SDoc
--- Promoted data constructors already have a tick in their OccName
-pprPromotionQuote tc
-  = case tc of
-      PromotedDataCon {} -> char '\'' -- Always quote promoted DataCons in types
-
-      PromotedTyCon {}   -> ifPprDebug (char '\'')
-                            -- However, we don't quote TyCons in kinds, except with -dppr-debug
-                            -- e.g. type family T a :: Bool -> *
-                            -- cf Trac #5952.
-      _                  -> empty
+pprPromotionQuote (PromotedDataCon {}) = char '\''   -- Quote promoted DataCons
+                                                     -- in types
+pprPromotionQuote (PromotedTyCon {})   = ifPprDebug (char '\'')
+pprPromotionQuote _                    = empty -- However, we don't quote TyCons
+                                               -- in kinds e.g.
+                                               -- type family T a :: Bool -> *
+                                               -- cf Trac #5952.
+                                               -- Except with -dppr-debug
 
 instance NamedThing TyCon where
     getName = tyConName
diff --git a/compiler/types/Type.hs b/compiler/types/Type.hs
index 0c8ed35776..a2feeef723 100644
--- a/compiler/types/Type.hs
+++ b/compiler/types/Type.hs
@@ -30,7 +30,6 @@ module Type (
         mkTyConApp, mkTyConTy,
         tyConAppTyCon_maybe, tyConAppArgs_maybe, tyConAppTyCon, tyConAppArgs,
         splitTyConApp_maybe, splitTyConApp, tyConAppArgN, nextRole,
-        splitTyConArgs,
 
         mkForAllTy, mkForAllTys, splitForAllTy_maybe, splitForAllTys,
         mkPiKinds, mkPiType, mkPiTypes,
@@ -596,14 +595,6 @@ nextRole ty
   | otherwise
   = Nominal
 
-splitTyConArgs :: TyCon -> [KindOrType] -> ([Kind], [Type])
--- Given a tycon app (T k1 .. kn t1 .. tm), split the kind and type args
--- TyCons always have prenex kinds
-splitTyConArgs tc kts
-  = splitAtList kind_vars kts
-  where
-  (kind_vars, _) = splitForAllTys (tyConKind tc)
-
 newTyConInstRhs :: TyCon -> [Type] -> Type
 -- ^ Unwrap one 'layer' of newtype on a type constructor and its
 -- arguments, using an eta-reduced version of the @newtype@ if possible.
diff --git a/compiler/utils/Binary.hs b/compiler/utils/Binary.hs
index 5083804d6f..8946b6cf62 100644
--- a/compiler/utils/Binary.hs
+++ b/compiler/utils/Binary.hs
@@ -76,6 +76,7 @@ import Data.IORef
 import Data.Char                ( ord, chr )
 import Data.Time
 import Data.Typeable
+import Data.Typeable.Internal
 import Control.Monad            ( when )
 import System.IO as IO
 import System.IO.Unsafe         ( unsafeInterleaveIO )
@@ -553,14 +554,10 @@ instance Binary (Bin a) where
 -- Instances for Data.Typeable stuff
 
 instance Binary TyCon where
-    put_ bh tc = do
-        put_ bh (tyConPackage tc)
-        put_ bh (tyConModule tc)
-        put_ bh (tyConName tc)
+    put_ bh (TyCon _ p m n) = do
+        put_ bh (p,m,n)
     get bh = do
-        p <- get bh
-        m <- get bh
-        n <- get bh
+        (p,m,n) <- get bh
         return (mkTyCon3 p m n)
 
 instance Binary TypeRep where
diff --git a/compiler/vectorise/Vectorise/Generic/PData.hs b/compiler/vectorise/Vectorise/Generic/PData.hs
index b69a773626..fc0192c744 100644
--- a/compiler/vectorise/Vectorise/Generic/PData.hs
+++ b/compiler/vectorise/Vectorise/Generic/PData.hs
@@ -59,7 +59,7 @@ buildDataFamInst name' fam_tc vect_tc rhs
                            rec_flag    -- FIXME: is this ok?
                            False       -- Not promotable
                            False       -- not GADT syntax
-                           (DataFamInstTyCon ax fam_tc pat_tys)
+                           (FamInstTyCon ax fam_tc pat_tys)
       ; liftDs $ newFamInst (DataFamilyInst rep_tc) ax }
  where
     tyvars    = tyConTyVars vect_tc
@@ -79,7 +79,6 @@ buildPDataDataCon orig_name vect_tc repr_tc repr
       fam_envs  <- readGEnv global_fam_inst_env
       liftDs $ buildDataCon fam_envs dc_name
                             False                  -- not infix
-                            NotPromoted            -- not promotable
                             (map (const no_bang) comp_tys)
                             (Just $ map (const HsLazy) comp_tys)
                             []                     -- no field labels
@@ -122,7 +121,6 @@ buildPDatasDataCon orig_name vect_tc repr_tc repr
       fam_envs <- readGEnv global_fam_inst_env
       liftDs $ buildDataCon fam_envs dc_name
                             False                  -- not infix
-                            NotPromoted            -- not promotable
                             (map (const no_bang) comp_tys)
                             (Just $ map (const HsLazy) comp_tys)
                             []                     -- no field labels
diff --git a/compiler/vectorise/Vectorise/Type/Env.hs b/compiler/vectorise/Vectorise/Type/Env.hs
index 8396e2cafa..47b1caa516 100644
--- a/compiler/vectorise/Vectorise/Type/Env.hs
+++ b/compiler/vectorise/Vectorise/Type/Env.hs
@@ -323,9 +323,7 @@ vectTypeEnv tycons vectTypeDecls vectClassDecls
     addParallelTyConAndCons tycon
       = do
         { addGlobalParallelTyCon tycon
-        ; mapM_ addGlobalParallelVar [ id | dc <- tyConDataCons tycon
-                                          , AnId id <- dataConImplicitTyThings dc ]
-                                          -- Ignoring the promoted tycon; hope that's ok
+        ; mapM_ addGlobalParallelVar . concatMap dataConImplicitIds . tyConDataCons $ tycon
         }
 
     -- Add a mapping from the original to vectorised type constructor to the vectorisation map.  
diff --git a/compiler/vectorise/Vectorise/Type/TyConDecl.hs b/compiler/vectorise/Vectorise/Type/TyConDecl.hs
index 40f28d18d8..910aba473a 100644
--- a/compiler/vectorise/Vectorise/Type/TyConDecl.hs
+++ b/compiler/vectorise/Vectorise/Type/TyConDecl.hs
@@ -7,7 +7,6 @@ import Vectorise.Type.Type
 import Vectorise.Monad
 import Vectorise.Env( GlobalEnv( global_fam_inst_env ) )
 import BuildTyCl( buildClass, buildDataCon )
-import OccName
 import Class
 import Type
 import TyCon
@@ -99,7 +98,6 @@ vectTyConDecl tycon name'
              gadt_flag = isGadtSyntaxTyCon tycon
 
            -- build the vectorised type constructor
-       ; tc_rep_name <- mkDerivedName mkTyConRepUserOcc name'
        ; return $ buildAlgTyCon
                     name'                   -- new name
                     (tyConTyVars tycon)     -- keep original type vars
@@ -110,7 +108,7 @@ vectTyConDecl tycon name'
                     rec_flag                -- whether recursive
                     False                   -- Not promotable
                     gadt_flag               -- whether in GADT syntax
-                    (VanillaAlgTyCon tc_rep_name)
+                    NoParentTyCon
        }
 
   -- some other crazy thing that we don't handle
@@ -137,6 +135,8 @@ vectAlgTyConRhs :: TyCon -> AlgTyConRhs -> VM AlgTyConRhs
 vectAlgTyConRhs tc (AbstractTyCon {})
   = do dflags <- getDynFlags
        cantVectorise dflags "Can't vectorise imported abstract type" (ppr tc)
+vectAlgTyConRhs _tc DataFamilyTyCon
+  = return DataFamilyTyCon
 vectAlgTyConRhs _tc (DataTyCon { data_cons = data_cons
                                , is_enum   = is_enum
                                })
@@ -184,7 +184,6 @@ vectDataCon dc
        ; liftDs $ buildDataCon fam_envs
                     name'
                     (dataConIsInfix dc)            -- infix if the original is
-                    NotPromoted                    -- Vectorised type is not promotable
                     (dataConSrcBangs dc)           -- strictness as original constructor
                     (Just $ dataConImplBangs dc)
                     []                             -- no labelled fields for now