add Trace_lwt.with_span for tracing synchronous code

src/lwt/trace_lwt.ml

@@ -33,3 +33,34 @@ let[@inline] with_span_lwt ?parent ?force_toplevel ?__FUNCTION__ ~__FILE__
       ~__LINE__ ?data name f
   else
     f 0L
+
+let[@inline never] with_span_real_ ?parent ?(force_toplevel = false)
+    ?__FUNCTION__ ~__FILE__ ~__LINE__ ?data name f =
+  let parent =
+    match parent with
+    | Some _ as p -> p
+    | None -> Lwt.get k_parent
+  in
+
+  let espan =
+    match parent, force_toplevel with
+    | _, true | None, _ ->
+      enter_manual_toplevel_span ~flavor:`Sync ?__FUNCTION__ ~__FILE__ ~__LINE__
+        ?data name
+    | Some parent, _ ->
+      enter_manual_sub_span ~parent ~flavor:`Sync ?__FUNCTION__ ~__FILE__
+        ~__LINE__ ?data name
+  in
+
+  Lwt.with_value k_parent (Some espan) (fun () ->
+      Fun.protect
+        (fun () -> f espan.span)
+        ~finally:(fun () -> exit_manual_span espan))
+
+let[@inline] with_span ?parent ?force_toplevel ?__FUNCTION__ ~__FILE__ ~__LINE__
+    ?data name f =
+  if enabled () then
+    with_span_real_ ?parent ?force_toplevel ?__FUNCTION__ ~__FILE__ ~__LINE__
+      ?data name f
+  else
+    f 0L

src/lwt/trace_lwt.mli

@@ -25,3 +25,26 @@ val with_span_lwt :
     @param parent an explicit parent, which bypasses the implicit context.
 
     @since NEXT_RELEASE *)
+
+val with_span :
+  ?parent:explicit_span ->
+  ?force_toplevel:bool ->
+  ?__FUNCTION__:string ->
+  __FILE__:string ->
+  __LINE__:int ->
+  ?data:(unit -> (string * user_data) list) ->
+  string ->
+  (span -> 'a) ->
+  'a
+(** [with_span ~__FILE__ ~__LINE__ name f] calls [f span]
+    where [span] is a new span named with [name]. The span is
+    traced as being synchronous.
+
+    If [f] returns an ['a Lwt.t] future, use [with_span_lwt] instead.
+
+    @param force_toplevel if true, this span will not have a parent even if
+      there is one in the implicit context; ie it create a new
+      {!Trace_core.enter_manual_toplevel_span} in any  case.
+    @param parent an explicit parent, which bypasses the implicit context.
+
+    @since NEXT_RELEASE *)