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 ]

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]
 
 {- *********************************************************************
 *                                                                      *

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,

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

compiler/GHC/Core/TyCo/Rep.hs

 {-# 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 []
 
+
 {-
 %************************************************************************
 %*                                                                      *

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

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

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
 

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

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

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]

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
 

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

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`.

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

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

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

libraries/base/Data/Typeable/Internal.hs

+{-# 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 @(->))

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

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,