From f40cdbe64f7a64ea2e47b0db8961755c66d989a6 Mon Sep 17 00:00:00 2001
From: Simon Cruanes <simon.cruanes.2007@m4x.org>
Date: Thu, 29 Jan 2015 00:35:34 +0100
Subject: [PATCH 01/72] add CCRef module

---
 _oasis             |  2 +-
 doc/intro.txt      |  1 +
 src/core/CCRef.ml  | 56 +++++++++++++++++++++++++++++++++++++++++++
 src/core/CCRef.mli | 59 ++++++++++++++++++++++++++++++++++++++++++++++
 4 files changed, 117 insertions(+), 1 deletion(-)
 create mode 100644 src/core/CCRef.ml
 create mode 100644 src/core/CCRef.mli

diff --git a/_oasis b/_oasis
index b348e689..90e512cb 100644
--- a/_oasis
+++ b/_oasis
@@ -48,7 +48,7 @@ Flag "advanced"
 Library "containers"
   Path:             src/core
   Modules:          CCVector, CCPrint, CCError, CCHeap, CCList, CCOpt, CCPair,
-                    CCFun, CCHash, CCInt, CCBool, CCFloat, CCArray,
+                    CCFun, CCHash, CCInt, CCBool, CCFloat, CCArray, CCRef,
                     CCOrd, CCRandom, CCString, CCHashtbl, CCMap, CCFormat
   BuildDepends:     bytes
 
diff --git a/doc/intro.txt b/doc/intro.txt
index edbad184..400e2e7c 100644
--- a/doc/intro.txt
+++ b/doc/intro.txt
@@ -40,6 +40,7 @@ CCOrd
 CCPair
 CCPrint
 CCRandom
+CCRef
 CCString
 CCVector
 }
diff --git a/src/core/CCRef.ml b/src/core/CCRef.ml
new file mode 100644
index 00000000..136d0cfe
--- /dev/null
+++ b/src/core/CCRef.ml
@@ -0,0 +1,56 @@
+
+(*
+copyright (c) 2013-2014, simon cruanes
+all rights reserved.
+
+redistribution and use in source and binary forms, with or without
+modification, are permitted provided that the following conditions are met:
+
+redistributions of source code must retain the above copyright notice, this
+list of conditions and the following disclaimer.  redistributions in binary
+form must reproduce the above copyright notice, this list of conditions and the
+following disclaimer in the documentation and/or other materials provided with
+the distribution.
+
+THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" AND
+ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED
+WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE
+DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDER OR CONTRIBUTORS BE LIABLE
+FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL
+DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR
+SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER
+CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY,
+OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE
+OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+*)
+
+(** {1 References} *)
+
+type 'a print = Format.formatter -> 'a -> unit
+type 'a pp = Buffer.t -> 'a -> unit
+type 'a ord = 'a -> 'a -> int
+type 'a eq = 'a -> 'a -> bool
+type 'a sequence = ('a -> unit) -> unit
+
+type 'a t = 'a ref
+
+let create x = ref x
+
+let map f r = ref (f !r)
+
+let iter f r = f !r
+
+let update f r = r := (f !r)
+
+let compare f r1 r2 = f !r1 !r2
+
+let equal f r1 r2 = f !r1 !r2
+
+let to_list r = [!r]
+let to_seq r yield = yield !r
+
+let print pp_x fmt r = pp_x fmt !r
+
+let pp pp_x buf r = pp_x buf !r
+
+
diff --git a/src/core/CCRef.mli b/src/core/CCRef.mli
new file mode 100644
index 00000000..475c0d97
--- /dev/null
+++ b/src/core/CCRef.mli
@@ -0,0 +1,59 @@
+
+(*
+copyright (c) 2013-2014, simon cruanes
+all rights reserved.
+
+redistribution and use in source and binary forms, with or without
+modification, are permitted provided that the following conditions are met:
+
+redistributions of source code must retain the above copyright notice, this
+list of conditions and the following disclaimer.  redistributions in binary
+form must reproduce the above copyright notice, this list of conditions and the
+following disclaimer in the documentation and/or other materials provided with
+the distribution.
+
+THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" AND
+ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED
+WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE
+DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDER OR CONTRIBUTORS BE LIABLE
+FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL
+DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR
+SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER
+CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY,
+OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE
+OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+*)
+
+(** {1 References} *)
+
+type 'a print = Format.formatter -> 'a -> unit
+type 'a pp = Buffer.t -> 'a -> unit
+type 'a ord = 'a -> 'a -> int
+type 'a eq = 'a -> 'a -> bool
+type 'a sequence = ('a -> unit) -> unit
+
+type 'a t = 'a ref
+
+val map : ('a -> 'b) -> 'a t -> 'b t
+(** Transform the value *)
+
+val create : 'a -> 'a t
+(** Alias to {!ref} *)
+
+val iter : ('a -> unit) -> 'a t -> unit
+(** Call the function on the content of the reference *)
+
+val update : ('a -> 'a) -> 'a t -> unit
+(** Update the reference's content with the given function *)
+
+val compare : 'a ord -> 'a t ord
+
+val equal : 'a eq -> 'a t eq
+
+val to_list : 'a t -> 'a list
+
+val to_seq : 'a t -> 'a sequence
+
+val print : 'a print -> 'a t print
+val pp : 'a pp -> 'a t pp
+

From 5404d018142730af49e9f4cc95b0335ac2d895e7 Mon Sep 17 00:00:00 2001
From: Simon Cruanes <simon.cruanes.2007@m4x.org>
Date: Thu, 29 Jan 2015 00:42:10 +0100
Subject: [PATCH 02/72] add CCSet

---
 _oasis             |  2 +-
 doc/intro.txt      |  1 +
 src/core/CCSet.ml  | 86 ++++++++++++++++++++++++++++++++++++++++++++++
 src/core/CCSet.mli | 53 ++++++++++++++++++++++++++++
 4 files changed, 141 insertions(+), 1 deletion(-)
 create mode 100644 src/core/CCSet.ml
 create mode 100644 src/core/CCSet.mli

diff --git a/_oasis b/_oasis
index 90e512cb..30340442 100644
--- a/_oasis
+++ b/_oasis
@@ -48,7 +48,7 @@ Flag "advanced"
 Library "containers"
   Path:             src/core
   Modules:          CCVector, CCPrint, CCError, CCHeap, CCList, CCOpt, CCPair,
-                    CCFun, CCHash, CCInt, CCBool, CCFloat, CCArray, CCRef,
+                    CCFun, CCHash, CCInt, CCBool, CCFloat, CCArray, CCRef, CCSet,
                     CCOrd, CCRandom, CCString, CCHashtbl, CCMap, CCFormat
   BuildDepends:     bytes
 
diff --git a/doc/intro.txt b/doc/intro.txt
index 400e2e7c..631dec78 100644
--- a/doc/intro.txt
+++ b/doc/intro.txt
@@ -41,6 +41,7 @@ CCPair
 CCPrint
 CCRandom
 CCRef
+CCSet
 CCString
 CCVector
 }
diff --git a/src/core/CCSet.ml b/src/core/CCSet.ml
new file mode 100644
index 00000000..5abed74a
--- /dev/null
+++ b/src/core/CCSet.ml
@@ -0,0 +1,86 @@
+
+(*
+copyright (c) 2013-2014, simon cruanes
+all rights reserved.
+
+redistribution and use in source and binary forms, with or without
+modification, are permitted provided that the following conditions are met:
+
+redistributions of source code must retain the above copyright notice, this
+list of conditions and the following disclaimer.  redistributions in binary
+form must reproduce the above copyright notice, this list of conditions and the
+following disclaimer in the documentation and/or other materials provided with
+the distribution.
+
+THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" AND
+ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED
+WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE
+DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDER OR CONTRIBUTORS BE LIABLE
+FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL
+DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR
+SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER
+CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY,
+OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE
+OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+*)
+
+(** {1 Wrapper around Set} *)
+
+type 'a sequence = ('a -> unit) -> unit
+type 'a printer = Buffer.t -> 'a -> unit
+type 'a formatter = Format.formatter -> 'a -> unit
+
+module type S = sig
+  include Set.S
+
+  val of_seq : elt sequence -> t
+
+  val to_seq : t -> elt sequence
+
+  val of_list : elt list -> t
+
+  val to_list : t -> elt list
+
+  val pp : ?start:string -> ?stop:string -> ?sep:string ->
+            elt printer -> t printer
+
+  val print : ?start:string -> ?stop:string -> ?sep:string ->
+              elt formatter -> t formatter
+end
+
+module Make(O : Map.OrderedType) = struct
+  include Set.Make(O)
+
+  let of_seq s =
+    let set = ref empty  in
+    s (fun x -> set := add x !set);
+    !set
+
+  let to_seq s yield = iter yield s
+
+  let of_list l = List.fold_left (fun set x -> add x set) empty l
+
+  let to_list = elements
+
+  let pp ?(start="{") ?(stop="}") ?(sep=", ") pp_x buf m =
+    let first = ref true in
+    Buffer.add_string buf start;
+    iter
+      (fun x ->
+        if !first then first := false else Buffer.add_string buf sep;
+        pp_x buf x;
+      ) m;
+    Buffer.add_string buf stop
+
+  let print ?(start="[") ?(stop="]") ?(sep=", ") pp_x fmt m =
+    Format.pp_print_string fmt start;
+    let first = ref true in
+    iter
+      (fun x ->
+        if !first then first := false else Format.pp_print_string fmt sep;
+        pp_x fmt x;
+        Format.pp_print_cut fmt ()
+      ) m;
+    Format.pp_print_string fmt stop
+end
+
diff --git a/src/core/CCSet.mli b/src/core/CCSet.mli
new file mode 100644
index 00000000..cc396ddc
--- /dev/null
+++ b/src/core/CCSet.mli
@@ -0,0 +1,53 @@
+
+(*
+copyright (c) 2013-2014, simon cruanes
+all rights reserved.
+
+redistribution and use in source and binary forms, with or without
+modification, are permitted provided that the following conditions are met:
+
+redistributions of source code must retain the above copyright notice, this
+list of conditions and the following disclaimer.  redistributions in binary
+form must reproduce the above copyright notice, this list of conditions and the
+following disclaimer in the documentation and/or other materials provided with
+the distribution.
+
+THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" AND
+ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED
+WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE
+DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDER OR CONTRIBUTORS BE LIABLE
+FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL
+DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR
+SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER
+CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY,
+OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE
+OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+*)
+
+(** {1 Wrapper around Set} *)
+
+type 'a sequence = ('a -> unit) -> unit
+type 'a printer = Buffer.t -> 'a -> unit
+type 'a formatter = Format.formatter -> 'a -> unit
+
+module type S = sig
+  include Set.S
+
+  val of_seq : elt sequence -> t
+
+  val to_seq : t -> elt sequence
+
+  val of_list : elt list -> t
+
+  val to_list : t -> elt list
+
+  val pp : ?start:string -> ?stop:string -> ?sep:string ->
+            elt printer -> t printer
+
+  val print : ?start:string -> ?stop:string -> ?sep:string ->
+              elt formatter -> t formatter
+end
+
+module Make(O : Set.OrderedType) : S
+  with type t = Set.Make(O).t
+  and type elt = O.t

From a1a8a8252ce9fc207773f60881cd0aa72b603939 Mon Sep 17 00:00:00 2001
From: Simon Cruanes <simon.cruanes.2007@m4x.org>
Date: Thu, 29 Jan 2015 00:42:42 +0100
Subject: [PATCH 03/72] @since tags

---
 src/core/CCRef.mli | 3 ++-
 src/core/CCSet.mli | 3 ++-
 2 files changed, 4 insertions(+), 2 deletions(-)

diff --git a/src/core/CCRef.mli b/src/core/CCRef.mli
index 475c0d97..e0d74cd6 100644
--- a/src/core/CCRef.mli
+++ b/src/core/CCRef.mli
@@ -24,7 +24,8 @@ OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE
 OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
 *)
 
-(** {1 References} *)
+(** {1 References}
+@since NEXT_RELEASE *)
 
 type 'a print = Format.formatter -> 'a -> unit
 type 'a pp = Buffer.t -> 'a -> unit
diff --git a/src/core/CCSet.mli b/src/core/CCSet.mli
index cc396ddc..9261505b 100644
--- a/src/core/CCSet.mli
+++ b/src/core/CCSet.mli
@@ -24,7 +24,8 @@ OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE
 OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
 *)
 
-(** {1 Wrapper around Set} *)
+(** {1 Wrapper around Set}
+@since NEXT_RELEASE *)
 
 type 'a sequence = ('a -> unit) -> unit
 type 'a printer = Buffer.t -> 'a -> unit

From 21c90a209de6fc48e290c7e1714bc9c6509cbfc8 Mon Sep 17 00:00:00 2001
From: Simon Cruanes <simon.cruanes.2007@m4x.org>
Date: Fri, 30 Jan 2015 19:11:05 +0100
Subject: [PATCH 04/72] wip: Lwt_klist, a functional stream for Lwt

---
 _oasis                |   4 +-
 src/lwt/lwt_klist.ml  | 159 ++++++++++++++++++++++++++++++++++++++++++
 src/lwt/lwt_klist.mli |  88 +++++++++++++++++++++++
 3 files changed, 249 insertions(+), 2 deletions(-)
 create mode 100644 src/lwt/lwt_klist.ml
 create mode 100644 src/lwt/lwt_klist.mli

diff --git a/_oasis b/_oasis
index 30340442..7e197a54 100644
--- a/_oasis
+++ b/_oasis
@@ -131,7 +131,7 @@ Library "containers_thread"
 
 Library "containers_lwt"
   Path:             src/lwt
-  Modules:          Lwt_automaton, Lwt_actor
+  Modules:          Lwt_automaton, Lwt_actor, Lwt_klist
   Pack:             true
   FindlibName:      lwt
   FindlibParent:    containers
@@ -192,7 +192,7 @@ Executable run_qtest
   Install:          false
   CompiledObject:   native
   MainIs:           run_qtest.ml
-  Build$:           flag(tests)
+  Build$:           flag(tests) && flag(bigarray)
   BuildDepends:     containers, containers.misc, containers.string, containers.iter,
                     containers.io, containers.advanced, containers.sexp,
                     containers.bigarray,
diff --git a/src/lwt/lwt_klist.ml b/src/lwt/lwt_klist.ml
new file mode 100644
index 00000000..30b3154b
--- /dev/null
+++ b/src/lwt/lwt_klist.ml
@@ -0,0 +1,159 @@
+
+(*
+copyright (c) 2013-2014, simon cruanes
+all rights reserved.
+
+redistribution and use in source and binary forms, with or without
+modification, are permitted provided that the following conditions are met:
+
+redistributions of source code must retain the above copyright notice, this
+list of conditions and the following disclaimer.  redistributions in binary
+form must reproduce the above copyright notice, this list of conditions and the
+following disclaimer in the documentation and/or other materials provided with
+the distribution.
+
+THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" AND
+ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED
+WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE
+DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDER OR CONTRIBUTORS BE LIABLE
+FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL
+DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR
+SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER
+CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY,
+OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE
+OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+*)
+
+(** {1 Functional streams for Lwt} *)
+
+type 'a t = [ `Nil | `Cons of 'a * (unit -> 'a t) ] Lwt.t
+type 'a stream = 'a t
+
+let (>>=) = Lwt.(>>=)
+let (>|=) = Lwt.(>|=)
+
+let empty = Lwt.return `Nil
+
+let cons x l = Lwt.return (`Cons (x, fun () -> l))
+
+let rec of_list_rec l () = match l with
+  | [] -> empty
+  | x :: tl -> Lwt.return (`Cons (x, of_list_rec tl))
+
+let of_list l : 'a t = of_list_rec l ()
+
+let rec create_rec f () : 'a t =
+  f () >|= function
+  | None -> `Nil
+  | Some x -> `Cons (x, create_rec f)
+
+let create f = create_rec f ()
+
+let next l =
+  l >|= function
+  | `Nil -> None
+  | `Cons (x, tl) -> Some (x, tl())
+
+let next_exn l =
+  l >>= function
+  | `Nil -> Lwt.fail Not_found
+  | `Cons (x, tl) -> Lwt.return (x, tl ())
+
+let rec map_rec f l () =
+  l >|= function
+  | `Nil -> `Nil
+  | `Cons (x, tl) -> `Cons (f x, map_rec f (tl ()))
+
+let map f (l:'a t) : 'b t = map_rec f l ()
+
+let rec map_s_rec (f:'a -> 'b Lwt.t) l () =
+  l >>= function
+  | `Nil -> empty
+  | `Cons (x, tl) ->
+      f x >|= fun y -> `Cons (y, map_s_rec f (tl ()))
+
+let map_s f l = map_s_rec f l ()
+
+let rec append_rec l1 l2 () =
+  l1 >>= function
+  | `Nil -> l2
+  | `Cons (x, tl1) -> Lwt.return (`Cons (x, append_rec (tl1 ()) l2))
+
+let append l1 l2 = append_rec l1 l2 ()
+
+let rec flat_map f l =
+  l >>= function
+  | `Nil -> empty
+  | `Cons (x, tl) -> append (f x) (flat_map f (tl ()))
+
+let rec iter f l =
+  l >>= function
+  | `Nil -> Lwt.return_unit
+  | `Cons (x, tl) ->  f x; iter f (tl ())
+
+let rec iter_s f l =
+  l >>= function
+  | `Nil -> Lwt.return_unit
+  | `Cons (x, tl) ->  f x >>= fun () -> iter_s f (tl ())
+
+module Queue = struct
+  type 'a t = {
+    bufsize : int;
+    cond : unit Lwt_condition.t;
+    q : 'a Queue.t;
+    mutable str : 'a stream;
+    mutable closed : bool;
+  }
+
+  (* function that waits for the next element, and recursively,
+    returning a stream of values *)
+  let rec make_stream_ t () : 'a stream =
+    if t.closed then empty
+    else if not (Queue.is_empty t.q)
+      then (
+        let x = Queue.pop t.q in
+        Lwt_condition.signal t.cond ();
+        Lwt.return (`Cons (x, make_stream_ t))
+      )
+    else
+      (* wait for something to happen *)
+      Lwt_condition.wait t.cond >>= make_stream_ t
+
+  let create ?(bufsize=128) () =
+    let t = {
+      bufsize;
+      q = Queue.create ();
+      str = empty;
+      cond = Lwt_condition.create ();
+      closed = false;
+    } in
+    t.str <- make_stream_ t ();
+    t
+
+  exception ClosedQueue
+
+  let close t =
+    if not t.closed then (
+      t.closed <- true;
+      Lwt_condition.signal t.cond ()
+    )
+
+  let rec push_rec t x () =
+    if t.closed then raise ClosedQueue;
+    if Queue.length t.q = t.bufsize
+      then Lwt_condition.wait t.cond >>= push_rec t x
+    else (
+      Queue.push x t.q;
+      Lwt.return_unit
+    )
+
+  let push t x = push_rec t x ()
+
+  let to_stream t = t.str
+
+  let take t = assert false
+  let take_exn t = assert false
+
+end
+
+
diff --git a/src/lwt/lwt_klist.mli b/src/lwt/lwt_klist.mli
new file mode 100644
index 00000000..766de3f6
--- /dev/null
+++ b/src/lwt/lwt_klist.mli
@@ -0,0 +1,88 @@
+
+(*
+copyright (c) 2013-2014, simon cruanes
+all rights reserved.
+
+redistribution and use in source and binary forms, with or without
+modification, are permitted provided that the following conditions are met:
+
+redistributions of source code must retain the above copyright notice, this
+list of conditions and the following disclaimer.  redistributions in binary
+form must reproduce the above copyright notice, this list of conditions and the
+following disclaimer in the documentation and/or other materials provided with
+the distribution.
+
+THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" AND
+ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED
+WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE
+DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDER OR CONTRIBUTORS BE LIABLE
+FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL
+DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR
+SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER
+CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY,
+OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE
+OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+*)
+
+(** {1 Functional streams for Lwt} *)
+
+type 'a t = [ `Nil | `Cons of 'a * (unit -> 'a t) ] Lwt.t
+type 'a stream = 'a t
+
+val empty : 'a t
+
+val cons : 'a -> 'a t -> 'a t
+
+val of_list : 'a list -> 'a t
+
+val create : (unit -> 'a option Lwt.t) -> 'a t
+(** Create from a function that returns the next element *)
+
+val next : 'a t -> ('a * 'a t) option Lwt.t
+(** Obtain the next element *)
+
+val next_exn : 'a t -> ('a * 'a t) Lwt.t
+(** Obtain the next element or fail
+    @raise Not_found if the stream is empty *)
+
+val map : ('a -> 'b) -> 'a t -> 'b t
+val map_s : ('a -> 'b Lwt.t) -> 'a t -> 'b t
+
+val append : 'a t -> 'a t -> 'a t
+
+val flat_map : ('a -> 'b t) -> 'a t -> 'b t
+
+val iter : ('a -> unit) -> 'a t -> unit Lwt.t
+val iter_s : ('a -> unit Lwt.t) -> 'a t -> unit Lwt.t
+
+(** {2 Bounded Queue} *)
+module Queue : sig
+  type 'a t
+
+  val create : ?bufsize:int -> unit -> 'a t
+  (** Create a new queue, with the given internal buffer size.
+      If [bufsize=0] the queue is fully blocking *)
+
+  exception ClosedQueue
+
+  val close : _ t -> unit
+  (** Close the queue. Elements remaining in the queue will be available for
+      consumption, say, by {!get}; pushing an element will raise {!ClosedQueue} *)
+
+  val push : 'a t -> 'a -> unit Lwt.t
+  (** Push an element at the back of the queue. Returns immediately
+      if the queue isn't full, blocks until an element is consumed otherwise *)
+
+  val take : 'a t -> 'a option Lwt.t
+  (** Take the next element. May block if no element is currently available. *)
+
+  val take_exn : 'a t -> 'a Lwt.t
+  (** Same as {!get} but fails if the queue is closed.
+      @raise ClosedQueue if the queue gets closed before an element is pushed *)
+
+  val to_stream : 'a t -> 'a stream
+  (** Stream of elements pushed into the queue *)
+
+  (* TODO: fix semantics; e.g. notion of "cursor" with several cursors
+      on one queue *)
+end

From ceca7b634386a34e8cb7c5ad734837a1d8b4bbc5 Mon Sep 17 00:00:00 2001
From: Simon Cruanes <simon.cruanes.2007@m4x.org>
Date: Mon, 2 Feb 2015 15:28:18 +0100
Subject: [PATCH 05/72] fix CCFormat.seq combinator

---
 src/core/CCFormat.ml | 5 ++++-
 1 file changed, 4 insertions(+), 1 deletion(-)

diff --git a/src/core/CCFormat.ml b/src/core/CCFormat.ml
index 5bff0275..0af423c3 100644
--- a/src/core/CCFormat.ml
+++ b/src/core/CCFormat.ml
@@ -82,7 +82,10 @@ let seq ?(start="[") ?(stop="]") ?(sep=", ") pp fmt seq =
   Format.pp_print_string fmt start;
   let first = ref true in
   seq (fun x ->
-    (if !first then first := false else Format.pp_print_string fmt sep);
+    (if !first then first := false else (
+      Format.pp_print_string fmt sep;
+      Format.pp_print_cut fmt ();
+    ));
     pp fmt x);
   Format.pp_print_string fmt stop
 

From 438c57e8475e6624062ed3f6a10db5fe2dd0d3be Mon Sep 17 00:00:00 2001
From: Simon Cruanes <simon.cruanes.2007@m4x.org>
Date: Wed, 4 Feb 2015 09:15:57 +0100
Subject: [PATCH 06/72] a few tests for CCCache.lru

---
 src/data/CCCache.ml | 18 ++++++++++++++++++
 1 file changed, 18 insertions(+)

diff --git a/src/data/CCCache.ml b/src/data/CCCache.ml
index e65b2e2f..2c1d152e 100644
--- a/src/data/CCCache.ml
+++ b/src/data/CCCache.ml
@@ -293,6 +293,24 @@ let lru (type a) ?(eq=default_eq_) ?(hash=default_hash_) size =
     iter=L.iter c;
   }
 
+(*$T
+  let eq (i1,_)(i2,_) = i1=i2 and hash (i,_) = CCInt.hash i in \
+  let c = lru ~eq ~hash 2 in \
+  ignore (with_cache c CCFun.id (1, true)); \
+  ignore (with_cache c CCFun.id (1, false)); \
+  with_cache c CCFun.id (1, false) = (1, true)
+*)
+
+(*$T
+  let f = (let r = ref 0 in fun _ -> incr r; !r) in \
+  let c = lru 2 in \
+  let res1 = with_cache c f 1 in \
+  let res2 = with_cache c f 2 in \
+  let res3 = with_cache c f 3 in \
+  let res1_bis = with_cache c f 1 in \
+  res1 <> res2 && res2 <> res3 && res3 <> res1_bis && res1_bis <> res1
+*)
+
 module UNBOUNDED(X:HASH) = struct
   module H = Hashtbl.Make(X)
 

From 9d2e369732d62650fc755be5cedddfba5409e866 Mon Sep 17 00:00:00 2001
From: Simon Cruanes <simon.cruanes.2007@m4x.org>
Date: Wed, 4 Feb 2015 12:57:36 +0100
Subject: [PATCH 07/72] document some invariants in CCCache (see #38)

---
 src/data/CCCache.ml | 7 +++++++
 1 file changed, 7 insertions(+)

diff --git a/src/data/CCCache.ml b/src/data/CCCache.ml
index 2c1d152e..f5c85cd3 100644
--- a/src/data/CCCache.ml
+++ b/src/data/CCCache.ml
@@ -33,6 +33,13 @@ let default_hash_ = Hashtbl.hash
 
 (** {2 Value interface} *)
 
+(** Invariants:
+  - after [cache.set x y], [get cache x] must return [y] or raise [Not_found]
+  - [cache.set x y] is only called if [get cache x] fails, never if [x] is already bound
+  - [cache.size()] must be positive and correspond to the number of items in [cache.iter]
+  - [cache.iter f] calls [f x y] with every [x] such that [cache.get x = y]
+  - after [cache.clear()], [cache.get x] fails for every [x]
+*)
 type ('a,'b) t = {
   set : 'a -> 'b -> unit;
   get : 'a -> 'b;  (* or raise Not_found *)

From 93119a47e75d4a4d64be5506e5d8ae5c7bb35562 Mon Sep 17 00:00:00 2001
From: Simon Cruanes <simon.cruanes.2007@m4x.org>
Date: Thu, 5 Feb 2015 22:29:38 +0100
Subject: [PATCH 08/72] trailing space

---
 src/data/CCCache.ml | 2 +-
 1 file changed, 1 insertion(+), 1 deletion(-)

diff --git a/src/data/CCCache.ml b/src/data/CCCache.ml
index f5c85cd3..e0340bca 100644
--- a/src/data/CCCache.ml
+++ b/src/data/CCCache.ml
@@ -330,7 +330,7 @@ module UNBOUNDED(X:HASH) = struct
   let get c x = H.find c x
 
   let set c x y = H.replace c x y
-  
+
   let size c () = H.length c
 
   let iter c f = H.iter f c

From 9bee9c6d64b931b9fd064bfb86a5c5735ce2159a Mon Sep 17 00:00:00 2001
From: Simon Cruanes <simon.cruanes.2007@m4x.org>
Date: Mon, 9 Feb 2015 14:00:40 +0100
Subject: [PATCH 09/72] use compiledObject: best for binaries

---
 _oasis | 13 +++++++------
 1 file changed, 7 insertions(+), 6 deletions(-)

diff --git a/_oasis b/_oasis
index 7e197a54..a9c62dc0 100644
--- a/_oasis
+++ b/_oasis
@@ -157,7 +157,7 @@ Document containers
 Executable run_benchs
   Path:             benchs/
   Install:          false
-  CompiledObject:   native
+  CompiledObject:   best
   Build$:           flag(bench) && flag(misc)
   MainIs:           run_benchs.ml
   BuildDepends:     containers, containers.misc, containers.advanced,
@@ -167,7 +167,7 @@ Executable run_benchs
 Executable bench_hash
   Path: benchs/
   Install: false
-  CompiledObject: native
+  CompiledObject: best
   Build$: flag(bench) && flag(misc)
   MainIs: bench_hash.ml
   BuildDepends: containers, containers.misc
@@ -190,7 +190,7 @@ PreBuildCommand: make qtest-gen
 Executable run_qtest
   Path:             qtest/
   Install:          false
-  CompiledObject:   native
+  CompiledObject:   best
   MainIs:           run_qtest.ml
   Build$:           flag(tests) && flag(bigarray)
   BuildDepends:     containers, containers.misc, containers.string, containers.iter,
@@ -201,7 +201,7 @@ Executable run_qtest
 Executable run_tests
   Path: tests/
   Install: false
-  CompiledObject: native
+  CompiledObject: best
   MainIs: run_tests.ml
   Build$: flag(tests) && flag(misc)
   BuildDepends: containers, containers.data, oUnit, sequence, gen,
@@ -215,6 +215,7 @@ Test all
 Executable lambda
   Path: examples/
   Install: false
+  CompiledObject: best
   MainIs: lambda.ml
   Build$: flag(misc)
   BuildDepends: containers, containers.misc
@@ -222,7 +223,7 @@ Executable lambda
 Executable id_sexp
   Path:             examples/
   Install:          false
-  CompiledObject:   native
+  CompiledObject:   best
   MainIs:           id_sexp.ml
   Build$:           flag(misc)
   BuildDepends:     containers.sexp
@@ -230,7 +231,7 @@ Executable id_sexp
 Executable id_sexp2
   Path:             examples/
   Install:          false
-  CompiledObject:   native
+  CompiledObject:   best
   MainIs:           id_sexp2.ml
   Build$:           flag(misc)
   BuildDepends:     containers.sexp

From 9b4677b266072e3813eb3f203a5f273a32207c85 Mon Sep 17 00:00:00 2001
From: Simon Cruanes <simon.cruanes.2007@m4x.org>
Date: Tue, 10 Feb 2015 15:51:11 +0100
Subject: [PATCH 10/72] wip: ring buffer (currently an experiment called
 "bufferIO") -> make it polymorphic

---
 _oasis                  |   3 +-
 src/data/CCBufferIO.ml  | 214 ++++++++++++++++++++++++++++++++++++++++
 src/data/CCBufferIO.mli |  96 ++++++++++++++++++
 3 files changed, 312 insertions(+), 1 deletion(-)
 create mode 100644 src/data/CCBufferIO.ml
 create mode 100644 src/data/CCBufferIO.mli

diff --git a/_oasis b/_oasis
index a9c62dc0..5338b481 100644
--- a/_oasis
+++ b/_oasis
@@ -69,7 +69,8 @@ Library "containers_sexp"
 Library "containers_data"
   Path:             src/data
   Modules:          CCMultiMap, CCMultiSet, CCTrie, CCFlatHashtbl, CCCache,
-                    CCPersistentHashtbl, CCDeque, CCFQueue, CCBV, CCMixtbl
+                    CCPersistentHashtbl, CCDeque, CCFQueue, CCBV, CCMixtbl,
+                    CCBufferIO
   FindlibParent:    containers
   FindlibName:      data
 
diff --git a/src/data/CCBufferIO.ml b/src/data/CCBufferIO.ml
new file mode 100644
index 00000000..58264d4f
--- /dev/null
+++ b/src/data/CCBufferIO.ml
@@ -0,0 +1,214 @@
+(*
+ * 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
new file mode 100644
index 00000000..c3c12fd4
--- /dev/null
+++ b/src/data/CCBufferIO.mli
@@ -0,0 +1,96 @@
+(*
+ * 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]) *)

From 0d3158d1bdb58806f380ddd2fc551e4158bdd036 Mon Sep 17 00:00:00 2001
From: Simon Cruanes <simon.cruanes.2007@m4x.org>
Date: Mon, 9 Feb 2015 21:05:22 +0100
Subject: [PATCH 11/72] doc

---
 src/core/CCRef.ml  | 4 +++-
 src/core/CCSet.mli | 1 +
 2 files changed, 4 insertions(+), 1 deletion(-)

diff --git a/src/core/CCRef.ml b/src/core/CCRef.ml
index 136d0cfe..a0f74d70 100644
--- a/src/core/CCRef.ml
+++ b/src/core/CCRef.ml
@@ -24,7 +24,9 @@ OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE
 OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
 *)
 
-(** {1 References} *)
+(** {1 References}
+
+@since NEXT_RELEASE *)
 
 type 'a print = Format.formatter -> 'a -> unit
 type 'a pp = Buffer.t -> 'a -> unit
diff --git a/src/core/CCSet.mli b/src/core/CCSet.mli
index 9261505b..62bdd9fe 100644
--- a/src/core/CCSet.mli
+++ b/src/core/CCSet.mli
@@ -25,6 +25,7 @@ OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
 *)
 
 (** {1 Wrapper around Set}
+
 @since NEXT_RELEASE *)
 
 type 'a sequence = ('a -> unit) -> unit

From 472aaa83a21dd58966d7c3c3009391a4f61b074a Mon Sep 17 00:00:00 2001
From: carm <carmelo.piccione@gmail.com>
Date: Tue, 10 Feb 2015 23:00:09 -0500
Subject: [PATCH 12/72] first cut of a polymorphic buffer

---
 src/data/CCBufferIO.ml  | 108 ++++++++++++++++++----------------------
 src/data/CCBufferIO.mli |  77 ++++++++++++++--------------
 2 files changed, 85 insertions(+), 100 deletions(-)

diff --git a/src/data/CCBufferIO.ml b/src/data/CCBufferIO.ml
index 58264d4f..c71c84a8 100644
--- a/src/data/CCBufferIO.ml
+++ b/src/data/CCBufferIO.ml
@@ -20,10 +20,11 @@
 
 (** Circular Byte Buffer for IO *)
 
-type t = {
+type 'a t = {
   mutable start : int;
   mutable stop : int; (* excluded *)
-  mutable buf : string;
+  mutable buf : 'a array;
+  size: int
 }
 
 exception Empty
@@ -31,39 +32,35 @@ exception Empty
 let create size =
   { start=0;
     stop=0;
-    buf =String.make size ' ';
+    size;
+    buf = Array.of_list [];
   }
 
 let copy b =
-  { b with buf=String.copy b.buf; }
+  { b with buf=Array.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 capacity b = b.size
 
 let length b =
   if b.stop >= b.start
   then b.stop - b.start
-  else (String.length b.buf - b.start) + b.stop
+  else (Array.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
+let resize b cap elem =
+  assert (cap >= Array.length b.buf);
+  let buf' = Array.make cap elem 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);
+      Array.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;
+      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
@@ -72,66 +69,56 @@ let resize b cap =
   b.stop <- len;
   ()
 
-let blit_from b s o len =
+let blit_from 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 (String.length b.buf + len + 24);
+  if (Array.length from_buf) = 0 then () else
+  if cap < len then 
+    resize b (Array.length b.buf + len + 24) from_buf.(0);
   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
+    let len_end = Array.length b.buf - b.stop in
     if len_end >= len
-    then (String.blit s o b.buf b.stop len;
+    then (Array.blit from_buf 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);
+    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);
-    String.blit s o b.buf b.stop len;
+    Array.blit from_buf 0 b.buf b.stop len;
     b.stop <- b.stop + len
   end;
   ()
 
-let blit_into b s o len =
-  if o+len > String.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 _ = String.blit b.buf b.start s o n in
+    let _ = Array.blit b.buf b.start to_buf 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);
+    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
-      String.blit b.buf 0 s (o+len_end) n;
+      Array.blit b.buf 0 to_buf (o+len_end) n;
       n + len_end
     end
   end
 
-let add_string b s = blit_from b s 0 (String.length s)
+let add b s = blit_from b s 0 (Array.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 b = create 24 in add b s; add_string b s'; \
+    Array.length s + String.length s' = length b)
 *)
 
 let clear b =
@@ -142,26 +129,26 @@ let clear b =
 let reset b =
   clear b;
   if capacity b > 64
-    then b.buf <- String.make 64 ' ';  (* reset *)
+    then b.buf <- Array.sub b.buf 0 64;
   ()
 
 let is_empty b = b.start = b.stop
 
 let next b =
   if b.start = b.stop then raise Empty;
-  b.buf.[b.start]
+  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
+  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
 
 let junk b =
   if b.start = b.stop then raise Empty;
-  if b.start + 1 = String.length b.buf
+  if b.start + 1 = Array.length b.buf
   then b.start <- 0
   else b.start <- b.start + 1
 
@@ -170,7 +157,7 @@ let skip b len =
   if b.stop >= b.start
   then b.start <- b.start + len
   else
-    let len_end = String.length b.buf - b.start in
+    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
@@ -185,10 +172,10 @@ let skip b len =
 
 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
+  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;
+    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;
   )
 
 (*$T
@@ -202,13 +189,14 @@ let get b i =
   then
     if i >= b.stop - b.start
     then raise (Invalid_argument "BufferIO.get")
-    else b.buf.[b.start + i]
+    else b.buf.(b.start + i)
   else
-    let len_end = String.length b.buf - b.start in
+    let len_end = Array.length b.buf - b.start in
     if i < len_end
-      then b.buf.[b.start + i]
+      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]
-
+      else b.buf.(i - len_end)
 
+let to_list b =
+  Array.to_list (Array.sub b.buf b.start b.stop)
diff --git a/src/data/CCBufferIO.mli b/src/data/CCBufferIO.mli
index c3c12fd4..3c6c4784 100644
--- a/src/data/CCBufferIO.mli
+++ b/src/data/CCBufferIO.mli
@@ -1,5 +1,5 @@
-(*
- * BatBufferIO - Circular byte buffer
+(**
+ * CCBufferIO - Polymorphic Circular Buffer
  * Copyright (C) 2014 Simon Cruanes
  *
  * This library is free software; you can redistribute it and/or
@@ -18,79 +18,76 @@
  * Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
  *)
 
-(** Circular Byte Buffer for IO *)
+(** Circular Polymorphic Buffer for IO *)
 
-type t = private {
+type 'a t = private {
   mutable start : int;
   mutable stop : int; (* excluded *)
-  mutable buf : string;
+  mutable buf : 'a array;
+  size : int
 }
 
 exception Empty
 
-val create : int -> t
+val create : int -> 'a t
 (** [create size] creates a new buffer with given size *)
 
-val copy : t -> t
+val copy : 'a t ->'a  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 : 'a t -> int
+(** length of the inner buffer *)
 
-val capacity : t -> int
-(** length of the inner string buffer *)
+val length : 'a t -> int
+(** number of elements currently stored in the 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.
+val blit_from : 'a t -> 'a array -> 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 -> 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)]).
+val blit_into : 'a t -> 'a array -> 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 add_string : t -> string -> unit
-(** [add_string buf s] adds [s] at the end of [buf]. *)
+val add : 'a t -> 'a array -> unit
+(** [add buf t] adds elements [t] at the end of [buf]. *)
 
