Here's a version that provides clean output with no delays. It uses a
single-entry mailbox (the TMVar "output") to ensure the processing
doesn't run too far ahead of the log.
module Test where
import System.Random
import Control.Concurrent
import Control.Concurrent.STM
test :: IO ()
test =
do
tv <- atomically (newTVar 0)
output <- atomically (newTMVar "Log begins")
forkIO (writer output)
forkIO (producer tv output)
consumer tv output
write :: TMVar String -> String -> STM ()
write output message = putTMVar output message
producer tv o =
do r <- randomRIO (1,10)
atomically $ do v <- readTVar tv
writeTVar tv (v+r)
write o ("insert " ++ show r)
producer tv o
return ()
consumer tv o =
do r <- randomRIO (1,10)
atomically $ do v <- readTVar tv
if (v < r)
then retry
else writeTVar tv (v-r)
write o ("consume " ++ show r)
consumer tv o
return ()
writer :: TMVar String -> IO ()
writer o =
do msg <- atomically $ takeTMVar o
putStrLn msg
writer o
_______________________________________________
Haskell-Cafe mailing list
Haskell-Cafe@haskell.org
http://www.haskell.org/mailman/listinfo/haskell-cafe
