[MLton-commit] r5356
Vesa Karvonen
vesak at mlton.org
Tue Feb 27 13:25:05 PST 2007
Changed code to clean up handler lists to eliminate space leaks.
Different Mailbox implementation to ensure that messages arrive in the
correct order.
----------------------------------------------------------------------
U mltonlib/trunk/com/ssh/async/unstable/detail/async.sml
----------------------------------------------------------------------
Modified: mltonlib/trunk/com/ssh/async/unstable/detail/async.sml
===================================================================
--- mltonlib/trunk/com/ssh/async/unstable/detail/async.sml 2007-02-27 21:13:03 UTC (rev 5355)
+++ mltonlib/trunk/com/ssh/async/unstable/detail/async.sml 2007-02-27 21:25:03 UTC (rev 5356)
@@ -67,62 +67,82 @@
structure Ch = struct
datatype 'a t
- = T of {ts : 'a Handler.t Queue.t,
- gs : {handler : Unit.t Handler.t, value : 'a} Queue.t}
- fun new () = T {ts = Queue.new (), gs = Queue.new ()}
+ = T of {ts : 'a Handler.t Node.t,
+ gs : {handler : Unit.t Handler.t, value : 'a} Node.t}
+ fun new () = T {ts = Node.new (), gs = Node.new ()}
fun take (T {gs, ts}) =
E (fn () =>
- case Queue.dequeWhile (Handler.scheduled o #handler) gs of
- NONE => INL (Queue.enque ts)
- | SOME {handler, value} =>
- (Handler.schedule () handler ; INR value))
+ (Node.filterOut (Handler.scheduled o #handler) gs
+ ; case Node.take gs of
+ NONE => INL (Node.push ts)
+ | SOME {handler, value} =>
+ (Handler.schedule () handler ; INR value)))
fun give (T {ts, gs}) v =
E (fn () =>
- case Queue.dequeWhile Handler.scheduled ts of
- SOME th => (Handler.schedule v th ; INR ())
- | NONE =>
- INL (fn h => Queue.enque gs {handler = h, value = v}))
- fun send m = Event.once o give m
+ (Node.filterOut Handler.scheduled ts
+ ; case Node.take ts of
+ SOME th => (Handler.schedule v th ; INR ())
+ | NONE =>
+ INL (fn h => Node.push gs {handler = h, value = v})))
end
- structure Mailbox = Ch
+ structure Mailbox = struct
+ datatype 'a t = T of {ts : 'a Handler.t Node.t, vs : 'a Queue.t}
+ fun new () = T {ts = Node.new (), vs = Queue.new ()}
+ fun take (T {ts, vs}) =
+ E (fn () =>
+ case Queue.deque vs of
+ NONE => (Node.filterOut Handler.scheduled ts
+ ; INL (Node.push ts))
+ | SOME v => INR v)
+ fun send (T {ts, vs}) v =
+ (Queue.enque vs v
+ ; Node.filterOut Handler.scheduled ts
+ ; case Node.take ts of
+ NONE => ()
+ | SOME th =>
+ case Queue.deque vs of
+ NONE => raise Fail "impossible"
+ | SOME v => Handler.schedule v th)
+ end
structure IVar = struct
- datatype 'a t = T of {rs : 'a Handler.t Queue.t, st : 'a Option.t Ref.t}
- fun new () = T {rs = Queue.new (), st = ref NONE}
+ datatype 'a t = T of {rs : 'a Handler.t Node.t, st : 'a Option.t Ref.t}
+ fun new () = T {rs = Node.new (), st = ref NONE}
fun read (T {rs, st}) =
E (fn () =>
case !st of
SOME v => INR v
- | NONE => INL (Queue.enque rs))
+ | NONE => (Node.filterOut Handler.scheduled rs
+ ; INL (Node.push rs)))
fun fill (T {rs, st}) v =
case !st of
SOME _ => raise Full
- | NONE => (st := SOME v ; Queue.appClear (Handler.schedule v) rs)
+ | NONE => (st := SOME v ; Node.clearWith (Handler.schedule v) rs)
end
structure MVar = struct
- datatype 'a t = T of {ts : 'a Handler.t Queue.t, st : 'a Option.t Ref.t}
- fun new () = T {ts = Queue.new (), st = ref NONE}
+ datatype 'a t = T of {ts : 'a Handler.t Node.t, st : 'a Option.t Ref.t}
+ fun new () = T {ts = Node.new (), st = ref NONE}
fun take (T {ts, st}) =
E (fn () =>
case !st of
SOME v => (st := NONE ; INR v)
- | NONE => INL (Queue.enque ts))
- fun fill (T {ts, st}) v =
+ | NONE => (Node.filterOut Handler.scheduled ts
+ ; INL (Node.push ts)))
+ fun give (T {ts, st}) v =
+ (Node.filterOut Handler.scheduled ts
+ ; case Node.take ts of
+ NONE => st := SOME v
+ | SOME h => Handler.schedule v h)
+ fun fill (t as T {st, ...}) v =
case !st of
SOME _ => raise Full
- | NONE =>
- case Queue.dequeWhile Handler.scheduled ts of
- NONE => st := SOME v
- | SOME h => Handler.schedule v h
- fun send (T {ts, st}) v =
+ | NONE => give t v
+ fun send (t as T {st, ...}) v =
case !st of
SOME _ => st := SOME v
- | NONE =>
- case Queue.dequeWhile Handler.scheduled ts of
- NONE => st := SOME v
- | SOME h => Handler.schedule v h
+ | NONE => give t v
end
structure SkipCh = MVar
More information about the MLton-commit
mailing list