[MLton-commit] r4886

[Vesa Karvonen]

Some minor addition to Sum : SUM.

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

U   mltonlib/trunk/com/ssh/extended-basis/unstable/detail/sum.sml
U   mltonlib/trunk/com/ssh/extended-basis/unstable/extensions.mlb
U   mltonlib/trunk/com/ssh/extended-basis/unstable/public/sum.sig

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

Modified: mltonlib/trunk/com/ssh/extended-basis/unstable/detail/sum.sml
===================================================================
--- mltonlib/trunk/com/ssh/extended-basis/unstable/detail/sum.sml	2006-11-30 15:48:32 UTC (rev 4885)
+++ mltonlib/trunk/com/ssh/extended-basis/unstable/detail/sum.sml	2006-11-30 15:53:21 UTC (rev 4886)
@@ -14,20 +14,23 @@
    val swap = fn INL x => INR x | INR x => INL x
 
    val out = fn INL x => x | INR x => x
-
    val app = sum
    fun map (fA, fB) = sum (INL o fA, INR o fB)
 
-   val isL = fn INL _ => true | INR _ => false
-   val outL = fn INL l => l | INR _ => raise Sum
-   val getL = fn INL x => (fn _ => x) | INR _ => (fn x => x)
-   fun mapL f = map (f, fn r => r)
+   fun appL f = app (f, ignore)
+   fun getL (INL x) _ = x | getL (INR _) x = x
+   fun isL (INL _) = true | isL (INR _) = false
+   fun mapL f = map (f, Fn.id)
+   fun outL (INL l) = l | outL (INR _) = raise Sum
 
+   fun appR f = appL f o swap
+   fun getR ? = (getL o swap) ?
    fun isR ? = (isL o swap) ?
+   fun mapR f = swap o mapL f o swap
    fun outR ? = (outL o swap) ?
-   fun getR ? = (getL o swap) ?
-   fun mapR f = swap o mapL f o swap
 
+   fun mapLR f = map (f, f)
+
    fun equal (eqA, eqB) =
        fn (INL l, INL r) => eqA (l, r)
         | (INL _, INR _) => false

Modified: mltonlib/trunk/com/ssh/extended-basis/unstable/extensions.mlb
===================================================================
--- mltonlib/trunk/com/ssh/extended-basis/unstable/extensions.mlb	2006-11-30 15:48:32 UTC (rev 4885)
+++ mltonlib/trunk/com/ssh/extended-basis/unstable/extensions.mlb	2006-11-30 15:53:21 UTC (rev 4886)
@@ -81,7 +81,7 @@
                detail/product.sml
             end
          end
-         basis Sum = bas public/sum.sig detail/sum.sml end
+         basis Sum = let open Fn in bas public/sum.sig detail/sum.sml end end
          basis Emb = let
             open Fn Products
          in

Modified: mltonlib/trunk/com/ssh/extended-basis/unstable/public/sum.sig
===================================================================
--- mltonlib/trunk/com/ssh/extended-basis/unstable/public/sum.sig	2006-11-30 15:48:32 UTC (rev 4885)
+++ mltonlib/trunk/com/ssh/extended-basis/unstable/public/sum.sig	2006-11-30 15:53:21 UTC (rev 4886)
@@ -4,38 +4,40 @@
  * See the file MLton-LICENSE for details.
  *)
 
-(**
- * A general purpose sum type.
- *)
+(** A general purpose sum type. *)
 signature SUM = sig
    datatype ('a, 'b) sum = INL of 'a | INR of 'b
    type ('a, 'b) t = ('a, 'b) sum
 
    exception Sum
 
-   val sum : ('a -> 'c) * ('b -> 'c) -> ('a, 'b) t -> 'c
+   (** == Operations == *)
 
    val swap : ('a, 'b) t -> ('b, 'a) t
 
-   val out : ('x, 'x) t -> 'x
-
-   val app : 'a Effect.t * 'b Effect.t -> ('a, 'b) t Effect.t
-
-   val map : ('a -> 'c) * ('b -> 'd) -> ('a, 'b) t -> ('c, 'd) t
-
    val isL : ('a, 'b) t UnPr.t
    val isR : ('a, 'b) t UnPr.t
 
+   val getL : ('a, 'b) t -> 'a UnOp.t
+   val getR : ('a, 'b) t -> 'b UnOp.t
+
+   val out : ('a, 'a) t -> 'a
    val outL : ('a, 'b) t -> 'a
    val outR : ('a, 'b) t -> 'b
 
-   val getL : ('a, 'b) t -> 'a UnOp.t
-   val getR : ('a, 'b) t -> 'b UnOp.t
+   (** == HOFs == *)
 
+   val sum : ('a -> 'c) * ('b -> 'c) -> ('a, 'b) t -> 'c
+
+   val app : 'a Effect.t * 'b Effect.t -> ('a, 'b) t Effect.t
+   val appL : 'a Effect.t -> ('a, 'b) t Effect.t
+   val appR : 'b Effect.t -> ('a, 'b) t Effect.t
+
+   val map : ('a -> 'c) * ('b -> 'd) -> ('a, 'b) t -> ('c, 'd) t
    val mapL : ('a -> 'c) -> ('a, 'b) t -> ('c, 'b) t
    val mapR : ('b -> 'd) -> ('a, 'b) t -> ('a, 'd) t
+   val mapLR : ('a -> 'b) -> ('a, 'a) t -> ('b, 'b) t
 
    val equal : 'a BinPr.t * 'b BinPr.t -> ('a, 'b) t BinPr.t
-
    val collate : 'a Cmp.t * 'b Cmp.t -> ('a, 'b) t Cmp.t
 end