Dear all,

I've thought the following three (dummy) programs would run some of their parts in parallel (on dual core) if compiled with option threaded (smp). The truth is that only the first one exploits multicore CPU. Why?

Moreover, using RTS option -sstderr makes runtime not to evaluate in parallel even for the first program. Why?

 Thanks for tips

   Dusan

My arch:
Linux pcx 2.6.24-ARCH #1 SMP PREEMPT Sun Feb 10 15:44:59 CET 2008 x86_64 Intel(R) Core(TM)2 CPU 6600 @ 2.40GHz GenuineIntel GNU/Linux

My ghc:
The Glorious Glasgow Haskell Compilation System, version 6.8.2
/64bit, binary distro for FC/


----------------------------------------------------
Prog 1:

module Main() where

import Control.Parallel
import Control.Parallel.Strategies

fibs :: Integer -> Integer
fibs n | n > 1  = fibs (n-1) + fibs (n-2)
      | n == 1 = 1
      | True   = 0

fib n = if n<0 then error "Negative input to fib!"
       else f1+f2
 where
   [f1,f2] = parMap rnf fibs [(n-1),(n-2)]

main = do
 putStrLn "Starting..."
 putStrLn $ "Fib 43: " ++ show (fib 43)
 putStrLn "Done!"


----------------------------------------------------
Prog 2:

module Main() where

import Control.Concurrent
import Control.Concurrent.MVar

fibs :: Integer -> Integer
fibs n | n > 1  = fibs (n-1) + fibs (n-2)
      | n == 1 = 1
      | True   = 0

fib n = if n<0 then error "Negative input to fib!"
       else do
         v1 <- newEmptyMVar
         v2 <- newEmptyMVar
         h1 <- forkIO $ putMVar v1 $ fibs (n-1)
         h2 <- forkIO $ putMVar v2 $ fibs (n-2)
         f1 <- takeMVar v1
         f2 <- takeMVar v2
         killThread h1
         killThread h2
         return (f1+f2)

main = do
 putStrLn "Starting..."
 f <- fib 43
 putStrLn $ "Fib 43: " ++ show f
 putStrLn "Done!"


----------------------------------------------------
Prog 3:

module Main() where

import Control.Concurrent
import Control.Concurrent.MVar

fibs :: Integer -> Integer
fibs n | n > 1  = fibs (n-1) + fibs (n-2)
      | n == 1 = 1
      | True   = 0

fib n = if n<0 then error "Negative input to fib!"
       else do
         v1 <- newEmptyMVar
         v2 <- newEmptyMVar
         h1 <- forkOS $ putMVar v1 $ fibs (n-1)
         h2 <- forkOS $ putMVar v2 $ fibs (n-2)
         f1 <- takeMVar v1
         f2 <- takeMVar v2
         killThread h1
         killThread h2
         return (f1+f2)

main = do
 putStrLn "Starting..."
 f <- fib 43
 putStrLn $ "Fib 43: " ++ show f
 putStrLn "Done!"


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

Reply via email to