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
.
7 * MLton is released under a BSD
-style license
.
8 * See the file MLton
-LICENSE for details
.
17 Process
.usage
{usage
= "[-mlkit] [-mlton </path/to/mlton>] [-mosml] [-poly] [-smlnj] bench1 bench2 ...",
20 val doOnce
= ref
false
21 val doWiki
= ref
false
22 val runArgs
: string list ref
= ref
[]
24 fun withInput (file
, f
: unit
-> 'a
): 'a
=
29 open Pervasive
.Posix
.FileSys
31 openf (file
, O_RDONLY
, O
.flags
[])
35 (fn () => FileDesc
.fluidLet (FileDesc
.stdin
, inFd
, f
),
36 fn () => FileDesc
.close inFd
)
43 open Pervasive
.Posix
.FileSys
45 openf ("/dev/null", O_WRONLY
, O
.flags
[])
50 (fn () => fluidLet (stderr
, nullFd
, fn () =>
51 fluidLet (stdout
, nullFd
, f
)),
52 fn () => close nullFd
)
56 Explicit
of {args
: string list
,
58 | Shell
of string list
64 Explicit
{args
, com
} =>
65 Process
.wait (Process
.spawnp
{file
= com
, args
= com
:: args
})
66 | Shell ss
=> List.foreach (ss
, Process
.system
))
69 val trialTime
= Time
.seconds (IntInf
.fromInt
60)
71 fun timeCall (com
, args
): real =
75 val {user
, system
} = timeIt (Explicit
{args
= args
, com
= com
})
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
)
85 then Time
.toReal (doit Time
.zero
)
86 else loop (0, Time
.zero
)
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
*)
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
)
146 val default_main
= (fn bench
=> concat
["val _ = Main.doit ", benchCount bench
, "\n"])
148 fun compileSizeRun
{command
, exe
, doTextPlusData
: bool} =
153 val {system
, user
} = timeIt command
154 handle _
=> Escape
.escape (e
, {compile
= NONE
,
157 val compile
= SOME (Time
.toReal (Time
.+ (system
, user
)))
162 val {text
, data
, ...} = Process
.size exe
163 in SOME (Position
.fromInt (text
+ data
))
165 else SOME (File
.size exe
)
167 timeCall (exe
, !runArgs
)
168 handle _
=> Escape
.escape (e
, {compile
= compile
,
171 in {compile
= compile
,
176 fun batch_
{abbrv
, bench
} =
182 then String.fromChar c
185 concat
[bench
, ".", abbrv
, ".batch"]
189 concat
[batch_ ab
, ".sml"]
192 val n
= Counter
.new
0
194 fun makeMLton commandPattern
=
195 case ChoicePattern
.expand commandPattern
of
196 Result
.No m
=> usage m
201 val abbrv
= "MLton" ^
(Int.toString (Counter
.next n
))
206 test
= (fn {bench
} =>
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
])::*)
215 {command
= Shell cmds
,
217 doTextPlusData
= true}
222 fun kitCompile
{bench
} =
224 val bargs
= {abbrv
= "MLKit", bench
= bench
}
225 val bin
= batch_ bargs
227 {command
= Explicit
{args
= ["-o", bin
, batch bargs
],
230 doTextPlusData
= true}
233 fun mosmlCompile
{bench
} =
235 val bargs
= {abbrv
= "Moscow ML", bench
= bench
}
236 val bin
= batch_ bargs
238 {command
= Explicit
{args
= ["-orthodox", "-standalone", "-toplevel",
239 "-o", bin
, batch bargs
],
242 doTextPlusData
= false}
257 (output
, concat
["val tmp = TextIO.openOut(\"", tmp
, "\");\n",
258 "val _ = TextIO.output(tmp, SMLofNJ.SysInfo.getHeapSuffix());\n",
259 "val _ = TextIO.closeOut(tmp);\n"]),
263 Process
.wait (Process
.spawnp
{file
= sml
, args
= [sml
]})))
264 ; In
.withClose (In
.openIn tmp
, In
.inputAll
)))
269 fun njCompile
{bench
} =
273 (* sml should start SML
/NJ
*)
279 (out
, "local\nval _ = SMLofNJ.Internals.GC.messages false\n")
280 ; File
.outputContents (concat
[bench
, ".sml"], out
)
284 ["in val _ = SMLofNJ.exportFn (\"", bench
,
285 "\", fn _ => (Main.doit ", benchCount bench
,
286 "; OS.Process.success))\nend\n"]
288 fn input
=> withInput (input
, fn () => timeIt (Explicit
{args
= [],
290 handle _
=> Escape
.escape (e
, {compile
= NONE
,
293 val suffix
= Promise
.force njSuffix
294 val heap
= concat
[bench
, ".", suffix
]
296 if not (File
.doesExist heap
)
297 then {compile
= NONE
,
302 val compile
= Time
.toReal (Time
.+ (user
, system
))
303 val size
= SOME (File
.size heap
)
305 timeCall (sml
, [concat
["@SMLload=", heap
]])
306 handle _
=> Escape
.escape (e
, {compile
= SOME compile
,
309 in {compile
= SOME compile
,
315 fun polyCompile
{bench
} =
317 val bargs
= {abbrv
= "Poly/ML", bench
= bench
}
318 val bin
= batch_ bargs
320 {command
= Explicit
{args
= [batch bargs
, "-o", bin
],
323 doTextPlusData
= false}
326 type 'a data
= {bench
: string,
332 val compilers
: {name
: string,
334 main
: string -> string,
335 test
: {bench
: File
.t
} -> {compile
: real option
,
337 size
: Position
.int option
}} list ref
339 fun pushCompiler compiler
= List.push(compilers
, compiler
)
340 fun pushCompilers compilers
' = compilers
:= (List.rev compilers
') @
(!compilers
)
342 fun setData (switch
, data
, str
) =
344 fun die () = usage (concat
["invalid -", switch
, " argument: ", str
])
346 val numSave
= Save
.new ()
347 val regexpSave
= Save
.new ()
348 val re
= seq
[save (star digit
, numSave
),
350 save (star any
, regexpSave
)]
351 val reC
= compileDFA re
353 case Compiled
.matchAll (reC
, str
) of
357 val num
= Match
.lookupString (match
, numSave
)
358 val num
= case Int.fromString num
of
361 val regexp
= Match
.lookupString (match
, regexpSave
)
362 val (regexp
, saves
) =
363 case Regexp
.fromString regexp
of
365 | SOME regexp
=> regexp
366 val save
= if 0 <= num
andalso num
< Vector.length saves
367 then Vector.sub (saves
, num
)
369 val regexpC
= compileDFA regexp
372 (Compiled
.matchAll (regexpC
, s
),
373 fn match
=> Match
.lookupString (match
, save
))
375 data
:= SOME (str
, doit
)
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
387 open MLton
.Platform
.OS
393 val {hard
, ...} = get stackSize
395 set (stackSize
, {hard
= hard
, soft
= hard
})
408 runArgs
:= String.tokens (args
, Char.isSpace
))),
409 ("err", SpaceString setErrData
),
411 None (fn () => pushCompiler
415 test
= kitCompile
})),
417 None (fn () => pushCompiler
421 test
= mosmlCompile
})),
423 SpaceString (fn arg
=> pushCompilers
425 ("once", trueRef doOnce
),
426 ("out", SpaceString setOutData
),
428 None (fn () => pushCompiler
431 main
= (fn bench
=> concat
["fun main _ = Main.doit ", benchCount bench
, "\n"]),
432 test
= polyCompile
})),
434 None (fn () => pushCompiler
440 ("wiki", trueRef doWiki
)]}
444 Result
.No msg
=> usage msg
445 | Result
.Yes benchmarks
=>
447 val compilers
= List.rev (!compilers
)
448 val base
= #
abbrv (hd compilers
)
453 setHandler (Pervasive
.Posix
.Signal
.pipe
, Handler
.ignore
)
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
459 val failures
= ref
[]
460 fun show ({compiles
, runs
, sizes
, errs
, outs
}, {showAll
}) =
462 val out
= Out
.standard
465 (compilers
, fn {name
, abbrv
, ...} =>
466 Out
.output (out
, concat
[abbrv
, " -- ", name
, "\n"]))
473 concat
["WARNING: ", base
, " failed on: ",
474 concat (List.separate (fs
, ", ")),
476 fun show (title
, data
: 'a data
, toString
, toStringHtml
) =
478 val _
= Out
.output (out
, concat
[title
, "\n"])
481 (compilers
, [], fn ({name
= n
, abbrv
= a
, ...}, ac
) =>
483 orelse List.exists (data
, fn {compiler
= c
', ...} =>
489 (benchmarks
, [], fn (b
, ac
) =>
491 orelse List.exists (data
, fn {bench
= b
', ...} =>
497 :: List.revMap (compilers
, fn (_
, a
) => a
))
501 (compilers
, fn (_
, a
) =>
503 (data
, fn {bench
= b
',
504 compiler
= c
', ...} =>
505 b
= b
' andalso a
= c
')) of
507 | SOME
{value
= v
, ...} =>
512 (table
{columnHeads
= NONE
,
514 List.revMap (compilers
,
516 rows
= rows toString
},
520 fun p s
= Out
.output (out
, s
)
523 [] => raise Fail
"bug"
527 ; List.foreach (ns
, fn n
=>
536 val rows
= rows toStringHtml
541 fn [] => raise Fail
"bug"
555 val bases
= List.keepAll (runs
, fn {compiler
, ...} =>
559 (runs
, [], fn ({bench
, compiler
, value
}, ac
) =>
560 if compiler
= base
andalso not showAll
566 case List.peek (bases
, fn {bench
= b
, ...} =>
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
577 show (concat
["out: ", out
], outs
, s2s
, s2s
)
578 val _
= case !errData
of
581 show (concat
["err: ", err
], errs
, s2s
, s2s
)
584 val totalFailures
= ref
[]
587 (benchmarks
, {compiles
= [], runs
= [], sizes
= [],
588 outs
= [], errs
= []},
591 val foundOne
= ref
false
594 (compilers
, ac
, fn ({name
, abbrv
, main
, test
},
595 ac
as {compiles
: real data
,
597 sizes
: Position
.int data
,
599 errs
: string data
}) =>
605 (batch
{abbrv
= abbrv
, bench
= bench
}, fn out
=>
606 (File
.outputContents (concat
[bench
, ".sml"], out
);
607 Out
.output (out
, (main bench
))))
610 File
.tempName
{prefix
= "tmp", suffix
= "out"}
612 File
.tempName
{prefix
= "tmp", suffix
= "err"}
614 val {compile
, run
, size
} =
616 (fn () => test
{bench
= bench
})
619 andalso Option
.isNone run
620 then List.push (failures
, bench
)
628 (outTmpFile
, NONE
, fn (s
, v
) =>
629 let val s
= String.removeTrailing
631 Char.equals (c
, Char.newline
))
642 (errTmpFile
, NONE
, fn (s
, v
) =>
643 let val s
= String.removeTrailing
645 Char.equals (c
, Char.newline
))
651 val _
= File
.remove outTmpFile
652 val _
= File
.remove errTmpFile
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
679 else List.push (totalFailures
, bench
)
683 val _
= show (data
, {showAll
= true})
684 val totalFailures
= !totalFailures
686 if List.isEmpty totalFailures
688 else (print ("The following benchmarks failed completely.\n")
689 ; List.foreach (totalFailures
, fn s
=>
690 print (concat
[s
, "\n"])))
695 val main
= Process
.makeMain main