{-
The parallel function (specialised to lists) is equivalent to:

import Control.Parallel.Strategies
parallel :: [IO [a]] -> IO [[a]]
parallel = return . withStrategy (parList $ seqList r0) . map unsafePerformIO

However, this version performs about 10% slower with 2 processors in GHC 6.12.1
-}

module Parallel(parallel) where

import System.IO.Unsafe
import GHC.Conc(numCapabilities)
import Control.Concurrent
import Control.Monad


parallel :: [IO a] -> IO [a]
parallel = if numCapabilities <= 1 then parallel1 else parallelN


parallel1 :: [IO a] -> IO [a]
parallel1 [] = return []
parallel1 (x:xs) = do
    x2 <- x
    xs2 <- unsafeInterleaveIO $ parallel1 xs
    return $ x2:xs2


parallelN :: [IO a] -> IO [a]
parallelN xs = do
    ms <- mapM (const newEmptyMVar) xs
    chan <- newChan
    mapM_ (writeChan chan . Just) $ zip ms xs
    replicateM_ numCapabilities (writeChan chan Nothing >> forkIO (f chan))
    parallel1 $ map takeMVar ms
    where
        f chan = do
            v <- readChan chan
            case v of
                Nothing -> return ()
                Just (m,x) -> do
                    x' <- x
                    putMVar m x'
                    f chan