add Tiny_httpd_pool

This commit is contained in:
Simon Cruanes 2023-06-05 22:18:13 -04:00
parent 3f3d3e3464
commit 5ba1ff0de4
4 changed files with 55 additions and 0 deletions

View file

@ -5,3 +5,4 @@ module Util = Tiny_httpd_util
module Dir = Tiny_httpd_dir module Dir = Tiny_httpd_dir
module Html = Tiny_httpd_html module Html = Tiny_httpd_html
module IO = Tiny_httpd_io module IO = Tiny_httpd_io
module Pool = Pool

View file

@ -100,6 +100,10 @@ end
module Util = Tiny_httpd_util module Util = Tiny_httpd_util
(** {2 Resource pool} *)
module Pool = Pool
(** {2 Static directory serving} *) (** {2 Static directory serving} *)
module Dir = Tiny_httpd_dir module Dir = Tiny_httpd_dir

38
src/Tiny_httpd_pool.ml Normal file
View file

@ -0,0 +1,38 @@
module A = Tiny_httpd_atomic_
type 'a list_ = Nil | Cons of int * 'a * 'a list_
type 'a t = {
mk_item: unit -> 'a;
max_size: int; (** Max number of items *)
items: 'a list_ A.t;
}
let create ~mk_item ?(max_size = 128) () : _ t =
{ mk_item; 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 rec release_ self x : unit =
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
release_ self x
let with_resource (self : _ t) f =
let x = acquire_ self in
Fun.protect ~finally:(fun () -> release_ self x) (fun () -> f x)

12
src/Tiny_httpd_pool.mli Normal file
View file

@ -0,0 +1,12 @@
(** Resource pool *)
type 'a t
(** Pool of values of type ['a] *)
val create : mk_item:(unit -> 'a) -> ?max_size:int -> unit -> 'a t
(** Create a new pool. *)
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. *)