Extend nullary TyConApp optimisation to all TyCons

See Note [Sharing nullary TyConApps] in GHC.Core.TyCon.

Closes #19367.

Metric Decrease:
    T9872a
    T9872b
    T9872c

8 files changed, 218 insertions, 174 deletions

diff --git a/compiler/GHC/Builtin/Types.hs b/compiler/GHC/Builtin/Types.hs
index 9957e0bed7..924ce6648d 100644
--- a/compiler/GHC/Builtin/Types.hs
+++ b/compiler/GHC/Builtin/Types.hs
@@ -692,9 +692,9 @@ constraintKindTyCon = pcTyCon constraintKindTyConName Nothing [] []
 
 -- See Note [Prefer Type over TYPE 'LiftedRep] in GHC.Core.TyCo.Rep.
 liftedTypeKind, typeToTypeKind, constraintKind :: Kind
-liftedTypeKind   = TyCoRep.TyConApp liftedTypeKindTyCon []
+liftedTypeKind   = mkTyConTy liftedTypeKindTyCon
 typeToTypeKind   = liftedTypeKind `mkVisFunTyMany` liftedTypeKind
-constraintKind   = mkTyConApp constraintKindTyCon []
+constraintKind   = mkTyConTy constraintKindTyCon
 
 {-
 ************************************************************************
diff --git a/compiler/GHC/Builtin/Types/Prim.hs b/compiler/GHC/Builtin/Types/Prim.hs
index 61f341a0bb..89093a2350 100644
--- a/compiler/GHC/Builtin/Types/Prim.hs
+++ b/compiler/GHC/Builtin/Types/Prim.hs
@@ -126,6 +126,7 @@ import GHC.Utils.Outputable
 import GHC.Utils.Panic
 import GHC.Core.TyCo.Rep -- Doesn't need special access, but this is easier to avoid
                          -- import loops which show up if you import Type instead
+import {-# SOURCE #-} GHC.Core.Type ( mkTyConTy )
 
 import Data.Char
 
diff --git a/compiler/GHC/Core/TyCo/Rep.hs b/compiler/GHC/Core/TyCo/Rep.hs
index 7414bc18da..2d9867e427 100644
--- a/compiler/GHC/Core/TyCo/Rep.hs
+++ b/compiler/GHC/Core/TyCo/Rep.hs
@@ -42,7 +42,7 @@ module GHC.Core.TyCo.Rep (
         MCoercion(..), MCoercionR, MCoercionN,
 
         -- * Functions over types
-        mkTyConTy, mkTyVarTy, mkTyVarTys,
+        mkTyConTy_, mkTyVarTy, mkTyVarTys,
         mkTyCoVarTy, mkTyCoVarTys,
         mkFunTy, mkVisFunTy, mkInvisFunTy, mkVisFunTys,
         mkForAllTy, mkForAllTys, mkInvisForAllTys,
@@ -51,7 +51,6 @@ module GHC.Core.TyCo.Rep (
         mkScaledFunTy,
         mkVisFunTyMany, mkVisFunTysMany,
         mkInvisFunTyMany, mkInvisFunTysMany,
-        mkTyConApp,
         tYPE,
 
         -- * Functions over binders
@@ -91,8 +90,8 @@ import GHC.Core.TyCon
 import GHC.Core.Coercion.Axiom
 
 -- others
-import GHC.Builtin.Names ( liftedTypeKindTyConKey, liftedRepDataConKey, manyDataConKey, tYPETyConKey )
-import {-# SOURCE #-} GHC.Builtin.Types ( liftedTypeKindTyCon, liftedTypeKind, manyDataConTy )
+import GHC.Builtin.Names ( liftedRepDataConKey )
+import {-# SOURCE #-} GHC.Builtin.Types ( liftedTypeKind, manyDataConTy )
 import {-# SOURCE #-} GHC.Builtin.Types.Prim ( tYPETyCon )
 import GHC.Types.Basic ( LeftOrRight(..), pickLR )
 import GHC.Types.Unique ( hasKey, Uniquable(..) )
@@ -1004,35 +1003,11 @@ mkPiTy (Named (Bndr tv vis)) ty = mkForAllTy tv vis ty
 mkPiTys :: [TyCoBinder] -> Type -> Type
 mkPiTys tbs ty = foldr mkPiTy ty tbs
 
--- | Create the plain type constructor type which has been applied to no type arguments at all.
-mkTyConTy :: TyCon -> Type
-mkTyConTy tycon = TyConApp tycon []
-
--- | A key function: builds a 'TyConApp' or 'FunTy' as appropriate to
--- its arguments.  Applies its arguments to the constructor from left to right.
-mkTyConApp :: TyCon -> [Type] -> Type
-mkTyConApp tycon tys
-  | isFunTyCon tycon
-  , [w, _rep1,_rep2,ty1,ty2] <- tys
-  -- The FunTyCon (->) is always a visible one
-  = FunTy { ft_af = VisArg, ft_mult = w, ft_arg = ty1, ft_res = ty2 }
-
-  -- See Note [Prefer Type over TYPE 'LiftedRep]
-  | tycon `hasKey` liftedTypeKindTyConKey
-  = ASSERT2( null tys, ppr tycon $$ ppr tys )
-    liftedTypeKindTyConApp
-  | tycon `hasKey` manyDataConKey
-  -- There are a lot of occurrences of 'Many' so it's a small optimisation to
-  -- avoid reboxing every time `mkTyConApp` is called.
-  = ASSERT2( null tys, ppr tycon $$ ppr tys )
-    manyDataConTy
-  -- See Note [Prefer Type over TYPE 'LiftedRep].
-  | tycon `hasKey` tYPETyConKey
-  , [rep] <- tys
-  = tYPE rep
-  -- The catch-all case
-  | otherwise
-  = TyConApp tycon tys
+-- | Create a nullary 'TyConApp'. In general you should rather use
+-- 'GHC.Core.Type.mkTyConTy'. This merely exists to break the import cycle
+-- between 'GHC.Core.TyCon' and this module.
+mkTyConTy_ :: TyCon -> Type
+mkTyConTy_ tycon = TyConApp tycon []
 
 {-
 Note [Prefer Type over TYPE 'LiftedRep]
@@ -1079,16 +1054,9 @@ To accomplish these we use a number of tricks:
     (namely 'GHC.Builtin.Types.Prim.liftedTypeKind'), ensuring that we
     don't need to allocate such types (goal (a)).
 
- 3. To avoid allocating 'TyConApp' constructors the
-    'GHC.Builtin.Types.Prim.tYPE' function catches the lifted case and returns
-    `liftedTypeKind` instead of building an application (goal (a)).
-
- 4. Similarly, 'Type.mkTyConApp' catches applications of `TYPE` and
-    handles them using 'GHC.Builtin.Types.Prim.tYPE', ensuring
-    that it benefits from the optimisation described above (goal (a)).
-
-Note that it's quite important that we do not define 'liftedTypeKind' in terms
-of 'mkTyConApp' since this tricks (1) and (4) would then result in a loop.
+ 3. We use the sharing mechanism described in Note [Sharing nullary TyConApps]
+    in GHC.Core.TyCon to ensure that we never need to allocate such
+    nullary applications (goal (a)).
 
 See #17958.
 -}
@@ -1101,12 +1069,6 @@ tYPE (TyConApp tc [])
   | tc `hasKey` liftedRepDataConKey = liftedTypeKind  -- TYPE 'LiftedRep
 tYPE rr = TyConApp tYPETyCon [rr]
 
--- This is a single, global definition of the type `Type`
--- Defined here so it is only allocated once.
--- See Note [Prefer Type over TYPE 'LiftedRep] in this module.
-liftedTypeKindTyConApp :: Type
-liftedTypeKindTyConApp = TyConApp liftedTypeKindTyCon []
-
 {-
 %************************************************************************
 %*                                                                      *
diff --git a/compiler/GHC/Core/TyCo/Rep.hs-boot b/compiler/GHC/Core/TyCo/Rep.hs-boot
index cb675327b7..614a596bbe 100644
--- a/compiler/GHC/Core/TyCo/Rep.hs-boot
+++ b/compiler/GHC/Core/TyCo/Rep.hs-boot
@@ -3,6 +3,7 @@ module GHC.Core.TyCo.Rep where
 import GHC.Utils.Outputable ( Outputable )
 import Data.Data  ( Data )
 import {-# SOURCE #-} GHC.Types.Var( Var, ArgFlag, AnonArgFlag )
+import {-# SOURCE #-} GHC.Core.TyCon ( TyCon )
 
 data Type
 data Coercion
@@ -22,6 +23,7 @@ type MCoercionN = MCoercion
 
 mkFunTyMany :: AnonArgFlag -> Type -> Type -> Type
 mkForAllTy :: Var -> ArgFlag -> Type -> Type
+mkTyConTy_ :: TyCon -> Type
 
 instance Data Type  -- To support Data instances in GHC.Core.Coercion.Axiom
 instance Outputable Type
diff --git a/compiler/GHC/Core/TyCo/Subst.hs b/compiler/GHC/Core/TyCo/Subst.hs
index 7ea61bdae2..6394879e8c 100644
--- a/compiler/GHC/Core/TyCo/Subst.hs
+++ b/compiler/GHC/Core/TyCo/Subst.hs
@@ -57,7 +57,7 @@ module GHC.Core.TyCo.Subst
 import GHC.Prelude
 
 import {-# SOURCE #-} GHC.Core.Type
-   ( mkCastTy, mkAppTy, isCoercionTy )
+   ( mkCastTy, mkAppTy, isCoercionTy, mkTyConApp )
 import {-# SOURCE #-} GHC.Core.Coercion
    ( mkCoVarCo, mkKindCo, mkNthCo, mkTransCo
    , mkNomReflCo, mkSubCo, mkSymCo
diff --git a/compiler/GHC/Core/TyCon.hs b/compiler/GHC/Core/TyCon.hs
index 2684a4d6d4..babcbce347 100644
--- a/compiler/GHC/Core/TyCon.hs
+++ b/compiler/GHC/Core/TyCon.hs
@@ -88,6 +88,7 @@ module GHC.Core.TyCon(
         tyConFamilySize,
         tyConStupidTheta,
         tyConArity,
+        tyConNullaryTy,
         tyConRoles,
         tyConFlavour,
         tyConTuple_maybe, tyConClass_maybe, tyConATs,
@@ -135,7 +136,7 @@ import GHC.Prelude
 import GHC.Platform
 
 import {-# SOURCE #-} GHC.Core.TyCo.Rep
-   ( Kind, Type, PredType, mkForAllTy, mkFunTyMany )
+   ( Kind, Type, PredType, mkForAllTy, mkFunTyMany, mkTyConTy_ )
 import {-# SOURCE #-} GHC.Core.TyCo.Ppr
    ( pprType )
 import {-# SOURCE #-} GHC.Builtin.Types
@@ -417,6 +418,20 @@ See also:
  * [Verifying injectivity annotation] in GHC.Core.FamInstEnv
  * [Type inference for type families with injectivity] in GHC.Tc.Solver.Interact
 
+Note [Sharing nullary TyConApps]
+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+Nullary type constructor applications are extremely common. For this reason
+each TyCon carries with it a @TyConApp tycon []@. This ensures that
+'mkTyConTy' does not need to allocate and eliminates quite a bit of heap
+residency. Furthermore, we use 'mkTyConTy' in the nullary case of 'mkTyConApp',
+ensuring that this function also benefits from sharing.
+
+This optimisation improves allocations in the Cabal test by around 0.3% and
+decreased cache misses measurably.
+
+See #19367.
+
+
 ************************************************************************
 *                                                                      *
                     TyConBinder, TyConTyCoBinder
@@ -718,6 +733,7 @@ data TyCon
         tyConResKind :: Kind,             -- ^ Result kind
         tyConKind    :: Kind,             -- ^ Kind of this TyCon
         tyConArity   :: Arity,            -- ^ Arity
+        tyConNullaryTy :: Type,
 
         tcRepName :: TyConRepName
     }
@@ -748,6 +764,7 @@ data TyCon
         tyConResKind :: Kind,             -- ^ Result kind
         tyConKind    :: Kind,             -- ^ Kind of this TyCon
         tyConArity   :: Arity,            -- ^ Arity
+        tyConNullaryTy :: Type,           -- ^ A pre-allocated @TyConApp tycon []@
 
               -- The tyConTyVars scope over:
               --
@@ -805,6 +822,7 @@ data TyCon
         tyConResKind :: Kind,             -- ^ Result kind
         tyConKind    :: Kind,             -- ^ Kind of this TyCon
         tyConArity   :: Arity,            -- ^ Arity
+        tyConNullaryTy :: Type,           -- ^ A pre-allocated @TyConApp tycon []@
              -- tyConTyVars scope over: synTcRhs
 
         tcRoles      :: [Role],  -- ^ The role for each type variable
@@ -843,6 +861,7 @@ data TyCon
         tyConResKind :: Kind,             -- ^ Result kind
         tyConKind    :: Kind,             -- ^ Kind of this TyCon
         tyConArity   :: Arity,            -- ^ Arity
+        tyConNullaryTy :: Type,           -- ^ A pre-allocated @TyConApp tycon []@
             -- tyConTyVars connect an associated family TyCon
             -- with its parent class; see GHC.Tc.Validity.checkConsistentFamInst
 
@@ -879,6 +898,7 @@ data TyCon
         tyConResKind :: Kind,             -- ^ Result kind
         tyConKind    :: Kind,             -- ^ Kind of this TyCon
         tyConArity   :: Arity,            -- ^ Arity
+        tyConNullaryTy :: Type,           -- ^ A pre-allocated @TyConApp tycon []@
 
         tcRoles       :: [Role], -- ^ The role for each type variable
                                  -- This list has length = tyConArity
@@ -904,6 +924,7 @@ data TyCon
         tyConResKind :: Kind,             -- ^ Result kind
         tyConKind    :: Kind,             -- ^ Kind of this TyCon
         tyConArity   :: Arity,            -- ^ Arity
+        tyConNullaryTy :: Type,           -- ^ A pre-allocated @TyConApp tycon []@
 
         tcRoles       :: [Role],    -- ^ Roles: N for kind vars, R for type vars
         dataCon       :: DataCon,   -- ^ Corresponding data constructor
@@ -923,6 +944,7 @@ data TyCon
         tyConResKind :: Kind,          -- ^ Result kind
         tyConKind    :: Kind,          -- ^ Kind of this TyCon
         tyConArity   :: Arity,         -- ^ Arity
+        tyConNullaryTy :: Type,           -- ^ A pre-allocated @TyConApp tycon []@
 
           -- NB: the TyConArity of a TcTyCon must match
           -- the number of Required (positional, user-specified)
@@ -1602,15 +1624,18 @@ So we compromise, and move their Kind calculation to the call site.
 -- this functionality
 mkFunTyCon :: Name -> [TyConBinder] -> Name -> TyCon
 mkFunTyCon name binders rep_nm
-  = FunTyCon {
-        tyConUnique  = nameUnique name,
-        tyConName    = name,
-        tyConBinders = binders,
-        tyConResKind = liftedTypeKind,
-        tyConKind    = mkTyConKind binders liftedTypeKind,
-        tyConArity   = length binders,
-        tcRepName    = rep_nm
-    }
+  = let tc =
+          FunTyCon {
+              tyConUnique  = nameUnique name,
+              tyConName    = name,
+              tyConBinders = binders,
+              tyConResKind = liftedTypeKind,
+              tyConKind    = mkTyConKind binders liftedTypeKind,
+              tyConArity   = length binders,
+              tyConNullaryTy = mkTyConTy_ tc,
+              tcRepName    = rep_nm
+          }
+    in tc
 
 -- | This is the making of an algebraic 'TyCon'.
 mkAlgTyCon :: Name
@@ -1626,22 +1651,25 @@ mkAlgTyCon :: Name
            -> Bool              -- ^ Was the 'TyCon' declared with GADT syntax?
            -> TyCon
 mkAlgTyCon name binders res_kind roles cType stupid rhs parent gadt_syn
-  = AlgTyCon {
-        tyConName        = name,
-        tyConUnique      = nameUnique name,
-        tyConBinders     = binders,
-        tyConResKind     = res_kind,
-        tyConKind        = mkTyConKind binders res_kind,
-        tyConArity       = length binders,
-        tyConTyVars      = binderVars binders,
-        tcRoles          = roles,
-        tyConCType       = cType,
-        algTcStupidTheta = stupid,
-        algTcRhs         = rhs,
-        algTcFields      = fieldsOfAlgTcRhs rhs,
-        algTcParent      = ASSERT2( okParent name parent, ppr name $$ ppr parent ) parent,
-        algTcGadtSyntax  = gadt_syn
-    }
+  = let tc =
+          AlgTyCon {
+              tyConName        = name,
+              tyConUnique      = nameUnique name,
+              tyConBinders     = binders,
+              tyConResKind     = res_kind,
+              tyConKind        = mkTyConKind binders res_kind,
+              tyConArity       = length binders,
+              tyConNullaryTy   = mkTyConTy_ tc,
+              tyConTyVars      = binderVars binders,
+              tcRoles          = roles,
+              tyConCType       = cType,
+              algTcStupidTheta = stupid,
+              algTcRhs         = rhs,
+              algTcFields      = fieldsOfAlgTcRhs rhs,
+              algTcParent      = ASSERT2( okParent name parent, ppr name $$ ppr parent ) parent,
+              algTcGadtSyntax  = gadt_syn
+          }
+    in tc
 
 -- | Simpler specialization of 'mkAlgTyCon' for classes
 mkClassTyCon :: Name -> [TyConBinder]
@@ -1661,23 +1689,26 @@ mkTupleTyCon :: Name
              -> AlgTyConFlav
              -> TyCon
 mkTupleTyCon name binders res_kind arity con sort parent
-  = AlgTyCon {
-        tyConUnique      = nameUnique name,
-        tyConName        = name,
-        tyConBinders     = binders,
-        tyConTyVars      = binderVars binders,
-        tyConResKind     = res_kind,
-        tyConKind        = mkTyConKind binders res_kind,
-        tyConArity       = arity,
-        tcRoles          = replicate arity Representational,
-        tyConCType       = Nothing,
-        algTcGadtSyntax  = False,
-        algTcStupidTheta = [],
-        algTcRhs         = TupleTyCon { data_con = con,
-                                        tup_sort = sort },
-        algTcFields      = emptyDFsEnv,
-        algTcParent      = parent
-    }
+  = let tc =
+          AlgTyCon {
+              tyConUnique      = nameUnique name,
+              tyConName        = name,
+              tyConBinders     = binders,
+              tyConTyVars      = binderVars binders,
+              tyConResKind     = res_kind,
+              tyConKind        = mkTyConKind binders res_kind,
+              tyConArity       = arity,
+              tyConNullaryTy   = mkTyConTy_ tc,
+              tcRoles          = replicate arity Representational,
+              tyConCType       = Nothing,
+              algTcGadtSyntax  = False,
+              algTcStupidTheta = [],
+              algTcRhs         = TupleTyCon { data_con = con,
+                                              tup_sort = sort },
+              algTcFields      = emptyDFsEnv,
+              algTcParent      = parent
+          }
+    in tc
 
 mkSumTyCon :: Name
              -> [TyConBinder]
@@ -1688,22 +1719,25 @@ mkSumTyCon :: Name
              -> AlgTyConFlav
              -> TyCon
 mkSumTyCon name binders res_kind arity tyvars cons parent
-  = AlgTyCon {
-        tyConUnique      = nameUnique name,
-        tyConName        = name,
-        tyConBinders     = binders,
-        tyConTyVars      = tyvars,
-        tyConResKind     = res_kind,
-        tyConKind        = mkTyConKind binders res_kind,
-        tyConArity       = arity,
-        tcRoles          = replicate arity Representational,
-        tyConCType       = Nothing,
-        algTcGadtSyntax  = False,
-        algTcStupidTheta = [],
-        algTcRhs         = mkSumTyConRhs cons,
-        algTcFields      = emptyDFsEnv,
-        algTcParent      = parent
-    }
+  = let tc =
+          AlgTyCon {
+              tyConUnique      = nameUnique name,
+              tyConName        = name,
+              tyConBinders     = binders,
+              tyConTyVars      = tyvars,
+              tyConResKind     = res_kind,
+              tyConKind        = mkTyConKind binders res_kind,
+              tyConArity       = arity,
+              tyConNullaryTy   = mkTyConTy_ tc,
+              tcRoles          = replicate arity Representational,
+              tyConCType       = Nothing,
+              algTcGadtSyntax  = False,
+              algTcStupidTheta = [],
+              algTcRhs         = mkSumTyConRhs cons,
+              algTcFields      = emptyDFsEnv,
+              algTcParent      = parent
+          }
+    in tc
 
 -- | Makes a tycon suitable for use during type-checking. It stores
 -- a variety of details about the definition of the TyCon, but no
@@ -1721,16 +1755,19 @@ mkTcTyCon :: Name
           -> TyConFlavour        -- ^ What sort of 'TyCon' this represents
           -> TyCon
 mkTcTyCon name binders res_kind scoped_tvs poly flav
-  = TcTyCon { tyConUnique  = getUnique name
-            , tyConName    = name
-            , tyConTyVars  = binderVars binders
-            , tyConBinders = binders
-            , tyConResKind = res_kind
-            , tyConKind    = mkTyConKind binders res_kind
-            , tyConArity   = length binders
-            , tcTyConScopedTyVars = scoped_tvs
-            , tcTyConIsPoly       = poly
-            , tcTyConFlavour      = flav }
+  = let tc =
+          TcTyCon { tyConUnique  = getUnique name
+                  , tyConName    = name
+                  , tyConTyVars  = binderVars binders
+                  , tyConBinders = binders
+                  , tyConResKind = res_kind
+                  , tyConKind    = mkTyConKind binders res_kind
+                  , tyConArity   = length binders
+                  , tyConNullaryTy = mkTyConTy_ tc
+                  , tcTyConScopedTyVars = scoped_tvs
+                  , tcTyConIsPoly       = poly
+                  , tcTyConFlavour      = flav }
+    in tc
 
 -- | No scoped type variables (to be used with mkTcTyCon).
 noTcTyConScopedTyVars :: [(Name, TcTyVar)]
@@ -1767,55 +1804,64 @@ mkPrimTyCon' :: Name -> [TyConBinder]
              -> [Role]
              -> Bool -> Maybe TyConRepName -> TyCon
 mkPrimTyCon' name binders res_kind roles is_unlifted rep_nm
-  = PrimTyCon {
-        tyConName    = name,
-        tyConUnique  = nameUnique name,
-        tyConBinders = binders,
-        tyConResKind = res_kind,
-        tyConKind    = mkTyConKind binders res_kind,
-        tyConArity   = length roles,
-        tcRoles      = roles,
-        isUnlifted   = is_unlifted,
-        primRepName  = rep_nm
-    }
+  = let tc =
+          PrimTyCon {
+              tyConName    = name,
+              tyConUnique  = nameUnique name,
+              tyConBinders = binders,
+              tyConResKind = res_kind,
+              tyConKind    = mkTyConKind binders res_kind,
+              tyConArity   = length roles,
+              tyConNullaryTy = mkTyConTy_ tc,
+              tcRoles      = roles,
+              isUnlifted   = is_unlifted,
+              primRepName  = rep_nm
+          }
+    in tc
 
 -- | Create a type synonym 'TyCon'
 mkSynonymTyCon :: Name -> [TyConBinder] -> Kind   -- ^ /result/ kind
                -> [Role] -> Type -> Bool -> Bool -> Bool -> TyCon
 mkSynonymTyCon name binders res_kind roles rhs is_tau is_fam_free is_forgetful
-  = SynonymTyCon {
-        tyConName      = name,
-        tyConUnique    = nameUnique name,
-        tyConBinders   = binders,
-        tyConResKind   = res_kind,
-        tyConKind      = mkTyConKind binders res_kind,
-        tyConArity     = length binders,
-        tyConTyVars    = binderVars binders,
-        tcRoles        = roles,
-        synTcRhs       = rhs,
-        synIsTau       = is_tau,
-        synIsFamFree   = is_fam_free,
-        synIsForgetful = is_forgetful
-    }
+  = let tc =
+          SynonymTyCon {
+              tyConName      = name,
+              tyConUnique    = nameUnique name,
+              tyConBinders   = binders,
+              tyConResKind   = res_kind,
+              tyConKind      = mkTyConKind binders res_kind,
+              tyConArity     = length binders,
+              tyConNullaryTy = mkTyConTy_ tc,
+              tyConTyVars    = binderVars binders,
+              tcRoles        = roles,
+              synTcRhs       = rhs,
+              synIsTau       = is_tau,
+              synIsFamFree   = is_fam_free,
+              synIsForgetful = is_forgetful
+          }
+    in tc
 
 -- | Create a type family 'TyCon'
 mkFamilyTyCon :: Name -> [TyConBinder] -> Kind  -- ^ /result/ kind
               -> Maybe Name -> FamTyConFlav
               -> Maybe Class -> Injectivity -> TyCon
 mkFamilyTyCon name binders res_kind resVar flav parent inj
-  = FamilyTyCon
-      { tyConUnique  = nameUnique name
-      , tyConName    = name
-      , tyConBinders = binders
-      , tyConResKind = res_kind
-      , tyConKind    = mkTyConKind binders res_kind
-      , tyConArity   = length binders
-      , tyConTyVars  = binderVars binders
-      , famTcResVar  = resVar
-      , famTcFlav    = flav
-      , famTcParent  = classTyCon <$> parent
-      , famTcInj     = inj
-      }
+  = let tc =
+          FamilyTyCon
+            { tyConUnique  = nameUnique name
+            , tyConName    = name
+            , tyConBinders = binders
+            , tyConResKind = res_kind
+            , tyConKind    = mkTyConKind binders res_kind
+            , tyConArity   = length binders
+            , tyConNullaryTy = mkTyConTy_ tc
+            , tyConTyVars  = binderVars binders
+            , famTcResVar  = resVar
+            , famTcFlav    = flav
+            , famTcParent  = classTyCon <$> parent
+            , famTcInj     = inj
+            }
+    in tc
 
 
 -- | Create a promoted data constructor 'TyCon'
@@ -1826,18 +1872,21 @@ mkPromotedDataCon :: DataCon -> Name -> TyConRepName
                   -> [TyConTyCoBinder] -> Kind -> [Role]
                   -> RuntimeRepInfo -> TyCon
 mkPromotedDataCon con name rep_name binders res_kind roles rep_info
-  = PromotedDataCon {
-        tyConUnique   = nameUnique name,
-        tyConName     = name,
-        tyConArity    = length roles,
-        tcRoles       = roles,
-        tyConBinders  = binders,
-        tyConResKind  = res_kind,
-        tyConKind     = mkTyConKind binders res_kind,
-        dataCon       = con,
-        tcRepName     = rep_name,
-        promDcRepInfo = rep_info
-  }
+  = let tc =
+          PromotedDataCon {
+            tyConUnique   = nameUnique name,
+            tyConName     = name,
+            tyConArity    = length roles,
+            tyConNullaryTy = mkTyConTy_ tc,
+            tcRoles       = roles,
+            tyConBinders  = binders,
+            tyConResKind  = res_kind,
+            tyConKind     = mkTyConKind binders res_kind,
+            dataCon       = con,
+            tcRepName     = rep_name,
+            promDcRepInfo = rep_info
+          }
+    in tc
 
 isFunTyCon :: TyCon -> Bool
 isFunTyCon (FunTyCon {}) = True
@@ -2217,7 +2266,11 @@ setTcTyConKind :: TyCon -> Kind -> TyCon
 -- The new kind is always a zonked version of its previous
 -- kind, so we don't need to update any other fields.
 -- See Note [The Purely Kinded Invariant] in GHC.Tc.Gen.HsType
-setTcTyConKind tc@(TcTyCon {}) kind = tc { tyConKind = kind }
+setTcTyConKind tc@(TcTyCon {}) kind = let tc' = tc { tyConKind = kind
+                                                   , tyConNullaryTy = mkTyConTy_ tc'
+                                                       -- see Note [Sharing nullary TyCons]
+                                                   }
+                                      in tc'
 setTcTyConKind tc              _    = pprPanic "setTcTyConKind" (ppr tc)
 
 -- | Could this TyCon ever be levity-polymorphic when fully applied?
diff --git a/compiler/GHC/Core/Type.hs b/compiler/GHC/Core/Type.hs
index 7032b97939..6a9eeed6fa 100644
--- a/compiler/GHC/Core/Type.hs
+++ b/compiler/GHC/Core/Type.hs
@@ -1490,6 +1490,31 @@ tyConBindersTyCoBinders = map to_tyb
     to_tyb (Bndr tv (NamedTCB vis)) = Named (Bndr tv vis)
     to_tyb (Bndr tv (AnonTCB af))   = Anon af (tymult (varType tv))
 
+-- | Create the plain type constructor type which has been applied to no type arguments at all.
+mkTyConTy :: TyCon -> Type
+mkTyConTy tycon = tyConNullaryTy tycon
+  -- see Note [Sharing nullary TyConApps] in GHC.Core.TyCon
+
+-- | A key function: builds a 'TyConApp' or 'FunTy' as appropriate to
+-- its arguments.  Applies its arguments to the constructor from left to right.
+mkTyConApp :: TyCon -> [Type] -> Type
+mkTyConApp tycon tys
+  | [] <- tys
+  = mkTyConTy tycon
+
+  | isFunTyCon tycon
+  , [w, _rep1,_rep2,ty1,ty2] <- tys
+  -- The FunTyCon (->) is always a visible one
+  = FunTy { ft_af = VisArg, ft_mult = w, ft_arg = ty1, ft_res = ty2 }
+
+  -- See Note [Prefer Type over TYPE 'LiftedRep].
+  | tycon `hasKey` tYPETyConKey
+  , [rep] <- tys
+  = tYPE rep
+  -- The catch-all case
+  | otherwise
+  = TyConApp tycon tys
+
 
 {-
 --------------------------------------------------------------------
@@ -2254,7 +2279,6 @@ But the left is an AppTy while the right is a TyConApp. The solution is
 to use repSplitAppTy_maybe to break up the TyConApp into its pieces and
 then continue. Easy to do, but also easy to forget to do.
 
-
 Note [Comparing nullary type synonyms]
 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
 Consider the task of testing equality between two 'Type's of the form
@@ -2281,7 +2305,7 @@ We perform this optimisation in a number of places:
 
 This optimisation is especially helpful for the ubiquitous GHC.Types.Type,
 since GHC prefers to use the type synonym over @TYPE 'LiftedRep@ applications
-whenever possible. See [Prefer Type over TYPE 'LiftedRep] in
+whenever possible. See Note [Prefer Type over TYPE 'LiftedRep] in
 GHC.Core.TyCo.Rep for details.
 
 -}
diff --git a/compiler/GHC/Core/Type.hs-boot b/compiler/GHC/Core/Type.hs-boot
index bada997f3b..8afa22c771 100644
--- a/compiler/GHC/Core/Type.hs-boot
+++ b/compiler/GHC/Core/Type.hs-boot
@@ -12,6 +12,8 @@ isCoercionTy :: Type -> Bool
 
 mkAppTy    :: Type -> Type -> Type
 mkCastTy   :: Type -> Coercion -> Type
+mkTyConTy  :: TyCon -> Type
+mkTyConApp :: TyCon -> [Type] -> Type
 piResultTy :: HasDebugCallStack => Type -> Type -> Type
 
 coreView :: Type -> Maybe Type