[Haskell-beginners] missing parallelism

[haskell at erebe.eu]

On 24/04/2015 14:21, Maurizio Vitale wrote:
> G'day,
>    I have a test code that I compile with ghc -threaded -eventlog
> -rtsopts --make parallel.hs and run with ./parallel 2 +RTS -ls -N4 on
> a laptop with 4 physical cores. I would expect activities in two
> threads, but threadscope shows only one active thread.
> Can somebody explain me the program's behaviour?
>
> Thanks a lot
>
>     Maurizio
>
> {-# LANGUAGE UnicodeSyntax #-}
> {-# LANGUAGE TupleSections #-}
>
> import Control.Applicative
> import Control.Concurrent.Async (async, waitAny, Async)
> import Data.List (delete, sortBy)
> import Data.Ord (comparing)
> import System.CPUTime
> import System.Environment
> import GHC.Conc (numCapabilities)
>
> concurrentlyLimited :: Int -> [IO a] -> IO [a]
> concurrentlyLimited n tasks = concurrentlyLimited' n (zip [0..] tasks) [] []
>
> concurrentlyLimited' ∷ Int               -- ^ number of concurrent evaluations
>                       → [(Int, IO b)]     -- ^ still to run (ordered by
> first element)
>                       → [Async (Int,b)]   -- ^ currently running
>                       → [(Int,b)]         -- ^ partial results (ordered
> by first element)
>                       → IO [b]
> concurrentlyLimited' _ [] [] results = return . map snd $ sortBy
> (comparing fst) results
> concurrentlyLimited' 0 todo ongoing results = do
>      (task, newResult) <- waitAny ongoing
>      concurrentlyLimited' 1 todo (delete task ongoing) (newResult:results)
>
> concurrentlyLimited' _ [] ongoing results = concurrentlyLimited' 0 []
> ongoing results
> concurrentlyLimited' n ((i, task):otherTasks) ongoing results = do
>      t <- async $ (i,) <$> task
>      concurrentlyLimited' (n-1) otherTasks (t:ongoing) results
>
> euler :: Int → Int
> euler n = length (filter (relprime n) [1..n-1])
>            where
>              relprime x y = gcd x y == 1
>
> sumEuler :: Int → Int
> sumEuler = sum . (map euler) . mkList
>             where
>               mkList n = [1..n-1]
>
> p ∷ IO Int
> p = return $ sumEuler 3000
>
> numThreads ∷ [String] → IO Int
> numThreads [] = return numCapabilities
> numThreads [cores] = return $ read cores
>
> main ∷ IO()
> main = do
>    threads ← getArgs >>= numThreads
>    putStrLn $ "Running up to " ++ show threads ++ " threads in parallel
> (on " ++ show numCapabilities ++ " cores)"
>    startTime ← getCPUTime
>    f ← concurrentlyLimited threads $ replicate 10 p
>    endTime ← getCPUTime
>    putStrLn $ foldr  ((++) . show ) ""  f
>    putStrLn $ "Evaluation took " ++ show (fromIntegral (endTime -
> startTime) / 1000000000000∷Double)
> _______________________________________________
> Beginners mailing list
> Beginners at haskell.org
> http://mail.haskell.org/cgi-bin/mailman/listinfo/beginners

Hello,

I don't have an Haskell environnement at hand, but my advice is to 
search for when your Async/eulerSum calls are evaluated.
For example try to remove this line   -- putStrLn $ foldr  ((++) . show 
) ""  f
Does your program still compute something ? If no that's because your 
sum is evaluated due to the show and not due to your async.

t <- async $ (i,) <$> task

Your async will try to compute (i,eulerSum) but you never force the 
computation of the eulersum inside the async, so the async take no time 
and return quickly.
Instead of this type [Async (Int, b)] you should aim for this one [(Int, 
Async b)]

Let me know if that helps you.

Regards,
Romain