module DivConRW(divConRW,divConDM,divConRW2) where
import Prelude hiding (seq)
import Control.Parallel (pseq)
import Eden
import EdenMWToken (mwNest')
import EdiWP
import Data.List
import System.IO.Unsafe
import Control.Monad
seq = pseq
mw :: (Trans a, Trans b) =>
Int -> Int -> (a -> b) -> [a] -> [b]
mw = ediWPf
unshuffle :: Int -> [a] -> [[a]]
unshuffle n xs = [takeEach n (drop i xs) | i <- [0..n1]]
takeEach :: Int -> [a] -> [a]
takeEach n [] = []
takeEach n (x:xs) = x : takeEach n (drop (n1) xs)
shuffle :: [[a]] -> [a]
shuffle = concat . transpose
farm :: (Trans a, Trans b) => Int -> (a -> b) -> [a] -> [b]
farm np f ts = let inputss = unshuffle np ts
in shuffle (parMapAt (repeat 0) (map f) inputss)
parMapAt :: (Trans a, Trans b) => [Int] -> (a -> b) -> [a] -> [b]
parMapAt places f xs
= unsafePerformIO (
zipWithM (\pe x -> instantiateAt pe (process f) x)
places xs
)
divConSeq :: (a->Bool) -> (a->b) -> (a->[a]) -> (a->[b]->b) -> a -> b
divConSeq trivial solve split combine x
| trivial x = solve x
| otherwise = combine x children
where children = map (divConSeq trivial solve split combine) (split x)
divConRW :: (Trans a,Trans b, Show b, Show a, NFData b) =>
Int -> (a->Bool) -> (a->b) -> (a->[a]) -> (a->[b]->b) -> a -> b
divConRW depth trivial solve split combine x
= combineTopMaster combine levels results
where (tasks,levels) = generateTasks depth trivial split x
results = workpool (divConSeq trivial solve split combine) tasks
workpool f tasks = mw pes 10 f tasks
divConDM :: (Trans a,Trans b, Show b, Show a, NFData a, NFData b) =>
Int -> (a->Bool) -> (a->b) -> (a->[a]) -> (a->[b]->b) -> a -> b
divConDM depth trivial solve split combine x
=
combineTopMaster combine levels results
where (tasks,levels) = generateTasks depth trivial split x
results = shuffle (parMapAt [2,3..]
(\ i -> map (divConSeq trivial solve split combine)
((unshuffle pes tasks)!!i)) [0..pes1])
pes :: Int
pes = max 1 (noPe1)
data Tree a = Tree a [Tree a] | Leaf a deriving Show
instance NFData a => NFData (Tree a)
where rnf (Tree a ls) = rnf a `seq` rnf ls
rnf (Leaf a) = rnf a
generateTasks :: Int -> (a->Bool) -> (a->[a]) -> a -> ([a],Tree a)
generateTasks 0 _ _ a = ([a],Leaf a)
generateTasks n trivial split a
| trivial a = ([a],Leaf a)
| otherwise = (concat ass,Tree a ts)
where assts = map (generateTasks (n1) trivial split) (split a)
(ass,ts) = unzip assts
foldl_rnf :: NFData a => (a -> b -> a) -> a -> [b] -> a
foldl_rnf _ b [] = b
foldl_rnf f b (x:xs) = let new = f b x
in rnf new `seq` foldl_rnf f new xs
combineTop :: (NFData b, Show b, Show a) =>
(a->[b]->b) -> (Tree a) -> [b] -> b
combineTop c t bs = fst (combineTop' c t bs)
combineTopMaster :: (NFData b) =>
(a->[b]->b) -> (Tree a) -> [b] -> b
combineTopMaster c t bs = fst (combineTopRnf c t bs)
#if 1
combineTop' :: (NFData b, Show b, Show a) =>
(a->[b]->b) -> (Tree a) -> [b] -> (b,[b])
combineTop' _ (Leaf a) (b:bs) = (b,bs)
combineTop' combine (Tree a ts) bs =
(combine a (reverse res),bs')
where (bs',res) = foldl' f (bs,[]) ts
f (olds,news) t = (remaining,b:news)
where (b,remaining) =
combineTop' combine t olds
combineTop' _ t ls = error ("combineTop' _ Parameter t:\n" ++ show t ++ " \nParameter ls:\n" ++ show ls)
combineTopRnf :: (NFData b) =>
(a->[b]->b) -> (Tree a) -> [b] -> (b,[b])
combineTopRnf _ (Leaf a) (b:bs) = (b,bs)
combineTopRnf combine (Tree a ts) bs
=
(rnf res `seq` combine a res, bs')
where (bs',res) = foldl f (bs,[]) ts
f (olds,news) t = (remaining,news++[b])
where (b,remaining) =
combineTopRnf combine t olds
#else
combineTop' :: (a->[b]->b) -> (Tree a) -> [b] -> (b,Int)
combineTop' _ (Leaf a) (b:bs) = (b,1)
combineTop' combine (Tree a ts) bs = (combine a res,length bs length bs')
where (bs',res) = foldl f (bs,[]) ts
f (olds,news) t = (drop n olds,news++[b])
where (b,n) = combineTop' combine t olds
#endif
liftWorker :: (t -> r) -> (Int, t) -> (Int, r)
liftWorker f (k, x) = (k, f x)
mwNest :: (Trans t, Trans r) =>
Int -> Int -> Int -> Int -> (t -> r) -> [t] -> [r]
mwNest depth l1 np pf f tasks = let taggedTasks = zip [1,2..] tasks
in sortByTag $ mwNest' depth l1 np pf (liftWorker f) taggedTasks
divConRW2 :: (Trans a,Trans b, Show b, Show a, NFData b) =>
Int -> (a->Bool) -> (a->b) -> (a->[a]) -> (a->[b]->b) -> a -> b
divConRW2 depth trivial solve split combine x
= combineTopMaster combine levels results
where (tasks,levels) = generateTasks depth trivial split x
results = workpool (divConSeq trivial solve split combine) tasks
workpool f tasks = mwNest 2 4 noPe 20 f tasks