haskellConcurrent.hs

import Control.Concurrent

main = do
  setNumCapabilities 4
  result <- parallelDoWork 38 4
  --result <- doWork 38 4
  putStrLn $ show result

parallelDoWork n m = do
  resultMVars <- mapM (\_ -> forkWork n) [1..m]
  results <- mapM takeMVar resultMVars
  return $ foldl (+) 0 results

forkWork :: Int -> IO (MVar Int)
forkWork n = do
  m <- newEmptyMVar
  forkIO $ do
    -- $! is necessary to have the result evaluated now, inside the thread,
    -- rather than when takeMVar is called
    let value = slowFib $! n
    putMVar m $! value
  return m

doWork :: Int -> Int -> IO Int
doWork n m = return $ foldl (+) 0 [slowFib n | _ <- [1..m]]

slowFib :: Int -> Int
slowFib 1 = 1
slowFib 2 = 2
slowFib n = slowFib (n - 1) + slowFib (n - 2)