Commit | Line | Data |
---|---|---|
7f918cf1 CE |
1 | (* Copyright (C) 2013,2014 Matthew Fluet. |
2 | * Copyright (C) 2009 Matthew Fluet. | |
3 | * Copyright (C) 1999-2007 Henry Cejtin, Matthew Fluet, Suresh | |
4 | * Jagannathan, and Stephen Weeks. | |
5 | * Copyright (C) 1997-2000 NEC Research Institute. | |
6 | * | |
7 | * MLton is released under a BSD-style license. | |
8 | * See the file MLton-LICENSE for details. | |
9 | *) | |
10 | ||
11 | structure Main = | |
12 | struct | |
13 | ||
14 | type int = Int.t | |
15 | ||
16 | fun usage msg = | |
17 | Process.usage {usage = "[-mlkit] [-mlton </path/to/mlton>] [-mosml] [-poly] [-smlnj] bench1 bench2 ...", | |
18 | msg = msg} | |
19 | ||
20 | val doOnce = ref false | |
21 | val doWiki = ref false | |
22 | val runArgs : string list ref = ref [] | |
23 | ||
24 | fun withInput (file, f: unit -> 'a): 'a = | |
25 | let | |
26 | open FileDesc | |
27 | val inFd = | |
28 | let | |
29 | open Pervasive.Posix.FileSys | |
30 | in | |
31 | openf (file, O_RDONLY, O.flags []) | |
32 | end | |
33 | in | |
34 | Exn.finally | |
35 | (fn () => FileDesc.fluidLet (FileDesc.stdin, inFd, f), | |
36 | fn () => FileDesc.close inFd) | |
37 | end | |
38 | ||
39 | fun ignoreOutput f = | |
40 | let | |
41 | val nullFd = | |
42 | let | |
43 | open Pervasive.Posix.FileSys | |
44 | in | |
45 | openf ("/dev/null", O_WRONLY, O.flags []) | |
46 | end | |
47 | open FileDesc | |
48 | in | |
49 | Exn.finally | |
50 | (fn () => fluidLet (stderr, nullFd, fn () => | |
51 | fluidLet (stdout, nullFd, f)), | |
52 | fn () => close nullFd) | |
53 | end | |
54 | ||
55 | datatype command = | |
56 | Explicit of {args: string list, | |
57 | com: string} | |
58 | | Shell of string list | |
59 | ||
60 | fun timeIt ca = | |
61 | Process.time | |
62 | (fn () => | |
63 | case ca of | |
64 | Explicit {args, com} => | |
65 | Process.wait (Process.spawnp {file = com, args = com :: args}) | |
66 | | Shell ss => List.foreach (ss, Process.system)) | |
67 | ||
68 | local | |
69 | val trialTime = Time.seconds (IntInf.fromInt 60) | |
70 | in | |
71 | fun timeCall (com, args): real = | |
72 | let | |
73 | fun doit ac = | |
74 | let | |
75 | val {user, system} = timeIt (Explicit {args = args, com = com}) | |
76 | val op + = Time.+ | |
77 | in ac + user + system | |
78 | end | |
79 | fun loop (n, ac: Time.t): real = | |
80 | if Time.> (ac, trialTime) | |
81 | then Time.toReal ac / Real.fromInt n | |
82 | else loop (n + 1, doit ac) | |
83 | in | |
84 | if !doOnce | |
85 | then Time.toReal (doit Time.zero) | |
86 | else loop (0, Time.zero) | |
87 | end | |
88 | end | |
89 | ||
90 | val benchCounts: (string * int) list = | |
91 | ("barnes-hut", 24576):: (* 31.32 sec *) | |
92 | ("boyer", 12288):: (* 40.77 sec *) | |
93 | ("checksum", 8192):: (* 31.33 sec *) | |
94 | ("count-graphs", 16):: (* 35.35 sec *) | |
95 | ("DLXSimulator", 256):: (* 30.68 sec *) | |
96 | ("even-odd", 24):: (* 37.76 sec *) | |
97 | ("fft", 12):: (* 35.31 sec *) | |
98 | ("fib", 12):: (* 30.48 sec *) | |
99 | ("flat-array", 32768):: (* 35.03 sec *) | |
100 | ("hamlet", 384):: (* 44.55 sec *) | |
101 | ("imp-for", 3072):: (* 30.25 sec *) | |
102 | ("knuth-bendix", 3072):: (* 37.84 sec *) | |
103 | ("lexgen", 2048):: (* 34.41 sec *) | |
104 | ("life", 32):: (* 37.98 sec *) | |
105 | ("logic", 256):: (* 39.00 sec *) | |
106 | ("mandelbrot", 6):: (* 38.49 sec *) | |
107 | ("matrix-multiply", 128):: (* 30.01 sec *) | |
108 | ("md5", 96):: (* 41.23 sec *) | |
109 | ("merge", 16384):: (* 39.13 sec *) | |
110 | ("mlyacc", 3072):: (* 37.48 sec *) | |
111 | ("model-elimination", 4):: (* 39.14 sec *) | |
112 | ("mpuz", 96):: (* 30.01 sec *) | |
113 | ("nucleic", 4096):: (* 31.90 sec *) | |
114 | ("output1", 12):: (* 33.01 sec *) | |
115 | ("peek", 2048):: (* 35.93 sec *) | |
116 | ("pidigits", 4096):: (* 36.27 sec *) | |
117 | ("psdes-random", 24):: (* 40.57 sec *) | |
118 | ("ratio-regions", 1536):: (* 45.14 sec *) | |
119 | ("ray", 1536):: (* 42.18 sec *) | |
120 | ("raytrace", 96):: (* 37.27 sec *) | |
121 | ("simple", 768):: (* 36.10 sec *) | |
122 | ("smith-normal-form", 192):: (* 41.93 sec *) | |
123 | ("string-concat", 768):: (* 93.94 sec *) | |
124 | ("tailfib", 512):: (* 35.36 sec *) | |
125 | ("tak", 24):: (* 44.71 sec *) | |
126 | ("tensor", 6):: (* 34.63 sec *) | |
127 | ("tsp", 16):: (* 36.91 sec *) | |
128 | ("tyan", 384):: (* 32.56 sec *) | |
129 | ("vector32-concat", 96):: (* 79.84 sec *) | |
130 | ("vector64-concat", 96):: | |
131 | ("vector-rev", 64):: (* 32.16 sec *) | |
132 | ("vliw", 768):: (* 30.51 sec *) | |
133 | ("wc-input1", 24576):: (* 41.69 sec *) | |
134 | ("wc-scanStream", 24576):: (* 30.55 sec *) | |
135 | ("zebra", 64):: (* 33.44 sec *) | |
136 | ("zern", 12288):: (* 33.59 sec *) | |
137 | nil | |
138 | ||
139 | val benchCount = | |
140 | String.memoize | |
141 | (fn s => | |
142 | case List.peek (benchCounts, fn (b, _) => b = s) of | |
143 | NONE => Error.bug (concat ["no benchCount for ", s]) | |
144 | | SOME (_, c) => Int.toString c) | |
145 | ||
146 | val default_main = (fn bench => concat ["val _ = Main.doit ", benchCount bench, "\n"]) | |
147 | ||
148 | fun compileSizeRun {command, exe, doTextPlusData: bool} = | |
149 | Escape.new | |
150 | (fn e => | |
151 | let | |
152 | val exe = "./" ^ exe | |
153 | val {system, user} = timeIt command | |
154 | handle _ => Escape.escape (e, {compile = NONE, | |
155 | run = NONE, | |
156 | size = NONE}) | |
157 | val compile = SOME (Time.toReal (Time.+ (system, user))) | |
158 | val size = | |
159 | if doTextPlusData | |
160 | then | |
161 | let | |
162 | val {text, data, ...} = Process.size exe | |
163 | in SOME (Position.fromInt (text + data)) | |
164 | end | |
165 | else SOME (File.size exe) | |
166 | val run = | |
167 | timeCall (exe, !runArgs) | |
168 | handle _ => Escape.escape (e, {compile = compile, | |
169 | run = NONE, | |
170 | size = size}) | |
171 | in {compile = compile, | |
172 | run = SOME run, | |
173 | size = size} | |
174 | end) | |
175 | ||
176 | fun batch_ {abbrv, bench} = | |
177 | let | |
178 | val abbrv = | |
179 | String.translate | |
180 | (abbrv, fn c => | |
181 | if Char.isAlphaNum c | |
182 | then String.fromChar c | |
183 | else "_") | |
184 | in | |
185 | concat [bench, ".", abbrv, ".batch"] | |
186 | end | |
187 | ||
188 | fun batch ab = | |
189 | concat [batch_ ab, ".sml"] | |
190 | ||
191 | local | |
192 | val n = Counter.new 0 | |
193 | in | |
194 | fun makeMLton commandPattern = | |
195 | case ChoicePattern.expand commandPattern of | |
196 | Result.No m => usage m | |
197 | | Result.Yes cmds => | |
198 | List.map | |
199 | (cmds, fn cmd => | |
200 | let | |
201 | val abbrv = "MLton" ^ (Int.toString (Counter.next n)) | |
202 | in | |
203 | {name = cmd, | |
204 | abbrv = abbrv, | |
205 | main = default_main, | |
206 | test = (fn {bench} => | |
207 | let | |
208 | val src = batch {abbrv = abbrv, bench = bench} | |
209 | val exe = String.dropSuffix (src, 4) | |
210 | val cmds = (concat [cmd, " -output ", exe, " ", src]):: | |
211 | (*(concat ["strip ", exe])::*) | |
212 | nil | |
213 | in | |
214 | compileSizeRun | |
215 | {command = Shell cmds, | |
216 | exe = exe, | |
217 | doTextPlusData = true} | |
218 | end)} | |
219 | end) | |
220 | end | |
221 | ||
222 | fun kitCompile {bench} = | |
223 | let | |
224 | val bargs = {abbrv = "MLKit", bench = bench} | |
225 | val bin = batch_ bargs | |
226 | in compileSizeRun | |
227 | {command = Explicit {args = ["-o", bin, batch bargs], | |
228 | com = "mlkit"}, | |
229 | exe = bin, | |
230 | doTextPlusData = true} | |
231 | end | |
232 | ||
233 | fun mosmlCompile {bench} = | |
234 | let | |
235 | val bargs = {abbrv = "Moscow ML", bench = bench} | |
236 | val bin = batch_ bargs | |
237 | in compileSizeRun | |
238 | {command = Explicit {args = ["-orthodox", "-standalone", "-toplevel", | |
239 | "-o", bin, batch bargs], | |
240 | com = "mosmlc"}, | |
241 | exe = bin, | |
242 | doTextPlusData = false} | |
243 | end | |
244 | ||
245 | ||
246 | val njSuffix = | |
247 | Promise.delay | |
248 | (fn () => | |
249 | let | |
250 | val sml = "sml" | |
251 | val suffix = | |
252 | File.withTemp | |
253 | (fn tmp => | |
254 | (File.withTempOut | |
255 | (fn output => | |
256 | Out.output | |
257 | (output, concat ["val tmp = TextIO.openOut(\"", tmp, "\");\n", | |
258 | "val _ = TextIO.output(tmp, SMLofNJ.SysInfo.getHeapSuffix());\n", | |
259 | "val _ = TextIO.closeOut(tmp);\n"]), | |
260 | fn input => | |
261 | withInput | |
262 | (input, fn () => | |
263 | Process.wait (Process.spawnp {file = sml, args = [sml]}))) | |
264 | ; In.withClose (In.openIn tmp, In.inputAll))) | |
265 | in | |
266 | suffix | |
267 | end) | |
268 | ||
269 | fun njCompile {bench} = | |
270 | Escape.new | |
271 | (fn e => | |
272 | let | |
273 | (* sml should start SML/NJ *) | |
274 | val sml = "sml" | |
275 | val {system, user} = | |
276 | File.withTempOut | |
277 | (fn out => | |
278 | (Out.output | |
279 | (out, "local\nval _ = SMLofNJ.Internals.GC.messages false\n") | |
280 | ; File.outputContents (concat [bench, ".sml"], out) | |
281 | ; (Out.output | |
282 | (out, | |
283 | concat | |
284 | ["in val _ = SMLofNJ.exportFn (\"", bench, | |
285 | "\", fn _ => (Main.doit ", benchCount bench, | |
286 | "; OS.Process.success))\nend\n"] | |
287 | ))), | |
288 | fn input => withInput (input, fn () => timeIt (Explicit {args = [], | |
289 | com = sml}))) | |
290 | handle _ => Escape.escape (e, {compile = NONE, | |
291 | run = NONE, | |
292 | size = NONE}) | |
293 | val suffix = Promise.force njSuffix | |
294 | val heap = concat [bench, ".", suffix] | |
295 | in | |
296 | if not (File.doesExist heap) | |
297 | then {compile = NONE, | |
298 | run = NONE, | |
299 | size = NONE} | |
300 | else | |
301 | let | |
302 | val compile = Time.toReal (Time.+ (user, system)) | |
303 | val size = SOME (File.size heap) | |
304 | val run = | |
305 | timeCall (sml, [concat ["@SMLload=", heap]]) | |
306 | handle _ => Escape.escape (e, {compile = SOME compile, | |
307 | run = NONE, | |
308 | size = size}) | |
309 | in {compile = SOME compile, | |
310 | run = SOME run, | |
311 | size = size} | |
312 | end | |
313 | end) | |
314 | ||
315 | fun polyCompile {bench} = | |
316 | let | |
317 | val bargs = {abbrv = "Poly/ML", bench = bench} | |
318 | val bin = batch_ bargs | |
319 | in compileSizeRun | |
320 | {command = Explicit {args = [batch bargs, "-o", bin], | |
321 | com = "polyc"}, | |
322 | exe = bin, | |
323 | doTextPlusData = false} | |
324 | end | |
325 | ||
326 | type 'a data = {bench: string, | |
327 | compiler: string, | |
328 | value: 'a} list | |
329 | ||
330 | fun main args = | |
331 | let | |
332 | val compilers: {name: string, | |
333 | abbrv: string, | |
334 | main: string -> string, | |
335 | test: {bench: File.t} -> {compile: real option, | |
336 | run: real option, | |
337 | size: Position.int option}} list ref | |
338 | = ref [] | |
339 | fun pushCompiler compiler = List.push(compilers, compiler) | |
340 | fun pushCompilers compilers' = compilers := (List.rev compilers') @ (!compilers) | |
341 | ||
342 | fun setData (switch, data, str) = | |
343 | let | |
344 | fun die () = usage (concat ["invalid -", switch, " argument: ", str]) | |
345 | open Regexp | |
346 | val numSave = Save.new () | |
347 | val regexpSave = Save.new () | |
348 | val re = seq [save (star digit, numSave), | |
349 | char #",", | |
350 | save (star any, regexpSave)] | |
351 | val reC = compileDFA re | |
352 | in | |
353 | case Compiled.matchAll (reC, str) of | |
354 | NONE => die () | |
355 | | SOME match => | |
356 | let | |
357 | val num = Match.lookupString (match, numSave) | |
358 | val num = case Int.fromString num of | |
359 | NONE => die () | |
360 | | SOME num => num | |
361 | val regexp = Match.lookupString (match, regexpSave) | |
362 | val (regexp, saves) = | |
363 | case Regexp.fromString regexp of | |
364 | NONE => die () | |
365 | | SOME regexp => regexp | |
366 | val save = if 0 <= num andalso num < Vector.length saves | |
367 | then Vector.sub (saves, num) | |
368 | else die () | |
369 | val regexpC = compileDFA regexp | |
370 | fun doit s = | |
371 | Option.map | |
372 | (Compiled.matchAll (regexpC, s), | |
373 | fn match => Match.lookupString (match, save)) | |
374 | in | |
375 | data := SOME (str, doit) | |
376 | end | |
377 | end | |
378 | val outData : (string * (string -> string option)) option ref = ref NONE | |
379 | val setOutData = fn str => setData ("out", outData, str) | |
380 | val errData : (string * (string -> string option)) option ref = ref NONE | |
381 | val setErrData = fn str => setData ("err", errData, str) | |
382 | (* Set the stack limit to its max, since mlkit segfaults on some benchmarks | |
383 | * otherwise. | |
384 | *) | |
385 | val _ = | |
386 | let | |
387 | open MLton.Platform.OS | |
388 | in | |
389 | if host = Linux | |
390 | then | |
391 | let | |
392 | open MLton.Rlimit | |
393 | val {hard, ...} = get stackSize | |
394 | in | |
395 | set (stackSize, {hard = hard, soft = hard}) | |
396 | end | |
397 | else () | |
398 | end | |
399 | local | |
400 | open Popt | |
401 | in | |
402 | val res = | |
403 | parse | |
404 | {switches = args, | |
405 | opts = [("args", | |
406 | SpaceString | |
407 | (fn args => | |
408 | runArgs := String.tokens (args, Char.isSpace))), | |
409 | ("err", SpaceString setErrData), | |
410 | ("mlkit", | |
411 | None (fn () => pushCompiler | |
412 | {name = "MLKit", | |
413 | abbrv = "MLKit", | |
414 | main = default_main, | |
415 | test = kitCompile})), | |
416 | ("mosml", | |
417 | None (fn () => pushCompiler | |
418 | {name = "Moscow ML", | |
419 | abbrv = "Moscow ML", | |
420 | main = default_main, | |
421 | test = mosmlCompile})), | |
422 | ("mlton", | |
423 | SpaceString (fn arg => pushCompilers | |
424 | (makeMLton arg))), | |
425 | ("once", trueRef doOnce), | |
426 | ("out", SpaceString setOutData), | |
427 | ("poly", | |
428 | None (fn () => pushCompiler | |
429 | {name = "Poly/ML", | |
430 | abbrv = "Poly/ML", | |
431 | main = (fn bench => concat ["fun main _ = Main.doit ", benchCount bench, "\n"]), | |
432 | test = polyCompile})), | |
433 | ("smlnj", | |
434 | None (fn () => pushCompiler | |
435 | {name = "SML/NJ", | |
436 | abbrv = "SML/NJ", | |
437 | main = default_main, | |
438 | test = njCompile})), | |
439 | trace, | |
440 | ("wiki", trueRef doWiki)]} | |
441 | end | |
442 | in | |
443 | case res of | |
444 | Result.No msg => usage msg | |
445 | | Result.Yes benchmarks => | |
446 | let | |
447 | val compilers = List.rev (!compilers) | |
448 | val base = #abbrv (hd compilers) | |
449 | val _ = | |
450 | let | |
451 | open MLton.Signal | |
452 | in | |
453 | setHandler (Pervasive.Posix.Signal.pipe, Handler.ignore) | |
454 | end | |
455 | fun r2s n r = Real.format (r, Real.Format.fix (SOME n)) | |
456 | val i2s = Int.toCommaString | |
457 | val p2s = i2s o Position.toInt | |
458 | val s2s = fn s => s | |
459 | val failures = ref [] | |
460 | fun show ({compiles, runs, sizes, errs, outs}, {showAll}) = | |
461 | let | |
462 | val out = Out.standard | |
463 | val _ = | |
464 | List.foreach | |
465 | (compilers, fn {name, abbrv, ...} => | |
466 | Out.output (out, concat [abbrv, " -- ", name, "\n"])) | |
467 | val _ = | |
468 | case !failures of | |
469 | [] => () | |
470 | | fs => | |
471 | Out.output | |
472 | (out, | |
473 | concat ["WARNING: ", base, " failed on: ", | |
474 | concat (List.separate (fs, ", ")), | |
475 | "\n"]) | |
476 | fun show (title, data: 'a data, toString, toStringHtml) = | |
477 | let | |
478 | val _ = Out.output (out, concat [title, "\n"]) | |
479 | val compilers = | |
480 | List.fold | |
481 | (compilers, [], fn ({name = n, abbrv = a, ...}, ac) => | |
482 | if showAll | |
483 | orelse List.exists (data, fn {compiler = c', ...} => | |
484 | a = c') | |
485 | then (n, a) :: ac | |
486 | else ac) | |
487 | val benchmarks = | |
488 | List.fold | |
489 | (benchmarks, [], fn (b, ac) => | |
490 | if showAll | |
491 | orelse List.exists (data, fn {bench = b', ...} => | |
492 | b = b') | |
493 | then b :: ac | |
494 | else ac) | |
495 | fun rows toString = | |
496 | ("benchmark" | |
497 | :: List.revMap (compilers, fn (_, a) => a)) | |
498 | :: (List.revMap | |
499 | (benchmarks, fn b => | |
500 | b :: (List.revMap | |
501 | (compilers, fn (_, a) => | |
502 | case (List.peek | |
503 | (data, fn {bench = b', | |
504 | compiler = c', ...} => | |
505 | b = b' andalso a = c')) of | |
506 | NONE => "*" | |
507 | | SOME {value = v, ...} => | |
508 | toString v)))) | |
509 | open Justify | |
510 | val () = | |
511 | outputTable | |
512 | (table {columnHeads = NONE, | |
513 | justs = (Left :: | |
514 | List.revMap (compilers, | |
515 | fn _ => Right)), | |
516 | rows = rows toString}, | |
517 | out) | |
518 | fun prow ns = | |
519 | let | |
520 | fun p s = Out.output (out, s) | |
521 | in | |
522 | case ns of | |
523 | [] => raise Fail "bug" | |
524 | | b :: ns => | |
525 | (p "||" | |
526 | ; p b | |
527 | ; List.foreach (ns, fn n => | |
528 | (p "||"; p n)) | |
529 | ; p "||\n") | |
530 | end | |
531 | val _ = | |
532 | if not (!doWiki) | |
533 | then () | |
534 | else | |
535 | let | |
536 | val rows = rows toStringHtml | |
537 | in | |
538 | prow (hd rows) | |
539 | ; (List.foreach | |
540 | (tl rows, | |
541 | fn [] => raise Fail "bug" | |
542 | | b :: r => | |
543 | let | |
544 | val b = | |
545 | concat | |
546 | ["[attachment:", | |
547 | b, ".sml ", b, "]"] | |
548 | in | |
549 | prow (b :: r) | |
550 | end)) | |
551 | end | |
552 | in | |
553 | () | |
554 | end | |
555 | val bases = List.keepAll (runs, fn {compiler, ...} => | |
556 | compiler = base) | |
557 | val ratios = | |
558 | List.fold | |
559 | (runs, [], fn ({bench, compiler, value}, ac) => | |
560 | if compiler = base andalso not showAll | |
561 | then ac | |
562 | else | |
563 | {bench = bench, | |
564 | compiler = compiler, | |
565 | value = | |
566 | case List.peek (bases, fn {bench = b, ...} => | |
567 | bench = b) of | |
568 | NONE => ~1.0 | |
569 | | SOME {value = v, ...} => value / v} :: ac) | |
570 | val _ = show ("run time ratio", ratios, r2s 2, r2s 1) | |
571 | val _ = show ("size", sizes, p2s, p2s) | |
572 | val _ = show ("compile time", compiles, r2s 2, r2s 2) | |
573 | val _ = show ("run time", runs, r2s 2, r2s 2) | |
574 | val _ = case !outData of | |
575 | NONE => () | |
576 | | SOME (out, _) => | |
577 | show (concat ["out: ", out], outs, s2s, s2s) | |
578 | val _ = case !errData of | |
579 | NONE => () | |
580 | | SOME (err, _) => | |
581 | show (concat ["err: ", err], errs, s2s, s2s) | |
582 | in () | |
583 | end | |
584 | val totalFailures = ref [] | |
585 | val data = | |
586 | List.fold | |
587 | (benchmarks, {compiles = [], runs = [], sizes = [], | |
588 | outs = [], errs = []}, | |
589 | fn (bench, ac) => | |
590 | let | |
591 | val foundOne = ref false | |
592 | val res = | |
593 | List.fold | |
594 | (compilers, ac, fn ({name, abbrv, main, test}, | |
595 | ac as {compiles: real data, | |
596 | runs: real data, | |
597 | sizes: Position.int data, | |
598 | outs: string data, | |
599 | errs: string data}) => | |
600 | if true | |
601 | then | |
602 | let | |
603 | val _ = | |
604 | File.withOut | |
605 | (batch {abbrv = abbrv, bench = bench}, fn out => | |
606 | (File.outputContents (concat [bench, ".sml"], out); | |
607 | Out.output (out, (main bench)))) | |
608 | (* | |
609 | val outTmpFile = | |
610 | File.tempName {prefix = "tmp", suffix = "out"} | |
611 | val errTmpFile = | |
612 | File.tempName {prefix = "tmp", suffix = "err"} | |
613 | *) | |
614 | val {compile, run, size} = | |
615 | ignoreOutput | |
616 | (fn () => test {bench = bench}) | |
617 | val _ = | |
618 | if name = base | |
619 | andalso Option.isNone run | |
620 | then List.push (failures, bench) | |
621 | else () | |
622 | (* | |
623 | val out = | |
624 | case !outData of | |
625 | NONE => NONE | |
626 | | SOME (_, doit) => | |
627 | File.foldLines | |
628 | (outTmpFile, NONE, fn (s, v) => | |
629 | let val s = String.removeTrailing | |
630 | (s, fn c => | |
631 | Char.equals (c, Char.newline)) | |
632 | in | |
633 | case doit s of | |
634 | NONE => v | |
635 | | v => v | |
636 | end) | |
637 | val err = | |
638 | case !errData of | |
639 | NONE => NONE | |
640 | | SOME (_, doit) => | |
641 | File.foldLines | |
642 | (errTmpFile, NONE, fn (s, v) => | |
643 | let val s = String.removeTrailing | |
644 | (s, fn c => | |
645 | Char.equals (c, Char.newline)) | |
646 | in | |
647 | case doit s of | |
648 | NONE => v | |
649 | | v => v | |
650 | end) | |
651 | val _ = File.remove outTmpFile | |
652 | val _ = File.remove errTmpFile | |
653 | *) | |
654 | val out = NONE | |
655 | val err = NONE | |
656 | fun add (v, ac) = | |
657 | case v of | |
658 | NONE => ac | |
659 | | SOME v => | |
660 | (foundOne := true | |
661 | ; {bench = bench, | |
662 | compiler = abbrv, | |
663 | value = v} :: ac) | |
664 | val ac = | |
665 | {compiles = add (compile, compiles), | |
666 | runs = add (run, runs), | |
667 | sizes = add (size, sizes), | |
668 | outs = add (out, outs), | |
669 | errs = add (err, errs)} | |
670 | val _ = show (ac, {showAll = false}) | |
671 | val _ = Out.flush Out.standard | |
672 | in | |
673 | ac | |
674 | end | |
675 | else ac) | |
676 | val _ = | |
677 | if !foundOne | |
678 | then () | |
679 | else List.push (totalFailures, bench) | |
680 | in | |
681 | res | |
682 | end) | |
683 | val _ = show (data, {showAll = true}) | |
684 | val totalFailures = !totalFailures | |
685 | val _ = | |
686 | if List.isEmpty totalFailures | |
687 | then () | |
688 | else (print ("The following benchmarks failed completely.\n") | |
689 | ; List.foreach (totalFailures, fn s => | |
690 | print (concat [s, "\n"]))) | |
691 | in () | |
692 | end | |
693 | end | |
694 | ||
695 | val main = Process.makeMain main | |
696 | ||
697 | end |