summaryrefslogtreecommitdiff
path: root/Utility/Parallel.hs
diff options
context:
space:
mode:
authorGravatar Joey Hess <joey@kitenet.net>2012-07-18 19:25:46 -0400
committerGravatar Joey Hess <joey@kitenet.net>2012-07-18 19:25:46 -0400
commit2edb5d145c66c36d0f5fd90bfb7905989643266a (patch)
tree0414c82ecc7af3ccaa1ca8f2e54c206adb1a3cea /Utility/Parallel.hs
parentcf47bb3f509ae63ad868b66c0b6f2baecb93e4c7 (diff)
rewrote to not use forkProcess
That can make the threaded runtime stall.. But it can use threads now!
Diffstat (limited to 'Utility/Parallel.hs')
-rw-r--r--Utility/Parallel.hs25
1 files changed, 18 insertions, 7 deletions
diff --git a/Utility/Parallel.hs b/Utility/Parallel.hs
index f4a79316c..fcab2a90a 100644
--- a/Utility/Parallel.hs
+++ b/Utility/Parallel.hs
@@ -1,4 +1,4 @@
-{- parallel processes
+{- parallel processing via threads
-
- Copyright 2012 Joey Hess <joey@kitenet.net>
-
@@ -9,16 +9,27 @@ module Utility.Parallel where
import Common
-import System.Posix.Process
+import Control.Concurrent
+import Control.Exception
-{- Runs an action in parallel with a set of values.
+{- Runs an action in parallel with a set of values, in a set of threads.
+ - In order for the actions to truely run in parallel, requires GHC's
+ - threaded runtime,
+ -
- Returns the values partitioned into ones with which the action succeeded,
- and ones with which it failed. -}
inParallel :: (v -> IO ()) -> [v] -> IO ([v], [v])
inParallel a l = do
- pids <- mapM (forkProcess . a) l
- statuses <- mapM (getProcessStatus True False) pids
- return $ reduce $ partition (succeeded . snd) $ zip l statuses
+ mvars <- mapM thread l
+ statuses <- mapM takeMVar mvars
+ return $ reduce $ partition snd $ zip l statuses
where
- succeeded v = v == Just (Exited ExitSuccess)
reduce (x,y) = (map fst x, map fst y)
+ thread v = do
+ mvar <- newEmptyMVar
+ _ <- forkIO $ do
+ r <- try (a v) :: IO (Either SomeException ())
+ case r of
+ Left _ -> putMVar mvar False
+ Right _ -> putMVar mvar True
+ return mvar