Par.hs


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

module Par (map, mapIO, mapIO_) where

import Control.Parallel (par, pseq)
import Control.Concurrent (forkIO)
import qualified Control.Concurrent.MVar as MVar
import Prelude hiding (map)

map :: (a -> b) -> [a] -> [b]
map _ [] = []
map f (x:xs) =
  let this = f x
      that = Par.map f xs
  in that `par` this `pseq` this : that

mapIO :: (a -> IO b) -> [a] -> IO [b]
mapIO _ [] = return []
mapIO f (x:xs) = do restMVar <- MVar.newEmptyMVar
                    _ <- forkIO (do rest <- mapIO f xs
                                    MVar.putMVar restMVar rest)
                    this <- f x
                    rest <- MVar.takeMVar restMVar
                    return (this : rest)

mapIO_ :: (a -> IO ()) -> [a] -> IO ()
mapIO_ _ [] = return ()
mapIO_ f (x:xs) = do _ <- forkIO (mapIO_ f xs)
                     f x