feat pool: expose acquire/release

This commit is contained in:
Simon Cruanes 2025-04-15 09:44:46 -04:00
parent f6daff24c0
commit c55e3a2dfc
No known key found for this signature in database
GPG key ID: EBFFF6F283F3A2B4
2 changed files with 20 additions and 6 deletions

View file

@ -12,20 +12,20 @@ type 'a t = {
let create ?(clear = ignore) ~mk_item ?(max_size = 512) () : _ t = let create ?(clear = ignore) ~mk_item ?(max_size = 512) () : _ t =
{ mk_item; clear; max_size; items = A.make Nil } { mk_item; clear; max_size; items = A.make Nil }
let rec acquire_ self = let rec acquire self =
match A.get self.items with match A.get self.items with
| Nil -> self.mk_item () | Nil -> self.mk_item ()
| Cons (_, x, tl) as l -> | Cons (_, x, tl) as l ->
if A.compare_and_set self.items l tl then if A.compare_and_set self.items l tl then
x x
else else
acquire_ self acquire self
let[@inline] size_ = function let[@inline] size_ = function
| Cons (sz, _, _) -> sz | Cons (sz, _, _) -> sz
| Nil -> 0 | Nil -> 0
let release_ self x : unit = let release self x : unit =
let rec loop () = let rec loop () =
match A.get self.items with match A.get self.items with
| Cons (sz, _, _) when sz >= self.max_size -> | Cons (sz, _, _) when sz >= self.max_size ->
@ -40,12 +40,17 @@ let release_ self x : unit =
loop () loop ()
let with_resource (self : _ t) f = let with_resource (self : _ t) f =
let x = acquire_ self in let x = acquire self in
try try
let res = f x in let res = f x in
release_ self x; release self x;
res res
with e -> with e ->
let bt = Printexc.get_raw_backtrace () in let bt = Printexc.get_raw_backtrace () in
release_ self x; release self x;
Printexc.raise_with_backtrace e bt Printexc.raise_with_backtrace e bt
module Raw = struct
let release = release
let acquire = acquire
end

View file

@ -23,3 +23,12 @@ val with_resource : 'a t -> ('a -> 'b) -> 'b
(** [with_resource pool f] runs [f x] with [x] a resource; (** [with_resource pool f] runs [f x] with [x] a resource;
when [f] fails or returns, [x] is returned to the pool for when [f] fails or returns, [x] is returned to the pool for
future reuse. *) future reuse. *)
(** Low level control over the pool.
This is easier to get wrong (e.g. releasing the same resource twice)
so use with caution.
@since NEXT_RELEASE *)
module Raw : sig
val acquire : 'a t -> 'a
val release : 'a t -> 'a -> unit
end