Automatically filter benchmarks to run by given diff base file

This makes it more convenient to run diffs against only specific benchmarks.

CHANGES.md

@@ -1,5 +1,6 @@
 ## Next version
 
+- Automatically filter benchmarks by given diff base file (@polytypic)
 - Randomize suites to expose variation from effects on runtime (@polytypic)
 
 ## 0.1.3

lib/cmd.ml

@@ -1,63 +1,66 @@
+open Data
+
 type output = [ `JSON | `Brief | `Diff of string ]
 
 let worse_colors = [| 196; 197; 198; 199; 200; 201 |]
 let better_colors = [| 46; 47; 48; 49; 50; 51 |]
 
 let print_diff base next =
-  let open Data in
-  Option.pair (Results.parse base) (Results.parse next)
-  |> Option.iter @@ fun (base, next) ->
-     List.zip_by Benchmark.compare_by_name base next
-     |> List.iter @@ fun ((base : Benchmark.t), (next : Benchmark.t)) ->
-        Printf.printf "%s:\n" base.name;
-        let zipped =
-          List.zip_by Metric.compare_by_name base.metrics next.metrics
-        in
-        let extreme_of join trend =
-          List.fold_left
-            (fun acc ((base : Metric.t), (next : Metric.t)) ->
-              if trend <> base.trend || trend <> next.trend then acc
-              else join acc (next.value /. base.value))
-            1.0 zipped
-        in
-        let min_higher = extreme_of Float.min `Higher_is_better in
-        let max_higher = extreme_of Float.max `Higher_is_better in
-        let min_lower = extreme_of Float.min `Lower_is_better in
-        let max_lower = extreme_of Float.max `Lower_is_better in
-        zipped
-        |> List.iter @@ fun ((base : Metric.t), (next : Metric.t)) ->
-           Printf.printf "  %s:\n" base.name;
-           if
-             base.trend <> next.trend || base.units <> next.units
-             || Float.equal base.value next.value
-           then Printf.printf "    %.2f %s\n" next.value next.units
-           else
-             let times = next.value /. base.value in
-             let colors, extreme =
-               if next.trend = `Higher_is_better then
-                 if times < 1.0 then (worse_colors, min_higher)
-                 else (better_colors, max_higher)
-               else if 1.0 < times then (worse_colors, max_lower)
-               else (better_colors, min_lower)
-             in
-             let range = Float.abs (extreme -. 1.0) in
-             let color =
-               colors.(Float.to_int
-                         (Float.round
-                            (Float.of_int (Array.length colors - 1)
-                            *. Float.abs (extreme -. times)
-                            /. range)))
-             in
-             Printf.printf
-               "    %.2f %s = \x1b[1;38;5;%dm%.2f\x1b\x1b[0;39;49m x %.2f %s\n"
-               next.value next.units color times base.value base.units
+  List.zip_by Benchmark.compare_by_name base next
+  |> List.iter @@ fun ((base : Benchmark.t), (next : Benchmark.t)) ->
+     Printf.printf "%s:\n" base.name;
+     let zipped =
+       List.zip_by Metric.compare_by_name base.metrics next.metrics
+     in
+     let extreme_of join trend =
+       List.fold_left
+         (fun acc ((base : Metric.t), (next : Metric.t)) ->
+           if trend <> base.trend || trend <> next.trend then acc
+           else join acc (next.value /. base.value))
+         1.0 zipped
+     in
+     let min_higher = extreme_of Float.min `Higher_is_better in
+     let max_higher = extreme_of Float.max `Higher_is_better in
+     let min_lower = extreme_of Float.min `Lower_is_better in
+     let max_lower = extreme_of Float.max `Lower_is_better in
+     zipped
+     |> List.iter @@ fun ((base : Metric.t), (next : Metric.t)) ->
+        Printf.printf "  %s:\n" base.name;
+        if
+          base.trend <> next.trend || base.units <> next.units
+          || Float.equal base.value next.value
+        then Printf.printf "    %.2f %s\n" next.value next.units
+        else
+          let times = next.value /. base.value in
+          let colors, extreme =
+            if next.trend = `Higher_is_better then
+              if times < 1.0 then (worse_colors, min_higher)
+              else (better_colors, max_higher)
+            else if 1.0 < times then (worse_colors, max_lower)
+            else (better_colors, min_lower)
+          in
+          let range = Float.abs (extreme -. 1.0) in
+          let color =
+            colors.(Float.to_int
+                      (Float.round
+                         (Float.of_int (Array.length colors - 1)
+                         *. Float.abs (extreme -. times)
+                         /. range)))
+          in
+          Printf.printf
+            "    %.2f %s = \x1b[1;38;5;%dm%.2f\x1b\x1b[0;39;49m x %.2f %s\n"
+            next.value next.units color times base.value base.units
 
 let run_benchmark ~budgetf ~debug (name, fn) =
   if debug then
     (* I wish there was a way to tell dune not to capture stderr. *)
     Printf.printf "Running: %s\n%!" name;
   `Assoc [ ("name", `String name); ("metrics", `List (fn ~budgetf)) ]
 
+let name_of = function
+  | `Assoc (("name", `String name) :: _) -> name
+  | _ -> failwith "bug"
+
 let build_filter = function
   | [] -> Fun.const true
   | filters -> begin
