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

I'm seeing no performance increase with a simple coarse-grained
2-thread code using Control.Concurrent. I compile with:

>  hc conc.hs -o conc --make -threaded

and I run with

>  time ./conc +RTS -N2

But using either "-N1" or "-N2", the program runs in about 1.8secs.
(I'd prefer a longer running thread task, but my fib function
currently runs out of memory).

Anyway, my program is below, and I'm using GHC version 6.8.2 on
a 2-core Pentium D. Can anyone help?

module Main where

import Control.Concurrent

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

This is a serial algorithm.  No matter what the rest of your program is doing, this calculation is sequential, so you will not see a speedup.

Parallelizing computation of the fibonacci numbers is reasonably tricky.  I think you might be able to do it using the fib(2n) identity.  But not this simple algorithm: throwing processors at a problem does not automatically make it parallel.  :-)



heavytask m = putMVar m (fibs !! 100000)

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