[MLton-commit] r5495

[geoffw at mlton.org]

"Swapped" monadic bind operator.

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

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
U   mltonlib/trunk/com/ssh/extended-basis/unstable/public/export/infixes.sml

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

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-04-05 12:57:44 UTC (rev 5494)
+++ mltonlib/trunk/com/ssh/extended-basis/unstable/detail/concept/mk-monad.fun	2007-04-05 13:52:06 UTC (rev 5495)
@@ -12,6 +12,9 @@
    fun map f aM = aM >>= pure f
    fun thunk th = map th (return ())
    type 'a monad_ex = 'a monad
+
+   fun op =<< x = (op >>= o Pair.swap) x
+
    local
       fun mk f (aM, bM) = aM >>= (fn a => bM >>= (fn b => return (f (a, b))))
    in

Modified: mltonlib/trunk/com/ssh/extended-basis/unstable/public/concept/monad.sig
===================================================================
--- mltonlib/trunk/com/ssh/extended-basis/unstable/public/concept/monad.sig	2007-04-05 12:57:44 UTC (rev 5494)
+++ mltonlib/trunk/com/ssh/extended-basis/unstable/public/concept/monad.sig	2007-04-05 13:52:06 UTC (rev 5495)
@@ -34,6 +34,7 @@
 signature MONAD_EX = sig
    type 'a monad_ex
    include FUNC where type 'a func = 'a monad_ex
+   val =<< : ('a -> 'b monad_ex) * 'a monad_ex -> 'b monad_ex
    val >> : 'a monad_ex * 'b monad_ex -> 'b monad_ex
    val >>& : 'a monad_ex * 'b monad_ex -> ('a, 'b) Product.t monad_ex
    val >>* : 'a monad_ex * 'b monad_ex -> ('a * 'b) monad_ex

Modified: mltonlib/trunk/com/ssh/extended-basis/unstable/public/export/infixes.sml
===================================================================
--- mltonlib/trunk/com/ssh/extended-basis/unstable/public/export/infixes.sml	2007-04-05 12:57:44 UTC (rev 5494)
+++ mltonlib/trunk/com/ssh/extended-basis/unstable/public/export/infixes.sml	2007-04-05 13:52:06 UTC (rev 5495)
@@ -69,6 +69,8 @@
 (* ========================================================================== *)
 infix  1 !    :=   ! orElse  !       ! >>= >>& !        ! :=: += -=
          !         !         !       ! >>* >>@ !        !
+(* -------------------------------------------------------------------------- *)
+infixr 1 !         !         !       !   =<<   !        !
 (* ========================================================================== *)
 infix  0 ! before  !         !       !   <|>   !   &`   ! &
 (* -------------------------------------------------------------------------- *)