[MLton-commit] r5449

Vesa Karvonen vesak at mlton.org
Mon Mar 19 00:32:47 PST 2007


Renamed the plus val of MONADP_CORE to <|> and introduced a fixity
declaration for it (just below of the sequencing monadic operators).

The rationale for choosing the symbolic identifier <|>.  Currently all
other monadic operators use >> as a prefix.  The < and > symbols in <|>
make it visually belong with the other monadic operators and reflect the
semantics (evaluation can go either way) of the operator.  The symbol | is
not used in any operator of the Basis or previously in any operator of the
Extended Basis.  This means that there is no previous precedence
associated with it.  (Operators that are variations of a "base" operator
like + or * are generally given the same precedence in the Extended
Basis.)  In SML, the symbol | is used with pattern matching where it is
used to separate alternative clauses.  This also reminds about the
semantics of plus in MonadPlus.  Finally, the monadic parser combinator
library Parsec uses <|>.

Also simplified the implementation of seq/app functions.

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

U   mltonlib/trunk/com/ssh/extended-basis/unstable/detail/concept/mk-monad.fun
U   mltonlib/trunk/com/ssh/extended-basis/unstable/detail/io/reader.sml
U   mltonlib/trunk/com/ssh/extended-basis/unstable/public/concept/monad.sig
U   mltonlib/trunk/com/ssh/extended-basis/unstable/public/export/infixes.sml
U   mltonlib/trunk/com/ssh/misc-util/unstable/maybe.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-03-18 23:59:47 UTC (rev 5448)
+++ mltonlib/trunk/com/ssh/extended-basis/unstable/detail/concept/mk-monad.fun	2007-03-19 08:32:46 UTC (rev 5449)
@@ -4,9 +4,9 @@
  * See the LICENSE file or http://mlton.org/License for details.
  *)
 
-functor MkMonad (MonadCore : MONAD_CORE) : MONAD = struct
+functor MkMonad (Core : MONAD_CORE) : MONAD = struct
    infix >> >>& >>* >>= >>@
-   open MonadCore
+   open Core
    type 'a func = 'a monad
    fun map f aM = aM >>= return o f
    type 'a monad_ex = 'a monad
@@ -14,39 +14,25 @@
    fun fM >>@ aM = map Fn.\> (fM >>* aM)
    fun aM >>& bM = map Product.& (aM >>* bM)
    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))
+   local
+      fun mk fin comb x2yM ac =
+       fn [] => return (fin ac)
+        | x::xs => x2yM x >>= (fn y => mk fin comb x2yM (comb (y, ac)) xs)
    in
-     fun seqWith f xs =
-         seqWithTail f xs []
+      fun seqWith x2yM = mk rev op :: x2yM []
+      fun appWith x2yM = mk ignore ignore x2yM ()
+      fun seq xMs = seqWith Fn.id xMs
+      fun app xMs = appWith Fn.id xMs
    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
-   structure Monad = MkMonad (MonadPCore)
-   open Monad MonadPCore
+functor MkMonadP (Core : MONADP_CORE) : MONADP = struct
+   infix <|>
+   structure Monad = MkMonad (Core)
+   open Monad Core
    type 'a monadp_ex = 'a monad
-   fun sum [] = zero | sum [x] = x | sum (x::xs) = plus (x, sum xs)
+   fun sum [] = zero | sum [x] = x | sum (x::xs) = x <|> sum xs
 end

Modified: mltonlib/trunk/com/ssh/extended-basis/unstable/detail/io/reader.sml
===================================================================
--- mltonlib/trunk/com/ssh/extended-basis/unstable/detail/io/reader.sml	2007-03-18 23:59:47 UTC (rev 5448)
+++ mltonlib/trunk/com/ssh/extended-basis/unstable/detail/io/reader.sml	2007-03-19 08:32:46 UTC (rev 5449)
@@ -7,7 +7,7 @@
 structure Reader :> READER = struct
    open Reader
 
-   infix >>=
+   infix >>= <|>
 
    type 'a monad_dom = Univ.t and 'a monad_cod = ('a * Univ.t) Option.t
 
@@ -17,7 +17,7 @@
           fun return a s = SOME (a, s)
           fun aM >>= a2bM = Option.mapPartial (Fn.uncurry a2bM) o aM
           fun zero _ = NONE
-          fun plus (lM, rM) s = case lM s of NONE => rM s | result => result)
+          fun (lM <|> rM) s = case lM s of NONE => rM s | result => result)
 
    open Monad
 

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-18 23:59:47 UTC (rev 5448)
+++ mltonlib/trunk/com/ssh/extended-basis/unstable/public/concept/monad.sig	2007-03-19 08:32:46 UTC (rev 5449)
@@ -65,7 +65,7 @@
 signature MONADP_CORE = sig
    include MONAD_CORE
    val zero : 'a monad
-   val plus : 'a monad BinOp.t
+   val <|> : 'a monad BinOp.t
 end
 
 signature MONADP_EX = sig

Modified: mltonlib/trunk/com/ssh/extended-basis/unstable/public/export/infixes.sml
===================================================================
--- mltonlib/trunk/com/ssh/extended-basis/unstable/public/export/infixes.sml	2007-03-18 23:59:47 UTC (rev 5448)
+++ mltonlib/trunk/com/ssh/extended-basis/unstable/public/export/infixes.sml	2007-03-19 08:32:46 UTC (rev 5449)
@@ -70,7 +70,7 @@
 infix  1 !    :=   ! orElse  !       ! >>= >>& !        ! :=: += -=
          !         !         !       ! >>* >>@ !        !
 (* ========================================================================== *)
-infix  0 ! before  !         !       !         !   &`   ! &
+infix  0 ! before  !         !       !   <|>   !   &`   ! &
 (* -------------------------------------------------------------------------- *)
 infixr 0 !         !         !       !         !        ! -->
 (* ************************************************************************** *)

Modified: mltonlib/trunk/com/ssh/misc-util/unstable/maybe.sml
===================================================================
--- mltonlib/trunk/com/ssh/misc-util/unstable/maybe.sml	2007-03-18 23:59:47 UTC (rev 5448)
+++ mltonlib/trunk/com/ssh/misc-util/unstable/maybe.sml	2007-03-19 08:32:46 UTC (rev 5449)
@@ -34,7 +34,7 @@
         val return = `
         fun (aM >>= a2bM) () = case aM () of NONE => NONE | SOME a => a2bM a ()
         fun zero () = NONE
-        fun plus (l, r) () = case l () of NONE => r () | r => r)
+        fun (l <|> r) () = case l () of NONE => r () | r => r)
    open Monad
    fun liftBinFn f (aM, bM) = map f (aM >>* bM)
    fun get q = q ()




More information about the MLton-commit mailing list