[Git][ghc/ghc][wip/T22317] 2 commits: Make OpaqueNo* tests less noisy to unrelated changes
Sebastian Graf (@sgraf812)
gitlab at gitlab.haskell.org
Wed Nov 16 10:59:26 UTC 2022
Sebastian Graf pushed to branch wip/T22317 at Glasgow Haskell Compiler / GHC
Commits:
34b55d44 by Sebastian Graf at 2022-11-16T11:59:18+01:00
Make OpaqueNo* tests less noisy to unrelated changes
- - - - -
6b589a07 by Sebastian Graf at 2022-11-16T11:59:18+01:00
Simplifier: Consider `seq` as a `BoringCtxt` (#22317)
See `Note [Seq is boring]` for the rationale.
Fixes #22317.
- - - - -
6 changed files:
- compiler/GHC/Core/Opt/Simplify/Utils.hs
- compiler/GHC/Core/Unfold.hs
- + testsuite/tests/simplCore/should_compile/T22317.hs
- + testsuite/tests/simplCore/should_compile/T22317.stderr
- testsuite/tests/simplCore/should_compile/T22375.stderr
- testsuite/tests/simplCore/should_compile/all.T
Changes:
=====================================
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]
+~~~~~~~~~~~~~~~~~~~~
+Consider T22317
+
+ data T = T (Maybe Bool) (Maybe Bool) (Maybe Bool) (Maybe Bool)
+
+ m :: Maybe a -> Maybe a -> Maybe a
+ m = \ (@a_az7) (ds_dAn :: Maybe a_az7) (ds_dAo :: Maybe a_az7) ->
+ case ds_dAn of {
+ Nothing -> ds_dAo;
+ Just v1_awh ->
+ case ds_dAo of wild_X2 {
+ Nothing -> GHC.Maybe.Just @a_az7 v1_awh;
+ Just ipv_sAC -> ds_dAo
+ }
+ }
+ {-# INLINE m #-}
+
+ f :: T -> T -> T
+ f = \ (ds_dAv :: T) (ds_dAw :: T) ->
+ case ds_dAv of { T a1_awj b1_awk c1_awl d1_awm ->
+ case ds_dAw of { T a2_awn b2_awo c2_awp d2_awq ->
+ case m @Bool a1_awj a2_awn of a_X3 { __DEFAULT ->
+ case m @Bool b1_awk b2_awo of b_X4 { __DEFAULT ->
+ case m @Bool c1_awl c2_awp of c_X6 { __DEFAULT ->
+ case m @Bool d1_awm d2_awq of d_X8 { __DEFAULT ->
+ Lib.T a_X3 b_X4 c_X6 d_X8 }}}}}}
+
+Here we gain absolutely nothing by inlining `m`, just a bunch of join points
+from `m`'s definition and and case-of-case, bloating up the code.
+Hence even though case-of-case would fire here, we refrain from inlining `m`.
+We do so by regarding a seq context as a `BoringCtxt` (not `CaseCxt`).
+
+On the other hand, T14955 gives a compelling example where we want to
+inline a CPR'd wrapper
+
+ test3 xs = case xs of [] -> True; (x:xs) -> test3 xs
+ ==>
+ $wtest3 xs = case xs of [] -> (##); (x:xs) -> case test3 xs of __DEFAULT -> (##)
+ test3 xs = case $wtest3 xs of (##) -> True
+
+And it would be stupid not to inline test3 into $wtest3.
+Crucially, the case binder is dead in the latter example but not in the
+former, so the latter is much more likely to cancel away the result of
+test3 (and indeed it does), whereas a non-dead case binder indicates that
+the thing is going to be put in a field.
-}
lazyArgContext :: ArgInfo -> CallCtxt
@@ -811,10 +858,12 @@ 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 DEFAULT _ _] <- alts
+ , not (isDeadBinder case_bndr) = BoringCtxt -- See Note [Seq is boring]
+ | otherwise = CaseCtxt
+
interesting (ApplyToVal {}) = ValAppCtxt
-- Can happen if we have (f Int |> co) y
=====================================
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
=====================================
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 #-}
=====================================
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
=====================================
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 }
}
=====================================
testsuite/tests/simplCore/should_compile/all.T
=====================================
@@ -388,15 +388,15 @@ test('T20820', normal, compile, ['-O0'])
# Verify that the letrec is still there
test('T20895', [ grep_errmsg(r'\s*=\s*letrec') ], compile, ['-O0 -ddump-simpl -dsuppress-all -fno-local-float-out-top-level'])
-test('OpaqueNoAbsentArgWW', normal, compile, ['-O -ddump-simpl -dsuppress-uniques'])
+test('OpaqueNoAbsentArgWW', [ grep_errmsg(r'$wf') ], compile, ['-O -ddump-simpl -dsuppress-uniques'])
test('OpaqueNoCastWW', normal, compile, ['-O -ddump-simpl -dsuppress-uniques'])
-test('OpaqueNoRebox', normal, compile, ['-O -ddump-simpl -dsuppress-uniques'])
-test('OpaqueNoRebox2', normal, compile, ['-O -ddump-simpl -dsuppress-uniques'])
-test('OpaqueNoRebox3', normal, compile, ['-O -ddump-simpl -dsuppress-uniques'])
-test('OpaqueNoSpecConstr', req_interp, compile, ['-O -ddump-simpl -dsuppress-uniques'])
-test('OpaqueNoSpecialise', normal, compile, ['-O -ddump-simpl -dsuppress-uniques'])
-test('OpaqueNoStrictArgWW', normal, compile, ['-O -fworker-wrapper-cbv -ddump-simpl -dsuppress-uniques'])
-test('OpaqueNoWW', normal, compile, ['-O -ddump-simpl -dsuppress-uniques'])
+test('OpaqueNoRebox', [ grep_errmsg(r'$wf') ], compile, ['-O -ddump-simpl -dsuppress-uniques'])
+test('OpaqueNoRebox2', [ grep_errmsg(r'$wf') ], compile, ['-O -ddump-simpl -dsuppress-uniques'])
+test('OpaqueNoRebox3', [ grep_errmsg(r'$wf') ], compile, ['-O -ddump-simpl -dsuppress-uniques'])
+test('OpaqueNoSpecConstr', [ req_interp, grep_errmsg(r'$sloop') ], compile, ['-O -ddump-simpl -dsuppress-uniques'])
+test('OpaqueNoSpecialise', [ grep_errmsg(r'$sf') ], compile, ['-O -ddump-simpl -dsuppress-uniques'])
+test('OpaqueNoStrictArgWW', [ grep_errmsg(r'$wf') ], compile, ['-O -fworker-wrapper-cbv -ddump-simpl -dsuppress-uniques'])
+test('OpaqueNoWW', [ grep_errmsg(r'$wf') ], compile, ['-O -ddump-simpl -dsuppress-uniques'])
test('T21144', normal, compile, ['-O'])
@@ -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'])
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/8c81c480df60466a290b05c4337315cfbe8779f6...6b589a0730494413d5f7e0468ba1a7c3b26a40b1
--
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/8c81c480df60466a290b05c4337315cfbe8779f6...6b589a0730494413d5f7e0468ba1a7c3b26a40b1
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/20221116/acfa154c/attachment-0001.html>
More information about the ghc-commits
mailing list