summaryrefslogtreecommitdiff
path: root/compiler/GHC
diff options
context:
space:
mode:
authorBen Gamari <ben@smart-cactus.org>2021-02-02 10:06:11 -0500
committerBen Gamari <ben@smart-cactus.org>2021-03-07 17:01:40 -0500
commit3e082f8ff5ea2f42c5e6430094683b26b5818fb8 (patch)
tree4c85427ff40740b654cf1911a20a3a478a9fb754 /compiler/GHC
parentcf65cf16c89414273c4f6b2d090d4b2fffb90759 (diff)
downloadhaskell-3e082f8ff5ea2f42c5e6430094683b26b5818fb8.tar.gz
Implement BoxedRep proposalwip/boxed-rep
This implements the BoxedRep proposal, refactoring the `RuntimeRep` hierarchy from: ```haskell data RuntimeRep = LiftedPtrRep | UnliftedPtrRep | ... ``` to ```haskell data RuntimeRep = BoxedRep Levity | ... data Levity = Lifted | Unlifted ``` Updates binary, haddock submodules. Closes #17526. Metric Increase: T12545
Diffstat (limited to 'compiler/GHC')
-rw-r--r--compiler/GHC/Builtin/Names.hs74
-rw-r--r--compiler/GHC/Builtin/Types.hs170
-rw-r--r--compiler/GHC/Builtin/Types.hs-boot18
-rw-r--r--compiler/GHC/Builtin/Types/Prim.hs26
-rw-r--r--compiler/GHC/Core/TyCo/Rep.hs68
-rw-r--r--compiler/GHC/Core/TyCon.hs8
-rw-r--r--compiler/GHC/Core/Type.hs150
-rw-r--r--compiler/GHC/Core/Type.hs-boot1
-rw-r--r--compiler/GHC/Iface/Type.hs48
-rw-r--r--compiler/GHC/Tc/Errors.hs4
-rw-r--r--compiler/GHC/Tc/Instance/Typeable.hs28
-rw-r--r--compiler/GHC/Tc/Utils/TcMType.hs4
-rw-r--r--compiler/GHC/Types/RepType.hs12
-rw-r--r--compiler/GHC/Utils/Binary.hs1
-rw-r--r--compiler/GHC/Utils/Binary/Typeable.hs13
15 files changed, 437 insertions, 188 deletions
diff --git a/compiler/GHC/Builtin/Names.hs b/compiler/GHC/Builtin/Names.hs
index 93ea664739..2836c82e72 100644
--- a/compiler/GHC/Builtin/Names.hs
+++ b/compiler/GHC/Builtin/Names.hs
@@ -1894,7 +1894,7 @@ statePrimTyConKey, stableNamePrimTyConKey, stableNameTyConKey,
wordPrimTyConKey, wordTyConKey, word8PrimTyConKey, word8TyConKey,
word16PrimTyConKey, word16TyConKey, word32PrimTyConKey, word32TyConKey,
word64PrimTyConKey, word64TyConKey,
- liftedConKey, unliftedConKey, anyBoxConKey, kindConKey, boxityConKey,
+ anyBoxConKey, kindConKey, boxityConKey,
typeConKey, threadIdPrimTyConKey, bcoPrimTyConKey, ptrTyConKey,
funPtrTyConKey, tVarPrimTyConKey, eqPrimTyConKey,
eqReprPrimTyConKey, eqPhantPrimTyConKey,
@@ -1917,8 +1917,6 @@ word32PrimTyConKey = mkPreludeTyConUnique 65
word32TyConKey = mkPreludeTyConUnique 66
word64PrimTyConKey = mkPreludeTyConUnique 67
word64TyConKey = mkPreludeTyConUnique 68
-liftedConKey = mkPreludeTyConUnique 69
-unliftedConKey = mkPreludeTyConUnique 70
anyBoxConKey = mkPreludeTyConUnique 71
kindConKey = mkPreludeTyConUnique 72
boxityConKey = mkPreludeTyConUnique 73
@@ -1934,15 +1932,20 @@ eitherTyConKey :: Unique
eitherTyConKey = mkPreludeTyConUnique 84
-- Kind constructors
-liftedTypeKindTyConKey, tYPETyConKey,
- constraintKindTyConKey, runtimeRepTyConKey,
+liftedTypeKindTyConKey, unliftedTypeKindTyConKey,
+ tYPETyConKey, liftedRepTyConKey, unliftedRepTyConKey,
+ constraintKindTyConKey, levityTyConKey, runtimeRepTyConKey,
vecCountTyConKey, vecElemTyConKey :: Unique
liftedTypeKindTyConKey = mkPreludeTyConUnique 87
-tYPETyConKey = mkPreludeTyConUnique 88
+unliftedTypeKindTyConKey = mkPreludeTyConUnique 88
+tYPETyConKey = mkPreludeTyConUnique 89
constraintKindTyConKey = mkPreludeTyConUnique 92
+levityTyConKey = mkPreludeTyConUnique 94
runtimeRepTyConKey = mkPreludeTyConUnique 95
vecCountTyConKey = mkPreludeTyConUnique 96
vecElemTyConKey = mkPreludeTyConUnique 97
+liftedRepTyConKey = mkPreludeTyConUnique 98
+unliftedRepTyConKey = mkPreludeTyConUnique 99
pluginTyConKey, frontendPluginTyConKey :: Unique
pluginTyConKey = mkPreludeTyConUnique 102
@@ -2206,59 +2209,61 @@ metaDataDataConKey = mkPreludeDataConUnique 68
metaConsDataConKey = mkPreludeDataConUnique 69
metaSelDataConKey = mkPreludeDataConUnique 70
-vecRepDataConKey, tupleRepDataConKey, sumRepDataConKey :: Unique
+vecRepDataConKey, tupleRepDataConKey, sumRepDataConKey,
+ boxedRepDataConKey :: Unique
vecRepDataConKey = mkPreludeDataConUnique 71
tupleRepDataConKey = mkPreludeDataConUnique 72
sumRepDataConKey = mkPreludeDataConUnique 73
+boxedRepDataConKey = mkPreludeDataConUnique 74
-- See Note [Wiring in RuntimeRep] in GHC.Builtin.Types
-runtimeRepSimpleDataConKeys, unliftedSimpleRepDataConKeys, unliftedRepDataConKeys :: [Unique]
-liftedRepDataConKey :: Unique
-runtimeRepSimpleDataConKeys@(liftedRepDataConKey : unliftedSimpleRepDataConKeys)
- = map mkPreludeDataConUnique [74..88]
+-- Includes all nullary-data-constructor reps. Does not
+-- include BoxedRep, VecRep, SumRep, TupleRep.
+runtimeRepSimpleDataConKeys :: [Unique]
+runtimeRepSimpleDataConKeys
+ = map mkPreludeDataConUnique [75..87]
-unliftedRepDataConKeys = vecRepDataConKey :
- tupleRepDataConKey :
- sumRepDataConKey :
- unliftedSimpleRepDataConKeys
+liftedDataConKey,unliftedDataConKey :: Unique
+liftedDataConKey = mkPreludeDataConUnique 88
+unliftedDataConKey = mkPreludeDataConUnique 89
-- See Note [Wiring in RuntimeRep] in GHC.Builtin.Types
-- VecCount
vecCountDataConKeys :: [Unique]
-vecCountDataConKeys = map mkPreludeDataConUnique [89..94]
+vecCountDataConKeys = map mkPreludeDataConUnique [90..95]
-- See Note [Wiring in RuntimeRep] in GHC.Builtin.Types
-- VecElem
vecElemDataConKeys :: [Unique]
-vecElemDataConKeys = map mkPreludeDataConUnique [95..104]
+vecElemDataConKeys = map mkPreludeDataConUnique [96..105]
-- Typeable things
kindRepTyConAppDataConKey, kindRepVarDataConKey, kindRepAppDataConKey,
kindRepFunDataConKey, kindRepTYPEDataConKey,
kindRepTypeLitSDataConKey, kindRepTypeLitDDataConKey
:: Unique
-kindRepTyConAppDataConKey = mkPreludeDataConUnique 105
-kindRepVarDataConKey = mkPreludeDataConUnique 106
-kindRepAppDataConKey = mkPreludeDataConUnique 107
-kindRepFunDataConKey = mkPreludeDataConUnique 108
-kindRepTYPEDataConKey = mkPreludeDataConUnique 109
-kindRepTypeLitSDataConKey = mkPreludeDataConUnique 110
-kindRepTypeLitDDataConKey = mkPreludeDataConUnique 111
+kindRepTyConAppDataConKey = mkPreludeDataConUnique 106
+kindRepVarDataConKey = mkPreludeDataConUnique 107
+kindRepAppDataConKey = mkPreludeDataConUnique 108
+kindRepFunDataConKey = mkPreludeDataConUnique 109
+kindRepTYPEDataConKey = mkPreludeDataConUnique 110
+kindRepTypeLitSDataConKey = mkPreludeDataConUnique 111
+kindRepTypeLitDDataConKey = mkPreludeDataConUnique 112
typeLitSymbolDataConKey, typeLitNatDataConKey, typeLitCharDataConKey :: Unique
-typeLitSymbolDataConKey = mkPreludeDataConUnique 112
-typeLitNatDataConKey = mkPreludeDataConUnique 113
-typeLitCharDataConKey = mkPreludeDataConUnique 114
+typeLitSymbolDataConKey = mkPreludeDataConUnique 113
+typeLitNatDataConKey = mkPreludeDataConUnique 114
+typeLitCharDataConKey = mkPreludeDataConUnique 115
-- Unsafe equality
unsafeReflDataConKey :: Unique
-unsafeReflDataConKey = mkPreludeDataConUnique 115
+unsafeReflDataConKey = mkPreludeDataConUnique 116
-- Multiplicity
oneDataConKey, manyDataConKey :: Unique
-oneDataConKey = mkPreludeDataConUnique 116
-manyDataConKey = mkPreludeDataConUnique 117
+oneDataConKey = mkPreludeDataConUnique 117
+manyDataConKey = mkPreludeDataConUnique 118
-- ghc-bignum
integerISDataConKey, integerINDataConKey, integerIPDataConKey,
@@ -2505,14 +2510,16 @@ mkTrFunKey = mkPreludeMiscIdUnique 511
-- Representations for primitive types
trTYPEKey
- ,trTYPE'PtrRepLiftedKey
+ , trTYPE'PtrRepLiftedKey
, trRuntimeRepKey
, tr'PtrRepLiftedKey
+ , trLiftedRepKey
:: Unique
trTYPEKey = mkPreludeMiscIdUnique 512
trTYPE'PtrRepLiftedKey = mkPreludeMiscIdUnique 513
trRuntimeRepKey = mkPreludeMiscIdUnique 514
tr'PtrRepLiftedKey = mkPreludeMiscIdUnique 515
+trLiftedRepKey = mkPreludeMiscIdUnique 516
-- KindReps for common cases
starKindRepKey, starArrStarKindRepKey, starArrStarArrStarKindRepKey :: Unique
@@ -2818,5 +2825,6 @@ The following names should be considered by GHCi to be in scope always.
pretendNameIsInScope :: Name -> Bool
pretendNameIsInScope n
= any (n `hasKey`)
- [ liftedTypeKindTyConKey, tYPETyConKey
- , runtimeRepTyConKey, liftedRepDataConKey ]
+ [ liftedTypeKindTyConKey, unliftedTypeKindTyConKey
+ , tYPETyConKey
+ , runtimeRepTyConKey, boxedRepDataConKey ]
diff --git a/compiler/GHC/Builtin/Types.hs b/compiler/GHC/Builtin/Types.hs
index 1a3550fcaa..3b928c801f 100644
--- a/compiler/GHC/Builtin/Types.hs
+++ b/compiler/GHC/Builtin/Types.hs
@@ -98,10 +98,13 @@ module GHC.Builtin.Types (
-- * Kinds
typeSymbolKindCon, typeSymbolKind,
- isLiftedTypeKindTyConName, liftedTypeKind,
- typeToTypeKind, constraintKind,
- liftedTypeKindTyCon, constraintKindTyCon, constraintKindTyConName,
- liftedTypeKindTyConName,
+ isLiftedTypeKindTyConName,
+ typeToTypeKind,
+ liftedRepTyCon, unliftedRepTyCon,
+ constraintKind, liftedTypeKind, unliftedTypeKind,
+ constraintKindTyCon, liftedTypeKindTyCon, unliftedTypeKindTyCon,
+ constraintKindTyConName, liftedTypeKindTyConName, unliftedTypeKindTyConName,
+ liftedRepTyConName, unliftedRepTyConName,
-- * Equality predicates
heqTyCon, heqTyConName, heqClass, heqDataCon,
@@ -109,13 +112,16 @@ module GHC.Builtin.Types (
coercibleTyCon, coercibleTyConName, coercibleDataCon, coercibleClass,
-- * RuntimeRep and friends
- runtimeRepTyCon, vecCountTyCon, vecElemTyCon,
+ runtimeRepTyCon, levityTyCon, vecCountTyCon, vecElemTyCon,
- runtimeRepTy, liftedRepTy, liftedRepDataCon, liftedRepDataConTyCon,
+ boxedRepDataConTyCon,
+ runtimeRepTy, liftedRepTy, unliftedRepTy,
vecRepDataConTyCon, tupleRepDataConTyCon, sumRepDataConTyCon,
- liftedRepDataConTy, unliftedRepDataConTy,
+ liftedDataConTyCon, unliftedDataConTyCon,
+ liftedDataConTy, unliftedDataConTy,
+
intRepDataConTy,
int8RepDataConTy, int16RepDataConTy, int32RepDataConTy, int64RepDataConTy,
wordRepDataConTy,
@@ -213,6 +219,43 @@ to this Note, so a search for this Note's name should find all the lists.
See also Note [Getting from RuntimeRep to PrimRep] in GHC.Types.RepType.
+
+Note [Wired-in Types and Type Constructors]
+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+
+This module include a lot of wired-in types and type constructors. Here,
+these are presented in a tabular format to make it easier to find the
+wired-in type identifier corresponding to a known Haskell type. Data
+constructors are nested under their corresponding types with two spaces
+of indentation.
+
+Identifier Type Haskell name Notes
+----------------------------------------------------------------------------
+liftedTypeKindTyCon TyCon GHC.Types.Type Synonym for: TYPE LiftedRep
+unliftedTypeKindTyCon TyCon GHC.Types.Type Synonym for: TYPE UnliftedRep
+liftedRepTyCon TyCon GHC.Types.LiftedRep Synonym for: 'BoxedRep 'Lifted
+unliftedRepTyCon TyCon GHC.Types.LiftedRep Synonym for: 'BoxedRep 'Unlifted
+levityTyCon TyCon GHC.Types.Levity Data type
+ liftedDataConTyCon TyCon GHC.Types.Lifted Data constructor
+ unliftedDataConTyCon TyCon GHC.Types.Unlifted Data constructor
+vecCountTyCon TyCon GHC.Types.VecCount Data type
+ vec2DataConTy Type GHC.Types.Vec2 Data constructor
+ vec4DataConTy Type GHC.Types.Vec4 Data constructor
+ vec8DataConTy Type GHC.Types.Vec8 Data constructor
+ vec16DataConTy Type GHC.Types.Vec16 Data constructor
+ vec32DataConTy Type GHC.Types.Vec32 Data constructor
+ vec64DataConTy Type GHC.Types.Vec64 Data constructor
+runtimeRepTyCon TyCon GHC.Types.RuntimeRep Data type
+ boxedRepDataConTyCon TyCon GHC.Types.BoxedRep Data constructor
+ intRepDataConTy Type GHC.Types.IntRep Data constructor
+ doubleRepDataConTy Type GHC.Types.DoubleRep Data constructor
+ floatRepDataConTy Type GHC.Types.FloatRep Data constructor
+boolTyCon TyCon GHC.Types.Bool Data type
+ trueDataCon DataCon GHC.Types.True Data constructor
+ falseDataCon DataCon GHC.Types.False Data constructor
+ promotedTrueDataCon TyCon GHC.Types.True Data constructor
+ promotedFalseDataCon TyCon GHC.Types.False Data constructor
+
************************************************************************
* *
\subsection{Wired in type constructors}
@@ -221,8 +264,10 @@ See also Note [Getting from RuntimeRep to PrimRep] in GHC.Types.RepType.
If you change which things are wired in, make sure you change their
names in GHC.Builtin.Names, so they use wTcQual, wDataQual, etc
+
-}
+
-- This list is used only to define GHC.Builtin.Utils.wiredInThings. That in turn
-- is used to initialise the name environment carried around by the renamer.
-- This means that if we look up the name of a TyCon (or its implicit binders)
@@ -261,13 +306,17 @@ wiredInTyCons = [ -- Units are not treated like other tuples, because they
, coercibleTyCon
, typeSymbolKindCon
, runtimeRepTyCon
+ , levityTyCon
, vecCountTyCon
, vecElemTyCon
, constraintKindTyCon
, liftedTypeKindTyCon
+ , unliftedTypeKindTyCon
, multiplicityTyCon
, naturalTyCon
, integerTyCon
+ , liftedRepTyCon
+ , unliftedRepTyCon
]
mkWiredInTyConName :: BuiltInSyntax -> Module -> FastString -> Unique -> TyCon -> Name
@@ -484,8 +533,13 @@ typeSymbolKindConName = mkWiredInTyConName UserSyntax gHC_TYPES (fsLit "Symbol")
constraintKindTyConName :: Name
constraintKindTyConName = mkWiredInTyConName UserSyntax gHC_TYPES (fsLit "Constraint") constraintKindTyConKey constraintKindTyCon
-liftedTypeKindTyConName :: Name
+liftedTypeKindTyConName, unliftedTypeKindTyConName :: Name
liftedTypeKindTyConName = mkWiredInTyConName UserSyntax gHC_TYPES (fsLit "Type") liftedTypeKindTyConKey liftedTypeKindTyCon
+unliftedTypeKindTyConName = mkWiredInTyConName UserSyntax gHC_TYPES (fsLit "UnliftedType") unliftedTypeKindTyConKey unliftedTypeKindTyCon
+
+liftedRepTyConName, unliftedRepTyConName :: Name
+liftedRepTyConName = mkWiredInTyConName UserSyntax gHC_TYPES (fsLit "LiftedRep") liftedRepTyConKey liftedRepTyCon
+unliftedRepTyConName = mkWiredInTyConName UserSyntax gHC_TYPES (fsLit "UnliftedRep") unliftedRepTyConKey unliftedRepTyCon
multiplicityTyConName :: Name
multiplicityTyConName = mkWiredInTyConName UserSyntax gHC_TYPES (fsLit "Multiplicity")
@@ -501,18 +555,24 @@ manyDataConName = mkWiredInDataConName BuiltInSyntax gHC_TYPES (fsLit "Many") ma
-- reported. Making them built-in make it so that they are always considered in
-- scope.
-runtimeRepTyConName, vecRepDataConName, tupleRepDataConName, sumRepDataConName :: Name
+runtimeRepTyConName, vecRepDataConName, tupleRepDataConName, sumRepDataConName, boxedRepDataConName :: Name
runtimeRepTyConName = mkWiredInTyConName UserSyntax gHC_TYPES (fsLit "RuntimeRep") runtimeRepTyConKey runtimeRepTyCon
vecRepDataConName = mkWiredInDataConName UserSyntax gHC_TYPES (fsLit "VecRep") vecRepDataConKey vecRepDataCon
tupleRepDataConName = mkWiredInDataConName UserSyntax gHC_TYPES (fsLit "TupleRep") tupleRepDataConKey tupleRepDataCon
sumRepDataConName = mkWiredInDataConName UserSyntax gHC_TYPES (fsLit "SumRep") sumRepDataConKey sumRepDataCon
+boxedRepDataConName = mkWiredInDataConName UserSyntax gHC_TYPES (fsLit "BoxedRep") boxedRepDataConKey boxedRepDataCon
+
+levityTyConName, liftedDataConName, unliftedDataConName :: Name
+levityTyConName = mkWiredInTyConName UserSyntax gHC_TYPES (fsLit "Levity") levityTyConKey levityTyCon
+liftedDataConName = mkWiredInDataConName UserSyntax gHC_TYPES (fsLit "Lifted") liftedDataConKey liftedDataCon
+unliftedDataConName = mkWiredInDataConName UserSyntax gHC_TYPES (fsLit "Unlifted") unliftedDataConKey unliftedDataCon
+
-- See Note [Wiring in RuntimeRep]
runtimeRepSimpleDataConNames :: [Name]
runtimeRepSimpleDataConNames
= zipWith3Lazy mk_special_dc_name
- [ fsLit "LiftedRep", fsLit "UnliftedRep"
- , fsLit "IntRep"
+ [ fsLit "IntRep"
, fsLit "Int8Rep", fsLit "Int16Rep", fsLit "Int32Rep", fsLit "Int64Rep"
, fsLit "WordRep"
, fsLit "Word8Rep", fsLit "Word16Rep", fsLit "Word32Rep", fsLit "Word64Rep"
@@ -691,8 +751,9 @@ constraintKindTyCon :: TyCon
constraintKindTyCon = pcTyCon constraintKindTyConName Nothing [] []
-- See Note [Prefer Type over TYPE 'LiftedRep] in GHC.Core.TyCo.Rep.
-liftedTypeKind, typeToTypeKind, constraintKind :: Kind
+liftedTypeKind, unliftedTypeKind, typeToTypeKind, constraintKind :: Kind
liftedTypeKind = mkTyConTy liftedTypeKindTyCon
+unliftedTypeKind = mkTyConTy unliftedTypeKindTyCon
typeToTypeKind = liftedTypeKind `mkVisFunTyMany` liftedTypeKind
constraintKind = mkTyConTy constraintKindTyCon
@@ -1424,16 +1485,52 @@ runtimeRepTy = mkTyConTy runtimeRepTyCon
-- Type synonyms; see Note [TYPE and RuntimeRep] in GHC.Builtin.Types.Prim
-- and Note [Prefer Type over TYPE 'LiftedRep] in GHC.Core.TyCo.Rep.
--- type Type = tYPE 'LiftedRep
+-- type Type = TYPE ('BoxedRep 'Lifted)
+-- type LiftedRep = 'BoxedRep 'Lifted
liftedTypeKindTyCon :: TyCon
-liftedTypeKindTyCon = buildSynTyCon liftedTypeKindTyConName
- [] liftedTypeKind [] rhs
- where rhs = TyCoRep.TyConApp tYPETyCon [liftedRepTy]
+liftedTypeKindTyCon =
+ buildSynTyCon liftedTypeKindTyConName [] liftedTypeKind [] rhs
+ where rhs = TyCoRep.TyConApp tYPETyCon [mkTyConApp liftedRepTyCon []]
+
+unliftedTypeKindTyCon :: TyCon
+unliftedTypeKindTyCon =
+ buildSynTyCon unliftedTypeKindTyConName [] liftedTypeKind [] rhs
+ where rhs = TyCoRep.TyConApp tYPETyCon [mkTyConApp unliftedRepTyCon []]
+
+liftedRepTyCon :: TyCon
+liftedRepTyCon = buildSynTyCon
+ liftedRepTyConName [] runtimeRepTy [] liftedRepTy
+
+unliftedRepTyCon :: TyCon
+unliftedRepTyCon = buildSynTyCon
+ unliftedRepTyConName [] runtimeRepTy [] unliftedRepTy
runtimeRepTyCon :: TyCon
runtimeRepTyCon = pcTyCon runtimeRepTyConName Nothing []
- (vecRepDataCon : tupleRepDataCon :
- sumRepDataCon : runtimeRepSimpleDataCons)
+ (vecRepDataCon : tupleRepDataCon :
+ sumRepDataCon : boxedRepDataCon : runtimeRepSimpleDataCons)
+
+levityTyCon :: TyCon
+levityTyCon = pcTyCon levityTyConName Nothing [] [liftedDataCon,unliftedDataCon]
+
+liftedDataCon, unliftedDataCon :: DataCon
+liftedDataCon = pcSpecialDataCon liftedDataConName
+ [] levityTyCon LiftedInfo
+unliftedDataCon = pcSpecialDataCon unliftedDataConName
+ [] levityTyCon UnliftedInfo
+
+boxedRepDataCon :: DataCon
+boxedRepDataCon = pcSpecialDataCon boxedRepDataConName
+ [ mkTyConTy levityTyCon ] runtimeRepTyCon (RuntimeRep prim_rep_fun)
+ where
+ -- See Note [Getting from RuntimeRep to PrimRep] in RepType
+ prim_rep_fun [lev]
+ = case tyConRuntimeRepInfo (tyConAppTyCon lev) of
+ LiftedInfo -> [LiftedRep]
+ UnliftedInfo -> [UnliftedRep]
+ _ -> pprPanic "boxedRepDataCon" (ppr lev)
+ prim_rep_fun args
+ = pprPanic "boxedRepDataCon" (ppr args)
vecRepDataCon :: DataCon
vecRepDataCon = pcSpecialDataCon vecRepDataConName [ mkTyConTy vecCountTyCon
@@ -1488,11 +1585,9 @@ sumRepDataConTyCon = promoteDataCon sumRepDataCon
-- See Note [Wiring in RuntimeRep]
-- See Note [Getting from RuntimeRep to PrimRep] in GHC.Types.RepType
runtimeRepSimpleDataCons :: [DataCon]
-liftedRepDataCon :: DataCon
-runtimeRepSimpleDataCons@(liftedRepDataCon : _)
+runtimeRepSimpleDataCons
= zipWithLazy mk_runtime_rep_dc
- [ LiftedRep, UnliftedRep
- , IntRep
+ [ IntRep
, Int8Rep, Int16Rep, Int32Rep, Int64Rep
, WordRep
, Word8Rep, Word16Rep, Word32Rep, Word64Rep
@@ -1505,15 +1600,13 @@ runtimeRepSimpleDataCons@(liftedRepDataCon : _)
= pcSpecialDataCon name [] runtimeRepTyCon (RuntimeRep (\_ -> [primrep]))
-- See Note [Wiring in RuntimeRep]
-liftedRepDataConTy, unliftedRepDataConTy,
- intRepDataConTy,
+intRepDataConTy,
int8RepDataConTy, int16RepDataConTy, int32RepDataConTy, int64RepDataConTy,
wordRepDataConTy,
word8RepDataConTy, word16RepDataConTy, word32RepDataConTy, word64RepDataConTy,
addrRepDataConTy,
floatRepDataConTy, doubleRepDataConTy :: Type
-[liftedRepDataConTy, unliftedRepDataConTy,
- intRepDataConTy,
+[intRepDataConTy,
int8RepDataConTy, int16RepDataConTy, int32RepDataConTy, int64RepDataConTy,
wordRepDataConTy,
word8RepDataConTy, word16RepDataConTy, word32RepDataConTy, word64RepDataConTy,
@@ -1565,12 +1658,29 @@ int8ElemRepDataConTy, int16ElemRepDataConTy, int32ElemRepDataConTy,
doubleElemRepDataConTy] = map (mkTyConTy . promoteDataCon)
vecElemDataCons
-liftedRepDataConTyCon :: TyCon
-liftedRepDataConTyCon = promoteDataCon liftedRepDataCon
--- The type ('LiftedRep)
+liftedDataConTyCon :: TyCon
+liftedDataConTyCon = promoteDataCon liftedDataCon
+
+unliftedDataConTyCon :: TyCon
+unliftedDataConTyCon = promoteDataCon unliftedDataCon
+
+liftedDataConTy :: Type
+liftedDataConTy = mkTyConTy liftedDataConTyCon
+
+unliftedDataConTy :: Type
+unliftedDataConTy = mkTyConTy unliftedDataConTyCon
+
+boxedRepDataConTyCon :: TyCon
+boxedRepDataConTyCon = promoteDataCon boxedRepDataCon
+
+-- The type ('BoxedRep 'Lifted)
liftedRepTy :: Type
-liftedRepTy = liftedRepDataConTy
+liftedRepTy = mkTyConApp boxedRepDataConTyCon [liftedDataConTy]
+
+-- The type ('BoxedRep 'Unlifted)
+unliftedRepTy :: Type
+unliftedRepTy = mkTyConApp boxedRepDataConTyCon [unliftedDataConTy]
{- *********************************************************************
* *
diff --git a/compiler/GHC/Builtin/Types.hs-boot b/compiler/GHC/Builtin/Types.hs-boot
index c19137e148..1c341de418 100644
--- a/compiler/GHC/Builtin/Types.hs-boot
+++ b/compiler/GHC/Builtin/Types.hs-boot
@@ -17,17 +17,27 @@ coercibleTyCon, heqTyCon :: TyCon
unitTy :: Type
liftedTypeKind :: Kind
+unliftedTypeKind :: Kind
+
liftedTypeKindTyCon :: TyCon
+unliftedTypeKindTyCon :: TyCon
+
+liftedRepTyCon :: TyCon
+unliftedRepTyCon :: TyCon
constraintKind :: Kind
-runtimeRepTyCon, vecCountTyCon, vecElemTyCon :: TyCon
+runtimeRepTyCon, levityTyCon, vecCountTyCon, vecElemTyCon :: TyCon
runtimeRepTy :: Type
-liftedRepDataConTyCon, vecRepDataConTyCon, tupleRepDataConTyCon :: TyCon
+boxedRepDataConTyCon :: TyCon
+liftedDataConTyCon :: TyCon
+vecRepDataConTyCon, tupleRepDataConTyCon :: TyCon
+
+liftedRepTy, unliftedRepTy :: Type
+liftedDataConTy, unliftedDataConTy :: Type
-liftedRepDataConTy, unliftedRepDataConTy,
- intRepDataConTy,
+intRepDataConTy,
int8RepDataConTy, int16RepDataConTy, int32RepDataConTy, int64RepDataConTy,
wordRepDataConTy,
word8RepDataConTy, word16RepDataConTy, word32RepDataConTy, word64RepDataConTy,
diff --git a/compiler/GHC/Builtin/Types/Prim.hs b/compiler/GHC/Builtin/Types/Prim.hs
index 27df5236a3..29bb386001 100644
--- a/compiler/GHC/Builtin/Types/Prim.hs
+++ b/compiler/GHC/Builtin/Types/Prim.hs
@@ -101,7 +101,7 @@ import GHC.Prelude
import {-# SOURCE #-} GHC.Builtin.Types
( runtimeRepTy, unboxedTupleKind, liftedTypeKind
, vecRepDataConTyCon, tupleRepDataConTyCon
- , liftedRepDataConTy, unliftedRepDataConTy
+ , liftedRepTy, unliftedRepTy
, intRepDataConTy
, int8RepDataConTy, int16RepDataConTy, int32RepDataConTy, int64RepDataConTy
, wordRepDataConTy
@@ -129,7 +129,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 {-# SOURCE #-} GHC.Core.Type ( mkTyConTy, tYPE )
import Data.Char
@@ -368,7 +368,7 @@ alphaTy, betaTy, gammaTy, deltaTy :: Type
(alphaTy:betaTy:gammaTy:deltaTy:_) = alphaTys
alphaTyVarsUnliftedRep :: [TyVar]
-alphaTyVarsUnliftedRep = mkTemplateTyVars $ repeat (tYPE unliftedRepDataConTy)
+alphaTyVarsUnliftedRep = mkTemplateTyVars $ repeat (tYPE unliftedRepTy)
alphaTyVarUnliftedRep :: TyVar
(alphaTyVarUnliftedRep:_) = alphaTyVarsUnliftedRep
@@ -460,26 +460,28 @@ Note [TYPE and RuntimeRep]
All types that classify values have a kind of the form (TYPE rr), where
data RuntimeRep -- Defined in ghc-prim:GHC.Types
- = LiftedRep
- | UnliftedRep
+ = BoxedRep Levity
| IntRep
| FloatRep
.. etc ..
+ data Levity = Lifted | Unlifted
+
rr :: RuntimeRep
TYPE :: RuntimeRep -> TYPE 'LiftedRep -- Built in
So for example:
- Int :: TYPE 'LiftedRep
- Array# Int :: TYPE 'UnliftedRep
+ Int :: TYPE ('BoxedRep 'Lifted)
+ Array# Int :: TYPE ('BoxedRep 'Unlifted)
Int# :: TYPE 'IntRep
Float# :: TYPE 'FloatRep
- Maybe :: TYPE 'LiftedRep -> TYPE 'LiftedRep
+ Maybe :: TYPE ('BoxedRep 'Lifted) -> TYPE ('BoxedRep 'Lifted)
(# , #) :: TYPE r1 -> TYPE r2 -> TYPE (TupleRep [r1, r2])
We abbreviate '*' specially:
- type * = TYPE 'LiftedRep
+ type LiftedRep = 'BoxedRep 'Lifted
+ type * = TYPE LiftedRep
The 'rr' parameter tells us how the value is represented at runtime.
@@ -512,7 +514,7 @@ generator never has to manipulate a value of type 'a :: TYPE rr'.
Note [PrimRep and kindPrimRep]
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
As part of its source code, in GHC.Core.TyCon, GHC has
- data PrimRep = LiftedRep | UnliftedRep | IntRep | FloatRep | ...etc...
+ data PrimRep = BoxedRep Levity | IntRep | FloatRep | ...etc...
Notice that
* RuntimeRep is part of the syntax tree of the program being compiled
@@ -586,8 +588,8 @@ pcPrimTyCon name roles rep
primRepToRuntimeRep :: PrimRep -> Type
primRepToRuntimeRep rep = case rep of
VoidRep -> TyConApp tupleRepDataConTyCon [mkPromotedListTy runtimeRepTy []]
- LiftedRep -> liftedRepDataConTy
- UnliftedRep -> unliftedRepDataConTy
+ LiftedRep -> liftedRepTy
+ UnliftedRep -> unliftedRepTy
IntRep -> intRepDataConTy
Int8Rep -> int8RepDataConTy
Int16Rep -> int16RepDataConTy
diff --git a/compiler/GHC/Core/TyCo/Rep.hs b/compiler/GHC/Core/TyCo/Rep.hs
index 2d9867e427..75d56ed501 100644
--- a/compiler/GHC/Core/TyCo/Rep.hs
+++ b/compiler/GHC/Core/TyCo/Rep.hs
@@ -1,5 +1,6 @@
{-# LANGUAGE CPP #-}
{-# LANGUAGE DeriveDataTypeable #-}
+{-# LANGUAGE MultiWayIf #-}
{-# OPTIONS_HADDOCK not-home #-}
@@ -51,7 +52,6 @@ module GHC.Core.TyCo.Rep (
mkScaledFunTy,
mkVisFunTyMany, mkVisFunTysMany,
mkInvisFunTyMany, mkInvisFunTysMany,
- tYPE,
-- * Functions over binders
TyCoBinder(..), TyCoVarBinder, TyBinder,
@@ -90,11 +90,9 @@ import GHC.Core.TyCon
import GHC.Core.Coercion.Axiom
-- others
-import GHC.Builtin.Names ( liftedRepDataConKey )
-import {-# SOURCE #-} GHC.Builtin.Types ( liftedTypeKind, manyDataConTy )
-import {-# SOURCE #-} GHC.Builtin.Types.Prim ( tYPETyCon )
+import {-# SOURCE #-} GHC.Builtin.Types ( manyDataConTy )
import GHC.Types.Basic ( LeftOrRight(..), pickLR )
-import GHC.Types.Unique ( hasKey, Uniquable(..) )
+import GHC.Types.Unique ( Uniquable(..) )
import GHC.Utils.Outputable
import GHC.Data.FastString
import GHC.Utils.Misc
@@ -1010,66 +1008,6 @@ mkTyConTy_ :: TyCon -> Type
mkTyConTy_ tycon = TyConApp tycon []
{-
-Note [Prefer Type over TYPE 'LiftedRep]
-~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
-The Core of nearly any program will have numerous occurrences of
-@TYPE 'LiftedRep@ (and, equivalently, 'Type') floating about. Concretely, while
-investigating #17292 we found that these constituting a majority of 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
- 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:
-
- 1. Instead of representing the lifted kind as
- @TyConApp tYPETyCon [liftedRepDataCon]@ we rather prefer to
- use the 'GHC.Types.Type' type synonym (represented as a nullary TyConApp).
- This serves goal (b) since there are no applied type arguments to traverse,
- e.g., during comparison.
-
- 2. We have a 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)).
-
- 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.
--}
-
--- | Given a RuntimeRep, applies TYPE to it.
--- See Note [TYPE and RuntimeRep] in GHC.Builtin.Types.Prim.
-tYPE :: Type -> Type
-tYPE (TyConApp tc [])
- -- See Note [Prefer Type of TYPE 'LiftedRep]
- | tc `hasKey` liftedRepDataConKey = liftedTypeKind -- TYPE 'LiftedRep
-tYPE rr = TyConApp tYPETyCon [rr]
-
-{-
%************************************************************************
%* *
Coercions
diff --git a/compiler/GHC/Core/TyCon.hs b/compiler/GHC/Core/TyCon.hs
index babcbce347..4b517027da 100644
--- a/compiler/GHC/Core/TyCon.hs
+++ b/compiler/GHC/Core/TyCon.hs
@@ -140,7 +140,7 @@ import {-# SOURCE #-} GHC.Core.TyCo.Rep
import {-# SOURCE #-} GHC.Core.TyCo.Ppr
( pprType )
import {-# SOURCE #-} GHC.Builtin.Types
- ( runtimeRepTyCon, constraintKind
+ ( runtimeRepTyCon, constraintKind, levityTyCon
, multiplicityTyCon
, vecCountTyCon, vecElemTyCon, liftedTypeKind )
import {-# SOURCE #-} GHC.Core.DataCon
@@ -1095,6 +1095,8 @@ data RuntimeRepInfo
-- be the list of arguments to the promoted datacon.
| VecCount Int -- ^ A constructor of @VecCount@
| VecElem PrimElemRep -- ^ A constructor of @VecElem@
+ | LiftedInfo -- ^ A constructor of @Levity@
+ | UnliftedInfo -- ^ A constructor of @Levity@
-- | Extract those 'DataCon's that we are able to learn about. Note
-- that visibility in this sense does not correspond to visibility in
@@ -2215,8 +2217,8 @@ isKindTyCon tc = getUnique tc `elementOfUniqSet` kindTyConKeys
-- -XDataKinds.
kindTyConKeys :: UniqSet Unique
kindTyConKeys = unionManyUniqSets
- ( mkUniqSet [ liftedTypeKindTyConKey, constraintKindTyConKey, tYPETyConKey ]
- : map (mkUniqSet . tycon_with_datacons) [ runtimeRepTyCon
+ ( mkUniqSet [ liftedTypeKindTyConKey, liftedRepTyConKey, constraintKindTyConKey, tYPETyConKey ]
+ : map (mkUniqSet . tycon_with_datacons) [ runtimeRepTyCon, levityTyCon
, multiplicityTyCon
, vecCountTyCon, vecElemTyCon ] )
where
diff --git a/compiler/GHC/Core/Type.hs b/compiler/GHC/Core/Type.hs
index 6a9eeed6fa..25276c155f 100644
--- a/compiler/GHC/Core/Type.hs
+++ b/compiler/GHC/Core/Type.hs
@@ -3,7 +3,7 @@
--
-- Type - public interface
-{-# LANGUAGE CPP, FlexibleContexts, PatternSynonyms, ViewPatterns #-}
+{-# LANGUAGE CPP, FlexibleContexts, PatternSynonyms, ViewPatterns, MultiWayIf #-}
{-# OPTIONS_GHC -fno-warn-orphans #-}
{-# OPTIONS_GHC -Wno-incomplete-record-updates #-}
@@ -36,7 +36,7 @@ module GHC.Core.Type (
splitFunTy, splitFunTy_maybe,
splitFunTys, funResultTy, funArgTy,
- mkTyConApp, mkTyConTy,
+ mkTyConApp, mkTyConTy, tYPE,
tyConAppTyCon_maybe, tyConAppTyConPicky_maybe,
tyConAppArgs_maybe, tyConAppTyCon, tyConAppArgs,
splitTyConApp_maybe, splitTyConApp, tyConAppArgN,
@@ -122,9 +122,11 @@ module GHC.Core.Type (
isLiftedType_maybe,
isLiftedTypeKind, isUnliftedTypeKind, pickyIsLiftedTypeKind,
isLiftedRuntimeRep, isUnliftedRuntimeRep,
+ isLiftedLevity, isUnliftedLevity,
isUnliftedType, mightBeUnliftedType, isUnboxedTupleType, isUnboxedSumType,
isAlgType, isDataFamilyAppType,
isPrimitiveType, isStrictType,
+ isLevityTy, isLevityVar,
isRuntimeRepTy, isRuntimeRepVar, isRuntimeRepKindedTy,
dropRuntimeRepArgs,
getRuntimeRep,
@@ -257,7 +259,8 @@ import GHC.Core.TyCon
import GHC.Builtin.Types.Prim
import {-# SOURCE #-} GHC.Builtin.Types
( charTy, naturalTy, listTyCon
- , typeSymbolKind, liftedTypeKind
+ , typeSymbolKind, liftedTypeKind, unliftedTypeKind
+ , liftedRepTyCon, unliftedRepTyCon
, constraintKind
, unrestrictedFunTyCon
, manyDataConTy, oneDataConTy )
@@ -613,6 +616,7 @@ isLiftedTypeKind kind
pickyIsLiftedTypeKind :: Kind -> Bool
-- Checks whether the kind is literally
-- TYPE LiftedRep
+-- or TYPE ('BoxedRep 'Lifted)
-- or Type
-- without expanding type synonyms or anything
-- Used only when deciding whether to suppress the ":: *" in
@@ -621,8 +625,13 @@ pickyIsLiftedTypeKind :: Kind -> Bool
pickyIsLiftedTypeKind kind
| TyConApp tc [arg] <- kind
, tc `hasKey` tYPETyConKey
- , TyConApp rr_tc [] <- arg
- , rr_tc `hasKey` liftedRepDataConKey = True
+ , TyConApp rr_tc rr_args <- arg = case rr_args of
+ [] -> rr_tc `hasKey` liftedRepTyConKey
+ [rr_arg]
+ | rr_tc `hasKey` boxedRepDataConKey
+ , TyConApp lev [] <- rr_arg
+ , lev `hasKey` liftedDataConKey -> True
+ _ -> False
| TyConApp tc [] <- kind
, tc `hasKey` liftedTypeKindTyConKey = True
| otherwise = False
@@ -632,8 +641,28 @@ isLiftedRuntimeRep :: Type -> Bool
-- False of type variables (a :: RuntimeRep)
-- and of other reps e.g. (IntRep :: RuntimeRep)
isLiftedRuntimeRep rep
- | TyConApp rr_tc args <- coreFullView rep
- , rr_tc `hasKey` liftedRepDataConKey = ASSERT( null args ) True
+ | Just rep' <- coreView rep
+ = isLiftedRuntimeRep rep'
+ | TyConApp rr_tc [rr_arg] <- rep
+ , rr_tc `hasKey` boxedRepDataConKey
+ = isLiftedLevity rr_arg
+ | otherwise
+ = False
+
+isLiftedLevity :: Type -> Bool
+isLiftedLevity lev
+ | Just lev' <- coreView lev = isLiftedLevity lev'
+ | TyConApp lev_tc lev_args <- lev
+ , lev_tc `hasKey` liftedDataConKey
+ = ASSERT( null lev_args ) True
+ | otherwise = False
+
+isUnliftedLevity :: Type -> Bool
+isUnliftedLevity lev
+ | Just lev' <- coreView lev = isUnliftedLevity lev'
+ | TyConApp lev_tc lev_args <- lev
+ , lev_tc `hasKey` unliftedDataConKey
+ = ASSERT( null lev_args ) True
| otherwise = False
-- | Returns True if the kind classifies unlifted types and False otherwise.
@@ -650,27 +679,47 @@ isUnliftedRuntimeRep :: Type -> Bool
-- False of (LiftedRep :: RuntimeRep)
-- and of variables (a :: RuntimeRep)
isUnliftedRuntimeRep rep
- | TyConApp rr_tc _ <- coreFullView rep -- NB: args might be non-empty
- -- e.g. TupleRep [r1, .., rn]
- = isPromotedDataCon rr_tc && not (rr_tc `hasKey` liftedRepDataConKey)
+ | Just rep' <- coreView rep -- NB: args might be non-empty
+ -- e.g. TupleRep [r1, .., rn]
+ = isUnliftedRuntimeRep rep'
+isUnliftedRuntimeRep (TyConApp rr_tc args)
+ | isPromotedDataCon rr_tc =
+ -- NB: args might be non-empty e.g. TupleRep [r1, .., rn]
+ if (rr_tc `hasKey` boxedRepDataConKey)
+ then case args of
+ [lev] -> isUnliftedLevity lev
+ _ -> False
+ else True
-- Avoid searching all the unlifted RuntimeRep type cons
-- In the RuntimeRep data type, only LiftedRep is lifted
- -- But be careful of type families (F tys) :: RuntimeRep
- | otherwise {- Variables, applications -}
- = False
+ -- But be careful of type families (F tys) :: RuntimeRep,
+ -- hence the isPromotedDataCon rr_tc
+isUnliftedRuntimeRep _ = False
-- | Is this the type 'RuntimeRep'?
isRuntimeRepTy :: Type -> Bool
isRuntimeRepTy ty
- | TyConApp tc args <- coreFullView ty
+ | Just ty' <- coreView ty = isRuntimeRepTy ty'
+ | TyConApp tc args <- ty
, tc `hasKey` runtimeRepTyConKey = ASSERT( null args ) True
+ | otherwise = False
- | otherwise = False
+-- | Is this the type 'Levity'?
+isLevityTy :: Type -> Bool
+isLevityTy lev
+ | Just lev' <- coreView lev = isLevityTy lev'
+ | TyConApp tc args <- coreFullView lev
+ , tc `hasKey` levityTyConKey = ASSERT( null args ) True
+ | otherwise = False
-- | Is a tyvar of type 'RuntimeRep'?
isRuntimeRepVar :: TyVar -> Bool
isRuntimeRepVar = isRuntimeRepTy . tyVarKind
+-- | Is a tyvar of type 'Levity'?
+isLevityVar :: TyVar -> Bool
+isLevityVar = isLevityTy . tyVarKind
+
-- | Is this the type 'Multiplicity'?
isMultiplicityTy :: Type -> Bool
isMultiplicityTy ty
@@ -1499,7 +1548,7 @@ mkTyConTy tycon = tyConNullaryTy tycon
-- its arguments. Applies its arguments to the constructor from left to right.
mkTyConApp :: TyCon -> [Type] -> Type
mkTyConApp tycon tys
- | [] <- tys
+ | null tys
= mkTyConTy tycon
| isFunTyCon tycon
@@ -1515,6 +1564,75 @@ mkTyConApp tycon tys
| otherwise
= TyConApp tycon tys
+{-
+Note [Prefer Type over TYPE 'LiftedRep]
+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+The Core of nearly any program will have numerous occurrences of
+@TYPE 'LiftedRep@ (and, equivalently, 'Type') floating about. Concretely, while
+investigating #17292 we found that these constituting a majority of 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
+ 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:
+
+ 1. Instead of representing the lifted kind as
+ @TyConApp tYPETyCon [liftedRepDataCon]@ we rather prefer to
+ use the 'GHC.Types.Type' type synonym (represented as a nullary TyConApp).
+ This serves goal (b) since there are no applied type arguments to traverse,
+ e.g., during comparison.
+
+ 2. We have a 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)).
+
+ 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.
+-}
+
+
+-- | Given a @RuntimeRep@, applies @TYPE@ to it.
+-- See Note [TYPE and RuntimeRep] in GHC.Builtin.Types.Prim.
+tYPE :: Type -> Type
+tYPE rr@(TyConApp tc [arg])
+ -- See Note [Prefer Type of TYPE 'LiftedRep]
+ | tc `hasKey` boxedRepDataConKey
+ , TyConApp tc' [] <- arg
+ = if | tc' `hasKey` liftedDataConKey -> liftedTypeKind -- TYPE (BoxedRep 'Lifted)
+ | tc' `hasKey` unliftedDataConKey -> unliftedTypeKind -- TYPE (BoxedRep 'Unlifted)
+ | otherwise -> TyConApp tYPETyCon [rr]
+ | tc == liftedRepTyCon -- TYPE LiftedRep
+ = liftedTypeKind
+ | tc == unliftedRepTyCon -- TYPE UnliftedRep
+ = unliftedTypeKind
+tYPE rr = TyConApp tYPETyCon [rr]
+
{-
--------------------------------------------------------------------
diff --git a/compiler/GHC/Core/Type.hs-boot b/compiler/GHC/Core/Type.hs-boot
index 8afa22c771..c38f6fc89d 100644
--- a/compiler/GHC/Core/Type.hs-boot
+++ b/compiler/GHC/Core/Type.hs-boot
@@ -21,6 +21,7 @@ tcView :: Type -> Maybe Type
isRuntimeRepTy :: Type -> Bool
isMultiplicityTy :: Type -> Bool
isLiftedTypeKind :: Type -> Bool
+tYPE :: Type -> Type
splitTyConApp_maybe :: HasDebugCallStack => Type -> Maybe (TyCon, [Type])
tyConAppTyCon_maybe :: Type -> Maybe TyCon
diff --git a/compiler/GHC/Iface/Type.hs b/compiler/GHC/Iface/Type.hs
index 67f27410e8..eaba819a74 100644
--- a/compiler/GHC/Iface/Type.hs
+++ b/compiler/GHC/Iface/Type.hs
@@ -77,8 +77,9 @@ import GHC.Prelude
import {-# SOURCE #-} GHC.Builtin.Types
( coercibleTyCon, heqTyCon
- , liftedRepDataConTyCon, tupleTyConName
- , manyDataConTyCon, oneDataConTyCon )
+ , tupleTyConName
+ , manyDataConTyCon, oneDataConTyCon
+ , liftedRepTyCon )
import {-# SOURCE #-} GHC.Core.Type ( isRuntimeRepTy, isMultiplicityTy )
import GHC.Core.TyCon hiding ( pprPromotionQuote )
@@ -414,16 +415,36 @@ IfaceHoleCo to ensure that they don't end up in an interface file.
ifaceTyConHasKey :: IfaceTyCon -> Unique -> Bool
ifaceTyConHasKey tc key = ifaceTyConName tc `hasKey` key
+-- | Given a kind K, is K of the form (TYPE ('BoxedRep 'LiftedRep))?
isIfaceLiftedTypeKind :: IfaceKind -> Bool
isIfaceLiftedTypeKind (IfaceTyConApp tc IA_Nil)
= isLiftedTypeKindTyConName (ifaceTyConName tc)
-isIfaceLiftedTypeKind (IfaceTyConApp tc
- (IA_Arg (IfaceTyConApp ptr_rep_lifted IA_Nil)
- Required IA_Nil))
- = tc `ifaceTyConHasKey` tYPETyConKey
- && ptr_rep_lifted `ifaceTyConHasKey` liftedRepDataConKey
+isIfaceLiftedTypeKind (IfaceTyConApp tc1 args1)
+ = isIfaceTyConAppLiftedTypeKind tc1 args1
isIfaceLiftedTypeKind _ = False
+-- | Given a kind constructor K and arguments A, returns true if
+-- both of the following statements are true:
+--
+-- * K is TYPE
+-- * A is a singleton IfaceAppArgs of the form ('BoxedRep 'Lifted)
+--
+-- For the second condition, we must also check for the type
+-- synonym LiftedRep.
+isIfaceTyConAppLiftedTypeKind :: IfaceTyCon -> IfaceAppArgs -> Bool
+isIfaceTyConAppLiftedTypeKind tc1 args1
+ | tc1 `ifaceTyConHasKey` tYPETyConKey
+ , IA_Arg soleArg1 Required IA_Nil <- args1
+ , IfaceTyConApp rep args2 <- soleArg1 =
+ if | rep `ifaceTyConHasKey` boxedRepDataConKey
+ , IA_Arg soleArg2 Required IA_Nil <- args2
+ , IfaceTyConApp lev IA_Nil <- soleArg2
+ , lev `ifaceTyConHasKey` liftedDataConKey -> True
+ | rep `ifaceTyConHasKey` liftedRepTyConKey
+ , IA_Nil <- args2 -> True
+ | otherwise -> False
+ | otherwise = False
+
splitIfaceSigmaTy :: IfaceType -> ([IfaceForAllBndr], [IfacePredType], IfaceType)
-- Mainly for printing purposes
--
@@ -1081,11 +1102,14 @@ defaultNonStandardVars do_runtimereps do_multiplicities ty = go False emptyFsEnv
| do_multiplicities, tc `ifaceTyConHasKey` multiplicityTyConKey = Just many_ty
check_substitution _ = Nothing
+-- | The type ('BoxedRep 'Lifted), also known as LiftedRep.
liftedRep_ty :: IfaceType
liftedRep_ty =
- IfaceTyConApp (IfaceTyCon dc_name (IfaceTyConInfo IsPromoted IfaceNormalTyCon))
- IA_Nil
- where dc_name = getName liftedRepDataConTyCon
+ IfaceTyConApp liftedRep IA_Nil
+ where
+ liftedRep :: IfaceTyCon
+ liftedRep = IfaceTyCon tc_name (IfaceTyConInfo NotPromoted IfaceNormalTyCon)
+ where tc_name = getName liftedRepTyCon
many_ty :: IfaceType
many_ty =
@@ -1409,9 +1433,7 @@ pprTyTcApp ctxt_prec tc tys =
, isInvisibleArgFlag argf
-> pprIfaceTyList ctxt_prec ty1 ty2
- | tc `ifaceTyConHasKey` tYPETyConKey
- , IA_Arg (IfaceTyConApp rep IA_Nil) Required IA_Nil <- tys
- , rep `ifaceTyConHasKey` liftedRepDataConKey
+ | isIfaceTyConAppLiftedTypeKind tc tys
, print_type_abbreviations -- See Note [Printing type abbreviations]
-> ppr_kind_type ctxt_prec
diff --git a/compiler/GHC/Tc/Errors.hs b/compiler/GHC/Tc/Errors.hs
index 82dbd65848..f5641766d3 100644
--- a/compiler/GHC/Tc/Errors.hs
+++ b/compiler/GHC/Tc/Errors.hs
@@ -1793,7 +1793,9 @@ headline_eq_msg :: Bool -> Ct -> Type -> Type -> SDoc
headline_eq_msg add_ea ct ty1 ty2
| (isLiftedRuntimeRep ty1 && isUnliftedRuntimeRep ty2) ||
- (isLiftedRuntimeRep ty2 && isUnliftedRuntimeRep ty1)
+ (isLiftedRuntimeRep ty2 && isUnliftedRuntimeRep ty1) ||
+ (isLiftedLevity ty1 && isUnliftedLevity ty2) ||
+ (isLiftedLevity ty2 && isUnliftedLevity ty1)
= text "Couldn't match a lifted type with an unlifted type"
| isAtomicTy ty1 || isAtomicTy ty2
diff --git a/compiler/GHC/Tc/Instance/Typeable.hs b/compiler/GHC/Tc/Instance/Typeable.hs
index 0f0b7a0a11..6c4aeaeb49 100644
--- a/compiler/GHC/Tc/Instance/Typeable.hs
+++ b/compiler/GHC/Tc/Instance/Typeable.hs
@@ -7,6 +7,7 @@
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE TypeFamilies #-}
+{-# LANGUAGE MultiWayIf #-}
module GHC.Tc.Instance.Typeable(mkTypeableBinds, tyConIsTypeable) where
@@ -28,7 +29,7 @@ import GHC.Builtin.Names
import GHC.Builtin.Types.Prim ( primTyCons )
import GHC.Builtin.Types
( tupleTyCon, sumTyCon, runtimeRepTyCon
- , vecCountTyCon, vecElemTyCon
+ , levityTyCon, vecCountTyCon, vecElemTyCon
, nilDataCon, consDataCon )
import GHC.Types.Name
import GHC.Types.Id
@@ -175,7 +176,7 @@ mkTypeableBinds
} } }
where
needs_typeable_binds tc
- | tc `elem` [runtimeRepTyCon, vecCountTyCon, vecElemTyCon]
+ | tc `elem` [runtimeRepTyCon, levityTyCon, vecCountTyCon, vecElemTyCon]
= False
| otherwise =
isAlgTyCon tc
@@ -351,7 +352,7 @@ mkPrimTypeableTodos
-- Note [Built-in syntax and the OrigNameCache] in "GHC.Iface.Env" for more.
ghcPrimTypeableTyCons :: [TyCon]
ghcPrimTypeableTyCons = concat
- [ [ runtimeRepTyCon, vecCountTyCon, vecElemTyCon ]
+ [ [ runtimeRepTyCon, levityTyCon, vecCountTyCon, vecElemTyCon ]
, map (tupleTyCon Unboxed) [0..mAX_TUPLE_SIZE]
, map sumTyCon [2..mAX_SUM_SIZE]
, primTyCons
@@ -557,9 +558,9 @@ mkKindRepRhs :: TypeableStuff
-> CmEnv -- ^ in-scope kind variables
-> Kind -- ^ the kind we want a 'KindRep' for
-> KindRepM (LHsExpr GhcTc) -- ^ RHS expression
-mkKindRepRhs stuff@(Stuff {..}) in_scope = new_kind_rep
+mkKindRepRhs stuff@(Stuff {..}) in_scope = new_kind_rep_shortcut
where
- new_kind_rep k
+ new_kind_rep_shortcut k
-- We handle (TYPE LiftedRep) etc separately to make it
-- clear to consumers (e.g. serializers) that there is
-- a loop here (as TYPE :: RuntimeRep -> TYPE 'LiftedRep)
@@ -567,9 +568,20 @@ mkKindRepRhs stuff@(Stuff {..}) in_scope = new_kind_rep
-- Typeable respects the Constraint/Type distinction
-- so do not follow the special case here
, Just arg <- kindRep_maybe k
- , Just (tc, []) <- splitTyConApp_maybe arg
- , Just dc <- isPromotedDataCon_maybe tc
- = return $ nlHsDataCon kindRepTYPEDataCon `nlHsApp` nlHsDataCon dc
+ = case splitTyConApp_maybe arg of
+ Just (tc, [])
+ | Just dc <- isPromotedDataCon_maybe tc
+ -> return $ nlHsDataCon kindRepTYPEDataCon `nlHsApp` nlHsDataCon dc
+
+ Just (rep, [levArg])
+ | Just dcRep <- isPromotedDataCon_maybe rep
+ , Just (lev, []) <- splitTyConApp_maybe levArg
+ , Just dcLev <- isPromotedDataCon_maybe lev
+ -> return $ nlHsDataCon kindRepTYPEDataCon `nlHsApp` (nlHsDataCon dcRep `nlHsApp` nlHsDataCon dcLev)
+
+ _ -> new_kind_rep k
+ | otherwise = new_kind_rep k
+
new_kind_rep (TyVarTy v)
| Just idx <- lookupCME in_scope v
diff --git a/compiler/GHC/Tc/Utils/TcMType.hs b/compiler/GHC/Tc/Utils/TcMType.hs
index 1e82be0f0e..a3cda06cac 100644
--- a/compiler/GHC/Tc/Utils/TcMType.hs
+++ b/compiler/GHC/Tc/Utils/TcMType.hs
@@ -1793,6 +1793,10 @@ defaultTyVar default_kind tv
= do { traceTc "Defaulting a RuntimeRep var to LiftedRep" (ppr tv)
; writeMetaTyVar tv liftedRepTy
; return True }
+ | isLevityVar tv
+ = do { traceTc "Defaulting a Levity var to Lifted" (ppr tv)
+ ; writeMetaTyVar tv liftedDataConTy
+ ; return True }
| isMultiplicityVar tv
= do { traceTc "Defaulting a Multiplicty var to Many" (ppr tv)
; writeMetaTyVar tv manyDataConTy
diff --git a/compiler/GHC/Types/RepType.hs b/compiler/GHC/Types/RepType.hs
index 0ef8cfe9c9..2957dddb5d 100644
--- a/compiler/GHC/Types/RepType.hs
+++ b/compiler/GHC/Types/RepType.hs
@@ -361,10 +361,11 @@ but RuntimeRep has some extra cases:
data RuntimeRep = VecRep VecCount VecElem -- ^ a SIMD vector type
| TupleRep [RuntimeRep] -- ^ An unboxed tuple of the given reps
| SumRep [RuntimeRep] -- ^ An unboxed sum of the given reps
- | LiftedRep -- ^ lifted; represented by a pointer
- | UnliftedRep -- ^ unlifted; represented by a pointer
+ | BoxedRep Levity -- ^ boxed; represented by a pointer
| IntRep -- ^ signed, word-sized value
...etc...
+data Levity = Lifted
+ | Unlifted
It's all in 1-1 correspondence with PrimRep except for TupleRep and SumRep,
which describe unboxed products and sums respectively. RuntimeRep is defined
@@ -374,6 +375,13 @@ program, so that every variable has a type that has a PrimRep. For
example, unarisation transforms our utup function above, to take two Int
arguments instead of one (# Int, Int #) argument.
+Also, note that boxed types are represented slightly differently in RuntimeRep
+and PrimRep. PrimRep just has the nullary LiftedRep and UnliftedRep data
+constructors. RuntimeRep has a BoxedRep data constructor, which accepts a
+Levity. The subtle distinction is that since BoxedRep can accept a variable
+argument, RuntimeRep can talk about levity polymorphic types. PrimRep, by
+contrast, cannot.
+
See also Note [Getting from RuntimeRep to PrimRep] and Note [VoidRep].
Note [VoidRep]
diff --git a/compiler/GHC/Utils/Binary.hs b/compiler/GHC/Utils/Binary.hs
index ce533ed127..5ee0806cc1 100644
--- a/compiler/GHC/Utils/Binary.hs
+++ b/compiler/GHC/Utils/Binary.hs
@@ -876,7 +876,6 @@ instance Binary (Bin a) where
get bh = do i <- getWord32 bh; return (BinPtr (fromIntegral (i :: Word32)))
-
-- -----------------------------------------------------------------------------
-- Lazy reading/writing
diff --git a/compiler/GHC/Utils/Binary/Typeable.hs b/compiler/GHC/Utils/Binary/Typeable.hs
index c5b89bf35a..ebee92e211 100644
--- a/compiler/GHC/Utils/Binary/Typeable.hs
+++ b/compiler/GHC/Utils/Binary/Typeable.hs
@@ -22,6 +22,9 @@ import GHC.Prelude
import GHC.Utils.Binary
import GHC.Exts (TYPE, RuntimeRep(..), VecCount(..), VecElem(..))
+#if __GLASGOW_HASKELL__ >= 901
+import GHC.Exts (Levity(Lifted, Unlifted))
+#endif
import GHC.Serialized
import Foreign
@@ -115,8 +118,13 @@ instance Binary RuntimeRep where
put_ bh (VecRep a b) = putByte bh 0 >> put_ bh a >> put_ bh b
put_ bh (TupleRep reps) = putByte bh 1 >> put_ bh reps
put_ bh (SumRep reps) = putByte bh 2 >> put_ bh reps
+#if __GLASGOW_HASKELL__ >= 901
+ put_ bh (BoxedRep Lifted) = putByte bh 3
+ put_ bh (BoxedRep Unlifted) = putByte bh 4
+#else
put_ bh LiftedRep = putByte bh 3
put_ bh UnliftedRep = putByte bh 4
+#endif
put_ bh IntRep = putByte bh 5
put_ bh WordRep = putByte bh 6
put_ bh Int64Rep = putByte bh 7
@@ -139,8 +147,13 @@ instance Binary RuntimeRep where
0 -> VecRep <$> get bh <*> get bh
1 -> TupleRep <$> get bh
2 -> SumRep <$> get bh
+#if __GLASGOW_HASKELL__ >= 901
+ 3 -> pure (BoxedRep Lifted)
+ 4 -> pure (BoxedRep Unlifted)
+#else
3 -> pure LiftedRep
4 -> pure UnliftedRep
+#endif
5 -> pure IntRep
6 -> pure WordRep
7 -> pure Int64Rep
View Lorry Controller Status