[MLton-commit] r4839

[Vesa Karvonen]

Added map, min, and max.
----------------------------------------------------------------------

U   mltonlib/trunk/com/ssh/basic/unstable/basic.mlb
U   mltonlib/trunk/com/ssh/basic/unstable/detail/cmp.sml
U   mltonlib/trunk/com/ssh/basic/unstable/public/cmp.sig

----------------------------------------------------------------------

Modified: mltonlib/trunk/com/ssh/basic/unstable/basic.mlb
===================================================================
--- mltonlib/trunk/com/ssh/basic/unstable/basic.mlb	2006-11-19 18:21:27 UTC (rev 4838)
+++ mltonlib/trunk/com/ssh/basic/unstable/basic.mlb	2006-11-19 19:45:33 UTC (rev 4839)
@@ -58,7 +58,7 @@
             bas public/bin-pr.sig detail/bin-pr.sml end
          end
          basis Cmp = let
-            open BinPr Order Sq
+            open BinOp BinPr Fn Order Sq
          in
             bas public/cmp.sig detail/cmp.sml end
          end

Modified: mltonlib/trunk/com/ssh/basic/unstable/detail/cmp.sml
===================================================================
--- mltonlib/trunk/com/ssh/basic/unstable/detail/cmp.sml	2006-11-19 18:21:27 UTC (rev 4838)
+++ mltonlib/trunk/com/ssh/basic/unstable/detail/cmp.sml	2006-11-19 19:45:33 UTC (rev 4839)
@@ -7,11 +7,17 @@
 structure Cmp :> CMP = struct
    type 'a t = 'a Sq.t -> Order.t
 
-   fun mkRelOps cmp = let
+   fun map b2a = Fn.map (Sq.map b2a, Fn.id)
+
+   local
       open Order
    in
-      {<  = isLess    o cmp, <= = not o isGreater o cmp,
-       == = isEqual   o cmp, != = not o isEqual   o cmp,
-       >  = isGreater o cmp, >= = not o isLess    o cmp}
+      fun mkRelOps cmp =
+          {<  = isLess    o cmp, <= = not o isGreater o cmp,
+           == = isEqual   o cmp, != = not o isEqual   o cmp,
+           >  = isGreater o cmp, >= = not o isLess    o cmp}
+
+      fun max cmp (x, y) = if isLess (cmp (x, y)) then y else x
+      fun min cmp (x, y) = if isGreater (cmp (x, y)) then y else x
    end
 end

Modified: mltonlib/trunk/com/ssh/basic/unstable/public/cmp.sig
===================================================================
--- mltonlib/trunk/com/ssh/basic/unstable/public/cmp.sig	2006-11-19 18:21:27 UTC (rev 4838)
+++ mltonlib/trunk/com/ssh/basic/unstable/public/cmp.sig	2006-11-19 19:45:33 UTC (rev 4839)
@@ -4,13 +4,31 @@
  * See the file MLton-LICENSE for details.
  *)
 
-(** Utilities for dealing with compare functions. *)
+(** Utilities for dealing with compare functions or orderings. *)
 signature CMP = sig
    type 'a t = 'a Sq.t -> Order.t
-   (** Type of compare functions (e.g. {Int.compare, String.compare, ...}). *)
+   (**
+    * Type of compare functions or orderings (e.g. {Int.compare,
+    * String.compare, ...}).
+    *)
 
+   val map : ('b -> 'a) -> 'a t -> 'b t
+   (** Changes the domain of an ordering. *)
+
    val mkRelOps : 'a t -> {<  : 'a BinPr.t, <= : 'a BinPr.t,
                            >  : 'a BinPr.t, >= : 'a BinPr.t,
                            == : 'a BinPr.t, != : 'a BinPr.t}
-   (** Returns a record of relational operators given a compare function. *)
+   (** Given an ordering, returns a record of relational operators. *)
+
+   val max : 'a t -> 'a BinOp.t
+   (**
+    * Given an ordering, returns a function that returns the greater of
+    * its arguments.
+    *)
+
+   val min : 'a t -> 'a BinOp.t
+   (**
+    * Given an ordering, returns a function that returns the lesser of its
+    * arguments.
+    *)
 end