(* benchmark.sml
*
* This code is part of the Diderot Project (http://diderot-language.cs.uchicago.edu)
*
* COPYRIGHT (c) 2015 The University of Chicago
* All rights reserved.
*
* Code for loading benchmark reports from JSON files.
*)
structure Benchmark : sig
type results = {
name : string,
nprocs : int,
times : real list,
avg_time : real option,
std_dev : real option
}
type benchmark = {
bmark : string,
host : string,
version : string,
nruns : int,
max_nprocs : int,
max_nworkers : int,
date : string,
time : string,
diderotc_flags : string,
runtime_flags : string,
results : results list,
completed_at : string
}
type data = benchmark list
(* load a list of benchmark report files, returning a list of benchmarks *)
val loadFiles : string list -> benchmark list
(* store a list of benchmark records as a JSON file *)
val storeFile : benchmark list * string -> unit
(* conversion to and from JSON representation *)
val fromJSON : JSON.value -> benchmark list
val toJSON : benchmark list -> JSON.value
end = struct
structure J = JSON
(***** JSON Utility code *****)
fun findField (J.OBJECT fields) = let
fun find lab = (case List.find (fn (l, v) => (l = lab)) fields
of NONE => NONE
| SOME(_, v) => SOME v
(* end case *))
in
find
end
| findField _ = raise Fail "expected object"
fun lookupField findFn lab = (case findFn lab
of NONE => raise Fail(concat["no definition for field \"", lab, "\""])
| SOME v => v
(* end case *))
fun cvtArray cvtFn (J.ARRAY vl) = List.map cvtFn vl
| cvtArray cvtFn _ = raise Fail "expected array"
fun cvtInt (J.INT i) = IntInf.toInt i
| cvtInt _ = raise Fail "expected floating-point number"
fun cvtFloat (J.FLOAT r) = r
| cvtFloat (J.INT i) = Real.fromLargeInt i
| cvtFloat _ = raise Fail "expected floating-point number"
fun findInt find = let
fun get lab = cvtInt (find lab)
in
get
end
fun findFloat find = let
fun get lab = cvtFloat (find lab)
in
get
end
fun findString find = let
fun get lab = (case find lab
of J.STRING s => s
| _ => raise Fail "expected string"
(* end case *))
in
get
end
(***** end of JSON utility code *****)
type results = {
name : string,
nprocs : int,
times : real list,
avg_time : real option,
std_dev : real option
}
type benchmark = {
bmark : string,
host : string,
version : string,
nruns : int,
max_nprocs : int,
max_nworkers : int,
date : string,
time : string,
diderotc_flags : string,
runtime_flags : string,
results : results list,
completed_at : string
}
type data = benchmark list
(* convert a JSON results object to the results type *)
fun jsonToResults (obj : JSON.value) = let
val find = findField obj
val lookup = lookupField find
val times = cvtArray cvtFloat (lookup "times")
val nTimes = List.length times
(* if not already computed, compute the average time and standard deviation *)
val avgTime = if nTimes = 0
then NONE
else (case find "avg-time"
of NONE => SOME((List.foldl Real.+ 0.0 times) / (real nTimes))
| SOME v => SOME(cvtFloat v)
(* end case *))
(* if not already computed, compute the standard deviation *)
val stdDev = (case avgTime
of NONE => NONE (* implies that nTimes = 0 *)
| SOME avg => (case find "std-dev"
of NONE => let
fun sqr (x : real) = x*x
val sumSqrs = List.foldl (fn (x, s) => s + sqr(avg - x)) 0.0 times
in
SOME(Math.sqrt(sumSqrs / (real nTimes)))
end
| SOME v => SOME(cvtFloat v)
(* end case *))
(* end case *))
in {
name = findString lookup "name",
nprocs = findInt lookup "nprocs",
times = times,
avg_time = avgTime,
std_dev = stdDev
} end
(* convert a JSON object to a benchmark value *)
fun jsonToBenchmark obj = let
val lookup = lookupField (findField obj)
in {
bmark = findString lookup "bmark",
host = findString lookup "host",
version = findString lookup "version",
nruns = findInt lookup "nruns",
max_nprocs = findInt lookup "max-nprocs",
max_nworkers = findInt lookup "max-nworkers",
date = findString lookup "date",
time = findString lookup "time",
diderotc_flags = findString lookup "diderotc-flags",
runtime_flags = findString lookup "runtime-flags",
results = cvtArray jsonToResults (lookup "results"),
completed_at = findString lookup "completed-at"
} end
fun fromJSON (J.ARRAY objs) = List.map jsonToBenchmark objs
| fromJSON obj = [jsonToBenchmark obj]
fun resultsToJSON (r : results) = let
(* build reverse-order list of fields *)
val fields = []
val fields = ("name", J.STRING(#name r)) :: fields
val fields = ("nprocs", J.INT(IntInf.fromInt(#nprocs r))) :: fields
val fields = ("times", J.ARRAY(List.map J.FLOAT (#times r))) :: fields
val fields = (case #avg_time r
of SOME t => ("avg-time", J.FLOAT t) :: fields
| NONE => fields
(* end case *))
val fields = (case #std_dev r
of SOME t => ("std-dev", J.FLOAT t) :: fields
| NONE => fields
(* end case *))
in
J.OBJECT(List.rev fields)
end
fun benchmarkToJSON (b : benchmark) = let
(* build reverse-order list of fields *)
val fields = []
val fields = ("bmark", J.STRING(#bmark b)) :: fields
val fields = ("host", J.STRING(#host b)) :: fields
val fields = ("version", J.STRING(#version b)) :: fields
val fields = ("nruns", J.INT(IntInf.fromInt(#nruns b))) :: fields
val fields = ("max-nprocs", J.INT(IntInf.fromInt(#max_nprocs b))) :: fields
val fields = ("max-nworkers", J.INT(IntInf.fromInt(#max_nworkers b))) :: fields
val fields = ("date", J.STRING(#date b)) :: fields
val fields = ("time", J.STRING(#time b)) :: fields
val fields = ("diderotc-flags", J.STRING(#diderotc_flags b)) :: fields
val fields = ("runtime-flags", J.STRING(#runtime_flags b)) :: fields
val fields = ("results", J.ARRAY(List.map resultsToJSON (#results b))) :: fields
val fields = ("completed-at", J.STRING(#completed_at b)) :: fields
in
J.OBJECT(List.rev fields)
end
fun toJSON [b] = benchmarkToJSON b
| toJSON bs = JSON.ARRAY(List.map benchmarkToJSON bs)
fun loadFiles fs = List.foldr
(fn (f, bmarks) => fromJSON (JSONParser.parseFile f) @ bmarks)
[] fs
(* store a list of benchmark records as a JSON file *)
fun storeFile (bmarks, file) = let
val outS = TextIO.openOut file
in
JSONPrinter.print' {strm=outS, pretty=true} (toJSON bmarks)
handle ex => (TextIO.closeOut outS; raise ex);
TextIO.closeOut outS
end
end