Created

Embed URL

HTTPS clone URL

SSH clone URL

You can clone with HTTPS or SSH.

Download Gist

Example of bad TChan usage

View TChan.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
-- 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
Something went wrong with that request. Please try again.