From 79d57b6e2cd91329d442a95a31ebac7d88e68001 Mon Sep 17 00:00:00 2001
From: Simon Cruanes <simon.cruanes.2007@m4x.org>
Date: Mon, 7 Sep 2015 23:42:00 +0200
Subject: [PATCH] add tests and functions to `CCRAL`

---
 src/data/CCIntMap.ml |   3 -
 src/data/CCRAL.ml    | 149 ++++++++++++++++++++++++++++++++++---------
 src/data/CCRAL.mli   | 122 ++++++++++++++++++++---------------
 3 files changed, 191 insertions(+), 83 deletions(-)

diff --git a/src/data/CCIntMap.ml b/src/data/CCIntMap.ml
index 1a0b26f7..7e49c28f 100644
--- a/src/data/CCIntMap.ml
+++ b/src/data/CCIntMap.ml
@@ -288,7 +288,6 @@ let choose t =
   try Some (choose_exn t)
   with Not_found -> None
 
-(* TODO fix *)
 let rec union f t1 t2 = match t1, t2 with
   | E, o | o, E -> o
   | L (k, v), o
@@ -385,8 +384,6 @@ let rec inter f a b = match a, b with
 *)
 
 
-(* TODO: write tests *)
-
 (** {2 Whole-collection operations} *)
 
 type 'a sequence = ('a -> unit) -> unit
diff --git a/src/data/CCRAL.ml b/src/data/CCRAL.ml
index fb60a965..fcdc13b5 100644
--- a/src/data/CCRAL.ml
+++ b/src/data/CCRAL.ml
@@ -1,27 +1,5 @@
-(*
-Copyright (c) 2013, 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.
-*)
+(* This file is free software, part of containers. See file "license" for more details. *)
 
 (** {1 Random-Access Lists} *)
 
@@ -79,10 +57,12 @@ let rec set l i v = match l with
   | Cons (size,t, l') when i < size -> Cons (size, tree_update size t i v, l')
   | Cons (size,t, l') -> Cons (size, t, set l' (i - size) v)
 
