dph-prim-par-0.6.1.1: Data Parallel Haskell segmented arrays. (production version)

Safe HaskellSafe-Infered

Data.Array.Parallel.Unlifted.Distributed

Contents

Description

Distributed types and operations.

Synopsis

Gang operations

data Gang Source

A Gang is a group of threads which execute arbitrary work requests.

Instances

forkGang :: Int -> IO GangSource

Fork a Gang with the given number of threads (at least 1).

gangSize :: Gang -> IntSource

O(1). Yield the number of threads in the Gang.

Gang hacks

theGang :: GangSource

DPH programs use this single, shared gang of threads. The gang exists at top level, and is initialised at program start.

The vectoriser guarantees that the gang is only used by a single computation at a time. This is true because the program produced by the vector only uses flat parallelism, so parallel computations don't invoke further parallel computations. If the vectorised program tries to use nested parallelism then there is a bug in the vectoriser, and the code will run sequentially.

Distributed types and classes

class DT a whereSource

Class of distributable types. Instances of DT can be distributed across all workers of a Gang. All such types must be hyperstrict as we do not want to pass thunks into distributed computations.

Associated Types

data Dist a Source

data MDist a :: * -> *Source

Methods

indexD :: String -> Dist a -> Int -> aSource

Extract a single element of an immutable distributed value.

newMD :: Gang -> ST s (MDist a s)Source

Create an unitialised distributed value for the given Gang. The gang is used (only) to know how many elements are needed in the distributed value.

readMD :: MDist a s -> Int -> ST s aSource

Extract an element from a mutable distributed value.

writeMD :: MDist a s -> Int -> a -> ST s ()Source

Write an element of a mutable distributed value.

unsafeFreezeMD :: MDist a s -> ST s (Dist a)Source

Unsafely freeze a mutable distributed value.

deepSeqD :: a -> b -> bSource

Ensure a distributed value is fully evaluated.

sizeD :: Dist a -> IntSource

Number of elements in the distributed value.

  • For debugging only, as code shouldn't be sensitive to the return value.

sizeMD :: MDist a s -> IntSource

Number of elements in the mutable distributed value.

  • For debugging only, as code shouldn't be sensitive to the return value.

measureD :: a -> StringSource

Show a distributed value.

  • For debugging only.

Instances

DT Bool 
DT Char 
DT Double 
DT Float 
DT Int 
DT Integer 
DT Ordering 
DT Word8 
DT () 
DT UVSegd 
DT USSegd 
DT USegd 
DT a => DT (Maybe a) 
Unbox a => DT (Vector a) 
(DT a, DT b) => DT (a, b) 
(DT a, DT b, DT c) => DT (a, b, c) 

Higher-order combinators

mapD :: (DT a, DT b) => Gang -> (a -> b) -> Dist a -> Dist bSource

Map a function to every instance of a distributed value.

This applies the function to every thread, but not every value held by the thread. If you want that then use something like:

mapD theGang (V.map (+ 1)) :: Dist (Vector Int) -> Dist (Vector Int)

zipWithD :: (DT a, DT b, DT c) => Gang -> (a -> b -> c) -> Dist a -> Dist b -> Dist cSource

Combine two distributed values with the given function.

foldD :: DT a => Gang -> (a -> a -> a) -> Dist a -> aSource

Fold all the instances of a distributed value.

scanD :: forall a. DT a => Gang -> (a -> a -> a) -> a -> Dist a -> (Dist a, a)Source

Prefix sum of the instances of a distributed value.

Equality

eqD :: (Eq a, DT a) => Gang -> Dist a -> Dist a -> BoolSource

Test whether to distributed values are equal. This requires a Gang and hence can't be defined in terms of Eq.

neqD :: (Eq a, DT a) => Gang -> Dist a -> Dist a -> BoolSource

Test whether to distributed values are not equal. This requires a Gang and hence can't be defined in terms of Eq.

Distributed scalars

scalarD :: DT a => Gang -> a -> Dist aSource

Distribute a scalar. Each thread gets its own copy of the same value. Example: scalarD theGangN4 10 = [10, 10, 10, 10]

andD :: Gang -> Dist Bool -> BoolSource

AND together all instances of a distributed Bool.

orD :: Gang -> Dist Bool -> BoolSource

OR together all instances of a distributed Bool.

sumD :: (Num a, DT a) => Gang -> Dist a -> aSource

Sum all instances of a distributed number.

Distributed pairs

zipD :: (DT a, DT b) => Dist a -> Dist b -> Dist (a, b)Source

Pairing of distributed values. The two values must belong to the same Gang.

