reduce memory usage of Scope.t

src/client-ocurl/opentelemetry_client_ocurl.ml

@@ -21,7 +21,7 @@ let gc_metrics = AList.make ()
 module Self_trace = struct
   let enabled = Atomic.make true
 
-  let add_event (scope : Scope.t) ev = scope.events <- ev :: scope.events
+  let add_event (scope : Scope.t) ev = Scope.add_event scope (fun () -> ev)
 
   let dummy_trace_id_ = Trace_id.create ()
 

src/core/opentelemetry.ml

@@ -800,18 +800,92 @@ end
 
     A scope is a trace ID and the span ID of the currently active span.
 *)
-module Scope = struct
+module Scope : sig
+  type item_list
+
   type t = {
     trace_id: Trace_id.t;
     span_id: Span_id.t;
-    mutable events: Event.t list;
-    mutable attrs: key_value list;
-    mutable links: Span_link.t list;
+    mutable items: item_list;
   }
 
+  val attrs : t -> key_value list
+
+  val events : t -> Event.t list
+
+  val links : t -> Span_link.t list
+
+  val make :
+    trace_id:Trace_id.t ->
+    span_id:Span_id.t ->
+    ?events:Event.t list ->
+    ?attrs:key_value list ->
+    ?links:Span_link.t list ->
+    unit ->
+    t
+
+  val to_span_ctx : t -> Span_ctx.t
+
+  val add_event : t -> (unit -> Event.t) -> unit
+
+  val record_exception : t -> exn -> Printexc.raw_backtrace -> unit
+
+  val add_attrs : t -> (unit -> key_value list) -> unit
+
+  val add_links : t -> (unit -> Span_link.t list) -> unit
+
+  val ambient_scope_key : t Ambient_context.key
+
+  val get_ambient_scope : ?scope:t -> unit -> t option
+
+  val with_ambient_scope : t -> (unit -> 'a) -> 'a
+end = struct
+  type item_list =
+    | Nil
+    | Ev of Event.t * item_list
+    | Attr of key_value * item_list
+    | Span_link of Span_link.t * item_list
+
+  type t = {
+    trace_id: Trace_id.t;
+    span_id: Span_id.t;
+    mutable items: item_list;
+  }
+
+  let attrs scope =
+    let rec loop acc = function
+      | Nil -> acc
+      | Attr (attr, l) -> loop (attr :: acc) l
+      | Ev (_, l) | Span_link (_, l) -> loop acc l
+    in
+    loop [] scope.items
+
+  let events scope =
+    let rec loop acc = function
+      | Nil -> acc
+      | Ev (event, l) -> loop (event :: acc) l
+      | Attr (_, l) | Span_link (_, l) -> loop acc l
+    in
+    loop [] scope.items
+
+  let links scope =
+    let rec loop acc = function
+      | Nil -> acc
+      | Span_link (span_link, l) -> loop (span_link :: acc) l
+      | Ev (_, l) | Attr (_, l) -> loop acc l
+    in
+    loop [] scope.items
+
   let make ~trace_id ~span_id ?(events = []) ?(attrs = []) ?(links = []) () : t
       =
-    { trace_id; span_id; events; attrs; links }
+    let items =
+      let items = List.fold_left (fun acc ev -> Ev (ev, acc)) Nil events in
+      let items =
+        List.fold_left (fun acc attr -> Attr (attr, acc)) items attrs
+      in
+      List.fold_left (fun acc link -> Span_link (link, acc)) items links
+    in
+    { trace_id; span_id; items }
 
   (** Turn the scope into a span context *)
   let[@inline] to_span_ctx (self : t) : Span_ctx.t =
@@ -822,7 +896,7 @@ module Scope = struct
       Note that this takes a function that produces an event, and will only
       call it if there is an instrumentation backend. *)
   let[@inline] add_event (scope : t) (ev : unit -> Event.t) : unit =
-    if Collector.has_backend () then scope.events <- ev () :: scope.events
+    if Collector.has_backend () then scope.items <- Ev (ev (), scope.items)
 
   let[@inline] record_exception (scope : t) (exn : exn)
       (bt : Printexc.raw_backtrace) : unit =
