2 files changed, 22 insertions, 0 deletions
diff --git a/clib/cList.ml b/clib/cList.ml
index 0ef7c3d8b..627a3e3e0 100644
--- a/clib/cList.ml
+++ b/clib/cList.ml
@@ -62,6 +62,7 @@ sig
   val fold_right_and_left :
       ('a -> 'b -> 'b list -> 'a) -> 'b list -> 'a -> 'a
   val fold_left3 : ('a -> 'b -> 'c -> 'd -> 'a) -> 'a -> 'b list -> 'c list -> 'd list -> 'a
+  val fold_left2_set : exn -> ('a -> 'b -> 'c -> 'b list -> 'c list -> 'a) -> 'a -> 'b list -> 'c list -> 'a
   val for_all_i : (int -> 'a -> bool) -> int -> 'a list -> bool
   val except : 'a eq -> 'a -> 'a list -> 'a list
   val remove : 'a eq -> 'a -> 'a list -> 'a list
@@ -472,6 +473,19 @@ let fold_right_and_left f l hd =
     | a::l -> let hd = aux (a::tl) l in f hd a tl
    in aux [] l
 
+(* Match sets as lists according to a matching function, also folding a side effect *)
+let rec fold_left2_set e f x l1 l2 =
+  match l1 with
+  | a1::l1 ->
+     let rec find seen = function
+       | [] -> raise e
+       | a2::l2 ->
+          try fold_left2_set e f (f x a1 a2 l1 l2) l1 (List.rev_append seen l2)
+          with e' when e' = e -> find (a2::seen) l2 in
+     find [] l2
+  | [] ->
+     if l2 = [] then x else raise e
+
 let iteri f l = fold_left_i (fun i _ x -> f i x) 0 () l
 
 let for_all_i p =
diff --git a/clib/cList.mli b/clib/cList.mli
index f87db04cf..b3ee28548 100644
--- a/clib/cList.mli
+++ b/clib/cList.mli
@@ -121,6 +121,14 @@ sig
   val fold_right_and_left :
       ('a -> 'b -> 'b list -> 'a) -> 'b list -> 'a -> 'a
   val fold_left3 : ('a -> 'b -> 'c -> 'd -> 'a) -> 'a -> 'b list -> 'c list -> 'd list -> 'a
+
+  (** Fold sets, i.e. lists up to order; the folding function tells
+      when elements match by returning a value and raising the given
+      exception otherwise; sets should have the same size; raise the
+      given exception if no pairing of the two sets is found;;
+      complexity in O(n^2) *)
+  val fold_left2_set : exn -> ('a -> 'b -> 'c -> 'b list -> 'c list -> 'a) -> 'a -> 'b list -> 'c list -> 'a
+
   val for_all_i : (int -> 'a -> bool) -> int -> 'a list -> bool
   val except : 'a eq -> 'a -> 'a list -> 'a list
   val remove : 'a eq -> 'a -> 'a list -> 'a list