Move bench to separate internal library

Author: polytypic

bench/bench.ml

@@ -0,0 +1,5 @@
+module Times = Times
+module Stats = Stats
+module Suite = Suite
+module Cmd = Cmd
+module Util = Util

bench/barrier.ml bench/bench/barrier.ml

@@ -33,3 +33,9 @@ end
 module Cmd : sig
   val run : benchmarks:(string * Suite.t) list -> unit -> unit
 end
+
+module Util : sig
+  val iter_factor : int
+  val alloc : ?batch:int -> int Atomic.t -> int
+  val cross : 'a list -> 'b list -> ('a * 'b) list
+end

bench/barrier.mli bench/bench/barrier.mli

@@ -0,0 +1,50 @@
+let run ~benchmarks () =
+  let budgetf = ref 0.025 in
+  let filters = ref [] in
+
+  let rec specs =
+    [
+      ("-budget", Arg.Set_float budgetf, "seconds\t  Budget for a benchmark");
+      ("-help", Unit help, "\t  Show this help message");
+      ("--help", Unit help, "\t  Show this help message");
+    ]
+  and help () =
+    Arg.usage (Arg.align specs)
+      (Printf.sprintf
+         "\n\
+          Usage: %s <option>* filter*\n\n\
+          The filters are regular expressions for selecting benchmarks to run.\n\n\
+          Benchmarks:\n\n\
+          %s\n\n\
+          Options:\n"
+         (Filename.basename Sys.argv.(0))
+         (benchmarks
+         |> List.map (fun (name, _) -> "  " ^ name)
+         |> String.concat "\n"));
+    exit 1
+  in
+  Arg.parse specs (fun filter -> filters := filter :: !filters) "";
+
+  let budgetf = !budgetf in
+
+  let run (name, fn) =
+    let metrics = fn ~budgetf in
+    `Assoc [ ("name", `String name); ("metrics", `List metrics) ]
+  in
+
+  let filter =
+    match !filters with
+    | [] -> Fun.const true
+    | filters -> (
+        let regexps = filters |> List.map Str.regexp in
+        fun (name, _) ->
+          regexps
+          |> List.exists @@ fun regexp ->
+             match Str.search_forward regexp name 0 with
+             | _ -> true
+             | exception Not_found -> false)
+  in
+
+  `Assoc
+    [ ("results", `List (benchmarks |> List.filter filter |> List.map run)) ]
+  |> Yojson.Safe.pretty_print ~std:true Format.std_formatter

bench/bench/bench.ml

@@ -0,0 +1,11 @@
+(library
+ (name bench)
+ (package kcas_data)
+ (libraries
+  multicore-magic
+  domain-local-await
+  domain_shims
+  mtime
+  mtime.clock.os
+  yojson
+  str))

bench/bench.mli bench/bench/bench.mli

@@ -0,0 +1,63 @@
+type t = {
+  mean : float;
+  median : float;
+  sd : float;
+  inverted : bool;
+  best : float;
+  runs : int;
+}
+
+let scale factor { mean; median; sd; inverted; best; runs } =
+  {
+    mean = mean *. factor;
+    median = median *. factor;
+    sd = sd *. factor;
+    inverted;
+    best = best *. factor;
+    runs;
+  }
+
+let mean_of times =
+  Array.fold_left ( +. ) 0.0 times /. Float.of_int (Array.length times)
+
+let sd_of times mean =
+  Float.sqrt (mean_of (Array.map (fun v -> Float.abs (v -. mean) ** 2.) times))
+
+let median_of times =
+  Array.sort Float.compare times;
+  let n = Array.length times in
+  if n land 1 = 0 then (times.((n asr 1) - 1) +. times.(n asr 1)) /. 2.0
+  else times.(n asr 1)
+
+let of_times Times.{ inverted; times; runs } =
+  let mean = mean_of times in
+  let sd = sd_of times mean in
+  let median = median_of times in
+  let best =
+    if inverted then Array.fold_left Float.max Float.min_float times
+    else Array.fold_left Float.min Float.max_float times
+  in
+  { mean; sd; median; inverted; best; runs }
+
+let to_nonbreaking s =
+  s |> String.split_on_char ' ' |> String.concat " " (* a non-breaking space *)
+
+let to_json ~name ~description ~units t =
+  let trend =
+    if t.inverted then `String "higher-is-better" else `String "lower-is-better"
+  in
+  [
+    `Assoc
+      [
+        ("name", `String (to_nonbreaking name));
+        ("value", `Float t.median);
+        ("units", `String units);
+        ("trend", trend);
+        ("description", `String description);
+        ("#best", `Float t.best);
+        ("#mean", `Float t.mean);
+        ("#median", `Float t.median);
+        ("#sd", `Float t.sd);
+        ("#runs", `Int t.runs);
+      ];
+  ]

bench/bench/cmd.ml

@@ -0,0 +1 @@
+type t = budgetf:float -> Yojson.Safe.t list