diff options
| author | Ben Gamari <ben@smart-cactus.org> | 2020-08-12 14:07:34 -0400 |
|---|---|---|
| committer | Marge Bot <ben+marge-bot@smart-cactus.org> | 2020-11-21 01:13:26 -0500 |
| commit | 53ad67eacacde8fde452f1a323d5886183375182 (patch) | |
| tree | 8ebf2d25bc3eeff839f05ad578133a51cd7fddf8 /testsuite/tests | |
| parent | 56804e33a05729f5a5340d3680ae2849e30a9e86 (diff) | |
| download | haskell-53ad67eacacde8fde452f1a323d5886183375182.tar.gz | |
Introduce -fprof-callers flag
This introducing a new compiler flag to provide a convenient way to
introduce profiler cost-centers on all occurrences of the named
identifier.
Closes #18566.
Diffstat (limited to 'testsuite/tests')
9 files changed, 458 insertions, 1 deletions
diff --git a/testsuite/tests/parser/should_run/CountParserDeps.stdout b/testsuite/tests/parser/should_run/CountParserDeps.stdout index 9e810ce68c..5fbdf896ee 100644 --- a/testsuite/tests/parser/should_run/CountParserDeps.stdout +++ b/testsuite/tests/parser/should_run/CountParserDeps.stdout @@ -114,8 +114,8 @@ GHC.Parser.PostProcess GHC.Parser.PostProcess.Haddock GHC.Parser.Types GHC.Platform +GHC.Platform.AArch64 GHC.Platform.ARM -GHC.Platform.ARM64 GHC.Platform.Constants GHC.Platform.NoRegs GHC.Platform.PPC diff --git a/testsuite/tests/profiling/should_run/caller-cc/CallerCc1.prof.sample b/testsuite/tests/profiling/should_run/caller-cc/CallerCc1.prof.sample new file mode 100644 index 0000000000..bd653712ea --- /dev/null +++ b/testsuite/tests/profiling/should_run/caller-cc/CallerCc1.prof.sample @@ -0,0 +1,79 @@ + Fri Nov 13 01:06 2020 Time and Allocation Profiling Report (Final) + + CallerCc1 +RTS -hc -p -RTS 7 + + total time = 0.09 secs (87 ticks @ 1000 us, 1 processor) + total alloc = 105,486,200 bytes (excludes profiling overheads) + +COST CENTRE MODULE SRC %time %alloc + +disin Main Main.hs:(74,1)-(83,11) 35.6 49.5 +insert Main Main.hs:(108,1)-(112,8) 21.8 1.7 +clause.clause' Main Main.hs:(63,12)-(65,57) 17.2 37.5 +unicl.unicl' Main Main.hs:(178,11)-(180,36) 6.9 2.6 +conjunct Main Main.hs:(70,1)-(71,18) 5.7 0.0 +split.split' Main Main.hs:(165,11)-(166,28) 3.4 2.3 +disin.dp Main Main.hs:80:3-14 3.4 0.0 +unicl Main Main.hs:(176,1)-(180,36) 2.3 1.1 +tautclause Main Main.hs:173:1-49 2.3 3.7 +disin.dq Main Main.hs:81:3-14 1.1 0.0 +clause Main Main.hs:(61,1)-(65,57) 0.0 1.4 + + + individual inherited +COST CENTRE MODULE SRC no. entries %time %alloc %time %alloc + +MAIN MAIN <built-in> 128 0 0.0 0.0 100.0 100.0 + CAF Main <entire-module> 255 0 0.0 0.0 0.0 0.0 + clauses Main Main.hs:68:1-74 261 1 0.0 0.0 0.0 0.0 + Main.clauses(calling:Data.Foldable.concat) Main Main.hs:68:1-7 263 1 0.0 0.0 0.0 0.0 + main Main Main.hs:(42,1)-(44,23) 256 1 0.0 0.0 0.0 0.0 + redstar Main Main.hs:155:1-35 279 1 0.0 0.0 0.0 0.0 + spaces Main Main.hs:160:1-19 303 1 0.0 0.0 0.0 0.0 + CAF GHC.Conc.Signal <entire-module> 246 0 0.0 0.0 0.0 0.0 + CAF GHC.IO.Encoding <entire-module> 235 0 0.0 0.0 0.0 0.0 + CAF GHC.IO.Encoding.Iconv <entire-module> 233 0 0.0 0.0 0.0 0.0 + CAF GHC.IO.Handle.FD <entire-module> 225 0 0.0 0.0 0.0 0.0 + main Main Main.hs:(42,1)-(44,23) 257 0 0.0 0.0 100.0 100.0 + res Main Main.hs:(46,1)-(48,26) 258 1 0.0 0.0 100.0 99.9 + Main.main(calling:Data.Foldable.concat) Main Main.hs:42:1-4 259 1 0.0 0.0 0.0 0.0 + res.xs Main Main.hs:47:8-69 260 1 0.0 0.0 0.0 0.0 + clauses Main Main.hs:68:1-74 262 0 0.0 0.0 100.0 99.9 + disin Main Main.hs:(74,1)-(83,11) 267 857598 35.6 49.5 46.0 49.5 + conjunct Main Main.hs:(70,1)-(71,18) 291 759353 5.7 0.0 5.7 0.0 + disin.dp Main Main.hs:80:3-14 292 380009 3.4 0.0 3.4 0.0 + disin.dq Main Main.hs:81:3-14 293 380009 1.1 0.0 1.1 0.0 + negin Main Main.hs:(119,1)-(124,11) 268 1617 0.0 0.1 0.0 0.1 + elim Main Main.hs:(89,1)-(94,57) 269 1393 0.0 0.1 0.0 0.1 + disp Main Main.hs:86:1-71 301 7 0.0 0.0 0.0 0.0 + interleave Main Main.hs:(115,1)-(116,25) 302 35 0.0 0.0 0.0 0.0 + parse Main Main.hs:135:1-39 270 7 0.0 0.0 0.0 0.0 + parse.(...) Main Main.hs:135:19-39 272 7 0.0 0.0 0.0 0.0 + parse' Main Main.hs:(137,1)-(145,42) 273 280 0.0 0.0 0.0 0.0 + opri Main Main.hs:(127,1)-(132,12) 276 56 0.0 0.0 0.0 0.0 + spri Main Main.hs:(169,1)-(170,10) 274 56 0.0 0.0 0.0 0.0 + opri Main Main.hs:(127,1)-(132,12) 275 49 0.0 0.0 0.0 0.0 + parse'.(...) Main Main.hs:142:20-49 278 21 0.0 0.0 0.0 0.0 + redstar Main Main.hs:155:1-35 280 0 0.0 0.0 0.0 0.0 + spri Main Main.hs:(169,1)-(170,10) 282 63 0.0 0.0 0.0 0.0 + opri Main Main.hs:(127,1)-(132,12) 283 63 0.0 0.0 0.0 0.0 + while Main Main.hs:182:1-48 281 63 0.0 0.0 0.0 0.0 + red Main Main.hs:(148,1)-(152,43) 284 42 0.0 0.0 0.0 0.0 + parse'.s' Main Main.hs:142:20-49 285 21 0.0 0.0 0.0 0.0 + parse'.x Main Main.hs:142:20-49 277 21 0.0 0.0 0.0 0.0 + redstar Main Main.hs:155:1-35 286 0 0.0 0.0 0.0 0.0 + spri Main Main.hs:(169,1)-(170,10) 288 21 0.0 0.0 0.0 0.0 + opri Main Main.hs:(127,1)-(132,12) 289 14 0.0 0.0 0.0 0.0 + while Main Main.hs:182:1-48 287 21 0.0 0.0 0.0 0.0 + red Main Main.hs:(148,1)-(152,43) 290 14 0.0 0.0 0.0 0.0 + parse.f Main Main.hs:135:19-39 271 7 0.0 0.0 0.0 0.0 + split Main Main.hs:(163,1)-(166,28) 265 7 0.0 0.0 3.4 2.3 + split.split' Main Main.hs:(165,11)-(166,28) 266 74837 3.4 2.3 3.4 2.3 + unicl Main Main.hs:(176,1)-(180,36) 264 7 2.3 1.1 50.6 48.0 + unicl.unicl' Main Main.hs:(178,11)-(180,36) 294 37422 6.9 2.6 48.3 46.9 + tautclause Main Main.hs:173:1-49 295 37422 2.3 3.7 2.3 3.7 + unicl.unicl'.cp Main Main.hs:180:24-36 296 37422 0.0 0.0 39.1 40.6 + clause Main Main.hs:(61,1)-(65,57) 297 37422 0.0 1.4 39.1 40.6 + clause.clause' Main Main.hs:(63,12)-(65,57) 298 696150 17.2 37.5 39.1 39.2 + insert Main Main.hs:(108,1)-(112,8) 299 366786 21.8 1.7 21.8 1.7 + insert Main Main.hs:(108,1)-(112,8) 300 7 0.0 0.0 0.0 0.0 diff --git a/testsuite/tests/profiling/should_run/caller-cc/CallerCc1.stdout b/testsuite/tests/profiling/should_run/caller-cc/CallerCc1.stdout new file mode 100644 index 0000000000..e62352412e --- /dev/null +++ b/testsuite/tests/profiling/should_run/caller-cc/CallerCc1.stdout @@ -0,0 +1,7 @@ +a <= +a <= +a <= +a <= +a <= +a <= +a <= diff --git a/testsuite/tests/profiling/should_run/caller-cc/CallerCc2.prof.sample b/testsuite/tests/profiling/should_run/caller-cc/CallerCc2.prof.sample new file mode 100644 index 0000000000..d35a0d8350 --- /dev/null +++ b/testsuite/tests/profiling/should_run/caller-cc/CallerCc2.prof.sample @@ -0,0 +1,78 @@ + Fri Nov 13 01:06 2020 Time and Allocation Profiling Report (Final) + + CallerCc2 +RTS -hc -p -RTS 7 + + total time = 0.09 secs (91 ticks @ 1000 us, 1 processor) + total alloc = 105,486,200 bytes (excludes profiling overheads) + +COST CENTRE MODULE SRC %time %alloc + +disin Main Main.hs:(74,1)-(83,11) 26.4 49.5 +clause.clause' Main Main.hs:(63,12)-(65,57) 23.1 37.5 +insert Main Main.hs:(108,1)-(112,8) 18.7 1.7 +conjunct Main Main.hs:(70,1)-(71,18) 8.8 0.0 +unicl.unicl' Main Main.hs:(178,11)-(180,36) 5.5 2.6 +tautclause Main Main.hs:173:1-49 5.5 3.7 +unicl Main Main.hs:(176,1)-(180,36) 3.3 1.1 +split.split' Main Main.hs:(165,11)-(166,28) 3.3 2.3 +disin.dp Main Main.hs:80:3-14 3.3 0.0 +clause Main Main.hs:(61,1)-(65,57) 2.2 1.4 + + + individual inherited +COST CENTRE MODULE SRC no. entries %time %alloc %time %alloc + +MAIN MAIN <built-in> 128 0 0.0 0.0 100.0 100.0 + CAF Main <entire-module> 255 0 0.0 0.0 0.0 0.0 + clauses Main Main.hs:68:1-74 261 1 0.0 0.0 0.0 0.0 + Main.clauses(calling:Data.Foldable.concat) Main Main.hs:68:1-7 263 1 0.0 0.0 0.0 0.0 + main Main Main.hs:(42,1)-(44,23) 256 1 0.0 0.0 0.0 0.0 + redstar Main Main.hs:155:1-35 279 1 0.0 0.0 0.0 0.0 + spaces Main Main.hs:160:1-19 303 1 0.0 0.0 0.0 0.0 + CAF GHC.Conc.Signal <entire-module> 246 0 0.0 0.0 0.0 0.0 + CAF GHC.IO.Encoding <entire-module> 235 0 0.0 0.0 0.0 0.0 + CAF GHC.IO.Encoding.Iconv <entire-module> 233 0 0.0 0.0 0.0 0.0 + CAF GHC.IO.Handle.FD <entire-module> 225 0 0.0 0.0 0.0 0.0 + main Main Main.hs:(42,1)-(44,23) 257 0 0.0 0.0 100.0 100.0 + res Main Main.hs:(46,1)-(48,26) 258 1 0.0 0.0 100.0 99.9 + Main.main(calling:Data.Foldable.concat) Main Main.hs:42:1-4 259 1 0.0 0.0 0.0 0.0 + res.xs Main Main.hs:47:8-69 260 1 0.0 0.0 0.0 0.0 + clauses Main Main.hs:68:1-74 262 0 0.0 0.0 100.0 99.9 + disin Main Main.hs:(74,1)-(83,11) 267 857598 26.4 49.5 38.5 49.5 + conjunct Main Main.hs:(70,1)-(71,18) 291 759353 8.8 0.0 8.8 0.0 + disin.dp Main Main.hs:80:3-14 292 380009 3.3 0.0 3.3 0.0 + disin.dq Main Main.hs:81:3-14 293 380009 0.0 0.0 0.0 0.0 + negin Main Main.hs:(119,1)-(124,11) 268 1617 0.0 0.1 0.0 0.1 + elim Main Main.hs:(89,1)-(94,57) 269 1393 0.0 0.1 0.0 0.1 + disp Main Main.hs:86:1-71 301 7 0.0 0.0 0.0 0.0 + interleave Main Main.hs:(115,1)-(116,25) 302 35 0.0 0.0 0.0 0.0 + parse Main Main.hs:135:1-39 270 7 0.0 0.0 0.0 0.0 + parse.(...) Main Main.hs:135:19-39 272 7 0.0 0.0 0.0 0.0 + parse' Main Main.hs:(137,1)-(145,42) 273 280 0.0 0.0 0.0 0.0 + opri Main Main.hs:(127,1)-(132,12) 276 56 0.0 0.0 0.0 0.0 + spri Main Main.hs:(169,1)-(170,10) 274 56 0.0 0.0 0.0 0.0 + opri Main Main.hs:(127,1)-(132,12) 275 49 0.0 0.0 0.0 0.0 + parse'.(...) Main Main.hs:142:20-49 278 21 0.0 0.0 0.0 0.0 + redstar Main Main.hs:155:1-35 280 0 0.0 0.0 0.0 0.0 + spri Main Main.hs:(169,1)-(170,10) 282 63 0.0 0.0 0.0 0.0 + opri Main Main.hs:(127,1)-(132,12) 283 63 0.0 0.0 0.0 0.0 + while Main Main.hs:182:1-48 281 63 0.0 0.0 0.0 0.0 + red Main Main.hs:(148,1)-(152,43) 284 42 0.0 0.0 0.0 0.0 + parse'.s' Main Main.hs:142:20-49 285 21 0.0 0.0 0.0 0.0 + parse'.x Main Main.hs:142:20-49 277 21 0.0 0.0 0.0 0.0 + redstar Main Main.hs:155:1-35 286 0 0.0 0.0 0.0 0.0 + spri Main Main.hs:(169,1)-(170,10) 288 21 0.0 0.0 0.0 0.0 + opri Main Main.hs:(127,1)-(132,12) 289 14 0.0 0.0 0.0 0.0 + while Main Main.hs:182:1-48 287 21 0.0 0.0 0.0 0.0 + red Main Main.hs:(148,1)-(152,43) 290 14 0.0 0.0 0.0 0.0 + parse.f Main Main.hs:135:19-39 271 7 0.0 0.0 0.0 0.0 + split Main Main.hs:(163,1)-(166,28) 265 7 0.0 0.0 3.3 2.3 + split.split' Main Main.hs:(165,11)-(166,28) 266 74837 3.3 2.3 3.3 2.3 + unicl Main Main.hs:(176,1)-(180,36) 264 7 3.3 1.1 58.2 48.0 + unicl.unicl' Main Main.hs:(178,11)-(180,36) 294 37422 5.5 2.6 54.9 46.9 + tautclause Main Main.hs:173:1-49 295 37422 5.5 3.7 5.5 3.7 + unicl.unicl'.cp Main Main.hs:180:24-36 296 37422 0.0 0.0 44.0 40.6 + clause Main Main.hs:(61,1)-(65,57) 297 37422 2.2 1.4 44.0 40.6 + clause.clause' Main Main.hs:(63,12)-(65,57) 298 696150 23.1 37.5 41.8 39.2 + insert Main Main.hs:(108,1)-(112,8) 299 366786 18.7 1.7 18.7 1.7 + insert Main Main.hs:(108,1)-(112,8) 300 7 0.0 0.0 0.0 0.0 diff --git a/testsuite/tests/profiling/should_run/caller-cc/CallerCc2.stdout b/testsuite/tests/profiling/should_run/caller-cc/CallerCc2.stdout new file mode 100644 index 0000000000..e62352412e --- /dev/null +++ b/testsuite/tests/profiling/should_run/caller-cc/CallerCc2.stdout @@ -0,0 +1,7 @@ +a <= +a <= +a <= +a <= +a <= +a <= +a <= diff --git a/testsuite/tests/profiling/should_run/caller-cc/CallerCc3.prof.sample b/testsuite/tests/profiling/should_run/caller-cc/CallerCc3.prof.sample new file mode 100644 index 0000000000..68fd783a35 --- /dev/null +++ b/testsuite/tests/profiling/should_run/caller-cc/CallerCc3.prof.sample @@ -0,0 +1,78 @@ + Fri Nov 13 01:06 2020 Time and Allocation Profiling Report (Final) + + CallerCc3 +RTS -hc -p -RTS 7 + + total time = 0.09 secs (85 ticks @ 1000 us, 1 processor) + total alloc = 105,486,200 bytes (excludes profiling overheads) + +COST CENTRE MODULE SRC %time %alloc + +disin Main Main.hs:(74,1)-(83,11) 29.4 49.5 +insert Main Main.hs:(108,1)-(112,8) 24.7 1.7 +clause.clause' Main Main.hs:(63,12)-(65,57) 23.5 37.5 +conjunct Main Main.hs:(70,1)-(71,18) 10.6 0.0 +tautclause Main Main.hs:173:1-49 4.7 3.7 +unicl.unicl' Main Main.hs:(178,11)-(180,36) 3.5 2.6 +split.split' Main Main.hs:(165,11)-(166,28) 2.4 2.3 +disin.dp Main Main.hs:80:3-14 1.2 0.0 +unicl Main Main.hs:(176,1)-(180,36) 0.0 1.1 +clause Main Main.hs:(61,1)-(65,57) 0.0 1.4 + + + individual inherited +COST CENTRE MODULE SRC no. entries %time %alloc %time %alloc + +MAIN MAIN <built-in> 128 0 0.0 0.0 100.0 100.0 + CAF Main <entire-module> 255 0 0.0 0.0 0.0 0.0 + clauses Main Main.hs:68:1-74 261 1 0.0 0.0 0.0 0.0 + Main.clauses(calling:Data.Foldable.concat) Main Main.hs:68:1-7 263 1 0.0 0.0 0.0 0.0 + main Main Main.hs:(42,1)-(44,23) 256 1 0.0 0.0 0.0 0.0 + redstar Main Main.hs:155:1-35 279 1 0.0 0.0 0.0 0.0 + spaces Main Main.hs:160:1-19 303 1 0.0 0.0 0.0 0.0 + CAF GHC.Conc.Signal <entire-module> 246 0 0.0 0.0 0.0 0.0 + CAF GHC.IO.Encoding <entire-module> 235 0 0.0 0.0 0.0 0.0 + CAF GHC.IO.Encoding.Iconv <entire-module> 233 0 0.0 0.0 0.0 0.0 + CAF GHC.IO.Handle.FD <entire-module> 225 0 0.0 0.0 0.0 0.0 + main Main Main.hs:(42,1)-(44,23) 257 0 0.0 0.0 100.0 100.0 + res Main Main.hs:(46,1)-(48,26) 258 1 0.0 0.0 100.0 99.9 + Main.main(calling:Data.Foldable.concat) Main Main.hs:42:1-4 259 1 0.0 0.0 0.0 0.0 + res.xs Main Main.hs:47:8-69 260 1 0.0 0.0 0.0 0.0 + clauses Main Main.hs:68:1-74 262 0 0.0 0.0 100.0 99.9 + disin Main Main.hs:(74,1)-(83,11) 267 857598 29.4 49.5 41.2 49.5 + conjunct Main Main.hs:(70,1)-(71,18) 291 759353 10.6 0.0 10.6 0.0 + disin.dp Main Main.hs:80:3-14 292 380009 1.2 0.0 1.2 0.0 + disin.dq Main Main.hs:81:3-14 293 380009 0.0 0.0 0.0 0.0 + negin Main Main.hs:(119,1)-(124,11) 268 1617 0.0 0.1 0.0 0.1 + elim Main Main.hs:(89,1)-(94,57) 269 1393 0.0 0.1 0.0 0.1 + disp Main Main.hs:86:1-71 301 7 0.0 0.0 0.0 0.0 + interleave Main Main.hs:(115,1)-(116,25) 302 35 0.0 0.0 0.0 0.0 + parse Main Main.hs:135:1-39 270 7 0.0 0.0 0.0 0.0 + parse.(...) Main Main.hs:135:19-39 272 7 0.0 0.0 0.0 0.0 + parse' Main Main.hs:(137,1)-(145,42) 273 280 0.0 0.0 0.0 0.0 + opri Main Main.hs:(127,1)-(132,12) 276 56 0.0 0.0 0.0 0.0 + spri Main Main.hs:(169,1)-(170,10) 274 56 0.0 0.0 0.0 0.0 + opri Main Main.hs:(127,1)-(132,12) 275 49 0.0 0.0 0.0 0.0 + parse'.(...) Main Main.hs:142:20-49 278 21 0.0 0.0 0.0 0.0 + redstar Main Main.hs:155:1-35 280 0 0.0 0.0 0.0 0.0 + spri Main Main.hs:(169,1)-(170,10) 282 63 0.0 0.0 0.0 0.0 + opri Main Main.hs:(127,1)-(132,12) 283 63 0.0 0.0 0.0 0.0 + while Main Main.hs:182:1-48 281 63 0.0 0.0 0.0 0.0 + red Main Main.hs:(148,1)-(152,43) 284 42 0.0 0.0 0.0 0.0 + parse'.s' Main Main.hs:142:20-49 285 21 0.0 0.0 0.0 0.0 + parse'.x Main Main.hs:142:20-49 277 21 0.0 0.0 0.0 0.0 + redstar Main Main.hs:155:1-35 286 0 0.0 0.0 0.0 0.0 + spri Main Main.hs:(169,1)-(170,10) 288 21 0.0 0.0 0.0 0.0 + opri Main Main.hs:(127,1)-(132,12) 289 14 0.0 0.0 0.0 0.0 + while Main Main.hs:182:1-48 287 21 0.0 0.0 0.0 0.0 + red Main Main.hs:(148,1)-(152,43) 290 14 0.0 0.0 0.0 0.0 + parse.f Main Main.hs:135:19-39 271 7 0.0 0.0 0.0 0.0 + split Main Main.hs:(163,1)-(166,28) 265 7 0.0 0.0 2.4 2.3 + split.split' Main Main.hs:(165,11)-(166,28) 266 74837 2.4 2.3 2.4 2.3 + unicl Main Main.hs:(176,1)-(180,36) 264 7 0.0 1.1 56.5 48.0 + unicl.unicl' Main Main.hs:(178,11)-(180,36) 294 37422 3.5 2.6 56.5 46.9 + tautclause Main Main.hs:173:1-49 295 37422 4.7 3.7 4.7 3.7 + unicl.unicl'.cp Main Main.hs:180:24-36 296 37422 0.0 0.0 48.2 40.6 + clause Main Main.hs:(61,1)-(65,57) 297 37422 0.0 1.4 48.2 40.6 + clause.clause' Main Main.hs:(63,12)-(65,57) 298 696150 23.5 37.5 48.2 39.2 + insert Main Main.hs:(108,1)-(112,8) 299 366786 24.7 1.7 24.7 1.7 + insert Main Main.hs:(108,1)-(112,8) 300 7 0.0 0.0 0.0 0.0 diff --git a/testsuite/tests/profiling/should_run/caller-cc/CallerCc3.stdout b/testsuite/tests/profiling/should_run/caller-cc/CallerCc3.stdout new file mode 100644 index 0000000000..e62352412e --- /dev/null +++ b/testsuite/tests/profiling/should_run/caller-cc/CallerCc3.stdout @@ -0,0 +1,7 @@ +a <= +a <= +a <= +a <= +a <= +a <= +a <= diff --git a/testsuite/tests/profiling/should_run/caller-cc/Main.hs b/testsuite/tests/profiling/should_run/caller-cc/Main.hs new file mode 100644 index 0000000000..c945631d33 --- /dev/null +++ b/testsuite/tests/profiling/should_run/caller-cc/Main.hs @@ -0,0 +1,182 @@ +{- +From: dw@minster.york.ac.uk +To: partain +Subject: a compiler test +Date: 3 Mar 1992 12:31:00 GMT + +Will, + One of the decisions taken at the FLARE meeting yesterday was that we +(FLARE people) should send you (GRASP people) interesting Haskell programs +to test your new compiler. So allow me to present the following program, +written by Colin Runciman in various functional languages over the years, +which puts propositions into clausal form. The original program was +interactive, but I've made it batch so that you can run it over night. +Here is an example run with the prototype compiler. Note the result is +"a <=". + + hc clausify.hs + Haskell-0.41 (EXPERIMENTAL) + Glasgow University Haskell Compiler, version 0.41 + G-Code version + -71$ a.out + a <= + -71$ + +Cheers, + +David +-} + +------------------------------------------------------------------------------ +-- reducing propositions to clausal form +-- Colin Runciman, University of York, 18/10/90 + +-- an excellent benchmark is: (a = a = a) = (a = a = a) = (a = a = a) +-- batch mode version David Wakeling, February 1992 + +module Main(main) where + +import Data.Ix +import System.Environment + +main = do + (n:_) <- getArgs + putStr (res (read n)) + +res n = concat (map clauses xs) + where xs = take n (repeat "(a = a = a) = (a = a = a) = (a = a = a)") + {-# NOINLINE xs #-} + +data StackFrame = Ast Formula | Lex Char + +data Formula = + Sym Char | + Not Formula | + Dis Formula Formula | + Con Formula Formula | + Imp Formula Formula | + Eqv Formula Formula + +-- separate positive and negative literals, eliminating duplicates +clause p = clause' p ([] , []) + where + clause' (Dis p q) x = clause' p (clause' q x) + clause' (Sym s) (c,a) = (insert s c , a) + clause' (Not (Sym s)) (c,a) = (c , insert s a) + +-- the main pipeline from propositional formulae to printed clauses +clauses = concat . map disp . unicl . split . disin . negin . elim . parse + +conjunct (Con p q) = True +conjunct p = False + +-- shift disjunction within conjunction +disin (Dis p (Con q r)) = Con (disin (Dis p q)) (disin (Dis p r)) +disin (Dis (Con p q) r) = Con (disin (Dis p r)) (disin (Dis q r)) +disin (Dis p q) = + if conjunct dp || conjunct dq then disin (Dis dp dq) + else (Dis dp dq) + where + dp = disin p + dq = disin q +disin (Con p q) = Con (disin p) (disin q) +disin p = p + +-- format pair of lists of propositional symbols as clausal axiom +disp (l,r) = interleave l spaces ++ "<=" ++ interleave spaces r ++ "\n" + +-- eliminate connectives other than not, disjunction and conjunction +elim (Sym s) = Sym s +elim (Not p) = Not (elim p) +elim (Dis p q) = Dis (elim p) (elim q) +elim (Con p q) = Con (elim p) (elim q) +elim (Imp p q) = Dis (Not (elim p)) (elim q) +elim (Eqv f f') = Con (elim (Imp f f')) (elim (Imp f' f)) + +-- the priorities of propositional expressions +{- UNUSED: +fpri (Sym c) = 6 +fpri (Not p) = 5 +fpri (Con p q) = 4 +fpri (Dis p q) = 3 +fpri (Imp p q) = 2 +fpri (Eqv p q) = 1 +-} + +-- insertion of an item into an ordered list +-- Note: this is a corrected version from Colin (94/05/03 WDP) +insert x [] = [x] +insert x p@(y:ys) = + if x < y then x : p + else if x > y then y : insert x ys + else p + + +interleave (x:xs) ys = x : interleave ys xs +interleave [] _ = [] + +-- shift negation to innermost positions +negin (Not (Not p)) = negin p +negin (Not (Con p q)) = Dis (negin (Not p)) (negin (Not q)) +negin (Not (Dis p q)) = Con (negin (Not p)) (negin (Not q)) +negin (Dis p q) = Dis (negin p) (negin q) +negin (Con p q) = Con (negin p) (negin q) +negin p = p + +-- the priorities of symbols during parsing +opri '(' = 0 +opri '=' = 1 +opri '>' = 2 +opri '|' = 3 +opri '&' = 4 +opri '~' = 5 + +-- parsing a propositional formula +parse t = f where [Ast f] = parse' t [] + +parse' [] s = redstar s +parse' (' ':t) s = parse' t s +parse' ('(':t) s = parse' t (Lex '(' : s) +parse' (')':t) s = parse' t (x:s') + where + (x : Lex '(' : s') = redstar s +parse' (c:t) s = if inRange ('a','z') c then parse' t (Ast (Sym c) : s) + else if spri s > opri c then parse' (c:t) (red s) + else parse' t (Lex c : s) + +-- reduction of the parse stack +red (Ast p : Lex '=' : Ast q : s) = Ast (Eqv q p) : s +red (Ast p : Lex '>' : Ast q : s) = Ast (Imp q p) : s +red (Ast p : Lex '|' : Ast q : s) = Ast (Dis q p) : s +red (Ast p : Lex '&' : Ast q : s) = Ast (Con q p) : s +red (Ast p : Lex '~' : s) = Ast (Not p) : s + +-- iterative reduction of the parse stack +redstar = while ((/=) 0 . spri) red + +-- old: partain: +--redstar = while ((/=) (0::Int) . spri) red + +spaces = repeat ' ' + +-- split conjunctive proposition into a list of conjuncts +split p = split' p [] + where + split' (Con p q) a = split' p (split' q a) + split' p a = p : a + +-- priority of the parse stack +spri (Ast x : Lex c : s) = opri c +spri s = 0 + +-- does any symbol appear in both consequent and antecedent of clause +tautclause (c,a) = [x | x <- c, x `elem` a] /= [] + +-- form unique clausal axioms excluding tautologies +unicl a = foldr unicl' [] a + where + unicl' p x = if tautclause cp then x else insert cp x + where + cp = clause p + +while p f x = if p x then while p f (f x) else x diff --git a/testsuite/tests/profiling/should_run/caller-cc/all.T b/testsuite/tests/profiling/should_run/caller-cc/all.T new file mode 100644 index 0000000000..2b8837aa07 --- /dev/null +++ b/testsuite/tests/profiling/should_run/caller-cc/all.T @@ -0,0 +1,19 @@ +setTestOpts(req_profiling) +setTestOpts(extra_ways(['prof', 'ghci-ext-prof'])) +setTestOpts(only_ways(prof_ways)) +setTestOpts(extra_files(['Main.hs'])) +setTestOpts(extra_run_opts('7')) + +# N.B. Main.hs is stolen from heapprof001. + +test('CallerCc1', normal, + multimod_compile_and_run, + ['Main', '-fprof-callers=*.concat -O0']) + +test('CallerCc2', normal, + multimod_compile_and_run, + ['Main', '-fprof-callers=Data.Foldable.concat -O0']) + +test('CallerCc3', normal, + multimod_compile_and_run, + ['Main', '-fprof-callers=Data.Foldable.con*at -O0']) |