From 6c2eb2232b39ff4720fda0a4a009fb6afbc9dcea Mon Sep 17 00:00:00 2001
From: Andrew Martin <andrew.thaddeus@gmail.com>
Date: Wed, 7 Oct 2020 15:45:30 -0400
Subject: [PATCH] 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.
---
compiler/GHC/Builtin/Names.hs | 65 +++++----
compiler/GHC/Builtin/Types.hs | 137 +++++++++++++++---
compiler/GHC/Builtin/Types.hs-boot | 11 +-
compiler/GHC/Builtin/Types/Prim.hs | 22 +--
compiler/GHC/Core/TyCo/Rep.hs | 14 +-
compiler/GHC/Core/TyCon.hs | 8 +-
compiler/GHC/Core/Type.hs | 46 +++++-
compiler/GHC/Iface/Type.hs | 51 +++++--
compiler/GHC/Tc/Errors.hs | 4 +-
compiler/GHC/Tc/Instance/Typeable.hs | 27 +++-
compiler/GHC/Types/RepType.hs | 12 +-
compiler/GHC/Utils/Binary.hs | 1 -
compiler/GHC/Utils/Binary/Typeable.hs | 13 ++
docs/users_guide/9.2.1-notes.rst | 6 +
docs/users_guide/exts/levity_polymorphism.rst | 20 ++-
docs/users_guide/exts/typed_holes.rst | 2 +-
libraries/base/Data/Typeable.hs | 2 +
libraries/base/Data/Typeable/Internal.hs | 98 +++++++++----
libraries/base/GHC/Enum.hs | 5 +
libraries/base/GHC/Exts.hs | 3 +-
libraries/base/GHC/Show.hs | 3 +
libraries/base/Unsafe/Coerce.hs | 2 +-
libraries/base/tests/T11334a.hs | 4 +-
libraries/base/tests/T11334a.stdout | 2 +-
libraries/binary | 2 +-
libraries/ghc-heap/GHC/Exts/Heap.hs | 8 +
libraries/ghc-heap/tests/ClosureSizeUtils.hs | 2 +-
libraries/ghc-prim/GHC/Types.hs | 13 +-
.../Language/Haskell/TH/Syntax.hs | 8 +
.../tests/backpack/should_run/T13955.bkp | 2 +-
.../dependent/should_compile/RaeJobTalk.hs | 18 ++-
.../tests/dependent/should_fail/T17131.stderr | 4 +-
.../tests/deriving/should_compile/T13154b.hs | 4 +-
.../tests/deriving/should_fail/T12512.hs | 4 +-
testsuite/tests/ffi/should_run/T16650a.hs | 2 +-
testsuite/tests/ffi/should_run/T16650b.hs | 2 +-
testsuite/tests/ffi/should_run/T16650c.hs | 2 +-
testsuite/tests/ffi/should_run/T16650d.hs | 2 +-
.../UnliftedNewtypesByteArrayOffset.hs | 2 +-
testsuite/tests/ghci/scripts/T13963.script | 2 +-
testsuite/tests/ghci/scripts/T15941.stdout | 2 +-
testsuite/tests/ghci/scripts/T7627.stdout | 3 +-
testsuite/tests/ghci/should_run/T16096.stdout | 4 +-
testsuite/tests/ghci/should_run/T18594.stdout | 4 +-
testsuite/tests/plugins/plugins09.stdout | 1 +
testsuite/tests/plugins/plugins10.stdout | 1 +
testsuite/tests/plugins/plugins11.stdout | 1 +
testsuite/tests/plugins/static-plugins.stdout | 2 +-
.../tests/pmcheck/should_compile/T18249.hs | 2 +-
testsuite/tests/polykinds/T14555.stderr | 2 +-
testsuite/tests/polykinds/T14563.stderr | 2 +-
testsuite/tests/polykinds/T17963.stderr | 2 +-
testsuite/tests/polykinds/T18300.stderr | 4 +-
.../simplCore/should_compile/T18013.stderr | 4 +-
.../simplCore/should_compile/T9400.stderr | 2 +-
.../should_compile/spec-inline.stderr | 2 +-
testsuite/tests/th/T14869.hs | 2 +-
.../typecheck/should_compile/LevPolyResult.hs | 11 ++
.../UnliftedNewtypesUnassociatedFamily.hs | 5 +-
.../abstract_refinement_hole_fits.stderr | 34 ++---
.../tests/typecheck/should_compile/all.T | 1 +
.../constraint_hole_fits.stderr | 4 +-
.../refinement_hole_fits.stderr | 24 +--
.../tests/typecheck/should_fail/LevPolyLet.hs | 19 +++
.../typecheck/should_fail/LevPolyLet.stderr | 5 +
.../tests/typecheck/should_fail/T12373.stderr | 2 +-
.../tests/typecheck/should_fail/T13610.stderr | 2 +-
.../tests/typecheck/should_fail/T14884.stderr | 4 +-
.../tests/typecheck/should_fail/T15067.stderr | 14 +-
.../tests/typecheck/should_fail/T15883b.hs | 2 +-
.../typecheck/should_fail/T15883b.stderr | 5 +-
.../tests/typecheck/should_fail/T15883c.hs | 2 +-
.../typecheck/should_fail/T15883c.stderr | 5 +-
.../tests/typecheck/should_fail/T15883d.hs | 2 +-
.../typecheck/should_fail/T15883d.stderr | 5 +-
.../tests/typecheck/should_fail/T15883e.hs | 2 +-
.../typecheck/should_fail/T15883e.stderr | 5 +-
.../tests/typecheck/should_fail/T17021.stderr | 2 +-
.../typecheck/should_fail/T18357a.stderr | 2 +-
testsuite/tests/typecheck/should_fail/all.T | 1 +
.../typecheck/should_fail/tcfail090.stderr | 2 +-
.../typecheck/should_run/EtaExpandLevPoly.hs | 4 +-
.../typecheck/should_run/LevPolyResultInst.hs | 27 ++++
.../should_run/LevPolyResultInst.stdout | 2 +
.../tests/typecheck/should_run/T12809.hs | 2 +-
.../tests/typecheck/should_run/T14236.stdout | 4 +-
.../should_run/TestTypeableBinary.stdout | 2 +-
.../tests/typecheck/should_run/TypeOf.hs | 4 +-
.../tests/typecheck/should_run/TypeOf.stdout | 2 +-
.../tests/typecheck/should_run/TypeRep.hs | 4 +-
.../tests/typecheck/should_run/TypeRep.stdout | 4 +-
testsuite/tests/typecheck/should_run/all.T | 1 +
testsuite/tests/unboxedsums/T12711.stdout | 4 +-
testsuite/tests/unboxedsums/sum_rr.hs | 2 +-
utils/haddock | 2 +-
95 files changed, 634 insertions(+), 265 deletions(-)
create mode 100644 testsuite/tests/typecheck/should_compile/LevPolyResult.hs
create mode 100644 testsuite/tests/typecheck/should_fail/LevPolyLet.hs
create mode 100644 testsuite/tests/typecheck/should_fail/LevPolyLet.stderr
create mode 100644 testsuite/tests/typecheck/should_run/LevPolyResultInst.hs
create mode 100644 testsuite/tests/typecheck/should_run/LevPolyResultInst.stdout
diff --git a/compiler/GHC/Builtin/Names.hs b/compiler/GHC/Builtin/Names.hs
index cf0f72c50fe1..caa577a877f2 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 3339e0a02079..336185361135 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 000df212c3b4..222d88fdf753 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 61f341a0bb6e..e7482587695a 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 be7bdb3aef5c..262037402b66 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 a038fd646cd8..e07e51e60680 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 e5d0da93fd88..6065f3f56a9b 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 e87998dd372a..f6107a53188e 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 71b919b4fd53..605b3036c746 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 e4eb7a1b2d75..ba0115478510 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 0ef8cfe9c9ee..2957dddb5dff 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 1579eeb5a856..86f5fce3b4f0 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 580b245dedfe..ab96cf748c44 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
diff --git a/docs/users_guide/9.2.1-notes.rst b/docs/users_guide/9.2.1-notes.rst
index 283615b7a4ca..bfa828309269 100644
--- a/docs/users_guide/9.2.1-notes.rst
+++ b/docs/users_guide/9.2.1-notes.rst
@@ -13,6 +13,12 @@ Language
<https://www.microsoft.com/en-us/research/publication/a-quick-look-at-impredicativity/>`__
(Serrano et al, ICFP 2020). More information here: :ref:`impredicative-polymorphism`.
This replaces the old (undefined, flaky) behaviour of the :extension:`ImpredicativeTypes` extension.
+* The first stage of the `Pointer Rep Proposal`_ has been implemented. All
+ boxed types, both lifted and unlifted, now have representation kinds of
+ the shape ``BoxedRep r``. Code that references ``LiftedRep`` and ``UnliftedRep``
+ will need to be updated.
+
+.. _Pointer Rep Proposal: https://github.com/ghc-proposals/ghc-proposals/blob/master/proposals/0203-pointer-rep.rst
* Kind inference for data/newtype instance declarations is slightly
more restrictive than before. See the user manual :ref:`kind-inference-data-family-instances`.
diff --git a/docs/users_guide/exts/levity_polymorphism.rst b/docs/users_guide/exts/levity_polymorphism.rst
index a65f878b41a5..80a544e54bdf 100644
--- a/docs/users_guide/exts/levity_polymorphism.rst
+++ b/docs/users_guide/exts/levity_polymorphism.rst
@@ -13,21 +13,25 @@ Here are the key definitions, all available from ``GHC.Exts``: ::
TYPE :: RuntimeRep -> Type -- highly magical, built into GHC
- data RuntimeRep = LiftedRep -- for things like `Int`
- | UnliftedRep -- for things like `Array#`
- | IntRep -- for `Int#`
+ data Levity = Lifted -- for things like `Int`
+ | Unlifted -- for things like `Array#`
+
+ data RuntimeRep = BoxedRep Levity -- for anything represented by a GC-managed pointer
+ | IntRep -- for `Int#`
| TupleRep [RuntimeRep] -- unboxed tuples, indexed by the representations of the elements
| SumRep [RuntimeRep] -- unboxed sums, indexed by the representations of the disjuncts
| ...
+ type LiftedRep = BoxedRep Lifted
+
type Type = TYPE LiftedRep -- Type is just an ordinary type synonym
The idea is that we have a new fundamental type constant ``TYPE``, which
is parameterised by a ``RuntimeRep``. We thus get ``Int# :: TYPE 'IntRep``
-and ``Bool :: TYPE 'LiftedRep``. Anything with a type of the form
+and ``Bool :: TYPE LiftedRep``. Anything with a type of the form
``TYPE x`` can appear to either side of a function arrow ``->``. We can
thus say that ``->`` has type
-``TYPE r1 -> TYPE r2 -> TYPE 'LiftedRep``. The result is always lifted
+``TYPE r1 -> TYPE r2 -> TYPE LiftedRep``. The result is always lifted
because all functions are lifted in GHC.
.. _levity-polymorphic-restrictions:
@@ -102,13 +106,13 @@ Printing levity-polymorphic types
:category: verbosity
Print ``RuntimeRep`` parameters as they appear; otherwise, they are
- defaulted to ``'LiftedRep``.
+ defaulted to ``LiftedRep``.
Most GHC users will not need to worry about levity polymorphism
or unboxed types. For these users, seeing the levity polymorphism
in the type of ``$`` is unhelpful. And thus, by default, it is suppressed,
-by supposing all type variables of type ``RuntimeRep`` to be ``'LiftedRep``
-when printing, and printing ``TYPE 'LiftedRep`` as ``Type`` (or ``*`` when
+by supposing all type variables of type ``RuntimeRep`` to be ``LiftedRep``
+when printing, and printing ``TYPE LiftedRep`` as ``Type`` (or ``*`` when
:extension:`StarIsType` is on).
Should you wish to see levity polymorphism in your types, enable
diff --git a/docs/users_guide/exts/typed_holes.rst b/docs/users_guide/exts/typed_holes.rst
index 170824ee4f6d..4fded59ae292 100644
--- a/docs/users_guide/exts/typed_holes.rst
+++ b/docs/users_guide/exts/typed_holes.rst
@@ -443,7 +443,7 @@ it will additionally offer up a list of refinement hole fits, in this case: ::
with const @Integer @[Integer]
where const :: forall a b. a -> b -> a
($) (_ :: [Integer] -> Integer)
- with ($) @'GHC.Types.LiftedRep @[Integer] @Integer
+ with ($) @GHC.Types.LiftedRep @[Integer] @Integer
where ($) :: forall a b. (a -> b) -> a -> b
fail (_ :: String)
with fail @((->) [Integer]) @Integer
diff --git a/libraries/base/Data/Typeable.hs b/libraries/base/Data/Typeable.hs
index 43c9aa187d0f..1c84c99021c1 100644
--- a/libraries/base/Data/Typeable.hs
+++ b/libraries/base/Data/Typeable.hs
@@ -89,6 +89,8 @@ module Data.Typeable
-- * For backwards compatibility
, typeOf1, typeOf2, typeOf3, typeOf4, typeOf5, typeOf6, typeOf7
+ -- Jank
+ , I.trLiftedRep
) where
import qualified Data.Typeable.Internal as I
diff --git a/libraries/base/Data/Typeable/Internal.hs b/libraries/base/Data/Typeable/Internal.hs
index 85abebf331c8..de20ca8e1994 100644
--- a/libraries/base/Data/Typeable/Internal.hs
+++ b/libraries/base/Data/Typeable/Internal.hs
@@ -1,3 +1,4 @@
+{-# LANGUAGE UnliftedFFITypes #-}
{-# LANGUAGE AllowAmbiguousTypes #-}
{-# LANGUAGE Trustworthy #-}
{-# LANGUAGE ViewPatterns #-}
@@ -80,6 +81,9 @@ module Data.Typeable.Internal (
mkTrType, mkTrCon, mkTrApp, mkTrAppChecked, mkTrFun,
mkTyCon, mkTyCon#,
typeSymbolTypeRep, typeNatTypeRep,
+
+ -- Jank
+ trLiftedRep
) where
import GHC.Prim ( FUN )
@@ -375,7 +379,12 @@ mkTrCon tc kind_vars = TrTyCon
-- constructor, so we need to build it here.
fpTYPELiftedRep :: Fingerprint
fpTYPELiftedRep = fingerprintFingerprints
- [tyConFingerprint tyConTYPE, typeRepFingerprint trLiftedRep]
+ [ tyConFingerprint tyConTYPE
+ , fingerprintFingerprints
+ [ tyConFingerprint tyCon'BoxedRep
+ , tyConFingerprint tyCon'Lifted
+ ]
+ ]
-- There is absolutely nothing to gain and everything to lose
-- by inlining the worker. The wrapper should inline anyway.
{-# NOINLINE fpTYPELiftedRep #-}
@@ -383,7 +392,7 @@ fpTYPELiftedRep = fingerprintFingerprints
trTYPE :: TypeRep TYPE
trTYPE = typeRep
-trLiftedRep :: TypeRep 'LiftedRep
+trLiftedRep :: TypeRep ('BoxedRep 'Lifted)
trLiftedRep = typeRep
trMany :: TypeRep 'Many
@@ -399,23 +408,23 @@ mkTrApp :: forall k1 k2 (a :: k1 -> k2) (b :: k1).
-> TypeRep (b :: k1)
-> TypeRep (a b)
mkTrApp a b -- See Note [Kind caching], Wrinkle 2
- | Just HRefl <- a `eqTypeRep` trTYPE
- , Just HRefl <- b `eqTypeRep` trLiftedRep
- = TrType
-
- | TrFun {trFunRes = res_kind} <- typeRepKind a
- = TrApp
- { trAppFingerprint = fpr
- , trAppFun = a
- , trAppArg = b
- , trAppKind = res_kind }
-
- | otherwise = error ("Ill-kinded type application: "
- ++ show (typeRepKind a))
- where
- fpr_a = typeRepFingerprint a
- fpr_b = typeRepFingerprint b
- fpr = fingerprintFingerprints [fpr_a, fpr_b]
+ | Just HRefl <- a `eqTypeRep` trTYPE
+ , Just HRefl <- b `eqTypeRep` trLiftedRep
+ = TrType
+
+ | TrFun {trFunRes = res_kind} <- typeRepKind a
+ = TrApp
+ { trAppFingerprint = fpr
+ , trAppFun = a
+ , trAppArg = b
+ , trAppKind = res_kind }
+
+ | otherwise = error ("Ill-kinded type application: "
+ ++ show (typeRepKind a))
+ where
+ fpr_a = typeRepFingerprint a
+ fpr_b = typeRepFingerprint b
+ fpr = fingerprintFingerprints [fpr_a, fpr_b]
-- | Construct a representation for a type application that
-- may be a saturated arrow type. This is renamed to mkTrApp in
@@ -623,7 +632,7 @@ instantiateKindRep vars = go
= SomeTypeRep $ mkTrApp (unsafeCoerceRep $ go f) (unsafeCoerceRep $ go a)
go (KindRepFun a b)
= SomeTypeRep $ mkTrFun trMany (unsafeCoerceRep $ go a) (unsafeCoerceRep $ go b)
- go (KindRepTYPE LiftedRep) = SomeTypeRep TrType
+ go (KindRepTYPE (BoxedRep Lifted)) = SomeTypeRep TrType
go (KindRepTYPE r) = unkindedTypeRep $ tYPE `kApp` runtimeRepTypeRep r
go (KindRepTypeLitS sort s)
= mkTypeLitFromString sort (unpackCStringUtf8# s)
@@ -662,8 +671,9 @@ buildList = foldr cons nil
runtimeRepTypeRep :: RuntimeRep -> SomeKindedTypeRep RuntimeRep
runtimeRepTypeRep r =
case r of
- LiftedRep -> rep @'LiftedRep
- UnliftedRep -> rep @'UnliftedRep
+ BoxedRep Lifted -> SomeKindedTypeRep trLiftedRep
+ BoxedRep v -> kindedTypeRep @_ @'BoxedRep
+ `kApp` levityTypeRep v
VecRep c e -> kindedTypeRep @_ @'VecRep
`kApp` vecCountTypeRep c
`kApp` vecElemTypeRep e
@@ -688,6 +698,15 @@ runtimeRepTypeRep r =
rep :: forall (a :: RuntimeRep). Typeable a => SomeKindedTypeRep RuntimeRep
rep = kindedTypeRep @RuntimeRep @a
+levityTypeRep :: Levity -> SomeKindedTypeRep Levity
+levityTypeRep c =
+ case c of
+ Lifted -> rep @'Lifted
+ Unlifted -> rep @'Unlifted
+ where
+ rep :: forall (a :: Levity). Typeable a => SomeKindedTypeRep Levity
+ rep = kindedTypeRep @Levity @a
+
vecCountTypeRep :: VecCount -> SomeKindedTypeRep VecCount
vecCountTypeRep c =
case c of
@@ -840,13 +859,40 @@ splitApps = go []
-- produce a TypeRep for without difficulty), and then just substitute in the
-- appropriate module and constructor names.
--
+-- Prior to the introduction of BoxedRep, this was bad, but now it is
+-- even worse! We have to construct several different TyCons by hand
+-- so that we can build the fingerprint for TYPE ('BoxedRep 'LiftedRep).
+-- If we call `typeRep @('BoxedRep 'LiftedRep)` while trying to compute
+-- the fingerprint of `TYPE ('BoxedRep 'LiftedRep)`, we get a loop.
+--
-- The ticket to find a better way to deal with this is
-- #14480.
+
+tyConRuntimeRep :: TyCon
+tyConRuntimeRep = mkTyCon ghcPrimPackage "GHC.Types" "RuntimeRep" 0
+ (KindRepTYPE (BoxedRep Lifted))
+
tyConTYPE :: TyCon
-tyConTYPE = mkTyCon (tyConPackage liftedRepTyCon) "GHC.Prim" "TYPE" 0
- (KindRepFun (KindRepTyConApp liftedRepTyCon []) (KindRepTYPE LiftedRep))
- where
- liftedRepTyCon = typeRepTyCon (typeRep @RuntimeRep)
+tyConTYPE = mkTyCon ghcPrimPackage "GHC.Prim" "TYPE" 0
+ (KindRepFun
+ (KindRepTyConApp tyConRuntimeRep [])
+ (KindRepTYPE (BoxedRep Lifted))
+ )
+
+tyConLevity :: TyCon
+tyConLevity = mkTyCon ghcPrimPackage "GHC.Types" "Levity" 0
+ (KindRepTYPE (BoxedRep Lifted))
+
+tyCon'Lifted :: TyCon
+tyCon'Lifted = mkTyCon ghcPrimPackage "GHC.Types" "'Lifted" 0
+ (KindRepTyConApp tyConLevity [])
+
+tyCon'BoxedRep :: TyCon
+tyCon'BoxedRep = mkTyCon ghcPrimPackage "GHC.Types" "'BoxedRep" 0
+ (KindRepFun (KindRepTyConApp tyConLevity []) (KindRepTyConApp tyConRuntimeRep []))
+
+ghcPrimPackage :: String
+ghcPrimPackage = tyConPackage (typeRepTyCon (typeRep @Bool))
funTyCon :: TyCon
funTyCon = typeRepTyCon (typeRep @(->))
diff --git a/libraries/base/GHC/Enum.hs b/libraries/base/GHC/Enum.hs
index 54d6c6b34aa4..7bf00f490dd5 100644
--- a/libraries/base/GHC/Enum.hs
+++ b/libraries/base/GHC/Enum.hs
@@ -1005,6 +1005,11 @@ enumNegDeltaToNatural x0 ndelta lim = go x0
-- Instances from GHC.Types
+-- | @since 4.15.0.0
+deriving instance Bounded Levity
+-- | @since 4.15.0.0
+deriving instance Enum Levity
+
-- | @since 4.10.0.0
deriving instance Bounded VecCount
-- | @since 4.10.0.0
diff --git a/libraries/base/GHC/Exts.hs b/libraries/base/GHC/Exts.hs
index 31788c24c0c9..087427e84a3d 100755
--- a/libraries/base/GHC/Exts.hs
+++ b/libraries/base/GHC/Exts.hs
@@ -91,7 +91,8 @@ module GHC.Exts
type (~~),
-- * Representation polymorphism
- GHC.Prim.TYPE, RuntimeRep(..), VecCount(..), VecElem(..),
+ GHC.Prim.TYPE, RuntimeRep(..), LiftedRep, Levity(..),
+ VecCount(..), VecElem(..),
-- * Transform comprehensions
Down(..), groupWith, sortWith, the,
diff --git a/libraries/base/GHC/Show.hs b/libraries/base/GHC/Show.hs
index 3de7aca723e1..bf8ced53120e 100644
--- a/libraries/base/GHC/Show.hs
+++ b/libraries/base/GHC/Show.hs
@@ -594,6 +594,9 @@ instance Show KindRep where
. showString " "
. showsPrec 11 q
+-- | @since 4.15.0.0
+deriving instance Show Levity
+
-- | @since 4.11.0.0
deriving instance Show RuntimeRep
diff --git a/libraries/base/Unsafe/Coerce.hs b/libraries/base/Unsafe/Coerce.hs
index 679259225419..ae8c64145af9 100644
--- a/libraries/base/Unsafe/Coerce.hs
+++ b/libraries/base/Unsafe/Coerce.hs
@@ -285,7 +285,7 @@ unsafeEqualityProof = case unsafeEqualityProof @a @b of UnsafeRefl -> UnsafeRefl
unsafeCoerce :: forall (a :: Type) (b :: Type) . a -> b
unsafeCoerce x = case unsafeEqualityProof @a @b of UnsafeRefl -> x
-unsafeCoerceUnlifted :: forall (a :: TYPE 'UnliftedRep) (b :: TYPE 'UnliftedRep) . a -> b
+unsafeCoerceUnlifted :: forall (a :: TYPE ('BoxedRep 'Unlifted)) (b :: TYPE ('BoxedRep 'Unlifted)) . a -> b
-- Kind-homogeneous, but levity monomorphic (TYPE UnliftedRep)
unsafeCoerceUnlifted x = case unsafeEqualityProof @a @b of UnsafeRefl -> x
diff --git a/libraries/base/tests/T11334a.hs b/libraries/base/tests/T11334a.hs
index 0cf91eaa2a60..ad296967a7c0 100644
--- a/libraries/base/tests/T11334a.hs
+++ b/libraries/base/tests/T11334a.hs
@@ -7,5 +7,5 @@ import GHC.Types
main :: IO ()
main = do
print (typeOf (Proxy :: Proxy 'Just))
- print (typeOf (Proxy :: Proxy (TYPE 'LiftedRep)))
- print (typeOf (Proxy :: Proxy (TYPE 'UnliftedRep)))
+ print (typeOf (Proxy :: Proxy (TYPE ('BoxedRep 'Lifted))))
+ print (typeOf (Proxy :: Proxy (TYPE ('BoxedRep 'Unlifted))))
diff --git a/libraries/base/tests/T11334a.stdout b/libraries/base/tests/T11334a.stdout
index c2d860d653ac..b46a92d36641 100644
--- a/libraries/base/tests/T11334a.stdout
+++ b/libraries/base/tests/T11334a.stdout
@@ -1,3 +1,3 @@
Proxy (* -> Maybe *) ('Just *)
Proxy * *
-Proxy * (TYPE 'UnliftedRep)
+Proxy * (TYPE ('BoxedRep 'Unlifted))
diff --git a/libraries/binary b/libraries/binary
index b224410161f1..f22b3d34bb46 160000
--- a/libraries/binary
+++ b/libraries/binary
@@ -1 +1 @@
-Subproject commit b224410161f112dd1133a787ded9831799589ce7
+Subproject commit f22b3d34bb46f95ec5a23d1ef894e2a05818a781
diff --git a/libraries/ghc-heap/GHC/Exts/Heap.hs b/libraries/ghc-heap/GHC/Exts/Heap.hs
index 2dfe78840630..70ee2f0ecf54 100644
--- a/libraries/ghc-heap/GHC/Exts/Heap.hs
+++ b/libraries/ghc-heap/GHC/Exts/Heap.hs
@@ -90,10 +90,18 @@ class HasHeapRep (a :: TYPE rep) where
-> IO Closure
-- ^ Heap representation of the closure.
+#if __GLASGOW_HASKELL__ >= 901
+instance HasHeapRep (a :: TYPE ('BoxedRep 'Lifted)) where
+#else
instance HasHeapRep (a :: TYPE 'LiftedRep) where
+#endif
getClosureData = getClosureDataFromHeapObject
+#if __GLASGOW_HASKELL__ >= 901
+instance HasHeapRep (a :: TYPE ('BoxedRep 'Unlifted)) where
+#else
instance HasHeapRep (a :: TYPE 'UnliftedRep) where
+#endif
getClosureData x = getClosureDataFromHeapObject (unsafeCoerce# x)
instance Int# ~ a => HasHeapRep (a :: TYPE 'IntRep) where
diff --git a/libraries/ghc-heap/tests/ClosureSizeUtils.hs b/libraries/ghc-heap/tests/ClosureSizeUtils.hs
index 5fafa4f7a582..3b1578451a56 100644
--- a/libraries/ghc-heap/tests/ClosureSizeUtils.hs
+++ b/libraries/ghc-heap/tests/ClosureSizeUtils.hs
@@ -30,7 +30,7 @@ assertSize x =
assertSizeBox (asBox x) (typeRep @a)
assertSizeUnlifted
- :: forall (a :: TYPE 'UnliftedRep). (HasCallStack, Typeable a)
+ :: forall (a :: TYPE ('BoxedRep 'Unlifted)). (HasCallStack, Typeable a)
=> a -- ^ closure
-> Int -- ^ expected size in words
-> IO ()
diff --git a/libraries/ghc-prim/GHC/Types.hs b/libraries/ghc-prim/GHC/Types.hs
index dc81a9b8d3ad..2f9130425a3d 100644
--- a/libraries/ghc-prim/GHC/Types.hs
+++ b/libraries/ghc-prim/GHC/Types.hs
@@ -33,7 +33,7 @@ module GHC.Types (
Symbol,
Any,
type (~~), Coercible,
- TYPE, RuntimeRep(..), Type, Constraint,
+ TYPE, Levity(..), RuntimeRep(..), LiftedRep, Type, Constraint,
-- The historical type * should ideally be written as
-- `type *`, without the parentheses. But that's a true
-- pain to parse, and for little gain.
@@ -85,8 +85,11 @@ type (->) = FUN 'Many
-- | The kind of constraints, like @Show a@
data Constraint
+-- | The runtime representation of lifted types.
+type LiftedRep = 'BoxedRep 'Lifted
+
-- | The kind of types with lifted values. For example @Int :: Type@.
-type Type = TYPE 'LiftedRep
+type Type = TYPE LiftedRep
data Multiplicity = Many | One
@@ -410,6 +413,8 @@ data SPEC = SPEC | SPEC2
* *
********************************************************************* -}
+-- | Whether a boxed type is lifted or unlifted.
+data Levity = Lifted | Unlifted
-- | GHC maintains a property that the kind of all inhabited types
-- (as distinct from type constructors or type-level data) tells us
@@ -425,8 +430,7 @@ data SPEC = SPEC | SPEC2
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
| Int8Rep -- ^ signed, 8-bit value
| Int16Rep -- ^ signed, 16-bit value
@@ -444,6 +448,7 @@ data RuntimeRep = VecRep VecCount VecElem -- ^ a SIMD vector type
-- RuntimeRep is intimately tied to TyCon.RuntimeRep (in GHC proper). See
-- Note [RuntimeRep and PrimRep] in RepType.
-- See also Note [Wiring in RuntimeRep] in GHC.Builtin.Types
+-- See also Note [TYPE and RuntimeRep] in GHC.Builtin.Type.Prim
-- | Length of a SIMD vector type
data VecCount = Vec2
diff --git a/libraries/template-haskell/Language/Haskell/TH/Syntax.hs b/libraries/template-haskell/Language/Haskell/TH/Syntax.hs
index a3104ed684da..c7d5c81c685a 100644
--- a/libraries/template-haskell/Language/Haskell/TH/Syntax.hs
+++ b/libraries/template-haskell/Language/Haskell/TH/Syntax.hs
@@ -61,6 +61,10 @@ import Foreign.ForeignPtr
import Foreign.C.String
import Foreign.C.Types
+#if __GLASGOW_HASKELL__ >= 901
+import GHC.Types ( Levity(..) )
+#endif
+
-----------------------------------------------------
--
-- The Quasi class
@@ -816,7 +820,11 @@ class Lift (t :: TYPE r) where
-- | Turn a value into a Template Haskell expression, suitable for use in
-- a splice.
lift :: Quote m => t -> m Exp
+#if __GLASGOW_HASKELL__ >= 901
+ default lift :: (r ~ ('BoxedRep 'Lifted), Quote m) => t -> m Exp
+#else
default lift :: (r ~ 'LiftedRep, Quote m) => t -> m Exp
+#endif
lift = unTypeCode . liftTyped
-- | Turn a value into a Template Haskell typed expression, suitable for use
diff --git a/testsuite/tests/backpack/should_run/T13955.bkp b/testsuite/tests/backpack/should_run/T13955.bkp
index a7d447f1696d..eadeee6f5c0b 100644
--- a/testsuite/tests/backpack/should_run/T13955.bkp
+++ b/testsuite/tests/backpack/should_run/T13955.bkp
@@ -18,7 +18,7 @@ unit number-unknown where
unit number-int where
module NumberUnknown where
import GHC.Types
- type Rep = LiftedRep
+ type Rep = 'BoxedRep 'Lifted
type Number = Int
plus :: Int -> Int -> Int
plus = (+)
diff --git a/testsuite/tests/dependent/should_compile/RaeJobTalk.hs b/testsuite/tests/dependent/should_compile/RaeJobTalk.hs
index 6c74e10a7c3d..90a72c2a9af1 100644
--- a/testsuite/tests/dependent/should_compile/RaeJobTalk.hs
+++ b/testsuite/tests/dependent/should_compile/RaeJobTalk.hs
@@ -14,12 +14,14 @@ import Data.Type.Bool
import Data.Type.Equality hiding ((:~~:)(..))
import GHC.TypeLits
import Data.Proxy
-import GHC.Exts
+import GHC.Exts hiding (Lifted, BoxedRep)
import Data.Kind
import Unsafe.Coerce
import Data.Char
import Data.Maybe
+import qualified GHC.Exts as Exts
+
-------------------------------
-- Utilities
@@ -82,7 +84,9 @@ data TyCon (a :: k) where
Arrow :: TyCon (->)
TYPE :: TyCon TYPE
RuntimeRep :: TyCon RuntimeRep
- LiftedRep' :: TyCon 'LiftedRep
+ Levity :: TyCon Levity
+ BoxedRep :: TyCon 'Exts.BoxedRep
+ Lifted :: TyCon 'Exts.Lifted
-- If extending, add to eqTyCon too
eqTyCon :: TyCon a -> TyCon b -> Maybe (a :~~: b)
@@ -94,7 +98,9 @@ eqTyCon Maybe Maybe = Just HRefl
eqTyCon Arrow Arrow = Just HRefl
eqTyCon TYPE TYPE = Just HRefl
eqTyCon RuntimeRep RuntimeRep = Just HRefl
-eqTyCon LiftedRep' LiftedRep' = Just HRefl
+eqTyCon Levity Levity = Just HRefl
+eqTyCon BoxedRep BoxedRep = Just HRefl
+eqTyCon Lifted Lifted = Just HRefl
eqTyCon _ _ = Nothing
-- Check whether or not a type is really a plain old tycon;
@@ -212,8 +218,10 @@ instance TyConAble [] where tyCon = List
instance TyConAble Maybe where tyCon = Maybe
instance TyConAble (->) where tyCon = Arrow
instance TyConAble TYPE where tyCon = TYPE
-instance TyConAble 'LiftedRep where tyCon = LiftedRep'
-instance TyConAble RuntimeRep where tyCon = RuntimeRep
+instance TyConAble 'Exts.Lifted where tyCon = Lifted
+instance TyConAble 'Exts.BoxedRep where tyCon = BoxedRep
+instance TyConAble RuntimeRep where tyCon = RuntimeRep
+instance TyConAble Levity where tyCon = Levity
-- Can't just define Typeable the way we want, because the instances
-- overlap. So we have to mock up instance chains via closed type families.
diff --git a/testsuite/tests/dependent/should_fail/T17131.stderr b/testsuite/tests/dependent/should_fail/T17131.stderr
index daad6ac05483..b2af8ab7b85d 100644
--- a/testsuite/tests/dependent/should_fail/T17131.stderr
+++ b/testsuite/tests/dependent/should_fail/T17131.stderr
@@ -1,9 +1,9 @@
T17131.hs:12:34: error:
• Couldn't match kind: TypeReps xs
- with: '[ 'LiftedRep]
+ with: '[ 'BoxedRep 'Lifted]
Expected kind ‘TYPE ('TupleRep (TypeReps xs))’,
- but ‘(# a #)’ has kind ‘TYPE ('TupleRep '[ 'LiftedRep])’
+ but ‘(# a #)’ has kind ‘TYPE ('TupleRep '[ 'BoxedRep 'Lifted])’
The type variable ‘xs’ is ambiguous
• In the type ‘(# a #)’
In the type family declaration for ‘Tuple#’
diff --git a/testsuite/tests/deriving/should_compile/T13154b.hs b/testsuite/tests/deriving/should_compile/T13154b.hs
index 9df828b11172..585f010eba77 100644
--- a/testsuite/tests/deriving/should_compile/T13154b.hs
+++ b/testsuite/tests/deriving/should_compile/T13154b.hs
@@ -24,10 +24,10 @@ deriving instance Foo1 a
class Foo2 (a :: TYPE ('TupleRep '[]))
deriving instance Foo2 (##)
-class Foo3 (a :: TYPE ('SumRep '[ 'LiftedRep, 'LiftedRep ]))
+class Foo3 (a :: TYPE ('SumRep '[ 'BoxedRep 'Lifted, 'BoxedRep 'Lifted ]))
deriving instance Foo3 a
-class Foo4 (a :: TYPE ('SumRep '[ 'LiftedRep, 'LiftedRep ]))
+class Foo4 (a :: TYPE ('SumRep '[ 'BoxedRep 'Lifted, 'BoxedRep 'Lifted ]))
deriving instance Foo4 (# a | b #)
class Foo5 (a :: Type)
diff --git a/testsuite/tests/deriving/should_fail/T12512.hs b/testsuite/tests/deriving/should_fail/T12512.hs
index 804bfd31daef..61410d84cf54 100644
--- a/testsuite/tests/deriving/should_fail/T12512.hs
+++ b/testsuite/tests/deriving/should_fail/T12512.hs
@@ -6,8 +6,8 @@ module T12512 where
import GHC.Exts
-class Wat1 (a :: TYPE ('TupleRep ['LiftedRep, 'LiftedRep]))
+class Wat1 (a :: TYPE ('TupleRep ['BoxedRep 'Lifted, 'BoxedRep 'Lifted]))
deriving instance Wat1 (# a, b #)
-class Wat2 (a :: TYPE ('SumRep ['LiftedRep, 'LiftedRep]))
+class Wat2 (a :: TYPE ('SumRep ['BoxedRep 'Lifted, 'BoxedRep 'Lifted]))
deriving instance Wat2 (# a | b #)
diff --git a/testsuite/tests/ffi/should_run/T16650a.hs b/testsuite/tests/ffi/should_run/T16650a.hs
index 6a43a55118cd..65fc38b57daf 100644
--- a/testsuite/tests/ffi/should_run/T16650a.hs
+++ b/testsuite/tests/ffi/should_run/T16650a.hs
@@ -27,7 +27,7 @@ foreign import ccall unsafe "head_bytearray"
c_head_bytearray :: MutableByteArray# RealWorld -> IO Word8
data Box :: Type where
- Box :: (Any :: TYPE 'UnliftedRep) -> Box
+ Box :: (Any :: TYPE ('BoxedRep 'Unlifted)) -> Box
data MutableByteArray :: Type where
MutableByteArray :: MutableByteArray# RealWorld -> MutableByteArray
diff --git a/testsuite/tests/ffi/should_run/T16650b.hs b/testsuite/tests/ffi/should_run/T16650b.hs
index ba0d4a72a08a..265e5bf65fda 100644
--- a/testsuite/tests/ffi/should_run/T16650b.hs
+++ b/testsuite/tests/ffi/should_run/T16650b.hs
@@ -31,7 +31,7 @@ foreign import ccall unsafe "is_doubleton_homogenous"
c_is_doubleton_homogeneous :: MutableArrayArray# RealWorld -> IO Word8
data Box :: Type where
- Box :: (Any :: TYPE 'UnliftedRep) -> Box
+ Box :: (Any :: TYPE ('BoxedRep 'Unlifted)) -> Box
-- An array of bytes
data MutableByteArray :: Type where
diff --git a/testsuite/tests/ffi/should_run/T16650c.hs b/testsuite/tests/ffi/should_run/T16650c.hs
index 968731b3bda1..0d8e9ac8ec33 100644
--- a/testsuite/tests/ffi/should_run/T16650c.hs
+++ b/testsuite/tests/ffi/should_run/T16650c.hs
@@ -26,7 +26,7 @@ foreign import ccall unsafe "is_doubleton_homogenous"
MutableArray# RealWorld a -> IO Word8
data Box :: Type where
- Box :: (Any :: TYPE 'UnliftedRep) -> Box
+ Box :: (Any :: TYPE ('BoxedRep 'Unlifted)) -> Box
-- An array of unary integer functions
data MutableArray :: Type where
diff --git a/testsuite/tests/ffi/should_run/T16650d.hs b/testsuite/tests/ffi/should_run/T16650d.hs
index 8bb4a4697bb8..874701b40af1 100644
--- a/testsuite/tests/ffi/should_run/T16650d.hs
+++ b/testsuite/tests/ffi/should_run/T16650d.hs
@@ -26,7 +26,7 @@ foreign import ccall unsafe "is_doubleton_homogenous"
SmallMutableArray# RealWorld a -> IO Word8
data Box :: Type where
- Box :: (Any :: TYPE 'UnliftedRep) -> Box
+ Box :: (Any :: TYPE ('BoxedRep 'Unlifted)) -> Box
-- An array of unary integer functions
data SmallMutableArray :: Type where
diff --git a/testsuite/tests/ffi/should_run/UnliftedNewtypesByteArrayOffset.hs b/testsuite/tests/ffi/should_run/UnliftedNewtypesByteArrayOffset.hs
index 8953e9b02db1..7a0a5cce197b 100644
--- a/testsuite/tests/ffi/should_run/UnliftedNewtypesByteArrayOffset.hs
+++ b/testsuite/tests/ffi/should_run/UnliftedNewtypesByteArrayOffset.hs
@@ -19,7 +19,7 @@ foreign import ccall unsafe "head_bytearray"
foreign import ccall unsafe "head_bytearray"
c_head_bytearray_b :: MyArray# -> IO Word8
-newtype MyArray# :: TYPE 'UnliftedRep where
+newtype MyArray# :: TYPE ('BoxedRep 'Unlifted) where
MyArray# :: MutableByteArray# RealWorld -> MyArray#
data MutableByteArray :: Type where
diff --git a/testsuite/tests/ghci/scripts/T13963.script b/testsuite/tests/ghci/scripts/T13963.script
index c5e830aad1c7..030e8087a93c 100644
--- a/testsuite/tests/ghci/scripts/T13963.script
+++ b/testsuite/tests/ghci/scripts/T13963.script
@@ -1,5 +1,5 @@
:set -XPolyKinds -XDataKinds -XRankNTypes
-import GHC.Exts (TYPE, RuntimeRep(LiftedRep))
+import GHC.Exts (TYPE, RuntimeRep, LiftedRep)
type Pair (a :: TYPE rep) (b :: TYPE rep') rep'' = forall (r :: TYPE rep''). (a -> b -> r)
:kind Pair
:kind Pair Int
diff --git a/testsuite/tests/ghci/scripts/T15941.stdout b/testsuite/tests/ghci/scripts/T15941.stdout
index f9e6d339f9d9..803aa9ebd073 100644
--- a/testsuite/tests/ghci/scripts/T15941.stdout
+++ b/testsuite/tests/ghci/scripts/T15941.stdout
@@ -1,4 +1,4 @@
type T :: * -> * -> *
type T =
- (->) @{'GHC.Types.LiftedRep} @{'GHC.Types.LiftedRep} :: * -> * -> *
+ (->) @{GHC.Types.LiftedRep} @{GHC.Types.LiftedRep} :: * -> * -> *
-- Defined at <interactive>:2:1
diff --git a/testsuite/tests/ghci/scripts/T7627.stdout b/testsuite/tests/ghci/scripts/T7627.stdout
index b86ea432ff38..8967544004c7 100644
--- a/testsuite/tests/ghci/scripts/T7627.stdout
+++ b/testsuite/tests/ghci/scripts/T7627.stdout
@@ -38,7 +38,8 @@ type (#,#) :: *
-> *
-> TYPE
('GHC.Types.TupleRep
- '[ 'GHC.Types.LiftedRep, 'GHC.Types.LiftedRep])
+ '[ 'GHC.Types.BoxedRep 'GHC.Types.Lifted,
+ 'GHC.Types.BoxedRep 'GHC.Types.Lifted])
data (#,#) a b = (#,#) a b
-- Defined in ‘GHC.Prim’
(,) :: a -> b -> (a, b)
diff --git a/testsuite/tests/ghci/should_run/T16096.stdout b/testsuite/tests/ghci/should_run/T16096.stdout
index 5826057d4224..2749f06586bb 100644
--- a/testsuite/tests/ghci/should_run/T16096.stdout
+++ b/testsuite/tests/ghci/should_run/T16096.stdout
@@ -17,7 +17,7 @@ GHC.Base.returnIO
(GHC.Types.:
@()
(Unsafe.Coerce.unsafeCoerce#
- @'GHC.Types.LiftedRep @'GHC.Types.LiftedRep @[GHC.Types.Int] @() x)
+ @GHC.Types.LiftedRep @GHC.Types.LiftedRep @[GHC.Types.Int] @() x)
(GHC.Types.[] @()))
@@ -40,7 +40,7 @@ GHC.Base.returnIO
(GHC.Types.:
@()
(Unsafe.Coerce.unsafeCoerce#
- @'GHC.Types.LiftedRep @'GHC.Types.LiftedRep @[GHC.Types.Int] @() x)
+ @GHC.Types.LiftedRep @GHC.Types.LiftedRep @[GHC.Types.Int] @() x)
(GHC.Types.[] @()))
diff --git a/testsuite/tests/ghci/should_run/T18594.stdout b/testsuite/tests/ghci/should_run/T18594.stdout
index 9e2e79cd8be2..d3219de45e38 100644
--- a/testsuite/tests/ghci/should_run/T18594.stdout
+++ b/testsuite/tests/ghci/should_run/T18594.stdout
@@ -8,8 +8,8 @@ instance Monad ((->) r) -- Defined in ‘GHC.Base’
instance Monoid b => Monoid (a -> b) -- Defined in ‘GHC.Base’
instance Semigroup b => Semigroup (a -> b) -- Defined in ‘GHC.Base’
type Type :: *
-type Type = TYPE 'LiftedRep
+type Type = TYPE LiftedRep
-- Defined in ‘GHC.Types’
type Type :: Type
-type Type = TYPE 'LiftedRep
+type Type = TYPE LiftedRep
-- Defined in ‘GHC.Types’
diff --git a/testsuite/tests/plugins/plugins09.stdout b/testsuite/tests/plugins/plugins09.stdout
index 61f96283ff34..776f34b5f3fa 100644
--- a/testsuite/tests/plugins/plugins09.stdout
+++ b/testsuite/tests/plugins/plugins09.stdout
@@ -3,5 +3,6 @@ interfacePlugin: Prelude
interfacePlugin: GHC.Float
interfacePlugin: GHC.Base
typeCheckPlugin (rn)
+interfacePlugin: GHC.Prim
typeCheckPlugin (tc)
interfacePlugin: GHC.Num.BigNat
diff --git a/testsuite/tests/plugins/plugins10.stdout b/testsuite/tests/plugins/plugins10.stdout
index 37f424b07696..47e7d29b935b 100644
--- a/testsuite/tests/plugins/plugins10.stdout
+++ b/testsuite/tests/plugins/plugins10.stdout
@@ -6,6 +6,7 @@ interfacePlugin: GHC.Float
interfacePlugin: GHC.Base
interfacePlugin: Language.Haskell.TH.Syntax
typeCheckPlugin (rn)
+interfacePlugin: GHC.Prim
typeCheckPlugin (tc)
interfacePlugin: GHC.Num.BigNat
parsePlugin(a)
diff --git a/testsuite/tests/plugins/plugins11.stdout b/testsuite/tests/plugins/plugins11.stdout
index 6bab3559b192..b3e835f2bfbd 100644
--- a/testsuite/tests/plugins/plugins11.stdout
+++ b/testsuite/tests/plugins/plugins11.stdout
@@ -3,5 +3,6 @@ interfacePlugin: Prelude
interfacePlugin: GHC.Float
interfacePlugin: GHC.Base
typeCheckPlugin (rn)
+interfacePlugin: GHC.Prim
typeCheckPlugin (tc)
interfacePlugin: GHC.Num.BigNat
diff --git a/testsuite/tests/plugins/static-plugins.stdout b/testsuite/tests/plugins/static-plugins.stdout
index 032992824f1d..65af518b7ff0 100644
--- a/testsuite/tests/plugins/static-plugins.stdout
+++ b/testsuite/tests/plugins/static-plugins.stdout
@@ -5,11 +5,11 @@ interfacePlugin: GHC.Float
interfacePlugin: GHC.Base
interfacePlugin: System.IO
typeCheckPlugin (rn)
+interfacePlugin: GHC.Prim
interfacePlugin: GHC.Types
interfacePlugin: GHC.Show
interfacePlugin: GHC.TopHandler
typeCheckPlugin (tc)
-interfacePlugin: GHC.Prim
interfacePlugin: GHC.CString
interfacePlugin: GHC.Num.BigNat
==pure.1
diff --git a/testsuite/tests/pmcheck/should_compile/T18249.hs b/testsuite/tests/pmcheck/should_compile/T18249.hs
index b9bd048cbda2..2a343b08e125 100644
--- a/testsuite/tests/pmcheck/should_compile/T18249.hs
+++ b/testsuite/tests/pmcheck/should_compile/T18249.hs
@@ -14,7 +14,7 @@ f :: Int# -> Int
f !_ | False = 1
f _ = 2
-newtype UVoid :: TYPE 'UnliftedRep where
+newtype UVoid :: TYPE ('BoxedRep 'Unlifted) where
UVoid :: UVoid -> UVoid
g :: UVoid -> Int
diff --git a/testsuite/tests/polykinds/T14555.stderr b/testsuite/tests/polykinds/T14555.stderr
index 38618721240a..f85c1b44cc59 100644
--- a/testsuite/tests/polykinds/T14555.stderr
+++ b/testsuite/tests/polykinds/T14555.stderr
@@ -1,6 +1,6 @@
T14555.hs:12:34: error:
- • Couldn't match kind ‘rep’ with ‘'GHC.Types.LiftedRep’
+ • Couldn't match kind ‘rep’ with ‘GHC.Types.LiftedRep’
Expected kind ‘TYPE rep’, but ‘a -> b’ has kind ‘*’
• In the second argument of ‘Exp’, namely ‘(a -> b)’
In the type ‘Exp xs (a -> b)’
diff --git a/testsuite/tests/polykinds/T14563.stderr b/testsuite/tests/polykinds/T14563.stderr
index 2d8150765911..e2dd07a6d692 100644
--- a/testsuite/tests/polykinds/T14563.stderr
+++ b/testsuite/tests/polykinds/T14563.stderr
@@ -1,6 +1,6 @@
T14563.hs:9:39: error:
- • Couldn't match kind ‘rep''’ with ‘'GHC.Types.LiftedRep’
+ • Couldn't match kind ‘rep''’ with ‘GHC.Types.LiftedRep’
Expected kind ‘TYPE rep -> TYPE rep''’,
but ‘h’ has kind ‘TYPE rep -> *’
• In the second argument of ‘Lan’, namely ‘h’
diff --git a/testsuite/tests/polykinds/T17963.stderr b/testsuite/tests/polykinds/T17963.stderr
index e38d216fafc6..aa0e4d0d3eba 100644
--- a/testsuite/tests/polykinds/T17963.stderr
+++ b/testsuite/tests/polykinds/T17963.stderr
@@ -1,6 +1,6 @@
T17963.hs:15:23: error:
- • Couldn't match kind ‘rep’ with ‘'LiftedRep’
+ • Couldn't match kind ‘rep’ with ‘GHC.Types.LiftedRep’
When matching kinds
k0 :: *
ob :: TYPE rep
diff --git a/testsuite/tests/polykinds/T18300.stderr b/testsuite/tests/polykinds/T18300.stderr
index 53ea72b1b821..3ddd175d551c 100644
--- a/testsuite/tests/polykinds/T18300.stderr
+++ b/testsuite/tests/polykinds/T18300.stderr
@@ -1,4 +1,2 @@
-T18300.hs:13:1: error:
- • Data instance has non-* return kind ‘TYPE (F Int)’
- • In the data instance declaration for ‘T’
+T18300.hs:9:23: error: Not in scope: data constructor ‘LiftedRep’
diff --git a/testsuite/tests/simplCore/should_compile/T18013.stderr b/testsuite/tests/simplCore/should_compile/T18013.stderr
index 20cb606cb498..1f9a70946a84 100644
--- a/testsuite/tests/simplCore/should_compile/T18013.stderr
+++ b/testsuite/tests/simplCore/should_compile/T18013.stderr
@@ -129,9 +129,9 @@ Rule fired: Class op fmap (BUILTIN)
==================== Tidy Core ====================
Result size of Tidy Core
- = {terms: 52, types: 101, coercions: 17, joins: 0/1}
+ = {terms: 52, types: 102, coercions: 17, joins: 0/1}
--- RHS size: {terms: 37, types: 84, coercions: 17, joins: 0/1}
+-- RHS size: {terms: 37, types: 85, coercions: 17, joins: 0/1}
mapMaybeRule
:: forall a b. Rule IO a b -> Rule IO (Maybe a) (Maybe b)
[GblId,
diff --git a/testsuite/tests/simplCore/should_compile/T9400.stderr b/testsuite/tests/simplCore/should_compile/T9400.stderr
index 9e3f4184eaaa..3b53d2cb0234 100644
--- a/testsuite/tests/simplCore/should_compile/T9400.stderr
+++ b/testsuite/tests/simplCore/should_compile/T9400.stderr
@@ -65,7 +65,7 @@ main
@()
(putStrLn (unpackCString# "efg"#))
(Control.Exception.Base.patError
- @'LiftedRep @(IO ()) "T9400.hs:(17,5)-(18,29)|case"#))))
+ @LiftedRep @(IO ()) "T9400.hs:(17,5)-(18,29)|case"#))))
diff --git a/testsuite/tests/simplCore/should_compile/spec-inline.stderr b/testsuite/tests/simplCore/should_compile/spec-inline.stderr
index 87e8bd798020..a26d2ed3bc09 100644
--- a/testsuite/tests/simplCore/should_compile/spec-inline.stderr
+++ b/testsuite/tests/simplCore/should_compile/spec-inline.stderr
@@ -48,7 +48,7 @@ lvl = "spec-inline.hs:(19,5)-(29,25)|function go"#
Roman.foo3 :: Int
[GblId, Str=b, Cpr=b]
Roman.foo3
- = Control.Exception.Base.patError @'GHC.Types.LiftedRep @Int lvl
+ = Control.Exception.Base.patError @GHC.Types.LiftedRep @Int lvl
Rec {
-- RHS size: {terms: 40, types: 5, coercions: 0, joins: 0/0}
diff --git a/testsuite/tests/th/T14869.hs b/testsuite/tests/th/T14869.hs
index 4b0dcdc171f0..5bd2a0806ad1 100644
--- a/testsuite/tests/th/T14869.hs
+++ b/testsuite/tests/th/T14869.hs
@@ -9,7 +9,7 @@ import GHC.Exts
import Language.Haskell.TH (pprint, reify, stringE)
type MyConstraint = Constraint
-type MyLiftedRep = LiftedRep
+type MyLiftedRep = BoxedRep Lifted
type family Foo1 :: Type
type family Foo2 :: Constraint
diff --git a/testsuite/tests/typecheck/should_compile/LevPolyResult.hs b/testsuite/tests/typecheck/should_compile/LevPolyResult.hs
new file mode 100644
index 000000000000..6c17d5c9aea5
--- /dev/null
+++ b/testsuite/tests/typecheck/should_compile/LevPolyResult.hs
@@ -0,0 +1,11 @@
+{-# language DataKinds #-}
+{-# language KindSignatures #-}
+{-# language PolyKinds #-}
+{-# language RankNTypes #-}
+
+module LevPolyResult (example) where
+
+import GHC.Exts
+
+example :: forall (v :: Levity) (a :: TYPE ('BoxedRep v)). (Int -> a) -> a
+example f = f 42
diff --git a/testsuite/tests/typecheck/should_compile/UnliftedNewtypesUnassociatedFamily.hs b/testsuite/tests/typecheck/should_compile/UnliftedNewtypesUnassociatedFamily.hs
index 0a8143b0b6e1..dd7890d33c03 100644
--- a/testsuite/tests/typecheck/should_compile/UnliftedNewtypesUnassociatedFamily.hs
+++ b/testsuite/tests/typecheck/should_compile/UnliftedNewtypesUnassociatedFamily.hs
@@ -12,14 +12,15 @@ module UnliftedNewtypesUnassociatedFamily where
import GHC.Int (Int(I#))
import GHC.Word (Word(W#))
import GHC.Exts (Int#,Word#)
-import GHC.Exts (TYPE,RuntimeRep(LiftedRep,IntRep,WordRep,TupleRep))
+import GHC.Exts (TYPE,Levity(Lifted))
+import GHC.Exts (RuntimeRep(BoxedRep,IntRep,WordRep,TupleRep))
data family DFT (r :: RuntimeRep) :: TYPE r
newtype instance DFT 'IntRep = MkDFT1 Int#
newtype instance DFT 'WordRep = MkDFT2 Word#
newtype instance DFT ('TupleRep '[ 'IntRep, 'WordRep])
= MkDFT3 (# Int#, Word# #)
-data instance DFT 'LiftedRep = MkDFT4 | MkDFT5
+data instance DFT ('BoxedRep 'Lifted) = MkDFT4 | MkDFT5
data family DF :: TYPE (r :: RuntimeRep)
diff --git a/testsuite/tests/typecheck/should_compile/abstract_refinement_hole_fits.stderr b/testsuite/tests/typecheck/should_compile/abstract_refinement_hole_fits.stderr
index 57214ba1818e..61ed517535a9 100644
--- a/testsuite/tests/typecheck/should_compile/abstract_refinement_hole_fits.stderr
+++ b/testsuite/tests/typecheck/should_compile/abstract_refinement_hole_fits.stderr
@@ -33,20 +33,20 @@ abstract_refinement_hole_fits.hs:4:5: warning: [-Wtyped-holes (in -Wdefault)]
(a -> b -> b) -> b -> t a -> b
const (_ :: Integer)
where const :: forall a b. a -> b -> a
- ($) (_ :: [Integer] -> Integer)
- where ($) :: forall a b. (a -> b) -> a -> b
- ($!) (_ :: [Integer] -> Integer)
- where ($!) :: forall a b. (a -> b) -> a -> b
curry (_ :: (t0, [Integer]) -> Integer) (_ :: t0)
where curry :: forall a b c. ((a, b) -> c) -> a -> b -> c
(.) (_ :: b1 -> Integer) (_ :: [Integer] -> b1)
where (.) :: forall b c a. (b -> c) -> (a -> b) -> a -> c
flip (_ :: [Integer] -> t0 -> Integer) (_ :: t0)
where flip :: forall a b c. (a -> b -> c) -> b -> a -> c
+ ($) (_ :: [Integer] -> Integer)
+ where ($) :: forall a b. (a -> b) -> a -> b
return (_ :: Integer)
where return :: forall (m :: * -> *) a. Monad m => a -> m a
pure (_ :: Integer)
where pure :: forall (f :: * -> *) a. Applicative f => a -> f a
+ ($!) (_ :: [Integer] -> Integer)
+ where ($!) :: forall a b. (a -> b) -> a -> b
(>>=) (_ :: [Integer] -> a8) (_ :: a8 -> [Integer] -> Integer)
where (>>=) :: forall (m :: * -> *) a b.
Monad m =>
@@ -109,18 +109,18 @@ abstract_refinement_hole_fits.hs:4:5: warning: [-Wtyped-holes (in -Wdefault)]
where snd :: forall a b. (a, b) -> b
const (_ :: [Integer] -> Integer) (_ :: t0)
where const :: forall a b. a -> b -> a
+ uncurry (_ :: a3 -> b3 -> [Integer] -> Integer) (_ :: (a3, b3))
+ where uncurry :: forall a b c. (a -> b -> c) -> (a, b) -> c
seq (_ :: t2) (_ :: [Integer] -> Integer)
where seq :: forall a b. a -> b -> b
($) (_ :: t0 -> [Integer] -> Integer) (_ :: t0)
where ($) :: forall a b. (a -> b) -> a -> b
- uncurry (_ :: a3 -> b3 -> [Integer] -> Integer) (_ :: (a3, b3))
- where uncurry :: forall a b c. (a -> b -> c) -> (a, b) -> c
- ($!) (_ :: t0 -> [Integer] -> Integer) (_ :: t0)
- where ($!) :: forall a b. (a -> b) -> a -> b
return (_ :: [Integer] -> Integer) (_ :: t0)
where return :: forall (m :: * -> *) a. Monad m => a -> m a
pure (_ :: [Integer] -> Integer) (_ :: t0)
where pure :: forall (f :: * -> *) a. Applicative f => a -> f a
+ ($!) (_ :: t0 -> [Integer] -> Integer) (_ :: t0)
+ where ($!) :: forall a b. (a -> b) -> a -> b
abstract_refinement_hole_fits.hs:7:5: warning: [-Wtyped-holes (in -Wdefault)]
• Found hole: _ :: Integer -> [Integer] -> Integer
@@ -148,20 +148,20 @@ abstract_refinement_hole_fits.hs:7:5: warning: [-Wtyped-holes (in -Wdefault)]
where flip :: forall a b c. (a -> b -> c) -> b -> a -> c
const (_ :: [Integer] -> Integer)
where const :: forall a b. a -> b -> a
- ($) (_ :: Integer -> [Integer] -> Integer)
- where ($) :: forall a b. (a -> b) -> a -> b
- ($!) (_ :: Integer -> [Integer] -> Integer)
- where ($!) :: forall a b. (a -> b) -> a -> b
curry (_ :: (t0, Integer) -> [Integer] -> Integer) (_ :: t0)
where curry :: forall a b c. ((a, b) -> c) -> a -> b -> c
(.) (_ :: b1 -> [Integer] -> Integer) (_ :: Integer -> b1)
where (.) :: forall b c a. (b -> c) -> (a -> b) -> a -> c
flip (_ :: Integer -> t0 -> [Integer] -> Integer) (_ :: t0)
where flip :: forall a b c. (a -> b -> c) -> b -> a -> c
+ ($) (_ :: Integer -> [Integer] -> Integer)
+ where ($) :: forall a b. (a -> b) -> a -> b
return (_ :: [Integer] -> Integer)
where return :: forall (m :: * -> *) a. Monad m => a -> m a
pure (_ :: [Integer] -> Integer)
where pure :: forall (f :: * -> *) a. Applicative f => a -> f a
+ ($!) (_ :: Integer -> [Integer] -> Integer)
+ where ($!) :: forall a b. (a -> b) -> a -> b
(>>=) (_ :: Integer -> a8)
(_ :: a8 -> Integer -> [Integer] -> Integer)
where (>>=) :: forall (m :: * -> *) a b.
@@ -228,16 +228,16 @@ abstract_refinement_hole_fits.hs:7:5: warning: [-Wtyped-holes (in -Wdefault)]
where snd :: forall a b. (a, b) -> b
const (_ :: Integer -> [Integer] -> Integer) (_ :: t0)
where const :: forall a b. a -> b -> a
+ uncurry (_ :: a3 -> b3 -> Integer -> [Integer] -> Integer)
+ (_ :: (a3, b3))
+ where uncurry :: forall a b c. (a -> b -> c) -> (a, b) -> c
seq (_ :: t2) (_ :: Integer -> [Integer] -> Integer)
where seq :: forall a b. a -> b -> b
($) (_ :: t0 -> Integer -> [Integer] -> Integer) (_ :: t0)
where ($) :: forall a b. (a -> b) -> a -> b
- uncurry (_ :: a3 -> b3 -> Integer -> [Integer] -> Integer)
- (_ :: (a3, b3))
- where uncurry :: forall a b c. (a -> b -> c) -> (a, b) -> c
- ($!) (_ :: t0 -> Integer -> [Integer] -> Integer) (_ :: t0)
- where ($!) :: forall a b. (a -> b) -> a -> b
return (_ :: Integer -> [Integer] -> Integer) (_ :: t0)
where return :: forall (m :: * -> *) a. Monad m => a -> m a
pure (_ :: Integer -> [Integer] -> Integer) (_ :: t0)
where pure :: forall (f :: * -> *) a. Applicative f => a -> f a
+ ($!) (_ :: t0 -> Integer -> [Integer] -> Integer) (_ :: t0)
+ where ($!) :: forall a b. (a -> b) -> a -> b
diff --git a/testsuite/tests/typecheck/should_compile/all.T b/testsuite/tests/typecheck/should_compile/all.T
index 344b4394a9dd..ce0c3a97a1b3 100644
--- a/testsuite/tests/typecheck/should_compile/all.T
+++ b/testsuite/tests/typecheck/should_compile/all.T
@@ -689,6 +689,7 @@ test('UnliftedNewtypesForall', normal, compile, [''])
test('UnlifNewUnify', normal, compile, [''])
test('UnliftedNewtypesLPFamily', normal, compile, [''])
test('UnliftedNewtypesDifficultUnification', normal, compile, [''])
+test('LevPolyResult', normal, compile, [''])
test('T16832', normal, ghci_script, ['T16832.script'])
test('T16995', normal, compile, [''])
test('T17007', normal, compile, [''])
diff --git a/testsuite/tests/typecheck/should_compile/constraint_hole_fits.stderr b/testsuite/tests/typecheck/should_compile/constraint_hole_fits.stderr
index ffc02228f21d..3cc66588f03a 100644
--- a/testsuite/tests/typecheck/should_compile/constraint_hole_fits.stderr
+++ b/testsuite/tests/typecheck/should_compile/constraint_hole_fits.stderr
@@ -36,12 +36,12 @@ constraint_hole_fits.hs:4:5: warning: [-Wtyped-holes (in -Wdefault)]
where const :: forall a b. a -> b -> a
($) (_ :: [a] -> a)
where ($) :: forall a b. (a -> b) -> a -> b
- ($!) (_ :: [a] -> a)
- where ($!) :: forall a b. (a -> b) -> a -> b
return (_ :: a)
where return :: forall (m :: * -> *) a. Monad m => a -> m a
pure (_ :: a)
where pure :: forall (f :: * -> *) a. Applicative f => a -> f a
+ ($!) (_ :: [a] -> a)
+ where ($!) :: forall a b. (a -> b) -> a -> b
id (_ :: [a] -> a)
where id :: forall a. a -> a
head (_ :: [[a] -> a])
diff --git a/testsuite/tests/typecheck/should_compile/refinement_hole_fits.stderr b/testsuite/tests/typecheck/should_compile/refinement_hole_fits.stderr
index 9ed1615215c6..5941b587bf73 100644
--- a/testsuite/tests/typecheck/should_compile/refinement_hole_fits.stderr
+++ b/testsuite/tests/typecheck/should_compile/refinement_hole_fits.stderr
@@ -67,12 +67,7 @@ refinement_hole_fits.hs:4:5: warning: [-Wtyped-holes (in -Wdefault)]
(and originally defined in ‘GHC.Base’))
($) (_ :: [Integer] -> Integer)
where ($) :: forall a b. (a -> b) -> a -> b
- with ($) @'GHC.Types.LiftedRep @[Integer] @Integer
- (imported from ‘Prelude’ at refinement_hole_fits.hs:1:8-30
- (and originally defined in ‘GHC.Base’))
- ($!) (_ :: [Integer] -> Integer)
- where ($!) :: forall a b. (a -> b) -> a -> b
- with ($!) @'GHC.Types.LiftedRep @[Integer] @Integer
+ with ($) @GHC.Types.LiftedRep @[Integer] @Integer
(imported from ‘Prelude’ at refinement_hole_fits.hs:1:8-30
(and originally defined in ‘GHC.Base’))
return (_ :: Integer)
@@ -85,6 +80,11 @@ refinement_hole_fits.hs:4:5: warning: [-Wtyped-holes (in -Wdefault)]
with pure @((->) [Integer]) @Integer
(imported from ‘Prelude’ at refinement_hole_fits.hs:1:8-30
(and originally defined in ‘GHC.Base’))
+ ($!) (_ :: [Integer] -> Integer)
+ where ($!) :: forall a b. (a -> b) -> a -> b
+ with ($!) @GHC.Types.LiftedRep @[Integer] @Integer
+ (imported from ‘Prelude’ at refinement_hole_fits.hs:1:8-30
+ (and originally defined in ‘GHC.Base’))
id (_ :: [Integer] -> Integer)
where id :: forall a. a -> a
with id @([Integer] -> Integer)
@@ -162,12 +162,7 @@ refinement_hole_fits.hs:7:5: warning: [-Wtyped-holes (in -Wdefault)]
(and originally defined in ‘GHC.Base’))
($) (_ :: Integer -> [Integer] -> Integer)
where ($) :: forall a b. (a -> b) -> a -> b
- with ($) @'GHC.Types.LiftedRep @Integer @([Integer] -> Integer)
- (imported from ‘Prelude’ at refinement_hole_fits.hs:1:8-30
- (and originally defined in ‘GHC.Base’))
- ($!) (_ :: Integer -> [Integer] -> Integer)
- where ($!) :: forall a b. (a -> b) -> a -> b
- with ($!) @'GHC.Types.LiftedRep @Integer @([Integer] -> Integer)
+ with ($) @GHC.Types.LiftedRep @Integer @([Integer] -> Integer)
(imported from ‘Prelude’ at refinement_hole_fits.hs:1:8-30
(and originally defined in ‘GHC.Base’))
return (_ :: [Integer] -> Integer)
@@ -180,6 +175,11 @@ refinement_hole_fits.hs:7:5: warning: [-Wtyped-holes (in -Wdefault)]
with pure @((->) Integer) @([Integer] -> Integer)
(imported from ‘Prelude’ at refinement_hole_fits.hs:1:8-30
(and originally defined in ‘GHC.Base’))
+ ($!) (_ :: Integer -> [Integer] -> Integer)
+ where ($!) :: forall a b. (a -> b) -> a -> b
+ with ($!) @GHC.Types.LiftedRep @Integer @([Integer] -> Integer)
+ (imported from ‘Prelude’ at refinement_hole_fits.hs:1:8-30
+ (and originally defined in ‘GHC.Base’))
id (_ :: Integer -> [Integer] -> Integer)
where id :: forall a. a -> a
with id @(Integer -> [Integer] -> Integer)
diff --git a/testsuite/tests/typecheck/should_fail/LevPolyLet.hs b/testsuite/tests/typecheck/should_fail/LevPolyLet.hs
new file mode 100644
index 000000000000..6fb47133aee6
--- /dev/null
+++ b/testsuite/tests/typecheck/should_fail/LevPolyLet.hs
@@ -0,0 +1,19 @@
+{-# language DataKinds #-}
+{-# language KindSignatures #-}
+{-# language PolyKinds #-}
+{-# language RankNTypes #-}
+
+module LevPolyLet
+ ( example
+ ) where
+
+import GHC.Exts
+
+-- This should be rejected because of the let binding.
+example :: forall (v :: Levity) (a :: TYPE ('BoxedRep v)).
+ (Int -> a)
+ -> (a -> Bool)
+ -> Bool
+example f g =
+ let x = f 42
+ in g x
diff --git a/testsuite/tests/typecheck/should_fail/LevPolyLet.stderr b/testsuite/tests/typecheck/should_fail/LevPolyLet.stderr
new file mode 100644
index 000000000000..8d01f4028b87
--- /dev/null
+++ b/testsuite/tests/typecheck/should_fail/LevPolyLet.stderr
@@ -0,0 +1,5 @@
+LevPolyLet.hs:18:7:
+ A levity-polymorphic type is not allowed here:
+ Type: a
+ Kind: TYPE ('BoxedRep v)
+ In the type of binder ‘x’
diff --git a/testsuite/tests/typecheck/should_fail/T12373.stderr b/testsuite/tests/typecheck/should_fail/T12373.stderr
index 20137fbdad02..f822b72d2011 100644
--- a/testsuite/tests/typecheck/should_fail/T12373.stderr
+++ b/testsuite/tests/typecheck/should_fail/T12373.stderr
@@ -3,7 +3,7 @@ T12373.hs:10:19: error:
• Couldn't match a lifted type with an unlifted type
When matching types
a0 :: *
- MVar# RealWorld a1 :: TYPE 'UnliftedRep
+ MVar# RealWorld a1 :: TYPE ('BoxedRep 'Unlifted)
Expected: (# State# RealWorld, a0 #)
Actual: (# State# RealWorld, MVar# RealWorld a1 #)
• In the expression: newMVar# rw
diff --git a/testsuite/tests/typecheck/should_fail/T13610.stderr b/testsuite/tests/typecheck/should_fail/T13610.stderr
index c04687988cd0..155fee8d24d2 100644
--- a/testsuite/tests/typecheck/should_fail/T13610.stderr
+++ b/testsuite/tests/typecheck/should_fail/T13610.stderr
@@ -3,7 +3,7 @@ T13610.hs:11:15: error:
• Couldn't match a lifted type with an unlifted type
When matching types
a :: *
- Weak# () :: TYPE 'UnliftedRep
+ Weak# () :: TYPE ('BoxedRep 'Unlifted)
Expected: (# State# RealWorld, a #)
Actual: (# State# RealWorld, Weak# () #)
• In the expression: mkWeakNoFinalizer# double () s
diff --git a/testsuite/tests/typecheck/should_fail/T14884.stderr b/testsuite/tests/typecheck/should_fail/T14884.stderr
index c901811f6fba..2f63301359ad 100644
--- a/testsuite/tests/typecheck/should_fail/T14884.stderr
+++ b/testsuite/tests/typecheck/should_fail/T14884.stderr
@@ -19,11 +19,11 @@ T14884.hs:4:5: error:
(imported from ‘Prelude’ at T14884.hs:1:8-13
(and originally defined in ‘Data.Foldable’))
($) :: forall a b. (a -> b) -> a -> b
- with ($) @'GHC.Types.LiftedRep @String @(IO ())
+ with ($) @GHC.Types.LiftedRep @String @(IO ())
(imported from ‘Prelude’ at T14884.hs:1:8-13
(and originally defined in ‘GHC.Base’))
($!) :: forall a b. (a -> b) -> a -> b
- with ($!) @'GHC.Types.LiftedRep @String @(IO ())
+ with ($!) @GHC.Types.LiftedRep @String @(IO ())
(imported from ‘Prelude’ at T14884.hs:1:8-13
(and originally defined in ‘GHC.Base’))
id :: forall a. a -> a
diff --git a/testsuite/tests/typecheck/should_fail/T15067.stderr b/testsuite/tests/typecheck/should_fail/T15067.stderr
index 4ed3d3bc0a0c..a2ecc4326ca6 100644
--- a/testsuite/tests/typecheck/should_fail/T15067.stderr
+++ b/testsuite/tests/typecheck/should_fail/T15067.stderr
@@ -1,13 +1,13 @@
T15067.hs:9:14: error:
- • No instance for (Typeable (# 'GHC.Types.LiftedRep #))
+ • No instance for (Typeable (# GHC.Types.LiftedRep #))
arising from a use of ‘typeRep’
GHC can't yet do polykinded
- Typeable ((# 'GHC.Types.LiftedRep #) :: *
- -> *
- -> TYPE
- ('GHC.Types.SumRep
- '[ 'GHC.Types.LiftedRep,
- 'GHC.Types.LiftedRep]))
+ Typeable ((# GHC.Types.LiftedRep #) :: *
+ -> *
+ -> TYPE
+ ('GHC.Types.SumRep
+ '[GHC.Types.LiftedRep,
+ GHC.Types.LiftedRep]))
• In the expression: typeRep
In an equation for ‘floopadoop’: floopadoop = typeRep
diff --git a/testsuite/tests/typecheck/should_fail/T15883b.hs b/testsuite/tests/typecheck/should_fail/T15883b.hs
index 82613943a737..45b7d6536075 100644
--- a/testsuite/tests/typecheck/should_fail/T15883b.hs
+++ b/testsuite/tests/typecheck/should_fail/T15883b.hs
@@ -11,4 +11,4 @@ module T15883b where
import GHC.Exts
newtype Foo rep = MkFoo (forall (a :: TYPE rep). a)
-deriving stock instance Eq (Foo LiftedRep)
+deriving stock instance Eq (Foo (BoxedRep Lifted))
diff --git a/testsuite/tests/typecheck/should_fail/T15883b.stderr b/testsuite/tests/typecheck/should_fail/T15883b.stderr
index a89403d4af58..21b93053150f 100644
--- a/testsuite/tests/typecheck/should_fail/T15883b.stderr
+++ b/testsuite/tests/typecheck/should_fail/T15883b.stderr
@@ -1,5 +1,6 @@
T15883b.hs:14:1:
Can't make a derived instance of
- ‘Eq (Foo 'LiftedRep)’ with the stock strategy:
+ ‘Eq (Foo ('BoxedRep 'Lifted))’ with the stock strategy:
Don't know how to derive ‘Eq’ for type ‘forall a. a’
- In the stand-alone deriving instance for ‘Eq (Foo LiftedRep)’
+ In the stand-alone deriving instance for
+ ‘Eq (Foo (BoxedRep Lifted))’
diff --git a/testsuite/tests/typecheck/should_fail/T15883c.hs b/testsuite/tests/typecheck/should_fail/T15883c.hs
index bd031540c27d..93d57b784b5b 100644
--- a/testsuite/tests/typecheck/should_fail/T15883c.hs
+++ b/testsuite/tests/typecheck/should_fail/T15883c.hs
@@ -11,4 +11,4 @@ module T15883c where
import GHC.Exts
newtype Foo rep = MkFoo (forall (a :: TYPE rep). a)
-deriving stock instance Ord (Foo LiftedRep)
+deriving stock instance Ord (Foo (BoxedRep Lifted))
diff --git a/testsuite/tests/typecheck/should_fail/T15883c.stderr b/testsuite/tests/typecheck/should_fail/T15883c.stderr
index 5444f5d6c894..60678c4fcb7c 100644
--- a/testsuite/tests/typecheck/should_fail/T15883c.stderr
+++ b/testsuite/tests/typecheck/should_fail/T15883c.stderr
@@ -1,5 +1,6 @@
T15883c.hs:14:1:
Can't make a derived instance of
- ‘Ord (Foo 'LiftedRep)’ with the stock strategy:
+ ‘Ord (Foo ('BoxedRep 'Lifted))’ with the stock strategy:
Don't know how to derive ‘Ord’ for type ‘forall a. a’
- In the stand-alone deriving instance for ‘Ord (Foo LiftedRep)’
+ In the stand-alone deriving instance for
+ ‘Ord (Foo (BoxedRep Lifted))’
diff --git a/testsuite/tests/typecheck/should_fail/T15883d.hs b/testsuite/tests/typecheck/should_fail/T15883d.hs
index fd86c5cab3da..dbcd93751e4a 100644
--- a/testsuite/tests/typecheck/should_fail/T15883d.hs
+++ b/testsuite/tests/typecheck/should_fail/T15883d.hs
@@ -11,5 +11,5 @@ module T15883d where
import GHC.Exts
newtype Foo rep = MkFoo (forall (a :: TYPE rep). a)
-deriving stock instance Show (Foo LiftedRep)
+deriving stock instance Show (Foo (BoxedRep Lifted))
diff --git a/testsuite/tests/typecheck/should_fail/T15883d.stderr b/testsuite/tests/typecheck/should_fail/T15883d.stderr
index b080ff654444..162b31072efc 100644
--- a/testsuite/tests/typecheck/should_fail/T15883d.stderr
+++ b/testsuite/tests/typecheck/should_fail/T15883d.stderr
@@ -1,5 +1,6 @@
T15883d.hs:14:1:
Can't make a derived instance of
- ‘Show (Foo 'LiftedRep)’ with the stock strategy:
+ ‘Show (Foo ('BoxedRep 'Lifted))’ with the stock strategy:
Don't know how to derive ‘Show’ for type ‘forall a. a’
- In the stand-alone deriving instance for ‘Show (Foo LiftedRep)’
+ In the stand-alone deriving instance for
+ ‘Show (Foo (BoxedRep Lifted))’
diff --git a/testsuite/tests/typecheck/should_fail/T15883e.hs b/testsuite/tests/typecheck/should_fail/T15883e.hs
index bb1dcacf924a..cfecdb693ef2 100644
--- a/testsuite/tests/typecheck/should_fail/T15883e.hs
+++ b/testsuite/tests/typecheck/should_fail/T15883e.hs
@@ -13,6 +13,6 @@ import GHC.Exts
import Data.Data (Data)
newtype Foo rep = MkFoo (forall (a :: TYPE rep). a)
-deriving stock instance Data (Foo LiftedRep)
+deriving stock instance Data (Foo (BoxedRep Lifted))
diff --git a/testsuite/tests/typecheck/should_fail/T15883e.stderr b/testsuite/tests/typecheck/should_fail/T15883e.stderr
index 05e07f0307f9..a20b3f5d433e 100644
--- a/testsuite/tests/typecheck/should_fail/T15883e.stderr
+++ b/testsuite/tests/typecheck/should_fail/T15883e.stderr
@@ -1,5 +1,6 @@
T15883e.hs:16:1:
Can't make a derived instance of
- ‘Data (Foo 'LiftedRep)’ with the stock strategy:
+ ‘Data (Foo ('BoxedRep 'Lifted))’ with the stock strategy:
Don't know how to derive ‘Data’ for type ‘forall a. a’
- In the stand-alone deriving instance for ‘Data (Foo LiftedRep)’
+ In the stand-alone deriving instance for
+ ‘Data (Foo (BoxedRep Lifted))’
diff --git a/testsuite/tests/typecheck/should_fail/T17021.stderr b/testsuite/tests/typecheck/should_fail/T17021.stderr
index 12d6d687d8c0..96c700c4b706 100644
--- a/testsuite/tests/typecheck/should_fail/T17021.stderr
+++ b/testsuite/tests/typecheck/should_fail/T17021.stderr
@@ -2,5 +2,5 @@
T17021.hs:18:5: error:
A levity-polymorphic type is not allowed here:
Type: Int
- Kind: TYPE (Id 'LiftedRep)
+ Kind: TYPE (Id ('BoxedRep 'Lifted))
When trying to create a variable of type: Int
diff --git a/testsuite/tests/typecheck/should_fail/T18357a.stderr b/testsuite/tests/typecheck/should_fail/T18357a.stderr
index a9e87fed98a2..f60e09922a2c 100644
--- a/testsuite/tests/typecheck/should_fail/T18357a.stderr
+++ b/testsuite/tests/typecheck/should_fail/T18357a.stderr
@@ -1,6 +1,6 @@
T18357a.hs:9:10: error:
- • Couldn't match kind ‘r’ with ‘'LiftedRep’
+ • Couldn't match kind ‘r’ with ‘LiftedRep’
Expected a type, but ‘Int’ has kind ‘*’
• In the type ‘Int’
In the definition of data constructor ‘MkT’
diff --git a/testsuite/tests/typecheck/should_fail/all.T b/testsuite/tests/typecheck/should_fail/all.T
index 3eff08d08037..cec7b3c9efbd 100644
--- a/testsuite/tests/typecheck/should_fail/all.T
+++ b/testsuite/tests/typecheck/should_fail/all.T
@@ -440,6 +440,7 @@ test('T13068', [extra_files(['T13068.hs', 'T13068a.hs', 'T13068.hs-boot', 'T1306
test('T13075', normal, compile_fail, [''])
test('T13105', normal, compile_fail, [''])
test('LevPolyBounded', normal, compile_fail, [''])
+test('LevPolyLet', normal, compile_fail, [''])
test('T13487', normal, compile, [''])
test('T13292', normal, multimod_compile, ['T13292', '-v0 -fdefer-type-errors'])
test('T13300', normal, compile_fail, [''])
diff --git a/testsuite/tests/typecheck/should_fail/tcfail090.stderr b/testsuite/tests/typecheck/should_fail/tcfail090.stderr
index efb81e8ee6b2..5e1995d3eb32 100644
--- a/testsuite/tests/typecheck/should_fail/tcfail090.stderr
+++ b/testsuite/tests/typecheck/should_fail/tcfail090.stderr
@@ -3,6 +3,6 @@ tcfail090.hs:11:9: error:
• Couldn't match a lifted type with an unlifted type
When matching types
a0 :: *
- ByteArray# :: TYPE 'UnliftedRep
+ ByteArray# :: TYPE ('BoxedRep 'Unlifted)
• In the expression: my_undefined
In an equation for ‘die’: die _ = my_undefined
diff --git a/testsuite/tests/typecheck/should_run/EtaExpandLevPoly.hs b/testsuite/tests/typecheck/should_run/EtaExpandLevPoly.hs
index d57d2e1499dd..82553b4ff204 100644
--- a/testsuite/tests/typecheck/should_run/EtaExpandLevPoly.hs
+++ b/testsuite/tests/typecheck/should_run/EtaExpandLevPoly.hs
@@ -6,12 +6,12 @@ module Main where
import GHC.Exts
data G a where
- MkG :: G (TupleRep [LiftedRep, IntRep])
+ MkG :: G (TupleRep [BoxedRep Lifted, IntRep])
-- tests that we don't eta-expand functions that are levity-polymorphic
-- see CoreArity.mkEtaWW
foo :: forall a (b :: TYPE a). G a -> b -> b
-foo MkG = (\x -> x) :: forall (c :: TYPE (TupleRep [LiftedRep, IntRep])). c -> c
+foo MkG = (\x -> x) :: forall (c :: TYPE (TupleRep [BoxedRep Lifted, IntRep])). c -> c
data H a where
MkH :: H IntRep
diff --git a/testsuite/tests/typecheck/should_run/LevPolyResultInst.hs b/testsuite/tests/typecheck/should_run/LevPolyResultInst.hs
new file mode 100644
index 000000000000..8302a43693ae
--- /dev/null
+++ b/testsuite/tests/typecheck/should_run/LevPolyResultInst.hs
@@ -0,0 +1,27 @@
+{-# language BangPatterns #-}
+{-# language DataKinds #-}
+{-# language MagicHash #-}
+{-# language PolyKinds #-}
+{-# language RankNTypes #-}
+{-# language UnboxedTuples #-}
+
+import GHC.Exts
+
+main :: IO ()
+main = do
+ print (example (\x -> I# x > 7))
+ case indexArray# (example replicateFalse) 0# of
+ (# r #) -> print r
+
+-- Combines base:runST, primitive:newArray, and primitive:unsafeFreezeArray
+replicateFalse :: Int# -> Array# Bool
+replicateFalse n =
+ let !(# _, r #) = runRW#
+ (\s -> case newArray# n False s of
+ (# s', arr #) -> unsafeFreezeArray# arr s'
+ )
+ in r
+
+example :: forall (v :: Levity) (a :: TYPE ('BoxedRep v)). (Int# -> a) -> a
+{-# noinline example #-}
+example f = f 8#
diff --git a/testsuite/tests/typecheck/should_run/LevPolyResultInst.stdout b/testsuite/tests/typecheck/should_run/LevPolyResultInst.stdout
new file mode 100644
index 000000000000..1cc8b5e10d33
--- /dev/null
+++ b/testsuite/tests/typecheck/should_run/LevPolyResultInst.stdout
@@ -0,0 +1,2 @@
+True
+False
diff --git a/testsuite/tests/typecheck/should_run/T12809.hs b/testsuite/tests/typecheck/should_run/T12809.hs
index 66031a5af7b5..3e20403add97 100644
--- a/testsuite/tests/typecheck/should_run/T12809.hs
+++ b/testsuite/tests/typecheck/should_run/T12809.hs
@@ -32,7 +32,7 @@ g (# b, x #) = show b ++ " " ++ show (I# x)
h :: (# Double, Int# #) -> String
h (# d, x #) = show d ++ " " ++ show (I# x)
-cond :: forall (a :: TYPE (TupleRep [LiftedRep, IntRep])). Bool -> a -> a -> a
+cond :: forall (a :: TYPE (TupleRep [BoxedRep Lifted, IntRep])). Bool -> a -> a -> a
cond True x _ = x
cond False _ x = x
diff --git a/testsuite/tests/typecheck/should_run/T14236.stdout b/testsuite/tests/typecheck/should_run/T14236.stdout
index ffa0e65dc958..73c98017f204 100644
--- a/testsuite/tests/typecheck/should_run/T14236.stdout
+++ b/testsuite/tests/typecheck/should_run/T14236.stdout
@@ -1,3 +1,3 @@
-(FUN 'Many 'LiftedRep 'LiftedRep Int,Char)
-(FUN 'Many 'IntRep 'LiftedRep Int#,Char)
+(FUN 'Many ('BoxedRep 'Lifted) ('BoxedRep 'Lifted) Int,Char)
+(FUN 'Many 'IntRep ('BoxedRep 'Lifted) Int#,Char)
Int# -> [Char]
diff --git a/testsuite/tests/typecheck/should_run/TestTypeableBinary.stdout b/testsuite/tests/typecheck/should_run/TestTypeableBinary.stdout
index 1303db844c5c..6ef72dfb8378 100644
--- a/testsuite/tests/typecheck/should_run/TestTypeableBinary.stdout
+++ b/testsuite/tests/typecheck/should_run/TestTypeableBinary.stdout
@@ -5,7 +5,7 @@ good: Maybe
good: TYPE
good: RuntimeRep
good: 'IntRep
-good: FUN 'Many 'LiftedRep 'LiftedRep
+good: FUN 'Many ('BoxedRep 'Lifted) ('BoxedRep 'Lifted)
good: Proxy * Int
good: Proxy (TYPE 'IntRep) Int#
good: *
diff --git a/testsuite/tests/typecheck/should_run/TypeOf.hs b/testsuite/tests/typecheck/should_run/TypeOf.hs
index cec6833b64e7..8bd8471bdffa 100644
--- a/testsuite/tests/typecheck/should_run/TypeOf.hs
+++ b/testsuite/tests/typecheck/should_run/TypeOf.hs
@@ -28,9 +28,9 @@ main = do
print $ typeOf (Proxy :: Proxy [1,2,3])
print $ typeOf (Proxy :: Proxy 'EQ)
print $ typeOf (Proxy :: Proxy TYPE)
- print $ typeOf (Proxy :: Proxy (TYPE 'LiftedRep))
+ print $ typeOf (Proxy :: Proxy (TYPE ('BoxedRep 'Lifted)))
print $ typeOf (Proxy :: Proxy *)
print $ typeOf (Proxy :: Proxy ★)
- print $ typeOf (Proxy :: Proxy 'LiftedRep)
+ print $ typeOf (Proxy :: Proxy ('BoxedRep 'Lifted))
print $ typeOf (Proxy :: Proxy '(1, "hello"))
print $ typeOf (Proxy :: Proxy (~~))
diff --git a/testsuite/tests/typecheck/should_run/TypeOf.stdout b/testsuite/tests/typecheck/should_run/TypeOf.stdout
index 40d2cb5f8fb8..3cb5e4903615 100644
--- a/testsuite/tests/typecheck/should_run/TypeOf.stdout
+++ b/testsuite/tests/typecheck/should_run/TypeOf.stdout
@@ -19,6 +19,6 @@ Proxy (RuntimeRep -> *) TYPE
Proxy * *
Proxy * *
Proxy * *
-Proxy RuntimeRep 'LiftedRep
+Proxy RuntimeRep ('BoxedRep 'Lifted)
Proxy (Natural,Symbol) ('(,) Natural Symbol 1 "hello")
Proxy (* -> * -> Constraint) ((~~) * *)
diff --git a/testsuite/tests/typecheck/should_run/TypeRep.hs b/testsuite/tests/typecheck/should_run/TypeRep.hs
index beae93f6b3c0..886479fd33ab 100644
--- a/testsuite/tests/typecheck/should_run/TypeRep.hs
+++ b/testsuite/tests/typecheck/should_run/TypeRep.hs
@@ -53,10 +53,10 @@ main = do
print $ rep @(Proxy [1,2,3])
print $ rep @(Proxy 'EQ)
print $ rep @(Proxy TYPE)
- print $ rep @(Proxy (TYPE 'LiftedRep))
+ print $ rep @(Proxy (TYPE ('BoxedRep 'Lifted)))
print $ rep @(Proxy *)
print $ rep @(Proxy ★)
- print $ rep @(Proxy 'LiftedRep)
+ print $ rep @(Proxy ('BoxedRep 'Lifted))
-- Something lifted and primitive
print $ rep @RealWorld -- #12132
diff --git a/testsuite/tests/typecheck/should_run/TypeRep.stdout b/testsuite/tests/typecheck/should_run/TypeRep.stdout
index a0c03e09d807..cf43264714e5 100644
--- a/testsuite/tests/typecheck/should_run/TypeRep.stdout
+++ b/testsuite/tests/typecheck/should_run/TypeRep.stdout
@@ -13,7 +13,7 @@ Int -> Int
(%,%) (Eq Int) (Eq [Char])
Int#
(##)
-(#,#) 'IntRep 'LiftedRep Int# Int
+(#,#) 'IntRep ('BoxedRep 'Lifted) Int# Int
Proxy Constraint (Eq Int)
Proxy * (Int,Int)
Proxy Symbol "hello world"
@@ -24,5 +24,5 @@ Proxy (RuntimeRep -> *) TYPE
Proxy * *
Proxy * *
Proxy * *
-Proxy RuntimeRep 'LiftedRep
+Proxy RuntimeRep ('BoxedRep 'Lifted)
RealWorld
diff --git a/testsuite/tests/typecheck/should_run/all.T b/testsuite/tests/typecheck/should_run/all.T
index ef8ae9136da1..ef7bedb35400 100755
--- a/testsuite/tests/typecheck/should_run/all.T
+++ b/testsuite/tests/typecheck/should_run/all.T
@@ -145,5 +145,6 @@ test('UnliftedNewtypesFamilyRun', normal, compile_and_run, [''])
test('UnliftedNewtypesDependentFamilyRun', normal, compile_and_run, [''])
test('UnliftedNewtypesIdentityRun', normal, compile_and_run, [''])
test('UnliftedNewtypesCoerceRun', normal, compile_and_run, [''])
+test('LevPolyResultInst', normal, compile_and_run, [''])
test('T17104', normal, compile_and_run, [''])
test('T18627', normal, compile_and_run, ['-O']) # Optimisation shows up the bug
diff --git a/testsuite/tests/unboxedsums/T12711.stdout b/testsuite/tests/unboxedsums/T12711.stdout
index 54af3fdfa672..18a67a078dd4 100644
--- a/testsuite/tests/unboxedsums/T12711.stdout
+++ b/testsuite/tests/unboxedsums/T12711.stdout
@@ -1,2 +1,4 @@
(# _ | _ #) :: TYPE
- ('GHC.Types.SumRep '[ 'GHC.Types.LiftedRep, 'GHC.Types.LiftedRep])
+ ('GHC.Types.SumRep
+ '[ 'GHC.Types.BoxedRep 'GHC.Types.Lifted,
+ 'GHC.Types.BoxedRep 'GHC.Types.Lifted])
diff --git a/testsuite/tests/unboxedsums/sum_rr.hs b/testsuite/tests/unboxedsums/sum_rr.hs
index 448a9b22210d..11c8cbb648d1 100644
--- a/testsuite/tests/unboxedsums/sum_rr.hs
+++ b/testsuite/tests/unboxedsums/sum_rr.hs
@@ -5,4 +5,4 @@ module Example where
import Data.Typeable
import GHC.Exts
-data Wat (a :: TYPE (SumRep '[LiftedRep, IntRep])) = Wat a
+data Wat (a :: TYPE (SumRep '[BoxedRep Lifted, IntRep])) = Wat a
diff --git a/utils/haddock b/utils/haddock
index 48c4982646b7..4ffb30d8b637 160000
--- a/utils/haddock
+++ b/utils/haddock
@@ -1 +1 @@
-Subproject commit 48c4982646b7fe6343ccdf1581c97a7735fe8940
+Subproject commit 4ffb30d8b637ccebecc81ce610f0af451ac8088d
--
GitLab