diff options
| -rw-r--r-- | compiler/GHC/Core/Op/SetLevels.hs | 8 |
1 files changed, 7 insertions, 1 deletions
diff --git a/compiler/GHC/Core/Op/SetLevels.hs b/compiler/GHC/Core/Op/SetLevels.hs index 0ac49a0c1c..681ee5e516 100644 --- a/compiler/GHC/Core/Op/SetLevels.hs +++ b/compiler/GHC/Core/Op/SetLevels.hs @@ -91,10 +91,12 @@ import GHC.Types.Demand ( StrictSig, Demand, isStrictDmd, splitStrictSig, import GHC.Types.Cpr ( mkCprSig, botCpr ) import GHC.Types.Name ( getOccName, mkSystemVarName ) import GHC.Types.Name.Occurrence ( occNameString ) +import GHC.Types.Unique ( hasKey ) import GHC.Core.Type ( Type, mkLamTypes, splitTyConApp_maybe, tyCoVarsOfType , mightBeUnliftedType, closeOverKindsDSet ) import GHC.Types.Basic ( Arity, RecFlag(..), isRec ) import GHC.Core.DataCon ( dataConOrigResTy ) +import PrelNames ( runRWKey, keepAliveIdKey ) import TysWiredIn import GHC.Types.Unique.Supply import Util @@ -399,8 +401,12 @@ lvlNonTailExpr env expr lvlApp :: LevelEnv -> CoreExprWithFVs -> (CoreExprWithFVs, [CoreExprWithFVs]) -- Input application - -> LvlM LevelledExpr -- Result expression + -> LvlM LevelledExpr -- Result expression lvlApp env orig_expr ((_,AnnVar fn), args) + | fn `hasKey` runRWKey || fn `hasKey` keepAliveIdKey + = do { args' <- mapM (lvlExpr env) args + ; return (foldl' App (lookupVar env fn) args') } + | floatOverSat env -- See Note [Floating over-saturated applications] , arity > 0 , arity < n_val_args |