summaryrefslogtreecommitdiff
path: root/compiler/GHC
diff options
context:
space:
mode:
authorAndrew Martin <andrew.thaddeus@gmail.com>2020-10-07 15:45:30 -0400
committerBen Gamari <ben@smart-cactus.org>2020-12-14 18:48:51 -0500
commit6c2eb2232b39ff4720fda0a4a009fb6afbc9dcea (patch)
tree0a19d6cece0d63aadcfa6e014171a5baeaf4c167 /compiler/GHC
parentdad87210efffce9cfc2d17dc088a71d9dea14535 (diff)
downloadhaskell-6c2eb2232b39ff4720fda0a4a009fb6afbc9dcea.tar.gz
Implement BoxedRep proposal
This implements the BoxedRep proposal, refacoring the `RuntimeRep` hierarchy from: ```haskell data RuntimeRep = LiftedPtrRep | UnliftedPtrRep | ... ``` to ```haskell data RuntimeRep = BoxedRep Levity | ... data Levity = Lifted | Unlifted ``` Closes #17526.
Diffstat (limited to 'compiler/GHC')
-rw-r--r--compiler/GHC/Builtin/Names.hs65
-rw-r--r--compiler/GHC/Builtin/Types.hs137
-rw-r--r--compiler/GHC/Builtin/Types.hs-boot11
-rw-r--r--compiler/GHC/Builtin/Types/Prim.hs22
-rw-r--r--compiler/GHC/Core/TyCo/Rep.hs14
-rw-r--r--compiler/GHC/Core/TyCon.hs8
-rw-r--r--compiler/GHC/Core/Type.hs46
-rw-r--r--compiler/GHC/Iface/Type.hs51
-rw-r--r--compiler/GHC/Tc/Errors.hs4
-rw-r--r--compiler/GHC/Tc/Instance/Typeable.hs27
-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
13 files changed, 304 insertions, 107 deletions
diff --git a/compiler/GHC/Builtin/Names.hs b/compiler/GHC/Builtin/Names.hs
index cf0f72c50f..caa577a877 100644
--- a/compiler/GHC/Builtin/Names.hs
+++ b/compiler/GHC/Builtin/Names.hs
@@ -1767,7 +1767,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,
@@ -1790,8 +1790,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
@@ -1807,15 +1805,17 @@ eitherTyConKey :: Unique
eitherTyConKey = mkPreludeTyConUnique 84
-- Kind constructors
-liftedTypeKindTyConKey, tYPETyConKey,
- constraintKindTyConKey, runtimeRepTyConKey,
+liftedTypeKindTyConKey, tYPETyConKey, liftedRepTyConKey,
+ constraintKindTyConKey, levityTyConKey, runtimeRepTyConKey,
vecCountTyConKey, vecElemTyConKey :: Unique
liftedTypeKindTyConKey = mkPreludeTyConUnique 87
tYPETyConKey = mkPreludeTyConUnique 88
constraintKindTyConKey = mkPreludeTyConUnique 92
+levityTyConKey = mkPreludeTyConUnique 94
runtimeRepTyConKey = mkPreludeTyConUnique 95
vecCountTyConKey = mkPreludeTyConUnique 96
vecElemTyConKey = mkPreludeTyConUnique 97
+liftedRepTyConKey = mkPreludeTyConUnique 98
pluginTyConKey, frontendPluginTyConKey :: Unique
pluginTyConKey = mkPreludeTyConUnique 102
@@ -2073,58 +2073,60 @@ 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 :: Unique
-typeLitSymbolDataConKey = mkPreludeDataConUnique 112
-typeLitNatDataConKey = mkPreludeDataConUnique 113
+typeLitSymbolDataConKey = mkPreludeDataConUnique 113
+typeLitNatDataConKey = mkPreludeDataConUnique 114
-- Unsafe equality
unsafeReflDataConKey :: Unique
-unsafeReflDataConKey = mkPreludeDataConUnique 114
+unsafeReflDataConKey = mkPreludeDataConUnique 115
-- Multiplicity
oneDataConKey, manyDataConKey :: Unique
-oneDataConKey = mkPreludeDataConUnique 115
-manyDataConKey = mkPreludeDataConUnique 116
+oneDataConKey = mkPreludeDataConUnique 116
+manyDataConKey = mkPreludeDataConUnique 117
-- ghc-bignum
integerISDataConKey, integerINDataConKey, integerIPDataConKey,
@@ -2364,14 +2366,16 @@ mkTrFunKey = mkPreludeMiscIdUnique 510
-- Representations for primitive types
trTYPEKey
- ,trTYPE'PtrRepLiftedKey
+ , trTYPE'PtrRepLiftedKey
, trRuntimeRepKey
, tr'PtrRepLiftedKey
+ , trLiftedRepKey
:: Unique
trTYPEKey = mkPreludeMiscIdUnique 511
trTYPE'PtrRepLiftedKey = mkPreludeMiscIdUnique 512
trRuntimeRepKey = mkPreludeMiscIdUnique 513
tr'PtrRepLiftedKey = mkPreludeMiscIdUnique 514
+trLiftedRepKey = mkPreludeMiscIdUnique 515
-- KindReps for common cases
starKindRepKey, starArrStarKindRepKey, starArrStarArrStarKindRepKey :: Unique
@@ -2601,4 +2605,5 @@ pretendNameIsInScope :: Name -> Bool
pretendNameIsInScope n
= any (n `hasKey`)
[ liftedTypeKindTyConKey, tYPETyConKey
- , runtimeRepTyConKey, liftedRepDataConKey ]
+ , runtimeRepTyConKey, boxedRepDataConKey
+ , liftedDataConKey ]
diff --git a/compiler/GHC/Builtin/Types.hs b/compiler/GHC/Builtin/Types.hs
index 3339e0a020..3361853611 100644
--- a/compiler/GHC/Builtin/Types.hs
+++ b/compiler/GHC/Builtin/Types.hs
@@ -99,8 +99,9 @@ module GHC.Builtin.Types (
typeSymbolKindCon, typeSymbolKind,
isLiftedTypeKindTyConName, liftedTypeKind,
typeToTypeKind, constraintKind,
+ liftedRepTyCon,
liftedTypeKindTyCon, constraintKindTyCon, constraintKindTyConName,
- liftedTypeKindTyConName,
+ liftedTypeKindTyConName, liftedRepTyConName,
-- * Equality predicates
heqTyCon, heqTyConName, heqClass, heqDataCon,
@@ -108,13 +109,15 @@ 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,
+
intRepDataConTy,
int8RepDataConTy, int16RepDataConTy, int32RepDataConTy, int64RepDataConTy,
wordRepDataConTy,
@@ -212,6 +215,41 @@ 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
+liftedRepTyCon TyCon GHC.Types.LiftedRep Synonym for: 'BoxedRep 'Lifted
+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}
@@ -220,8 +258,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)
@@ -260,6 +300,7 @@ wiredInTyCons = [ -- Units are not treated like other tuples, because they
, coercibleTyCon
, typeSymbolKindCon
, runtimeRepTyCon
+ , levityTyCon
, vecCountTyCon
, vecElemTyCon
, constraintKindTyCon
@@ -267,6 +308,7 @@ wiredInTyCons = [ -- Units are not treated like other tuples, because they
, multiplicityTyCon
, naturalTyCon
, integerTyCon
+ , liftedRepTyCon
]
mkWiredInTyConName :: BuiltInSyntax -> Module -> FastString -> Unique -> TyCon -> Name
@@ -483,8 +525,9 @@ typeSymbolKindConName = mkWiredInTyConName UserSyntax gHC_TYPES (fsLit "Symbol")
constraintKindTyConName :: Name
constraintKindTyConName = mkWiredInTyConName UserSyntax gHC_TYPES (fsLit "Constraint") constraintKindTyConKey constraintKindTyCon
-liftedTypeKindTyConName :: Name
+liftedTypeKindTyConName, liftedRepTyConName :: Name
liftedTypeKindTyConName = mkWiredInTyConName UserSyntax gHC_TYPES (fsLit "Type") liftedTypeKindTyConKey liftedTypeKindTyCon
+liftedRepTyConName = mkWiredInTyConName UserSyntax gHC_TYPES (fsLit "LiftedRep") liftedRepTyConKey liftedRepTyCon
multiplicityTyConName :: Name
multiplicityTyConName = mkWiredInTyConName UserSyntax gHC_TYPES (fsLit "Multiplicity")
@@ -500,18 +543,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"
@@ -1413,16 +1462,43 @@ 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]
+ where rhs = TyCoRep.TyConApp tYPETyCon [mkTyConApp liftedRepTyCon []]
+
+liftedRepTyCon :: TyCon
+liftedRepTyCon = buildSynTyCon
+ liftedRepTyConName [] runtimeRepTy [] liftedRepTy
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
@@ -1477,11 +1553,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
@@ -1494,15 +1568,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,
@@ -1554,12 +1626,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 'LiftedRep)
liftedRepTy :: Type
-liftedRepTy = liftedRepDataConTy
+liftedRepTy = mkTyConApp boxedRepDataConTyCon [liftedDataConTy]
+
+-- The type ('BoxedRep 'UnliftedRep)
+unliftedRepTy :: Type
+unliftedRepTy = mkTyConApp boxedRepDataConTyCon [unliftedDataConTy]
{- *********************************************************************
* *
diff --git a/compiler/GHC/Builtin/Types.hs-boot b/compiler/GHC/Builtin/Types.hs-boot
index 000df212c3..222d88fdf7 100644
--- a/compiler/GHC/Builtin/Types.hs-boot
+++ b/compiler/GHC/Builtin/Types.hs-boot
@@ -20,13 +20,16 @@ liftedTypeKindTyCon :: 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
-liftedRepDataConTy, unliftedRepDataConTy,
- intRepDataConTy,
+liftedRepTy, unliftedRepTy :: Type
+
+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 61f341a0bb..e748258769 100644
--- a/compiler/GHC/Builtin/Types/Prim.hs
+++ b/compiler/GHC/Builtin/Types/Prim.hs
@@ -98,7 +98,7 @@ import GHC.Prelude
import {-# SOURCE #-} GHC.Builtin.Types
( runtimeRepTy, unboxedTupleKind, liftedTypeKind
, vecRepDataConTyCon, tupleRepDataConTyCon
- , liftedRepDataConTy, unliftedRepDataConTy
+ , liftedRepTy, unliftedRepTy
, intRepDataConTy
, int8RepDataConTy, int16RepDataConTy, int32RepDataConTy, int64RepDataConTy
, wordRepDataConTy
@@ -364,7 +364,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
@@ -451,26 +451,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.
@@ -577,8 +579,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 be7bdb3aef..262037402b 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 #-}
@@ -91,7 +92,7 @@ import GHC.Core.TyCon
import GHC.Core.Coercion.Axiom
-- others
-import GHC.Builtin.Names ( liftedTypeKindTyConKey, liftedRepDataConKey, manyDataConKey, tYPETyConKey )
+import GHC.Builtin.Names ( liftedTypeKindTyConKey, boxedRepDataConKey, liftedDataConKey, manyDataConKey, tYPETyConKey )
import {-# SOURCE #-} GHC.Builtin.Types ( liftedTypeKindTyCon, liftedTypeKind, manyDataConTy )
import {-# SOURCE #-} GHC.Builtin.Types.Prim ( tYPETyCon )
import GHC.Types.Basic ( LeftOrRight(..), pickLR )
@@ -1090,17 +1091,22 @@ 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 [])
+tYPE rr@(TyConApp tc [arg])
-- See Note [Prefer Type of TYPE 'LiftedRep]
- | tc `hasKey` liftedRepDataConKey = liftedTypeKind -- TYPE 'LiftedRep
+ | tc `hasKey` boxedRepDataConKey
+ , TyConApp tc' [] <- arg
+ = if | tc' `hasKey` liftedDataConKey -> liftedTypeKind
+ -- | tc' `hasKey` unlifedDataConKey -> unliftedTypeKind
+ | otherwise -> 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.
+-- See Note [mkTyConApp and Type] in this module.
liftedTypeKindTyConApp :: Type
liftedTypeKindTyConApp = TyConApp liftedTypeKindTyCon []
+
{-
%************************************************************************
%* *
diff --git a/compiler/GHC/Core/TyCon.hs b/compiler/GHC/Core/TyCon.hs
index a038fd646c..e07e51e606 100644
--- a/compiler/GHC/Core/TyCon.hs
+++ b/compiler/GHC/Core/TyCon.hs
@@ -139,7 +139,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
@@ -1073,6 +1073,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
+ | UnliftedInfo
-- | Extract those 'DataCon's that we are able to learn about. Note
-- that visibility in this sense does not correspond to visibility in
@@ -2235,8 +2237,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 e5d0da93fd..6065f3f56a 100644
--- a/compiler/GHC/Core/Type.hs
+++ b/compiler/GHC/Core/Type.hs
@@ -121,6 +121,7 @@ module GHC.Core.Type (
isLiftedType_maybe,
isLiftedTypeKind, isUnliftedTypeKind, pickyIsLiftedTypeKind,
isLiftedRuntimeRep, isUnliftedRuntimeRep,
+ isLiftedLevity, isUnliftedLevity,
isUnliftedType, mightBeUnliftedType, isUnboxedTupleType, isUnboxedSumType,
isAlgType, isDataFamilyAppType,
isPrimitiveType, isStrictType,
@@ -611,6 +612,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
@@ -619,8 +621,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
@@ -630,8 +637,27 @@ 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
+ | TyConApp rr_tc rr_args <- coreFullView rep
+ , rr_tc `hasKey` boxedRepDataConKey
+ = case rr_args of
+ [rr_arg] -> isLiftedLevity rr_arg
+ _ -> ASSERT( False ) True -- this should probably just panic
+ | 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.
@@ -648,9 +674,15 @@ 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)
+ | TyConApp rr_tc args <- coreFullView rep -- NB: args might be non-empty
+ -- e.g. TupleRep [r1, .., rn]
+ , isPromotedDataCon rr_tc =
+ -- NB: args might be non-empty e.g. TupleRep [r1, .., rn]
+ if (rr_tc `hasKey` boxedRepDataConKey)
+ then case args of
+ [TyConApp lev_tc []] -> lev_tc `hasKey` unliftedDataConKey
+ _ -> 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
diff --git a/compiler/GHC/Iface/Type.hs b/compiler/GHC/Iface/Type.hs
index e87998dd37..f6107a5318 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 )
+ , liftedDataConTyCon, tupleTyConName
+ , manyDataConTyCon, oneDataConTyCon
+ , boxedRepDataConTyCon )
import {-# SOURCE #-} GHC.Core.Type ( isRuntimeRepTy, isMultiplicityTy )
import GHC.Core.TyCon hiding ( pprPromotionQuote )
@@ -413,16 +414,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 'LiftedRep)
+--
+-- 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
--
@@ -1080,11 +1101,17 @@ defaultNonStandardVars do_runtimereps do_multiplicities ty = go False emptyFsEnv
| do_multiplicities, tc `ifaceTyConHasKey` multiplicityTyConKey = Just many_ty
check_substitution _ = Nothing
+-- The type ('BoxedRep 'LiftedRep)
liftedRep_ty :: IfaceType
liftedRep_ty =
- IfaceTyConApp (IfaceTyCon dc_name (IfaceTyConInfo IsPromoted IfaceNormalTyCon))
- IA_Nil
- where dc_name = getName liftedRepDataConTyCon
+ IfaceTyConApp boxedRep (IA_Arg (IfaceTyConApp lifted IA_Nil) Required IA_Nil)
+ where
+ boxedRep :: IfaceTyCon
+ boxedRep = IfaceTyCon dc_name (IfaceTyConInfo IsPromoted IfaceNormalTyCon)
+ where dc_name = getName boxedRepDataConTyCon
+ lifted :: IfaceTyCon
+ lifted = IfaceTyCon dc_name (IfaceTyConInfo IsPromoted IfaceNormalTyCon)
+ where dc_name = getName liftedDataConTyCon
many_ty :: IfaceType
many_ty =
@@ -1408,9 +1435,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 71b919b4fd..605b3036c7 100644
--- a/compiler/GHC/Tc/Errors.hs
+++ b/compiler/GHC/Tc/Errors.hs
@@ -1782,7 +1782,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 e4eb7a1b2d..ba01154785 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
@@ -555,9 +556,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)
@@ -565,9 +566,19 @@ 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
+ = if
+ | Just (tc, []) <- splitTyConApp_maybe arg
+ , Just dc <- isPromotedDataCon_maybe tc
+ -> return $ nlHsDataCon kindRepTYPEDataCon `nlHsApp` nlHsDataCon dc
+ | Just (rep,[levArg]) <- splitTyConApp_maybe arg
+ , Just dcRep <- isPromotedDataCon_maybe rep
+ , Just (lev, []) <- splitTyConApp_maybe levArg
+ , Just dcLev <- isPromotedDataCon_maybe lev
+ -> return $ nlHsDataCon kindRepTYPEDataCon `nlHsApp` (nlHsDataCon dcRep `nlHsApp` nlHsDataCon dcLev)
+ | otherwise
+ -> 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/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 1579eeb5a8..86f5fce3b4 100644
--- a/compiler/GHC/Utils/Binary.hs
+++ b/compiler/GHC/Utils/Binary.hs
@@ -864,7 +864,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 580b245ded..ab96cf748c 100644
--- a/compiler/GHC/Utils/Binary/Typeable.hs
+++ b/compiler/GHC/Utils/Binary/Typeable.hs
@@ -19,6 +19,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
@@ -112,8 +115,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
@@ -136,8 +144,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