public
Created

Example of bad TChan usage

  • Download Gist
TChan.hs
Haskell
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
-- 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 ()

Please sign in to comment on this gist.

Something went wrong with that request. Please try again.