  $ I d : message - ghc-2.code , v 1.3 2005/09/17 04:36:26 bfulgham Exp $
  The Great Computer Language Shootout
-- /
  Contributed by  
  Modified by  

-- A Modification of threads003, using explicit assigning of threads to CPUs
  ( assumes 2 CPUs ) .   This version can go faster with -N2 than -N1 .
--
  NB . do n't forget to run it with + RTS -qm , to disable automatic migration .

import Control.Concurrent
import Control.Monad
import System.Environment
import GHC.Conc (forkOnIO)

thread :: MVar Int -> MVar Int -> IO ()
thread inp out = do x <- takeMVar inp; putMVar out $! x+1; thread inp out

spawn cur n = do next <- newEmptyMVar
                 forkOnIO (if (n <= 1000) then 0 else 1) $ thread cur next
                 return next

main = do n <- getArgs >>= readIO.head
          s <- newEmptyMVar
          e <- foldM spawn s [1..2000]
          f <- newEmptyMVar
          forkOnIO 1 $ replicateM n (takeMVar e) >>= putMVar f . sum
          replicateM n (putMVar s 0)
          takeMVar f

  vim :   = haskell

 /
 A Modification of threads003, using explicit assigning of threads to CPUs

  $ I d : message - ghc-2.code , v 1.3 2005/09/17 04:36:26 bfulgham Exp $
  The Great Computer Language Shootout
  Contributed by  
  Modified by  

  ( assumes 2 CPUs ) .   This version can go faster with -N2 than -N1 .
  NB . do n't forget to run it with + RTS -qm , to disable automatic migration .

import Control.Concurrent
import Control.Monad
import System.Environment
import GHC.Conc (forkOnIO)

thread :: MVar Int -> MVar Int -> IO ()
thread inp out = do x <- takeMVar inp; putMVar out $! x+1; thread inp out

spawn cur n = do next <- newEmptyMVar
                 forkOnIO (if (n <= 1000) then 0 else 1) $ thread cur next
                 return next

main = do n <- getArgs >>= readIO.head
          s <- newEmptyMVar
          e <- foldM spawn s [1..2000]
          f <- newEmptyMVar
          forkOnIO 1 $ replicateM n (takeMVar e) >>= putMVar f . sum
          replicateM n (putMVar s 0)
          takeMVar f

  vim :   = haskell
