functorize ring buffer over ARRAY sig

src/data/CCRingBuffer.ml

@@ -22,17 +22,42 @@
 
 (** Polymorphic Circular Buffer for IO *)
 
-type 'a t = {
+module type ARRAY = sig
+  type elt
+  type t
+
+  val make: int -> elt -> t
+  val length: t -> int
+
+  val get: t -> int -> elt
+
+  val set: t -> int -> elt -> unit
+
+  val sub: t -> int -> int -> t
+  val max_length: int
+
+  val copy : t -> t
+  val of_list : elt list -> t
+  val to_list : t -> elt list
+  val blit : t -> int -> t -> int -> int -> unit
+
+  val iter : (elt -> unit) -> t -> unit
+end
+
+module Make(Array:ARRAY) =
+struct
+
+  type t = {
     mutable start : int;
     mutable stop : int; (* excluded *)
-  mutable buf : 'a array;
+    mutable buf : Array.t;
     bounded : bool;
     size : int
-}
+  }
 
-exception Empty
+  exception Empty
 
-let create ?(bounded=false) size =
+  let create ?(bounded=false) size =
     { start=0;
       stop=0;
       bounded;
@@ -40,21 +65,21 @@ let create ?(bounded=false) size =
       buf = Array.of_list []
     }
 
-let copy b =
+  let copy b =
     { b with buf=Array.copy b.buf; }
 
 
-let capacity b = Array.length b.buf
+  let capacity b = Array.length b.buf
 
-let max_capacity b = if b.bounded then Some b.size else None
+  let max_capacity b = if b.bounded then Some b.size else None
 
-let length b =
+  let length b =
     if b.stop >= b.start
     then b.stop - b.start
     else (Array.length b.buf - b.start) + b.stop
 
