| 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 |