cash-0.1.0.0: src/Math/ComputerAlgebra/Cash/CA_Skeletons.hs
{-# OPTIONS_GHC -cpp -XParallelListComp #-}
{-# LANGUAGE ScopedTypeVariables #-}
-- Time-stamp: <Sat Jun 26 2010 03:18:45 Stardate: Stardate: [-28]3280.27 hwloidl>
--
-- Some skeletons for computer algebra computations, based on Eden skeletons.
----------------------------------------------------------------------------------
module Math.ComputerAlgebra.Cash.CA_Skeletons where
-- this contains the main SCSCP functionality
#ifdef __PARALLEL_HASKELL__
import Math.ComputerAlgebra.Cash.ParSCSCP
#else
import Math.ComputerAlgebra.Cash.SCSCP_API
#endif
import Math.ComputerAlgebra.Cash.HS_SCSCP
import Math.ComputerAlgebra.Cash.HS2SCSCP
#ifdef __PARALLEL_HASKELL__
import EdenHelpers -- helper functions
-- import FoldDM
import Eden
#endif
#ifdef __PARALLEL_HASKELL__
import System.IO.Unsafe
-----------------------------------------
-- special skeleton for SCSCP calls
--
parMapSCSCP :: (Trans a, Trans b, OMData a, OMData b) =>
CAName -> -- (a -> b)
[a] -> -- input,
[b] -- result
parMapSCSCP mapF = parmapfarm noPe (call1 mapF)
-- parmap in EdI
parMap' :: (Trans a, Trans b) => (Process a b) -> [a] -> [b]
parMap' proc xs = unsafePerformIO (mapM (instantiate proc) xs)
-- Eden process farm (np processes, each working on a whole sublist)
parmapfarm :: (Trans a, Trans b) =>
Int -> (a -> b) -- worker process
-> [a] -> [b] -- what to do
parmapfarm np f inputs =
shuffle (parMap' (process (map f)) (unshuffle np inputs))
-- potential optimisation: use explicit IO inside the processes, write
-- out chunks of pcalls instead of one by one. Or: make reply threads
-- work!
-- imported from FoldDM
fold_map_dm :: Trans b => Int -> (a->b) -> (b->b->b) -> b -> [a] -> b
fold_map_dm thr
| noPe > thr = fmDM (noPe-1)
| otherwise = fmDM noPe
fmDM :: Trans b => Int -> (a->b) -> (b->b->b) -> b -> [a] -> b
fmDM np f comb cero tasks = foldl' comb cero (map deLift subresults) -- JB: remove Lift ...
where subresults = [createProcess (worker pid np f comb cero tasks) () | pid <- [0,1..np-1]] `using` whnfspine
-- JB: use createProcess instead of (***)
worker pid np f comb cero tasks = process (\() -> foldl' comb cero subresults)
where subresults = map f (extract pid np tasks)
extract i np ts = (unshuffle np ts) !! i
foldl' :: Trans a => (a->b->a) -> a -> [b] -> a
foldl' f a [] = a
foldl' f a (x:xs) = y `seq` foldl' f y xs
where y = f a x
foldl1' :: Trans a => (a->a->a) -> [a] -> a
foldl1' f [] = error "foldl1: empty list"
foldl1' f [x] = x
foldl1' f (x:(ys@(y:xs))) = foldl' f x ys
-- master worker...
-- import this from EdiWP.
-----------------------------------
-- fold only
--
parFoldSCSCP_,
parFoldSCSCP :: (Trans b, OMData b) =>
CAName -> -- (b -> b -> b)
b -> [b] -> -- neutral, input,
b -- result
parFoldSCSCP foldF neutral inputs = scscpFoldl subRs
where subRs = unsafePerformIO $ do
sequence [ instantiateAt i
(process scscpFoldl)
ins
| ins <- unshuffle noPe inputs
| i <- [1..noPe] ]
scscpFoldl = foldl' (call2 foldF) neutral
-- non-optimised, moves accumulator around
parFoldSCSCP_ foldF neutral inputs
= scscpFoldlStart neutral subRs -- final stage with acc. reference as well
where subRs = unsafePerformIO $ do
sequence [ instantiateAt i
(process (scscpFoldlStart neutral))
ins
| ins <- unshuffle noPe inputs
| i <- [1..noPe] ]
-- store intermediate results (acc.) inside the CA system
scscpFoldlStart :: (Trans a, OMData a) => a -> [a] -> a
scscpFoldlStart n [] = n
scscpFoldlStart n xs = let nRef = call1R (Right StoreObj) n
in nRef `seq` scscpFoldl nRef xs
scscpFoldl :: (OMData a, Trans a) => CARef -> [a] -> a
scscpFoldl x [] = call1 (Right RetrieveObj) x
scscpFoldl x (y:ys) = let x' = (call2R foldF x y)
in x' `seq` scscpFoldl x' ys
-- map and fold
parMapFoldSCSCP,
parMapFoldSCSCP_ :: (Trans a, Trans b, OMData a, OMData b) =>
CAName -> -- (a -> b)
CAName -> -- (b -> b -> b)
b -> [a] -> -- neutral, input,
b -- result
parMapFoldSCSCP mapF foldF neutral inputs = scscpFoldl neutral subRs
where subRs = unsafePerformIO $ do
sequence [ instantiateAt i (process mapFoldSCSCP) ins
| ins <- unshuffle noPe inputs
| i <- [1..noPe] ]
mapFoldSCSCP [] = neutral
mapFoldSCSCP xs = scscpFoldl neutral (map (call1 mapF) xs)
-- TODO: optimise this, by storing the map
-- results inside the CA system and using
-- a foldF :: [b] -> b which operates on
-- whole lists.
-- scscpFoldl x [] = x
-- scscpFoldl x (y:ys) = let x' = (call2 foldF x y)
-- in x' `seq` scscpFoldl x' ys
scscpFoldl = foldl' (call2 foldF)
-- map and fold
parMapFold1SCSCP :: (Trans a, Trans b, OMData a, OMData b) =>
CAName -> -- (a -> b)
CAName -> -- (b -> b -> b)
[a] -> -- input,
b -- result
parMapFold1SCSCP mapF foldF inputs = scscpFoldl1 subRs
where subRs = unsafePerformIO $ do
sequence [ instantiateAt i (process mapFold1SCSCP) ins
| ins <- unshuffle noPe inputs
| i <- [1..noPe] ]
mapFold1SCSCP [] = error "mapFold1SCSCP: Empty list"
mapFold1SCSCP xs = scscpFoldl1 (map (call1 mapF) xs)
-- TODO: optimise this, by storing the map
-- results inside the CA system and using
-- a foldF :: [b] -> b which operates on
-- whole lists.
-- scscpFoldl1 x [] = x
-- scscpFoldl1 x (y:ys) = let x' = (call2 foldF x y)
-- in x' `seq` scscpFoldl x' ys
scscpFoldl1 = foldl1' (call2 foldF)
-- map and fold
parMapFoldSCSCP_ mapF foldF neutral inputs
= scscpFoldl nRef subRs
where nRef = call1R (Right StoreObj) neutral
subRs = unsafePerformIO $ do
sequence [ instantiateAt i
(process (mapFoldSCSCP neutral)) ins
| ins <- unshuffle noPe inputs
| i <- [1..noPe] ]
-- mapFoldSCSCP [] = neutral
-- use foldF :: [b] -> b which operates on whole lists?
-- mapFoldSCSCP :: (OMData a, Trans a) => a -> [a] -> a
mapFoldSCSCP n xs = scscpFoldlRef n (map (call1R mapF) xs)
-- store intermediate results (acc.) inside the CA system
scscpFoldlRef :: (OMData a) => a -> [CARef] -> a
scscpFoldlRef n [] = n
scscpFoldlRef n xs = let nRef = call1R (Right StoreObj) neutral
in nRef `seq` scscpFoldlR nRef xs
-- arguments are stored as references (cookies):
scscpFoldlR :: (OMData a) => CARef -> [CARef] -> a
scscpFoldlR x [] = call1 (Right RetrieveObj) x
scscpFoldlR x (y:ys) = let x' = (call2R foldF x y)
in x' `seq` scscpFoldlR x' ys
-- arguments are real data:
scscpFoldl :: (OMData a, Trans a) => CARef -> [a] -> a
scscpFoldl x [] = call1 (Right RetrieveObj) x
scscpFoldl x (y:ys) = let x' = (call2R foldF x y)
in x' `seq` scscpFoldl x' ys
-- zipWith -- UNTESTED!!!
parZipWithSCSCP :: (Trans a, Trans b, Trans c, OMData a, OMData b, OMData c) =>
CAName -> -- (a -> b -> c)
[a] -> -- input list 1
[b] -> -- input list 2
[c] -- result list
parZipWithSCSCP f inputs1 inputs2 = shuffle subRs
where subRs = unsafePerformIO $ do
sequence [ instantiateAt i (process (uncurry scscpBlock)) (ins1, ins2)
| ins1 <- unshuffle noPe inputs1
| ins2 <- unshuffle noPe inputs2
| i <- [1..noPe] ]
scscpBlock xs ys = zipWith (call2 f) xs ys
# else /* not parallel */
mapSCSCP :: (OMData a, OMData b) => -- (Trans a, Trans b, OMData a, OMData b) =>
CAName -> -- (a -> b)
[a] -> -- input,
[b] -- result
mapSCSCP f = map (call1 f)
-- where singleton x = [x]
foldSCSCP :: (OMData b) => -- (Trans b, OMData b) =>
CAName -> -- (b -> b -> b)
b -> [b] -> -- neutral, input,
b -- result
foldSCSCP foldF neutral inputs = scscpFoldl inputs
where {- subRs = unsafePerformIO $ do
sequence [ instantiateAt i
(process scscpFoldl)
ins
| ins <- unshuffle noPe inputs
| i <- [1..noPe] ]-}
scscpFoldl = foldl' (call2 foldF) neutral
-- non-optimised, moves accumulator around
-- HWL HACK
foldl' :: (a->b->a) -> a -> [b] -> a
foldl' f a [] = a
foldl' f a (x:xs) = y `seq` foldl' f y xs
where y = f a x
#endif
-- Eden boilerplate code...
unshuffle :: Int -> [a] -> [[a]]
unshuffle n xs = [takeEach n (drop i xs) | i <- [0..n-1]]
where takeEach :: Int -> [a] -> [a]
takeEach n [] = []
takeEach n (x:xs) = x : takeEach n (drop (n-1) xs)
shuffle :: [[b]] -> [b]
-- shuffle = concat . transpose
-- this impl. sequentially evaluation one input list after
-- the other
-- for Eden we need a version, that produces the first outputs as fast
-- as possible, i. e. evaluates all input lists concurrently:
shuffle xxs
| and (map null xxs) = []
| otherwise = (mymaphead xxs) ++ ( shuffle (map mytail xxs))
where mymaphead [] = []
mymaphead ([]:xxs) = mymaphead xxs
mymaphead ((x:xs):xxs) = x : mymaphead xxs
mytail [] = []
mytail xs = tail xs
{-
takeEach :: Int -> [a] -> [[a]]
takeEach n [] = []
takeEach n xs = let (start,rest) = splitAt n xs
in start : takeEach n rest
-}
call2' :: (OMData a) =>
CAName -> a -> a -> a
call2' name x y = fromOM (callSCSCP name [toOM x, toOM y])
-- sad, sequential versions of the skeletons
mapSCSCP :: (OMData a, OMData b, Trans b) =>
CAName -> -- (a -> b)
[a] -> -- input,
[b] -- result
mapSCSCP mapF = map (call1 mapF)
mapFoldSCSCP :: (OMData a, OMData b, Trans a, Trans b) =>
CAName -> -- (a -> b)
CAName -> -- (b -> b -> b)
b -> [a] -> -- neutral, input,
b -- result
mapFoldSCSCP mapF foldF neutral inputs = foldl' (call2' foldF) neutral (map (call1 mapF) inputs)
mapFold1SCSCP :: (OMData a, OMData b, Trans b) =>
CAName -> -- (a -> b)
CAName -> -- (b -> b -> b)
[a] -> -- input,
b -- result
mapFold1SCSCP mapF foldF inputs = foldl1' (call2' foldF) (map (call1 mapF) inputs)
zipWithSCSCP :: (OMData a, OMData b, OMData c) =>
CAName -> -- (a -> b -> c)
[a] -> -- input list 1
[b] -> -- input list 2
[c] -- result list
zipWithSCSCP f = zipWith (call2 f)