Fix isLiftedType_maybe and handle fallout

As #20837 pointed out, `isLiftedType_maybe` returned `Just False` in
many situations where it should return `Nothing`, because it didn't
take into account type families or type variables.

In this patch, we fix this issue. We rename `isLiftedType_maybe` to
`typeLevity_maybe`, which now returns a `Levity` instead of a boolean.
We now return `Nothing` for types with kinds of the form
`TYPE (F a1 ... an)` for a type family `F`, as well as
`TYPE (BoxedRep l)` where `l` is a type variable.

This fix caused several other problems, as other parts of the compiler
were relying on `isLiftedType_maybe` returning a `Just` value, and were
now panicking after the above fix. There were two main situations in
which panics occurred:

  1. Issues involving the let/app invariant. To uphold that invariant,
     we need to know whether something is lifted or not. If we get an
     answer of `Nothing` from `isLiftedType_maybe`, then we don't know
     what to do. As this invariant isn't particularly invariant, we
     can change the affected functions to not panic, e.g. by behaving
     the same in the `Just False` case and in the `Nothing` case
     (meaning: no observable change in behaviour compared to before).

  2. Typechecking of data (/newtype) constructor patterns. Some programs
     involving patterns with unknown representations were accepted, such
     as T20363. Now that we are stricter, this caused further issues,
     culminating in Core Lint errors. However, the behaviour was
     incorrect the whole time; the incorrectness only being revealed by
     this change, not triggered by it.

     This patch fixes this by overhauling where the representation
     polymorphism involving pattern matching are done. Instead of doing
     it in `tcMatches`, we instead ensure that the `matchExpected`
     functions such as `matchExpectedFunTys`, `matchActualFunTySigma`,
     `matchActualFunTysRho` allow return argument pattern types which
     have a fixed RuntimeRep (as defined in Note [Fixed RuntimeRep]).
     This ensures that the pattern matching code only ever handles types
     with a known runtime representation. One exception was that
     patterns with an unknown representation type could sneak in via
     `tcConPat`, which points to a missing representation-polymorphism
     check, which this patch now adds.

     This means that we now reject the program in #20363, at least until
     we implement PHASE 2 of FixedRuntimeRep (allowing type families in
     RuntimeRep positions). The aforementioned refactoring, in which
     checks have been moved to `matchExpected` functions, is a first
     step in implementing PHASE 2 for patterns.

Fixes #20837

14 files changed, 125 insertions, 89 deletions

diff --git a/compiler/GHC/Core/Coercion/Opt.hs b/compiler/GHC/Core/Coercion/Opt.hs
index 041be10e3b..27375c5fe3 100644
--- a/compiler/GHC/Core/Coercion/Opt.hs
+++ b/compiler/GHC/Core/Coercion/Opt.hs
@@ -150,6 +150,7 @@ optCoercion' env co
   where
     lc = mkSubstLiftingContext env
 
+
 type NormalCo    = Coercion
   -- Invariants:
   --  * The substitution has been fully applied
diff --git a/compiler/GHC/Core/Lint.hs b/compiler/GHC/Core/Lint.hs
index adf8124b12..b9ca990f3d 100644
--- a/compiler/GHC/Core/Lint.hs
+++ b/compiler/GHC/Core/Lint.hs
@@ -634,7 +634,7 @@ lintLetBind top_lvl rec_flag binder rhs rhs_ty
         -- Check the let/app invariant
         -- See Note [Core let/app invariant] in GHC.Core
        ; checkL ( isJoinId binder
-               || not (isUnliftedType binder_ty)
+               || mightBeLiftedType binder_ty
                || (isNonRec rec_flag && exprOkForSpeculation rhs)
                || isDataConWorkId binder || isDataConWrapId binder -- until #17521 is fixed
                || exprIsTickedString rhs)
@@ -1280,14 +1280,14 @@ lintCoreArg (fun_ty, fun_ue) arg
        ; flags <- getLintFlags
 
        ; when (lf_check_fixed_rep flags) $
