4af7b3dd9d46 — Chris Cannam tip 2 months ago
Updated versions of containers from more recent upstream
M hash-key-sig.sml +4 -4
@@ 1,14 1,14 @@ 
 (* hash-key-sig.sml
  *
- * COPYRIGHT (c) 1993 by AT&T Bell Laboratories.  See COPYRIGHT file for details.
+ * COPYRIGHT (c) 2018 The Fellowship of SML/NJ (http://www.smlnj.org)
+ * All rights reserved.
  *
  * Abstract hash table keys.  This is the argument signature for the hash table
  * functor (see hash-table-sig.sml and hash-table.sml).
  *
  * AUTHOR:  John Reppy
- *	    AT&T Bell Laboratories
- *	    Murray Hill, NJ 07974
- *	    jhr@research.att.com
+ *	    University of Chicago
+ *	    https://cs.uchicago.edu/~jhr
  *)
 
 signature HASH_KEY =

          
M hash-table-fn.sml +6 -6
@@ 1,14 1,14 @@ 
 (* hash-table-fn.sml
  *
- * COPYRIGHT (c) 1992 by AT&T Bell Laboratories.
+ * COPYRIGHT (c) 2018 The Fellowship of SML/NJ (http://www.smlnj.org)
+ * All rights reserved.
  *
  * A hash table functor.  It takes a key type with two operations: sameKey and
  * hashVal as arguments (see hash-key-sig.sml).
  *
  * AUTHOR:  John Reppy
- *	    AT&T Bell Laboratories
- *	    Murray Hill, NJ 07974
- *	    jhr@research.att.com
+ *	    University of Chicago
+ *	    https://cs.uchicago.edu/~jhr
  *)
 
 functor HashTableFn (Key : HASH_KEY) : MONO_HASH_TABLE =

          
@@ 71,7 71,7 @@ functor HashTableFn (Key : HASH_KEY) : M
 	  val hash = hashVal key
 	  val indx = index (hash, Array.length arr)
 	  fun look HTRep.NIL = false
-	    | look (HTRep.B(h, k, v, r)) = 
+	    | look (HTRep.B(h, k, v, r)) =
 		((hash = h) andalso sameKey(key, k)) orelse look r
 	  in
 	    look (Array.sub (arr, indx))

          
@@ 161,7 161,7 @@ functor HashTableFn (Key : HASH_KEY) : M
    *)
     fun filteri pred (HT{table, n_items, ...}) =
 	  n_items := HTRep.filteri pred (! table)
-    fun filter pred (HT{table, n_items, ...}) = 
+    fun filter pred (HT{table, n_items, ...}) =
 	  n_items := HTRep.filter pred (! table)
 
   (* Create a copy of a hash table *)

          
M hash-table-rep.sml +24 -9
@@ 1,16 1,15 @@ 
 (* hash-table-rep.sml
  *
- * COPYRIGHT (c) 1993 by AT&T Bell Laboratories.
- * COPYRIGHT (c) 1996 AT&T Research.
+ * COPYRIGHT (c) 2018 The Fellowship of SML/NJ (http://www.smlnj.org)
+ * All rights reserved.
  *
  * This is the internal representation of hash tables, along with some
  * utility functions.  It is used in both the polymorphic and functor
  * hash table implementations.
  *
  * AUTHOR:  John Reppy
- *	    AT&T Bell Laboratories
- *	    Murray Hill, NJ 07974
- *	    jhr@research.att.com
+ *	    University of Chicago
+ *	    https://cs.uchicago.edu/~jhr
  *)
 
 structure HashTableRep : sig

          
@@ 67,13 66,29 @@ structure HashTableRep : sig
 
     fun index (i, sz) = Word.toIntX(Word.andb(i, Word.fromInt sz - 0w1))
 
-  (* find smallest power of 2 (<= 32) that is >= n *)
-    fun roundUp n = let
-	  fun f i = if (i >= n) then i else f(i * 2)
+  (* minimum and maximum hash table sizes.  We use powers of two for hash table
+   * sizes, since that give efficient indexing, and assume a minimum size of 32.
+   *)
+    val minSize = 32
+    val maxSize = let
+	  fun f i = let
+		  val i' = i+i
+		  in
+		    if i' < Array.maxLen then f i' else i
+		  end handle Overflow => i
 	  in
-	    f 32
+	    f 0x10000
 	  end
 
+  (* round up `n` to the next hash-table size *)
+    fun roundUp n = if (n >= maxSize)
+	  then maxSize
+	  else let
+	    fun f i = if (i >= n) then i else f(i + i)
+	    in
+	      f minSize
+	    end
+
   (* Create a new table; the int is a size hint and the exception
    * is to be raised by find.
    *)

          
M int-hash-table.sml +6 -6
@@ 1,13 1,13 @@ 
 (* int-hash-table.sml
  *
- * COPYRIGHT (c) 1999 Bell Labs, Lucent Technologies.
+ * COPYRIGHT (c) 2018 The Fellowship of SML/NJ (http://www.smlnj.org)
+ * All rights reserved.
  *
  * A specialization of the hash table functor to integer keys.
  *
  * AUTHOR:  John Reppy
- *	    Bell Labs
- *	    Murray Hill, NJ 07974
- *	    jhr@research.bell-labs.com
+ *	    University of Chicago
+ *	    https://cs.uchicago.edu/~jhr
  *)
 
 structure IntHashTable :> MONO_HASH_TABLE where type Key.hash_key = int =

          
@@ 76,7 76,7 @@ structure IntHashTable :> MONO_HASH_TABL
 	  val hash = hashVal key
 	  val indx = index (hash, Array.length arr)
 	  fun look HTRep.NIL = false
-	    | look (HTRep.B(h, k, v, r)) = 
+	    | look (HTRep.B(h, k, v, r)) =
 		((hash = h) andalso sameKey(key, k)) orelse look r
 	  in
 	    look (Array.sub (arr, indx))

          
@@ 166,7 166,7 @@ structure IntHashTable :> MONO_HASH_TABL
    *)
     fun filteri pred (HT{table, n_items, ...}) =
 	  n_items := HTRep.filteri pred (! table)
-    fun filter pred (HT{table, n_items, ...}) = 
+    fun filter pred (HT{table, n_items, ...}) =
 	  n_items := HTRep.filter pred (! table)
 
   (* Create a copy of a hash table *)

          
M int-redblack-map.sml +50 -6
@@ 84,13 84,57 @@ structure IntRedBlackMap :> ORD_MAP wher
 			      (* end case *))
 		      | _ => T(B, a, yk, y, ins b)
 		    (* end case *))
