mirror of
https://github.com/c-cube/ocaml-containers.git
synced 2025-12-06 03:05:28 -05:00
change a bit the interface of CCRingBuffer, indentation, names
This commit is contained in:
Simon Cruanes
parent
60159bdd75
commit
050514a326
2 changed files with 311 additions and 341 deletions
|
|
@ -23,83 +23,51 @@
|
|||
(** Polymorphic Circular Buffer for IO *)
|
||||
|
||||
module Array = struct
|
||||
|
||||
(** The abstract type for arrays *)
|
||||
module type S = sig
|
||||
(** The element type *)
|
||||
type elt
|
||||
|
||||
(** The type of an array instance *)
|
||||
type t
|
||||
|
||||
val empty : t
|
||||
(** The empty array *)
|
||||
|
||||
val make: int -> elt -> t
|
||||
(** [make s e] makes an array of size [s] with [e] elements *)
|
||||
|
||||
val length: t -> int
|
||||
(** [length t] gets the total number of elements currently in [t] *)
|
||||
|
||||
val get: t -> int -> elt
|
||||
(** [get t i] gets the element at position [i] *)
|
||||
|
||||
val set: t -> int -> elt -> unit
|
||||
(** [set t i e] sets the element at position [i] to [e] *)
|
||||
|
||||
val sub: t -> int -> int -> t
|
||||
(** [sub t i len] gets the subarray of [t] from
|
||||
position [i] to [i + len] *)
|
||||
|
||||
val copy : t -> t
|
||||
(** [copy t] makes a fresh copy of the array [t] *)
|
||||
|
||||
val blit : t -> int -> t -> int -> int -> unit
|
||||
(** [blit t s arr i len] copies [len] elements from [arr] starting at [i]
|
||||
to position [s] from [t] *)
|
||||
|
||||
val iter : (elt -> unit) -> t -> unit
|
||||
(** [iter f t] iterates over the array [t] invoking [f] with
|
||||
the current element, in array order *)
|
||||
end
|
||||
|
||||
module ByteArray :
|
||||
module Byte :
|
||||
S with type elt = char and type t = bytes = struct
|
||||
type elt = char
|
||||
include Bytes
|
||||
end
|
||||
|
||||
module FloatArray :
|
||||
S with type elt = float and type t = float array = struct
|
||||
type t = float array
|
||||
type elt = float
|
||||
let make = Array.make
|
||||
let length = Array.length
|
||||
let get = Array.get
|
||||
let set = Array.set
|
||||
let copy = Array.copy
|
||||
let blit = Array.blit
|
||||
let iter = Array.iter
|
||||
let sub = Array.sub
|
||||
let empty = Array.of_list []
|
||||
end
|
||||
|
||||
module IntArray :
|
||||
S with type elt = int and type t = int array = struct
|
||||
type t = int array
|
||||
type elt = int
|
||||
let make = Array.make
|
||||
let length = Array.length
|
||||
let get = Array.get
|
||||
let set = Array.set
|
||||
let copy = Array.copy
|
||||
let blit = Array.blit
|
||||
let iter = Array.iter
|
||||
let sub = Array.sub
|
||||
let empty = Array.of_list []
|
||||
end
|
||||
|
||||
|
||||
module BoolArray :
|
||||
S with type elt = bool and type t = bool array = struct
|
||||
type t = bool array
|
||||
type elt = bool
|
||||
let make = Array.make
|
||||
let length = Array.length
|
||||
let get = Array.get
|
||||
let set = Array.set
|
||||
let copy = Array.copy
|
||||
let blit = Array.blit
|
||||
let iter = Array.iter
|
||||
let sub = Array.sub
|
||||
let empty = Array.of_list []
|
||||
end
|
||||
|
||||
|
||||
module Make(Elt:sig type t end) :
|
||||
S with type elt = Elt.t and type t = Elt.t array = struct
|
||||
type elt = Elt.t
|
||||
|
|
@ -114,73 +82,115 @@ module Array = struct
|
|||
let sub = Array.sub
|
||||
let empty = Array.of_list []
|
||||
end
|
||||
|
||||
end
|
||||
|
||||
module type S =
|
||||
sig
|
||||
|
||||
module type S = sig
|
||||
(** The module type of Array for this ring buffer *)
|
||||
module Array : Array.S
|
||||
|
||||
type t = private {
|
||||
mutable start : int;
|
||||
mutable stop : int; (* excluded *)
|
||||
mutable buf : Array.t;
|
||||
bounded: bool;
|
||||
size : int
|
||||
}
|
||||
(** Defines the ring buffer type, with both bounded and
|
||||
unbounded flavors *)
|
||||
type t
|
||||
|
||||
(** Raised in querying functions when the buffer is empty *)
|
||||
exception Empty
|
||||
|
||||
val create : ?bounded:bool -> int -> t
|
||||
(** [create ?bounded size] creates a new buffer with given size.
|
||||
Defaults to [bounded=false]. *)
|
||||
|
||||
val copy : t -> t
|
||||
(** Make a fresh copy of the buffer. *)
|
||||
|
||||
val capacity : t -> int
|
||||
(** Length of the inner buffer. *)
|
||||
|
||||
val max_capacity : t -> int option
|
||||
(** Maximum length of the inner buffer, or [None] if unbounded. *)
|
||||
|
||||
val length : t -> int
|
||||
(** Number of elements currently stored in the buffer. *)
|
||||
|
||||
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 : 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 : t -> Array.elt list
|
||||
(** Extract the current content into a list *)
|
||||
|
||||
val clear : t -> unit
|
||||
(** Clear the content of the buffer. Doesn't actually destroy the content. *)
|
||||
|
||||
val reset : t -> unit
|
||||
(** Clear the content of the buffer, and also resize it to a default size *)
|
||||
|
||||
val is_empty :t -> bool
|
||||
(** Is the buffer empty (i.e. contains no elements)? *)
|
||||
|
||||
val junk_front : t -> unit
|
||||
(** Drop the front element from [t].
|
||||
@raise Empty if the buffer is already empty. *)
|
||||
|
||||
val junk_back : t -> unit
|
||||
(** Drop the back element from [t].
|
||||
@raise Empty if the buffer is already empty. *)
|
||||
|
||||
val skip : t -> int -> unit
|
||||
(** [skip b len] removes [len] elements from the front of [b].
|
||||
@raise Invalid_argument if [len > length b]. *)
|
||||
|
||||
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_front : t -> int -> Array.elt
|
||||
(** [get_front buf i] returns the [i]-th element of [buf] from the front, ie
|
||||
the one returned by [take_front buf] after [i-1] calls to [junk_front buf].
|
||||
@raise Invalid_argument if the index is invalid (> [length buf]) *)
|
||||
|
||||
val get_back : t -> int -> Array.elt
|
||||
(** [get_back buf i] returns the [i]-th element of [buf] from the back, ie
|
||||
the one returned by [take_back buf] after [i-1] calls to [junk_back buf].
|
||||
@raise Invalid_argument if the index is invalid (> [length buf]) *)
|
||||
|
||||
val push_back : t -> Array.elt -> unit
|
||||
(** Push value at the back of [t].
|
||||
If [t.bounded=false], the buffer will grow as needed,
|
||||
otherwise the oldest elements are replaced first. *)
|
||||
|
||||
val peek_front : t -> Array.elt
|
||||
(** First value from front of [t].
|
||||
@raise Empty if buffer is empty. *)
|
||||
|
||||
val peek_back : t -> Array.elt
|
||||
(** Get the last value from back of [t].
|
||||
@raise Empty if buffer is empty. *)
|
||||
|
||||
val take_back : t -> Array.elt
|
||||
val take_back : t -> Array.elt option
|
||||
(** Take the last value from back of [t], if any *)
|
||||
|
||||
val take_front : t -> Array.elt
|
||||
val take_back_exn : t -> Array.elt
|
||||
(** Take the last value from back of [t].
|
||||
@raise Empty if buffer is already empty. *)
|
||||
|
||||
val take_front : t -> Array.elt option
|
||||
(** Take the first value from front of [t], if any *)
|
||||
|
||||
val take_front_exn : t -> Array.elt
|
||||
(** Take the first value from front of [t].
|
||||
@raise Empty if buffer is already empty. *)
|
||||
end
|
||||
|
||||
module Make_array(Array:Array.S) =
|
||||
struct
|
||||
|
||||
module MakeFromArray(Array:Array.S) = struct
|
||||
module Array = Array
|
||||
|
||||
type t = {
|
||||
mutable start : int;
|
||||
mutable stop : int; (* excluded *)
|
||||
|
|
@ -199,32 +209,16 @@ struct
|
|||
buf = Array.empty
|
||||
}
|
||||
|
||||
(*$Q
|
||||
Q.small_int (fun i -> \
|
||||
let i = abs i in \
|
||||
let b = ByteBuffer.create i in \
|
||||
let open ByteBuffer in \
|
||||
b.size = i && b.bounded = false)
|
||||
*)
|
||||
|
||||
(*$Q
|
||||
Q.small_int (fun i -> \
|
||||
let i = abs i in \
|
||||
let b = ByteBuffer.create ~bounded:true i in \
|
||||
let open ByteBuffer in \
|
||||
b.size = i && b.bounded = true)
|
||||
*)
|
||||
|
||||
let copy b =
|
||||
{ b with buf=Array.copy b.buf; }
|
||||
|
||||
(*$Q
|
||||
Q.printable_string (fun s -> \
|
||||
let s_len = Bytes.length s in \
|
||||
let b = ByteBuffer.create s_len in \
|
||||
ByteBuffer.blit_from b s 0 s_len; \
|
||||
let b' = ByteBuffer.copy b in \
|
||||
try ByteBuffer.iteri b (fun i c -> if ByteBuffer.get_front b' i <> c then raise Exit); true with Exit -> false)
|
||||
let b = Byte.create s_len in \
|
||||
Byte.blit_from b s 0 s_len; \
|
||||
let b' = Byte.copy b in \
|
||||
try Byte.iteri b (fun i c -> if Byte.get_front b' i <> c then raise Exit); true with Exit -> false)
|
||||
*)
|
||||
|
||||
let capacity b =
|
||||
|
|
@ -234,18 +228,18 @@ struct
|
|||
(*$Q
|
||||
Q.printable_string (fun s -> \
|
||||
let s_len = Bytes.length s in \
|
||||
let b = ByteBuffer.create s_len in \
|
||||
ByteBuffer.blit_from b s 0 s_len; \
|
||||
ByteBuffer.capacity b >= Bytes.length s)
|
||||
let b = Byte.create s_len in \
|
||||
Byte.blit_from b s 0 s_len; \
|
||||
Byte.capacity b >= s_len)
|
||||
*)
|
||||
|
||||
(*$Q
|
||||
(Q.pair Q.small_int Q.printable_string) (fun (i, s) -> \
|
||||
let i = abs i in \
|
||||
let s_len = Bytes.length s in \
|
||||
let b = ByteBuffer.create ~bounded:true i in \
|
||||
ByteBuffer.blit_from b s 0 s_len; \
|
||||
ByteBuffer.capacity b <= i)
|
||||
let b = Byte.create ~bounded:true i in \
|
||||
Byte.blit_from b s 0 s_len; \
|
||||
Byte.capacity b <= i)
|
||||
*)
|
||||
|
||||
let max_capacity b = if b.bounded then Some b.size else None
|
||||
|
|
@ -253,15 +247,15 @@ struct
|
|||
(*$Q
|
||||
Q.small_int (fun i -> \
|
||||
let i = abs i in \
|
||||
let b = ByteBuffer.create i in \
|
||||
ByteBuffer.max_capacity b = None)
|
||||
let b = Byte.create i in \
|
||||
Byte.max_capacity b = None)
|
||||
*)
|
||||
|
||||
(*$Q
|
||||
Q.small_int (fun i -> \
|
||||
let i = abs i in \
|
||||
let b = ByteBuffer.create ~bounded:true i in \
|
||||
ByteBuffer.max_capacity b = Some i)
|
||||
let b = Byte.create ~bounded:true i in \
|
||||
Byte.max_capacity b = Some i)
|
||||
*)
|
||||
|
||||
let length b =
|
||||
|
|
@ -273,18 +267,18 @@ struct
|
|||
(Q.pair Q.small_int Q.printable_string) (fun (i, s) -> \
|
||||
let i = abs i in \
|
||||
let s_len = Bytes.length s in \
|
||||
let b = ByteBuffer.create i in \
|
||||
ByteBuffer.blit_from b s 0 s_len; \
|
||||
ByteBuffer.length b = s_len)
|
||||
let b = Byte.create i in \
|
||||
Byte.blit_from b s 0 s_len; \
|
||||
Byte.length b = s_len)
|
||||
*)
|
||||
|
||||
(*$Q
|
||||
(Q.pair Q.small_int Q.printable_string) (fun (i, s) -> \
|
||||
let i = abs i in \
|
||||
let s_len = Bytes.length s in \
|
||||
let b = ByteBuffer.create ~bounded:true i in \
|
||||
ByteBuffer.blit_from b s 0 s_len; \
|
||||
ByteBuffer.length b >= 0 && ByteBuffer.length b <= i)
|
||||
let b = Byte.create ~bounded:true i in \
|
||||
Byte.blit_from b s 0 s_len; \
|
||||
Byte.length b >= 0 && Byte.length b <= i)
|
||||
*)
|
||||
|
||||
(* resize [b] so that inner capacity is [cap] *)
|
||||
|
|
@ -309,27 +303,21 @@ struct
|
|||
let blit_from_bounded b from_buf o len =
|
||||
let cap = capacity b - length b in
|
||||
(* resize if needed, with a constant to amortize *)
|
||||
if cap < len then begin
|
||||
if cap < len then (
|
||||
let new_size =
|
||||
let desired = Array.length b.buf + len + 24 in
|
||||
min (b.size+1) desired in
|
||||
resize b new_size from_buf.(0);
|
||||
let good = capacity b = b.size || capacity b - length b >= len in
|
||||
if not good then begin
|
||||
print_endline ("capacity " ^ string_of_int (capacity b) ^ " and length " ^
|
||||
string_of_int (length b) ^ " difference is less than " ^
|
||||
string_of_int len ^ "!");assert(false)
|
||||
end;
|
||||
end;
|
||||
assert good;
|
||||
);
|
||||
let sub = Array.sub from_buf o len in
|
||||
let iter x =
|
||||
let capacity = Array.length b.buf in
|
||||
Array.set b.buf b.stop x;
|
||||
if b.stop = capacity-1 then b.stop <- 0 else b.stop <- b.stop + 1;
|
||||
if b.start = b.stop then
|
||||
begin
|
||||
if b.start = capacity-1 then b.start <- 0 else b.start <- b.start + 1
|
||||
end
|
||||
in
|
||||
Array.iter iter sub
|
||||
|
||||
|
|
@ -339,11 +327,7 @@ struct
|
|||
(* resize if needed, with a constant to amortize *)
|
||||
if cap < len then resize b (max (b.size+1) (Array.length b.buf + len + 24)) from_buf.(0);
|
||||
let good = capacity b - length b >= len in
|
||||
if not good then begin
|
||||
print_endline ("capacity " ^ string_of_int (capacity b) ^ " and length " ^
|
||||
string_of_int (length b) ^ " difference is less than " ^
|
||||
string_of_int len ^ "!");assert(false)
|
||||
end;
|
||||
assert good;
|
||||
if b.stop >= b.start
|
||||
then (* [_______ start xxxxxxxxx stop ______] *)
|
||||
let len_end = Array.length b.buf - b.stop in
|
||||
|
|
@ -370,25 +354,25 @@ struct
|
|||
|
||||
(*$Q
|
||||
(Q.pair Q.printable_string Q.printable_string) (fun (s,s') -> \
|
||||
(let b = ByteBuffer.create 24 in \
|
||||
ByteBuffer.blit_from b s 0 (Bytes.length s); \
|
||||
ByteBuffer.blit_from b s' 0 (Bytes.length s'); \
|
||||
ByteBuffer.length b = Bytes.length s + Bytes.length s'))
|
||||
(let b = Byte.create 24 in \
|
||||
Byte.blit_from b s 0 (Bytes.length s); \
|
||||
Byte.blit_from b s' 0 (Bytes.length s'); \
|
||||
Byte.length b = Bytes.length s + Bytes.length s'))
|
||||
*)
|
||||
|
||||
|
||||
(*$Q
|
||||
(Q.pair Q.printable_string Q.printable_string) (fun (s,s') -> \
|
||||
(let b = ByteBuffer.create ~bounded:true (Bytes.length s + Bytes.length s') in \
|
||||
ByteBuffer.blit_from b s 0 (Bytes.length s); \
|
||||
ByteBuffer.blit_from b s' 0 (Bytes.length s'); \
|
||||
ByteBuffer.length b = Bytes.length s + Bytes.length s'))
|
||||
(let b = Byte.create ~bounded:true (Bytes.length s + Bytes.length s') in \
|
||||
Byte.blit_from b s 0 (Bytes.length s); \
|
||||
Byte.blit_from b s' 0 (Bytes.length s'); \
|
||||
Byte.length b = Bytes.length s + Bytes.length s'))
|
||||
*)
|
||||
|
||||
|
||||
let blit_into b to_buf o len =
|
||||
if o+len > Array.length to_buf
|
||||
then raise (Invalid_argument "BufferIO.blit_into");
|
||||
then invalid_arg "RingBuffer.blit_into";
|
||||
if b.stop >= b.start
|
||||
then
|
||||
let n = min (b.stop - b.start) len in
|
||||
|
|
@ -408,10 +392,10 @@ struct
|
|||
|
||||
(*$Q
|
||||
Q.printable_string (fun s -> \
|
||||
let b = ByteBuffer.create (Bytes.length s) in \
|
||||
ByteBuffer.blit_from b s 0 (Bytes.length s); \
|
||||
let b = Byte.create (Bytes.length s) in \
|
||||
Byte.blit_from b s 0 (Bytes.length s); \
|
||||
let to_buf = Bytes.create (Bytes.length s) in \
|
||||
let len = ByteBuffer.blit_into b to_buf 0 (Bytes.length s) in \
|
||||
let len = Byte.blit_into b to_buf 0 (Bytes.length s) in \
|
||||
to_buf = s && len = Bytes.length s)
|
||||
*)
|
||||
|
||||
|
|
@ -424,10 +408,10 @@ struct
|
|||
(*$Q
|
||||
Q.printable_string (fun s -> \
|
||||
let s_len = Bytes.length s in \
|
||||
let b = ByteBuffer.create s_len in \
|
||||
ByteBuffer.blit_from b s 0 s_len; \
|
||||
ByteBuffer.clear b; \
|
||||
ByteBuffer.length b = 0)
|
||||
let b = Byte.create s_len in \
|
||||
Byte.blit_from b s 0 s_len; \
|
||||
Byte.clear b; \
|
||||
Byte.length b = 0)
|
||||
*)
|
||||
|
||||
|
||||
|
|
@ -438,10 +422,10 @@ struct
|
|||
(*$Q
|
||||
Q.printable_string (fun s -> \
|
||||
let s_len = Bytes.length s in \
|
||||
let b = ByteBuffer.create s_len in \
|
||||
ByteBuffer.blit_from b s 0 s_len; \
|
||||
ByteBuffer.reset b; \
|
||||
ByteBuffer.length b = 0 && ByteBuffer.capacity b = 0)
|
||||
let b = Byte.create s_len in \
|
||||
Byte.blit_from b s 0 s_len; \
|
||||
Byte.reset b; \
|
||||
Byte.length b = 0 && Byte.capacity b = 0)
|
||||
*)
|
||||
|
||||
|
||||
|
|
@ -450,14 +434,13 @@ struct
|
|||
(*$Q
|
||||
Q.printable_string (fun s -> \
|
||||
let s_len = Bytes.length s in \
|
||||
let b = ByteBuffer.create s_len in \
|
||||
ByteBuffer.blit_from b s 0 s_len; \
|
||||
ByteBuffer.skip b s_len; \
|
||||
ByteBuffer.is_empty b)
|
||||
let b = Byte.create s_len in \
|
||||
Byte.blit_from b s 0 s_len; \
|
||||
Byte.skip b s_len; \
|
||||
Byte.is_empty b)
|
||||
*)
|
||||
|
||||
|
||||
let take_front b =
|
||||
let take_front_exn b =
|
||||
if b.start = b.stop then raise Empty;
|
||||
let c = b.buf.(b.start) in
|
||||
if b.start + 1 = Array.length b.buf
|
||||
|
|
@ -465,29 +448,33 @@ struct
|
|||
else b.start <- b.start + 1;
|
||||
c
|
||||
|
||||
let take_front b = try Some (take_front_exn b) with Empty -> None
|
||||
|
||||
(*$Q
|
||||
Q.printable_string (fun s -> \
|
||||
let s_len = Bytes.length s in \
|
||||
let b = ByteBuffer.create s_len in \
|
||||
ByteBuffer.blit_from b s 0 s_len; \
|
||||
try let front = ByteBuffer.take_front b in \
|
||||
front = Bytes.get s 0 with ByteBuffer.Empty -> s_len = 0)
|
||||
let b = Byte.create s_len in \
|
||||
Byte.blit_from b s 0 s_len; \
|
||||
try let front = Byte.take_front_exn b in \
|
||||
front = Bytes.get s 0 with Byte.Empty -> s_len = 0)
|
||||
*)
|
||||
|
||||
let take_back b =
|
||||
let take_back_exn 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 take_back b = try Some (take_back_exn b) with Empty -> None
|
||||
|
||||
(*$Q
|
||||
Q.printable_string (fun s -> \
|
||||
let s_len = Bytes.length s in \
|
||||
let b = ByteBuffer.create s_len in \
|
||||
ByteBuffer.blit_from b s 0 s_len; \
|
||||
try let back = ByteBuffer.take_back b in \
|
||||
back = Bytes.get s (Bytes.length s - 1) with ByteBuffer.Empty -> s_len = 0)
|
||||
let b = Byte.create s_len in \
|
||||
Byte.blit_from b s 0 s_len; \
|
||||
try let back = Byte.take_back_exn b in \
|
||||
back = Bytes.get s (Bytes.length s - 1) with Byte.Empty -> s_len = 0)
|
||||
*)
|
||||
|
||||
let junk_front b =
|
||||
|
|
@ -499,10 +486,10 @@ struct
|
|||
(*$Q
|
||||
Q.printable_string (fun s -> \
|
||||
let s_len = Bytes.length s in \
|
||||
let b = ByteBuffer.create s_len in \
|
||||
ByteBuffer.blit_from b s 0 s_len; \
|
||||
try let () = ByteBuffer.junk_front b in \
|
||||
s_len - 1 = ByteBuffer.length b with ByteBuffer.Empty -> s_len = 0)
|
||||
let b = Byte.create s_len in \
|
||||
Byte.blit_from b s 0 s_len; \
|
||||
try let () = Byte.junk_front b in \
|
||||
s_len - 1 = Byte.length b with Byte.Empty -> s_len = 0)
|
||||
*)
|
||||
|
||||
let junk_back b =
|
||||
|
|
@ -514,15 +501,15 @@ struct
|
|||
(*$Q
|
||||
Q.printable_string (fun s -> \
|
||||
let s_len = Bytes.length s in \
|
||||
let b = ByteBuffer.create s_len in \
|
||||
ByteBuffer.blit_from b s 0 s_len; \
|
||||
try let () = ByteBuffer.junk_back b in \
|
||||
s_len - 1 = ByteBuffer.length b with ByteBuffer.Empty -> s_len = 0)
|
||||
let b = Byte.create s_len in \
|
||||
Byte.blit_from b s 0 s_len; \
|
||||
try let () = Byte.junk_back b in \
|
||||
s_len - 1 = Byte.length b with Byte.Empty -> s_len = 0)
|
||||
*)
|
||||
|
||||
let skip b len =
|
||||
if len > length b then raise (Invalid_argument
|
||||
("CCRingBufferIO.skip: " ^ string_of_int len));
|
||||
if len > length b then
|
||||
invalid_arg ("CCRingRingBuffer.skip: " ^ string_of_int len);
|
||||
if b.stop >= b.start
|
||||
then b.start <- b.start + len
|
||||
else
|
||||
|
|
@ -533,12 +520,12 @@ struct
|
|||
|
||||
(*$Q
|
||||
(Q.pair Q.printable_string Q.printable_string) (fun (s,s') -> \
|
||||
(let b = ByteBuffer.create 24 in \
|
||||
ByteBuffer.blit_from b s 0 (Bytes.length s); \
|
||||
ByteBuffer.blit_from b s' 0 (Bytes.length s'); \
|
||||
ByteBuffer.blit_from b "hello world" 0 (Bytes.length "hello world"); (* big enough *) \
|
||||
let l = ByteBuffer.length b in let l' = l/2 in ByteBuffer.skip b l'; \
|
||||
ByteBuffer.length b + l' = l))
|
||||
(let b = Byte.create 24 in \
|
||||
Byte.blit_from b s 0 (Bytes.length s); \
|
||||
Byte.blit_from b s' 0 (Bytes.length s'); \
|
||||
Byte.blit_from b "hello world" 0 (Bytes.length "hello world"); (* big enough *) \
|
||||
let l = Byte.length b in let l' = l/2 in Byte.skip b l'; \
|
||||
Byte.length b + l' = l))
|
||||
*)
|
||||
|
||||
let iteri b f =
|
||||
|
|
@ -552,28 +539,28 @@ struct
|
|||
(*$Q
|
||||
Q.printable_string (fun s -> \
|
||||
let s_len = Bytes.length s in \
|
||||
let b = ByteBuffer.create s_len in \
|
||||
ByteBuffer.blit_from b s 0 s_len; \
|
||||
try ByteBuffer.iteri b (fun i c -> if ByteBuffer.get_front b i <> c then raise Exit); true with Exit -> false)
|
||||
let b = Byte.create s_len in \
|
||||
Byte.blit_from b s 0 s_len; \
|
||||
try Byte.iteri b (fun i c -> if Byte.get_front b i <> c then raise Exit); true with Exit -> false)
|
||||
*)
|
||||
|
||||
let get b i =
|
||||
if b.stop >= b.start
|
||||
then
|
||||
if i >= b.stop - b.start
|
||||
then raise (Invalid_argument ("CCRingBuffer.get:" ^ string_of_int i))
|
||||
then invalid_arg ("CCRingBuffer.get:" ^ string_of_int i)
|
||||
else b.buf.(b.start + i)
|
||||
else
|
||||
let len_end = Array.length b.buf - b.start in
|
||||
if i < len_end
|
||||
then b.buf.(b.start + i)
|
||||
else if i - len_end > b.stop
|
||||
then raise (Invalid_argument ("CCRingBuffer.get: " ^ string_of_int i))
|
||||
then invalid_arg ("CCRingBuffer.get: " ^ string_of_int i)
|
||||
else b.buf.(i - len_end)
|
||||
|
||||
let get_front b i =
|
||||
if is_empty b then
|
||||
raise (Invalid_argument ("CCRingBuffer.get_front: " ^ string_of_int i))
|
||||
invalid_arg ("CCRingBuffer.get_front: " ^ string_of_int i)
|
||||
else
|
||||
get b i
|
||||
|
||||
|
|
@ -581,10 +568,10 @@ struct
|
|||
(Q.pair Q.small_int Q.printable_string) (fun (i, s) -> \
|
||||
let s = s ^ " " in \
|
||||
let s_len = Bytes.length s in \
|
||||
let b = ByteBuffer.create s_len in \
|
||||
ByteBuffer.blit_from b s 0 s_len; \
|
||||
let index = abs (i mod ByteBuffer.length b) in \
|
||||
let front = ByteBuffer.get_front b index in \
|
||||
let b = Byte.create s_len in \
|
||||
Byte.blit_from b s 0 s_len; \
|
||||
let index = abs (i mod Byte.length b) in \
|
||||
let front = Byte.get_front b index in \
|
||||
front = Bytes.get s index)
|
||||
*)
|
||||
|
||||
|
|
@ -598,10 +585,10 @@ struct
|
|||
(Q.pair Q.small_int Q.printable_string) (fun (i, s) -> \
|
||||
let s = s ^ " " in \
|
||||
let s_len = Bytes.length s in \
|
||||
let b = ByteBuffer.create s_len in \
|
||||
ByteBuffer.blit_from b s 0 s_len; \
|
||||
let index = abs (i mod ByteBuffer.length b) in \
|
||||
let back = ByteBuffer.get_back b index in \
|
||||
let b = Byte.create s_len in \
|
||||
Byte.blit_from b s 0 s_len; \
|
||||
let index = abs (i mod Byte.length b) in \
|
||||
let back = Byte.get_back b index in \
|
||||
back = Bytes.get s (s_len - index - 1))
|
||||
*)
|
||||
|
||||
|
|
@ -616,12 +603,12 @@ struct
|
|||
(*$Q
|
||||
Q.printable_string (fun s -> \
|
||||
let s_len = Bytes.length s in \
|
||||
let b = ByteBuffer.create s_len in \
|
||||
ByteBuffer.blit_from b s 0 s_len; \
|
||||
let l = ByteBuffer.to_list b in \
|
||||
let b = Byte.create s_len in \
|
||||
Byte.blit_from b s 0 s_len; \
|
||||
let l = Byte.to_list b in \
|
||||
let explode s = let rec exp i l = \
|
||||
if i < 0 then l else exp (i - 1) (s.[i] :: l) in \
|
||||
exp (String.length s - 1) [] in \
|
||||
exp (Bytes.length s - 1) [] in \
|
||||
explode s = l)
|
||||
*)
|
||||
|
||||
|
|
@ -630,42 +617,41 @@ struct
|
|||
(*$Q
|
||||
Q.printable_string (fun s -> \
|
||||
let s_len = Bytes.length s in \
|
||||
let b = ByteBuffer.create s_len in \
|
||||
ByteBuffer.blit_from b s 0 s_len; \
|
||||
ByteBuffer.push_back b 'X'; \
|
||||
ByteBuffer.peek_back b = 'X')
|
||||
let b = Byte.create s_len in \
|
||||
Byte.blit_from b s 0 s_len; \
|
||||
Byte.push_back b 'X'; \
|
||||
Byte.peek_back b = 'X')
|
||||
*)
|
||||
|
||||
|
||||
let peek_front b = if is_empty b then
|
||||
raise Empty else Array.get b.buf b.start
|
||||
let peek_front b =
|
||||
if is_empty b then raise Empty
|
||||
else Array.get b.buf b.start
|
||||
|
||||
(*$Q
|
||||
Q.printable_string (fun s -> \
|
||||
let s_len = Bytes.length s in \
|
||||
let b = ByteBuffer.create s_len in \
|
||||
ByteBuffer.blit_from b s 0 s_len; \
|
||||
try let back = ByteBuffer.peek_front b in \
|
||||
back = Bytes.get s 0 with ByteBuffer.Empty -> s_len = 0)
|
||||
let b = Byte.create s_len in \
|
||||
Byte.blit_from b s 0 s_len; \
|
||||
try let back = Byte.peek_front b in \
|
||||
back = Bytes.get s 0 with Byte.Empty -> s_len = 0)
|
||||
*)
|
||||
|
||||
let peek_back b = if is_empty b then
|
||||
raise Empty else Array.get b.buf
|
||||
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)
|
||||
|
||||
(*$Q
|
||||
Q.printable_string (fun s -> \
|
||||
let s_len = Bytes.length s in \
|
||||
let b = ByteBuffer.create s_len in \
|
||||
ByteBuffer.blit_from b s 0 s_len; \
|
||||
try let back = ByteBuffer.peek_back b in \
|
||||
back = Bytes.get s (s_len - 1) with ByteBuffer.Empty -> s_len = 0)
|
||||
let b = Byte.create s_len in \
|
||||
Byte.blit_from b s 0 s_len; \
|
||||
try let back = Byte.peek_back b in \
|
||||
back = Bytes.get s (s_len - 1) with Byte.Empty -> s_len = 0)
|
||||
*)
|
||||
|
||||
|
||||
|
||||
end
|
||||
|
||||
module ByteBuffer = Make_array(Array.ByteArray)
|
||||
module Byte = MakeFromArray(Array.Byte)
|
||||
|
||||
module Make(Elt:sig type t end) = Make_array(Array.Make(Elt))
|
||||
module Make(Elt:sig type t end) = MakeFromArray(Array.Make(Elt))
|
||||
|
|
|
|||
|
|
@ -26,13 +26,11 @@
|
|||
@since NEXT_RELEASE
|
||||
*)
|
||||
|
||||
(** The array module, with optimized versions of [Byte], [Float], and
|
||||
[Int], [Bool]. A [Make] functor is provided for polymorphic types. *)
|
||||
module Array : sig
|
||||
(** {2 Underlying Array} *)
|
||||
|
||||
(** The abstract type for arrays *)
|
||||
module Array : sig
|
||||
module type S = sig
|
||||
|
||||
(** The element type *)
|
||||
type elt
|
||||
|
||||
|
|
@ -71,44 +69,25 @@ module Array : sig
|
|||
end
|
||||
|
||||
(** Efficient array version for the [char] type *)
|
||||
module ByteArray :
|
||||
S with type elt = char and type t = bytes
|
||||
|
||||
(** Efficient array version for the [float] type *)
|
||||
module FloatArray :
|
||||
S with type elt = float and type t = float array
|
||||
|
||||
(** Efficient array version for the [int] type *)
|
||||
module IntArray :
|
||||
S with type elt = int and type t = int array
|
||||
|
||||
(** Efficient array version for the [bool] type *)
|
||||
module BoolArray :
|
||||
S with type elt = bool and type t = bool array
|
||||
module Byte :
|
||||
S with type elt = char and type t = Bytes.t
|
||||
|
||||
(** Makes an array given an arbitrary element type *)
|
||||
module Make :
|
||||
functor (Elt:sig type t end) ->
|
||||
module Make(Elt:sig type t end) :
|
||||
S with type elt = Elt.t and type t = Elt.t array
|
||||
end
|
||||
|
||||
(** The abstract ring buffer type, made concrete by choice of
|
||||
[Array] module implementation *)
|
||||
module type S =
|
||||
sig
|
||||
(** {2 Ring Buffer}
|
||||
|
||||
The abstract ring buffer type, made concrete by choice of
|
||||
[ARRAY] module implementation *)
|
||||
module type S = sig
|
||||
(** The module type of Array for this ring buffer *)
|
||||
module Array : Array.S
|
||||
|
||||
(** Defines the ring buffer type, with both bounded and
|
||||
unbounded flavors *)
|
||||
type t = private {
|
||||
mutable start : int;
|
||||
mutable stop : int; (* excluded *)
|
||||
mutable buf : Array.t;
|
||||
bounded: bool;
|
||||
size : int
|
||||
}
|
||||
type t
|
||||
|
||||
(** Raised in querying functions when the buffer is empty *)
|
||||
exception Empty
|
||||
|
|
@ -191,21 +170,26 @@ sig
|
|||
(** Get the last value from back of [t].
|
||||
@raise Empty if buffer is empty. *)
|
||||
|
||||
val take_back : t -> Array.elt
|
||||
val take_back : t -> Array.elt option
|
||||
(** Take the last value from back of [t], if any *)
|
||||
|
||||
val take_back_exn : t -> Array.elt
|
||||
(** Take the last value from back of [t].
|
||||
@raise Empty if buffer is already empty. *)
|
||||
|
||||
val take_front : t -> Array.elt
|
||||
val take_front : t -> Array.elt option
|
||||
(** Take the first value from front of [t], if any *)
|
||||
|
||||
val take_front_exn : t -> Array.elt
|
||||
(** Take the first value from front of [t].
|
||||
@raise Empty if buffer is already empty. *)
|
||||
|
||||
end
|
||||
|
||||
(** Makes a ring buffer module given array implementation *)
|
||||
module Make_array : functor (Array:Array.S) -> S with module Array = Array
|
||||
|
||||
(** An efficient byte based ring buffer *)
|
||||
module ByteBuffer : S with module Array = Array.ByteArray
|
||||
module Byte : S with module Array = Array.Byte
|
||||
|
||||
(** Makes a ring buffer module given the element type *)
|
||||
module Make: functor(Elt:sig type t end) -> S with module Array = Array.Make(Elt)
|
||||
(** Makes a ring buffer module with the given array type. *)
|
||||
module MakeFromArray(A : Array.S) : S with module Array = A
|
||||
|
||||
(** Buffer using regular arrays *)
|
||||
module Make(X : sig type t end) : S with type Array.elt = X.t
|
||||
|
|
|
|||
Loading…
Add table
Reference in a new issue