Safe Haskell | None |
---|
A collection of useful parallel combinators based on top of a Par
monad.
In particular, this module provides higher order functions for traversing data structures in parallel.
- parMap :: (Traversable t, NFData b, ParFuture iv p) => (a -> b) -> t a -> p (t b)
- parMapM :: (Traversable t, NFData b, ParFuture iv p) => (a -> p b) -> t a -> p (t b)
- parMapReduceRangeThresh :: (NFData a, ParFuture iv p) => Int -> InclusiveRange -> (Int -> p a) -> (a -> a -> p a) -> a -> p a
- parMapReduceRange :: (NFData a, ParFuture iv p) => InclusiveRange -> (Int -> p a) -> (a -> a -> p a) -> a -> p a
- data InclusiveRange = InclusiveRange Int Int
- parFor :: ParFuture iv p => InclusiveRange -> (Int -> p ()) -> p ()
Documentation
parMap :: (Traversable t, NFData b, ParFuture iv p) => (a -> b) -> t a -> p (t b)Source
Applies the given function to each element of a data structure in parallel (fully evaluating the results), and returns a new data structure containing the results.
parMap f xs = mapM (spawnP . f) xs >>= mapM get
parMap
is commonly used for lists, where it has this specialised type:
parMap :: NFData b => (a -> b) -> [a] -> Par [b]
parMapM :: (Traversable t, NFData b, ParFuture iv p) => (a -> p b) -> t a -> p (t b)Source
Like parMap
, but the function is a Par
monad operation.
parMapM f xs = mapM (spawn . f) xs >>= mapM get
:: (NFData a, ParFuture iv p) | |
=> Int | threshold |
-> InclusiveRange | range over which to calculate |
-> (Int -> p a) | compute one result |
-> (a -> a -> p a) | combine two results (associative) |
-> a | initial result |
-> p a |
Computes a binary map/reduce over a finite range. The range is recursively split into two, the result for each half is computed in parallel, and then the two results are combined. When the range reaches the threshold size, the remaining elements of the range are computed sequentially.
For example, the following is a parallel implementation of
foldl (+) 0 (map (^2) [1..10^6])
parMapReduceRangeThresh 100 (InclusiveRange 1 (10^6)) (\x -> return (x^2)) (\x y -> return (x+y)) 0
parMapReduceRange :: (NFData a, ParFuture iv p) => InclusiveRange -> (Int -> p a) -> (a -> a -> p a) -> a -> p aSource
"Auto-partitioning" version of parMapReduceRangeThresh
that chooses the threshold based on
the size of the range and the number of processors..
parFor :: ParFuture iv p => InclusiveRange -> (Int -> p ()) -> p ()Source
Parallel for-loop over an inclusive range. Semantically equivalent to
parFor (InclusiveRange n m) f = forM_ [n..m] f
except that the implementation will split the work into an unspecified number of subtasks in an attempt to gain parallelism. The exact number of subtasks is chosen at runtime, and is probably a small multiple of the available number of processors.
Strictly speaking the semantics of parFor
depends on the
number of processors, and its behaviour is therefore not
deterministic. However, a good rule of thumb is to not have any
interdependencies between the elements; if this rule is followed
then parFor
has deterministic semantics. One easy way to follow
this rule is to only use put
or put_
in f
, never get
.