diff options
Diffstat (limited to 'testsuite/tests')
21 files changed, 415 insertions, 434 deletions
diff --git a/testsuite/tests/arityanal/should_compile/Arity03.stderr b/testsuite/tests/arityanal/should_compile/Arity03.stderr index e5e3e754dd..f41fc1552c 100644 --- a/testsuite/tests/arityanal/should_compile/Arity03.stderr +++ b/testsuite/tests/arityanal/should_compile/Arity03.stderr @@ -18,18 +18,18 @@ end Rec } fac [InlPrag=[2]] :: Int -> Int [GblId, Arity=1, - Str=<1P(1L)>, - Cpr=m1, + Str=<1!P(1L)>, + Cpr=1, 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= \ (w [Occ=Once1!] :: Int) -> case w of { GHC.Types.I# ww1 [Occ=Once1] -> case F3.$wfac ww1 of ww2 [Occ=Once1] { __DEFAULT -> GHC.Types.I# ww2 } }}] -fac = \ (w :: Int) -> case w of { GHC.Types.I# ww1 -> case F3.$wfac ww1 of ww2 { __DEFAULT -> GHC.Types.I# ww2 } } + Tmpl= \ (x [Occ=Once1!] :: Int) -> case x of { GHC.Types.I# ww [Occ=Once1] -> case F3.$wfac ww of ww1 [Occ=Once1] { __DEFAULT -> GHC.Types.I# ww1 } }}] +fac = \ (x :: Int) -> case x of { GHC.Types.I# ww -> case F3.$wfac ww of ww1 { __DEFAULT -> GHC.Types.I# ww1 } } -- RHS size: {terms: 1, types: 0, coercions: 0, joins: 0/0} f3 :: Int -> Int [GblId, Arity=1, - Str=<1P(1L)>, - Cpr=m1, + Str=<1!P(1L)>, + Cpr=1, Unf=Unf{Src=InlineStable, TopLvl=True, Value=True, ConLike=True, WorkFree=True, Expandable=True, Guidance=ALWAYS_IF(arity=1,unsat_ok=True,boring_ok=True) Tmpl= fac}] f3 = fac diff --git a/testsuite/tests/arityanal/should_compile/Arity11.stderr b/testsuite/tests/arityanal/should_compile/Arity11.stderr index 7c7451a6d7..a4f2e38b53 100644 --- a/testsuite/tests/arityanal/should_compile/Arity11.stderr +++ b/testsuite/tests/arityanal/should_compile/Arity11.stderr @@ -142,4 +142,7 @@ f11 :: (Integer, Integer) f11 = (F11.f4, F11.f1) +------ Local rules for imported ids -------- +"SPEC fib @Integer @Integer" forall ($dEq :: Eq Integer) ($dNum :: Num Integer) ($dNum1 :: Num Integer). fib @Integer @Integer $dEq $dNum $dNum1 = F11.f11_fib + diff --git a/testsuite/tests/codeGen/should_compile/debug.stdout b/testsuite/tests/codeGen/should_compile/debug.stdout index 3dca62a419..25df0c258f 100644 --- a/testsuite/tests/codeGen/should_compile/debug.stdout +++ b/testsuite/tests/codeGen/should_compile/debug.stdout @@ -18,6 +18,7 @@ src<debug.hs:4:9> src<debug.hs:5:21-29> src<debug.hs:5:9-29> src<debug.hs:6:1-21> +src<debug.hs:6:16-21> == CBE == src<debug.hs:4:9> 89 diff --git a/testsuite/tests/driver/inline-check.stderr b/testsuite/tests/driver/inline-check.stderr index 40b5b59d19..a65d39ea6f 100644 --- a/testsuite/tests/driver/inline-check.stderr +++ b/testsuite/tests/driver/inline-check.stderr @@ -1,6 +1,6 @@ Considering inlining: foo arg infos [ValueArg] - interesting continuation RhsCtxt + interesting continuation RhsCtxt(NonRecursive) some_benefit True is exp: True is work-free: True @@ -19,7 +19,7 @@ Inactive unfolding: foo1 Inactive unfolding: foo1 Considering inlining: foo arg infos [] - interesting continuation RhsCtxt + interesting continuation RhsCtxt(NonRecursive) some_benefit False is exp: True is work-free: True diff --git a/testsuite/tests/numeric/should_compile/T19641.stderr b/testsuite/tests/numeric/should_compile/T19641.stderr index 8f6e3696be..7c1cf57b06 100644 --- a/testsuite/tests/numeric/should_compile/T19641.stderr +++ b/testsuite/tests/numeric/should_compile/T19641.stderr @@ -4,16 +4,16 @@ Result size of Tidy Core = {terms: 22, types: 20, coercions: 0, joins: 0/0} integer_to_int - = \ x -> - case x of { + = \ eta -> + case eta of { IS ipv -> Just (I# ipv); IP x1 -> Nothing; IN ds -> Nothing } natural_to_word - = \ x -> - case x of { + = \ eta -> + case eta of { NS x1 -> Just (W# x1); NB ds -> Nothing } diff --git a/testsuite/tests/profiling/should_run/T2552.prof.sample b/testsuite/tests/profiling/should_run/T2552.prof.sample index 7ed927f6db..c8bfad1ecf 100644 --- a/testsuite/tests/profiling/should_run/T2552.prof.sample +++ b/testsuite/tests/profiling/should_run/T2552.prof.sample @@ -1,36 +1,36 @@ - Sat Jun 4 11:59 2016 Time and Allocation Profiling Report (Final) + Mon Apr 25 16:27 2022 Time and Allocation Profiling Report (Final) T2552 +RTS -hc -p -RTS - total time = 0.09 secs (90 ticks @ 1000 us, 1 processor) - total alloc = 123,465,848 bytes (excludes profiling overheads) + total time = 0.05 secs (49 ticks @ 1000 us, 1 processor) + total alloc = 74,099,440 bytes (excludes profiling overheads) COST CENTRE MODULE SRC %time %alloc -fib1.fib1'.nfib Main T2552.hs:5:9-61 37.8 33.3 -fib2'.nfib Main T2552.hs:10:5-57 31.1 33.3 -fib3'.nfib Main T2552.hs:15:5-57 31.1 33.3 +fib1.fib1'.nfib Main T2552.hs:5:9-61 34.7 33.3 +fib3'.nfib Main T2552.hs:15:5-57 32.7 33.3 +fib2'.nfib Main T2552.hs:10:5-57 32.7 33.3 individual inherited COST CENTRE MODULE SRC no. entries %time %alloc %time %alloc -MAIN MAIN <built-in> 45 0 0.0 0.0 100.0 100.0 - CAF Main <entire-module> 89 0 0.0 0.0 100.0 100.0 - main Main T2552.hs:(17,1)-(20,17) 90 1 0.0 0.0 100.0 100.0 - fib1 Main T2552.hs:(1,1)-(5,61) 92 1 0.0 0.0 37.8 33.3 - fib1.fib1' Main T2552.hs:(3,5)-(5,61) 93 1 0.0 0.0 37.8 33.3 - nfib' Main T2552.hs:3:35-40 94 1 0.0 0.0 37.8 33.3 - fib1.fib1'.nfib Main T2552.hs:5:9-61 95 1028457 37.8 33.3 37.8 33.3 - fib2 Main T2552.hs:7:1-16 96 1 0.0 0.0 31.1 33.3 - fib2' Main T2552.hs:(8,1)-(10,57) 97 1 0.0 0.0 31.1 33.3 - fib2'.nfib Main T2552.hs:10:5-57 98 1028457 31.1 33.3 31.1 33.3 - fib3 Main T2552.hs:12:1-12 99 1 0.0 0.0 0.0 0.0 - fib3' Main T2552.hs:(13,1)-(15,57) 100 1 0.0 0.0 31.1 33.3 - fib3'.nfib Main T2552.hs:15:5-57 101 1028457 31.1 33.3 31.1 33.3 - CAF GHC.IO.Handle.FD <entire-module> 84 0 0.0 0.0 0.0 0.0 - CAF GHC.IO.Handle.Text <entire-module> 83 0 0.0 0.0 0.0 0.0 - CAF GHC.Conc.Signal <entire-module> 81 0 0.0 0.0 0.0 0.0 - CAF GHC.IO.Encoding <entire-module> 78 0 0.0 0.0 0.0 0.0 - CAF GHC.IO.Encoding.Iconv <entire-module> 64 0 0.0 0.0 0.0 0.0 - main Main T2552.hs:(17,1)-(20,17) 91 0 0.0 0.0 0.0 0.0 +MAIN MAIN <built-in> 128 0 0.0 0.0 100.0 100.0 + CAF Main <entire-module> 255 0 0.0 0.0 100.0 99.9 + fib3 Main T2552.hs:12:1-12 265 1 0.0 0.0 0.0 0.0 + main Main T2552.hs:(17,1)-(20,17) 256 1 0.0 0.0 100.0 99.9 + fib1 Main T2552.hs:(1,1)-(5,61) 258 1 0.0 0.0 34.7 33.3 + fib1.fib1' Main T2552.hs:(3,5)-(5,61) 259 1 0.0 0.0 34.7 33.3 + nfib' Main T2552.hs:3:35-40 260 1 0.0 0.0 34.7 33.3 + fib1.fib1'.nfib Main T2552.hs:5:9-61 261 1028457 34.7 33.3 34.7 33.3 + fib2 Main T2552.hs:7:1-16 262 1 0.0 0.0 32.7 33.3 + fib2' Main T2552.hs:(8,1)-(10,57) 263 1 0.0 0.0 32.7 33.3 + fib2'.nfib Main T2552.hs:10:5-57 264 1028457 32.7 33.3 32.7 33.3 + fib3 Main T2552.hs:12:1-12 266 0 0.0 0.0 32.7 33.3 + fib3' Main T2552.hs:(13,1)-(15,57) 267 1 0.0 0.0 32.7 33.3 + fib3'.nfib Main T2552.hs:15:5-57 268 1028457 32.7 33.3 32.7 33.3 + CAF GHC.Conc.Signal <entire-module> 250 0 0.0 0.0 0.0 0.0 + CAF GHC.IO.Encoding <entire-module> 241 0 0.0 0.0 0.0 0.0 + CAF GHC.IO.Encoding.Iconv <entire-module> 239 0 0.0 0.0 0.0 0.0 + CAF GHC.IO.Handle.FD <entire-module> 231 0 0.0 0.0 0.0 0.0 + main Main T2552.hs:(17,1)-(20,17) 257 0 0.0 0.0 0.0 0.0 diff --git a/testsuite/tests/profiling/should_run/all.T b/testsuite/tests/profiling/should_run/all.T index 0455d06f17..96a0d30bc6 100644 --- a/testsuite/tests/profiling/should_run/all.T +++ b/testsuite/tests/profiling/should_run/all.T @@ -93,7 +93,7 @@ test('T5314', [extra_ways(extra_prof_ways)], compile_and_run, ['']) test('T680', [], compile_and_run, ['-fno-full-laziness']) # Note [consistent stacks] -test('T2552', [expect_broken_for_10037], compile_and_run, ['']) +test('T2552', [], compile_and_run, ['']) test('T949', [extra_ways(extra_prof_ways)], compile_and_run, ['']) @@ -101,7 +101,7 @@ test('T949', [extra_ways(extra_prof_ways)], compile_and_run, ['']) # We care more about getting the optimised results right, so ignoring # this for now. test('ioprof', - [expect_broken_for_10037, + [normal, exit_code(1), omit_ways(['ghci-ext-prof']), # doesn't work with exit_code(1) ignore_stderr diff --git a/testsuite/tests/profiling/should_run/ioprof.prof.sample b/testsuite/tests/profiling/should_run/ioprof.prof.sample index 52ab8ba4d2..103207d8ca 100644 --- a/testsuite/tests/profiling/should_run/ioprof.prof.sample +++ b/testsuite/tests/profiling/should_run/ioprof.prof.sample @@ -1,46 +1,54 @@ - Sat Jun 4 11:59 2016 Time and Allocation Profiling Report (Final) + Mon May 23 13:50 2022 Time and Allocation Profiling Report (Final) ioprof +RTS -hc -p -RTS total time = 0.00 secs (0 ticks @ 1000 us, 1 processor) - total alloc = 180,024 bytes (excludes profiling overheads) + total alloc = 129,248 bytes (excludes profiling overheads) COST CENTRE MODULE SRC %time %alloc -CAF GHC.IO.Encoding <entire-module> 0.0 1.8 -CAF GHC.IO.Handle.FD <entire-module> 0.0 19.2 -CAF GHC.Exception <entire-module> 0.0 2.5 -main Main ioprof.hs:28:1-43 0.0 4.8 -errorM.\ Main ioprof.hs:23:22-28 0.0 68.7 +CAF Main <entire-module> 0.0 1.1 +main Main ioprof.hs:28:1-43 0.0 6.8 +errorM.\ Main ioprof.hs:23:22-28 0.0 56.8 +CAF GHC.IO.Handle.FD <entire-module> 0.0 26.9 +CAF GHC.IO.Exception <entire-module> 0.0 1.0 +CAF GHC.IO.Encoding <entire-module> 0.0 2.3 +CAF GHC.Exception <entire-module> 0.0 3.0 - individual inherited -COST CENTRE MODULE SRC no. entries %time %alloc %time %alloc + individual inherited +COST CENTRE MODULE SRC no. entries %time %alloc %time %alloc -MAIN MAIN <built-in> 46 0 0.0 0.4 0.0 100.0 - CAF Main <entire-module> 91 0 0.0 0.9 0.0 69.8 - <*> Main ioprof.hs:20:5-14 96 1 0.0 0.0 0.0 0.0 - fmap Main ioprof.hs:16:5-16 100 1 0.0 0.0 0.0 0.0 - main Main ioprof.hs:28:1-43 92 1 0.0 0.0 0.0 68.9 - runM Main ioprof.hs:26:1-37 94 1 0.0 0.1 0.0 68.9 - bar Main ioprof.hs:31:1-20 95 1 0.0 0.1 0.0 68.8 - foo Main ioprof.hs:34:1-16 104 1 0.0 0.0 0.0 0.0 - errorM Main ioprof.hs:23:1-28 105 1 0.0 0.0 0.0 0.0 - <*> Main ioprof.hs:20:5-14 97 0 0.0 0.0 0.0 68.7 - >>= Main ioprof.hs:(11,3)-(12,50) 98 1 0.0 0.0 0.0 68.7 - >>=.\ Main ioprof.hs:(11,27)-(12,50) 99 2 0.0 0.0 0.0 68.7 - fmap Main ioprof.hs:16:5-16 103 0 0.0 0.0 0.0 0.0 - foo Main ioprof.hs:34:1-16 106 0 0.0 0.0 0.0 68.7 - errorM Main ioprof.hs:23:1-28 107 0 0.0 0.0 0.0 68.7 - errorM.\ Main ioprof.hs:23:22-28 108 1 0.0 68.7 0.0 68.7 - fmap Main ioprof.hs:16:5-16 101 0 0.0 0.0 0.0 0.0 - >>= Main ioprof.hs:(11,3)-(12,50) 102 1 0.0 0.0 0.0 0.0 - CAF GHC.IO.Exception <entire-module> 89 0 0.0 0.7 0.0 0.7 - CAF GHC.Exception <entire-module> 86 0 0.0 2.5 0.0 2.5 - CAF GHC.IO.Handle.FD <entire-module> 85 0 0.0 19.2 0.0 19.2 - CAF GHC.Conc.Signal <entire-module> 82 0 0.0 0.4 0.0 0.4 - CAF GHC.IO.Encoding <entire-module> 80 0 0.0 1.8 0.0 1.8 - CAF GHC.Conc.Sync <entire-module> 75 0 0.0 0.1 0.0 0.1 - CAF GHC.Stack.CCS <entire-module> 71 0 0.0 0.2 0.0 0.2 - CAF GHC.IO.Encoding.Iconv <entire-module> 64 0 0.0 0.1 0.0 0.1 - main Main ioprof.hs:28:1-43 93 0 0.0 4.8 0.0 4.8 +MAIN MAIN <built-in> 129 0 0.0 0.5 0.0 100.0 + CAF GHC.Conc.Signal <entire-module> 233 0 0.0 0.5 0.0 0.5 + CAF GHC.Conc.Sync <entire-module> 232 0 0.0 0.5 0.0 0.5 + CAF GHC.Exception <entire-module> 215 0 0.0 3.0 0.0 3.0 + CAF GHC.IO.Encoding <entire-module> 199 0 0.0 2.3 0.0 2.3 + CAF GHC.IO.Encoding.Iconv <entire-module> 197 0 0.0 0.2 0.0 0.2 + CAF GHC.IO.Exception <entire-module> 191 0 0.0 1.0 0.0 1.0 + CAF GHC.IO.Handle.FD <entire-module> 188 0 0.0 26.9 0.0 26.9 + CAF GHC.Stack.CCS <entire-module> 167 0 0.0 0.2 0.0 0.2 + CAF GHC.Weak.Finalize <entire-module> 158 0 0.0 0.0 0.0 0.0 + CAF Main <entire-module> 136 0 0.0 1.1 0.0 1.1 + <*> Main ioprof.hs:20:5-14 261 1 0.0 0.0 0.0 0.0 + fmap Main ioprof.hs:16:5-16 269 1 0.0 0.0 0.0 0.0 + main Main ioprof.hs:28:1-43 258 1 0.0 0.0 0.0 0.0 + main Main ioprof.hs:28:1-43 259 0 0.0 6.8 0.0 63.7 + bar Main ioprof.hs:31:1-20 260 1 0.0 0.1 0.0 0.2 + foo Main ioprof.hs:34:1-16 275 1 0.0 0.0 0.0 0.0 + errorM Main ioprof.hs:23:1-28 276 1 0.0 0.0 0.0 0.0 + <*> Main ioprof.hs:20:5-14 262 0 0.0 0.0 0.0 0.0 + >>= Main ioprof.hs:(11,3)-(12,50) 263 1 0.0 0.0 0.0 0.0 + fmap Main ioprof.hs:16:5-16 270 0 0.0 0.0 0.0 0.0 + >>= Main ioprof.hs:(11,3)-(12,50) 271 1 0.0 0.0 0.0 0.0 + runM Main ioprof.hs:26:1-37 264 1 0.0 0.0 0.0 56.8 + bar Main ioprof.hs:31:1-20 265 0 0.0 0.0 0.0 56.8 + <*> Main ioprof.hs:20:5-14 266 0 0.0 0.0 0.0 0.0 + >>= Main ioprof.hs:(11,3)-(12,50) 267 0 0.0 0.0 0.0 0.0 + >>=.\ Main ioprof.hs:(11,27)-(12,50) 268 1 0.0 0.0 0.0 0.0 + fmap Main ioprof.hs:16:5-16 272 0 0.0 0.0 0.0 0.0 + >>= Main ioprof.hs:(11,3)-(12,50) 273 0 0.0 0.0 0.0 0.0 + >>=.\ Main ioprof.hs:(11,27)-(12,50) 274 1 0.0 0.0 0.0 0.0 + foo Main ioprof.hs:34:1-16 277 0 0.0 0.0 0.0 56.8 + errorM Main ioprof.hs:23:1-28 278 0 0.0 0.0 0.0 56.8 + errorM.\ Main ioprof.hs:23:22-28 279 1 0.0 56.8 0.0 56.8 diff --git a/testsuite/tests/simplCore/should_compile/Makefile b/testsuite/tests/simplCore/should_compile/Makefile index 02358e1746..b1ed06bf71 100644 --- a/testsuite/tests/simplCore/should_compile/Makefile +++ b/testsuite/tests/simplCore/should_compile/Makefile @@ -160,12 +160,12 @@ T5298: .PHONY: T5327 T5327: $(RM) -f T5327.hi T5327.o - '$(TEST_HC)' $(TEST_HC_OPTS) -c T5327.hs -O -ddump-simpl | grep -c '># 34# ' + '$(TEST_HC)' $(TEST_HC_OPTS) -c T5327.hs -O -ddump-simpl | grep -c '34#' .PHONY: T16254 T16254: $(RM) -f T16254.hi T16254.o - '$(TEST_HC)' $(TEST_HC_OPTS) -c T16254.hs -O -ddump-simpl | grep -c '># 34# ' + '$(TEST_HC)' $(TEST_HC_OPTS) -c T16254.hs -O -ddump-simpl | grep -c '34#' .PHONY: T5623 T5623: diff --git a/testsuite/tests/simplCore/should_compile/T16254.hs b/testsuite/tests/simplCore/should_compile/T16254.hs index 3c1490c17c..a877eee6ab 100644 --- a/testsuite/tests/simplCore/should_compile/T16254.hs +++ b/testsuite/tests/simplCore/should_compile/T16254.hs @@ -8,7 +8,12 @@ newtype Size a b where {-# INLINABLE val2 #-} val2 = Size 17 --- In the core, we should see a comparison against 34#, i.e. constant --- folding should have happened. We actually see it twice: Once in f's --- definition, and once in its unfolding. +-- In the core, we should see 34#, i.e. constant folding +-- should have happened. +-- +-- We actually get eta-reduction thus: +-- tmp = I# 34# +-- f = gtInt tmp +-- beucase gtInt is marked INLINE with two parameters. +-- But that's ok f n = case val2 of Size s -> s + s > n diff --git a/testsuite/tests/simplCore/should_compile/T5327.hs b/testsuite/tests/simplCore/should_compile/T5327.hs index a2d9c018ae..a533a2fe32 100644 --- a/testsuite/tests/simplCore/should_compile/T5327.hs +++ b/testsuite/tests/simplCore/should_compile/T5327.hs @@ -5,8 +5,13 @@ newtype Size = Size Int {-# INLINABLE val2 #-} val2 = Size 17 --- In the core, we should see a comparison against 34#, i.e. constant --- folding should have happened. We actually see it twice: Once in f's --- definition, and once in its unfolding. +-- In the core, we should see 34#, i.e. constant folding +-- should have happened. +-- +-- We actually get eta-reduction thus: +-- tmp = I# 34# +-- f = gtInt tmp +-- beucase gtInt is marked INLINE with two parameters. +-- But that's ok f n = case val2 of Size s -> s + s > n diff --git a/testsuite/tests/simplCore/should_compile/T7785.stderr b/testsuite/tests/simplCore/should_compile/T7785.stderr index f2f819f89a..504fdc1677 100644 --- a/testsuite/tests/simplCore/should_compile/T7785.stderr +++ b/testsuite/tests/simplCore/should_compile/T7785.stderr @@ -1,408 +1,331 @@ - -==================== Specialise ==================== -Result size of Specialise - = {terms: 293, types: 99, coercions: 11, joins: 0/2} +==================== Common sub-expression ==================== +Result size of Common sub-expression + = {terms: 181, types: 89, coercions: 5, joins: 0/1} -- RHS size: {terms: 5, types: 10, coercions: 0, joins: 0/0} -$cmyfmap_aG0 +$cmyfmap_aG7 :: forall a b. (Domain [] a, Domain [] b) => (a -> b) -> [a] -> [b] [LclId, Arity=4, - Unf=Unf{Src=<vanilla>, TopLvl=True, Value=True, ConLike=True, + Str=<A><A><U><SU>, + Unf=Unf{Src=InlineStable, TopLvl=True, Value=True, ConLike=True, WorkFree=True, Expandable=True, - Guidance=ALWAYS_IF(arity=2,unsat_ok=True,boring_ok=True)}] -$cmyfmap_aG0 - = \ (@a_aG3) (@b_aG4) _ [Occ=Dead] _ [Occ=Dead] -> - map @a_aG3 @b_aG4 + Guidance=ALWAYS_IF(arity=2,unsat_ok=True,boring_ok=True) + Tmpl= \ (@a_aGa) + (@b_aGb) + _ [Occ=Dead] + _ [Occ=Dead] + (eta_B0 [Occ=Once1, OS=OneShot] :: a_aGa -> b_aGb) + (eta_B1 [Occ=Once1, OS=OneShot] :: [a_aGa]) -> + GHC.Base.build + @b_aGb + (\ (@b1_aHe) + (c_aHf [Occ=Once1, OS=OneShot] :: b_aGb -> b1_aHe -> b1_aHe) + (n_aHg [Occ=Once1, OS=OneShot] :: b1_aHe) -> + GHC.Base.foldr + @a_aGa + @b1_aHe + (GHC.Base.mapFB @b_aGb @b1_aHe @a_aGa c_aHf eta_B0) + n_aHg + eta_B1)}] +$cmyfmap_aG7 + = \ (@a_aGa) + (@b_aGb) + _ [Occ=Dead, Dmd=A] + _ [Occ=Dead, Dmd=A, OS=OneShot] -> + map @a_aGa @b_aGb -- RHS size: {terms: 1, types: 0, coercions: 3, joins: 0/0} -Foo.$fMyFunctor[] [InlPrag=CONLIKE] :: MyFunctor [] +Foo.$fMyFunctor[] [InlPrag=INLINE (sat-args=0)] :: MyFunctor [] [LclIdX[DFunId(nt)], Arity=4, - Unf=DFun: \ -> Foo.C:MyFunctor TYPE: [] $cmyfmap_aG0] + Str=<A><A><U><SU>, + Unf=Unf{Src=InlineStable, TopLvl=True, Value=True, ConLike=True, + WorkFree=True, Expandable=True, + Guidance=ALWAYS_IF(arity=0,unsat_ok=False,boring_ok=True) + Tmpl= $cmyfmap_aG7 + `cast` (Sym (Foo.N:MyFunctor[0] <[]>_N) + :: (forall a b. + (Domain [] a, Domain [] b) => + (a -> b) -> [a] -> [b]) + ~R# MyFunctor [])}] Foo.$fMyFunctor[] - = $cmyfmap_aG0 + = $cmyfmap_aG7 `cast` (Sym (Foo.N:MyFunctor[0] <[]>_N) :: (forall a b. (Domain [] a, Domain [] b) => (a -> b) -> [a] -> [b]) ~R# MyFunctor []) --- RHS size: {terms: 114, types: 12, coercions: 0, joins: 0/1} -$sshared_sHu :: Domain [] Int => [Int] -> [Int] -[LclId, Arity=1] -$sshared_sHu - = \ (irred_azD :: Domain [] Int) -> - let { - f_sHt :: [Int] -> [Int] - [LclId] - f_sHt - = myfmap - @[] - Foo.$fMyFunctor[] - @Int - @Int - irred_azD - irred_azD - GHC.Num.$fNumInt_$cnegate } in - \ (x_X4N :: [Int]) -> - f_sHt - (f_sHt - (f_sHt - (f_sHt - (f_sHt - (f_sHt - (f_sHt - (f_sHt - (f_sHt - (f_sHt - (f_sHt - (f_sHt - (f_sHt - (f_sHt - (f_sHt - (f_sHt - (f_sHt - (f_sHt - (f_sHt - (f_sHt - (f_sHt - (f_sHt - (f_sHt - (f_sHt - (f_sHt - (f_sHt - (f_sHt - (f_sHt - (f_sHt - (f_sHt - (f_sHt - (f_sHt - (f_sHt - (f_sHt - (f_sHt - (f_sHt - (f_sHt - (f_sHt - (f_sHt - (f_sHt - (f_sHt - (f_sHt - (f_sHt - (f_sHt - (f_sHt - (f_sHt - (f_sHt - (f_sHt - (f_sHt - (f_sHt - (f_sHt - (f_sHt - (f_sHt - (f_sHt - (f_sHt - (f_sHt - (f_sHt - (f_sHt - (f_sHt - (f_sHt - (f_sHt - (f_sHt - (f_sHt - (f_sHt - (f_sHt - (f_sHt - (f_sHt - (f_sHt - (f_sHt - (f_sHt - (f_sHt - (f_sHt - (f_sHt - (f_sHt - (f_sHt - (f_sHt - (f_sHt - (f_sHt - (f_sHt - (f_sHt - (f_sHt - (f_sHt - (f_sHt - (f_sHt - (f_sHt - (f_sHt - (f_sHt - (f_sHt - (f_sHt - (f_sHt - (f_sHt - (f_sHt - (f_sHt - (f_sHt - (f_sHt - (f_sHt - (f_sHt - (f_sHt - (f_sHt - (f_sHt - (f_sHt - (f_sHt - (f_sHt - (f_sHt - (f_sHt - x_X4N)))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))) +-- RHS size: {terms: 2, types: 2, coercions: 0, joins: 0/0} +$sshared_sHD :: [Int] -> [Int] +[LclId, + Arity=1, + Str=<SU>, + Unf=Unf{Src=InlineStable, TopLvl=True, Value=True, ConLike=True, + WorkFree=True, Expandable=True, + Guidance=ALWAYS_IF(arity=0,unsat_ok=True,boring_ok=False) + Tmpl= map @Int @Int GHC.Num.$fNumInt_$cnegate}] +$sshared_sHD = map @Int @Int GHC.Num.$fNumInt_$cnegate --- RHS size: {terms: 116, types: 16, coercions: 0, joins: 0/1} +-- RHS size: {terms: 115, types: 15, coercions: 2, joins: 0/1} shared :: forall (f :: * -> *). (MyFunctor f, Domain f Int) => f Int -> f Int [LclIdX, Arity=2, - Unf=Unf{Src=<vanilla>, TopLvl=True, Value=True, ConLike=True, - WorkFree=True, Expandable=True, Guidance=NEVER}, + Str=<UC1(CS(CS(U)))><U>, RULES: "SPEC shared @[]" - forall ($dMyFunctor_sHr :: MyFunctor []). - shared @[] $dMyFunctor_sHr - = $sshared_sHu] + forall ($dMyFunctor_sHz :: MyFunctor []) + (irred_sHA :: Domain [] Int). + shared @[] $dMyFunctor_sHz irred_sHA + = $sshared_sHD] shared - = \ (@(f_azB :: * -> *)) - ($dMyFunctor_azC :: MyFunctor f_azB) - (irred_azD :: Domain f_azB Int) -> + = \ (@(f_ayh :: * -> *)) + ($dMyFunctor_ayi [Dmd=UC1(CS(CS(U)))] :: MyFunctor f_ayh) + (irred_ayj :: Domain f_ayh Int) -> let { - f_sHq :: f_azB Int -> f_azB Int + f_sHy :: f_ayh Int -> f_ayh Int [LclId] - f_sHq - = myfmap - @f_azB - $dMyFunctor_azC - @Int - @Int - irred_azD - irred_azD - GHC.Num.$fNumInt_$cnegate } in - \ (x_X4N :: f_azB Int) -> - f_sHq - (f_sHq - (f_sHq - (f_sHq - (f_sHq - (f_sHq - (f_sHq - (f_sHq - (f_sHq - (f_sHq - (f_sHq - (f_sHq - (f_sHq - (f_sHq - (f_sHq - (f_sHq - (f_sHq - (f_sHq - (f_sHq - (f_sHq - (f_sHq - (f_sHq - (f_sHq - (f_sHq - (f_sHq - (f_sHq - (f_sHq - (f_sHq - (f_sHq - (f_sHq - (f_sHq - (f_sHq - (f_sHq - (f_sHq - (f_sHq - (f_sHq - (f_sHq - (f_sHq - (f_sHq - (f_sHq - (f_sHq - (f_sHq - (f_sHq - (f_sHq - (f_sHq - (f_sHq - (f_sHq - (f_sHq - (f_sHq - (f_sHq - (f_sHq - (f_sHq - (f_sHq - (f_sHq - (f_sHq - (f_sHq - (f_sHq - (f_sHq - (f_sHq - (f_sHq - (f_sHq - (f_sHq - (f_sHq - (f_sHq - (f_sHq - (f_sHq - (f_sHq - (f_sHq - (f_sHq - (f_sHq - (f_sHq - (f_sHq - (f_sHq - (f_sHq - (f_sHq - (f_sHq - (f_sHq - (f_sHq - (f_sHq - (f_sHq - (f_sHq - (f_sHq - (f_sHq - (f_sHq - (f_sHq - (f_sHq - (f_sHq - (f_sHq - (f_sHq - (f_sHq - (f_sHq - (f_sHq - (f_sHq - (f_sHq - (f_sHq - (f_sHq - (f_sHq - (f_sHq - (f_sHq - (f_sHq - (f_sHq - (f_sHq - (f_sHq - (f_sHq - (f_sHq + f_sHy + = ($dMyFunctor_ayi + `cast` (Foo.N:MyFunctor[0] <f_ayh>_N + :: MyFunctor f_ayh + ~R# (forall a b. + (Domain f_ayh a, Domain f_ayh b) => + (a -> b) -> f_ayh a -> f_ayh b))) + @Int @Int irred_ayj irred_ayj GHC.Num.$fNumInt_$cnegate } in + \ (x_X4N :: f_ayh Int) -> + f_sHy + (f_sHy + (f_sHy + (f_sHy + (f_sHy + (f_sHy + (f_sHy + (f_sHy + (f_sHy + (f_sHy + (f_sHy + (f_sHy + (f_sHy + (f_sHy + (f_sHy + (f_sHy + (f_sHy + (f_sHy + (f_sHy + (f_sHy + (f_sHy + (f_sHy + (f_sHy + (f_sHy + (f_sHy + (f_sHy + (f_sHy + (f_sHy + (f_sHy + (f_sHy + (f_sHy + (f_sHy + (f_sHy + (f_sHy + (f_sHy + (f_sHy + (f_sHy + (f_sHy + (f_sHy + (f_sHy + (f_sHy + (f_sHy + (f_sHy + (f_sHy + (f_sHy + (f_sHy + (f_sHy + (f_sHy + (f_sHy + (f_sHy + (f_sHy + (f_sHy + (f_sHy + (f_sHy + (f_sHy + (f_sHy + (f_sHy + (f_sHy + (f_sHy + (f_sHy + (f_sHy + (f_sHy + (f_sHy + (f_sHy + (f_sHy + (f_sHy + (f_sHy + (f_sHy + (f_sHy + (f_sHy + (f_sHy + (f_sHy + (f_sHy + (f_sHy + (f_sHy + (f_sHy + (f_sHy + (f_sHy + (f_sHy + (f_sHy + (f_sHy + (f_sHy + (f_sHy + (f_sHy + (f_sHy + (f_sHy + (f_sHy + (f_sHy + (f_sHy + (f_sHy + (f_sHy + (f_sHy + (f_sHy + (f_sHy + (f_sHy + (f_sHy + (f_sHy + (f_sHy + (f_sHy + (f_sHy + (f_sHy + (f_sHy + (f_sHy + (f_sHy + (f_sHy x_X4N)))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))) --- RHS size: {terms: 8, types: 4, coercions: 4, joins: 0/0} +-- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0} +lvl_sHI :: Int +[LclId] +lvl_sHI = GHC.Types.I# 0# + +-- RHS size: {terms: 6, types: 5, coercions: 0, joins: 0/0} foo :: [Int] -> [Int] [LclIdX, Arity=1, - Unf=Unf{Src=<vanilla>, TopLvl=True, Value=True, ConLike=True, - WorkFree=True, Expandable=True, Guidance=IF_ARGS [0] 60 0}] + Str=<U>, + 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= \ (xs_awV [Occ=Once1] :: [Int]) -> + GHC.Base.build + @Int + (\ (@b1_aHe) + (c_aHf [Occ=Once1, OS=OneShot] :: Int -> b1_aHe -> b1_aHe) + (n_aHg [Occ=Once1, OS=OneShot] :: b1_aHe) -> + GHC.Base.foldr + @Int + @b1_aHe + (GHC.Base.mapFB @Int @b1_aHe @Int c_aHf GHC.Num.$fNumInt_$cnegate) + n_aHg + (GHC.Types.: @Int lvl_sHI xs_awV))}] foo - = \ (xs_axd :: [Int]) -> - shared - @[] - Foo.$fMyFunctor[] - (GHC.Classes.(%%) - `cast` (Sub (Sym (Foo.D:R:Domain[]a[0] <Int>_N)) - :: (() :: Constraint) ~R# Domain [] Int)) - (GHC.Types.: @Int (GHC.Types.I# 0#) xs_axd) + = \ (xs_awV :: [Int]) -> + map + @Int + @Int + GHC.Num.$fNumInt_$cnegate + (GHC.Types.: @Int lvl_sHI xs_awV) + +-- RHS size: {terms: 1, types: 0, coercions: 0, joins: 0/0} +lvl_sHJ :: Int +[LclId] +lvl_sHJ = lvl_sHI --- RHS size: {terms: 8, types: 4, coercions: 4, joins: 0/0} +-- RHS size: {terms: 6, types: 5, coercions: 0, joins: 0/0} bar :: [Int] -> [Int] [LclIdX, Arity=1, - Unf=Unf{Src=<vanilla>, TopLvl=True, Value=True, ConLike=True, - WorkFree=True, Expandable=True, Guidance=IF_ARGS [0] 60 10}] + Str=<1U>, + Cpr=m2, + 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= \ (xs_awW [Occ=Once1] :: [Int]) -> + GHC.Types.: + @Int + lvl_sHI + (GHC.Base.build + @Int + (\ (@b1_aHe) + (c_aHf [Occ=Once1, OS=OneShot] :: Int -> b1_aHe -> b1_aHe) + (n_aHg [Occ=Once1, OS=OneShot] :: b1_aHe) -> + GHC.Base.foldr + @Int + @b1_aHe + (GHC.Base.mapFB @Int @b1_aHe @Int c_aHf GHC.Num.$fNumInt_$cnegate) + n_aHg + xs_awW))}] bar - = \ (xs_axe :: [Int]) -> + = \ (xs_awW :: [Int]) -> GHC.Types.: - @Int - (GHC.Types.I# 0#) - (shared - @[] - Foo.$fMyFunctor[] - (GHC.Classes.(%%) - `cast` (Sub (Sym (Foo.D:R:Domain[]a[0] <Int>_N)) - :: (() :: Constraint) ~R# Domain [] Int)) - xs_axe) + @Int lvl_sHI (map @Int @Int GHC.Num.$fNumInt_$cnegate xs_awW) -- RHS size: {terms: 1, types: 0, coercions: 0, joins: 0/0} -$trModule_sHj :: GHC.Prim.Addr# -[LclId, - Unf=Unf{Src=<vanilla>, TopLvl=True, Value=True, ConLike=True, - WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 20 0}] -$trModule_sHj = "main"# +$trModule_sHr :: GHC.Prim.Addr# +[LclId] +$trModule_sHr = "main"# -- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0} -$trModule_sHk :: GHC.Types.TrName -[LclId, - Unf=Unf{Src=<vanilla>, TopLvl=True, Value=True, ConLike=True, - WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 10 10}] -$trModule_sHk = GHC.Types.TrNameS $trModule_sHj +$trModule_sHs :: GHC.Types.TrName +[LclId] +$trModule_sHs = GHC.Types.TrNameS $trModule_sHr -- RHS size: {terms: 1, types: 0, coercions: 0, joins: 0/0} -$trModule_sHl :: GHC.Prim.Addr# -[LclId, - Unf=Unf{Src=<vanilla>, TopLvl=True, Value=True, ConLike=True, - WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 20 0}] -$trModule_sHl = "Foo"# +$trModule_sHt :: GHC.Prim.Addr# +[LclId] +$trModule_sHt = "Foo"# -- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0} -$trModule_sHm :: GHC.Types.TrName -[LclId, - Unf=Unf{Src=<vanilla>, TopLvl=True, Value=True, ConLike=True, - WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 10 10}] -$trModule_sHm = GHC.Types.TrNameS $trModule_sHl +$trModule_sHu :: GHC.Types.TrName +[LclId] +$trModule_sHu = GHC.Types.TrNameS $trModule_sHt -- RHS size: {terms: 3, types: 0, coercions: 0, joins: 0/0} Foo.$trModule :: GHC.Types.Module -[LclIdX, - Unf=Unf{Src=<vanilla>, TopLvl=True, Value=True, ConLike=True, - WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 10 10}] -Foo.$trModule = GHC.Types.Module $trModule_sHk $trModule_sHm +[LclIdX] +Foo.$trModule = GHC.Types.Module $trModule_sHs $trModule_sHu -- RHS size: {terms: 3, types: 1, coercions: 0, joins: 0/0} -$krep_aGA [InlPrag=[~]] :: GHC.Types.KindRep -[LclId, - Unf=Unf{Src=<vanilla>, TopLvl=True, Value=True, ConLike=True, - WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 10 10}] -$krep_aGA +$krep_aGF [InlPrag=[~]] :: GHC.Types.KindRep +[LclId] +$krep_aGF = GHC.Types.KindRepTyConApp GHC.Types.$tcConstraint (GHC.Types.[] @GHC.Types.KindRep) -- RHS size: {terms: 3, types: 0, coercions: 0, joins: 0/0} -$krep_aGz [InlPrag=[~]] :: GHC.Types.KindRep -[LclId, - Unf=Unf{Src=<vanilla>, TopLvl=True, Value=True, ConLike=True, - WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 10 10}] -$krep_aGz = GHC.Types.KindRepFun GHC.Types.krep$*Arr* $krep_aGA +$krep_aGE [InlPrag=[~]] :: GHC.Types.KindRep +[LclId] +$krep_aGE = GHC.Types.KindRepFun GHC.Types.krep$*Arr* $krep_aGF -- RHS size: {terms: 1, types: 0, coercions: 0, joins: 0/0} -$tcMyFunctor_sHn :: GHC.Prim.Addr# -[LclId, - Unf=Unf{Src=<vanilla>, TopLvl=True, Value=True, ConLike=True, - WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 40 0}] -$tcMyFunctor_sHn = "MyFunctor"# +$tcMyFunctor_sHv :: GHC.Prim.Addr# +[LclId] +$tcMyFunctor_sHv = "MyFunctor"# -- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0} -$tcMyFunctor_sHo :: GHC.Types.TrName -[LclId, - Unf=Unf{Src=<vanilla>, TopLvl=True, Value=True, ConLike=True, - WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 10 10}] -$tcMyFunctor_sHo = GHC.Types.TrNameS $tcMyFunctor_sHn +$tcMyFunctor_sHw :: GHC.Types.TrName +[LclId] +$tcMyFunctor_sHw = GHC.Types.TrNameS $tcMyFunctor_sHv -- RHS size: {terms: 7, types: 0, coercions: 0, joins: 0/0} Foo.$tcMyFunctor :: GHC.Types.TyCon -[LclIdX, - Unf=Unf{Src=<vanilla>, TopLvl=True, Value=True, ConLike=True, - WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 10 10}] +[LclIdX] Foo.$tcMyFunctor = GHC.Types.TyCon - 12837160846121910345##64 - 787075802864859973##64 + 12837160846121910345## + 787075802864859973## Foo.$trModule - $tcMyFunctor_sHo + $tcMyFunctor_sHw 0# - $krep_aGz - - - + $krep_aGE diff --git a/testsuite/tests/simplCore/should_compile/all.T b/testsuite/tests/simplCore/should_compile/all.T index b92f24cd5b..5a018cdb2d 100644 --- a/testsuite/tests/simplCore/should_compile/all.T +++ b/testsuite/tests/simplCore/should_compile/all.T @@ -136,9 +136,14 @@ test('T5366', test('T7796', [], makefile_test, ['T7796']) test('T5550', omit_ways(prof_ways), compile, ['']) test('T7865', normal, makefile_test, ['T7865']) -# T7785: Check that we generate the specialising RULE. Might not be listed in -# -ddump-rules because of Note [Trimming auto-rules], hence grep -test('T7785', [ only_ways(['optasm']), grep_errmsg(r'RULE') ], compile, ['-ddump-spec']) + +# T7785: we want to check that we specialise 'shared'. But Tidy discards the +# rule (see Note [Trimming auto-rules] in GHC.Iface.Tidy) +# So, rather arbitrarily, we dump the output of CSE and grep for SPEC +test('T7785', [ only_ways(['optasm']), + grep_errmsg(r'SPEC') ], + compile, ['-ddump-cse']) + test('T7702', [extra_files(['T7702plugin']), pre_cmd('$MAKE -s --no-print-directory -C T7702plugin package.T7702 TOP={top}'), diff --git a/testsuite/tests/simplCore/should_run/T18012.hs b/testsuite/tests/simplCore/should_run/T18012.hs index 9118b75ff4..9ce1f1fb9d 100644 --- a/testsuite/tests/simplCore/should_run/T18012.hs +++ b/testsuite/tests/simplCore/should_run/T18012.hs @@ -32,10 +32,10 @@ notRule x = x {-# INLINE [0] notRule #-} {-# RULES "notRule/False" [~0] notRule False = True #-} -f :: T -> () -> Bool -f (D a) () = notRule a +f :: () -> T -> Bool +f () (D a) = notRule a {-# INLINE [100] f #-} -- so it isn’t inlined before FloatOut g :: () -> Bool -g x = f (D False) x +g x = f x (D False) {-# NOINLINE g #-} diff --git a/testsuite/tests/simplCore/should_run/T19569a.hs b/testsuite/tests/simplCore/should_run/T19569a.hs index bffef2c6df..a732e1f81f 100644 --- a/testsuite/tests/simplCore/should_run/T19569a.hs +++ b/testsuite/tests/simplCore/should_run/T19569a.hs @@ -3,6 +3,11 @@ -- so I added it to testsuite to catch such regressions in the future. -- It might be acceptable for this test to fail if you make changes to the simplifier. But generally such a failure shouldn't be accepted without good reason. +-- +-- For example, one of the numerical instabilities was/is caused by a rewrite rule +-- in GHC.Real which rewrites powers with small exponents. See !8082, changes in the +-- simplifier caused this rewrite rule to trigger (or not) which then produced different +-- results. -- The excessive whitespace is the result of running the original benchmark which was a .lhs file through unlit. diff --git a/testsuite/tests/simplCore/should_run/all.T b/testsuite/tests/simplCore/should_run/all.T index 53bcde5169..509ae1ff57 100644 --- a/testsuite/tests/simplCore/should_run/all.T +++ b/testsuite/tests/simplCore/should_run/all.T @@ -97,7 +97,9 @@ test('NumConstantFolding16', normal, compile_and_run, ['']) test('NumConstantFolding32', normal, compile_and_run, ['']) test('NumConstantFolding', normal, compile_and_run, ['']) test('T19413', normal, compile_and_run, ['']) + test('T19569a', [only_ways(['optasm']),extra_run_opts('True 1000000')], compile_and_run, ['-O2']) + test('T20203', normal, compile, ['-O -dsuppress-all -dsuppress-uniques -dno-typeable-binds -ddump-simpl']) test('T19313', normal, compile_and_run, ['']) test('UnliftedArgRule', normal, compile_and_run, ['']) diff --git a/testsuite/tests/stranal/should_compile/EtaExpansion.hs b/testsuite/tests/stranal/should_compile/EtaExpansion.hs new file mode 100644 index 0000000000..0558adac0b --- /dev/null +++ b/testsuite/tests/stranal/should_compile/EtaExpansion.hs @@ -0,0 +1,13 @@ +module Foo( wombat ) where + +-- We expect to eta-expand f to arity 2, but not to arity 3 +-- See Note [Bottoming bindings] in GHC.Core.Opt.Simplify +f :: String -> Int -> Int -> Int +{-# NOINLINE f #-} +f s = error s + +g :: (Int -> Int -> Int) -> Maybe Int +{-# NOINLINE g #-} +g h = let h1 = h 2 in Just (h1 2 + h1 3) + +wombat s = g (f s) diff --git a/testsuite/tests/stranal/should_compile/T18894b.hs b/testsuite/tests/stranal/should_compile/T18894b.hs index e90f34e3fd..99a4bf954d 100644 --- a/testsuite/tests/stranal/should_compile/T18894b.hs +++ b/testsuite/tests/stranal/should_compile/T18894b.hs @@ -17,4 +17,14 @@ f :: Int -> Int f 1 = 0 f m | odd m = eta m 2 - | otherwise = eta 2 m + | otherwise = eta m m + +{- +An earlier version of this test had (eta 2 m) in the otherwise case. +But then (eta 2) could be floated out; and indeed if 'f' is applied +many times, then sharing (eta 2) might be good. And if we inlined +eta, we certainly would share (expensive 2). + +So I made the test more robust at testing what we actually want here, +by changing to (eta m m). +-} diff --git a/testsuite/tests/stranal/should_compile/all.T b/testsuite/tests/stranal/should_compile/all.T index e9ae6e11ba..02428987fc 100644 --- a/testsuite/tests/stranal/should_compile/all.T +++ b/testsuite/tests/stranal/should_compile/all.T @@ -84,3 +84,4 @@ test('T21150', [ grep_errmsg(r'( t\d? :: Int)') ], compile, ['-dsuppress-uniques # T21128: Check that y is not reboxed in $wtheresCrud test('T21128', [ grep_errmsg(r'let { y = I\#') ], multimod_compile, ['T21128', '-v0 -dsuppress-uniques -dsuppress-all -ddump-simpl']) test('T21265', normal, compile, ['']) +test('EtaExpansion', normal, compile, ['']) diff --git a/testsuite/tests/stranal/sigs/BottomFromInnerLambda.stderr b/testsuite/tests/stranal/sigs/BottomFromInnerLambda.stderr index 1c944f8520..8784af67b7 100644 --- a/testsuite/tests/stranal/sigs/BottomFromInnerLambda.stderr +++ b/testsuite/tests/stranal/sigs/BottomFromInnerLambda.stderr @@ -1,18 +1,18 @@ ==================== Strictness signatures ==================== BottomFromInnerLambda.expensive: <1!P(SL)> -BottomFromInnerLambda.f: <1!P(SL)> +BottomFromInnerLambda.f: <1!S><1!S>b ==================== Cpr signatures ==================== BottomFromInnerLambda.expensive: 1 -BottomFromInnerLambda.f: +BottomFromInnerLambda.f: b ==================== Strictness signatures ==================== BottomFromInnerLambda.expensive: <1!P(1L)> -BottomFromInnerLambda.f: <1!P(1L)> +BottomFromInnerLambda.f: <1!P(1!S)><1!S>b diff --git a/testsuite/tests/stranal/sigs/T20746.stderr b/testsuite/tests/stranal/sigs/T20746.stderr index 5be614867a..2b54d3b8ff 100644 --- a/testsuite/tests/stranal/sigs/T20746.stderr +++ b/testsuite/tests/stranal/sigs/T20746.stderr @@ -1,6 +1,6 @@ ==================== Strictness signatures ==================== -Foo.f: <MP(A,1C1(L),A)><L> +Foo.f: <LP(A,SCS(L),A)><L> Foo.foogle: <L><L> |