Mercurial > hg > Members > toma > Jungle-haskell
changeset 15:3337ccc824a4
fix
| author | Daichi TOMA <toma@cr.ie.u-ryukyu.ac.jp> |
|---|---|
| date | Wed, 22 Jan 2014 15:13:10 +0900 |
| parents | 9df5178e867c |
| children | 72cc49b616cd |
| files | test/ParWrite.hs |
| diffstat | 1 files changed, 12 insertions(+), 13 deletions(-) [+] |
line wrap: on
line diff
--- a/test/ParWrite.hs Wed Jan 22 14:23:29 2014 +0900 +++ b/test/ParWrite.hs Wed Jan 22 15:13:10 2014 +0900 @@ -31,12 +31,16 @@ jungle <- createTree jungle treeId2 node <- getRootNode jungle treeId + node2 <- getRootNode jungle treeId let - miniTree = testTree node treeDepth + miniTree = testTree node treeDepth + miniTree2 = testTree node2 treeDepth updateRootNode jungle treeId miniTree + updateRootNode jungle treeId2 miniTree2 putStrLn $ show $ size miniTree + putStrLn $ show $ size miniTree2 t0 <- getCurrentTime printTimeSince t0 @@ -52,21 +56,16 @@ -- parallel write for two trees by singleWrite dualWrite jungle = do - x <- rpar (mapM runEval (singleWrite jungle writeCount treeId)) - y <- rpar (mapM runEval (singleWrite jungle writeCount treeId2)) + x <- rpar (updateRootNodeWith (writeFunctions writeCount) jungle treeId) + y <- rseq (updateRootNodeWith (writeFunctions writeCount) jungle treeId2) + rseq x return [x, y] --- paralell write for single tree -singleWrite :: Jungle -> Int -> String -> [Eval (IO ())] -singleWrite jungle writeCount treeId = zipWith parApply (writeFunctions writeCount) (repeat jungle) +-- generate functions to node update +writeFunctions :: Int -> Node -> Node +writeFunctions writeCount node = foldl' apply node [0..writeCount] where - parApply f jungle = (rseq.runEval.rpar) (updateRootNodeWith f jungle treeId) - --- generate functions to node update -writeFunctions :: Int -> [(Node -> Node)] -writeFunctions writeCount = map apply [0..writeCount] - where - apply x node = putAttribute node lastPos (show x) (B.pack . show $ x) + apply node x = putAttribute node lastPos (show x) (B.pack . show $ x) -- utils from ParRead