-(*$Q
-   Q.(pair (pair int int) (list int)) (fun ((i,v),l) -> \
-    let ral = of_list l in let ral = set ral i v in \
-    get ral i = v)
+(*$Q & ~small:(CCFun.compose snd List.length)
+   Q.(pair (pair small_int int) (list int)) (fun ((i,v),l) -> \
+    l=[] ||  \
+      (let i = (abs i) mod (List.length l) in \
+      let ral = of_list l in let ral = set ral i v in \
+      get ral i = v))
 *)
 
 let cons x l = match l with
@@ -166,7 +146,7 @@ and fold_tree t acc f = match t with
 
 let rec fold_rev f acc l = match l with
   | Nil -> acc
-  | Cons (_, Leaf x, l') -> f (fold f acc l') x
+  | Cons (_, Leaf x, l') -> f (fold_rev f acc l') x
   | Cons (_, t, l') ->
     let acc = fold_rev f acc l' in
     fold_tree_rev t acc f
@@ -179,7 +159,101 @@ and fold_tree_rev t acc f = match t with
 
 let append l1 l2 = fold_rev (fun l2 x -> cons x l2) l2 l1
 
-let of_list l = List.fold_right cons l empty
+(*$Q & ~small:(CCPair.merge (CCFun.compose_binop List.length (+)))
+  Q.(pair (list int) (list int)) (fun (l1,l2) -> \
+    append (of_list l1) (of_list l2) = of_list (l1 @ l2))
+*)
+
+let filter p l = fold_rev (fun acc x -> if p x then cons x acc else acc) empty l
+
+let filter_map f l =
+  fold_rev
+    (fun acc x -> match f x with
+      | None -> acc
+      | Some y -> cons y acc
+    ) empty l
+
+(*$T
+  of_list [1;2;3;4;5;6] |> filter (fun x -> x mod 2=0) |> to_list = [2;4;6]
+*)
+
+let flat_map f l =
+  fold_rev
+    (fun acc x ->
+      let l = f x in
+      append l acc
+    ) empty l
+
+let flatten l = fold_rev (fun acc l -> append l acc) empty l
+
+(*$T
+  flatten (of_list [of_list [1]; of_list []; of_list [2;3]]) = \
+    of_list [1;2;3;]
+*)
+
+(** {2 Conversions} *)
+
+type 'a sequence = ('a -> unit) -> unit
+type 'a gen = unit -> 'a option
+
+let add_list l l2 = List.fold_left (fun acc x -> cons x acc) l (List.rev l2)
+
+(*$Q & ~small:(CCPair.merge (CCFun.compose_binop List.length (+)))
+  Q.(pair (list small_int) (list small_int)) (fun (l1,l2) -> \
+    add_list (of_list l2) l1 |> to_list = l1 @ l2)
+*)
+
+let of_list l = add_list empty l
+
+let to_list l = fold_rev (fun acc x -> x :: acc) [] l
+
+(*$Q
+  Q.(list int) (fun l -> to_list (of_list l) = l)
+  *)
+
+let add_seq l s =
+  let l1 = ref empty in
+  s (fun x -> l1 := cons x !l1);
+  fold_rev (fun acc x -> cons x acc) l !l1
+
+let of_seq s = add_seq empty s
+
+let to_seq l yield = iter yield l
+
+let rec gen_iter_ f g = match g() with
+  | None -> ()
+  | Some x -> f x; gen_iter_ f g
+
+let add_gen l g =
+  let l1 = ref empty in
+  gen_iter_ (fun x -> l1 := cons x !l1) g;
+  fold_rev (fun acc x -> cons x acc) l !l1
+
+let of_gen g = add_gen empty g
+
+let to_gen l =
+  let st = Stack.create() in (* stack for tree *)
+  let l = ref l in (* tail of list *)
+  let rec next () =
+    if Stack.is_empty st
+    then match !l with
+    | Nil -> None
+    | Cons (_, t, tl) ->
+        l := tl;
+        Stack.push t st;
+        next()
+    else match Stack.pop st with
+      | Leaf x -> Some x
+      | Node (x, l, r) ->
+          Stack.push r st;
+          Stack.push l st;
+          Some x
+  in
+  next
+
+(*$Q
+  Q.(list int) (fun l -> of_list l |> to_gen |> Gen.to_list = l)
+*)
 
 let rec of_list_map f l = match l with
   | [] -> empty
@@ -187,4 +261,19 @@ let rec of_list_map f l = match l with
       let y = f x in
       cons y (of_list_map f l')
 
-let to_list l = List.rev (fold (fun l x -> x :: l) [] l)
+(** {2 IO} *)
+
+type 'a printer = Format.formatter -> 'a -> unit
+
+let print ?(sep=", ") pp_item fmt l =
+  let first = ref true in
+  iter
+    (fun x ->
+      if !first then first := false else (
+        Format.pp_print_string fmt sep;
+        Format.pp_print_cut fmt ();
+      );
+      pp_item fmt x
+    ) l;
+  ()
+
diff --git a/src/data/CCRAL.mli b/src/data/CCRAL.mli
index daca6d0b..95c790ae 100644
--- a/src/data/CCRAL.mli
+++ b/src/data/CCRAL.mli
@@ -1,95 +1,117 @@
-(*
-Copyright (c) 2013, 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:
+(* This file is free software, part of containers. See file "license" for more details. *)
 
-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.
+(** {1 Random-Access Lists}
 
-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 Random-Access Lists} *)
-
-(** This is an OCaml implementation of Okasaki's paper
+    This is an OCaml implementation of Okasaki's paper
     "Purely Functional Random Access Lists". It defines a list-like data
     structure with O(1) cons/tail operations, and O(log(n)) lookup/modification
     operations.
+
+    This module used to be part of [containers.misc]
+
+    {b status: stable}
+
+    @since NEXT_RELEASE
 *)
 
 type +'a t
-  (** List containing elements of type 'a *)
+(** List containing elements of type 'a *)
 
 val empty : 'a t
-  (** Empty list *)
+(** Empty list *)
 
 val is_empty : _ t -> bool
-  (** Check whether the list is empty *)
+(** Check whether the list is empty *)
 
 val cons : 'a -> 'a t -> 'a t
-  (** Add an element at the front of the list *)
+(** Add an element at the front of the list *)
 
 val return : 'a -> 'a t
 
 val map : ('a -> 'b) -> 'a t -> 'b t
-  (** Map on elements *)
+(** Map on elements *)
 
 val hd : 'a t -> 'a
-  (** First element of the list, or
-      @raise Invalid_argument if the list is empty *)
+(** First element of the list, or
+    @raise Invalid_argument if the list is empty *)
 
 val tl : 'a t -> 'a t
-  (** Remove the first element from the list,
-      or @raise Invalid_argument if the list is empty *)
+(** Remove the first element from the list, or
+    @raise Invalid_argument if the list is empty *)
 
 val front : 'a t -> ('a * 'a t) option
-  (** Remove and return the first element of the list *)
+(** Remove and return the first element of the list *)
 
 val front_exn : 'a t -> 'a * 'a t
-  (** Unsafe version of {!front}.
-      @raise Invalid_argument if the list is empty *)
+(** Unsafe version of {!front}.
+    @raise Invalid_argument if the list is empty *)
 
 val length : 'a t -> int
-  (** Number of elements *)
+(** Number of elements *)
 
 val get : 'a t -> int -> 'a
-  (** [get l i] accesses the [i]-th element of the list. O(log(n)).
-      @raise Invalid_argument if the list has less than [i+1] elements. *)
+(** [get l i] accesses the [i]-th element of the list. O(log(n)).
+    @raise Invalid_argument if the list has less than [i+1] elements. *)
 
 val set : 'a t -> int -> 'a -> 'a t
-  (** [set l i v] sets the [i]-th element of the list to [v]. O(log(n)).
-      @raise Invalid_argument if the list has less than [i+1] elements. *)
+(** [set l i v] sets the [i]-th element of the list to [v]. O(log(n)).
+    @raise Invalid_argument if the list has less than [i+1] elements. *)
 
 val remove : 'a t -> int -> 'a t
-  (** [remove l i] removes the [i]-th element of [v].
-      @raise Invalid_argument if the list has less than [i+1] elements. *)
+(** [remove l i] removes the [i]-th element of [v].
+    @raise Invalid_argument if the list has less than [i+1] elements. *)
 
 val append : 'a t -> 'a t -> 'a t
 
+val filter : ('a -> bool) -> 'a t -> 'a t
+
+val filter_map : ('a -> 'b option) -> 'a t -> 'b t
+
+val flat_map : ('a -> 'b t) -> 'a t -> 'b t
+
+val flatten : 'a t t -> 'a t
+
 val iter : ('a -> unit) -> 'a t -> unit
-  (** Iterate on the list's elements *)
+(** Iterate on the list's elements *)
 
 val fold : ('b -> 'a -> 'b) -> 'b -> 'a t -> 'b
-  (** Fold on the list's elements *)
+(** Fold on the list's elements *)
+
+val fold_rev : ('b -> 'a -> 'b) -> 'b -> 'a t -> 'b
+(** Fold on the list's elements, in reverse order (starting from the tail) *)
+
+(** {2 Conversions} *)
+
+type 'a sequence = ('a -> unit) -> unit
+type 'a gen = unit -> 'a option
+
+val add_list : 'a t -> 'a list -> 'a t
 
 val of_list : 'a list -> 'a t
-  (** Convert a list to a RAL. {b Caution}: non tail-rec *)
-
-val of_list_map : ('a -> 'b) -> 'a list -> 'b t
-  (** Combination of {!of_list} and {!map} *)
+(** Convert a list to a RAL. {b Caution}: non tail-rec *)
 
 val to_list : 'a t -> 'a list
+
+val of_list_map : ('a -> 'b) -> 'a list -> 'b t
+(** Combination of {!of_list} and {!map} *)
+
+val add_seq : 'a t -> 'a sequence -> 'a t
+
+val of_seq : 'a sequence -> 'a t
+
+val to_seq : 'a t -> 'a sequence
+
+val add_gen : 'a t -> 'a gen -> 'a t
+
+val of_gen : 'a gen -> 'a t
+
+val to_gen : 'a t -> 'a gen
+
+(** {2 IO} *)
+
+type 'a printer = Format.formatter -> 'a -> unit
+
+val print : ?sep:string -> 'a printer -> 'a t printer
+
+