module DivConN where
import Eden
import System.IO.Unsafe
import Control.Monad
import Control.Parallel.Strategies(seqList,Strategy, rwhnf)
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
)
spawnAt :: (Trans a, Trans b) => [Int] -> [Process a b] -> [a] -> [b]
spawnAt places ps is = unsafePerformIO
(sequence
[instantiateAt st p i |
(st,p,i) <- zip3 (cycle places) ps is]
)
dcN :: (Trans a, Trans b) =>
Int -> Int
-> (a -> Bool) -> (a -> b)
-> (a -> [a]) -> ([b] -> b)
-> a -> b
dcN n depth trivial solve split combine x
= dcN_c n depth trivial solve split (\_ parts -> combine parts) x
dcN_c :: (Trans a, Trans b) =>
Int -> Int
-> (a -> Bool) -> (a -> b)
-> (a -> [a]) -> (a -> [b] -> b)
-> a -> b
dcN_c n depth trivial solve split combine x
= if depth < 1 then seqDC x
else if trivial x then solve x
else childRs `seq`
combine x (myR : childRs)
where myself = dcN_c n (depth 1) trivial solve split combine
seqDC x = if trivial x then solve x
else combine x (map seqDC (split x))
(mine:rest) = split x
myR = myself mine
childRs = parMapAt places myself rest
`using` seqList r0
places = map ((+1) . (`mod` noPe) . (+(1))) shifts
shifts = map (selfPe +) [shift,2*shift..]
shift = n ^ (depth 1)
logN n 1 = 0
logN n k | k > 0 = 1 + logN n ((k + n1) `div` n)
| otherwise = error "logN"
dcN' n pes = dcN n depth
where depth = logN n pes
dcNTickets :: (Trans a, Trans b) =>
Int -> [Int]
-> (a -> Bool) -> (a -> b)
-> (a -> [a]) -> ([b] -> b)
-> (a -> b)
-> a -> b
dcNTickets k ts trivial solve split combine seqDC x
= dcNTickets_c k ts trivial solve split
(\_ parts -> rnf parts `seq`
combine parts) seqDC x
dcNTickets_c :: (Trans a, Trans b) =>
Int -> [Int]
-> (a -> Bool) -> (a -> b)
-> (a -> [a]) -> (a -> [b] -> b)
-> (a -> b)
-> a -> b
dcNTickets_c k [] trivial solve split combine seqDC x = seqDC x
dcNTickets_c k tickets trivial solve split combine seqDC x
= if trivial x then solve x
else childRes `seq`
rnf myRes `seq` rnf localRess `seq`
combine x (myRes:childRes ++ localRess )
where
(childTickets,restTickets) = splitAt (k1) tickets
(myTs:theirTs)=unshuffle k restTickets
ticketF ts = dcNTickets_c k ts trivial solve split combine seqDC
insts = length childTickets
(procIns, localIns) = splitAt insts theirIn
childProcs = map (process . ticketF) theirTs
childRes = spawnAt childTickets childProcs procIns
myRes = ticketF myTs myIn
(myIn:theirIn) = split x
localRess = map seqDC localIns
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)
dc4WithSeq :: (Trans a, Trans b) =>
Int ->
(a -> Bool) -> (a -> b) ->
(a -> [a]) -> ([b] -> b) ->
(a -> b) ->
a -> b
dc4WithSeq pes = quadDCAtSep (logN 4 pes)
quadDCAtSep :: (Trans a, Trans b) =>
Int -> (a -> Bool) -> (a -> b) -> (a -> [a]) -> ([b] -> b) -> (a -> b) -> a -> b
quadDCAtSep depth trivial solve split combine seqDC x =
if depth < 1 then seqDC x
else if trivial x then solve x
else
seqList rwhnf childrenL `seq`
combine (myself1 : children)
where myself = quadDCAtSep (depth 1) trivial solve split combine seqDC
[l,r1,r2,r3] = split x
children =
map deLift childrenL
childrenL = zipWith(\arg place -> cpAt place (process (myself)) arg)
[r1,r2,r3] places
places = map ((+1) . (`mod` noPe) . (+(1))) shifts
shifts = map (selfPe +) [shift,2*shift..]
shift = 4 ^ (depth 1)
myself1 = myself l