feature: trace loading/marshalling files

Loading/Marshalling can be slow if the files being loaded are huge. We
record the overhead when --trace-file is enabled.

Signed-off-by: Rudi Grinberg <[email protected]>

<!-- ps-id: 5cb1b063-6dd5-4cd7-a081-1d56fab2b6d7 -->

CHANGES.md

@@ -1,6 +1,9 @@
 Unreleased
 ----------
 
+- Include the time it takes to read/write state files when `--trace-file` is
+  enabled (#7960, @rgrinberg)
+
 - Add `dune show` command group which is an alias of `dune describe`. (#7946,
   @Alizter)
 

bin/common.ml

@@ -1191,7 +1191,6 @@ let build (builder : Builder.t) ~default_root_is_cwd =
             (Out (open_out f))
         in
         Dune_stats.set_global stats;
-        at_exit (fun () -> Dune_stats.close stats);
         stats)
   in
   let rpc =

boot/libs.ml

@@ -25,6 +25,9 @@ let local_libraries =
   ; ("otherlibs/dune-glob/src", Some "Dune_glob", false, None)
   ; ("otherlibs/xdg", Some "Xdg", false, None)
   ; ("otherlibs/dune-rpc/private", Some "Dune_rpc_private", false, None)
+  ; ("otherlibs/chrome-trace/src", Some "Chrome_trace", false, None)
+  ; ("vendor/spawn/src", Some "Spawn", false, None)
+  ; ("src/dune_stats", Some "Dune_stats", false, None)
   ; ("vendor/build_path_prefix_map/src", Some "Build_path_prefix_map", false,
     None)
   ; ("src/dune_config", Some "Dune_config", false, None)
@@ -33,13 +36,10 @@ let local_libraries =
   ; ("otherlibs/dune-private-libs/section", Some "Dune_section", false, None)
   ; ("src/dune_lang", Some "Dune_lang", false, None)
   ; ("vendor/opam-file-format", None, false, None)
-  ; ("otherlibs/chrome-trace/src", Some "Chrome_trace", false, None)
   ; ("src/dune_async_io", Some "Dune_async_io", false, None)
   ; ("src/fiber_util", Some "Fiber_util", false, None)
   ; ("src/dune_cache_storage", Some "Dune_cache_storage", false, None)
   ; ("src/dune_cache", Some "Dune_cache", false, None)
-  ; ("vendor/spawn/src", Some "Spawn", false, None)
-  ; ("src/dune_stats", Some "Dune_stats", false, None)
   ; ("otherlibs/dune-action-plugin/src", Some "Dune_action_plugin", false,
     None)
   ; ("src/csexp_rpc", Some "Csexp_rpc", false, None)

src/dune_stats/dune_stats.ml

@@ -120,6 +120,12 @@ let close { print; close; _ } =
 
 let global = ref None
 
+let () =
+  at_exit (fun () ->
+      match !global with
+      | None -> ()
+      | Some t -> close t)
+
 let set_global t =
   if Option.is_some !global then
     Code_error.raise "global stats have been set" [];

src/dune_util/dune

@@ -5,6 +5,8 @@
   (names dune_flock))
  (libraries
   stdune
+  dune_stats
+  chrome_trace
   xdg
   dyn
   ordering

src/dune_util/persistent.ml

@@ -49,13 +49,44 @@ module Make (D : Desc) = struct
 
   let to_string (v : D.t) = Printf.sprintf "%s%s" magic (Marshal.to_string v [])
 
-  let dump file (v : D.t) =
-    Io.with_file_out file ~f:(fun oc ->
-        output_string oc magic;
-        Marshal.to_channel oc v [])
-
-  let load file =
-    if Path.exists file then
+  let with_record stats ~name ~file ~f =
+    let start = Unix.gettimeofday () in
+    let res = Result.try_with f in
+    let event =
+      let stop = Unix.gettimeofday () in
+      let module Event = Chrome_trace.Event in
+      let module Timestamp = Event.Timestamp in
+      let dur = Timestamp.of_float_seconds (stop -. start) in
+      let common =
+        Event.common_fields ~name ~ts:(Timestamp.of_float_seconds start) ()
+      in
+      let args =
+        [ ("path", `String (Path.to_string file)); ("module", `String D.name) ]
+      in
+      Event.complete common ~args ~dur
+    in
+    Dune_stats.emit stats event;
+    Result.ok_exn res
+
+  let dump =
+    let dump file v =
+      Io.with_file_out file ~f:(fun oc ->
+          output_string oc magic;
+          Marshal.to_channel oc v [])
+    in
+    let dump =
+      lazy
+        (match Dune_stats.global () with
+        | None -> dump
+        | Some stats ->
+          fun file v ->
+            with_record stats ~name:"Writing Persistent Dune State" ~file
+              ~f:(fun () -> dump file v))
+    in
+    fun file (v : D.t) -> (Lazy.force dump) file v
+
+  let load =
+    let read_file file =
       Io.with_file_in file ~f:(fun ic ->
           match really_input_string ic (String.length magic) with
           | exception End_of_file -> None
@@ -72,7 +103,17 @@ module Make (D : Desc) = struct
                 None
               | d -> Some d
             else None)
-    else None
+    in
+    let read_file =
+      lazy
+        (match Dune_stats.global () with
+        | None -> read_file
+        | Some stats ->
+          fun file ->
+            with_record stats ~name:"Loading Persistent Dune State" ~file
+              ~f:(fun () -> read_file file))
+    in
+    fun file -> if Path.exists file then (Lazy.force read_file) file else None
 end
 
 type t = T : (module Desc with type t = 'a) * 'a -> t

test/blackbox-tests/test-cases/trace-file.t/run.t

@@ -9,6 +9,8 @@ This captures the commands that are being run:
   {"args":{"process_args":["-w","@[email protected]@30..39@[email protected]@[email protected]","-strict-sequence","-strict-formats","-short-paths","-keep-locs","-g","-bin-annot","-I",".prog.eobjs/byte","-no-alias-deps","-opaque","-o",".prog.eobjs/byte/prog.cmo","-c","-impl","prog.ml"],"pid":...},"ph":"X","dur":...,"name":"ocamlc.opt","cat":"process","ts":...,"pid":...,"tid":...}
   {"args":{"process_args":["-w","@[email protected]@30..39@[email protected]@[email protected]","-strict-sequence","-strict-formats","-short-paths","-keep-locs","-g","-I",".prog.eobjs/byte","-I",".prog.eobjs/native","-intf-suffix",".ml","-no-alias-deps","-opaque","-o",".prog.eobjs/native/prog.cmx","-c","-impl","prog.ml"],"pid":...},"ph":"X","dur":...,"name":"ocamlopt.opt","cat":"process","ts":...,"pid":...,"tid":...}
   {"args":{"process_args":["-w","@[email protected]@30..39@[email protected]@[email protected]","-strict-sequence","-strict-formats","-short-paths","-keep-locs","-g","-o","prog.exe",".prog.eobjs/native/prog.cmx"],"pid":...},"ph":"X","dur":...,"name":"ocamlopt.opt","cat":"process","ts":...,"pid":...,"tid":...}
+  {"args":{"path":"_build/.db","module":"INCREMENTAL-DB"},"ph":"X","dur":...,"name":"Writing Persistent Dune State","cat":"","ts":...,"pid":...,"tid":...}
+  {"args":{"path":"_build/.digest-db","module":"DIGEST-DB"},"ph":"X","dur":...,"name":"Writing Persistent Dune State","cat":"","ts":...,"pid":...,"tid":...}
 
 As well as data about the garbage collector: