From a1837e402e8aaa6c706ad5a6b3687c6d56d2519f Mon Sep 17 00:00:00 2001 From: Simon Cruanes Date: Wed, 14 Jan 2026 21:47:56 -0500 Subject: [PATCH] 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 | 171 +++++++-------------- src/subscriber/dune | 8 +- src/subscriber/span_sub.ml | 33 ++++ src/subscriber/span_tbl.ml | 1 - src/subscriber/span_tbl.mli | 21 --- src/subscriber/subscriber.ml | 132 +++++++--------- src/subscriber/tbl_.basic.ml | 13 -- src/subscriber/tbl_.mli | 7 - src/subscriber/tbl_.picos.ml | 18 --- src/subscriber/tbl_.thread.ml | 38 ----- src/subscriber/time_.dummy.ml | 1 - src/subscriber/time_.mli | 1 - src/subscriber/trace_subscriber.ml | 223 ++++++++++++---------------- src/subscriber/trace_subscriber.mli | 18 +-- 14 files changed, 234 insertions(+), 451 deletions(-) create mode 100644 src/subscriber/span_sub.ml delete mode 100644 src/subscriber/span_tbl.ml delete mode 100644 src/subscriber/span_tbl.mli delete mode 100644 src/subscriber/tbl_.basic.ml delete mode 100644 src/subscriber/tbl_.mli delete mode 100644 src/subscriber/tbl_.picos.ml delete mode 100644 src/subscriber/tbl_.thread.ml delete mode 100644 src/subscriber/time_.dummy.ml delete mode 100644 src/subscriber/time_.mli diff --git a/src/subscriber/callbacks.ml b/src/subscriber/callbacks.ml index 0792493..70bde0f 100644 --- a/src/subscriber/callbacks.ml +++ b/src/subscriber/callbacks.ml @@ -23,107 +23,43 @@ open Trace_core -(** First class module signature for callbacks *) -module type S = sig - 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 *) - - val new_span : st -> span - (** How to generate a new span? - @since NEXT_RELEASE *) - - 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 *) - - val on_name_thread : st -> time_ns:int64 -> tid:int -> name:string -> unit - (** Current thread is being named *) - - val on_name_process : st -> time_ns:int64 -> tid:int -> name:string -> unit - (** Current process is being named *) - - val on_enter_span : - st -> - __FUNCTION__:string option -> - __FILE__:string -> - __LINE__:int -> +type 'st t = { + on_init: 'st -> time_ns:int64 -> unit; + (** Called when the subscriber is initialized in a collector *) + new_span_id: 'st -> Span_sub.span_id; + (** How to generate a new span ID? + @since NEXT_RELEASE *) + on_shutdown: 'st -> time_ns:int64 -> unit; + (** Called when the collector is shutdown *) + on_enter_span: 'st -> Span_sub.t -> unit; (** Enter a span *) + on_exit_span: 'st -> time_ns:int64 -> tid:int -> Span_sub.t -> unit; + (** Exit a span. This and [on_enter_span] must follow strict stack + discipline. + @param tid the id of the thread on which the span was exited. *) + on_message: + 'st -> time_ns:int64 -> tid:int -> - data:(string * Trace_core.user_data) list -> - name:string -> - 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 -> + span:Span_sub.t option -> + params:extension_parameter list -> data:(string * Trace_core.user_data) list -> string -> - unit - (** Emit a log message *) - - val on_counter : - st -> + unit; + (** Emit a log message *) + on_counter: + 'st -> time_ns:int64 -> tid:int -> + params:extension_parameter list -> data:(string * Trace_core.user_data) list -> name:string -> float -> - unit - (** Emit the current value of a counter *) - - 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) + unit; + (** Emit the current value of a counter *) + on_extension_event: 'st -> time_ns:int64 -> tid:int -> extension_event -> unit; + (** Extension event + @since 0.8 *) +} (** 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_trace_id _ = Collector.dummy_trace_id + let new_span_id _ = Int64.min_int let on_shutdown _ ~time_ns:_ = () - let on_name_thread _ ~time_ns:_ ~tid:_ ~name:_ = () - let on_name_process _ ~time_ns:_ ~tid:_ ~name:_ = () - let on_message _ ~time_ns:_ ~tid:_ ~span:_ ~data:_ _msg = () - let on_counter _ ~time_ns:_ ~tid:_ ~data:_ ~name:_ _v = () - - let on_enter_span _ ~__FUNCTION__:_ ~__FILE__:_ ~__LINE__:_ ~time_ns:_ ~tid:_ - ~data:_ ~name:_ _sp = - () - + let on_message _ ~time_ns:_ ~tid:_ ~span:_ ~params:_ ~data:_ _msg = () + let on_counter _ ~time_ns:_ ~tid:_ ~params:_ ~data:_ ~name:_ _v = () + let on_enter_span _ _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. *) -let dummy (type st) () : st t = - let module M = struct - type nonrec st = st +(** Build a set of callbacks. + @since NEXT_RELEASE *) +let make ?(on_init = Dummy.on_init) ?(new_span_id = Dummy.new_span_id) + ?(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 - end in - (module M) +(** Dummy callbacks, ignores all events. *) +let dummy () : _ t = make () diff --git a/src/subscriber/dune b/src/subscriber/dune index 580214d..b8b3da0 100644 --- a/src/subscriber/dune +++ b/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 diff --git a/src/subscriber/span_sub.ml b/src/subscriber/span_sub.ml new file mode 100644 index 0000000..177e225 --- /dev/null +++ b/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. *) diff --git a/src/subscriber/span_tbl.ml b/src/subscriber/span_tbl.ml deleted file mode 100644 index e5113cc..0000000 --- a/src/subscriber/span_tbl.ml +++ /dev/null @@ -1 +0,0 @@ -include Tbl_ diff --git a/src/subscriber/span_tbl.mli b/src/subscriber/span_tbl.mli deleted file mode 100644 index 32be058..0000000 --- a/src/subscriber/span_tbl.mli +++ /dev/null @@ -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 diff --git a/src/subscriber/subscriber.ml b/src/subscriber/subscriber.ml index 80ddc02..27fa400 100644 --- a/src/subscriber/subscriber.ml +++ b/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 nonrec st = t array + type st = t array - let new_span st = - let (Sub { st = s; callbacks = (module CB) }) = Array.get st 0 in - CB.new_span s + let new_span_id (st : st) = + let (Sub { st; callbacks = cb }) = Array.get st 0 in + 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; callbacks = cb }) = Array.get st i in + cb.on_init st ~time_ns + done - 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 - CB.on_init s ~time_ns - done + let on_shutdown st ~time_ns = + for i = 0 to Array.length st - 1 do + let (Sub { st; callbacks = cb }) = Array.get st i in + cb.on_shutdown 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 - CB.on_shutdown s ~time_ns - done + let on_enter_span st span = + for i = 0 to Array.length st - 1 do + let (Sub { st; callbacks = cb }) = Array.get st i in + cb.on_enter_span st span + done - let on_name_thread 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_thread s ~time_ns ~tid ~name - done + let on_exit_span st ~time_ns ~tid span = + for i = 0 to Array.length st - 1 do + let (Sub { st; callbacks = cb }) = Array.get st i in + cb.on_exit_span st ~time_ns ~tid 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_message st ~time_ns ~tid ~span ~params ~data msg = + for i = 0 to Array.length st - 1 do + let (Sub { st; callbacks = cb }) = Array.get st i in + cb.on_message st ~time_ns ~tid ~span ~params ~data msg + 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_counter st ~time_ns ~tid ~params ~data ~name n = + for i = 0 to Array.length st - 1 do + let (Sub { st; callbacks = cb }) = Array.get st i in + cb.on_counter st ~time_ns ~tid ~params ~data ~name n + 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 - CB.on_exit_span s ~time_ns ~tid span - done + let on_extension_event st ~time_ns ~tid ev : unit = + for i = 0 to Array.length st - 1 do + let (Sub { st; callbacks = cb }) = Array.get st i in + cb.on_extension_event st ~time_ns ~tid ev + done - let on_add_data st ~data span = - for i = 0 to Array.length st - 1 do - let (Sub { st = s; callbacks = (module CB) }) = Array.get st i in - CB.on_add_data s ~data span - done - - let on_message st ~time_ns ~tid ~span ~data msg = - for i = 0 to Array.length st - 1 do - let (Sub { st = s; callbacks = (module CB) }) = Array.get st i in - CB.on_message s ~time_ns ~tid ~span ~data msg - 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 - CB.on_extension_event s ~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. *) diff --git a/src/subscriber/tbl_.basic.ml b/src/subscriber/tbl_.basic.ml deleted file mode 100644 index e182d8a..0000000 --- a/src/subscriber/tbl_.basic.ml +++ /dev/null @@ -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 [] diff --git a/src/subscriber/tbl_.mli b/src/subscriber/tbl_.mli deleted file mode 100644 index 78e2443..0000000 --- a/src/subscriber/tbl_.mli +++ /dev/null @@ -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 diff --git a/src/subscriber/tbl_.picos.ml b/src/subscriber/tbl_.picos.ml deleted file mode 100644 index 36dba69..0000000 --- a/src/subscriber/tbl_.picos.ml +++ /dev/null @@ -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 diff --git a/src/subscriber/tbl_.thread.ml b/src/subscriber/tbl_.thread.ml deleted file mode 100644 index 54517f2..0000000 --- a/src/subscriber/tbl_.thread.ml +++ /dev/null @@ -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 diff --git a/src/subscriber/time_.dummy.ml b/src/subscriber/time_.dummy.ml deleted file mode 100644 index 29ce8e8..0000000 --- a/src/subscriber/time_.dummy.ml +++ /dev/null @@ -1 +0,0 @@ -let[@inline] get_time_ns () : int64 = 0L diff --git a/src/subscriber/time_.mli b/src/subscriber/time_.mli deleted file mode 100644 index 5b29ca0..0000000 --- a/src/subscriber/time_.mli +++ /dev/null @@ -1 +0,0 @@ -val get_time_ns : unit -> int64 diff --git a/src/subscriber/trace_subscriber.ml b/src/subscriber/trace_subscriber.ml index e103916..88c5ef9 100644 --- a/src/subscriber/trace_subscriber.ml +++ b/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 = { - name: string; - flavor: Trace_core.span_flavor option; - mutable data: (string * Trace_core.user_data) list; - } + type Trace_core.span += Span_sub of Span_sub.t - (** Key used to carry some information between begin and end of manual spans, - by way of the meta map *) - let key_manual_info : manual_span_info Meta_map.key = Meta_map.Key.create () + let enter_span (Subscriber.Sub { st; callbacks = cb }) ~__FUNCTION__ ~__FILE__ + ~__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 + + cb.on_enter_span st span; + + 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 open Private_ in - 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) +let collector (self : Subscriber.t) : collector = + Collector.C_some (self, coll_cbs) 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 diff --git a/src/subscriber/trace_subscriber.mli b/src/subscriber/trace_subscriber.mli index d84d744..4a1f561 100644 --- a/src/subscriber/trace_subscriber.mli +++ b/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. - - It uses [mtime] (if available) to obtain timestamps. *) +(** A collector that calls the subscriber's callbacks. 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 -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 + val mk_span : t -> Span_sub.span_id end (**/**)