1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
|
-- |Intended for internal use: Parallel evaluation of @IO@ values
module System.IO.Parallel
( twoParallel
, threeParallel
, fourParallel
, manyParallel
) where
import Control.Concurrent (forkIO, yield)
import Control.Concurrent.MVar (MVar, newEmptyMVar, takeMVar, putMVar)
-------------------
-- |Run an @IO@ computation in parallel. The result will appear in the @MVar@.
async :: IO a -> IO (MVar a)
async m = do
v <- newEmptyMVar
_ <- forkIO $ do
x <- m
yield
putMVar v x
return v
-- |Run two @IO@ computations in parallel and wait for the results.
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'')
-- |Run three @IO@ computations in parallel and wait for the results.
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'')
-- |Run four @IO@ computations in parallel and wait for the results.
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'')
-- |Run computations in parallel and wait for the results.
manyParallel :: [IO a] -> IO [a]
manyParallel m
= mapM async m >>= mapM takeMVar
|
