parallel-3.2.1.0/0000755000000000000000000000000012641703044011636 5ustar0000000000000000parallel-3.2.1.0/parallel.cabal0000644000000000000000000000227312641703044014422 0ustar0000000000000000name: parallel version: 3.2.1.0 -- NOTE: Don't forget to update ./changelog.md license: BSD3 license-file: LICENSE maintainer: libraries@haskell.org bug-reports: https://github.com/haskell/parallel/issues 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 description: This package provides a library for parallel programming. extra-source-files: changelog.md source-repository head type: git location: https://github.com/haskell/parallel.git library default-language: Haskell2010 other-extensions: BangPatterns CPP MagicHash UnboxedTuples exposed-modules: Control.Seq Control.Parallel Control.Parallel.Strategies build-depends: array >= 0.3 && < 0.6, base >= 4.3 && < 4.10, containers >= 0.4 && < 0.6, deepseq >= 1.1 && < 1.5 ghc-options: -Wall if impl(ghc >= 6.11) -- To improve parallel performance: ghc-options: -feager-blackholing parallel-3.2.1.0/changelog.md0000644000000000000000000000150012641703044014103 0ustar0000000000000000# Changelog for [`parallel` package](http://hackage.haskell.org/package/parallel) ## 3.2.1.0 *Jan 2016* - Support `base-4.9.0.0` - Add `{-# NOINLINE[1] rseq #-}` to make the `RULE` more robust - Fix broken links to papers in Haddock - Make `rpar` type signature consistent with `rseq` via type-synonym - Drop redundant `Ix`-constraint on `seqArray`/`seqArrayBounds` for GHC >= 8.0 ## 3.2.0.6 *Dec 2014* - Make `-Wall` message free for all supported `base` versions ## 3.2.0.5 *Dec 2014* - Support `base-4.8.0.0`/`deepseq-1.4.0.0` (and thus GHC 7.10) ## 3.2.0.4 *Nov 2013* * Update package description to Cabal 1.10 format * Add support for GHC 7.8 * Drop support for GHCs older than GHC 7.0.1 * Add NOINLINE pragmas to `parBuffer`, `parList`, and `evalBuffer` to make RULEs more likely to fire parallel-3.2.1.0/Setup.hs0000644000000000000000000000012712641703044013272 0ustar0000000000000000module Main (main) where import Distribution.Simple main :: IO () main = defaultMain parallel-3.2.1.0/LICENSE0000644000000000000000000000363712641703044012654 0ustar0000000000000000This library (libraries/parallel) is derived from code from the GHC project which is largely (c) The University of Glasgow, and distributable under a BSD-style license (see below). ----------------------------------------------------------------------------- The Glasgow Haskell Compiler License Copyright 2004, The University Court of the University of Glasgow. All rights reserved. Redistribution and use in source and binary forms, with or without modification, are permitted provided that the following conditions are met: - Redistributions of source code must retain the above copyright notice, this list of conditions and the following disclaimer. - Redistributions in binary form must reproduce the above copyright notice, this list of conditions and the following disclaimer in the documentation and/or other materials provided with the distribution. - Neither name of the University nor the names of its contributors may be used to endorse or promote products derived from this software without specific prior written permission. THIS SOFTWARE IS PROVIDED BY THE UNIVERSITY COURT OF THE UNIVERSITY OF GLASGOW AND THE CONTRIBUTORS "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE UNIVERSITY COURT OF THE UNIVERSITY OF GLASGOW OR THE CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. ----------------------------------------------------------------------------- parallel-3.2.1.0/Control/0000755000000000000000000000000012641703044013256 5ustar0000000000000000parallel-3.2.1.0/Control/Parallel.hs0000644000000000000000000000456612641703044015361 0ustar0000000000000000{-# LANGUAGE CPP #-} ----------------------------------------------------------------------------- -- | -- Module : Control.Parallel -- Copyright : (c) The University of Glasgow 2001 -- License : BSD-style (see the file libraries/base/LICENSE) -- -- Maintainer : libraries@haskell.org -- Stability : stable -- Portability : portable -- -- Parallel Constructs -- ----------------------------------------------------------------------------- module Control.Parallel ( par, pseq ) where #ifdef __GLASGOW_HASKELL__ import qualified GHC.Conc ( par, pseq ) infixr 0 `par`, `pseq` #endif -- Maybe parIO and the like could be added here later. -- | Indicates that it may be beneficial to evaluate the first -- argument in parallel with the second. Returns the value of the -- second argument. -- -- @a ``par`` b@ is exactly equivalent semantically to @b@. -- -- @par@ is generally used when the value of @a@ is likely to be -- required later, but not immediately. Also it is a good idea to -- ensure that @a@ is not a trivial computation, otherwise the cost of -- spawning it in parallel overshadows the benefits obtained by -- running it in parallel. -- -- Note that actual parallelism is only supported by certain -- implementations (GHC with the @-threaded@ option, and GPH, for -- now). On other implementations, @par a b = b@. -- par :: a -> b -> b #ifdef __GLASGOW_HASKELL__ par = GHC.Conc.par #else -- For now, Hugs does not support par properly. par a b = b #endif -- | Semantically identical to 'seq', but with a subtle operational -- difference: 'seq' is strict in both its arguments, so the compiler -- may, for example, rearrange @a ``seq`` b@ into @b ``seq`` a ``seq`` b@. -- This is normally no problem when using 'seq' to express strictness, -- but it can be a problem when annotating code for parallelism, -- because we need more control over the order of evaluation; we may -- want to evaluate @a@ before @b@, because we know that @b@ has -- already been sparked in parallel with 'par'. -- -- This is why we have 'pseq'. In contrast to 'seq', 'pseq' is only -- strict in its first argument (as far as the compiler is concerned), -- which restricts the transformations that the compiler can do, and -- ensures that the user can retain control of the evaluation order. -- pseq :: a -> b -> b #ifdef __GLASGOW_HASKELL__ pseq = GHC.Conc.pseq #else pseq = seq #endif parallel-3.2.1.0/Control/Seq.hs0000644000000000000000000001777212641703044014360 0ustar0000000000000000{-# LANGUAGE BangPatterns #-} {-# LANGUAGE CPP #-} ----------------------------------------------------------------------------- -- | -- Module : Control.Parallel.SeqStrategies -- Copyright : (c) The University of Glasgow 2001-2009 -- License : BSD-style (see the file libraries/base/LICENSE) -- -- Maintainer : libraries@haskell.org -- Stability : experimental -- Portability : portable -- -- Sequential strategies provide ways to compositionally specify -- the degree of evaluation of a data type between the extremes of -- no evaluation and full evaluation. -- Sequential strategies may be viewed as complimentary to the parallel -- ones (see module "Control.Parallel.Strategies"). -- module Control.Seq ( -- * The sequential strategy type Strategy -- * Application of sequential strategies , using -- :: a -> Strategy a -> a , withStrategy -- :: Strategy a -> a -> a -- * Basic sequential strategies , r0 -- :: Strategy a , rseq , rdeepseq -- :: NFData a => Strategy a -- * Sequential strategies for lists , seqList -- :: Strategy a -> Strategy [a] , seqListN -- :: Int -> Strategy a -> Strategy [a] , seqListNth -- * Sequential strategies for foldable data types , seqFoldable -- :: Foldable t => Strategy a -> Strategy (t a) , seqMap -- :: Strategy k -> Strategy v -> Strategy (Map k v) , seqArray -- :: Ix i => Strategy a -> Strategy (Array i a) , seqArrayBounds -- :: Ix i => Strategy i -> Strategy (Array i a) -- * Sequential strategies for tuples -- | Evaluate the components of a tuple according to the given strategies. -- No guarantee is given as to the order of evaluation. , seqTuple2 -- :: Strategy a -> ... -> Strategy (a,...) , seqTuple3 , seqTuple4 , seqTuple5 , seqTuple6 , seqTuple7 , seqTuple8 , seqTuple9 ) where import Control.DeepSeq (NFData, deepseq) #if MIN_VERSION_base(4,8,0) import Data.Foldable (toList) #else import Data.Foldable (Foldable, toList) #endif import Data.Map (Map) import qualified Data.Map (toList) #if !((__GLASGOW_HASKELL__ >= 711) && MIN_VERSION_array(0,5,1)) import Data.Ix (Ix) #endif import Data.Array (Array) import qualified Data.Array (bounds, elems) infixl 0 `using` -- lowest precedence and associate to the left -- -------------------------------------------------------------------------- -- Sequential strategies -- | The type @'Strategy' a@ is @a -> ()@. -- Thus, a strategy is a function whose sole purpose it is to evaluate -- its argument (either in full or in part). type Strategy a = a -> () -- | Evaluate a value using the given strategy. using :: a -> Strategy a -> a x `using` strat = strat x `seq` x -- | Evaluate a value using the given strategy. -- This is simply 'using' with arguments reversed. withStrategy :: Strategy a -> a -> a withStrategy = flip using -- -------------------------------------------------------------------------- -- Basic sequential strategies -- | 'r0' performs *no* evaluation. r0 :: Strategy a r0 _ = () -- | 'rseq' evaluates its argument to weak head normal form. rseq :: Strategy a rseq x = x `seq` () -- | 'rdeepseq' fully evaluates its argument. -- Relies on class 'NFData' from module "Control.DeepSeq". rdeepseq :: NFData a => Strategy a rdeepseq x = x `deepseq` () -- -------------------------------------------------------------------------- -- Sequential strategies for lists -- | Evaluate each element of a list according to the given strategy. -- This function is a specialisation of 'seqFoldable' to lists. seqList :: Strategy a -> Strategy [a] seqList _strat [] = () seqList strat (x:xs) = strat x `seq` seqList strat xs -- Alternative definition via seqFoldable: -- seqList = seqFoldable -- | Evaluate the first n elements of a list according to the given strategy. seqListN :: Int -> Strategy a -> Strategy [a] seqListN 0 _strat _ = () seqListN !_ _strat [] = () seqListN !n strat (x:xs) = strat x `seq` seqListN (n-1) strat xs -- | Evaluate the nth element of a list (if there is such) according to -- the given strategy. -- The spine of the list up to the nth element is evaluated as a side effect. seqListNth :: Int -> Strategy a -> Strategy [a] seqListNth 0 strat (x:_) = strat x seqListNth !_ _strat [] = () seqListNth !n strat (_:xs) = seqListNth (n-1) strat xs -- -------------------------------------------------------------------------- -- Sequential strategies for foldable data types -- | Evaluate the elements of a foldable data structure according to -- the given strategy. seqFoldable :: Foldable t => Strategy a -> Strategy (t a) seqFoldable strat = seqList strat . toList -- Alternative definition via foldl': -- seqFoldable strat = foldl' (const strat) () {-# SPECIALISE seqFoldable :: Strategy a -> Strategy [a] #-} -- | Evaluate the elements of an array according to the given strategy. -- Evaluation of the array bounds may be triggered as a side effect. #if (__GLASGOW_HASKELL__ >= 711) && MIN_VERSION_array(0,5,1) seqArray :: Strategy a -> Strategy (Array i a) #else seqArray :: Ix i => Strategy a -> Strategy (Array i a) #endif seqArray strat = seqList strat . Data.Array.elems -- | Evaluate the bounds of an array according to the given strategy. #if (__GLASGOW_HASKELL__ >= 711) && MIN_VERSION_array(0,5,1) seqArrayBounds :: Strategy i -> Strategy (Array i a) #else seqArrayBounds :: Ix i => Strategy i -> Strategy (Array i a) #endif seqArrayBounds strat = seqTuple2 strat strat . Data.Array.bounds -- | Evaluate the keys and values of a map according to the given strategies. seqMap :: Strategy k -> Strategy v -> Strategy (Map k v) seqMap stratK stratV = seqList (seqTuple2 stratK stratV) . Data.Map.toList -- -------------------------------------------------------------------------- -- Sequential strategies for tuples seqTuple2 :: Strategy a -> Strategy b -> Strategy (a,b) seqTuple2 strat1 strat2 (x1,x2) = strat1 x1 `seq` strat2 x2 seqTuple3 :: Strategy a -> Strategy b -> Strategy c -> Strategy (a,b,c) seqTuple3 strat1 strat2 strat3 (x1,x2,x3) = strat1 x1 `seq` strat2 x2 `seq` strat3 x3 seqTuple4 :: Strategy a -> Strategy b -> Strategy c -> Strategy d -> Strategy (a,b,c,d) seqTuple4 strat1 strat2 strat3 strat4 (x1,x2,x3,x4) = strat1 x1 `seq` strat2 x2 `seq` strat3 x3 `seq` strat4 x4 seqTuple5 :: Strategy a -> Strategy b -> Strategy c -> Strategy d -> Strategy e -> Strategy (a,b,c,d,e) seqTuple5 strat1 strat2 strat3 strat4 strat5 (x1,x2,x3,x4,x5) = strat1 x1 `seq` strat2 x2 `seq` strat3 x3 `seq` strat4 x4 `seq` strat5 x5 seqTuple6 :: Strategy a -> Strategy b -> Strategy c -> Strategy d -> Strategy e -> Strategy f -> Strategy (a,b,c,d,e,f) seqTuple6 strat1 strat2 strat3 strat4 strat5 strat6 (x1,x2,x3,x4,x5,x6) = strat1 x1 `seq` strat2 x2 `seq` strat3 x3 `seq` strat4 x4 `seq` strat5 x5 `seq` strat6 x6 seqTuple7 :: Strategy a -> Strategy b -> Strategy c -> Strategy d -> Strategy e -> Strategy f -> Strategy g -> Strategy (a,b,c,d,e,f,g) seqTuple7 strat1 strat2 strat3 strat4 strat5 strat6 strat7 (x1,x2,x3,x4,x5,x6,x7) = strat1 x1 `seq` strat2 x2 `seq` strat3 x3 `seq` strat4 x4 `seq` strat5 x5 `seq` strat6 x6 `seq` strat7 x7 seqTuple8 :: 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) seqTuple8 strat1 strat2 strat3 strat4 strat5 strat6 strat7 strat8 (x1,x2,x3,x4,x5,x6,x7,x8) = strat1 x1 `seq` strat2 x2 `seq` strat3 x3 `seq` strat4 x4 `seq` strat5 x5 `seq` strat6 x6 `seq` strat7 x7 `seq` strat8 x8 seqTuple9 :: 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) seqTuple9 strat1 strat2 strat3 strat4 strat5 strat6 strat7 strat8 strat9 (x1,x2,x3,x4,x5,x6,x7,x8,x9) = strat1 x1 `seq` strat2 x2 `seq` strat3 x3 `seq` strat4 x4 `seq` strat5 x5 `seq` strat6 x6 `seq` strat7 x7 `seq` strat8 x8 `seq` strat9 x9 parallel-3.2.1.0/Control/Parallel/0000755000000000000000000000000012641703044015012 5ustar0000000000000000parallel-3.2.1.0/Control/Parallel/Strategies.hs0000644000000000000000000010247612641703044017472 0ustar0000000000000000{-# LANGUAGE BangPatterns, CPP, MagicHash, UnboxedTuples #-} ----------------------------------------------------------------------------- -- | -- Module : Control.Parallel.Strategies -- Copyright : (c) The University of Glasgow 2001-2010 -- License : BSD-style (see the file libraries/base/LICENSE) -- -- Maintainer : libraries@haskell.org -- Stability : experimental -- Portability : portable -- -- Parallel Evaluation Strategies, or Strategies for short, provide -- ways to express parallel computations. Strategies have the following -- key features: -- -- * Strategies express /deterministic parallelism/: -- the result of the program is unaffected by evaluating in parallel. -- The parallel tasks evaluated by a Strategy may have no side effects. -- For non-deterministic parallel programming, see "Control.Concurrent". -- -- * Strategies let you separate the description of the parallelism from the -- logic of your program, enabling modular parallelism. The basic idea -- is to build a lazy data structure representing the computation, and -- then write a Strategy that describes how to traverse the data structure -- and evaluate components of it sequentially or in parallel. -- -- * Strategies are /compositional/: larger strategies can be built -- by gluing together smaller ones. -- -- * 'Monad' and 'Applicative' instances are provided, for quickly building -- strategies that involve traversing structures in a regular way. -- -- For API history and changes in this release, see "Control.Parallel.Strategies#history". ----------------------------------------------------------------------------- module Control.Parallel.Strategies ( -- * The strategy type Strategy -- * Application of strategies , using -- :: a -> Strategy a -> a , withStrategy -- :: Strategy a -> a -> a -- * Composition of strategies , dot -- :: Strategy a -> Strategy a -> Strategy a -- * Basic strategies , r0 -- :: Strategy a , rseq , rdeepseq -- :: NFData a => Strategy a , rpar -- :: Strategy a , rparWith -- :: Strategy a -> Strategy a -- * Injection of sequential strategies , evalSeq -- :: Seq.Strategy a -> Strategy a , SeqStrategy -- * Strategies for traversable data types , evalTraversable -- :: Traversable t => Strategy a -> Strategy (t a) , parTraversable -- * Strategies for lists , evalList -- :: Strategy a -> Strategy [a] , parList , evalListN -- :: Int -> Strategy a -> Strategy [a] , parListN , evalListNth -- :: Int -> Strategy a -> Strategy [a] , parListNth , evalListSplitAt -- :: Int -> Strategy [a] -> Strategy [a] -> Strategy [a] , parListSplitAt , parListChunk , parMap -- ** Strategies for lazy lists , evalBuffer -- :: Int -> Strategy a -> Strategy [a] , parBuffer -- * Strategies for tuples -- | Evaluate the components of a tuple according to the -- given strategies. , evalTuple2 -- :: Strategy a -> ... -> Strategy (a,...) , evalTuple3 , evalTuple4 , evalTuple5 , evalTuple6 , evalTuple7 , evalTuple8 , evalTuple9 -- | Evaluate the components of a tuple in parallel according to -- the given strategies. , parTuple2 -- :: Strategy a -> ... -> Strategy (a,...) , parTuple3 , parTuple4 , parTuple5 , parTuple6 , parTuple7 , parTuple8 , parTuple9 -- * Strategic function application , ($|) -- :: (a -> b) -> Strategy a -> a -> b , ($||) , (.|) -- :: (b -> c) -> Strategy b -> (a -> b) -> a -> c , (.||) , (-|) -- :: (a -> b) -> Strategy b -> (b -> c) -> a -> c , (-||) -- * For Strategy programmers , Eval -- instances: Monad, Functor, Applicative , runEval -- :: Eval a -> a , -- * API History -- $history -- * Backwards compatibility -- | These functions and types are all deprecated, and will be -- removed in a future release. In all cases they have been -- either renamed or replaced with equivalent functionality. Done, demanding, sparking, (>|), (>||), rwhnf, unEval, seqTraverse, parTraverse, seqList, seqPair, parPair, seqTriple, parTriple, -- * For API completeness -- | so users of 'rdeepseq' aren't required to import Control.DeepSeq: NFData ) where #if !MIN_VERSION_base(4,8,0) import Data.Traversable import Control.Applicative #endif import Control.Parallel import Control.DeepSeq import Control.Monad import qualified Control.Seq import GHC.Exts infixr 9 `dot` -- same as (.) infixl 0 `using` -- lowest precedence and associate to the left -- ----------------------------------------------------------------------------- -- Eval monad (isomorphic to Lift monad from MonadLib 3.6.1) -- | 'Eval' is a Monad that makes it easier to define parallel -- strategies. It is a strict identity monad: that is, in -- -- > m >>= f -- -- @m@ is evaluated before the result is passed to @f@. -- -- > instance Monad Eval where -- > return = Done -- > m >>= k = case m of -- > Done x -> k x -- -- If you wanted to construct a 'Strategy' for a pair that sparked the -- first component in parallel and then evaluated the second -- component, you could write -- -- > myStrat :: Strategy (a,b) -- > myStrat (a,b) = do { a' <- rpar a; b' <- rseq b; return (a',b') } -- -- Alternatively, you could write this more compactly using the -- Applicative style as -- -- > myStrat (a,b) = (,) <$> rpar a <*> rseq b -- More examples, using the Applicative instance: -- -- > parList :: Strategy a -> Strategy [a] -- > parList strat = traverse (rpar `dot` strat)) -- -- > evalPair :: Strategy a -> Strategy b -> Strategy (a,b) -- > evalPair f g (a,b) = pure (,) <$> f a <*> g b -- #if __GLASGOW_HASKELL__ >= 702 newtype Eval a = Eval (State# RealWorld -> (# State# RealWorld, a #)) -- 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 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 -- | Pull the result out of the monad. runEval :: Eval a -> a runEval (Done x) = x instance Functor Eval where fmap = liftM instance Applicative Eval where pure = Done (<*>) = ap 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 -- The Eval monad satisfies the monad laws. -- -- (1) Left identity: -- return x >>= f ==> Done x >>= f ==> f x -- -- (2) Right identity: -- (i) m >>= return =*> Done u >>= return -- ==> return u -- ==> Done u <*= m -- (ii) m >>= return =*> undefined >>= return -- ==> undefined <*= m -- -- (3) Associativity: -- (i) (m >>= f) >>= g =*> (Done u >>= f) >>= g -- ==> f u >>= g <== (\x -> f x >>= g) u -- <== Done u >>= (\x -> f x >>= g) -- <*= m >>= (\x -> f x >>= g) -- (ii) (m >>= f) >>= g =*> (undefined >>= f) >>= g -- ==> undefined >>= g -- ==> undefined <== undefined >>= (\x -> f x >>= g) -- <*= m >>= (\x -> f x >>= g) -- ----------------------------------------------------------------------------- -- Strategies -- | A 'Strategy' is a function that embodies a parallel evaluation strategy. -- The function traverses (parts of) its argument, evaluating subexpressions -- in parallel or in sequence. -- -- A 'Strategy' may do an arbitrary amount of evaluation of its -- argument, but should not return a value different from the one it -- was passed. -- -- Parallel computations may be discarded by the runtime system if the -- program no longer requires their result, which is why a 'Strategy' -- function returns a new value equivalent to the old value. The -- intention is that the program applies the 'Strategy' to a -- structure, and then uses the returned value, discarding the old -- value. This idiom is expressed by the 'using' function. -- type Strategy a = a -> Eval a -- | Evaluate a value using the given 'Strategy'. -- -- > x `using` s = runEval (s x) -- using :: a -> Strategy a -> a x `using` strat = runEval (strat x) -- | evaluate a value using the given 'Strategy'. This is simply -- 'using' with the arguments reversed. -- withStrategy :: Strategy a -> a -> a withStrategy = flip using -- | Compose two strategies sequentially. -- This is the analogue to function composition on strategies. -- -- > strat2 `dot` strat1 == strat2 . withStrategy strat1 -- dot :: Strategy a -> Strategy a -> Strategy a strat2 `dot` strat1 = strat2 . runEval . strat1 -- Proof of strat2 `dot` strat1 == strat2 . withStrategy strat1 -- -- strat2 . withStrategy strat1 -- == \x -> strat2 (withStrategy strat1 x) -- == \x -> strat2 (x `using` strat1) -- == \x -> strat2 (runEval (strat1 x)) -- == \x -> (strat2 . runEval . strat1) x -- == strat2 `dot` strat1 -- One might be tempted to think that 'dot' is equivalent to '(<=<)', -- the right-to-left Kleisli composition in the Eval monad, because -- '(<=<)' can take the type @Strategy a -> Strategy a -> Strategy a@ -- and intuitively does what 'dot' does: First apply the strategy to the -- right then the one to the left. However, there is a subtle difference -- in strictness, witnessed by the following example: -- -- > (r0 `dot` rseq) undefined == Done undefined -- > (r0 <=< rseq) undefined == undefined -- -- | Inject a sequential strategy (ie. coerce a sequential strategy -- to a general strategy). -- -- Thanks to 'evalSeq', the type @Control.Seq.Strategy a@ is a subtype -- of @'Strategy' a@. evalSeq :: SeqStrategy a -> Strategy a evalSeq strat x = strat x `pseq` return x -- | A name for @Control.Seq.Strategy@, for documentation only. type SeqStrategy a = Control.Seq.Strategy a -- -------------------------------------------------------------------------- -- Basic strategies (some imported from SeqStrategies) -- | 'r0' performs *no* evaluation. -- -- > r0 == evalSeq Control.Seq.r0 -- r0 :: Strategy a r0 x = return x -- Proof of r0 == evalSeq Control.Seq.r0 -- -- evalSeq Control.Seq.r0 -- == \x -> Control.Seq.r0 x `pseq` return x -- == \x -> Control.Seq.Done `pseq` return x -- == \x -> return x -- == r0 -- | 'rseq' evaluates its argument to weak head normal form. -- -- > rseq == evalSeq Control.Seq.rseq -- rseq :: Strategy a #if __GLASGOW_HASKELL__ >= 702 rseq x = Eval $ \s -> seq# x s #else rseq x = x `seq` return x #endif -- Proof of rseq == evalSeq Control.Seq.rseq -- -- evalSeq Control.Seq.rseq -- == \x -> Control.Seq.rseq x `pseq` return x -- == \x -> (x `seq` Control.Seq.Done) `pseq` return x -- == \x -> x `pseq` return x -- == rseq -- | 'rdeepseq' fully evaluates its argument. -- -- > rdeepseq == evalSeq Control.Seq.rdeepseq -- rdeepseq :: NFData a => Strategy a rdeepseq x = do rseq (rnf x); return x -- Proof of rdeepseq == evalSeq Control.Seq.rdeepseq -- -- evalSeq Control.Seq.rdeepseq -- == \x -> Control.Seq.rdeepseq x `pseq` return x -- == \x -> (x `deepseq` Control.Seq.Done) `pseq` return x -- == \x -> (rnf x `seq` Control.Seq.Done) `pseq` return x -- == \x -> rnf x `pseq` return x -- == rdeepseq -- | 'rpar' sparks its argument (for evaluation in parallel). rpar :: Strategy a #if __GLASGOW_HASKELL__ >= 702 rpar x = Eval $ \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' -- -- * 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). -- -- 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 -- -------------------------------------------------------------------------- -- Strategy combinators for Traversable data types -- | Evaluate the elements of a traversable data structure -- according to the given strategy. evalTraversable :: Traversable t => Strategy a -> Strategy (t a) evalTraversable = traverse {-# INLINE evalTraversable #-} -- | Like 'evalTraversable' but evaluates all elements in parallel. parTraversable :: Traversable t => Strategy a -> Strategy (t a) parTraversable strat = evalTraversable (rparWith strat) {-# INLINE parTraversable #-} -- -------------------------------------------------------------------------- -- Strategies for lists -- | Evaluate each element of a list according to the given strategy. -- Equivalent to 'evalTraversable' at the list type. evalList :: Strategy a -> Strategy [a] evalList = evalTraversable -- Alternative explicitly recursive definition: -- evalList strat [] = return [] -- evalList strat (x:xs) = strat x >>= \x' -> -- evalList strat xs >>= \xs' -> -- return (x':xs') -- | Evaluate each element of a list in parallel according to given strategy. -- Equivalent to 'parTraversable' at the list type. parList :: Strategy a -> Strategy [a] parList = parTraversable -- Alternative definition via evalList: -- parList strat = evalList (rparWith strat) -- | @'evaListSplitAt' n stratPref stratSuff@ evaluates the prefix -- (of length @n@) of a list according to @stratPref@ and its the suffix -- according to @stratSuff@. 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') -- | Like 'evalListSplitAt' but evaluates both sublists in parallel. parListSplitAt :: Int -> Strategy [a] -> Strategy [a] -> Strategy [a] parListSplitAt n stratPref stratSuff = evalListSplitAt n (rparWith stratPref) (rparWith stratSuff) -- | Evaluate the first n elements of a list according to the given strategy. evalListN :: Int -> Strategy a -> Strategy [a] evalListN n strat = evalListSplitAt n (evalList strat) r0 -- | Like 'evalListN' but evaluates the first n elements in parallel. parListN :: Int -> Strategy a -> Strategy [a] parListN n strat = evalListN n (rparWith strat) -- | Evaluate the nth element of a list (if there is such) according to -- the given strategy. -- The spine of the list up to the nth element is evaluated as a side effect. evalListNth :: Int -> Strategy a -> Strategy [a] evalListNth n strat = evalListSplitAt n r0 (evalListN 1 strat) -- | Like 'evalListN' but evaluates the nth element in parallel. parListNth :: Int -> Strategy a -> Strategy [a] parListNth n strat = evalListNth n (rparWith strat) -- | Divides a list into chunks, and applies the strategy -- @'evalList' strat@ to each chunk in parallel. -- -- It is expected that this function will be replaced by a more -- generic clustering infrastructure in the future. -- -- If the chunk size is 1 or less, 'parListChunk' is equivalent to -- 'parList' -- 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 -- 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 -- | A combination of 'parList' and 'map', encapsulating a common pattern: -- -- > parMap strat f = withStrategy (parList strat) . map f -- parMap :: Strategy b -> (a -> b) -> [a] -> [b] parMap strat f = (`using` parList strat) . map f -- -------------------------------------------------------------------------- -- Strategies for lazy lists -- List-based non-compositional rolling buffer strategy, evaluating list -- elements to weak head normal form. -- Not to be exported; used in evalBuffer and for optimisation. evalBufferWHNF :: Int -> Strategy [a] evalBufferWHNF n0 xs0 = return (ret xs0 (start n0 xs0)) where -- ret :: [a] -> [a] -> [a] ret (x:xs) (y:ys) = y `pseq` (x : ret xs ys) ret xs _ = xs -- start :: Int -> [a] -> [a] start 0 ys = ys start !_n [] = [] start !n (y:ys) = y `pseq` start (n-1) ys -- | 'evalBuffer' is a rolling buffer strategy combinator for (lazy) lists. -- -- 'evalBuffer' is not as compositional as the type suggests. In fact, -- it evaluates list elements at least to weak head normal form, -- disregarding a strategy argument 'r0'. -- -- > evalBuffer n r0 == evalBuffer n rseq -- evalBuffer :: Int -> Strategy a -> Strategy [a] evalBuffer n strat = evalBufferWHNF n . map (withStrategy strat) -- Like evalBufferWHNF but sparks the list elements when pushing them -- into the buffer. -- Not to be exported; used in parBuffer and for optimisation. parBufferWHNF :: Int -> Strategy [a] parBufferWHNF n0 xs0 = return (ret xs0 (start n0 xs0)) where -- ret :: [a] -> [a] -> [a] ret (x:xs) (y:ys) = y `par` (x : ret xs ys) ret xs _ = xs -- start :: Int -> [a] -> [a] start 0 ys = ys start !_n [] = [] start !n (y:ys) = y `par` start (n-1) ys -- | Like 'evalBuffer' but evaluates the list elements in parallel when -- pushing them into the buffer. parBuffer :: Int -> Strategy a -> Strategy [a] parBuffer n strat = parBufferWHNF n . map (withStrategy strat) -- Alternative definition via evalBuffer (may compromise firing of RULES): -- parBuffer n strat = evalBuffer n (rparWith strat) -- Deforest the intermediate list in parBuffer/evalBuffer when it is -- unnecessary: {-# 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 #-} -- -------------------------------------------------------------------------- -- Strategies for tuples 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) -- -------------------------------------------------------------------------- -- Strategic function application {- These are very handy when writing pipeline parallelism asa sequence of @$@, @$|@ and @$||@'s. There is no need of naming intermediate values in this case. The separation of algorithm from strategy is achieved by allowing strategies only as second arguments to @$|@ and @$||@. -} -- | Sequential function application. The argument is evaluated using -- the given strategy before it is given to the function. ($|) :: (a -> b) -> Strategy a -> a -> b f $| s = \ x -> let z = x `using` s in z `pseq` f z -- | Parallel function application. The argument is evaluated using -- the given strategy, in parallel with the function application. ($||) :: (a -> b) -> Strategy a -> a -> b f $|| s = \ x -> let z = x `using` s in z `par` f z -- | Sequential function composition. The result of -- the second function is evaluated using the given strategy, -- and then given to the first function. (.|) :: (b -> c) -> Strategy b -> (a -> b) -> (a -> c) (.|) f s g = \ x -> let z = g x `using` s in z `pseq` f z -- | Parallel function composition. The result of the second -- function is evaluated using the given strategy, -- in parallel with the application of the first function. (.||) :: (b -> c) -> Strategy b -> (a -> b) -> (a -> c) (.||) f s g = \ x -> let z = g x `using` s in z `par` f z -- | Sequential inverse function composition, -- for those who read their programs from left to right. -- The result of the first function is evaluated using the -- given strategy, and then given to the second function. (-|) :: (a -> b) -> Strategy b -> (b -> c) -> (a -> c) (-|) f s g = \ x -> let z = f x `using` s in z `pseq` g z -- | Parallel inverse function composition, -- for those who read their programs from left to right. -- The result of the first function is evaluated using the -- given strategy, in parallel with the application of the -- second function. (-||) :: (a -> b) -> Strategy b -> (b -> c) -> (a -> c) (-||) f s g = \ x -> let z = f x `using` s in z `par` g z -- ----------------------------------------------------------------------------- -- Old/deprecated stuff {-# DEPRECATED Done "The Strategy type is now a -> Eval a, not a -> Done" #-} -- | DEPRECCATED: replaced by the 'Eval' monad type Done = () {-# DEPRECATED demanding "Use pseq or $| instead" #-} -- | DEPRECATED: Use 'pseq' or '$|' instead demanding :: a -> Done -> a demanding = flip pseq {-# DEPRECATED sparking "Use par or $|| instead" #-} -- | DEPRECATED: Use 'par' or '$||' instead sparking :: a -> Done -> a sparking = flip par {-# DEPRECATED (>|) "Use pseq or $| instead" #-} -- | DEPRECATED: Use 'pseq' or '$|' instead (>|) :: Done -> Done -> Done (>|) = Prelude.seq {-# DEPRECATED (>||) "Use par or $|| instead" #-} -- | DEPRECATED: Use 'par' or '$||' instead (>||) :: Done -> Done -> Done (>||) = par {-# DEPRECATED rwhnf "renamed to rseq" #-} -- | DEPRECATED: renamed to 'rseq' rwhnf :: Strategy a rwhnf = rseq {-# DEPRECATED seqTraverse "renamed to evalTraversable" #-} -- | DEPRECATED: renamed to 'evalTraversable' seqTraverse :: Traversable t => Strategy a -> Strategy (t a) seqTraverse = evalTraversable {-# DEPRECATED parTraverse "renamed to parTraversable" #-} -- | 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' seqList :: Strategy a -> Strategy [a] seqList = evalList {-# DEPRECATED seqPair "renamed to evalTuple2" #-} -- | DEPRECATED: renamed to 'evalTuple2' seqPair :: Strategy a -> Strategy b -> Strategy (a,b) seqPair = evalTuple2 {-# DEPRECATED parPair "renamed to parTuple2" #-} -- | DEPRECATED: renamed to 'parTuple2' parPair :: Strategy a -> Strategy b -> Strategy (a,b) parPair = parTuple2 {-# DEPRECATED seqTriple "renamed to evalTuple3" #-} -- | DEPRECATED: renamed to 'evalTuple3' seqTriple :: Strategy a -> Strategy b -> Strategy c -> Strategy (a,b,c) seqTriple = evalTuple3 {-# DEPRECATED parTriple "renamed to parTuple3" #-} -- | DEPRECATED: renamed to 'parTuple3' parTriple :: Strategy a -> Strategy b -> Strategy c -> Strategy (a,b,c) parTriple = parTuple3 {-# DEPRECATED unEval "renamed to runEval" #-} -- | DEPRECATED: renamed to 'runEval' unEval :: Eval a -> a unEval = runEval {- $history #history# The strategies library has a long history. What follows is a summary of how the current design evolved, and is mostly of interest to those who are familiar with an older version, or need to adapt old code to use the newer API. Version 1.x The original Strategies design is described in /Algorithm + Strategy = Parallelism/ and the code was written by Phil Trinder, Hans-Wolfgang Loidl, Kevin Hammond et al. Version 2.x Later, during work on the shared-memory implementation of parallelism in GHC, we discovered that the original formulation of Strategies had some problems, in particular it lead to space leaks and difficulties expressing speculative parallelism. Details are in the paper /Runtime Support for Multicore Haskell/ . This module has been rewritten in version 2. The main change is to the 'Strategy a' type synonym, which was previously @a -> Done@ and is now @a -> Eval a@. This change helps to fix the space leak described in \"Runtime Support for Multicore Haskell\". The problem is that the runtime will currently retain the memory referenced by all sparks, until they are evaluated. Hence, we must arrange to evaluate all the sparks eventually, just in case they aren't evaluated in parallel, so that they don't cause a space leak. This is why we must return a \"new\" value after applying a 'Strategy', so that the application can evaluate each spark created by the 'Strategy'. The simple rule is this: you /must/ use the result of applying a 'Strategy' if the strategy creates parallel sparks, and you should probably discard the the original value. If you don't do this, currently it may result in a space leak. In the future (GHC 6.14), it will probably result in lost parallelism instead, as we plan to change GHC so that unreferenced sparks are discarded rather than retained (we can't make this change until most code is switched over to this new version of Strategies, because code using the old verison of Strategies would be broken by the change in policy). The other changes in version 2.x are: * Strategies can now be defined using a convenient Monad/Applicative type, 'Eval'. e.g. @parList s = traverse (Par . (``using`` s))@ * 'parList' has been generalised to 'parTraverse', which works on any 'Traversable' type, and similarly 'seqList' has been generalised to 'seqTraverse' * 'parList' and 'parBuffer' have versions specialised to 'rwhnf', and there are transformation rules that automatically translate e.g. @parList rwnhf@ into a call to the optimised version. * 'NFData' has been moved to @Control.DeepSeq@ in the @deepseq@ package. Note that since the 'Strategy' type changed, 'rnf' is no longer a 'Strategy': use 'rdeepseq' instead. Version 2.1 moved NFData into a separate package, @deepseq@. Version 2.2 changed the type of Strategy to @a -> Eval a@, and re-introduced the @r0@ strategy which was missing in version 2.1. Version 2.3 simplified the @Eval@ type, so that @Eval@ is now just the strict identity monad. This change and various other improvements and refactorings are thanks to Patrick Maier who noticed that @Eval@ didn't satisfy the monad laws, and that a simpler version would fix that problem. (version 2.3 was not released on Hackage). Version 3 introduced a major overhaul of the API, to match what is presented in the paper /Seq no More: Better Strategies for Parallel Haskell/ The major differenes in the API are: * The addition of Sequential strategies ("Control.Seq") as a composable means for specifying sequential evaluation. * Changes to the naming scheme: 'rwhnf' renamed to 'rseq', 'seqList' renamed to 'evalList', 'seqPair' renamed to 'evalTuple2', The naming scheme is now as follows: * Basic polymorphic strategies (of type @'Strategy' a@) are called @r...@. Examples: 'r0', 'rseq', 'rpar', 'rdeepseq'. * A strategy combinator for a particular type constructor or constructor class @T@ is called @evalT...@, @parT...@ or @seqT...@. * The @seqT...@ combinators (residing in module "Control.Seq") yield sequential strategies. Thus, @seqT...@ combinators cannot spark, nor can the sequential strategies to which they may be applied. Examples: 'seqTuple2', 'seqListN', 'seqFoldable'. * The @evalT...@ combinators do not spark themselves, yet they may be applied to strategies that do spark. (They may also be applied to non-sparking strategies; however, in that case the corresponding @seqT...@ combinator might be a better choice.) Examples: 'evalTuple2', 'evalListN', 'evalTraversable'. * The @parT...@ combinators, which are derived from their @evalT...@ counterparts, do spark. They may be applied to all strategies, whether sparking or not. Examples: 'parTuple2', 'parListN', 'parTraversable'. * An exception to the type driven naming scheme are 'evalBuffer' and 'parBuffer', which are not named after their type constructor (lists) but after their function (rolling buffer of fixed size). -}