# HG changeset patch
# User Matthias Görgens <matthias.goergens@xxxxxxxxxx>
# 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