simon/moonpool
1
0
Fork 0
mirror of https://github.com/c-cube/moonpool.git synced 2025-12-05 19:00:33 -05:00
Code Issues Projects Releases Packages Wiki Activity Actions

feat local-storage: expose get/set with explicit storage

Browse source
This commit is contained in:
Simon Cruanes 2024-03-01 18:07:30 -05:00
parent 4325fda345
commit 953947f694
2 changed files with 12 additions and 2 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

10
src/core/task_local_storage.ml
View file

@ -55,12 +55,15 @@ let[@inline] get_opt key =
| None -> None
| Some cur -> Some (get_from_ cur key)
let set (type a) ((module K) : a key) (v : a) : unit =
let cur = get_cur_ () in
let set_into_ (type a) cur ((module K) : a key) (v : a) : unit =
if K.offset >= Array.length !cur then resize_ cur (K.offset + 1);
!cur.(K.offset) <- K.V v;
()
let[@inline] set key v : unit =
let cur = get_cur_ () in
set_into_ cur key v
let with_value key x f =
let old = get key in
set key x;
@ -72,7 +75,10 @@ module Private_ = struct
let k_storage = k_ls_values
let[@inline] create () = [||]
let[@inline] get_cur_opt () = TLS.get k_storage
let copy = Array.copy
let get = get_from_
let set = set_into_
let[@inline] copy_of_current () = copy @@ !(get_cur_ ())
let dummy = [||]
end

4
src/core/task_local_storage.mli
View file

@ -51,11 +51,15 @@ val with_value : 'a key -> 'a -> (unit -> 'b) -> 'b
(**/**)
(** Private API *)
module Private_ : sig
module Storage : sig
type t = storage
val get : t ref -> 'a key -> 'a
val set : t ref -> 'a key -> 'a -> unit
val k_storage : t ref option Thread_local_storage_.key
val get_cur_opt : unit -> t ref option
val create : unit -> t
val copy : t -> t
val copy_of_current : unit -> t