-         -- Only do these checks if lf_check_fixed_rep is on,
-         -- because otherwise isUnliftedType panics
+         -- Only check that 'arg_ty' has a fixed RuntimeRep
+         -- if 'lf_check_fixed_rep' is on.
          do { checkL (typeHasFixedRuntimeRep arg_ty)
                      (text "Argument does not have a fixed runtime representation"
                       <+> ppr arg <+> dcolon
                       <+> parens (ppr arg_ty <+> dcolon <+> ppr (typeKind arg_ty)))
 
-            ; checkL (not (isUnliftedType arg_ty) || exprOkForSpeculation arg)
+            ; checkL (mightBeLiftedType arg_ty || exprOkForSpeculation arg)
                      (mkLetAppMsg arg) }
 
        ; lintValApp arg fun_ty arg_ty fun_ue arg_ue }
diff --git a/compiler/GHC/Core/Opt/DmdAnal.hs b/compiler/GHC/Core/Opt/DmdAnal.hs
index 2dafaf8e0b..f136aba04a 100644
--- a/compiler/GHC/Core/Opt/DmdAnal.hs
+++ b/compiler/GHC/Core/Opt/DmdAnal.hs
@@ -352,7 +352,7 @@ dmdAnalStar env (n :* sd) e
   -- NB: (:*) expands AbsDmd and BotDmd as needed
   -- See Note [Analysing with absent demand]
   | WithDmdType dmd_ty e' <- dmdAnal env sd e
