[Shootout-list] Re: ring of processes
Raymond Racine
rracine@adelphia.net
Tue, 12 Oct 2004 23:11:27 -0400
--=-y3tDffO46efsljy8m7zJ
Content-Type: text/plain
Content-Transfer-Encoding: 7bit
Here is a MLton version using CML which is included in the upcoming
release.
--=-y3tDffO46efsljy8m7zJ
Content-Disposition: attachment; filename=ringmsg.sml
Content-Type: application/x-smil; name=ringmsg.sml
Content-Transfer-Encoding: 7bit
structure Ring =
struct
fun repeat (0,thunk) = ()
| repeat (n,thunk) = (thunk();repeat(n-1,thunk))
fun runRing size = let val conns = List.tabulate (size - 1, fn _ => CML.channel ())
val inouts = ListPair.zip (conns, tl conns)
fun startStd() = List.app (fn (inchan,outchan) =>
(CML.spawn (fn _ => while true do CML.send (outchan, (CML.recv inchan)));())) inouts
fun startRing() = let val (lastin,lastout) = List.last inouts
val firstin = CML.channel()
val (firstout,_) = List.hd inouts
val lastProcessor = fn () => (CML.send (firstin,"start");
let val done = ref false
in
while not (!done) do
if CML.recv lastin = "stop"
then (print "done"; done := true)
else ()
end)
val firstProcessor = fn () => let val msg = CML.recv firstin
in
if msg = "start"
then repeat (size * 128 - 1, fn _ => CML.send (firstout,"msg"))
else (print "Error: First msg not a start."; print (msg ^ "\n"));
CML.send (firstout,"stop")
end
in
startStd();
CML.spawn firstProcessor;
CML.spawn lastProcessor
end
in
let val tid = startRing()
in
CML.sync (CML.joinEvt tid);
RunCML.shutdown OS.Process.success
end
end
end
val _ = let val arg0 = List.hd (CommandLine.arguments())
in
RunCML.doit (fn () => Ring.runRing (Option.getOpt (Int.fromString arg0,0)), NONE)
end
--=-y3tDffO46efsljy8m7zJ
Content-Disposition: attachment; filename=ringmsg.mlb
Content-Type: text/plain; name=ringmsg.mlb; charset=UTF-8
Content-Transfer-Encoding: 7bit
$(MLTON_ROOT)/basis/basis.mlb
$(MLTON_ROOT)/cml/cml.mlb
local
ringmsg.sml
in
structure Ring
end
--=-y3tDffO46efsljy8m7zJ--