trace.subscriber: define custom span, simplify subscriber callbacks

- custom span carries around all the required data, including mutable
args
- no more manual enter/exit callbacks
- use record for callbacks
- no more big Span_tbl

src/subscriber/callbacks.ml

@@ -23,107 +23,43 @@
 
 open Trace_core
 
-(** First class module signature for callbacks *)
+type 'st t = {
-module type S = sig
+  on_init: 'st -> time_ns:int64 -> unit;
-  type st
-  (** Type of the state passed to every callback. *)
-
-  val on_init : st -> time_ns:int64 -> unit
       (** Called when the subscriber is initialized in a collector *)
-
+  new_span_id: 'st -> Span_sub.span_id;
-  val new_span : st -> span
+      (** How to generate a new span ID?
-  (** How to generate a new span?
           @since NEXT_RELEASE *)
-
+  on_shutdown: 'st -> time_ns:int64 -> unit;
-  val new_trace_id : st -> trace_id
-  (** How to generate a new trace ID?
-      @since NEXT_RELEASE *)
-
-  val on_shutdown : st -> time_ns:int64 -> unit
       (** Called when the collector is shutdown *)
-
+  on_enter_span: 'st -> Span_sub.t -> unit;  (** Enter a span *)
-  val on_name_thread : st -> time_ns:int64 -> tid:int -> name:string -> unit
+  on_exit_span: 'st -> time_ns:int64 -> tid:int -> Span_sub.t -> unit;
-  (** Current thread is being named *)
+      (** Exit a span. This and [on_enter_span] must follow strict stack
-
+          discipline.
-  val on_name_process : st -> time_ns:int64 -> tid:int -> name:string -> unit
+          @param tid the id of the thread on which the span was exited. *)
-  (** Current process is being named *)
+  on_message:
-
+    'st ->
-  val on_enter_span :
-    st ->
-    __FUNCTION__:string option ->
-    __FILE__:string ->
-    __LINE__:int ->
     time_ns:int64 ->
     tid:int ->
-    data:(string * Trace_core.user_data) list ->
+    span:Span_sub.t option ->
-    name:string ->
+    params:extension_parameter list ->
-    span ->
-    unit
-  (** Enter a regular (sync) span *)
-
-  val on_exit_span : st -> time_ns:int64 -> tid:int -> span -> unit
-  (** Exit a span. This and [on_enter_span] must follow strict stack discipline
-  *)
-
-  val on_add_data :
-    st -> data:(string * Trace_core.user_data) list -> span -> unit
-  (** Add data to a regular span (which must be active) *)
-
-  val on_message :
-    st ->
-    time_ns:int64 ->
-    tid:int ->
-    span:span option ->
     data:(string * Trace_core.user_data) list ->
     string ->
-    unit
+    unit;
       (** Emit a log message *)
-
+  on_counter:
-  val on_counter :
+    'st ->
-    st ->
     time_ns:int64 ->
     tid:int ->
+    params:extension_parameter list ->
     data:(string * Trace_core.user_data) list ->
     name:string ->
     float ->
-    unit
+    unit;
       (** Emit the current value of a counter *)
-
+  on_extension_event: 'st -> time_ns:int64 -> tid:int -> extension_event -> unit;
-  val on_enter_manual_span :
-    st ->
-    __FUNCTION__:string option ->
-    __FILE__:string ->
-    __LINE__:int ->
-    time_ns:int64 ->
-    tid:int ->
-    parent:span option ->
-    data:(string * Trace_core.user_data) list ->
-    name:string ->
-    flavor:Trace_core.span_flavor option ->
-    trace_id:trace_id ->
-    span ->
-    unit
-  (** Enter a manual (possibly async) span *)
-
-  val on_exit_manual_span :
-    st ->
-    time_ns:int64 ->
-    tid:int ->
-    name:string ->
-    data:(string * Trace_core.user_data) list ->
-    flavor:Trace_core.span_flavor option ->
-    trace_id:trace_id ->
-    span ->
-    unit
-  (** Exit a manual span *)
-
-  val on_extension_event :
-    st -> time_ns:int64 -> tid:int -> extension_event -> unit
       (** Extension event
           @since 0.8 *)
-end
+}
-
-type 'st t = (module S with type st = 'st)
 (** Callbacks for a subscriber. There is one callback per event in {!Trace}. The
     type ['st] is the state that is passed to every single callback. *)
 
@@ -141,37 +77,32 @@ type 'st t = (module S with type st = 'st)
     ]} *)
 module Dummy = struct
   let on_init _ ~time_ns:_ = ()
