Commit b5db3457 authored by Ben Gamari's avatar Ben Gamari 🐢 Committed by Marge Bot

Extend nullary TyConApp optimisation to all TyCons

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

Closes #19367.

Metric Decrease:
    T9872a
    T9872b
    T9872c
parent 4dc2bcca
...@@ -692,9 +692,9 @@ constraintKindTyCon = pcTyCon constraintKindTyConName Nothing [] [] ...@@ -692,9 +692,9 @@ constraintKindTyCon = pcTyCon constraintKindTyConName Nothing [] []
-- See Note [Prefer Type over TYPE 'LiftedRep] in GHC.Core.TyCo.Rep. -- See Note [Prefer Type over TYPE 'LiftedRep] in GHC.Core.TyCo.Rep.
liftedTypeKind, typeToTypeKind, constraintKind :: Kind liftedTypeKind, typeToTypeKind, constraintKind :: Kind
liftedTypeKind = TyCoRep.TyConApp liftedTypeKindTyCon [] liftedTypeKind = mkTyConTy liftedTypeKindTyCon
typeToTypeKind = liftedTypeKind `mkVisFunTyMany` liftedTypeKind typeToTypeKind = liftedTypeKind `mkVisFunTyMany` liftedTypeKind
constraintKind = mkTyConApp constraintKindTyCon [] constraintKind = mkTyConTy constraintKindTyCon
{- {-
************************************************************************ ************************************************************************
......
...@@ -126,6 +126,7 @@ import GHC.Utils.Outputable ...@@ -126,6 +126,7 @@ import GHC.Utils.Outputable
import GHC.Utils.Panic import GHC.Utils.Panic
import GHC.Core.TyCo.Rep -- Doesn't need special access, but this is easier to avoid 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 loops which show up if you import Type instead
import {-# SOURCE #-} GHC.Core.Type ( mkTyConTy )
import Data.Char import Data.Char
......
...@@ -42,7 +42,7 @@ module GHC.Core.TyCo.Rep ( ...@@ -42,7 +42,7 @@ module GHC.Core.TyCo.Rep (
MCoercion(..), MCoercionR, MCoercionN, MCoercion(..), MCoercionR, MCoercionN,
-- * Functions over types -- * Functions over types
mkTyConTy, mkTyVarTy, mkTyVarTys, mkTyConTy_, mkTyVarTy, mkTyVarTys,
mkTyCoVarTy, mkTyCoVarTys, mkTyCoVarTy, mkTyCoVarTys,
mkFunTy, mkVisFunTy, mkInvisFunTy, mkVisFunTys, mkFunTy, mkVisFunTy, mkInvisFunTy, mkVisFunTys,
mkForAllTy, mkForAllTys, mkInvisForAllTys, mkForAllTy, mkForAllTys, mkInvisForAllTys,
...@@ -51,7 +51,6 @@ module GHC.Core.TyCo.Rep ( ...@@ -51,7 +51,6 @@ module GHC.Core.TyCo.Rep (
mkScaledFunTy, mkScaledFunTy,
mkVisFunTyMany, mkVisFunTysMany, mkVisFunTyMany, mkVisFunTysMany,
mkInvisFunTyMany, mkInvisFunTysMany, mkInvisFunTyMany, mkInvisFunTysMany,
mkTyConApp,
tYPE, tYPE,
-- * Functions over binders -- * Functions over binders
...@@ -91,8 +90,8 @@ import GHC.Core.TyCon ...@@ -91,8 +90,8 @@ import GHC.Core.TyCon
import GHC.Core.Coercion.Axiom import GHC.Core.Coercion.Axiom
-- others -- others
import GHC.Builtin.Names ( liftedTypeKindTyConKey, liftedRepDataConKey, manyDataConKey, tYPETyConKey ) import GHC.Builtin.Names ( liftedRepDataConKey )
import {-# SOURCE #-} GHC.Builtin.Types ( liftedTypeKindTyCon, liftedTypeKind, manyDataConTy ) import {-# SOURCE #-} GHC.Builtin.Types ( liftedTypeKind, manyDataConTy )
import {-# SOURCE #-} GHC.Builtin.Types.Prim ( tYPETyCon ) import {-# SOURCE #-} GHC.Builtin.Types.Prim ( tYPETyCon )
import GHC.Types.Basic ( LeftOrRight(..), pickLR ) import GHC.Types.Basic ( LeftOrRight(..), pickLR )
import GHC.Types.Unique ( hasKey, Uniquable(..) ) import GHC.Types.Unique ( hasKey, Uniquable(..) )
...@@ -1004,35 +1003,11 @@ mkPiTy (Named (Bndr tv vis)) ty = mkForAllTy tv vis ty ...@@ -1004,35 +1003,11 @@ mkPiTy (Named (Bndr tv vis)) ty = mkForAllTy tv vis ty
mkPiTys :: [TyCoBinder] -> Type -> Type mkPiTys :: [TyCoBinder] -> Type -> Type
mkPiTys tbs ty = foldr mkPiTy ty tbs mkPiTys tbs ty = foldr mkPiTy ty tbs
-- | Create the plain type constructor type which has been applied to no type arguments at all. -- | Create a nullary 'TyConApp'. In general you should rather use
mkTyConTy :: TyCon -> Type -- 'GHC.Core.Type.mkTyConTy'. This merely exists to break the import cycle
mkTyConTy tycon = TyConApp tycon [] -- between 'GHC.Core.TyCon' and this module.
mkTyConTy_ :: TyCon -> Type
-- | A key function: builds a 'TyConApp' or 'FunTy' as appropriate to mkTyConTy_ tycon = TyConApp tycon []
-- 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
{- {-
Note [Prefer Type over TYPE 'LiftedRep] Note [Prefer Type over TYPE 'LiftedRep]
...@@ -1079,16 +1054,9 @@ To accomplish these we use a number of tricks: ...@@ -1079,16 +1054,9 @@ To accomplish these we use a number of tricks:
(namely 'GHC.Builtin.Types.Prim.liftedTypeKind'), ensuring that we (namely 'GHC.Builtin.Types.Prim.liftedTypeKind'), ensuring that we
don't need to allocate such types (goal (a)). don't need to allocate such types (goal (a)).
3. To avoid allocating 'TyConApp' constructors the 3. We use the sharing mechanism described in Note [Sharing nullary TyConApps]
'GHC.Builtin.Types.Prim.tYPE' function catches the lifted case and returns in GHC.Core.TyCon to ensure that we never need to allocate such
`liftedTypeKind` instead of building an application (goal (a)). nullary applications (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.
See #17958. See #17958.
-} -}
...@@ -1101,12 +1069,6 @@ tYPE (TyConApp tc []) ...@@ -1101,12 +1069,6 @@ tYPE (TyConApp tc [])
| tc `hasKey` liftedRepDataConKey = liftedTypeKind -- TYPE 'LiftedRep | tc `hasKey` liftedRepDataConKey = liftedTypeKind -- TYPE 'LiftedRep
tYPE rr = TyConApp tYPETyCon [rr] 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 []
{- {-
%************************************************************************ %************************************************************************
%* * %* *
......
...@@ -3,6 +3,7 @@ module GHC.Core.TyCo.Rep where ...@@ -3,6 +3,7 @@ module GHC.Core.TyCo.Rep where
import GHC.Utils.Outputable ( Outputable ) import GHC.Utils.Outputable ( Outputable )
import Data.Data ( Data ) import Data.Data ( Data )
import {-# SOURCE #-} GHC.Types.Var( Var, ArgFlag, AnonArgFlag ) import {-# SOURCE #-} GHC.Types.Var( Var, ArgFlag, AnonArgFlag )
import {-# SOURCE #-} GHC.Core.TyCon ( TyCon )
data Type data Type
data Coercion data Coercion
...@@ -22,6 +23,7 @@ type MCoercionN = MCoercion ...@@ -22,6 +23,7 @@ type MCoercionN = MCoercion
mkFunTyMany :: AnonArgFlag -> Type -> Type -> Type mkFunTyMany :: AnonArgFlag -> Type -> Type -> Type
mkForAllTy :: Var -> ArgFlag -> Type -> Type mkForAllTy :: Var -> ArgFlag -> Type -> Type
mkTyConTy_ :: TyCon -> Type
instance Data Type -- To support Data instances in GHC.Core.Coercion.Axiom instance Data Type -- To support Data instances in GHC.Core.Coercion.Axiom
instance Outputable Type instance Outputable Type
...@@ -57,7 +57,7 @@ module GHC.Core.TyCo.Subst ...@@ -57,7 +57,7 @@ module GHC.Core.TyCo.Subst
import GHC.Prelude import GHC.Prelude
import {-# SOURCE #-} GHC.Core.Type import {-# SOURCE #-} GHC.Core.Type
( mkCastTy, mkAppTy, isCoercionTy ) ( mkCastTy, mkAppTy, isCoercionTy, mkTyConApp )
import {-# SOURCE #-} GHC.Core.Coercion import {-# SOURCE #-} GHC.Core.Coercion
( mkCoVarCo, mkKindCo, mkNthCo, mkTransCo ( mkCoVarCo, mkKindCo, mkNthCo, mkTransCo
, mkNomReflCo, mkSubCo, mkSymCo , mkNomReflCo, mkSubCo, mkSymCo
......
...@@ -88,6 +88,7 @@ module GHC.Core.TyCon( ...@@ -88,6 +88,7 @@ module GHC.Core.TyCon(
tyConFamilySize, tyConFamilySize,
tyConStupidTheta, tyConStupidTheta,
tyConArity, tyConArity,
tyConNullaryTy,
tyConRoles, tyConRoles,
tyConFlavour, tyConFlavour,
tyConTuple_maybe, tyConClass_maybe, tyConATs, tyConTuple_maybe, tyConClass_maybe, tyConATs,
...@@ -135,7 +136,7 @@ import GHC.Prelude ...@@ -135,7 +136,7 @@ import GHC.Prelude
import GHC.Platform import GHC.Platform
import {-# SOURCE #-} GHC.Core.TyCo.Rep import {-# SOURCE #-} GHC.Core.TyCo.Rep
( Kind, Type, PredType, mkForAllTy, mkFunTyMany ) ( Kind, Type, PredType, mkForAllTy, mkFunTyMany, mkTyConTy_ )
import {-# SOURCE #-} GHC.Core.TyCo.Ppr import {-# SOURCE #-} GHC.Core.TyCo.Ppr
( pprType ) ( pprType )
import {-# SOURCE #-} GHC.Builtin.Types import {-# SOURCE #-} GHC.Builtin.Types
...@@ -417,6 +418,20 @@ See also: ...@@ -417,6 +418,20 @@ See also:
* [Verifying injectivity annotation] in GHC.Core.FamInstEnv * [Verifying injectivity annotation] in GHC.Core.FamInstEnv
* [Type inference for type families with injectivity] in GHC.Tc.Solver.Interact * [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 TyConBinder, TyConTyCoBinder
...@@ -718,6 +733,7 @@ data TyCon ...@@ -718,6 +733,7 @@ data TyCon
tyConResKind :: Kind, -- ^ Result kind tyConResKind :: Kind, -- ^ Result kind
tyConKind :: Kind, -- ^ Kind of this TyCon tyConKind :: Kind, -- ^ Kind of this TyCon
tyConArity :: Arity, -- ^ Arity tyConArity :: Arity, -- ^ Arity
tyConNullaryTy :: Type,
tcRepName :: TyConRepName tcRepName :: TyConRepName
} }
...@@ -748,6 +764,7 @@ data TyCon ...@@ -748,6 +764,7 @@ data TyCon
tyConResKind :: Kind, -- ^ Result kind tyConResKind :: Kind, -- ^ Result kind
tyConKind :: Kind, -- ^ Kind of this TyCon tyConKind :: Kind, -- ^ Kind of this TyCon
tyConArity :: Arity, -- ^ Arity tyConArity :: Arity, -- ^ Arity
tyConNullaryTy :: Type, -- ^ A pre-allocated @TyConApp tycon []@
-- The tyConTyVars scope over: -- The tyConTyVars scope over:
-- --
...@@ -805,6 +822,7 @@ data TyCon ...@@ -805,6 +822,7 @@ data TyCon
tyConResKind :: Kind, -- ^ Result kind tyConResKind :: Kind, -- ^ Result kind
tyConKind :: Kind, -- ^ Kind of this TyCon tyConKind :: Kind, -- ^ Kind of this TyCon
tyConArity :: Arity, -- ^ Arity tyConArity :: Arity, -- ^ Arity
tyConNullaryTy :: Type, -- ^ A pre-allocated @TyConApp tycon []@
-- tyConTyVars scope over: synTcRhs -- tyConTyVars scope over: synTcRhs
tcRoles :: [Role], -- ^ The role for each type variable tcRoles :: [Role], -- ^ The role for each type variable
...@@ -843,6 +861,7 @@ data TyCon ...@@ -843,6 +861,7 @@ data TyCon
tyConResKind :: Kind, -- ^ Result kind tyConResKind :: Kind, -- ^ Result kind
tyConKind :: Kind, -- ^ Kind of this TyCon tyConKind :: Kind, -- ^ Kind of this TyCon
tyConArity :: Arity, -- ^ Arity tyConArity :: Arity, -- ^ Arity
tyConNullaryTy :: Type, -- ^ A pre-allocated @TyConApp tycon []@
-- tyConTyVars connect an associated family TyCon -- tyConTyVars connect an associated family TyCon
-- with its parent class; see GHC.Tc.Validity.checkConsistentFamInst -- with its parent class; see GHC.Tc.Validity.checkConsistentFamInst
...@@ -879,6 +898,7 @@ data TyCon ...@@ -879,6 +898,7 @@ data TyCon
tyConResKind :: Kind, -- ^ Result kind tyConResKind :: Kind, -- ^ Result kind
tyConKind :: Kind, -- ^ Kind of this TyCon tyConKind :: Kind, -- ^ Kind of this TyCon
tyConArity :: Arity, -- ^ Arity tyConArity :: Arity, -- ^ Arity
tyConNullaryTy :: Type, -- ^ A pre-allocated @TyConApp tycon []@
tcRoles :: [Role], -- ^ The role for each type variable tcRoles :: [Role], -- ^ The role for each type variable
-- This list has length = tyConArity -- This list has length = tyConArity
...@@ -904,6 +924,7 @@ data TyCon ...@@ -904,6 +924,7 @@ data TyCon
tyConResKind :: Kind, -- ^ Result kind tyConResKind :: Kind, -- ^ Result kind
tyConKind :: Kind, -- ^ Kind of this TyCon tyConKind :: Kind, -- ^ Kind of this TyCon
tyConArity :: Arity, -- ^ Arity tyConArity :: Arity, -- ^ Arity
tyConNullaryTy :: Type, -- ^ A pre-allocated @TyConApp tycon []@
tcRoles :: [Role], -- ^ Roles: N for kind vars, R for type vars tcRoles :: [Role], -- ^ Roles: N for kind vars, R for type vars
dataCon :: DataCon, -- ^ Corresponding data constructor dataCon :: DataCon, -- ^ Corresponding data constructor
...@@ -923,6 +944,7 @@ data TyCon ...@@ -923,6 +944,7 @@ data TyCon
tyConResKind :: Kind, -- ^ Result kind tyConResKind :: Kind, -- ^ Result kind
tyConKind :: Kind, -- ^ Kind of this TyCon tyConKind :: Kind, -- ^ Kind of this TyCon
tyConArity :: Arity, -- ^ Arity tyConArity :: Arity, -- ^ Arity
tyConNullaryTy :: Type, -- ^ A pre-allocated @TyConApp tycon []@
-- NB: the TyConArity of a TcTyCon must match -- NB: the TyConArity of a TcTyCon must match
-- the number of Required (positional, user-specified) -- the number of Required (positional, user-specified)
...@@ -1602,15 +1624,18 @@ So we compromise, and move their Kind calculation to the call site. ...@@ -1602,15 +1624,18 @@ So we compromise, and move their Kind calculation to the call site.
-- this functionality -- this functionality
mkFunTyCon :: Name -> [TyConBinder] -> Name -> TyCon mkFunTyCon :: Name -> [TyConBinder] -> Name -> TyCon
mkFunTyCon name binders rep_nm mkFunTyCon name binders rep_nm
= FunTyCon { = let tc =
tyConUnique = nameUnique name, FunTyCon {
tyConName = name, tyConUnique = nameUnique name,
tyConBinders = binders, tyConName = name,
tyConResKind = liftedTypeKind, tyConBinders = binders,
tyConKind = mkTyConKind binders liftedTypeKind, tyConResKind = liftedTypeKind,
tyConArity = length binders, tyConKind = mkTyConKind binders liftedTypeKind,
tcRepName = rep_nm tyConArity = length binders,
} tyConNullaryTy = mkTyConTy_ tc,
tcRepName = rep_nm
}
in tc
-- | This is the making of an algebraic 'TyCon'. -- | This is the making of an algebraic 'TyCon'.
mkAlgTyCon :: Name mkAlgTyCon :: Name
...@@ -1626,22 +1651,25 @@ mkAlgTyCon :: Name ...@@ -1626,22 +1651,25 @@ mkAlgTyCon :: Name
-> Bool -- ^ Was the 'TyCon' declared with GADT syntax? -> Bool -- ^ Was the 'TyCon' declared with GADT syntax?
-> TyCon -> TyCon
mkAlgTyCon name binders res_kind roles cType stupid rhs parent gadt_syn mkAlgTyCon name binders res_kind roles cType stupid rhs parent gadt_syn
= AlgTyCon { = let tc =
tyConName = name, AlgTyCon {
tyConUnique = nameUnique name, tyConName = name,
tyConBinders = binders, tyConUnique = nameUnique name,
tyConResKind = res_kind, tyConBinders = binders,
tyConKind = mkTyConKind binders res_kind, tyConResKind = res_kind,
tyConArity = length binders, tyConKind = mkTyConKind binders res_kind,
tyConTyVars = binderVars binders, tyConArity = length binders,
tcRoles = roles, tyConNullaryTy = mkTyConTy_ tc,
tyConCType = cType, tyConTyVars = binderVars binders,
algTcStupidTheta = stupid, tcRoles = roles,
algTcRhs = rhs, tyConCType = cType,
algTcFields = fieldsOfAlgTcRhs rhs, algTcStupidTheta = stupid,
algTcParent = ASSERT2( okParent name parent, ppr name $$ ppr parent ) parent, algTcRhs = rhs,
algTcGadtSyntax = gadt_syn algTcFields = fieldsOfAlgTcRhs rhs,
} algTcParent = ASSERT2( okParent name parent, ppr name $$ ppr parent ) parent,
algTcGadtSyntax = gadt_syn
}
in tc
-- | Simpler specialization of 'mkAlgTyCon' for classes -- | Simpler specialization of 'mkAlgTyCon' for classes
mkClassTyCon :: Name -> [TyConBinder] mkClassTyCon :: Name -> [TyConBinder]
...@@ -1661,23 +1689,26 @@ mkTupleTyCon :: Name ...@@ -1661,23 +1689,26 @@ mkTupleTyCon :: Name
-> AlgTyConFlav -> AlgTyConFlav
-> TyCon -> TyCon
mkTupleTyCon name binders res_kind arity con sort parent mkTupleTyCon name binders res_kind arity con sort parent
= AlgTyCon { = let tc =
tyConUnique = nameUnique name, AlgTyCon {
tyConName = name, tyConUnique = nameUnique name,
tyConBinders = binders, tyConName = name,
tyConTyVars = binderVars binders, tyConBinders = binders,
tyConResKind = res_kind, tyConTyVars = binderVars binders,
tyConKind = mkTyConKind binders res_kind, tyConResKind = res_kind,
tyConArity = arity, tyConKind = mkTyConKind binders res_kind,
tcRoles = replicate arity Representational, tyConArity = arity,
tyConCType = Nothing, tyConNullaryTy = mkTyConTy_ tc,
algTcGadtSyntax = False, tcRoles = replicate arity Representational,
algTcStupidTheta = [], tyConCType = Nothing,
algTcRhs = TupleTyCon { data_con = con, algTcGadtSyntax = False,
tup_sort = sort }, algTcStupidTheta = [],
algTcFields = emptyDFsEnv, algTcRhs = TupleTyCon { data_con = con,
algTcParent = parent tup_sort = sort },
} algTcFields = emptyDFsEnv,
algTcParent = parent
}
in tc
mkSumTyCon :: Name mkSumTyCon :: Name
-> [TyConBinder] -> [TyConBinder]
...@@ -1688,22 +1719,25 @@ mkSumTyCon :: Name ...@@ -1688,22 +1719,25 @@ mkSumTyCon :: Name
-> AlgTyConFlav -> AlgTyConFlav
-> TyCon -> TyCon
mkSumTyCon name binders res_kind arity tyvars cons parent mkSumTyCon name binders res_kind arity tyvars cons parent
= AlgTyCon { = let tc =
tyConUnique = nameUnique name, AlgTyCon {
tyConName = name, tyConUnique = nameUnique name,
tyConBinders = binders, tyConName = name,
tyConTyVars = tyvars, tyConBinders = binders,
tyConResKind = res_kind, tyConTyVars = tyvars,
tyConKind = mkTyConKind binders res_kind, tyConResKind = res_kind,
tyConArity = arity, tyConKind = mkTyConKind binders res_kind,
tcRoles = replicate arity Representational, tyConArity = arity,
tyConCType = Nothing, tyConNullaryTy = mkTyConTy_ tc,
algTcGadtSyntax = False, tcRoles = replicate arity Representational,
algTcStupidTheta = [], tyConCType = Nothing,
algTcRhs = mkSumTyConRhs cons, algTcGadtSyntax = False,
algTcFields = emptyDFsEnv, algTcStupidTheta = [],
algTcParent = parent algTcRhs = mkSumTyConRhs cons,
} algTcFields = emptyDFsEnv,
algTcParent = parent
}
in tc
-- | Makes a tycon suitable for use during type-checking. It stores -- | Makes a tycon suitable for use during type-checking. It stores
-- a variety of details about the definition of the TyCon, but no -- a variety of details about the definition of the TyCon, but no
...@@ -1721,16 +1755,19 @@ mkTcTyCon :: Name ...@@ -1721,16 +1755,19 @@ mkTcTyCon :: Name
-> TyConFlavour -- ^ What sort of 'TyCon' this represents -> TyConFlavour -- ^ What sort of 'TyCon' this represents
-> TyCon -> TyCon
mkTcTyCon name binders res_kind scoped_tvs poly flav mkTcTyCon name binders res_kind scoped_tvs poly flav
= TcTyCon { tyConUnique = getUnique name = let tc =
, tyConName = name TcTyCon { tyConUnique = getUnique name
, tyConTyVars = binderVars binders , tyConName = name
, tyConBinders = binders , tyConTyVars = binderVars binders
, tyConResKind = res_kind , tyConBinders = binders
, tyConKind = mkTyConKind binders res_kind , tyConResKind = res_kind
, tyConArity = length binders , tyConKind = mkTyConKind binders res_kind
, tcTyConScopedTyVars = scoped_tvs , tyConArity = length binders
, tcTyConIsPoly = poly , tyConNullaryTy = mkTyConTy_ tc
, tcTyConFlavour = flav } , tcTyConScopedTyVars = scoped_tvs
, tcTyConIsPoly = poly
, tcTyConFlavour = flav }
in tc
-- | No scoped type variables (to be used with mkTcTyCon). -- | No scoped type variables (to be used with mkTcTyCon).
noTcTyConScopedTyVars :: [(Name, TcTyVar)] noTcTyConScopedTyVars :: [(Name, TcTyVar)]
...@@ -1767,55 +1804,64 @@ mkPrimTyCon' :: Name -> [TyConBinder] ...@@ -1767,55 +1804,64 @@ mkPrimTyCon' :: Name -> [TyConBinder]
-> [Role] -> [Role]
-> Bool -> Maybe TyConRepName -> TyCon -> Bool -> Maybe TyConRepName -> TyCon
mkPrimTyCon' name binders res_kind roles is_unlifted rep_nm mkPrimTyCon' name binders res_kind roles is_unlifted rep_nm
= PrimTyCon { = let tc =
tyConName = name, PrimTyCon {
tyConUnique = nameUnique name, tyConName = name,
tyConBinders = binders, tyConUnique = nameUnique name,
tyConResKind = res_kind, tyConBinders = binders,
tyConKind = mkTyConKind binders res_kind, tyConResKind = res_kind,
tyConArity = length roles, tyConKind = mkTyConKind binders res_kind,
tcRoles = roles, tyConArity = length roles,
isUnlifted = is_unlifted, tyConNullaryTy = mkTyConTy_ tc,
primRepName = rep_nm tcRoles = roles,
} isUnlifted = is_unlifted,
primRepName = rep_nm
}
in tc
-- | Create a type synonym 'TyCon' -- | Create a type synonym 'TyCon'
mkSynonymTyCon :: Name -> [TyConBinder] -> Kind -- ^ /result/ kind mkSynonymTyCon :: Name -> [TyConBinder] -> Kind -- ^ /result/ kind
-> [Role] -> Type -> Bool -> Bool -> Bool -> TyCon -> [Role] -> Type -> Bool -> Bool -> Bool -> TyCon
mkSynonymTyCon name binders res_kind roles rhs is_tau is_fam_free is_forgetful mkSynonymTyCon name binders res_kind roles rhs is_tau is_fam_free is_forgetful
= SynonymTyCon { = let tc =
tyConName = name, SynonymTyCon {
tyConUnique = nameUnique name, tyConName = name,
tyConBinders = binders, tyConUnique = nameUnique name,
tyConResKind = res_kind, tyConBinders = binders,
tyConKind = mkTyConKind binders res_kind, tyConResKind = res_kind,
tyConArity = length binders, tyConKind = mkTyConKind binders res_kind,
tyConTyVars = binderVars binders, tyConArity = length binders,
tcRoles = roles, tyConNullaryTy = mkTyConTy_ tc,
synTcRhs = rhs, tyConTyVars = binderVars binders,
synIsTau = is_tau, tcRoles = roles,
synIsFamFree = is_fam_free, synTcRhs = rhs,
synIsForgetful = is_forgetful synIsTau = is_tau,
} synIsFamFree = is_fam_free,
synIsForgetful = is_forgetful
}
in tc
-- | Create a type family 'TyCon' -- | Create a type family 'TyCon'
mkFamilyTyCon :: Name -> [TyConBinder] -> Kind -- ^ /result/ kind mkFamilyTyCon :: Name -> [TyConBinder] -> Kind -- ^ /result/ kind
-> Maybe Name -> FamTyConFlav -> Maybe Name -> FamTyConFlav
-> Maybe Class -> Injectivity -> TyCon -> Maybe Class -> Injectivity -> TyCon
mkFamilyTyCon name binders res_kind resVar flav parent inj mkFamilyTyCon name binders res_kind resVar flav parent inj
= FamilyTyCon = let tc =
{ tyConUnique = nameUnique name FamilyTyCon