-val to_string : t -> string
-(** extract the current content into a string *)
+val to_list : 'a t -> 'a list
+(** extract the current content into a list *)
 
-val clear : t -> unit
+val clear : 'a t -> unit
 (** clear the content of the buffer. Doesn't actually destroy the content. *)
 
-val reset : t -> unit
+val reset : 'a 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 is_empty :'a t -> bool
+(** is the buffer empty (i.e. contains no elements)? *)
 
-val next : t -> char
-(** obtain next char (the first one of the buffer)
+val next : 'a t -> 'a
+(** obtain next element (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)
+val pop : 'a t -> 'a
+(** obtain and remove next element (the first one)
     @raise Empty if the buffer is empty *)
 
-val junk : t -> unit
+val junk : 'a t -> unit
 (** Drop next element.
     @raise Empty if the buffer is already empty *)
 
-val skip : t -> int -> unit
+val skip : 'a 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]
+val iteri : 'a t -> (int -> 'a -> 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 : t -> int -> char
-(** [get buf i] returns the [i]-th character of [buf], ie the one that
+val get : 'a t -> int -> 'a
+(** [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]) *)

From ae7244f2e3de1e405b7fdb0aa7ee736dc429a8ae Mon Sep 17 00:00:00 2001
From: Carmelo Piccione <carmelo.piccione@gmail.com>
Date: Tue, 10 Feb 2015 23:01:59 -0500
Subject: [PATCH 13/72] Update ocamldoc

---
 src/data/CCBufferIO.ml | 4 ++--
 1 file changed, 2 insertions(+), 2 deletions(-)

diff --git a/src/data/CCBufferIO.ml b/src/data/CCBufferIO.ml
index c71c84a8..170c8934 100644
--- a/src/data/CCBufferIO.ml
+++ b/src/data/CCBufferIO.ml
@@ -1,5 +1,5 @@
 (*
- * BatBufferIO - Circular byte buffer
+ * CCBufferIO - Polymorphic circular buffer
  * Copyright (C) 2014 Simon Cruanes
  *
  * This library is free software; you can redistribute it and/or
@@ -18,7 +18,7 @@
  * Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
  *)
 
-(** Circular Byte Buffer for IO *)
+(** Polymorphic Circular Buffer for IO *)
 
 type 'a t = {
   mutable start : int;

From 8fec7b005e4b62ee11b6a850c204da4e5d271e67 Mon Sep 17 00:00:00 2001
From: carm <carmelo.piccione@gmail.com>
Date: Wed, 11 Feb 2015 11:09:19 -0500
Subject: [PATCH 14/72] wip fixes

---
 src/data/CCBufferIO.ml | 46 +++++++++++++++++-------------------------
 1 file changed, 18 insertions(+), 28 deletions(-)

diff --git a/src/data/CCBufferIO.ml b/src/data/CCBufferIO.ml
index c71c84a8..abb96ff0 100644
--- a/src/data/CCBufferIO.ml
+++ b/src/data/CCBufferIO.ml
@@ -40,7 +40,7 @@ let copy b =
   { b with buf=Array.copy b.buf; }
 
 
-let capacity b = b.size
+let capacity b = Array.length b.buf
 
 let length b =
   if b.stop >= b.start
@@ -65,34 +65,20 @@ let resize b cap elem =
     end
   in
   b.buf <- buf';
-  b.start <- 0;
-  b.stop <- len;
   ()
 
 let blit_from b from_buf o len =
+  if (Array.length from_buf) = 0 then () else
   let cap = capacity b - length b in
   (* resize if needed, with a constant to amortize *)
-  if (Array.length from_buf) = 0 then () else
-  if cap < len then 
-    resize b (Array.length b.buf + len + 24) from_buf.(0);
-  assert (capacity b - length b >= len);
-  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 0 b.buf b.stop len;
-    b.stop <- b.stop + len
-  end;
-  ()
-
+  if capacity b < b.size then 
+    resize b b.size from_buf.(0);
+  let sub = Array.sub from_buf o len in
+    let iter i x = 
+      b.start <- i mod capacity b;
+      Array.set b.buf x b.start in
+    Array.iteri iter sub
+     
 let blit_into b to_buf o len =
   if o+len > Array.length to_buf
     then raise (Invalid_argument "BufferIO.blit_into");
@@ -128,9 +114,7 @@ let clear b =
 
 let reset b =
   clear b;
-  if capacity b > 64
-    then b.buf <- Array.sub b.buf 0 64;
-  ()
+  b.buf <- Array.of_list []
 
 let is_empty b = b.start = b.stop
 
@@ -199,4 +183,10 @@ let get b i =
       else b.buf.(i - len_end)
 
 let to_list b =
-  Array.to_list (Array.sub b.buf b.start b.stop)
+  if (b.stop >= b.start) 
+    then Array.to_list (Array.sub b.buf b.start b.stop)
+  else List.append 
+    (Array.to_list (Array.sub b.buf b.start (Array.length b.buf)))
+    (Array.to_list (Array.sub b.buf 0 b.stop)) 
+    
+

From acd1b6e97e5ad052dc0bad5cd9a078b0afd6790f Mon Sep 17 00:00:00 2001
From: carm <carmelo.piccione@gmail.com>
Date: Wed, 11 Feb 2015 23:08:12 -0500
Subject: [PATCH 15/72] put back more advanced resize heuristic

---
 src/data/CCBufferIO.ml | 4 ++--
 1 file changed, 2 insertions(+), 2 deletions(-)

diff --git a/src/data/CCBufferIO.ml b/src/data/CCBufferIO.ml
index 8207540b..91ccd026 100644
--- a/src/data/CCBufferIO.ml
+++ b/src/data/CCBufferIO.ml
@@ -71,8 +71,8 @@ let blit_from b from_buf o len =
   if (Array.length from_buf) = 0 then () else
   let cap = capacity b - length b in
   (* resize if needed, with a constant to amortize *)
-  if capacity b < b.size then 
-    resize b b.size from_buf.(0);
+   if cap < len then
+     resize b (min b.size (Array.length b.buf + len + 24)) from_buf.(0);
   let sub = Array.sub from_buf o len in
     let iter i x = 
       b.start <- i mod capacity b;

From 7d92950a4ef17eb3c99b639faafd91cebae2d547 Mon Sep 17 00:00:00 2001
From: carm <carmelo.piccione@gmail.com>
Date: Thu, 12 Feb 2015 00:20:28 -0500
Subject: [PATCH 16/72] working polymorphic ring buffer

---
 src/data/CCBufferIO.ml | 23 +++++++++++++----------
 1 file changed, 13 insertions(+), 10 deletions(-)

diff --git a/src/data/CCBufferIO.ml b/src/data/CCBufferIO.ml
index 91ccd026..1778ed00 100644
--- a/src/data/CCBufferIO.ml
+++ b/src/data/CCBufferIO.ml
@@ -52,7 +52,7 @@ let resize b cap elem =
   assert (cap >= Array.length b.buf);
   let buf' = Array.make cap elem in
   (* copy into buf' *)
-  let len =
+  let _:int =
     if b.stop >= b.start
     then begin
       Array.blit b.buf b.start buf' 0 (b.stop - b.start);
@@ -64,20 +64,23 @@ let resize b cap elem =
       len_end + b.stop
     end
   in
-  b.buf <- buf';
-  ()
+  b.buf <- buf'
 
 let blit_from b from_buf o len =
   if (Array.length from_buf) = 0 then () else
   let cap = capacity b - length b in
   (* resize if needed, with a constant to amortize *)
    if cap < len then
-     resize b (min b.size (Array.length b.buf + len + 24)) from_buf.(0);
+     resize b (min (b.size+1) (Array.length b.buf + len + 24)) from_buf.(0);
   let sub = Array.sub from_buf o len in
-    let iter i x = 
-      b.start <- i mod capacity b;
-      Array.set b.buf x b.start in
-    Array.iteri iter sub
+    let iter x =
+      if b.start = 0 then b.start <- capacity b - 1 else b.start <- b.start - 1;
+      if b.start = b.stop then
+        begin
+          if b.stop = 0 then b.stop <- capacity b - 1 else b.stop <- b.stop - 1
+        end;
+      Array.set b.buf b.start x in
+    Array.iter iter sub
      
 let blit_into b to_buf o len =
   if o+len > Array.length to_buf
@@ -184,9 +187,9 @@ let get b i =
 
 let to_list b =
   if (b.stop >= b.start) 
-    then Array.to_list (Array.sub b.buf b.start b.stop)
+    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)))
+    (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)) 
     
 

From 4a994cff388ce532569f4ce0bc1b6d2ac9898120 Mon Sep 17 00:00:00 2001
From: carm <carmelo.piccione@gmail.com>
Date: Fri, 13 Feb 2015 19:00:04 -0500
Subject: [PATCH 17/72] rename buffer io to ring buffer

---
 _oasis                                        | 2 +-
 src/data/{CCBufferIO.ml => CCRingBuffer.ml}   | 4 +++-
 src/data/{CCBufferIO.mli => CCRingBuffer.mli} | 0
 3 files changed, 4 insertions(+), 2 deletions(-)
 rename src/data/{CCBufferIO.ml => CCRingBuffer.ml} (97%)
 rename src/data/{CCBufferIO.mli => CCRingBuffer.mli} (100%)

diff --git a/_oasis b/_oasis
index 5338b481..bdf8be95 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,
-                    CCBufferIO
+                    CCRingBuffer
   FindlibParent:    containers
   FindlibName:      data
 
diff --git a/src/data/CCBufferIO.ml b/src/data/CCRingBuffer.ml
similarity index 97%
rename from src/data/CCBufferIO.ml
rename to src/data/CCRingBuffer.ml
index 1778ed00..8616c37c 100644
--- a/src/data/CCBufferIO.ml
+++ b/src/data/CCRingBuffer.ml
@@ -1,5 +1,7 @@
 (*
- * CCBufferIO - Polymorphic circular buffer
+ * CCRingBufferIO - Polymorphic circular buffer with
+ * deque semantics for accessing both the head and tail.
+ *
  * Copyright (C) 2014 Simon Cruanes
  *
  * This library is free software; you can redistribute it and/or
diff --git a/src/data/CCBufferIO.mli b/src/data/CCRingBuffer.mli
similarity index 100%
rename from src/data/CCBufferIO.mli
rename to src/data/CCRingBuffer.mli

From 2cf485ebee94571e71c2d6b92f681a40ffa21ddb Mon Sep 17 00:00:00 2001
From: carm <carmelo.piccione@gmail.com>
Date: Fri, 13 Feb 2015 19:21:46 -0500
Subject: [PATCH 18/72] support for unbounded ring buffer

---
 src/data/CCRingBuffer.ml  | 12 +++++++-----
 src/data/CCRingBuffer.mli | 10 +++++++---
 2 files changed, 14 insertions(+), 8 deletions(-)

diff --git a/src/data/CCRingBuffer.ml b/src/data/CCRingBuffer.ml
index 8616c37c..67ec5798 100644
--- a/src/data/CCRingBuffer.ml
+++ b/src/data/CCRingBuffer.ml
@@ -26,16 +26,16 @@ type 'a t = {
   mutable start : int;
   mutable stop : int; (* excluded *)
   mutable buf : 'a array;
-  size: int
+  max_capacity: int
 }
 
 exception Empty
 
-let create size =
+let create ?(max_capacity=max_int) () =
   { start=0;
     stop=0;
-    size;
-    buf = Array.of_list [];
+    max_capacity;
+    buf = Array.of_list []
   }
 
 let copy b =
@@ -44,6 +44,8 @@ let copy b =
 
 let capacity b = Array.length b.buf
 
+let max_capacity b = b.max_capacity
+
 let length b =
   if b.stop >= b.start
   then b.stop - b.start
@@ -73,7 +75,7 @@ let blit_from 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 (min (b.size+1) (Array.length b.buf + len + 24)) from_buf.(0);
+     resize b (min (b.max_capacity+1) (Array.length b.buf + len + 24)) from_buf.(0);
   let sub = Array.sub from_buf o len in
     let iter x =
       if b.start = 0 then b.start <- capacity b - 1 else b.start <- b.start - 1;
diff --git a/src/data/CCRingBuffer.mli b/src/data/CCRingBuffer.mli
index 3c6c4784..f717879c 100644
--- a/src/data/CCRingBuffer.mli
+++ b/src/data/CCRingBuffer.mli
@@ -24,13 +24,14 @@ type 'a t = private {
   mutable start : int;
   mutable stop : int; (* excluded *)
   mutable buf : 'a array;
-  size : int
+  max_capacity : int
 }
 
 exception Empty
 
-val create : int -> 'a t
-(** [create size] creates a new buffer with given size *)
+val create : ?max_capacity:int -> unit -> 'a t
+(** [create ~max_capacity ()] creates a new buffer with given maximum capacity.
+    Defaults to unbounded. *)
 
 val copy : 'a t ->'a  t
 (** fresh copy of the buffer *)
@@ -38,6 +39,9 @@ val copy : 'a t ->'a  t
 val capacity : 'a t -> int
 (** length of the inner buffer *)
 
+val max_capacity : 'a t -> int
+(** maximum length of the inner buffer *)
+
 val length : 'a t -> int
 (** number of elements currently stored in the buffer *)
 

From a43145b10790934577c0d751d39bfcdb8edc1e80 Mon Sep 17 00:00:00 2001
From: carm <carmelo.piccione@gmail.com>
Date: Fri, 13 Feb 2015 20:08:13 -0500
Subject: [PATCH 19/72] bounded/unbounded versions of blit_from

---
 src/data/CCRingBuffer.ml  | 62 +++++++++++++++++++++++++++++++--------
 src/data/CCRingBuffer.mli | 13 ++++----
 2 files changed, 56 insertions(+), 19 deletions(-)

diff --git a/src/data/CCRingBuffer.ml b/src/data/CCRingBuffer.ml
index 67ec5798..ad13c2e5 100644
--- a/src/data/CCRingBuffer.ml
+++ b/src/data/CCRingBuffer.ml
@@ -26,15 +26,17 @@ type 'a t = {
   mutable start : int;
   mutable stop : int; (* excluded *)
   mutable buf : 'a array;
-  max_capacity: int
+  bounded : bool;
+  size : int
 }
 
 exception Empty
 
-let create ?(max_capacity=max_int) () =
+let create ?(bounded=false) size =
   { start=0;
     stop=0;
-    max_capacity;
+    bounded;
+    size;
     buf = Array.of_list []
   }
 
@@ -44,7 +46,7 @@ let copy b =
 
 let capacity b = Array.length b.buf
 
-let max_capacity b = b.max_capacity
+let max_capacity b = if b.bounded then Some b.size else None
 
 let length b =
   if b.stop >= b.start
@@ -70,22 +72,56 @@ let resize b cap elem =
   in
   b.buf <- buf'
 
-let blit_from b from_buf o len =
-  if (Array.length from_buf) = 0 then () else
-  let cap = capacity b - length b in
+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
-     resize b (min (b.max_capacity+1) (Array.length b.buf + len + 24)) from_buf.(0);
+     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 sub = Array.sub from_buf o len in
+  let capacity = capacity b in
     let iter x =
-      if b.start = 0 then b.start <- capacity b - 1 else b.start <- b.start - 1;
+     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.stop = 0 then b.stop <- capacity b - 1 else b.stop <- b.stop - 1
-        end;
-      Array.set b.buf b.start x in
+      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 - 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);
+  assert (capacity b - length b >= len);
+  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
+
 let blit_into b to_buf o len =
   if o+len > Array.length to_buf
     then raise (Invalid_argument "BufferIO.blit_into");
diff --git a/src/data/CCRingBuffer.mli b/src/data/CCRingBuffer.mli
index f717879c..b7b409e6 100644
--- a/src/data/CCRingBuffer.mli
+++ b/src/data/CCRingBuffer.mli
@@ -24,14 +24,15 @@ type 'a t = private {
   mutable start : int;
   mutable stop : int; (* excluded *)
   mutable buf : 'a array;
-  max_capacity : int
+  bounded: bool;
+  size : int
 }
 
 exception Empty
 
-val create : ?max_capacity:int -> unit -> 'a t
-(** [create ~max_capacity ()] creates a new buffer with given maximum capacity.
-    Defaults to unbounded. *)
+val create : ?bounded:bool -> int -> 'a t
+(** [create ?bounded size] creates a new buffer with given size.
+    Defaults to [bounded=false]. *)
 
 val copy : 'a t ->'a  t
 (** fresh copy of the buffer *)
@@ -39,8 +40,8 @@ val copy : 'a t ->'a  t
 val capacity : 'a t -> int
 (** length of the inner buffer *)
 
-val max_capacity : 'a t -> int
-(** maximum length of the inner buffer *)
+val max_capacity : 'a t -> int option
+(** maximum length of the inner buffer, or [None] if unbounded. *)
 
 val length : 'a t -> int
 (** number of elements currently stored in the buffer *)

From 07f0afcd28fbd8d44176b6cd02722599b09fa7a7 Mon Sep 17 00:00:00 2001
From: carm <carmelo.piccione@gmail.com>
Date: Sat, 14 Feb 2015 08:31:54 -0500
Subject: [PATCH 20/72] add deque style functions to ring buffer module, bug
 fixes

---
 src/data/CCRingBuffer.ml  | 46 ++++++++++++++++++++++++++++-----------
 src/data/CCRingBuffer.mli | 24 ++++++++++++++------
 2 files changed, 50 insertions(+), 20 deletions(-)

diff --git a/src/data/CCRingBuffer.ml b/src/data/CCRingBuffer.ml
index ad13c2e5..57fc189d 100644
--- a/src/data/CCRingBuffer.ml
+++ b/src/data/CCRingBuffer.ml
@@ -1,5 +1,5 @@
 (*
- * CCRingBufferIO - Polymorphic circular buffer with
+ * CCRingBuffer - Polymorphic circular buffer with
  * deque semantics for accessing both the head and tail.
  *
  * Copyright (C) 2014 Simon Cruanes
@@ -75,22 +75,23 @@ let resize b cap elem =
 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
+  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);
+     resize b new_size from_buf.(0)
+  end;
   let sub = Array.sub from_buf o len in
-  let capacity = capacity b in
-    let iter 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.start = b.stop then
+  let iter x = 
+    let capacity = capacity b 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
+        if b.start = capacity-1 then b.start <- 0 else b.start <- b.start + 1
       end
-    in
-    Array.iter iter sub
+  in
+  Array.iter iter sub
      
 
 let blit_from_unbounded b from_buf o len =
@@ -117,7 +118,7 @@ let blit_from_unbounded 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
+  if b.bounded then
     blit_from_bounded b from_buf o len
   else
     blit_from_unbounded b from_buf o len
@@ -165,7 +166,7 @@ let next b =
   if b.start = b.stop then raise Empty;
   b.buf.(b.start)
 
-let pop 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
@@ -173,6 +174,13 @@ let pop b =
   else b.start <- b.start + 1;
   c
 
+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 =
   if b.start = b.stop then raise Empty;
   if b.start + 1 = Array.length b.buf
@@ -232,4 +240,16 @@ let to_list b =
     (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 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
+  raise Empty else Array.get b.buf 
+    (if b.stop = 0 then capacity b - 1 else b.stop-1)
+
+
+
+
 
diff --git a/src/data/CCRingBuffer.mli b/src/data/CCRingBuffer.mli
index b7b409e6..6ec2d42a 100644
--- a/src/data/CCRingBuffer.mli
+++ b/src/data/CCRingBuffer.mli
@@ -57,9 +57,6 @@ val blit_into : 'a t -> 'a array -> int -> int -> int
     @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 add : 'a t -> 'a array -> unit
-(** [add buf t] adds elements [t] at the end of [buf]. *)
-
 val to_list : 'a t -> 'a list
 (** extract the current content into a list *)
 
@@ -76,10 +73,6 @@ val next : 'a t -> 'a
 (** obtain next element (the first one of the buffer)
     @raise Empty if the buffer is empty *)
 
-val pop : 'a t -> 'a
-(** obtain and remove next element (the first one)
-    @raise Empty if the buffer is empty *)
-
 val junk : 'a t -> unit
 (** Drop next element.
     @raise Empty if the buffer is already empty *)
@@ -96,3 +89,20 @@ val get : 'a t -> int -> 'a
 (** [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
+  (** Push value at the back *)
+
+val peek_front : 'a t -> 'a
+  (** First value, or Empty *)
+
+val peek_back : 'a t -> 'a
+  (** Last value, or Empty *)
+
+val take_back : 'a t -> 'a
+  (** Take last value, or raise Empty *)
+
+val take_front : 'a t -> 'a
+  (** Take first value, or raise Empty *)
+
+

From c7607f8ce774f7b2c4012c17554c1cdf0f12d767 Mon Sep 17 00:00:00 2001
From: carm <carmelo.piccione@gmail.com>
Date: Mon, 16 Feb 2015 00:19:17 -0500
Subject: [PATCH 21/72] functorize ring buffer over ARRAY sig

---
 src/data/CCRingBuffer.ml  | 393 ++++++++++++++++++++------------------
 src/data/CCRingBuffer.mli | 142 ++++++++------
 2 files changed, 291 insertions(+), 244 deletions(-)

diff --git a/src/data/CCRingBuffer.ml b/src/data/CCRingBuffer.ml
index 57fc189d..91743f41 100644
--- a/src/data/CCRingBuffer.ml
+++ b/src/data/CCRingBuffer.ml
@@ -22,234 +22,255 @@
 
 (** Polymorphic Circular Buffer for IO *)
 
-type 'a t = {
-  mutable start : int;
-  mutable stop : int; (* excluded *)
-  mutable buf : 'a array;
-  bounded : bool;
-  size : int
-}
+module type ARRAY = sig
+  type elt
+  type t
 
-exception Empty
+  val make: int -> elt -> t
+  val length: t -> int
 
-let create ?(bounded=false) size =
-  { start=0;
-    stop=0;
-    bounded;
-    size;
-    buf = Array.of_list []
+  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 : Array.t;
+    bounded : bool;
+    size : int
   }
 
-let copy b =
-  { b with buf=Array.copy b.buf; }
+  exception Empty
+
+  let create ?(bounded=false) size =
+    { start=0;
+      stop=0;
+      bounded;
+      size;
+      buf = Array.of_list []
+    }
+
+  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 =
-  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] *)
-let resize b cap elem =
-  assert (cap >= Array.length b.buf);
-  let buf' = Array.make cap elem in
-  (* copy into buf' *)
-  let _:int =
+  let length b =
     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'
+    then b.stop - b.start
+    else (Array.length b.buf - b.start) + b.stop
 
-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
-     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)
-  end;
-  let sub = Array.sub from_buf o len in
-  let iter x = 
-    let capacity = capacity b 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
+  (* 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
-  Array.iter iter sub
-     
+    in
+    b.buf <- buf'
 
-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);
-  assert (capacity b - length b >= len);
-  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_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
+      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)
+    end;
+    let sub = Array.sub from_buf o len in
+    let iter x =
+      let capacity = capacity b 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 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 =
-  if o+len > Array.length to_buf
+  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);
+    assert (capacity b - length b >= len);
+    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
+
+  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 *)
+    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 n = min b.stop (len - len_end) in
-      Array.blit b.buf 0 to_buf (o+len_end) n;
-      n + len_end
+      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
-  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.pair Q.printable_string Q.printable_string) (fun (s,s') -> \
+  (*$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 =
-  b.stop <- 0;
-  b.start <- 0;
-  ()
+  let clear b =
+    b.stop <- 0;
+    b.start <- 0;
+    ()
 
-let reset b =
-  clear b;
-  b.buf <- Array.of_list []
+  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 =
-  if b.start = b.stop then raise Empty;
-  b.buf.(b.start)
+  let next b =
+    if b.start = b.stop then raise Empty;
+    b.buf.(b.start)
 
-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
+  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
 
-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 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 =
-  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 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 =
-  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 = 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
+  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 = 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') -> \
+  (*$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 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;
-  )
+  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;
+    )
 
-(*$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
-*)
+  (*$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 = Array.length b.buf - b.start in
-    if i < len_end
+  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 = Array.length b.buf - b.start in
+      if i < len_end
       then b.buf.(b.start + i)
-    else if i - len_end > b.stop
+      else if i - len_end > b.stop
       then raise (Invalid_argument "BufferIO.get")
       else b.buf.(i - len_end)
 
-let to_list b =
-  if (b.stop >= b.start) 
+  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 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
-  raise Empty else Array.get b.buf 
-    (if b.stop = 0 then capacity b - 1 else b.stop-1)
-
-
+    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 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
+      raise Empty else Array.get b.buf 
+                         (if b.stop = 0 then capacity b - 1 else b.stop-1)
+end
diff --git a/src/data/CCRingBuffer.mli b/src/data/CCRingBuffer.mli
index 6ec2d42a..bc405f43 100644
--- a/src/data/CCRingBuffer.mli
+++ b/src/data/CCRingBuffer.mli
@@ -20,89 +20,115 @@
 
 (** Circular Polymorphic Buffer for IO *)
 
-type 'a t = private {
-  mutable start : int;
-  mutable stop : int; (* excluded *)
-  mutable buf : 'a array;
-  bounded: bool;
-  size : int
-}
+module type ARRAY = sig
+  type elt
+  type t
 
-exception Empty
+  val make: int -> elt -> t
+  val length: t -> int
 
-val create : ?bounded:bool -> int -> 'a t
-(** [create ?bounded size] creates a new buffer with given size.
-    Defaults to [bounded=false]. *)
+  val get: t -> int -> elt
 
-val copy : 'a t ->'a  t
-(** fresh copy of the buffer *)
+  val set: t -> int -> elt -> unit
 
-val capacity : 'a t -> int
-(** length of the inner buffer *)
+  val sub: t -> int -> int -> t
+  val max_length: int
 
-val max_capacity : 'a t -> int option
-(** maximum length of the inner buffer, or [None] if unbounded. *)
+  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 length : 'a t -> int
-(** number of elements currently stored in the buffer *)
+  val iter : (elt -> unit) -> t -> unit
+end
 
-val blit_from : 'a t -> 'a array -> 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 : 'a t -> 'a array -> 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] *)
+module Make : functor (Array:ARRAY) ->
+sig
 
-val to_list : 'a t -> 'a list
-(** extract the current content into a list *)
+  type t = private {
+    mutable start : int;
+    mutable stop : int; (* excluded *)
+    mutable buf : Array.t;
+    bounded: bool;
+    size : int
+  }
 
