[Git][ghc/ghc][wip/T21623] Replace SORT with TYPE and CONSTRAINT
Simon Peyton Jones (@simonpj)
gitlab at gitlab.haskell.org
Sun Aug 14 23:50:14 UTC 2022
Simon Peyton Jones pushed to branch wip/T21623 at Glasgow Haskell Compiler / GHC
Commits:
1fc503f4 by Simon Peyton Jones at 2022-08-15T00:48:31+01:00
Replace SORT with TYPE and CONSTRAINT
- - - - -
11 changed files:
- compiler/GHC/Builtin/Names.hs
- compiler/GHC/Builtin/Types.hs
- compiler/GHC/Builtin/Types.hs-boot
- compiler/GHC/Builtin/Types/Prim.hs
- compiler/GHC/Core/TyCo/Rep.hs
- compiler/GHC/Core/TyCon.hs
- compiler/GHC/Core/Type.hs
- compiler/GHC/Core/Unify.hs
- compiler/GHC/HsToCore/Pmc/Solver.hs
- libraries/base/GHC/Err.hs
- libraries/ghc-prim/GHC/Types.hs
Changes:
=====================================
compiler/GHC/Builtin/Names.hs
=====================================
@@ -1895,15 +1895,13 @@ nonEmptyTyConKey = mkPreludeTyConUnique 86
-- Kind constructors
liftedTypeKindTyConKey, unliftedTypeKindTyConKey,
- tYPETyConKey, liftedRepTyConKey, unliftedRepTyConKey,
+ tYPETyConKey, cONSTRAINTTyConKey,
+ liftedRepTyConKey, unliftedRepTyConKey,
constraintKindTyConKey, levityTyConKey, runtimeRepTyConKey,
vecCountTyConKey, vecElemTyConKey,
- zeroBitRepTyConKey, zeroBitTypeTyConKey,
- typeOrConstraintTyConKey, sORTTyConKey, cONSTRAINTTyConKey :: Unique
-typeOrConstraintTyConKey = mkPreludeTyConUnique 87
+ zeroBitRepTyConKey, zeroBitTypeTyConKey :: Unique
liftedTypeKindTyConKey = mkPreludeTyConUnique 88
unliftedTypeKindTyConKey = mkPreludeTyConUnique 89
-sORTTyConKey = mkPreludeTyConUnique 90
tYPETyConKey = mkPreludeTyConUnique 91
cONSTRAINTTyConKey = mkPreludeTyConUnique 92
constraintKindTyConKey = mkPreludeTyConUnique 93
@@ -2129,10 +2127,6 @@ fingerprintDataConKey = mkPreludeDataConUnique 35
srcLocDataConKey :: Unique
srcLocDataConKey = mkPreludeDataConUnique 37
-typeLikeDataConKey, constraintLikeDataConKey :: Unique
-typeLikeDataConKey = mkPreludeDataConUnique 38
-constraintLikeDataConKey = mkPreludeDataConUnique 39
-
trTyConDataConKey, trModuleDataConKey,
trNameSDataConKey, trNameDDataConKey,
trGhcPrimModuleKey :: Unique
=====================================
compiler/GHC/Builtin/Types.hs
=====================================
@@ -130,11 +130,6 @@ module GHC.Builtin.Types (
liftedDataConTyCon, unliftedDataConTyCon,
liftedDataConTy, unliftedDataConTy,
- -- * TypeOrConstraint
- typeOrConstraintTyCon, typeOrConstraintTy,
- typeLikeDataConTyCon, constraintLikeDataConTyCon,
- typeLikeDataConTy, constraintLikeDataConTy,
-
intRepDataConTy,
int8RepDataConTy, int16RepDataConTy, int32RepDataConTy, int64RepDataConTy,
wordRepDataConTy,
@@ -183,12 +178,12 @@ import GHC.Core.Coercion.Axiom
import GHC.Types.Id
import GHC.Types.TyThing
import GHC.Types.SourceText
-import GHC.Types.Var ( VarBndr (Bndr), visArgTypeLike )
+import GHC.Types.Var ( VarBndr (Bndr) )
import GHC.Settings.Constants ( mAX_TUPLE_SIZE, mAX_CTUPLE_SIZE, mAX_SUM_SIZE )
import GHC.Unit.Module ( Module )
import GHC.Core.Type
import qualified GHC.Core.TyCo.Rep as TyCoRep (Type(TyConApp))
-import GHC.Core.TyCo.Rep ( RuntimeRepType, mkNakedKindFunTy )
+import GHC.Core.TyCo.Rep ( RuntimeRepType )
import GHC.Types.RepType
import GHC.Core.DataCon
import GHC.Core.ConLike
@@ -315,14 +310,11 @@ wiredInTyCons = [ -- Units are not treated like other tuples, because they
, typeSymbolKindCon
, runtimeRepTyCon
, levityTyCon
- , typeOrConstraintTyCon
, vecCountTyCon
, vecElemTyCon
, constraintKindTyCon
, liftedTypeKindTyCon
, unliftedTypeKindTyCon
- , tYPETyCon
- , cONSTRAINTTyCon
, multiplicityTyCon
, naturalTyCon
, integerTyCon
@@ -1472,12 +1464,12 @@ unrestrictedFunTyConName = mkWiredInTyConName BuiltInSyntax gHC_TYPES (fsLit "->
* *
Type synonyms (all declared in ghc-prim:GHC.Types)
- type CONSTRAINT = SORT ConstraintLike :: RuntimeRep -> Type -- cONSTRAINTKind
- type Constraint = CONSTRAINT LiftedRep :: Type -- constraintKind
+ type CONSTRAINT :: RuntimeRep -> Type -- primitive; cONSTRAINTKind
+ type Constraint = CONSTRAINT LiftedRep :: Type -- constraintKind
- type TYPE = SORT TypeLike :: RuntimeRep -> Type -- tYPEKind
- type Type = TYPE LiftedRep :: Type -- liftedTypeKind
- type UnliftedType = TYPE UnliftedRep :: Type -- unliftedTypeKind
+ type TYPE :: RuntimeRep -> Type -- primitive; tYPEKind
+ type Type = TYPE LiftedRep :: Type -- liftedTypeKind
+ type UnliftedType = TYPE UnliftedRep :: Type -- unliftedTypeKind
type LiftedRep = BoxedRep Lifted :: RuntimeRep -- liftedRepTy
type UnliftedRep = BoxedRep Unlifted :: RuntimeRep -- unliftedRepTy
@@ -1501,37 +1493,6 @@ so the check will loop infinitely. Hence the use of a naked FunTy
constructor in tTYPETyCon and cONSTRAINTTyCon.
-}
-----------------------
--- type TYPE = SORT TypeLike
-tYPETyCon :: TyCon
-tYPETyCon = buildSynTyCon tYPETyConName [] kind [] rhs
- where
- rhs = TyCoRep.TyConApp sORTTyCon [typeLikeDataConTy]
- -- See Note [Naked FunTy]
- kind = mkNakedKindFunTy visArgTypeLike runtimeRepTy liftedTypeKind
-
-tYPETyConName :: Name
-tYPETyConName = mkWiredInTyConName UserSyntax gHC_TYPES (fsLit "TYPE")
- tYPETyConKey tYPETyCon
-
-tYPEKind :: Type
-tYPEKind = mkTyConTy tYPETyCon
-
-----------------------
--- type CONSTRAINT = SORT ConstraintLike
-cONSTRAINTTyCon :: TyCon
-cONSTRAINTTyCon = buildSynTyCon cONSTRAINTTyConName [] kind [] rhs
- where
- rhs = TyCoRep.TyConApp sORTTyCon [constraintLikeDataConTy]
- -- See Note [Naked FunTy]
- kind = mkNakedKindFunTy visArgTypeLike runtimeRepTy liftedTypeKind
-
-cONSTRAINTTyConName :: Name
-cONSTRAINTTyConName = mkWiredInTyConName UserSyntax gHC_TYPES (fsLit "CONSTRAINT")
- cONSTRAINTTyConKey cONSTRAINTTyCon
-
-cONSTRAINTKind :: Type
-cONSTRAINTKind = mkTyConTy cONSTRAINTTyCon
----------------------
-- type Constraint = CONSTRAINT LiftedRep
@@ -1582,45 +1543,6 @@ unliftedTypeKind :: Type
unliftedTypeKind = mkTyConTy unliftedTypeKindTyCon
-{- *********************************************************************
-* *
- data TypeOrConstraint = TypeLike | ConstraintLike
-* *
-********************************************************************* -}
-
-typeOrConstraintTyConName, typeLikeDataConName, constraintLikeDataConName :: Name
-typeOrConstraintTyConName = mkWiredInTyConName UserSyntax gHC_TYPES (fsLit "TypeOrConstraint")
- typeOrConstraintTyConKey typeOrConstraintTyCon
-typeLikeDataConName = mkWiredInDataConName UserSyntax gHC_TYPES (fsLit "TypeLike")
- typeLikeDataConKey typeLikeDataCon
-constraintLikeDataConName = mkWiredInDataConName UserSyntax gHC_TYPES (fsLit "ConstraintLike")
- constraintLikeDataConKey constraintLikeDataCon
-
-typeOrConstraintTyCon :: TyCon
-typeOrConstraintTyCon = pcTyCon typeOrConstraintTyConName Nothing []
- [typeLikeDataCon, constraintLikeDataCon]
-
-typeOrConstraintTy :: Type
-typeOrConstraintTy = mkTyConTy typeOrConstraintTyCon
-
-typeLikeDataCon, constraintLikeDataCon :: DataCon
-typeLikeDataCon = pcSpecialDataCon typeLikeDataConName
- [] typeOrConstraintTyCon (TypeOrConstraint TypeLike)
-constraintLikeDataCon = pcSpecialDataCon constraintLikeDataConName
- [] typeOrConstraintTyCon (TypeOrConstraint ConstraintLike)
-
-typeLikeDataConTyCon :: TyCon
-typeLikeDataConTyCon = promoteDataCon typeLikeDataCon
-
-constraintLikeDataConTyCon :: TyCon
-constraintLikeDataConTyCon = promoteDataCon constraintLikeDataCon
-
-typeLikeDataConTy :: Type
-typeLikeDataConTy = mkTyConTy typeLikeDataConTyCon
-
-constraintLikeDataConTy :: Type
-constraintLikeDataConTy = mkTyConTy constraintLikeDataConTyCon
-
{- *********************************************************************
* *
data Levity = Lifted | Unlifted
=====================================
compiler/GHC/Builtin/Types.hs-boot
=====================================
@@ -12,14 +12,10 @@ typeSymbolKind :: Type
charTy :: Type
mkBoxedTupleTy :: [Type] -> Type
-tYPETyCon, cONSTRAINTTyCon :: TyCon
-
coercibleTyCon, heqTyCon :: TyCon
unitTy :: Type
-typeOrConstraintTy :: Type
-
liftedTypeKindTyConName :: Name
liftedTypeKind, unliftedTypeKind, zeroBitTypeKind :: Kind
=====================================
compiler/GHC/Builtin/Types/Prim.hs
=====================================
@@ -43,7 +43,8 @@ module GHC.Builtin.Types.Prim(
multiplicityTyVar1, multiplicityTyVar2,
-- Kind constructors...
- sORTTyCon, sORTTyConName,
+ tYPETyCon, tYPETyConName, tYPEKind,
+ cONSTRAINTTyCon, cONSTRAINTTyConName, cONSTRAINTKind,
-- Arrows
fUNTyCon, fUNTyConName,
@@ -109,7 +110,6 @@ import GHC.Prelude
import {-# SOURCE #-} GHC.Builtin.Types
( runtimeRepTy, levityTy, unboxedTupleKind, liftedTypeKind, unliftedTypeKind
- , typeOrConstraintTy
, boxedRepDataConTyCon, vecRepDataConTyCon
, liftedRepTy, unliftedRepTy, zeroBitRepTy
, intRepDataConTy
@@ -125,7 +125,7 @@ import {-# SOURCE #-} GHC.Builtin.Types
, word32ElemRepDataConTy, word64ElemRepDataConTy, floatElemRepDataConTy
, doubleElemRepDataConTy
, multiplicityTy
- , constraintKind, cONSTRAINTTyCon )
+ , constraintKind )
import GHC.Types.Var ( TyVarBinder, TyVar
, mkTyVar, mkTyVarBinder, mkTyVarBinders )
@@ -150,6 +150,12 @@ import Data.Char
* *
********************************************************************* -}
+mk_TYPE_app :: Type -> Type
+mk_TYPE_app rep = mkTyConApp tYPETyCon [rep]
+
+mk_CONSTRAINT_app :: Type -> Type
+mk_CONSTRAINT_app rep = mkTyConApp cONSTRAINTTyCon [rep]
+
mkPrimTc :: FastString -> Unique -> TyCon -> Name
mkPrimTc = mkGenPrimTc UserSyntax
@@ -175,7 +181,7 @@ pcPrimTyCon name roles res_rep
where
bndr_kis = liftedTypeKind <$ roles
binders = mkTemplateAnonTyConBinders bndr_kis
- result_kind = mkTYPEapp res_rep
+ result_kind = mk_TYPE_app res_rep
-- | Create a primitive nullary 'TyCon' with the given 'Name'
-- and result kind representation.
@@ -198,14 +204,15 @@ pcPrimTyCon_LevPolyLastArg :: Name
pcPrimTyCon_LevPolyLastArg name roles res_rep
= mkPrimTyCon name binders result_kind (Nominal : roles)
where
- result_kind = mkTYPEapp res_rep
+ result_kind = mk_TYPE_app res_rep
lev_bndr = mkNamedTyConBinder Inferred levity1TyVar
binders = lev_bndr : mkTemplateAnonTyConBinders anon_bndr_kis
lev_tv = mkTyVarTy (binderVar lev_bndr)
-- [ Type, ..., Type, TYPE (BoxedRep l) ]
- anon_bndr_kis = changeLast (liftedTypeKind <$ roles)
- (mkTYPEapp $ mkTyConApp boxedRepDataConTyCon [lev_tv])
+ anon_bndr_kis = changeLast (liftedTypeKind <$ roles) $
+ mk_TYPE_app $
+ mkTyConApp boxedRepDataConTyCon [lev_tv]
{- *********************************************************************
@@ -267,7 +274,8 @@ exposedPrimTyCons
, stackSnapshotPrimTyCon
, fUNTyCon
- , sORTTyCon
+ , tYPETyCon
+ , cONSTRAINTTyCon
#include "primop-vector-tycons.hs-incl"
]
@@ -477,7 +485,9 @@ openAlphaTyVar, openBetaTyVar, openGammaTyVar :: TyVar
-- beta :: TYPE r2
-- gamma :: TYPE r3
[openAlphaTyVar,openBetaTyVar,openGammaTyVar]
- = mkTemplateTyVars [mkTYPEapp runtimeRep1Ty, mkTYPEapp runtimeRep2Ty, mkTYPEapp runtimeRep3Ty]
+ = mkTemplateTyVars [ mk_TYPE_app runtimeRep1Ty
+ , mk_TYPE_app runtimeRep2Ty
+ , mk_TYPE_app runtimeRep3Ty]
openAlphaTyVarSpec, openBetaTyVarSpec, openGammaTyVarSpec :: TyVarBinder
openAlphaTyVarSpec = mkTyVarBinder Specified openAlphaTyVar
@@ -506,8 +516,8 @@ levity2Ty = mkTyVarTy levity2TyVar
levPolyAlphaTyVar, levPolyBetaTyVar :: TyVar
[levPolyAlphaTyVar, levPolyBetaTyVar] =
mkTemplateTyVars
- [mkTYPEapp (mkTyConApp boxedRepDataConTyCon [levity1Ty])
- ,mkTYPEapp (mkTyConApp boxedRepDataConTyCon [levity2Ty])]
+ [ mk_TYPE_app (mkTyConApp boxedRepDataConTyCon [levity1Ty])
+ , mk_TYPE_app (mkTyConApp boxedRepDataConTyCon [levity2Ty])]
-- alpha :: TYPE ('BoxedRep l)
-- beta :: TYPE ('BoxedRep k)
@@ -599,8 +609,8 @@ fUNTyCon = mkPrimTyCon fUNTyConName tc_bndrs liftedTypeKind tc_roles
tc_bndrs = [ mkNamedTyConBinder Required multiplicityTyVar1
, mkNamedTyConBinder Inferred runtimeRep1TyVar
, mkNamedTyConBinder Inferred runtimeRep2TyVar ]
- ++ mkTemplateAnonTyConBinders [ mkTYPEapp runtimeRep1Ty
- , mkTYPEapp runtimeRep2Ty ]
+ ++ mkTemplateAnonTyConBinders [ mk_TYPE_app runtimeRep1Ty
+ , mk_TYPE_app runtimeRep2Ty ]
tc_roles = [Nominal, Nominal, Nominal, Representational, Representational]
-- (=>) :: forall {rep1 :: RuntimeRep} {rep2 :: RuntimeRep}.
@@ -611,8 +621,8 @@ ctArrowTyCon = mkPrimTyCon ctArrowTyConName tc_bndrs liftedTypeKind tc_roles
-- See also unrestrictedFunTyCon
tc_bndrs = [ mkNamedTyConBinder Inferred runtimeRep1TyVar
, mkNamedTyConBinder Inferred runtimeRep2TyVar ]
- ++ mkTemplateAnonTyConBinders [ mkCONSTRAINTapp runtimeRep1Ty
- , mkTYPEapp runtimeRep2Ty ]
+ ++ mkTemplateAnonTyConBinders [ mk_CONSTRAINT_app runtimeRep1Ty
+ , mk_TYPE_app runtimeRep2Ty ]
tc_roles = [Nominal, Nominal, Representational, Representational]
-- (==>) :: forall {rep1 :: RuntimeRep} {rep2 :: RuntimeRep}.
@@ -623,8 +633,8 @@ ccArrowTyCon = mkPrimTyCon ccArrowTyConName tc_bndrs constraintKind tc_roles
-- See also unrestrictedFunTyCon
tc_bndrs = [ mkNamedTyConBinder Inferred runtimeRep1TyVar
, mkNamedTyConBinder Inferred runtimeRep2TyVar ]
- ++ mkTemplateAnonTyConBinders [ mkCONSTRAINTapp runtimeRep1Ty
- , mkCONSTRAINTapp runtimeRep2Ty ]
+ ++ mkTemplateAnonTyConBinders [ mk_CONSTRAINT_app runtimeRep1Ty
+ , mk_CONSTRAINT_app runtimeRep2Ty ]
tc_roles = [Nominal, Nominal, Representational, Representational]
-- (-=>) :: forall {rep1 :: RuntimeRep} {rep2 :: RuntimeRep}.
@@ -635,8 +645,8 @@ tcArrowTyCon = mkPrimTyCon tcArrowTyConName tc_bndrs constraintKind tc_roles
-- See also unrestrictedFunTyCon
tc_bndrs = [ mkNamedTyConBinder Inferred runtimeRep1TyVar
, mkNamedTyConBinder Inferred runtimeRep2TyVar ]
- ++ mkTemplateAnonTyConBinders [ mkTYPEapp runtimeRep1Ty
- , mkCONSTRAINTapp runtimeRep2Ty ]
+ ++ mkTemplateAnonTyConBinders [ mk_TYPE_app runtimeRep1Ty
+ , mk_CONSTRAINT_app runtimeRep2Ty ]
tc_roles = [Nominal, Nominal, Representational, Representational]
{-
@@ -731,18 +741,18 @@ either. Reason (c.f. #7451):
bad; but it's fine provide they are not Apart.
So we ensure that Type and Constraint are not apart; or, more
-precisely, that TypeLike and ConstraintLike are not apart. This
+precisely, that TYPE and CONSTRAINT are not apart. This
non-apart-ness check is implemented in GHC.Core.Unify.unify_ty: look for
`maybeApart MARTypeVsConstraint`.
-Note taht before, nothing prevents writing instances like:
+Note that, as before, nothing prevents writing instances like:
instance C (Proxy @Type a) where ...
-In particular, SORT and TypeLike and ConstraintLike (and the synonyms
-TYPE, CONSTRAINT etc) are all allowed in instance heads. It's just
-that TypeLike is not apart from ConstraintLike so that instance would
-irretrievably overlap with:
+In particular, TYPE and CONSTRAINT (and the synonyms Type, Constraint
+etc) are all allowed in instance heads. It's just that TYPE
+apart from CONSTRAINT so that instance would irretrievably overlap
+with:
instance C (Proxy @Constraint a) where ...
@@ -775,15 +785,32 @@ generator never has to manipulate a value of type 'a :: TYPE rr'.
a -> b -> TYPE ('TupleRep '[r1, r2])
-}
-sORTTyCon :: TyCon
-sORTTyConName :: Name
-
--- SORT :: TypeOrConstraint -> RuntimeRep -> Type
-sORTTyCon = mkPrimTyCon sORTTyConName
- (mkTemplateAnonTyConBinders [typeOrConstraintTy, runtimeRepTy])
+----------------------
+tYPETyCon :: TyCon
+tYPETyCon = mkPrimTyCon tYPETyConName
+ (mkTemplateAnonTyConBinders [runtimeRepTy])
liftedTypeKind
[Nominal]
-sORTTyConName = mkPrimTc (fsLit "SORT") sORTTyConKey sORTTyCon
+
+tYPETyConName :: Name
+tYPETyConName = mkPrimTc (fsLit "TYPE") tYPETyConKey tYPETyCon
+
+tYPEKind :: Type
+tYPEKind = mkTyConTy tYPETyCon
+
+----------------------
+-- type CONSTRAINT = SORT ConstraintLike
+cONSTRAINTTyCon :: TyCon
+cONSTRAINTTyCon = mkPrimTyCon cONSTRAINTTyConName
+ (mkTemplateAnonTyConBinders [runtimeRepTy])
+ liftedTypeKind
+ [Nominal]
+
+cONSTRAINTTyConName :: Name
+cONSTRAINTTyConName = mkPrimTc (fsLit "CONSTRAINT") cONSTRAINTTyConKey cONSTRAINTTyCon
+
+cONSTRAINTKind :: Type
+cONSTRAINTKind = mkTyConTy cONSTRAINTTyCon
{- *********************************************************************
=====================================
compiler/GHC/Core/TyCo/Rep.hs
=====================================
@@ -65,11 +65,6 @@ module GHC.Core.TyCo.Rep (
-- * Functions over coercions
pickLR,
- -- * Space-saving construction
- mkTYPEapp, mkTYPEapp_maybe,
- mkCONSTRAINTapp, mkCONSTRAINTapp_maybe,
- mkBoxedRepApp_maybe, mkTupleRepApp_maybe,
-
-- ** Analyzing types
TyCoFolder(..), foldTyCo, noView,
@@ -2122,149 +2117,4 @@ constructors for these.
type Mult = Type
-{- *********************************************************************
-* *
- Space-saving construction
-* *
-********************************************************************* -}
-
-{- Note [Using synonyms to compress types]
-~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
-Was: Prefer Type over TYPE (BoxedRep Lifted)]
-
-The Core of nearly any program will have numerous occurrences of the Types
-
- TyConApp BoxedRep [TyConApp Lifted []] -- Synonym LiftedRep
- TyConApp BoxedRep [TyConApp Unlifted []] -- Synonym UnliftedREp
- TyConApp TYPE [TyConApp LiftedRep []] -- Synonym Type
- TyConApp TYPE [TyConApp UnliftedRep []] -- Synonym UnliftedType
-
-While investigating #17292 we found that these constituted a majority
-of all TyConApp constructors on the heap:
-
- (From a sample of 100000 TyConApp closures)
- 0x45f3523 - 28732 - `Type`
- 0x420b840702 - 9629 - generic type constructors
- 0x42055b7e46 - 9596
- 0x420559b582 - 9511
- 0x420bb15a1e - 9509
- 0x420b86c6ba - 9501
- 0x42055bac1e - 9496
- 0x45e68fd - 538 - `TYPE ...`
-
-Consequently, we try hard to ensure that operations on such types are
-efficient. Specifically, we strive to
-
- a. Avoid heap allocation of such types; use a single static TyConApp
- b. Use a small (shallow in the tree-depth sense) representation
- for such types
-
-Goal (b) is particularly useful as it makes traversals (e.g. free variable
-traversal, substitution, and comparison) more efficient.
-Comparison in particular takes special advantage of nullary type synonym
-applications (e.g. things like @TyConApp typeTyCon []@), Note [Comparing
-nullary type synonyms] in "GHC.Core.Type".
-
-To accomplish these we use a number of tricks, implemented by mkTyConApp.
-
- 1. Instead of (TyConApp BoxedRep [TyConApp Lifted []]),
- we prefer a statically-allocated (TyConApp LiftedRep [])
- where `LiftedRep` is a type synonym:
- type LiftedRep = BoxedRep Lifted
- Similarly for UnliftedRep
-
- 2. Instead of (TyConApp TYPE [TyConApp LiftedRep []])
- we prefer the statically-allocated (TyConApp Type [])
- where `Type` is a type synonym
- type Type = TYPE LiftedRep
- Similarly for UnliftedType
-
-These serve goal (b) since there are no applied type arguments to traverse,
-e.g., during comparison.
-
- 3. We have a single, statically allocated top-level binding to
- represent `TyConApp GHC.Types.Type []` (namely
- 'GHC.Builtin.Types.Prim.liftedTypeKind'), ensuring that we don't
- need to allocate such types (goal (a)). See functions
- mkTYPEapp and mkBoxedRepApp
-
- 4. 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, #20541
--}
-
-mkTYPEapp :: RuntimeRepType -> Type
-mkTYPEapp rr
- = case mkTYPEapp_maybe rr of
- Just ty -> ty
- Nothing -> TyConApp tYPETyCon [rr]
-
-mkTYPEapp_maybe :: RuntimeRepType -> Maybe Type
--- ^ Given a @RuntimeRep@, applies @TYPE@ to it.
--- On the fly it rewrites
--- TYPE LiftedRep --> liftedTypeKind (a synonym)
--- TYPE UnliftedRep --> unliftedTypeKind (ditto)
--- TYPE ZeroBitRep --> zeroBitTypeKind (ditto)
--- NB: no need to check for TYPE (BoxedRep Lifted), TYPE (BoxedRep Unlifted)
--- because those inner types should already have been rewritten
--- to LiftedRep and UnliftedRep respectively, by mkTyConApp
---
--- see Note [SORT, TYPE, and CONSTRAINT] in GHC.Builtin.Types.Prim.
--- See Note [Using synonyms to compress types] in GHC.Core.Type
-{-# NOINLINE mkTYPEapp_maybe #-}
-mkTYPEapp_maybe (TyConApp tc args)
- | key == liftedRepTyConKey = assert (null args) $ Just liftedTypeKind -- TYPE LiftedRep
- | key == unliftedRepTyConKey = assert (null args) $ Just unliftedTypeKind -- TYPE UnliftedRep
- | key == zeroBitRepTyConKey = assert (null args) $ Just zeroBitTypeKind -- TYPE ZeroBitRep
- where
- key = tyConUnique tc
-mkTYPEapp_maybe _ = Nothing
-
-------------------
-mkCONSTRAINTapp :: RuntimeRepType -> Type
--- ^ Just like mkTYPEapp
-mkCONSTRAINTapp rr
- = case mkCONSTRAINTapp_maybe rr of
- Just ty -> ty
- Nothing -> TyConApp cONSTRAINTTyCon [rr]
-
-mkCONSTRAINTapp_maybe :: RuntimeRepType -> Maybe Type
--- ^ Just like mkTYPEapp_maybe
-{-# NOINLINE mkCONSTRAINTapp_maybe #-}
-mkCONSTRAINTapp_maybe (TyConApp tc args)
- | key == liftedRepTyConKey = assert (null args) $ Just constraintKind -- CONSTRAINT LiftedRep
- where
- key = tyConUnique tc
-mkCONSTRAINTapp_maybe _ = Nothing
-
-------------------
-mkBoxedRepApp_maybe :: Type -> Maybe Type
--- ^ Given a `Levity`, apply `BoxedRep` to it
--- On the fly, rewrite
--- BoxedRep Lifted --> liftedRepTy (a synonym)
--- BoxedRep Unlifted --> unliftedRepTy (ditto)
--- See Note [SORT, TYPE, and CONSTRAINT] in GHC.Builtin.Types.Prim.
--- See Note [Using synonyms to compress types] in GHC.Core.Type
-{-# NOINLINE mkBoxedRepApp_maybe #-}
-mkBoxedRepApp_maybe (TyConApp tc args)
- | key == liftedDataConKey = assert (null args) $ Just liftedRepTy -- BoxedRep Lifted
- | key == unliftedDataConKey = assert (null args) $ Just unliftedRepTy -- BoxedRep Unlifted
- where
- key = tyConUnique tc
-mkBoxedRepApp_maybe _ = Nothing
-
-mkTupleRepApp_maybe :: Type -> Maybe Type
--- ^ Given a `[RuntimeRep]`, apply `TupleRep` to it
--- On the fly, rewrite
--- TupleRep [] -> zeroBitRepTy (a synonym)
--- See Note [SORT, TYPE, and CONSTRAINT] in GHC.Builtin.Types.Prim.
--- See Note [Using synonyms to compress types] in GHC.Core.Type
-{-# NOINLINE mkTupleRepApp_maybe #-}
-mkTupleRepApp_maybe (TyConApp tc args)
- | key == nilDataConKey = assert (isSingleton args) $ Just zeroBitRepTy -- ZeroBitRep
- where
- key = tyConUnique tc
-mkTupleRepApp_maybe _ = Nothing
=====================================
compiler/GHC/Core/TyCon.hs
=====================================
@@ -521,8 +521,9 @@ mkTyConKind :: [TyConBinder] -> Kind -> Kind
mkTyConKind bndrs res_kind = foldr mk res_kind bndrs
where
mk :: TyConBinder -> Kind -> Kind
- mk (Bndr tv (AnonTCB af)) k = mkNakedKindFunTy af (varType tv) k
mk (Bndr tv (NamedTCB vis)) k = mkForAllTy tv vis k
+ mk (Bndr tv (AnonTCB af)) k = mkNakedKindFunTy af (varType tv) k
+ -- mkNakedKindFunTy: see Note [Naked FunTy] in GHC.Builtin.Types
tyConInvisTVBinders :: [TyConBinder] -- From the TyCon
-> [InvisTVBinder] -- Suitable for the foralls of a term function
@@ -1240,8 +1241,6 @@ data PromDataConInfo
| Levity Levity -- ^ A constructor of `Levity`
- | TypeOrConstraint TypeOrConstraint -- ^ A constructor of `TypeOrConstraint`
-
-- | 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!
=====================================
compiler/GHC/Core/Type.hs
=====================================
@@ -40,7 +40,7 @@ module GHC.Core.Type (
funTyAnonArgFlag, anonArgTyCon,
mkFunctionType, mkScaledFunctionTys, chooseAnonArgFlag,
- mkTyConApp, mkTyConTy, mkTYPEapp, mkCONSTRAINTapp,
+ mkTyConApp, mkTyConTy,
tyConAppTyCon_maybe, tyConAppTyConPicky_maybe,
tyConAppArgs_maybe, tyConAppTyCon, tyConAppArgs,
@@ -119,6 +119,11 @@ module GHC.Core.Type (
isValidJoinPointType,
tyConAppNeedsKindSig,
+ -- * Space-saving construction
+ mkTYPEapp, mkTYPEapp_maybe,
+ mkCONSTRAINTapp, mkCONSTRAINTapp_maybe,
+ mkBoxedRepApp_maybe, mkTupleRepApp_maybe,
+
-- *** Levity and boxity
sORTKind_maybe, typeTypeOrConstraint,
typeLevity_maybe,
@@ -260,14 +265,18 @@ import GHC.Types.Unique.Set
import GHC.Core.TyCon
import GHC.Builtin.Types.Prim
+
import {-# SOURCE #-} GHC.Builtin.Types
- ( charTy, naturalTy
- , typeSymbolKind, liftedTypeKind, unliftedTypeKind
- , boxedRepDataConTyCon, constraintKind
- , manyDataConTy, oneDataConTy )
+ ( charTy, naturalTy
+ , typeSymbolKind, liftedTypeKind, unliftedTypeKind
+ , boxedRepDataConTyCon, constraintKind, zeroBitTypeKind
+ , manyDataConTy, oneDataConTy
+ , liftedRepTy, unliftedRepTy, zeroBitRepTy )
+
import GHC.Types.Name( Name )
import GHC.Builtin.Names
import GHC.Core.Coercion.Axiom
+
import {-# SOURCE #-} GHC.Core.Coercion
( mkNomReflCo, mkGReflCo, mkReflCo
, mkTyConAppCo, mkAppCo, mkCoVarCo, mkAxiomRuleCo
@@ -1525,7 +1534,6 @@ applyTysX tvs body_ty arg_tys
(arg_tys_prefix, arg_tys_rest) = splitAtList tvs arg_tys
-
{- Note [Care with kind instantiation]
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
Suppose we have
@@ -1648,6 +1656,70 @@ tcSplitTyConApp_maybe ty
-> funTyConAppTy_maybe af w arg res
_ -> Nothing
+---------------------------
+-- | (mkTyConTy tc) returns (TyConApp tc [])
+-- but arranges to share that TyConApp among all calls
+-- See Note [Sharing nullary TyConApps] in GHC.Core.TyCon
+mkTyConTy :: TyCon -> Type
+mkTyConTy tycon = tyConNullaryTy 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 []
+ = -- See Note [Sharing nullary TyConApps] in GHC.Core.TyCon
+ mkTyConTy tycon
+
+mkTyConApp tycon tys@(ty1:rest)
+ | Just (af, mult, arg, res) <- tyConAppFun_maybe id tycon tys
+ = FunTy { ft_af = af, ft_mult = mult, ft_arg = arg, ft_res = res }
+
+ -- See Note [Using synonyms to compress types]
+ | key == tYPETyConKey
+ = assert (null rest) $
+-- mkTYPEapp_maybe ty1 `orElse` bale_out
+ case mkTYPEapp_maybe ty1 of
+ Just ty -> ty -- pprTrace "mkTYPEapp:yes" (ppr ty) ty
+ Nothing -> bale_out -- pprTrace "mkTYPEapp:no" (ppr bale_out) bale_out
+
+ -- See Note [Using synonyms to compress types]
+ | key == boxedRepDataConTyConKey
+ = assert (null rest) $
+-- mkBoxedRepApp_maybe ty1 `orElse` bale_out
+ case mkBoxedRepApp_maybe ty1 of
+ Just ty -> ty -- pprTrace "mkBoxedRepApp:yes" (ppr ty) ty
+ Nothing -> bale_out -- pprTrace "mkBoxedRepApp:no" (ppr bale_out) bale_out
+
+ | key == tupleRepDataConTyConKey
+ = case mkTupleRepApp_maybe ty1 of
+ Just ty -> ty -- pprTrace "mkTupleRepApp:yes" (ppr ty) ty
+ Nothing -> bale_out -- pprTrace "mkTupleRepApp:no" (ppr bale_out) bale_out
+
+ -- The catch-all case
+ | otherwise
+ = bale_out
+ where
+ key = tyConUnique tycon
+ bale_out = TyConApp tycon tys
+
+
+{- Note [Care using synonyms to compress types]
+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+Using a synonym to compress a types has a tricky wrinkle. Consider
+coreView applied to (TyConApp LiftedRep [])
+
+* coreView expands the LiftedRep synonym:
+ type LiftedRep = BoxedRep Lifted
+
+* Danger: we might apply the empty substitution to the RHS of the
+ synonym. And substTy calls mkTyConApp BoxedRep [Lifted]. And
+ mkTyConApp compresses that back to LiftedRep. Loop!
+
+* Solution: in expandSynTyConApp_maybe, don't call substTy for nullary
+ type synonyms. That's more efficient anyway.
+-}
+
+
-------------------
newTyConInstRhs :: TyCon -> [Type] -> Type
-- ^ Unwrap one 'layer' of newtype on a type constructor and its
@@ -1732,77 +1804,6 @@ The solution is easy: just use `coreView` when establishing (EQ3) and (EQ4) in
`mk_cast_ty`.
-}
-tyConBindersTyCoBinders :: [TyConBinder] -> [TyCoBinder]
--- Return the tyConBinders in TyCoBinder form
-tyConBindersTyCoBinders = map to_tyb
- where
- to_tyb (Bndr tv (NamedTCB vis)) = Named (Bndr tv vis)
- to_tyb (Bndr tv (AnonTCB af)) = Anon af (tymult (varType tv))
-
--- | (mkTyConTy tc) returns (TyConApp tc [])
--- but arranges to share that TyConApp among all calls
--- See Note [Sharing nullary TyConApps] in GHC.Core.TyCon
-mkTyConTy :: TyCon -> Type
-mkTyConTy tycon = tyConNullaryTy 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 []
- = -- See Note [Sharing nullary TyConApps] in GHC.Core.TyCon
- mkTyConTy tycon
-
-mkTyConApp tycon tys@(ty1:rest)
- | Just (af, mult, arg, res) <- tyConAppFun_maybe id tycon tys
- = FunTy { ft_af = af, ft_mult = mult, ft_arg = arg, ft_res = res }
-
- -- See Note [Using synonyms to compress types]
- | key == tYPETyConKey
- = assert (null rest) $
--- mkTYPEapp_maybe ty1 `orElse` bale_out
- case mkTYPEapp_maybe ty1 of
- Just ty -> ty -- pprTrace "mkTYPEapp:yes" (ppr ty) ty
- Nothing -> bale_out -- pprTrace "mkTYPEapp:no" (ppr bale_out) bale_out
-
- -- See Note [Using synonyms to compress types]
- | key == boxedRepDataConTyConKey
- = assert (null rest) $
--- mkBoxedRepApp_maybe ty1 `orElse` bale_out
- case mkBoxedRepApp_maybe ty1 of
- Just ty -> ty -- pprTrace "mkBoxedRepApp:yes" (ppr ty) ty
- Nothing -> bale_out -- pprTrace "mkBoxedRepApp:no" (ppr bale_out) bale_out
-
- | key == tupleRepDataConTyConKey
- = case mkTupleRepApp_maybe ty1 of
- Just ty -> ty -- pprTrace "mkTupleRepApp:yes" (ppr ty) ty
- Nothing -> bale_out -- pprTrace "mkTupleRepApp:no" (ppr bale_out) bale_out
-
- -- The catch-all case
- | otherwise
- = bale_out
- where
- key = tyConUnique tycon
- bale_out = TyConApp tycon tys
-
-
-{- Note [Care using synonyms to compress types]
-~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
-Using a synonym to compress a types has a tricky wrinkle. Consider
-coreView applied to (TyConApp LiftedRep [])
-
-* coreView expands the LiftedRep synonym:
- type LiftedRep = BoxedRep Lifted
-
-* Danger: we might apply the empty substitution to the RHS of the
- synonym. And substTy calls mkTyConApp BoxedRep [Lifted]. And
- mkTyConApp compresses that back to LiftedRep. Loop!
-
-* Solution: in expandSynTyConApp_maybe, don't call substTy for nullary
- type synonyms. That's more efficient anyway.
--}
-
-
-
{- *********************************************************************
* *
CoercionTy
@@ -1833,6 +1834,13 @@ stripCoercionTy ty = pprPanic "stripCoercionTy" (ppr ty)
* *
********************************************************************* -}
+tyConBindersTyCoBinders :: [TyConBinder] -> [TyCoBinder]
+-- Return the tyConBinders in TyCoBinder form
+tyConBindersTyCoBinders = map to_tyb
+ where
+ to_tyb (Bndr tv (NamedTCB vis)) = Named (Bndr tv vis)
+ to_tyb (Bndr tv (AnonTCB af)) = Anon af (tymult (varType tv))
+
-- | Make a dependent forall over an 'Inferred' variable
mkTyCoInvForAllTy :: TyCoVar -> Type -> Type
mkTyCoInvForAllTy tv ty
@@ -3042,17 +3050,14 @@ tcTypeKind ty@(ForAllTy {})
-}
sORTKind_maybe :: Kind -> Maybe (TypeOrConstraint, Type)
--- Sees if the argument is if form (SORT type_or_constraint runtime_rep)
--- and if so returns those components
---
--- We do not have type-or-constraint polymorphism, so the
--- argument to SORT should always be TypeLike or ConstraintLike
+-- Sees if the argument is of form (TYPE rep) or (CONSTRAINT rep)
+-- and if so returns which, and the runtime rep
sORTKind_maybe kind
= case splitTyConApp_maybe kind of
- Just (tc, tys) | tc `hasKey` sORTTyConKey
- , [torc_ty, rep] <- tys
- , Just torc <- getTypeOrConstraint_maybe torc_ty
- -> Just (torc, rep)
+ Just (tc, tys) | tc `hasKey` tYPETyConKey, [rep] <- tys
+ -> Just (TypeLike, rep)
+ | tc `hasKey` cONSTRAINTTyConKey, [rep] <- tys
+ -> Just (ConstraintLike, rep)
_ -> Nothing
typeTypeOrConstraint :: HasDebugCallStack => Type -> TypeOrConstraint
@@ -3081,15 +3086,6 @@ classifiesTypeWithValues :: Kind -> Bool
-- ^ True of a kind `SORT _ _`
classifiesTypeWithValues k = isJust (sORTKind_maybe k)
-getTypeOrConstraint_maybe :: Type -> Maybe TypeOrConstraint
--- The argument is a type of kind TypeOrConstraint
-getTypeOrConstraint_maybe ty
- | Just (tc,args) <- splitTyConApp_maybe ty
- , TypeOrConstraint torc <- tyConPromDataConInfo tc
- = assert (null args) $ Just torc
- | otherwise
- = Nothing
-
isConstraintKind :: Kind -> Bool
-- True of (SORT ConstraintLike _)
isConstraintKind kind
@@ -3890,3 +3886,149 @@ isLinearType ty = case ty of
FunTy _ _ _ _ -> True
ForAllTy _ res -> isLinearType res
_ -> False
+
+{- *********************************************************************
+* *
+ Space-saving construction
+* *
+********************************************************************* -}
+
+{- Note [Using synonyms to compress types]
+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+Was: Prefer Type over TYPE (BoxedRep Lifted)]
+
+The Core of nearly any program will have numerous occurrences of the Types
+
+ TyConApp BoxedRep [TyConApp Lifted []] -- Synonym LiftedRep
+ TyConApp BoxedRep [TyConApp Unlifted []] -- Synonym UnliftedREp
+ TyConApp TYPE [TyConApp LiftedRep []] -- Synonym Type
+ TyConApp TYPE [TyConApp UnliftedRep []] -- Synonym UnliftedType
+
+While investigating #17292 we found that these constituted a majority
+of all TyConApp constructors on the heap:
+
+ (From a sample of 100000 TyConApp closures)
+ 0x45f3523 - 28732 - `Type`
+ 0x420b840702 - 9629 - generic type constructors
+ 0x42055b7e46 - 9596
+ 0x420559b582 - 9511
+ 0x420bb15a1e - 9509
+ 0x420b86c6ba - 9501
+ 0x42055bac1e - 9496
+ 0x45e68fd - 538 - `TYPE ...`
+
+Consequently, we try hard to ensure that operations on such types are
+efficient. Specifically, we strive to
+
+ a. Avoid heap allocation of such types; use a single static TyConApp
+ b. Use a small (shallow in the tree-depth sense) representation
+ for such types
+
+Goal (b) is particularly useful as it makes traversals (e.g. free variable
+traversal, substitution, and comparison) more efficient.
+Comparison in particular takes special advantage of nullary type synonym
+applications (e.g. things like @TyConApp typeTyCon []@), Note [Comparing
+nullary type synonyms] in "GHC.Core.Type".
+
+To accomplish these we use a number of tricks, implemented by mkTyConApp.
+
+ 1. Instead of (TyConApp BoxedRep [TyConApp Lifted []]),
+ we prefer a statically-allocated (TyConApp LiftedRep [])
+ where `LiftedRep` is a type synonym:
+ type LiftedRep = BoxedRep Lifted
+ Similarly for UnliftedRep
+
+ 2. Instead of (TyConApp TYPE [TyConApp LiftedRep []])
+ we prefer the statically-allocated (TyConApp Type [])
+ where `Type` is a type synonym
+ type Type = TYPE LiftedRep
+ Similarly for UnliftedType
+
+These serve goal (b) since there are no applied type arguments to traverse,
+e.g., during comparison.
+
+ 3. We have a single, statically allocated top-level binding to
+ represent `TyConApp GHC.Types.Type []` (namely
+ 'GHC.Builtin.Types.Prim.liftedTypeKind'), ensuring that we don't
+ need to allocate such types (goal (a)). See functions
+ mkTYPEapp and mkBoxedRepApp
+
+ 4. 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, #20541
+-}
+
+mkTYPEapp :: RuntimeRepType -> Type
+mkTYPEapp rr
+ = case mkTYPEapp_maybe rr of
+ Just ty -> ty
+ Nothing -> TyConApp tYPETyCon [rr]
+
+mkTYPEapp_maybe :: RuntimeRepType -> Maybe Type
+-- ^ Given a @RuntimeRep@, applies @TYPE@ to it.
+-- On the fly it rewrites
+-- TYPE LiftedRep --> liftedTypeKind (a synonym)
+-- TYPE UnliftedRep --> unliftedTypeKind (ditto)
+-- TYPE ZeroBitRep --> zeroBitTypeKind (ditto)
+-- NB: no need to check for TYPE (BoxedRep Lifted), TYPE (BoxedRep Unlifted)
+-- because those inner types should already have been rewritten
+-- to LiftedRep and UnliftedRep respectively, by mkTyConApp
+--
+-- see Note [SORT, TYPE, and CONSTRAINT] in GHC.Builtin.Types.Prim.
+-- See Note [Using synonyms to compress types] in GHC.Core.Type
+{-# NOINLINE mkTYPEapp_maybe #-}
+mkTYPEapp_maybe (TyConApp tc args)
+ | key == liftedRepTyConKey = assert (null args) $ Just liftedTypeKind -- TYPE LiftedRep
+ | key == unliftedRepTyConKey = assert (null args) $ Just unliftedTypeKind -- TYPE UnliftedRep
+ | key == zeroBitRepTyConKey = assert (null args) $ Just zeroBitTypeKind -- TYPE ZeroBitRep
+ where
+ key = tyConUnique tc
+mkTYPEapp_maybe _ = Nothing
+
+------------------
+mkCONSTRAINTapp :: RuntimeRepType -> Type
+-- ^ Just like mkTYPEapp
+mkCONSTRAINTapp rr
+ = case mkCONSTRAINTapp_maybe rr of
+ Just ty -> ty
+ Nothing -> TyConApp cONSTRAINTTyCon [rr]
+
+mkCONSTRAINTapp_maybe :: RuntimeRepType -> Maybe Type
+-- ^ Just like mkTYPEapp_maybe
+{-# NOINLINE mkCONSTRAINTapp_maybe #-}
+mkCONSTRAINTapp_maybe (TyConApp tc args)
+ | key == liftedRepTyConKey = assert (null args) $ Just constraintKind -- CONSTRAINT LiftedRep
+ where
+ key = tyConUnique tc
+mkCONSTRAINTapp_maybe _ = Nothing
+
+------------------
+mkBoxedRepApp_maybe :: Type -> Maybe Type
+-- ^ Given a `Levity`, apply `BoxedRep` to it
+-- On the fly, rewrite
+-- BoxedRep Lifted --> liftedRepTy (a synonym)
+-- BoxedRep Unlifted --> unliftedRepTy (ditto)
+-- See Note [SORT, TYPE, and CONSTRAINT] in GHC.Builtin.Types.Prim.
+-- See Note [Using synonyms to compress types] in GHC.Core.Type
+{-# NOINLINE mkBoxedRepApp_maybe #-}
+mkBoxedRepApp_maybe (TyConApp tc args)
+ | key == liftedDataConKey = assert (null args) $ Just liftedRepTy -- BoxedRep Lifted
+ | key == unliftedDataConKey = assert (null args) $ Just unliftedRepTy -- BoxedRep Unlifted
+ where
+ key = tyConUnique tc
+mkBoxedRepApp_maybe _ = Nothing
+
+mkTupleRepApp_maybe :: Type -> Maybe Type
+-- ^ Given a `[RuntimeRep]`, apply `TupleRep` to it
+-- On the fly, rewrite
+-- TupleRep [] -> zeroBitRepTy (a synonym)
+-- See Note [SORT, TYPE, and CONSTRAINT] in GHC.Builtin.Types.Prim.
+-- See Note [Using synonyms to compress types] in GHC.Core.Type
+{-# NOINLINE mkTupleRepApp_maybe #-}
+mkTupleRepApp_maybe (TyConApp tc args)
+ | key == nilDataConKey = assert (isSingleton args) $ Just zeroBitRepTy -- ZeroBitRep
+ where
+ key = tyConUnique tc
+mkTupleRepApp_maybe _ = Nothing
=====================================
compiler/GHC/Core/Unify.hs
=====================================
@@ -1081,14 +1081,6 @@ unify_ty env ty1 (TyVarTy tv2) kco
= uVar (umSwapRn env) tv2 ty1 (mkSymCo kco)
unify_ty env ty1 ty2 _kco
- -- Type and Constraint are not Apart
- -- See Note [Type vs Constraint] in GHC.Builtin.Types.Prim
- | Just (tc1,_) <- mb_tc_app1
- , TypeOrConstraint {} <- tyConPromDataConInfo tc1
- , Just (tc2,_) <- mb_tc_app2
- , TypeOrConstraint {} <- tyConPromDataConInfo tc2
- = maybeApart MARTypeVsConstraint
-
| Just (tc1, tys1) <- mb_tc_app1
, Just (tc2, tys2) <- mb_tc_app2
, tc1 == tc2
@@ -1124,6 +1116,13 @@ unify_ty env ty1 ty2 _kco
-- NB: we have already dealt with the 'ty1 = variable' case
= maybeApart MARTypeFamily
+ -- TYPE and CONSTRAINT are not Apart
+ -- See Note [Type vs Constraint] in GHC.Builtin.Types.Prim
+ -- NB: at this point we know that the two TyCons do not match
+ | Just {} <- sORTKind_maybe ty1
+ , Just {} <- sORTKind_maybe ty2
+ = maybeApart MARTypeVsConstraint
+
where
mb_tc_app1 = splitTyConApp_maybe ty1
mb_tc_app2 = splitTyConApp_maybe ty2
=====================================
compiler/GHC/HsToCore/Pmc/Solver.hs
=====================================
@@ -72,7 +72,6 @@ import GHC.Core.TyCon
import GHC.Core.TyCon.RecWalk
import GHC.Builtin.Names
import GHC.Builtin.Types
-import GHC.Builtin.Types.Prim (sORTTyCon)
import GHC.Core.TyCo.Rep
import GHC.Core.TyCo.Subst (elemSubst)
import GHC.Core.Type
@@ -146,10 +145,10 @@ updRcm f (RCM vanilla pragmas)
-- Ex.: @vanillaCompleteMatchTC 'Maybe' ==> Just ("Maybe", {'Just','Nothing'})@
vanillaCompleteMatchTC :: TyCon -> Maybe CompleteMatch
vanillaCompleteMatchTC tc =
- let -- SORT acts like an empty data type on the term-level (#14086), but
+ let -- TYPE acts like an empty data type on the term-level (#14086), but
-- it is a PrimTyCon, so tyConDataCons_maybe returns Nothing. Hence a
-- special case.
- mb_dcs | tc == sORTTyCon = Just []
+ mb_dcs | tc == tYPETyCon = Just []
| otherwise = tyConDataCons_maybe tc
in vanillaCompleteMatch . mkUniqDSet . map RealDataCon <$> mb_dcs
=====================================
libraries/base/GHC/Err.hs
=====================================
@@ -23,7 +23,7 @@
-----------------------------------------------------------------------------
module GHC.Err( absentErr, error, errorWithoutStackTrace, undefined ) where
-import GHC.Types (Char, RuntimeRep, TYPE)
+import GHC.Types (Char, RuntimeRep)
import GHC.Stack.Types
import GHC.Prim
import {-# SOURCE #-} GHC.Exception
=====================================
libraries/ghc-prim/GHC/Types.hs
=====================================
@@ -106,12 +106,6 @@ type UnliftedRep = 'BoxedRep 'Unlifted
type ZeroBitRep = 'TupleRep '[]
-------------------------
--- | The kind of types
-type TYPE = SORT TypeLike
-
--- | The kind of constraints
-type CONSTRAINT = SORT ConstraintLike
-
-- | The kind of lifted constraints
type Constraint = CONSTRAINT LiftedRep
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/1fc503f463d69e3b04535bda8de995fa7a5f797d
--
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/1fc503f463d69e3b04535bda8de995fa7a5f797d
You're receiving this email because of your account on gitlab.haskell.org.
-------------- next part --------------
An HTML attachment was scrubbed...
URL: <http://mail.haskell.org/pipermail/ghc-commits/attachments/20220814/fc55243e/attachment-0001.html>
More information about the ghc-commits
mailing list