-  let new_span _ = Collector.dummy_span
+  let new_span_id _ = Int64.min_int
-  let new_trace_id _ = Collector.dummy_trace_id
   let on_shutdown _ ~time_ns:_ = ()
-  let on_name_thread _ ~time_ns:_ ~tid:_ ~name:_ = ()
+  let on_message _ ~time_ns:_ ~tid:_ ~span:_ ~params:_ ~data:_ _msg = ()
-  let on_name_process _ ~time_ns:_ ~tid:_ ~name:_ = ()
+  let on_counter _ ~time_ns:_ ~tid:_ ~params:_ ~data:_ ~name:_ _v = ()
-  let on_message _ ~time_ns:_ ~tid:_ ~span:_ ~data:_ _msg = ()
+  let on_enter_span _ _sp = ()
-  let on_counter _ ~time_ns:_ ~tid:_ ~data:_ ~name:_ _v = ()
-
-  let on_enter_span _ ~__FUNCTION__:_ ~__FILE__:_ ~__LINE__:_ ~time_ns:_ ~tid:_
-      ~data:_ ~name:_ _sp =
-    ()
-
   let on_exit_span _ ~time_ns:_ ~tid:_ _ = ()
-  let on_add_data _ ~data:_ _sp = ()
-
-  let on_enter_manual_span _ ~__FUNCTION__:_ ~__FILE__:_ ~__LINE__:_ ~time_ns:_
-      ~tid:_ ~parent:_ ~data:_ ~name:_ ~flavor:_ ~trace_id:_ _sp =
-    ()
-
-  let on_exit_manual_span _ ~time_ns:_ ~tid:_ ~name:_ ~data:_ ~flavor:_
-      ~trace_id:_ _ =
-    ()
-
   let on_extension_event _ ~time_ns:_ ~tid:_ _ = ()
 end
 
-(** Dummy callbacks, ignores all events. *)
+(** Build a set of callbacks.
-let dummy (type st) () : st t =
+    @since NEXT_RELEASE *)
-  let module M = struct
+let make ?(on_init = Dummy.on_init) ?(new_span_id = Dummy.new_span_id)
-    type nonrec st = st
+    ?(on_enter_span = Dummy.on_enter_span) ?(on_exit_span = Dummy.on_exit_span)
+    ?(on_message = Dummy.on_message) ?(on_counter = Dummy.on_counter)
+    ?(on_extension_event = Dummy.on_extension_event)
+    ?(on_shutdown = Dummy.on_shutdown) () : _ t =
+  {
+    on_init;
+    new_span_id;
+    on_enter_span;
+    on_exit_span;
+    on_message;
+    on_counter;
+    on_extension_event;
+    on_shutdown;
+  }
 
-    include Dummy
+(** Dummy callbacks, ignores all events. *)
-  end in
+let dummy () : _ t = make ()
-  (module M)

src/subscriber/dune

