diff options
author | Ben Gamari <ben@smart-cactus.org> | 2020-04-19 15:09:24 +0000 |
---|---|---|
committer | Ben Gamari <ben@smart-cactus.org> | 2020-04-19 15:09:24 +0000 |
commit | 88a9a43b6a9d5c17f239fd13e72aa01937d7fade (patch) | |
tree | b75a07c23c5eb34c5df7bfe2af2f81326e44af1c /compiler/GHC | |
parent | 4fd166ae587683e51f022c0d2657955b05023f28 (diff) | |
download | haskell-88a9a43b6a9d5c17f239fd13e72aa01937d7fade.tar.gz |
SetLevels: Don't float out of runRW# and keepAlive# appswip/with2-primop
Diffstat (limited to 'compiler/GHC')
-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 |