[Shootout-list] Re: ring of processes

[Raymond Racine]

--=-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--