Benchmarks Game/Parallel/ThreadRing

-- The Great Computer Language Shootout
-- http://shootout.alioth.debian.org/
-- Contributed by Jed Brown with improvements by Spencer Janssen and Don Stewart
--
-- 503 threads are created with forkOnIO, with each thread
-- creating one synchronised mutable variable (MVar) shared with the
-- next thread in the ring. The last thread created returns an MVar to
-- share with the first thread. Each thread reads from the MVar to its
-- left, and writes to the MVar to its right.
--
-- Each thread then waits on a token to be passed from its neighbour.
-- Tokens are then passed around the threads via the MVar chain N times, 
-- and the thread id of the final thread to receive a token is printed.
--
-- More information on Haskell concurrency and parallelism:
--   http://www.haskell.org/ghc/dist/current/docs/users_guide/lang-parallel.html
--
-- SMP parallelisation strategy is to partition the ring equally over each capability.
--
 
import Control.Monad
import Control.Concurrent
import System.Environment
import GHC.Conc
 
ring = 503
 
new l i = do
  r <- newEmptyMVar
  forkOnIO n (thread i l r)
  return r
 where
  n | i < 125   = 0
    | i < 250   = 1
    | i < 375   = 2
    | otherwise = 3
 
 
thread :: Int -> MVar Int -> MVar Int -> IO ()
thread i l r = go
  where go = do
          m <- takeMVar l
          when (m == 1) (print i)
          putMVar r $! m - 1
          when (m > 0) go
 
main = do
  a <- newMVar . read . head =<< getArgs
  z <- foldM new a [2..ring]
  thread 1 z a