[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