Commit 7ef6fe8f authored by Ben Gamari's avatar Ben Gamari 🐢 Committed by Marge Bot

SetLevels: Fix potential panic in lvlBind

3b31a94d introduced a use of isUnliftedType which can panic in the case
of levity-polymorphic types. Fix this by introducing mightBeUnliftedType
which returns whether the type is *guaranteed* to be lifted.
parent d9e637df
Pipeline #10067 failed with stages
in 325 minutes and 20 seconds
......@@ -89,7 +89,7 @@ import Demand ( StrictSig, Demand, isStrictDmd, splitStrictSig, increa
import Name ( getOccName, mkSystemVarName )
import OccName ( occNameString )
import Type ( Type, mkLamTypes, splitTyConApp_maybe, tyCoVarsOfType
, isUnliftedType, closeOverKindsDSet )
, mightBeUnliftedType, closeOverKindsDSet )
import BasicTypes ( Arity, RecFlag(..), isRec )
import DataCon ( dataConOrigResTy )
import TysWiredIn
......@@ -1099,8 +1099,8 @@ lvlBind env (AnnRec pairs)
| floatTopLvlOnly env && not (isTopLvl dest_lvl)
-- Only floating to the top level is allowed.
|| not (profitableFloat env dest_lvl)
|| (isTopLvl dest_lvl && any (isUnliftedType . idType) bndrs)
-- This isUnliftedType stuff is the same test as in the non-rec case
|| (isTopLvl dest_lvl && any (mightBeUnliftedType . idType) bndrs)
-- This mightBeUnliftedType stuff is the same test as in the non-rec case
-- You might wonder whether we can have a recursive binding for
-- an unlifted value -- but we can if it's a /join binding/ (#16978)
-- (Ultimately I think we should not use SetLevels to
......
......@@ -126,7 +126,7 @@ module Type (
tyConAppNeedsKindSig,
-- (Lifting and boxity)
isLiftedType_maybe, isUnliftedType, isUnboxedTupleType, isUnboxedSumType,
isLiftedType_maybe, isUnliftedType, mightBeUnliftedType, isUnboxedTupleType, isUnboxedSumType,
isAlgType, isDataFamilyAppType,
isPrimitiveType, isStrictType,
isRuntimeRepTy, isRuntimeRepVar, isRuntimeRepKindedTy,
......@@ -2225,6 +2225,16 @@ isUnliftedType ty
= not (isLiftedType_maybe ty `orElse`
pprPanic "isUnliftedType" (ppr ty <+> dcolon <+> ppr (typeKind ty)))
-- | Returns:
--
-- * 'False' if the type is /guaranteed/ lifted or
-- * 'True' if it is unlifted, OR we aren't sure (e.g. in a levity-polymorphic case)
mightBeUnliftedType :: Type -> Bool
mightBeUnliftedType ty
= case isLiftedType_maybe ty of
Just is_lifted -> not is_lifted
Nothing -> True
-- | Is this a type of kind RuntimeRep? (e.g. LiftedRep)
isRuntimeRepKindedTy :: Type -> Bool
isRuntimeRepKindedTy = isRuntimeRepTy . typeKind
......
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment