[MLton-commit] r5432

[geoffw at mlton.org]

Extended MONAD_EX with additional common and useful operations.

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

U   mltonlib/trunk/com/ssh/extended-basis/unstable/detail/concept/mk-monad.fun
U   mltonlib/trunk/com/ssh/extended-basis/unstable/public/concept/monad.sig

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

Modified: mltonlib/trunk/com/ssh/extended-basis/unstable/detail/concept/mk-monad.fun
===================================================================
--- mltonlib/trunk/com/ssh/extended-basis/unstable/detail/concept/mk-monad.fun	2007-03-15 14:46:05 UTC (rev 5431)
+++ mltonlib/trunk/com/ssh/extended-basis/unstable/detail/concept/mk-monad.fun	2007-03-15 14:51:35 UTC (rev 5432)
@@ -16,6 +16,32 @@
    fun aM >> bM = map #2 (aM >>* bM)
    fun seq [] = return []
      | seq (xM::xMs) = map op :: (xM >>* seq xMs)
+
+   local 
+     fun seqWithTail f xs accum =
+         case xs
+           of [] => return (List.rev accum)
+            | x::xs' => (f x) >>= (fn x' => seqWithTail f xs' (x'::accum))
+   in
+     fun seqWith f xs =
+         seqWithTail f xs []
+   end
+
+   fun app (ms : 'a monad list) : unit monad =
+       case ms
+         of [] => return ()
+          | m::ms' => m >> (app ms')
+
+   fun appWith (f : 'a -> 'b monad) (xs : 'a list) : unit monad =
+       case xs
+         of [] => return ()
+          | x::xs' => (f x) >> (appWith f xs')
+
+   fun ignore m = m >> return ()
+
+   fun when b m = if b then m else return ()
+   fun unless b m = if b then return () else m
+
 end
 
 functor MkMonadP (MonadPCore : MONADP_CORE) : MONADP = struct

Modified: mltonlib/trunk/com/ssh/extended-basis/unstable/public/concept/monad.sig
===================================================================
--- mltonlib/trunk/com/ssh/extended-basis/unstable/public/concept/monad.sig	2007-03-15 14:46:05 UTC (rev 5431)
+++ mltonlib/trunk/com/ssh/extended-basis/unstable/public/concept/monad.sig	2007-03-15 14:51:35 UTC (rev 5432)
@@ -38,7 +38,21 @@
    val >>& : 'a monad_ex * 'b monad_ex -> ('a, 'b) Product.t monad_ex
    val >>* : 'a monad_ex * 'b monad_ex -> ('a * 'b) monad_ex
    val >>@ : ('a -> 'b) monad_ex * 'a monad_ex -> 'b monad_ex
+
    val seq : 'a monad_ex List.t -> 'a List.t monad_ex
+   val seqWith : ('a -> 'b monad_ex) -> 'a List.t -> 'b List.t monad_ex
+
+   val app : 'a monad_ex List.t -> unit monad_ex
+   val appWith : ('a -> 'b monad_ex) -> 'a List.t -> unit monad_ex
+
+   val ignore : 'a monad_ex -> unit monad_ex
+   (** {ignore m == (m >> return ())} *)
+
+   val when : bool -> unit monad_ex -> unit monad_ex
+   (** {when b m == if b then m else (return ())} *)
+
+   val unless : bool -> unit monad_ex -> unit monad_ex
+   (** {unless b m == if b then (return ()) else m} *)
 end
 
 signature MONAD = sig