Home My Page Projects Code Snippets Project Openings diderot
Summary Activity Tracker Tasks SCM

SCM Repository

[diderot] View of /benchmarks/analysis/benchmark.sml
ViewVC logotype

View of /benchmarks/analysis/benchmark.sml

Parent Directory Parent Directory | Revision Log Revision Log


Revision 3349 - (download) (annotate)
Tue Oct 27 15:16:36 2015 UTC (5 years, 1 month ago) by jhr
File size: 6767 byte(s)
making copyrights consistent for all code in the repository
(* 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

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