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

merge from struktured: shiny new CCRingBuffer

Browse source
This commit is contained in:
Simon Cruanes 2015-02-25 18:57:02 +01:00
commit 60159bdd75
6 changed files with 884 additions and 311 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

2
_oasis
View file

@ -70,7 +70,7 @@ Library "containers_data"
Path: src/data Path: src/data
Modules: CCMultiMap, CCMultiSet, CCTrie, CCFlatHashtbl, CCCache, Modules: CCMultiMap, CCMultiSet, CCTrie, CCFlatHashtbl, CCCache,
CCPersistentHashtbl, CCDeque, CCFQueue, CCBV, CCMixtbl, CCPersistentHashtbl, CCDeque, CCFQueue, CCBV, CCMixtbl,
CCMixmap, CCBufferIO CCMixmap, CCRingBuffer
FindlibParent: containers FindlibParent: containers
FindlibName: data FindlibName: data

1
doc/intro.txt
View file

@ -73,6 +73,7 @@ CCMixtbl
CCMultiMap CCMultiMap
CCMultiSet CCMultiSet
CCPersistentHashtbl CCPersistentHashtbl
CCRingBuffer
CCTrie CCTrie
} }

214
src/data/CCBufferIO.ml
View file

@ -1,214 +0,0 @@
(*
* BatBufferIO - Circular byte buffer
* Copyright (C) 2014 Simon Cruanes
*
* This library is free software; you can redistribute it and/or
* modify it under the terms of the GNU Lesser General Public
* License as published by the Free Software Foundation; either
* version 2.1 of the License, or (at your option) any later version,
* with the special exception on linking described in file LICENSE.
*
* This library is distributed in the hope that it will be useful,
* but WITHOUT ANY WARRANTY; without even the implied warranty of
* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
* Lesser General Public License for more details.
*
* You should have received a copy of the GNU Lesser General Public
* License along with this library; if not, write to the Free Software
* Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
*)
(** Circular Byte Buffer for IO *)
type t = {
mutable start : int;
mutable stop : int; (* excluded *)
mutable buf : string;
}
exception Empty
let create size =
{ start=0;
stop=0;
buf =String.make size ' ';
}
let copy b =
{ b with buf=String.copy b.buf; }
let of_string s =
{ start=0;
stop=String.length s;
buf=String.copy s;
}
let capacity b = String.length b.buf
let length b =
if b.stop >= b.start
then b.stop - b.start
else (String.length b.buf - b.start) + b.stop
(* resize [b] so that inner capacity is [cap] *)
let resize b cap =
assert (cap >= String.length b.buf);
let buf' = String.make cap ' ' in
(* copy into buf' *)
let len =
if b.stop >= b.start
then begin
String.blit b.buf b.start buf' 0 (b.stop - b.start);
b.stop - b.start
end else begin
let len_end = String.length b.buf - b.start in
String.blit b.buf b.start buf' 0 len_end;
String.blit b.buf 0 buf' len_end b.stop;
len_end + b.stop
end
in
b.buf <- buf';
b.start <- 0;
b.stop <- len;
()
let blit_from b s o len =
let cap = capacity b - length b in
(* resize if needed, with a constant to amortize *)
if cap < len then resize b (String.length b.buf + len + 24);
assert (capacity b - length b >= len);
if b.stop >= b.start
then (* [_______ start xxxxxxxxx stop ______] *)
let len_end = String.length b.buf - b.stop in
if len_end >= len
then (String.blit s o b.buf b.stop len;
b.stop <- b.stop + len)
else (String.blit s o b.buf b.stop len_end;
String.blit s (o+len_end) b.buf 0 (len-len_end);
b.stop <- len-len_end)
else begin (* [xxxxx stop ____________ start xxxxxx] *)
let len_middle = b.start - b.stop in
assert (len_middle >= len);
String.blit s o b.buf b.stop len;
b.stop <- b.stop + len
end;
()
let blit_into b s o len =
if o+len > String.length s
then raise (Invalid_argument "BufferIO.blit_into");
if b.stop >= b.start
then
let n = min (b.stop - b.start) len in
let _ = String.blit b.buf b.start s o n in
n
else begin
let len_end = String.length b.buf - b.start in
String.blit b.buf b.start s o (min len_end len);
if len_end >= len
then len (* done *)
else begin
let n = min b.stop (len - len_end) in
String.blit b.buf 0 s (o+len_end) n;
n + len_end
end
end
let add_string b s = blit_from b s 0 (String.length s)
(*$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'; \
String.length s + String.length s' = length b)
*)
let to_string b =
let s = String.make (length b) ' ' in
let n = blit_into b s 0 (String.length s) in
assert (n = String.length s);
s
(*$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'; \
to_string b = s ^ s')
*)
let clear b =
b.stop <- 0;
b.start <- 0;
()
let reset b =
clear b;
if capacity b > 64
then b.buf <- String.make 64 ' '; (* reset *)
()
let is_empty b = b.start = b.stop
let next b =
if b.start = b.stop then raise Empty;
b.buf.[b.start]
let pop b =
if b.start = b.stop then raise Empty;
let c = b.buf.[b.start] in
if b.start + 1 = String.length b.buf
then b.start <- 0
else b.start <- b.start + 1;
c
let junk b =
if b.start = b.stop then raise Empty;
if b.start + 1 = String.length b.buf
then b.start <- 0
else b.start <- b.start + 1
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
else
let len_end = String.length b.buf - b.start in
if len > len_end
then b.start <- len-len_end (* wrap to the beginning *)
else b.start <- b.start + len
(*$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 =
if b.stop >= b.start
then for i = b.start to b.stop - 1 do f i b.buf.[i] done
else (
for i = b.start to String.length b.buf -1 do f i b.buf.[i] done;
for i = 0 to b.stop - 1 do f i b.buf.[i] done;
)
(*$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 =
if b.stop >= b.start
then
if i >= b.stop - b.start
then raise (Invalid_argument "BufferIO.get")
else b.buf.[b.start + i]
else
let len_end = String.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 "BufferIO.get")
else b.buf.[i - len_end]

96
src/data/CCBufferIO.mli
View file

@ -1,96 +0,0 @@
(*
* BatBufferIO - Circular byte buffer
* Copyright (C) 2014 Simon Cruanes
*
* This library is free software; you can redistribute it and/or
* modify it under the terms of the GNU Lesser General Public
* License as published by the Free Software Foundation; either
* version 2.1 of the License, or (at your option) any later version,
* with the special exception on linking described in file LICENSE.
*
* This library is distributed in the hope that it will be useful,
* but WITHOUT ANY WARRANTY; without even the implied warranty of
* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
* Lesser General Public License for more details.
*
* You should have received a copy of the GNU Lesser General Public
* License along with this library; if not, write to the Free Software
* Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
*)
(** Circular Byte Buffer for IO *)
type t = private {
mutable start : int;
mutable stop : int; (* excluded *)
mutable buf : string;
}
exception Empty
val create : int -> t
(** [create size] creates a new buffer with given size *)
val copy : t -> t
(** fresh copy of the buffer *)
val of_string : string -> t
(** build a buffer from an initial string. The string is copied.
Use {!String.blit_from} if you want more control. *)
val capacity : t -> int
(** length of the inner string buffer *)
val length : t -> int
(** number of bytes currently stored in the buffer *)
val blit_from : t -> string -> int -> int -> unit
(** [blit_from buf s o len] copies the slice [o, ... o + len - 1] from
the string [s] to the end of the buffer.
@raise Invalid_argument if [o,len] is not a valid slice of [s] *)
val blit_into : t -> string -> int -> int -> int
(** [blit_into buf s o len] copies at most [len] bytes from [buf]
into [s], starting at offset [o] in [s].
@return the number of bytes actually copied ([min len (length buf)]).
@raise Invalid_argument if [o,len] is not a valid slice of [s] *)
val add_string : t -> string -> unit
(** [add_string buf s] adds [s] at the end of [buf]. *)
val to_string : t -> string
(** extract the current content into a string *)
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 byte)? *)
val next : t -> char
(** obtain next char (the first one of the buffer)
@raise Empty if the buffer is empty *)
val pop : t -> char
(** obtain and remove next char (the first one)
@raise Empty if the buffer is empty *)
val junk : t -> unit
(** Drop next element.
@raise Empty if the buffer is already empty *)
val skip : t -> int -> unit
(** [skip b len] removes [len] elements from [b].
@raise Invalid_argument if [len > length b]. *)
val iteri : t -> (int -> char -> unit) -> unit
(** [iteri b f] calls [f i c] for each char [c] in [buf], with [i]
being its relative index within [buf]. *)
val get : t -> int -> char
(** [get buf i] returns the [i]-th character 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]) *)

