-- $Id: prodcons.ghc,v 1.1 2001/02/28 01:08:27 doug Exp $
-- http://www.bagley.org/~doug/shootout/
-- from Josef Svenningsson
module Main where
import CVar
import MVar
import Concurrent
import Exception
import IOExts
import System
producer :: Int -> IORef Int -> CVar Int -> IO ()
producer n p ch = sequence_ (map send [1..n])
where send i = do writeCVar ch i
prod <- readIORef p
writeIORef p (prod+1)
consumer :: Int -> IORef Int -> CVar Int -> IO ()
consumer n c ch = cons 1
where cons i | n <= i = return ()
cons i
= do i <- readCVar ch
con <- readIORef c
writeIORef c (con+1)
cons i
myForkIO :: IO () -> IO (MVar ())
myForkIO io = do
mvar <- newEmptyMVar
forkIO (io `finally` putMVar mvar ())
return mvar
join :: MVar () -> IO ()
join mvar = readMVar mvar
main = do (a:_) <- getArgs
let n = read a
produced <- newIORef 0
consumed <- newIORef 0
channel <- newCVar
p <- myForkIO (producer n produced channel)
c <- myForkIO (consumer n consumed channel)
join p; join c
prod <- readIORef produced
cons <- readIORef consumed
putStrLn (show prod ++ " " ++ show cons)