[MLton-commit] r6490

[Vesa Karvonen]

Renamed CPS.pass to CPS.return and added CPS.>>= augmenting CPS to a
monad.

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

U   mltonlib/trunk/com/ssh/extended-basis/unstable/detail/control/with.sml
U   mltonlib/trunk/com/ssh/extended-basis/unstable/detail/fn/cps.sml
U   mltonlib/trunk/com/ssh/extended-basis/unstable/public/control/with.sig
U   mltonlib/trunk/com/ssh/extended-basis/unstable/public/export/top-level.sml
U   mltonlib/trunk/com/ssh/extended-basis/unstable/public/fn/cps.sig

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

Modified: mltonlib/trunk/com/ssh/extended-basis/unstable/detail/control/with.sml
===================================================================
--- mltonlib/trunk/com/ssh/extended-basis/unstable/detail/control/with.sml	2008-03-16 19:01:06 UTC (rev 6489)
+++ mltonlib/trunk/com/ssh/extended-basis/unstable/detail/control/with.sml	2008-03-16 19:07:04 UTC (rev 6490)
@@ -1,4 +1,4 @@
-(* Copyright (C) 2006 SSH Communications Security, Helsinki, Finland
+(* Copyright (C) 2006-2008 SSH Communications Security, Helsinki, Finland
  *
  * This code is released under the MLton license, a BSD-style license.
  * See the LICENSE file or http://mlton.org/License for details.
@@ -9,21 +9,14 @@
 
    infix >>=
 
-   structure Monad =
-      MkMonad (type 'a monad = 'a t
-               val return = CPS.pass
-               fun (aM >>= a2bM) f = aM (fn a => a2bM a f))
-
+   structure Monad = MkMonad (type 'a monad = 'a t open CPS)
    open Monad
 
    val lift = Fn.id
    val for = Fn.id
-   fun one aM f = let
-      val result = ref NONE
-   in
-      aM (fn a => result := SOME (f a)) : Unit.t
-    ; valOf (!result)
-   end
+   fun one aM f =
+       case ref NONE
+        of res => (aM (fn a => res := SOME (f a)) : Unit.t ; valOf (!res))
 
    fun alloc g a f = f (g a)
    fun free ef x f = (f x handle e => (ef x ; raise e)) before ef x

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-16 19:01:06 UTC (rev 6489)
+++ mltonlib/trunk/com/ssh/extended-basis/unstable/detail/fn/cps.sml	2008-03-16 19:07:04 UTC (rev 6490)
@@ -6,5 +6,6 @@
 
 structure CPS :> CPS = struct
    open CPS
-   fun pass x f = f x
+   fun return x f = f x
+   fun op >>= (aM, a2bM) = aM o Fn.flip a2bM
 end

Modified: mltonlib/trunk/com/ssh/extended-basis/unstable/public/control/with.sig
===================================================================
--- mltonlib/trunk/com/ssh/extended-basis/unstable/public/control/with.sig	2008-03-16 19:01:06 UTC (rev 6489)
+++ mltonlib/trunk/com/ssh/extended-basis/unstable/public/control/with.sig	2008-03-16 19:07:04 UTC (rev 6490)
@@ -27,7 +27,7 @@
     * be more efficient than {one}.
     *)
 
-   val one : 'a t -> ('a -> 'b) -> 'b
+   val one : 'a t -> ('a, 'b) CPS.t
    (**
     * Runs the monad and passes the value to the given block.  The result
     * of the block is then returned.  If the result is {()} then it is

Modified: mltonlib/trunk/com/ssh/extended-basis/unstable/public/export/top-level.sml
===================================================================
--- mltonlib/trunk/com/ssh/extended-basis/unstable/public/export/top-level.sml	2008-03-16 19:01:06 UTC (rev 6489)
+++ mltonlib/trunk/com/ssh/extended-basis/unstable/public/export/top-level.sml	2008-03-16 19:07:04 UTC (rev 6490)
@@ -53,7 +53,7 @@
 
    (** == CPS == *)
 
-   val pass = CPS.pass
+   val pass = CPS.return
 
    (** == Fold == *)
 

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-16 19:01:06 UTC (rev 6489)
+++ mltonlib/trunk/com/ssh/extended-basis/unstable/public/fn/cps.sig	2008-03-16 19:07:04 UTC (rev 6490)
@@ -4,10 +4,16 @@
  * See the LICENSE file or http://mlton.org/License for details.
  *)
 
-(** Utilities for programming in continuation passing -style. *)
+(**
+ * Signature for utilities for programming in continuation passing -style.
+ *)
 signature CPS = sig
-   type ('a, 'b) t = ('a -> 'b) -> 'b
+   type ('a, 'c) t = ('a -> 'c) -> 'c
+   (** Type of CPS functions. *)
 
-   val pass : 'a -> ('a, 'b) t
-   (** Pass to continuation ({pass x f = f x}). *)
+   val return : 'a -> ('a, 'c) t
+   (** Pass to continuation: {return x f = f x}. *)
+
+   val >>= : ('a, 'c) t * ('a -> ('b, 'c) t) -> ('b, 'c) t
+   (** Bind. *)
 end