-(* resize [b] so that inner capacity is [cap] *)
+  (* resize [b] so that inner capacity is [cap] *)
-let resize b cap elem =
+  let resize b cap elem =
     assert (cap >= Array.length b.buf);
     let buf' = Array.make cap elem in
     (* copy into buf' *)
@@ -72,7 +97,7 @@ let resize b cap elem =
     in
     b.buf <- buf'
 
-let blit_from_bounded b from_buf o len =
+  let blit_from_bounded b from_buf o len =
     let cap = capacity b - len in
     (* resize if needed, with a constant to amortize *)
     if cap < len then begin
@@ -94,7 +119,7 @@ let blit_from_bounded b from_buf o len =
     Array.iter iter sub
 
 
-let blit_from_unbounded b from_buf o len =
+  let blit_from_unbounded b from_buf o len =
     let cap = capacity b - len in
     (* resize if needed, with a constant to amortize *)
     if cap < len then resize b (max b.size (Array.length b.buf + len + 24)) from_buf.(0);
@@ -116,14 +141,14 @@ let blit_from_unbounded b from_buf o len =
     end;
     ()
 
-let blit_from b from_buf o len =
+  let blit_from b from_buf o len =
     if (Array.length from_buf) = 0 then () else
     if b.bounded then
       blit_from_bounded b from_buf o len
     else
       blit_from_unbounded b from_buf o len
 
-let blit_into b to_buf o len =
+  let blit_into b to_buf o len =
     if o+len > Array.length to_buf
     then raise (Invalid_argument "BufferIO.blit_into");
     if b.stop >= b.start
@@ -143,30 +168,30 @@ let blit_into b to_buf o len =
       end
     end
 
-let add b s = blit_from b s 0 (Array.length s)
+  let add b s = blit_from b s 0 (Array.length s)
 
-(*$Q
+  (*$Q
     (Q.pair Q.printable_string Q.printable_string) (fun (s,s') -> \
     let b = create 24 in add b s; add_string b s'; \
     Array.length s + String.length s' = length b)
-*)
+  *)
 
-let clear b =
+  let clear b =
     b.stop <- 0;
     b.start <- 0;
     ()
 
-let reset b =
+  let reset b =
     clear b;
     b.buf <- Array.of_list []
 
-let is_empty b = b.start = b.stop
+  let is_empty b = b.start = b.stop
 
-let next b =
+  let next b =
     if b.start = b.stop then raise Empty;
     b.buf.(b.start)
 
-let take_front b =
+  let take_front b =
     if b.start = b.stop then raise Empty;
     let c = b.buf.(b.start) in
     if b.start + 1 = Array.length b.buf
@@ -174,20 +199,20 @@ let take_front b =
     else b.start <- b.start + 1;
     c
 
-let take_back b =
+  let take_back b =
     if b.start = b.stop then raise Empty;
     if b.stop - 1 = 0
     then b.stop <- Array.length b.buf - 1
     else b.stop <- b.stop - 1;
     b.buf.(b.stop)
 
-let junk b =
+  let junk b =
     if b.start = b.stop then raise Empty;
     if b.start + 1 = Array.length b.buf
     then b.start <- 0
     else b.start <- b.start + 1
 
-let skip b len =
+  let skip b len =
     if len > length b then raise (Invalid_argument "BufferIO.skip");
     if b.stop >= b.start
     then b.start <- b.start + len
@@ -197,15 +222,15 @@ let skip b len =
       then b.start <- len-len_end  (* wrap to the beginning *)
       else b.start <- b.start + len
 
-(*$Q
+  (*$Q
     (Q.pair Q.printable_string Q.printable_string) (fun (s,s') -> \
     let b = create 24 in add_string b s; add_string b s'; \
     add_string b "hello world"; (* big enough *) \
     let l = length b in let l' = l/2 in skip b l'; \
     length b + l' = l)
-*)
+  *)
 
-let iteri b f =
+  let iteri b f =
     if b.stop >= b.start
     then for i = b.start to b.stop - 1 do f i b.buf.(i) done
     else (
@@ -213,13 +238,13 @@ let iteri b f =
       for i = 0 to b.stop - 1 do f i b.buf.(i) done;
     )
 
-(*$T
+  (*$T
     let s = "hello world" in \
     let b = of_string s in \
     try iteri b (fun i c -> if s.[i] <> c then raise Exit); true with Exit -> false
-*)
+  *)
 
-let get b i =
+  let get b i =
     if b.stop >= b.start
     then
       if i >= b.stop - b.start
@@ -233,23 +258,19 @@ let get b i =
       then raise (Invalid_argument "BufferIO.get")
       else b.buf.(i - len_end)
 
-let to_list b =
+  let to_list b =
     if (b.stop >= b.start) 
     then Array.to_list (Array.sub b.buf b.start (b.stop-b.start))
     else List.append 
            (Array.to_list (Array.sub b.buf b.start (Array.length b.buf - b.start)))
            (Array.to_list (Array.sub b.buf 0 b.stop)) 
 
-let push_back b e = add b (Array.of_list [e])
+  let push_back b e = add b (Array.of_list [e])
 
-let peek_front b = if is_empty b then 
+  let peek_front b = if is_empty b then 
       raise Empty else Array.get b.buf b.start
 
-let peek_back b = if is_empty b then
+  let peek_back b = if is_empty b then
       raise Empty else Array.get b.buf 
                          (if b.stop = 0 then capacity b - 1 else b.stop-1)
-
+end
-
-
-
-

src/data/CCRingBuffer.mli

@@ -20,89 +20,115 @@
 
 (** Circular Polymorphic Buffer for IO *)
 
-type 'a t = private {
+module type ARRAY = sig
+  type elt
+  type t
+
+  val make: int -> elt -> t
+  val length: t -> int
+
+  val get: t -> int -> elt
+
+  val set: t -> int -> elt -> unit
+
+  val sub: t -> int -> int -> t
+  val max_length: int
+
+  val copy : t -> t
+  val of_list : elt list -> t
+  val to_list : t -> elt list
+  val blit : t -> int -> t -> int -> int -> unit
+
+  val iter : (elt -> unit) -> t -> unit
+end
+
+
+module Make : functor (Array:ARRAY) ->
+sig
+
+  type t = private {
     mutable start : int;
     mutable stop : int; (* excluded *)
-  mutable buf : 'a array;
+    mutable buf : Array.t;
     bounded: bool;
     size : int
-}
+  }
 
-exception Empty
+  exception Empty
 
-val create : ?bounded:bool -> int -> 'a t
+  val create : ?bounded:bool -> int -> t
-(** [create ?bounded size] creates a new buffer with given size.
+  (** [create ?bounded size] creates a new buffer with given size.
       Defaults to [bounded=false]. *)
 
-val copy : 'a t ->'a  t
+  val copy : t -> t
-(** fresh copy of the buffer *)
+  (** fresh copy of the buffer *)
 
-val capacity : 'a t -> int
+  val capacity : t -> int
-(** length of the inner buffer *)
+  (** length of the inner buffer *)
 
-val max_capacity : 'a t -> int option
+  val max_capacity : t -> int option
-(** maximum length of the inner buffer, or [None] if unbounded. *)
+  (** maximum length of the inner buffer, or [None] if unbounded. *)
 
-val length : 'a t -> int
+  val length : t -> int
-(** number of elements currently stored in the buffer *)
+  (** number of elements currently stored in the buffer *)
 
-val blit_from : 'a t -> 'a array -> 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
+  (** [blit_from buf from_buf o len] copies the slice [o, ... o + len - 1] from
       a input buffer [from_buf] to the end of the buffer.
       @raise Invalid_argument if [o,len] is not a valid slice of [s] *)
 
-val blit_into : 'a t -> 'a array -> int -> int -> int
+  val blit_into : t ->  Array.t -> int -> int -> int
-(** [blit_into buf to_buf o len] copies at most [len] elements from [buf]
+  (** [blit_into buf to_buf o len] copies at most [len] elements from [buf]
       into [to_buf] starting at offset [o] in [s].
       @return the number of elements actually copied ([min len (length buf)]).
       @raise Invalid_argument if [o,len] is not a valid slice of [s] *)
 
-val to_list : 'a t -> 'a list
+  val to_list : t -> Array.elt list
-(** extract the current content into a list *)
+  (** extract the current content into a list *)
 
-val clear : 'a t -> unit
+  val clear : t -> unit
-(** clear the content of the buffer. Doesn't actually destroy the content. *)
+  (** clear the content of the buffer. Doesn't actually destroy the content. *)
 
-val reset : 'a t -> unit
+  val reset : t -> unit
-(** clear the content of the buffer, and also resize it to a default size *)
+  (** clear the content of the buffer, and also resize it to a default size *)
 
-val is_empty :'a t -> bool
+  val is_empty :t -> bool
-(** is the buffer empty (i.e. contains no elements)? *)
+  (** is the buffer empty (i.e. contains no elements)? *)
 
-val next : 'a t -> 'a
+  val next : t -> Array.elt
-(** obtain next element (the first one of the buffer)
+  (** obtain next element (the first one of the buffer)
       @raise Empty if the buffer is empty *)
 
-val junk : 'a t -> unit
+  val junk : t -> unit
-(** Drop next element.
+  (** Drop next element.
       @raise Empty if the buffer is already empty *)
 
-val skip : 'a t -> int -> unit
+  val skip : t -> int -> unit
-(** [skip b len] removes [len] elements from [b].
+  (** [skip b len] removes [len] elements from [b].
       @raise Invalid_argument if [len > length b]. *)
 
-val iteri : 'a t -> (int -> 'a -> 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]
+  (** [iteri b f] calls [f i t] for each element [t] in [buf], with [i]
       being its relative index within [buf]. *)
 
-val get : 'a t -> int -> 'a
+  val get : t -> int -> Array.elt
-(** [get buf i] returns the [i]-th element of [buf], ie the one that
+  (** [get buf i] returns the [i]-th element of [buf], ie the one that
       is returned by [next buf] after [i-1] calls to [junk buf].
       @raise Invalid_argument if the index is invalid (> [length buf]) *)
 
-val push_back : 'a t -> 'a -> unit
+  val push_back : t -> Array.elt -> unit
   (** Push value at the back *)
 
-val peek_front : 'a t -> 'a
+  val peek_front : t -> Array.elt
   (** First value, or Empty *)
 
-val peek_back : 'a t -> 'a
+  val peek_back : t -> Array.elt
   (** Last value, or Empty *)
 
-val take_back : 'a t -> 'a
+  val take_back : t -> Array.elt
   (** Take last value, or raise Empty *)
 
-val take_front : 'a t -> 'a
+  val take_front : t -> Array.elt
   (** Take first value, or raise Empty *)
 
-
+end