From 09ca2dd72030b1f4527a3089bdf7dc57d854a4d4 Mon Sep 17 00:00:00 2001 From: Corentin Leruth Date: Thu, 10 Oct 2024 20:53:28 +0200 Subject: [PATCH] reduce memory usage of Scope.t --- .../opentelemetry_client_ocurl.ml | 2 +- src/core/opentelemetry.ml | 105 +++++++++++++++--- src/trace/opentelemetry_trace.ml | 11 +- 3 files changed, 98 insertions(+), 20 deletions(-) diff --git a/src/client-ocurl/opentelemetry_client_ocurl.ml b/src/client-ocurl/opentelemetry_client_ocurl.ml index d724f1c..0cb32a3 100644 --- a/src/client-ocurl/opentelemetry_client_ocurl.ml +++ b/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 () diff --git a/src/core/opentelemetry.ml b/src/core/opentelemetry.ml index 4cd7124..fd0f8b7 100644 --- a/src/core/opentelemetry.ml +++ b/src/core/opentelemetry.ml @@ -800,18 +800,93 @@ 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 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 events: Event.t list; - mutable attrs: key_value list; - mutable links: Span_link.t list; + 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 +897,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 +911,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,7 +920,8 @@ 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. @@ -853,7 +929,10 @@ module Scope = struct 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 +1097,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 +1146,8 @@ 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 ~id:span_id ?trace_state + ~attrs ~events:[] ~start_time ~end_time:(Timestamp_ns.now_unix_ns ()) ~status name in diff --git a/src/trace/opentelemetry_trace.ml b/src/trace/opentelemetry_trace.ml index 9c53c33..c71f42a 100644 --- a/src/trace/opentelemetry_trace.ml +++ b/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 *)