breaking: use poly variants for user_data/span_flavor in subscriber

no need to do redundant conversions.

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 {

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 =

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

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

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 =

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

src/subscriber/types.ml

@@ -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} *)

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 =

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 ]

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