mirror of
https://github.com/c-cube/moonpool.git
synced 2025-12-11 13:38:38 -05:00
refactor: move functional queue into private, from chan
This commit is contained in:
parent
0750e6af41
commit
8c36b65786
4 changed files with 52 additions and 51 deletions
|
|
@ -1,59 +1,9 @@
|
||||||
module A = Atomic_
|
module A = Atomic_
|
||||||
|
module Q = Moonpool_private.Fqueue
|
||||||
|
|
||||||
type 'a or_error = 'a Fut.or_error
|
type 'a or_error = 'a Fut.or_error
|
||||||
type 'a waiter = 'a Fut.promise
|
type 'a waiter = 'a Fut.promise
|
||||||
|
|
||||||
let[@inline] list_is_empty_ = function
|
|
||||||
| [] -> true
|
|
||||||
| _ :: _ -> false
|
|
||||||
|
|
||||||
(** Simple functional queue *)
|
|
||||||
module Q : sig
|
|
||||||
type 'a t
|
|
||||||
|
|
||||||
val return : 'a -> 'a t
|
|
||||||
val is_empty : _ t -> bool
|
|
||||||
|
|
||||||
exception Empty
|
|
||||||
|
|
||||||
val pop_exn : 'a t -> 'a * 'a t
|
|
||||||
val push : 'a t -> 'a -> 'a t
|
|
||||||
val iter : ('a -> unit) -> 'a t -> unit
|
|
||||||
end = struct
|
|
||||||
type 'a t = {
|
|
||||||
hd: 'a list;
|
|
||||||
tl: 'a list;
|
|
||||||
}
|
|
||||||
(** Queue containing elements of type 'a.
|
|
||||||
|
|
||||||
invariant: if hd=[], then tl=[] *)
|
|
||||||
|
|
||||||
let[@inline] return x : _ t = { hd = [ x ]; tl = [] }
|
|
||||||
|
|
||||||
let[@inline] make_ hd tl =
|
|
||||||
match hd with
|
|
||||||
| [] -> { hd = List.rev tl; tl = [] }
|
|
||||||
| _ :: _ -> { hd; tl }
|
|
||||||
|
|
||||||
let[@inline] is_empty self = list_is_empty_ self.hd
|
|
||||||
let[@inline] push self x : _ t = make_ self.hd (x :: self.tl)
|
|
||||||
|
|
||||||
let iter f (self : _ t) : unit =
|
|
||||||
List.iter f self.hd;
|
|
||||||
List.iter f self.tl
|
|
||||||
|
|
||||||
exception Empty
|
|
||||||
|
|
||||||
let pop_exn self =
|
|
||||||
match self.hd with
|
|
||||||
| [] ->
|
|
||||||
assert (list_is_empty_ self.tl);
|
|
||||||
raise Empty
|
|
||||||
| x :: hd' ->
|
|
||||||
let self' = make_ hd' self.tl in
|
|
||||||
x, self'
|
|
||||||
end
|
|
||||||
|
|
||||||
exception Closed
|
exception Closed
|
||||||
|
|
||||||
type 'a state =
|
type 'a state =
|
||||||
|
|
|
||||||
|
|
@ -8,5 +8,6 @@ module Fiber = Fiber
|
||||||
module Fls = Fls
|
module Fls = Fls
|
||||||
module Handle = Handle
|
module Handle = Handle
|
||||||
module Main = Main
|
module Main = Main
|
||||||
|
module Coop_lock = Coop_lock
|
||||||
include Fiber
|
include Fiber
|
||||||
include Main
|
include Main
|
||||||
|
|
|
||||||
37
src/private/fqueue.ml
Normal file
37
src/private/fqueue.ml
Normal file
|
|
@ -0,0 +1,37 @@
|
||||||
|
type 'a t = {
|
||||||
|
hd: 'a list;
|
||||||
|
tl: 'a list;
|
||||||
|
}
|
||||||
|
(** Queue containing elements of type 'a.
|
||||||
|
|
||||||
|
invariant: if hd=[], then tl=[] *)
|
||||||
|
|
||||||
|
let[@inline] list_is_empty_ = function
|
||||||
|
| [] -> true
|
||||||
|
| _ :: _ -> false
|
||||||
|
|
||||||
|
let empty = { hd = []; tl = [] }
|
||||||
|
let[@inline] return x : _ t = { hd = [ x ]; tl = [] }
|
||||||
|
|
||||||
|
let[@inline] make_ hd tl =
|
||||||
|
match hd with
|
||||||
|
| [] -> { hd = List.rev tl; tl = [] }
|
||||||
|
| _ :: _ -> { hd; tl }
|
||||||
|
|
||||||
|
let[@inline] is_empty self = list_is_empty_ self.hd
|
||||||
|
let[@inline] push self x : _ t = make_ self.hd (x :: self.tl)
|
||||||
|
|
||||||
|
let iter f (self : _ t) : unit =
|
||||||
|
List.iter f self.hd;
|
||||||
|
List.iter f self.tl
|
||||||
|
|
||||||
|
exception Empty
|
||||||
|
|
||||||
|
let pop_exn self =
|
||||||
|
match self.hd with
|
||||||
|
| [] ->
|
||||||
|
assert (list_is_empty_ self.tl);
|
||||||
|
raise Empty
|
||||||
|
| x :: hd' ->
|
||||||
|
let self' = make_ hd' self.tl in
|
||||||
|
x, self'
|
||||||
13
src/private/fqueue.mli
Normal file
13
src/private/fqueue.mli
Normal file
|
|
@ -0,0 +1,13 @@
|
||||||
|
(** Simple functional queue *)
|
||||||
|
|
||||||
|
type +'a t
|
||||||
|
|
||||||
|
val empty : 'a t
|
||||||
|
val return : 'a -> 'a t
|
||||||
|
val is_empty : _ t -> bool
|
||||||
|
|
||||||
|
exception Empty
|
||||||
|
|
||||||
|
val pop_exn : 'a t -> 'a * 'a t
|
||||||
|
val push : 'a t -> 'a -> 'a t
|
||||||
|
val iter : ('a -> unit) -> 'a t -> unit
|
||||||
Loading…
Add table
Reference in a new issue