diff options
author | Sebastian Graf <sebastian.graf@kit.edu> | 2022-11-15 21:36:00 +0100 |
---|---|---|
committer | Marge Bot <ben+marge-bot@smart-cactus.org> | 2022-11-19 03:22:49 -0500 |
commit | b1a8af691763fa4620bc7974012c3986569e1e05 (patch) | |
tree | 206ec27dac10d7e18e2a46815d734142d2f2442e | |
parent | cb8430f8133dc7e6375ae7aa5a282986f3ddac69 (diff) | |
download | haskell-b1a8af691763fa4620bc7974012c3986569e1e05.tar.gz |
Simplifier: Consider `seq` as a `BoringCtxt` (#22317)
See `Note [Seq is boring]` for the rationale.
Fixes #22317.
-rw-r--r-- | compiler/GHC/Core/Opt/Simplify/Utils.hs | 62 | ||||
-rw-r--r-- | compiler/GHC/Core/Unfold.hs | 7 | ||||
-rw-r--r-- | testsuite/tests/simplCore/should_compile/T22317.hs | 20 | ||||
-rw-r--r-- | testsuite/tests/simplCore/should_compile/T22317.stderr | 256 | ||||
-rw-r--r-- | testsuite/tests/simplCore/should_compile/T22375.stderr | 29 | ||||
-rw-r--r-- | testsuite/tests/simplCore/should_compile/all.T | 2 |
6 files changed, 359 insertions, 17 deletions
diff --git a/compiler/GHC/Core/Opt/Simplify/Utils.hs b/compiler/GHC/Core/Opt/Simplify/Utils.hs index 9d18365d5d..262272b5d8 100644 --- a/compiler/GHC/Core/Opt/Simplify/Utils.hs +++ b/compiler/GHC/Core/Opt/Simplify/Utils.hs @@ -740,8 +740,8 @@ Note [Interesting call context] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ We want to avoid inlining an expression where there can't possibly be any gain, such as in an argument position. Hence, if the continuation -is interesting (eg. a case scrutinee, application etc.) then we -inline, otherwise we don't. +is interesting (eg. a case scrutinee that isn't just a seq, application etc.) +then we inline, otherwise we don't. Previously some_benefit used to return True only if the variable was applied to some value arguments. This didn't work: @@ -781,6 +781,53 @@ expression into the branches of any case in f's unfolding. So, to reduce unnecessary code expansion, we just make the context look boring. This made a small compile-time perf improvement in perf/compiler/T6048, and it looks plausible to me. + +Note [Seq is boring] +~~~~~~~~~~~~~~~~~~~~ +Suppose + f x = case v of + True -> Just x + False -> Just (x-1) + +Now consider these cases: + +1. case f x of b{-dead-} { DEFAULT -> blah[no b] } + Inlining (f x) will allow us to avoid ever allocating (Just x), + since the case binder `b` is dead. We will end up with a + join point for blah, thus + join j = blah in + case v of { True -> j; False -> j } + which will turn into (case v of DEFAULT -> blah + All good + +2. case f x of b { DEFAULT -> blah[b] } + Inlining (f x) will still mean we allocate (Just x). We'd get: + join j b = blah[b] + case v of { True -> j (Just x); False -> j (Just (x-1)) } + No new optimisations are revealed. Nothing is gained. + (This is the situation in T22317.) + +2a. case g x of b { (x{-dead-}, x{-dead-}) -> blah[b, no x, no y] } + Instead of DEFAULT we have a single constructor alternative + with all dead binders. This is just a variant of (2); no + gain from inlining (f x) + +3. case f x of b { Just y -> blah[y,b] } + Inlining (f x) will mean we still allocate (Just x), + but we also get to bind `y` without fetching it out of the Just, thus + join j y b = blah[y,b] + case v of { True -> j x (Just x) + ; False -> let y = x-1 in j y (Just y) } + Inlining (f x) has a small benefit, perhaps. + (To T14955 it makes a surprisingly large difference of ~30% to inline here.) + + +Conclusion: if the case expression + * Has a non-dead case-binder + * Has one alternative + * All the binders in the alternative are dead +then the `case` is just a strict let-binding, and the scrutinee is +BoringCtxt (don't inline). Otherwise CaseCtxt. -} lazyArgContext :: ArgInfo -> CallCtxt @@ -811,10 +858,13 @@ interestingCallContext :: SimplEnv -> SimplCont -> CallCtxt interestingCallContext env cont = interesting cont where - interesting (Select {}) - | seCaseCase env = CaseCtxt - | otherwise = BoringCtxt - -- See Note [No case of case is boring] + interesting (Select {sc_alts=alts, sc_bndr=case_bndr}) + | not (seCaseCase env) = BoringCtxt -- See Note [No case of case is boring] + | [Alt _ bs _] <- alts + , all isDeadBinder bs + , not (isDeadBinder case_bndr) = BoringCtxt -- See Note [Seq is boring] + | otherwise = CaseCtxt + interesting (ApplyToVal {}) = ValAppCtxt -- Can happen if we have (f Int |> co) y diff --git a/compiler/GHC/Core/Unfold.hs b/compiler/GHC/Core/Unfold.hs index 49ef7ca02c..56f8251e3d 100644 --- a/compiler/GHC/Core/Unfold.hs +++ b/compiler/GHC/Core/Unfold.hs @@ -1347,8 +1347,11 @@ call is at least CONLIKE. At least for the cases where we use ArgCtxt for the RHS of a 'let', we only profit from the inlining if we get a CONLIKE thing (modulo lets). -Note [Lone variables] See also Note [Interaction of exprIsWorkFree and lone variables] -~~~~~~~~~~~~~~~~~~~~~ which appears below +Note [Lone variables] +~~~~~~~~~~~~~~~~~~~~~ +See also Note [Interaction of exprIsWorkFree and lone variables] +which appears below + The "lone-variable" case is important. I spent ages messing about with unsatisfactory variants, but this is nice. The idea is that if a variable appears all alone diff --git a/testsuite/tests/simplCore/should_compile/T22317.hs b/testsuite/tests/simplCore/should_compile/T22317.hs new file mode 100644 index 0000000000..b3ec3d96f5 --- /dev/null +++ b/testsuite/tests/simplCore/should_compile/T22317.hs @@ -0,0 +1,20 @@ +{-# LANGUAGE BangPatterns #-} + +module T22317 where + +data T = T (Maybe Bool) (Maybe Bool) (Maybe Bool) (Maybe Bool) + + +m :: Maybe a -> Maybe a -> Maybe a +m (Just v1) Nothing = Just v1 +m _ mb = mb +{-# INLINE m #-} + +f :: T -> T -> T +f (T a1 b1 c1 d1) (T a2 b2 c2 d2) + = let j1 !a = let j2 !b = let j3 !c = let j4 !d = T a b c d + in j4 (m d1 d2) + in j3 (m c1 c2) + in j2 (m b1 b2) + in j1 (m a1 a2) +{-# OPAQUE f #-} diff --git a/testsuite/tests/simplCore/should_compile/T22317.stderr b/testsuite/tests/simplCore/should_compile/T22317.stderr new file mode 100644 index 0000000000..2358132fdc --- /dev/null +++ b/testsuite/tests/simplCore/should_compile/T22317.stderr @@ -0,0 +1,256 @@ +Considering inlining: m + arg infos [TrivArg, TrivArg] + interesting continuation BoringCtxt + some_benefit False + is exp: True + is work-free: True + guidance ALWAYS_IF(arity=2,unsat_ok=False,boring_ok=False) + ANSWER = NO +Considering inlining: m + arg infos [TrivArg, TrivArg] + interesting continuation BoringCtxt + some_benefit False + is exp: True + is work-free: True + guidance ALWAYS_IF(arity=2,unsat_ok=False,boring_ok=False) + ANSWER = NO +Considering inlining: m + arg infos [TrivArg, TrivArg] + interesting continuation BoringCtxt + some_benefit False + is exp: True + is work-free: True + guidance ALWAYS_IF(arity=2,unsat_ok=False,boring_ok=False) + ANSWER = NO +Considering inlining: m + arg infos [TrivArg, TrivArg] + interesting continuation BoringCtxt + some_benefit False + is exp: True + is work-free: True + guidance ALWAYS_IF(arity=2,unsat_ok=False,boring_ok=False) + ANSWER = NO +Considering inlining: m + arg infos [TrivArg, TrivArg] + interesting continuation BoringCtxt + some_benefit False + is exp: True + is work-free: True + guidance ALWAYS_IF(arity=2,unsat_ok=False,boring_ok=False) + ANSWER = NO +Considering inlining: m + arg infos [TrivArg, TrivArg] + interesting continuation BoringCtxt + some_benefit False + is exp: True + is work-free: True + guidance ALWAYS_IF(arity=2,unsat_ok=False,boring_ok=False) + ANSWER = NO +Considering inlining: m + arg infos [TrivArg, TrivArg] + interesting continuation BoringCtxt + some_benefit False + is exp: True + is work-free: True + guidance ALWAYS_IF(arity=2,unsat_ok=False,boring_ok=False) + ANSWER = NO +Considering inlining: m + arg infos [TrivArg, TrivArg] + interesting continuation BoringCtxt + some_benefit False + is exp: True + is work-free: True + guidance ALWAYS_IF(arity=2,unsat_ok=False,boring_ok=False) + ANSWER = NO +Considering inlining: m + arg infos [TrivArg, TrivArg] + interesting continuation BoringCtxt + some_benefit False + is exp: True + is work-free: True + guidance ALWAYS_IF(arity=2,unsat_ok=False,boring_ok=False) + ANSWER = NO +Considering inlining: m + arg infos [TrivArg, TrivArg] + interesting continuation BoringCtxt + some_benefit False + is exp: True + is work-free: True + guidance ALWAYS_IF(arity=2,unsat_ok=False,boring_ok=False) + ANSWER = NO +Considering inlining: m + arg infos [TrivArg, TrivArg] + interesting continuation BoringCtxt + some_benefit False + is exp: True + is work-free: True + guidance ALWAYS_IF(arity=2,unsat_ok=False,boring_ok=False) + ANSWER = NO +Considering inlining: m + arg infos [TrivArg, TrivArg] + interesting continuation BoringCtxt + some_benefit False + is exp: True + is work-free: True + guidance ALWAYS_IF(arity=2,unsat_ok=False,boring_ok=False) + ANSWER = NO +Considering inlining: m + arg infos [TrivArg, TrivArg] + interesting continuation BoringCtxt + some_benefit False + is exp: True + is work-free: True + guidance ALWAYS_IF(arity=2,unsat_ok=False,boring_ok=False) + ANSWER = NO +Considering inlining: m + arg infos [TrivArg, TrivArg] + interesting continuation BoringCtxt + some_benefit False + is exp: True + is work-free: True + guidance ALWAYS_IF(arity=2,unsat_ok=False,boring_ok=False) + ANSWER = NO +Considering inlining: m + arg infos [TrivArg, TrivArg] + interesting continuation BoringCtxt + some_benefit False + is exp: True + is work-free: True + guidance ALWAYS_IF(arity=2,unsat_ok=False,boring_ok=False) + ANSWER = NO +Considering inlining: m + arg infos [TrivArg, TrivArg] + interesting continuation BoringCtxt + some_benefit False + is exp: True + is work-free: True + guidance ALWAYS_IF(arity=2,unsat_ok=False,boring_ok=False) + ANSWER = NO +Considering inlining: m + arg infos [TrivArg, TrivArg] + interesting continuation BoringCtxt + some_benefit False + is exp: True + is work-free: True + guidance ALWAYS_IF(arity=2,unsat_ok=False,boring_ok=False) + ANSWER = NO +Considering inlining: m + arg infos [TrivArg, TrivArg] + interesting continuation BoringCtxt + some_benefit False + is exp: True + is work-free: True + guidance ALWAYS_IF(arity=2,unsat_ok=False,boring_ok=False) + ANSWER = NO +Considering inlining: m + arg infos [TrivArg, TrivArg] + interesting continuation BoringCtxt + some_benefit False + is exp: True + is work-free: True + guidance ALWAYS_IF(arity=2,unsat_ok=False,boring_ok=False) + ANSWER = NO +Considering inlining: m + arg infos [TrivArg, TrivArg] + interesting continuation BoringCtxt + some_benefit False + is exp: True + is work-free: True + guidance ALWAYS_IF(arity=2,unsat_ok=False,boring_ok=False) + ANSWER = NO +Considering inlining: m + arg infos [TrivArg, TrivArg] + interesting continuation BoringCtxt + some_benefit False + is exp: True + is work-free: True + guidance ALWAYS_IF(arity=2,unsat_ok=False,boring_ok=False) + ANSWER = NO +Considering inlining: m + arg infos [TrivArg, TrivArg] + interesting continuation BoringCtxt + some_benefit False + is exp: True + is work-free: True + guidance ALWAYS_IF(arity=2,unsat_ok=False,boring_ok=False) + ANSWER = NO +Considering inlining: m + arg infos [TrivArg, TrivArg] + interesting continuation BoringCtxt + some_benefit False + is exp: True + is work-free: True + guidance ALWAYS_IF(arity=2,unsat_ok=False,boring_ok=False) + ANSWER = NO +Considering inlining: m + arg infos [TrivArg, TrivArg] + interesting continuation BoringCtxt + some_benefit False + is exp: True + is work-free: True + guidance ALWAYS_IF(arity=2,unsat_ok=False,boring_ok=False) + ANSWER = NO +Considering inlining: m + arg infos [TrivArg, TrivArg] + interesting continuation BoringCtxt + some_benefit False + is exp: True + is work-free: True + guidance ALWAYS_IF(arity=2,unsat_ok=False,boring_ok=False) + ANSWER = NO +Considering inlining: m + arg infos [TrivArg, TrivArg] + interesting continuation BoringCtxt + some_benefit False + is exp: True + is work-free: True + guidance ALWAYS_IF(arity=2,unsat_ok=False,boring_ok=False) + ANSWER = NO +Considering inlining: m + arg infos [TrivArg, TrivArg] + interesting continuation BoringCtxt + some_benefit False + is exp: True + is work-free: True + guidance ALWAYS_IF(arity=2,unsat_ok=False,boring_ok=False) + ANSWER = NO +Considering inlining: m + arg infos [TrivArg, TrivArg] + interesting continuation BoringCtxt + some_benefit False + is exp: True + is work-free: True + guidance ALWAYS_IF(arity=2,unsat_ok=False,boring_ok=False) + ANSWER = NO +Considering inlining: m + arg infos [TrivArg, TrivArg] + interesting continuation BoringCtxt + some_benefit False + is exp: True + is work-free: True + guidance ALWAYS_IF(arity=2,unsat_ok=False,boring_ok=False) + ANSWER = NO +Considering inlining: m + arg infos [TrivArg, TrivArg] + interesting continuation BoringCtxt + some_benefit False + is exp: True + is work-free: True + guidance ALWAYS_IF(arity=2,unsat_ok=False,boring_ok=False) + ANSWER = NO +Considering inlining: m + arg infos [TrivArg, TrivArg] + interesting continuation BoringCtxt + some_benefit False + is exp: True + is work-free: True + guidance ALWAYS_IF(arity=2,unsat_ok=False,boring_ok=False) + ANSWER = NO +Considering inlining: m + arg infos [TrivArg, TrivArg] + interesting continuation BoringCtxt + some_benefit False + is exp: True + is work-free: True + guidance ALWAYS_IF(arity=2,unsat_ok=False,boring_ok=False) + ANSWER = NO diff --git a/testsuite/tests/simplCore/should_compile/T22375.stderr b/testsuite/tests/simplCore/should_compile/T22375.stderr index 826d3bc8eb..2fed873c64 100644 --- a/testsuite/tests/simplCore/should_compile/T22375.stderr +++ b/testsuite/tests/simplCore/should_compile/T22375.stderr @@ -1,7 +1,7 @@ ==================== Tidy Core ==================== Result size of Tidy Core - = {terms: 71, types: 31, coercions: 0, joins: 0/0} + = {terms: 76, types: 37, coercions: 0, joins: 0/0} -- RHS size: {terms: 14, types: 7, coercions: 0, joins: 0/0} T22375.$fEqX_$c== :: X -> X -> Bool @@ -46,7 +46,24 @@ T22375.$fEqX [InlPrag=CONLIKE] :: Eq X T22375.$fEqX = GHC.Classes.C:Eq @X T22375.$fEqX_$c== T22375.$fEqX_$c/= --- RHS size: {terms: 32, types: 5, coercions: 0, joins: 0/0} +-- RHS size: {terms: 24, types: 3, coercions: 0, joins: 0/0} +T22375.$wf [InlPrag=[2]] :: X -> GHC.Prim.Int# -> GHC.Prim.Int# +[GblId[StrictWorker([!])], + Arity=2, + Str=<1L><L>, + Unf=Unf{Src=<vanilla>, TopLvl=True, Value=True, ConLike=True, + WorkFree=True, Expandable=True, Guidance=IF_ARGS [64 0] 55 0}] +T22375.$wf + = \ (x :: X) (ww :: GHC.Prim.Int#) -> + case x of { + A -> GHC.Prim.+# 1# ww; + B -> GHC.Prim.+# 2# ww; + C -> GHC.Prim.+# 3# ww; + D -> GHC.Prim.+# 4# ww; + E -> GHC.Prim.+# 5# ww + } + +-- RHS size: {terms: 12, types: 5, coercions: 0, joins: 0/0} f [InlPrag=[2]] :: X -> Int -> Int [GblId, Arity=2, @@ -57,13 +74,7 @@ f [InlPrag=[2]] :: X -> Int -> Int Guidance=ALWAYS_IF(arity=2,unsat_ok=True,boring_ok=False)}] f = \ (x :: X) (v :: Int) -> case v of { GHC.Types.I# ww -> - case x of { - A -> GHC.Types.I# (GHC.Prim.+# 1# ww); - B -> GHC.Types.I# (GHC.Prim.+# 2# ww); - C -> GHC.Types.I# (GHC.Prim.+# 3# ww); - D -> GHC.Types.I# (GHC.Prim.+# 4# ww); - E -> GHC.Types.I# (GHC.Prim.+# 5# ww) - } + case T22375.$wf x ww of ww1 { __DEFAULT -> GHC.Types.I# ww1 } } diff --git a/testsuite/tests/simplCore/should_compile/all.T b/testsuite/tests/simplCore/should_compile/all.T index 88bbbc0b2c..583acbc47d 100644 --- a/testsuite/tests/simplCore/should_compile/all.T +++ b/testsuite/tests/simplCore/should_compile/all.T @@ -449,3 +449,5 @@ test('T22375', normal, compile, ['-O -ddump-simpl -dsuppress-uniques -dno-typeab # One module, T21851_2.hs, has OPTIONS_GHC -ddump-simpl # Expecting to see $s$wwombat test('T21851_2', [grep_errmsg(r'wwombat') ], multimod_compile, ['T21851_2', '-O -dno-typeable-binds -dsuppress-uniques']) +# Should not inline m, so there shouldn't be a single YES +test('T22317', [grep_errmsg(r'ANSWER = YES') ], compile, ['-O -dinline-check m -ddebug-output']) |