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.

3 files changed, 54 insertions, 14 deletions

diff --git a/compiler/GHC/Core/TyCo/Rep.hs b/compiler/GHC/Core/TyCo/Rep.hs
index be7bdb3aef..262037402b 100644
--- a/compiler/GHC/Core/TyCo/Rep.hs
+++ b/compiler/GHC/Core/TyCo/Rep.hs
@@ -1,5 +1,6 @@
 {-# LANGUAGE CPP                #-}
 {-# LANGUAGE DeriveDataTypeable #-}
+{-# LANGUAGE MultiWayIf         #-}
 
 {-# OPTIONS_HADDOCK not-home #-}
 
@@ -91,7 +92,7 @@ import GHC.Core.TyCon
 import GHC.Core.Coercion.Axiom
 
 -- others
-import GHC.Builtin.Names ( liftedTypeKindTyConKey, liftedRepDataConKey, manyDataConKey, tYPETyConKey )
+import GHC.Builtin.Names ( liftedTypeKindTyConKey, boxedRepDataConKey, liftedDataConKey, manyDataConKey, tYPETyConKey )
 import {-# SOURCE #-} GHC.Builtin.Types ( liftedTypeKindTyCon, liftedTypeKind, manyDataConTy )
 import {-# SOURCE #-} GHC.Builtin.Types.Prim ( tYPETyCon )
 import GHC.Types.Basic ( LeftOrRight(..), pickLR )
@@ -1090,17 +1091,22 @@ See #17958.
 -- | Given a RuntimeRep, applies TYPE to it.
 -- See Note [TYPE and RuntimeRep] in GHC.Builtin.Types.Prim.
 tYPE :: Type -> Type
-tYPE (TyConApp tc [])
+tYPE rr@(TyConApp tc [arg])
   -- See Note [Prefer Type of TYPE 'LiftedRep]
-  | tc `hasKey` liftedRepDataConKey = liftedTypeKind  -- TYPE 'LiftedRep
+  | tc `hasKey` boxedRepDataConKey
+  , TyConApp tc' [] <- arg
+  = if | tc' `hasKey` liftedDataConKey  -> liftedTypeKind
+       -- | tc' `hasKey` unlifedDataConKey -> unliftedTypeKind
+       | otherwise                      -> TyConApp tYPETyCon [rr]
 tYPE rr = TyConApp tYPETyCon [rr]
 
 -- This is a single, global definition of the type `Type`
 -- Defined here so it is only allocated once.
--- See Note [Prefer Type over TYPE 'LiftedRep] in this module.
+-- See Note [mkTyConApp and Type] in this module.
 liftedTypeKindTyConApp :: Type
 liftedTypeKindTyConApp = TyConApp liftedTypeKindTyCon []
 
+
 {-
 %************************************************************************
 %*                                                                      *
diff --git a/compiler/GHC/Core/TyCon.hs b/compiler/GHC/Core/TyCon.hs
index a038fd646c..e07e51e606 100644
--- a/compiler/GHC/Core/TyCon.hs
+++ b/compiler/GHC/Core/TyCon.hs
@@ -139,7 +139,7 @@ import {-# SOURCE #-} GHC.Core.TyCo.Rep
 import {-# SOURCE #-} GHC.Core.TyCo.Ppr
    ( pprType )
 import {-# SOURCE #-} GHC.Builtin.Types
-   ( runtimeRepTyCon, constraintKind
+   ( runtimeRepTyCon, constraintKind, levityTyCon
    , multiplicityTyCon
    , vecCountTyCon, vecElemTyCon, liftedTypeKind )
 import {-# SOURCE #-} GHC.Core.DataCon
@@ -1073,6 +1073,8 @@ data RuntimeRepInfo
       -- be the list of arguments to the promoted datacon.
   | VecCount Int         -- ^ A constructor of @VecCount@
   | VecElem PrimElemRep  -- ^ A constructor of @VecElem@
+  | LiftedInfo
+  | UnliftedInfo
 
 -- | Extract those 'DataCon's that we are able to learn about.  Note
 -- that visibility in this sense does not correspond to visibility in
@@ -2235,8 +2237,8 @@ isKindTyCon tc = getUnique tc `elementOfUniqSet` kindTyConKeys
 -- -XDataKinds.
 kindTyConKeys :: UniqSet Unique
 kindTyConKeys = unionManyUniqSets
-  ( mkUniqSet [ liftedTypeKindTyConKey, constraintKindTyConKey, tYPETyConKey ]
-  : map (mkUniqSet . tycon_with_datacons) [ runtimeRepTyCon
+  ( mkUniqSet [ liftedTypeKindTyConKey, liftedRepTyConKey, constraintKindTyConKey, tYPETyConKey ]
+  : map (mkUniqSet . tycon_with_datacons) [ runtimeRepTyCon, levityTyCon
                                           , multiplicityTyCon
                                           , vecCountTyCon, vecElemTyCon ] )
   where
diff --git a/compiler/GHC/Core/Type.hs b/compiler/GHC/Core/Type.hs
index e5d0da93fd..6065f3f56a 100644
--- a/compiler/GHC/Core/Type.hs
+++ b/compiler/GHC/Core/Type.hs
@@ -121,6 +121,7 @@ module GHC.Core.Type (
         isLiftedType_maybe,
         isLiftedTypeKind, isUnliftedTypeKind, pickyIsLiftedTypeKind,
         isLiftedRuntimeRep, isUnliftedRuntimeRep,
+        isLiftedLevity, isUnliftedLevity,
         isUnliftedType, mightBeUnliftedType, isUnboxedTupleType, isUnboxedSumType,
         isAlgType, isDataFamilyAppType,
         isPrimitiveType, isStrictType,
@@ -611,6 +612,7 @@ isLiftedTypeKind kind
 pickyIsLiftedTypeKind :: Kind -> Bool
 -- Checks whether the kind is literally
 --      TYPE LiftedRep
+-- or   TYPE ('BoxedRep 'Lifted)
 -- or   Type
 -- without expanding type synonyms or anything
 -- Used only when deciding whether to suppress the ":: *" in
@@ -619,8 +621,13 @@ pickyIsLiftedTypeKind :: Kind -> Bool
 pickyIsLiftedTypeKind kind
   | TyConApp tc [arg] <- kind
   , tc `hasKey` tYPETyConKey
-  , TyConApp rr_tc [] <- arg
-  , rr_tc `hasKey` liftedRepDataConKey = True
+  , TyConApp rr_tc rr_args <- arg = case rr_args of
+      [] -> rr_tc `hasKey` liftedRepTyConKey
+      [rr_arg]
+        | rr_tc `hasKey` boxedRepDataConKey
+        , TyConApp lev [] <- rr_arg
+        , lev `hasKey` liftedDataConKey -> True
+      _ -> False
   | TyConApp tc [] <- kind
   , tc `hasKey` liftedTypeKindTyConKey = True
   | otherwise                          = False
@@ -630,8 +637,27 @@ isLiftedRuntimeRep :: Type -> Bool
 -- False of type variables (a :: RuntimeRep)
 --   and of other reps e.g. (IntRep :: RuntimeRep)
 isLiftedRuntimeRep rep
-  | TyConApp rr_tc args <- coreFullView rep
-  , rr_tc `hasKey` liftedRepDataConKey = ASSERT( null args ) True
+  | TyConApp rr_tc rr_args <- coreFullView rep
+  , rr_tc `hasKey` boxedRepDataConKey
+  = case rr_args of
+      [rr_arg] -> isLiftedLevity rr_arg
+      _ -> ASSERT( False ) True -- this should probably just panic
+  | otherwise                          = False
+
+isLiftedLevity :: Type -> Bool
+isLiftedLevity lev
+  | Just lev' <- coreView lev          = isLiftedLevity lev'
+  | TyConApp lev_tc lev_args <- lev
+  , lev_tc `hasKey` liftedDataConKey
+  = ASSERT( null lev_args ) True
+  | otherwise                          = False
+
+isUnliftedLevity :: Type -> Bool
+isUnliftedLevity lev
+  | Just lev' <- coreView lev          = isUnliftedLevity lev'
+  | TyConApp lev_tc lev_args <- lev
+  , lev_tc `hasKey` unliftedDataConKey
+  = ASSERT( null lev_args ) True
   | otherwise                          = False
 
 -- | Returns True if the kind classifies unlifted types and False otherwise.
@@ -648,9 +674,15 @@ isUnliftedRuntimeRep :: Type -> Bool
 -- False of           (LiftedRep :: RuntimeRep)
 --   and of variables (a :: RuntimeRep)
 isUnliftedRuntimeRep rep
-  | TyConApp rr_tc _ <- coreFullView rep   -- NB: args might be non-empty
-                                           --     e.g. TupleRep [r1, .., rn]
-  = isPromotedDataCon rr_tc && not (rr_tc `hasKey` liftedRepDataConKey)
+  | TyConApp rr_tc args <- coreFullView rep   -- NB: args might be non-empty
+                                              --     e.g. TupleRep [r1, .., rn]
+  , isPromotedDataCon rr_tc =
+      -- NB: args might be non-empty e.g. TupleRep [r1, .., rn]
+      if (rr_tc `hasKey` boxedRepDataConKey)
+        then case args of
+          [TyConApp lev_tc []] -> lev_tc `hasKey` unliftedDataConKey
+          _ -> False
+        else True
         -- Avoid searching all the unlifted RuntimeRep type cons
         -- In the RuntimeRep data type, only LiftedRep is lifted
         -- But be careful of type families (F tys) :: RuntimeRep