@@ -836,7 +910,7 @@ module Scope = struct
               "stacktrace", `String (Printexc.raw_backtrace_to_string bt);
             ]
       in
-      scope.events <- ev :: scope.events
+      scope.items <- Ev (ev, scope.items)
     )
 
   (** Add attributes to the scope. It will be aggregated into the span.
@@ -845,15 +919,19 @@ module Scope = struct
       call it if there is an instrumentation backend. *)
   let[@inline] add_attrs (scope : t) (attrs : unit -> key_value list) : unit =
     if Collector.has_backend () then
-      scope.attrs <- List.rev_append (attrs ()) scope.attrs
+      scope.items <-
+        List.fold_left (fun acc attr -> Attr (attr, acc)) scope.items (attrs ())
 
   (** Add links to the scope. It will be aggregated into the span.
 
       Note that this takes a function that produces links, and will only
       call it if there is an instrumentation backend. *)
   let[@inline] add_links (scope : t) (links : unit -> Span_link.t list) : unit =
     if Collector.has_backend () then
-      scope.links <- List.rev_append (links ()) scope.links
+      scope.items <-
+        List.fold_left
+          (fun acc link -> Span_link (link, acc))
+          scope.items (links ())
 
   (** The opaque key necessary to access/set the ambient scope with
       {!Ambient_context}. *)
@@ -1018,9 +1096,7 @@ module Trace = struct
   type scope = Scope.t = {
     trace_id: Trace_id.t;
     span_id: Span_id.t;
-    mutable events: Event.t list;
-    mutable attrs: Span.key_value list;
-    mutable links: Span_link.t list;
+    mutable items: Scope.item_list;
   }
   [@@deprecated "use Scope.t"]
 
@@ -1069,8 +1145,9 @@ module Trace = struct
         (* TODO: should the attrs passed to with_ go on the Span
            (in Span.create) or on the ResourceSpan (in emit)?
            (question also applies to Opentelemetry_lwt.Trace.with) *)
-        Span.create ?kind ~trace_id ?parent ~links:scope.links ~id:span_id
-          ?trace_state ~attrs:scope.attrs ~events:scope.events ~start_time
+        Span.create ?kind ~trace_id ?parent ~links:(Scope.links scope)
+          ~id:span_id ?trace_state ~attrs:(Scope.attrs scope)
+          ~events:(Scope.events scope) ~start_time
           ~end_time:(Timestamp_ns.now_unix_ns ())
           ~status name
       in

src/trace/opentelemetry_trace.ml

@@ -145,10 +145,10 @@ module Internal = struct
       { start_time; name; __FILE__; __LINE__; __FUNCTION__; scope; parent } =
     let open Otel in
     let end_time = Timestamp_ns.now_unix_ns () in
-    let kind, attrs = otel_attrs_of_otrace_data scope.attrs in
+    let kind, attrs = otel_attrs_of_otrace_data (Scope.attrs scope) in
 
     let status : Span.status =
-      match List.assoc_opt Well_known.status_error_key scope.attrs with
+      match List.assoc_opt Well_known.status_error_key attrs with
       | Some (`String message) -> { message; code = Span.Status_code_error }
       | _ -> { message = ""; code = Span.Status_code_ok }
     in
@@ -176,7 +176,8 @@ module Internal = struct
 
     let parent_id = Option.map Otel.Span_ctx.parent_id parent in
     Span.create ~kind ~trace_id:scope.trace_id ?parent:parent_id ~status
-      ~id:scope.span_id ~start_time ~end_time ~attrs ~events:scope.events name
+      ~id:scope.span_id ~start_time ~end_time ~attrs
+      ~events:(Scope.events scope) name
     |> fst
 
   let exit_span' otrace_id otel_span_begin =
@@ -247,13 +248,13 @@ module Internal = struct
       let active_spans = Active_spans.get () in
       match Active_span_tbl.find_opt active_spans.tbl otrace_id with
       | None -> !on_internal_error (spf "no active span with ID %Ld" otrace_id)
-      | Some sb -> sb.scope.attrs <- List.rev_append data sb.scope.attrs
+      | Some sb -> Otel.Scope.add_attrs sb.scope (fun () -> data)
 
     let add_data_to_manual_span (span : Otrace.explicit_span) data : unit =
       match Otrace.Meta_map.find_exn k_explicit_scope span.meta with
       | exception _ ->
         !on_internal_error (spf "manual span does not a contain an OTEL scope")
-      | scope -> scope.attrs <- List.rev_append data scope.attrs
+      | scope -> Otel.Scope.add_attrs scope (fun () -> data)
 
     let message ?span ~data:_ msg : unit =
       (* gather information from context *)