[MLton-commit] r6466

[Vesa Karvonen]

Added Exn.reflect as a complement to Exn.apply and Exn.eval.

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

U   mltonlib/trunk/com/ssh/extended-basis/unstable/detail/control/exn.sml
U   mltonlib/trunk/com/ssh/extended-basis/unstable/detail/lazy/lazy.sml
U   mltonlib/trunk/com/ssh/extended-basis/unstable/public/control/exn.sig

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

Modified: mltonlib/trunk/com/ssh/extended-basis/unstable/detail/control/exn.sml
===================================================================
--- mltonlib/trunk/com/ssh/extended-basis/unstable/detail/control/exn.sml	2008-03-09 05:56:07 UTC (rev 6465)
+++ mltonlib/trunk/com/ssh/extended-basis/unstable/detail/control/exn.sml	2008-03-09 20:05:42 UTC (rev 6466)
@@ -11,6 +11,7 @@
    fun apply f x = Sum.INR (f x) handle e => Sum.INL e
    fun eval th = apply th ()
    fun throw e = raise e
+   fun reflect s = Sum.sum (throw, Fn.id) s
    fun try (th, fv, fe) = Sum.sum (fe, fv) (eval th)
    fun after (th, ef) = try (th, Effect.past ef, throw o Effect.past ef)
    val finally = after

Modified: mltonlib/trunk/com/ssh/extended-basis/unstable/detail/lazy/lazy.sml
===================================================================
--- mltonlib/trunk/com/ssh/extended-basis/unstable/detail/lazy/lazy.sml	2008-03-09 05:56:07 UTC (rev 6465)
+++ mltonlib/trunk/com/ssh/extended-basis/unstable/detail/lazy/lazy.sml	2008-03-09 20:05:42 UTC (rev 6466)
@@ -11,10 +11,9 @@
    fun lazy th = ref (ref (LAZY th))
    fun eager x = ref (ref (EAGER (Sum.INR x)))
    fun delay th = lazy (ref o ref o EAGER o (fn () => Exn.eval th))
-   fun replay s = Sum.sum (Exn.throw, Fn.id) s
    fun force promise =
        case !(!promise) of
-          EAGER x => replay x
+          EAGER x => Exn.reflect x
         | LAZY th =>
           Exn.try (th,
                    fn promise' =>
@@ -22,7 +21,7 @@
                          LAZY _ => (!promise := !(!promise')
                                   ; promise := !promise'
                                   ; force promise)
-                       | EAGER x => replay x,
+                       | EAGER x => Exn.reflect x,
                    fn e =>
                       (!promise := EAGER (Sum.INL e) (* XXX *)
                      ; raise e))

Modified: mltonlib/trunk/com/ssh/extended-basis/unstable/public/control/exn.sig
===================================================================
--- mltonlib/trunk/com/ssh/extended-basis/unstable/public/control/exn.sig	2008-03-09 05:56:07 UTC (rev 6465)
+++ mltonlib/trunk/com/ssh/extended-basis/unstable/public/control/exn.sig	2008-03-09 20:05:42 UTC (rev 6466)
@@ -17,6 +17,9 @@
    val eval : 'a Thunk.t -> (t, 'a) Sum.t
    (** Evaluate a thunk ({eval th = INR (th ()) handle e => INL e}). *)
 
+   val reflect : (t, 'a) Sum.t -> 'a
+   (** {reflect} is equivalent to {sum (throw, id)}. *)
+
    val after : 'a Thunk.t * Unit.t Effect.t -> 'a
    (** {after (th, ef) = try (th, past ef, throw o past ef)}. *)