Create a gist now

Instantly share code, notes, and snippets.

Example of bad TChan usage
-- See http://stackoverflow.com/questions/6439925/poor-performance-lockup-with-stm
{-# LANGUAGE BangPatterns #-}
module Main where
import Control.Concurrent.STM
import Control.Concurrent
import System.Random(randomRIO)
import Control.Monad(forever, when)
maxN :: Int
maxN = 20
data Tuple = T {-# UNPACK #-} !Int {-# UNPACK #-} !Int
deriving (Eq, Show)
data Record = R {-# UNPACK #-} !Tuple {-# UNPACK #-} !Int
deriving (Eq, Show)
allCoords :: [Tuple]
allCoords = [ T x y | x <- [0..maxN], y <- [0..maxN]]
randomCoords :: IO Tuple
randomCoords = do
x <- randomRIO (0,maxN)
y <- randomRIO (0,maxN)
return $ T x y
doWork :: TChan Record -> IO ()
doWork chan = do mapM_ startWatcher allCoords
go 1 >> return ()
where
go !cnt = do xy <- randomCoords
atomically $ writeTChan chan (R xy cnt)
go cnt
startWatcher p = do
chan' <- atomically $ dupTChan chan
_ <- ($) forkIO $ watcher chan'
return ()
where
watcher chan' = forever $ do
r@(R p' _) <- atomically $ readTChan chan'
when (p == p') (print r)
main :: IO ()
main = do
chan <- newTChanIO :: IO (TChan Record)
doWork chan
return ()
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment