- to the Map module - to the List module - and some functional combinators (like compose with (++)) in Fun module
stdext/Makefile | 4 ++-- stdext/fun.ml | 18 ++++++++++++++++++ stdext/fun.mli | 6 ++++++ stdext/listext.ml | 4 ++++ stdext/listext.mli | 3 +++ stdext/mapext.ml | 47 +++++++++++++++++++++++++++++++++++++++++++++++ stdext/mapext.mli | 31 +++++++++++++++++++++++++++++++ stdext/opt.ml | 11 +++++++++++ stdext/opt.mli | 1 + stdext/pervasiveext.ml | 9 +++++++++ stdext/pervasiveext.mli | 3 +++ 11 files changed, 135 insertions(+), 2 deletions(-)
# HG changeset patch # User Matthias Görgens <[email protected]> # Date 1264518061 0 # Node ID 8b81395fd12ce37f0391ac3d0a999e9d79079448 # Parent 8df716c248d1fe025b2039d5d092826d61c0bc20 Adding extensions to some modules in the extended standard library: - to the Map module - to the List module - and some functional combinators (like compose with (++)) in Fun module diff -r 8df716c248d1 -r 8b81395fd12c stdext/Makefile --- a/stdext/Makefile +++ b/stdext/Makefile @@ -20,9 +20,9 @@ OCAML_TEST_INC = -I $(shell ocamlfind query oUnit) OCAML_TEST_LIB = $(shell ocamlfind query oUnit)/oUnit.cmxa -STDEXT_OBJS = filenameext stringext arrayext hashtblext listext pervasiveext threadext ring \ +STDEXT_OBJS = fun listext filenameext stringext arrayext hashtblext pervasiveext threadext ring \ qring fring opt bigbuffer unixext range vIO trie config date encodings fe fecomms \ - forkhelpers gzip sha1sum zerocheck base64 backtrace tar + forkhelpers gzip sha1sum zerocheck base64 backtrace tar mapext INTF = $(foreach obj, $(STDEXT_OBJS),$(obj).cmi) LIBS = stdext.cma stdext.cmxa diff -r 8df716c248d1 -r 8b81395fd12c stdext/fun.ml --- /dev/null +++ b/stdext/fun.ml @@ -0,0 +1,18 @@ + + +(* just forgets it's second argument: *) +let const a b = a + +let uncurry f (a,b) = f a b + +let id a = a + +let flip f a b = f b a + +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 (+++) f g a b = comp2 f g a b diff -r 8df716c248d1 -r 8b81395fd12c stdext/fun.mli --- /dev/null +++ b/stdext/fun.mli @@ -0,0 +1,6 @@ +val const : 'a -> 'b -> 'a +val uncurry : ('a -> 'b -> 'c) -> ('a * 'b) -> 'c +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) diff -r 8df716c248d1 -r 8b81395fd12c stdext/listext.ml --- a/stdext/listext.ml +++ b/stdext/listext.ml @@ -170,4 +170,8 @@ let assoc_default k l d = if List.mem_assoc k l then List.assoc k l else d + +(* Like the Lisp cons *) +let cons a b = a :: b + end diff -r 8df716c248d1 -r 8b81395fd12c stdext/listext.mli --- a/stdext/listext.mli +++ b/stdext/listext.mli @@ -169,4 +169,7 @@ is not in the list. *) val assoc_default : 'a -> ('a * 'b) list -> 'b -> 'b + (* Like Lisp cons*) + val cons : 'a -> 'a list -> 'a list + end diff -r 8df716c248d1 -r 8b81395fd12c stdext/mapext.ml --- /dev/null +++ b/stdext/mapext.ml @@ -0,0 +1,47 @@ + +module type S = + sig + type key + type +'a t + val empty: 'a t + val is_empty: 'a t -> bool + val add: key -> 'a -> 'a t -> 'a t + val find: key -> 'a t -> 'a + val remove: key -> 'a t -> 'a t + val mem: key -> 'a t -> bool + val iter: (key -> 'a -> unit) -> 'a t -> unit + val map: ('a -> 'b) -> 'a t -> 'b t + val mapi: (key -> 'a -> 'b) -> 'a t -> 'b t + val fold: (key -> 'a -> 'b -> 'b) -> 'a t -> 'b -> 'b + val compare: ('a -> 'a -> int) -> 'a t -> 'a t -> int + val equal: ('a -> 'a -> bool) -> 'a t -> 'a t -> bool + + val fromHash : (key, 'a) Hashtbl.t -> 'a t + + val filter : ('a -> bool) -> 'a t -> 'a t + + (* values: gives the list of values of the map. *) + val values : 'a t -> 'a list + + val fromListWith : ('a -> 'a -> 'a) -> (key * 'a) list -> 'a t + val adjust : ('a -> 'a) -> key -> 'a t -> 'a t + + end + +module Make(Ord: Map.OrderedType) = struct + include Map.Make (Ord) + + let fromHash h = Hashtbl.fold add h empty + let filter pred m = fold (fun k v acc -> (if pred v then add k v else Fun.id) acc) m empty + (* values: gives the list of values of the map. *) + let values m = fold (Fun.const Listext.List.cons) m [] + + let fromListWith op list = List.fold_left (fun map (k,v) -> + add k (if mem k map + then op v (find k map) + else v) map) + empty list + let adjust op k m = try add k (op (find k m)) m with Not_found -> m + + +end diff -r 8df716c248d1 -r 8b81395fd12c stdext/mapext.mli --- /dev/null +++ b/stdext/mapext.mli @@ -0,0 +1,31 @@ +module type S = + sig + type key + type +'a t + val empty: 'a t + val is_empty: 'a t -> bool + val add: key -> 'a -> 'a t -> 'a t + val find: key -> 'a t -> 'a + val remove: key -> 'a t -> 'a t + val mem: key -> 'a t -> bool + val iter: (key -> 'a -> unit) -> 'a t -> unit + val map: ('a -> 'b) -> 'a t -> 'b t + val mapi: (key -> 'a -> 'b) -> 'a t -> 'b t + val fold: (key -> 'a -> 'b -> 'b) -> 'a t -> 'b -> 'b + val compare: ('a -> 'a -> int) -> 'a t -> 'a t -> int + val equal: ('a -> 'a -> bool) -> 'a t -> 'a t -> bool + + val fromHash : (key, 'a) Hashtbl.t -> 'a t + val filter : ('a -> bool) -> 'a t -> 'a t + + (* values: gives the list of values of the map. *) + val values : 'a t -> 'a list + + val fromListWith : ('a -> 'a -> 'a) -> (key * 'a) list -> 'a t + (* Update a value at a specific key with the result of the + provided function. When the key is not a member of the map, the + original map is returned. *) + val adjust : ('a -> 'a) -> key -> 'a t -> 'a t + end + +module Make (Ord : Map.OrderedType) : S with type key = Ord.t diff -r 8df716c248d1 -r 8b81395fd12c stdext/opt.ml --- a/stdext/opt.ml +++ b/stdext/opt.ml @@ -11,6 +11,15 @@ * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the * GNU Lesser General Public License for more details. *) + +(* Perhaps it's better to use `option' from the ocaml-extlib extension + * to the standard library instead? (Although it would not suffice, + * since it's not a super-set of our `opt'.) + * (http://code.google.com/p/ocaml-extlib/) + *) + +open Pervasiveext + let iter f = function | Some x -> f x | None -> () @@ -43,3 +52,5 @@ match opt with | Some x -> f x accu | None -> accu + +let cat_options a = List.map unbox (List.filter is_boxed a) diff -r 8df716c248d1 -r 8b81395fd12c stdext/opt.mli --- a/stdext/opt.mli +++ b/stdext/opt.mli @@ -19,3 +19,4 @@ 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_options : 'a option list -> 'a list diff -r 8df716c248d1 -r 8b81395fd12c stdext/pervasiveext.ml --- a/stdext/pervasiveext.ml +++ b/stdext/pervasiveext.ml @@ -27,6 +27,8 @@ clean_f (); result +(* Those should go into the Opt module: *) + let maybe_with_default d f v = match v with None -> d | Some x -> f x @@ -53,3 +55,10 @@ let ignore_string v = let (_: string) = v in () let ignore_float v = let (_: float) = v in () let ignore_bool v = let (_: bool) = v in () + +(* To avoid some parens: *) +(* composition of functions: *) +let (++) f g x = Fun.comp f g x + +(* and application *) +let ($) f a = f a diff -r 8df716c248d1 -r 8b81395fd12c stdext/pervasiveext.mli --- a/stdext/pervasiveext.mli +++ b/stdext/pervasiveext.mli @@ -25,3 +25,6 @@ val ignore_string : string -> unit val ignore_float : float -> unit val ignore_bool : bool -> unit + +val (++) : ('b -> 'c) -> ('a -> 'b) -> ('a -> 'c) +val ($) : ('a -> 'b) -> 'a -> 'b
_______________________________________________ xen-api mailing list [email protected] http://lists.xensource.com/mailman/listinfo/xen-api
