[enhance] libbase, traverse: added sub_option to traverse utils

MLstate · Feb 1, 2012 · a689f5f · a689f5f
1 parent 8821425
commit a689f5f
Show file tree

Hide file tree

Showing 2 changed files with 8 additions and 0 deletions.
diff --git a/libbase/traverse.ml b/libbase/traverse.ml
@@ -50,6 +50,13 @@ struct
   let sub_current e = (function [e] -> e | _ ->  assert false), [e]
   let sub_ignore x = (function [] -> x | _ -> assert false), []
 
+  let sub_option sub_e opt =
+    match opt with
+    | None -> (fun x -> assert (List.is_empty x); None), []
+    | Some e ->
+        let usub, l = sub_e e in
+        (fun l -> Some (usub l)), l
+
   let wrap cons (unsub,l) = (fun l -> cons (unsub l)), l
 end
 

diff --git a/libbase/traverse.mli b/libbase/traverse.mli
@@ -69,6 +69,7 @@ module Utils : sig
    val sub_3 : ('a1, 'at, 'bt, 'b1) sub -> ('a2, 'at, 'bt, 'b2) sub -> ('a3, 'at, 'bt, 'b3) sub -> ('a1 * 'a2 * 'a3, 'at, 'bt, 'b1 * 'b2 * 'b3) sub
    val sub_4 : ('a1, 'at, 'bt, 'b1) sub -> ('a2, 'at, 'bt, 'b2) sub -> ('a3, 'at, 'bt, 'b3) sub -> ('a4, 'at, 'bt, 'b4) sub -> ('a1 * 'a2 * 'a3 * 'a4, 'at, 'bt, 'b1 * 'b2 * 'b3 * 'b4) sub
    val sub_list : ('a, 'at, 'bt, 'b) sub -> ('a list, 'at, 'bt, 'b list) sub
+   val sub_option : ('a, 'at, 'bt, 'b) sub -> ('a option, 'at, 'bt, 'b option) sub
    val sub_current : ('a, 'a, 'b, 'b) sub
    val sub_ignore : ('a, _, _, 'a) sub