mirror of
https://github.com/c-cube/tiny_httpd.git
synced 2025-12-06 11:15:35 -05:00
add Tiny_httpd_pool
This commit is contained in:
parent
3f3d3e3464
commit
5ba1ff0de4
4 changed files with 55 additions and 0 deletions
|
|
@ -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
|
||||||
|
|
|
||||||
|
|
@ -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
38
src/Tiny_httpd_pool.ml
Normal 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
12
src/Tiny_httpd_pool.mli
Normal 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. *)
|
||||||
Loading…
Add table
Reference in a new issue