{-# LANGUAGE BangPatterns, CPP, MagicHash, UnboxedTuples #-}
module Control.Parallel.Strategies (
Strategy
, using
, withStrategy
, dot
, r0
, rseq
, rdeepseq
, rpar
, rparWith
, evalSeq
, SeqStrategy
, evalTraversable
, parTraversable
, evalList
, parList
, evalListN
, parListN
, evalListNth
, parListNth
, evalListSplitAt
, parListSplitAt
, parListChunk
, parMap
, evalBuffer
, parBuffer
, evalTuple2
, evalTuple3
, evalTuple4
, evalTuple5
, evalTuple6
, evalTuple7
, evalTuple8
, evalTuple9
, parTuple2
, parTuple3
, parTuple4
, parTuple5
, parTuple6
, parTuple7
, parTuple8
, parTuple9
, ($|)
, ($||)
, (.|)
, (.||)
, (-|)
, (-||)
, Eval
, runEval
,
Done, demanding, sparking, (>|), (>||),
rwhnf, unEval,
seqTraverse, parTraverse,
seqList,
seqPair, parPair,
seqTriple, parTriple,
NFData
) where
import Data.Traversable
import Control.Applicative
import Control.Parallel
import Control.DeepSeq
import Control.Monad
import qualified Control.Seq
import GHC.Exts
infixr 9 `dot`
infixl 0 `using`
#if __GLASGOW_HASKELL__ >= 702
newtype Eval a = Eval (State# RealWorld -> (# State# RealWorld, a #))
runEval :: Eval a -> a
runEval (Eval x) = case x realWorld# of (# _, a #) -> a
instance Monad Eval where
return x = Eval $ \s -> (# s, x #)
Eval x >>= k = Eval $ \s -> case x s of
(# s', a #) -> case k a of
Eval f -> f s'
#else
data Eval a = Done a
runEval :: Eval a -> a
runEval (Done x) = x
instance Monad Eval where
return x = Done x
Done x >>= k = lazy (k x)
{-# RULES "lazy Done" forall x . lazy (Done x) = Done x #-}
#endif
instance Functor Eval where
fmap = liftM
instance Applicative Eval where
(<*>) = ap
pure = return
type Strategy a = a -> Eval a
using :: a -> Strategy a -> a
x `using` strat = runEval (strat x)
withStrategy :: Strategy a -> a -> a
withStrategy = flip using
dot :: Strategy a -> Strategy a -> Strategy a
strat2 `dot` strat1 = strat2 . runEval . strat1
evalSeq :: SeqStrategy a -> Strategy a
evalSeq strat x = strat x `pseq` return x
type SeqStrategy a = Control.Seq.Strategy a
r0 :: Strategy a
r0 x = return x
rseq :: Strategy a
#if __GLASGOW_HASKELL__ >= 702
rseq x = Eval $ \s -> seq# x s
#else
rseq x = x `seq` return x
#endif
rdeepseq :: NFData a => Strategy a
rdeepseq x = do rseq (rnf x); return x
rpar :: a -> Eval a
#if __GLASGOW_HASKELL__ >= 702
rpar x = Eval $ \s -> spark# x s
#else
rpar x = case (par# x) of { _ -> Done x }
#endif
{-# INLINE rpar #-}
rparWith :: Strategy a -> Strategy a
#if __GLASGOW_HASKELL__ >= 702
rparWith s a = do l <- rpar r; return (case l of Lift x -> x)
where r = case s a of
Eval f -> case f realWorld# of
(# _, a' #) -> Lift a'
data Lift a = Lift a
#else
rparWith s a = do l <- rpar (s a); return (case l of Done x -> x)
#endif
evalTraversable :: Traversable t => Strategy a -> Strategy (t a)
evalTraversable = traverse
{-# INLINE evalTraversable #-}
parTraversable :: Traversable t => Strategy a -> Strategy (t a)
parTraversable strat = evalTraversable (rparWith strat)
{-# INLINE parTraversable #-}
evalList :: Strategy a -> Strategy [a]
evalList = evalTraversable
parList :: Strategy a -> Strategy [a]
parList = parTraversable
evalListSplitAt :: Int -> Strategy [a] -> Strategy [a] -> Strategy [a]
evalListSplitAt n stratPref stratSuff xs
= let (ys,zs) = splitAt n xs in
stratPref ys >>= \ys' ->
stratSuff zs >>= \zs' ->
return (ys' ++ zs')
parListSplitAt :: Int -> Strategy [a] -> Strategy [a] -> Strategy [a]
parListSplitAt n stratPref stratSuff = evalListSplitAt n (rparWith stratPref) (rparWith stratSuff)
evalListN :: Int -> Strategy a -> Strategy [a]
evalListN n strat = evalListSplitAt n (evalList strat) r0
parListN :: Int -> Strategy a -> Strategy [a]
parListN n strat = evalListN n (rparWith strat)
evalListNth :: Int -> Strategy a -> Strategy [a]
evalListNth n strat = evalListSplitAt n r0 (evalListN 1 strat)
parListNth :: Int -> Strategy a -> Strategy [a]
parListNth n strat = evalListNth n (rparWith strat)
parListChunk :: Int -> Strategy a -> Strategy [a]
parListChunk n strat xs
| n <= 1 = parList strat xs
| otherwise = concat `fmap` parList (evalList strat) (chunk n xs)
chunk :: Int -> [a] -> [[a]]
chunk _ [] = []
chunk n xs = as : chunk n bs where (as,bs) = splitAt n xs
parListWHNF :: Strategy [a]
parListWHNF xs = go xs `pseq` return xs
where
go [] = []
go (y:ys) = y `par` go ys
{-# NOINLINE [1] parList #-}
{-# RULES
"parList/rseq" parList rseq = parListWHNF
#-}
parMap :: Strategy b -> (a -> b) -> [a] -> [b]
parMap strat f = (`using` parList strat) . map f
evalBufferWHNF :: Int -> Strategy [a]
evalBufferWHNF n0 xs0 = return (ret xs0 (start n0 xs0))
where
ret (x:xs) (y:ys) = y `pseq` (x : ret xs ys)
ret xs _ = xs
start 0 ys = ys
start !_n [] = []
start !n (y:ys) = y `pseq` start (n-1) ys
evalBuffer :: Int -> Strategy a -> Strategy [a]
evalBuffer n strat = evalBufferWHNF n . map (withStrategy strat)
parBufferWHNF :: Int -> Strategy [a]
parBufferWHNF n0 xs0 = return (ret xs0 (start n0 xs0))
where
ret (x:xs) (y:ys) = y `par` (x : ret xs ys)
ret xs _ = xs
start 0 ys = ys
start !_n [] = []
start !n (y:ys) = y `par` start (n-1) ys
parBuffer :: Int -> Strategy a -> Strategy [a]
parBuffer n strat = parBufferWHNF n . map (withStrategy strat)
{-# NOINLINE [1] evalBuffer #-}
{-# NOINLINE [1] parBuffer #-}
{-# RULES
"evalBuffer/rseq" forall n . evalBuffer n rseq = evalBufferWHNF n
"parBuffer/rseq" forall n . parBuffer n rseq = parBufferWHNF n
#-}
evalTuple2 :: Strategy a -> Strategy b -> Strategy (a,b)
evalTuple2 strat1 strat2 (x1,x2) =
pure (,) <*> strat1 x1 <*> strat2 x2
evalTuple3 :: Strategy a -> Strategy b -> Strategy c -> Strategy (a,b,c)
evalTuple3 strat1 strat2 strat3 (x1,x2,x3) =
pure (,,) <*> strat1 x1 <*> strat2 x2 <*> strat3 x3
evalTuple4 :: Strategy a -> Strategy b -> Strategy c -> Strategy d -> Strategy (a,b,c,d)
evalTuple4 strat1 strat2 strat3 strat4 (x1,x2,x3,x4) =
pure (,,,) <*> strat1 x1 <*> strat2 x2 <*> strat3 x3 <*> strat4 x4
evalTuple5 :: Strategy a -> Strategy b -> Strategy c -> Strategy d -> Strategy e -> Strategy (a,b,c,d,e)
evalTuple5 strat1 strat2 strat3 strat4 strat5 (x1,x2,x3,x4,x5) =
pure (,,,,) <*> strat1 x1 <*> strat2 x2 <*> strat3 x3 <*> strat4 x4 <*> strat5 x5
evalTuple6 :: Strategy a -> Strategy b -> Strategy c -> Strategy d -> Strategy e -> Strategy f -> Strategy (a,b,c,d,e,f)
evalTuple6 strat1 strat2 strat3 strat4 strat5 strat6 (x1,x2,x3,x4,x5,x6) =
pure (,,,,,) <*> strat1 x1 <*> strat2 x2 <*> strat3 x3 <*> strat4 x4 <*> strat5 x5 <*> strat6 x6
evalTuple7 :: Strategy a -> Strategy b -> Strategy c -> Strategy d -> Strategy e -> Strategy f -> Strategy g -> Strategy (a,b,c,d,e,f,g)
evalTuple7 strat1 strat2 strat3 strat4 strat5 strat6 strat7 (x1,x2,x3,x4,x5,x6,x7) =
pure (,,,,,,) <*> strat1 x1 <*> strat2 x2 <*> strat3 x3 <*> strat4 x4 <*> strat5 x5 <*> strat6 x6 <*> strat7 x7
evalTuple8 :: Strategy a -> Strategy b -> Strategy c -> Strategy d -> Strategy e -> Strategy f -> Strategy g -> Strategy h -> Strategy (a,b,c,d,e,f,g,h)
evalTuple8 strat1 strat2 strat3 strat4 strat5 strat6 strat7 strat8 (x1,x2,x3,x4,x5,x6,x7,x8) =
pure (,,,,,,,) <*> strat1 x1 <*> strat2 x2 <*> strat3 x3 <*> strat4 x4 <*> strat5 x5 <*> strat6 x6 <*> strat7 x7 <*> strat8 x8
evalTuple9 :: Strategy a -> Strategy b -> Strategy c -> Strategy d -> Strategy e -> Strategy f -> Strategy g -> Strategy h -> Strategy i -> Strategy (a,b,c,d,e,f,g,h,i)
evalTuple9 strat1 strat2 strat3 strat4 strat5 strat6 strat7 strat8 strat9 (x1,x2,x3,x4,x5,x6,x7,x8,x9) =
pure (,,,,,,,,) <*> strat1 x1 <*> strat2 x2 <*> strat3 x3 <*> strat4 x4 <*> strat5 x5 <*> strat6 x6 <*> strat7 x7 <*> strat8 x8 <*> strat9 x9
parTuple2 :: Strategy a -> Strategy b -> Strategy (a,b)
parTuple2 strat1 strat2 =
evalTuple2 (rparWith strat1) (rparWith strat2)
parTuple3 :: Strategy a -> Strategy b -> Strategy c -> Strategy (a,b,c)
parTuple3 strat1 strat2 strat3 =
evalTuple3 (rparWith strat1) (rparWith strat2) (rparWith strat3)
parTuple4 :: Strategy a -> Strategy b -> Strategy c -> Strategy d -> Strategy (a,b,c,d)
parTuple4 strat1 strat2 strat3 strat4 =
evalTuple4 (rparWith strat1) (rparWith strat2) (rparWith strat3) (rparWith strat4)
parTuple5 :: Strategy a -> Strategy b -> Strategy c -> Strategy d -> Strategy e -> Strategy (a,b,c,d,e)
parTuple5 strat1 strat2 strat3 strat4 strat5 =
evalTuple5 (rparWith strat1) (rparWith strat2) (rparWith strat3) (rparWith strat4) (rparWith strat5)
parTuple6 :: Strategy a -> Strategy b -> Strategy c -> Strategy d -> Strategy e -> Strategy f -> Strategy (a,b,c,d,e,f)
parTuple6 strat1 strat2 strat3 strat4 strat5 strat6 =
evalTuple6 (rparWith strat1) (rparWith strat2) (rparWith strat3) (rparWith strat4) (rparWith strat5) (rparWith strat6)
parTuple7 :: Strategy a -> Strategy b -> Strategy c -> Strategy d -> Strategy e -> Strategy f -> Strategy g -> Strategy (a,b,c,d,e,f,g)
parTuple7 strat1 strat2 strat3 strat4 strat5 strat6 strat7 =
evalTuple7 (rparWith strat1) (rparWith strat2) (rparWith strat3) (rparWith strat4) (rparWith strat5) (rparWith strat6) (rparWith strat7)
parTuple8 :: Strategy a -> Strategy b -> Strategy c -> Strategy d -> Strategy e -> Strategy f -> Strategy g -> Strategy h -> Strategy (a,b,c,d,e,f,g,h)
parTuple8 strat1 strat2 strat3 strat4 strat5 strat6 strat7 strat8 =
evalTuple8 (rparWith strat1) (rparWith strat2) (rparWith strat3) (rparWith strat4) (rparWith strat5) (rparWith strat6) (rparWith strat7) (rparWith strat8)
parTuple9 :: Strategy a -> Strategy b -> Strategy c -> Strategy d -> Strategy e -> Strategy f -> Strategy g -> Strategy h -> Strategy i -> Strategy (a,b,c,d,e,f,g,h,i)
parTuple9 strat1 strat2 strat3 strat4 strat5 strat6 strat7 strat8 strat9 =
evalTuple9 (rparWith strat1) (rparWith strat2) (rparWith strat3) (rparWith strat4) (rparWith strat5) (rparWith strat6) (rparWith strat7) (rparWith strat8) (rparWith strat9)
($|) :: (a -> b) -> Strategy a -> a -> b
f $| s = \ x -> let z = x `using` s in z `pseq` f z
($||) :: (a -> b) -> Strategy a -> a -> b
f $|| s = \ x -> let z = x `using` s in z `par` f z
(.|) :: (b -> c) -> Strategy b -> (a -> b) -> (a -> c)
(.|) f s g = \ x -> let z = g x `using` s in
z `pseq` f z
(.||) :: (b -> c) -> Strategy b -> (a -> b) -> (a -> c)
(.||) f s g = \ x -> let z = g x `using` s in
z `par` f z
(-|) :: (a -> b) -> Strategy b -> (b -> c) -> (a -> c)
(-|) f s g = \ x -> let z = f x `using` s in
z `pseq` g z
(-||) :: (a -> b) -> Strategy b -> (b -> c) -> (a -> c)
(-||) f s g = \ x -> let z = f x `using` s in
z `par` g z
{-# DEPRECATED Done "The Strategy type is now a -> Eval a, not a -> Done" #-}
type Done = ()
{-# DEPRECATED demanding "Use pseq or $| instead" #-}
demanding :: a -> Done -> a
demanding = flip pseq
{-# DEPRECATED sparking "Use par or $|| instead" #-}
sparking :: a -> Done -> a
sparking = flip par
{-# DEPRECATED (>|) "Use pseq or $| instead" #-}
(>|) :: Done -> Done -> Done
(>|) = Prelude.seq
{-# DEPRECATED (>||) "Use par or $|| instead" #-}
(>||) :: Done -> Done -> Done
(>||) = par
{-# DEPRECATED rwhnf "renamed to rseq" #-}
rwhnf :: Strategy a
rwhnf = rseq
{-# DEPRECATED seqTraverse "renamed to evalTraversable" #-}
seqTraverse :: Traversable t => Strategy a -> Strategy (t a)
seqTraverse = evalTraversable
{-# DEPRECATED parTraverse "renamed to parTraversable" #-}
parTraverse :: Traversable t => Strategy a -> Strategy (t a)
parTraverse = parTraversable
{-# DEPRECATED parListWHNF "use (parList rseq) instead" #-}
{-# DEPRECATED seqList "renamed to evalList" #-}
seqList :: Strategy a -> Strategy [a]
seqList = evalList
{-# DEPRECATED seqPair "renamed to evalTuple2" #-}
seqPair :: Strategy a -> Strategy b -> Strategy (a,b)
seqPair = evalTuple2
{-# DEPRECATED parPair "renamed to parTuple2" #-}
parPair :: Strategy a -> Strategy b -> Strategy (a,b)
parPair = parTuple2
{-# DEPRECATED seqTriple "renamed to evalTuple3" #-}
seqTriple :: Strategy a -> Strategy b -> Strategy c -> Strategy (a,b,c)
seqTriple = evalTuple3
{-# DEPRECATED parTriple "renamed to parTuple3" #-}
parTriple :: Strategy a -> Strategy b -> Strategy c -> Strategy (a,b,c)
parTriple = parTuple3
{-# DEPRECATED unEval "renamed to runEval" #-}
unEval :: Eval a -> a
unEval = runEval