hlint 1.6 → 1.6.1

raw patch · 2 files changed

+39/−1 lines, 2 files

Files

• hlint.cabal +2/−1
• src/Parallel.hs +37/−0

@@ -1,7 +1,7 @@ cabal-version:      >= 1.6 build-type:         Simple name:               hlint-version:            1.6+version:            1.6.1 license:            GPL license-file:       LICENSE category:           Development@@ -44,6 +44,7 @@         Type         Test         Util+        Parallel         HSE.All         HSE.Bracket         HSE.Evaluate

@@ -0,0 +1,37 @@++module Parallel(parallel) where++import System.IO.Unsafe(unsafeInterleaveIO)+import GHC.Conc(numCapabilities)+import Control.Concurrent+import Control.Monad+++parallel :: [IO a] -> IO [a]+parallel = if numCapabilities <= 1 then parallel1 else parallelN+++parallel1 :: [IO a] -> IO [a]+parallel1 [] = return []+parallel1 (x:xs) = do+    x2 <- x+    xs2 <- unsafeInterleaveIO $ parallel1 xs+    return $ x2:xs2+++parallelN :: [IO a] -> IO [a]+parallelN xs = do+    ms <- mapM (const newEmptyMVar) xs+    chan <- newChan+    mapM (writeChan chan . Just) $ zip ms xs+    replicateM_ numCapabilities (writeChan chan Nothing >> forkIO (f chan))+    parallel1 $ map takeMVar ms+    where+        f chan = do+            v <- readChan chan+            case v of+                Nothing -> return ()+                Just (m,x) -> do+                    x' <- x+                    putMVar m x'+                    f chan