Minor improvements to Stdext (Listext, Either, Fun, and Opt).

REQUIRED FOR:
This patch is required for the 'encrypt-vm-migrate' patch in xen-api.hg.

Signed-off-by: Rok Strnisa <rok.strnisa@citrix.com>

diff --git a/stdext/Makefile b/stdext/Makefile
index cba57bd53c2a387a54c19147ec4d3b9fe9ac1139..3d332499d6df22225205fb900aefad081df7511c 100644 (file)
--- a/stdext/Makefile
+++ b/stdext/Makefile
@@ -20,8 +20,8 @@ FEPP = camlp4o -I ../rpc-light -I $(shell ocamlfind query type-conv) pa_type_con
 OCAML_TEST_INC = -I $(shell ocamlfind query oUnit)
 OCAML_TEST_LIB = $(shell ocamlfind query oUnit)/oUnit.cmxa
 
-STDEXT_OBJS = fun listext filenameext stringext arrayext hashtblext pervasiveext threadext ring \
-       qring fring opt bigbuffer unixext range vIO trie config date encodings fe fecomms \
+STDEXT_OBJS = fun opt listext filenameext stringext arrayext hashtblext pervasiveext threadext ring \
+       qring fring bigbuffer unixext range vIO trie config date encodings fe fecomms \
        forkhelpers gzip sha1sum zerocheck base64 backtrace tar mapext os either
 
 INTF = $(foreach obj, $(STDEXT_OBJS),$(obj).cmi)

diff --git a/stdext/either.ml b/stdext/either.ml
index 42e6fe11addd2f3094f2300cf26577f20b2533d8..fe0679d4ea293e6209f376a8e7a7d7ea757344cd 100644 (file)
--- a/stdext/either.ml
+++ b/stdext/either.ml
@@ -1,4 +1,5 @@
 open Pervasiveext
+open Listext
 
 type ('a,'b) t = Left of 'a | Right of 'b
 
@@ -12,7 +13,7 @@ let to_option = function
        | Right x -> Some x
        | Left _ -> None
 
-let cat_right l = Opt.cat_some ++ List.map to_option $ l
+let cat_right l = List.unbox_list ++ List.map to_option $ l
 
 let join = function
        | Right (Right x) -> Right x

diff --git a/stdext/fun.ml b/stdext/fun.ml
index 951040634093121190b340b760ec93aec3edd60c..a8be363d5b0a93c026cb318dbd444e73fc08eb32 100644 (file)
--- a/stdext/fun.ml
+++ b/stdext/fun.ml
@@ -14,7 +14,7 @@ let on op f x y = op (f x) (f y)
 let comp f g x = f (g x)
 let (++) f g x = comp f g x
 
-let comp2  f g a b = ((++) ++ (++)) f g a b
+let comp2 f g a b = f (g a b)
 let (+++) f g a b = comp2 f g a b
 
 let ($) f a = f a

