Adding fold_left / fold_right function to maps.

2 files changed, 22 insertions, 0 deletions

diff --git a/lib/cMap.ml b/lib/cMap.ml
index d8cd2d779a..6bf3b2f068 100644
--- a/lib/cMap.ml
+++ b/lib/cMap.ml
@@ -22,6 +22,8 @@ sig
   val modify : key -> (key -> 'a -> 'a) -> 'a t -> 'a t
   val domain : 'a t -> Set.t
   val bind : (key -> 'a) -> Set.t -> 'a t
+  val fold_left : (key -> 'a -> 'b -> 'b) -> 'a t -> 'b -> 'b
+  val fold_right : (key -> 'a -> 'b -> 'b) -> 'a t -> 'b -> 'b
   module Unsafe :
   sig
     val map : (key -> 'a -> key * 'b) -> 'a t -> 'b t
@@ -35,6 +37,8 @@ sig
   val modify : M.t -> (M.t -> 'a -> 'a) -> 'a map -> 'a map
   val domain : 'a map -> Set.Make(M).t
   val bind : (M.t -> 'a) -> Set.Make(M).t -> 'a map
+  val fold_left : (M.t -> 'a -> 'b -> 'b) -> 'a map -> 'b -> 'b
+  val fold_right : (M.t -> 'a -> 'b -> 'b) -> 'a map -> 'b -> 'b
   module Unsafe :
   sig
     val map : (M.t -> 'a -> M.t * 'b) -> 'a map -> 'b map
@@ -99,6 +103,18 @@ struct
     map_inj (MNode (bind f l, k, f k, bind f r, h))
   (** Dual operation of [domain]. *)
 
+  let rec fold_left f (s : 'a map) accu = match map_prj s with
+  | MEmpty -> accu
+  | MNode (l, k, v, r, h) ->
+    let accu = f k v (fold_left f l accu) in
+    fold_left f r accu
+
+  let rec fold_right f (s : 'a map) accu = match map_prj s with
+  | MEmpty -> accu
+  | MNode (l, k, v, r, h) ->
+    let accu = f k v (fold_right f r accu) in
+    fold_right f l accu
+
   module Unsafe =
   struct
 
diff --git a/lib/cMap.mli b/lib/cMap.mli
index 6b61782b05..7091e844e3 100644
--- a/lib/cMap.mli
+++ b/lib/cMap.mli
@@ -39,6 +39,12 @@ sig
   (** [bind f s] transform the set [x1; ...; xn] into [x1 := f x1; ...;
       xn := f xn]. *)
 
+  val fold_left : (key -> 'a -> 'b -> 'b) -> 'a t -> 'b -> 'b
+  (** Alias for {!fold}, to easily track where we depend on fold order. *)
+
+  val fold_right : (key -> 'a -> 'b -> 'b) -> 'a t -> 'b -> 'b
+  (** Folding keys in decreasing order. *)
+
   module Unsafe :
   sig
     val map : (key -> 'a -> key * 'b) -> 'a t -> 'b t