diff options
Diffstat (limited to 'compiler')
| -rw-r--r-- | compiler/simplCore/SetLevels.hs | 6 | ||||
| -rw-r--r-- | compiler/types/Type.hs | 12 |
2 files changed, 14 insertions, 4 deletions
diff --git a/compiler/simplCore/SetLevels.hs b/compiler/simplCore/SetLevels.hs index e7187b3c52..89187259ba 100644 --- a/compiler/simplCore/SetLevels.hs +++ b/compiler/simplCore/SetLevels.hs @@ -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 diff --git a/compiler/types/Type.hs b/compiler/types/Type.hs index e65861a9ea..94ee5af202 100644 --- a/compiler/types/Type.hs +++ b/compiler/types/Type.hs @@ -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 |