diff --git a/src/client/rpool.ml b/src/client/rpool.ml deleted file mode 100644 index 833ccaef..00000000 --- a/src/client/rpool.ml +++ /dev/null @@ -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 diff --git a/src/client/rpool.mli b/src/client/rpool.mli deleted file mode 100644 index 4a80e115..00000000 --- a/src/client/rpool.mli +++ /dev/null @@ -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