diff options
| author | Ben Gamari <ben@smart-cactus.org> | 2019-09-10 13:04:48 -0400 |
|---|---|---|
| committer | Marge Bot <ben+marge-bot@smart-cactus.org> | 2019-09-11 09:48:03 -0400 |
| commit | 7ef6fe8f70156581ce8e370a90975fb96f98783a (patch) | |
| tree | 75bb6f7c650ba7a7675a3cf6aa06b21eafc1525c /compiler/simplCore/SetLevels.hs | |
| parent | d9e637dfb3a0c29b235a99363e4eb6b255aa781a (diff) | |
| download | haskell-7ef6fe8f70156581ce8e370a90975fb96f98783a.tar.gz | |
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.
Diffstat (limited to 'compiler/simplCore/SetLevels.hs')
| -rw-r--r-- | compiler/simplCore/SetLevels.hs | 6 |
1 files changed, 3 insertions, 3 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 |