(* benchmark.sml
 *
 * COPYRIGHT (c) 2015 The Diderot Project (http://diderot-language.cs.uchicago.edu)
 * 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
      }

  (* load a list of benchmark report files, returning a list of benchmarks *)
    val loadFiles : string list -> benchmark list

    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
      }


  (* 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) = raise Fail "TODO"

    fun benchmarkToJSON (b : benchmark) = raise Fail "TODO"

    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

  end

<script type="text/javascript">//<![CDATA[
		function toggle_ffErrors() {
			var errorsblock = document.getElementById("ffErrorsBlock");
			var errorsgroup = document.getElementById("ffErrors");
			if (errorsblock.style.display == "none") {
				errorsblock.style.display = "block";
				errorsgroup.style.right = "10px";
			} else {
				errorsblock.style.display = "none";
				errorsgroup.style.right = "300px";
			}
		}
//]]></script>
<div id="ffErrors">
<a href="javascript:toggle_ffErrors();">Click to toggle</a>
<div id="ffErrorsBlock">
	<div class="error">does not end with &lt;/html&gt; tag</div>
	<div class="error">does not end with &lt;/body&gt; tag</div>
	<div class="info">The output has ended thus:  fs = List.foldr
	  (fn (f, bmarks) =&gt; fromJSON (JSONParser.parseFile f) @ bmarks)
	    [] fs

  end</div>
</div></div>
</body></html>