# HG changeset patch # User Daichi TOMA # Date 1391427487 -32400 # Node ID efb4e880ac7f1c57c9c148b7328a6910aa7e95be # Parent 278bd0dcec51a7b8e74e666a5731fe4abe7f4b13 add simple parallel execution test diff -r 278bd0dcec51 -r efb4e880ac7f test/ParRead.hs --- a/test/ParRead.hs Mon Feb 03 19:35:08 2014 +0900 +++ b/test/ParRead.hs Mon Feb 03 20:38:07 2014 +0900 @@ -24,7 +24,7 @@ node2 <- getRootNode jungle "test_tree" t0 <- getCurrentTime printTimeSince t0 - let result = map (func node2) [1..1000] `using` parList rseq + let result = map (func node2) [1..1000] `using` parList rpar print (length (filter (> size_x) result)) printTimeSince t0 diff -r 278bd0dcec51 -r efb4e880ac7f test/runEvalTest/Makefile --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/test/runEvalTest/Makefile Mon Feb 03 20:38:07 2014 +0900 @@ -0,0 +1,7 @@ +# we should use cabal +RCPUS = 4 +test: ParSum + ./ParSum +RTS -K1G -N$(RCPUS) + +ParSum: ParSum.hs + ghc -O2 ParSum.hs -i.. -threaded -rtsopts diff -r 278bd0dcec51 -r efb4e880ac7f test/runEvalTest/ParSum.hs --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/test/runEvalTest/ParSum.hs Mon Feb 03 20:38:07 2014 +0900 @@ -0,0 +1,51 @@ +{-# LANGUAGE OverloadedStrings #-} + +import Control.Parallel +import Control.Parallel.Strategies +import Text.Printf +import Data.Time.Clock +import Control.Exception +import System.Environment + +num = 1000000 + +main = do + t0 <- getCurrentTime + printTimeSince t0 + --a <- evaluate $ runEval test3 + --a <- evaluate $ runEval (test1 100) + a <- evaluate $ ((map (\x -> (sum' (x*num) ((x+1)*num))) [0..10]) `using` parList' rpar) + print a + printTimeSince t0 + +parList' s [x] = do + a <- s x + return [a] +parList' s (x:xs) = do + a <- s x + b <- parList' s xs + return (a:b) + +test = do + a <- rpar (sum' 0 num) + b <- rpar (sum' num (num*2)) + return (a,b) + +test1 i = do + a <- rpar (sum' (i*num) ((i+1) * num)) + if i == 0 + then (return [a]) + else do b <- test1 (i-1) + return (a:b) +test3 = do + a <- rpar (sum' 0 num) + b <- rpar (sum' num (if a < num then a else (num*2))) + return (a,b) + +sum' begin end = if begin < end + then begin + (sum' (begin + 1) end) + else begin + +printTimeSince t0 = do + t1 <- getCurrentTime + printf "time: %.2fs\n" (realToFrac (diffUTCTime t1 t0) :: Double)