[MLton-commit] r6519

[Vesa Karvonen]

Added CPS.callcc.

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

U   mltonlib/trunk/com/ssh/extended-basis/unstable/detail/fn/cps.sml
U   mltonlib/trunk/com/ssh/extended-basis/unstable/public/fn/cps.sig

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

Modified: mltonlib/trunk/com/ssh/extended-basis/unstable/detail/fn/cps.sml
===================================================================
--- mltonlib/trunk/com/ssh/extended-basis/unstable/detail/fn/cps.sml	2008-03-29 12:54:13 UTC (rev 6518)
+++ mltonlib/trunk/com/ssh/extended-basis/unstable/detail/fn/cps.sml	2008-03-30 21:32:31 UTC (rev 6519)
@@ -5,7 +5,10 @@
  *)
 
 structure CPS :> CPS = struct
-   open CPS
+   open Fn CPS
    fun return x f = f x
-   fun op >>= (aM, a2bM) = aM o Fn.flip a2bM
+   fun op >>= (aM, a2bM) = aM o flip a2bM
+   type ('a, 'c) cont = 'a -> 'c
+   fun callcc b k = b k k
+   fun throw k x _ = k x
 end

Modified: mltonlib/trunk/com/ssh/extended-basis/unstable/public/fn/cps.sig
===================================================================
--- mltonlib/trunk/com/ssh/extended-basis/unstable/public/fn/cps.sig	2008-03-29 12:54:13 UTC (rev 6518)
+++ mltonlib/trunk/com/ssh/extended-basis/unstable/public/fn/cps.sig	2008-03-30 21:32:31 UTC (rev 6519)
@@ -5,15 +5,24 @@
  *)
 
 (**
- * Signature for utilities for programming in continuation passing -style.
+ * Signature for programming in continuation passing -style monadically.
  *)
 signature CPS = sig
    type ('a, 'c) t = ('a -> 'c) -> 'c
    (** Type of CPS functions. *)
 
    val return : 'a -> ('a, 'c) t
-   (** Pass to continuation: {return x f = f x}. *)
+   (** Return passes value to continuation: {return x = fn k => k x}. *)
 
    val >>= : ('a, 'c) t * ('a -> ('b, 'c) t) -> ('b, 'c) t
-   (** Bind. *)
+   (** Bind chains CPS blocks: {aM >>= a2bM = fn k => aM (fn a => a2bM a k)}. *)
+
+   type ('a, 'c) cont
+   (** Type of CPS -continuations. *)
+
+   val callcc : (('a, 'c) cont, ('a, 'c) t) t
+   (** Captures the current continuation and calls the function with it. *)
+
+   val throw : ('a, 'c) cont -> 'a -> ('b, 'c) t
+   (** Invokes a captured continuation with the given value. *)
 end