Skip to content

@tibbe /hsGreat.hs
Created

Embed URL

HTTPS clone URL

Subversion checkout URL

You can clone with
or
.
Download ZIP
import Control.Monad
import Control.Concurrent
import Data.Int
import System.Environment
sendSidewards :: Chan Int -> Chan Int -> IO ()
sendSidewards from to = do
n <- readChan from
writeChan to n
sendSidewards from to
sendLeft :: Chan Int -> IO ()
sendLeft left = do
n <- readChan left
writeChan left n
sendLeft left
makeTrack :: Chan Int -> Int -> IO()
makeTrack left nRemaining =
if nRemaining > 0 then
midTrack left nRemaining
else
sendLeft left
midTrack :: Chan Int -> Int -> IO()
midTrack left nRemaining = do
right <- newChan
forkIO $ makeTrack right (nRemaining - 1)
forkIO $ sendSidewards left right
sendSidewards right left
launchRunner :: Chan Int -> Int -> IO()
launchRunner chan num = do
writeChan chan num
doRace :: Chan Int -> MVar [Int] -> Int -> IO()
doRace start resultChan numRunners = do
let runners = [1..numRunners]
let launchRunnerOnChan = launchRunner start
forkIO $ mapM_ launchRunnerOnChan runners
finishLine start numRunners [] resultChan
finishLine :: Chan Int -> Int -> [Int] -> MVar [Int] -> IO()
finishLine inChan remaining results resultChan =
if remaining > 0 then do
res <- receiveResults inChan
finishLine inChan (remaining - 1) (res:results) resultChan
else doneResults results resultChan
doneResults :: [Int] -> MVar [Int] -> IO()
doneResults results resultChan = do
putMVar resultChan results
receiveResults :: Chan Int -> IO Int
receiveResults inChan = readChan inChan
main = do
(numRunners:numThreads:_) <- getArgs
racerA <- newChan
racerB <- newChan
forkIO $ makeTrack racerA $ read numThreads
forkIO $ makeTrack racerB $ read numThreads
resultsA <- newEmptyMVar
resultsB <- newEmptyMVar
forkIO $ doRace racerA resultsA $ read numRunners
forkIO $ doRace racerB resultsB $ read numRunners
awaitWinner resultsA resultsB
awaitWinner :: MVar [Int] -> MVar [Int] -> IO()
awaitWinner aChan bChan = do
aReady <- varReady aChan
if aReady then
printWinner aChan "a"
else do
bReady <- varReady bChan
if bReady then
printWinner bChan "b"
else awaitWinner aChan bChan
varReady :: MVar [Int] -> IO Bool
varReady var = do
empty <- isEmptyMVar var
return (not empty)
printWinner :: MVar [Int] -> [Char] -> IO()
printWinner chan name = do
putStrLn (name ++ " won!")
nums <- takeMVar chan
putStrLn $ show nums
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment
Something went wrong with that request. Please try again.