refactor: move optional hmap FLS stuff into core/task_local_storage

This commit is contained in:
Simon Cruanes 2024-08-30 09:42:18 -04:00
parent 328ecf4ea5
commit 7df8c069ed
No known key found for this signature in database
GPG key ID: EBFFF6F283F3A2B4
9 changed files with 20 additions and 18 deletions

View file

@ -4,6 +4,11 @@
(libraries
moonpool.private
(re_export thread-local-storage)
(select
hmap_ls_.ml
from
(hmap -> hmap_ls_.real.ml)
(-> hmap_ls_.dummy.ml))
moonpool.dpool
(re_export exn_bt)
(re_export picos))

View file

@ -1,4 +1,4 @@
open Moonpool.Private.Types_
open Types_
open struct
module FLS = Picos.Fiber.FLS
@ -36,7 +36,8 @@ let[@inline] set_in_local_hmap (k : 'a Hmap.key) (v : 'a) : unit =
(**/**)
module Private_hmap_fls_ = struct
(* private functions, to be used by the rest of moonpool *)
module Private_hmap_ls_ = struct
(** Copy the hmap from f1.fls to f2.fls *)
let copy_fls (f1 : Picos.Fiber.t) (f2 : Picos.Fiber.t) : unit =
match FLS.get_exn f1 k_local_hmap with

View file

@ -39,3 +39,5 @@ let with_value k v (f : _ -> 'b) : 'b =
PF.FLS.set fiber k v;
let finally () = PF.FLS.set fiber k old_v in
Fun.protect f ~finally
include Hmap_ls_

View file

@ -36,3 +36,11 @@ val with_value : 'a t -> 'a -> (unit -> 'b) -> 'b
(** [with_value k v f] sets [k] to [v] for the duration of the call
to [f()]. When [f()] returns (or fails), [k] is restored
to its old value. *)
(** {2 Local [Hmap.t]}
This requires [hmap] to be installed. *)
include module type of struct
include Hmap_ls_
end

View file

@ -4,12 +4,7 @@
(synopsis "Fibers and structured concurrency for Moonpool")
(libraries
moonpool
picos
(select
hmap_fls.ml
from
(hmap -> hmap_fls.real.ml)
(-> hmap_fls.dummy.ml)))
picos)
(enabled_if
(>= %{ocaml_version} 5.0))
(flags :standard -open Moonpool_private -open Moonpool)

View file

@ -259,7 +259,7 @@ let spawn_ ~parent ~runner (f : unit -> 'a) : 'a t =
(* copy local hmap from parent, if present *)
Option.iter
(fun (p : _ t) -> Hmap_fls.Private_hmap_fls_.copy_fls p.pfiber pfiber)
(fun (p : _ t) -> Fls.Private_hmap_ls_.copy_fls p.pfiber pfiber)
parent;
(match parent with

View file

@ -1,2 +1 @@
include Task_local_storage
include Hmap_fls

View file

@ -17,11 +17,3 @@
include module type of struct
include Task_local_storage
end
(** {2 Local [Hmap.t]}
This requires [hmap] to be installed. *)
include module type of struct
include Hmap_fls
end