module System.IO.Parallel
( twoParallel
, threeParallel
, fourParallel
, manyParallel
) where
import Control.Concurrent (forkIO, yield)
import Control.Concurrent.MVar (MVar, newEmptyMVar, takeMVar, putMVar)
async :: IO a -> IO (MVar a)
async m = do
v <- newEmptyMVar
_ <- forkIO $ do
x <- m
yield
putMVar v x
return v
twoParallel :: IO a -> IO b -> IO (a, b)
twoParallel a b = do
a' <- async a
b' <- async b
a'' <- takeMVar a'
b'' <- takeMVar b'
return (a'', b'')
threeParallel :: IO a -> IO b -> IO c -> IO (a, b, c)
threeParallel a b c = do
a' <- async a
b' <- async b
c' <- async c
a'' <- takeMVar a'
b'' <- takeMVar b'
c'' <- takeMVar c'
return (a'', b'', c'')
fourParallel :: IO a -> IO b -> IO c -> IO d -> IO (a, b, c, d)
fourParallel a b c d = do
a' <- async a
b' <- async b
c' <- async c
d' <- async d
a'' <- takeMVar a'
b'' <- takeMVar b'
c'' <- takeMVar c'
d'' <- takeMVar d'
return (a'', b'', c'', d'')
manyParallel :: [IO a] -> IO [a]
manyParallel m
= mapM async m >>= mapM takeMVar