From 05453c3ce8ed72a27bb38ee28b9c5c0861ddef42 Mon Sep 17 00:00:00 2001
From: Simon Cruanes <simon.cruanes.2007@m4x.org>
Date: Fri, 18 Jul 2014 02:34:40 +0200
Subject: [PATCH] CCKlist.product and product_with (fair cartesian product)

---
 core/CCKList.ml  | 28 ++++++++++++++++++++++++++++
 core/CCKList.mli |  9 +++++++++
 2 files changed, 37 insertions(+)

diff --git a/core/CCKList.ml b/core/CCKList.ml
index 9dd606e6..964bdb1f 100644
--- a/core/CCKList.ml
+++ b/core/CCKList.ml
@@ -139,6 +139,34 @@ and _flat_map_app f l l' () = match l () with
   | `Cons (x, tl) ->
       `Cons (x, _flat_map_app f tl l')
 
+let product_with f l1 l2 =
+  let rec _next_left h1 tl1 h2 tl2 () =
+    match tl1() with
+    | `Nil -> _next_right ~die:true h1 tl1 h2 tl2 ()
+    | `Cons (x, tl1') ->
+        _map_list_left x h2
+          (_next_right ~die:false (x::h1) tl1' h2 tl2)
+          ()
+  and _next_right ~die h1 tl1 h2 tl2 () =
+    match tl2() with
+    | `Nil when die -> `Nil
+    | `Nil -> _next_left h1 tl1 h2 tl2 ()
+    | `Cons (y, tl2') ->
+        _map_list_right h1 y
+          (_next_left h1 tl1 (y::h2) tl2')
+          ()
+  and _map_list_left x l kont () = match l with
+    | [] -> kont()
+    | y::l' -> `Cons (f x y, _map_list_left x l' kont)
+  and _map_list_right l y kont () = match l with
+    | [] -> kont()
+    | x::l' -> `Cons (f x y, _map_list_right l' y kont)
+  in
+  _next_left [] l1 [] l2
+
+let product l1 l2 =
+  product_with (fun x y -> x,y) l1 l2
+
 let rec filter_map f l () = match l() with
   | `Nil -> `Nil
   | `Cons (x, l') ->
diff --git a/core/CCKList.mli b/core/CCKList.mli
index 0997a7f2..2e244712 100644
--- a/core/CCKList.mli
+++ b/core/CCKList.mli
@@ -78,6 +78,15 @@ val filter : ('a -> bool) -> 'a t -> 'a t
 
 val append : 'a t -> 'a t -> 'a t
 
+val product_with : ('a -> 'b -> 'c) -> 'a t -> 'b t -> 'c t
+(** Fair product of two (possibly infinite) lists into a new list. Lazy.
+    The first parameter is used to combine each pair of elements
+    @since NEXT_RELEASE *)
+
+val product : 'a t -> 'b t -> ('a * 'b) t
+(** Specialization of {!product_with} producing tuples
+    @since NEXT_RELEASE *)
+
 val flat_map : ('a -> 'b t) -> 'a t -> 'b t
 
 val filter_map : ('a -> 'b option) -> 'a t -> 'b t