[Git][ghc/ghc][wip/simplifier-tweaks] Make postInlineUnconditionally a bit more aggressive
Simon Peyton Jones (@simonpj)
gitlab at gitlab.haskell.org
Fri Jul 7 08:47:35 UTC 2023
Simon Peyton Jones pushed to branch wip/simplifier-tweaks at Glasgow Haskell Compiler / GHC
Commits:
9cb540eb by Simon Peyton Jones at 2023-07-07T09:45:58+01:00
Make postInlineUnconditionally a bit more aggressive
Try postInlineUnconditionally for one-branch things, even
if under a lambda
Reinstate the check in simplAuxBind
- - - - -
2 changed files:
- compiler/GHC/Core/Opt/Simplify/Iteration.hs
- compiler/GHC/Core/Opt/Simplify/Utils.hs
Changes:
=====================================
compiler/GHC/Core/Opt/Simplify/Iteration.hs
=====================================
@@ -417,11 +417,11 @@ simplAuxBind _str env bndr new_rhs
= return (emptyFloats env, env) -- Here c is dead, and we avoid
-- creating the binding c = (a,b)
-{- Try not doing this
-- The cases would be inlined unconditionally by completeBind:
- -- but it seems not uncommon, and avoids faff to do it here
- -- This is safe because it's only used for auxiliary bindings, which
- -- have no NOLINE pragmas, nor RULEs
+ -- but it seems not uncommon, and it turns to be a little more
+ -- efficient (in compile time allocations) to do it here.
+ -- See Note [Post-inline for single-use things] in GHC.Core.Opt.Simplify.Utils
+ -- Note: auxiliary bindings have no NOLINE pragmas, RULEs, or stable unfoldings
| exprIsTrivial new_rhs -- Short-cut for let x = y in ...
|| case (idOccInfo bndr) of
OneOcc{ occ_n_br = 1, occ_in_lam = NotInsideLam } -> True
@@ -430,7 +430,6 @@ simplAuxBind _str env bndr new_rhs
, case new_rhs of
Coercion co -> extendCvSubst env bndr co
_ -> extendIdSubst env bndr (DoneEx new_rhs Nothing) )
--}
| otherwise
= do { -- ANF-ise the RHS
=====================================
compiler/GHC/Core/Opt/Simplify/Utils.hs
=====================================
@@ -1544,16 +1544,9 @@ postInlineUnconditionally env bind_cxt old_bndr bndr rhs
-> n_br < 100 -- See Note [Suppress exponential blowup]
- && (smallEnoughToInline uf_opts unfolding || (in_lam == NotInsideLam && n_br == 1)) -- Small enough to dup
- -- ToDo: consider discount on smallEnoughToInline if int_cxt is true
- --
- -- NB: Do NOT inline arbitrarily big things, even if occ_n_br=1
- -- Reason: doing so risks exponential behaviour. We simplify a big
- -- expression, inline it, and simplify it again. But if the
- -- very same thing happens in the big expression, we get
- -- exponential cost!
- -- PRINCIPLE: when we've already simplified an expression once,
- -- make sure that we only inline it if it's reasonably small.
+ && ( (n_br == 1) -- See Note [Post-inline for single-use things]
+ || smallEnoughToInline uf_opts unfolding) -- Small enough to dup
+ -- ToDo: consider discount on smallEnoughToInline if int_cxt is true
&& (in_lam == NotInsideLam ||
-- Outside a lambda, we want to be reasonably aggressive
@@ -1576,18 +1569,6 @@ postInlineUnconditionally env bind_cxt old_bndr bndr rhs
_ -> False
--- Here's an example that we don't handle well:
--- let f = if b then Left (\x.BIG) else Right (\y.BIG)
--- in \y. ....case f of {...} ....
--- Here f is used just once, and duplicating the case work is fine (exprIsCheap).
--- But
--- - We can't preInlineUnconditionally because that would invalidate
--- the occ info for b.
--- - We can't postInlineUnconditionally because the RHS is big, and
--- that risks exponential behaviour
--- - We can't call-site inline, because the rhs is big
--- Alas!
-
where
occ_info = idOccInfo old_bndr
unfolding = idUnfolding bndr
@@ -1614,6 +1595,51 @@ in allocation if you miss this out. And bits of GHC itself start
to allocate more. An egregious example is test perf/compiler/T14697,
where GHC.Driver.CmdLine.$wprocessArgs allocated hugely more.
+
+Note [Post-inline for single-use things]
+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+If we have
+
+ let x = rhs in ...x...
+
+and `x` is used exactly once, and not inside a lambda, then we will usually
+preInlineUnconditinally. But we can still get this situation in
+postInlineUnconditionally:
+
+ case K rhs of K x -> ...x....
+
+Here we'll use `simplAuxBind` to bind `x` to (the already-simplified) `rhs`;
+and `x` is used exactly once. It's beneficial to inline right away; otherwise
+we risk creating
+
+ let x = rhs in ...x...
+
+which will take another iteration of the Simplifier to eliminate. We do this in
+two places
+
+1. `simplAuxBind` does a kind of poor-man's `postInlineUnconditionally`. It
+ does not need to account for many of the cases (e.g. top level) that the
+ full `postInlineUnconditionally` does. Moreover, we don't have an
+ OutId, which `postInlineUnconditionally` needs.
+
+2. In the full `postInlineUnconditionally` we also look for the special case
+ of "one occurrence, not under a lambda".
+
+
+-- Here's an example that we don't handle well:
+-- let f = if b then Left (\x.BIG) else Right (\y.BIG)
+-- in \y. ....case f of {...} ....
+-- Here f is used just once, and duplicating the case work is fine (exprIsCheap).
+-- But
+-- - We can't preInlineUnconditionally because that would invalidate
+-- the occ info for b.
+-- - We can't postInlineUnconditionally because the RHS is big, and
+-- that risks exponential behaviour
+-- - We can't call-site inline, because the rhs is big
+-- Alas!
+
+
+
Note [Suppress exponential blowup]
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
In #13253, and several related tickets, we got an exponential blowup
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/9cb540eb7a61621830fda2263fe1f744c5e80002
--
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/9cb540eb7a61621830fda2263fe1f744c5e80002
You're receiving this email because of your account on gitlab.haskell.org.
-------------- next part --------------
An HTML attachment was scrubbed...
URL: <http://mail.haskell.org/pipermail/ghc-commits/attachments/20230707/d73459c9/attachment-0001.html>
More information about the ghc-commits
mailing list