diff --git a/Changes b/Changes
index c317af938..96e8fa6d7 100644
--- a/Changes
+++ b/Changes
@@ -83,6 +83,7 @@ Standard library:
   low level input, value Scanf.stdin has been added.
 * Random: changed the algorithm to produce better randomness.  Now passes the
   DieHard tests.
+- Map: implement functions from Set that make sense for Map.
 
 Other libraries:
 * Str: letters that constitute a word now include digits 0-9 and
diff --git a/stdlib/map.ml b/stdlib/map.ml
index a159e7aef..3d9597aa0 100644
--- a/stdlib/map.ml
+++ b/stdlib/map.ml
@@ -25,16 +25,28 @@ module type S =
     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 add: key -> 'a -> 'a t -> 'a t
+    val singleton: key -> 'a -> 'a t
+    val remove: key -> 'a t -> 'a t
+    val merge: (key -> 'a option -> 'b option -> 'c option) -> 'a t -> 'b t -> 'c t
     val compare: ('a -> 'a -> int) -> 'a t -> 'a t -> int
     val equal: ('a -> 'a -> bool) -> 'a t -> 'a t -> bool
+    val iter: (key -> 'a -> unit) -> 'a t -> unit
+    val fold: (key -> 'a -> 'b -> 'b) -> 'a t -> 'b -> 'b
+    val for_all: (key -> 'a -> bool) -> 'a t -> bool
+    val exists: (key -> 'a -> bool) -> 'a t -> bool
+    val filter: (key -> 'a -> bool) -> 'a t -> 'a t
+    val partition: (key -> 'a -> bool) -> 'a t -> 'a t * 'a t
+    val cardinal: 'a t -> int
+    val bindings: 'a t -> (key * 'a) list
+    val min_binding: 'a t -> (key * 'a)
+    val max_binding: 'a t -> (key * 'a)
+    val choose: 'a t -> (key * 'a)
+    val split: key -> 'a t -> 'a t * 'a option * 'a t
+    val find: key -> 'a t -> 'a
+    val map: ('a -> 'b) -> 'a t -> 'b t
+    val mapi: (key -> 'a -> 'b) -> 'a t -> 'b t
   end
 
 module Make(Ord: OrderedType) = struct
@@ -53,6 +65,8 @@ module Make(Ord: OrderedType) = struct
       let hl = height l and hr = height r in
       Node(l, x, d, r, (if hl >= hr then hl + 1 else hr + 1))
 
+    let singleton x d = Node(Empty, x, d, Empty, 1)
+
     let bal l x d r =
       let hl = match l with Empty -> 0 | Node(_,_,_,_,h) -> h in
       let hr = match r with Empty -> 0 | Node(_,_,_,_,h) -> h in
@@ -119,6 +133,11 @@ module Make(Ord: OrderedType) = struct
       | Node(Empty, x, d, r, _) -> (x, d)
       | Node(l, x, d, r, _) -> min_binding l
 
+    let rec max_binding = function
+        Empty -> raise Not_found
+      | Node(l, x, d, Empty, _) -> (x, d)
+      | Node(l, x, d, r, _) -> max_binding r
+
     let rec remove_min_binding = function
         Empty -> invalid_arg "Map.remove_min_elt"
       | Node(Empty, x, d, r, _) -> r
@@ -173,6 +192,80 @@ module Make(Ord: OrderedType) = struct
       | Node(l, v, d, r, _) ->
           fold f r (f v d (fold f l accu))
 
+    let rec for_all p = function
+        Empty -> true
+      | Node(l, v, d, r, _) -> p v d && for_all p l && for_all p r
+
+    let rec exists p = function
+        Empty -> false
+      | Node(l, v, d, r, _) -> p v d || exists p l || exists p r
+
+    let filter p s =
+      let rec filt accu = function
+        | Empty -> accu
+        | Node(l, v, d, r, _) ->
+            filt (filt (if p v d then add v d accu else accu) l) r in
+      filt Empty s
+
+    let partition p s =
+      let rec part (t, f as accu) = function
+        | Empty -> accu
+        | Node(l, v, d, r, _) ->
+            part (part (if p v d then (add v d t, f) else (t, add v d f)) l) r in
+      part (Empty, Empty) s
+
+    (* Same as create and bal, but no assumptions are made on the
+       relative heights of l and r. *)
+
+    let rec join l v d r =
+      match (l, r) with
+        (Empty, _) -> add v d r
+      | (_, Empty) -> add v d l
+      | (Node(ll, lv, ld, lr, lh), Node(rl, rv, rd, rr, rh)) ->
+          if lh > rh + 2 then bal ll lv ld (join lr v d r) else
+          if rh > lh + 2 then bal (join l v d rl) rv rd rr else
+          create l v d r
+
+    (* Merge two trees l and r into one.
+       All elements of l must precede the elements of r.
+       No assumption on the heights of l and r. *)
+
+    let concat t1 t2 =
+      match (t1, t2) with
+        (Empty, t) -> t
+      | (t, Empty) -> t
+      | (_, _) ->
+          let (x, d) = min_binding t2 in
+          join t1 x d (remove_min_binding t2)
+
+    let concat_or_join t1 v d t2 =
+      match d with
+      | Some d -> join t1 v d t2
+      | None -> concat t1 t2
+
+    let rec split x = function
+        Empty ->
+          (Empty, None, Empty)
+      | Node(l, v, d, r, _) ->
+          let c = Ord.compare x v in
+          if c = 0 then (l, Some d, r)
+          else if c < 0 then
+            let (ll, pres, rl) = split x l in (ll, pres, join rl v d r)
+          else
+            let (lr, pres, rr) = split x r in (join l v d lr, pres, rr)
+
+    let rec merge f s1 s2 =
+      match (s1, s2) with
+        (Empty, Empty) -> Empty
+      | (Node (l1, v1, d1, r1, h1), _) when h1 >= height s2 ->
+          let (l2, d2, r2) = split v1 s2 in
+          concat_or_join (merge f l1 l2) v1 (f v1 (Some d1) d2) (merge f r1 r2)
+      | (_, Node (l2, v2, d2, r2, h2)) ->
+          let (l1, d1, r1) = split v2 s1 in
+          concat_or_join (merge f l1 l2) v2 (f v2 d1 (Some d2)) (merge f r1 r2)
+      | _ ->
+          assert false
+
     type 'a enumeration = End | More of key * 'a * 'a t * 'a enumeration
 
     let rec cons_enum m e =
@@ -205,4 +298,17 @@ module Make(Ord: OrderedType) = struct
             equal_aux (cons_enum r1 e1) (cons_enum r2 e2)
       in equal_aux (cons_enum m1 End) (cons_enum m2 End)
 
+    let rec cardinal = function
+        Empty -> 0
+      | Node(l, _, _, r, _) -> cardinal l + 1 + cardinal r
+
+    let rec bindings_aux accu = function
+        Empty -> accu
+      | Node(l, v, d, r, _) -> bindings_aux ((v, d) :: bindings_aux accu r) l
+
+    let bindings s =
+      bindings_aux [] s
+
+    let choose = min_binding
+
 end
diff --git a/stdlib/map.mli b/stdlib/map.mli
index af1d4d37b..7d1e8355a 100644
--- a/stdlib/map.mli
+++ b/stdlib/map.mli
@@ -52,22 +52,34 @@ module type S =
     val is_empty: 'a t -> bool
     (** Test whether a map is empty or not. *)
 
+    val mem: key -> 'a t -> bool
+    (** [mem x m] returns [true] if [m] contains a binding for [x],
+       and [false] otherwise. *)
+
     val add: key -> 'a -> 'a t -> 'a t
     (** [add x y m] returns a map containing the same bindings as
        [m], plus a binding of [x] to [y]. If [x] was already bound
        in [m], its previous binding disappears. *)
 
-    val find: key -> 'a t -> 'a
-    (** [find x m] returns the current binding of [x] in [m],
-       or raises [Not_found] if no such binding exists. *)
+    val singleton: key -> 'a -> 'a t
+    (** [singleton x y] returns the one-element map that contains a binding [y] for [x]. *)
 
     val remove: key -> 'a t -> 'a t
     (** [remove x m] returns a map containing the same bindings as
        [m], except for [x] which is unbound in the returned map. *)
 
-    val mem: key -> 'a t -> bool
-    (** [mem x m] returns [true] if [m] contains a binding for [x],
-       and [false] otherwise. *)
+    val merge: (key -> 'a option -> 'b option -> 'c option) -> 'a t -> 'b t -> 'c t
+    (** [merge f m1 m2] compute a map whose keys is a subset of keys of [m1] and of [m2]. The presence of each such binding, and the corresponding value, is determined with the function [f]. *)
+
+    val compare: ('a -> 'a -> int) -> 'a t -> 'a t -> int
+    (** Total ordering between maps.  The first argument is a total ordering
+        used to compare data associated with equal keys in the two maps. *)
+
+    val equal: ('a -> 'a -> bool) -> 'a t -> 'a t -> bool
+    (** [equal cmp m1 m2] tests whether the maps [m1] and [m2] are
+       equal, that is, contain equal keys and associate them with
+       equal data.  [cmp] is the equality predicate used to compare
+       the data associated with the keys. *)
 
     val iter: (key -> 'a -> unit) -> 'a t -> unit
     (** [iter f m] applies [f] to all bindings in map [m].
@@ -75,6 +87,65 @@ module type S =
        as second argument.  The bindings are passed to [f] in increasing
        order with respect to the ordering over the type of the keys. *)
 
+    val fold: (key -> 'a -> 'b -> 'b) -> 'a t -> 'b -> 'b
+    (** [fold f m a] computes [(f kN dN ... (f k1 d1 a)...)],
+       where [k1 ... kN] are the keys of all bindings in [m]
+       (in increasing order), and [d1 ... dN] are the associated data. *)
+
+    val for_all: (key -> 'a -> bool) -> 'a t -> bool
+    (** [for_all p m] checks if all the bindings of the map
+       satisfy the predicate [p]. *)
+
+    val exists: (key -> 'a -> bool) -> 'a t -> bool
+    (** [exists p m] checks if at least one binding of the map
+       satisfy the predicate [p]. *)
+
+    val filter: (key -> 'a -> bool) -> 'a t -> 'a t
+    (** [filter p m] returns the map with all the bindings in [m]
+       that satisfy predicate [p]. *)
+
+    val partition: (key -> 'a -> bool) -> 'a t -> 'a t * 'a t
+    (** [partition p m] returns a pair of maps [(m1, m2)], where
+       [m1] contains all the bindings of [s] that satisfy the
+       predicate [p], and [m2] is the map with all the bindings of
+       [s] that do not satisfy [p]. *)
+
+    val cardinal: 'a t -> int
+    (** Return the number of bindings of a map. *)
+
+    val bindings: 'a t -> (key * 'a) list
+    (** Return the list of all bindings of the given map.
+       The returned list is sorted in increasing order with respect
+       to the ordering [Ord.compare], where [Ord] is the argument
+       given to {!Map.Make}. *)
+
+    val min_binding: 'a t -> (key * 'a)
+    (** Return the smallest binding of the given map
+       (with respect to the [Ord.compare] ordering), or raise
+       [Not_found] if the map is empty. *)
+
+    val max_binding: 'a t -> (key * 'a)
+    (** Same as {!Map.S.max_binding}, but returns the largest binding
+       of the given map. *)
+
+    val choose: 'a t -> (key * 'a)
+    (** Return one binding of the given map, or raise [Not_found] if
+       the map is empty. Which binding is chosen is unspecified,
+       but equal bindings will be chosen for equal maps. *)
+
+    val split: key -> 'a t -> 'a t * 'a option * 'a t
+    (** [split x m] returns a triple [(l, data, r)], where
+          [l] is the map with all the bindings of [m] whose key
+        is strictly less than [x];
+          [r] is the map with all the bindings of [m] whose key
+        is strictly greater than [x];
+          [data] is [None] if [m] contains no binding for [x],
+          or [Some v] if [m] binds [v] to [x]. *)
+
+    val find: key -> 'a t -> 'a
+    (** [find x m] returns the current binding of [x] in [m],
+       or raises [Not_found] if no such binding exists. *)
+
     val map: ('a -> 'b) -> 'a t -> 'b t
     (** [map f m] returns a map with same domain as [m], where the
        associated value [a] of all bindings of [m] has been
@@ -86,20 +157,6 @@ module type S =
     (** Same as {!Map.S.map}, but the function receives as arguments both the
        key and the associated value for each binding of the map. *)
 
-    val fold: (key -> 'a -> 'b -> 'b) -> 'a t -> 'b -> 'b
-    (** [fold f m a] computes [(f kN dN ... (f k1 d1 a)...)],
-       where [k1 ... kN] are the keys of all bindings in [m]
-       (in increasing order), and [d1 ... dN] are the associated data. *)
-
-    val compare: ('a -> 'a -> int) -> 'a t -> 'a t -> int
-    (** Total ordering between maps.  The first argument is a total ordering
-        used to compare data associated with equal keys in the two maps. *)
-
-    val equal: ('a -> 'a -> bool) -> 'a t -> 'a t -> bool
-    (** [equal cmp m1 m2] tests whether the maps [m1] and [m2] are
-       equal, that is, contain equal keys and associate them with
-       equal data.  [cmp] is the equality predicate used to compare
-       the data associated with the keys. *)
 
   end
 (** Output signature of the functor {!Map.Make}. *)
diff --git a/stdlib/moreLabels.mli b/stdlib/moreLabels.mli
index fbf848cba..55c773347 100644
--- a/stdlib/moreLabels.mli
+++ b/stdlib/moreLabels.mli
@@ -73,18 +73,30 @@ module Map : sig
       and (+'a) t
       val empty : 'a t
       val is_empty: 'a t -> bool
-      val add : key:key -> data:'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 add : key:key -> data:'a -> 'a t -> 'a t
+      val singleton: key -> 'a -> 'a t
+      val remove : key -> 'a t -> 'a t
+      val merge: f:(key -> 'a option -> 'b option -> 'c option) -> 'a t -> 'b t -> 'c t
+      val compare: cmp:('a -> 'a -> int) -> 'a t -> 'a t -> int
+      val equal: cmp:('a -> 'a -> bool) -> 'a t -> 'a t -> bool
       val iter : f:(key:key -> data:'a -> unit) -> 'a t -> unit
-      val map : f:('a -> 'b) -> 'a t -> 'b t
-      val mapi : f:(key -> 'a -> 'b) -> 'a t -> 'b t
       val fold :
           f:(key:key -> data:'a -> 'b -> 'b) ->
           'a t -> init:'b -> 'b
-      val compare: cmp:('a -> 'a -> int) -> 'a t -> 'a t -> int
-      val equal: cmp:('a -> 'a -> bool) -> 'a t -> 'a t -> bool
+      val for_all: f:(key -> 'a -> bool) -> 'a t -> bool
+      val exists: f:(key -> 'a -> bool) -> 'a t -> bool
+      val filter: f:(key -> 'a -> bool) -> 'a t -> 'a t
+      val partition: f:(key -> 'a -> bool) -> 'a t -> 'a t * 'a t
+      val cardinal: 'a t -> int
+      val bindings: 'a t -> (key * 'a) list
+      val min_binding: 'a t -> (key * 'a)
+      val max_binding: 'a t -> (key * 'a)
+      val choose: 'a t -> (key * 'a)
+      val split: key -> 'a t -> 'a t * 'a option * 'a t
+      val find : key -> 'a t -> 'a
+      val map : f:('a -> 'b) -> 'a t -> 'b t
+      val mapi : f:(key -> 'a -> 'b) -> 'a t -> 'b t
   end
   module Make : functor (Ord : OrderedType) -> S with type key = Ord.t
 end
diff --git a/testsuite/tests/basic/maps.ml b/testsuite/tests/basic/maps.ml
new file mode 100644
index 000000000..cb0e989b1
--- /dev/null
+++ b/testsuite/tests/basic/maps.ml
@@ -0,0 +1,28 @@
+(***********************************************************************)
+(*                                                                     *)
+(*                           Objective Caml                            *)
+(*                                                                     *)
+(*            Xavier Leroy, projet Cristal, INRIA Rocquencourt         *)
+(*                                                                     *)
+(*  Copyright 1996 Institut National de Recherche en Informatique et   *)
+(*  en Automatique.  All rights reserved.  This file is distributed    *)
+(*  under the terms of the Q Public License version 1.0.               *)
+(*                                                                     *)
+(***********************************************************************)
+
+(* $Id: sets.ml 5183 2002-10-16 09:06:39Z weis $ *)
+
+module IntMap = Map.Make(struct type t = int let compare x y = x-y end)
+
+let m1 = IntMap.add 4 "Y" (IntMap.singleton 3 "X1")
+let m2 = IntMap.add 4 "Y" (IntMap.singleton 5 "X2")
+
+let show m = IntMap.iter (fun k v -> Printf.printf "%d %s\n" k v) m
+
+let () =
+  print_endline "Union+concat";
+  show (IntMap.merge (fun _ l r -> match l, r with Some x, None | None, Some x -> Some x | Some x, Some y -> Some (x ^ x) | _ -> assert false) m1 m2);
+  print_endline "Inter";
+  show (IntMap.merge (fun _ l r -> match l, r with Some x, Some y when x = y -> Some x | _ -> None) m1 m2);
+  ()
+
diff --git a/testsuite/tests/basic/maps.reference b/testsuite/tests/basic/maps.reference
new file mode 100644
index 000000000..c7b0c0833
--- /dev/null
+++ b/testsuite/tests/basic/maps.reference
@@ -0,0 +1,6 @@
+Union+concat
+3 X1
+4 YY
+5 X2
+Inter
+4 Y