diff --git a/stdext/fun.mli b/stdext/fun.mli
index c4da94634be54bdad5730ffb9a26cccbb329cd1a..66cc846682562498d55a11b3b0810e3ee69096f6 100644 (file)
--- a/stdext/fun.mli
+++ b/stdext/fun.mli
@@ -4,6 +4,7 @@ val id : 'a -> 'a
 val flip : ('a -> 'b -> 'c) -> ('b -> 'a -> 'c)
 val on : ('b -> 'b -> 'c) -> ('a -> 'b) -> 'a -> 'a -> 'c
 val comp : ('b -> 'c) -> ('a -> 'b) -> ('a -> 'c)
+val comp2 : ('b -> 'c) -> ('a1 -> 'a2 -> 'b) -> ('a1 -> 'a2 -> 'c)
 val (+++) : ('c -> 'd) -> ('a -> 'b -> 'c) -> 'a -> 'b -> 'd
 val (++) : ('b -> 'c) -> ('a -> 'b) -> 'a -> 'c
-val ($) : ('a -> 'b) -> 'a -> 'b
\ No newline at end of file
+val ($) : ('a -> 'b) -> 'a -> 'b

diff --git a/stdext/listext.ml b/stdext/listext.ml
index e7cbe3c5b8c38072d8fde818b9f96a6dd50362a4..e5f42c1135cf8c69d9e33ce066774ff691c72f4b 100644 (file)
--- a/stdext/listext.ml
+++ b/stdext/listext.ml
@@ -147,18 +147,9 @@ let unrle l =
 let inner fold_left2 base f l1 l2 g =
        fold_left2 (fun accu e1 e2 -> g accu (f e1 e2)) base l1 l2
 
-let filter_map f list =
-       List.fold_right
-               begin
-                       fun element list -> match (f element) with
-                               | Some x -> x :: list
-                               | None -> list
-               end
-               list []
-
-let rec is_sorted compare list = 
+let rec is_sorted compare list =
        match list with
-               | x :: y :: list -> 
+               | x :: y :: list ->
                        if compare x y <= 0
                                then is_sorted compare (y :: list)
                                else false
@@ -172,6 +163,9 @@ let set_difference a b = List.filter (fun x -> not(List.mem x b)) a
 let assoc_default k l d =
   if List.mem_assoc k l then List.assoc k l else d
 
+let map_assoc_with_key op al =
+       List.map (fun (k, v1) -> (k, op k v1)) al
+
 (* Like the Lisp cons *)
 let cons a b = a :: b
 
@@ -197,8 +191,6 @@ let safe_hd = function
        | a::_ -> Some a
        | [] -> None
 
-let make_assoc op l = map (fun item -> item, op item) l
-
 let rec replace_assoc key new_value = function
        | [] -> []
        | (k, _) as p :: tl ->
@@ -207,6 +199,14 @@ let rec replace_assoc key new_value = function
                else
                        p :: replace_assoc key new_value tl
 
-let make_assoc op l = map (fun item -> item, op item) l
+let make_assoc op l = map (fun key -> key, op key) l
+
+let unbox_list a = List.map Opt.unbox (List.filter Opt.is_boxed a)
+
+let filter_map f list =
+       (unbox_list +++ map) f list
+
+let restrict_with_default default keys al =
+       make_assoc (fun k -> assoc_default k al default) keys
 
 end

diff --git a/stdext/listext.mli b/stdext/listext.mli
index 31feb053e43d12505c017c62b14ac398be19b3a3..2f4fee4f563f787eb14917fe029d572a73e5479f 100644 (file)
--- a/stdext/listext.mli
+++ b/stdext/listext.mli
@@ -72,7 +72,7 @@ sig
        val position : ('a -> bool) -> 'a list -> int list
 
        (** Map the given function over a list, supplying the integer
-        * index as well as the element value. *)
+           index as well as the element value. *)
        val mapi : (int -> 'a -> 'b) -> 'a list -> 'b list
 
        val iteri : (int -> 'a -> unit) -> 'a list -> unit
@@ -89,7 +89,7 @@ sig
        val chop : int -> 'a list -> 'a list * 'a list
 
        (** Split a list at the given index to give a pair of lists, the first in
-               reverse order. *)
+                 reverse order. *)
        val rev_chop : int -> 'a list -> 'a list * 'a list
 
        (** Tail-recursive [chop]. *)
@@ -118,7 +118,7 @@ sig
        val morph : int -> ('a -> 'a) -> 'a list -> 'a list
 
        (** Insert the element [e] between every pair of adjacent elements in the
-               given list. *)
+           given list. *)
        val between : 'a -> 'a list -> 'a list
 
        (** Tail-recursive [between]. *)
@@ -128,7 +128,7 @@ sig
        val randomize : 'a list -> 'a list
 
        (** Distribute the given element over the given list, returning a list of
-               lists with the new element in each position. *)
+           lists with the new element in each position. *)
        val distribute : 'a -> 'a list -> 'a list list
 
        (** Generate all permutations of the given list. *)
