Skip to content

@josejuan /gist:3742897
Created

Embed URL

HTTPS clone URL

Subversion checkout URL

You can clone with
or
.
Download ZIP
Thanks to Don Stewart! (yet another concurrency test)
{-# LANGUAGE BangPatterns #-}
import Control.Concurrent
import Control.Monad
import System.Environment(getArgs)
import Data.Int
import Control.Concurrent.STM
addMany' :: [TVar Int64] -> Int64 -> Int64 -> IO ()
addMany' !a !n !i =
forM_ [1..i] (\_ ->
forM_ a (shW n))
addMany :: TVar Int64 -> [TVar Int64] -> Int64 -> Int64 -> IO ()
addMany !c !a !n !i = addMany' a n i >> shW 1 c
waitTo !c !nth = do
threadDelay (100*1000)
w' <- shR c
if w' == nth
then return ()
else waitTo c nth
shR = atomically . readTVar
shW !k !r = atomically $
do x' <- readTVar r
writeTVar r $! (x' + k)
main = do
args <- getArgs
let (niters, nvars, nthreads) = (read x, read y, read z)
(x:y:z:_) = args
c <- atomically $ newTVar 0
a <- mapM (\_ -> atomically $ newTVar 0) [1..nvars]
mapM_ (\k -> forkIO $ addMany c a k niters) [1..nthreads]
waitTo c nthreads
z <- mapM shR a
putStrLn $ show $ sum z
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.