simon/ocaml-containers
1
0
Fork 0
mirror of https://github.com/c-cube/ocaml-containers.git synced 2025-12-06 03:05:28 -05:00
Code Issues Projects Releases Packages Wiki Activity Actions

change a bit the interface of CCRingBuffer, indentation, names

Browse source
This commit is contained in:
Simon Cruanes 2015-02-25 19:22:09 +01:00
parent 60159bdd75
commit 050514a326
2 changed files with 311 additions and 341 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

584
src/data/CCRingBuffer.ml
View file

@ -23,83 +23,51 @@
(** Polymorphic Circular Buffer for IO *) (** Polymorphic Circular Buffer for IO *)
module Array = struct module Array = struct
(** The abstract type for arrays *)
module type S = sig module type S = sig
(** The element type *)
type elt type elt
(** The type of an array instance *)
type t type t
val empty : t val empty : t
(** The empty array *)
val make: int -> elt -> t val make: int -> elt -> t
(** [make s e] makes an array of size [s] with [e] elements *)
val length: t -> int val length: t -> int
(** [length t] gets the total number of elements currently in [t] *)
val get: t -> int -> elt val get: t -> int -> elt
(** [get t i] gets the element at position [i] *)
val set: t -> int -> elt -> unit val set: t -> int -> elt -> unit
(** [set t i e] sets the element at position [i] to [e] *)
val sub: t -> int -> int -> t 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 val copy : t -> t
(** [copy t] makes a fresh copy of the array [t] *)
val blit : t -> int -> t -> int -> int -> unit 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 val iter : (elt -> unit) -> t -> unit
(** [iter f t] iterates over the array [t] invoking [f] with
the current element, in array order *)
end end
module ByteArray : module Byte :
S with type elt = char and type t = bytes = struct S with type elt = char and type t = bytes = struct
type elt = char type elt = char
include Bytes include Bytes
end 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) : module Make(Elt:sig type t end) :
S with type elt = Elt.t and type t = Elt.t array = struct S with type elt = Elt.t and type t = Elt.t array = struct
type elt = Elt.t type elt = Elt.t
@ -114,73 +82,115 @@ module Array = struct
let sub = Array.sub let sub = Array.sub
let empty = Array.of_list [] let empty = Array.of_list []
end end
end end
module type S = module type S = sig
sig (** The module type of Array for this ring buffer *)
module Array : Array.S module Array : Array.S
type t = private { (** Defines the ring buffer type, with both bounded and
mutable start : int; unbounded flavors *)
mutable stop : int; (* excluded *) type t
mutable buf : Array.t;
bounded: bool; (** Raised in querying functions when the buffer is empty *)
size : int
}
exception Empty exception Empty
val create : ?bounded:bool -> int -> t val create : ?bounded:bool -> int -> t
(** [create ?bounded size] creates a new buffer with given size.
Defaults to [bounded=false]. *)
val copy : t -> t val copy : t -> t
(** Make a fresh copy of the buffer. *)
val capacity : t -> int val capacity : t -> int
(** Length of the inner buffer. *)
val max_capacity : t -> int option val max_capacity : t -> int option
(** Maximum length of the inner buffer, or [None] if unbounded. *)
val length : t -> int val length : t -> int
(** Number of elements currently stored in the buffer. *)
val blit_from : t -> Array.t -> int -> int -> unit 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 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 val to_list : t -> Array.elt list
(** Extract the current content into a list *)
val clear : t -> unit val clear : t -> unit
(** Clear the content of the buffer. Doesn't actually destroy the content. *)
val reset : t -> unit val reset : t -> unit
(** Clear the content of the buffer, and also resize it to a default size *)
val is_empty :t -> bool val is_empty :t -> bool
(** Is the buffer empty (i.e. contains no elements)? *)
val junk_front : t -> unit val junk_front : t -> unit
(** Drop the front element from [t].
@raise Empty if the buffer is already empty. *)
val junk_back : t -> unit val junk_back : t -> unit
(** Drop the back element from [t].
@raise Empty if the buffer is already empty. *)
val skip : t -> int -> unit 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 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 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 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 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 val peek_front : t -> Array.elt
(** First value from front of [t].
@raise Empty if buffer is empty. *)
val peek_back : t -> Array.elt 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 end
module Make_array(Array:Array.S) = module MakeFromArray(Array:Array.S) = struct
struct
module Array = Array module Array = Array
type t = { type t = {
mutable start : int; mutable start : int;
mutable stop : int; (* excluded *) mutable stop : int; (* excluded *)
@ -199,69 +209,53 @@ struct
buf = Array.empty 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 = let copy b =
{ b with buf=Array.copy b.buf; } { b with buf=Array.copy b.buf; }
(*$Q (*$Q
Q.printable_string (fun s -> \ Q.printable_string (fun s -> \
let s_len = Bytes.length s in \ let s_len = Bytes.length s in \
let b = ByteBuffer.create s_len in \ let b = Byte.create s_len in \
ByteBuffer.blit_from b s 0 s_len; \ Byte.blit_from b s 0 s_len; \
let b' = ByteBuffer.copy b in \ let b' = Byte.copy b in \
try ByteBuffer.iteri b (fun i c -> if ByteBuffer.get_front b' i <> c then raise Exit); true with Exit -> false) try Byte.iteri b (fun i c -> if Byte.get_front b' i <> c then raise Exit); true with Exit -> false)
*) *)
let capacity b = let capacity b =
let len = Array.length b.buf in let len = Array.length b.buf in
match len with 0 -> 0 | l -> l - 1 match len with 0 -> 0 | l -> l - 1
(*$Q (*$Q
Q.printable_string (fun s -> \ Q.printable_string (fun s -> \
let s_len = Bytes.length s in \ let s_len = Bytes.length s in \
let b = ByteBuffer.create s_len in \ let b = Byte.create s_len in \
ByteBuffer.blit_from b s 0 s_len; \ Byte.blit_from b s 0 s_len; \
ByteBuffer.capacity b >= Bytes.length s) Byte.capacity b >= s_len)
*) *)
(*$Q (*$Q
(Q.pair Q.small_int Q.printable_string) (fun (i, s) -> \ (Q.pair Q.small_int Q.printable_string) (fun (i, s) -> \
let i = abs i in \ let i = abs i in \
let s_len = Bytes.length s in \ let s_len = Bytes.length s in \
let b = ByteBuffer.create ~bounded:true i in \ let b = Byte.create ~bounded:true i in \
ByteBuffer.blit_from b s 0 s_len; \ Byte.blit_from b s 0 s_len; \
ByteBuffer.capacity b <= i) Byte.capacity b <= i)
*) *)
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
(*$Q (*$Q
Q.small_int (fun i -> \ Q.small_int (fun i -> \
let i = abs i in \ let i = abs i in \
let b = ByteBuffer.create i in \ let b = Byte.create i in \
ByteBuffer.max_capacity b = None) Byte.max_capacity b = None)
*) *)
(*$Q (*$Q
Q.small_int (fun i -> \ Q.small_int (fun i -> \
let i = abs i in \ let i = abs i in \
let b = ByteBuffer.create ~bounded:true i in \ let b = Byte.create ~bounded:true i in \
ByteBuffer.max_capacity b = Some i) Byte.max_capacity b = Some i)
*) *)
let length b = let length b =
@ -269,22 +263,22 @@ struct
then b.stop - b.start then b.stop - b.start
else (Array.length b.buf - b.start) + b.stop else (Array.length b.buf - b.start) + b.stop
(*$Q (*$Q
(Q.pair Q.small_int Q.printable_string) (fun (i, s) -> \ (Q.pair Q.small_int Q.printable_string) (fun (i, s) -> \
let i = abs i in \ let i = abs i in \
let s_len = Bytes.length s in \ let s_len = Bytes.length s in \
let b = ByteBuffer.create i in \ let b = Byte.create i in \
ByteBuffer.blit_from b s 0 s_len; \ Byte.blit_from b s 0 s_len; \
ByteBuffer.length b = s_len) Byte.length b = s_len)
*) *)
(*$Q (*$Q
(Q.pair Q.small_int Q.printable_string) (fun (i, s) -> \ (Q.pair Q.small_int Q.printable_string) (fun (i, s) -> \
let i = abs i in \ let i = abs i in \
let s_len = Bytes.length s in \ let s_len = Bytes.length s in \
let b = ByteBuffer.create ~bounded:true i in \ let b = Byte.create ~bounded:true i in \
ByteBuffer.blit_from b s 0 s_len; \ Byte.blit_from b s 0 s_len; \
ByteBuffer.length b >= 0 && ByteBuffer.length b <= i) Byte.length b >= 0 && Byte.length b <= i)
*) *)
(* resize [b] so that inner capacity is [cap] *) (* resize [b] so that inner capacity is [cap] *)
@ -309,27 +303,21 @@ struct
let blit_from_bounded b from_buf o len = let blit_from_bounded b from_buf o len =
let cap = capacity b - length b in let cap = capacity b - length b in
(* resize if needed, with a constant to amortize *) (* resize if needed, with a constant to amortize *)
if cap < len then begin if cap < len then (
let new_size = let new_size =
let desired = Array.length b.buf + len + 24 in let desired = Array.length b.buf + len + 24 in
min (b.size+1) desired in min (b.size+1) desired in
resize b new_size from_buf.(0); resize b new_size from_buf.(0);
let good = capacity b = b.size || capacity b - length b >= len in let good = capacity b = b.size || capacity b - length b >= len in
if not good then begin assert good;
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;
let sub = Array.sub from_buf o len in let sub = Array.sub from_buf o len in
let iter x = let iter x =
let capacity = Array.length b.buf in let capacity = Array.length b.buf in
Array.set b.buf b.stop x; Array.set b.buf b.stop x;
if b.stop = capacity-1 then b.stop <- 0 else b.stop <- b.stop + 1; if b.stop = capacity-1 then b.stop <- 0 else b.stop <- b.stop + 1;
if b.start = b.stop then if b.start = b.stop then
begin if b.start = capacity-1 then b.start <- 0 else b.start <- b.start + 1
if b.start = capacity-1 then b.start <- 0 else b.start <- b.start + 1
end
in in
Array.iter iter sub Array.iter iter sub
@ -339,11 +327,7 @@ struct
(* resize if needed, with a constant to amortize *) (* 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); 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 let good = capacity b - length b >= len in
if not good then begin assert good;
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;
if b.stop >= b.start if b.stop >= b.start
then (* [_______ start xxxxxxxxx stop ______] *) then (* [_______ start xxxxxxxxx stop ______] *)
let len_end = Array.length b.buf - b.stop in let len_end = Array.length b.buf - b.stop in
@ -370,25 +354,25 @@ struct
(*$Q (*$Q
(Q.pair Q.printable_string Q.printable_string) (fun (s,s') -> \ (Q.pair Q.printable_string Q.printable_string) (fun (s,s') -> \
(let b = ByteBuffer.create 24 in \ (let b = Byte.create 24 in \
ByteBuffer.blit_from b s 0 (Bytes.length s); \ Byte.blit_from b s 0 (Bytes.length s); \
ByteBuffer.blit_from b s' 0 (Bytes.length s'); \ Byte.blit_from b s' 0 (Bytes.length s'); \
ByteBuffer.length b = Bytes.length s + Bytes.length s')) Byte.length b = Bytes.length s + Bytes.length s'))
*) *)
(*$Q (*$Q
(Q.pair Q.printable_string Q.printable_string) (fun (s,s') -> \ (Q.pair Q.printable_string Q.printable_string) (fun (s,s') -> \
(let b = ByteBuffer.create ~bounded:true (Bytes.length s + Bytes.length s') in \ (let b = Byte.create ~bounded:true (Bytes.length s + Bytes.length s') in \
ByteBuffer.blit_from b s 0 (Bytes.length s); \ Byte.blit_from b s 0 (Bytes.length s); \
ByteBuffer.blit_from b s' 0 (Bytes.length s'); \ Byte.blit_from b s' 0 (Bytes.length s'); \
ByteBuffer.length b = Bytes.length s + Bytes.length s')) Byte.length b = Bytes.length s + Bytes.length s'))
*) *)
let blit_into b to_buf o len = let blit_into b to_buf o len =
if o+len > Array.length to_buf 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 if b.stop >= b.start
then then
let n = min (b.stop - b.start) len in let n = min (b.stop - b.start) len in
@ -408,10 +392,10 @@ struct
(*$Q (*$Q
Q.printable_string (fun s -> \ Q.printable_string (fun s -> \
let b = ByteBuffer.create (Bytes.length s) in \ let b = Byte.create (Bytes.length s) in \
ByteBuffer.blit_from b s 0 (Bytes.length s); \ Byte.blit_from b s 0 (Bytes.length s); \
let to_buf = Bytes.create (Bytes.length s) in \ 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) to_buf = s && len = Bytes.length s)
*) *)
@ -421,43 +405,42 @@ struct
b.start <- 0; b.start <- 0;
() ()
(*$Q (*$Q
Q.printable_string (fun s -> \ Q.printable_string (fun s -> \
let s_len = Bytes.length s in \ let s_len = Bytes.length s in \
let b = ByteBuffer.create s_len in \ let b = Byte.create s_len in \
ByteBuffer.blit_from b s 0 s_len; \ Byte.blit_from b s 0 s_len; \
ByteBuffer.clear b; \ Byte.clear b; \
ByteBuffer.length b = 0) Byte.length b = 0)
*) *)
let reset b = let reset b =
clear b; clear b;
b.buf <- Array.empty b.buf <- Array.empty
(*$Q (*$Q
Q.printable_string (fun s -> \ Q.printable_string (fun s -> \
let s_len = Bytes.length s in \ let s_len = Bytes.length s in \
let b = ByteBuffer.create s_len in \ let b = Byte.create s_len in \
ByteBuffer.blit_from b s 0 s_len; \ Byte.blit_from b s 0 s_len; \
ByteBuffer.reset b; \ Byte.reset b; \
ByteBuffer.length b = 0 && ByteBuffer.capacity b = 0) Byte.length b = 0 && Byte.capacity b = 0)
*) *)
let is_empty b = b.start = b.stop let is_empty b = b.start = b.stop
(*$Q (*$Q
Q.printable_string (fun s -> \ Q.printable_string (fun s -> \
let s_len = Bytes.length s in \ let s_len = Bytes.length s in \
let b = ByteBuffer.create s_len in \ let b = Byte.create s_len in \
ByteBuffer.blit_from b s 0 s_len; \ Byte.blit_from b s 0 s_len; \
ByteBuffer.skip b s_len; \ Byte.skip b s_len; \
ByteBuffer.is_empty b) Byte.is_empty b)
*) *)
let take_front_exn b =
let take_front b =
if b.start = b.stop then raise Empty; if b.start = b.stop then raise Empty;
let c = b.buf.(b.start) in let c = b.buf.(b.start) in
if b.start + 1 = Array.length b.buf if b.start + 1 = Array.length b.buf
@ -465,30 +448,34 @@ struct
else b.start <- b.start + 1; else b.start <- b.start + 1;
c c
(*$Q let take_front b = try Some (take_front_exn b) with Empty -> None
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 take_back b = (*$Q
Q.printable_string (fun s -> \
let s_len = Bytes.length s in \
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_exn b =
if b.start = b.stop then raise Empty; if b.start = b.stop then raise Empty;
if b.stop - 1 = 0 if b.stop - 1 = 0
then b.stop <- Array.length b.buf - 1 then b.stop <- Array.length b.buf - 1
else b.stop <- b.stop - 1; else b.stop <- b.stop - 1;
b.buf.(b.stop) b.buf.(b.stop)
(*$Q let take_back b = try Some (take_back_exn b) with Empty -> None
Q.printable_string (fun s -> \
let s_len = Bytes.length s in \ (*$Q
let b = ByteBuffer.create s_len in \ Q.printable_string (fun s -> \
ByteBuffer.blit_from b s 0 s_len; \ let s_len = Bytes.length s in \
try let back = ByteBuffer.take_back b in \ let b = Byte.create s_len in \
back = Bytes.get s (Bytes.length s - 1) with ByteBuffer.Empty -> s_len = 0) 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 = let junk_front b =
if b.start = b.stop then raise Empty; if b.start = b.stop then raise Empty;
@ -496,14 +483,14 @@ struct
then b.start <- 0 then b.start <- 0
else b.start <- b.start + 1 else b.start <- b.start + 1
(*$Q (*$Q
Q.printable_string (fun s -> \ Q.printable_string (fun s -> \
let s_len = Bytes.length s in \ let s_len = Bytes.length s in \
let b = ByteBuffer.create s_len in \ let b = Byte.create s_len in \
ByteBuffer.blit_from b s 0 s_len; \ Byte.blit_from b s 0 s_len; \
try let () = ByteBuffer.junk_front b in \ try let () = Byte.junk_front b in \
s_len - 1 = ByteBuffer.length b with ByteBuffer.Empty -> s_len = 0) s_len - 1 = Byte.length b with Byte.Empty -> s_len = 0)
*) *)
let junk_back b = let junk_back b =
if b.start = b.stop then raise Empty; if b.start = b.stop then raise Empty;
@ -511,18 +498,18 @@ struct
then b.stop <- Array.length b.buf - 1 then b.stop <- Array.length b.buf - 1
else b.stop <- b.stop - 1 else b.stop <- b.stop - 1
(*$Q (*$Q
Q.printable_string (fun s -> \ Q.printable_string (fun s -> \
let s_len = Bytes.length s in \ let s_len = Bytes.length s in \
let b = ByteBuffer.create s_len in \ let b = Byte.create s_len in \
ByteBuffer.blit_from b s 0 s_len; \ Byte.blit_from b s 0 s_len; \
try let () = ByteBuffer.junk_back b in \ try let () = Byte.junk_back b in \
s_len - 1 = ByteBuffer.length b with ByteBuffer.Empty -> s_len = 0) s_len - 1 = Byte.length b with Byte.Empty -> s_len = 0)
*) *)
let skip b len = let skip b len =
if len > length b then raise (Invalid_argument if len > length b then
("CCRingBufferIO.skip: " ^ string_of_int len)); invalid_arg ("CCRingRingBuffer.skip: " ^ string_of_int len);
if b.stop >= b.start if b.stop >= b.start
then b.start <- b.start + len then b.start <- b.start + len
else else
@ -533,12 +520,12 @@ struct
(*$Q (*$Q
(Q.pair Q.printable_string Q.printable_string) (fun (s,s') -> \ (Q.pair Q.printable_string Q.printable_string) (fun (s,s') -> \
(let b = ByteBuffer.create 24 in \ (let b = Byte.create 24 in \
ByteBuffer.blit_from b s 0 (Bytes.length s); \ Byte.blit_from b s 0 (Bytes.length s); \
ByteBuffer.blit_from b s' 0 (Bytes.length s'); \ Byte.blit_from b s' 0 (Bytes.length s'); \
ByteBuffer.blit_from b "hello world" 0 (Bytes.length "hello world"); (* big enough *) \ Byte.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'; \ let l = Byte.length b in let l' = l/2 in Byte.skip b l'; \
ByteBuffer.length b + l' = l)) Byte.length b + l' = l))
*) *)
let iteri b f = let iteri b f =
@ -549,123 +536,122 @@ struct
for i = 0 to b.stop - 1 do f i b.buf.(i) done; for i = 0 to b.stop - 1 do f i b.buf.(i) done;
) )
(*$Q (*$Q
Q.printable_string (fun s -> \ Q.printable_string (fun s -> \
let s_len = Bytes.length s in \ let s_len = Bytes.length s in \
let b = ByteBuffer.create s_len in \ let b = Byte.create s_len in \
ByteBuffer.blit_from b s 0 s_len; \ Byte.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) 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 = let get b i =
if b.stop >= b.start if b.stop >= b.start
then then
if i >= b.stop - b.start 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 b.buf.(b.start + i)
else else
let len_end = Array.length b.buf - b.start in let len_end = Array.length b.buf - b.start in
if i < len_end if i < len_end
then b.buf.(b.start + i) then b.buf.(b.start + i)
else if i - len_end > b.stop 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) else b.buf.(i - len_end)
let get_front b i = let get_front b i =
if is_empty b then 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 else
get b i get b i
(*$Q (*$Q
(Q.pair Q.small_int Q.printable_string) (fun (i, s) -> \ (Q.pair Q.small_int Q.printable_string) (fun (i, s) -> \
let s = s ^ " " in \ let s = s ^ " " in \
let s_len = Bytes.length s in \ let s_len = Bytes.length s in \
let b = ByteBuffer.create s_len in \ let b = Byte.create s_len in \
ByteBuffer.blit_from b s 0 s_len; \ Byte.blit_from b s 0 s_len; \
let index = abs (i mod ByteBuffer.length b) in \ let index = abs (i mod Byte.length b) in \
let front = ByteBuffer.get_front b index in \ let front = Byte.get_front b index in \
front = Bytes.get s index) front = Bytes.get s index)
*) *)
let get_back b i = let get_back b i =
let offset = ((length b) - i - 1) in let offset = ((length b) - i - 1) in
if offset < 0 then if offset < 0 then
raise (Invalid_argument ("CCRingBuffer.get_back:" ^ string_of_int i)) raise (Invalid_argument ("CCRingBuffer.get_back:" ^ string_of_int i))
else get b offset else get b offset
(*$Q (*$Q
(Q.pair Q.small_int Q.printable_string) (fun (i, s) -> \ (Q.pair Q.small_int Q.printable_string) (fun (i, s) -> \
let s = s ^ " " in \ let s = s ^ " " in \
let s_len = Bytes.length s in \ let s_len = Bytes.length s in \
let b = ByteBuffer.create s_len in \ let b = Byte.create s_len in \
ByteBuffer.blit_from b s 0 s_len; \ Byte.blit_from b s 0 s_len; \
let index = abs (i mod ByteBuffer.length b) in \ let index = abs (i mod Byte.length b) in \
let back = ByteBuffer.get_back b index in \ let back = Byte.get_back b index in \
back = Bytes.get s (s_len - index - 1)) back = Bytes.get s (s_len - index - 1))
*) *)
let to_list b = let to_list b =
let len = length b in let len = length b in
let rec build l i = let rec build l i =
if i < 0 then l else if i < 0 then l else
build ((get_front b i)::l) (i-1) in build ((get_front b i)::l) (i-1) in
build [] (len-1) build [] (len-1)
(*$Q (*$Q
Q.printable_string (fun s -> \ Q.printable_string (fun s -> \
let s_len = Bytes.length s in \ let s_len = Bytes.length s in \
let b = ByteBuffer.create s_len in \ let b = Byte.create s_len in \
ByteBuffer.blit_from b s 0 s_len; \ Byte.blit_from b s 0 s_len; \
let l = ByteBuffer.to_list b in \ let l = Byte.to_list b in \
let explode s = let rec exp i l = \ let explode s = let rec exp i l = \
if i < 0 then l else exp (i - 1) (s.[i] :: l) in \ 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) explode s = l)
*) *)
let push_back b e = blit_from b (Array.make 1 e) 0 1 let push_back b e = blit_from b (Array.make 1 e) 0 1
(*$Q (*$Q
Q.printable_string (fun s -> \ Q.printable_string (fun s -> \
let s_len = Bytes.length s in \ let s_len = Bytes.length s in \
let b = ByteBuffer.create s_len in \ let b = Byte.create s_len in \
ByteBuffer.blit_from b s 0 s_len; \ Byte.blit_from b s 0 s_len; \
ByteBuffer.push_back b 'X'; \ Byte.push_back b 'X'; \
ByteBuffer.peek_back b = 'X') Byte.peek_back b = 'X')
*) *)
let peek_front b = if is_empty b then let peek_front b =
raise Empty else Array.get b.buf b.start 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 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)
*)
(*$Q
Q.printable_string (fun s -> \
let s_len = Bytes.length s in \
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
(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 = 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 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))

68
src/data/CCRingBuffer.mli
View file

@ -26,13 +26,11 @@
@since NEXT_RELEASE @since NEXT_RELEASE
*) *)
(** The array module, with optimized versions of [Byte], [Float], and (** {2 Underlying Array} *)
[Int], [Bool]. A [Make] functor is provided for polymorphic types. *)
(** The abstract type for arrays *)
module Array : sig module Array : sig
(** The abstract type for arrays *)
module type S = sig module type S = sig
(** The element type *) (** The element type *)
type elt type elt
@ -71,44 +69,25 @@ module Array : sig
end end
(** Efficient array version for the [char] type *) (** Efficient array version for the [char] type *)
module ByteArray : module Byte :
S with type elt = char and type t = bytes S with type elt = char and type t = Bytes.t
(** 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
(** Makes an array given an arbitrary element type *) (** Makes an array given an arbitrary element type *)
module Make : module Make(Elt:sig type t end) :
functor (Elt:sig type t end) -> S with type elt = Elt.t and type t = Elt.t array
S with type elt = Elt.t and type t = Elt.t array
end end
(** The abstract ring buffer type, made concrete by choice of (** {2 Ring Buffer}
[Array] module implementation *)
module type S =
sig
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 *) (** The module type of Array for this ring buffer *)
module Array : Array.S module Array : Array.S
(** Defines the ring buffer type, with both bounded and (** Defines the ring buffer type, with both bounded and
unbounded flavors *) unbounded flavors *)
type t = private { type t
mutable start : int;
mutable stop : int; (* excluded *)
mutable buf : Array.t;
bounded: bool;
size : int
}
(** Raised in querying functions when the buffer is empty *) (** Raised in querying functions when the buffer is empty *)
exception Empty exception Empty
@ -191,21 +170,26 @@ sig
(** Get the last value from back of [t]. (** Get the last value from back of [t].
@raise Empty if buffer is empty. *) @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]. (** Take the last value from back of [t].
@raise Empty if buffer is already empty. *) @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]. (** Take the first value from front of [t].
@raise Empty if buffer is already empty. *) @raise Empty if buffer is already empty. *)
end 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 *) (** 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 *) (** Makes a ring buffer module with the given array type. *)
module Make: functor(Elt:sig type t end) -> S with module Array = Array.Make(Elt) 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