On Fri, Dec 19, 2008 at 9:27 AM, Paul Keir <pkeir@dcs.gla.ac.uk> wrote:
module Main where

import Control.Concurrent

fibs = 0 : 1 : zipWith (+) fibs (tail fibs)

heavytask m = putMVar m (fibs !! 100000)

Oh, also, heavytask is not very heavy at all.  It just writes the thunk (fibs !! 100000) into the MVar.  Not a single number is added in this thread.

You probably meant to have the thread evaluate its argument _before_ writing it to the variable:

heavytask m = putMVar m $! (fibs !! 100000)

(Or more transparently)

heavytask m = let answer = fibs !! 100000 in answer `seq` putMVar m answer

But as per my other comments, you will not see a speedup (in fact, you will probably see some slowdown as two threads compete to compute the same value).

Luke
 


main = do ms <- sequence $ replicate 2 newEmptyMVar
         mapM_ (forkIO . heavytask) $ tail ms
         heavytask $ head ms
         ms' <- mapM takeMVar ms
         mapM_ print ms'

Regards,
Paul
_______________________________________________
Haskell-Cafe mailing list
Haskell-Cafe@haskell.org
http://www.haskell.org/mailman/listinfo/haskell-cafe