-val clear : 'a t -> unit
-(** clear the content of the buffer. Doesn't actually destroy the content. *)
+  exception Empty
 
-val reset : 'a t -> unit
-(** clear the content of the buffer, and also resize it to a default size *)
+  val create : ?bounded:bool -> int -> t
+  (** [create ?bounded size] creates a new buffer with given size.
+      Defaults to [bounded=false]. *)
 
-val is_empty :'a t -> bool
-(** is the buffer empty (i.e. contains no elements)? *)
+  val copy : t -> t
+  (** fresh copy of the buffer *)
 
-val next : 'a t -> 'a
-(** obtain next element (the first one of the buffer)
-    @raise Empty if the buffer is empty *)
+  val capacity : t -> int
+  (** length of the inner buffer *)
 
-val junk : 'a t -> unit
-(** Drop next element.
-    @raise Empty if the buffer is already empty *)
+  val max_capacity : t -> int option
+  (** maximum length of the inner buffer, or [None] if unbounded. *)
 
-val skip : 'a t -> int -> unit
-(** [skip b len] removes [len] elements from [b].
-    @raise Invalid_argument if [len > length b]. *)
+  val length : t -> int
+  (** number of elements currently stored in the buffer *)
 
-val iteri : 'a t -> (int -> 'a -> unit) -> unit
-(** [iteri b f] calls [f i t] for each element [t] in [buf], with [i]
-    being its relative index within [buf]. *)
+  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 get : 'a t -> int -> 'a
-(** [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 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 push_back : 'a t -> 'a -> unit
+  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 next : t -> Array.elt
+  (** obtain next element (the first one of the buffer)
+      @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 -> 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 : t -> int -> Array.elt
+  (** [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 : 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

From 847286597b2b77d3a6407e0f058940da1b2a7735 Mon Sep 17 00:00:00 2001
From: carm <carmelo.piccione@gmail.com>
Date: Mon, 16 Feb 2015 19:48:31 -0500
Subject: [PATCH 22/72] specialized primitive module arrays, functorized
 version for remainder

---
 src/data/CCRingBuffer.ml  | 118 ++++++++++++++++++++++++++++++--------
 src/data/CCRingBuffer.mli |  49 +++++++++++-----
 2 files changed, 129 insertions(+), 38 deletions(-)

diff --git a/src/data/CCRingBuffer.ml b/src/data/CCRingBuffer.ml
index 91743f41..d860de1b 100644
--- a/src/data/CCRingBuffer.ml
+++ b/src/data/CCRingBuffer.ml
@@ -22,29 +22,100 @@
 
 (** Polymorphic Circular Buffer for IO *)
 
-module type ARRAY = sig
-  type elt
-  type t
+module Array = struct
 
-  val make: int -> elt -> t
-  val length: t -> int
+  module type S = sig
+    type elt
+    type t
 
-  val get: t -> int -> elt
+    val empty : t
+    val make: int -> elt -> t
+    val length: t -> int
 
-  val set: t -> int -> elt -> unit
+    val get: t -> int -> elt
 
-  val sub: t -> int -> int -> t
-  val max_length: int
+    val set: t -> int -> elt -> unit
 
-  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 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
 
-  val iter : (elt -> unit) -> t -> unit
 end
 
-module Make(Array:ARRAY) =
+module Make(Array:Array.S) =
 struct
 
   type t = {
@@ -62,7 +133,7 @@ struct
       stop=0;
       bounded;
       size;
-      buf = Array.of_list []
+      buf = Array.empty
     }
 
   let copy b =
@@ -183,7 +254,7 @@ struct
 
   let reset b =
     clear b;
-    b.buf <- Array.of_list []
+    b.buf <- Array.empty
 
   let is_empty b = b.start = b.stop
 
@@ -259,13 +330,13 @@ struct
       else b.buf.(i - len_end)
 
   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 len = length b in
+    let rec build l i =
+      if i < 0 then l else
+      build ((get b i)::l) (i-1) in
+    build [] (len-1)
 
-  let push_back b e = add b (Array.of_list [e])
+  let push_back b e = add b (Array.make 1 e)
 
   let peek_front b = if is_empty b then 
       raise Empty else Array.get b.buf b.start
@@ -274,3 +345,4 @@ struct
       raise Empty else Array.get b.buf 
                          (if b.stop = 0 then capacity b - 1 else b.stop-1)
 end
+
diff --git a/src/data/CCRingBuffer.mli b/src/data/CCRingBuffer.mli
index bc405f43..1affaaf9 100644
--- a/src/data/CCRingBuffer.mli
+++ b/src/data/CCRingBuffer.mli
@@ -20,30 +20,49 @@
 
 (** Circular Polymorphic Buffer for IO *)
 
-module type ARRAY = sig
-  type elt
-  type t
+module Array : sig
 
-  val make: int -> elt -> t
-  val length: t -> int
+  module type S = sig
+    type elt
+    type t
 
-  val get: t -> int -> elt
+    val empty : t
+    val make: int -> elt -> t
+    val length: t -> int
 
-  val set: t -> int -> elt -> unit
+    val get: t -> int -> elt
 
-  val sub: t -> int -> int -> t
-  val max_length: int
+    val set: t -> int -> elt -> unit
 
-  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 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 
+
+  module FloatArray :
+    S with type elt = float and type t = float array 
+
+
+  module IntArray :
+    S with type elt = int and type t = int array 
+
+  module BoolArray :
+    S with type elt = bool and type t = bool array 
+
+  module Make  :
+   functor (Elt:sig type t end) ->
+      S with type elt = Elt.t and type t = Elt.t array
 
-  val iter : (elt -> unit) -> t -> unit
 end
 
 
-module Make : functor (Array:ARRAY) ->
+module Make : functor (Array:Array.S) ->
 sig
 
   type t = private {

From 9787e52e36da2ba46c48cc2013c963585a5ab92e Mon Sep 17 00:00:00 2001
From: carm <carmelo.piccione@gmail.com>
Date: Tue, 17 Feb 2015 00:47:57 -0500
Subject: [PATCH 23/72] various ring buf convenience functors

make explicit signature for ring buffer type
---
 src/data/CCRingBuffer.ml  | 102 +++++++++++++++++++++++++++++++++++++-
 src/data/CCRingBuffer.mli |  15 ++++--
 2 files changed, 113 insertions(+), 4 deletions(-)

diff --git a/src/data/CCRingBuffer.ml b/src/data/CCRingBuffer.ml
index d860de1b..d571d6f7 100644
--- a/src/data/CCRingBuffer.ml
+++ b/src/data/CCRingBuffer.ml
@@ -115,9 +115,101 @@ module Array = struct
 
 end
 
-module Make(Array:Array.S) =
+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
+  (** [create ?bounded size] creates a new buffer with given size.
+      Defaults to [bounded=false]. *)
+
+  val copy : t -> t
+  (** 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 next : t -> Array.elt
+  (** obtain next element (the first one of the buffer)
+      @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 -> 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 : t -> int -> Array.elt
+  (** [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 : t -> Array.elt -> unit
+  (** Push value at the back *)
+
+  val peek_front : t -> Array.elt
+  (** First value, or Empty *)
+
+  val peek_back : t -> Array.elt
+  (** Last value, or Empty *)
+
+  val take_back : t -> Array.elt
+  (** Take last value, or raise Empty *)
+
+  val take_front : t -> Array.elt
+  (** Take first value, or raise Empty *)
+
+end
+
+module Make_array(Array:Array.S) =
 struct
 
+  module Array = Array
   type t = {
     mutable start : int;
     mutable stop : int; (* excluded *)
@@ -346,3 +438,11 @@ struct
                          (if b.stop = 0 then capacity b - 1 else b.stop-1)
 end
 
+module Bytes = Make_array(Array.ByteArray)
+module Floats = Make_array(Array.FloatArray)
+module Ints = Make_array(Array.IntArray)
+module Bools = Make_array(Array.BoolArray)
+
+module Make(Elt:sig type t end) = Make_array(Array.Make(Elt))
+
+
diff --git a/src/data/CCRingBuffer.mli b/src/data/CCRingBuffer.mli
index 1affaaf9..6a10322f 100644
--- a/src/data/CCRingBuffer.mli
+++ b/src/data/CCRingBuffer.mli
@@ -61,10 +61,11 @@ module Array : sig
 
 end
 
-
-module Make : functor (Array:Array.S) ->
+module type S =
 sig
 
+  module Array : Array.S
+
   type t = private {
     mutable start : int;
     mutable stop : int; (* excluded *)
@@ -72,7 +73,6 @@ sig
     bounded: bool;
     size : int
   }
-
   exception Empty
 
   val create : ?bounded:bool -> int -> t
@@ -151,3 +151,12 @@ sig
   (** Take first value, or raise Empty *)
 
 end
+
+module Make_array : functor (Array:Array.S) -> S with module Array = Array
+
+module Bytes : S with module Array = Array.ByteArray
+module Floats : S with module Array = Array.FloatArray
+module Ints : S with module Array = Array.IntArray
+module Bools : S with module Array = Array.BoolArray
+
+module Make: functor(Elt:sig type t end) -> S with module Array = Array.Make(Elt)

From 8ec4ba09ac12643ccacde76e120f23281d6af4b6 Mon Sep 17 00:00:00 2001
From: carm <carmelo.piccione@gmail.com>
Date: Tue, 17 Feb 2015 00:57:08 -0500
Subject: [PATCH 24/72] remove white space

---
 src/data/CCRingBuffer.ml | 2 --
 1 file changed, 2 deletions(-)

diff --git a/src/data/CCRingBuffer.ml b/src/data/CCRingBuffer.ml
index d571d6f7..796e9f9d 100644
--- a/src/data/CCRingBuffer.ml
+++ b/src/data/CCRingBuffer.ml
@@ -444,5 +444,3 @@ module Ints = Make_array(Array.IntArray)
 module Bools = Make_array(Array.BoolArray)
 
 module Make(Elt:sig type t end) = Make_array(Array.Make(Elt))
-
-

From 00bcb47c4f60f3c72b11c1d0ac9ec3db332d45e9 Mon Sep 17 00:00:00 2001
From: carm <carmelo.piccione@gmail.com>
Date: Tue, 17 Feb 2015 19:25:50 -0500
Subject: [PATCH 25/72] remove Floats/Ints/Bools modules

---
 src/data/CCRingBuffer.ml  | 4 +---
 src/data/CCRingBuffer.mli | 3 ---
 2 files changed, 1 insertion(+), 6 deletions(-)

diff --git a/src/data/CCRingBuffer.ml b/src/data/CCRingBuffer.ml
index 796e9f9d..73326bdb 100644
--- a/src/data/CCRingBuffer.ml
+++ b/src/data/CCRingBuffer.ml
@@ -439,8 +439,6 @@ struct
 end
 
 module Bytes = Make_array(Array.ByteArray)
-module Floats = Make_array(Array.FloatArray)
-module Ints = Make_array(Array.IntArray)
-module Bools = Make_array(Array.BoolArray)
 
 module Make(Elt:sig type t end) = Make_array(Array.Make(Elt))
+
diff --git a/src/data/CCRingBuffer.mli b/src/data/CCRingBuffer.mli
index 6a10322f..f420d0a9 100644
--- a/src/data/CCRingBuffer.mli
+++ b/src/data/CCRingBuffer.mli
@@ -155,8 +155,5 @@ end
 module Make_array : functor (Array:Array.S) -> S with module Array = Array
 
 module Bytes : S with module Array = Array.ByteArray
-module Floats : S with module Array = Array.FloatArray
-module Ints : S with module Array = Array.IntArray
-module Bools : S with module Array = Array.BoolArray
 
 module Make: functor(Elt:sig type t end) -> S with module Array = Array.Make(Elt)

From 39cac7bc08051155d8d828a7c3ab766ed7df5e63 Mon Sep 17 00:00:00 2001
From: carm <carmelo.piccione@gmail.com>
Date: Wed, 18 Feb 2015 00:26:59 -0500
Subject: [PATCH 26/72] converted various functions to _[front|back] style

---
 src/data/CCRingBuffer.ml  | 77 +++++++++++++++------------------------
 src/data/CCRingBuffer.mli | 77 +++++++++++++++++++++++----------------
 2 files changed, 76 insertions(+), 78 deletions(-)

diff --git a/src/data/CCRingBuffer.ml b/src/data/CCRingBuffer.ml
index 73326bdb..8e169a6b 100644
--- a/src/data/CCRingBuffer.ml
+++ b/src/data/CCRingBuffer.ml
@@ -53,7 +53,7 @@ module Array = struct
   module FloatArray :
     S with type elt = float and type t = float array = struct
     type t = float array
-    type elt = float 
+    type elt = float
     let make = Array.make
     let length = Array.length
     let get = Array.get
@@ -130,79 +130,48 @@ sig
   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
-  (** 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 next : t -> Array.elt
-  (** obtain next element (the first one of the buffer)
-      @raise Empty if the buffer is empty *)
+  val junk_front : t -> unit
 
-  val junk : t -> unit
-  (** Drop next element.
-      @raise Empty if the buffer is already empty *)
+  val junk_back : t -> unit
 
   val skip : t -> int -> unit
-  (** [skip b len] removes [len] elements from [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 : t -> int -> Array.elt
-  (** [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 get_front : t -> int -> Array.elt
+
+  val get_back : t -> int -> Array.elt
 
   val push_back : t -> Array.elt -> unit
-  (** Push value at the back *)
 
   val peek_front : t -> Array.elt
-  (** First value, or Empty *)
 
   val peek_back : t -> Array.elt
-  (** Last value, or Empty *)
 
   val take_back : t -> Array.elt
-  (** Take last value, or raise Empty *)
 
   val take_front : t -> Array.elt
-  (** Take first value, or raise Empty *)
 
 end
 
@@ -350,10 +319,6 @@ struct
 
   let is_empty b = b.start = b.stop
 
-  let next b =
-    if b.start = b.stop then raise Empty;
-    b.buf.(b.start)
-
   let take_front b =
     if b.start = b.stop then raise Empty;
     let c = b.buf.(b.start) in
@@ -369,12 +334,18 @@ struct
     else b.stop <- b.stop - 1;
     b.buf.(b.stop)
 
-  let junk b =
+  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
 
+  let junk_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
+
   let skip b len =
     if len > length b then raise (Invalid_argument "BufferIO.skip");
     if b.stop >= b.start
@@ -411,30 +382,42 @@ struct
     if b.stop >= b.start
     then
       if i >= b.stop - b.start
-      then raise (Invalid_argument "BufferIO.get")
+      then raise (Invalid_argument "CCRingBuffer.get")
       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 "BufferIO.get")
+      then raise (Invalid_argument "CCRingBuffer.get")
       else b.buf.(i - len_end)
 
+  let get_front b i =
+    if is_empty b then
+      raise (Invalid_argument "CCRingBuffer.get_front")
+    else
+      get b i
+
+  let get_back b i =
+    let offset = ((length b) - i - 1) in
+      if offset < 0 then
+        raise (Invalid_argument "CCRingBuffer.get_back")
+      else get b offset
+
   let to_list b =
     let len = length b in
     let rec build l i =
       if i < 0 then l else
-      build ((get b i)::l) (i-1) in
+      build ((get_front b i)::l) (i-1) in
     build [] (len-1)
 
   let push_back b e = add b (Array.make 1 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
-      raise Empty else Array.get b.buf 
+      raise Empty else Array.get b.buf
                          (if b.stop = 0 then capacity b - 1 else b.stop-1)
 end
 
diff --git a/src/data/CCRingBuffer.mli b/src/data/CCRingBuffer.mli
index f420d0a9..f1a42ec9 100644
--- a/src/data/CCRingBuffer.mli
+++ b/src/data/CCRingBuffer.mli
@@ -1,5 +1,5 @@
 (**
- * CCBufferIO - Polymorphic Circular Buffer
+ * CCRingBuffer - Polymorphic Circular Buffer
  * Copyright (C) 2014 Simon Cruanes
  *
  * This library is free software; you can redistribute it and/or
@@ -27,7 +27,9 @@ module Array : sig
     type t
 
     val empty : t
+
     val make: int -> elt -> t
+
     val length: t -> int
 
     val get: t -> int -> elt
@@ -37,28 +39,27 @@ module Array : sig
     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 
+    S with type elt = char and type t = bytes
 
   module FloatArray :
-    S with type elt = float and type t = float array 
-
+    S with type elt = float and type t = float array
 
   module IntArray :
-    S with type elt = int and type t = int array 
+    S with type elt = int and type t = int array
 
   module BoolArray :
-    S with type elt = bool and type t = bool array 
+    S with type elt = bool and type t = bool array
 
-  module Make  :
+  module Make :
    functor (Elt:sig type t end) ->
       S with type elt = Elt.t and type t = Elt.t array
-
 end
 
 module type S =
@@ -80,16 +81,16 @@ sig
       Defaults to [bounded=false]. *)
 
   val copy : t -> t
-  (** fresh copy of the buffer *)
+  (** Make a fresh copy of the buffer. *)
 
   val capacity : t -> int
-  (** length of the inner buffer *)
+  (** Length of the inner buffer. *)
 
   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 : t -> int
-  (** number of elements currently stored in the buffer *)
+  (** 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
@@ -103,57 +104,71 @@ sig
       @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 *)
+  (** Extract the current content into a list *)
 
   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 : 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 :t -> bool
-  (** is the buffer empty (i.e. contains no elements)? *)
+  (** Is the buffer empty (i.e. contains no elements)? *)
 
-  val next : t -> Array.elt
-  (** obtain next element (the first one of the buffer)
-      @raise Empty if the buffer is empty *)
+  val junk_front : t -> unit
+  (** Drop the front element from [t].
+      @raise Empty if the buffer is already empty. *)
 
-  val junk : t -> unit
-  (** Drop next element.
-      @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 [b].
+  (** [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 : t -> int -> Array.elt
-  (** [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].
+  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 *)
+  (** 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, or Empty *)
+  (** First value from front of [t].
+      @raise Empty if buffer is empty. *)
 
   val peek_back : t -> Array.elt
-  (** Last value, or Empty *)
+  (** Get the last value from back of [t].
+      @raise Empty if buffer is empty. *)
 
   val take_back : t -> Array.elt
-  (** Take last value, or raise Empty *)
+  (** Take the last value from back of [t].
+      @raise Empty if buffer is already empty. *)
 
   val take_front : t -> Array.elt
-  (** Take first value, or raise Empty *)
+  (** 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 Bytes : 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)

From f426a97a3151c8a57453ea0ff47530598c2e3a47 Mon Sep 17 00:00:00 2001
From: Simon Cruanes <simon.cruanes.2007@m4x.org>
Date: Wed, 18 Feb 2015 10:59:27 +0100
Subject: [PATCH 27/72] fix quick tests

---
 tests/quick/.common.ml          | 9 +++++----
 tests/quick/levenshtein_dict.ml | 7 +++----
 2 files changed, 8 insertions(+), 8 deletions(-)

diff --git a/tests/quick/.common.ml b/tests/quick/.common.ml
index 9ee90649..fe217640 100644
--- a/tests/quick/.common.ml
+++ b/tests/quick/.common.ml
@@ -1,8 +1,9 @@
 #use "topfind";;
-#directory "_build/core/";;
-#directory "_build/string";;
-#directory "_build/misc";;
-#directory "_build/lwt";;
+#directory "_build/src/core/";;
+#directory "_build/src/string";;
+#directory "_build/src/misc";;
+#directory "_build/src/io";;
+#directory "_build/src/lwt";;
 
 #require "unix";;
 
diff --git a/tests/quick/levenshtein_dict.ml b/tests/quick/levenshtein_dict.ml
index 8700c4fa..5fc2c3be 100755
--- a/tests/quick/levenshtein_dict.ml
+++ b/tests/quick/levenshtein_dict.ml
@@ -2,13 +2,12 @@
 #use "tests/quick/.common.ml";;
 #load "containers.cma";;
 #load "containers_string.cma";;
+#load "containers_io.cma";;
 
 open Containers_string
 
-let words = CCIO.(
-  (with_in "/usr/share/dict/cracklib-small" >>>= read_lines)
-  |> run_exn
-  )
+let words =
+  CCIO.with_in "/usr/share/dict/words" CCIO.read_lines_l
 
 let idx = List.fold_left
   (fun idx s -> Levenshtein.Index.add idx s s)

From 705fcff4ec25b059066b8f64ae67da59d3bfb88d Mon Sep 17 00:00:00 2001
From: Simon Cruanes <simon.cruanes.2007@m4x.org>
Date: Wed, 18 Feb 2015 11:32:09 +0100
Subject: [PATCH 28/72] simplified CCTrie implementation

---
 src/data/CCTrie.ml | 152 +++++++++++++++++----------------------------
 1 file changed, 56 insertions(+), 96 deletions(-)

diff --git a/src/data/CCTrie.ml b/src/data/CCTrie.ml
index 2956fe2f..bdebe9b8 100644
--- a/src/data/CCTrie.ml
+++ b/src/data/CCTrie.ml
@@ -125,7 +125,7 @@ module Make(W : WORD) = struct
 
   type 'a t =
     | Empty
-    | Path of char_ list * 'a t
+    | Cons of char_ * 'a t  (* simple case *)
     | Node of 'a option * 'a t M.t
 
   (* invariants:
@@ -136,7 +136,6 @@ module Make(W : WORD) = struct
   let empty = Empty
 
   let _invariant = function
-    | Path ([],_) -> false
     | Node (None, map) when M.is_empty map -> false
     | _ -> true
 
@@ -164,10 +163,6 @@ module Make(W : WORD) = struct
   let _seq_map map k =
     M.iter (fun key v -> k (key,v)) map
 
-  let _is_path = function
-    | Path _ -> true
-    | _ -> false
-
   (* return common prefix, and disjoint suffixes *)
   let rec _merge_lists l1 l2 = match l1, l2 with
     | [], _
@@ -180,41 +175,28 @@ module Make(W : WORD) = struct
         else
           [], l1, l2
 
-  (* prefix [l] to the tree [t] *)
-  let _mk_path l t = match l, t with
-    | [], _ -> t
-    | _, Empty -> Empty
-    | _, Node _ -> Path (l, t)
-    | _, Path (l',t') ->
-        assert (not(_is_path t'));
-        Path (l@l', t')
-
-  let _mk_path_cons x t = match t with
-    | Empty -> Empty
-    | Node _ -> Path ([x], t)
-    | Path (l', t') ->
-        assert (not(_is_path t'));
-        Path (x::l', t')
 
+  (* sub-tree t prefixed with c *)
+  let _cons c t = Cons (c, t)
   (* build a Node value *)
   let _mk_node value map = match value with
     | Some _ -> Node (value, map)
     | None ->
-        if M.is_empty map then Empty
-        else
-          let high, t' = M.max_binding map in
-          let low, _ = M.min_binding map in
-          if W.compare low high = 0
-            then _mk_path [high] t'  (* only one element *)
-            else Node (value,map)
+      if M.is_empty map then Empty
+      else
+        if M.cardinal map = 1
+        then
+          let c, sub = M.min_binding map in
+          _cons c sub
+        else Node (value,map)
 
-  let _remove_sub c t = match t with
+  (* remove key [c] from [t] *)
+  let _remove c t = match t with
     | Empty -> t
-    | Path ([], _) -> assert false
-    | Path (c'::_, _) ->
-        if W.compare c c' = 0
-          then Empty
-          else t
+    | Cons (c', _) ->
+      if W.compare c c' = 0
+      then Empty
+      else t
     | Node (value, map) ->
         if M.mem c map
         then
@@ -223,29 +205,23 @@ module Make(W : WORD) = struct
         else t
 
   let update key f t =
-    (* [state]: current subtree and rebuild function; [x]: current char *)
+    (* first arg: current subtree and rebuild function; [c]: current char *)
     let goto (t, rebuild) c =
       match t with
-      | Empty -> (t, fun t -> rebuild (_mk_path_cons c t))
-      | Path ([], _) -> assert false
-      | Path (c'::l, t') ->
-          if W.compare c c' = 0
-          then
-            (* follow the path *)
-            _mk_path l t', (fun t -> rebuild (_mk_path_cons c t))
-          else
-            (* exit the path, so we have an empty tree. Upon rebuild we
-                potentially need to make a map *)
-            let rebuild' new_child =
-              rebuild (
-                if is_empty new_child then t
-                else
-                  let map = M.singleton c new_child in
-                  let map = M.add c' (_mk_path l t') map in
-                  _mk_node None map
-              )
-            in
-            empty, rebuild'
+      | Empty -> empty, fun t -> rebuild (_cons c t)
+      | Cons (c', t') ->
+        if W.compare c c' = 0
+        then t', (fun t -> rebuild (_cons c t))
+        else
+          let rebuild' new_child =
+            rebuild (
+              if is_empty new_child then t
+              else
+                let map = M.singleton c new_child in
+                let map = M.add c' t' map in
+                _mk_node None map
+          ) in
+          empty, rebuild'
       | Node (value, map) ->
           try
             let t' = M.find c map in
@@ -271,13 +247,11 @@ module Make(W : WORD) = struct
     in
     let finish (t,rebuild) = match t with
       | Empty -> rebuild (_mk_node (f None) M.empty)
-      | Path ([], _) -> assert false
-      | Path (c::l', t') ->
-          rebuild (
-            match f None with
-            | None -> t   (* TODO: raise exception & return original tree *)
-            | Some _ as v ->
-                _mk_node v (M.singleton c (_mk_path l' t'))
+      | Cons (c, t') ->
+        rebuild
+          (match f None with
+           | None -> t
+           | Some _ as v -> _mk_node v (M.singleton c t')
           )
       | Node (value, map) ->
           let value' = f value in
@@ -294,10 +268,9 @@ module Make(W : WORD) = struct
     (* at subtree [t], and character [c] *)
     let goto t c = match t with
       | Empty -> raise Not_found
-      | Path ([], _) -> assert false
-      | Path (c'::l, t') ->
+      | Cons (c', t') ->
           if W.compare c c' = 0
-            then _mk_path l t'
+            then t'
             else raise Not_found
       | Node (_, map) -> M.find c map
     and finish t = match t with
@@ -311,7 +284,6 @@ module Make(W : WORD) = struct
     try Some (find_exn k t)
     with Not_found -> None
 
-  let _difflist_append f l = fun l' -> f (l @ l')
   let _difflist_add f x = fun l' -> f (x :: l')
 
   (* fold that also keeps the path from the root, so as to provide the list
@@ -319,7 +291,7 @@ module Make(W : WORD) = struct
       a function that prepends a list to some suffix *)
   let rec _fold f path t acc = match t with
     | Empty -> acc
-    | Path (l, t') -> _fold f (_difflist_append path l) t' acc
+    | Cons (c, t') -> _fold f (_difflist_add path c) t' acc
     | Node (v, map) ->
         let acc = match v with
           | None -> acc
@@ -350,7 +322,7 @@ module Make(W : WORD) = struct
 
   let rec fold_values f acc t = match t with
     | Empty -> acc
-    | Path (_, t') -> fold_values f acc t'
+    | Cons (_, t') -> fold_values f acc t'
     | Node (v, map) ->
         let acc = match v with
           | None -> acc
@@ -365,29 +337,19 @@ module Make(W : WORD) = struct
   let rec merge f t1 t2 = match t1, t2 with
     | Empty, _ -> t2
     | _, Empty -> t1
-    | Path (l1,t1'), Path (l2,t2') ->
-        let common, l1', l2' = _merge_lists l1 l2 in
-        begin match l1', l2' with
-          | c1::l1'', c2::l2'' ->
-              (* need to build a map here, to represent the choice
-                between [c1] and [c2] *)
-              assert (W.compare c1 c2 <> 0);
-              let map = M.add c1 (_mk_path l1'' t1') M.empty in
-              let map = M.add c2 (_mk_path l2'' t2') map in
-              _mk_path common (Node (None, map))
-          | _ ->
-              _mk_path common
-                (merge f
-                  (_mk_path l1' t1')
-                  (_mk_path l2' t2')
-                )
-        end
-    | Path ([], _), _ -> assert false
-    | Path (c1::l1, t1'), Node (value, map) ->
+    | Cons (c1,t1'), Cons (c2,t2') ->
+      if W.compare c1 c2 = 0
+      then _cons c1 (merge f t1' t2')
+      else
+        let map = M.add c1 t1' M.empty in
+        let map = M.add c2 t2' map in
+        _mk_node None map
+
+    | Cons (c1, t1'), Node (value, map) ->
         begin try
           (* collision *)
           let t2' = M.find c1 map in
-          let new_t = merge f (_mk_path l1 t1') t2' in
+          let new_t = merge f t1' t2' in
           let map' = if is_empty new_t
             then M.remove c1 map
             else M.add c1 new_t map
@@ -396,9 +358,9 @@ module Make(W : WORD) = struct
         with Not_found ->
           (* no collision *)
           assert (not(is_empty t1'));
-          Node (value, M.add c1 (_mk_path l1 t1') map)
+          Node (value, M.add c1 t1' map)
         end
-    | Node _, Path _ -> merge f t2 t1  (* previous case *)
+    | Node _, Cons _ -> merge f t2 t1  (* previous case *)
     | Node(v1, map1), Node (v2, map2) ->
         let v = match v1, v2 with
           | None, _ -> v2
@@ -419,7 +381,7 @@ module Make(W : WORD) = struct
 
   let rec size t = match t with
     | Empty -> 0
-    | Path (_, t') -> size t'
+    | Cons (_, t') -> size t'
     | Node (v, map) ->
         let s = if v=None then 0 else 1 in
         M.fold
@@ -442,8 +404,7 @@ module Make(W : WORD) = struct
     let _tree_node x l () = `Node (x,l) in
     match t with
     | Empty -> `Nil
-    | Path ([], _) -> assert false
-    | Path (c::l, t') -> `Node (`Char c, [to_tree (_mk_path l t')])
+    | Cons (c, t') -> `Node (`Char c, [to_tree t'])
     | Node (v, map) ->
         let x = match v with
           | None -> `Switch
@@ -464,10 +425,9 @@ module Make(W : WORD) = struct
       match cur with
       | None -> (None, alternatives)
       | Some (Empty,_) -> (None, alternatives)
-      | Some (Path ([], _),_) -> assert false
-      | Some (Path (c'::l, t'), trail) ->
+      | Some (Cons (c', t'), trail) ->
           if W.compare c c' = 0
-            then Some (_mk_path l t', _difflist_add trail c), alternatives
+            then Some (t', _difflist_add trail c), alternatives
             else None, alternatives
       | Some (Node (_, map), trail) ->
           let alternatives =

From f6ea8b0aa28cbd31f57d2e2f4b9e9837f15fa7b5 Mon Sep 17 00:00:00 2001
From: Simon Cruanes <simon.cruanes.2007@m4x.org>
Date: Wed, 18 Feb 2015 16:53:28 +0100
Subject: [PATCH 29/72] small change in doc/build_deps.ml

---
 doc/build_deps.ml | 5 ++++-
 1 file changed, 4 insertions(+), 1 deletion(-)

diff --git a/doc/build_deps.ml b/doc/build_deps.ml
index 5386c641..37633b20 100755
--- a/doc/build_deps.ml
+++ b/doc/build_deps.ml
@@ -18,9 +18,12 @@ let odoc_files =
   |> Gen.to_list
 ;;
 
+let out = "deps.dot";;
+
 let cmd =
-  "ocamldoc -dot -o deps.dot " ^ String.concat " " odoc_files
+  "ocamldoc -dot -o " ^ out ^ " " ^ String.concat " " odoc_files
 ;;
 
 print_endline ("run: " ^ cmd);;
 Unix.system cmd;;
+print_endline ("output in " ^ out);;

From 77b6197c496286245c84529f1e56cc21aaac8f0a Mon Sep 17 00:00:00 2001
From: Simon Cruanes <simon.cruanes.2007@m4x.org>
Date: Thu, 19 Feb 2015 16:41:47 +0100
Subject: [PATCH 30/72] wip: Lwt_pipe

---
 _oasis               |   2 +-
 src/lwt/lwt_pipe.ml  | 287 +++++++++++++++++++++++++++++++++++++++++++
 src/lwt/lwt_pipe.mli | 140 +++++++++++++++++++++
 3 files changed, 428 insertions(+), 1 deletion(-)
 create mode 100644 src/lwt/lwt_pipe.ml
 create mode 100644 src/lwt/lwt_pipe.mli

diff --git a/_oasis b/_oasis
index 5338b481..af6dbc2c 100644
--- a/_oasis
+++ b/_oasis
@@ -132,7 +132,7 @@ Library "containers_thread"
 
 Library "containers_lwt"
   Path:             src/lwt
-  Modules:          Lwt_automaton, Lwt_actor, Lwt_klist
+  Modules:          Lwt_automaton, Lwt_actor, Lwt_klist, Lwt_pipe
   Pack:             true
   FindlibName:      lwt
   FindlibParent:    containers
diff --git a/src/lwt/lwt_pipe.ml b/src/lwt/lwt_pipe.ml
new file mode 100644
index 00000000..7998267e
--- /dev/null
+++ b/src/lwt/lwt_pipe.ml
@@ -0,0 +1,287 @@
+
+(*
+copyright (c) 2013-2014, simon cruanes
+all rights reserved.
+
+redistribution and use in source and binary forms, with or without
+modification, are permitted provided that the following conditions are met:
+
+redistributions of source code must retain the above copyright notice, this
+list of conditions and the following disclaimer.  redistributions in binary
+form must reproduce the above copyright notice, this list of conditions and the
+following disclaimer in the documentation and/or other materials provided with
+the distribution.
+
+THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" AND
+ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED
+WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE
+DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDER OR CONTRIBUTORS BE LIABLE
+FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL
+DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR
+SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER
+CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY,
+OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE
+OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+*)
+
+type 'a or_error = [`Ok of 'a | `Error of string]
+type 'a step = ['a or_error | `End]
+
+let (>>=) = Lwt.(>>=)
+let (>|=) = Lwt.(>|=)
+
+module LwtErr = struct
+  type 'a t = 'a or_error Lwt.t
+
+  let return x = Lwt.return (`Ok x)
+
+  let return_unit = Lwt.return (`Ok ())
+
+  let fail msg = Lwt.return (`Error msg)
+
+  let (>>=) x f =
+    Lwt.bind x
+      (function
+        | `Error msg -> fail msg
+        | `Ok y -> f y
+      )
+
+  let (>|=) x f =
+    Lwt.map
+      (function
+        | `Error _ as e -> e
+        | `Ok x -> `Ok (f x)
+      ) x
+end
+
+let step_map f = function
+  | `Ok x -> `Ok (f x)
+  | (`Error _ | `End) as e -> e
+
+let (>>|=) = LwtErr.(>|=)
+
+let ret_end = Lwt.return `End
+
+module Pipe = struct
+  type -'a writer = 'a step -> unit Lwt.t
+
+  type +'a reader = unit -> 'a step Lwt.t
+
+  (* messages given to writers through the condition *)
+  type 'a msg =
+    | Send of 'a step Lwt.u (* send directly to reader *)
+    | SendQueue (* push into queue *)
+
+  type 'a t = {
+    lock : Lwt_mutex.t;
+    queue : 'a step Queue.t;
+    max_size : int;
+    cond : 'a msg Lwt_condition.t;
+    mutable keep : unit Lwt.t list;  (* do not GC *)
+  }
+
+  let create ?(max_size=0) () = {
+    queue=Queue.create();
+    max_size;
+    lock=Lwt_mutex.create();
+    cond=Lwt_condition.create();
+    keep=[];
+  }
+
+  let keep p fut = p.keep <- fut :: p.keep
+
+  (* read next one *)
+  let reader t () =
+    Lwt_mutex.with_lock t.lock
+      (fun () ->
+         if Queue.is_empty t.queue
+         then (
+           let fut, send = Lwt.wait () in
+           Lwt_condition.signal t.cond (Send send);
+           fut
+         ) else (
+           (* direct pop *)
+           assert (t.max_size > 0);
+           let x = Queue.pop t.queue in
+           Lwt_condition.signal t.cond SendQueue;  (* queue isn't full anymore *)
+           Lwt.return x
+         )
+      )
+
+  (* write a value *)
+  let writer t x =
+    let rec try_write () =
+      if Queue.length t.queue < t.max_size then (
+        Queue.push x t.queue;
+        Lwt.return_unit
+      ) else (
+        (* wait for readers to consume the queue *)
+        Lwt_condition.wait ~mutex:t.lock t.cond >>= fun msg ->
+        match msg with
+          | Send s ->
+            Lwt.wakeup s x;
+            Lwt.return_unit
+          | SendQueue -> try_write () (* try again! *)
+      )
+    in
+    Lwt_mutex.with_lock t.lock try_write
+
+  let create_pair ?max_size () =
+    let p = create ?max_size () in
+    reader p, writer p
+
+  let rec connect_ (r:'a reader) (w:'a writer) =
+    r () >>= function
+    | `End -> w `End (* then stop *)
+    | (`Error _ | `Ok _) as step -> w step >>= fun () -> connect_ r w
+
+  let pipe_into p1 p2 =
+    connect_ (reader p1) (writer p2)
+end
+
+let connect r w = Pipe.connect_ r w
+
+module Writer = struct
+  type -'a t = 'a Pipe.writer
+
+  let write t x = t (`Ok x)
+
+  let write_error t msg = t (`Error msg)
+
+  let write_end t = t `End
+
+  let rec write_list t l = match l with
+    | [] -> Lwt.return_unit
+    | x :: tail ->
+      write t x >>= fun () -> write_list t tail
+
+  let map ~f t x = t (step_map f x)
+end
+
+module Reader = struct
+  type +'a t = 'a Pipe.reader
+
+  let read t = t ()
+
+  let map ~f t () =
+    t () >|= (step_map f)
+
+  let rec filter_map ~f t () =
+    t () >>= function
+    | `Error msg -> LwtErr.fail msg
+    | `Ok x ->
+      begin match f x with
+        | Some y -> LwtErr.return y
+        | None -> filter_map ~f t ()
+      end
+    | `End -> ret_end
+
+  let rec fold ~f ~x t =
+    t () >>= function
+    | `End -> LwtErr.return x
+    | `Error msg -> LwtErr.fail msg
+    | `Ok y -> fold ~f ~x:(f x y) t
+
+  let rec fold_s ~f ~x t =
+    t () >>= function
+    | `End -> LwtErr.return x
+    | `Error msg -> LwtErr.fail msg
+    | `Ok y ->
+      f x y >>= fun x -> fold_s ~f ~x t
+
+  let rec iter ~f t =
+    t () >>= function
+    | `End -> LwtErr.return_unit
+    | `Error msg -> LwtErr.fail msg
+    | `Ok x -> f x; iter ~f t
+
+  let rec iter_s ~f t =
+    t () >>= function
+    | `End -> LwtErr.return_unit
+    | `Error msg -> LwtErr.fail msg
+    | `Ok x -> f x >>= fun () -> iter_s ~f t
+
+  let merge a b : _ t =
+    let r, w = Pipe.create_pair () in
+    Lwt.async (fun () -> Lwt.join [connect a w; connect b w]);
+    r
+end
+
+(** {2 Conversions} *)
+
+let of_list l : _ Reader.t =
+  let l = ref l in
+  fun () -> match !l with
+    | [] -> ret_end
+    | x :: tail ->
+      l := tail;
+      Lwt.return (`Ok x)
+
+let of_array a =
+  let i = ref 0 in
+  fun () ->
+    if !i = Array.length a
+    then ret_end
+    else (
+      let x = a.(!i) in
+      incr i;
+      Lwt.return (`Ok x)
+    )
+
+let of_string s =
+  let i = ref 0 in
+  fun () ->
+    if !i = String.length s
+    then ret_end
+    else (
+      let x = String.get s !i in
+      incr i;
+      Lwt.return (`Ok x)
+    )
+
+let to_rev_list w =
+  Reader.fold ~f:(fun acc x -> x :: acc) ~x:[] w
+
+let to_list w = to_rev_list w >>|= List.rev
+
+let to_list_exn w =
+  to_list w >>= function
+  | `Error msg -> Lwt.fail (Failure msg)
+  | `Ok x -> Lwt.return x
+
+let to_buffer buf : _ Writer.t = function
+  | `Ok c ->
+    Buffer.add_char buf c;
+    Lwt.return_unit
+  | `Error _ | `End -> Lwt.return_unit
+
+let to_buffer_str buf = function
+  | `Ok s ->
+    Buffer.add_string buf s;
+    Lwt.return_unit
+  | `Error _ | `End -> Lwt.return_unit
+
+(** {2 Basic IO wrappers} *)
+
+module IO = struct
+  let read ?(bufsize=4096) ic : _ Reader.t =
+    let buf = Bytes.make bufsize ' ' in
+    fun () ->
+      Lwt_io.read_into ic buf 0 bufsize >>= fun n ->
+      if n = 0 then ret_end
+      else
+        Lwt.return (`Ok (Bytes.sub_string buf 0 n))
+
+  let read_lines ic () =
+    Lwt_io.read_line_opt ic >>= function
+    | None -> ret_end
+    | Some line -> Lwt.return (`Ok line)
+
+  let write oc = function
+    | `Ok s -> Lwt_io.write oc s
+    | `End | `Error _ -> Lwt.return_unit
+
+  let write_lines oc = function
+    | `Ok l -> Lwt_io.write_line oc l
+    | `End | `Error _ -> Lwt.return_unit
+end
diff --git a/src/lwt/lwt_pipe.mli b/src/lwt/lwt_pipe.mli
new file mode 100644
index 00000000..71bb73d1
--- /dev/null
+++ b/src/lwt/lwt_pipe.mli
@@ -0,0 +1,140 @@
+
+(*
+copyright (c) 2013-2014, simon cruanes
+all rights reserved.
+
+redistribution and use in source and binary forms, with or without
+modification, are permitted provided that the following conditions are met:
+
+redistributions of source code must retain the above copyright notice, this
+list of conditions and the following disclaimer.  redistributions in binary
+form must reproduce the above copyright notice, this list of conditions and the
+following disclaimer in the documentation and/or other materials provided with
+the distribution.
+
+THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" AND
+ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED
+WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE
+DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDER OR CONTRIBUTORS BE LIABLE
+FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL
+DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR
+SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER
+CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY,
+OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE
+OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+*)
+
+(** {1 Pipes, Readers, Writers}
+
+  Stream processing using:
+
+  {- Pipe: a possibly buffered channel through which readers and writer communicate}
+  {- Reader: accepts values, produces effects}
+  {- Writer: yield values}
+*)
+
+type 'a or_error = [`Ok of 'a | `Error of string]
+type 'a step = ['a or_error | `End]
+
+module LwtErr : sig
+  type 'a t = 'a or_error Lwt.t
+  val (>>=) : 'a t -> ('a -> 'b t) -> 'b t
+  val (>|=) : 'a t -> ('a -> 'b) -> 'b t
+  val return : 'a -> 'a t
+  val fail : string -> 'a t
+end
+
+module Writer : sig
+  type -'a t
+
+  val write : 'a t -> 'a -> unit Lwt.t
+
+  val write_list : 'a t -> 'a list -> unit Lwt.t
+
+  val write_error : _ t -> string -> unit Lwt.t
+
+  val write_end : _ t -> unit Lwt.t
+
+  val map : f:('a -> 'b) -> 'b t -> 'a t
+end
+
+module Reader : sig
+  type +'a t
+
+  val read : 'a t -> 'a step Lwt.t
+
+  val map : f:('a -> 'b) -> 'a t -> 'b t
+
+  val filter_map : f:('a -> 'b option) -> 'a t -> 'b t
+
+  val fold : f:('acc -> 'a -> 'acc) -> x:'acc -> 'a t -> 'acc LwtErr.t
+
+  val fold_s : f:('acc -> 'a -> 'acc Lwt.t) -> x:'acc -> 'a t -> 'acc LwtErr.t
+
+  val iter : f:('a -> unit) -> 'a t -> unit LwtErr.t
+
+  val iter_s : f:('a -> unit Lwt.t) -> 'a t -> unit LwtErr.t
+
+  val merge : 'a t -> 'a t -> 'a t
+  (** Merge the two input streams *)
+end
+
+module Pipe : sig
+  type 'a t
+  (** A pipe between producers of values of type 'a, and consumers of values
+      of type 'a. *)
+
+  val reader : 'a t -> 'a Reader.t
+
+  val writer : 'a t -> 'a Writer.t
+
+  val keep : _ t -> unit Lwt.t -> unit
+  (** [keep p fut] adds a pointer from [p] to [fut] so that [fut] is not
+      garbage-collected before [p] *)
+
+  val create : ?max_size:int -> unit -> 'a t
+  (** Create a new pipe.
+      @param max_size size of internal buffer. Default 0. *)
+
+  val create_pair : ?max_size:int -> unit -> 'a Reader.t * 'a Writer.t
+  (** Create a pair [r, w] connect by a pipe *)
+
+  val pipe_into : 'a t -> 'a t -> unit Lwt.t
+  (** [connect p1 p2] forwards every item output by [p1] into [p2]'s input
+      until [`End] is reached. After [`End] is sent, the process stops. *)
+end
+
+val connect : 'a Reader.t -> 'a Writer.t -> unit Lwt.t
+(** [connect r w] sends every item read from [r] into [w] *)
+
+(** {2 Conversions} *)
+
+val of_list : 'a list -> 'a Reader.t
+
+val of_array : 'a array -> 'a Reader.t
+
+val of_string : string -> char Reader.t
+
+val to_rev_list : 'a Reader.t -> 'a list LwtErr.t
+
+val to_list : 'a Reader.t -> 'a list LwtErr.t
+
+val to_list_exn : 'a Reader.t -> 'a list Lwt.t
+(** Same as {!to_list}, but can fail with
+    @raise Failure if some error is met *)
+
+val to_buffer : Buffer.t -> char Writer.t
+
+val to_buffer_str : Buffer.t -> string Writer.t
+
+(** {2 Basic IO wrappers} *)
+
+module IO : sig
+  val read : ?bufsize:int -> Lwt_io.input_channel -> string Reader.t
+
+  val read_lines : Lwt_io.input_channel -> string Reader.t
+
+  val write : Lwt_io.output_channel -> string Writer.t
+
+  val write_lines : Lwt_io.output_channel -> string Writer.t
+end

From c6b23890ec37d4969b4d4ad258138a659e75feef Mon Sep 17 00:00:00 2001
From: Simon Cruanes <simon.cruanes.2007@m4x.org>
Date: Thu, 19 Feb 2015 18:15:49 +0100
Subject: [PATCH 31/72] Lwt_pipe now with reader/writer subtypes of pipe,
 better API, safer closing

---
 src/lwt/lwt_pipe.ml  | 354 ++++++++++++++++++++++++++++---------------
 src/lwt/lwt_pipe.mli |  87 ++++++-----
 2 files changed, 284 insertions(+), 157 deletions(-)

diff --git a/src/lwt/lwt_pipe.ml b/src/lwt/lwt_pipe.ml
index 7998267e..f91b89fd 100644
--- a/src/lwt/lwt_pipe.ml
+++ b/src/lwt/lwt_pipe.ml
@@ -28,7 +28,6 @@ type 'a or_error = [`Ok of 'a | `Error of string]
 type 'a step = ['a or_error | `End]
 
 let (>>=) = Lwt.(>>=)
-let (>|=) = Lwt.(>|=)
 
 module LwtErr = struct
   type 'a t = 'a or_error Lwt.t
@@ -54,234 +53,343 @@ module LwtErr = struct
       ) x
 end
 
-let step_map f = function
-  | `Ok x -> `Ok (f x)
-  | (`Error _ | `End) as e -> e
-
 let (>>|=) = LwtErr.(>|=)
 
 let ret_end = Lwt.return `End
 
+exception Closed
+
 module Pipe = struct
-  type -'a writer = 'a step -> unit Lwt.t
-
-  type +'a reader = unit -> 'a step Lwt.t
-
   (* messages given to writers through the condition *)
   type 'a msg =
     | Send of 'a step Lwt.u (* send directly to reader *)
     | SendQueue (* push into queue *)
+    | Close (* close *)
 
-  type 'a t = {
+  type 'a inner_buf =
+    | Buf of 'a step Queue.t * int  (* buf, max size *)
+    | NoBuf
+
+  type ('a, +'perm) t = {
+    close : unit Lwt.u;
+    closed : unit Lwt.t;
     lock : Lwt_mutex.t;
-    queue : 'a step Queue.t;
-    max_size : int;
+    buf : 'a inner_buf;
     cond : 'a msg Lwt_condition.t;
-    mutable keep : unit Lwt.t list;  (* do not GC *)
-  }
+    mutable keep : unit Lwt.t list;  (* do not GC, and wait for completion *)
+  } constraint 'perm = [< `r | `w]
 
-  let create ?(max_size=0) () = {
-    queue=Queue.create();
-    max_size;
-    lock=Lwt_mutex.create();
-    cond=Lwt_condition.create();
-    keep=[];
-  }
+  let create ?(max_size=0) () =
+    let buf = match max_size with
+      | 0 -> NoBuf
+      | n when n < 0 -> invalid_arg "max_size"
+      | n -> Buf (Queue.create (), n)
+    in
+    let closed, close = Lwt.wait () in
+    {
+      close;
+      closed;
+      buf;
+      lock=Lwt_mutex.create();
+      cond=Lwt_condition.create();
+      keep=[];
+    }
 
   let keep p fut = p.keep <- fut :: p.keep
 
+  let is_closed p = not (Lwt.is_sleeping p.closed)
+
+  let close p =
+    if is_closed p then Lwt.return_unit
+    else (
+      Lwt.wakeup p.close (); (* evaluate *)
+      Lwt_condition.broadcast p.cond Close;
+      Lwt.join p.keep;
+    )
+
+  let close_async p = Lwt.async (fun () -> close p)
+
+  let on_close p = p.closed
+
+  (* try to take next element from buffer *)
+  let try_next_buf t = match t.buf with
+    | NoBuf -> None
+    | Buf (q, _) ->
+      if Queue.is_empty q then None
+      else Some (Queue.pop q)
+
+  (* returns true if it could push successfully *)
+  let try_push_buf t x = match t.buf with
+    | NoBuf -> false
+    | Buf (q, max_size) when Queue.length q = max_size -> false
+    | Buf (q, _) -> Queue.push x q; true
+
   (* read next one *)
-  let reader t () =
+  let read t =
     Lwt_mutex.with_lock t.lock
       (fun () ->
-         if Queue.is_empty t.queue
-         then (
+         match try_next_buf t with
+         | None when is_closed t -> ret_end (* end of stream *)
+         | None ->
            let fut, send = Lwt.wait () in
            Lwt_condition.signal t.cond (Send send);
            fut
-         ) else (
-           (* direct pop *)
-           assert (t.max_size > 0);
-           let x = Queue.pop t.queue in
+         | Some x ->
            Lwt_condition.signal t.cond SendQueue;  (* queue isn't full anymore *)
            Lwt.return x
-         )
       )
 
   (* write a value *)
-  let writer t x =
+  let write t x =
     let rec try_write () =
-      if Queue.length t.queue < t.max_size then (
-        Queue.push x t.queue;
-        Lwt.return_unit
-      ) else (
+      if is_closed t then Lwt.fail Closed
+      else if try_push_buf t x
+      then Lwt.return_unit  (* into buffer, do not wait *)
+      else (
         (* wait for readers to consume the queue *)
         Lwt_condition.wait ~mutex:t.lock t.cond >>= fun msg ->
         match msg with
-          | Send s ->
-            Lwt.wakeup s x;
-            Lwt.return_unit
-          | SendQueue -> try_write () (* try again! *)
+        | Send s ->
+          Lwt.wakeup s x;  (* sync with reader *)
+          Lwt.return_unit
+        | SendQueue -> try_write () (* try again! *)
+        | Close -> Lwt.fail Closed
       )
     in
     Lwt_mutex.with_lock t.lock try_write
 
-  let create_pair ?max_size () =
-    let p = create ?max_size () in
-    reader p, writer p
+  let rec connect_rec r w =
+    read r >>= function
+    | `End -> Lwt.return_unit
+    | (`Error _ | `Ok _) as step ->
+      write w step >>= fun () ->
+      connect_rec r w
 
-  let rec connect_ (r:'a reader) (w:'a writer) =
-    r () >>= function
-    | `End -> w `End (* then stop *)
-    | (`Error _ | `Ok _) as step -> w step >>= fun () -> connect_ r w
+  let connect a b =
+    let fut = connect_rec a b in
+    keep b fut
 
-  let pipe_into p1 p2 =
-    connect_ (reader p1) (writer p2)
+  (* close a when b closes *)
+  let close_when_closed a b =
+    Lwt.on_success b.closed
+      (fun () -> close_async a)
+
+  (* close a when every member of l closes *)
+  let close_when_all_closed a l =
+    let n = ref (List.length l) in
+    List.iter
+      (fun p -> Lwt.on_success p.closed
+          (fun () ->
+             decr n;
+             if !n = 0 then close_async a
+          )
+      ) l
 end
 
-let connect r w = Pipe.connect_ r w
-
 module Writer = struct
-  type -'a t = 'a Pipe.writer
+  type 'a t = ('a, [`w]) Pipe.t
 
-  let write t x = t (`Ok x)
+  let write t x = Pipe.write t (`Ok x)
 
-  let write_error t msg = t (`Error msg)
-
-  let write_end t = t `End
+  let write_error t msg = Pipe.write t (`Error msg)
 
   let rec write_list t l = match l with
     | [] -> Lwt.return_unit
     | x :: tail ->
       write t x >>= fun () -> write_list t tail
 
-  let map ~f t x = t (step_map f x)
+  let map ~f a =
+    let b = Pipe.create() in
+    let rec fwd () =
+      Pipe.read b >>= function
+      | `Ok x -> write a (f x) >>= fwd
+      | `Error msg -> write_error a msg >>= fwd
+      | `End -> Lwt.return_unit
+    in
+    Pipe.keep b (fwd());
+    (* when a gets closed, close b too *)
+    Lwt.on_success (Pipe.on_close a) (fun () -> Pipe.close_async b);
+    b
+
+  let send_all l =
+    if l = [] then invalid_arg "send_all";
+    let res = Pipe.create () in
+    let rec fwd () =
+      Pipe.read res >>= function
+      | `End -> Lwt.return_unit
+      | `Ok x -> Lwt_list.iter_p (fun p -> write p x) l >>= fwd
+      | `Error msg -> Lwt_list.iter_p (fun p -> write_error p msg) l >>= fwd
+    in
+    (* do not GC before res dies; close res when any outputx is closed *)
+    Pipe.keep res (fwd ());
+    List.iter (Pipe.close_when_closed res) l;
+    res
+
+  let send_both a b = send_all [a; b]
 end
 
 module Reader = struct
-  type +'a t = 'a Pipe.reader
+  type 'a t = ('a, [`r]) Pipe.t
 
-  let read t = t ()
+  let read = Pipe.read
 
-  let map ~f t () =
-    t () >|= (step_map f)
+  let map ~f a =
+    let b = Pipe.create () in
+    let rec fwd () =
+      Pipe.read a >>= function
+      | `Ok x -> Pipe.write b (`Ok (f x)) >>= fwd
+      | (`Error _) as e -> Pipe.write b e >>= fwd
+      | `End -> Pipe.close b
+    in
+    Pipe.keep b (fwd());
+    b
 
-  let rec filter_map ~f t () =
-    t () >>= function
-    | `Error msg -> LwtErr.fail msg
-    | `Ok x ->
-      begin match f x with
-        | Some y -> LwtErr.return y
-        | None -> filter_map ~f t ()
-      end
-    | `End -> ret_end
+  let filter_map ~f a =
+    let b = Pipe.create () in
+    let rec fwd () =
+      Pipe.read a >>= function
+      | `Ok x ->
+        begin match f x with
+          | None -> fwd()
+          | Some y -> Pipe.write b (`Ok y) >>= fwd
+        end
+      | (`Error _) as e -> Pipe.write b e >>= fwd
+      | `End -> Pipe.close b
+    in
+    Pipe.keep b (fwd());
+    b
 
   let rec fold ~f ~x t =
-    t () >>= function
+    read t >>= function
     | `End -> LwtErr.return x
     | `Error msg -> LwtErr.fail msg
     | `Ok y -> fold ~f ~x:(f x y) t
 
   let rec fold_s ~f ~x t =
-    t () >>= function
+    read t >>= function
     | `End -> LwtErr.return x
     | `Error msg -> LwtErr.fail msg
     | `Ok y ->
       f x y >>= fun x -> fold_s ~f ~x t
 
   let rec iter ~f t =
-    t () >>= function
+    read t >>= function
     | `End -> LwtErr.return_unit
     | `Error msg -> LwtErr.fail msg
     | `Ok x -> f x; iter ~f t
 
   let rec iter_s ~f t =
-    t () >>= function
+    read t >>= function
     | `End -> LwtErr.return_unit
     | `Error msg -> LwtErr.fail msg
     | `Ok x -> f x >>= fun () -> iter_s ~f t
 
-  let merge a b : _ t =
-    let r, w = Pipe.create_pair () in
-    Lwt.async (fun () -> Lwt.join [connect a w; connect b w]);
-    r
+  let merge_all l =
+    if l = [] then invalid_arg "merge_all";
+    let res = Pipe.create () in
+    List.iter (fun p -> Pipe.connect p res) l;
+    (* connect res' input to all members of l; close res when they all close *)
+    Pipe.close_when_all_closed res l;
+    res
+
+  let merge_both a b = merge_all [a; b]
 end
 
 (** {2 Conversions} *)
 
 let of_list l : _ Reader.t =
-  let l = ref l in
-  fun () -> match !l with
-    | [] -> ret_end
-    | x :: tail ->
-      l := tail;
-      Lwt.return (`Ok x)
+  let p = Pipe.create ~max_size:0 () in
+  Pipe.keep p (Lwt_list.iter_s (Writer.write p) l >>= fun () -> Pipe.close p);
+  p
 
 let of_array a =
-  let i = ref 0 in
-  fun () ->
-    if !i = Array.length a
-    then ret_end
+  let p = Pipe.create ~max_size:0 () in
+  let rec send i =
+    if i = Array.length a then Pipe.close p
     else (
-      let x = a.(!i) in
-      incr i;
-      Lwt.return (`Ok x)
+      Writer.write p a.(i) >>= fun () ->
+      send (i+1)
     )
+  in
+  Pipe.keep p (send 0);
+  p
 
-let of_string s =
-  let i = ref 0 in
-  fun () ->
-    if !i = String.length s
-    then ret_end
+let of_string a =
+  let p = Pipe.create ~max_size:0 () in
+  let rec send i =
+    if i = String.length a then Pipe.close p
     else (
-      let x = String.get s !i in
-      incr i;
-      Lwt.return (`Ok x)
+      Writer.write p (String.get a i) >>= fun () ->
+      send (i+1)
     )
+  in
+  Pipe.keep p (send 0);
+  p
 
-let to_rev_list w =
-  Reader.fold ~f:(fun acc x -> x :: acc) ~x:[] w
+let to_rev_list r =
+  Reader.fold ~f:(fun acc x -> x :: acc) ~x:[] r
 
-let to_list w = to_rev_list w >>|= List.rev
+let to_list r = to_rev_list r >>|= List.rev
 
-let to_list_exn w =
-  to_list w >>= function
+let to_list_exn r =
+  to_list r >>= function
   | `Error msg -> Lwt.fail (Failure msg)
   | `Ok x -> Lwt.return x
 
-let to_buffer buf : _ Writer.t = function
-  | `Ok c ->
-    Buffer.add_char buf c;
+let to_buffer buf =
+  let p = Pipe.create () in
+  Pipe.keep p (
+    Reader.iter ~f:(fun c -> Buffer.add_char buf c) p >>= fun _ ->
     Lwt.return_unit
-  | `Error _ | `End -> Lwt.return_unit
+  );
+  p
 
-let to_buffer_str buf = function
-  | `Ok s ->
-    Buffer.add_string buf s;
+let to_buffer_str buf =
+  let p = Pipe.create () in
+  Pipe.keep p (
+    Reader.iter ~f:(fun s -> Buffer.add_string buf s) p >>= fun _ ->
     Lwt.return_unit
-  | `Error _ | `End -> Lwt.return_unit
+  );
+  p
 
 (** {2 Basic IO wrappers} *)
 
 module IO = struct
   let read ?(bufsize=4096) ic : _ Reader.t =
     let buf = Bytes.make bufsize ' ' in
-    fun () ->
+    let p = Pipe.create ~max_size:0 () in
+    let rec send() =
       Lwt_io.read_into ic buf 0 bufsize >>= fun n ->
-      if n = 0 then ret_end
+      if n = 0 then Pipe.close p
       else
-        Lwt.return (`Ok (Bytes.sub_string buf 0 n))
+        Writer.write p (Bytes.sub_string buf 0 n) >>= fun () ->
+        send ()
+    in Lwt.async send;
+    p
 
-  let read_lines ic () =
-    Lwt_io.read_line_opt ic >>= function
-    | None -> ret_end
-    | Some line -> Lwt.return (`Ok line)
+  let read_lines ic =
+    let p = Pipe.create () in
+    let rec send () =
+      Lwt_io.read_line_opt ic >>= function
+      | None -> Pipe.close p
+      | Some line -> Writer.write p line >>= fun () -> send ()
+    in
+    Lwt.async send;
+    p
 
-  let write oc = function
-    | `Ok s -> Lwt_io.write oc s
-    | `End | `Error _ -> Lwt.return_unit
+  let write oc =
+    let p = Pipe.create () in
+    Pipe.keep p (
+      Reader.iter_s ~f:(Lwt_io.write oc) p >>= fun _ ->
+      Pipe.close p
+    );
+    p
 
-  let write_lines oc = function
-    | `Ok l -> Lwt_io.write_line oc l
-    | `End | `Error _ -> Lwt.return_unit
+  let write_lines oc =
+    let p = Pipe.create () in
+    Pipe.keep p (
+      Reader.iter_s ~f:(Lwt_io.write_line oc) p >>= fun _ ->
+      Pipe.close p
+    );
+    p
 end
diff --git a/src/lwt/lwt_pipe.mli b/src/lwt/lwt_pipe.mli
index 71bb73d1..836977db 100644
--- a/src/lwt/lwt_pipe.mli
+++ b/src/lwt/lwt_pipe.mli
@@ -44,22 +44,65 @@ module LwtErr : sig
   val fail : string -> 'a t
 end
 
+exception Closed
+
+module Pipe : sig
+  type ('a, +'perm) t constraint 'perm = [< `r | `w]
+  (** A pipe between producers of values of type 'a, and consumers of values
+      of type 'a. *)
+
+  val keep : _ t -> unit Lwt.t -> unit
+  (** [keep p fut] adds a pointer from [p] to [fut] so that [fut] is not
+      garbage-collected before [p] *)
+
+  val is_closed : _ t -> bool
+
+  val close : _ t -> unit Lwt.t
+  (** [close p] closes [p], which will not accept input anymore.
+      This sends [`End] to all readers connected to [p] *)
+
+  val close_async : _ t -> unit
+  (** Same as {!close} but closes in the background *)
+
+  val on_close : _ t -> unit Lwt.t
+  (** Evaluates once the pipe closes *)
+
+  val create : ?max_size:int -> unit -> ('a, 'perm) t
+  (** Create a new pipe.
+      @param max_size size of internal buffer. Default 0. *)
+
+  val connect : ('a, [>`r]) t -> ('a, [>`w]) t -> unit
+  (** [connect p1 p2] forwards every item output by [p1] into [p2]'s input
+      until [p1] is closed. *)
+end
+
 module Writer : sig
-  type -'a t
+  type 'a t = ('a, [`w]) Pipe.t
 
   val write : 'a t -> 'a -> unit Lwt.t
+  (** @raise Pipe.Closed if the writer is closed *)
 
   val write_list : 'a t -> 'a list -> unit Lwt.t
+  (** @raise Pipe.Closed if the writer is closed *)
 
   val write_error : _ t -> string -> unit Lwt.t
-
-  val write_end : _ t -> unit Lwt.t
+  (** @raise Pipe.Closed if the writer is closed *)
 
   val map : f:('a -> 'b) -> 'b t -> 'a t
+  (** Map values before writing them *)
+
+  val send_both : 'a t -> 'a t -> 'a t
+  (** [send_both a b] returns a writer [c] such that writing to [c]
+      writes to [a] and [b], and waits for those writes to succeed
+      before returning *)
+
+  val send_all : 'a t list -> 'a t
+  (** Generalized version of {!send_both}
+      @raise Invalid_argument if the list is empty *)
 end
 
 module Reader : sig
-  type +'a t
+  type 'a t = ('a, [`r]) Pipe.t
 
   val read : 'a t -> 'a step Lwt.t
 
@@ -75,38 +118,14 @@ module Reader : sig
 
   val iter_s : f:('a -> unit Lwt.t) -> 'a t -> unit LwtErr.t
 
-  val merge : 'a t -> 'a t -> 'a t
-  (** Merge the two input streams *)
+  val merge_both : 'a t -> 'a t -> 'a t
+  (** Merge the two input streams in a non-specified order *)
+
+  val merge_all : 'a t list -> 'a t
+  (** Merge all the input streams
+      @raise Invalid_argument if the list is empty *)
 end
 
-module Pipe : sig
-  type 'a t
-  (** A pipe between producers of values of type 'a, and consumers of values
-      of type 'a. *)
-
-  val reader : 'a t -> 'a Reader.t
-
-  val writer : 'a t -> 'a Writer.t
-
-  val keep : _ t -> unit Lwt.t -> unit
-  (** [keep p fut] adds a pointer from [p] to [fut] so that [fut] is not
-      garbage-collected before [p] *)
-
-  val create : ?max_size:int -> unit -> 'a t
-  (** Create a new pipe.
-      @param max_size size of internal buffer. Default 0. *)
-
-  val create_pair : ?max_size:int -> unit -> 'a Reader.t * 'a Writer.t
-  (** Create a pair [r, w] connect by a pipe *)
-
-  val pipe_into : 'a t -> 'a t -> unit Lwt.t
-  (** [connect p1 p2] forwards every item output by [p1] into [p2]'s input
-      until [`End] is reached. After [`End] is sent, the process stops. *)
-end
-
-val connect : 'a Reader.t -> 'a Writer.t -> unit Lwt.t
-(** [connect r w] sends every item read from [r] into [w] *)
-
 (** {2 Conversions} *)
 
 val of_list : 'a list -> 'a Reader.t

From e41faaf91ef09d7a45282d3e61954062eef5c192 Mon Sep 17 00:00:00 2001
From: Simon Cruanes <simon.cruanes.2007@m4x.org>
Date: Thu, 19 Feb 2015 18:31:49 +0100
Subject: [PATCH 32/72] wip: fix bugs in Lwt_pipe

---
 src/lwt/lwt_pipe.ml  | 155 ++++++++++++++++++++-----------------------
 src/lwt/lwt_pipe.mli |  11 ++-
 2 files changed, 81 insertions(+), 85 deletions(-)

diff --git a/src/lwt/lwt_pipe.ml b/src/lwt/lwt_pipe.ml
index f91b89fd..c48209c1 100644
--- a/src/lwt/lwt_pipe.ml
+++ b/src/lwt/lwt_pipe.ml
@@ -60,38 +60,26 @@ let ret_end = Lwt.return `End
 exception Closed
 
 module Pipe = struct
-  (* messages given to writers through the condition *)
-  type 'a msg =
-    | Send of 'a step Lwt.u (* send directly to reader *)
-    | SendQueue (* push into queue *)
-    | Close (* close *)
-
-  type 'a inner_buf =
-    | Buf of 'a step Queue.t * int  (* buf, max size *)
-    | NoBuf
-
   type ('a, +'perm) t = {
     close : unit Lwt.u;
     closed : unit Lwt.t;
-    lock : Lwt_mutex.t;
-    buf : 'a inner_buf;
-    cond : 'a msg Lwt_condition.t;
+    buf :
+      [`Item of 'a step
+      | `Block of 'a step * unit Lwt.u
+      ] Queue.t; (* actions queued *)
+    max_size : int;
+    box : 'a step Lwt.u Lwt_mvar.t;
     mutable keep : unit Lwt.t list;  (* do not GC, and wait for completion *)
   } constraint 'perm = [< `r | `w]
 
   let create ?(max_size=0) () =
-    let buf = match max_size with
-      | 0 -> NoBuf
-      | n when n < 0 -> invalid_arg "max_size"
-      | n -> Buf (Queue.create (), n)
-    in
     let closed, close = Lwt.wait () in
     {
       close;
       closed;
-      buf;
-      lock=Lwt_mutex.create();
-      cond=Lwt_condition.create();
+      buf = Queue.create ();
+      max_size;
+      box=Lwt_mvar.create_empty ();
       keep=[];
     }
 
@@ -103,65 +91,52 @@ module Pipe = struct
     if is_closed p then Lwt.return_unit
     else (
       Lwt.wakeup p.close (); (* evaluate *)
-      Lwt_condition.broadcast p.cond Close;
       Lwt.join p.keep;
     )
 
   let close_async p = Lwt.async (fun () -> close p)
 
-  let on_close p = p.closed
+  let wait p = Lwt.map (fun _ -> ()) p.closed
 
   (* try to take next element from buffer *)
-  let try_next_buf t = match t.buf with
-    | NoBuf -> None
-    | Buf (q, _) ->
-      if Queue.is_empty q then None
-      else Some (Queue.pop q)
-
-  (* returns true if it could push successfully *)
-  let try_push_buf t x = match t.buf with
-    | NoBuf -> false
-    | Buf (q, max_size) when Queue.length q = max_size -> false
-    | Buf (q, _) -> Queue.push x q; true
+  let try_next_buf t =
+    if Queue.is_empty t.buf then None
+    else Some (Queue.pop t.buf)
 
   (* read next one *)
   let read t =
-    Lwt_mutex.with_lock t.lock
-      (fun () ->
-         match try_next_buf t with
-         | None when is_closed t -> ret_end (* end of stream *)
-         | None ->
-           let fut, send = Lwt.wait () in
-           Lwt_condition.signal t.cond (Send send);
-           fut
-         | Some x ->
-           Lwt_condition.signal t.cond SendQueue;  (* queue isn't full anymore *)
-           Lwt.return x
-      )
+     match try_next_buf t with
+     | None when is_closed t -> ret_end (* end of stream *)
+     | None ->
+       let fut, send = Lwt.wait () in
+       Lwt_mvar.put t.box send >>= fun () ->
+       fut
+     | Some (`Item x) -> Lwt.return x
+     | Some (`Block (x, signal_done)) ->
+       Lwt.wakeup signal_done (); (* signal the writer it's done *)
+       Lwt.return x
+
+  (* TODO: signal writers when their value has less than max_size
+  steps before being read *)
 
   (* write a value *)
   let write t x =
-    let rec try_write () =
-      if is_closed t then Lwt.fail Closed
-      else if try_push_buf t x
-      then Lwt.return_unit  (* into buffer, do not wait *)
-      else (
-        (* wait for readers to consume the queue *)
-        Lwt_condition.wait ~mutex:t.lock t.cond >>= fun msg ->
-        match msg with
-        | Send s ->
-          Lwt.wakeup s x;  (* sync with reader *)
-          Lwt.return_unit
-        | SendQueue -> try_write () (* try again! *)
-        | Close -> Lwt.fail Closed
-      )
-    in
-    Lwt_mutex.with_lock t.lock try_write
+    if is_closed t then Lwt.fail Closed
+    else if Queue.length t.buf < t.max_size
+    then (
+      Queue.push (`Item x) t.buf;
+      Lwt.return_unit  (* into buffer, do not wait *)
+    ) else (
+      let is_done, signal_done = Lwt.wait () in
+      Queue.push (`Block (x, signal_done)) t.buf;
+      is_done
+    )
 
   let rec connect_rec r w =
     read r >>= function
     | `End -> Lwt.return_unit
-    | (`Error _ | `Ok _) as step ->
+    | `Error _ as step -> write w step
+    | `Ok _ as step ->
       write w step >>= fun () ->
       connect_rec r w
 
@@ -170,20 +145,20 @@ module Pipe = struct
     keep b fut
 
   (* close a when b closes *)
-  let close_when_closed a b =
-    Lwt.on_success b.closed
-      (fun () -> close_async a)
+  let link_close p ~after =
+    Lwt.on_termination after.closed
+      (fun _ -> close_async p)
 
-  (* close a when every member of l closes *)
-  let close_when_all_closed a l =
-    let n = ref (List.length l) in
+  (* close a when every member of after closes *)
+  let link_close_l p ~after =
+    let n = ref (List.length after) in
     List.iter
-      (fun p -> Lwt.on_success p.closed
-          (fun () ->
-             decr n;
-             if !n = 0 then close_async a
-          )
-      ) l
+      (fun p' -> Lwt.on_termination p'.closed
+        (fun _ ->
+           decr n;
+           if !n = 0 then close_async p
+        )
+      ) after
 end
 
 module Writer = struct
@@ -203,12 +178,12 @@ module Writer = struct
     let rec fwd () =
       Pipe.read b >>= function
       | `Ok x -> write a (f x) >>= fwd
-      | `Error msg -> write_error a msg >>= fwd
+      | `Error msg -> write_error a msg >>= fun _ -> Pipe.close a
       | `End -> Lwt.return_unit
     in
     Pipe.keep b (fwd());
     (* when a gets closed, close b too *)
-    Lwt.on_success (Pipe.on_close a) (fun () -> Pipe.close_async b);
+    Pipe.link_close b ~after:a;
     b
 
   let send_all l =
@@ -222,7 +197,7 @@ module Writer = struct
     in
     (* do not GC before res dies; close res when any outputx is closed *)
     Pipe.keep res (fwd ());
-    List.iter (Pipe.close_when_closed res) l;
+    List.iter (fun out -> Pipe.link_close res ~after:out) l;
     res
 
   let send_both a b = send_all [a; b]
@@ -238,7 +213,7 @@ module Reader = struct
     let rec fwd () =
       Pipe.read a >>= function
       | `Ok x -> Pipe.write b (`Ok (f x)) >>= fwd
-      | (`Error _) as e -> Pipe.write b e >>= fwd
+      | (`Error _) as e -> Pipe.write b e >>= fun _ -> Pipe.close b
       | `End -> Pipe.close b
     in
     Pipe.keep b (fwd());
@@ -253,7 +228,7 @@ module Reader = struct
           | None -> fwd()
           | Some y -> Pipe.write b (`Ok y) >>= fwd
         end
-      | (`Error _) as e -> Pipe.write b e >>= fwd
+      | (`Error _) as e -> Pipe.write b e >>= fun _ -> Pipe.close b
       | `End -> Pipe.close b
     in
     Pipe.keep b (fwd());
@@ -289,12 +264,24 @@ module Reader = struct
     let res = Pipe.create () in
     List.iter (fun p -> Pipe.connect p res) l;
     (* connect res' input to all members of l; close res when they all close *)
-    Pipe.close_when_all_closed res l;
+    Pipe.link_close_l res ~after:l;
     res
 
   let merge_both a b = merge_all [a; b]
+
+  let append a b =
+    let c = Pipe.create () in
+    Pipe.connect a c;
+    Lwt.on_success (Pipe.wait a)
+      (fun () ->
+         Pipe.connect b c;
+         Pipe.link_close c ~after:b (* once a and b finished, c is too *)
+      );
+    c
 end
 
+let connect = Pipe.connect
+
 (** {2 Conversions} *)
 
 let of_list l : _ Reader.t =
@@ -326,10 +313,10 @@ let of_string a =
   Pipe.keep p (send 0);
   p
 
-let to_rev_list r =
+let to_list_rev r =
   Reader.fold ~f:(fun acc x -> x :: acc) ~x:[] r
 
-let to_list r = to_rev_list r >>|= List.rev
+let to_list r = to_list_rev r >>|= List.rev
 
 let to_list_exn r =
   to_list r >>= function
@@ -381,6 +368,7 @@ module IO = struct
     let p = Pipe.create () in
     Pipe.keep p (
       Reader.iter_s ~f:(Lwt_io.write oc) p >>= fun _ ->
+      Lwt_io.flush oc >>= fun () ->
       Pipe.close p
     );
     p
@@ -389,6 +377,7 @@ module IO = struct
     let p = Pipe.create () in
     Pipe.keep p (
       Reader.iter_s ~f:(Lwt_io.write_line oc) p >>= fun _ ->
+      Lwt_io.flush oc >>= fun () ->
       Pipe.close p
     );
     p
diff --git a/src/lwt/lwt_pipe.mli b/src/lwt/lwt_pipe.mli
index 836977db..ae10cbd7 100644
--- a/src/lwt/lwt_pipe.mli
+++ b/src/lwt/lwt_pipe.mli
@@ -31,6 +31,8 @@ OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
   {- Pipe: a possibly buffered channel through which readers and writer communicate}
   {- Reader: accepts values, produces effects}
   {- Writer: yield values}
+
+  @since NEXT_RELEASE
 *)
 
 type 'a or_error = [`Ok of 'a | `Error of string]
@@ -64,7 +66,7 @@ module Pipe : sig
   val close_async : _ t -> unit
   (** Same as {!close} but closes in the background *)
 
-  val on_close : _ t -> unit Lwt.t
+  val wait : _ t -> unit Lwt.t
   (** Evaluates once the pipe closes *)
 
   val create : ?max_size:int -> unit -> ('a, 'perm) t
@@ -124,8 +126,13 @@ module Reader : sig
   val merge_all : 'a t list -> 'a t
   (** Merge all the input streams
       @raise Invalid_argument if the list is empty *)
+
+  val append : 'a t -> 'a t -> 'a t
 end
 
+val connect : 'a Reader.t -> 'a Writer.t -> unit
+(** Handy synonym to {!Pipe.connect} *)
+
 (** {2 Conversions} *)
 
 val of_list : 'a list -> 'a Reader.t
@@ -134,7 +141,7 @@ val of_array : 'a array -> 'a Reader.t
 
 val of_string : string -> char Reader.t
 
-val to_rev_list : 'a Reader.t -> 'a list LwtErr.t
+val to_list_rev : 'a Reader.t -> 'a list LwtErr.t
 
 val to_list : 'a Reader.t -> 'a list LwtErr.t
 

From 89aded1311ba7f9e3a051d47771cb6db7a47b8bf Mon Sep 17 00:00:00 2001
From: Simon Cruanes <simon.cruanes.2007@m4x.org>
Date: Thu, 19 Feb 2015 19:35:53 +0100
Subject: [PATCH 33/72] wip: lwt_klist

---
 .header               |   2 +-
 src/lwt/lwt_klist.ml  | 154 ++++++++++++++++++++----------------------
 src/lwt/lwt_klist.mli |  66 ++++++++++--------
 3 files changed, 114 insertions(+), 108 deletions(-)

diff --git a/.header b/.header
index 71e61012..d5a14c50 100644
--- a/.header
+++ b/.header
@@ -1,5 +1,5 @@
 (*
-copyright (c) 2013-2014, simon cruanes
+copyright (c) 2013-2015, simon cruanes
 all rights reserved.
 
 redistribution and use in source and binary forms, with or without
diff --git a/src/lwt/lwt_klist.ml b/src/lwt/lwt_klist.ml
index 30b3154b..fa186711 100644
--- a/src/lwt/lwt_klist.ml
+++ b/src/lwt/lwt_klist.ml
@@ -26,7 +26,7 @@ OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
 
 (** {1 Functional streams for Lwt} *)
 
-type 'a t = [ `Nil | `Cons of 'a * (unit -> 'a t) ] Lwt.t
+type 'a t = [ `Nil | `Cons of 'a * 'a t ] Lwt.t
 type 'a stream = 'a t
 
 let (>>=) = Lwt.(>>=)
@@ -34,126 +34,120 @@ let (>|=) = Lwt.(>|=)
 
 let empty = Lwt.return `Nil
 
-let cons x l = Lwt.return (`Cons (x, fun () -> l))
+let cons x l = Lwt.return (`Cons (x, l))
 
-let rec of_list_rec l () = match l with
-  | [] -> empty
-  | x :: tl -> Lwt.return (`Cons (x, of_list_rec tl))
-
-let of_list l : 'a t = of_list_rec l ()
-
-let rec create_rec f () : 'a t =
+let rec create f : 'a t =
+  let fut, wake = Lwt.wait () in
   f () >|= function
   | None -> `Nil
-  | Some x -> `Cons (x, create_rec f)
-
-let create f = create_rec f ()
+  | Some x -> `Cons (x, create f)
+and create_rec f () =
+  f () >|= function
+  | None -> `Nil
+  | Some x -> `Cons (x, create f)
 
 let next l =
   l >|= function
   | `Nil -> None
-  | `Cons (x, tl) -> Some (x, tl())
+  | `Cons (x, tl) -> Some (x, tl)
 
 let next_exn l =
   l >>= function
   | `Nil -> Lwt.fail Not_found
-  | `Cons (x, tl) -> Lwt.return (x, tl ())
+  | `Cons (x, tl) -> Lwt.return (x, tl)
 
-let rec map_rec f l () =
+let rec map f l =
   l >|= function
   | `Nil -> `Nil
-  | `Cons (x, tl) -> `Cons (f x, map_rec f (tl ()))
+  | `Cons (x, tl) -> `Cons (f x, map f tl)
 
-let map f (l:'a t) : 'b t = map_rec f l ()
-
-let rec map_s_rec (f:'a -> 'b Lwt.t) l () =
+let rec map_s (f:'a -> 'b Lwt.t) l =
   l >>= function
   | `Nil -> empty
   | `Cons (x, tl) ->
-      f x >|= fun y -> `Cons (y, map_s_rec f (tl ()))
+      f x >|= fun y -> `Cons (y, map_s f tl)
 
-let map_s f l = map_s_rec f l ()
-
-let rec append_rec l1 l2 () =
+let rec append l1 l2 =
   l1 >>= function
   | `Nil -> l2
-  | `Cons (x, tl1) -> Lwt.return (`Cons (x, append_rec (tl1 ()) l2))
-
-let append l1 l2 = append_rec l1 l2 ()
+  | `Cons (x, tl1) -> Lwt.return (`Cons (x, append tl1 l2))
 
 let rec flat_map f l =
   l >>= function
   | `Nil -> empty
-  | `Cons (x, tl) -> append (f x) (flat_map f (tl ()))
+  | `Cons (x, tl) -> append (f x) (flat_map f tl)
+
+let rec filter_map f l =
+  l >>= function
+  | `Nil -> empty
+  | `Cons (x, tl) ->
+    match f x with
+    | None -> filter_map f tl
+    | Some y -> Lwt.return (`Cons (y, filter_map f tl))
+
+let rec filter_map_s f l =
+  l >>= function
+  | `Nil -> empty
+  | `Cons (x, tl) ->
+    f x >>= function
+    | None -> filter_map_s f tl
+    | Some y -> Lwt.return (`Cons (y, filter_map_s f tl))
 
 let rec iter f l =
   l >>= function
   | `Nil -> Lwt.return_unit
-  | `Cons (x, tl) ->  f x; iter f (tl ())
+  | `Cons (x, tl) -> f x; iter f tl
 
 let rec iter_s f l =
   l >>= function
   | `Nil -> Lwt.return_unit
-  | `Cons (x, tl) ->  f x >>= fun () -> iter_s f (tl ())
+  | `Cons (x, tl) -> f x >>= fun () -> iter_s f tl
 
-module Queue = struct
-  type 'a t = {
-    bufsize : int;
-    cond : unit Lwt_condition.t;
-    q : 'a Queue.t;
-    mutable str : 'a stream;
-    mutable closed : bool;
-  }
+let rec fold f acc l =
+  l >>= function
+  | `Nil -> Lwt.return acc
+  | `Cons (x, tl) ->
+    let acc = f acc x in
+    fold f acc tl
 
-  (* function that waits for the next element, and recursively,
-    returning a stream of values *)
-  let rec make_stream_ t () : 'a stream =
-    if t.closed then empty
-    else if not (Queue.is_empty t.q)
-      then (
-        let x = Queue.pop t.q in
-        Lwt_condition.signal t.cond ();
-        Lwt.return (`Cons (x, make_stream_ t))
-      )
-    else
-      (* wait for something to happen *)
-      Lwt_condition.wait t.cond >>= make_stream_ t
+let rec fold_s f acc l =
+  l >>= function
+  | `Nil -> Lwt.return acc
+  | `Cons (x, tl) -> f acc x >>= fun acc -> fold_s f acc tl
 
-  let create ?(bufsize=128) () =
-    let t = {
-      bufsize;
-      q = Queue.create ();
-      str = empty;
-      cond = Lwt_condition.create ();
-      closed = false;
-    } in
-    t.str <- make_stream_ t ();
-    t
+let take n l = assert false
+let take_while f l = assert false
+let take_while_s f l = assert false
+let drop n l = assert false
+let drop_while f l = assert false
+let drop_while_s f l = assert false
+let merge a b = assert false
 
-  exception ClosedQueue
+(** {2 Conversions} *)
 
-  let close t =
-    if not t.closed then (
-      t.closed <- true;
-      Lwt_condition.signal t.cond ()
-    )
+type 'a gen = unit -> 'a option
 
-  let rec push_rec t x () =
-    if t.closed then raise ClosedQueue;
-    if Queue.length t.q = t.bufsize
-      then Lwt_condition.wait t.cond >>= push_rec t x
-    else (
-      Queue.push x t.q;
-      Lwt.return_unit
-    )
+let rec of_list l = match l with
+  | [] -> empty
+  | x :: tl -> Lwt.return (`Cons (x, of_list tl))
 
-  let push t x = push_rec t x ()
+let rec of_array_rec a i =
+  if i = Array.length a 
+  then empty
+  else Lwt.return (`Cons (a.(i), of_array_rec a (i+1)))
 
-  let to_stream t = t.str
+let of_array a = of_array_rec a 0
 
-  let take t = assert false
-  let take_exn t = assert false
-
-end
+let rec of_gen g = match g () with
+  | None -> empty
+  | Some x -> Lwt.return (`Cons (x, of_gen g))
 
+let rec of_gen_s g = match g() with
+  | None -> empty
+  | Some x ->
+    x >|= fun x -> `Cons (x, of_gen_s g)
 
+let of_string s = assert false
+let to_string l = assert false
+let to_list l = assert false
+let to_rev_list l = assert false
diff --git a/src/lwt/lwt_klist.mli b/src/lwt/lwt_klist.mli
index 766de3f6..4a2b6087 100644
--- a/src/lwt/lwt_klist.mli
+++ b/src/lwt/lwt_klist.mli
@@ -26,15 +26,13 @@ OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
 
 (** {1 Functional streams for Lwt} *)
 
-type 'a t = [ `Nil | `Cons of 'a * (unit -> 'a t) ] Lwt.t
+type 'a t = [ `Nil | `Cons of 'a * 'a t ] Lwt.t
 type 'a stream = 'a t
 
 val empty : 'a t
 
 val cons : 'a -> 'a t -> 'a t
 
-val of_list : 'a list -> 'a t
-
 val create : (unit -> 'a option Lwt.t) -> 'a t
 (** Create from a function that returns the next element *)
 
@@ -43,46 +41,60 @@ val next : 'a t -> ('a * 'a t) option Lwt.t
 
 val next_exn : 'a t -> ('a * 'a t) Lwt.t
 (** Obtain the next element or fail
-    @raise Not_found if the stream is empty *)
+    @raise Not_found if the stream is empty (using {!Lwt.fail}) *)
 
 val map : ('a -> 'b) -> 'a t -> 'b t
+
 val map_s : ('a -> 'b Lwt.t) -> 'a t -> 'b t
 
 val append : 'a t -> 'a t -> 'a t
 
+val filter_map : ('a -> 'b option) -> 'a t -> 'b t
+
+val filter_map_s : ('a -> 'b option Lwt.t) -> 'a t -> 'b t
+
 val flat_map : ('a -> 'b t) -> 'a t -> 'b t
 
 val iter : ('a -> unit) -> 'a t -> unit Lwt.t
+
 val iter_s : ('a -> unit Lwt.t) -> 'a t -> unit Lwt.t
 
-(** {2 Bounded Queue} *)
-module Queue : sig
-  type 'a t
+val fold : ('a -> 'b -> 'a) -> 'a -> 'b t -> 'a Lwt.t
 
-  val create : ?bufsize:int -> unit -> 'a t
-  (** Create a new queue, with the given internal buffer size.
-      If [bufsize=0] the queue is fully blocking *)
+val fold_s : ('a -> 'b -> 'a Lwt.t) -> 'a -> 'b t -> 'a Lwt.t
 
-  exception ClosedQueue
+val take : int -> 'a t -> 'a t
 
-  val close : _ t -> unit
-  (** Close the queue. Elements remaining in the queue will be available for
-      consumption, say, by {!get}; pushing an element will raise {!ClosedQueue} *)
+val take_while : ('a -> bool) -> 'a t -> 'a t
 
-  val push : 'a t -> 'a -> unit Lwt.t
-  (** Push an element at the back of the queue. Returns immediately
-      if the queue isn't full, blocks until an element is consumed otherwise *)
+val take_while_s : ('a -> bool Lwt.t) -> 'a t -> 'a t
 
-  val take : 'a t -> 'a option Lwt.t
-  (** Take the next element. May block if no element is currently available. *)
+val drop : int -> 'a t -> 'a t
 
-  val take_exn : 'a t -> 'a Lwt.t
-  (** Same as {!get} but fails if the queue is closed.
-      @raise ClosedQueue if the queue gets closed before an element is pushed *)
+val drop_while : ('a -> bool) -> 'a t -> 'a t
 
-  val to_stream : 'a t -> 'a stream
-  (** Stream of elements pushed into the queue *)
+val drop_while_s : ('a -> bool Lwt.t) -> 'a t -> 'a t
+
+val merge : 'a t -> 'a t -> 'a t
+(** Non-deterministic merge *)
+
+(** {2 Conversions} *)
+
+type 'a gen = unit -> 'a option
+
+val of_list : 'a list -> 'a t
+
+val of_array : 'a array -> 'a t
+
+val of_gen : 'a gen -> 'a t
+
+val of_gen_s : 'a Lwt.t gen -> 'a t
+
+val of_string : string -> 'a t
+
+val to_list : 'a t -> 'a list Lwt.t
+
+val to_rev_list : 'a t -> 'a list Lwt.t
+
+val to_string : char t -> string Lwt.t
 
-  (* TODO: fix semantics; e.g. notion of "cursor" with several cursors
-      on one queue *)
-end

From aef87c148d2675fea2a70a5c9b93ff96f4828931 Mon Sep 17 00:00:00 2001
From: Simon Cruanes <simon.cruanes.2007@m4x.org>
Date: Thu, 19 Feb 2015 19:50:36 +0100
Subject: [PATCH 34/72] wip: lwt_pipe

---
 src/lwt/lwt_pipe.ml  | 76 +++++++++++++++++++++++++++++---------------
 src/lwt/lwt_pipe.mli | 32 +++++++++++++++----
 2 files changed, 76 insertions(+), 32 deletions(-)

diff --git a/src/lwt/lwt_pipe.ml b/src/lwt/lwt_pipe.ml
index c48209c1..5fbe401b 100644
--- a/src/lwt/lwt_pipe.ml
+++ b/src/lwt/lwt_pipe.ml
@@ -63,12 +63,10 @@ module Pipe = struct
   type ('a, +'perm) t = {
     close : unit Lwt.u;
     closed : unit Lwt.t;
-    buf :
-      [`Item of 'a step
-      | `Block of 'a step * unit Lwt.u
-      ] Queue.t; (* actions queued *)
+    readers : 'a step Lwt.u Queue.t;  (* readers *)
+    writers : 'a step Queue.t;
+    blocked_writers : ('a step * unit Lwt.u) Queue.t; (* blocked writers *)
     max_size : int;
-    box : 'a step Lwt.u Lwt_mvar.t;
     mutable keep : unit Lwt.t list;  (* do not GC, and wait for completion *)
   } constraint 'perm = [< `r | `w]
 
@@ -77,9 +75,10 @@ module Pipe = struct
     {
       close;
       closed;
-      buf = Queue.create ();
+      readers = Queue.create ();
+      writers = Queue.create ();
+      blocked_writers = Queue.create ();
       max_size;
-      box=Lwt_mvar.create_empty ();
       keep=[];
     }
 
@@ -98,23 +97,36 @@ module Pipe = struct
 
   let wait p = Lwt.map (fun _ -> ()) p.closed
 
-  (* try to take next element from buffer *)
-  let try_next_buf t =
-    if Queue.is_empty t.buf then None
-    else Some (Queue.pop t.buf)
+  (* try to take next element from writers buffer *)
+  let try_read t =
+    if Queue.is_empty t.writers
+    then if Queue.is_empty t.blocked_writers
+      then None
+      else (
+        assert (t.max_size = 0);
+        let x, signal_done = Queue.pop t.blocked_writers in
+        Lwt.wakeup signal_done ();
+        Some x
+      )
+    else (
+      let x = Queue.pop t.writers in
+      (* some writer may unblock *)
+      if not (Queue.is_empty t.blocked_writers) && Queue.length t.writers < t.max_size then (
+        let y, signal_done = Queue.pop t.blocked_writers in
+        Queue.push y t.writers;
+        Lwt.wakeup signal_done ();
+      );
+      Some x
+    )
 
   (* read next one *)
-  let read t =
-     match try_next_buf t with
+  let read t = match try_read t with
      | None when is_closed t -> ret_end (* end of stream *)
      | None ->
        let fut, send = Lwt.wait () in
-       Lwt_mvar.put t.box send >>= fun () ->
+       Queue.push send t.readers;
        fut
-     | Some (`Item x) -> Lwt.return x
-     | Some (`Block (x, signal_done)) ->
-       Lwt.wakeup signal_done (); (* signal the writer it's done *)
-       Lwt.return x
+     | Some x -> Lwt.return x
 
   (* TODO: signal writers when their value has less than max_size
   steps before being read *)
@@ -122,14 +134,21 @@ module Pipe = struct
   (* write a value *)
   let write t x =
     if is_closed t then Lwt.fail Closed
-    else if Queue.length t.buf < t.max_size
-    then (
-      Queue.push (`Item x) t.buf;
-      Lwt.return_unit  (* into buffer, do not wait *)
-    ) else (
+    else if Queue.length t.readers > 0
+      then (
+        let send = Queue.pop t.readers in
+        Lwt.wakeup send x;
+        Lwt.return_unit
+      )
+    else if Queue.length t.writers < t.max_size
+      then (
+        Queue.push x t.writers;
+        Lwt.return_unit  (* into buffer, do not wait *)
+      )
+    else (
       let is_done, signal_done = Lwt.wait () in
-      Queue.push (`Block (x, signal_done)) t.buf;
-      is_done
+      Queue.push (x, signal_done) t.blocked_writers;
+      is_done (* block *)
     )
 
   let rec connect_rec r w =
@@ -280,7 +299,12 @@ module Reader = struct
     c
 end
 
-let connect = Pipe.connect
+let connect ?(ownership=`None) a b =
+  Pipe.connect a b;
+  match ownership with
+  | `None -> ()
+  | `InOwnsOut -> Pipe.link_close b ~after:a
+  | `OutOwnsIn -> Pipe.link_close a ~after:b
 
 (** {2 Conversions} *)
 
diff --git a/src/lwt/lwt_pipe.mli b/src/lwt/lwt_pipe.mli
index ae10cbd7..90b18c2b 100644
--- a/src/lwt/lwt_pipe.mli
+++ b/src/lwt/lwt_pipe.mli
@@ -28,11 +28,29 @@ OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
 
   Stream processing using:
 
-  {- Pipe: a possibly buffered channel through which readers and writer communicate}
-  {- Reader: accepts values, produces effects}
-  {- Writer: yield values}
+  - Pipe: a possibly buffered channel through which readers and writer communicate
+  - Reader: accepts values, produces effects
+  - Writer: yield values
 
-  @since NEXT_RELEASE
+Examples:
+{[
+#require "containers.lwt";;
+
+module P = Containers_lwt.Lwt_pipe;;
+
+let p1 =
+  P.of_list CCList.(1 -- 100)
+  |> P.Reader.map ~f:string_of_int;;
+
+Lwt_io.with_file ~mode:Lwt_io.output "/tmp/foo"
+  (fun oc ->
+     let p2 = P.IO.write_lines oc in
+     P.connect ~ownership:`InOwnsOut p1 p2;
+     P.Pipe.wait p2
+  );;
+]}
+
+@since NEXT_RELEASE
 *)
 
 type 'a or_error = [`Ok of 'a | `Error of string]
@@ -130,8 +148,10 @@ module Reader : sig
   val append : 'a t -> 'a t -> 'a t
 end
 
-val connect : 'a Reader.t -> 'a Writer.t -> unit
-(** Handy synonym to {!Pipe.connect} *)
+val connect : ?ownership:[`None | `InOwnsOut | `OutOwnsIn] ->
+              'a Reader.t -> 'a Writer.t -> unit
+(** Handy synonym to {!Pipe.connect}, with additional resource management.
+    @param own determines which pipes owns which *)
 
 (** {2 Conversions} *)
 

From 51b2828af391a9dd0526813170370836c83e4594 Mon Sep 17 00:00:00 2001
From: cpiccion <carmelo.piccione@theice.com>
Date: Thu, 19 Feb 2015 18:28:20 -0500
Subject: [PATCH 35/72] formatting, qtests

---
 src/data/CCRingBuffer.ml  | 42 +++++++++++++++++++++------------------
 src/data/CCRingBuffer.mli |  4 ++--
 2 files changed, 25 insertions(+), 21 deletions(-)

diff --git a/src/data/CCRingBuffer.ml b/src/data/CCRingBuffer.ml
index 8e169a6b..7bc90e94 100644
--- a/src/data/CCRingBuffer.ml
+++ b/src/data/CCRingBuffer.ml
@@ -29,8 +29,10 @@ module Array = struct
     type t
 
     val empty : t
-    val make: int -> elt -> t
-    val length: t -> int
+		
+		val make: int -> elt -> t
+	
+		val length: t -> int
 
     val get: t -> int -> elt
 
@@ -39,12 +41,13 @@ module Array = struct
     val sub: t -> int -> int -> t
 
     val copy : t -> t
-    val blit : t -> int -> t -> int -> int -> unit
+	
+		val blit : t -> int -> t -> int -> int -> unit
 
     val iter : (elt -> unit) -> t -> unit
   end
 
-  module ByteArray :
+	module ByteArray :
     S with type elt = char and type t = bytes = struct
     type elt = char
     include Bytes
@@ -200,6 +203,14 @@ struct
   let copy b =
     { b with buf=Array.copy b.buf; }
 
+	(*$T
+	  let b = ByteBuffer.create 3 in \
+	  let s = Bytes.of_string "hello world" in \
+  	ByteBuffer.blit_from b s 0 (Bytes.length s); \
+    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 = Array.length b.buf
 
@@ -300,15 +311,7 @@ struct
       end
     end
 
-  let add b s = blit_from b s 0 (Array.length s)
-
-  (*$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;
     ()
@@ -358,10 +361,11 @@ struct
 
   (*$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 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 word"); (* 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 =
@@ -411,7 +415,7 @@ struct
       build ((get_front b i)::l) (i-1) in
     build [] (len-1)
 
-  let push_back b e = add b (Array.make 1 e)
+  let push_back b e = blit_from b (Array.make 1 e) 0 1
 
   let peek_front b = if is_empty b then
       raise Empty else Array.get b.buf b.start
@@ -421,7 +425,7 @@ struct
                          (if b.stop = 0 then capacity b - 1 else b.stop-1)
 end
 
-module Bytes = Make_array(Array.ByteArray)
+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
index f1a42ec9..43b356db 100644
--- a/src/data/CCRingBuffer.mli
+++ b/src/data/CCRingBuffer.mli
@@ -46,7 +46,7 @@ module Array : sig
   end
 
   module ByteArray :
-    S with type elt = char and type t = bytes
+		S with type elt = char and type t = bytes
 
   module FloatArray :
     S with type elt = float and type t = float array
@@ -168,7 +168,7 @@ end
 module Make_array : functor (Array:Array.S) -> S with module Array = Array
 
 (** An efficient byte based ring buffer *)
-module Bytes : S with module Array = Array.ByteArray
+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)

From a1ca8ff83180e5e11cadcd47120b22db5e07f45e Mon Sep 17 00:00:00 2001
From: carm <carmelo.piccione@gmail.com>
Date: Thu, 19 Feb 2015 23:10:19 -0500
Subject: [PATCH 36/72] formatting

---
 src/data/CCRingBuffer.ml | 26 +++++++++++++-------------
 1 file changed, 13 insertions(+), 13 deletions(-)

diff --git a/src/data/CCRingBuffer.ml b/src/data/CCRingBuffer.ml
index 7bc90e94..fe064467 100644
--- a/src/data/CCRingBuffer.ml
+++ b/src/data/CCRingBuffer.ml
@@ -29,10 +29,10 @@ module Array = struct
     type t
 
     val empty : t
-		
-		val make: int -> elt -> t
-	
-		val length: t -> int
+
+    val make: int -> elt -> t
+
+    val length: t -> int
 
     val get: t -> int -> elt
 
@@ -41,13 +41,13 @@ module Array = struct
     val sub: t -> int -> int -> t
 
     val copy : t -> t
-	
-		val blit : t -> int -> t -> int -> int -> unit
+
+    val blit : t -> int -> t -> int -> int -> unit
 
     val iter : (elt -> unit) -> t -> unit
   end
 
-	module ByteArray :
+  module ByteArray :
     S with type elt = char and type t = bytes = struct
     type elt = char
     include Bytes
@@ -203,13 +203,13 @@ struct
   let copy b =
     { b with buf=Array.copy b.buf; }
 
-	(*$T
-	  let b = ByteBuffer.create 3 in \
-	  let s = Bytes.of_string "hello world" in \
-  	ByteBuffer.blit_from b s 0 (Bytes.length s); \
+(*$T
+  let b = ByteBuffer.create 3 in \
+  let s = Bytes.of_string "hello world" in \
+  ByteBuffer.blit_from b s 0 (Bytes.length s); \
     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 = Array.length b.buf
@@ -362,7 +362,7 @@ struct
   (*$Q
     (Q.pair Q.printable_string Q.printable_string) (fun (s,s') -> \
     (let b = ByteBuffer.create 24 in ByteBuffer.blit_from b s 0 (Bytes.length s);
-		ByteBuffer.blit_from b s' 0 (Bytes.length s'); \
+    ByteBuffer.blit_from b s' 0 (Bytes.length s'); \
     ByteBuffer.blit_from b "hello world" 0 (Bytes.length "hello word"); (* big enough *) \
     let l = ByteBuffer.length b in let l' = l/2 in ByteBuffer.skip b l'; \
     ByteBuffer.length b + l' = l))

From c286789e5c3c0bc0332781250d35353e215cd7c1 Mon Sep 17 00:00:00 2001
From: carm <carmelo.piccione@gmail.com>
Date: Thu, 19 Feb 2015 23:42:54 -0500
Subject: [PATCH 37/72] update testing instructions

---
 README.md | 13 ++++---------
 1 file changed, 4 insertions(+), 9 deletions(-)

diff --git a/README.md b/README.md
index bb8bcd40..842ccfcc 100644
--- a/README.md
+++ b/README.md
@@ -182,16 +182,11 @@ branch `stable` it is not necessary.
 
     $ make
 
-To build and run tests (requires `oUnit` and `qtest`):
+To build and run tests (requires `oUnit`, `qtest`, and `check`):
 
-    $ opam install oUnit
-    $ make tests
-    $ ./tests.native
-
-and
-
-    $ opam install qtest
-    $ make qtest
+    $ opam install oUnit qtest qcheck
+    $ ./configure --enable-tests
+    $ make test
 
 To build the small benchmarking suite (requires `benchmark`):
 

From c7bc99760aa19c2b4ff0886db2214e041908a938 Mon Sep 17 00:00:00 2001
From: carm <carmelo.piccione@gmail.com>
Date: Thu, 19 Feb 2015 23:44:49 -0500
Subject: [PATCH 38/72] fix qcheck typo

---
 README.md | 2 +-
 1 file changed, 1 insertion(+), 1 deletion(-)

diff --git a/README.md b/README.md
index 842ccfcc..38b5a44b 100644
--- a/README.md
+++ b/README.md
@@ -182,7 +182,7 @@ branch `stable` it is not necessary.
 
     $ make
 
-To build and run tests (requires `oUnit`, `qtest`, and `check`):
+To build and run tests (requires `oUnit`, `qtest`, and `qcheck`):
 
     $ opam install oUnit qtest qcheck
     $ ./configure --enable-tests

From d257d91b0dc6fdf3bd34ad5ada788dea8c6b183b Mon Sep 17 00:00:00 2001
From: Simon Cruanes <simon.cruanes.2007@m4x.org>
Date: Fri, 20 Feb 2015 15:01:57 +0100
Subject: [PATCH 39/72] remove old META file

---
 META | 44 --------------------------------------------
 1 file changed, 44 deletions(-)
 delete mode 100644 META

diff --git a/META b/META
deleted file mode 100644
index bdfc3a8d..00000000
--- a/META
+++ /dev/null
@@ -1,44 +0,0 @@
-# OASIS_START
-# DO NOT EDIT (digest: 9f5c18246e625c62ccb7bf59b1670289)
-version = "0.1"
-description = "A bunch of modules, including polymorphic containers."
-requires = "unix"
-archive(byte) = "containers.cma"
-archive(byte, plugin) = "containers.cma"
-archive(native) = "containers.cmxa"
-archive(native, plugin) = "containers.cmxs"
-exists_if = "containers.cma"
-package "thread" (
- version = "0.1"
- description = "A bunch of modules, including polymorphic containers."
- requires = "containers threads lwt"
- archive(byte) = "containers_thread.cma"
- archive(byte, plugin) = "containers_thread.cma"
- archive(native) = "containers_thread.cmxa"
- archive(native, plugin) = "containers_thread.cmxs"
- exists_if = "containers_thread.cma"
-)
-
-package "lwt" (
- version = "0.1"
- description = "A bunch of modules, including polymorphic containers."
- requires = "containers lwt lwt.unix"
- archive(byte) = "containers_lwt.cma"
- archive(byte, plugin) = "containers_lwt.cma"
- archive(native) = "containers_lwt.cmxa"
- archive(native, plugin) = "containers_lwt.cmxs"
- exists_if = "containers_lwt.cma"
-)
-
-package "cgi" (
- version = "0.1"
- description = "A bunch of modules, including polymorphic containers."
- requires = "containers CamlGI"
- archive(byte) = "containers_cgi.cma"
- archive(byte, plugin) = "containers_cgi.cma"
- archive(native) = "containers_cgi.cmxa"
- archive(native, plugin) = "containers_cgi.cmxs"
- exists_if = "containers_cgi.cma"
-)
-# OASIS_STOP
-

From 244908a39e4f7340bdf9fe01d2eb86bda3b28dec Mon Sep 17 00:00:00 2001
From: Simon Cruanes <simon.cruanes.2007@m4x.org>
Date: Fri, 20 Feb 2015 15:14:45 +0100
Subject: [PATCH 40/72] lwt_pipe: remove Pipe module, put values at toplevel,
 put read/write directly on pipes

---
 src/lwt/lwt_pipe.ml  | 356 +++++++++++++++++++++----------------------
 src/lwt/lwt_pipe.mli |  91 +++++------
 2 files changed, 223 insertions(+), 224 deletions(-)

diff --git a/src/lwt/lwt_pipe.ml b/src/lwt/lwt_pipe.ml
index 5fbe401b..eb02d9c0 100644
--- a/src/lwt/lwt_pipe.ml
+++ b/src/lwt/lwt_pipe.ml
@@ -59,198 +59,199 @@ let ret_end = Lwt.return `End
 
 exception Closed
 
-module Pipe = struct
-  type ('a, +'perm) t = {
-    close : unit Lwt.u;
-    closed : unit Lwt.t;
-    readers : 'a step Lwt.u Queue.t;  (* readers *)
-    writers : 'a step Queue.t;
-    blocked_writers : ('a step * unit Lwt.u) Queue.t; (* blocked writers *)
-    max_size : int;
-    mutable keep : unit Lwt.t list;  (* do not GC, and wait for completion *)
-  } constraint 'perm = [< `r | `w]
+type ('a, +'perm) t = {
+  close : unit Lwt.u;
+  closed : unit Lwt.t;
+  readers : 'a step Lwt.u Queue.t;  (* readers *)
+  writers : 'a step Queue.t;
+  blocked_writers : ('a step * unit Lwt.u) Queue.t; (* blocked writers *)
+  max_size : int;
+  mutable keep : unit Lwt.t list;  (* do not GC, and wait for completion *)
+} constraint 'perm = [< `r | `w]
 
-  let create ?(max_size=0) () =
-    let closed, close = Lwt.wait () in
-    {
-      close;
-      closed;
-      readers = Queue.create ();
-      writers = Queue.create ();
-      blocked_writers = Queue.create ();
-      max_size;
-      keep=[];
-    }
+type ('a, 'perm) pipe = ('a, 'perm) t
 
-  let keep p fut = p.keep <- fut :: p.keep
+let create ?(max_size=0) () =
+  let closed, close = Lwt.wait () in
+  {
+    close;
+    closed;
+    readers = Queue.create ();
+    writers = Queue.create ();
+    blocked_writers = Queue.create ();
+    max_size;
+    keep=[];
+  }
 
-  let is_closed p = not (Lwt.is_sleeping p.closed)
+let keep p fut = p.keep <- fut :: p.keep
 
-  let close p =
-    if is_closed p then Lwt.return_unit
+let is_closed p = not (Lwt.is_sleeping p.closed)
+
+let close p =
+  if is_closed p then Lwt.return_unit
+  else (
+    Lwt.wakeup p.close (); (* evaluate *)
+    Lwt.join p.keep;
+  )
+
+let close_async p = Lwt.async (fun () -> close p)
+
+let wait p = Lwt.map (fun _ -> ()) p.closed
+
+(* try to take next element from writers buffer *)
+let try_read t =
+  if Queue.is_empty t.writers
+  then if Queue.is_empty t.blocked_writers
+    then None
     else (
-      Lwt.wakeup p.close (); (* evaluate *)
-      Lwt.join p.keep;
-    )
-
-  let close_async p = Lwt.async (fun () -> close p)
-
-  let wait p = Lwt.map (fun _ -> ()) p.closed
-
-  (* try to take next element from writers buffer *)
-  let try_read t =
-    if Queue.is_empty t.writers
-    then if Queue.is_empty t.blocked_writers
-      then None
-      else (
-        assert (t.max_size = 0);
-        let x, signal_done = Queue.pop t.blocked_writers in
-        Lwt.wakeup signal_done ();
-        Some x
-      )
-    else (
-      let x = Queue.pop t.writers in
-      (* some writer may unblock *)
-      if not (Queue.is_empty t.blocked_writers) && Queue.length t.writers < t.max_size then (
-        let y, signal_done = Queue.pop t.blocked_writers in
-        Queue.push y t.writers;
-        Lwt.wakeup signal_done ();
-      );
+      assert (t.max_size = 0);
+      let x, signal_done = Queue.pop t.blocked_writers in
+      Lwt.wakeup signal_done ();
       Some x
     )
+  else (
+    let x = Queue.pop t.writers in
+    (* some writer may unblock *)
+    if not (Queue.is_empty t.blocked_writers) && Queue.length t.writers < t.max_size then (
+      let y, signal_done = Queue.pop t.blocked_writers in
+      Queue.push y t.writers;
+      Lwt.wakeup signal_done ();
+    );
+    Some x
+  )
 
-  (* read next one *)
-  let read t = match try_read t with
-     | None when is_closed t -> ret_end (* end of stream *)
-     | None ->
-       let fut, send = Lwt.wait () in
-       Queue.push send t.readers;
-       fut
-     | Some x -> Lwt.return x
+(* read next one *)
+let read t = match try_read t with
+   | None when is_closed t -> ret_end (* end of stream *)
+   | None ->
+     let fut, send = Lwt.wait () in
+     Queue.push send t.readers;
+     fut
+   | Some x -> Lwt.return x
 
-  (* TODO: signal writers when their value has less than max_size
-  steps before being read *)
-
-  (* write a value *)
-  let write t x =
-    if is_closed t then Lwt.fail Closed
-    else if Queue.length t.readers > 0
-      then (
-        let send = Queue.pop t.readers in
-        Lwt.wakeup send x;
-        Lwt.return_unit
-      )
-    else if Queue.length t.writers < t.max_size
-      then (
-        Queue.push x t.writers;
-        Lwt.return_unit  (* into buffer, do not wait *)
-      )
-    else (
-      let is_done, signal_done = Lwt.wait () in
-      Queue.push (x, signal_done) t.blocked_writers;
-      is_done (* block *)
+(* write a value *)
+let write_step t x =
+  if is_closed t then Lwt.fail Closed
+  else if Queue.length t.readers > 0
+    then (
+      (* some reader waits, synchronize now *)
+      let send = Queue.pop t.readers in
+      Lwt.wakeup send x;
+      Lwt.return_unit
     )
+  else if Queue.length t.writers < t.max_size
+    then (
+      Queue.push x t.writers;
+      Lwt.return_unit  (* into buffer, do not wait *)
+    )
+  else (
+    (* block until the queue isn't full anymore *)
+    let is_done, signal_done = Lwt.wait () in
+    Queue.push (x, signal_done) t.blocked_writers;
+    is_done (* block *)
+  )
 
-  let rec connect_rec r w =
-    read r >>= function
-    | `End -> Lwt.return_unit
-    | `Error _ as step -> write w step
-    | `Ok _ as step ->
-      write w step >>= fun () ->
-      connect_rec r w
+let rec connect_rec r w =
+  read r >>= function
+  | `End -> Lwt.return_unit
+  | `Error _ as step -> write_step w step
+  | `Ok _ as step ->
+    write_step w step >>= fun () ->
+    connect_rec r w
 
-  let connect a b =
-    let fut = connect_rec a b in
-    keep b fut
+(* close a when b closes *)
+let link_close p ~after =
+  Lwt.on_termination after.closed
+    (fun _ -> close_async p)
 
-  (* close a when b closes *)
-  let link_close p ~after =
-    Lwt.on_termination after.closed
-      (fun _ -> close_async p)
+let connect ?(ownership=`None) a b =
+  let fut = connect_rec a b in
+  keep b fut;
+  match ownership with
+  | `None -> ()
+  | `InOwnsOut -> link_close b ~after:a
+  | `OutOwnsIn -> link_close a ~after:b
 
-  (* close a when every member of after closes *)
-  let link_close_l p ~after =
-    let n = ref (List.length after) in
-    List.iter
-      (fun p' -> Lwt.on_termination p'.closed
-        (fun _ ->
-           decr n;
-           if !n = 0 then close_async p
-        )
-      ) after
-end
+(* close a when every member of after closes *)
+let link_close_l p ~after =
+  let n = ref (List.length after) in
+  List.iter
+    (fun p' -> Lwt.on_termination p'.closed
+      (fun _ ->
+         decr n;
+         if !n = 0 then close_async p
+      )
+    ) after
+
+let write_error t msg = write_step t (`Error msg)
+
+let write t x = write_step t (`Ok x)
+
+let rec write_list t l = match l with
+  | [] -> Lwt.return_unit
+  | x :: tail ->
+    write t x >>= fun () -> write_list t tail
 
 module Writer = struct
-  type 'a t = ('a, [`w]) Pipe.t
-
-  let write t x = Pipe.write t (`Ok x)
-
-  let write_error t msg = Pipe.write t (`Error msg)
-
-  let rec write_list t l = match l with
-    | [] -> Lwt.return_unit
-    | x :: tail ->
-      write t x >>= fun () -> write_list t tail
+  type 'a t = ('a, [`w]) pipe
 
   let map ~f a =
-    let b = Pipe.create() in
+    let b = create() in
     let rec fwd () =
-      Pipe.read b >>= function
+      read b >>= function
       | `Ok x -> write a (f x) >>= fwd
-      | `Error msg -> write_error a msg >>= fun _ -> Pipe.close a
+      | `Error msg -> write_error a msg >>= fun _ -> close a
       | `End -> Lwt.return_unit
     in
-    Pipe.keep b (fwd());
+    keep b (fwd());
     (* when a gets closed, close b too *)
-    Pipe.link_close b ~after:a;
+    link_close b ~after:a;
     b
 
   let send_all l =
     if l = [] then invalid_arg "send_all";
-    let res = Pipe.create () in
+    let res = create () in
     let rec fwd () =
-      Pipe.read res >>= function
+      read res >>= function
       | `End -> Lwt.return_unit
       | `Ok x -> Lwt_list.iter_p (fun p -> write p x) l >>= fwd
       | `Error msg -> Lwt_list.iter_p (fun p -> write_error p msg) l >>= fwd
     in
     (* do not GC before res dies; close res when any outputx is closed *)
-    Pipe.keep res (fwd ());
-    List.iter (fun out -> Pipe.link_close res ~after:out) l;
+    keep res (fwd ());
+    List.iter (fun out -> link_close res ~after:out) l;
     res
 
   let send_both a b = send_all [a; b]
 end
 
 module Reader = struct
-  type 'a t = ('a, [`r]) Pipe.t
-
-  let read = Pipe.read
+  type 'a t = ('a, [`r]) pipe
 
   let map ~f a =
-    let b = Pipe.create () in
+    let b = create () in
     let rec fwd () =
-      Pipe.read a >>= function
-      | `Ok x -> Pipe.write b (`Ok (f x)) >>= fwd
-      | (`Error _) as e -> Pipe.write b e >>= fun _ -> Pipe.close b
-      | `End -> Pipe.close b
+      read a >>= function
+      | `Ok x -> write_step b (`Ok (f x)) >>= fwd
+      | (`Error _) as e -> write_step b e >>= fun _ -> close b
+      | `End -> close b
     in
-    Pipe.keep b (fwd());
+    keep b (fwd());
     b
 
   let filter_map ~f a =
-    let b = Pipe.create () in
+    let b = create () in
     let rec fwd () =
-      Pipe.read a >>= function
+      read a >>= function
       | `Ok x ->
         begin match f x with
           | None -> fwd()
-          | Some y -> Pipe.write b (`Ok y) >>= fwd
+          | Some y -> write_step b (`Ok y) >>= fwd
         end
-      | (`Error _) as e -> Pipe.write b e >>= fun _ -> Pipe.close b
-      | `End -> Pipe.close b
+      | (`Error _) as e -> write_step b e >>= fun _ -> close b
+      | `End -> close b
     in
-    Pipe.keep b (fwd());
+    keep b (fwd());
     b
 
   let rec fold ~f ~x t =
@@ -280,61 +281,54 @@ module Reader = struct
 
   let merge_all l =
     if l = [] then invalid_arg "merge_all";
-    let res = Pipe.create () in
-    List.iter (fun p -> Pipe.connect p res) l;
+    let res = create () in
+    List.iter (fun p -> connect p res) l;
     (* connect res' input to all members of l; close res when they all close *)
-    Pipe.link_close_l res ~after:l;
+    link_close_l res ~after:l;
     res
 
   let merge_both a b = merge_all [a; b]
 
   let append a b =
-    let c = Pipe.create () in
-    Pipe.connect a c;
-    Lwt.on_success (Pipe.wait a)
+    let c = create () in
+    connect a c;
+    Lwt.on_success (wait a)
       (fun () ->
-         Pipe.connect b c;
-         Pipe.link_close c ~after:b (* once a and b finished, c is too *)
+         connect b c;
+         link_close c ~after:b (* once a and b finished, c is too *)
       );
     c
 end
 
-let connect ?(ownership=`None) a b =
-  Pipe.connect a b;
-  match ownership with
-  | `None -> ()
-  | `InOwnsOut -> Pipe.link_close b ~after:a
-  | `OutOwnsIn -> Pipe.link_close a ~after:b
-
 (** {2 Conversions} *)
 
 let of_list l : _ Reader.t =
-  let p = Pipe.create ~max_size:0 () in
-  Pipe.keep p (Lwt_list.iter_s (Writer.write p) l >>= fun () -> Pipe.close p);
+  let p = create ~max_size:0 () in
+  keep p (Lwt_list.iter_s (write p) l >>= fun () -> close p);
   p
 
 let of_array a =
-  let p = Pipe.create ~max_size:0 () in
+  let p = create ~max_size:0 () in
   let rec send i =
-    if i = Array.length a then Pipe.close p
+    if i = Array.length a then close p
     else (
-      Writer.write p a.(i) >>= fun () ->
+      write p a.(i) >>= fun () ->
       send (i+1)
     )
   in
-  Pipe.keep p (send 0);
+  keep p (send 0);
   p
 
 let of_string a =
-  let p = Pipe.create ~max_size:0 () in
+  let p = create ~max_size:0 () in
   let rec send i =
-    if i = String.length a then Pipe.close p
+    if i = String.length a then close p
     else (
-      Writer.write p (String.get a i) >>= fun () ->
+      write p (String.get a i) >>= fun () ->
       send (i+1)
     )
   in
-  Pipe.keep p (send 0);
+  keep p (send 0);
   p
 
 let to_list_rev r =
@@ -348,16 +342,16 @@ let to_list_exn r =
   | `Ok x -> Lwt.return x
 
 let to_buffer buf =
-  let p = Pipe.create () in
-  Pipe.keep p (
+  let p = create () in
+  keep p (
     Reader.iter ~f:(fun c -> Buffer.add_char buf c) p >>= fun _ ->
     Lwt.return_unit
   );
   p
 
 let to_buffer_str buf =
-  let p = Pipe.create () in
-  Pipe.keep p (
+  let p = create () in
+  keep p (
     Reader.iter ~f:(fun s -> Buffer.add_string buf s) p >>= fun _ ->
     Lwt.return_unit
   );
@@ -368,41 +362,41 @@ let to_buffer_str buf =
 module IO = struct
   let read ?(bufsize=4096) ic : _ Reader.t =
     let buf = Bytes.make bufsize ' ' in
-    let p = Pipe.create ~max_size:0 () in
+    let p = create ~max_size:0 () in
     let rec send() =
       Lwt_io.read_into ic buf 0 bufsize >>= fun n ->
-      if n = 0 then Pipe.close p
+      if n = 0 then close p
       else
-        Writer.write p (Bytes.sub_string buf 0 n) >>= fun () ->
+        write p (Bytes.sub_string buf 0 n) >>= fun () ->
         send ()
     in Lwt.async send;
     p
 
   let read_lines ic =
-    let p = Pipe.create () in
+    let p = create () in
     let rec send () =
       Lwt_io.read_line_opt ic >>= function
-      | None -> Pipe.close p
-      | Some line -> Writer.write p line >>= fun () -> send ()
+      | None -> close p
+      | Some line -> write p line >>= fun () -> send ()
     in
     Lwt.async send;
     p
 
   let write oc =
-    let p = Pipe.create () in
-    Pipe.keep p (
+    let p = create () in
+    keep p (
       Reader.iter_s ~f:(Lwt_io.write oc) p >>= fun _ ->
       Lwt_io.flush oc >>= fun () ->
-      Pipe.close p
+      close p
     );
     p
 
   let write_lines oc =
-    let p = Pipe.create () in
-    Pipe.keep p (
+    let p = create () in
+    keep p (
       Reader.iter_s ~f:(Lwt_io.write_line oc) p >>= fun _ ->
       Lwt_io.flush oc >>= fun () ->
-      Pipe.close p
+      close p
     );
     p
 end
diff --git a/src/lwt/lwt_pipe.mli b/src/lwt/lwt_pipe.mli
index 90b18c2b..a24debae 100644
--- a/src/lwt/lwt_pipe.mli
+++ b/src/lwt/lwt_pipe.mli
@@ -46,7 +46,7 @@ Lwt_io.with_file ~mode:Lwt_io.output "/tmp/foo"
   (fun oc ->
      let p2 = P.IO.write_lines oc in
      P.connect ~ownership:`InOwnsOut p1 p2;
-     P.Pipe.wait p2
+     P.wait p2
   );;
 ]}
 
@@ -66,49 +66,59 @@ end
 
 exception Closed
 
-module Pipe : sig
-  type ('a, +'perm) t constraint 'perm = [< `r | `w]
-  (** A pipe between producers of values of type 'a, and consumers of values
-      of type 'a. *)
+type ('a, +'perm) t constraint 'perm = [< `r | `w]
+(** A pipe between producers of values of type 'a, and consumers of values
+    of type 'a. *)
 
-  val keep : _ t -> unit Lwt.t -> unit
-  (** [keep p fut] adds a pointer from [p] to [fut] so that [fut] is not
-      garbage-collected before [p] *)
+type ('a, 'perm) pipe = ('a, 'perm) t
 
-  val is_closed : _ t -> bool
+val keep : _ t -> unit Lwt.t -> unit
+(** [keep p fut] adds a pointer from [p] to [fut] so that [fut] is not
+    garbage-collected before [p] *)
 
-  val close : _ t -> unit Lwt.t
-  (** [close p] closes [p], which will not accept input anymore.
-      This sends [`End] to all readers connected to [p] *)
+val is_closed : _ t -> bool
 
-  val close_async : _ t -> unit
-  (** Same as {!close} but closes in the background *)
+val close : _ t -> unit Lwt.t
+(** [close p] closes [p], which will not accept input anymore.
+    This sends [`End] to all readers connected to [p] *)
 
-  val wait : _ t -> unit Lwt.t
-  (** Evaluates once the pipe closes *)
+val close_async : _ t -> unit
+(** Same as {!close} but closes in the background *)
 
-  val create : ?max_size:int -> unit -> ('a, 'perm) t
-  (** Create a new pipe.
-      @param max_size size of internal buffer. Default 0. *)
+val wait : _ t -> unit Lwt.t
+(** Evaluates once the pipe closes *)
 
-  val connect : ('a, [>`r]) t -> ('a, [>`w]) t -> unit
-  (** [connect p1 p2] forwards every item output by [p1] into [p2]'s input
-      until [p1] is closed. *)
-end
+val create : ?max_size:int -> unit -> ('a, 'perm) t
+(** Create a new pipe.
+    @param max_size size of internal buffer. Default 0. *)
+
+val connect : ?ownership:[`None | `InOwnsOut | `OutOwnsIn] ->
+              ('a, [>`r]) t -> ('a, [>`w]) t -> unit
+(** [connect p1 p2] forwards every item output by [p1] into [p2]'s input
+    until [p1] is closed.
+    @param own determines which pipes owns which (the owner, when it
+      closes, also closes the ownee) *)
+
+val link_close : _ t -> after:_ t -> unit
+(** [link_close p ~after] will close [p] when [after] closes.
+    if [after] is closed already, closes [p] immediately *)
+
+val read : ('a, [>`r]) t -> 'a step Lwt.t
+(** Read the next value from a Pipe *)
+
+val write : ('a, [>`w]) t -> 'a -> unit Lwt.t
+(** @raise Pipe.Closed if the writer is closed *)
+
+val write_list : ('a, [>`w]) t -> 'a list -> unit Lwt.t
+(** @raise Pipe.Closed if the writer is closed *)
+
+val write_error : (_, [>`w]) t -> string -> unit Lwt.t
+(** @raise Pipe.Closed if the writer is closed *)
 
 module Writer : sig
-  type 'a t = ('a, [`w]) Pipe.t
+  type 'a t = ('a, [`w]) pipe
 
-  val write : 'a t -> 'a -> unit Lwt.t
-  (** @raise Pipe.Closed if the writer is closed *)
-
-  val write_list : 'a t -> 'a list -> unit Lwt.t
-  (** @raise Pipe.Closed if the writer is closed *)
-
-  val write_error : _ t -> string -> unit Lwt.t
-  (** @raise Pipe.Closed if the writer is closed *)
-
-  val map : f:('a -> 'b) -> 'b t -> 'a t
+  val map : f:('a -> 'b) -> ('b, [>`w]) pipe -> 'a t
   (** Map values before writing them *)
 
   val send_both : 'a t -> 'a t -> 'a t
@@ -122,11 +132,9 @@ module Writer : sig
 end
 
 module Reader : sig
-  type 'a t = ('a, [`r]) Pipe.t
+  type 'a t = ('a, [`r]) pipe
 
-  val read : 'a t -> 'a step Lwt.t
-
-  val map : f:('a -> 'b) -> 'a t -> 'b t
+  val map : f:('a -> 'b) -> ('a, [>`r]) pipe -> 'b t
 
   val filter_map : f:('a -> 'b option) -> 'a t -> 'b t
 
@@ -146,13 +154,10 @@ module Reader : sig
       @raise Invalid_argument if the list is empty *)
 
   val append : 'a t -> 'a t -> 'a t
+  (** [append a b] reads from [a] until [a] closes, then reads from [b]
+      and closes when [b] closes *)
 end
 
-val connect : ?ownership:[`None | `InOwnsOut | `OutOwnsIn] ->
-              'a Reader.t -> 'a Writer.t -> unit
-(** Handy synonym to {!Pipe.connect}, with additional resource management.
-    @param own determines which pipes owns which *)
-
 (** {2 Conversions} *)
 
 val of_list : 'a list -> 'a Reader.t

From 1a2ffbb262906dea5ddfb69e954866f258f7cf1c Mon Sep 17 00:00:00 2001
From: Simon Cruanes <simon.cruanes.2007@m4x.org>
Date: Fri, 20 Feb 2015 16:46:57 +0100
Subject: [PATCH 41/72] Add CCMixmap in containers.data (close #40)

---
 _oasis                |   2 +-
 src/data/CCMixmap.ml  | 162 ++++++++++++++++++++++++++++++++++++++++++
 src/data/CCMixmap.mli | 100 ++++++++++++++++++++++++++
 3 files changed, 263 insertions(+), 1 deletion(-)
 create mode 100644 src/data/CCMixmap.ml
 create mode 100644 src/data/CCMixmap.mli

diff --git a/_oasis b/_oasis
index af6dbc2c..ff6f9d02 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,
-                    CCBufferIO
+                    CCMixmap, CCBufferIO
   FindlibParent:    containers
   FindlibName:      data
 
diff --git a/src/data/CCMixmap.ml b/src/data/CCMixmap.ml
new file mode 100644
index 00000000..152dcca8
--- /dev/null
+++ b/src/data/CCMixmap.ml
@@ -0,0 +1,162 @@
+
+(*
+copyright (c) 2013-2014, simon cruanes
+all rights reserved.
+
+redistribution and use in source and binary forms, with or without
+modification, are permitted provided that the following conditions are met:
+
+redistributions of source code must retain the above copyright notice, this
+list of conditions and the following disclaimer.  redistributions in binary
+form must reproduce the above copyright notice, this list of conditions and the
+following disclaimer in the documentation and/or other materials provided with
+the distribution.
+
+THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" AND
+ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED
+WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE
+DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDER OR CONTRIBUTORS BE LIABLE
+FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL
+DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR
+SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER
+CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY,
+OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE
+OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+*)
+
+(** {1 Hash Table with Heterogeneous Keys} *)
+
+type 'b injection = {
+  get : (unit -> unit) -> 'b option;
+  set : 'b -> (unit -> unit);
+}
+
+let create_inj () =
+  let r = ref None in
+  let get f =
+    r := None;
+    f ();
+    !r
+  and set v =
+    (fun () -> r := Some v)
+  in
+  {get;set}
+
+module type S = sig
+  type key
+
+  type t
+  (** A map containing values of different types, indexed by {!key}. *)
+
+  val empty : t
+  (** Empty map *)
+
+  val get : inj:'a injection -> t  -> key -> 'a option
+  (** Get the value corresponding to this key, if it exists and
+      belongs to the same key *)
+
+  val add : inj:'a injection -> t -> key -> 'a -> t
+  (** Bind the key to the value, using [inj] *)
+
+  val find : inj:'a injection -> t -> key -> 'a
+  (** Find the value for the given key, which must be of the right type.
+      @raise Not_found if either the key is not found, or if its value
+        doesn't belong to the right type *)
+
+  val cardinal : t -> int
+  (** Number of bindings *)
+
+  val remove : t -> key -> t
+  (** Remove the binding for this key *)
+
+  val mem : inj:_ injection-> t -> key -> bool
+  (** Is the given key in the map, with the right type? *)
+
+  val iter_keys : f:(key -> unit) -> t -> unit
+  (** Iterate on the keys of this map *)
+
+  val fold_keys : f:('a -> key -> 'a) -> x:'a -> t -> 'a
+  (** Fold over the keys *)
+
+  (** {2 Iterators} *)
+
+  type 'a sequence = ('a -> unit) -> unit
+
+  val keys_seq : t -> key sequence
+  (** All the keys *)
+
+  val bindings_of : inj:'a injection -> t -> (key * 'a) sequence
+  (** All the bindings that come from the corresponding injection *)
+
+  type value =
+    | Value : ('a injection -> 'a option) -> value
+
+  val bindings : t -> (key * value) sequence
+  (** Iterate on all bindings *)
+end
+
+module type ORD = sig
+  type t
+  val compare : t -> t -> int
+end
+
+module Make(X : ORD) : S with type key = X.t = struct
+  module M = Map.Make(X)
+
+  type key = X.t
+  type t = (unit -> unit) M.t
+
+  let empty = M.empty
+
+  let find ~inj map x =
+    match inj.get (M.find x map) with
+      | None -> raise Not_found
+      | Some v -> v
+
+  let get ~inj map x =
+    try inj.get (M.find x map)
+    with Not_found -> None
+
+  let add ~inj map x y =
+    M.add x (inj.set y) map
+
+  let cardinal = M.cardinal
+
+  let remove map x = M.remove x map
+
+  let mem ~inj map x =
+    try
+      inj.get (M.find x map) <> None
+    with Not_found -> false
+
+  let iter_keys ~f map =
+    M.iter (fun x _ -> f x) map
+
+  let fold_keys ~f ~x map =
+    M.fold (fun x _ acc -> f acc x) map x
+
+  (** {2 Iterators} *)
+
+  type 'a sequence = ('a -> unit) -> unit
+
+  let keys_seq map yield =
+    M.iter
+      (fun x _ -> yield x)
+      map
+
+  let bindings_of ~inj map yield =
+    M.iter
+      (fun k value ->
+        match inj.get value with
+        | None -> ()
+        | Some v -> yield (k, v)
+      ) map
+
+  type value =
+    | Value : ('b injection -> 'b option) -> value
+
+  let bindings map yield =
+    M.iter
+      (fun x y -> yield (x, Value (fun inj -> inj.get y)))
+      map
+end
diff --git a/src/data/CCMixmap.mli b/src/data/CCMixmap.mli
new file mode 100644
index 00000000..3cc1e9d7
--- /dev/null
+++ b/src/data/CCMixmap.mli
@@ -0,0 +1,100 @@
+(*
+copyright (c) 2013-2014, simon cruanes
+all rights reserved.
+
+redistribution and use in source and binary forms, with or without
+modification, are permitted provided that the following conditions are met:
+
+redistributions of source code must retain the above copyright notice, this
+list of conditions and the following disclaimer.  redistributions in binary
+form must reproduce the above copyright notice, this list of conditions and the
+following disclaimer in the documentation and/or other materials provided with
+the distribution.
+
+THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" AND
+ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED
+WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE
+DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDER OR CONTRIBUTORS BE LIABLE
+FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL
+DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR
+SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER
+CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY,
+OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE
+OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+*)
+
+(** {1 Maps with Heterogeneous Values}
+
+@since NEXT_RELEASE *)
+
+type 'a injection
+(** An accessor for values of type 'a in any map. Values put
+    in the map using an key can only be retrieved using this
+    very same key. *)
+
+val create_inj : unit -> 'a injection
+(** Return a value that works for a given type of values.  This function is
+    normally called once for each type of value.  Several keys may be
+    created for the same type, but a value set with a given setter can only be
+    retrieved with the matching getter.  The same key can be reused
+    across multiple maps (although not in a thread-safe way). *)
+
+module type S = sig
+  type key
+
+  type t
+  (** A map containing values of different types, indexed by {!key}. *)
+
+  val empty : t
+  (** Empty map *)
+
+  val get : inj:'a injection -> t  -> key -> 'a option
+  (** Get the value corresponding to this key, if it exists and
+      belongs to the same key *)
+
+  val add : inj:'a injection -> t -> key -> 'a -> t
+  (** Bind the key to the value, using [inj] *)
+
+  val find : inj:'a injection -> t -> key -> 'a
+  (** Find the value for the given key, which must be of the right type.
+      @raise Not_found if either the key is not found, or if its value
+        doesn't belong to the right type *)
+
+  val cardinal : t -> int
+  (** Number of bindings *)
+
+  val remove : t -> key -> t
+  (** Remove the binding for this key *)
+
+  val mem : inj:_ injection-> t -> key -> bool
+  (** Is the given key in the map, with the right type? *)
+
+  val iter_keys : f:(key -> unit) -> t -> unit
+  (** Iterate on the keys of this map *)
+
+  val fold_keys : f:('a -> key -> 'a) -> x:'a -> t -> 'a
+  (** Fold over the keys *)
+
+  (** {2 Iterators} *)
+
+  type 'a sequence = ('a -> unit) -> unit
+
+  val keys_seq : t -> key sequence
+  (** All the keys *)
+
+  val bindings_of : inj:'a injection -> t -> (key * 'a) sequence
+  (** All the bindings that come from the corresponding injection *)
+
+  type value =
+    | Value : ('a injection -> 'a option) -> value
+
+  val bindings : t -> (key * value) sequence
+  (** Iterate on all bindings *)
+end
+
+module type ORD = sig
+  type t
+  val compare : t -> t -> int
+end
+
+module Make(X : ORD) : S with type key = X.t

From 6a79b88ef02f4c5b25b9c7f0f0d885c1591ffcb6 Mon Sep 17 00:00:00 2001
From: Simon Cruanes <simon.cruanes.2007@m4x.org>
Date: Fri, 20 Feb 2015 16:49:08 +0100
Subject: [PATCH 42/72] documentation

---
 doc/intro.txt         | 11 +++++++++++
 src/data/CCMixtbl.mli |  4 ++--
 src/lwt/lwt_pipe.mli  |  6 +++++-
 3 files changed, 18 insertions(+), 3 deletions(-)

diff --git a/doc/intro.txt b/doc/intro.txt
index 631dec78..231aab21 100644
--- a/doc/intro.txt
+++ b/doc/intro.txt
@@ -68,6 +68,7 @@ CCBV
 CCCache
 CCFQueue
 CCFlatHashtbl
+CCMixmap
 CCMixtbl
 CCMultiMap
 CCMultiSet
@@ -131,6 +132,16 @@ UnionFind
 Univ
 }
 
+{4 Lwt}
+
+Utils for Lwt (including experimental stuff)
+
+{!modules:
+Lwt_actor
+Lwt_klist
+Lwt_pipe
+}
+
 {4 Others}
 
 {!modules:
diff --git a/src/data/CCMixtbl.mli b/src/data/CCMixtbl.mli
index 67af7755..a315b41a 100644
--- a/src/data/CCMixtbl.mli
+++ b/src/data/CCMixtbl.mli
@@ -82,8 +82,8 @@ val set : inj:'b injection -> 'a t -> 'a -> 'b -> unit
 
 val find : inj:'b injection -> 'a t -> 'a -> 'b
 (** Find the value for the given key, which must be of the right type.
-    raises Not_found if either the key is not found, or if its value
-    doesn't belong to the right type *)
+    @raise Not_found if either the key is not found, or if its value
+      doesn't belong to the right type *)
 
 val length : 'a t -> int
 (** Number of bindings *)
diff --git a/src/lwt/lwt_pipe.mli b/src/lwt/lwt_pipe.mli
index a24debae..87ba7ecc 100644
--- a/src/lwt/lwt_pipe.mli
+++ b/src/lwt/lwt_pipe.mli
@@ -28,7 +28,7 @@ OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
 
   Stream processing using:
 
-  - Pipe: a possibly buffered channel through which readers and writer communicate
+  - Pipe: a possibly buffered channel that can act as a reader or as a writer
   - Reader: accepts values, produces effects
   - Writer: yield values
 
@@ -115,6 +115,8 @@ val write_list : ('a, [>`w]) t -> 'a list -> unit Lwt.t
 val write_error : (_, [>`w]) t -> string -> unit Lwt.t
 (** @raise Pipe.Closed if the writer is closed *)
 
+(** {2 Write-only Interface and Combinators} *)
+
 module Writer : sig
   type 'a t = ('a, [`w]) pipe
 
@@ -131,6 +133,8 @@ module Writer : sig
       @raise Invalid_argument if the list is empty *)
 end
 
+(** {2 Read-only Interface and Combinators} *)
+
 module Reader : sig
   type 'a t = ('a, [`r]) pipe
 

From f9d32d0af24f36584193792c79c30db8ddffb226 Mon Sep 17 00:00:00 2001
From: Simon Cruanes <simon.cruanes.2007@m4x.org>
Date: Fri, 20 Feb 2015 17:24:55 +0100
Subject: [PATCH 43/72] draft of printer for CCKTree (not done yet)

---
 src/iter/CCKTree.ml  | 51 ++++++++++++++++++++++++++++++++++++++++++++
 src/iter/CCKTree.mli | 26 ++++++++++++++++++++++
 2 files changed, 77 insertions(+)

diff --git a/src/iter/CCKTree.ml b/src/iter/CCKTree.ml
index 35e8590d..cb0f47ed 100644
--- a/src/iter/CCKTree.ml
+++ b/src/iter/CCKTree.ml
@@ -181,6 +181,57 @@ let find ?pset f t =
   in
   _find_kl f (bfs ?pset t)
 
+(** {2 Pretty-printing} *)
+
+let print pp_x fmt t =
+  let out_funs = Format.pp_get_formatter_out_functions fmt () in
+  let print_bar fmt () = Format.pp_print_string fmt "|  " in
+  let print_bars n fmt () =
+    for _i = 0 to n-1 do print_bar fmt () done
+  in
+  let print_node ~last fmt () =
+    if last
+    then Format.pp_print_string fmt "└──"
+    else Format.pp_print_string fmt "├──"
+  in
+  (* special printer for Format, handling indentation and all *)
+  let pp_functions =
+    {out_funs with
+     Format.out_spaces=(fun n -> print_bars n fmt ())
+    }
+  in
+  let set_printer () =
+    Format.pp_set_formatter_out_functions fmt pp_functions
+  in
+  (* at depth [lvl] *)
+  let rec pp ~last lvl t = match t with
+    | `Nil -> ()
+    | `Node (x, children) ->
+      if lvl>0 then (
+        print_bars (lvl-1) fmt ();
+        print_node ~last fmt ()
+      );
+      pp_x fmt x;
+      Format.pp_print_newline fmt ();
+      (* remove empty children *)
+      let children = List.fold_left
+        (fun acc c -> match c() with
+          | `Nil -> acc
+          | `Node _ as sub -> sub :: acc
+        ) [] children
+      in
+      let children = List.rev children in
+      let n = List.length children in
+      List.iteri
+        (fun i c ->
+           pp ~last:(i+1=n) (lvl+1) c
+        ) children
+  in
+  set_printer ();
+  pp ~last:false 0 (t ());
+  Format.pp_set_formatter_out_functions fmt out_funs; (* restore *)
+  ()
+
 (** {2 Pretty printing in the DOT (graphviz) format} *)
 
 module Dot = struct
diff --git a/src/iter/CCKTree.mli b/src/iter/CCKTree.mli
index c64444f3..d63b4c01 100644
--- a/src/iter/CCKTree.mli
+++ b/src/iter/CCKTree.mli
@@ -94,6 +94,32 @@ val bfs : ?pset:'a pset -> 'a t -> 'a klist
 val find : ?pset:'a pset -> ('a -> 'b option) -> 'a t -> 'b option
 (** Look for an element that maps to [Some _] *)
 
+(** {2 Pretty-printing}
+
+Example (tree of calls for naive Fibonacci function):
+{[
+  let mk_fib n =
+    let rec fib' l r i =
+      if i=n then r else fib' r (l+r) (i+1)
+    in fib' 1 1 1;;
+
+  let rec fib n = match n with
+    | 0 | 1 -> CCKTree.singleton (`Cst n)
+    | _ -> CCKTree.node2 (`Plus (mk_fib n)) (fib (n-1)) (fib (n-2));;
+
+  let pp_node fmt = function
+    | `Cst n -> Format.fprintf fmt "%d" n
+    | `Plus n -> Format.fprintf fmt "%d" n;;
+
+  Format.printf "%a@." (CCKTree.print pp_node) (fib 8);;
+]}
+*)
+
+val print : 'a formatter -> 'a t formatter
+(** A pretty-printer using indentation to render the tree. Empty nodes
+    are not rendered; sharing is ignored.
+    @since NEXT_RELEASE *)
+
 (** {2 Pretty printing in the DOT (graphviz) format} *)
 
 module Dot : sig

From 1be3bcf7662e17bce11a1ed561ab8ea9414f46ac Mon Sep 17 00:00:00 2001
From: Simon Cruanes <simon.cruanes.2007@m4x.org>
Date: Fri, 20 Feb 2015 17:37:38 +0100
Subject: [PATCH 44/72] lwt_pipe: better output to buffer/string

---
 src/lwt/lwt_pipe.ml  | 32 ++++++++++++++++++--------------
 src/lwt/lwt_pipe.mli | 14 +++++++++-----
 2 files changed, 27 insertions(+), 19 deletions(-)

diff --git a/src/lwt/lwt_pipe.ml b/src/lwt/lwt_pipe.ml
index eb02d9c0..368ef67b 100644
--- a/src/lwt/lwt_pipe.ml
+++ b/src/lwt/lwt_pipe.ml
@@ -53,6 +53,7 @@ module LwtErr = struct
       ) x
 end
 
+let (>>>=) = LwtErr.(>>=)
 let (>>|=) = LwtErr.(>|=)
 
 let ret_end = Lwt.return `End
@@ -341,21 +342,24 @@ let to_list_exn r =
   | `Error msg -> Lwt.fail (Failure msg)
   | `Ok x -> Lwt.return x
 
-let to_buffer buf =
-  let p = create () in
-  keep p (
-    Reader.iter ~f:(fun c -> Buffer.add_char buf c) p >>= fun _ ->
-    Lwt.return_unit
-  );
-  p
+let to_buffer buf r =
+  Reader.iter ~f:(fun c -> Buffer.add_char buf c) r
 
-let to_buffer_str buf =
-  let p = create () in
-  keep p (
-    Reader.iter ~f:(fun s -> Buffer.add_string buf s) p >>= fun _ ->
-    Lwt.return_unit
-  );
-  p
+let to_buffer_str ?(sep="") buf r =
+  let first = ref true in
+  Reader.iter r
+    ~f:(fun s ->
+        if !first then first:= false else Buffer.add_string buf sep;
+        Buffer.add_string buf s
+      )
+
+let to_string r =
+  let buf = Buffer.create 128 in
+  to_buffer buf r >>>= fun () -> LwtErr.return (Buffer.contents buf)
+
+let join_strings ?sep r =
+  let buf = Buffer.create 128 in
+  to_buffer_str ?sep buf r >>>= fun () -> LwtErr.return (Buffer.contents buf)
 
 (** {2 Basic IO wrappers} *)
 
diff --git a/src/lwt/lwt_pipe.mli b/src/lwt/lwt_pipe.mli
index 87ba7ecc..2c9cdcec 100644
--- a/src/lwt/lwt_pipe.mli
+++ b/src/lwt/lwt_pipe.mli
@@ -170,17 +170,21 @@ val of_array : 'a array -> 'a Reader.t
 
 val of_string : string -> char Reader.t
 
-val to_list_rev : 'a Reader.t -> 'a list LwtErr.t
+val to_list_rev : ('a,[>`r]) t -> 'a list LwtErr.t
 
-val to_list : 'a Reader.t -> 'a list LwtErr.t
+val to_list : ('a,[>`r]) t -> 'a list LwtErr.t
 
-val to_list_exn : 'a Reader.t -> 'a list Lwt.t
+val to_list_exn : ('a,[>`r]) t -> 'a list Lwt.t
 (** Same as {!to_list}, but can fail with
     @raise Failure if some error is met *)
 
-val to_buffer : Buffer.t -> char Writer.t
+val to_buffer : Buffer.t -> (char ,[>`r]) t -> unit LwtErr.t
 
-val to_buffer_str : Buffer.t -> string Writer.t
+val to_buffer_str : ?sep:string -> Buffer.t -> (string, [>`r]) t -> unit LwtErr.t
+
+val to_string : (char, [>`r]) t -> string LwtErr.t
+
+val join_strings  : ?sep:string -> (string, [>`r]) t -> string LwtErr.t
 
 (** {2 Basic IO wrappers} *)
 

From 0c49d30d85ec456a3800a1d99cab42312f756041 Mon Sep 17 00:00:00 2001
From: Simon Cruanes <simon.cruanes.2007@m4x.org>
Date: Fri, 20 Feb 2015 17:50:33 +0100
Subject: [PATCH 45/72] use S-expressions in CCKTree.print, much much easier

---
 src/iter/CCKTree.ml  | 65 ++++++++++++++++----------------------------
 src/iter/CCKTree.mli |  4 +--
 2 files changed, 25 insertions(+), 44 deletions(-)

diff --git a/src/iter/CCKTree.ml b/src/iter/CCKTree.ml
index cb0f47ed..02ac32c4 100644
--- a/src/iter/CCKTree.ml
+++ b/src/iter/CCKTree.ml
@@ -184,52 +184,33 @@ let find ?pset f t =
 (** {2 Pretty-printing} *)
 
 let print pp_x fmt t =
-  let out_funs = Format.pp_get_formatter_out_functions fmt () in
-  let print_bar fmt () = Format.pp_print_string fmt "|  " in
-  let print_bars n fmt () =
-    for _i = 0 to n-1 do print_bar fmt () done
-  in
-  let print_node ~last fmt () =
-    if last
-    then Format.pp_print_string fmt "└──"
-    else Format.pp_print_string fmt "├──"
-  in
-  (* special printer for Format, handling indentation and all *)
-  let pp_functions =
-    {out_funs with
-     Format.out_spaces=(fun n -> print_bars n fmt ())
-    }
-  in
-  let set_printer () =
-    Format.pp_set_formatter_out_functions fmt pp_functions
-  in
   (* at depth [lvl] *)
-  let rec pp ~last lvl t = match t with
+  let rec pp fmt t = match t with
     | `Nil -> ()
     | `Node (x, children) ->
-      if lvl>0 then (
-        print_bars (lvl-1) fmt ();
-        print_node ~last fmt ()
-      );
-      pp_x fmt x;
-      Format.pp_print_newline fmt ();
-      (* remove empty children *)
-      let children = List.fold_left
-        (fun acc c -> match c() with
-          | `Nil -> acc
-          | `Node _ as sub -> sub :: acc
-        ) [] children
-      in
-      let children = List.rev children in
-      let n = List.length children in
-      List.iteri
-        (fun i c ->
-           pp ~last:(i+1=n) (lvl+1) c
-        ) children
+      let children = filter children in
+      match children with
+      | [] -> pp_x fmt x
+      | _::_ ->
+        Format.fprintf fmt "@[<v2>(@[<hov0>%a@]%a)@]"
+          pp_x x pp_children children
+  and filter l  =
+    let l = List.fold_left
+      (fun acc c -> match c() with
+        | `Nil -> acc
+        | `Node _ as sub -> sub :: acc
+      ) [] l
+    in
+    List.rev l
+  and pp_children fmt children =
+    (* remove empty children *)
+    List.iter
+      (fun c ->
+         Format.fprintf fmt "@,";
+         pp fmt c
+      ) children
   in
-  set_printer ();
-  pp ~last:false 0 (t ());
-  Format.pp_set_formatter_out_functions fmt out_funs; (* restore *)
+  pp fmt (t ());
   ()
 
 (** {2 Pretty printing in the DOT (graphviz) format} *)
diff --git a/src/iter/CCKTree.mli b/src/iter/CCKTree.mli
index d63b4c01..7b773ef3 100644
--- a/src/iter/CCKTree.mli
+++ b/src/iter/CCKTree.mli
@@ -116,8 +116,8 @@ Example (tree of calls for naive Fibonacci function):
 *)
 
 val print : 'a formatter -> 'a t formatter
-(** A pretty-printer using indentation to render the tree. Empty nodes
-    are not rendered; sharing is ignored.
+(** A pretty-printer using S-expressions and boxes to render the tree.
+    Empty nodes are not rendered; sharing is ignored.
     @since NEXT_RELEASE *)
 
 (** {2 Pretty printing in the DOT (graphviz) format} *)

From d338ce279c2917247d87a9e3e438447163c83a45 Mon Sep 17 00:00:00 2001
From: Simon Cruanes <simon.cruanes.2007@m4x.org>
Date: Fri, 20 Feb 2015 18:19:18 +0100
Subject: [PATCH 46/72] Lwt_pipe: conversion to/from lwt_klist

---
 src/lwt/lwt_pipe.ml  | 22 ++++++++++++++++++++++
 src/lwt/lwt_pipe.mli |  7 +++++++
 2 files changed, 29 insertions(+)

diff --git a/src/lwt/lwt_pipe.ml b/src/lwt/lwt_pipe.ml
index 368ef67b..b7c24a17 100644
--- a/src/lwt/lwt_pipe.ml
+++ b/src/lwt/lwt_pipe.ml
@@ -303,6 +303,8 @@ end
 
 (** {2 Conversions} *)
 
+type 'a lwt_klist = [ `Nil | `Cons of 'a * 'a lwt_klist ] Lwt.t
+
 let of_list l : _ Reader.t =
   let p = create ~max_size:0 () in
   keep p (Lwt_list.iter_s (write p) l >>= fun () -> close p);
@@ -332,6 +334,17 @@ let of_string a =
   keep p (send 0);
   p
 
+let of_lwt_klist l =
+  let p = create ~max_size:0 () in
+  let rec next l =
+    l >>= function
+    | `Nil -> close p
+    | `Cons (x, tl) ->
+      write p x >>= fun () -> next tl
+  in
+  keep p (next l);
+  p
+
 let to_list_rev r =
   Reader.fold ~f:(fun acc x -> x :: acc) ~x:[] r
 
@@ -361,6 +374,15 @@ let join_strings ?sep r =
   let buf = Buffer.create 128 in
   to_buffer_str ?sep buf r >>>= fun () -> LwtErr.return (Buffer.contents buf)
 
+let to_lwt_klist r =
+  let rec next () =
+    read r >>= function
+    | `End -> Lwt.return `Nil
+    | `Error _ -> Lwt.return `Nil
+    | `Ok x -> Lwt.return (`Cons (x, next ()))
+  in
+  next ()
+
 (** {2 Basic IO wrappers} *)
 
 module IO = struct
diff --git a/src/lwt/lwt_pipe.mli b/src/lwt/lwt_pipe.mli
index 2c9cdcec..efcd0bee 100644
--- a/src/lwt/lwt_pipe.mli
+++ b/src/lwt/lwt_pipe.mli
@@ -164,12 +164,16 @@ end
 
 (** {2 Conversions} *)
 
+type 'a lwt_klist = [ `Nil | `Cons of 'a * 'a lwt_klist ] Lwt.t
+
 val of_list : 'a list -> 'a Reader.t
 
 val of_array : 'a array -> 'a Reader.t
 
 val of_string : string -> char Reader.t
 
+val of_lwt_klist : 'a lwt_klist -> 'a Reader.t
+
 val to_list_rev : ('a,[>`r]) t -> 'a list LwtErr.t
 
 val to_list : ('a,[>`r]) t -> 'a list LwtErr.t
@@ -186,6 +190,9 @@ val to_string : (char, [>`r]) t -> string LwtErr.t
 
 val join_strings  : ?sep:string -> (string, [>`r]) t -> string LwtErr.t
 
+val to_lwt_klist : 'a Reader.t -> 'a lwt_klist
+(** Iterates on the reader. Errors are ignored (but stop the list). *)
+
 (** {2 Basic IO wrappers} *)
 
 module IO : sig

From c16783f513b0cb7c5de85ab7c08be83c1725b7e4 Mon Sep 17 00:00:00 2001
From: Simon Cruanes <simon.cruanes.2007@m4x.org>
Date: Fri, 20 Feb 2015 18:19:30 +0100
Subject: [PATCH 47/72] Implement missing functions from Lwt_klist

---
 src/lwt/lwt_klist.ml  | 95 +++++++++++++++++++++++++++++++++++--------
 src/lwt/lwt_klist.mli | 10 ++++-
 2 files changed, 86 insertions(+), 19 deletions(-)

diff --git a/src/lwt/lwt_klist.ml b/src/lwt/lwt_klist.ml
index fa186711..59bba1d9 100644
--- a/src/lwt/lwt_klist.ml
+++ b/src/lwt/lwt_klist.ml
@@ -37,11 +37,6 @@ let empty = Lwt.return `Nil
 let cons x l = Lwt.return (`Cons (x, l))
 
 let rec create f : 'a t =
-  let fut, wake = Lwt.wait () in
-  f () >|= function
-  | None -> `Nil
-  | Some x -> `Cons (x, create f)
-and create_rec f () =
   f () >|= function
   | None -> `Nil
   | Some x -> `Cons (x, create f)
@@ -115,13 +110,66 @@ let rec fold_s f acc l =
   | `Nil -> Lwt.return acc
   | `Cons (x, tl) -> f acc x >>= fun acc -> fold_s f acc tl
 
-let take n l = assert false
-let take_while f l = assert false
-let take_while_s f l = assert false
-let drop n l = assert false
-let drop_while f l = assert false
-let drop_while_s f l = assert false
-let merge a b = assert false
+let rec take n l = match n with
+  | 0 -> empty
+  | _ ->
+    l >>= function
+    | `Nil -> empty
+    | `Cons (x, tl) -> Lwt.return (`Cons (x, take (n-1) tl))
+
+let rec take_while f l =
+  l >>= function
+  | `Cons (x, tl) when f x -> Lwt.return (`Cons (x, take_while f  tl))
+  | `Nil
+  | `Cons _ -> empty
+
+let rec take_while_s f l =
+  l >>= function
+  | `Nil -> empty
+  | `Cons (x, tl) ->
+    f x >>= function
+    | true -> Lwt.return (`Cons (x, take_while_s f  tl))
+    | false -> empty
+
+let rec drop n l = match n with
+  | 0 -> l
+  | _ ->
+    l >>= function
+    | `Nil -> empty
+    | `Cons (_, tl) -> drop (n-1) tl
+
+let rec drop_while f l =
+  l >>= function
+  | `Nil -> empty
+  | `Cons (x, _) when f x -> l
+  | `Cons (_, tl) -> drop_while f tl
+
+let rec drop_while_s f l =
+  l >>= function
+  | `Nil -> empty
+  | `Cons (x, tl) ->
+    f x >>= function
+    | false -> drop_while_s f tl
+    | true -> l
+
+let merge a b =
+  let add_left = Lwt.map (fun y -> `Left y) in
+  let add_right = Lwt.map (fun y -> `Right y) in
+  let remove_side l =
+    l >|= function
+    | `Left x -> x
+    | `Right x -> x
+  in
+  let rec merge' l r =
+    Lwt.choose [l; r] >>= function
+    | `Left `Nil -> remove_side r
+    | `Left (`Cons (x, l')) ->
+      Lwt.return (`Cons (x, merge' (add_left l') r))
+    | `Right `Nil -> remove_side l
+    | `Right (`Cons (x, r')) ->
+      Lwt.return (`Cons (x, merge' l (add_right r')))
+  in
+  merge' (add_left a) (add_right b)
 
 (** {2 Conversions} *)
 
@@ -132,7 +180,7 @@ let rec of_list l = match l with
   | x :: tl -> Lwt.return (`Cons (x, of_list tl))
 
 let rec of_array_rec a i =
-  if i = Array.length a 
+  if i = Array.length a
   then empty
   else Lwt.return (`Cons (a.(i), of_array_rec a (i+1)))
 
@@ -147,7 +195,20 @@ let rec of_gen_s g = match g() with
   | Some x ->
     x >|= fun x -> `Cons (x, of_gen_s g)
 
-let of_string s = assert false
-let to_string l = assert false
-let to_list l = assert false
-let to_rev_list l = assert false
+let rec of_string_rec s i =
+  if i = String.length s
+  then empty
+  else Lwt.return (`Cons (String.get s i, of_string_rec s (i+1)))
+
+let of_string s : char t = of_string_rec s 0
+
+let to_string l =
+  let buf = Buffer.create 128 in
+  iter (fun c -> Buffer.add_char buf c) l >>= fun () ->
+  Lwt.return (Buffer.contents buf)
+
+let to_rev_list l =
+  fold (fun acc x -> x :: acc) [] l
+
+let to_list l = to_rev_list l >|= List.rev
+
diff --git a/src/lwt/lwt_klist.mli b/src/lwt/lwt_klist.mli
index 4a2b6087..8f94fbbe 100644
--- a/src/lwt/lwt_klist.mli
+++ b/src/lwt/lwt_klist.mli
@@ -24,7 +24,13 @@ OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE
 OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
 *)
 
-(** {1 Functional streams for Lwt} *)
+(** {1 Functional streams for Lwt}
+
+Functional streams, that is, lazy lists whose nodes are behind a
+Lwt.t future. Such as list never mutates, it can be safely traversed
+several times, but might eat memory.
+
+@since NEXT_RELEASE *)
 
 type 'a t = [ `Nil | `Cons of 'a * 'a t ] Lwt.t
 type 'a stream = 'a t
@@ -90,7 +96,7 @@ val of_gen : 'a gen -> 'a t
 
 val of_gen_s : 'a Lwt.t gen -> 'a t
 
-val of_string : string -> 'a t
+val of_string : string -> char t
 
 val to_list : 'a t -> 'a list Lwt.t
 

From 777aca435ae7eee3d847101f7b774d8df659c059 Mon Sep 17 00:00:00 2001
From: cpiccion <carmelo.piccione@theice.com>
Date: Fri, 20 Feb 2015 16:20:03 -0500
Subject: [PATCH 48/72] unit test fixes

---
 src/data/CCRingBuffer.ml | 2 +-
 1 file changed, 1 insertion(+), 1 deletion(-)

diff --git a/src/data/CCRingBuffer.ml b/src/data/CCRingBuffer.ml
index fe064467..cf19483d 100644
--- a/src/data/CCRingBuffer.ml
+++ b/src/data/CCRingBuffer.ml
@@ -361,7 +361,7 @@ struct
 
   (*$Q
     (Q.pair Q.printable_string Q.printable_string) (fun (s,s') -> \
-    (let b = ByteBuffer.create 24 in ByteBuffer.blit_from b s 0 (Bytes.length s);
+    (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 word"); (* big enough *) \
     let l = ByteBuffer.length b in let l' = l/2 in ByteBuffer.skip b l'; \

From c22a33c405244faaf3a27a256496de060b45caf9 Mon Sep 17 00:00:00 2001
From: carm <carmelo.piccione@gmail.com>
Date: Sun, 22 Feb 2015 13:03:59 -0500
Subject: [PATCH 49/72] fix bugs revealed in qtests

---
 src/data/CCRingBuffer.ml | 95 +++++++++++++++++++++++++++-------------
 1 file changed, 64 insertions(+), 31 deletions(-)

diff --git a/src/data/CCRingBuffer.ml b/src/data/CCRingBuffer.ml
index cf19483d..e3b2e806 100644
--- a/src/data/CCRingBuffer.ml
+++ b/src/data/CCRingBuffer.ml
@@ -68,7 +68,6 @@ module Array = struct
     let empty = Array.of_list []
   end
 
-
   module IntArray :
     S with type elt = int and type t = int array = struct
     type t = int array
@@ -102,7 +101,7 @@ module Array = struct
 
 
   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 t = Elt.t array
     let make = Array.make
@@ -204,15 +203,17 @@ struct
     { b with buf=Array.copy b.buf; }
 
 (*$T
-  let b = ByteBuffer.create 3 in \
   let s = Bytes.of_string "hello world" in \
-  ByteBuffer.blit_from b s 0 (Bytes.length s); \
-    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 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 = Array.length b.buf
+  let capacity b =
+    let len = Array.length b.buf in
+    match len with 0 -> 0 | l -> l - 1
 
   let max_capacity b = if b.bounded then Some b.size else None
 
@@ -241,17 +242,23 @@ struct
     b.buf <- buf'
 
   let blit_from_bounded b from_buf o len =
-    let cap = capacity b - len in
+    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)
+      resize b new_size 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;
     end;
     let sub = Array.sub from_buf o len in
     let iter x =
-      let capacity = capacity b in
+      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
@@ -263,10 +270,15 @@ struct
 
 
   let blit_from_unbounded b from_buf o len =
-    let cap = capacity b - len in
+    let cap = capacity b - length b 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);
-    assert (capacity b - length b >= len);
+    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
@@ -285,12 +297,30 @@ struct
     ()
 
   let blit_from b from_buf o len =
-    if (Array.length from_buf) = 0 then () else
+    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");
@@ -311,7 +341,7 @@ struct
       end
     end
 
-	let clear b =
+  let clear b =
     b.stop <- 0;
     b.start <- 0;
     ()
@@ -350,20 +380,22 @@ struct
     else b.stop <- b.stop - 1
 
   let skip b len =
-    if len > length b then raise (Invalid_argument "BufferIO.skip");
+    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
+      then (print_endline "case B1"; b.start <- len-len_end)  (* wrap to the beginning *)
+      else (print_endline "case B2"; 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); \
+    (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 word"); (* big enough *) \
+    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))
   *)
@@ -376,36 +408,38 @@ struct
       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
-  *)
+(*$T
+ let s = Bytes.of_string "hello world" in \
+ 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")
+      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")
+      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")
+      raise (Invalid_argument ("CCRingBuffer.get_front: " ^ string_of_int i))
     else
       get b i
 
   let get_back b i =
     let offset = ((length b) - i - 1) in
       if offset < 0 then
-        raise (Invalid_argument "CCRingBuffer.get_back")
+        raise (Invalid_argument ("CCRingBuffer.get_back:" ^ string_of_int i))
       else get b offset
 
   let to_list b =
@@ -428,4 +462,3 @@ end
 module ByteBuffer = Make_array(Array.ByteArray)
 
 module Make(Elt:sig type t end) = Make_array(Array.Make(Elt))
-

From a2a6d282298e6a1096510f286a7775542471af9f Mon Sep 17 00:00:00 2001
From: carm <carmelo.piccione@gmail.com>
Date: Sun, 22 Feb 2015 18:28:45 -0500
Subject: [PATCH 50/72] blit into qtest

---
 src/data/CCRingBuffer.ml | 10 ++++++++++
 1 file changed, 10 insertions(+)

diff --git a/src/data/CCRingBuffer.ml b/src/data/CCRingBuffer.ml
index e3b2e806..3be95455 100644
--- a/src/data/CCRingBuffer.ml
+++ b/src/data/CCRingBuffer.ml
@@ -341,6 +341,16 @@ struct
       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;

From aecbbf0dcd9fe8509b5330c7490ee61ee37c6497 Mon Sep 17 00:00:00 2001
From: carm <carmelo.piccione@gmail.com>
Date: Sun, 22 Feb 2015 18:51:06 -0500
Subject: [PATCH 51/72] ringbuffer clear qtest

---
 src/data/CCRingBuffer.ml | 10 ++++++++++
 1 file changed, 10 insertions(+)

diff --git a/src/data/CCRingBuffer.ml b/src/data/CCRingBuffer.ml
index 3be95455..b68d803d 100644
--- a/src/data/CCRingBuffer.ml
+++ b/src/data/CCRingBuffer.ml
@@ -356,6 +356,16 @@ struct
     b.start <- 0;
     ()
 
+(*$T
+ let s = Bytes.of_string "hello world" in \
+ 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

From d8c2bd9da582a79857810a2e46348d0f0161cf25 Mon Sep 17 00:00:00 2001
From: carm <carmelo.piccione@gmail.com>
Date: Sun, 22 Feb 2015 18:53:16 -0500
Subject: [PATCH 52/72] ringbuffer reset qtest

---
 src/data/CCRingBuffer.ml | 10 ++++++++++
 1 file changed, 10 insertions(+)

diff --git a/src/data/CCRingBuffer.ml b/src/data/CCRingBuffer.ml
index b68d803d..2dae025a 100644
--- a/src/data/CCRingBuffer.ml
+++ b/src/data/CCRingBuffer.ml
@@ -370,6 +370,16 @@ struct
     clear b;
     b.buf <- Array.empty
 
+(*$T
+ let s = Bytes.of_string "hello world" in \
+ 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
 
   let take_front b =

From 9e0908dc2d23a213b74f0577885899910e1a7dec Mon Sep 17 00:00:00 2001
From: carm <carmelo.piccione@gmail.com>
Date: Sun, 22 Feb 2015 18:55:36 -0500
Subject: [PATCH 53/72] ringbuffer isempty qtest

---
 src/data/CCRingBuffer.ml | 10 ++++++++++
 1 file changed, 10 insertions(+)

diff --git a/src/data/CCRingBuffer.ml b/src/data/CCRingBuffer.ml
index 2dae025a..f044fb9d 100644
--- a/src/data/CCRingBuffer.ml
+++ b/src/data/CCRingBuffer.ml
@@ -382,6 +382,16 @@ struct
 
   let is_empty b = b.start = b.stop
 
+(*$T
+ let s = Bytes.of_string "hello world" in \
+ 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

From b57ca9d06a09a42604d8d6e0d19f16f2935c06ae Mon Sep 17 00:00:00 2001
From: carm <carmelo.piccione@gmail.com>
Date: Sun, 22 Feb 2015 19:18:14 -0500
Subject: [PATCH 54/72] fix to junk_back, take/junk qtests

---
 src/data/CCRingBuffer.ml | 38 +++++++++++++++++++++++++++++++++++++-
 1 file changed, 37 insertions(+), 1 deletion(-)

diff --git a/src/data/CCRingBuffer.ml b/src/data/CCRingBuffer.ml
index f044fb9d..3741ab0f 100644
--- a/src/data/CCRingBuffer.ml
+++ b/src/data/CCRingBuffer.ml
@@ -400,6 +400,15 @@ struct
     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
@@ -407,18 +416,45 @@ struct
     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 - 1 = 0
+    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));

From 420f7c6bccbe8fca0e937540482a459bcd7736bc Mon Sep 17 00:00:00 2001
From: carm <carmelo.piccione@gmail.com>
Date: Sun, 22 Feb 2015 19:52:15 -0500
Subject: [PATCH 55/72] fix to blit_from_bounded, several more qtests

---
 src/data/CCRingBuffer.ml | 65 +++++++++++++++++++++++++++++++++++-----
 1 file changed, 57 insertions(+), 8 deletions(-)

diff --git a/src/data/CCRingBuffer.ml b/src/data/CCRingBuffer.ml
index 3741ab0f..98303005 100644
--- a/src/data/CCRingBuffer.ml
+++ b/src/data/CCRingBuffer.ml
@@ -202,26 +202,75 @@ struct
   let copy b =
     { b with buf=Array.copy b.buf; }
 
-(*$T
-  let s = Bytes.of_string "hello world" in \
+(*$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
+  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 <= i)
+  *)
+
   (* resize [b] so that inner capacity is [cap] *)
   let resize b cap elem =
     assert (cap >= Array.length b.buf);
@@ -249,7 +298,7 @@ struct
         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 - length b >= len in 
+      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 " ^ 
@@ -273,7 +322,7 @@ struct
     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 
+    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 " ^ 
@@ -484,12 +533,12 @@ struct
       for i = 0 to b.stop - 1 do f i b.buf.(i) done;
     )
 
-(*$T
- let s = Bytes.of_string "hello world" in \
+(*$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
+ 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 =

From d66a5bc86f03ff1d0213fd7f41dc7b2945a1ca03 Mon Sep 17 00:00:00 2001
From: carm <carmelo.piccione@gmail.com>
Date: Sun, 22 Feb 2015 19:57:17 -0500
Subject: [PATCH 56/72] ringbuffer create qtest

---
 src/data/CCRingBuffer.ml | 16 ++++++++++++++++
 1 file changed, 16 insertions(+)

diff --git a/src/data/CCRingBuffer.ml b/src/data/CCRingBuffer.ml
index 98303005..77608728 100644
--- a/src/data/CCRingBuffer.ml
+++ b/src/data/CCRingBuffer.ml
@@ -199,6 +199,22 @@ struct
       buf = Array.empty
     }
 
+(*$Q
+  Q.small_int (fun i -> \
+  let i = abs i in \
+  let b = ByteBuffer.create i in \
+  let open ByteBuffer in \
+  b.size = i && b.bounded = false)
+  *)
+
+(*$Q
+  Q.small_int (fun i -> \
+  let i = abs i in \
+  let b = ByteBuffer.create ~bounded:true i in \
+  let open ByteBuffer in \
+  b.size = i && b.bounded = true)
+  *)
+
   let copy b =
     { b with buf=Array.copy b.buf; }
 

From ed126fa6bb3d2ffe5acd2527fd6674014980ee23 Mon Sep 17 00:00:00 2001
From: carm <carmelo.piccione@gmail.com>
Date: Sun, 22 Feb 2015 19:58:46 -0500
Subject: [PATCH 57/72] check for non-negative length

---
 src/data/CCRingBuffer.ml | 2 +-
 1 file changed, 1 insertion(+), 1 deletion(-)

diff --git a/src/data/CCRingBuffer.ml b/src/data/CCRingBuffer.ml
index 77608728..ba3fbc90 100644
--- a/src/data/CCRingBuffer.ml
+++ b/src/data/CCRingBuffer.ml
@@ -284,7 +284,7 @@ struct
   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 <= i)
+  ByteBuffer.length b >= 0 && ByteBuffer.length b <= i)
   *)
 
   (* resize [b] so that inner capacity is [cap] *)

From ec92dfaa94818bb3639b851ab47d561cb7e73809 Mon Sep 17 00:00:00 2001
From: carm <carmelo.piccione@gmail.com>
Date: Sun, 22 Feb 2015 20:01:47 -0500
Subject: [PATCH 58/72] remove debugging, better is_empty test

---
 src/data/CCRingBuffer.ml | 10 +++++-----
 1 file changed, 5 insertions(+), 5 deletions(-)

diff --git a/src/data/CCRingBuffer.ml b/src/data/CCRingBuffer.ml
index ba3fbc90..bdf27dde 100644
--- a/src/data/CCRingBuffer.ml
+++ b/src/data/CCRingBuffer.ml
@@ -447,13 +447,13 @@ struct
 
   let is_empty b = b.start = b.stop
 
-(*$T
- let s = Bytes.of_string "hello world" in \
+(*$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
+ ByteBuffer.is_empty b)
  *)
 
 
@@ -528,8 +528,8 @@ struct
     else
       let len_end = Array.length b.buf - b.start in
       if len > len_end
-      then (print_endline "case B1"; b.start <- len-len_end)  (* wrap to the beginning *)
-      else (print_endline "case B2"; b.start <- b.start + len)
+      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') -> \

From 356f6934dd21b6f505513e36ee2e33371158e0b0 Mon Sep 17 00:00:00 2001
From: carm <carmelo.piccione@gmail.com>
Date: Sun, 22 Feb 2015 20:10:16 -0500
Subject: [PATCH 59/72] ringbuffer get front/back qtests

---
 src/data/CCRingBuffer.ml | 24 ++++++++++++++++++++++++
 1 file changed, 24 insertions(+)

diff --git a/src/data/CCRingBuffer.ml b/src/data/CCRingBuffer.ml
index bdf27dde..5f218ea4 100644
--- a/src/data/CCRingBuffer.ml
+++ b/src/data/CCRingBuffer.ml
@@ -577,12 +577,36 @@ struct
     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 =

From 67eae77105856b43044089068729e74d28e4ed62 Mon Sep 17 00:00:00 2001
From: carm <carmelo.piccione@gmail.com>
Date: Sun, 22 Feb 2015 20:27:26 -0500
Subject: [PATCH 60/72] final set of qtests for ringbuffer

---
 src/data/CCRingBuffer.ml | 44 +++++++++++++++++++++++++++++++++++++++-
 1 file changed, 43 insertions(+), 1 deletion(-)

diff --git a/src/data/CCRingBuffer.ml b/src/data/CCRingBuffer.ml
index 5f218ea4..3dc37a1b 100644
--- a/src/data/CCRingBuffer.ml
+++ b/src/data/CCRingBuffer.ml
@@ -606,7 +606,6 @@ struct
  *)
 
 
-
   let to_list b =
     let len = length b in
     let rec build l i =
@@ -614,14 +613,57 @@ struct
       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)

From 7c0ed782e422847e6e5a19c0ebd1b5abe38ef48b Mon Sep 17 00:00:00 2001
From: carm <carmelo.piccione@gmail.com>
Date: Sun, 22 Feb 2015 20:29:13 -0500
Subject: [PATCH 61/72] make some tests more random

---
 src/data/CCRingBuffer.ml | 12 ++++++------
 1 file changed, 6 insertions(+), 6 deletions(-)

diff --git a/src/data/CCRingBuffer.ml b/src/data/CCRingBuffer.ml
index 3dc37a1b..dde33241 100644
--- a/src/data/CCRingBuffer.ml
+++ b/src/data/CCRingBuffer.ml
@@ -421,13 +421,13 @@ struct
     b.start <- 0;
     ()
 
-(*$T
- let s = Bytes.of_string "hello world" in \
+(*$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
+ ByteBuffer.length b = 0)
  *)
 
 
@@ -435,13 +435,13 @@ struct
     clear b;
     b.buf <- Array.empty
 
-(*$T
- let s = Bytes.of_string "hello world" in \
+(*$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
+ ByteBuffer.length b = 0 && ByteBuffer.capacity b = 0)
  *)
 
 

From 6f788d3a2a36537fc9f4c1806ca484d5e7ce2a5d Mon Sep 17 00:00:00 2001
From: carm <carmelo.piccione@gmail.com>
Date: Sun, 22 Feb 2015 21:03:16 -0500
Subject: [PATCH 62/72] ringbuffer doc updates

---
 src/data/CCRingBuffer.ml  |  2 +-
 src/data/CCRingBuffer.mli | 35 +++++++++++++++++++++++++++++++++--
 2 files changed, 34 insertions(+), 3 deletions(-)

diff --git a/src/data/CCRingBuffer.ml b/src/data/CCRingBuffer.ml
index dde33241..b1507052 100644
--- a/src/data/CCRingBuffer.ml
+++ b/src/data/CCRingBuffer.ml
@@ -2,7 +2,7 @@
  * CCRingBuffer - Polymorphic circular buffer with
  * deque semantics for accessing both the head and tail.
  *
- * Copyright (C) 2014 Simon Cruanes
+ * 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
diff --git a/src/data/CCRingBuffer.mli b/src/data/CCRingBuffer.mli
index 43b356db..100a15b8 100644
--- a/src/data/CCRingBuffer.mli
+++ b/src/data/CCRingBuffer.mli
@@ -1,6 +1,6 @@
 (**
  * CCRingBuffer - Polymorphic Circular Buffer
- * Copyright (C) 2014 Simon Cruanes
+ * 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
@@ -20,53 +20,82 @@
 
 (** Circular Polymorphic Buffer for IO *)
 
+(** 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
+    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 *)
@@ -74,6 +103,8 @@ sig
     bounded: bool;
     size : int
   }
+
+  (** Raised in querying functions when the buffer is empty *)
   exception Empty
 
   val create : ?bounded:bool -> int -> t

From 050514a32682e89630d4f816200957a12773960f Mon Sep 17 00:00:00 2001
From: Simon Cruanes <simon.cruanes.2007@m4x.org>
Date: Wed, 25 Feb 2015 19:22:09 +0100
Subject: [PATCH 63/72] change a bit the interface of CCRingBuffer,
 indentation, names

---
 src/data/CCRingBuffer.ml  | 584 +++++++++++++++++++-------------------
 src/data/CCRingBuffer.mli |  68 ++---
 2 files changed, 311 insertions(+), 341 deletions(-)

diff --git a/src/data/CCRingBuffer.ml b/src/data/CCRingBuffer.ml
index b1507052..afc518ac 100644
--- a/src/data/CCRingBuffer.ml
+++ b/src/data/CCRingBuffer.ml
@@ -23,83 +23,51 @@
 (** Polymorphic Circular Buffer for IO *)
 
 module Array = struct
-
+  (** The abstract type for arrays *)
   module type S = sig
+    (** The element type *)
     type elt
+
+    (** The type of an array instance *)
     type t
 
     val empty : t
+    (** The empty array *)
 
     val make: int -> elt -> t
+    (** [make s e] makes an array of size [s] with [e] elements *)
 
     val length: t -> int
+    (** [length t] gets the total number of elements currently in [t] *)
 
     val get: t -> int -> elt
+    (** [get t i] gets the element at position [i] *)
 
     val set: t -> int -> elt -> unit
+    (** [set t i e] sets the element at position [i] to [e] *)
 
     val sub: t -> int -> int -> t
+    (** [sub t i len] gets the subarray of [t] from
+        position [i] to [i + len] *)
 
     val copy : t -> t
+    (** [copy t] makes a fresh copy of the array [t] *)
 
     val blit : t -> int -> t -> int -> int -> unit
+    (** [blit t s arr i len] copies [len] elements from [arr] starting at [i]
+        to position [s] from [t] *)
 
     val iter : (elt -> unit) -> t -> unit
+    (** [iter f t] iterates over the array [t] invoking [f] with
+        the current element, in array order *)
   end
 
-  module ByteArray :
+  module Byte :
     S with type elt = char and type t = bytes = struct
     type elt = char
     include Bytes
   end
 
-  module FloatArray :
-    S with type elt = float and type t = float array = struct
-    type t = float array
-    type elt = float
-    let make = Array.make
-    let length = Array.length
-    let get = Array.get
-    let set = Array.set
-    let copy = Array.copy
-    let blit = Array.blit
-    let iter = Array.iter
-    let sub = Array.sub
-    let empty = Array.of_list []
-  end
-
-  module IntArray :
-    S with type elt = int and type t = int array = struct
-    type t = int array
-    type elt = int
-    let make = Array.make
-    let length = Array.length
-    let get = Array.get
-    let set = Array.set
-    let copy = Array.copy
-    let blit = Array.blit
-    let iter = Array.iter
-    let sub = Array.sub
-    let empty = Array.of_list []
-  end
-
-
-  module BoolArray :
-    S with type elt = bool and type t = bool array = struct
-    type t = bool array
-    type elt = bool
-    let make = Array.make
-    let length = Array.length
-    let get = Array.get
-    let set = Array.set
-    let copy = Array.copy
-    let blit = Array.blit
-    let iter = Array.iter
-    let sub = Array.sub
-    let empty = Array.of_list []
-  end
-
-
   module Make(Elt:sig type t end) :
     S with type elt = Elt.t and type t = Elt.t array = struct
     type elt = Elt.t
@@ -114,73 +82,115 @@ module Array = struct
     let sub = Array.sub
     let empty = Array.of_list []
   end
-
 end
 
-module type S =
-sig
-
+module type S = sig
+  (** The module type of Array for this ring buffer *)
   module Array : Array.S
 
-  type t = private {
-    mutable start : int;
-    mutable stop : int; (* excluded *)
-    mutable buf : Array.t;
-    bounded: bool;
-    size : int
-  }
+  (** Defines the ring buffer type, with both bounded and
+      unbounded flavors *)
+  type t
+
+  (** Raised in querying functions when the buffer is empty *)
   exception Empty
 
   val create : ?bounded:bool -> int -> t
+  (** [create ?bounded size] creates a new buffer with given size.
+      Defaults to [bounded=false]. *)
 
   val copy : t -> t
+  (** Make a fresh copy of the buffer. *)
 
   val capacity : t -> int
+  (** Length of the inner buffer. *)
 
   val max_capacity : t -> int option
+  (** Maximum length of the inner buffer, or [None] if unbounded. *)
 
   val length : t -> int
+  (** Number of elements currently stored in the buffer. *)
 
   val blit_from : t -> Array.t -> int -> int -> unit
+  (** [blit_from buf from_buf o len] copies the slice [o, ... o + len - 1] from
+      a input buffer [from_buf] to the end of the buffer.
+      @raise Invalid_argument if [o,len] is not a valid slice of [s] *)
 
   val blit_into : t ->  Array.t -> int -> int -> int
+  (** [blit_into buf to_buf o len] copies at most [len] elements from [buf]
+      into [to_buf] starting at offset [o] in [s].
+      @return the number of elements actually copied ([min len (length buf)]).
+      @raise Invalid_argument if [o,len] is not a valid slice of [s] *)
 
   val to_list : t -> Array.elt list
+  (** Extract the current content into a list *)
 
   val clear : t -> unit
+  (** Clear the content of the buffer. Doesn't actually destroy the content. *)
 
   val reset : t -> unit
+  (** Clear the content of the buffer, and also resize it to a default size *)
 
   val is_empty :t -> bool
+  (** Is the buffer empty (i.e. contains no elements)? *)
 
   val junk_front : t -> unit
+  (** Drop the front element from [t].
+      @raise Empty if the buffer is already empty. *)
 
   val junk_back : t -> unit
+  (** Drop the back element from [t].
+      @raise Empty if the buffer is already empty. *)
 
   val skip : t -> int -> unit
+  (** [skip b len] removes [len] elements from the front of [b].
+      @raise Invalid_argument if [len > length b]. *)
 
   val iteri : t -> (int -> Array.elt -> unit) -> unit
+  (** [iteri b f] calls [f i t] for each element [t] in [buf], with [i]
+      being its relative index within [buf]. *)
 
   val get_front : t -> int -> Array.elt
+  (** [get_front buf i] returns the [i]-th element of [buf] from the front, ie
+      the one returned by [take_front buf] after [i-1] calls to [junk_front buf].
+      @raise Invalid_argument if the index is invalid (> [length buf]) *)
 
   val get_back : t -> int -> Array.elt
+  (** [get_back buf i] returns the [i]-th element of [buf] from the back, ie
+      the one returned by [take_back buf] after [i-1] calls to [junk_back buf].
+      @raise Invalid_argument if the index is invalid (> [length buf]) *)
 
   val push_back : t -> Array.elt -> unit
+  (** Push value at the back of [t].
+      If [t.bounded=false], the buffer will grow as needed,
+      otherwise the oldest elements are replaced first. *)
 
   val peek_front : t -> Array.elt
+  (** First value from front of [t].
+      @raise Empty if buffer is empty. *)
 
   val peek_back : t -> Array.elt
+  (** Get the last value from back of [t].
+      @raise Empty if buffer is empty. *)
 
-  val take_back : t -> Array.elt
+  val take_back : t -> Array.elt option
+  (** Take the last value from back of [t], if any *)
 
-  val take_front : t -> Array.elt
+  val take_back_exn : t -> Array.elt
+  (** Take the last value from back of [t].
+      @raise Empty if buffer is already empty. *)
 
+  val take_front : t -> Array.elt option
+  (** Take the first value from front of [t], if any *)
+
+  val take_front_exn : t -> Array.elt
+  (** Take the first value from front of [t].
+      @raise Empty if buffer is already empty. *)
 end
 
-module Make_array(Array:Array.S) =
-struct
-
+module MakeFromArray(Array:Array.S) = struct
   module Array = Array
+
   type t = {
     mutable start : int;
     mutable stop : int; (* excluded *)
@@ -199,69 +209,53 @@ struct
       buf = Array.empty
     }
 
-(*$Q
-  Q.small_int (fun i -> \
-  let i = abs i in \
-  let b = ByteBuffer.create i in \
-  let open ByteBuffer in \
-  b.size = i && b.bounded = false)
-  *)
-
-(*$Q
-  Q.small_int (fun i -> \
-  let i = abs i in \
-  let b = ByteBuffer.create ~bounded:true i in \
-  let open ByteBuffer in \
-  b.size = i && b.bounded = true)
-  *)
-
   let copy b =
     { b with buf=Array.copy b.buf; }
 
-(*$Q
-  Q.printable_string (fun s -> \
-  let s_len = Bytes.length s in \
-  let b = ByteBuffer.create s_len in \
-  ByteBuffer.blit_from b s 0 s_len; \
-  let b' = ByteBuffer.copy b in \
-  try ByteBuffer.iteri b (fun i c -> if ByteBuffer.get_front b' i <> c then raise Exit); true with Exit -> false)
-*)
+  (*$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; \
+    let b' = Byte.copy b in \
+    try Byte.iteri b (fun i c -> if Byte.get_front b' i <> c then raise Exit); true with Exit -> false)
+  *)
 
   let capacity b =
     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.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; \
+    Byte.capacity b >= s_len)
   *)
 
-(*$Q
-  (Q.pair Q.small_int Q.printable_string) (fun (i, s) -> \
-  let i = abs i in \
-  let s_len = Bytes.length s in \
-  let b = ByteBuffer.create ~bounded:true i in \
-  ByteBuffer.blit_from b s 0 s_len; \
-  ByteBuffer.capacity b <= i)
+  (*$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 = Byte.create ~bounded:true i in \
+    Byte.blit_from b s 0 s_len; \
+    Byte.capacity b <= i)
   *)
 
   let max_capacity b = if b.bounded then Some b.size else None
 
-(*$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 = Byte.create i in \
+    Byte.max_capacity b = None)
   *)
 
-(*$Q
-  Q.small_int (fun i -> \
-  let i = abs i in \
-  let b = ByteBuffer.create ~bounded:true i in \
-  ByteBuffer.max_capacity b = Some i)
+  (*$Q
+    Q.small_int (fun i -> \
+    let i = abs i in \
+    let b = Byte.create ~bounded:true i in \
+    Byte.max_capacity b = Some i)
   *)
 
   let length b =
@@ -269,22 +263,22 @@ struct
     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 = Byte.create i in \
+    Byte.blit_from b s 0 s_len; \
+    Byte.length b = s_len)
   *)
 
-(*$Q
-  (Q.pair Q.small_int Q.printable_string) (fun (i, s) -> \
-  let i = abs i in \
-  let s_len = Bytes.length s in \
-  let b = ByteBuffer.create ~bounded:true i in \
-  ByteBuffer.blit_from b s 0 s_len; \
-  ByteBuffer.length b >= 0 && ByteBuffer.length b <= i)
+  (*$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 = Byte.create ~bounded:true i in \
+    Byte.blit_from b s 0 s_len; \
+    Byte.length b >= 0 && Byte.length b <= i)
   *)
 
   (* resize [b] so that inner capacity is [cap] *)
@@ -309,27 +303,21 @@ struct
   let blit_from_bounded b from_buf o len =
     let cap = capacity b - length b in
     (* resize if needed, with a constant to amortize *)
-    if cap < len then begin
+    if cap < len then (
       let new_size =
         let desired = Array.length b.buf + len + 24 in
         min (b.size+1) desired in
       resize b new_size from_buf.(0);
       let good = capacity b = b.size || capacity b - length b >= len in
-      if not good then begin 
-      print_endline ("capacity " ^ string_of_int (capacity b) ^ " and length " ^ 
-      string_of_int (length b) ^ " difference is less than " ^ 
-      string_of_int len ^ "!");assert(false) 
-      end;
-    end;
+      assert good;
+    );
     let sub = Array.sub from_buf o len in
     let iter x =
       let capacity = Array.length b.buf in
       Array.set b.buf b.stop x;
       if b.stop = capacity-1 then b.stop <- 0 else b.stop <- b.stop + 1;
       if b.start = b.stop then
-        begin
-          if b.start = capacity-1 then b.start <- 0 else b.start <- b.start + 1
-        end
+        if b.start = capacity-1 then b.start <- 0 else b.start <- b.start + 1
     in
     Array.iter iter sub
 
@@ -339,11 +327,7 @@ struct
     (* resize if needed, with a constant to amortize *)
     if cap < len then resize b (max (b.size+1) (Array.length b.buf + len + 24)) from_buf.(0);
     let good = capacity b - length b >= len in
-    if not good then begin 
-      print_endline ("capacity " ^ string_of_int (capacity b) ^ " and length " ^ 
-      string_of_int (length b) ^ " difference is less than " ^ 
-      string_of_int len ^ "!");assert(false) 
-    end;
+    assert good;
     if b.stop >= b.start
     then (*  [_______ start xxxxxxxxx stop ______] *)
       let len_end = Array.length b.buf - b.stop in
@@ -370,25 +354,25 @@ struct
 
   (*$Q
     (Q.pair Q.printable_string Q.printable_string) (fun (s,s') -> \
-    (let b = ByteBuffer.create 24 in \
-    ByteBuffer.blit_from b s 0 (Bytes.length s); \
-    ByteBuffer.blit_from b s' 0 (Bytes.length s'); \
-    ByteBuffer.length b = Bytes.length s + Bytes.length s'))
+    (let b = Byte.create 24 in \
+    Byte.blit_from b s 0 (Bytes.length s); \
+    Byte.blit_from b s' 0 (Bytes.length s'); \
+    Byte.length b = Bytes.length s + Bytes.length s'))
   *)
 
 
   (*$Q
     (Q.pair Q.printable_string Q.printable_string) (fun (s,s') -> \
-    (let b = ByteBuffer.create ~bounded:true (Bytes.length s + Bytes.length s') in \
-    ByteBuffer.blit_from b s 0 (Bytes.length s); \
-    ByteBuffer.blit_from b s' 0 (Bytes.length s'); \
-    ByteBuffer.length b = Bytes.length s + Bytes.length s'))
+    (let b = Byte.create ~bounded:true (Bytes.length s + Bytes.length s') in \
+    Byte.blit_from b s 0 (Bytes.length s); \
+    Byte.blit_from b s' 0 (Bytes.length s'); \
+    Byte.length b = Bytes.length s + Bytes.length s'))
   *)
 
 
   let blit_into b to_buf o len =
     if o+len > Array.length to_buf
-    then raise (Invalid_argument "BufferIO.blit_into");
+    then invalid_arg "RingBuffer.blit_into";
     if b.stop >= b.start
     then
       let n = min (b.stop - b.start) len in
@@ -408,10 +392,10 @@ struct
 
   (*$Q
     Q.printable_string (fun s -> \
-    let b = ByteBuffer.create (Bytes.length s) in \
-    ByteBuffer.blit_from b s 0 (Bytes.length s); \
+    let b = Byte.create (Bytes.length s) in \
+    Byte.blit_from b s 0 (Bytes.length s); \
     let to_buf = Bytes.create (Bytes.length s) in \
-    let len = ByteBuffer.blit_into b to_buf 0 (Bytes.length s) in \
+    let len = Byte.blit_into b to_buf 0 (Bytes.length s) in \
     to_buf = s && len = Bytes.length s)
   *)
 
@@ -421,43 +405,42 @@ struct
     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)
- *)
+  (*$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; \
+    Byte.clear b; \
+    Byte.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)
- *)
+  (*$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; \
+    Byte.reset b; \
+    Byte.length b = 0 && Byte.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)
- *)
+  (*$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; \
+    Byte.skip b s_len; \
+    Byte.is_empty b)
+  *)
 
-
-  let take_front b =
+  let take_front_exn b =
     if b.start = b.stop then raise Empty;
     let c = b.buf.(b.start) in
     if b.start + 1 = Array.length b.buf
@@ -465,30 +448,34 @@ struct
     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_front b = try Some (take_front_exn b) with Empty -> None
 
-  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.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 take_back b = try Some (take_back_exn b) with Empty -> None
+
+  (*$Q
+    Q.printable_string (fun s -> \
+    let s_len = Bytes.length s in \
+    let b = Byte.create s_len in \
+    Byte.blit_from b s 0 s_len; \
+    try let back = Byte.take_back_exn b in \
+    back = Bytes.get s (Bytes.length s - 1) with Byte.Empty -> s_len = 0)
+  *)
 
   let junk_front b =
     if b.start = b.stop then raise Empty;
@@ -496,14 +483,14 @@ struct
     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)
- *)
+  (*$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 () = Byte.junk_front b in \
+    s_len - 1 = Byte.length b with Byte.Empty -> s_len = 0)
+  *)
 
   let junk_back b =
     if b.start = b.stop then raise Empty;
@@ -511,18 +498,18 @@ struct
     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)
- *)
+  (*$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 () = Byte.junk_back b in \
+    s_len - 1 = Byte.length b with Byte.Empty -> s_len = 0)
+  *)
 
   let skip b len =
-    if len > length b then raise (Invalid_argument
-      ("CCRingBufferIO.skip: " ^ string_of_int len));
+    if len > length b then
+      invalid_arg ("CCRingRingBuffer.skip: " ^ string_of_int len);
     if b.stop >= b.start
     then b.start <- b.start + len
     else
@@ -533,12 +520,12 @@ struct
 
   (*$Q
     (Q.pair Q.printable_string Q.printable_string) (fun (s,s') -> \
-    (let b = ByteBuffer.create 24 in \
-    ByteBuffer.blit_from b s 0 (Bytes.length s); \
-    ByteBuffer.blit_from b s' 0 (Bytes.length s'); \
-    ByteBuffer.blit_from b "hello world" 0 (Bytes.length "hello world"); (* big enough *) \
-    let l = ByteBuffer.length b in let l' = l/2 in ByteBuffer.skip b l'; \
-    ByteBuffer.length b + l' = l))
+    (let b = Byte.create 24 in \
+    Byte.blit_from b s 0 (Bytes.length s); \
+    Byte.blit_from b s' 0 (Bytes.length s'); \
+    Byte.blit_from b "hello world" 0 (Bytes.length "hello world"); (* big enough *) \
+    let l = Byte.length b in let l' = l/2 in Byte.skip b l'; \
+    Byte.length b + l' = l))
   *)
 
   let iteri b f =
@@ -549,123 +536,122 @@ struct
       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)
-*)
+  (*$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 Byte.iteri b (fun i c -> if Byte.get_front b i <> c then raise Exit); true with Exit -> false)
+  *)
 
   let get b i =
     if b.stop >= b.start
     then
       if i >= b.stop - b.start
-      then raise (Invalid_argument ("CCRingBuffer.get:" ^ string_of_int i))
+      then invalid_arg ("CCRingBuffer.get:" ^ string_of_int i)
       else b.buf.(b.start + i)
     else
       let len_end = Array.length b.buf - b.start in
       if i < len_end
       then b.buf.(b.start + i)
       else if i - len_end > b.stop
-      then raise (Invalid_argument ("CCRingBuffer.get: " ^ string_of_int i))
+      then invalid_arg ("CCRingBuffer.get: " ^ string_of_int i)
       else b.buf.(i - len_end)
 
   let get_front b i =
     if is_empty b then
-      raise (Invalid_argument ("CCRingBuffer.get_front: " ^ string_of_int i))
+      invalid_arg ("CCRingBuffer.get_front: " ^ string_of_int i)
     else
       get b i
 
-(*$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)
- *)
+  (*$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 = Byte.create s_len in \
+    Byte.blit_from b s 0 s_len; \
+    let index = abs (i mod Byte.length b) in \
+    let front = Byte.get_front b index in \
+    front = Bytes.get s index)
+  *)
 
   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
+    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))
- *)
+  (*$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 = Byte.create s_len in \
+    Byte.blit_from b s 0 s_len; \
+    let index = abs (i mod Byte.length b) in \
+    let back = Byte.get_back b index in \
+    back = Bytes.get s (s_len - index - 1))
+  *)
 
 
   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 ((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)
- *)
+  (*$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; \
+    let l = Byte.to_list b in \
+    let explode s = let rec exp i l = \
+     if i < 0 then l else exp (i - 1) (s.[i] :: l) in \
+     exp (Bytes.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')
- *)
+  (*$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; \
+    Byte.push_back b 'X'; \
+    Byte.peek_back b = 'X')
+  *)
 
 
-  let peek_front b = if is_empty b then
-      raise Empty else Array.get b.buf b.start
-
-(*$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)
- *)
+  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 = 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
 
-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))
diff --git a/src/data/CCRingBuffer.mli b/src/data/CCRingBuffer.mli
index f98a712c..0d130540 100644
--- a/src/data/CCRingBuffer.mli
+++ b/src/data/CCRingBuffer.mli
@@ -26,13 +26,11 @@
     @since NEXT_RELEASE
 *)
 
-(** The array module, with optimized versions of [Byte], [Float], and
-    [Int], [Bool]. A [Make] functor is provided for polymorphic types. *)
+(** {2 Underlying Array} *)
+
+(** The abstract type for arrays *)
 module Array : sig
-
-  (** The abstract type for arrays *)
   module type S = sig
-
     (** The element type *)
     type elt
 
@@ -71,44 +69,25 @@ module Array : sig
   end
 
   (** Efficient array version for the [char] type *)
-  module ByteArray :
-    S with type elt = char and type t = bytes
-
-  (** Efficient array version for the [float] type *)
-  module FloatArray :
-    S with type elt = float and type t = float array
-
-  (** Efficient array version for the [int] type *)
-  module IntArray :
-    S with type elt = int and type t = int array
-
-  (** Efficient array version for the [bool] type *)
-  module BoolArray :
-    S with type elt = bool and type t = bool array
+  module Byte :
+    S with type elt = char and type t = Bytes.t
 
   (** Makes an array given an arbitrary element type *)
-  module Make :
-   functor (Elt:sig type t end) ->
-      S with type elt = Elt.t and type t = Elt.t array
+  module Make(Elt:sig type t end) :
+    S with type elt = Elt.t and type t = Elt.t array
 end
 
-(** The abstract ring buffer type, made concrete by choice of
-    [Array] module implementation *)
-module type S =
-sig
+(** {2 Ring Buffer}
 
+    The abstract ring buffer type, made concrete by choice of
+    [ARRAY] module implementation *)
+module type S = sig
   (** The module type of Array for this ring buffer *)
   module Array : Array.S
 
   (** Defines the ring buffer type, with both bounded and
       unbounded flavors *)
-  type t = private {
-    mutable start : int;
-    mutable stop : int; (* excluded *)
-    mutable buf : Array.t;
-    bounded: bool;
-    size : int
-  }
+  type t
 
   (** Raised in querying functions when the buffer is empty *)
   exception Empty
@@ -191,21 +170,26 @@ sig
   (** Get the last value from back of [t].
       @raise Empty if buffer is empty. *)
 
-  val take_back : t -> Array.elt
+  val take_back : t -> Array.elt option
+  (** Take the last value from back of [t], if any *)
+
+  val take_back_exn : t -> Array.elt
   (** Take the last value from back of [t].
       @raise Empty if buffer is already empty. *)
 
-  val take_front : t -> Array.elt
+  val take_front : t -> Array.elt option
+  (** Take the first value from front of [t], if any *)
+
+  val take_front_exn : t -> Array.elt
   (** Take the first value from front of [t].
       @raise Empty if buffer is already empty. *)
-
 end
 
-(** Makes a ring buffer module given array implementation *)
-module Make_array : functor (Array:Array.S) -> S with module Array = Array
-
 (** An efficient byte based ring buffer *)
-module ByteBuffer : S with module Array = Array.ByteArray
+module Byte : S with module Array = Array.Byte
 
-(** Makes a ring buffer module given the element type *)
-module Make: functor(Elt:sig type t end) -> S with module Array = Array.Make(Elt)
+(** Makes a ring buffer module with the given array type. *)
+module MakeFromArray(A : Array.S) : S with module Array = A
+
+(** Buffer using regular arrays *)
+module Make(X : sig type t end) : S with type Array.elt = X.t

From 14f593d246b749ff987eca534237e83ac1977083 Mon Sep 17 00:00:00 2001
From: Simon Cruanes <simon.cruanes.2007@m4x.org>
Date: Wed, 25 Feb 2015 21:58:34 +0100
Subject: [PATCH 64/72] wip: qtests for containers.lwt

---
 Makefile             | 17 ++++++++++++++++-
 _oasis               | 16 ++++++++++++++++
 src/lwt/lwt_klist.ml |  4 ++++
 3 files changed, 36 insertions(+), 1 deletion(-)

diff --git a/Makefile b/Makefile
index d2288b04..a7079cec 100644
--- a/Makefile
+++ b/Makefile
@@ -75,10 +75,16 @@ QTESTABLE=$(filter-out $(DONTTEST), \
 	$(wildcard src/bigarray/*.mli) \
 	)
 
+QTESTABLE_LWT=$(filter-out $(DONTTEST), \
+	$(wildcard src/lwt/*.ml) \
+	$(wildcard src/lwt/*.mli) \
+	)
+
 qtest-clean:
 	@rm -rf qtest/
 
 QTEST_PREAMBLE='open CCFun;; '
+QTEST_LWT_PREAMBLE=$(QTEST_PREAMBLE)
 
 #qtest-build: qtest-clean build
 #	@mkdir -p qtest
@@ -89,7 +95,7 @@ QTEST_PREAMBLE='open CCFun;; '
 #		-I core -I misc -I string \
 #		qtest/qtest_all.native
 
-qtest-gen: qtest-clean
+qtest-gen:
 	@mkdir -p qtest
 	@if which qtest > /dev/null ; then \
 		qtest extract --preamble $(QTEST_PREAMBLE) \
@@ -98,6 +104,15 @@ qtest-gen: qtest-clean
 	else touch qtest/run_qtest.ml ; \
 	fi
 
+qtest-lwt-gen:
+	@mkdir -p qtest/lwt/
+	@if which qtest > /dev/null ; then \
+		qtest extract --preamble $(QTEST_LWT_PREAMBLE) \
+			-o qtest/lwt/run_qtest_lwt.ml \
+			$(QTESTABLE_LWT) 2> /dev/null ; \
+	else touch qtest/lwt/run_qtest_lwt.ml ; \
+	fi
+
 push-stable:
 	git checkout stable
 	git merge master -m 'merge from master'
diff --git a/_oasis b/_oasis
index f3113494..9fc9f4aa 100644
--- a/_oasis
+++ b/_oasis
@@ -199,6 +199,18 @@ Executable run_qtest
                     containers.bigarray,
                     sequence, gen, oUnit, QTest2Lib
 
+PreBuildCommand: make qtest-lwt-gen
+
+Executable run_qtest_lwt
+  Path:             qtest/lwt/
+  Install:          false
+  CompiledObject:   best
+  MainIs:           run_qtest_lwt.ml
+  Build$:           flag(tests) && flag(lwt)
+  BuildDepends:     containers, containers.lwt, lwt, lwt.unix,
+                    sequence, gen, oUnit, QTest2Lib
+
+
 Executable run_tests
   Path: tests/
   Install: false
@@ -213,6 +225,10 @@ Test all
   TestTools:    run_tests, run_qtest
   Run$:         flag(tests) && flag(misc)
 
+Test lwt
+  Command:      echo "test lwt"; ./run_qtest_lwt.native
+  Run$:         flag(tests) && flag(lwt)
+
 Executable lambda
   Path: examples/
   Install: false
diff --git a/src/lwt/lwt_klist.ml b/src/lwt/lwt_klist.ml
index 59bba1d9..bf651830 100644
--- a/src/lwt/lwt_klist.ml
+++ b/src/lwt/lwt_klist.ml
@@ -212,3 +212,7 @@ let to_rev_list l =
 
 let to_list l = to_rev_list l >|= List.rev
 
+(*$Q
+  (Q.list Q.int) (fun l -> Lwt_main.run (of_list l |> to_list) = l)
+*)
+

From fe234e3dbade62e9ca0cd3331ed2cf060ab9fc5f Mon Sep 17 00:00:00 2001
From: Simon Cruanes <simon.cruanes.2007@m4x.org>
Date: Wed, 25 Feb 2015 22:52:13 +0100
Subject: [PATCH 65/72] containers.data now depends on bytes

---
 _oasis | 1 +
 1 file changed, 1 insertion(+)

diff --git a/_oasis b/_oasis
index 9fc9f4aa..bd53d0d1 100644
--- a/_oasis
+++ b/_oasis
@@ -71,6 +71,7 @@ Library "containers_data"
   Modules:          CCMultiMap, CCMultiSet, CCTrie, CCFlatHashtbl, CCCache,
                     CCPersistentHashtbl, CCDeque, CCFQueue, CCBV, CCMixtbl,
                     CCMixmap, CCRingBuffer
+  BuildDepends:     bytes
   FindlibParent:    containers
   FindlibName:      data
 

From 536f3152afa1928416fe6609173bece8316501e6 Mon Sep 17 00:00:00 2001
From: Simon Cruanes <simon.cruanes.2007@m4x.org>
Date: Wed, 25 Feb 2015 23:08:03 +0100
Subject: [PATCH 66/72] bugfix in CCRingBuffer (syntax?)

---
 src/data/CCRingBuffer.ml | 22 +++++++++-------------
 1 file changed, 9 insertions(+), 13 deletions(-)

diff --git a/src/data/CCRingBuffer.ml b/src/data/CCRingBuffer.ml
index afc518ac..ca6e7fdd 100644
--- a/src/data/CCRingBuffer.ml
+++ b/src/data/CCRingBuffer.ml
@@ -63,7 +63,7 @@ module Array = struct
   end
 
   module Byte :
-    S with type elt = char and type t = bytes = struct
+    S with type elt = char and type t = Bytes.t = struct
     type elt = char
     include Bytes
   end
@@ -286,18 +286,14 @@ module MakeFromArray(Array:Array.S) = struct
     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
+    if b.stop >= b.start
+    then
+      Array.blit b.buf b.start buf' 0 (b.stop - b.start)
+    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;
+    end;
     b.buf <- buf'
 
   let blit_from_bounded b from_buf o len =

From cf6d73099865463a297498f8313dfc4d8e768eea Mon Sep 17 00:00:00 2001
From: Simon Cruanes <simon.cruanes.2007@m4x.org>
Date: Wed, 25 Feb 2015 23:08:19 +0100
Subject: [PATCH 67/72] CCRingBuffer.append (simple implementation)

---
 src/data/CCRingBuffer.ml  | 28 +++++++++++++++++++++++-----
 src/data/CCRingBuffer.mli | 11 +++++++++--
 2 files changed, 32 insertions(+), 7 deletions(-)

diff --git a/src/data/CCRingBuffer.ml b/src/data/CCRingBuffer.ml
index ca6e7fdd..714b78d3 100644
--- a/src/data/CCRingBuffer.ml
+++ b/src/data/CCRingBuffer.ml
@@ -122,6 +122,10 @@ module type S = sig
       @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 append : t -> into:t -> unit
+  (** [append b ~into] copies all data from [b] and adds it at the
+      end of [into] *)
+
   val to_list : t -> Array.elt list
   (** Extract the current content into a list *)
 
@@ -146,8 +150,11 @@ module type S = sig
   (** [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]
+  val iter : t -> f:(Array.elt -> unit) -> unit
+  (** [iter b ~f] calls [f i t] for each element [t] in [buf] *)
+
+  val iteri : t -> f:(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
@@ -395,7 +402,6 @@ module MakeFromArray(Array:Array.S) = struct
     to_buf = s && len = Bytes.length s)
   *)
 
-
   let clear b =
     b.stop <- 0;
     b.start <- 0;
@@ -524,7 +530,15 @@ module MakeFromArray(Array:Array.S) = struct
     Byte.length b + l' = l))
   *)
 
-  let iteri b f =
+  let iter b ~f =
+    if b.stop >= b.start
+    then for i = b.start to b.stop - 1 do f b.buf.(i) done
+    else (
+      for i = b.start to Array.length b.buf -1 do f b.buf.(i) done;
+      for i = 0 to b.stop - 1 do f b.buf.(i) done;
+    )
+
+  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 (
@@ -537,7 +551,8 @@ module MakeFromArray(Array:Array.S) = struct
     let s_len = Bytes.length s in \
     let b = Byte.create s_len in \
     Byte.blit_from b s 0 s_len; \
-    try Byte.iteri b (fun i c -> if Byte.get_front b i <> c then raise Exit); true with Exit -> false)
+    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 =
@@ -619,6 +634,9 @@ module MakeFromArray(Array:Array.S) = struct
     Byte.peek_back b = 'X')
   *)
 
+  (* TODO: more efficient version *)
+  let append b ~into =
+    iter b ~f:(push_back into)
 
   let peek_front b =
     if is_empty b then raise Empty
diff --git a/src/data/CCRingBuffer.mli b/src/data/CCRingBuffer.mli
index 0d130540..313da6a0 100644
--- a/src/data/CCRingBuffer.mli
+++ b/src/data/CCRingBuffer.mli
@@ -119,6 +119,10 @@ module type S = sig
       @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 append : t -> into:t -> unit
+  (** [append b ~into] copies all data from [b] and adds it at the
+      end of [into] *)
+
   val to_list : t -> Array.elt list
   (** Extract the current content into a list *)
 
@@ -143,8 +147,11 @@ module type S = sig
   (** [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]
+  val iter : t -> f:(Array.elt -> unit) -> unit
+  (** [iter b ~f] calls [f i t] for each element [t] in [buf] *)
+
+  val iteri : t -> f:(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

From fa09029e8a6f2285fe37287c721d77f8719d4592 Mon Sep 17 00:00:00 2001
From: Simon Cruanes <simon.cruanes.2007@m4x.org>
Date: Thu, 26 Feb 2015 16:20:23 +0100
Subject: [PATCH 68/72] Lwt_pipe.Reader: more combinators

---
 src/lwt/lwt_pipe.ml  | 31 +++++++++++++++++++++++++++++++
 src/lwt/lwt_pipe.mli | 12 +++++++++---
 2 files changed, 40 insertions(+), 3 deletions(-)

diff --git a/src/lwt/lwt_pipe.ml b/src/lwt/lwt_pipe.ml
index b7c24a17..36af2b1f 100644
--- a/src/lwt/lwt_pipe.ml
+++ b/src/lwt/lwt_pipe.ml
@@ -27,6 +27,7 @@ OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
 type 'a or_error = [`Ok of 'a | `Error of string]
 type 'a step = ['a or_error | `End]
 
+let (>|=) = Lwt.(>|=)
 let (>>=) = Lwt.(>>=)
 
 module LwtErr = struct
@@ -240,6 +241,28 @@ module Reader = struct
     keep b (fwd());
     b
 
+  let map_s ~f a =
+    let b = create () in
+    let rec fwd () =
+      read a >>= function
+      | `Ok x -> f x >>= fun y -> write_step b (`Ok y) >>= fwd
+      | (`Error _) as e -> write_step b e >>= fun _ -> close b
+      | `End -> close b
+    in
+    keep b (fwd());
+    b
+
+  let filter ~f a =
+    let b = create () in
+    let rec fwd () =
+      read a >>= function
+      | `Ok x -> if f x then write_step b (`Ok x) >>= fwd else fwd()
+      | (`Error _) as e -> write_step b e >>= fun _ -> close b
+      | `End -> close b
+    in
+    keep b (fwd());
+    b
+
   let filter_map ~f a =
     let b = create () in
     let rec fwd () =
@@ -280,6 +303,14 @@ module Reader = struct
     | `Error msg -> LwtErr.fail msg
     | `Ok x -> f x >>= fun () -> iter_s ~f t
 
+  let iter_p ~f t =
+    let rec iter acc =
+      read t >>= function
+      | `End -> Lwt.join acc >|= fun () -> `Ok ()
+      | `Error msg -> LwtErr.fail msg
+      | `Ok x -> iter (f x :: acc)
+    in iter []
+
   let merge_all l =
     if l = [] then invalid_arg "merge_all";
     let res = create () in
diff --git a/src/lwt/lwt_pipe.mli b/src/lwt/lwt_pipe.mli
index efcd0bee..63bcbeb7 100644
--- a/src/lwt/lwt_pipe.mli
+++ b/src/lwt/lwt_pipe.mli
@@ -140,16 +140,22 @@ module Reader : sig
 
   val map : f:('a -> 'b) -> ('a, [>`r]) pipe -> 'b t
 
-  val filter_map : f:('a -> 'b option) -> 'a t -> 'b t
+  val map_s : f:('a -> 'b Lwt.t) -> ('a, [>`r]) pipe -> 'b t
 
-  val fold : f:('acc -> 'a -> 'acc) -> x:'acc -> 'a t -> 'acc LwtErr.t
+  val filter : f:('a -> bool) -> ('a, [>`r]) pipe -> 'a t
 
-  val fold_s : f:('acc -> 'a -> 'acc Lwt.t) -> x:'acc -> 'a t -> 'acc LwtErr.t
+  val filter_map : f:('a -> 'b option) -> ('a, [>`r]) pipe -> 'b t
+
+  val fold : f:('acc -> 'a -> 'acc) -> x:'acc -> ('a, [>`r]) pipe -> 'acc LwtErr.t
+
+  val fold_s : f:('acc -> 'a -> 'acc Lwt.t) -> x:'acc -> ('a, [>`r]) pipe -> 'acc LwtErr.t
 
   val iter : f:('a -> unit) -> 'a t -> unit LwtErr.t
 
   val iter_s : f:('a -> unit Lwt.t) -> 'a t -> unit LwtErr.t
 
+  val iter_p : f:('a -> unit Lwt.t) -> 'a t -> unit LwtErr.t
+
   val merge_both : 'a t -> 'a t -> 'a t
   (** Merge the two input streams in a non-specified order *)
 

From 45a35aa646ab07b8f6eaa08ed369474ad7cd4dbb Mon Sep 17 00:00:00 2001
From: Simon Cruanes <simon.cruanes.2007@m4x.org>
Date: Fri, 27 Feb 2015 13:42:07 +0100
Subject: [PATCH 69/72] fix in oasis

---
 _oasis | 4 +---
 1 file changed, 1 insertion(+), 3 deletions(-)

diff --git a/_oasis b/_oasis
index bd53d0d1..b4aa18f5 100644
--- a/_oasis
+++ b/_oasis
@@ -187,7 +187,7 @@ Test future
   TestTools:    run_test_future
   Run$:         flag(tests) && flag(thread)
 
-PreBuildCommand: make qtest-gen
+PreBuildCommand: make qtest-gen ; make qtest-lwt-gen
 
 Executable run_qtest
   Path:             qtest/
@@ -200,8 +200,6 @@ Executable run_qtest
                     containers.bigarray,
                     sequence, gen, oUnit, QTest2Lib
 
-PreBuildCommand: make qtest-lwt-gen
-
 Executable run_qtest_lwt
   Path:             qtest/lwt/
   Install:          false

From 125484a9c4d65f081fa7a15fb2d7d1ed74f39f18 Mon Sep 17 00:00:00 2001
From: Simon Cruanes <simon.cruanes.2007@m4x.org>
Date: Fri, 27 Feb 2015 14:30:59 +0100
Subject: [PATCH 70/72] add Float, Ref, Set, Format to CCPervasives

---
 src/pervasives/CCPervasives.ml | 8 ++++++++
 1 file changed, 8 insertions(+)

diff --git a/src/pervasives/CCPervasives.ml b/src/pervasives/CCPervasives.ml
index 13228ed0..96410c18 100644
--- a/src/pervasives/CCPervasives.ml
+++ b/src/pervasives/CCPervasives.ml
@@ -48,7 +48,13 @@ module Array = struct
 end
 module Bool = CCBool
 module Error = CCError
+module Float = CCFloat
+module Format = struct
+  include Format
+  include CCFormat
+end
 module Fun = CCFun
+module Hash = CCHash
 module Int = CCInt
 (* FIXME
 module Hashtbl = struct
@@ -72,6 +78,8 @@ module Random = struct
   include Random
   include CCRandom
 end
+module Ref = CCRef
+module Set = CCSet
 module String = struct
   include String
   include CCString

From c5354c792e3686bc7b5746ecb3f152c1424b639b Mon Sep 17 00:00:00 2001
From: Simon Cruanes <simon.cruanes.2007@m4x.org>
Date: Fri, 27 Feb 2015 14:31:17 +0100
Subject: [PATCH 71/72] some "status: experimental" annotations on new modules

---
 src/data/CCMixmap.mli     | 2 ++
 src/data/CCRingBuffer.mli | 2 ++
 src/lwt/lwt_klist.mli     | 2 ++
 src/lwt/lwt_pipe.mli      | 2 ++
 4 files changed, 8 insertions(+)

diff --git a/src/data/CCMixmap.mli b/src/data/CCMixmap.mli
index 3cc1e9d7..3be7ea81 100644
--- a/src/data/CCMixmap.mli
+++ b/src/data/CCMixmap.mli
@@ -25,6 +25,8 @@ OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
 
 (** {1 Maps with Heterogeneous Values}
 
+{b status: experimental}
+
 @since NEXT_RELEASE *)
 
 type 'a injection
diff --git a/src/data/CCRingBuffer.mli b/src/data/CCRingBuffer.mli
index 313da6a0..c90a07c9 100644
--- a/src/data/CCRingBuffer.mli
+++ b/src/data/CCRingBuffer.mli
@@ -23,6 +23,8 @@
     Useful for IO, or as a general-purpose alternative to {!Queue} when
     batch operations are needed.
 
+    {b status: experimental}
+
     @since NEXT_RELEASE
 *)
 
diff --git a/src/lwt/lwt_klist.mli b/src/lwt/lwt_klist.mli
index 8f94fbbe..2e7ab8ea 100644
--- a/src/lwt/lwt_klist.mli
+++ b/src/lwt/lwt_klist.mli
@@ -30,6 +30,8 @@ Functional streams, that is, lazy lists whose nodes are behind a
 Lwt.t future. Such as list never mutates, it can be safely traversed
 several times, but might eat memory.
 
+{b status: experimental}
+
 @since NEXT_RELEASE *)
 
 type 'a t = [ `Nil | `Cons of 'a * 'a t ] Lwt.t
diff --git a/src/lwt/lwt_pipe.mli b/src/lwt/lwt_pipe.mli
index 63bcbeb7..b9f5dfa5 100644
--- a/src/lwt/lwt_pipe.mli
+++ b/src/lwt/lwt_pipe.mli
@@ -50,6 +50,8 @@ Lwt_io.with_file ~mode:Lwt_io.output "/tmp/foo"
   );;
 ]}
 
+{b status: experimental}
+
 @since NEXT_RELEASE
 *)
 

From 95295b834cc729a2d1060b3502836ed043baa9e8 Mon Sep 17 00:00:00 2001
From: Simon Cruanes <simon.cruanes.2007@m4x.org>
Date: Fri, 27 Feb 2015 14:39:58 +0100
Subject: [PATCH 72/72] version 0.9

---
 CHANGELOG.md              | 20 ++++++++++++++++++++
 _oasis                    |  2 +-
 src/core/CCRef.ml         |  2 +-
 src/core/CCRef.mli        |  2 +-
 src/core/CCSet.mli        |  2 +-
 src/data/CCMixmap.mli     |  2 +-
 src/data/CCRingBuffer.mli |  2 +-
 src/iter/CCKTree.mli      |  2 +-
 src/lwt/lwt_klist.mli     |  2 +-
 src/lwt/lwt_pipe.mli      |  2 +-
 10 files changed, 29 insertions(+), 9 deletions(-)

diff --git a/CHANGELOG.md b/CHANGELOG.md
index 87f5dcbe..c05947a4 100644
--- a/CHANGELOG.md
+++ b/CHANGELOG.md
@@ -1,5 +1,25 @@
 # Changelog
 
+## 0.9
+
+- add `Float`, `Ref`, `Set`, `Format` to `CCPervasives`
+- `CCRingBuffer.append` (simple implementation)
+- `containers.data` now depends on bytes
+- new `CCRingBuffer` module, imperative deque with batch (blit) operations,
+  mostly done by Carmelo Piccione
+- new `Lwt_pipe` and `Lwt_klist` streams for Lwt, respectively (un)bounded
+  synchronized queues and lazy lists
+- `CCKTree.print`, a simple S-expressions printer for generic trees
+- Add `CCMixmap` in containers.data (close #40), functional alternative to `CCMixtbl`
+- remove old META file
+- simplified `CCTrie` implementation
+- use "compiledObject: best" in `_oasis` for binaries
+- document some invariants in `CCCache` (see #38)
+- tests for `CCCache.lru`
+- fix `CCFormat.seq` combinator
+- add `CCSet` module in core/
+- add `CCRef` module in core/
+
 ## 0.8
 
 - add `@Emm` to authors
diff --git a/_oasis b/_oasis
index b4aa18f5..78f4d98b 100644
--- a/_oasis
+++ b/_oasis
@@ -1,6 +1,6 @@
 OASISFormat: 0.4
 Name:        containers
-Version:     0.8
+Version:     0.9
 Homepage:    https://github.com/c-cube/ocaml-containers
 Authors:     Simon Cruanes
 License:     BSD-2-clause
diff --git a/src/core/CCRef.ml b/src/core/CCRef.ml
index a0f74d70..e3965765 100644
--- a/src/core/CCRef.ml
+++ b/src/core/CCRef.ml
@@ -26,7 +26,7 @@ OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
 
 (** {1 References}
 
-@since NEXT_RELEASE *)
+@since 0.9 *)
 
 type 'a print = Format.formatter -> 'a -> unit
 type 'a pp = Buffer.t -> 'a -> unit
diff --git a/src/core/CCRef.mli b/src/core/CCRef.mli
index e0d74cd6..35694e7e 100644
--- a/src/core/CCRef.mli
+++ b/src/core/CCRef.mli
@@ -25,7 +25,7 @@ OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
 *)
 
 (** {1 References}
-@since NEXT_RELEASE *)
+@since 0.9 *)
 
 type 'a print = Format.formatter -> 'a -> unit
 type 'a pp = Buffer.t -> 'a -> unit
diff --git a/src/core/CCSet.mli b/src/core/CCSet.mli
index 62bdd9fe..a9b1912a 100644
--- a/src/core/CCSet.mli
+++ b/src/core/CCSet.mli
@@ -26,7 +26,7 @@ OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
 
 (** {1 Wrapper around Set}
 
-@since NEXT_RELEASE *)
+@since 0.9 *)
 
 type 'a sequence = ('a -> unit) -> unit
 type 'a printer = Buffer.t -> 'a -> unit
diff --git a/src/data/CCMixmap.mli b/src/data/CCMixmap.mli
index 3be7ea81..c7adfe68 100644
--- a/src/data/CCMixmap.mli
+++ b/src/data/CCMixmap.mli
@@ -27,7 +27,7 @@ OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
 
 {b status: experimental}
 
-@since NEXT_RELEASE *)
+@since 0.9 *)
 
 type 'a injection
 (** An accessor for values of type 'a in any map. Values put
diff --git a/src/data/CCRingBuffer.mli b/src/data/CCRingBuffer.mli
index c90a07c9..7eadba09 100644
--- a/src/data/CCRingBuffer.mli
+++ b/src/data/CCRingBuffer.mli
@@ -25,7 +25,7 @@
 
     {b status: experimental}
 
-    @since NEXT_RELEASE
+    @since 0.9
 *)
 
 (** {2 Underlying Array} *)
diff --git a/src/iter/CCKTree.mli b/src/iter/CCKTree.mli
index 7b773ef3..30916abf 100644
--- a/src/iter/CCKTree.mli
+++ b/src/iter/CCKTree.mli
@@ -118,7 +118,7 @@ Example (tree of calls for naive Fibonacci function):
 val print : 'a formatter -> 'a t formatter
 (** A pretty-printer using S-expressions and boxes to render the tree.
     Empty nodes are not rendered; sharing is ignored.
-    @since NEXT_RELEASE *)
+    @since 0.9 *)
 
 (** {2 Pretty printing in the DOT (graphviz) format} *)
 
diff --git a/src/lwt/lwt_klist.mli b/src/lwt/lwt_klist.mli
index 2e7ab8ea..abc62b9b 100644
--- a/src/lwt/lwt_klist.mli
+++ b/src/lwt/lwt_klist.mli
@@ -32,7 +32,7 @@ several times, but might eat memory.
 
 {b status: experimental}
 
-@since NEXT_RELEASE *)
+@since 0.9 *)
 
 type 'a t = [ `Nil | `Cons of 'a * 'a t ] Lwt.t
 type 'a stream = 'a t
diff --git a/src/lwt/lwt_pipe.mli b/src/lwt/lwt_pipe.mli
index b9f5dfa5..46702c78 100644
--- a/src/lwt/lwt_pipe.mli
+++ b/src/lwt/lwt_pipe.mli
@@ -52,7 +52,7 @@ Lwt_io.with_file ~mode:Lwt_io.output "/tmp/foo"
 
 {b status: experimental}
 
-@since NEXT_RELEASE
+@since 0.9
 *)
 
 type 'a or_error = [`Ok of 'a | `Error of string]