From 89eecf7ba3aabcf6dc56c4763758e2c06f01e0ed Mon Sep 17 00:00:00 2001 From: Simon Cruanes Date: Thu, 4 Dec 2025 12:39:03 -0500 Subject: [PATCH] breaking: use poly variants for user_data/span_flavor in subscriber no need to do redundant conversions. --- src/event/event.ml | 14 +++++------ src/fuchsia/subscriber.ml | 4 ++-- src/fuchsia/writer.ml | 21 ++++++++--------- src/subscriber/callbacks.ml | 18 +++++++-------- src/subscriber/trace_subscriber.ml | 36 +++-------------------------- src/subscriber/trace_subscriber.mli | 4 ---- src/subscriber/types.ml | 13 ----------- src/tef/subscriber.ml | 4 ++-- src/tef/writer.ml | 30 ++++++++++++------------ src/tef/writer.mli | 12 +++++----- 10 files changed, 54 insertions(+), 102 deletions(-) delete mode 100644 src/subscriber/types.ml diff --git a/src/event/event.ml b/src/event/event.ml index 3ccf2d5..456562b 100644 --- a/src/event/event.ml +++ b/src/event/event.ml @@ -15,7 +15,7 @@ type t = tid: int; msg: string; time_ns: int64; - data: (string * Sub.user_data) list; + data: (string * user_data) list; } | E_define_span of { tid: int; @@ -23,7 +23,7 @@ type t = time_ns: int64; id: span; fun_name: string option; - data: (string * Sub.user_data) list; + data: (string * user_data) list; } | E_exit_span of { id: span; @@ -31,23 +31,23 @@ type t = } | E_add_data of { id: span; - data: (string * Sub.user_data) list; + data: (string * user_data) list; } | E_enter_manual_span of { tid: int; name: string; time_ns: int64; id: trace_id; - flavor: Sub.flavor option; + flavor: span_flavor option; fun_name: string option; - data: (string * Sub.user_data) list; + data: (string * user_data) list; } | E_exit_manual_span of { tid: int; name: string; time_ns: int64; - flavor: Sub.flavor option; - data: (string * Sub.user_data) list; + flavor: span_flavor option; + data: (string * user_data) list; id: trace_id; } | E_counter of { diff --git a/src/fuchsia/subscriber.ml b/src/fuchsia/subscriber.ml index 9459f28..768ae46 100644 --- a/src/fuchsia/subscriber.ml +++ b/src/fuchsia/subscriber.ml @@ -8,7 +8,7 @@ type span_info = { tid: int; name: string; start_ns: int64; - mutable data: (string * Sub.user_data) list; + mutable data: (string * user_data) list; (* NOTE: thread safety: this is supposed to only be modified by the thread that's running this (synchronous, stack-abiding) span. *) } @@ -116,7 +116,7 @@ module Callbacks = struct let add_fun_name_ fun_name data : _ list = match fun_name with | None -> data - | Some f -> ("function", Sub.U_string f) :: data + | Some f -> ("function", `String f) :: data let[@inline] on_enter_span (self : st) ~__FUNCTION__:fun_name ~__FILE__:_ ~__LINE__:_ ~time_ns ~tid ~data ~name span : unit = diff --git a/src/fuchsia/writer.ml b/src/fuchsia/writer.ml index 47d2646..972d9eb 100644 --- a/src/fuchsia/writer.ml +++ b/src/fuchsia/writer.ml @@ -15,12 +15,7 @@ end open Util -type user_data = Sub.user_data = - | U_bool of bool - | U_float of float - | U_int of int - | U_none - | U_string of string +type user_data = Trace_core.user_data type arg = | A_bool of bool @@ -30,12 +25,16 @@ type arg = | A_string of string | A_kid of int64 -(* NOTE: only works because [user_data] is a prefix of [arg] and is immutable *) -let arg_of_user_data : user_data -> arg = Obj.magic +let arg_of_user_data : user_data -> arg = function + | `Bool b -> A_bool b + | `Float f -> A_float f + | `Int i -> A_int i + | `String s -> A_string s + | `None -> A_none -(* NOTE: only works because [user_data] is a prefix of [arg] and is immutable *) -let args_of_user_data : (string * user_data) list -> (string * arg) list = - Obj.magic +let[@inline] args_of_user_data : + (string * user_data) list -> (string * arg) list = + fun l -> List.rev_map (fun (k, v) -> k, arg_of_user_data v) l module I64 = struct include Int64 diff --git a/src/subscriber/callbacks.ml b/src/subscriber/callbacks.ml index 3877e95..0792493 100644 --- a/src/subscriber/callbacks.ml +++ b/src/subscriber/callbacks.ml @@ -22,7 +22,6 @@ at least 64 bits. *) open Trace_core -open Types (** First class module signature for callbacks *) module type S = sig @@ -56,7 +55,7 @@ module type S = sig __LINE__:int -> time_ns:int64 -> tid:int -> - data:(string * user_data) list -> + data:(string * Trace_core.user_data) list -> name:string -> span -> unit @@ -66,7 +65,8 @@ module type S = sig (** Exit a span. This and [on_enter_span] must follow strict stack discipline *) - val on_add_data : st -> data:(string * user_data) list -> span -> unit + 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 : @@ -74,7 +74,7 @@ module type S = sig time_ns:int64 -> tid:int -> span:span option -> - data:(string * user_data) list -> + data:(string * Trace_core.user_data) list -> string -> unit (** Emit a log message *) @@ -83,7 +83,7 @@ module type S = sig st -> time_ns:int64 -> tid:int -> - data:(string * user_data) list -> + data:(string * Trace_core.user_data) list -> name:string -> float -> unit @@ -97,9 +97,9 @@ module type S = sig time_ns:int64 -> tid:int -> parent:span option -> - data:(string * user_data) list -> + data:(string * Trace_core.user_data) list -> name:string -> - flavor:flavor option -> + flavor:Trace_core.span_flavor option -> trace_id:trace_id -> span -> unit @@ -110,8 +110,8 @@ module type S = sig time_ns:int64 -> tid:int -> name:string -> - data:(string * user_data) list -> - flavor:flavor option -> + data:(string * Trace_core.user_data) list -> + flavor:Trace_core.span_flavor option -> trace_id:trace_id -> span -> unit diff --git a/src/subscriber/trace_subscriber.ml b/src/subscriber/trace_subscriber.ml index 36d7e80..e103916 100644 --- a/src/subscriber/trace_subscriber.ml +++ b/src/subscriber/trace_subscriber.ml @@ -2,7 +2,6 @@ open Trace_core module Callbacks = Callbacks module Subscriber = Subscriber module Span_tbl = Span_tbl -include Types type t = Subscriber.t @@ -30,8 +29,8 @@ open struct type manual_span_info = { name: string; - flavor: flavor option; - mutable data: (string * user_data) list; + flavor: Trace_core.span_flavor option; + mutable data: (string * Trace_core.user_data) list; } (** Key used to carry some information between begin and end of manual spans, @@ -39,26 +38,6 @@ open struct let key_manual_info : manual_span_info Meta_map.key = Meta_map.Key.create () end -let[@inline] conv_flavor = function - | `Async -> Async - | `Sync -> Sync - -let[@inline] conv_flavor_opt = function - | None -> None - | Some f -> Some (conv_flavor f) - -let[@inline] conv_user_data = function - | `Int i -> U_int i - | `Bool b -> U_bool b - | `Float f -> U_float f - | `String s -> U_string s - | `None -> U_none - -let rec conv_data = function - | [] -> [] - | [ (k, v) ] -> [ k, conv_user_data v ] - | (k, v) :: tl -> (k, conv_user_data v) :: conv_data tl - (** A collector that calls the callbacks of subscriber *) let collector (Sub { st; callbacks = (module CB) } : Subscriber.t) : collector = let open Private_ in @@ -67,7 +46,6 @@ let collector (Sub { st; callbacks = (module CB) } : Subscriber.t) : collector = let span = CB.new_span st in let tid = tid_ () in let time_ns = now_ns () in - let data = conv_data data in CB.on_enter_span st ~__FUNCTION__ ~__FILE__ ~__LINE__ ~time_ns ~tid ~data ~name span; span @@ -89,18 +67,13 @@ let collector (Sub { st; callbacks = (module CB) } : Subscriber.t) : collector = Printexc.raise_with_backtrace exn bt let add_data_to_span span data = - if data <> [] then ( - let data = conv_data data in - CB.on_add_data st ~data span - ) + 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 - let data = conv_data data in - let flavor = conv_flavor_opt flavor in (* get the common trace id, or make a new one *) let trace_id, parent = @@ -131,7 +104,6 @@ let collector (Sub { st; callbacks = (module CB) } : Subscriber.t) : collector = let add_data_to_manual_span (es : explicit_span) data = if data <> [] then ( - let data = conv_data data in match Meta_map.find key_manual_info es.meta with | None -> assert false | Some m -> m.data <- List.rev_append data m.data @@ -140,13 +112,11 @@ let collector (Sub { st; callbacks = (module CB) } : Subscriber.t) : collector = let message ?span ~data msg : unit = let time_ns = now_ns () in let tid = tid_ () in - let data = conv_data data 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 - let data = conv_data data in CB.on_counter st ~tid ~time_ns ~data ~name f let[@inline] counter_int ~data name i = diff --git a/src/subscriber/trace_subscriber.mli b/src/subscriber/trace_subscriber.mli index 6229549..d84d744 100644 --- a/src/subscriber/trace_subscriber.mli +++ b/src/subscriber/trace_subscriber.mli @@ -13,10 +13,6 @@ module Callbacks = Callbacks module Subscriber = Subscriber module Span_tbl = Span_tbl -include module type of struct - include Types -end - (** {2 Main API} *) type t = Subscriber.t diff --git a/src/subscriber/types.ml b/src/subscriber/types.ml deleted file mode 100644 index dc48841..0000000 --- a/src/subscriber/types.ml +++ /dev/null @@ -1,13 +0,0 @@ -(** Some core types for subscribers. *) - -type user_data = - | U_bool of bool - | U_float of float - | U_int of int - | U_none - | U_string of string - (** A non polymorphic-variant version of {!Trace_core.user_data} *) - -type flavor = - | Sync - | Async (** A non polymorphic-variant version of {!Trace_core.flavor} *) diff --git a/src/tef/subscriber.ml b/src/tef/subscriber.ml index 7c6688e..b90a6a3 100644 --- a/src/tef/subscriber.ml +++ b/src/tef/subscriber.ml @@ -29,7 +29,7 @@ type span_info = { tid: int; name: string; start_us: float; - mutable data: (string * Sub.user_data) list; + mutable data: (string * user_data) list; (* NOTE: thread safety: this is supposed to only be modified by the thread that's running this (synchronous, stack-abiding) span. *) } @@ -113,7 +113,7 @@ module Callbacks = struct let add_fun_name_ fun_name data : _ list = match fun_name with | None -> data - | Some f -> ("function", Sub.U_string f) :: data + | Some f -> ("function", `String f) :: data let[@inline] on_enter_span (self : st) ~__FUNCTION__:fun_name ~__FILE__:_ ~__LINE__:_ ~time_ns ~tid ~data ~name span : unit = diff --git a/src/tef/writer.ml b/src/tef/writer.ml index 9865988..26286c3 100644 --- a/src/tef/writer.ml +++ b/src/tef/writer.ml @@ -21,12 +21,12 @@ let str_val (buf : Buffer.t) (s : string) = String.iter encode_char s; char buf '"' -let pp_user_data_ (out : Buffer.t) : Sub.user_data -> unit = function - | U_none -> raw_string out "null" - | U_int i -> Printf.bprintf out "%d" i - | U_bool b -> Printf.bprintf out "%b" b - | U_string s -> str_val out s - | U_float f -> Printf.bprintf out "%g" f +let pp_user_data_ (out : Buffer.t) : Trace_core.user_data -> unit = function + | `None -> raw_string out "null" + | `Int i -> Printf.bprintf out "%d" i + | `Bool b -> Printf.bprintf out "%b" b + | `String s -> str_val out s + | `Float f -> Printf.bprintf out "%g" f (* emit args, if not empty. [ppv] is used to print values. *) let emit_args_o_ ppv (out : Buffer.t) args : unit = @@ -51,24 +51,24 @@ let emit_duration_event ~pid ~tid ~name ~start ~end_ ~args buf : unit = args let emit_manual_begin ~pid ~tid ~name ~(id : int64) ~ts ~args - ~(flavor : Sub.flavor option) buf : unit = + ~(flavor : Trace_core.span_flavor option) buf : unit = Printf.bprintf buf {json|{"pid":%d,"cat":"trace","id":%Ld,"tid": %d,"ts": %.2f,"name":%a,"ph":"%c"%a}|json} pid id tid ts str_val name (match flavor with - | None | Some Async -> 'b' - | Some Sync -> 'B') + | None | Some `Async -> 'b' + | Some `Sync -> 'B') (emit_args_o_ pp_user_data_) args let emit_manual_end ~pid ~tid ~name ~(id : int64) ~ts - ~(flavor : Sub.flavor option) ~args buf : unit = + ~(flavor : Trace_core.span_flavor option) ~args buf : unit = Printf.bprintf buf {json|{"pid":%d,"cat":"trace","id":%Ld,"tid": %d,"ts": %.2f,"name":%a,"ph":"%c"%a}|json} pid id tid ts str_val name (match flavor with - | None | Some Async -> 'e' - | Some Sync -> 'E') + | None | Some `Async -> 'e' + | Some `Sync -> 'E') (emit_args_o_ pp_user_data_) args @@ -83,15 +83,15 @@ let emit_name_thread ~pid ~tid ~name buf : unit = Printf.bprintf buf {json|{"pid":%d,"tid": %d,"name":"thread_name","ph":"M"%a}|json} pid tid (emit_args_o_ pp_user_data_) - [ "name", U_string name ] + [ "name", `String name ] let emit_name_process ~pid ~name buf : unit = Printf.bprintf buf {json|{"pid":%d,"name":"process_name","ph":"M"%a}|json} pid (emit_args_o_ pp_user_data_) - [ "name", U_string name ] + [ "name", `String name ] let emit_counter ~pid ~tid ~name ~ts buf f : unit = Printf.bprintf buf {json|{"pid":%d,"tid":%d,"ts":%.2f,"name":"c","ph":"C"%a}|json} pid tid ts (emit_args_o_ pp_user_data_) - [ name, U_float f ] + [ name, `Float f ] diff --git a/src/tef/writer.mli b/src/tef/writer.mli index d1563a7..536b602 100644 --- a/src/tef/writer.mli +++ b/src/tef/writer.mli @@ -12,7 +12,7 @@ val emit_duration_event : name:string -> start:float -> end_:float -> - args:(string * Sub.user_data) list -> + args:(string * Trace_core.user_data) list -> Buffer.t -> unit @@ -22,8 +22,8 @@ val emit_manual_begin : name:string -> id:span -> ts:float -> - args:(string * Sub.user_data) list -> - flavor:Sub.flavor option -> + args:(string * Trace_core.user_data) list -> + flavor:Trace_core.span_flavor option -> Buffer.t -> unit @@ -33,8 +33,8 @@ val emit_manual_end : name:string -> id:span -> ts:float -> - flavor:Sub.flavor option -> - args:(string * Sub.user_data) list -> + flavor:Trace_core.span_flavor option -> + args:(string * Trace_core.user_data) list -> Buffer.t -> unit @@ -43,7 +43,7 @@ val emit_instant_event : tid:int -> name:string -> ts:float -> - args:(string * Sub.user_data) list -> + args:(string * Trace_core.user_data) list -> Buffer.t -> unit