diff --git a/Control/Parallel/Strategies.hs b/Control/Parallel/Strategies.hs --- a/Control/Parallel/Strategies.hs +++ b/Control/Parallel/Strategies.hs @@ -1,4 +1,5 @@ {-# LANGUAGE BangPatterns, CPP, MagicHash, UnboxedTuples #-} +{-# LANGUAGE GeneralizedNewtypeDeriving #-} ----------------------------------------------------------------------------- -- | -- Module : Control.Parallel.Strategies @@ -41,6 +42,8 @@ -- * Application of strategies , using -- :: a -> Strategy a -> a , withStrategy -- :: Strategy a -> a -> a + , usingIO -- :: a -> Strategy a -> IO a + , withStrategyIO -- :: Strategy a -> a -> IO a -- * Composition of strategies , dot -- :: Strategy a -> Strategy a -> Strategy a @@ -113,7 +116,9 @@ -- * For Strategy programmers , Eval -- instances: Monad, Functor, Applicative + , parEval -- :: Eval a -> Eval a , runEval -- :: Eval a -> a + , runEvalIO -- :: Eval a -> IO a , -- * API History @@ -145,14 +150,24 @@ #endif import Control.Parallel import Control.DeepSeq (NFData(rnf)) +import Control.Monad.Fix (MonadFix (..)) + +#if MIN_VERSION_base(4,4,0) +import System.IO.Unsafe (unsafeDupablePerformIO) +import Control.Exception (evaluate) +#else +import System.IO.Unsafe (unsafePerformIO) import Control.Monad +#endif import qualified Control.Seq import GHC.Exts +import GHC.IO (IO (..)) infixr 9 `dot` -- same as (.) infixl 0 `using` -- lowest precedence and associate to the left +infixl 0 `usingIO` -- lowest precedence and associate to the left -- ----------------------------------------------------------------------------- -- Eval monad (isomorphic to Lift monad from MonadLib 3.6.1) @@ -192,27 +207,55 @@ #if __GLASGOW_HASKELL__ >= 702 -newtype Eval a = Eval (State# RealWorld -> (# State# RealWorld, a #)) +newtype Eval a = Eval {unEval_ :: IO a} + deriving (Functor, Applicative, Monad) -- GHC 7.2.1 added the seq# and spark# primitives, that we use in -- the Eval monad implementation in order to get the correct -- strictness behaviour. -- | Pull the result out of the monad. runEval :: Eval a -> a -runEval (Eval x) = case x realWorld# of (# _, a #) -> a +# if MIN_VERSION_base(4,4,0) +runEval = unsafeDupablePerformIO . unEval_ +# else +runEval = unsafePerformIO . unEval_ +# endif -instance Functor Eval where - fmap = liftM +-- | Run the evaluation in the 'IO' monad. This allows sequencing of +-- evaluations relative to 'IO' actions. +runEvalIO :: Eval a -> IO a +runEvalIO = unEval_ -instance Applicative Eval where - pure x = Eval $ \s -> (# s, x #) - (<*>) = ap +-- We don't use GND to derive MonadFix from the IO instance. The IO instance +-- has to be very careful to ensure that lazy blackholing doesn't cause IO +-- actions to be duplicated in case of an infinite loop. This has a small +-- performance cost. Eval computations are always assumed to be pure, so +-- duplicating them is okay. What about ST computations embedded in Eval ones? +-- Those also shouldn't be a problem: the ST computations are "closed", so it's +-- safe to duplicate them, and the RTS already takes care to avoid resuming +-- a computation paused by an asynchronous exception in multiple threads. +-- Lazy ST takes care of itself with noDuplicate#, so we don't really need +-- to think about it too much. +-- +-- Note: +-- mfix f = let res = runEval (Lift <$> f (unLift res)) +-- in case res of Lift r -> return r +-- data Lift a = Lift a +instance MonadFix Eval where + -- Borrowed from the instance for ST + mfix k = Eval $ IO $ \ s -> + let ans = liftEv (k r) s + Evret _ r = ans + in + case ans of Evret s' x -> (# s', x #) -instance Monad Eval where - return = pure - Eval x >>= k = Eval $ \s -> case x s of - (# s', a #) -> case k a of - Eval f -> f s' +data Evret a = Evret (State# RealWorld) a + +-- liftEv is useful when we want a lifted result from an Eval computation. It +-- is used to implement mfix. +liftEv :: Eval a -> State# RealWorld -> Evret a +liftEv (Eval (IO m)) = \s -> case m s of (# s', r #) -> Evret s' r + #else data Eval a = Done a @@ -221,6 +264,11 @@ runEval :: Eval a -> a runEval (Done x) = x +-- | Run the evaluation in the 'IO' monad. This allows sequencing of +-- evaluations relative to 'IO' actions. +runEvalIO :: Eval a -> IO a +runEvalIO (Done x) = return x + instance Functor Eval where fmap = liftM @@ -232,10 +280,10 @@ return = pure Done x >>= k = lazy (k x) -- Note: pattern 'Done x' makes '>>=' strict -{-# RULES "lazy Done" forall x . lazy (Done x) = Done x #-} - -#endif +instance MonadFix Eval where + mfix f = let r = f (runEval r) in r +{-# RULES "lazy Done" forall x . lazy (Done x) = Done x #-} -- The Eval monad satisfies the monad laws. -- @@ -259,7 +307,9 @@ -- ==> undefined <== undefined >>= (\x -> f x >>= g) -- <*= m >>= (\x -> f x >>= g) +#endif + -- ----------------------------------------------------------------------------- -- Strategies @@ -293,9 +343,29 @@ withStrategy :: Strategy a -> a -> a withStrategy = flip using +-- | Evaluate a value using the given 'Strategy' inside the 'IO' monad. See +-- also 'runEvalIO'. +-- +-- > x `usingIO` s = runEvalIO (s x) +-- +usingIO :: a -> Strategy a -> IO a +x `usingIO` strat = runEvalIO (strat x) + +-- | Evaluate a value using the given 'Strategy' inside the 'IO' monad. This +-- is simply 'usingIO' with the arguments reversed. +-- +withStrategyIO :: Strategy a -> a -> IO a +withStrategyIO = flip usingIO + -- | Compose two strategies sequentially. -- This is the analogue to function composition on strategies. -- +-- For any strategies @strat1@, @strat2@, and @strat3@, +-- +-- > (strat1 `dot` strat2) `dot` strat3 == strat1 `dot` (strat2 `dot` strat3) +-- > strat1 `dot` strat1 = strat1 +-- > strat1 `dot` r0 == strat1 +-- -- > strat2 `dot` strat1 == strat2 . withStrategy strat1 -- dot :: Strategy a -> Strategy a -> Strategy a @@ -356,11 +426,14 @@ -- rseq :: Strategy a #if __GLASGOW_HASKELL__ >= 702 -rseq x = Eval $ \s -> seq# x s +rseq x = Eval (evaluate x) #else rseq x = x `seq` return x #endif +-- Staged NOINLINE so we can match on rseq in RULES +{-# NOINLINE [1] rseq #-} + -- Proof of rseq == evalSeq Control.Seq.rseq -- -- evalSeq Control.Seq.rseq @@ -388,33 +461,63 @@ -- | 'rpar' sparks its argument (for evaluation in parallel). rpar :: Strategy a #if __GLASGOW_HASKELL__ >= 702 -rpar x = Eval $ \s -> spark# x s +rpar x = Eval $ IO $ \s -> spark# x s #else rpar x = case (par# x) of { _ -> Done x } #endif {-# INLINE rpar #-} --- | instead of saying @rpar `dot` strat@, you can say --- @rparWith strat@. Compared to 'rpar', 'rparWith' +-- | Perform a computation in parallel using a strategy. -- --- * does not exit the `Eval` monad +-- @ +-- rparWith strat x +-- @ -- --- * does not have a built-in `rseq`, so for example `rparWith r0` --- behaves as you might expect (it is a strategy that creates a --- spark that does no evaluation). +-- will spark @strat x@. Note that @rparWith strat@ is /not/ the +-- same as @rpar `dot` strat@. Specifically, @rpar `dot` strat@ +-- always sparks a computation to reduce the result of the +-- strategic computation to WHNF, while @rparWith strat@ need +-- not. -- +-- > rparWith r0 = r0 +-- > rparWith rpar = rpar +-- > rparWith rseq = rpar -- +-- @rparWith rpar x@ creates a spark that immediately creates another +-- spark to evaluate @x@. We consider this equivalent to @rpar@ because +-- there isn't any real additional parallelism. However, it is always +-- less efficient because there's a bit of extra work to create the +-- first (useless) spark. Similarly, @rparWith r0@ creates a spark +-- that does precisely nothing. No real parallelism is added, but there +-- is a bit of extra work to do nothing. 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' +rparWith strat = parEval . strat +-- | 'parEval' sparks the computation of its argument for evaluation in +-- parallel. Unlike @'rpar' . 'runEval'@, 'parEval' +-- +-- * does not exit the `Eval` monad +-- +-- * does not have a built-in `rseq`, so for example @'parEval' ('r0' x)@ +-- behaves as you might expect (it creates a spark that does no +-- evaluation). +-- +-- It is related to 'rparWith' by the following equality: +-- +-- > parEval . strat = rparWith strat +-- +parEval :: Eval a -> Eval a +-- The intermediate `Lift` box is necessary, in order to avoid a built-in +-- `rseq` in `parEval`. In particular, we want @parEval . r0 = r0@, not +-- @parEval . r0 = rpar@. +parEval m = do + l <- rpar r + return (case l of Lift x -> x) + + where + r = runEval (Lift <$> m) + data Lift a = Lift a -#else -rparWith s a = do l <- rpar (s a); return (case l of Done x -> x) -#endif -- -------------------------------------------------------------------------- -- Strategy combinators for Traversable data types @@ -502,26 +605,6 @@ chunk _ [] = [] chunk n xs = as : chunk n bs where (as,bs) = splitAt n xs --- Non-compositional version of 'parList', evaluating list elements --- to weak head normal form. --- Not to be exported; used for optimisation. - --- | DEPRECATED: use @'parList' 'rseq'@ instead -parListWHNF :: Strategy [a] -parListWHNF xs = go xs `pseq` return xs - where -- go :: [a] -> [a] - go [] = [] - go (y:ys) = y `par` go ys - --- The non-compositional 'parListWHNF' might be more efficient than its --- more compositional counterpart; use RULES to do the specialisation. - -{-# NOINLINE [1] parList #-} -{-# NOINLINE [1] rseq #-} -{-# RULES - "parList/rseq" parList rseq = parListWHNF - #-} - -- -------------------------------------------------------------------------- -- Convenience @@ -751,8 +834,6 @@ -- | DEPRECATED: renamed to 'parTraversable' parTraverse :: Traversable t => Strategy a -> Strategy (t a) parTraverse = parTraversable - -{-# DEPRECATED parListWHNF "use (parList rseq) instead" #-} {-# DEPRECATED seqList "renamed to evalList" #-} -- | DEPRECATED: renamed to 'evalList' diff --git a/changelog.md b/changelog.md --- a/changelog.md +++ b/changelog.md @@ -1,5 +1,11 @@ # Changelog for [`parallel` package](http://hackage.haskell.org/package/parallel) +## 3.2.2.0 *Jul 2018* + + - bump dependency bounds + - add parEval + - add a MonadFix instance + ## 3.2.1.1 *Apr 2017* - Compatibility with `deepseq-1.4.3` diff --git a/parallel.cabal b/parallel.cabal --- a/parallel.cabal +++ b/parallel.cabal @@ -1,5 +1,5 @@ name: parallel -version: 3.2.1.1 +version: 3.2.2.0 -- NOTE: Don't forget to update ./changelog.md license: BSD3 license-file: LICENSE @@ -9,10 +9,19 @@ category: Control, Parallelism build-type: Simple cabal-version: >=1.10 -tested-with: GHC==8.0.1, GHC==7.10.3, GHC==7.8.4, GHC==7.6.3, GHC==7.4.2, GHC==7.2.2, GHC==7.0.4 +tested-with: GHC==8.6.1, GHC==8.4.3, GHC==8.2.2, GHC==8.0.2, GHC==7.10.3, GHC==7.8.4, GHC==7.6.3, GHC==7.4.2, GHC==7.2.2, GHC==7.0.4 description: This package provides a library for parallel programming. + . + For documentation start from the "Control.Parallel.Strategies" + module below. + . + For more tutorial documentation, see the book . + . + To understand the principles behind the library, see + . + extra-source-files: changelog.md source-repository head @@ -34,8 +43,8 @@ build-depends: array >= 0.3 && < 0.6, - base >= 4.3 && < 4.11, - containers >= 0.4 && < 0.6, + base >= 4.3 && < 4.13, + containers >= 0.4 && < 0.7, deepseq >= 1.1 && < 1.5 ghc-options: -Wall @@ -43,3 +52,6 @@ if impl(ghc >= 6.11) -- To improve parallel performance: ghc-options: -feager-blackholing + + if impl(ghc >= 7.2.1) + build-depends: ghc-prim