wip: support frame API

src/bindings/tracy_client.ml

@@ -24,6 +24,11 @@ external _tracy_span_value : span -> int64 -> unit = "ml_tracy_span_value"
 external _tracy_span_color : span -> int -> unit = "ml_tracy_span_color"
   [@@noalloc]
 
+external _tracy_frame_enter : string -> unit = "ml_tracy_frame_enter"
+  [@@noalloc]
+
+external _tracy_frame_exit : string -> unit = "ml_tracy_frame_exit" [@@noalloc]
+
 let enter ?cs_depth ~__FILE__:file ~__LINE__:line ?(__FUNCTION__ = "<fun>") name
     : span =
   let depth =
@@ -46,6 +51,18 @@ let add_text = _tracy_span_text
 let set_app_info = _tracy_app_info
 let message_f k = k (fun fmt -> Format.kasprintf message fmt)
 let add_text_f sp k = k (fun fmt -> Format.kasprintf (add_text sp) fmt)
+let enter_frame = _tracy_frame_enter
+let exit_frame = _tracy_frame_exit
+
+let[@inline] with_frame name f =
+  enter_frame name;
+  try
+    let x = f () in
+    exit_frame name;
+    x
+  with e ->
+    exit_frame name;
+    raise e
 
 let[@inline] with_ ?cs_depth ~__FILE__ ~__LINE__ ?__FUNCTION__ name f =
   let _sp = enter ?cs_depth ~__FILE__ ~__LINE__ ?__FUNCTION__ name in

src/bindings/tracy_client.mli

@@ -68,4 +68,16 @@ val message_f :
 (** Send a formatted message.
     Usage: [message_f (fun k -> k "hello %s %d" "world" 42)] *)
 
+val enter_frame : string -> unit
+(** Enter named frame.
+    @since NEXT_RELEASE *)
+
+val exit_frame : string -> unit
+(** Exit named frame.
+    @since NEXT_RELEASE *)
+
+val with_frame : string -> (unit -> 'a) -> 'a
+(** Protected enter+exit frame
+    @since NEXT_RELEASE *)
+
 val plot : string -> float -> unit

src/bindings/tracy_stubs.cc

@@ -156,4 +156,19 @@ CAMLprim value ml_tracy_plot(value name, value x) {
 
   CAMLreturn(Val_unit);
 }
+
+CAMLprim value ml_tracy_frame_enter(value name) {
+  char const *c_name = String_val(name);
+  TracyCFrameMarkStart(c_name);
+  return Val_unit;
+}
+
+CAMLprim value ml_tracy_frame_exit(value name) {
+  char const *c_name = String_val(name);
+  TracyCFrameMarkEnd(c_name);
+  return Val_unit;
 }
+
+
+} // extern "C"
+

src/trace/tracy_client_trace.ml

@@ -39,6 +39,8 @@ module C () : Trace.Collector.S = struct
   let shutdown () = ()
   let add_data_to_span _ _ = ()
   let add_data_to_manual_span _ _ = ()
+  let enter_context name = Tracy_client.enter_frame name
+  let exit_context name = Tracy_client.exit_frame name
 
   let enter_manual_span ~parent:_ ~flavor:_ ~__FUNCTION__:_ ~__FILE__:_
       ~__LINE__:_ ~data:_ _name : explicit_span =