non optional dependency on thread-local-storage

it's a dep of picos anyway

dune-project

@@ -22,15 +22,14 @@
   (trace :with-test)
   (trace-tef :with-test)
   (qcheck-core (and :with-test (>= 0.19)))
+  (thread-local-storage (and (>= 0.2) (< 0.3)))
   (odoc :with-doc)
   (mdx
    (and
     (>= 1.9.0)
     :with-test)))
  (depopts
-   (trace (>= 0.6))
-   thread-local-storage)
- (conflicts (thread-local-storage (< 0.2)))
+   (trace (>= 0.6)))
  (tags
   (thread pool domain futures fork-join)))
 

moonpool.opam

@@ -15,15 +15,12 @@ depends: [
   "trace" {with-test}
   "trace-tef" {with-test}
   "qcheck-core" {with-test & >= "0.19"}
+  "thread-local-storage" {>= "0.2" & < "0.3"}
   "odoc" {with-doc}
   "mdx" {>= "1.9.0" & with-test}
 ]
 depopts: [
   "trace" {>= "0.6"}
-  "thread-local-storage"
-]
-conflicts: [
-  "thread-local-storage" {< "0.2"}
 ]
 build: [
   ["dune" "subst"] {dev}

src/core/dune

@@ -1,7 +1,12 @@
 (library
  (public_name moonpool)
  (name moonpool)
- (libraries moonpool.private moonpool.dpool picos.exn_bt picos)
+ (libraries
+  moonpool.private
+  thread-local-storage
+  moonpool.dpool
+  picos.exn_bt
+  picos)
  (flags :standard -open Moonpool_private)
  (private_modules types_ util_pool_)
  (preprocess

src/core/moonpool.ml

@@ -30,7 +30,8 @@ module Lock = Lock
 module Immediate_runner = struct end
 module Runner = Runner
 module Task_local_storage = Task_local_storage
-module Thread_local_storage = Thread_local_storage_
+module Thread_local_storage = Thread_local_storage
+module Trigger = Trigger
 module Ws_pool = Ws_pool
 
 module Private = struct

src/core/moonpool.mli

@@ -13,6 +13,7 @@ module Ws_pool = Ws_pool
 module Fifo_pool = Fifo_pool
 module Background_thread = Background_thread
 module Runner = Runner
+module Trigger = Trigger
 
 module Immediate_runner : sig end
 [@@deprecated "use Moonpool_fib.Main"]
@@ -78,7 +79,7 @@ module Lock = Lock
 module Fut = Fut
 module Chan = Chan
 module Task_local_storage = Task_local_storage
-module Thread_local_storage = Thread_local_storage_
+module Thread_local_storage = Thread_local_storage
 
 (** A simple blocking queue.
 

src/core/runner.ml

@@ -1,5 +1,4 @@
 open Types_
-module TLS = Thread_local_storage_
 
 type task = unit -> unit
 

src/core/runner.mli

@@ -73,7 +73,7 @@ module For_runner_implementors : sig
       {b NOTE}: the runner should support DLA and {!Suspend_} on OCaml 5.x,
       so that {!Fork_join} and other 5.x features work properly. *)
 
-  val k_cur_runner : t Thread_local_storage_.t
+  val k_cur_runner : t Thread_local_storage.t
   (** Key that should be used by each runner to store itself in TLS
       on every thread it controls, so that tasks running on these threads
       can access the runner. This is necessary for {!get_current_runner}

src/core/types_.ml

@@ -1,4 +1,4 @@
-module TLS = Thread_local_storage_
+module TLS = Thread_local_storage
 module Domain_pool_ = Moonpool_dpool
 
 type ls_value = ..

src/core/ws_pool.ml

@@ -1,7 +1,6 @@
 open Types_
 module WSQ = Ws_deque_
 module A = Atomic_
-module TLS = Thread_local_storage_
 include Runner
 
 let ( let@ ) = ( @@ )

src/private/dune

@@ -8,11 +8,6 @@
  (libraries
   threads
   either
-  (select
-   thread_local_storage_.ml
-   from
-   (thread-local-storage -> thread_local_storage_.stub.ml)
-   (-> thread_local_storage_.real.ml))
   (select
    tracing_.ml
    from

src/private/thread_local_storage_.mli

@@ -1,15 +0,0 @@
-(** Thread local storage *)
-
-type 'a t
-(** A TLS slot for values of type ['a]. This allows the storage of a
-    single value of type ['a] per thread. *)
-
-exception Not_set
-
-val create : unit -> 'a t
-
-val get_exn : 'a t -> 'a
-(** @raise Not_set if not present *)
-
-val get_opt : 'a t -> 'a option
-val set : 'a t -> 'a -> unit

src/private/thread_local_storage_.real.ml

@@ -1,122 +0,0 @@
-(* vendored from  https://github.com/c-cube/thread-local-storage *)
-
-module Atomic = Atomic_
-
-(* sanity check *)
-let () = assert (Obj.field (Obj.repr (Thread.self ())) 1 = Obj.repr ())
-
-type 'a t = int
-(** Unique index for this TLS slot. *)
-
-let tls_length index =
-  let ceil_pow_2_minus_1 (n : int) : int =
-    let n = n lor (n lsr 1) in
-    let n = n lor (n lsr 2) in
-    let n = n lor (n lsr 4) in
-    let n = n lor (n lsr 8) in
-    let n = n lor (n lsr 16) in
-    if Sys.int_size > 32 then
-      n lor (n lsr 32)
-    else
-      n
-  in
-  let size = ceil_pow_2_minus_1 (index + 1) in
-  assert (size > index);
-  size
-
-(** Counter used to allocate new keys *)
-let counter = Atomic.make 0
-
-(** Value used to detect a TLS slot that was not initialized yet.
-    Because [counter] is private and lives forever, no other
-    object the user can see will have the same address. *)
-let sentinel_value_for_uninit_tls : Obj.t = Obj.repr counter
-
-external max_wosize : unit -> int = "caml_sys_const_max_wosize"
-
-let max_word_size = max_wosize ()
-
-let create () : _ t =
-  let index = Atomic.fetch_and_add counter 1 in
-  if tls_length index <= max_word_size then
-    index
-  else (
-    (* Some platforms have a small max word size. *)
-    ignore (Atomic.fetch_and_add counter (-1));
-    failwith "Thread_local_storage.create: out of TLS slots"
-  )
-
-type thread_internal_state = {
-  _id: int;  (** Thread ID (here for padding reasons) *)
-  mutable tls: Obj.t;  (** Our data, stowed away in this unused field *)
-  _other: Obj.t;
-      (** Here to avoid lying to ocamlopt/flambda about the size of [Thread.t] *)
-}
-(** A partial representation of the internal type [Thread.t], allowing
-  us to access the second field (unused after the thread
-  has started) and stash TLS data in it. *)
-
-let[@inline] get_raw index : Obj.t =
-  let thread : thread_internal_state = Obj.magic (Thread.self ()) in
-  let tls = thread.tls in
-  if Obj.is_block tls && index < Array.length (Obj.obj tls : Obj.t array) then
-    Array.unsafe_get (Obj.obj tls : Obj.t array) index
-  else
-    sentinel_value_for_uninit_tls
-
-exception Not_set
-
-let[@inline] get_exn slot =
-  let v = get_raw slot in
-  if v != sentinel_value_for_uninit_tls then
-    Obj.obj v
-  else
-    raise_notrace Not_set
-
-let[@inline] get_opt slot =
-  let v = get_raw slot in
-  if v != sentinel_value_for_uninit_tls then
-    Some (Obj.obj v)
-  else
-    None
-
-(** Allocating and setting *)
-
-(** Grow the array so that [index] is valid. *)
-let grow (old : Obj.t array) (index : int) : Obj.t array =
-  let new_length = tls_length index in
-  let new_ = Array.make new_length sentinel_value_for_uninit_tls in
-  Array.blit old 0 new_ 0 (Array.length old);
-  new_
-
-let get_tls_with_capacity index : Obj.t array =
-  let thread : thread_internal_state = Obj.magic (Thread.self ()) in
-  let tls = thread.tls in
-  if Obj.is_int tls then (
-    let new_tls = grow [||] index in
-    thread.tls <- Obj.repr new_tls;
-    new_tls
-  ) else (
-    let tls = (Obj.obj tls : Obj.t array) in
-    if index < Array.length tls then
-      tls
-    else (
-      let new_tls = grow tls index in
-      thread.tls <- Obj.repr new_tls;
-      new_tls
-    )
-  )
-
-let[@inline] set slot value : unit =
-  let tls = get_tls_with_capacity slot in
-  Array.unsafe_set tls slot (Obj.repr (Sys.opaque_identity value))
-
-let[@inline] get_default ~default slot =
-  let v = get_raw slot in
-  if v != sentinel_value_for_uninit_tls then
-    Obj.obj v
-  else (
-    let v = default () in
-    set slot v;
-    v
-  )

src/private/thread_local_storage_.stub.ml

@@ -1,2 +0,0 @@
-(* just defer to library *)
-include Thread_local_storage