671
src/data/CCRingBuffer.ml Normal file
View file

@ -0,0 +1,671 @@
(*
* CCRingBuffer - Polymorphic circular buffer with
* deque semantics for accessing both the head and tail.
*
* Copyright (C) 2015 Simon Cruanes, Carmelo Piccione
*
* This library is free software; you can redistribute it and/or
* modify it under the terms of the GNU Lesser General Public
* License as published by the Free Software Foundation; either
* version 2.1 of the License, or (at your option) any later version,
* with the special exception on linking described in file LICENSE.
*
* This library is distributed in the hope that it will be useful,
* but WITHOUT ANY WARRANTY; without even the implied warranty of
* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
* Lesser General Public License for more details.
*
* You should have received a copy of the GNU Lesser General Public
* License along with this library; if not, write to the Free Software
* Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
*)
(** Polymorphic Circular Buffer for IO *)
module Array = struct
module type S = sig
type elt
type t
val empty : 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 copy : t -> t
val blit : t -> int -> t -> int -> int -> unit
val iter : (elt -> unit) -> t -> unit
end
module ByteArray :
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
type t = Elt.t array
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
end
module type S =
sig
module Array : Array.S
type t = private {
mutable start : int;
mutable stop : int; (* excluded *)
mutable buf : Array.t;
bounded: bool;
size : int
}
exception Empty
val create : ?bounded:bool -> int -> t
val copy : t -> t
val capacity : t -> int
val max_capacity : t -> int option
val length : t -> int
val blit_from : t -> Array.t -> int -> int -> unit
val blit_into : t -> Array.t -> int -> int -> int
val to_list : t -> Array.elt list
val clear : t -> unit
val reset : t -> unit
val is_empty :t -> bool
val junk_front : t -> unit
val junk_back : t -> unit
val skip : t -> int -> unit
val iteri : t -> (int -> Array.elt -> unit) -> unit
val get_front : t -> int -> Array.elt
val get_back : t -> int -> Array.elt
val push_back : t -> Array.elt -> unit
val peek_front : t -> Array.elt
val peek_back : t -> Array.elt
val take_back : t -> Array.elt
val take_front : t -> Array.elt
end
module Make_array(Array:Array.S) =
struct
module Array = Array
type t = {
mutable start : int;
mutable stop : int; (* excluded *)
mutable buf : Array.t;
bounded : bool;
size : int
}
exception Empty
let create ?(bounded=false) size =
{ start=0;
stop=0;
bounded;
size;
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 capacity b =
let len = Array.length b.buf in
match len with 0 -> 0 | l -> l - 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; \
ByteBuffer.capacity b >= Bytes.length s)
*)
(*$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 max_capacity b = if b.bounded then Some b.size else None
(*$Q
Q.small_int (fun i -> \
let i = abs i in \
let b = ByteBuffer.create i in \
ByteBuffer.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 length b =
if b.stop >= b.start
then b.stop - b.start
else (Array.length b.buf - b.start) + b.stop
(*$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 i in \
ByteBuffer.blit_from b s 0 s_len; \
ByteBuffer.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)
*)
(* 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' *)
let _:int =
if b.stop >= b.start
then begin
Array.blit b.buf b.start buf' 0 (b.stop - b.start);
b.stop - b.start
end else begin
let len_end = Array.length b.buf - b.start in
Array.blit b.buf b.start buf' 0 len_end;
Array.blit b.buf 0 buf' len_end b.stop;
len_end + b.stop
end
in
b.buf <- buf'
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
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;
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
let blit_from_unbounded b from_buf o len =
let cap = capacity b - length b in
(* 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;
if b.stop >= b.start
then (* [_______ start xxxxxxxxx stop ______] *)
let len_end = Array.length b.buf - b.stop in
if len_end >= len
then (Array.blit from_buf o b.buf b.stop len;
b.stop <- b.stop + len)
else (Array.blit from_buf o b.buf b.stop len_end;
Array.blit from_buf (o+len_end) b.buf 0 (len-len_end);
b.stop <- len-len_end)
else begin (* [xxxxx stop ____________ start xxxxxx] *)
let len_middle = b.start - b.stop in
assert (len_middle >= len);
Array.blit from_buf o b.buf b.stop len;
b.stop <- b.stop + len
end;
()
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
(*$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'))
*)
(*$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 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
then
let n = min (b.stop - b.start) len in
let _ = Array.blit b.buf b.start to_buf o n in
n
else begin
let len_end = Array.length b.buf - b.start in
Array.blit b.buf b.start to_buf o (min len_end len);
if len_end >= len
then len (* done *)
else begin
let n = min b.stop (len - len_end) in
Array.blit b.buf 0 to_buf (o+len_end) n;
n + len_end
end
end
(*$Q
Q.printable_string (fun s -> \
let b = ByteBuffer.create (Bytes.length s) in \
ByteBuffer.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 \
to_buf = s && len = Bytes.length s)
*)
let clear b =
b.stop <- 0;
b.start <- 0;
()
(*$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 reset b =
clear b;
b.buf <- Array.empty
(*$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 is_empty b = b.start = b.stop
(*$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 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
then b.start <- 0
else b.start <- b.start + 1;
c
(*$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 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)
(*$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 junk_front 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
(*$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 junk_back b =
if b.start = b.stop then raise Empty;
if b.stop = 0
then b.stop <- Array.length b.buf - 1
else b.stop <- 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 () = ByteBuffer.junk_back b in \
s_len - 1 = ByteBuffer.length b with ByteBuffer.Empty -> s_len = 0)
*)
let skip b len =
if len > length b then raise (Invalid_argument
("CCRingBufferIO.skip: " ^ string_of_int len));
if b.stop >= b.start
then b.start <- b.start + len
else
let len_end = Array.length b.buf - b.start in
if len > len_end
then b.start <- len-len_end (* wrap to the beginning *)
else b.start <- b.start + len
(*$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 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 (
for i = b.start to Array.length b.buf -1 do f i b.buf.(i) done;
for i = 0 to b.stop - 1 do f i b.buf.(i) done;
)
(*$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 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))
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))
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))
else
get b i
(*$Q
(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 \
front = Bytes.get s index)
*)
let get_back b i =
let offset = ((length b) - i - 1) in
if offset < 0 then
raise (Invalid_argument ("CCRingBuffer.get_back:" ^ string_of_int i))
else get b offset
(*$Q
(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 \
back = Bytes.get s (s_len - index - 1))
*)
let to_list b =
let len = length b in
let rec build l i =
if i < 0 then l else
build ((get_front b i)::l) (i-1) in
build [] (len-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; \
let l = ByteBuffer.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 \
explode s = l)
*)
let push_back b e = blit_from b (Array.make 1 e) 0 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; \
ByteBuffer.push_back b 'X'; \
ByteBuffer.peek_back b = 'X')
*)
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 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)
*)
end
module ByteBuffer = Make_array(Array.ByteArray)
module Make(Elt:sig type t end) = Make_array(Array.Make(Elt))

