File: Parallel.hs

package info (click to toggle)
hlint 2.1.10-2
  • links: PTS, VCS
  • area: main
  • in suites: bullseye, buster, sid
  • size: 588 kB
  • sloc: haskell: 4,475; lisp: 86; makefile: 5
file content (46 lines) | stat: -rw-r--r-- 1,228 bytes parent folder | download | duplicates (2)
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
{-
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 Control.Concurrent
import Control.Exception
import Control.Monad


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


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


parallelN :: Int -> [IO a] -> IO [a]
parallelN j xs = do
    ms <- mapM (const newEmptyMVar) xs
    chan <- newChan
    mapM_ (writeChan chan . Just) $ zip ms xs
    replicateM_ j (writeChan chan Nothing >> forkIO (f chan))
    let throwE x = throw (x :: SomeException)
    parallel1 $ map (fmap (either throwE id) . takeMVar) ms
    where
        f chan = do
            v <- readChan chan
            case v of
                Nothing -> return ()
                Just (m,x) -> do
                    putMVar m =<< try x
                    f chan