[Haskell-cafe] Uses forkOS all CPUS on-board?

[Dusan Kolar]

Hello haskellers,

  in past few days, a lot of stuff on concurrency went through
the conference. I'm trying to use posted things and my own.
They work, even in a context switching regime, but I can't
exploit all the CPU's on my computer. Always is "active"
just one thread and, thus, the computation is even slower
than having a sequential version. Below, you can find
my code - it computes nothing useful, it's been simplified
to test parallelism, nothing else. Where's my error?

  Regards

    Dusan


import Control.Concurrent

-- computes nothing too much useful, but takes a long time ;-)
sumAllSums [] = 0
sumAllSums l@(_:xs) = sumlist 0 l + sumAllSums xs
    where sumlist res [] = res
          sumlist sr  (v:vs) = sumlist (sr+v) vs


main = do
  putStrLn "Starting..."
  mv1 <- newEmptyMVar
  mv2 <- newEmptyMVar
  t1 <- forkOS $ mkSum1 mv1
  t2 <- forkOS $ mkSum2 mv2
  tt mv1 mv2
  forkOS $ do killThread t1
              killThread t2
  putStrLn "Done!"
  where
    mkSum1 mv = do
      let res = sumAllSums [1..10000]
      let ms1 = "Sum1: " ++ show res
      seq (length ms1) (putMVar mv ms1)
    mkSum2 mv = do
      let res = sumAllSums [1..10001]
      let ms2 = "Sum2: " ++ show res
      seq (length ms2) (putMVar mv ms2)
    tt mv1 mv2 = do
      yield
      mr1 <- tryTakeMVar mv1
      case mr1 of
        Just r1 -> do
          yield
          putStrLn r1
          yield
          r2 <- takeMVar mv2
          putStrLn r2
        Nothing -> do
          mr2 <- tryTakeMVar mv2
          case mr2 of
            Just r2 -> do
              yield
              putStrLn r2
              yield
              r1 <- takeMVar mv1
              putStrLn r1
            Nothing -> tt mv1 mv2