summaryrefslogtreecommitdiff
path: root/testsuite
diff options
context:
space:
mode:
authorSimon Peyton Jones <simonpj@microsoft.com>2019-11-08 17:49:35 +0000
committerMarge Bot <ben+marge-bot@smart-cactus.org>2020-04-02 01:45:58 -0400
commitb943b25d0786da64031ac63ddf9b4574182057bb (patch)
tree529ac144237d1c4d7524360374fa8b33a6bd5ee4 /testsuite
parent3c09f636a459f50119bfbb5bf798b9a9e19eb464 (diff)
downloadhaskell-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')
-rw-r--r--testsuite/tests/dependent/should_compile/dynamic-paper.stderr4
-rw-r--r--testsuite/tests/simplCore/should_compile/T17901.stdout10
-rw-r--r--testsuite/tests/simplCore/should_compile/T7360.hs4
-rw-r--r--testsuite/tests/simplCore/should_compile/T7360.stderr40
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}