more utils

src/util/cb_set.ml

@@ -0,0 +1,9 @@
+type cb = unit -> unit
+
+type t = { cbs: cb Alist.t } [@@unboxed]
+
+let create () : t = { cbs = Alist.make () }
+
+let[@inline] register self f = Alist.add self.cbs f
+
+let[@inline] trigger self = List.iter (fun f -> f ()) (Alist.get self.cbs)

src/util/cb_set.mli

@@ -0,0 +1,9 @@
+(** A collection of callbacks. thread-safe. *)
+
+type t
+
+val create : unit -> t
+
+val register : t -> (unit -> unit) -> unit
+
+val trigger : t -> unit

src/util/rpool.ml

@@ -1,59 +0,0 @@
-module A = Atomic
-
-type 'a list_ =
-  | Nil
-  | Cons of int * 'a * 'a list_
-
-type 'a t = {
-  mk_item: unit -> 'a;
-  clear: 'a -> unit;
-  max_size: int;  (** Max number of items *)
-  items: 'a list_ A.t;
-}
-
-let create ?(clear = ignore) ~mk_item ?(max_size = 512) () : _ t =
-  { mk_item; clear; max_size; items = A.make Nil }
-
-let rec acquire self =
-  match A.get self.items with
-  | Nil -> self.mk_item ()
-  | Cons (_, x, tl) as l ->
-    if A.compare_and_set self.items l tl then
-      x
-    else
-      acquire self
-
-let[@inline] size_ = function
-  | Cons (sz, _, _) -> sz
-  | Nil -> 0
-
-let release self x : unit =
-  let rec loop () =
-    match A.get self.items with
-    | Cons (sz, _, _) when sz >= self.max_size ->
-      (* forget the item *)
-      ()
-    | l ->
-      if not (A.compare_and_set self.items l (Cons (size_ l + 1, x, l))) then
-        loop ()
-  in
-
-  self.clear x;
-  loop ()
-
-let with_resource (self : _ t) f =
-  let x = acquire self in
-  try
-    let res = f x in
-    release self x;
-    res
-  with e ->
-    let bt = Printexc.get_raw_backtrace () in
-    release self x;
-    Printexc.raise_with_backtrace e bt
-
-module Raw = struct
-  let release = release
-
-  let acquire = acquire
-end

src/util/rpool.mli

@@ -1,27 +0,0 @@
-(** Simple resource pool.
-
-    This is intended for buffers, protobuf encoders, etc. *)
-
-type 'a t
-(** Pool of values of type ['a] *)
-
-val create :
-  ?clear:('a -> unit) -> mk_item:(unit -> 'a) -> ?max_size:int -> unit -> 'a t
-(** Create a new pool.
-    @param mk_item produce a new item in case the pool is empty
-    @param max_size
-      maximum number of item in the pool before we start dropping resources on
-      the floor. This controls resource consumption.
-    @param clear a function called on items before recycling them. *)
-
-val with_resource : 'a t -> ('a -> 'b) -> 'b
-(** [with_resource pool f] runs [f x] with [x] a resource; when [f] fails or
-    returns, [x] is returned to the pool for 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. *)
-module Raw : sig
-  val acquire : 'a t -> 'a
-
-  val release : 'a t -> 'a -> unit
-end