ocaml-opentelemetry/src/ambient-context/dls.ml.tmp

(* TODO: conditional compilation, and use Basic_map in each DLS *)

(** Storage using DLS. *)

open Opentelemetry_ambient_context_core

open struct
  module DLS = Domain.DLS

  module Int_map = Map.Make (struct
    type t = int

    let compare : t -> t -> int = Stdlib.compare
  end)

  (* key used to access the context *)
  let dls_k_context : Context.t ref Int_map.t DLS.key =
    DLS.new_key
      ~split_from_parent:(fun _ -> Int_map.empty)
      (fun _ -> Int_map.empty)

  let dls_get () =
    let tid = Thread.id @@ Thread.self () in
    let map_ref = DLS.get dls_k_context in
    try !(Int_map.find tid map_ref) with Not_found -> Hmap.empty

  let dls_with ctx f =
    let tid = Thread.id @@ Thread.self () in
    let map = DLS.get dls_k_context in
    let ctx_ref =
      try Int_map.find tid map
      with Not_found ->
        let r = ref Context.empty in
        DLS.set dls_k_context (Int_map.add tid r map);
        r
    in

    let old_ctx = !ctx_ref in
    ctx_ref := ctx;

    let finally () = ctx_ref := old_ctx in
    Fun.protect ~finally f
end

let storage : Storage.t =
  { name = "dls-int-map"; get_context = dls_get; with_context = dls_with }