diff options
author | Simon Peyton Jones <simonpj@microsoft.com> | 2019-11-08 17:49:35 +0000 |
---|---|---|
committer | Marge Bot <ben+marge-bot@smart-cactus.org> | 2020-04-02 01:45:58 -0400 |
commit | b943b25d0786da64031ac63ddf9b4574182057bb (patch) | |
tree | 529ac144237d1c4d7524360374fa8b33a6bd5ee4 /testsuite | |
parent | 3c09f636a459f50119bfbb5bf798b9a9e19eb464 (diff) | |
download | haskell-b943b25d0786da64031ac63ddf9b4574182057bb.tar.gz |
Re-engineer the binder-swap transformation
The binder-swap transformation is implemented by the occurrence
analyser -- see Note [Binder swap] in OccurAnal. However it had
a very nasty corner in it, for the case where the case scrutinee
was a GlobalId. This led to trouble and hacks, and ultimately
to #16296.
This patch re-engineers how the occurrence analyser implements
the binder-swap, by actually carrying out a substitution rather
than by adding a let-binding. It's all described in
Note [The binder-swap substitution].
I did a few other things along the way
* Fix a bug in StgCse, which could allow a loop breaker to be CSE'd
away. See Note [Care with loop breakers] in StgCse. I think it can
only show up if occurrence analyser sets up bad loop breakers, but
still.
* Better commenting in SimplUtils.prepareAlts
* A little refactoring in CoreUnfold; nothing significant
e.g. rename CoreUnfold.mkTopUnfolding to mkFinalUnfolding
* Renamed CoreSyn.isFragileUnfolding to hasCoreUnfolding
* Move mkRuleInfo to CoreFVs
We observed respectively 4.6% and 5.9% allocation decreases for the following
tests:
Metric Decrease:
T9961
haddock.base
Diffstat (limited to 'testsuite')
4 files changed, 21 insertions, 37 deletions
diff --git a/testsuite/tests/dependent/should_compile/dynamic-paper.stderr b/testsuite/tests/dependent/should_compile/dynamic-paper.stderr index 56da989d37..e9496e19e6 100644 --- a/testsuite/tests/dependent/should_compile/dynamic-paper.stderr +++ b/testsuite/tests/dependent/should_compile/dynamic-paper.stderr @@ -1,5 +1,5 @@ Simplifier ticks exhausted - When trying UnfoldingDone delta + When trying UnfoldingDone delta1 To increase the limit, use -fsimpl-tick-factor=N (default 100). If you need to increase the limit substantially, please file a @@ -12,4 +12,4 @@ Simplifier ticks exhausted simplifier non-termination has been judged acceptable. To see detailed counts use -ddump-simpl-stats - Total ticks: 140086 + Total ticks: 140082 diff --git a/testsuite/tests/simplCore/should_compile/T17901.stdout b/testsuite/tests/simplCore/should_compile/T17901.stdout index 406e81ef5f..99969cc0c1 100644 --- a/testsuite/tests/simplCore/should_compile/T17901.stdout +++ b/testsuite/tests/simplCore/should_compile/T17901.stdout @@ -4,13 +4,11 @@ C -> wombat1 T17901.C = \ (@p) (wombat1 :: T -> p) (x :: T) -> case x of wild { __DEFAULT -> wombat1 wild } - (wombat2 [Occ=Once*!] :: S -> p) - SA _ [Occ=Dead] -> wombat2 wild; - SB -> wombat2 T17901.SB + Tmpl= \ (@p) (wombat2 [Occ=Once!] :: S -> p) (x [Occ=Once] :: S) -> + case x of wild [Occ=Once] { __DEFAULT -> wombat2 wild }}] = \ (@p) (wombat2 :: S -> p) (x :: S) -> case x of wild { __DEFAULT -> wombat2 wild } - (wombat3 [Occ=Once*!] :: W -> p) - WB -> wombat3 T17901.WB; - WA _ [Occ=Dead] -> wombat3 wild + Tmpl= \ (@p) (wombat3 [Occ=Once!] :: W -> p) (x [Occ=Once] :: W) -> + case x of wild [Occ=Once] { __DEFAULT -> wombat3 wild }}] = \ (@p) (wombat3 :: W -> p) (x :: W) -> case x of wild { __DEFAULT -> wombat3 wild } diff --git a/testsuite/tests/simplCore/should_compile/T7360.hs b/testsuite/tests/simplCore/should_compile/T7360.hs index 2bf31f200a..4da49041f8 100644 --- a/testsuite/tests/simplCore/should_compile/T7360.hs +++ b/testsuite/tests/simplCore/should_compile/T7360.hs @@ -6,7 +6,7 @@ module T7360 where import GHC.List as L data Foo = Foo1 | Foo2 | Foo3 !Int - + fun1 :: Foo -> () {-# NOINLINE fun1 #-} fun1 x = case x of @@ -14,7 +14,7 @@ fun1 x = case x of Foo2 -> () Foo3 {} -> () -fun2 x = (fun1 Foo1, -- Keep -ddump-simpl output +fun2 x = (fun1 Foo1, -- Keep -ddump-simpl output -- in a predictable order case x of [] -> L.length x diff --git a/testsuite/tests/simplCore/should_compile/T7360.stderr b/testsuite/tests/simplCore/should_compile/T7360.stderr index b74aee564e..45c88f376e 100644 --- a/testsuite/tests/simplCore/should_compile/T7360.stderr +++ b/testsuite/tests/simplCore/should_compile/T7360.stderr @@ -1,7 +1,7 @@ ==================== Tidy Core ==================== Result size of Tidy Core - = {terms: 114, types: 53, coercions: 0, joins: 0/0} + = {terms: 106, types: 47, coercions: 0, joins: 0/0} -- RHS size: {terms: 6, types: 3, coercions: 0, joins: 0/0} T7360.$WFoo3 [InlPrag=INLINE[0]] :: Int -> Foo @@ -25,21 +25,13 @@ fun1 [InlPrag=NOINLINE] :: Foo -> () fun1 = \ (x :: Foo) -> case x of { __DEFAULT -> GHC.Tuple.() } -- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0} -T7360.fun5 :: () +T7360.fun4 :: () [GblId, Unf=Unf{Src=<vanilla>, TopLvl=True, Value=False, ConLike=False, WorkFree=False, Expandable=False, Guidance=IF_ARGS [] 20 0}] -T7360.fun5 = fun1 T7360.Foo1 +T7360.fun4 = fun1 T7360.Foo1 --- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0} -T7360.fun4 :: Int -[GblId, - Cpr=m1, - Unf=Unf{Src=<vanilla>, TopLvl=True, Value=True, ConLike=True, - WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 10 20}] -T7360.fun4 = GHC.Types.I# 0# - --- RHS size: {terms: 16, types: 13, coercions: 0, joins: 0/0} +-- RHS size: {terms: 11, types: 8, coercions: 0, joins: 0/0} fun2 :: forall {a}. [a] -> ((), Int) [GblId, Arity=1, @@ -48,24 +40,18 @@ fun2 :: forall {a}. [a] -> ((), Int) Unf=Unf{Src=InlineStable, TopLvl=True, Value=True, ConLike=True, WorkFree=True, Expandable=True, Guidance=ALWAYS_IF(arity=1,unsat_ok=True,boring_ok=False) - Tmpl= \ (@a) (x [Occ=Once!] :: [a]) -> - (T7360.fun5, - case x of wild [Occ=Once] { - [] -> T7360.fun4; - : _ [Occ=Dead] _ [Occ=Dead] -> - case GHC.List.$wlenAcc @a wild 0# of ww2 [Occ=Once] { __DEFAULT -> - GHC.Types.I# ww2 - } + Tmpl= \ (@a) (x [Occ=Once] :: [a]) -> + (T7360.fun4, + case x of wild [Occ=Once] { __DEFAULT -> + case GHC.List.$wlenAcc @a wild 0# of ww2 [Occ=Once] { __DEFAULT -> + GHC.Types.I# ww2 + } })}] fun2 = \ (@a) (x :: [a]) -> - (T7360.fun5, - case x of wild { - [] -> T7360.fun4; - : ds ds1 -> - case GHC.List.$wlenAcc @a wild 0# of ww2 { __DEFAULT -> - GHC.Types.I# ww2 - } + (T7360.fun4, + case GHC.List.$wlenAcc @a x 0# of ww2 { __DEFAULT -> + GHC.Types.I# ww2 }) -- RHS size: {terms: 1, types: 0, coercions: 0, joins: 0/0} |