diff --git a/_oasis b/_oasis index ff6f9d02..f3113494 100644 --- a/_oasis +++ b/_oasis @@ -70,7 +70,7 @@ Library "containers_data" Path: src/data Modules: CCMultiMap, CCMultiSet, CCTrie, CCFlatHashtbl, CCCache, CCPersistentHashtbl, CCDeque, CCFQueue, CCBV, CCMixtbl, - CCMixmap, CCBufferIO + CCMixmap, CCRingBuffer FindlibParent: containers FindlibName: data diff --git a/doc/intro.txt b/doc/intro.txt index 231aab21..b0bbb36a 100644 --- a/doc/intro.txt +++ b/doc/intro.txt @@ -73,6 +73,7 @@ CCMixtbl CCMultiMap CCMultiSet CCPersistentHashtbl +CCRingBuffer CCTrie } diff --git a/src/data/CCBufferIO.ml b/src/data/CCBufferIO.ml deleted file mode 100644 index 58264d4f..00000000 --- a/src/data/CCBufferIO.ml +++ /dev/null @@ -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] - - diff --git a/src/data/CCBufferIO.mli b/src/data/CCBufferIO.mli deleted file mode 100644 index c3c12fd4..00000000 --- a/src/data/CCBufferIO.mli +++ /dev/null @@ -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]) *) diff --git a/src/data/CCRingBuffer.ml b/src/data/CCRingBuffer.ml new file mode 100644 index 00000000..b1507052 --- /dev/null +++ b/src/data/CCRingBuffer.ml @@ -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)) diff --git a/src/data/CCRingBuffer.mli b/src/data/CCRingBuffer.mli new file mode 100644 index 00000000..f98a712c --- /dev/null +++ b/src/data/CCRingBuffer.mli @@ -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)