gistfile1.hs

module Main where

import System.Environment 
import Control.Concurrent
import Control.Monad

process i inbox outbox = do
	msg <- takeMVar inbox					-- read message from inbox
	when (i /= 0 ||  msg == 0) (putMVar outbox $! msg) 	-- all except the last node forward their message
	when (msg /= 0) (process i inbox outbox) 		-- when not at the last message, recur.

mkRing 0 inbox final = forkIO (process 0 inbox final)	-- the last node terminates by writing into the “final” mvar

mkRing i inbox final = do
	outbox <- newEmptyMVar		-- create new outbox
	forkIO (process i inbox outbox)	-- run a process with the inbox and outbox
	mkRing (i-1) outbox final	-- create the next one with the current outbox as its inbox.

main = do
	args <- getArgs
	let n = read . head $ args		-- number of items in the ring
	let m = read . head . tail $ args	-- number of messages sent for 1 turn each

	first <- newEmptyMVar	-- inbox of the first process 
	final <- newEmptyMVar	-- outbox of the last process
	mkRing n first final	-- spawn processes

	mapM (putMVar first) [m-1,m-2..0] -- write m messages into the ring.
	takeMVar final	-- read the outbox of the last process, blocking.