-          in
-	    case ins m
-  	    of E => raise Fail "cannot be empty here"
-	     | T(_, a, yk, y, b) => MAP(!nItems', T(B, a, yk, y, b))
-	  end
+    in
+        case ins m of
+            E => raise Fail "cannot be empty here"
+          | T(_, a, yk, y, b) => MAP(!nItems', T(B, a, yk, y, b))
+    end
     fun insert' ((xk, x), m) = insert (m, xk, x)
 
+    fun insertWithi comb (MAP(nItems, m), xk, x) = let
+	  val nItems' = ref nItems
+	  fun ins E = (nItems' := nItems+1; T(R, E, xk, x, E))
+            | ins (s as T(color, a, yk, y, b)) =
+		if (xk < yk)
+		  then (case a
+		     of T(R, c, zk, z, d) =>
+			  if (xk < zk)
+			    then (case ins c
+			       of T(R, e, wk, w, f) => T(R, T(B,e,wk,w,f), zk, z, T(B,d,yk,y,b))
+                		| c => T(B, T(R,c,zk,z,d), yk, y, b)
+			      (* end case *))
+			  else if (xk = zk)
+			    then T(color, T(R, c, xk, comb(xk, z, x), d), yk, y, b)
+			    else (case ins d
+			       of T(R, e, wk, w, f) => T(R, T(B,c,zk,z,e), wk, w, T(B,f,yk,y,b))
+                		| d => T(B, T(R,c,zk,z,d), yk, y, b)
+			      (* end case *))
+		      | _ => T(B, ins a, yk, y, b)
+		    (* end case *))
+		else if (xk = yk)
+		  then T(color, a, xk, comb(xk, y, x), b)
+		  else (case b
+		     of T(R, c, zk, z, d) =>
+			  if (xk < zk)
+			    then (case ins c
+			       of T(R, e, wk, w, f) => T(R, T(B,a,yk,y,e), wk, w, T(B,f,zk,z,d))
+				| c => T(B, a, yk, y, T(R,c,zk,z,d))
+			      (* end case *))
+			  else if (xk = zk)
+			    then T(color, a, yk, y, T(R, c, xk, comb(xk, z, x), d))
+			    else (case ins d
+			       of T(R, e, wk, w, f) => T(R, T(B,a,yk,y,c), zk, z, T(B,e,wk,w,f))
+				| d => T(B, a, yk, y, T(R,c,zk,z,d))
+			      (* end case *))
+		      | _ => T(B, a, yk, y, ins b)
+		    (* end case *))
+    in
+        case ins m of
+            E => raise Fail "cannot be empty here"
+          | T(_, a, yk, y, b) => MAP(!nItems', T(B, a, yk, y, b))
+    end
+    fun insertWith comb = insertWithi (fn (_, x1, x2) => comb(x1, x2))
+
   (* Is a key in the domain of the map? *)
     fun inDomain (MAP(_, t), k) = let
 	  fun find' E = false

          
@@ 225,7 269,7 @@ structure IntRedBlackMap :> ORD_MAP wher
 			 * left child recolored to black.
 			 *)
 			  (y, zip(p, T(B, a', yk', y', b')))
-		      | (_, E, T(_, a', yk', y', b')) => 
+		      | (_, E, T(_, a', yk', y', b')) =>
 			(* node is black and right child is red; we replace the node with its
 			 * right child recolored to black.
 			 *)

          
M lib-base-sig.sml +2 -2
@@ 1,6 1,7 @@ 
 (* lib-base-sig.sml
  *
- * COPYRIGHT (c) 1993 by AT&T Bell Laboratories.  See COPYRIGHT file for details.
+ * COPYRIGHT (c) 2020 The Fellowship of SML/NJ (http://www.smlnj.org)
+ * All rights reserved.
  *)
 
 signature LIB_BASE =

          
@@ 18,4 19,3 @@ signature LIB_BASE =
 	(* raise the exception Fail with a standard format message. *)
 
   end (* LIB_BASE *)
-

          
M lib-base.sml +2 -2
@@ 1,6 1,7 @@ 
 (* lib-base.sml
  *
- * COPYRIGHT (c) 1993 by AT&T Bell Laboratories.  See COPYRIGHT file for details.
+ * COPYRIGHT (c) 2020 The Fellowship of SML/NJ (http://www.smlnj.org)
+ * All rights reserved.
  *)
 
 structure LibBase : LIB_BASE =

          
@@ 20,4 21,3 @@ structure LibBase : LIB_BASE =
 	  raise (Fail(concat[module, ".", func, ": ", msg]))
 
   end (* LibBase *)
-

          
M listsort-sig.sml +5 -4
@@ 1,6 1,7 @@ 
 (* listsort-sig.sml
  *
- * COPYRIGHT (c) 1989 by AT&T Bell Laboratories
+ * COPYRIGHT (c) 2020 The Fellowship of SML/NJ (http://www.smlnj.org)
+ * All rights reserved.
  *
  * The generic list sorting interface.  Taken from the SML/NJ compiler.
  *)

          
@@ 8,17 9,17 @@ 
 signature LIST_SORT =
   sig
 
-     val sort : ('a * 'a -> bool) -> 'a list -> 'a list  
+     val sort : ('a * 'a -> bool) -> 'a list -> 'a list
 	(* (sort gt l) sorts the list l in ascending order using the
 	 * ``greater-than'' relationship defined by gt.
 	 *)
 
      val uniqueSort : ('a * 'a -> order) -> 'a list -> 'a list
-       (* uniquesort produces an increasing list, removing equal 
+       (* uniquesort produces an increasing list, removing equal
         * elements
         *)
 
-     val sorted : ('a * 'a -> bool) -> 'a list -> bool  
+     val sorted : ('a * 'a -> bool) -> 'a list -> bool
 	(* (sorted gt l) returns true if the list is sorted in ascending
 	 * order under the ``greater-than'' predicate gt.
 	 *)

          
M mono-hash-table-sig.sml +4 -4
@@ 1,13 1,13 @@ 
 (* mono-hash-table-sig.sml
  *
- * COPYRIGHT (c) 1992 by AT&T Bell Laboratories.
+ * COPYRIGHT (c) 2018 The Fellowship of SML/NJ (http://www.smlnj.org)
+ * All rights reserved.
  *
  * The result signature of the hash table functor (see hash-table.sml).
  *
  * AUTHOR:  John Reppy
- *	    AT&T Bell Laboratories
- *	    Murray Hill, NJ 07974
- *	    jhr@research.att.com
+ *	    University of Chicago
+ *	    https://cs.uchicago.edu/~jhr
  *)
 
 signature MONO_HASH_TABLE =

          
M ord-key-sig.sml +5 -2
@@ 1,15 1,18 @@ 
 (* ord-key-sig.sml
  *
- * COPYRIGHT (c) 1993 by AT&T Bell Laboratories.  See COPYRIGHT file for details.
+ * COPYRIGHT (c) 2020 The Fellowship of SML/NJ (http://www.smlnj.org)
+ * All rights reserved.
  *
  * Abstract linearly ordered keys.
- *
  *)
 
 signature ORD_KEY =
   sig
+
+  (* the type of keys *)
     type ord_key
 
+  (* defines a total ordering on the ord_key type *)
     val compare : ord_key * ord_key -> order
 
   end (* ORD_KEY *)

          
M ord-map-sig.sml +12 -1
@@ 1,6 1,6 @@ 
 (* ord-map-sig.sml
  *
- * COPYRIGHT (c) 2012 The Fellowship of SML/NJ (http://www.smlnj.org)
+ * COPYRIGHT (c) 2020 The Fellowship of SML/NJ (http://www.smlnj.org)
  * All rights reserved.
  *
  * COPYRIGHT (c) 1996 by AT&T Research.  See COPYRIGHT file for details.

          
@@ 13,6 13,7 @@ signature ORD_MAP =
   sig
 
     structure Key : ORD_KEY
+	(* the map's domain and its comparison function *)
 
     type 'a map
 

          
@@ 29,6 30,16 @@ signature ORD_MAP =
     val insert' : ((Key.ord_key * 'a) * 'a map) -> 'a map
 	(* Insert an item. *)
 
+    val insertWith  : ('a * 'a -> 'a) -> 'a map * Key.ord_key * 'a -> 'a map
+	(* Insert an item with a combining function to resolve collisions.
+	 * The first argument to the combining function is the existing value,
+	 * and the second argument is the value being inserted into the map.
+	 *)
+    val insertWithi : (Key.ord_key * 'a * 'a -> 'a) -> 'a map * Key.ord_key * 'a -> 'a map
+	(* Like insertWith, except that the combining function also takes the
+	 * key as an argument.
+	 *)
+
     val find : 'a map * Key.ord_key -> 'a option
 	(* Look for an item, return NONE if the item doesn't exist *)
 

          
M ord-set-sig.sml +40 -7
@@ 9,6 9,7 @@ signature ORD_SET =
   sig
 
     structure Key : ORD_KEY
+	(* the set elements and their comparison function *)
 
     type item = Key.ord_key
     type set

          
@@ 22,6 23,11 @@ signature ORD_SET =
     val fromList : item list -> set
 	(* create a set from a list of items *)
 
+    val toList : set -> item list
+	(* Return an ordered list of the items in the set.
+         * Added in SML/NJ 110.80.
+         *)
+
     val add  : set * item -> set
     val add' : (item * set) -> set
 	(* Add an item. *)

          
@@ 45,6 51,16 @@ signature ORD_SET =
     val isEmpty : set -> bool
 	(* Return true if and only if the set is empty *)
 
+    val minItem : set -> item
+	(* return the smallest element of the set (raises Empty if the set is empty).
+         * Added in SML/NJ 110.80.
+         *)
+
+    val maxItem : set -> item
+	(* return the largest element of the set (raises Empty if the set is empty).
+         * Added in SML/NJ 110.80.
+         *)
+
     val equal : (set * set) -> bool
 	(* Return true if and only if the two sets are equal *)
 

          
@@ 54,12 70,12 @@ signature ORD_SET =
     val isSubset : (set * set) -> bool
 	(* Return true if and only if the first set is a subset of the second *)
 
+    val disjoint : set * set -> bool
+	(* are the two sets disjoint? *)
+
     val numItems : set ->  int
 	(* Return the number of items in the table *)
 
-    val listItems : set -> item list
-	(* Return an ordered list of the items in the set *)
-
     val union : set * set -> set
         (* Union *)
 

          
@@ 73,25 89,38 @@ signature ORD_SET =
 	(* Create a new set by applying a map function to the elements
 	 * of the set.
          *)
-     
+
+    val mapPartial : (item -> item option) -> set -> set
+	(* Create a new set by mapping a partial function over the
+	 * items in the set.
+	 *)
+
     val app : (item -> unit) -> set -> unit
-	(* Apply a function to the entries of the set 
+	(* Apply a function to the entries of the set
          * in increasing order
          *)
 
     val foldl : (item * 'b -> 'b) -> 'b -> set -> 'b
-	(* Apply a folding function to the entries of the set 
+	(* Apply a folding function to the entries of the set
          * in increasing order
          *)
 
     val foldr : (item * 'b -> 'b) -> 'b -> set -> 'b
-	(* Apply a folding function to the entries of the set 
+	(* Apply a folding function to the entries of the set
          * in decreasing order
          *)
 
     val partition : (item -> bool) -> set -> (set * set)
+	(* partition a set into two based using the given predicate.  Returns two
+	 * sets, where the first contains those elements for which the predicate is
+	 * true and the second contains those elements for which the predicate is
+	 * false.
+	 *)
 
     val filter : (item -> bool) -> set -> set
+	(* filter a set by the given predicate returning only those elements for
+	 * which the predicate is true.
+	 *)
 
     val exists : (item -> bool) -> set -> bool
 	(* check the elements of a set with a predicate and return true if

          
@@ 106,5 135,9 @@ signature ORD_SET =
 	 *)
 
     val find : (item -> bool) -> set -> item option
+	(* find an element in the set for which the predicate is true *)
+
+  (* DEPRECATED FUNCTIONS *)
+    val listItems : set -> item list
 
   end (* ORD_SET *)

          
M redblack-map-fn.sml +59 -8
@@ 3,8 3,6 @@ 
  * COPYRIGHT (c) 2014 The Fellowship of SML/NJ (http://www.smlnj.org)
  * All rights reserved.
  *
- * COPYRIGHT (c) 1999 Bell Labs, Lucent Technologies.
- *
  * This code is based on Chris Okasaki's implementation of
  * red-black trees.  The linear-time tree construction code is
  * based on the paper "Constructing red-black trees" by Hinze,

          
@@ 81,13 79,66 @@ functor RedBlackMapFn (K : ORD_KEY) :> O
 			| _ => T(B, a, yk, y, ins b)
 		      (* end case *))
 		(* end case *))
-          in
-	    case ins m
-  	    of E => raise Fail "cannot be empty here"
-	     | T(_, a, yk, y, b) => MAP(!nItems', T(B, a, yk, y, b))
-	  end
+    in
+        case ins m of
+            E => raise Fail "cannot be empty here"
+	 | T(_, a, yk, y, b) => MAP(!nItems', T(B, a, yk, y, b))
+    end
     fun insert' ((xk, x), m) = insert (m, xk, x)
 
+    fun insertWithi comb (MAP(nItems, m), xk, x) = let
+	  val nItems' = ref nItems
+	  fun ins E = (nItems' := nItems+1; T(R, E, xk, x, E))
+            | ins (s as T(color, a, yk, y, b)) = (case K.compare(xk, yk)
+		 of LESS => (case a
+		       of T(R, c, zk, z, d) => (case K.compare(xk, zk)
+			     of LESS => (case ins c
+				   of T(R, e, wk, w, f) =>
+					T(R, T(B,e,wk, w,f), zk, z, T(B,d,yk,y,b))
+                		    | c => T(B, T(R,c,zk,z,d), yk, y, b)
+				  (* end case *))
+			      | EQUAL => let
+				  val x' = comb(xk, z, x)
+				  in
+				    T(color, T(R, c, xk, x', d), yk, y, b)
+				  end
+			      | GREATER => (case ins d
+				   of T(R, e, wk, w, f) =>
+					T(R, T(B,c,zk,z,e), wk, w, T(B,f,yk,y,b))
+                		    | d => T(B, T(R,c,zk,z,d), yk, y, b)
+				  (* end case *))
+			    (* end case *))
+			| _ => T(B, ins a, yk, y, b)
+		      (* end case *))
+		  | EQUAL => T(color, a, xk, comb(xk, y, x), b)
+		  | GREATER => (case b
+		       of T(R, c, zk, z, d) => (case K.compare(xk, zk)
+			     of LESS => (case ins c
+				   of T(R, e, wk, w, f) =>
+					T(R, T(B,a,yk,y,e), wk, w, T(B,f,zk,z,d))
+				    | c => T(B, a, yk, y, T(R,c,zk,z,d))
+				  (* end case *))
+			      | EQUAL => let
+				  val x' = comb(xk, z, x)
+				  in
+				    T(color, a, yk, y, T(R, c, xk, x', d))
+				  end
+			      | GREATER => (case ins d
+				   of T(R, e, wk, w, f) =>
+					T(R, T(B,a,yk,y,c), zk, z, T(B,e,wk,w,f))
+				    | d => T(B, a, yk, y, T(R,c,zk,z,d))
+				  (* end case *))
+			    (* end case *))
+			| _ => T(B, a, yk, y, ins b)
+		      (* end case *))
+		(* end case *))
+    in
+        case ins m of
+            E => raise Fail "cannot be empty here"
+	 | T(_, a, yk, y, b) => MAP(!nItems', T(B, a, yk, y, b))
+    end
+    fun insertWith comb = insertWithi (fn (_, x1, x2) => comb(x1, x2))
+
   (* Is a key in the domain of the map? *)
     fun inDomain (MAP(_, t), k) = let
 	  fun find' E = false

          
@@ 221,7 272,7 @@ functor RedBlackMapFn (K : ORD_KEY) :> O
 			   * left child recolored to black.
 			   *)
 			    (y, zip(p, T(B, a', yk', y', b')))
-			| (_, E, T(_, a', yk', y', b')) => 
+			| (_, E, T(_, a', yk', y', b')) =>
 			  (* node is black and right child is red; we replace the node with its
 			   * right child recolored to black.
 			   *)

          
M redblack-set-fn.sml +49 -10
@@ 3,8 3,6 @@ 
  * COPYRIGHT (c) 2014 The Fellowship of SML/NJ (http://www.smlnj.org)
  * All rights reserved.
  *
- * COPYRIGHT (c) 1999 Bell Labs, Lucent Technologies.
- *
  * This code is based on Chris Okasaki's implementation of
  * red-black trees.  The linear-time tree construction code is
  * based on the paper "Constructing red-black trees" by Hinze,

          
@@ 43,6 41,22 @@ functor RedBlackSetFn (K : ORD_KEY) :> O
 
     val empty = SET(0, E)
 
+    fun minItem (SET(_, tr)) = let
+	  fun min E = raise Empty
+	    | min (T(_, E, item, _)) = item
+	    | min (T(_, tr, _, _)) = min tr
+	  in
+	    min tr
+	  end
+
+    fun maxItem (SET(_, tr)) = let
+	  fun max E = raise Empty
+	    | max (T(_, _, item, E)) = item
+	    | max (T(_, _, _, tr)) = max tr
+	  in
+	    max tr
+	  end
+
     fun singleton x = SET(1, T(B, E, x, E))
 
     fun add (SET(nItems, m), x) = let

          
@@ 79,11 93,11 @@ functor RedBlackSetFn (K : ORD_KEY) :> O
 			| _ => T(B, a, y, ins b)
 		      (* end case *))
 		(* end case *))
-          in
-	    case ins m
-  	    of E => raise Fail "cannot be empty here"
-             | T(_, a, y, b) => SET(!nItems', T(B, a, y, b))
-	  end
+    in
+        case ins m
+        of E => raise Fail "cannot be empty here"
+         | T(_, a, y, b) => SET(!nItems', T(B, a, y, b))
+    end
     fun add' (x, m) = add (m, x)
 
     fun addList (s, []) = s

          
@@ 97,7 111,7 @@ functor RedBlackSetFn (K : ORD_KEY) :> O
 	| RIGHT of (color * tree * item * zipper)
     in
     fun delete (SET(nItems, t), k) = let
-	(* zip the zipper *) 
+	(* zip the zipper *)
 	  fun zip (TOP, t) = t
 	    | zip (LEFT(color, x, b, p), a) = zip(p, T(color, a, x, b))
 	    | zip (RIGHT(color, a, x, p), b) = zip(p, T(color, a, x, b))

          
@@ 184,7 198,7 @@ functor RedBlackSetFn (K : ORD_KEY) :> O
 			   * left child recolored to black.
 			   *)
 			    zip(p, T(B, a', y', b'))
-			| (_, E, T(_, a', y', b')) => 
+			| (_, E, T(_, a', y', b')) =>
 			  (* node is black and right child is red; we replace the node with its
 			   * right child recolored to black.
 			   *)

          
@@ 239,7 253,7 @@ functor RedBlackSetFn (K : ORD_KEY) :> O
 	  end
 
   (* return an ordered list of the items in the set. *)
-    fun listItems s = foldr (fn (x, l) => x::l) [] s
+    fun toList s = foldr (fn (x, l) => x::l) [] s
 
   (* functions for walking the tree while keeping a stack of parents
    * to be visited.

          
@@ 299,6 313,22 @@ functor RedBlackSetFn (K : ORD_KEY) :> O
 	    cmp (start s1, start s2)
 	  end
 
+  (* Return true if the two sets are disjoint *)
+    fun disjoint (SET(0, _), _) = true
+      | disjoint (_, SET(0, _)) = true
+      | disjoint (SET(_, s1), SET(_, s2)) = let
+	  fun walk ((E, _), _) = true
+	    | walk (_, (E, _)) = true
+	    | walk (t1 as (T(_, _, x, _), r1), t2 as (T(_, _, y, _), r2)) = (
+		case Key.compare(x, y)
+		 of LESS => walk (next r1, t2)
+		  | EQUAL => false
+		  | GREATER => walk (t1, next r2)
+		(* end case *))
+	  in
+	    walk (next (start s1), next (start s2))
+	  end
+
   (* support for constructing red-black trees in linear time from increasing
    * ordered sequences (based on a description by R. Hinze).  Note that the
    * elements in the digits are ordered with the largest on the left, whereas

          
@@ 421,6 451,12 @@ functor RedBlackSetFn (K : ORD_KEY) :> O
 	    foldl addf empty
 	  end
 
+    fun mapPartial f = let
+	  fun f' (x, acc) = (case f x of SOME x' => add(acc, x') | NONE => acc)
+	  in
+	    foldl f' empty
+	  end
+
   (* Filter out those elements of the set that do not satisfy the
    * predicate.  The filtering is done in increasing map order.
    *)

          
@@ 476,4 512,7 @@ functor RedBlackSetFn (K : ORD_KEY) :> O
 	    fn (SET(_, t)) => test t
 	  end
 
+  (* DEPRECATED FUNCTIONS *)
+    val listItems = toList
+
   end;