summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorSimonMarlow <>2018-07-13 16:34:00 (GMT)
committerhdiff <hdiff@hdiff.luite.com>2018-07-13 16:34:00 (GMT)
commit4985aaf7b7037d0cad55c3d27d5fc5653f43071d (patch)
tree217649587ef04dac69824da87042f93998b6c12b
parent42742b760d5dec5f3eb101977e679788bd581624 (diff)
version 3.2.2.0HEAD3.2.2.0master
-rw-r--r--Control/Parallel/Strategies.hs191
-rw-r--r--changelog.md6
-rw-r--r--parallel.cabal20
3 files changed, 158 insertions, 59 deletions
diff --git a/Control/Parallel/Strategies.hs b/Control/Parallel/Strategies.hs
index fbc08f7..5ca739d 100644
--- 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 @@ module Control.Parallel.Strategies (
-- * 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 @@ module Control.Parallel.Strategies (
-- * 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 @@ import Control.Applicative
#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 @@ infixl 0 `using` -- lowest precedence and associate to the left
#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
-
-instance Functor Eval where
- fmap = liftM
+# if MIN_VERSION_base(4,4,0)
+runEval = unsafeDupablePerformIO . unEval_
+# else
+runEval = unsafePerformIO . unEval_
+# endif
+
+-- | Run the evaluation in the 'IO' monad. This allows sequencing of
+-- evaluations relative to 'IO' actions.
+runEvalIO :: Eval a -> IO a
+runEvalIO = unEval_
+
+-- 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 #)
+
+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
-instance Applicative Eval where
- pure x = Eval $ \s -> (# s, x #)
- (<*>) = ap
-
-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'
#else
data Eval a = Done a
@@ -221,6 +264,11 @@ data Eval a = Done a
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 @@ instance Monad Eval where
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,6 +307,8 @@ instance Monad Eval where
-- ==> undefined <== undefined >>= (\x -> f x >>= g)
-- <*= m >>= (\x -> f x >>= g)
+#endif
+
-- -----------------------------------------------------------------------------
-- Strategies
@@ -293,9 +343,29 @@ x `using` strat = runEval (strat x)
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,10 +426,13 @@ r0 x = return x
--
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
--
@@ -388,33 +461,63 @@ rdeepseq x = do rseq (rnf x); return x
-- | '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.
+--
+-- @
+-- rparWith strat x
+-- @
+--
+-- 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
+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 `rparWith r0`
--- behaves as you might expect (it is a strategy that creates a
--- spark that does no evaluation).
+-- * 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:
--
-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'
+-- > 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 :: Int -> [a] -> [[a]]
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
@@ -752,8 +835,6 @@ seqTraverse = evalTraversable
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'
seqList :: Strategy a -> Strategy [a]
diff --git a/changelog.md b/changelog.md
index a45e517..cde1a65 100644
--- 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
index 577a11e..b627ba3 100644
--- 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,9 +9,18 @@ synopsis: Parallel programming library
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 <http://simonmar.github.io/pages/pcph.html Parallel and Concurrent Programming in Haskell>.
+ .
+ To understand the principles behind the library, see
+ <http://simonmar.github.io/bib/papers/strategies.pdf Seq no more: Better Strategies for Parallel Haskell>.
+
extra-source-files: changelog.md
@@ -34,8 +43,8 @@ library
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 @@ library
if impl(ghc >= 6.11)
-- To improve parallel performance:
ghc-options: -feager-blackholing
+
+ if impl(ghc >= 7.2.1)
+ build-depends: ghc-prim