[MLton-commit] r5472
Vesa Karvonen
vesak at mlton.org
Tue Mar 27 11:44:41 PST 2007
Prefer currying more consistently.
----------------------------------------------------------------------
U mltonlib/trunk/com/ssh/async/unstable/detail/async.sml
U mltonlib/trunk/com/ssh/async/unstable/example/actor/actor.sml
U mltonlib/trunk/com/ssh/async/unstable/example/smlbot/smlbot.sml
U mltonlib/trunk/com/ssh/async/unstable/public/async.sig
U mltonlib/trunk/com/ssh/async/unstable/test/async.sml
----------------------------------------------------------------------
Modified: mltonlib/trunk/com/ssh/async/unstable/detail/async.sml
===================================================================
--- mltonlib/trunk/com/ssh/async/unstable/detail/async.sml 2007-03-27 03:34:46 UTC (rev 5471)
+++ mltonlib/trunk/com/ssh/async/unstable/detail/async.sml 2007-03-27 19:44:40 UTC (rev 5472)
@@ -24,7 +24,7 @@
structure Event = struct
datatype 'a t = E of ('a Handler.t UnPr.t, 'a) Sum.t Thunk.t
- fun on (E t, f) =
+ fun on (E t) f =
E (fn () =>
INL (fn h => let
val h = Handler.prepend f h
@@ -52,9 +52,9 @@
case t () of
INL ef => ignore (ef (Handler.new ()))
| INR () => ()
- fun when ? = once (on ?)
- fun each e = when (e, fn () => each e)
- fun every ? = each (on ?)
+ fun when ? = once o on ?
+ fun each e = when e (fn () => each e)
+ fun every ? = each o on ?
val any = once o choose
val all = each o choose
end
@@ -154,10 +154,10 @@
fun taker (T st) = let
val ch = Ch.new ()
fun lp st =
- when (IVar.read st,
- fn N (v, st) =>
- when (Ch.give ch v,
- fn () => lp st))
+ when (IVar.read st)
+ (fn N (v, st) =>
+ when (Ch.give ch v)
+ (fn () => lp st))
in
lp (!st) ; Ch.take ch
end
Modified: mltonlib/trunk/com/ssh/async/unstable/example/actor/actor.sml
===================================================================
--- mltonlib/trunk/com/ssh/async/unstable/example/actor/actor.sml 2007-03-27 03:34:46 UTC (rev 5471)
+++ mltonlib/trunk/com/ssh/async/unstable/example/actor/actor.sml 2007-03-27 19:44:40 UTC (rev 5472)
@@ -51,7 +51,7 @@
val wakeupCh = SkipCh.new ()
fun handler f =
recur (!msgs, []) (fn loop =>
- fn ([], _) => when (SkipCh.take wakeupCh, fn () => handler f)
+ fn ([], _) => when (SkipCh.take wakeupCh) (fn () => handler f)
| (m::ms, fms) =>
try (fn () => f m,
fn () => msgs := List.revAppend (fms, ms),
Modified: mltonlib/trunk/com/ssh/async/unstable/example/smlbot/smlbot.sml
===================================================================
--- mltonlib/trunk/com/ssh/async/unstable/example/smlbot/smlbot.sml 2007-03-27 03:34:46 UTC (rev 5471)
+++ mltonlib/trunk/com/ssh/async/unstable/example/smlbot/smlbot.sml 2007-03-27 19:44:40 UTC (rev 5472)
@@ -12,8 +12,6 @@
open Async
- fun when e f = Async.when (e, f)
-
fun relTimeout t = let
val v = IVar.new ()
in
@@ -70,7 +68,7 @@
o String.tokens (eq #"\n") o stripPrefix 0
val jobs = Mailbox.new ()
fun taking () =
- (when (Mailbox.take jobs))
+ (every (Mailbox.take jobs))
(fn code => let
val proc = Unix.execute ("./run-sandboxed-sml.sh", [])
val (ins, outs) = Unix.streamsOf proc
@@ -79,7 +77,7 @@
; TextIO.closeOut outs
; send (format (TextIO.inputAll ins)) : Unit.t
; TextIO.closeIn ins
- ; taking ()
+ ; ignore (Unix.reap proc)
end)
in
taking () ; Mailbox.send jobs
Modified: mltonlib/trunk/com/ssh/async/unstable/public/async.sig
===================================================================
--- mltonlib/trunk/com/ssh/async/unstable/public/async.sig 2007-03-27 03:34:46 UTC (rev 5471)
+++ mltonlib/trunk/com/ssh/async/unstable/public/async.sig 2007-03-27 19:44:40 UTC (rev 5472)
@@ -52,7 +52,7 @@
* event does not commit to the returned event.
*)
- val on : 'a Event.t * ('a -> 'b) -> 'b Event.t
+ val on : 'a Event.t -> ('a -> 'b) -> 'b Event.t
(**
* Creates an event that is enabled whenever the given event is enabled
* and when committed to also executes the given function, which is
@@ -87,14 +87,14 @@
*
* {each} can be implemented as a simple tail-recursive loop:
*
- *> fun each e = when (e, fn () => each e)
+ *> fun each e = when e (fn () => each e)
*)
- val when : ('a Event.t * 'a Effect.t) Effect.t
- (** {when (e, h) = once (on (e, h))} *)
+ val when : 'a Event.t -> 'a Effect.t Effect.t
+ (** {when e = once o on e} *)
- val every : ('a Event.t * 'a Effect.t) Effect.t
- (** {every (e, h) = each (on (e, h))} *)
+ val every : 'a Event.t -> 'a Effect.t Effect.t
+ (** {every e = each o on e} *)
val any : Unit.t Event.t List.t Effect.t
(** {any = once o choose} *)
Modified: mltonlib/trunk/com/ssh/async/unstable/test/async.sml
===================================================================
--- mltonlib/trunk/com/ssh/async/unstable/test/async.sml 2007-03-27 03:34:46 UTC (rev 5471)
+++ mltonlib/trunk/com/ssh/async/unstable/test/async.sml 2007-03-27 19:44:40 UTC (rev 5472)
@@ -9,10 +9,10 @@
*)
val () = let
open UnitTest Async Async.Handler
- fun eq (ac, ex) = verifyEq Type.int {actual = ac, expect = ex}
- fun eql (ac, ex) = verifyEq (Type.list Type.int) {actual = ac, expect = ex}
+ fun eq ex ac = verifyEq Type.int {actual = ac, expect = ex}
+ fun eql ex ac = verifyEq (Type.list Type.int) {actual = ac, expect = ex}
val full = verifyFailsWith (fn Full => true | _ => false)
- fun inc v _ = v += 1
+ fun inc v () = v += 1
val push = List.push
in
unitTests
@@ -25,12 +25,12 @@
in
fill v ()
; full (fill v)
- ; when (read v, inc n) ; eq (!n, 0)
- ; runAll () ; eq (!n, 1)
+ ; when (read v) (inc n) ; eq 0 (!n)
+ ; runAll () ; eq 1 (!n)
; full (fill v)
- ; when (read v, inc n) ; eq (!n, 1)
- ; runAll () ; eq (!n, 2)
- ; runAll () ; eq (!n, 2)
+ ; when (read v) (inc n) ; eq 1 (!n)
+ ; runAll () ; eq 2 (!n)
+ ; runAll () ; eq 2 (!n)
end))
(title "Async.MVar")
@@ -42,13 +42,13 @@
in
fill v ()
; full (fill v)
- ; when (take v, inc n) ; eq (!n, 0)
- ; runAll () ; eq (!n, 1)
+ ; when (take v) (inc n) ; eq 0 (!n)
+ ; runAll () ; eq 1 (!n)
; fill v ()
; full (fill v)
- ; when (take v, inc n) ; eq (!n, 1)
- ; runAll () ; eq (!n, 2)
- ; runAll () ; eq (!n, 2)
+ ; when (take v) (inc n) ; eq 1 (!n)
+ ; runAll () ; eq 2 (!n)
+ ; runAll () ; eq 2 (!n)
end))
(title "Async.choose")
@@ -58,17 +58,17 @@
val b1 = new ()
val b2 = new ()
val n = ref 0
- val e = choose [on (take b1, inc n),
- on (take b2, inc n)]
+ val e = choose [on (take b1) (inc n),
+ on (take b2) (inc n)]
in
send b1 ()
; send b1 ()
; send b2 ()
- ; once e ; eq (!n, 0)
- ; runAll () ; eq (!n, 1)
- ; each e ; eq (!n, 1)
- ; runAll () ; eq (!n, 3)
- ; runAll () ; eq (!n, 3)
+ ; once e ; eq 0 (!n)
+ ; runAll () ; eq 1 (!n)
+ ; each e ; eq 1 (!n)
+ ; runAll () ; eq 3 (!n)
+ ; runAll () ; eq 3 (!n)
end))
(title "Async.Mailbox")
@@ -80,14 +80,14 @@
in
send b 1
; send b 2
- ; when (take b, push s) ; runAll ()
- ; when (take b, push s)
- ; when (take b, push s) ; runAll ()
+ ; when (take b) (push s) ; runAll ()
+ ; when (take b) (push s)
+ ; when (take b) (push s) ; runAll ()
; send b 3
; send b 4
; send b 5
- ; every (take b, push s) ; runAll ()
- ; eql (!s, [5,4,3,2,1])
+ ; every (take b) (push s) ; runAll ()
+ ; eql [5,4,3,2,1] (!s)
end))
(title "Async.Multicast")
@@ -106,13 +106,13 @@
val s2 = ref []
val s3 = ref []
in
- all [on (t1, push s1),
- on (t2, push s2),
- on (t3, push s3)]
+ all [on t1 (push s1),
+ on t2 (push s2),
+ on t3 (push s3)]
; runAll ()
- ; eql (!s1, [4, 3, 2])
- ; eql (!s2, [4, 3])
- ; eql (!s3, [4])
+ ; eql [4, 3, 2] (!s1)
+ ; eql [4, 3] (!s2)
+ ; eql [4] (!s3)
end))
(title "Async.SkipCh")
@@ -122,10 +122,10 @@
val c = new ()
in
send c 1
- ; when (take c, eq /> 1) ; runAll ()
+ ; when (take c) (eq 1) ; runAll ()
; send c 2
; send c 3
- ; when (take c, eq /> 3) ; runAll ()
+ ; when (take c) (eq 3) ; runAll ()
end))
(title "Async")
@@ -135,8 +135,8 @@
val c = SkipCh.new ()
val l = ref []
fun lp () =
- any [on (SkipCh.take c, lp o push l),
- on (IVar.read v, push l)]
+ any [on (SkipCh.take c) (lp o push l),
+ on (IVar.read v) (push l)]
in
lp ()
; runAll ()
@@ -145,7 +145,7 @@
; SkipCh.send c 3
; SkipCh.send c 4 ; runAll ()
; IVar.fill v 5 ; runAll ()
- ; eql (!l, [5, 4, 2, 1])
+ ; eql [5, 4, 2, 1] (!l)
end))
$
More information about the MLton-commit
mailing list