{-
Copyright 2010 Mario Blazevic
This file is part of the Streaming Component Combinators (SCC) project.
The SCC project is free software: you can redistribute it and/or modify it under the terms of the GNU General Public
License as published by the Free Software Foundation, either version 3 of the License, or (at your option) any later
version.
SCC is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty
of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details.
You should have received a copy of the GNU General Public License along with SCC. If not, see
.
-}
-- | The "Control.Monad.Parallel" tests.
module Main where
import Prelude hiding (mapM)
import Control.Monad (liftM)
import Control.Parallel (pseq)
import Data.Functor.Identity (runIdentity)
import Data.Maybe (fromJust)
import System.Environment (getArgs)
import Control.Monad.Parallel
parFib :: MonadParallel m => Int -> Int -> m Integer
parFib _ 0 = return 1
parFib _ 1 = return 1
parFib 1 n = applyM fib n
parFib k n = bindM2 (\a b-> return (a + b)) (parFib (mod k 2) (n - 1)) (parFib (mod (k + 1) 2) (n - 2))
forkFib :: MonadFork m => Int -> Int -> m Integer
forkFib _ 0 = return 1
forkFib _ 1 = return 1
forkFib 1 n = applyM fib n
forkFib k n = do mf1 <- forkExec (forkFib (mod k 2) (n - 1))
f2 <- forkFib (mod (k + 1) 2) (n - 2)
f1 <- mf1
return (f1 + f2)
parSeqFib :: MonadParallel m => [Int] -> m Integer
parSeqFib = liftM sum . mapM (applyM fib)
applyM f n = let result = f n in result `pseq` return result
fib 0 = 1
fib 1 = 1
fib n = fib (n - 2) + fib (n - 1)
main = do args <- getArgs
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]
_ -> 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
_ -> error (help ++ "Bad monad.")
print result
help = "Usage: test-parallel \n"
++ " where is 'fib',\n"
++ " is 'par', 'fork, or '[par]'\n"
++ " is 'Identity', 'Maybe', '[]', or 'IO',\n"
++ " is the number of threads to launch,\n"
++ " and is the size of the task.\n"