more operators in CCKlist

core/CCKList.ml

@@ -25,6 +25,13 @@ OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
 
 (** {1 Continuation List} *)
 
+type 'a sequence = ('a -> unit) -> unit
+type 'a gen = unit -> 'a option
+type 'a equal = 'a -> 'a -> bool
+type 'a ord = 'a -> 'a -> int
+type 'a printer = Buffer.t -> 'a -> unit
+type 'a formatter = Format.formatter -> 'a -> unit
+
 type + 'a t = unit -> 
   [ `Nil
   | `Cons of 'a * 'a t
@@ -40,47 +47,20 @@ let is_empty l = match l () with
   | `Nil -> true
   | `Cons _ -> false
 
-let to_list l =
-  let rec direct i (l:'a t) = match l () with
-    | `Nil -> []
-    | _ when i=0 -> safe [] l
-    | `Cons (x, f) -> x :: direct (i-1) f
-  and safe acc l = match l () with
-    | `Nil -> List.rev acc
-    | `Cons (x,l') -> safe (x::acc) l'
-  in
-  direct 200 l
+let rec equal eq l1 l2 = match l1(), l2() with
+  | `Nil, `Nil -> true
+  | `Nil, _
+  | _, `Nil -> false
+  | `Cons (x1,l1'), `Cons (x2,l2') ->
+      eq x1 x2 && equal eq l1' l2'
 
-let of_list l =
-  let rec aux l () = match l with
-    | [] -> `Nil
-    | x::l' -> `Cons (x, aux l')
-  in aux l
-
-let equal ?(eq=(=)) l1 l2 =
-  let rec aux l1 l2 = match l1(), l2() with
-    | `Nil, `Nil -> true
-    | `Nil, _
-    | _, `Nil -> false
-    | `Cons (x1,l1'), `Cons (x2,l2') ->
-        eq x1 x2 && aux l1' l2'
-  in aux l1 l2
-
-type 'a sequence = ('a -> unit) -> unit
-type 'a gen = unit -> 'a option
-
-let rec to_seq res k = match res () with
-  | `Nil -> ()
-  | `Cons (s, f) -> k s; to_seq f k
-
-let to_gen l =
-  let l = ref l in
-  fun () ->
-    match !l () with
-    | `Nil -> None
-    | `Cons (x,l') ->
-        l := l';
-        Some x
+let rec compare cmp l1 l2 = match l1(), l2() with
+  | `Nil, `Nil -> 0
+  | `Nil, _ -> -1
+  | _, `Nil -> 1
+  | `Cons (x1,l1'), `Cons (x2,l2') ->
+      let c = cmp x1 x2 in
+      if c = 0 then compare cmp l1' l2' else c
 
 let rec fold f acc res = match res () with
   | `Nil -> acc
@@ -97,11 +77,21 @@ let rec take n (l:'a t) () = match l () with
   | `Nil -> `Nil
   | `Cons (x,l') -> `Cons (x, take (n-1) l')
 
+let rec take_while p l () = match l () with
+  | `Nil -> `Nil
+  | `Cons (x,l') when p x -> `Cons (x, take_while p l')
+  | `Cons (_,l') -> take_while p l' ()
+
 let rec drop n (l:'a t) () = match l () with
   | l' when n=0 -> l'
   | `Nil -> `Nil
   | `Cons (_,l') -> drop (n-1) l' ()
 
+let rec drop_while p l () = match l() with
+  | `Nil -> `Nil
+  | `Cons (x,l') when p x -> drop_while p l' ()
+  | `Cons _ as res -> res
+
 (*$Q
   (Q.pair (Q.list Q.small_int) Q.small_int) (fun (l,n) -> \
     let s = of_list l in let s1, s2 = take n s, drop n s in \
@@ -173,3 +163,96 @@ let range i j =
 *)
 
 let (--) = range
+
+let rec fold2 f acc l1 l2 = match l1(), l2() with
+  | `Nil, _
+  | _, `Nil -> acc
+  | `Cons(x1,l1'), `Cons(x2,l2') ->
+      fold2 f (f acc x1 x2) l1' l2'
+
+let rec map2 f l1 l2 () = match l1(), l2() with
+  | `Nil, _
+  | _, `Nil -> `Nil
+  | `Cons(x1,l1'), `Cons(x2,l2') ->
+      `Cons (f x1 x2, map2 f l1' l2')
+
+let rec iter2 f l1 l2 = match l1(), l2() with
+  | `Nil, _
+  | _, `Nil -> ()
+  | `Cons(x1,l1'), `Cons(x2,l2') ->
+      f x1 x2; iter2 f l1' l2'
+
+let rec for_all2 f l1 l2 = match l1(), l2() with
+  | `Nil, _
+  | _, `Nil -> true
+  | `Cons(x1,l1'), `Cons(x2,l2') ->
+      f x1 x2 && for_all2 f l1' l2'
+
+let rec exists2 f l1 l2 = match l1(), l2() with
+  | `Nil, _
+  | _, `Nil -> false
+  | `Cons(x1,l1'), `Cons(x2,l2') ->
+      f x1 x2 || exists2 f l1' l2'
+
+let rec merge cmp l1 l2 () = match l1(), l2() with
+  | `Nil, tl2 -> tl2
+  | tl1, `Nil -> tl1
+  | `Cons(x1,l1'), `Cons(x2,l2') ->
+      if cmp x1 x2 < 0
+      then `Cons (x1, merge cmp l1' l2)
+      else `Cons (x2, merge cmp l1 l2')
+
+(** {2 Conversions} *)
+
+let rec _to_rev_list acc l = match l() with
+  | `Nil -> acc
+  | `Cons (x,l') -> _to_rev_list (x::acc) l'
+
+let to_rev_list l = _to_rev_list [] l
+
+let to_list l =
+  let rec direct i (l:'a t) = match l () with
+    | `Nil -> []
+    | _ when i=0 -> List.rev (_to_rev_list [] l)
+    | `Cons (x, f) -> x :: direct (i-1) f
+  in
+  direct 200 l
+
+let of_list l =
+  let rec aux l () = match l with
+    | [] -> `Nil
+    | x::l' -> `Cons (x, aux l')
+  in aux l
+
+let rec to_seq res k = match res () with
+  | `Nil -> ()
+  | `Cons (s, f) -> k s; to_seq f k
+
+let to_gen l =
+  let l = ref l in
+  fun () ->
+    match !l () with
+    | `Nil -> None
+    | `Cons (x,l') ->
+        l := l';
+        Some x
+
+(** {2 IO} *)
+
+let pp ?(sep=",") pp_item buf l =
+  let rec pp buf l = match l() with
+    | `Nil -> ()
+    | `Cons (x,l') -> Buffer.add_string buf sep; pp_item buf x; pp buf l'
+  in
+  match l() with
+    | `Nil -> ()
+    | `Cons (x,l') -> pp_item buf x; pp buf l'
+
+let print ?(sep=",") pp_item fmt l =
+  let rec pp fmt l = match l() with
+    | `Nil -> ()
+    | `Cons (x,l') -> Format.pp_print_string fmt sep; pp_item fmt x; pp fmt l'
+  in
+  match l() with
+    | `Nil -> ()
+    | `Cons (x,l') -> pp_item fmt x; pp fmt l'

core/CCKList.mli

@@ -25,6 +25,15 @@ OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
 
 (** {1 Continuation List} *)
 
+type 'a sequence = ('a -> unit) -> unit
+type 'a gen = unit -> 'a option
+type 'a equal = 'a -> 'a -> bool
+type 'a ord = 'a -> 'a -> int
+type 'a printer = Buffer.t -> 'a -> unit
+type 'a formatter = Format.formatter -> 'a -> unit
+
+(** {2 Basics} *)
+
 type + 'a t = unit -> 
   [ `Nil
   | `Cons of 'a * 'a t
@@ -40,30 +49,27 @@ val singleton : 'a -> 'a t
 
 val is_empty : 'a t -> bool
 
-val of_list : 'a list -> 'a t
+val equal : 'a equal -> 'a t equal
+(** Equality step by step. Eager. *)
 
-val to_list : 'a t -> 'a list
-(** Gather all values into a list *)
-
-val equal : ?eq:('a -> 'a -> bool) -> 'a t -> 'a t -> bool
-
-type 'a sequence = ('a -> unit) -> unit
-type 'a gen = unit -> 'a option
-
-val to_seq : 'a t -> 'a sequence
-val to_gen : 'a t -> 'a gen
+val compare : 'a ord -> 'a t ord
+(** Lexicographic comparison. Eager. *)
 
 val fold : ('a -> 'b -> 'a) -> 'a -> 'b t -> 'a
 (** Fold on values *)
 
 val iter : ('a -> unit) -> 'a t -> unit
 
-val length : 'a t -> int
+val length : _ t -> int
 
 val take : int -> 'a t -> 'a t
 
+val take_while : ('a -> bool) -> 'a t -> 'a t
+
 val drop : int -> 'a t -> 'a t
 
+val drop_while : ('a -> bool) -> 'a t -> 'a t
+
 val map : ('a -> 'b) -> 'a t -> 'b t
 
 val fmap : ('a -> 'b option) -> 'a t -> 'b t
@@ -81,3 +87,42 @@ val flatten : 'a t t -> 'a t
 val range : int -> int -> int t
 
 val (--) : int -> int -> int t
+
+(** {2 Operations on two Collections} *)
+
+val fold2 : ('acc -> 'a -> 'b -> 'acc) -> 'acc -> 'a t -> 'b t -> 'acc
+(** Fold on two collections at once. Stop at soon as one of them ends *)
+
+val map2 : ('a -> 'b -> 'c) -> 'a t -> 'b t -> 'c t
+(** Map on two collections at once. Stop as soon as one of the
+    arguments is exhausted *)
+
+val iter2 : ('a -> 'b -> unit) -> 'a t -> 'b t -> unit
+(** Iterate on two collections at once. Stop as soon as one of them ends *)
+
+val for_all2 : ('a -> 'b -> bool) -> 'a t -> 'b t -> bool
+val exists2 : ('a -> 'b -> bool) -> 'a t -> 'b t -> bool
+
+val merge : 'a ord -> 'a t -> 'a t -> 'a t
+(** Merge two sorted iterators into a sorted iterator *)
+
+(** {2 Conversions} *)
+
+val of_list : 'a list -> 'a t
+
+val to_list : 'a t -> 'a list
+(** Gather all values into a list *)
+
+val to_rev_list : 'a t -> 'a list
+(** Convert to a list, in reverse order. More efficient than {!to_list} *)
+
+val to_seq : 'a t -> 'a sequence
+
+val to_gen : 'a t -> 'a gen
+
+
+(** {2 IO} *)
+
+val pp : ?sep:string -> 'a printer -> 'a t printer
+
+val print : ?sep:string -> 'a formatter -> 'a t formatter

tests/bench_batch.ml

@@ -78,7 +78,7 @@ end)
 module BenchKList = Make(struct
   include CCKList
   let name = "klist"
-  let equal a b = equal a b
+  let equal a b = equal (=) a b
   let doubleton x y = CCKList.of_list [ x; y ]
 end)