From c16382d57ed9bf51089a14f079404ff8b4ce6eb2 Mon Sep 17 00:00:00 2001 From: Simon Peyton Jones Date: Thu, 7 Jun 2018 11:03:21 +0100 Subject: Remove ad-hoc special case in occAnal Back in 1999 I put this ad-hoc code in the Case-handling code for occAnal: occAnal env (Case scrut bndr ty alts) = ... -- Note [Case binder usage] -- ~~~~~~~~~~~~~~~~~~~~~~~~ -- The case binder gets a usage of either "many" or "dead", never "one". -- Reason: we like to inline single occurrences, to eliminate a binding, -- but inlining a case binder *doesn't* eliminate a binding. -- We *don't* want to transform -- case x of w { (p,q) -> f w } -- into -- case x of w { (p,q) -> f (p,q) } tag_case_bndr usage bndr = (usage', setIdOccInfo bndr final_occ_info) where occ_info = lookupDetails usage bndr usage' = usage `delDetails` bndr final_occ_info = case occ_info of IAmDead -> IAmDead _ -> noOccInfo But the comment looks wrong -- the bad inlining will not happen -- and I think it relates to some long-ago version of the simplifier. So I simply removed the special case, which gives more accurate occurrence-info to the case binder. Interestingly I got a slight improvement in nofib binary sizes. -------------------------------------------------------------------------------- Program Size Allocs Runtime Elapsed TotalMem -------------------------------------------------------------------------------- cacheprof -0.1% +0.2% -0.7% -1.2% +8.6% -------------------------------------------------------------------------------- Min -0.2% 0.0% -14.5% -30.5% 0.0% Max -0.1% +0.2% +10.0% +10.0% +25.0% Geometric Mean -0.2% +0.0% -1.9% -5.4% +0.3% I have no idea if the improvement in runtime is real. I did look at the tiny increase in allocation for cacheprof and concluded that it was unimportant (I forget the details). Also the more accurate occ-info for the case binder meant that some inlining happens in one pass that previously took successive passes for the test dependent/should_compile/dynamic-paper (which has a known Russel-paradox infinite loop in the simplifier). In short, a small win: less ad-hoc complexity and slightly smaller binaries. --- testsuite/tests/codeGen/should_compile/T14626.stdout | 2 +- testsuite/tests/dependent/should_compile/all.T | 2 +- testsuite/tests/dependent/should_compile/dynamic-paper.stderr | 1 + testsuite/tests/simplCore/should_compile/T13143.stderr | 4 +++- testsuite/tests/simplCore/should_compile/T3717.stderr | 4 +++- testsuite/tests/simplCore/should_compile/T4930.stderr | 4 +++- testsuite/tests/simplCore/should_compile/T7360.stderr | 4 ++-- testsuite/tests/simplCore/should_compile/T7865.stdout | 2 +- testsuite/tests/simplCore/should_compile/spec-inline.stderr | 6 ++++-- 9 files changed, 19 insertions(+), 10 deletions(-) create mode 100644 testsuite/tests/dependent/should_compile/dynamic-paper.stderr (limited to 'testsuite') diff --git a/testsuite/tests/codeGen/should_compile/T14626.stdout b/testsuite/tests/codeGen/should_compile/T14626.stdout index 31e280e062..389d3e733a 100644 --- a/testsuite/tests/codeGen/should_compile/T14626.stdout +++ b/testsuite/tests/codeGen/should_compile/T14626.stdout @@ -1,2 +1,2 @@ - case dt of dt { __DEFAULT -> T14626.MkT dt } + case dt of dt [Occ=Once] { __DEFAULT -> T14626.MkT dt } case v of { T14626.MkT y [Occ=Once] -> diff --git a/testsuite/tests/dependent/should_compile/all.T b/testsuite/tests/dependent/should_compile/all.T index 66221840bb..e153cafe41 100644 --- a/testsuite/tests/dependent/should_compile/all.T +++ b/testsuite/tests/dependent/should_compile/all.T @@ -17,7 +17,7 @@ test('T9632', normal, compile, ['']) # discussed in #11330. test('dynamic-paper', expect_broken_for(11330, ['profasm']), - compile, ['']) + compile_fail, ['']) test('T11311', normal, compile, ['']) test('T11405', normal, compile, ['']) test('T11241', normal, compile, ['']) diff --git a/testsuite/tests/dependent/should_compile/dynamic-paper.stderr b/testsuite/tests/dependent/should_compile/dynamic-paper.stderr new file mode 100644 index 0000000000..0519ecba6e --- /dev/null +++ b/testsuite/tests/dependent/should_compile/dynamic-paper.stderr @@ -0,0 +1 @@ + \ No newline at end of file diff --git a/testsuite/tests/simplCore/should_compile/T13143.stderr b/testsuite/tests/simplCore/should_compile/T13143.stderr index 160a4a2c93..d8b0c1b468 100644 --- a/testsuite/tests/simplCore/should_compile/T13143.stderr +++ b/testsuite/tests/simplCore/should_compile/T13143.stderr @@ -105,7 +105,9 @@ g [InlPrag=NOUSERINLINE[2]] :: Bool -> Bool -> Int -> Int (w1 [Occ=Once] :: Bool) (w2 [Occ=Once!] :: Int) -> case w2 of { GHC.Types.I# ww1 [Occ=Once] -> - case T13143.$wg w w1 ww1 of ww2 { __DEFAULT -> GHC.Types.I# ww2 } + case T13143.$wg w w1 ww1 of ww2 [Occ=Once] { __DEFAULT -> + GHC.Types.I# ww2 + } }}] g = \ (w :: Bool) (w1 :: Bool) (w2 :: Int) -> case w2 of { GHC.Types.I# ww1 -> diff --git a/testsuite/tests/simplCore/should_compile/T3717.stderr b/testsuite/tests/simplCore/should_compile/T3717.stderr index a271850abf..45fdf89bb4 100644 --- a/testsuite/tests/simplCore/should_compile/T3717.stderr +++ b/testsuite/tests/simplCore/should_compile/T3717.stderr @@ -71,7 +71,9 @@ foo [InlPrag=NOUSERINLINE[2]] :: Int -> Int Guidance=ALWAYS_IF(arity=1,unsat_ok=True,boring_ok=False) Tmpl= \ (w [Occ=Once!] :: Int) -> case w of { GHC.Types.I# ww1 [Occ=Once] -> - case T3717.$wfoo ww1 of ww2 { __DEFAULT -> GHC.Types.I# ww2 } + case T3717.$wfoo ww1 of ww2 [Occ=Once] { __DEFAULT -> + GHC.Types.I# ww2 + } }}] foo = \ (w :: Int) -> diff --git a/testsuite/tests/simplCore/should_compile/T4930.stderr b/testsuite/tests/simplCore/should_compile/T4930.stderr index 02e8a6c65e..7556ecc9af 100644 --- a/testsuite/tests/simplCore/should_compile/T4930.stderr +++ b/testsuite/tests/simplCore/should_compile/T4930.stderr @@ -71,7 +71,9 @@ foo [InlPrag=NOUSERINLINE[2]] :: Int -> Int Guidance=ALWAYS_IF(arity=1,unsat_ok=True,boring_ok=False) Tmpl= \ (w [Occ=Once!] :: Int) -> case w of { GHC.Types.I# ww1 [Occ=Once] -> - case T4930.$wfoo ww1 of ww2 { __DEFAULT -> GHC.Types.I# ww2 } + case T4930.$wfoo ww1 of ww2 [Occ=Once] { __DEFAULT -> + GHC.Types.I# ww2 + } }}] foo = \ (w :: Int) -> diff --git a/testsuite/tests/simplCore/should_compile/T7360.stderr b/testsuite/tests/simplCore/should_compile/T7360.stderr index 8ae5953b43..f310e8f7a8 100644 --- a/testsuite/tests/simplCore/should_compile/T7360.stderr +++ b/testsuite/tests/simplCore/should_compile/T7360.stderr @@ -57,10 +57,10 @@ fun2 :: forall a. [a] -> ((), Int) Guidance=ALWAYS_IF(arity=1,unsat_ok=True,boring_ok=False) Tmpl= \ (@ a) (x [Occ=Once!] :: [a]) -> (T7360.fun5, - case x of wild { + case x of wild [Occ=Once] { [] -> T7360.fun4; : _ [Occ=Dead] _ [Occ=Dead] -> - case GHC.List.$wlenAcc @ a wild 0# of ww2 { __DEFAULT -> + case GHC.List.$wlenAcc @ a wild 0# of ww2 [Occ=Once] { __DEFAULT -> GHC.Types.I# ww2 } })}] diff --git a/testsuite/tests/simplCore/should_compile/T7865.stdout b/testsuite/tests/simplCore/should_compile/T7865.stdout index 7ea5449fbe..4073fec7ad 100644 --- a/testsuite/tests/simplCore/should_compile/T7865.stdout +++ b/testsuite/tests/simplCore/should_compile/T7865.stdout @@ -1,7 +1,7 @@ T7865.$wexpensive [InlPrag=NOINLINE] T7865.$wexpensive expensive [InlPrag=NOUSERINLINE[0]] :: Int -> Int - case T7865.$wexpensive ww1 of ww2 { __DEFAULT -> GHC.Types.I# ww2 } + case T7865.$wexpensive ww1 of ww2 [Occ=Once] { __DEFAULT -> expensive case T7865.$wexpensive ww1 of ww2 { __DEFAULT -> GHC.Types.I# ww2 } case T7865.$wexpensive ww1 of ww2 { __DEFAULT -> diff --git a/testsuite/tests/simplCore/should_compile/spec-inline.stderr b/testsuite/tests/simplCore/should_compile/spec-inline.stderr index 0b0c79695a..65dd9a1aa0 100644 --- a/testsuite/tests/simplCore/should_compile/spec-inline.stderr +++ b/testsuite/tests/simplCore/should_compile/spec-inline.stderr @@ -144,7 +144,9 @@ Roman.foo_go [InlPrag=NOUSERINLINE[2]] WorkFree=True, Expandable=True, Guidance=ALWAYS_IF(arity=2,unsat_ok=True,boring_ok=False) Tmpl= \ (w [Occ=Once] :: Maybe Int) (w1 [Occ=Once] :: Maybe Int) -> - case Roman.$wgo w w1 of ww { __DEFAULT -> GHC.Types.I# ww }}] + case Roman.$wgo w w1 of ww [Occ=Once] { __DEFAULT -> + GHC.Types.I# ww + }}] Roman.foo_go = \ (w :: Maybe Int) (w1 :: Maybe Int) -> case Roman.$wgo w w1 of ww { __DEFAULT -> GHC.Types.I# ww } @@ -177,7 +179,7 @@ foo :: Int -> Int WorkFree=True, Expandable=True, Guidance=ALWAYS_IF(arity=1,unsat_ok=True,boring_ok=False) Tmpl= \ (n [Occ=Once!] :: Int) -> - case n of n1 { GHC.Types.I# _ [Occ=Dead] -> + case n of n1 [Occ=Once] { GHC.Types.I# _ [Occ=Dead] -> Roman.foo_go (GHC.Base.Just @ Int n1) Roman.foo1 }}] foo -- cgit v1.2.1