
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)