@@ -126,26 +129,46 @@ let run ~benchmarks ?(budgetf = 0.025) ?(filters = []) ?(debug = false)
   if !budgetf < 0.0 || 60.0 *. 60.0 < !budgetf then
     invalid_arg "budgetf out of range";
 
-  let benchmark_results =
+  let base_results =
+    match !output with
+    | `Diff fname -> begin
+        match Results.parse (Yojson.Safe.from_file fname) with
+        | None -> []
+        | Some results -> results
+      end
+    | `JSON | `Brief -> []
+  in
+
+  let benchmark_jsons =
     benchmarks
     |> List.filter (build_filter !filters)
+    |> begin
+         match base_results with
+         | [] -> Fun.id
+         | results ->
+             let (module S) = Set.make String.compare in
+             let names = results |> List.map Benchmark.name |> S.of_list in
+             List.filter (fun (name, _) -> S.mem name names)
+       end
     |> (if !randomize then shuffle else Fun.id)
     |> List.map (run_benchmark ~debug:!debug ~budgetf:!budgetf)
-    |> List.sort @@ fun l r ->
-       let name_of = function
-         | `Assoc (("name", `String name) :: _) -> name
-         | _ -> failwith "bug"
-       in
-       String.compare (name_of l) (name_of r)
+    |> List.sort @@ fun l r -> String.compare (name_of l) (name_of r)
   in
 
-  let results = `Assoc [ ("results", `List benchmark_results) ] in
+  let results_json = `Assoc [ ("results", `List benchmark_jsons) ] in
+  let results =
+    lazy
+      (match Results.parse results_json with
+      | None -> []
+      | Some results -> results)
+  in
 
   begin
     match !output with
-    | `JSON -> Yojson.Safe.pretty_print ~std:true Format.std_formatter results
-    | `Brief -> print_diff results results
-    | `Diff fname -> print_diff (Yojson.Safe.from_file fname) results
+    | `JSON ->
+        Yojson.Safe.pretty_print ~std:true Format.std_formatter results_json
+    | `Brief -> print_diff (Lazy.force results) (Lazy.force results)
+    | `Diff _ -> print_diff base_results (Lazy.force results)
   end;
 
   if flush then Format.print_flush ()

lib/data.ml

@@ -42,6 +42,7 @@ module Benchmark = struct
     >+> fun (name :: metrics) -> { name; metrics }
 
   let compare_by_name x y = String.compare x.name y.name
+  let name x = x.name
 end
 
 module Results = struct