211
src/data/CCRingBuffer.mli Normal file
View file

@ -0,0 +1,211 @@
(**
* CCRingBuffer - Polymorphic Circular Buffer
* Copyright (C) 2015 Simon Cruanes, Carmelo Piccione
*
* This library is free software; you can redistribute it and/or
* modify it under the terms of the GNU Lesser General Public
* License as published by the Free Software Foundation; either
* version 2.1 of the License, or (at your option) any later version,
* with the special exception on linking described in file LICENSE.
*
* This library is distributed in the hope that it will be useful,
* but WITHOUT ANY WARRANTY; without even the implied warranty of
* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
* Lesser General Public License for more details.
*
* You should have received a copy of the GNU Lesser General Public
* License along with this library; if not, write to the Free Software
* Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
*)
(** {1 Circular Buffer (Deque)}
Useful for IO, or as a general-purpose alternative to {!Queue} when
batch operations are needed.
@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
(** 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
(** 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
(** Makes an array given an arbitrary element type *)
module Make :
functor (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
(** 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
}
(** 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
(** Take the last value from back of [t].
@raise Empty if buffer is already empty. *)
val take_front : 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
(** Makes a ring buffer module given the element type *)
module Make: functor(Elt:sig type t end) -> S with module Array = Array.Make(Elt)