Annotation of /benchmarks/analysis/benchmark.sml

Parent Directory | Revision Log

---

Revision 3349 - (view) (download)

1 :	jhr	3058	(* benchmark.sml
2 :			*
3 :	jhr	3349	* This code is part of the Diderot Project (http://diderot-language.cs.uchicago.edu)
4 :			*
5 :			* COPYRIGHT (c) 2015 The University of Chicago
6 :	jhr	3058	* All rights reserved.
7 :			*
8 :			* Code for loading benchmark reports from JSON files.
9 :			*)
10 :
11 :			structure Benchmark : sig
12 :
13 :			type results = {
14 :			name : string,
15 :			nprocs : int,
16 :			times : real list,
17 :			avg_time : real option,
18 :			std_dev : real option
19 :			}
20 :
21 :			type benchmark = {
22 :			bmark : string,
23 :			host : string,
24 :			version : string,
25 :			nruns : int,
26 :			max_nprocs : int,
27 :			max_nworkers : int,
28 :			date : string,
29 :			time : string,
30 :			diderotc_flags : string,
31 :			runtime_flags : string,
32 :			results : results list,
33 :			completed_at : string
34 :			}
35 :
36 :	jhr	3059	type data = benchmark list
37 :
38 :	jhr	3058	(* load a list of benchmark report files, returning a list of benchmarks *)
39 :			val loadFiles : string list -> benchmark list
40 :
41 :	jhr	3070	(* store a list of benchmark records as a JSON file *)
42 :			val storeFile : benchmark list * string -> unit
43 :
44 :			(* conversion to and from JSON representation *)
45 :	jhr	3058	val fromJSON : JSON.value -> benchmark list
46 :			val toJSON : benchmark list -> JSON.value
47 :
48 :			end = struct
49 :
50 :			structure J = JSON
51 :
52 :			(***** JSON Utility code *****)
53 :
54 :			fun findField (J.OBJECT fields) = let
55 :			fun find lab = (case List.find (fn (l, v) => (l = lab)) fields
56 :			of NONE => NONE
57 :			| SOME(_, v) => SOME v
58 :			(* end case *))
59 :			in
60 :			find
61 :			end
62 :			| findField _ = raise Fail "expected object"
63 :
64 :			fun lookupField findFn lab = (case findFn lab
65 :			of NONE => raise Fail(concat["no definition for field \"", lab, "\""])
66 :			| SOME v => v
67 :			(* end case *))
68 :
69 :			fun cvtArray cvtFn (J.ARRAY vl) = List.map cvtFn vl
70 :			| cvtArray cvtFn _ = raise Fail "expected array"
71 :
72 :			fun cvtInt (J.INT i) = IntInf.toInt i
73 :			| cvtInt _ = raise Fail "expected floating-point number"
74 :
75 :			fun cvtFloat (J.FLOAT r) = r
76 :			| cvtFloat (J.INT i) = Real.fromLargeInt i
77 :			| cvtFloat _ = raise Fail "expected floating-point number"
78 :
79 :			fun findInt find = let
80 :			fun get lab = cvtInt (find lab)
81 :			in
82 :			get
83 :			end
84 :
85 :			fun findFloat find = let
86 :			fun get lab = cvtFloat (find lab)
87 :			in
88 :			get
89 :			end
90 :
91 :			fun findString find = let
92 :			fun get lab = (case find lab
93 :			of J.STRING s => s
94 :			| _ => raise Fail "expected string"
95 :			(* end case *))
96 :			in
97 :			get
98 :			end
99 :
100 :			(***** end of JSON utility code *****)
101 :
102 :			type results = {
103 :			name : string,
104 :			nprocs : int,
105 :			times : real list,
106 :			avg_time : real option,
107 :			std_dev : real option
108 :			}
109 :
110 :			type benchmark = {
111 :			bmark : string,
112 :			host : string,
113 :			version : string,
114 :			nruns : int,
115 :			max_nprocs : int,
116 :			max_nworkers : int,
117 :			date : string,
118 :			time : string,
119 :			diderotc_flags : string,
120 :			runtime_flags : string,
121 :			results : results list,
122 :			completed_at : string
123 :			}
124 :
125 :	jhr	3059	type data = benchmark list
126 :	jhr	3058
127 :			(* convert a JSON results object to the results type *)
128 :			fun jsonToResults (obj : JSON.value) = let
129 :			val find = findField obj
130 :			val lookup = lookupField find
131 :			val times = cvtArray cvtFloat (lookup "times")
132 :			val nTimes = List.length times
133 :			(* if not already computed, compute the average time and standard deviation *)
134 :			val avgTime = if nTimes = 0
135 :			then NONE
136 :			else (case find "avg-time"
137 :			of NONE => SOME((List.foldl Real.+ 0.0 times) / (real nTimes))
138 :			| SOME v => SOME(cvtFloat v)
139 :			(* end case *))
140 :			(* if not already computed, compute the standard deviation *)
141 :			val stdDev = (case avgTime
142 :			of NONE => NONE (* implies that nTimes = 0 *)
143 :			| SOME avg => (case find "std-dev"
144 :			of NONE => let
145 :			fun sqr (x : real) = x*x
146 :			val sumSqrs = List.foldl (fn (x, s) => s + sqr(avg - x)) 0.0 times
147 :			in
148 :			SOME(Math.sqrt(sumSqrs / (real nTimes)))
149 :			end
150 :			| SOME v => SOME(cvtFloat v)
151 :			(* end case *))
152 :			(* end case *))
153 :			in {
154 :			name = findString lookup "name",
155 :			nprocs = findInt lookup "nprocs",
156 :			times = times,
157 :			avg_time = avgTime,
158 :			std_dev = stdDev
159 :			} end
160 :
161 :			(* convert a JSON object to a benchmark value *)
162 :			fun jsonToBenchmark obj = let
163 :			val lookup = lookupField (findField obj)
164 :			in {
165 :			bmark = findString lookup "bmark",
166 :			host = findString lookup "host",
167 :			version = findString lookup "version",
168 :			nruns = findInt lookup "nruns",
169 :			max_nprocs = findInt lookup "max-nprocs",
170 :			max_nworkers = findInt lookup "max-nworkers",
171 :			date = findString lookup "date",
172 :			time = findString lookup "time",
173 :			diderotc_flags = findString lookup "diderotc-flags",
174 :			runtime_flags = findString lookup "runtime-flags",
175 :			results = cvtArray jsonToResults (lookup "results"),
176 :			completed_at = findString lookup "completed-at"
177 :			} end
178 :
179 :			fun fromJSON (J.ARRAY objs) = List.map jsonToBenchmark objs
180 :			| fromJSON obj = [jsonToBenchmark obj]
181 :
182 :	jhr	3070	fun resultsToJSON (r : results) = let
183 :			(* build reverse-order list of fields *)
184 :			val fields = []
185 :			val fields = ("name", J.STRING(#name r)) :: fields
186 :			val fields = ("nprocs", J.INT(IntInf.fromInt(#nprocs r))) :: fields
187 :			val fields = ("times", J.ARRAY(List.map J.FLOAT (#times r))) :: fields
188 :			val fields = (case #avg_time r
189 :			of SOME t => ("avg-time", J.FLOAT t) :: fields
190 :			| NONE => fields
191 :			(* end case *))
192 :			val fields = (case #std_dev r
193 :			of SOME t => ("std-dev", J.FLOAT t) :: fields
194 :			| NONE => fields
195 :			(* end case *))
196 :			in
197 :			J.OBJECT(List.rev fields)
198 :			end
199 :	jhr	3058
200 :	jhr	3070	fun benchmarkToJSON (b : benchmark) = let
201 :			(* build reverse-order list of fields *)
202 :			val fields = []
203 :			val fields = ("bmark", J.STRING(#bmark b)) :: fields
204 :			val fields = ("host", J.STRING(#host b)) :: fields
205 :			val fields = ("version", J.STRING(#version b)) :: fields
206 :			val fields = ("nruns", J.INT(IntInf.fromInt(#nruns b))) :: fields
207 :			val fields = ("max-nprocs", J.INT(IntInf.fromInt(#max_nprocs b))) :: fields
208 :			val fields = ("max-nworkers", J.INT(IntInf.fromInt(#max_nworkers b))) :: fields
209 :			val fields = ("date", J.STRING(#date b)) :: fields
210 :			val fields = ("time", J.STRING(#time b)) :: fields
211 :			val fields = ("diderotc-flags", J.STRING(#diderotc_flags b)) :: fields
212 :			val fields = ("runtime-flags", J.STRING(#runtime_flags b)) :: fields
213 :			val fields = ("results", J.ARRAY(List.map resultsToJSON (#results b))) :: fields
214 :			val fields = ("completed-at", J.STRING(#completed_at b)) :: fields
215 :			in
216 :			J.OBJECT(List.rev fields)
217 :			end
218 :	jhr	3058
219 :			fun toJSON [b] = benchmarkToJSON b
220 :			| toJSON bs = JSON.ARRAY(List.map benchmarkToJSON bs)
221 :
222 :			fun loadFiles fs = List.foldr
223 :			(fn (f, bmarks) => fromJSON (JSONParser.parseFile f) @ bmarks)
224 :			[] fs
225 :
226 :	jhr	3070	(* store a list of benchmark records as a JSON file *)
227 :			fun storeFile (bmarks, file) = let
228 :			val outS = TextIO.openOut file
229 :			in
230 :			JSONPrinter.print' {strm=outS, pretty=true} (toJSON bmarks)
231 :			handle ex => (TextIO.closeOut outS; raise ex);
232 :			TextIO.closeOut outS
233 :			end
234 :
235 :	jhr	3058	end

---

root@smlnj-gforge.cs.uchicago.edu	ViewVC Help
Powered by ViewVC 1.0.0