diff options
| author | Ben Gamari <ben@smart-cactus.org> | 2020-04-19 11:16:32 -0400 |
|---|---|---|
| committer | Ben Gamari <ben@smart-cactus.org> | 2020-05-22 15:14:51 -0400 |
| commit | 5a2cdd5c2f69992a59fa57b9dc46f6ed71864ef6 (patch) | |
| tree | 041d5ae04a2f37d0d9b27cd932d7fbe80ba49af4 /compiler/GHC/Core/Opt/SetLevels.hs | |
| parent | 31f1c568e7c9562d58ae10dbcd74d67da8156021 (diff) | |
| download | haskell-wip/runRW.tar.gz | |
Allow simplification through runRW#wip/runRW
Because runRW# inlines so late, we were previously able to do very
little simplification across it. For instance, given even a simple
program like
case runRW# (\s -> let n = I# 42# in n) of
I# n# -> f n#
we previously had no way to avoid the allocation of the I#.
This patch allows the simplifier to push strict contexts into the
continuation of a runRW# application, as explained in
in Note [Simplification of runRW#] in GHC.CoreToStg.Prep.
Fixes #15127.
Metric Increase:
T9961
Metric Decrease:
ManyConstructors
Co-Authored-By: Simon Peyton-Jone <simonpj@microsoft.com>
Diffstat (limited to 'compiler/GHC/Core/Opt/SetLevels.hs')
| -rw-r--r-- | compiler/GHC/Core/Opt/SetLevels.hs | 10 |
1 files changed, 9 insertions, 1 deletions
diff --git a/compiler/GHC/Core/Opt/SetLevels.hs b/compiler/GHC/Core/Opt/SetLevels.hs index 0a1395a432..cef8230436 100644 --- a/compiler/GHC/Core/Opt/SetLevels.hs +++ b/compiler/GHC/Core/Opt/SetLevels.hs @@ -91,11 +91,13 @@ 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 GHC.Builtin.Types +import GHC.Builtin.Names ( runRWKey ) import GHC.Types.Unique.Supply import GHC.Utils.Misc import GHC.Utils.Outputable @@ -399,8 +401,14 @@ 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) + -- Try to ensure that runRW#'s continuation isn't floated out. + -- See Note [Simplification of runRW#]. + | fn `hasKey` runRWKey + = 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 |