unzipD :: (DT a, DT b) => Dist (a, b) -> (Dist a, Dist b)Source

Unpairing of distributed values.

fstD :: (DT a, DT b) => Dist (a, b) -> Dist aSource

Extract the first elements of a distributed pair.

sndD :: (DT a, DT b) => Dist (a, b) -> Dist bSource

Extract the second elements of a distributed pair.

Distributed arrays

lengthD :: Unbox a => Dist (Vector a) -> Dist IntSource

Yield the distributed length of a distributed array.

splitLenD :: Gang -> Int -> Dist IntSource

O(threads). Distribute an array length over a Gang. Each thread holds the number of elements it's reponsible for. If the array length doesn't split evenly among the threads then the first threads get a few more elements.

splitLenD theGangN4 511
      = [128,128,128,127]

splitLenIdxD :: Gang -> Int -> Dist (Int, Int)Source

O(threads). Distribute an array length over a Gang. Each thread holds the number of elements it's responsible for, and the index of the start of its chunk.

splitLenIdxD theGangN4 511 
      = [(128,0),(128,128),(128,256),(127,384)]

splitD :: Unbox a => Gang -> Distribution -> Vector a -> Dist (Vector a)Source

Distribute an array over a Gang.

NOTE: This is defined in terms of splitD_impl to avoid introducing loops through RULES. Without it, splitJoinD would be a loop breaker.

splitAsD :: Unbox a => Gang -> Dist Int -> Vector a -> Dist (Vector a)Source

Distribute an array over a Gang such that each threads gets the given number of elements.

splitAsD theGangN4 (splitLenD theGangN4 10) [1 2 3 4 5 6 7 8 9 0]
      = [[1 2 3] [4 5 6] [7 8] [9 0]]

joinLengthD :: Unbox a => Gang -> Dist (Vector a) -> IntSource

O(threads). Get the overall length of a distributed array. This is implemented by reading the chunk length from each thread, and summing them up.

joinD :: Unbox a => Gang -> Distribution -> Dist (Vector a) -> Vector aSource

Join a distributed array. Join sums up the array lengths of each chunk, allocates a new result array, and copies each chunk into the result.

NOTE: This is defined in terms of joinD_impl to avoid introducing loops through RULES. Without it, splitJoinD would be a loop breaker.

splitJoinD :: (Unbox a, Unbox b) => Gang -> (Dist (Vector a) -> Dist (Vector b)) -> Vector a -> Vector bSource

Split a vector over a gang, run a distributed computation, then join the pieces together again.

joinDM :: Unbox a => Gang -> Dist (Vector a) -> ST s (MVector s a)Source

Join a distributed array, yielding a mutable global array

glueSegdD :: Gang -> Dist ((USegd, Int), Int) -> Dist USegdSource

Glue a distributed segment descriptor back into the original global one. Prop: glueSegdD gang $ splitSegdOnElems gang usegd = usegd

NOTE: This is runs sequentially and should only be used for testing purposes.

carryD :: forall a. (Unbox a, DT a) => Gang -> (a -> a -> a) -> a -> Dist Bool -> Dist (Vector a) -> (Dist (Vector a), a)Source

Selectively combine the last elements of some chunks with the first elements of others.

NOTE: This runs sequentially and should only be used for testing purposes.

 pprp $ splitD theGang unbalanced $ fromList [80, 10, 20, 40, 50, 10 :: Int]
 DVector lengths: [2,2,1,1]
         chunks:  [[80,10],[20,40],[50],[10]]

pprp $ fst 
       $ carryD theGang (+) 0 
          (mkDPrim $ fromList [True, False, True, False]) 
          (splitD theGang unbalanced $ fromList [80, 10, 20, 40, 50, 10 :: Int])

DVector lengths: [1,2,0,1]
          chunks: [[80],[30,40],[],[60]]

data Distribution Source

This is a phantom parameter used to record whether a distributed value is balanced evenly among the threads. It's used to signal this property between RULES, but the actual value is never used.

Permutations

permuteD :: forall a. Unbox a => Gang -> Dist (Vector a) -> Dist (Vector Int) -> Vector aSource

Permute for distributed arrays.

Update

atomicUpdateD :: forall a. Unbox a => Gang -> Dist (Vector a) -> Dist (Vector (Int, a)) -> Vector aSource

Debugging

fromD :: DT a => Gang -> Dist a -> [a]Source

Yield all elements of a distributed value.

  • For debugging only, don't use in production code.

toD :: DT a => Gang -> [a] -> Dist aSource

Generate a distributed value from the first p elements of a list.

  • For debugging only, don't use in production code.

debugD :: DT a => Dist a -> StringSource

Show all members of a distributed value.