@@ -149,14 +149,14 @@ sig
                'e -> ('b -> 'c -> 'i) -> 'f -> 'g -> ('a -> 'i -> 'd) -> 'h
 
        (** Applies a function f that generates optional values, to each
-        * of the items in a list A [a1; ...; am], generating a new list of
-        * non-optional values B [b1; ...; bn], with m >= n. For each value
-        * a in list A, list B contains a corresponding value b if and only
-        * if the application of (f a) results in Some b.  *)
+           of the items in a list A [a1; ...; am], generating a new list of
+           non-optional values B [b1; ...; bn], with m >= n. For each value
+           a in list A, list B contains a corresponding value b if and only
+           if the application of (f a) results in Some b.  *)
        val filter_map : ('a -> 'b option) -> 'a list -> 'b list
 
        (** Returns true if and only if the given list is in sorted order
-        * according to the given comparison function.  *)
+           according to the given comparison function.  *)
        val is_sorted : ('a -> 'a -> int) -> 'a list -> bool
 
        (** Returns the intersection of two lists. *)
@@ -166,13 +166,18 @@ sig
        val set_difference : 'a list -> 'a list -> 'a list
 
        (** Act as List.assoc, but return the given default value if the
-        * key is not in the list. *)
+           key is not in the list. *)
        val assoc_default : 'a -> ('a * 'b) list -> 'b -> 'b
 
+       (** [map_assoc_with_key op al] transforms every value in [al] based on the
+           key and the value using [op]. *)
+       val map_assoc_with_key : ('k -> 'v1 -> 'v2) -> ('k * 'v1) list -> ('k * 'v2) list
+
        (* Like Lisp cons*)
        val cons : 'a -> 'a list -> 'a list
 
-       (* take n list: Return the first n elements of list (or less if list is shorter).*)
+       (** [take n list] returns the first [n] elements of [list] (or less if list
+           is shorter).*)
        val take : int -> 'a list -> 'a list
 
        val tails : 'a list -> ('a list) list
@@ -182,4 +187,12 @@ sig
        val replace_assoc : 'a -> 'b -> ('a * 'b) list -> ('a * 'b) list
 
        val make_assoc : ('a -> 'b) -> 'a list -> ('a * 'b) list
+
+       (** Unbox all values from the option list. *)
+       val unbox_list : 'a option list -> 'a list
+
+       (** [restrict_with_default default keys al] makes a new association map
+           from [keys] to previous values for [keys] in [al]. If a key is not found
+           in [al], the [default] is used. *)
+       val restrict_with_default : 'v -> 'k list -> ('k * 'v) list -> ('k * 'v) list
 end

diff --git a/stdext/opt.ml b/stdext/opt.ml
index bf637609fc8d27cdeb94296af71e2208b310d7e4..9f43b36cef92b55a18eaf2d84106365e197c1a7b 100644 (file)
--- a/stdext/opt.ml
+++ b/stdext/opt.ml
@@ -53,8 +53,6 @@ let fold_right f opt accu =
        | Some x -> f x accu
        | None -> accu
 
-let cat_some a = List.map unbox (List.filter is_boxed a)
-
 let join = function
     | Some (Some a) -> Some a
     | _ -> None

diff --git a/stdext/opt.mli b/stdext/opt.mli
index e3db7aa99ccbd391ec388eabacf58310c0beb4a2..9e9ff3a106719708b66c0c1a7149ab4a80467d7b 100644 (file)
--- a/stdext/opt.mli
+++ b/stdext/opt.mli
@@ -19,5 +19,4 @@ val is_boxed : 'a option -> bool
 val to_list : 'a option -> 'a list
 val fold_left : ('a -> 'b -> 'a) -> 'a -> 'b option -> 'a
 val fold_right : ('a -> 'b -> 'b) -> 'a option -> 'b -> 'b
-val cat_some : 'a option list -> 'a list
 val join : ('a option) option -> 'a option