@@ -1,7 +1,7 @@
 (library
  (name trace_subscriber)
  (public_name trace.subscriber)
- (private_modules time_ thread_ tbl_)
+ (private_modules time_ thread_)
  (libraries
   (re_export trace.core)
   (select
@@ -9,12 +9,6 @@
    from
    (threads -> thread_.real.ml)
    (-> thread_.dummy.ml))
-  (select
-   tbl_.ml
-   from
-   (picos_aux.htbl -> tbl_.picos.ml)
-   (threads -> tbl_.thread.ml)
-   (-> tbl_.basic.ml))
   (select
    time_.ml
    from

src/subscriber/span_sub.ml

@@ -0,0 +1,33 @@
+(** Subscriber span.
+
+    This is the concrete representation of spans used in [Trace_subscriber].
+
+    @since NEXT_RELEASE *)
+
+open Trace_core
+
+type span_id = int64
+(** Unique ID *)
+
+type span_flavor =
+  [ `Sync
+  | `Async
+  ]
+
+type t = {
+  id: span_id;
+  name: string;
+  __FUNCTION__: string option;
+  __FILE__: string;
+  __LINE__: int;
+  time_ns: int64;  (** Time the span was entered. *)
+  mutable time_exit_ns: int64;
+      (** Time the span was exited. Set at exit, [Int64.max_int] otherwise *)
+  tid: int;  (** Thread in which span was created *)
+  parent: parent;
+  flavor: span_flavor;
+  params: extension_parameter list;
+  mutable data: (string * Trace_core.user_data) list;
+      (** Modified by [add_data_to_span] *)
+}
+(** The type of spans used by all subscribers. *)

src/subscriber/span_tbl.ml

@@ -1 +0,0 @@
-include Tbl_

src/subscriber/span_tbl.mli

@@ -1,21 +0,0 @@
-(** A table that can be used to remember information about spans.
-
-    This is convenient when we want to rememner information from a span begin,
-    when dealing with the corresponding span end.
-
-    {b NOTE}: this is thread safe when threads are enabled. *)
-
-open Trace_core
-
-type 'v t
-
-val create : unit -> 'v t
-val add : 'v t -> span -> 'v -> unit
-
-val find_exn : 'v t -> span -> 'v
-(** @raise Not_found if information isn't found *)
-
-val remove : _ t -> span -> unit
-(** Remove the span if present *)
-
-val to_list : 'v t -> (span * 'v) list

src/subscriber/subscriber.ml

@@ -17,95 +17,65 @@ type t =
 let dummy : t = Sub { st = (); callbacks = Callbacks.dummy () }
 
 open struct
-  module Tee_cb : Callbacks.S with type st = t array = struct
+  type st = t array
-    type nonrec st = t array
 
-    let new_span st =
+  let new_span_id (st : st) =
-      let (Sub { st = s; callbacks = (module CB) }) = Array.get st 0 in
+    let (Sub { st; callbacks = cb }) = Array.get st 0 in
-      CB.new_span s
+    cb.new_span_id st
-
-    let new_trace_id st =
-      let (Sub { st = s; callbacks = (module CB) }) = Array.get st 0 in
-      CB.new_trace_id s
 
   let on_init st ~time_ns =
     for i = 0 to Array.length st - 1 do
-        let (Sub { st = s; callbacks = (module CB) }) = Array.get st i in
+      let (Sub { st; callbacks = cb }) = Array.get st i in
-        CB.on_init s ~time_ns
+      cb.on_init st ~time_ns
     done
 
   let on_shutdown st ~time_ns =
     for i = 0 to Array.length st - 1 do
-        let (Sub { st = s; callbacks = (module CB) }) = Array.get st i in
+      let (Sub { st; callbacks = cb }) = Array.get st i in
-        CB.on_shutdown s ~time_ns
+      cb.on_shutdown st ~time_ns
     done
 
-    let on_name_thread st ~time_ns ~tid ~name =
+  let on_enter_span st span =
     for i = 0 to Array.length st - 1 do
-        let (Sub { st = s; callbacks = (module CB) }) = Array.get st i in
+      let (Sub { st; callbacks = cb }) = Array.get st i in
-        CB.on_name_thread s ~time_ns ~tid ~name
+      cb.on_enter_span st span
-      done
-
-    let on_name_process st ~time_ns ~tid ~name =
-      for i = 0 to Array.length st - 1 do
-        let (Sub { st = s; callbacks = (module CB) }) = Array.get st i in
-        CB.on_name_process s ~time_ns ~tid ~name
-      done
-
-    let on_enter_span st ~__FUNCTION__ ~__FILE__ ~__LINE__ ~time_ns ~tid ~data
-        ~name span =
-      for i = 0 to Array.length st - 1 do
-        let (Sub { st = s; callbacks = (module CB) }) = Array.get st i in
-        CB.on_enter_span s ~__FUNCTION__ ~__FILE__ ~__LINE__ ~time_ns ~tid ~data
-          ~name span
     done
 
   let on_exit_span st ~time_ns ~tid span =
     for i = 0 to Array.length st - 1 do
-        let (Sub { st = s; callbacks = (module CB) }) = Array.get st i in
+      let (Sub { st; callbacks = cb }) = Array.get st i in
-        CB.on_exit_span s ~time_ns ~tid span
+      cb.on_exit_span st ~time_ns ~tid span
     done
 
-    let on_add_data st ~data span =
+  let on_message st ~time_ns ~tid ~span ~params ~data msg =
     for i = 0 to Array.length st - 1 do
-        let (Sub { st = s; callbacks = (module CB) }) = Array.get st i in
+      let (Sub { st; callbacks = cb }) = Array.get st i in
-        CB.on_add_data s ~data span
+      cb.on_message st ~time_ns ~tid ~span ~params ~data msg
     done
 
-    let on_message st ~time_ns ~tid ~span ~data msg =
+  let on_counter st ~time_ns ~tid ~params ~data ~name n =
     for i = 0 to Array.length st - 1 do
-        let (Sub { st = s; callbacks = (module CB) }) = Array.get st i in
+      let (Sub { st; callbacks = cb }) = Array.get st i in
-        CB.on_message s ~time_ns ~tid ~span ~data msg
+      cb.on_counter st ~time_ns ~tid ~params ~data ~name n
-      done
-
-    let on_counter st ~time_ns ~tid ~data ~name n =
-      for i = 0 to Array.length st - 1 do
-        let (Sub { st = s; callbacks = (module CB) }) = Array.get st i in
-        CB.on_counter s ~time_ns ~tid ~data ~name n
-      done
-
-    let on_enter_manual_span st ~__FUNCTION__ ~__FILE__ ~__LINE__ ~time_ns ~tid
-        ~parent ~data ~name ~flavor ~trace_id span =
-      for i = 0 to Array.length st - 1 do
-        let (Sub { st = s; callbacks = (module CB) }) = Array.get st i in
-        CB.on_enter_manual_span s ~__FUNCTION__ ~__FILE__ ~__LINE__ ~time_ns
-          ~tid ~parent ~data ~name ~flavor ~trace_id span
-      done
-
-    let on_exit_manual_span st ~time_ns ~tid ~name ~data ~flavor ~trace_id span
-        =
-      for i = 0 to Array.length st - 1 do
-        let (Sub { st = s; callbacks = (module CB) }) = Array.get st i in
-        CB.on_exit_manual_span s ~time_ns ~tid ~name ~data ~flavor ~trace_id
-          span
     done
 
   let on_extension_event st ~time_ns ~tid ev : unit =
     for i = 0 to Array.length st - 1 do
-        let (Sub { st = s; callbacks = (module CB) }) = Array.get st i in
+      let (Sub { st; callbacks = cb }) = Array.get st i in
-        CB.on_extension_event s ~time_ns ~tid ev
+      cb.on_extension_event st ~time_ns ~tid ev
     done
-  end
+
+  let tee_cb : t array Callbacks.t =
+    {
+      Callbacks.on_init;
+      new_span_id;
+      on_enter_span;
+      on_exit_span;
+      on_message;
+      on_counter;
+      on_extension_event;
+      on_shutdown;
+    }
 end
 
 (** Tee multiple subscribers, ie return a subscriber that forwards to every
@@ -117,7 +87,7 @@ let tee_l (subs : t list) : t =
   match subs with
   | [] -> dummy
   | [ s ] -> s
-  | l -> Sub { st = Array.of_list l; callbacks = (module Tee_cb) }
+  | l -> Sub { st = Array.of_list l; callbacks = tee_cb }
 
 (** [tee s1 s2] is a subscriber that forwards every call to [s1] and [s2] both.
 *)

src/subscriber/tbl_.basic.ml

@@ -1,13 +0,0 @@
-module T = Hashtbl.Make (struct
-  include Int64
-
-  let hash = Hashtbl.hash
-end)
-
-type 'v t = 'v T.t
-
-let create () : _ t = T.create 32
-let find_exn = T.find
-let remove = T.remove
-let add = T.replace
-let to_list self : _ list = T.fold (fun k v l -> (k, v) :: l) self []

src/subscriber/tbl_.mli

@@ -1,7 +0,0 @@
-type 'v t
-
-val create : unit -> 'v t
-val add : 'v t -> int64 -> 'v -> unit
-val find_exn : 'v t -> int64 -> 'v
-val remove : _ t -> int64 -> unit
-val to_list : 'v t -> (int64 * 'v) list

src/subscriber/tbl_.picos.ml

@@ -1,18 +0,0 @@
-module H = Picos_aux_htbl
-
-module Key = struct
-  include Int64
-
-  let hash = Hashtbl.hash
-end
-
-type 'v t = (int64, 'v) H.t
-
-let create () : _ t = H.create ~hashed_type:(module Key) ()
-let find_exn = H.find_exn
-let[@inline] remove self k = ignore (H.try_remove self k : bool)
-
-let[@inline] add self k v =
-  if not (H.try_add self k v) then ignore (H.try_set self k v)
-
-let[@inline] to_list self = H.to_seq self |> List.of_seq

src/subscriber/tbl_.thread.ml

@@ -1,38 +0,0 @@
-module T = Hashtbl.Make (struct
-  include Int64
-
-  let hash = Hashtbl.hash
-end)
-
-type 'v t = {
-  tbl: 'v T.t;
-  lock: Mutex.t;
-}
-
-let create () : _ t = { tbl = T.create 32; lock = Mutex.create () }
-
-let find_exn self k =
-  Mutex.lock self.lock;
-  try
-    let v = T.find self.tbl k in
-    Mutex.unlock self.lock;
-    v
-  with e ->
-    Mutex.unlock self.lock;
-    raise e
-
-let remove self k =
-  Mutex.lock self.lock;
-  T.remove self.tbl k;
-  Mutex.unlock self.lock
-
-let add self k v =
-  Mutex.lock self.lock;
-  T.replace self.tbl k v;
-  Mutex.unlock self.lock
-
-let to_list self : _ list =
-  Mutex.lock self.lock;
-  let l = T.fold (fun k v l -> (k, v) :: l) self.tbl [] in
-  Mutex.unlock self.lock;
-  l

src/subscriber/time_.dummy.ml

@@ -1 +0,0 @@
-let[@inline] get_time_ns () : int64 = 0L

src/subscriber/time_.mli

@@ -1 +0,0 @@
-val get_time_ns : unit -> int64

src/subscriber/trace_subscriber.ml

@@ -1,7 +1,7 @@
 open Trace_core
 module Callbacks = Callbacks
 module Subscriber = Subscriber
-module Span_tbl = Span_tbl
+module Span_sub = Span_sub
 
 type t = Subscriber.t
 
@@ -26,127 +26,104 @@ end
 
 open struct
   module A = Trace_core.Internal_.Atomic_
+  open Private_
 
-  type manual_span_info = {
+  type Trace_core.span += Span_sub of Span_sub.t
-    name: string;
+
-    flavor: Trace_core.span_flavor option;
+  let enter_span (Subscriber.Sub { st; callbacks = cb }) ~__FUNCTION__ ~__FILE__
-    mutable data: (string * Trace_core.user_data) list;
+      ~__LINE__ ~params ~data ~parent name : span =
+    let id = cb.new_span_id st in
+    let tid = tid_ () in
+    let time_ns = now_ns () in
+
+    let flavor = ref `Sync in
+    List.iter
+      (function
+        | Core_ext.Extension_span_flavor f -> flavor := f
+        | _ -> ())
+      params;
+
+    let span : Span_sub.t =
+      {
+        name;
+        id;
+        tid;
+        __FUNCTION__;
+        __FILE__;
+        __LINE__;
+        data;
+        parent;
+        flavor = !flavor;
+        params;
+        time_ns;
+        time_exit_ns = Int64.max_int;
       }
+    in
 
-  (** Key used to carry some information between begin and end of manual spans,
+    cb.on_enter_span st span;
-      by way of the meta map *)
+
-  let key_manual_info : manual_span_info Meta_map.key = Meta_map.Key.create ()
+    Span_sub span
+
+  let exit_span (Subscriber.Sub { st; callbacks = cb }) span : unit =
+    match span with
+    | Span_sub span ->
+      let time_ns = now_ns () in
+      span.time_exit_ns <- time_ns;
+      let tid = tid_ () in
+      cb.on_exit_span st ~time_ns ~tid span
+    | _ -> ()
+
+  let add_data_to_span _sub span data =
+    match span with
+    | Span_sub span -> span.data <- List.rev_append data span.data
+    | _ -> ()
+
+  let message (Subscriber.Sub { st; callbacks = cb }) ~params ~data ~span msg :
+      unit =
+    let time_ns = now_ns () in
+    let tid = tid_ () in
+    let span =
+      match span with
+      | Some (Span_sub s) -> Some s
+      | _ -> None
+    in
+    cb.on_message st ~time_ns ~tid ~span ~params ~data msg
+
+  let counter_float (Subscriber.Sub { st; callbacks = cb }) ~params ~data name f
+      : unit =
+    let time_ns = now_ns () in
+    let tid = tid_ () in
+    cb.on_counter st ~tid ~time_ns ~params ~data ~name f
+
+  let[@inline] counter_int sub ~params ~data name i =
+    counter_float sub ~params ~data name (float_of_int i)
+
+  let init (Subscriber.Sub { st; callbacks = cb }) =
+    (* init code *)
+    let time_ns = now_ns () in
+    cb.on_init st ~time_ns
+
+  let shutdown (Subscriber.Sub { st; callbacks = cb }) =
+    let time_ns = now_ns () in
+    cb.on_shutdown st ~time_ns
+
+  let extension_event (Subscriber.Sub { st; callbacks = cb }) ev =
+    let tid = tid_ () in
+    let time_ns = now_ns () in
+    cb.on_extension_event st ~time_ns ~tid ev
+
+  (* TODO: do we want to track this? *)
+  let current_span _ = None
+
+  let coll_cbs : t Collector.Callbacks.t =
+    Collector.Callbacks.make ~enter_span ~exit_span ~current_span ~message
+      ~add_data_to_span ~counter_int ~counter_float ~extension:extension_event
+      ~init ~shutdown ()
 end
 
 (** A collector that calls the callbacks of subscriber *)
-let collector (Sub { st; callbacks = (module CB) } : Subscriber.t) : collector =
+let collector (self : Subscriber.t) : collector =
-  let open Private_ in
+  Collector.C_some (self, coll_cbs)
-  let module M = struct
-    let enter_span ~__FUNCTION__ ~__FILE__ ~__LINE__ ~data name : span =
-      let span = CB.new_span st in
-      let tid = tid_ () in
-      let time_ns = now_ns () in
-      CB.on_enter_span st ~__FUNCTION__ ~__FILE__ ~__LINE__ ~time_ns ~tid ~data
-        ~name span;
-      span
-
-    let exit_span span : unit =
-      let time_ns = now_ns () in
-      let tid = tid_ () in
-      CB.on_exit_span st ~time_ns ~tid span
-
-    let with_span ~__FUNCTION__ ~__FILE__ ~__LINE__ ~data name f =
-      let span = enter_span ~__FUNCTION__ ~__FILE__ ~__LINE__ ~data name in
-      try
-        let x = f span in
-        exit_span span;
-        x
-      with exn ->
-        let bt = Printexc.get_raw_backtrace () in
-        exit_span span;
-        Printexc.raise_with_backtrace exn bt
-
-    let add_data_to_span span data =
-      if data <> [] then CB.on_add_data st ~data span
-
-    let enter_manual_span ~(parent : explicit_span_ctx option) ~flavor
-        ~__FUNCTION__ ~__FILE__ ~__LINE__ ~data name : explicit_span =
-      let span = CB.new_span st in
-      let tid = tid_ () in
-      let time_ns = now_ns () in
-
-      (* get the common trace id, or make a new one *)
-      let trace_id, parent =
-        match parent with
-        | Some m -> m.trace_id, Some m.span
-        | None -> CB.new_trace_id st, None
-      in
-
-      CB.on_enter_manual_span st ~__FUNCTION__ ~__FILE__ ~__LINE__ ~parent ~data
-        ~time_ns ~tid ~name ~flavor ~trace_id span;
-      let meta =
-        Meta_map.empty
-        |> Meta_map.add key_manual_info { name; flavor; data = [] }
-      in
-      { span; trace_id; meta }
-
-    let exit_manual_span (es : explicit_span) : unit =
-      let time_ns = now_ns () in
-      let tid = tid_ () in
-      let trace_id = es.trace_id in
-      let minfo =
-        match Meta_map.find key_manual_info es.meta with
-        | None -> assert false
-        | Some m -> m
-      in
-      CB.on_exit_manual_span st ~tid ~time_ns ~data:minfo.data ~name:minfo.name
-        ~flavor:minfo.flavor ~trace_id es.span
-
-    let add_data_to_manual_span (es : explicit_span) data =
-      if data <> [] then (
-        match Meta_map.find key_manual_info es.meta with
-        | None -> assert false
-        | Some m -> m.data <- List.rev_append data m.data
-      )
-
-    let message ?span ~data msg : unit =
-      let time_ns = now_ns () in
-      let tid = tid_ () in
-      CB.on_message st ~time_ns ~tid ~span ~data msg
-
-    let counter_float ~data name f : unit =
-      let time_ns = now_ns () in
-      let tid = tid_ () in
-      CB.on_counter st ~tid ~time_ns ~data ~name f
-
-    let[@inline] counter_int ~data name i =
-      counter_float ~data name (float_of_int i)
-
-    let name_process name : unit =
-      let tid = tid_ () in
-      let time_ns = now_ns () in
-      CB.on_name_process st ~time_ns ~tid ~name
-
-    let name_thread name : unit =
-      let tid = tid_ () in
-      let time_ns = now_ns () in
-      CB.on_name_thread st ~time_ns ~tid ~name
-
-    let shutdown () =
-      let time_ns = now_ns () in
-      CB.on_shutdown st ~time_ns
-
-    let extension_event ev =
-      let tid = tid_ () in
-      let time_ns = now_ns () in
-      CB.on_extension_event st ~time_ns ~tid ev
-
-    let () =
-      (* init code *)
-      let time_ns = now_ns () in
-      CB.on_init st ~time_ns
-  end in
-  (module M)
 
 module Span_generator = struct
   type t = int A.t
@@ -154,15 +131,3 @@ module Span_generator = struct
   let create () = A.make 0
   let[@inline] mk_span self = A.fetch_and_add self 1 |> Int64.of_int
 end
-
-module Trace_id_8B_generator = struct
-  type t = int A.t
-
-  let create () = A.make 0
-
-  let[@inline] mk_trace_id (self : t) : trace_id =
-    let n = A.fetch_and_add self 1 in
-    let b = Bytes.create 8 in
-    Bytes.set_int64_le b 0 (Int64.of_int n);
-    Bytes.unsafe_to_string b
-end

src/subscriber/trace_subscriber.mli

@@ -11,7 +11,7 @@
 
 module Callbacks = Callbacks
 module Subscriber = Subscriber
-module Span_tbl = Span_tbl
+module Span_sub = Span_sub
 
 (** {2 Main API} *)
 
@@ -24,9 +24,8 @@ type t = Subscriber.t
     whenever the trace collector invokes the callbacks. *)
 
 val collector : t -> Trace_core.collector
-(** A collector that calls the subscriber's callbacks.
+(** A collector that calls the subscriber's callbacks. It uses [mtime] (if
-
+    available) to obtain timestamps. *)
-    It uses [mtime] (if available) to obtain timestamps. *)
 
 (** A counter-based span generator.
     @since NEXT_RELEASE *)
@@ -34,16 +33,7 @@ module Span_generator : sig
   type t
 
   val create : unit -> t
-  val mk_span : t -> Trace_core.span
+  val mk_span : t -> Span_sub.span_id
-end
-
-(** A counter-based trace ID generator, producing 8-byte trace IDs.
-    @since NEXT_RELEASE *)
-module Trace_id_8B_generator : sig
-  type t
-
-  val create : unit -> t
-  val mk_trace_id : t -> Trace_core.trace_id
 end
 
 (**/**)