Ticket #1889: B.hs

File B.hs, 1.3 KB (added by dons, 8 years ago)

thread-ring code

Line 
1-- The Great Computer Language Shootout
2-- http://shootout.alioth.debian.org/
3-- Contributed by Jed Brown with improvements by Spencer Janssen and Don Stewart
4--
5-- 503 threads are created with forkIO, with each thread
6-- creating one synchronised mutable variable (MVar) shared with the
7-- next thread in the ring. The last thread created returns an MVar to
8-- share with the first thread. Each thread reads from the MVar to its
9-- left, and writes to the MVar to its right.
10--
11-- Each thread then waits on a token to be passed from its neighbour.
12-- Tokens are then passed around the threads via the MVar chain N times,
13-- and the thread id of the final thread to receive a token is printed.
14--
15-- More information on Haskell concurrency and parallelism:
16--   http://www.haskell.org/ghc/dist/current/docs/users_guide/lang-parallel.html
17--
18
19import Control.Monad
20import Control.Concurrent
21import System.Environment
22
23ring = 503
24
25new l i = do
26  r <- newEmptyMVar
27  forkIO (thread i l r)
28  return r
29
30thread :: Int -> MVar Int -> MVar Int -> IO ()
31thread i l r = go
32  where go = do
33          m <- takeMVar l
34          when (m == 1) (print i)
35          putMVar r $! m - 1
36          when (m > 0) go
37
38main = do
39  a <- newMVar . read . head =<< getArgs
40  z <- foldM new a [2..ring]
41  thread 1 z a