From b943b25d0786da64031ac63ddf9b4574182057bb Mon Sep 17 00:00:00 2001 From: Simon Peyton Jones Date: Fri, 8 Nov 2019 17:49:35 +0000 Subject: 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 --- .../tests/simplCore/should_compile/T17901.stdout | 10 +++--- testsuite/tests/simplCore/should_compile/T7360.hs | 4 +-- .../tests/simplCore/should_compile/T7360.stderr | 40 +++++++--------------- 3 files changed, 19 insertions(+), 35 deletions(-) (limited to 'testsuite/tests/simplCore') 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=, 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=, 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} -- cgit v1.2.1