feat(profile): add ?args to spans

src/tef/Sidekick_tef.real.ml

@@ -61,17 +61,6 @@ module Make () : P.BACKEND = struct
     String.iter encode_char s;
     char oc '"'
 
-  let emit_duration_event ~name ~start ~end_ () : unit =
-    let dur = end_ -. start in
-    let ts = start in
-    let pid = Unix.getpid () in
-    let tid = Thread.id (Thread.self ()) in
-    emit_sep_ ();
-    Printf.fprintf oc
-      {json|{"pid": %d,"cat":"","tid": %d,"dur": %.2f,"ts": %.2f,"name":%a,"ph":"X"}|json}
-      pid tid dur ts str_val name;
-    ()
-
   (* emit args, if not empty. [ppv] is used to print values. *)
   let emit_args_o_ ppv oc args : unit =
     if args <> [] then (
@@ -84,6 +73,17 @@ module Make () : P.BACKEND = struct
       char oc '}'
     )
 
+  let emit_duration_event ~name ~start ~end_ ~args () : unit =
+    let dur = end_ -. start in
+    let ts = start in
+    let pid = Unix.getpid () in
+    let tid = Thread.id (Thread.self ()) in
+    emit_sep_ ();
+    Printf.fprintf oc
+      {json|{"pid": %d,"cat":"","tid": %d,"dur": %.2f,"ts": %.2f,"name":%a,"ph":"X"%a}|json}
+      pid tid dur ts str_val name (emit_args_o_ str_val) args;
+    ()
+
   let emit_instant_event ~name ~ts ~args () : unit =
     let pid = Unix.getpid () in
     let tid = Thread.id (Thread.self ()) in

src/util/Profile.ml

@@ -2,7 +2,12 @@ module type BACKEND = sig
   val get_ts : unit -> float
 
   val emit_duration_event :
-    name:string -> start:float -> end_:float -> unit -> unit
+    name:string ->
+    start:float ->
+    end_:float ->
+    args:(string * string) list ->
+    unit ->
+    unit
 
   val emit_instant_event :
     name:string -> ts:float -> args:(string * string) list -> unit -> unit
@@ -49,47 +54,47 @@ let[@inline] count name cs =
   )
 
 (* slow path *)
-let[@inline never] exit_full_ (module B : BACKEND) name start =
+let[@inline never] exit_full_ (module B : BACKEND) ~args name start =
   let now = B.get_ts () in
-  B.emit_duration_event ~name ~start ~end_:now ()
+  B.emit_duration_event ~name ~start ~end_:now ~args ()
 
-let[@inline] exit_with_ b pb =
+let[@inline] exit_with_ ~args b pb =
   match pb with
   | No_probe -> ()
-  | Probe { name; start } -> exit_full_ b name start
+  | Probe { name; start } -> exit_full_ ~args b name start
 
-let[@inline] exit pb =
+let[@inline] exit ?(args = []) pb =
   match pb, !out_ with
-  | Probe { name; start }, Some b -> exit_full_ b name start
+  | Probe { name; start }, Some b -> exit_full_ ~args b name start
   | _ -> ()
 
-let[@inline] with_ name f =
+let[@inline] with_ ?(args = []) name f =
   match !out_ with
   | None -> f ()
   | Some b ->
     let pb = begin_with_ b name in
     (try
        let x = f () in
-       exit_with_ b pb;
+       exit_with_ ~args b pb;
        x
      with e ->
-       exit_with_ b pb;
+       exit_with_ ~args b pb;
        raise e)
 
-let[@inline] with1 name f x =
+let[@inline] with1 ?(args = []) name f x =
   match !out_ with
   | None -> f x
   | Some b ->
     let pb = begin_with_ b name in
     (try
        let res = f x in
-       exit_with_ b pb;
+       exit_with_ ~args b pb;
        res
      with e ->
-       exit_with_ b pb;
+       exit_with_ ~args b pb;
        raise e)
 
-let[@inline] with2 name f x y = with_ name (fun () -> f x y)
+let[@inline] with2 ?args name f x y = with_ ?args name (fun () -> f x y)
 
 module Control = struct
   let setup b =

src/util/Profile.mli

@@ -10,17 +10,25 @@ val null_probe : probe
 val enabled : unit -> bool
 val instant : ?args:(string * string) list -> string -> unit
 val begin_ : string -> probe
-val exit : probe -> unit
+val exit : ?args:(string * string) list -> probe -> unit
-val with_ : string -> (unit -> 'a) -> 'a
+val with_ : ?args:(string * string) list -> string -> (unit -> 'a) -> 'a
-val with1 : string -> ('a -> 'b) -> 'a -> 'b
+val with1 : ?args:(string * string) list -> string -> ('a -> 'b) -> 'a -> 'b
-val with2 : string -> ('a -> 'b -> 'c) -> 'a -> 'b -> 'c
+
+val with2 :
+  ?args:(string * string) list -> string -> ('a -> 'b -> 'c) -> 'a -> 'b -> 'c
+
 val count : string -> (string * int) list -> unit
 
 module type BACKEND = sig
   val get_ts : unit -> float
 
   val emit_duration_event :
-    name:string -> start:float -> end_:float -> unit -> unit
+    name:string ->
+    start:float ->
+    end_:float ->
+    args:(string * string) list ->
+    unit ->
+    unit
 
   val emit_instant_event :
     name:string -> ts:float -> args:(string * string) list -> unit -> unit