Performance wtf

performance_wtf.hs

concurrentMap3 :: Int -> (a -> b) -> [a] -> IO [b]
concurrentMap3 k f xs = do
  mvars   <- sequence $ replicate k newEmptyMVar
  _       <- sequence $ map spark (ys `zip` mvars)
  results <- sequence $ map takeMVar mvars
  return $ concat $ results
  where len = fromIntegral $ length $ xs -- Hope you're happy now GHC. 
        q   = ceiling $ (len / (fromIntegral k))
        ys  = every q xs
        spark = \tup -> forkIO $ do 
          val <- sequence $ map (\x -> evaluate $ f x) (fst tup) -- Forcing strict evaluation!
          putMVar (snd tup) val