Merge PR #980: Adding combinators + a canonical renaming in List, Option, Name

6 files changed, 86 insertions, 13 deletions

diff --git a/lib/cArray.ml b/lib/cArray.ml
index 85984d436..d08f24d49 100644
--- a/lib/cArray.ml
+++ b/lib/cArray.ml
@@ -53,8 +53,12 @@ sig
     ('a -> 'b -> 'c -> 'd) -> 'a array -> 'b array -> 'c array -> 'd array
   val map_left : ('a -> 'b) -> 'a array -> 'b array
   val iter2 : ('a -> 'b -> unit) -> 'a array -> 'b array -> unit
-  val fold_map' : ('a -> 'c -> 'b * 'c) -> 'a array -> 'c -> 'b array * 'c
+  val fold_left_map : ('a -> 'b -> 'a * 'c) -> 'a -> 'b array -> 'a * 'c array
+  val fold_right_map : ('a -> 'c -> 'b * 'c) -> 'a array -> 'c -> 'b array * 'c
+  val fold_left2_map : ('a -> 'b -> 'c -> 'a * 'd) -> 'a -> 'b array -> 'c array -> 'a * 'd array
+  val fold_right2_map : ('a -> 'b -> 'c -> 'd * 'c) -> 'a array -> 'b array -> 'c -> 'd array * 'c
   val fold_map : ('a -> 'b -> 'a * 'c) -> 'a -> 'b array -> 'a * 'c array
+  val fold_map' : ('a -> 'c -> 'b * 'c) -> 'a array -> 'c -> 'b array * 'c
   val fold_map2' :
     ('a -> 'b -> 'c -> 'd * 'c) -> 'a array -> 'b array -> 'c -> 'd array * 'c
   val distinct : 'a array -> bool
@@ -433,7 +437,7 @@ let iter2 f v1 v2 =
 
 let pure_functional = false
 
-let fold_map' f v e =
+let fold_right_map f v e =
 if pure_functional then
   let (l,e) =
     Array.fold_right
@@ -445,18 +449,28 @@ else
   let v' = Array.map (fun x -> let (y,e) = f x !e' in e' := e; y) v in
   (v',!e')
 
-let fold_map f e v =
+let fold_map' = fold_right_map
+
+let fold_left_map f e v =
   let e' = ref e in
   let v' = Array.map (fun x -> let (e,y) = f !e' x in e' := e; y) v in
   (!e',v')
 
-let fold_map2' f v1 v2 e =
+let fold_map = fold_left_map
+
+let fold_right2_map f v1 v2 e =
   let e' = ref e in
   let v' =
     map2 (fun x1 x2 -> let (y,e) = f x1 x2 !e' in e' := e; y) v1 v2
   in
   (v',!e')
 
+let fold_map2' = fold_right2_map
+
+let fold_left2_map f e v1 v2 =
+  let e' = ref e in
+  let v' = map2 (fun x1 x2 -> let (e,y) = f !e' x1 x2 in e' := e; y) v1 v2 in
+  (!e',v')
 
 let distinct v =
   let visited = Hashtbl.create 23 in
diff --git a/lib/cArray.mli b/lib/cArray.mli
index 7e5c93b5d..325ff8edc 100644
--- a/lib/cArray.mli
+++ b/lib/cArray.mli
@@ -96,10 +96,28 @@ sig
   val iter2 : ('a -> 'b -> unit) -> 'a array -> 'b array -> unit
   (** Iter on two arrays. Raise [Invalid_argument "Array.iter2"] if sizes differ. *)
 
-  val fold_map' : ('a -> 'c -> 'b * 'c) -> 'a array -> 'c -> 'b array * 'c
+  val fold_left_map : ('a -> 'b -> 'a * 'c) -> 'a -> 'b array -> 'a * 'c array
+  (** [fold_left_map f e_0 [|l_1...l_n|] = e_n,[|k_1...k_n|]]
+    where [(e_i,k_i)=f e_{i-1} l_i] *)
+
+  val fold_right_map : ('a -> 'c -> 'b * 'c) -> 'a array -> 'c -> 'b array * 'c
+  (** Same, folding on the right *)
+
+  val fold_left2_map : ('a -> 'b -> 'c -> 'a * 'd) -> 'a -> 'b array -> 'c array -> 'a * 'd array
+  (** Same with two arrays, folding on the left *)
+
+  val fold_right2_map : ('a -> 'b -> 'c -> 'd * 'c) -> 'a array -> 'b array -> 'c -> 'd array * 'c
+  (** Same with two arrays, folding on the left *)
+
   val fold_map : ('a -> 'b -> 'a * 'c) -> 'a -> 'b array -> 'a * 'c array
+  (** @deprecated Same as [fold_left_map] *)
+
+  val fold_map' : ('a -> 'c -> 'b * 'c) -> 'a array -> 'c -> 'b array * 'c
+  (** @deprecated Same as [fold_right_map] *)
+
   val fold_map2' :
     ('a -> 'b -> 'c -> 'd * 'c) -> 'a array -> 'b array -> 'c -> 'd array * 'c
+  (** @deprecated Same as [fold_right2_map] *)
 
   val distinct : 'a array -> bool
   (** Return [true] if every element of the array is unique (for default 
diff --git a/lib/cList.ml b/lib/cList.ml
index cb84b6097..ca69628af 100644
--- a/lib/cList.ml
+++ b/lib/cList.ml
@@ -92,6 +92,10 @@ sig
   val map_append : ('a -> 'b list) -> 'a list -> 'b list
   val map_append2 : ('a -> 'b -> 'c list) -> 'a list -> 'b list -> 'c list
   val share_tails : 'a list -> 'a list -> 'a list * 'a list * 'a list
+  val fold_left_map : ('a -> 'b -> 'a * 'c) -> 'a -> 'b list -> 'a * 'c list
+  val fold_right_map : ('b -> 'a -> 'c * 'a) -> 'b list -> 'a -> 'c list * 'a
+  val fold_left2_map : ('a -> 'b -> 'c -> 'a * 'd) -> 'a -> 'b list -> 'c list -> 'a * 'd list
+  val fold_right2_map : ('b -> 'c -> 'a -> 'd * 'a) -> 'b list -> 'c list -> 'a -> 'd list * 'a
   val fold_map : ('a -> 'b -> 'a * 'c) -> 'a -> 'b list -> 'a * 'c list
   val fold_map' : ('b -> 'a -> 'c * 'a) -> 'b list -> 'a -> 'c list * 'a
   val map_assoc : ('a -> 'b) -> ('c * 'a) list -> ('c * 'b) list
@@ -761,13 +765,15 @@ let share_tails l1 l2 =
   in
   shr_rev [] (List.rev l1, List.rev l2)
 
-let rec fold_map f e = function
+let rec fold_left_map f e = function
   |  []  -> (e,[])
   |  h::t ->
        let e',h' = f e h in
-       let e'',t' = fold_map f e' t in
+       let e'',t' = fold_left_map f e' t in
          e'',h'::t'
 
+let fold_map = fold_left_map
+
 (* (* tail-recursive version of the above function *)
 let fold_map f e l =
   let g (e,b') h =
@@ -779,9 +785,17 @@ let fold_map f e l =
 *)
 
 (* The same, based on fold_right, with the effect accumulated on the right *)
-let fold_map' f l e =
+let fold_right_map f l e =
   List.fold_right (fun x (l,e) -> let (y,e) = f x e in (y::l,e)) l ([],e)
 
+let fold_map' = fold_right_map
+
+let fold_left2_map f e l l' =
+  List.fold_left2 (fun (e,l) x x' -> let (e,y) = f e x x' in (e,y::l)) (e,[]) l l'
+
+let fold_right2_map f l l' e =
+  List.fold_right2 (fun x x' (l,e) -> let (y,e) = f x x' e in (y::l,e)) l l' ([],e)
+
 let map_assoc f = List.map (fun (x,a) -> (x,f a))
 
 let rec assoc_f f a = function
diff --git a/lib/cList.mli b/lib/cList.mli
index d7d6614cd..8cb07da79 100644
--- a/lib/cList.mli
+++ b/lib/cList.mli
@@ -198,11 +198,25 @@ sig
 
   val share_tails : 'a list -> 'a list -> 'a list * 'a list * 'a list
 
-  val fold_map : ('a -> 'b -> 'a * 'c) -> 'a -> 'b list -> 'a * 'c list
-  (** [fold_map f e_0 [l_1...l_n] = e_n,[k_1...k_n]]
+  val fold_left_map : ('a -> 'b -> 'a * 'c) -> 'a -> 'b list -> 'a * 'c list
+  (** [fold_left_map f e_0 [l_1...l_n] = e_n,[k_1...k_n]]
     where [(e_i,k_i)=f e_{i-1} l_i] *)
 
+  val fold_right_map : ('b -> 'a -> 'c * 'a) -> 'b list -> 'a -> 'c list * 'a
+  (** Same, folding on the right *)
+
+  val fold_left2_map : ('a -> 'b -> 'c -> 'a * 'd) -> 'a -> 'b list -> 'c list -> 'a * 'd list
+  (** Same with two lists, folding on the left *)
+
+  val fold_right2_map : ('b -> 'c -> 'a -> 'd * 'a) -> 'b list -> 'c list -> 'a -> 'd list * 'a
+  (** Same with two lists, folding on the right *)
+
+  val fold_map : ('a -> 'b -> 'a * 'c) -> 'a -> 'b list -> 'a * 'c list
+  (** @deprecated Same as [fold_left_map] *)
+
   val fold_map' : ('b -> 'a -> 'c * 'a) -> 'b list -> 'a -> 'c list * 'a
+  (** @deprecated Same as [fold_right_map] *)
+
   val map_assoc : ('a -> 'b) -> ('c * 'a) list -> ('c * 'b) list
   val assoc_f : 'a eq -> 'a -> ('a * 'b) list -> 'b
   val remove_assoc_f : 'a eq -> 'a -> ('a * 'b) list -> ('a * 'b) list
diff --git a/lib/option.ml b/lib/option.ml
index 7cedffef0..98b168035 100644
--- a/lib/option.ml
+++ b/lib/option.ml
@@ -121,12 +121,19 @@ let fold_right f x a =
   | Some y -> f y a
   | _ -> a
 
-(** [fold_map f a x] is [a, f y] if [x] is [Some y], and [a] otherwise. *)
-let fold_map f a x =
+(** [fold_left_map f a x] is [a, f y] if [x] is [Some y], and [a] otherwise. *)
+let fold_left_map f a x =
   match x with
   | Some y -> let a, z = f a y in a, Some z
   | _ -> a, None
 
+let fold_right_map f x a =
+  match x with
+  | Some y -> let z, a = f y a in Some z, a
+  | _ -> None, a
+
+let fold_map = fold_left_map
+
 (** [cata f a x] is [a] if [x] is [None] and [f y] if [x] is [Some y]. *)
 let cata f a = function
   | Some c -> f c
diff --git a/lib/option.mli b/lib/option.mli
index c4d1ebc3a..66f05023f 100644
--- a/lib/option.mli
+++ b/lib/option.mli
@@ -85,7 +85,13 @@ val fold_left2 : ('a -> 'b -> 'c -> 'a) -> 'a -> 'b option -> 'c option -> 'a
 (** [fold_right f x a] is [f y a] if [x] is [Some y], and [a] otherwise. *)
 val fold_right : ('a -> 'b -> 'b) -> 'a option -> 'b -> 'b
 
-(** [fold_map f a x] is [a, f y] if [x] is [Some y], and [a] otherwise. *)
+(** [fold_left_map f a x] is [a, f y] if [x] is [Some y], and [a] otherwise. *)
+val fold_left_map : ('a -> 'b -> 'a * 'c) -> 'a -> 'b option -> 'a * 'c option
+
+(** Same as [fold_left_map] on the right *)
+val fold_right_map : ('b -> 'a -> 'c * 'a) -> 'b option -> 'a -> 'c option * 'a
+
+(** @deprecated Same as [fold_left_map] *)
 val fold_map : ('a -> 'b -> 'a * 'c) -> 'a -> 'b option -> 'a * 'c option
 
 (** [cata f e x] is [e] if [x] is [None] and [f a] if [x] is [Some a] *)