[MLton-commit] r5537
Vesa Karvonen
vesak at mlton.org
Sat Apr 21 15:16:31 PDT 2007
Minor tweaks.
----------------------------------------------------------------------
U mltonlib/trunk/com/ssh/extended-basis/unstable/detail/concept/mk-monad.fun
U mltonlib/trunk/com/ssh/extended-basis/unstable/detail/data/option.sml
U mltonlib/trunk/com/ssh/extended-basis/unstable/detail/data/pair.sml
U mltonlib/trunk/com/ssh/extended-basis/unstable/detail/data/product.sml
U mltonlib/trunk/com/ssh/extended-basis/unstable/detail/data/univ-ref.sml
U mltonlib/trunk/com/ssh/extended-basis/unstable/detail/fn/effect.sml
U mltonlib/trunk/com/ssh/extended-basis/unstable/detail/ml/smlnj/workarounds/string.sig
U mltonlib/trunk/com/ssh/extended-basis/unstable/detail/sequence/mk-seq-common-ext.fun
U mltonlib/trunk/com/ssh/extended-basis/unstable/public/concept/monad.sig
U mltonlib/trunk/com/ssh/extended-basis/unstable/public/data/option.sig
U mltonlib/trunk/com/ssh/extended-basis/unstable/public/fn/effect.sig
U mltonlib/trunk/com/ssh/extended-basis/unstable/public/sequence/list.sig
U mltonlib/trunk/com/ssh/extended-basis/unstable/public/text/char.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-04-21 22:07:32 UTC (rev 5536)
+++ mltonlib/trunk/com/ssh/extended-basis/unstable/detail/concept/mk-monad.fun 2007-04-21 22:16:29 UTC (rev 5537)
@@ -5,16 +5,19 @@
*)
functor MkMonad (Core : MONAD_CORE) : MONAD = struct
- infix >> >>& >>* >>= >>@ oo
+ infix >> >>& >>* >>= >>@ oo =<<
+
open Core
+
type 'a func = 'a monad
+ type 'a monad_ex = 'a monad
+
+ fun f =<< x = x >>= f
+
fun pure f = return o f
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
@@ -28,23 +31,22 @@
fun (y2zM oo x2yM) x = x2yM x >>= y2zM
local
- fun mkFold fM b fin =
- fn [] => return (fin b)
- | x::xs => fM (x, b) >>= (fn b' => mkFold fM b' fin xs)
+ fun mk fM b fin =
+ fn [] => return (fin b)
+ | x::xs => fM (x, b) >>= (fn b' => mk fM b' fin xs)
in
- fun foldl fM b = mkFold fM b Fn.id
+ fun foldl fM b = mk fM b Fn.id
fun foldr fM b = foldl fM b o rev
- fun seqWith x2yM =
- mkFold (fn (x, ys) => map (fn y => y::ys) (x2yM x)) [] rev
+ fun seqWith x2yM = mk (fn (x, ys) => map (fn y => y::ys) (x2yM x)) [] rev
fun appWith x2yM = foldl (ignore o x2yM o Pair.fst) ()
fun seq xMs = seqWith Fn.id xMs
fun app xMs = appWith Fn.id xMs
fun seqWithPartial x2yM =
- mkFold (fn (x, ys) => map (fn SOME y => y::ys | NONE => ys) (x2yM x))
- [] rev
+ mk (fn (x, ys) => map (fn SOME y => y::ys | NONE => ys) (x2yM x))
+ [] rev
end
fun when b m = if b then m else return ()
@@ -76,9 +78,9 @@
type 'a monadp_ex = 'a monad
fun sumWith x2yM =
- fn [] => zero
- | [x] => x2yM x
- | x::xs => x2yM x <|> sumWith x2yM xs
+ fn [] => zero
+ | [x] => x2yM x
+ | x::xs => x2yM x <|> sumWith x2yM xs
fun sum ms = sumWith Fn.id ms
end
Modified: mltonlib/trunk/com/ssh/extended-basis/unstable/detail/data/option.sml
===================================================================
--- mltonlib/trunk/com/ssh/extended-basis/unstable/detail/data/option.sml 2007-04-21 22:07:32 UTC (rev 5536)
+++ mltonlib/trunk/com/ssh/extended-basis/unstable/detail/data/option.sml 2007-04-21 22:16:29 UTC (rev 5537)
@@ -8,10 +8,8 @@
open Option
val isNone = fn NONE => true
| SOME _ => false
-
fun collate cmp = fn (NONE, NONE) => EQUAL
| (SOME _, NONE) => GREATER
| (NONE, SOME _) => LESS
- | (SOME x1, SOME x2) => cmp (x1, x2)
-
+ | (SOME x1, SOME x2) => cmp (x1, x2)
end
Modified: mltonlib/trunk/com/ssh/extended-basis/unstable/detail/data/pair.sml
===================================================================
--- mltonlib/trunk/com/ssh/extended-basis/unstable/detail/data/pair.sml 2007-04-21 22:07:32 UTC (rev 5536)
+++ mltonlib/trunk/com/ssh/extended-basis/unstable/detail/data/pair.sml 2007-04-21 22:16:29 UTC (rev 5537)
@@ -23,7 +23,7 @@
fun fst (a, _) = a
fun snd (_, b) = b
- fun app (ea, eb) (a, b) = (ea a : unit ; eb b : unit)
+ fun app (ea, eb) (a, b) = (ea a : Unit.t ; eb b : Unit.t)
fun appFst eA = app (eA, Effect.ignore)
fun appSnd eB = app (Effect.ignore, eB)
Modified: mltonlib/trunk/com/ssh/extended-basis/unstable/detail/data/product.sml
===================================================================
--- mltonlib/trunk/com/ssh/extended-basis/unstable/detail/data/product.sml 2007-04-21 22:07:32 UTC (rev 5536)
+++ mltonlib/trunk/com/ssh/extended-basis/unstable/detail/data/product.sml 2007-04-21 22:16:29 UTC (rev 5537)
@@ -25,7 +25,7 @@
fun fst (a & _) = a
fun snd (_ & b) = b
- fun app (eA, eB) (a & b) = (eA a : unit ; eB b : unit)
+ fun app (eA, eB) (a & b) = (eA a : Unit.t ; eB b : Unit.t)
fun appFst eA = app (eA, Effect.ignore)
fun appSnd eB = app (Effect.ignore, eB)
Modified: mltonlib/trunk/com/ssh/extended-basis/unstable/detail/data/univ-ref.sml
===================================================================
--- mltonlib/trunk/com/ssh/extended-basis/unstable/detail/data/univ-ref.sml 2007-04-21 22:07:32 UTC (rev 5536)
+++ mltonlib/trunk/com/ssh/extended-basis/unstable/detail/data/univ-ref.sml 2007-04-21 22:16:29 UTC (rev 5537)
@@ -8,8 +8,8 @@
open Univ
datatype t =
- IN of {clear : unit -> unit,
- store : unit -> unit}
+ IN of {clear : Unit.t Effect.t,
+ store : Unit.t Effect.t}
local
fun mk deref = let
@@ -23,7 +23,7 @@
end
in
fun newIso () = mk (fn SOME ? => ? | NONE => raise Univ)
- fun newEmb () = mk (fn ? => ?)
+ fun newEmb () = mk Fn.id
end
end
Modified: mltonlib/trunk/com/ssh/extended-basis/unstable/detail/fn/effect.sml
===================================================================
--- mltonlib/trunk/com/ssh/extended-basis/unstable/detail/fn/effect.sml 2007-04-21 22:07:32 UTC (rev 5536)
+++ mltonlib/trunk/com/ssh/extended-basis/unstable/detail/fn/effect.sml 2007-04-21 22:16:29 UTC (rev 5537)
@@ -8,13 +8,7 @@
open Effect
val ignore = ignore
val nop = ignore
- fun obs ef x = (ef x : unit ; x)
- fun past ef x = (ef () : unit ; x)
- local
- fun tabulate' m ef =
- fn 0 => ()
- | n => (ef m; tabulate' (m + 1) ef (n - 1))
- in
- fun tabulate n ef = tabulate' 0 ef n
- end
+ fun obs ef x = (ef x : Unit.t ; x)
+ fun past ef x = (ef () : Unit.t ; x)
+ fun tabulate n ef = ignore (Basic.repeat (fn i => (ef i : Unit.t ; i+1)) n 0)
end
Modified: mltonlib/trunk/com/ssh/extended-basis/unstable/detail/ml/smlnj/workarounds/string.sig
===================================================================
--- mltonlib/trunk/com/ssh/extended-basis/unstable/detail/ml/smlnj/workarounds/string.sig 2007-04-21 22:07:32 UTC (rev 5536)
+++ mltonlib/trunk/com/ssh/extended-basis/unstable/detail/ml/smlnj/workarounds/string.sig 2007-04-21 22:16:29 UTC (rev 5537)
@@ -35,5 +35,5 @@
val scan : (Char.char, 'a) StringCvt.reader -> (string, 'a) StringCvt.reader
val fromString : String.string -> string option
val toCString : string -> String.string
- val fromCString : String.string -> string option
+ val fromCString : String.string -> string option
end
Modified: mltonlib/trunk/com/ssh/extended-basis/unstable/detail/sequence/mk-seq-common-ext.fun
===================================================================
--- mltonlib/trunk/com/ssh/extended-basis/unstable/detail/sequence/mk-seq-common-ext.fun 2007-04-21 22:07:32 UTC (rev 5536)
+++ mltonlib/trunk/com/ssh/extended-basis/unstable/detail/sequence/mk-seq-common-ext.fun 2007-04-21 22:16:29 UTC (rev 5537)
@@ -6,8 +6,8 @@
functor MkSeqCommonExt (type 'a t
val foldr : ('a * 'b -> 'b) -> 'b -> 'a t -> 'b
- val fromList : 'a list -> 'a t
- val maxLen : int) = struct
+ val fromList : 'a List.t -> 'a t
+ val maxLen : Int.t) = struct
fun unfoldi fis (n, s) = let
fun lp (i, s, xs) =
if i = n then (fromList (rev xs), s)
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-21 22:07:32 UTC (rev 5536)
+++ mltonlib/trunk/com/ssh/extended-basis/unstable/public/concept/monad.sig 2007-04-21 22:16:29 UTC (rev 5537)
@@ -33,7 +33,9 @@
signature MONAD_EX = sig
type 'a monad_ex
- include FUNC where type 'a func = 'a monad_ex
+ include FUNC
+ sharing type func = 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
@@ -43,49 +45,49 @@
val pure : ('a -> 'b) -> 'a -> 'b monad_ex
(** {pure f == return o f} *)
- val thunk : 'a Thunk.t -> 'a monad_ex
+ val thunk : 'a Thunk.t -> 'a monad_ex
(** {thunk thk == return () >>= pure thunk} *)
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 seqWithPartial : ('a -> 'b Option.t monad_ex) -> 'a List.t ->
+ val seqWithPartial : ('a -> 'b Option.t 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 app : 'a monad_ex List.t -> Unit.t monad_ex
+ val appWith : ('a -> 'b monad_ex) -> 'a List.t -> Unit.t monad_ex
- val oo : ('b -> 'c monad_ex) * ('a -> 'b monad_ex) -> 'a ->
+ val oo : ('b -> 'c monad_ex) * ('a -> 'b monad_ex) -> 'a ->
'c monad_ex
(** {f2 oo f1 == (fn x => f1 x >>= f2) } *)
- val ignore : 'a monad_ex -> unit monad_ex
- (** {ignore m == (m >> return ())} *)
+ val ignore : 'a monad_ex -> Unit.t 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 when : Bool.t -> Unit.t monad_ex -> Unit.t 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} *)
+ val unless : Bool.t -> Unit.t monad_ex -> Unit.t monad_ex
+ (** {unless b m == if b then return () else m} *)
- val tabulate : int -> (int -> 'a monad_ex) -> 'a List.t monad_ex
+ val tabulate : Int.t -> (Int.t -> 'a monad_ex) -> 'a List.t monad_ex
(**
- * Tabulate is a version of List.tabulate that can use
- * functions that produce computations.
- *
- * {tabulate n f ==
- * (f 0) >>= (fn x0 => (f 1) >>= ...
- * (fn xn >>= return [x1, ..., xn]))}
- *
- * The actual implementation is tail recursive. *)
+ * Tabulate is a version of List.tabulate that can use functions that
+ * produce computations.
+ *
+ *> tabulate n f ==
+ *> (f 0) >>= (fn x0 => (f 1) >>= ...
+ *> (fn xn >>= return [x1, ..., xn]))
+ *
+ * The actual implementation is tail recursive.
+ *)
- val foldl : ('a * 'b -> 'b monad_ex) -> 'b -> 'a list -> 'b monad_ex
- val foldr : ('a * 'b -> 'b monad_ex) -> 'b -> 'a list -> 'b monad_ex
+ val foldl : ('a * 'b -> 'b monad_ex) -> 'b -> 'a List.t -> 'b monad_ex
+ val foldr : ('a * 'b -> 'b monad_ex) -> 'b -> 'a List.t -> 'b monad_ex
- val mapFst : ('a -> 'c monad_ex) -> ('a, 'b) Pair.t ->
+ val mapFst : ('a -> 'c monad_ex) -> ('a, 'b) Pair.t ->
('c, 'b) Pair.t monad_ex
- val mapSnd : ('b -> 'c monad_ex) -> ('a, 'b) Pair.t ->
+ val mapSnd : ('b -> 'c monad_ex) -> ('a, 'b) Pair.t ->
('a, 'c) Pair.t monad_ex
-
end
signature MONAD = sig
@@ -120,14 +122,14 @@
val getState : monad_ws_state monad_ws
val setState : monad_ws_state -> Unit.t monad_ws
val run : monad_ws_state -> 'a monad_ws -> monad_ws_state * 'a
-end
-
+end
+
signature MONAD_STATE = sig
include MONAD MONAD_WS
sharing type monad = monad_ws
-end
+end
signature MONADP_STATE = sig
include MONADP MONAD_WS
sharing type monad = monad_ws
-end
+end
Modified: mltonlib/trunk/com/ssh/extended-basis/unstable/public/data/option.sig
===================================================================
--- mltonlib/trunk/com/ssh/extended-basis/unstable/public/data/option.sig 2007-04-21 22:07:32 UTC (rev 5536)
+++ mltonlib/trunk/com/ssh/extended-basis/unstable/public/data/option.sig 2007-04-21 22:16:29 UTC (rev 5537)
@@ -15,9 +15,9 @@
(** Returns {true} if given option is {NONE}; otherwise returns {false}. *)
val collate : 'a Cmp.t -> 'a t Cmp.t
- (**
- * Returns {EQUAL} if given {(NONE,NONE)}; {GREATER} if given
- * {(SOME _, NONE)}; {LESS} if given {(NONE, SOME _)}; for
- * {(SOME _, SOME _)} it uses the provided comparison function. *)
-
+ (**
+ * Returns {EQUAL} if given {(NONE,NONE)}; {GREATER} if given {(SOME _,
+ * NONE)}; {LESS} if given {(NONE, SOME _)}; for {(SOME _, SOME _)} it
+ * uses the provided comparison function.
+ *)
end
Modified: mltonlib/trunk/com/ssh/extended-basis/unstable/public/fn/effect.sig
===================================================================
--- mltonlib/trunk/com/ssh/extended-basis/unstable/public/fn/effect.sig 2007-04-21 22:07:32 UTC (rev 5536)
+++ mltonlib/trunk/com/ssh/extended-basis/unstable/public/fn/effect.sig 2007-04-21 22:16:29 UTC (rev 5537)
@@ -30,6 +30,6 @@
* name {past} comes from the idea that the data flows past the effect.
*)
- val tabulate : Int.t -> (Int.t t) t
- (** {tabulate n f == (f 0; ... ; f (n - 1))} *)
+ val tabulate : Int.t -> Int.t t t
+ (** {tabulate n f == (f 0; ... ; f (n - 1))} *)
end
Modified: mltonlib/trunk/com/ssh/extended-basis/unstable/public/sequence/list.sig
===================================================================
--- mltonlib/trunk/com/ssh/extended-basis/unstable/public/sequence/list.sig 2007-04-21 22:07:32 UTC (rev 5536)
+++ mltonlib/trunk/com/ssh/extended-basis/unstable/public/sequence/list.sig 2007-04-21 22:16:29 UTC (rev 5537)
@@ -128,30 +128,32 @@
* predicate on lists of the element type.
*)
- (** == Operations using equivalence relations and partial orders ==
- * The {ByEq} functions use a binary predicate and operates in O(n^2)
- * time. The binary predicate is assumed to be an equivalence relation.
+ (** == Operations using equivalence relations and partial orders ==
*
- * The {ByCmp} use comparison function and operates in O(n log n) time.
+ * The {ByEq} functions use a binary predicate and operates in O(n^2)
+ * time. The binary predicate is assumed to be an equivalence
+ * relation.
+ *
+ * The {ByCmp} use comparison function and operates in O(n log n) time.
* The comparison function is assumed to be be partial order.
*)
val uniqueByEq : 'a BinPr.t -> 'a t UnPr.t
- (**
- * {uniqueByEq eq xs} returns {true} all if elements of are pair-wise
- * distinct.
+ (**
+ * {uniqueByEq eq xs} returns {true} all if elements of are pair-wise
+ * distinct.
*)
-
+
val divideByEq : 'a BinPr.t -> 'a t -> 'a t t
- (**
+ (**
* {divideByEq eq xs} divides {xs} up into a list of lists. Each list
- * contains elements in the equivalence class induced by {eq}.
+ * contains elements in the equivalence class induced by {eq}.
*)
val nubByEq : 'a BinPr.t -> 'a t UnOp.t
- (**
- * {nubByEq eq xs} removes duplicates in {xs} based upon the
- * equivalence class specified by {eq}. It preserves the ordering of
+ (**
+ * {nubByEq eq xs} removes duplicates in {xs} based upon the
+ * equivalence class specified by {eq}. It preserves the ordering of
* the elements in {xs}.
*)
end
Modified: mltonlib/trunk/com/ssh/extended-basis/unstable/public/text/char.sig
===================================================================
--- mltonlib/trunk/com/ssh/extended-basis/unstable/public/text/char.sig 2007-04-21 22:07:32 UTC (rev 5536)
+++ mltonlib/trunk/com/ssh/extended-basis/unstable/public/text/char.sig 2007-04-21 22:16:29 UTC (rev 5537)
@@ -18,8 +18,8 @@
val succ : t UnOp.t
val pred : t UnOp.t
- val contains : string -> t -> bool
- val notContains : string -> t -> bool
+ val contains : string -> t UnPr.t
+ val notContains : string -> t UnPr.t
(** == Character Predicates == *)
More information about the MLton-commit
mailing list