diff options
| author | Simon Peyton Jones <simonpj@microsoft.com> | 2017-02-28 16:07:20 -0500 |
|---|---|---|
| committer | David Feuer <David.Feuer@gmail.com> | 2017-02-28 16:07:21 -0500 |
| commit | 2effe18ab51d66474724d38b20e49cc1b8738f60 (patch) | |
| tree | 8e69360fe2b24408778944f2450f3903e8236168 /testsuite | |
| parent | 55efc9718b520ef354e32c15c4b49cdfecce412f (diff) | |
| download | haskell-2effe18ab51d66474724d38b20e49cc1b8738f60.tar.gz | |
The Early Inline Patch
This very small patch switches on sm_inline even in the InitialPhase
(aka "gentle" phase). There is no reason not to... and the results
are astonishing.
I think the peformance of GHC itself improves by about 5%; and some
programs get much smaller, quicker. Result: across the board
irmprovements in
compile time performance. Here are the changes in perf/compiler;
the numbers are decreases in compiler bytes-allocated:
3% T5837
7% parsing001
9% T12234
35% T9020
9% T3064
13% T9961
20% T13056
5% T9872d
5% T9872c
5% T9872b
7% T9872a
5% T783
35% T12227
20% T1969
Plus in perf/should_run
5% lazy-bs-alloc
It wasn't as easy as it sounds: I did a raft of preparatory work in
earlier patches. But it's great!
Reviewers: austin, bgamari
Subscribers: thomie
Differential Revision: https://phabricator.haskell.org/D3203
Diffstat (limited to 'testsuite')
22 files changed, 165 insertions, 205 deletions
diff --git a/testsuite/tests/codeGen/should_compile/debug.stdout b/testsuite/tests/codeGen/should_compile/debug.stdout index 59332ffa85..3dca62a419 100644 --- a/testsuite/tests/codeGen/should_compile/debug.stdout +++ b/testsuite/tests/codeGen/should_compile/debug.stdout @@ -15,10 +15,9 @@ src<debug.hs:6:1-21> src<debug.hs:(3,1)-(5,29)> src<debug.hs:3:9> src<debug.hs:4:9> -src<debug.hs:5:25-29> +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/deriving/perf/all.T b/testsuite/tests/deriving/perf/all.T index a13a6aa7b9..4d88bc9ca5 100644 --- a/testsuite/tests/deriving/perf/all.T +++ b/testsuite/tests/deriving/perf/all.T @@ -3,10 +3,11 @@ test('T10858', [(platform('x86_64-unknown-mingw32'), 272402736, 8), # 2017-02-19 272402736 (x64/Windows) - unknown - (wordsize(64), 304094944, 8) ]), + (wordsize(64), 275357824, 8) ]), # Initial: 476296112 # 2016-12-19 247768192 Join points (#19288) # 2016-02-12 304094944 Type-indexed Typeable + # 2016-02-25 275357824 Early inline patch only_ways(['normal'])], compile, ['-O']) diff --git a/testsuite/tests/indexed-types/should_compile/T7837.stderr b/testsuite/tests/indexed-types/should_compile/T7837.stderr index a4d96b1dfb..7fd0a48058 100644 --- a/testsuite/tests/indexed-types/should_compile/T7837.stderr +++ b/testsuite/tests/indexed-types/should_compile/T7837.stderr @@ -1,6 +1,5 @@ Rule fired: Class op signum Rule fired: Class op abs -Rule fired: normalize/Double -Rule fired: Class op HEq_sc Rule fired: Class op HEq_sc +Rule fired: normalize/Double Rule fired: Class op HEq_sc diff --git a/testsuite/tests/perf/compiler/T4007.stdout b/testsuite/tests/perf/compiler/T4007.stdout index e7ccd42a05..59c81d9b51 100644 --- a/testsuite/tests/perf/compiler/T4007.stdout +++ b/testsuite/tests/perf/compiler/T4007.stdout @@ -1,12 +1,6 @@ -Rule fired: unpack -Rule fired: Class op >> -Rule fired: Class op return -Rule fired: Class op foldr -Rule fired: Class op >> -Rule fired: Class op return -Rule fired: Class op foldr Rule fired: Class op >> Rule fired: Class op return +Rule fired: unpack Rule fired: Class op foldr Rule fired: fold/build Rule fired: <# diff --git a/testsuite/tests/perf/compiler/all.T b/testsuite/tests/perf/compiler/all.T index 7a8e04f220..b77481594c 100644 --- a/testsuite/tests/perf/compiler/all.T +++ b/testsuite/tests/perf/compiler/all.T @@ -68,6 +68,7 @@ test('T1969', # 2014-06-29 5949188 (x86/Linux) # 2015-07-11 6241108 (x86/Linux, 64bit machine) use +RTS -G1 # 2016-04-06 9093608 (x86/Linux, 64bit machine) + (wordsize(64), 19924328, 15)]), # 2014-09-10 10463640, 10 # post-AMP-update (somewhat stabelish) # looks like the peak is around ~10M, but we're @@ -81,6 +82,8 @@ test('T1969', # 2015-10-28 15017528 (amd64/Linux) emit typeable at definition site # 2016-10-12 17285216 (amd64/Linux) it's not entirely clear why # 2017-02-01 19924328 (amd64/Linux) Join points (#12988) + # 2017-02-14 16393848 Early inline patch + compiler_stats_num_field('bytes allocated', [(platform('i386-unknown-mingw32'), 301784492, 5), # 215582916 (x86/Windows) @@ -97,7 +100,7 @@ test('T1969', # 2014-06-29 303300692 (x86/Linux) # 2015-07-11 288699104 (x86/Linux, 64-bit machine) use +RTS -G1 # 2016-04-06 344730660 (x86/Linux, 64-bit machine) - (wordsize(64), 831733376, 5)]), + (wordsize(64), 695354904, 5)]), # 2009-11-17 434845560 (amd64/Linux) # 2009-12-08 459776680 (amd64/Linux) # 2010-05-17 519377728 (amd64/Linux) @@ -119,6 +122,7 @@ test('T1969', # 2015-10-28 695430728 (x86_64/Linux) emit Typeable at definition site # 2015-10-28 756138176 (x86_64/Linux) inst-decl defaults go via typechecker (#12220) # 2017-02-17 831733376 (x86_64/Linux) Type-indexed Typeable + # 2017-02-25 695354904 (x86_64/Linux) Early inlining patch only_ways(['normal']), extra_hc_opts('-dcore-lint -static'), @@ -316,7 +320,7 @@ test('T3064', # 2014-12-22: 122836340 (Windows) Death to silent superclasses # 2016-04-06: 153261024 (x86/Linux) probably wildcard refactor - (wordsize(64), 306222424, 5)]), + (wordsize(64), 259815560, 5)]), # (amd64/Linux) (2011-06-28): 73259544 # (amd64/Linux) (2013-02-07): 224798696 # (amd64/Linux) (2013-08-02): 236404384, increase from roles @@ -340,6 +344,7 @@ test('T3064', # (amd64/Linux) (2016-04-15): 287460128 Improvement due to using coercionKind instead # of zonkTcType (Trac #11882) # (amd64/Darwin) (2017-01-23): 306222424 Presumably creep from recent changes (Typeable?) + # (amd64/Linux) (2017-02-14): 259815560 Early inline patch: 9% improvement ################################### # deactivated for now, as this metric became too volatile recently @@ -445,10 +450,11 @@ test('T5631', test('parsing001', [compiler_stats_num_field('bytes allocated', [(wordsize(32), 274000576, 10), - (wordsize(64), 493730288, 5)]), + (wordsize(64), 463931280, 5)]), # expected value: 587079016 (amd64/Linux) # 2016-09-01: 581551384 (amd64/Linux) Restore w/w limit (#11565) # 2016-12-19: 493730288 (amd64/Linux) Join points (#12988) + # 2017-02-14: 463931280 Early inlining patch; acutal improvement 7% only_ways(['normal']), ], compile_fail, ['']) @@ -467,7 +473,7 @@ test('T783', # 2014-12-22: 235002220 (Windows) not sure why # 2016-04-06: 249332816 (x86/Linux, 64-bit machine) - (wordsize(64), 488592288, 10)]), + (wordsize(64), 436978192, 10)]), # prev: 349263216 (amd64/Linux) # 07/08/2012: 384479856 (amd64/Linux) # 29/08/2012: 436927840 (amd64/Linux) @@ -496,6 +502,8 @@ test('T783', # (D1535: Major overhaul of pattern match checker, #11162) # 2016-02-03: 488592288 (amd64/Linux) # (D1795: Another overhaul of pattern match checker, #11374) + # 2017-02-14 436978192 Early inlining: 5% improvement + extra_hc_opts('-static') ], compile,['']) @@ -510,7 +518,7 @@ test('T5321Fun', # 2014-09-03: 299656164 (specialisation and inlining) # 2014-12-10: 206406188 # Improvements in constraint solver # 2016-04-06: 279922360 x86/Linux - (wordsize(64), 524706256, 5)]) + (wordsize(64), 488295304, 5)]) # prev: 585521080 # 2012-08-29: 713385808 # (increase due to new codegen) # 2013-05-15: 628341952 # (reason for decrease unknown) @@ -535,6 +543,7 @@ test('T5321Fun', # "drift" reported above # 2017-01-31: 498135752 # Join points (#12988) # 2017-02-23: 524706256 # Type-indexed Typeable? (on Darwin) + # 2017-02-25: 488295304 # Early inlining patch ], compile,['']) @@ -617,7 +626,7 @@ test('T5837', (platform('x86_64-unknown-mingw32'), 59161648, 7), # 2017-02-19 59161648 (x64/Windows) - Unknown - (wordsize(64), 54151864, 7)]) + (wordsize(64), 52625920, 7)]) # sample: 3926235424 (amd64/Linux, 15/2/2012) # 2012-10-02 81879216 # 2012-09-20 87254264 amd64/Linux @@ -652,6 +661,7 @@ test('T5837', # Also bumped acceptance threshold to 7%. # 2017-02-20 58648600 amd64/Linux Type-indexed Typeable # 2017-02-28 54151864 amd64/Linux Likely drift due to recent simplifier improvements + # 2017-02-25 52625920 amd64/Linux Early inlining patch ], compile, ['-freduction-depth=50']) @@ -688,7 +698,7 @@ test('T9020', [(wordsize(32), 343005716, 10), # Original: 381360728 # 2014-07-31: 343005716 (Windows) (general round of updates) - (wordsize(64), 764866144, 10)]) + (wordsize(64), 500707080, 10)]) # prev: 795469104 # 2014-07-17: 728263536 (general round of updates) # 2014-09-10: 785871680 post-AMP-cleanup @@ -698,6 +708,8 @@ test('T9020', # 2016-04-06: 852298336 Refactoring of CSE #11781 # 2016-04-06: 698401736 Use thenIO in Applicative IO # 2017-02-03: 764866144 Join points + # 2017-02-14: 500707080 Early inline patch; 35% decrease! + # Program size collapses in first simplification ], compile,['']) @@ -750,7 +762,7 @@ test('T9675', test('T9872a', [ only_ways(['normal']), compiler_stats_num_field('bytes allocated', - [(wordsize(64), 3298422648, 5), + [(wordsize(64), 3005891848, 5), # 2014-12-10 5521332656 Initally created # 2014-12-16 5848657456 Flattener parameterized over roles # 2014-12-18 2680733672 Reduce type families even more eagerly @@ -758,6 +770,8 @@ test('T9872a', # 2016-04-07 3352882080 CSE improvements # 2016-10-19 3134866040 Refactor traceRn interface (#12617) # 2017-02-17 3298422648 Type-indexed Typeable + # 2017-02-25 3005891848 Early inlining patch + (wordsize(32), 1740903516, 5) # was 1325592896 # 2016-04-06 1740903516 x86/Linux @@ -769,7 +783,7 @@ test('T9872a', test('T9872b', [ only_ways(['normal']), compiler_stats_num_field('bytes allocated', - [(wordsize(64), 4069522928, 5), + [(wordsize(64), 3730686224, 5), # 2014-12-10 6483306280 Initally created # 2014-12-16 6892251912 Flattener parameterized over roles # 2014-12-18 3480212048 Reduce type families even more eagerly @@ -777,6 +791,8 @@ test('T9872b', # 2016-02-08 4918990352 Improved a bit by tyConRolesRepresentational # 2016-04-06: 4600233488 Refactoring of CSE #11781 # 2016-09-15: 4069522928 Fix #12422 + # 2017-02-14 3730686224 Early inlining: 5% improvement + (wordsize(32), 2422750696, 5) # was 1700000000 # 2016-04-06 2422750696 x86/Linux @@ -787,7 +803,7 @@ test('T9872b', test('T9872c', [ only_ways(['normal']), compiler_stats_num_field('bytes allocated', - [(wordsize(64), 3702580928, 5), + [(wordsize(64), 3404346032, 5), # 2014-12-10 5495850096 Initally created # 2014-12-16 5842024784 Flattener parameterized over roles # 2014-12-18 2963554096 Reduce type families even more eagerly @@ -795,6 +811,8 @@ test('T9872c', # 2016-02-08 4454071184 Improved a bit by tyConRolesRepresentational # 2016-04-06: 4306667256 Refactoring of CSE #11781 # 2016-09-15: 3702580928 Fixing #12422 + # 2017-02-14 3404346032 Early inlining: 5% improvement + (wordsize(32), 2257242896, 5) # was 1500000000 # 2016-04-06 2257242896 @@ -805,7 +823,7 @@ test('T9872c', test('T9872d', [ only_ways(['normal']), compiler_stats_num_field('bytes allocated', - [(wordsize(64), 535565128, 5), + [(wordsize(64), 498855104, 5), # 2014-12-18 796071864 Initally created # 2014-12-18 739189056 Reduce type families even more eagerly # 2015-01-07 687562440 TrieMap leaf compression @@ -816,6 +834,8 @@ test('T9872d', # 2016-12-05 478169352 using tyConIsTyFamFree, I think, but only # a 1% improvement 482 -> 478 # 2017-02-17 535565128 Type-indexed Typeable + # 2017-02-25 498855104 Early inlining + (wordsize(32), 264566040, 5) # some date 328810212 # 2015-07-11 350369584 @@ -828,7 +848,7 @@ test('T9872d', test('T9961', [ only_ways(['normal']), compiler_stats_num_field('bytes allocated', - [(wordsize(64), 571246936, 5), + [(wordsize(64), 498326216, 5), # 2015-01-12 807117816 Initally created # 2015-spring 772510192 Got better # 2015-05-22 663978160 Fix for #10370 improves it more @@ -838,6 +858,8 @@ test('T9961', # 2016-03-24 568526784 x64_64/Linux Add eqInt* variants (#11688) # 2016-09-01 537297968 x64_64/Linux Restore w/w limit (#11565) # 2016-12-19 571246936 x64_64/Linux Join points (#12988) + # 2017-02-14 498326216 Early inline patch; 13% improvement + (wordsize(32), 275264188, 5) # was 375647160 # 2016-04-06 275264188 x86/Linux @@ -872,7 +894,7 @@ test('T9233', test('T10370', [ only_ways(['optasm']), compiler_stats_num_field('max_bytes_used', # Note [residency] - [(wordsize(64), 51126304, 15), + [(wordsize(64), 41291976, 15), # 2015-10-22 19548720 # 2016-02-24 22823976 Changing Levity to RuntimeRep; not sure why this regresses though, even after some analysis # 2016-04-14 28256896 final demand analyzer run @@ -887,16 +909,19 @@ test('T10370', # See the comment 16 on #8472. # 2017-02-17 51126304 Type-indexed Typeawble # 2017-02-27 43455848 Likely drift from recent simplifier improvements + # 2017-02-25 41291976 Early inline patch + (wordsize(32), 11371496, 15), # 2015-10-22 11371496 ]), compiler_stats_num_field('peak_megabytes_allocated', # Note [residency] - [(wordsize(64), 187, 15), + [(wordsize(64), 154, 15), # 2015-10-22 76 # 2016-04-14 101 final demand analyzer run # 2016-08-08 121 see above # 2017-01-18 146 Allow top-level string literals in Core # 2017-02-17 187 Type-indexed Typeawble + # 2017-02-25 154 Early inline patch (wordsize(32), 39, 15), # 2015-10-22 39 ]), @@ -924,11 +949,12 @@ test('T10547', test('T12227', [ only_ways(['normal']), compiler_stats_num_field('bytes allocated', - [(wordsize(64), 1715827784, 5), + [(wordsize(64), 1060158624, 5), # 2016-07-11 5650186880 (Windows) before fix for #12227 # 2016-07-11 1822822016 (Windows) after fix for #12227 # 2016-12-20 1715827784 after d250d493 (INLINE in Traversable dms) # (or thereabouts in the commit history) + # 2017-02-14 1060158624 Early inlining: 35% improvement ]), ], compile, @@ -953,12 +979,13 @@ test('T12234', [(platform('x86_64-unknown-mingw32'), 89180624, 5), # initial: 89180624 # 2017-02-19 89180624 (x64/Windows) - Unknown - (wordsize(64), 86525344, 5), + (wordsize(64), 80245640, 5), # initial: 72958288 # 2016-01-17: 76848856 (x86-64, Linux. drift?) # 2017-02-01: 80882208 (Use superclass instances when solving) # 2017-02-05: 74374440 (Probably OccAnal fixes) # 2017-02-17: 86525344 (Type-indexed Typeable) + # 2017-02-25: 80245640 (Early inline patch) ]), ], compile, @@ -967,11 +994,12 @@ test('T12234', test('T13035', [ only_ways(['normal']), compiler_stats_num_field('bytes allocated', - [(wordsize(64), 103890200, 5), + [(wordsize(64), 98390488, 5), # 2017-01-05 90595208 initial # 2017-01-19 95269000 Allow top-level string literals in Core # 2017-02-05 88806416 Probably OccAnal fixes # 2017-02-17 103890200 Type-indexed Typeable + # 2017-02-25 98390488 Early inline patch ]), ], compile, @@ -980,10 +1008,11 @@ test('T13035', test('T13056', [ only_ways(['optasm']), compiler_stats_num_field('bytes allocated', - [(wordsize(64), 524611224, 5), + [(wordsize(64), 440548592, 5), # 2017-01-06 520166912 initial # 2017-01-31 546800240 Join points (#12988) # 2017-02-07 524611224 new SetLevels + # 2017-02-14 440548592 Early inline patch: 16% improvement ]), ], compile, diff --git a/testsuite/tests/perf/haddock/all.T b/testsuite/tests/perf/haddock/all.T index dce0a648a1..16e78af2fc 100644 --- a/testsuite/tests/perf/haddock/all.T +++ b/testsuite/tests/perf/haddock/all.T @@ -129,7 +129,7 @@ test('haddock.compiler', [extra_files(['../../../../compiler/stage2/haddock.t']), unless(in_tree_compiler(), skip), req_haddock ,stats_num_field('bytes allocated', - [(wordsize(64), 62070477608, 10) + [(wordsize(64), 55777283352, 10) # 2012-08-14: 26070600504 (amd64/Linux) # 2012-08-29: 26353100288 (amd64/Linux, new CG) # 2012-09-18: 26882813032 (amd64/Linux) @@ -146,6 +146,7 @@ test('haddock.compiler', # 2016-06-21: 55314944264 (amd64/Linux) D2350: Make checkFamInstConsistency less expensive # 2016-11-29: 60911147344 (amd64/Linux) unknown cause # 2017-02-11: 62070477608 (amd64/Linux) OccurAnal / One-Shot (#13227) (and others) + # 2017-02-25: 55777283352 (amd64/Linux) Early inline patch ,(platform('i386-unknown-mingw32'), 902576468, 10) # 2012-10-30: 13773051312 (x86/Windows) diff --git a/testsuite/tests/perf/should_run/all.T b/testsuite/tests/perf/should_run/all.T index 2f57613c3a..3bc620f9b2 100644 --- a/testsuite/tests/perf/should_run/all.T +++ b/testsuite/tests/perf/should_run/all.T @@ -89,6 +89,8 @@ test('lazy-bs-alloc', # 2014-01-22: 411500 (x86/Linux) # 2014-01-28: Widen 1->2% (x86/Windows was at 425212) # 2016-04-06: 429760 (x86/Linux) no idea what happened + # 2017-02-14: 421448 Early inline patch + only_ways(['normal']), extra_run_opts('arith011.stdout'), ignore_stdout, diff --git a/testsuite/tests/simplCore/should_compile/Makefile b/testsuite/tests/simplCore/should_compile/Makefile index 1206ad6f6a..51aeaa140b 100644 --- a/testsuite/tests/simplCore/should_compile/Makefile +++ b/testsuite/tests/simplCore/should_compile/Makefile @@ -7,13 +7,17 @@ T3990: '$(TEST_HC)' $(TEST_HC_OPTS) -O -c -ddump-simpl T3990.hs | grep 'test_case' # Grep output should show an unpacked constructor +T8848: + $(RM) -f T8848.o T8848.hi + '$(TEST_HC)' $(TEST_HC_OPTS) -O -c -ddump-rule-firings T8848.hs | grep 'SPEC map2' + # Should fire twice + T9509: $(RM) -f T9509*.o T9509*.hi '$(TEST_HC)' $(TEST_HC_OPTS) -O -c T9509a.hs - '$(TEST_HC)' $(TEST_HC_OPTS) -O -c T9509.hs -funfolding-use-threshold=20 \ + '$(TEST_HC)' $(TEST_HC_OPTS) -O -c T9509.hs \ -ddump-rule-rewrites | grep SPEC - # Grep output should show a SPEC rule firing - # The unfolding use threshold is to prevent foo inlining before it is specialised + # Grep output should show a SPEC rule firing, twice T13317: $(RM) -f T13317.o T13317.hi @@ -135,6 +139,7 @@ T4138: '$(TEST_HC)' $(TEST_HC_OPTS) -O -c T4138_A.hs '$(TEST_HC)' $(TEST_HC_OPTS) -O -c T4138.hs -ddump-simpl > T4138.simpl grep -c 'F#' T4138.simpl + # We expect to see this T7165: $(RM) -f T7165.hi T7165a.hi T7165a.o T7165.o diff --git a/testsuite/tests/simplCore/should_compile/T10181.hs b/testsuite/tests/simplCore/should_compile/T10181.hs index 1983507cd2..8de148a57f 100644 --- a/testsuite/tests/simplCore/should_compile/T10181.hs +++ b/testsuite/tests/simplCore/should_compile/T10181.hs @@ -1,3 +1,8 @@ module T10181 where +-- GHC 8.0 and previous wrongly eta-reduced this to +-- t = t +-- but GHC 8.2 does not; some kind of consequence of +-- better simplification in the early stages. + t a = t a diff --git a/testsuite/tests/simplCore/should_compile/T3772.stdout b/testsuite/tests/simplCore/should_compile/T3772.stdout index f5de5d7835..44aee7b69e 100644 --- a/testsuite/tests/simplCore/should_compile/T3772.stdout +++ b/testsuite/tests/simplCore/should_compile/T3772.stdout @@ -3,6 +3,50 @@ Result size of Tidy Core = {terms: 44, types: 19, coercions: 0, joins: 0/0} +-- RHS size: {terms: 1, types: 0, coercions: 0, joins: 0/0} +T3772.$trModule4 :: GHC.Prim.Addr# +[GblId, + Caf=NoCafRefs, + Unf=Unf{Src=<vanilla>, TopLvl=True, Value=True, ConLike=True, + WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 20 0}] +T3772.$trModule4 = "main"# + +-- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0} +T3772.$trModule3 :: GHC.Types.TrName +[GblId, + Caf=NoCafRefs, + Str=m1, + Unf=Unf{Src=<vanilla>, TopLvl=True, Value=True, ConLike=True, + WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 10 20}] +T3772.$trModule3 = GHC.Types.TrNameS T3772.$trModule4 + +-- RHS size: {terms: 1, types: 0, coercions: 0, joins: 0/0} +T3772.$trModule2 :: GHC.Prim.Addr# +[GblId, + Caf=NoCafRefs, + Unf=Unf{Src=<vanilla>, TopLvl=True, Value=True, ConLike=True, + WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 30 0}] +T3772.$trModule2 = "T3772"# + +-- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0} +T3772.$trModule1 :: GHC.Types.TrName +[GblId, + Caf=NoCafRefs, + Str=m1, + Unf=Unf{Src=<vanilla>, TopLvl=True, Value=True, ConLike=True, + WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 10 20}] +T3772.$trModule1 = GHC.Types.TrNameS T3772.$trModule2 + +-- RHS size: {terms: 3, types: 0, coercions: 0, joins: 0/0} +T3772.$trModule :: GHC.Types.Module +[GblId, + Caf=NoCafRefs, + Str=m, + Unf=Unf{Src=<vanilla>, TopLvl=True, Value=True, ConLike=True, + WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 10 30}] +T3772.$trModule + = GHC.Types.Module T3772.$trModule3 T3772.$trModule1 + Rec { -- RHS size: {terms: 10, types: 2, coercions: 0, joins: 0/0} $wxs :: GHC.Prim.Int# -> () @@ -39,49 +83,5 @@ foo [InlPrag=INLINE[0]] :: Int -> () foo = \ (w :: Int) -> case w of { GHC.Types.I# ww1 -> T3772.$wfoo ww1 } --- RHS size: {terms: 1, types: 0, coercions: 0, joins: 0/0} -T3772.$trModule2 :: GHC.Prim.Addr# -[GblId, - Caf=NoCafRefs, - Unf=Unf{Src=<vanilla>, TopLvl=True, Value=True, ConLike=True, - WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 30 0}] -T3772.$trModule2 = "T3772"# - --- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0} -T3772.$trModule1 :: GHC.Types.TrName -[GblId, - Caf=NoCafRefs, - Str=m1, - Unf=Unf{Src=<vanilla>, TopLvl=True, Value=True, ConLike=True, - WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 10 20}] -T3772.$trModule1 = GHC.Types.TrNameS T3772.$trModule2 - --- RHS size: {terms: 1, types: 0, coercions: 0, joins: 0/0} -T3772.$trModule4 :: GHC.Prim.Addr# -[GblId, - Caf=NoCafRefs, - Unf=Unf{Src=<vanilla>, TopLvl=True, Value=True, ConLike=True, - WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 20 0}] -T3772.$trModule4 = "main"# - --- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0} -T3772.$trModule3 :: GHC.Types.TrName -[GblId, - Caf=NoCafRefs, - Str=m1, - Unf=Unf{Src=<vanilla>, TopLvl=True, Value=True, ConLike=True, - WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 10 20}] -T3772.$trModule3 = GHC.Types.TrNameS T3772.$trModule4 - --- RHS size: {terms: 3, types: 0, coercions: 0, joins: 0/0} -T3772.$trModule :: GHC.Types.Module -[GblId, - Caf=NoCafRefs, - Str=m, - Unf=Unf{Src=<vanilla>, TopLvl=True, Value=True, ConLike=True, - WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 10 30}] -T3772.$trModule - = GHC.Types.Module T3772.$trModule3 T3772.$trModule1 - diff --git a/testsuite/tests/simplCore/should_compile/T4138.stdout b/testsuite/tests/simplCore/should_compile/T4138.stdout index 0cfbf08886..b8626c4cff 100644 --- a/testsuite/tests/simplCore/should_compile/T4138.stdout +++ b/testsuite/tests/simplCore/should_compile/T4138.stdout @@ -1 +1 @@ -2 +4 diff --git a/testsuite/tests/simplCore/should_compile/T7785.hs b/testsuite/tests/simplCore/should_compile/T7785.hs index c6dacb705c..ecde1ff020 100644 --- a/testsuite/tests/simplCore/should_compile/T7785.hs +++ b/testsuite/tests/simplCore/should_compile/T7785.hs @@ -1,9 +1,21 @@ {-# LANGUAGE TypeFamilies, ConstraintKinds #-} module Foo( shared, foo, bar) where +-- module Foo where import GHC.Exts +{- +foo :: [Int] -> [Int] +foo = let f = map negate + in f. f. f. f. f. f. f. f. f. f. f. f. f. f. f. f. f. f. f. f. f. f. f. + f. f. f. f. f. f. f. f. f. f. f. f. f. f. f. f. f. f. f. f. f. f. f. + f. f. f. f. f. f. f. f. f. f. f. f. f. f. f. f. f. f. f. f. f. f. f. + f. f. f. f. f. f. f. f. f. f. f. f. f. f. f. f. f. f. f. f. f. f. f. + f . f . f . f . f . f . f . f . f . f . f . f . f + +-} + type family Domain (f :: * -> *) a :: Constraint type instance Domain [] a = () @@ -22,7 +34,7 @@ shared = let f. f. f. f. f. f. f. f. f. f. f. f. f. f. f. f. f. f. f. f. f. f. f. f. f. f. f. f. f. f. f. f. f. f. f. f. f. f. f. f. f. f. f. f. f. f. f. f. f. f. f. f. f. f. f. f. f. f. f. f. f. f. f. f. f. f. f. f. f. - f + f . f . f . f . f . f . f . f . f . f . f . f . f foo xs = shared $ 0:xs bar xs = 0:shared xs diff --git a/testsuite/tests/simplCore/should_compile/T8848.hs b/testsuite/tests/simplCore/should_compile/T8848.hs index d0f48bdbda..dff86d4541 100644 --- a/testsuite/tests/simplCore/should_compile/T8848.hs +++ b/testsuite/tests/simplCore/should_compile/T8848.hs @@ -18,10 +18,15 @@ instance A.Applicative (Shape r)=> A.Applicative (Shape (S r)) where instance Fun.Functor (Shape Z) where instance (Fun.Functor (Shape r)) => Fun.Functor (Shape (S r)) where -map2 :: (A.Applicative (Shape r))=> (a->b ->c) -> (Shape r a) -> (Shape r b) -> (Shape r c ) -map2 = \f l r -> A.pure f A.<*> l A.<*> r - -{-# SPECIALIZE map2 :: (a->b->c)-> (Shape (S (S Z)) a )-> Shape (S (S Z)) b -> Shape (S (S Z)) c #-} - -map3 :: (a->b->c)-> (Shape (S (S Z)) a )-> Shape (S (S Z)) b -> Shape (S (S Z)) c -map3 x y z = map2 x y z
\ No newline at end of file +map2 :: (A.Applicative (Shape r))=> (a->b ->c) -> (Shape r a) -> (Shape r b) -> [Shape r c] +-- Artifically made recursive so that it won't inline, +-- se we can see if the speicalisation happens +map2 = \f l r -> (A.pure f A.<*> l A.<*> r) : map2 f l r + +{-# SPECIALIZE map2 :: (a->b->c) + -> (Shape (S (S Z)) a ) + -> Shape (S (S Z)) b + -> [Shape (S (S Z)) c] #-} + +map3 :: (a->b->c)-> (Shape (S (S Z)) a )-> Shape (S (S Z)) b -> [Shape (S (S Z)) c] +map3 x y z = map2 x y z diff --git a/testsuite/tests/simplCore/should_compile/T8848.stderr b/testsuite/tests/simplCore/should_compile/T8848.stderr deleted file mode 100644 index aa9bf88d37..0000000000 --- a/testsuite/tests/simplCore/should_compile/T8848.stderr +++ /dev/null @@ -1,101 +0,0 @@ -Rule fired: Class op pure -Rule fired: Class op <*> -Rule fired: Class op <*> -Rule fired: SPEC map2 -Rule fired: Class op fmap -Rule fired: Class op fmap -Rule fired: Class op fmap -Rule fired: Class op liftA2 -Rule fired: Class op $p1Applicative -Rule fired: Class op fmap -Rule fired: Class op <*> -Rule fired: Class op $p1Applicative -Rule fired: Class op <$ -Rule fired: Class op <*> -Rule fired: Class op liftA2 -Rule fired: Class op liftA2 -Rule fired: Class op liftA2 -Rule fired: Class op liftA2 -Rule fired: Class op liftA2 -Rule fired: Class op $p1Applicative -Rule fired: Class op fmap -Rule fired: Class op <*> -Rule fired: Class op $p1Applicative -Rule fired: Class op fmap -Rule fired: Class op <*> -Rule fired: Class op $p1Applicative -Rule fired: Class op <$ -Rule fired: Class op <*> -Rule fired: Class op $p1Applicative -Rule fired: Class op <$ -Rule fired: Class op <*> -Rule fired: Class op $p1Applicative -Rule fired: Class op $p1Applicative -Rule fired: SPEC $cfmap @ 'Z -Rule fired: SPEC $c<$ @ 'Z -Rule fired: SPEC $fFunctorShape @ 'Z -Rule fired: Class op fmap -Rule fired: Class op fmap -Rule fired: SPEC $c<$ @ 'Z -Rule fired: SPEC $fFunctorShape @ 'Z -Rule fired: Class op $p1Applicative -Rule fired: SPEC $fFunctorShape @ 'Z -Rule fired: SPEC $cp1Applicative @ 'Z -Rule fired: SPEC $cpure @ 'Z -Rule fired: SPEC $c<*> @ 'Z -Rule fired: SPEC $cliftA2 @ 'Z -Rule fired: SPEC $c*> @ 'Z -Rule fired: SPEC $c<* @ 'Z -Rule fired: SPEC $fApplicativeShape @ 'Z -Rule fired: SPEC $fApplicativeShape @ 'Z -Rule fired: SPEC $fApplicativeShape @ 'Z -Rule fired: SPEC $fApplicativeShape @ 'Z -Rule fired: SPEC $fApplicativeShape @ 'Z -Rule fired: Class op liftA2 -Rule fired: Class op $p1Applicative -Rule fired: Class op <$ -Rule fired: Class op <*> -Rule fired: Class op $p1Applicative -Rule fired: Class op <$ -Rule fired: Class op <*> -Rule fired: Class op $p1Applicative -Rule fired: Class op fmap -Rule fired: Class op <*> -Rule fired: Class op $p1Applicative -Rule fired: Class op fmap -Rule fired: Class op <*> -Rule fired: Class op liftA2 -Rule fired: Class op liftA2 -Rule fired: Class op liftA2 -Rule fired: Class op liftA2 -Rule fired: SPEC $c<*> @ 'Z -Rule fired: SPEC $cliftA2 @ 'Z -Rule fired: SPEC $c*> @ 'Z -Rule fired: SPEC $c<* @ 'Z -Rule fired: SPEC $fApplicativeShape @ 'Z -Rule fired: Class op liftA2 -Rule fired: Class op liftA2 -Rule fired: Class op liftA2 -Rule fired: Class op liftA2 -Rule fired: SPEC $fApplicativeShape @ 'Z -Rule fired: Class op liftA2 -Rule fired: Class op liftA2 -Rule fired: SPEC $fApplicativeShape @ 'Z -Rule fired: Class op $p1Applicative -Rule fired: Class op fmap -Rule fired: Class op <*> -Rule fired: Class op $p1Applicative -Rule fired: Class op fmap -Rule fired: Class op <*> -Rule fired: SPEC $fApplicativeShape @ 'Z -Rule fired: Class op $p1Applicative -Rule fired: Class op <$ -Rule fired: Class op <*> -Rule fired: Class op $p1Applicative -Rule fired: Class op <$ -Rule fired: Class op <*> -Rule fired: SPEC $fFunctorShape @ 'Z -Rule fired: Class op fmap -Rule fired: Class op fmap -Rule fired: SPEC $c<*> @ ('S 'Z) -Rule fired: SPEC $c<*> @ ('S 'Z) diff --git a/testsuite/tests/simplCore/should_compile/T9509.stdout b/testsuite/tests/simplCore/should_compile/T9509.stdout index 0acd484558..c774c06096 100644 --- a/testsuite/tests/simplCore/should_compile/T9509.stdout +++ b/testsuite/tests/simplCore/should_compile/T9509.stdout @@ -1 +1,2 @@ Rule: SPEC/T9509 foo @ Int + Rule: SPEC/T9509 foo @ Int diff --git a/testsuite/tests/simplCore/should_compile/T9509a.hs b/testsuite/tests/simplCore/should_compile/T9509a.hs index bd6511eedb..b80cf6a7d4 100644 --- a/testsuite/tests/simplCore/should_compile/T9509a.hs +++ b/testsuite/tests/simplCore/should_compile/T9509a.hs @@ -6,5 +6,5 @@ foo :: Ord a => a -> IO a {-# INLINABLE foo #-} foo x = newIORef x >>= readIORef >>= \y -> case compare x y of - LT -> return x ; - _ -> return y + LT -> return x + _ -> foo x -- Recursive so it won't inline diff --git a/testsuite/tests/simplCore/should_compile/all.T b/testsuite/tests/simplCore/should_compile/all.T index 11067e4fbf..ca25d4f9db 100644 --- a/testsuite/tests/simplCore/should_compile/all.T +++ b/testsuite/tests/simplCore/should_compile/all.T @@ -180,7 +180,9 @@ test('T8832', run_command, ['$MAKE -s --no-print-directory T8832 T8832_WORDSIZE_OPTS=' + ('-DT8832_WORDSIZE_64' if wordsize(64) else '')]) -test('T8848', only_ways(['optasm']), compile, ['-ddump-rule-firings -dsuppress-uniques']) +test('T8848', normal, + run_command, + ['$MAKE -s --no-print-directory T8848']) test('T8848a', only_ways(['optasm']), compile, ['-ddump-rules']) test('T8331', only_ways(['optasm']), compile, ['-ddump-rules']) test('T6056', only_ways(['optasm']), multimod_compile, ['T6056', '-v0 -ddump-rule-firings']) @@ -192,7 +194,7 @@ test('T10176', only_ways(['optasm']), compile, ['']) test('T10180', only_ways(['optasm']), compile, ['']) test('T10602', only_ways(['optasm']), multimod_compile, ['T10602','-v0']) test('T10627', only_ways(['optasm']), compile, ['']) -test('T10181', [expect_broken(10181), only_ways(['optasm'])], compile, ['']) +test('T10181', [only_ways(['optasm'])], compile, ['']) test('T10083', normal, run_command, diff --git a/testsuite/tests/simplCore/should_compile/rule2.stderr b/testsuite/tests/simplCore/should_compile/rule2.stderr index 572fac36a8..7444cc90a4 100644 --- a/testsuite/tests/simplCore/should_compile/rule2.stderr +++ b/testsuite/tests/simplCore/should_compile/rule2.stderr @@ -1,6 +1,6 @@ ==================== FloatOut stats: ==================== -1 Lets floated to top level; 0 Lets floated elsewhere; from 4 Lambda groups +0 Lets floated to top level; 0 Lets floated elsewhere; from 3 Lambda groups @@ -10,23 +10,20 @@ ==================== Grand total simplifier statistics ==================== -Total ticks: 15 +Total ticks: 13 -2 PreInlineUnconditionally - 1 f - 1 lvl +1 PreInlineUnconditionally 1 f 1 UnfoldingDone 1 Roman.bar 1 RuleFired 1 foo/bar 3 LetFloatFromLet 3 1 EtaReduction 1 ds -7 BetaReduction +6 BetaReduction 1 f 1 a 1 m - 1 b 1 m 1 b 1 m -9 SimplifierDone 9 +8 SimplifierDone 8 diff --git a/testsuite/tests/simplCore/should_run/T7611.hs b/testsuite/tests/simplCore/should_run/T7611.hs index 717a65518a..bd6baa4d85 100644 --- a/testsuite/tests/simplCore/should_run/T7611.hs +++ b/testsuite/tests/simplCore/should_run/T7611.hs @@ -4,6 +4,7 @@ import GHC.Exts newtype Age = Age Int +{-# NOINLINE myMap #-} myMap f [] = [] myMap f (x:xs) = f x : myMap f xs diff --git a/testsuite/tests/simplCore/should_run/simplrun002.hs b/testsuite/tests/simplCore/should_run/simplrun002.hs index e6cb8d7efc..ec4ea7c7ac 100644 --- a/testsuite/tests/simplCore/should_run/simplrun002.hs +++ b/testsuite/tests/simplCore/should_run/simplrun002.hs @@ -15,9 +15,13 @@ import System.IO.Unsafe ( unsafePerformIO ) -- Dont inline till last, to give the rule a chance sndSnd (a,(b,c)) = (a,c) +{-# NOINLINE [2] myFst #-} +-- Dont inline till last, to give the rule a chance +myFst (a,b) = a + trace x y = unsafePerformIO (hPutStr stderr x >> hPutStr stderr "\n" >> return y) -{-# RULES "foo" forall v . fst (sndSnd v) = trace "Yes" (fst v) #-} +{-# RULES "foo" forall v . myFst (sndSnd v) = trace "Yes" (fst v) #-} main :: IO () -main = print (fst (sndSnd (True, (False,True)))) +main = print (myFst (sndSnd (True, (False,True)))) diff --git a/testsuite/tests/simplCore/should_run/simplrun008.hs b/testsuite/tests/simplCore/should_run/simplrun008.hs index a562005ad4..c82040b683 100644 --- a/testsuite/tests/simplCore/should_run/simplrun008.hs +++ b/testsuite/tests/simplCore/should_run/simplrun008.hs @@ -10,9 +10,13 @@ f x = "NOT FIRED" neg :: Int -> Int neg = negate +{-# NOINLINE myord #-} +myord :: Char -> Int +myord = ord + {-# RULES "f" forall (c::Char->Int) (x::Char). f (c x) = "RULE FIRED" #-} -main = do { print (f (ord 'a')) -- Rule should fire +main = do { print (f (myord 'a')) -- Rule should fire ; print (f (neg 1)) } -- Rule should not fire diff --git a/testsuite/tests/th/TH_Roles2.stderr b/testsuite/tests/th/TH_Roles2.stderr index 30279111c3..d2c6316c51 100644 --- a/testsuite/tests/th/TH_Roles2.stderr +++ b/testsuite/tests/th/TH_Roles2.stderr @@ -16,8 +16,8 @@ TH_Roles2.$tcT TH_Roles2.$trModule (GHC.Types.TrNameS "T"#) 1 - krep_a4im -krep_a4im [InlPrag=[~]] + krep_a40L +krep_a40L [InlPrag=[~]] = GHC.Types.KindRepFun (GHC.Types.KindRepVar 0) (GHC.Types.KindRepTYPE GHC.Types.LiftedRep) |