-  = assertPpr (not (isUnliftedType (exprType e)) || exprOkForSpeculation e) (ppr e)
+  = assertPpr (mightBeLiftedType (exprType e) || exprOkForSpeculation e) (ppr e)
     -- The argument 'e' should satisfy the let/app invariant
     (toPlusDmdArg $ multDmdType n dmd_ty, e')
 
diff --git a/compiler/GHC/Core/Opt/FloatIn.hs b/compiler/GHC/Core/Opt/FloatIn.hs
index abd56abdf0..ed62d3dfb2 100644
--- a/compiler/GHC/Core/Opt/FloatIn.hs
+++ b/compiler/GHC/Core/Opt/FloatIn.hs
@@ -27,7 +27,7 @@ import GHC.Core.Utils
 import GHC.Core.FVs
 import GHC.Core.Type
 
-import GHC.Types.Basic      ( RecFlag(..), isRec )
+import GHC.Types.Basic      ( RecFlag(..), isRec, Levity(Unlifted) )
 import GHC.Types.Id         ( isOneShotBndr, idType, isJoinId, isJoinId_maybe )
 import GHC.Types.Tickish
 import GHC.Types.Var
@@ -448,6 +448,7 @@ bindings are:
 
 fiExpr platform to_drop (_, AnnCase scrut case_bndr _ [AnnAlt con alt_bndrs rhs])
   | isUnliftedType (idType case_bndr)
+     -- binders have a fixed RuntimeRep so it's OK to call isUnliftedType
   , exprOkForSideEffects (deAnnotate scrut)
       -- See Note [Floating primops]
   = wrapFloats shared_binds $
@@ -592,7 +593,7 @@ noFloatIntoRhs is_rec bndr rhs
 
 noFloatIntoArg :: CoreExprWithFVs' -> Type -> Bool
 noFloatIntoArg expr expr_ty
-  | isUnliftedType expr_ty
+  | Just Unlifted <- typeLevity_maybe expr_ty
   = True  -- See Note [Do not destroy the let/app invariant]
 
    | AnnLam bndr e <- expr
diff --git a/compiler/GHC/Core/Opt/FloatOut.hs b/compiler/GHC/Core/Opt/FloatOut.hs
index 1a88c97d55..19b687a4a3 100644
--- a/compiler/GHC/Core/Opt/FloatOut.hs
+++ b/compiler/GHC/Core/Opt/FloatOut.hs
@@ -269,6 +269,8 @@ splitRecFloats fs
   = go [] [] (bagToList fs)
   where
     go ul_prs prs (FloatLet (NonRec b r) : fs) | isUnliftedType (idType b)
+                                               -- NB: isUnliftedType is OK here as binders always
+                                               -- have a fixed RuntimeRep.
                                                , not (isJoinId b)
                                                = go ((b,r):ul_prs) prs fs
                                                | otherwise
diff --git a/compiler/GHC/Core/Opt/Simplify.hs b/compiler/GHC/Core/Opt/Simplify.hs
index f77411e0b1..3c3854bf41 100644
--- a/compiler/GHC/Core/Opt/Simplify.hs
+++ b/compiler/GHC/Core/Opt/Simplify.hs
@@ -574,25 +574,40 @@ When we transform to
 
 Its not wrong to drop it on the floor, but better to keep it.
 
-Note [Cast w/w: unlifted]
-~~~~~~~~~~~~~~~~~~~~~~~~~
-BUT don't do cast worker/wrapper if 'e' has an unlifted type.
-This *can* happen:
+Note [Preserve RuntimeRep info in cast w/w]
+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+We must not do cast w/w when the presence of the coercion is needed in order
+to determine the runtime representation.
+
+Example:
+
+  Suppose we have a type family:
+
+    type F :: RuntimeRep
+    type family F where
+      F = LiftedRep
+
+  together with a type `ty :: TYPE F` and a top-level binding
+
+    a :: ty |> TYPE F[0]
+
+  The kind of `ty |> TYPE F[0]` is `LiftedRep`, so `a` is a top-level lazy binding.
+  However, were we to apply cast w/w, we would get:
 
-     foo :: Int = (error (# Int,Int #) "urk")
-                  `cast` CoUnsafe (# Int,Int #) Int
+    b :: ty
+    b = ...
 
-If do the makeTrivial thing to the error call, we'll get
-    foo = case error (# Int,Int #) "urk" of v -> v `cast` ...
-But 'v' isn't in scope!
+    a :: ty |> TYPE F[0]
+    a = b `cast` GRefl (TYPE F[0])
 
-These strange casts can happen as a result of case-of-case
-        bar = case (case x of { T -> (# 2,3 #); F -> error "urk" }) of
-                (# p,q #) -> p+q
+  Now we are in trouble because `ty :: TYPE F` does not have a known runtime
+  representation, because we need to be able to reduce the nullary type family
+  application `F` to find that out.
 
-NOTE: Nowadays we don't use casts for these error functions;
-instead, we use (case erorr ... of {}). So I'm not sure
-this Note makes much sense any more.
+Conclusion: only do cast w/w when doing so would not lose the RuntimeRep
+information. That is, when handling `Cast rhs co`, don't attempt cast w/w
+unless the kind of the type of rhs is concrete, in the sense of
+Note [Concrete types] in GHC.Tc.Utils.Concrete.
 -}
 
 tryCastWorkerWrapper :: SimplEnv -> TopLevelFlag
@@ -606,8 +621,9 @@ tryCastWorkerWrapper env top_lvl old_bndr occ_info bndr (Cast rhs co)
                         --            a DFunUnfolding in mk_worker_unfolding
   , not (exprIsTrivial rhs)        -- Not x = y |> co; Wrinkle 1
   , not (hasInlineUnfolding info)  -- Not INLINE things: Wrinkle 4
-  , not (isUnliftedType rhs_ty)    -- Not if rhs has an unlifted type;
-                                   --     see Note [Cast w/w: unlifted]
+  , isConcrete (typeKind rhs_ty)   -- Don't peel off a cast if doing so would
+                                   -- lose the underlying runtime representation.
+                                   -- See Note [Preserve RuntimeRep info in cast w/w]
   = do  { (rhs_floats, work_rhs) <- prepareRhs env top_lvl occ_fs rhs
         ; uniq <- getUniqueM
         ; let work_name = mkSystemVarName uniq occ_fs
@@ -2850,6 +2866,7 @@ doCaseToLet scrut case_bndr
   = isTyCoArg scrut        -- Note [Core type and coercion invariant]
 
   | isUnliftedType (idType case_bndr)
+    -- OK to call isUnliftedType: scrutinees always have a fixed RuntimeRep (see FRRCase)
   = exprOkForSpeculation scrut
 
   | otherwise  -- Scrut has a lifted type
diff --git a/compiler/GHC/Core/Opt/Simplify/Env.hs b/compiler/GHC/Core/Opt/Simplify/Env.hs
index 54a5f171ec..cb3e1854d5 100644
--- a/compiler/GHC/Core/Opt/Simplify/Env.hs
+++ b/compiler/GHC/Core/Opt/Simplify/Env.hs
@@ -526,6 +526,8 @@ unitLetFloat bind = assert (all (not . isJoinId) (bindersOf bind)) $
           -- See Note [Core top-level string literals] in GHC.Core.
       | exprOkForSpeculation rhs = FltOkSpec  -- Unlifted, and lifted but ok-for-spec (eg HNF)
       | otherwise                = assertPpr (not (isUnliftedType (idType bndr))) (ppr bndr)
+                                   -- NB: binders always have a fixed RuntimeRep, so calling
+                                   -- isUnliftedType is OK here
                                    FltCareful
       -- Unlifted binders can only be let-bound if exprOkForSpeculation holds
 
diff --git a/compiler/GHC/Core/Opt/Simplify/Utils.hs b/compiler/GHC/Core/Opt/Simplify/Utils.hs
index ec26ba89fb..4ed22d2914 100644
--- a/compiler/GHC/Core/Opt/Simplify/Utils.hs
+++ b/compiler/GHC/Core/Opt/Simplify/Utils.hs
@@ -590,21 +590,14 @@ mkArgInfo env fun rules n_val_args call_cont
       | Just (_, arg_ty, fun_ty') <- splitFunTy_maybe fun_ty        -- Add strict-type info
       , dmd : rest_dmds <- dmds
       , let dmd'
-             -- TODO: we should just use isLiftedType_maybe, but that
-             -- function is currently wrong (#20837).
-             | Just rr <- getRuntimeRep_maybe arg_ty
-             , Just False <- isLiftedRuntimeRep_maybe rr
-             -- The type is definitely unlifted, such as:
-             --   - TYPE (BoxedRep Unlifted)
-             --   - TYPE IntRep, TYPE FloatRep, ...
+             | Just Unlifted <- typeLevity_maybe arg_ty
              = strictifyDmd dmd
              | otherwise
-             -- Could be definitely lifted, or we're not sure (e.g. levity-polymorphic).
+             -- Something that's not definitely unlifted.
+             -- If the type is representation-polymorphic, we can't know whether
+             -- it's strict.
              = dmd
       = dmd' : add_type_strictness fun_ty' rest_dmds
-          -- If the type is representation-polymorphic, we can't know whether
-          -- it's strict. isLiftedType_maybe will return Just False only when
-          -- we're sure the type is unlifted.
 
       | otherwise
       = dmds
diff --git a/compiler/GHC/Core/Opt/SpecConstr.hs b/compiler/GHC/Core/Opt/SpecConstr.hs
index d973c75570..aec343508e 100644
--- a/compiler/GHC/Core/Opt/SpecConstr.hs
+++ b/compiler/GHC/Core/Opt/SpecConstr.hs
@@ -2458,7 +2458,7 @@ setStrUnfolding id str
   | not (isId id) || isEvaldUnfolding (idUnfolding id)
   = id
   | isMarkedStrict str
-  , not (isUnliftedType (idType id)) -- Pointless to stick an evald unfolding on unlifted types
+  , not $ isUnliftedType (idType id) -- Pointless to stick an evald unfolding on unlifted types
   = -- trace "setStrUnfolding2" $
     assert (isId id) $
     assert (not $ hasCoreUnfolding $ idUnfolding id) $
diff --git a/compiler/GHC/Core/Opt/WorkWrap/Utils.hs b/compiler/GHC/Core/Opt/WorkWrap/Utils.hs
index c62ba572de..06a7e91eae 100644
--- a/compiler/GHC/Core/Opt/WorkWrap/Utils.hs
+++ b/compiler/GHC/Core/Opt/WorkWrap/Utils.hs
@@ -630,6 +630,7 @@ wantToUnboxArg do_unlifting fam_envs ty dmd@(n :* sd)
   , isStrUsedDmd dmd
   , not (isFunTy ty)
   , not (isUnliftedType ty) -- Already unlifted!
+    -- NB: function arguments have a fixed RuntimeRep, so it's OK to call isUnliftedType here
   = Unlift
 
   | otherwise
@@ -915,7 +916,7 @@ mkAbsentFiller :: WwOpts -> Id -> Maybe CoreExpr
 mkAbsentFiller opts arg
   -- The lifted case: Bind 'absentError' for a nice panic message if we are
   -- wrong (like we were in #11126). See (1) in Note [Absent fillers]
-  | not (isUnliftedType arg_ty)
+  | mightBeLiftedType arg_ty
   , not is_strict, not is_evald -- See (2) in Note [Absent fillers]
   = Just (mkAbsentErrorApp arg_ty msg)
 
diff --git a/compiler/GHC/Core/PatSyn.hs b/compiler/GHC/Core/PatSyn.hs
index c3aeb87c27..39cafc46e2 100644
--- a/compiler/GHC/Core/PatSyn.hs
+++ b/compiler/GHC/Core/PatSyn.hs
@@ -59,7 +59,9 @@ data PatSyn
         psName        :: Name,
         psUnique      :: Unique,       -- Cached from Name
 
-        psArgs        :: [Type],
+        psArgs        :: [Type],       -- ^ Argument types.
+                                       -- These always have a fixed RuntimeRep as per
+                                       -- Note [Fixed RuntimeRep] in GHC.Tc.Utils.Concrete.
         psArity       :: Arity,        -- == length psArgs
         psInfix       :: Bool,         -- True <=> declared infix
         psFieldLabels :: [FieldLabel], -- List of fields for a
@@ -381,6 +383,8 @@ mkPatSyn :: Name
          -> ([InvisTVBinder], ThetaType) -- ^ Existentially-quantified type
                                          -- variables and provided dicts
          -> [Type]               -- ^ Original arguments
+                                 -- These must have a fixed RuntimeRep as per
+                                 -- Note [Fixed RuntimeRep] in GHC.Tc.Utils.Concrete.
          -> Type                 -- ^ Original result type
          -> PatSynMatcher        -- ^ Matcher
          -> PatSynBuilder        -- ^ Builder
diff --git a/compiler/GHC/Core/Type.hs b/compiler/GHC/Core/Type.hs
index c71bbdfc9e..6adf7c7a34 100644
--- a/compiler/GHC/Core/Type.hs
+++ b/compiler/GHC/Core/Type.hs
@@ -121,12 +121,13 @@ module GHC.Core.Type (
         tyConAppNeedsKindSig,
 
         -- *** Levity and boxity
-        isLiftedType_maybe,
+        typeLevity_maybe,
         isLiftedTypeKind, isUnliftedTypeKind, isBoxedTypeKind, pickyIsLiftedTypeKind,
-        isLiftedRuntimeRep, isUnliftedRuntimeRep, isLiftedRuntimeRep_maybe,
+        isLiftedRuntimeRep, isUnliftedRuntimeRep, runtimeRepLevity_maybe,
         isBoxedRuntimeRep,
         isLiftedLevity, isUnliftedLevity,
-        isUnliftedType, isBoxedType, mightBeUnliftedType, isUnboxedTupleType, isUnboxedSumType,
+        isUnliftedType, isBoxedType, isUnboxedTupleType, isUnboxedSumType,
+        mightBeLiftedType, mightBeUnliftedType,
         isStateType,
         isAlgType, isDataFamilyAppType,
         isPrimitiveType, isStrictType,
@@ -733,25 +734,25 @@ isBoxedRuntimeRep_maybe rep
 --
 -- @isLiftedRuntimeRep rr@ returns:
 --
---   * @Just True @ if @rr@ is @LiftedRep :: RuntimeRep@
---   * @Just False@ if @rr@ is definitely not lifted, e.g. @IntRep@
---   * @Nothing   @ if not known (e.g. it's a type variable or a type family application).
-isLiftedRuntimeRep_maybe :: Type -> Maybe Bool
-isLiftedRuntimeRep_maybe rep
+--   * @Just Lifted@ if @rr@ is @LiftedRep :: RuntimeRep@
+--   * @Just Unlifted@ if @rr@ is definitely unlifted, e.g. @IntRep@
+--   * @Nothing@ if not known (e.g. it's a type variable or a type family application).
+runtimeRepLevity_maybe :: Type -> Maybe Levity
+runtimeRepLevity_maybe rep
   | TyConApp rr_tc args <- coreFullView rep
   , isPromotedDataCon rr_tc =
       -- NB: args might be non-empty e.g. TupleRep [r1, .., rn]
       if (rr_tc `hasKey` boxedRepDataConKey)
         then case args of
-          [lev] | isLiftedLevity   lev -> Just True
-                | isUnliftedLevity lev -> Just False
+          [lev] | isLiftedLevity   lev -> Just Lifted
+                | isUnliftedLevity lev -> Just Unlifted
           _                            -> Nothing
-        else Just False
+        else Just Unlifted
         -- 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,
         -- hence the isPromotedDataCon rr_tc
-isLiftedRuntimeRep_maybe _ = Nothing
+runtimeRepLevity_maybe _ = Nothing
 
 -- | Check whether a type of kind 'RuntimeRep' is lifted.
 --
@@ -761,11 +762,8 @@ isLiftedRuntimeRep_maybe _ = Nothing
 --  * False of type variables, type family applications,
 --    and of other reps such as @IntRep :: RuntimeRep@.
 isLiftedRuntimeRep :: Type -> Bool
-isLiftedRuntimeRep rep
-  | Just True <- isLiftedRuntimeRep_maybe rep
-  = True
-  | otherwise
-  = False
+isLiftedRuntimeRep rep =
+  runtimeRepLevity_maybe rep == Just Lifted
 
 -- | Check whether a type of kind 'RuntimeRep' is unlifted.
 --
@@ -774,11 +772,8 @@ isLiftedRuntimeRep rep
 --  * False of 'LiftedRep',
 --  * False for type variables and type family applications.
 isUnliftedRuntimeRep :: Type -> Bool
-isUnliftedRuntimeRep rep
-  | Just False <- isLiftedRuntimeRep_maybe rep
-  = True
-  | otherwise
-  = False
+isUnliftedRuntimeRep rep =
+  runtimeRepLevity_maybe rep == Just Unlifted
 
 -- | An INLINE helper for functions such as 'isLiftedLevity' and 'isUnliftedLevity'.
 --
@@ -2453,18 +2448,17 @@ buildSynTyCon name binders res_kind roles rhs
 ************************************************************************
 -}
 
--- | Returns Just True if this type is surely lifted, Just False
--- if it is surely unlifted, Nothing if we can't be sure (i.e., it is
--- representation-polymorphic), and panics if the kind does not have the shape
--- TYPE r.
-isLiftedType_maybe :: HasDebugCallStack => Type -> Maybe Bool
-isLiftedType_maybe ty = case coreFullView (getRuntimeRep ty) of
-  ty' | isLiftedRuntimeRep ty'  -> Just True
-      | isUnliftedRuntimeRep ty' -> Just False
-  TyConApp {}                   -> Just False  -- Everything else is unlifted
-  _                             -> Nothing     -- representation-polymorphic
-
--- | See "Type#type_classification" for what an unlifted type is.
+-- | Tries to compute the 'Levity' of the given type. Returns either
+-- a definite 'Levity', or 'Nothing' if we aren't sure (e.g. the
+-- type is representation-polymorphic).
+--
+-- Panics if the kind does not have the shape @TYPE r@.
+typeLevity_maybe :: HasDebugCallStack => Type -> Maybe Levity
+typeLevity_maybe ty = runtimeRepLevity_maybe (getRuntimeRep ty)
+
+-- | Is the given type definitely unlifted?
+-- See "Type#type_classification" for what an unlifted type is.
+--
 -- Panics on representation-polymorphic types; See 'mightBeUnliftedType' for
 -- a more approximate predicate that behaves better in the presence of
 -- representation polymorphism.
@@ -2474,9 +2468,12 @@ isUnliftedType :: HasDebugCallStack => Type -> Bool
         -- I found bindings like these were getting floated to the top level.
         -- They are pretty bogus types, mind you.  It would be better never to
         -- construct them
-isUnliftedType ty
-  = not (isLiftedType_maybe ty `orElse`
-         pprPanic "isUnliftedType" (ppr ty <+> dcolon <+> ppr (typeKind ty)))
+isUnliftedType ty =
+  case typeLevity_maybe ty of
+    Just Lifted   -> False
+    Just Unlifted -> True
+    Nothing       ->
+      pprPanic "isUnliftedType" (ppr ty <+> dcolon <+> ppr (typeKind ty))
 
 -- | State token type.
 isStateType :: Type -> Bool
@@ -2487,14 +2484,19 @@ isStateType ty
 
 -- | Returns:
 --
+-- * 'False' if the type is /guaranteed/ unlifted or
+-- * 'True' if it lifted, OR we aren't sure
+--    (e.g. in a representation-polymorphic case)
+mightBeLiftedType :: Type -> Bool
+mightBeLiftedType = mightBeLifted . typeLevity_maybe
+
+-- | Returns:
+--
 -- * 'False' if the type is /guaranteed/ lifted or
 -- * 'True' if it is unlifted, OR we aren't sure
 --    (e.g. in a representation-polymorphic case)
 mightBeUnliftedType :: Type -> Bool
-mightBeUnliftedType ty
-  = case isLiftedType_maybe ty of
-      Just is_lifted -> not is_lifted
-      Nothing -> True
+mightBeUnliftedType = mightBeUnlifted . typeLevity_maybe
 
 -- | See "Type#type_classification" for what a boxed type is.
 -- Panics on representation-polymorphic types; See 'mightBeUnliftedType' for
diff --git a/compiler/GHC/Core/Unfold.hs b/compiler/GHC/Core/Unfold.hs
index c341107957..3dba991bed 100644
--- a/compiler/GHC/Core/Unfold.hs
+++ b/compiler/GHC/Core/Unfold.hs
@@ -522,7 +522,9 @@ sizeExpr opts !bOMB_OUT_SIZE top_args expr
 
                 -- unboxed variables, inline primops and unsafe foreign calls
                 -- are all "inline" things:
-          is_inline_scrut (Var v) = isUnliftedType (idType v)
+          is_inline_scrut (Var v) =
+            isUnliftedType (idType v)
+              -- isUnliftedType is OK here: scrutinees have a fixed RuntimeRep (search for FRRCase)
           is_inline_scrut scrut
               | (Var f, _) <- collectArgs scrut
                 = case idDetails f of
@@ -581,6 +583,7 @@ sizeExpr opts !bOMB_OUT_SIZE top_args expr
       |  isTyVar bndr                 -- Doesn't exist at runtime
       || isJoinId bndr                -- Not allocated at all
       || isUnliftedType (idType bndr) -- Doesn't live in heap
+           -- OK to call isUnliftedType: binders have a fixed RuntimeRep (search for FRRBinder)
       = 0
       | otherwise
       = 10
diff --git a/compiler/GHC/Core/Utils.hs b/compiler/GHC/Core/Utils.hs
index 03e2ecee55..da13a346d8 100644
--- a/compiler/GHC/Core/Utils.hs
+++ b/compiler/GHC/Core/Utils.hs
@@ -96,7 +96,8 @@ import GHC.Types.Tickish
 import GHC.Types.Id
 import GHC.Types.Id.Info
 import GHC.Types.Unique
-import GHC.Types.Basic     ( Arity, CbvMark(..), isMarkedCbv )
+import GHC.Types.Basic     ( Arity, CbvMark(..), Levity(..)
+                           , isMarkedCbv )
 import GHC.Types.Unique.Set
 
 import GHC.Data.FastString
@@ -524,7 +525,8 @@ bindNonRec bndr rhs body
 -- | Tests whether we have to use a @case@ rather than @let@ binding for this expression
 -- as per the invariants of 'CoreExpr': see "GHC.Core#let_app_invariant"
 needsCaseBinding :: Type -> CoreExpr -> Bool
-needsCaseBinding ty rhs = isUnliftedType ty && not (exprOkForSpeculation rhs)
+needsCaseBinding ty rhs =
+  mightBeUnliftedType ty && not (exprOkForSpeculation rhs)
         -- Make a case expression instead of a let
         -- These can arise either from the desugarer,
         -- or from beta reductions: (\x.e) (x +# y)
@@ -1590,6 +1592,7 @@ expr_ok primop_ok (Case scrut bndr _ alts)
   =  -- See Note [exprOkForSpeculation: case expressions]
      expr_ok primop_ok scrut
   && isUnliftedType (idType bndr)
+      -- OK to call isUnliftedType: binders always have a fixed RuntimeRep
   && all (\(Alt _ _ rhs) -> expr_ok primop_ok rhs) alts
   && altsAreExhaustive alts
 
@@ -1646,7 +1649,7 @@ app_ok primop_ok fun args
 
       _  -- Unlifted types
          -- c.f. the Var case of exprIsHNF
-         | isUnliftedType (idType fun)
+         | Just Unlifted <- typeLevity_maybe (idType fun)
          -> assertPpr (n_val_args == 0) (ppr fun $$ ppr args)
             True  -- Our only unlifted types are Int# etc, so will have
                   -- no value args.  The assert is just to check this.
@@ -1671,8 +1674,10 @@ app_ok primop_ok fun args
     primop_arg_ok :: TyBinder -> CoreExpr -> Bool
     primop_arg_ok (Named _) _ = True   -- A type argument
     primop_arg_ok (Anon _ ty) arg      -- A term argument
-       | isUnliftedType (scaledThing ty) = expr_ok primop_ok arg
-       | otherwise         = True  -- See Note [Primops with lifted arguments]
+       | Just Lifted <- typeLevity_maybe (scaledThing ty)
+       = True -- See Note [Primops with lifted arguments]
+       | otherwise
+       = expr_ok primop_ok arg
 
 -----------------------------
 altsAreExhaustive :: [Alt b] -> Bool
@@ -1917,7 +1922,7 @@ exprIsHNFlike is_con is_con_unf = is_hnf_like
         -- We don't look through loop breakers here, which is a bit conservative
         -- but otherwise I worry that if an Id's unfolding is just itself,
         -- we could get an infinite loop
-      || isUnliftedType (idType v)
+      || ( typeLevity_maybe (idType v) == Just Unlifted )
         -- Unlifted binders are always evaluated (#20140)
 
     is_hnf_like (Lit l)          = not (isLitRubbish l)
@@ -2684,15 +2689,20 @@ computeCbvInfo id rhs =
         map fst .
           -- Starting at the end, drop all non-cbv marks, and marks applied to unlifted types
           dropWhileEndLE (\(m,v) -> not (isMarkedCbv m) || isUnliftedType (idType v)) $
+            -- NB: function arguments must have a fixed RuntimeRep, so isUnliftedType can't crash.
           zip marks val_args
 
     mkCbvMarks :: ([Id]) -> [CbvMark]
     mkCbvMarks = map mkMark
       where
         cbv_arg arg = isEvaldUnfolding (idUnfolding arg)
-        mkMark arg = if cbv_arg arg && (not $ isUnliftedType (idType arg))
-          then MarkedCbv
-          else NotMarkedCbv
+        mkMark arg
+          | cbv_arg arg
+          , not $ isUnliftedType (idType arg)
+            -- NB: isUnliftedType can't crash here as function arguments have a fixed RuntimeRep
+          = MarkedCbv
+          | otherwise
+          = NotMarkedCbv
     -- If we determined earlier one an argument should be passed cbv it should
     -- still be so here.
     checkMarks id new_marks