Created

Embed URL

HTTPS clone URL

SSH clone URL

You can clone with HTTPS or SSH.

Download Gist
View hsGreat.hs
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90
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.