From 97a51a9fddce9b31df5de5783e09ce077e7ec7e9 Mon Sep 17 00:00:00 2001 From: Jun Furuse Date: Sun, 27 Aug 2023 15:56:36 +0900 Subject: [PATCH 1/5] Benchmark: exposed Measure.Time, adding measure_lwt - Exposes functions under Measure.Time for getting the time to execute functions in nano seconds --- src/lib_benchmark/measure.ml | 9 +++++++++ src/lib_benchmark/measure.mli | 10 ++++++++++ 2 files changed, 19 insertions(+) diff --git a/src/lib_benchmark/measure.ml b/src/lib_benchmark/measure.ml index 2f9fd0ce7b6e..db1fecad1e5d 100644 --- a/src/lib_benchmark/measure.ml +++ b/src/lib_benchmark/measure.ml @@ -372,6 +372,15 @@ module Time = struct dt [@@inline always] + let measure_lwt f = + let open Lwt.Syntax in + let bef = get_time_ns () in + let+ res = f () in + let aft = get_time_ns () in + let dt = Int64.(to_float (sub aft bef)) in + (dt, res) + [@@inline always] + let measure_and_return f = let bef = get_time_ns () in let x = f () in diff --git a/src/lib_benchmark/measure.mli b/src/lib_benchmark/measure.mli index f59f11fe2ce3..c0aa0b7ccf4c 100644 --- a/src/lib_benchmark/measure.mli +++ b/src/lib_benchmark/measure.mli @@ -82,3 +82,13 @@ val make_timing_probe : (module Compare.COMPARABLE with type t = 't) -> 't Generator.probe val get_free_variable_set : packed_measurement -> Free_variable.Set.t + +module Time : sig + (** All return nano seconds *) + + val measure : (unit -> unit) -> float + + val measure_and_return : (unit -> 'a) -> float * 'a + + val measure_lwt : (unit -> 'a Lwt.t) -> (float * 'a) Lwt.t +end -- GitLab From c517aeb05b642168a885ec3b0f46664f4e17883f Mon Sep 17 00:00:00 2001 From: Jun Furuse Date: Sun, 27 Aug 2023 22:56:30 +0900 Subject: [PATCH 2/5] Benchmark: skips GC for Generator.Calculated Since Calculated performs its mesuring by itself, Measure does not need to perform GC for it. --- src/lib_benchmark/generator.ml | 2 ++ src/lib_benchmark/measure.ml | 13 ++++++++++--- 2 files changed, 12 insertions(+), 3 deletions(-) diff --git a/src/lib_benchmark/generator.ml b/src/lib_benchmark/generator.ml index dfc5ad2b9004..77a488271586 100644 --- a/src/lib_benchmark/generator.ml +++ b/src/lib_benchmark/generator.ml @@ -45,6 +45,8 @@ type 'workload benchmark = measure : unit -> float; } -> 'workload benchmark + (** Calculated provides its own [measure] function, unlike the other + benchmarks where [Measure] module times their closures *) | Plain : { workload : 'workload; closure : unit -> unit; diff --git a/src/lib_benchmark/measure.ml b/src/lib_benchmark/measure.ml index db1fecad1e5d..e7fd1b909d22 100644 --- a/src/lib_benchmark/measure.ml +++ b/src/lib_benchmark/measure.ml @@ -466,8 +466,15 @@ let perform_benchmark (type c t) (options : options) List.fold_left (fun workload_data benchmark_fun -> progress () ; - set_gc_increment () ; - Gc.compact () ; + let bench = benchmark_fun () in + (match bench with + | Generator.Calculated _ -> + (* Calculated already gets its measures. + No need to perform GC. *) + () + | _ -> + set_gc_increment () ; + Gc.compact ()) ; let measure_plain_benchmark workload closure = let measures = compute_empirical_timing_distribution @@ -478,7 +485,7 @@ let perform_benchmark (type c t) (options : options) in {workload; measures} :: workload_data in - match benchmark_fun () with + match bench with | Generator.Calculated {workload; measure} -> let measures = Array.init options.nsamples (fun _ -> measure ()) in let measures = Maths.vector_of_array measures in -- GitLab From cceb9f1a1f97056eb1fc368b948be3b0fd9d06aa Mon Sep 17 00:00:00 2001 From: Jun Furuse Date: Mon, 28 Aug 2023 19:53:23 +0900 Subject: [PATCH 3/5] Shell_benchmarks: fixes Key_map.to_seq - It was not completely seq-ized. --- src/lib_shell_benchmarks/io_helpers.ml | 13 ++++++++----- 1 file changed, 8 insertions(+), 5 deletions(-) diff --git a/src/lib_shell_benchmarks/io_helpers.ml b/src/lib_shell_benchmarks/io_helpers.ml index dbbf1c9eeb07..c8741c5295f3 100644 --- a/src/lib_shell_benchmarks/io_helpers.ml +++ b/src/lib_shell_benchmarks/io_helpers.ml @@ -179,14 +179,17 @@ module Key_map = struct | None -> None | Some subtree -> find_opt tl subtree) - let rec to_seq path acc tree = + let rec to_seq : + String_map.key list -> + (String_map.key list * 'a) Seq.t -> + 'a t -> + (String_map.key list * 'a) Seq.t = + fun path acc tree -> match tree with | Leaf v -> fun () -> Seq.Cons ((List.rev path, v), acc) | Node map -> - String_map.fold - (fun seg subtree acc -> to_seq (seg :: path) acc subtree) - map - acc + Seq.concat_map (fun (seg, subtree) -> to_seq (seg :: path) acc subtree) + @@ String_map.to_seq map let to_seq tree = to_seq [] Seq.empty tree -- GitLab From 84c4db1504e541527b473542f4aac9413ffa845e Mon Sep 17 00:00:00 2001 From: Jun Furuse Date: Thu, 17 Aug 2023 18:08:00 +0900 Subject: [PATCH 4/5] Shell_benchmarks: Io_stats.load_tree now returns the full paths - Now load_tree returns the full paths, instead of the relative paths --- src/lib_shell_benchmarks/io_stats.ml | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/lib_shell_benchmarks/io_stats.ml b/src/lib_shell_benchmarks/io_stats.ml index cdb694f51b25..65edf1e014b2 100644 --- a/src/lib_shell_benchmarks/io_stats.ml +++ b/src/lib_shell_benchmarks/io_stats.ml @@ -97,7 +97,7 @@ let load_tree context key = match o with | Some bytes -> let len = Bytes.length bytes in - Io_helpers.Key_map.insert path len tree + Io_helpers.Key_map.insert (key @ path) len tree | None -> tree) let context_statistics base_dir context_hash = -- GitLab From 929d6c03d92bd1f352e7f8ed9dfa88bd80766fe4 Mon Sep 17 00:00:00 2001 From: Jun Furuse Date: Sat, 26 Aug 2023 10:50:52 +0900 Subject: [PATCH 5/5] Shell_benchmarks: optimizes Io_stats.load_tree - Ordering is not important here --- src/lib_shell_benchmarks/io_stats.ml | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/lib_shell_benchmarks/io_stats.ml b/src/lib_shell_benchmarks/io_stats.ml index 65edf1e014b2..91463e16b542 100644 --- a/src/lib_shell_benchmarks/io_stats.ml +++ b/src/lib_shell_benchmarks/io_stats.ml @@ -90,7 +90,7 @@ let load_tree context key = Context.fold context key - ~order:`Sorted + ~order:`Undefined ~init:Io_helpers.Key_map.empty ~f:(fun path t tree -> let+ o = Context.Tree.to_value t in -- GitLab