diff options
author | Andrew Martin <andrew.thaddeus@gmail.com> | 2020-10-07 15:45:30 -0400 |
---|---|---|
committer | Ben Gamari <ben@smart-cactus.org> | 2020-12-14 18:48:51 -0500 |
commit | 6c2eb2232b39ff4720fda0a4a009fb6afbc9dcea (patch) | |
tree | 0a19d6cece0d63aadcfa6e014171a5baeaf4c167 /compiler/GHC | |
parent | dad87210efffce9cfc2d17dc088a71d9dea14535 (diff) | |
download | haskell-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.hs | 65 | ||||
-rw-r--r-- | compiler/GHC/Builtin/Types.hs | 137 | ||||
-rw-r--r-- | compiler/GHC/Builtin/Types.hs-boot | 11 | ||||
-rw-r--r-- | compiler/GHC/Builtin/Types/Prim.hs | 22 | ||||
-rw-r--r-- | compiler/GHC/Core/TyCo/Rep.hs | 14 | ||||
-rw-r--r-- | compiler/GHC/Core/TyCon.hs | 8 | ||||
-rw-r--r-- | compiler/GHC/Core/Type.hs | 46 | ||||
-rw-r--r-- | compiler/GHC/Iface/Type.hs | 51 | ||||
-rw-r--r-- | compiler/GHC/Tc/Errors.hs | 4 | ||||
-rw-r--r-- | compiler/GHC/Tc/Instance/Typeable.hs | 27 | ||||
-rw-r--r-- | compiler/GHC/Types/RepType.hs | 12 | ||||
-rw-r--r-- | compiler/GHC/Utils/Binary.hs | 1 | ||||
-rw-r--r-- | compiler/GHC/Utils/Binary/Typeable.hs | 13 |
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 |