monad-parallel 0.5.1 → 0.5.2

raw patch · 3 files changed

+26/−23 lines, 3 files

Files

• Control/Monad/Parallel.hs +6/−7
• TestParallel.hs +19/−15
• monad-parallel.cabal +1/−1

@@ -61,11 +61,10 @@  import Prelude () import Control.Concurrent (forkIO)-import Control.Concurrent.MVar (newEmptyMVar, putMVar, takeMVar, tryPutMVar)-import Control.Monad (Monad, (>>=), return, join, liftM)-import qualified Control.Monad+import Control.Concurrent.MVar (newEmptyMVar, putMVar, takeMVar)+import Control.Monad (Monad, (>>=), return) import Control.Parallel (par, pseq)-import Data.Functor.Identity (Identity, runIdentity)+import Data.Functor.Identity (Identity) import Data.Int (Int) import Data.List (foldr, map, replicate) import Data.Maybe (Maybe)@@ -111,7 +110,7 @@  -- | Like 'Control.Monad.sequence_', but executing the actions in parallel. sequence_ :: MonadParallel m => [m a] -> m () -sequence_ ms = foldr (liftM2 (\ x y -> ())) (return ()) ms+sequence_ ms = foldr (liftM2 (\ _ _ -> ())) (return ()) ms  -- | Like 'Control.Monad.mapM', but applying the function to the individual list items in parallel. mapM :: MonadParallel m => (a -> m b) -> [a] -> m [b]@@ -134,7 +133,7 @@ -- | IO is parallelizable by `forkIO`. instance MonadParallel IO where    bindM2 f ma mb = do vb <- newEmptyMVar-                       forkIO (mb >>= putMVar vb)+                       _ <- forkIO (mb >>= putMVar vb)                        a <- ma                        b <- takeMVar vb                        f a b@@ -145,5 +144,5 @@ -- | IO is forkable by `forkIO`. instance MonadFork IO where    forkExec ma = do v <- newEmptyMVar-                    forkIO (ma >>= putMVar v)+                    _ <- forkIO (ma >>= putMVar v)                     return (takeMVar v)

@@ -42,8 +42,11 @@                  f1 <- mf1                  return (f1 + f2) -parSeqFib :: MonadParallel m => [Int] -> m Integer-parSeqFib = liftM sum . mapM (applyM fib)+parSeqFib :: MonadParallel m => Int -> Int -> m Integer+parSeqFib t n = liftM sum $ mapM (applyM fib) (split t n)+   where split 1 n = [n]+         split k n | k > 1 = let (max : rest) = split (k - 1) n+                             in rest ++ [max - 1, max - 2]  applyM f n = let result = f n in result `pseq` return result @@ -55,25 +58,26 @@           if length args /= 5              then putStr help              else do let [taskName, method, monad, size, threads] = args-                         task :: MonadFork m => m Integer-                         task = case (method, taskName) of ("par", "fib") -> parFib (read threads) (read size)-                                                           ("fork", "fib") -> forkFib (read threads) (read size)-                                                           ("[par]", "fib") -> parSeqFib [1 .. read size]+                         task :: MonadFork m => Int -> Int -> m Integer+                         task = case (method, taskName) of ("par", "fib") -> parFib+                                                           ("fork", "fib") -> forkFib+                                                           ("[par]", "fib") -> parSeqFib                                                            _ -> error (help ++ "Bad method or task.")-                         parOnlyTask :: MonadParallel m => m Integer-                         parOnlyTask = case (method, taskName) of ("par", "fib") -> parFib (read threads) (read size)-                                                                  ("[par]", "fib") -> parSeqFib [1 .. read size]-                                                                  _ -> error ("Monad " ++ monad ++ " can't do " ++ method)-                     result <- case monad of "Maybe" -> return $ fromJust task-                                             "[]" -> return $ head task-                                             "Identity" -> return $ runIdentity parOnlyTask-                                             "IO" -> task+                         parOnlyTask :: MonadParallel m => Int -> Int -> m Integer+                         parOnlyTask = case (method, taskName) of ("par", "fib") -> parFib+                                                                  ("[par]", "fib") -> parSeqFib+                                                                  _ -> error ("Monad " ++ monad ++ " can't do "+                                                                              ++ method)+                     result <- case monad of "Maybe" -> return $ fromJust $ task (read threads) (read size)+                                             "[]" -> return $ head $ task (read threads) (read size)+                                             "Identity" -> return $ runIdentity $ parOnlyTask (read threads) (read size)+                                             "IO" -> task (read threads) (read size)                                              _ -> error (help ++ "Bad monad.")                      print result  help = "Usage: test-parallel <task> <method> <monad> <threads> <size>\n"        ++ "  where <task>    is 'fib',\n"-       ++ "        <method>  is 'par', 'fork, or '[par]'\n"+       ++ "        <method>  is 'par', 'fork', or '[par]'\n"        ++ "        <monad>   is 'Identity', 'Maybe', '[]', or 'IO',\n"        ++ "        <threads> is the number of threads to launch,\n"        ++ "    and <size>    is the size of the task.\n"

@@ -1,5 +1,5 @@ Name:                monad-parallel-Version:             0.5.1+Version:             0.5.2 Cabal-Version:       >= 1.2 Build-Type:          Simple Synopsis:            Parallel execution of monadic computations