mirror of
https://github.com/c-cube/ocaml-containers.git
synced 2025-12-06 11:15:31 -05:00
functorize ring buffer over ARRAY sig
This commit is contained in:
carm
parent
07f0afcd28
commit
c7607f8ce7
2 changed files with 291 additions and 244 deletions
|
|
@ -22,17 +22,42 @@
|
|||
|
||||
(** Polymorphic Circular Buffer for IO *)
|
||||
|
||||
type 'a t = {
|
||||
module type ARRAY = sig
|
||||
type elt
|
||||
type t
|
||||
|
||||
val make: int -> elt -> t
|
||||
val length: t -> int
|
||||
|
||||
val get: t -> int -> elt
|
||||
|
||||
val set: t -> int -> elt -> unit
|
||||
|
||||
val sub: t -> int -> int -> t
|
||||
val max_length: int
|
||||
|
||||
val copy : t -> t
|
||||
val of_list : elt list -> t
|
||||
val to_list : t -> elt list
|
||||
val blit : t -> int -> t -> int -> int -> unit
|
||||
|
||||
val iter : (elt -> unit) -> t -> unit
|
||||
end
|
||||
|
||||
module Make(Array:ARRAY) =
|
||||
struct
|
||||
|
||||
type t = {
|
||||
mutable start : int;
|
||||
mutable stop : int; (* excluded *)
|
||||
mutable buf : 'a array;
|
||||
mutable buf : Array.t;
|
||||
bounded : bool;
|
||||
size : int
|
||||
}
|
||||
}
|
||||
|
||||
exception Empty
|
||||
exception Empty
|
||||
|
||||
let create ?(bounded=false) size =
|
||||
let create ?(bounded=false) size =
|
||||
{ start=0;
|
||||
stop=0;
|
||||
bounded;
|
||||
|
|
@ -40,21 +65,21 @@ let create ?(bounded=false) size =
|
|||
buf = Array.of_list []
|
||||
}
|
||||
|
||||
let copy b =
|
||||
let copy b =
|
||||
{ b with buf=Array.copy b.buf; }
|
||||
|
||||
|
||||
let capacity b = Array.length b.buf
|
||||
let capacity b = Array.length b.buf
|
||||
|
||||
let max_capacity b = if b.bounded then Some b.size else None
|
||||
let max_capacity b = if b.bounded then Some b.size else None
|
||||
|
||||
let length b =
|
||||
let length b =
|
||||
if b.stop >= b.start
|
||||
then b.stop - b.start
|
||||
else (Array.length b.buf - b.start) + b.stop
|
||||
|
||||
(* resize [b] so that inner capacity is [cap] *)
|
||||
let resize b cap elem =
|
||||
(* resize [b] so that inner capacity is [cap] *)
|
||||
let resize b cap elem =
|
||||
assert (cap >= Array.length b.buf);
|
||||
let buf' = Array.make cap elem in
|
||||
(* copy into buf' *)
|
||||
|
|
@ -72,7 +97,7 @@ let resize b cap elem =
|
|||
in
|
||||
b.buf <- buf'
|
||||
|
||||
let blit_from_bounded b from_buf o len =
|
||||
let blit_from_bounded b from_buf o len =
|
||||
let cap = capacity b - len in
|
||||
(* resize if needed, with a constant to amortize *)
|
||||
if cap < len then begin
|
||||
|
|
@ -94,7 +119,7 @@ let blit_from_bounded b from_buf o len =
|
|||
Array.iter iter sub
|
||||
|
||||
|
||||
let blit_from_unbounded b from_buf o len =
|
||||
let blit_from_unbounded b from_buf o len =
|
||||
let cap = capacity b - len in
|
||||
(* resize if needed, with a constant to amortize *)
|
||||
if cap < len then resize b (max b.size (Array.length b.buf + len + 24)) from_buf.(0);
|
||||
|
|
@ -116,14 +141,14 @@ let blit_from_unbounded b from_buf o len =
|
|||
end;
|
||||
()
|
||||
|
||||
let blit_from b from_buf o len =
|
||||
let blit_from b from_buf o len =
|
||||
if (Array.length from_buf) = 0 then () else
|
||||
if b.bounded then
|
||||
blit_from_bounded b from_buf o len
|
||||
else
|
||||
blit_from_unbounded b from_buf o len
|
||||
|
||||
let blit_into b to_buf o len =
|
||||
let blit_into b to_buf o len =
|
||||
if o+len > Array.length to_buf
|
||||
then raise (Invalid_argument "BufferIO.blit_into");
|
||||
if b.stop >= b.start
|
||||
|
|
@ -143,30 +168,30 @@ let blit_into b to_buf o len =
|
|||
end
|
||||
end
|
||||
|
||||
let add b s = blit_from b s 0 (Array.length s)
|
||||
let add b s = blit_from b s 0 (Array.length s)
|
||||
|
||||
(*$Q
|
||||
(*$Q
|
||||
(Q.pair Q.printable_string Q.printable_string) (fun (s,s') -> \
|
||||
let b = create 24 in add b s; add_string b s'; \
|
||||
Array.length s + String.length s' = length b)
|
||||
*)
|
||||
*)
|
||||
|
||||
let clear b =
|
||||
let clear b =
|
||||
b.stop <- 0;
|
||||
b.start <- 0;
|
||||
()
|
||||
|
||||
let reset b =
|
||||
let reset b =
|
||||
clear b;
|
||||
b.buf <- Array.of_list []
|
||||
|
||||
let is_empty b = b.start = b.stop
|
||||
let is_empty b = b.start = b.stop
|
||||
|
||||
let next b =
|
||||
let next b =
|
||||
if b.start = b.stop then raise Empty;
|
||||
b.buf.(b.start)
|
||||
|
||||
let take_front b =
|
||||
let take_front b =
|
||||
if b.start = b.stop then raise Empty;
|
||||
let c = b.buf.(b.start) in
|
||||
if b.start + 1 = Array.length b.buf
|
||||
|
|
@ -174,20 +199,20 @@ let take_front b =
|
|||
else b.start <- b.start + 1;
|
||||
c
|
||||
|
||||
let take_back b =
|
||||
let take_back b =
|
||||
if b.start = b.stop then raise Empty;
|
||||
if b.stop - 1 = 0
|
||||
then b.stop <- Array.length b.buf - 1
|
||||
else b.stop <- b.stop - 1;
|
||||
b.buf.(b.stop)
|
||||
|
||||
let junk b =
|
||||
let junk b =
|
||||
if b.start = b.stop then raise Empty;
|
||||
if b.start + 1 = Array.length b.buf
|
||||
then b.start <- 0
|
||||
else b.start <- b.start + 1
|
||||
|
||||
let skip b len =
|
||||
let skip b len =
|
||||
if len > length b then raise (Invalid_argument "BufferIO.skip");
|
||||
if b.stop >= b.start
|
||||
then b.start <- b.start + len
|
||||
|
|
@ -197,15 +222,15 @@ let skip b len =
|
|||
then b.start <- len-len_end (* wrap to the beginning *)
|
||||
else b.start <- b.start + len
|
||||
|
||||
(*$Q
|
||||
(*$Q
|
||||
(Q.pair Q.printable_string Q.printable_string) (fun (s,s') -> \
|
||||
let b = create 24 in add_string b s; add_string b s'; \
|
||||
add_string b "hello world"; (* big enough *) \
|
||||
let l = length b in let l' = l/2 in skip b l'; \
|
||||
length b + l' = l)
|
||||
*)
|
||||
*)
|
||||
|
||||
let iteri b f =
|
||||
let iteri b f =
|
||||
if b.stop >= b.start
|
||||
then for i = b.start to b.stop - 1 do f i b.buf.(i) done
|
||||
else (
|
||||
|
|
@ -213,13 +238,13 @@ let iteri b f =
|
|||
for i = 0 to b.stop - 1 do f i b.buf.(i) done;
|
||||
)
|
||||
|
||||
(*$T
|
||||
(*$T
|
||||
let s = "hello world" in \
|
||||
let b = of_string s in \
|
||||
try iteri b (fun i c -> if s.[i] <> c then raise Exit); true with Exit -> false
|
||||
*)
|
||||
*)
|
||||
|
||||
let get b i =
|
||||
let get b i =
|
||||
if b.stop >= b.start
|
||||
then
|
||||
if i >= b.stop - b.start
|
||||
|
|
@ -233,23 +258,19 @@ let get b i =
|
|||
then raise (Invalid_argument "BufferIO.get")
|
||||
else b.buf.(i - len_end)
|
||||
|
||||
let to_list b =
|
||||
let to_list b =
|
||||
if (b.stop >= b.start)
|
||||
then Array.to_list (Array.sub b.buf b.start (b.stop-b.start))
|
||||
else List.append
|
||||
(Array.to_list (Array.sub b.buf b.start (Array.length b.buf - b.start)))
|
||||
(Array.to_list (Array.sub b.buf 0 b.stop))
|
||||
|
||||
let push_back b e = add b (Array.of_list [e])
|
||||
let push_back b e = add b (Array.of_list [e])
|
||||
|
||||
let peek_front b = if is_empty b then
|
||||
let peek_front b = if is_empty b then
|
||||
raise Empty else Array.get b.buf b.start
|
||||
|
||||
let peek_back b = if is_empty b then
|
||||
let peek_back b = if is_empty b then
|
||||
raise Empty else Array.get b.buf
|
||||
(if b.stop = 0 then capacity b - 1 else b.stop-1)
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
end
|
||||
|
|
|
|||
|
|
@ -20,89 +20,115 @@
|
|||
|
||||
(** Circular Polymorphic Buffer for IO *)
|
||||
|
||||
type 'a t = private {
|
||||
module type ARRAY = sig
|
||||
type elt
|
||||
type t
|
||||
|
||||
val make: int -> elt -> t
|
||||
val length: t -> int
|
||||
|
||||
val get: t -> int -> elt
|
||||
|
||||
val set: t -> int -> elt -> unit
|
||||
|
||||
val sub: t -> int -> int -> t
|
||||
val max_length: int
|
||||
|
||||
val copy : t -> t
|
||||
val of_list : elt list -> t
|
||||
val to_list : t -> elt list
|
||||
val blit : t -> int -> t -> int -> int -> unit
|
||||
|
||||
val iter : (elt -> unit) -> t -> unit
|
||||
end
|
||||
|
||||
|
||||
module Make : functor (Array:ARRAY) ->
|
||||
sig
|
||||
|
||||
type t = private {
|
||||
mutable start : int;
|
||||
mutable stop : int; (* excluded *)
|
||||
mutable buf : 'a array;
|
||||
mutable buf : Array.t;
|
||||
bounded: bool;
|
||||
size : int
|
||||
}
|
||||
}
|
||||
|
||||
exception Empty
|
||||
exception Empty
|
||||
|
||||
val create : ?bounded:bool -> int -> 'a t
|
||||
(** [create ?bounded size] creates a new buffer with given size.
|
||||
val create : ?bounded:bool -> int -> t
|
||||
(** [create ?bounded size] creates a new buffer with given size.
|
||||
Defaults to [bounded=false]. *)
|
||||
|
||||
val copy : 'a t ->'a t
|
||||
(** fresh copy of the buffer *)
|
||||
val copy : t -> t
|
||||
(** fresh copy of the buffer *)
|
||||
|
||||
val capacity : 'a t -> int
|
||||
(** length of the inner buffer *)
|
||||
val capacity : t -> int
|
||||
(** length of the inner buffer *)
|
||||
|
||||
val max_capacity : 'a t -> int option
|
||||
(** maximum length of the inner buffer, or [None] if unbounded. *)
|
||||
val max_capacity : t -> int option
|
||||
(** maximum length of the inner buffer, or [None] if unbounded. *)
|
||||
|
||||
val length : 'a t -> int
|
||||
(** number of elements currently stored in the buffer *)
|
||||
val length : t -> int
|
||||
(** number of elements currently stored in the buffer *)
|
||||
|
||||
val blit_from : 'a t -> 'a array -> int -> int -> unit
|
||||
(** [blit_from buf from_buf o len] copies the slice [o, ... o + len - 1] from
|
||||
val blit_from : t -> Array.t -> int -> int -> unit
|
||||
(** [blit_from buf from_buf o len] copies the slice [o, ... o + len - 1] from
|
||||
a input buffer [from_buf] to the end of the buffer.
|
||||
@raise Invalid_argument if [o,len] is not a valid slice of [s] *)
|
||||
|
||||
val blit_into : 'a t -> 'a array -> int -> int -> int
|
||||
(** [blit_into buf to_buf o len] copies at most [len] elements from [buf]
|
||||
val blit_into : t -> Array.t -> int -> int -> int
|
||||
(** [blit_into buf to_buf o len] copies at most [len] elements from [buf]
|
||||
into [to_buf] starting at offset [o] in [s].
|
||||
@return the number of elements actually copied ([min len (length buf)]).
|
||||
@raise Invalid_argument if [o,len] is not a valid slice of [s] *)
|
||||
|
||||
val to_list : 'a t -> 'a list
|
||||
(** extract the current content into a list *)
|
||||
val to_list : t -> Array.elt list
|
||||
(** extract the current content into a list *)
|
||||
|
||||
val clear : 'a t -> unit
|
||||
(** clear the content of the buffer. Doesn't actually destroy the content. *)
|
||||
val clear : t -> unit
|
||||
(** clear the content of the buffer. Doesn't actually destroy the content. *)
|
||||
|
||||
val reset : 'a t -> unit
|
||||
(** clear the content of the buffer, and also resize it to a default size *)
|
||||
val reset : t -> unit
|
||||
(** clear the content of the buffer, and also resize it to a default size *)
|
||||
|
||||
val is_empty :'a t -> bool
|
||||
(** is the buffer empty (i.e. contains no elements)? *)
|
||||
val is_empty :t -> bool
|
||||
(** is the buffer empty (i.e. contains no elements)? *)
|
||||
|
||||
val next : 'a t -> 'a
|
||||
(** obtain next element (the first one of the buffer)
|
||||
val next : t -> Array.elt
|
||||
(** obtain next element (the first one of the buffer)
|
||||
@raise Empty if the buffer is empty *)
|
||||
|
||||
val junk : 'a t -> unit
|
||||
(** Drop next element.
|
||||
val junk : t -> unit
|
||||
(** Drop next element.
|
||||
@raise Empty if the buffer is already empty *)
|
||||
|
||||
val skip : 'a t -> int -> unit
|
||||
(** [skip b len] removes [len] elements from [b].
|
||||
val skip : t -> int -> unit
|
||||
(** [skip b len] removes [len] elements from [b].
|
||||
@raise Invalid_argument if [len > length b]. *)
|
||||
|
||||
val iteri : 'a t -> (int -> 'a -> unit) -> unit
|
||||
(** [iteri b f] calls [f i t] for each element [t] in [buf], with [i]
|
||||
val iteri : t -> (int -> Array.elt -> unit) -> unit
|
||||
(** [iteri b f] calls [f i t] for each element [t] in [buf], with [i]
|
||||
being its relative index within [buf]. *)
|
||||
|
||||
val get : 'a t -> int -> 'a
|
||||
(** [get buf i] returns the [i]-th element of [buf], ie the one that
|
||||
val get : t -> int -> Array.elt
|
||||
(** [get buf i] returns the [i]-th element of [buf], ie the one that
|
||||
is returned by [next buf] after [i-1] calls to [junk buf].
|
||||
@raise Invalid_argument if the index is invalid (> [length buf]) *)
|
||||
|
||||
val push_back : 'a t -> 'a -> unit
|
||||
val push_back : t -> Array.elt -> unit
|
||||
(** Push value at the back *)
|
||||
|
||||
val peek_front : 'a t -> 'a
|
||||
val peek_front : t -> Array.elt
|
||||
(** First value, or Empty *)
|
||||
|
||||
val peek_back : 'a t -> 'a
|
||||
val peek_back : t -> Array.elt
|
||||
(** Last value, or Empty *)
|
||||
|
||||
val take_back : 'a t -> 'a
|
||||
val take_back : t -> Array.elt
|
||||
(** Take last value, or raise Empty *)
|
||||
|
||||
val take_front : 'a t -> 'a
|
||||
val take_front : t -> Array.elt
|
||||
(** Take first value, or raise Empty *)
|
||||
|
||||
|
||||
end
|
||||
|
|
|
|||
Loading…
Add table
Reference in a new issue