feat: add context zones in Trace

these represent some sort of global context, like frames,
GC major collections, etc.

src/core/collector.ml

@@ -77,6 +77,13 @@ module type S = sig
   val counter_float : data:(string * user_data) list -> string -> float -> unit
   (** Float counter. *)
 
+  val enter_context : string -> unit
+  (** Enter a local context (or frame)
+      @since NEXT_RELEASE *)
+
+  val exit_context : string -> unit
+  (** Exit a local context. @since NEXT_RELEASE *)
+
   val shutdown : unit -> unit
   (** Shutdown collector, possibly waiting for it to finish sending data. *)
 end

src/core/trace_core.ml

@@ -110,6 +110,23 @@ let counter_float ?(data = data_empty_build_) name f : unit =
     let data = data () in
     C.counter_float ~data name f
 
+let[@inline] enter_context name : unit =
+  match A.get collector with
+  | None -> ()
+  | Some (module C) -> C.enter_context name
+
+let[@inline] exit_context name : unit =
+  match A.get collector with
+  | None -> ()
+  | Some (module C) -> C.exit_context name
+
+let[@inline] with_context name f =
+  match A.get collector with
+  | None -> f ()
+  | Some (module C) ->
+    C.enter_context name;
+    Fun.protect ~finally:(fun () -> C.exit_context name) f
+
 let set_thread_name name : unit =
   match A.get collector with
   | None -> ()

src/core/trace_core.mli

@@ -121,6 +121,26 @@ val counter_float :
 (** Emit a counter of type [float]. See {!counter_int} for more details.
     @param data metadata for this metric (since 0.4) *)
 
+val enter_context : string -> unit
+(** [enter_context name] enters a local context with the
+    given name. The name must be a static string.
+
+    The exact semantic of contexts depends on your collector:
+      for TEF it might actually use contexts, for Tracy it
+      might use traces, for OTEL it might be ignored, etc.
+
+    @since NEXT_RELEASE *)
+
+val exit_context : string -> unit
+(** Exit a context. This must come after the corresponding
+    {!enter_context}, ideally on the same thread.
+    @since NEXT_RELEASE *)
+
+val with_context : string -> (unit -> 'a) -> 'a
+(** [with_context name f] enters the context, calls [f()],
+    and exits the context.
+    @since NEXT_RELEASE *)
+
 (** {2 Collector} *)
 
 type collector = (module Collector.S)

src/tef/trace_tef.ml

@@ -54,6 +54,16 @@ type event =
       id: span;
       time_us: float;
     }
+  | E_enter_context of {
+      tid: int;
+      name: string;
+      time_us: float;
+    }
+  | E_exit_context of {
+      tid: int;
+      name: string;
+      time_us: float;
+    }
   | E_add_data of {
       id: span;
       data: (string * user_data) list;
@@ -242,6 +252,24 @@ module Writer = struct
       args;
     Buffer.output_buffer self.oc self.buf
 
+  (* for context, we just emit async frames for now. There seems to be something
+     in the chrome tracing viewer to actually see _frames_, but it's poorly documented.
+     Hints: https://docs.google.com/document/d/15BB-suCb9j-nFt55yCFJBJCGzLg2qUm3WaSOPb8APtI/
+  *)
+  let emit_enter_context ~tid ~name ~ts (self : t) : unit =
+    emit_sep_ self;
+    Printf.fprintf self.oc
+      {json|{"pid":%d,"tid":%d,"ts":%.2f,"name":%a,"ph":"b"}|json} self.pid tid
+      ts str_val name;
+    ()
+
+  let emit_exit_context ~tid ~name ~ts (self : t) : unit =
+    emit_sep_ self;
+    Printf.fprintf self.oc
+      {json|{"pid":%d,"tid":%d,"ts":%.2f,"name":%a,"ph":"e"}|json} self.pid tid
+      ts str_val name;
+    ()
+
   let emit_name_thread ~tid ~name (self : t) : unit =
     emit_sep_and_start_ self;
     Printf.bprintf self.buf
@@ -307,6 +335,10 @@ let bg_thread ~out (events : event B_queue.t) : unit =
       (match Span_tbl.find_opt spans id with
       | None -> !on_tracing_error (Printf.sprintf "cannot find span %Ld" id)
       | Some info -> info.data <- List.rev_append data info.data)
+    | E_enter_context { name; time_us; tid } ->
+      Writer.emit_enter_context ~name ~ts:time_us ~tid writer
+    | E_exit_context { name; time_us; tid } ->
+      Writer.emit_exit_context ~name ~ts:time_us ~tid writer
     | E_enter_manual_span { tid; time_us; name; id; data; fun_name; flavor } ->
       let data = add_fun_name_ fun_name data in
       Writer.emit_manual_begin ~tid ~name ~id ~ts:time_us ~args:data ~flavor
@@ -453,6 +485,16 @@ let collector ~out () : collector =
     let counter_int ~data name i = counter_float ~data name (float_of_int i)
     let name_process name : unit = B_queue.push events (E_name_process { name })
 
+    let enter_context name : unit =
+      let time_us = now_us () in
+      let tid = get_tid_ () in
+      B_queue.push events (E_enter_context { name; tid; time_us })
+
+    let exit_context name : unit =
+      let time_us = now_us () in
+      let tid = get_tid_ () in
+      B_queue.push events (E_exit_context { name; tid; time_us })
+
     let name_thread name : unit =
       let tid = get_tid_ () in
       B_queue.push events (E_name_thread { tid; name })