[GHC] #2868: `par` `pseq` does not work as expected

[GHC]

#2868: `par` `pseq` does not work as expected
------------------------------------+---------------------------------------
    Reporter:  hoangta              |        Owner:  simonmar        
        Type:  bug                  |       Status:  new             
    Priority:  normal               |    Milestone:  6.10.2          
   Component:  Runtime System       |      Version:  6.10.1          
    Severity:  major                |   Resolution:                  
    Keywords:  par, pseq, parallel  |   Difficulty:  Easy (1 hr)     
    Testcase:                       |           Os:  Unknown/Multiple
Architecture:  Unknown/Multiple     |  
------------------------------------+---------------------------------------
Old description:

> The following Wombat program is from "A Tutorial on Parallel and
> Concurrent Programming in Haskell". It does not work as expected on my
> computer (Core(TM)2 Quad  CPU). Only one core is used when I watch by
> "mpstat -P ALL 1 200". I compile and run by:
> ghc --make -threaded wombat.hs
> ./wombat +RTS -N4
>
> and the result is:
> par sum: 119201850
> par time: 20.932636 seconds.
> seq sum: 119201850
> seq time: 20.926783 seconds.
>
> Please check if is is a bug.
>
> ---- wombat.hs ----
> import System.Time
> import Control.Parallel
>
> fib :: Int -> Int
> fib 0 = 0
> fib 1 = 1
> fib n = fib (n-1) + fib (n-2)
>
> secDiff :: ClockTime -> ClockTime -> Float
> secDiff (TOD secs1 psecs1) (TOD secs2 psecs2) =
>         fromInteger (psecs2 - psecs1) / 1e12 + fromInteger (secs2 -
> secs1)
>
> mkList :: Int -> [Int]
> mkList n = [1..n-1]
>
> relprime :: Int -> Int -> Bool
> relprime x y = gcd x y == 1
>
> euler :: Int -> Int
> euler n = length (filter (relprime n) (mkList n))
>
> sumEuler :: Int -> Int
> sumEuler = sum . (map euler) . mkList
>
> seqSumFibEuler:: Int -> Int -> Int
> seqSumFibEuler a b = fib a + sumEuler b
>
> parSumFibEuler a b = f `par` (e `pseq` (e+ f))
>         where
>                 f = fib a
>                 e = sumEuler b
>
> r1 = seqSumFibEuler 40 7450
> r2 = parSumFibEuler 40 7450
>
> main :: IO ()
> main =
>         do
>                 t0 <- getClockTime
>                 pseq r1 (return())
>                 t1 <- getClockTime
>                 putStrLn ("seq sum: " ++ show r1)
>                 putStrLn ("seq time: " ++ show (secDiff t0 t1) ++ "
> seconds.")
>                 t0 <- getClockTime
>                 pseq r2 (return())
>                 t1 <- getClockTime
>                 putStrLn ("par sum: " ++ show r2)
>                 putStrLn ("par time: " ++ show (secDiff t0 t1) ++ "
> seconds.")

New description:

 The following Wombat program is from "A Tutorial on Parallel and
 Concurrent Programming in Haskell". It does not work as expected on my
 computer (Core(TM)2 Quad  CPU). Only one core is used when I watch by
 "mpstat -P ALL 1 200". I compile and run by:
 {{{
 ghc --make -threaded wombat.hs
 ./wombat +RTS -N4
 }}}
 and the result is:
 {{{
 par sum: 119201850
 par time: 20.932636 seconds.
 seq sum: 119201850
 seq time: 20.926783 seconds.
 }}}
 Please check if is is a bug.

 {{{
 ---- wombat.hs ----
 import System.Time
 import Control.Parallel

 fib :: Int -> Int
 fib 0 = 0
 fib 1 = 1
 fib n = fib (n-1) + fib (n-2)

 secDiff :: ClockTime -> ClockTime -> Float
 secDiff (TOD secs1 psecs1) (TOD secs2 psecs2) =
         fromInteger (psecs2 - psecs1) / 1e12 + fromInteger (secs2 - secs1)

 mkList :: Int -> [Int]
 mkList n = [1..n-1]

 relprime :: Int -> Int -> Bool
 relprime x y = gcd x y == 1

 euler :: Int -> Int
 euler n = length (filter (relprime n) (mkList n))

 sumEuler :: Int -> Int
 sumEuler = sum . (map euler) . mkList

 seqSumFibEuler:: Int -> Int -> Int
 seqSumFibEuler a b = fib a + sumEuler b

 parSumFibEuler a b = f `par` (e `pseq` (e+ f))
         where
                 f = fib a
                 e = sumEuler b

 r1 = seqSumFibEuler 40 7450
 r2 = parSumFibEuler 40 7450

 main :: IO ()
 main =
         do
                 t0 <- getClockTime
                 pseq r1 (return())
                 t1 <- getClockTime
                 putStrLn ("seq sum: " ++ show r1)
                 putStrLn ("seq time: " ++ show (secDiff t0 t1) ++ "
 seconds.")
                 t0 <- getClockTime
                 pseq r2 (return())
                 t1 <- getClockTime
                 putStrLn ("par sum: " ++ show r2)
                 putStrLn ("par time: " ++ show (secDiff t0 t1) ++ "
 seconds.")
 }}}

-- 
Ticket URL: <http://hackage.haskell.org/trac/ghc/ticket/2868#comment:2>
GHC <http://www.haskell.org/ghc/>
The Glasgow Haskell Compiler