Copyright | [2008..2014] Manuel M T Chakravarty, Gabriele Keller [2008..2009] Sean Lee [2009..2014] Trevor L. McDonell [2013..2014] Robert Clifton-Everest |
---|---|
License | BSD3 |
Maintainer | Manuel M T Chakravarty <chak@cse.unsw.edu.au> |
Stability | experimental |
Portability | non-portable (GHC extensions) |
Safe Haskell | None |
Language | Haskell98 |
This module defines an embedded language of array computations for high-performance computing. Computations on multi-dimensional, regular arrays are expressed in the form of parameterised collective operations (such as maps, reductions, and permutations). These computations are online compiled and executed on a range of architectures.
- Abstract interface:
The types representing array computations are only exported abstractly — i.e., client code can generate array computations and submit them for execution, but it cannot inspect these computations. This is to allow for more flexibility for future extensions of this library.
- Code execution:
Access to the various backends is via a run
function in backend-specific
top level modules. Currently, we have the following:
- Data.Array.Accelerate.Interpreter: simple interpreter in Haskell as a reference implementation defining the semantics of the Accelerate language
- Data.Array.Accelerate.CUDA: an implementation supporting parallel execution on CUDA-capable NVIDIA GPUs
- Examples and documentation:
- A (draft) tutorial is available on the GitHub wiki: https://github.com/AccelerateHS/accelerate/wiki
- The
accelerate-examples
package demonstrates a range of computational kernels and several complete applications: http://hackage.haskell.org/package/accelerate-examples
- data Acc a
- class (Typeable (ArrRepr a), Typeable (ArrRepr' a), Typeable a) => Arrays a
- data Array sh e
- type Scalar e = Array DIM0 e
- type Vector e = Array DIM1 e
- type Segments i = Vector i
- class (Show a, Typeable a, Typeable (EltRepr a), Typeable (EltRepr' a), ArrayElt (EltRepr a), ArrayElt (EltRepr' a)) => Elt a
- data Z = Z
- data tail :. head = tail :. head
- class (Elt sh, Elt (Any sh), Shape (EltRepr sh)) => Shape sh
- data All = All
- data Any sh = Any
- class (Elt sl, Shape (SliceShape sl), Shape (CoSliceShape sl), Shape (FullShape sl)) => Slice sl where
- type SliceShape sl :: *
- type CoSliceShape sl :: *
- type FullShape sl :: *
- sliceIndex :: sl -> SliceIndex (EltRepr sl) (EltRepr (SliceShape sl)) (EltRepr (CoSliceShape sl)) (EltRepr (FullShape sl))
- type DIM0 = Z
- type DIM1 = DIM0 :. Int
- type DIM2 = DIM1 :. Int
- type DIM3 = DIM2 :. Int
- type DIM4 = DIM3 :. Int
- type DIM5 = DIM4 :. Int
- type DIM6 = DIM5 :. Int
- type DIM7 = DIM6 :. Int
- type DIM8 = DIM7 :. Int
- type DIM9 = DIM8 :. Int
- (!) :: (Shape ix, Elt e) => Acc (Array ix e) -> Exp ix -> Exp e
- (!!) :: (Shape ix, Elt e) => Acc (Array ix e) -> Exp Int -> Exp e
- the :: Elt e => Acc (Scalar e) -> Exp e
- null :: (Shape ix, Elt e) => Acc (Array ix e) -> Exp Bool
- length :: Elt e => Acc (Vector e) -> Exp Int
- shape :: (Shape ix, Elt e) => Acc (Array ix e) -> Exp ix
- size :: (Shape ix, Elt e) => Acc (Array ix e) -> Exp Int
- shapeSize :: Shape ix => Exp ix -> Exp Int
- slice :: (Slice slix, Elt e) => Acc (Array (FullShape slix) e) -> Exp slix -> Acc (Array (SliceShape slix) e)
- init :: Elt e => Acc (Vector e) -> Acc (Vector e)
- tail :: Elt e => Acc (Vector e) -> Acc (Vector e)
- take :: Elt e => Exp Int -> Acc (Vector e) -> Acc (Vector e)
- drop :: Elt e => Exp Int -> Acc (Vector e) -> Acc (Vector e)
- slit :: Elt e => Exp Int -> Exp Int -> Acc (Vector e) -> Acc (Vector e)
- use :: Arrays arrays => arrays -> Acc arrays
- unit :: Elt e => Exp e -> Acc (Scalar e)
- generate :: (Shape ix, Elt a) => Exp ix -> (Exp ix -> Exp a) -> Acc (Array ix a)
- replicate :: (Slice slix, Elt e) => Exp slix -> Acc (Array (SliceShape slix) e) -> Acc (Array (FullShape slix) e)
- fill :: (Shape sh, Elt e) => Exp sh -> Exp e -> Acc (Array sh e)
- enumFromN :: (Shape sh, Elt e, IsNum e) => Exp sh -> Exp e -> Acc (Array sh e)
- enumFromStepN :: (Shape sh, Elt e, IsNum e) => Exp sh -> Exp e -> Exp e -> Acc (Array sh e)
- (++) :: forall sh e. (Slice sh, Shape sh, Elt e) => Acc (Array (sh :. Int) e) -> Acc (Array (sh :. Int) e) -> Acc (Array (sh :. Int) e)
- (?|) :: Arrays a => Exp Bool -> (Acc a, Acc a) -> Acc a
- acond :: Arrays a => Exp Bool -> Acc a -> Acc a -> Acc a
- awhile :: Arrays a => (Acc a -> Acc (Scalar Bool)) -> (Acc a -> Acc a) -> Acc a -> Acc a
- (>->) :: (Arrays a, Arrays b, Arrays c) => (Acc a -> Acc b) -> (Acc b -> Acc c) -> Acc a -> Acc c
- reshape :: (Shape ix, Shape ix', Elt e) => Exp ix -> Acc (Array ix' e) -> Acc (Array ix e)
- flatten :: (Shape ix, Elt a) => Acc (Array ix a) -> Acc (Vector a)
- permute :: (Shape ix, Shape ix', Elt a) => (Exp a -> Exp a -> Exp a) -> Acc (Array ix' a) -> (Exp ix -> Exp ix') -> Acc (Array ix a) -> Acc (Array ix' a)
- backpermute :: (Shape ix, Shape ix', Elt a) => Exp ix' -> (Exp ix' -> Exp ix) -> Acc (Array ix a) -> Acc (Array ix' a)
- ignore :: Shape ix => Exp ix
- reverse :: Elt e => Acc (Vector e) -> Acc (Vector e)
- transpose :: Elt e => Acc (Array DIM2 e) -> Acc (Array DIM2 e)
- map :: (Shape ix, Elt a, Elt b) => (Exp a -> Exp b) -> Acc (Array ix a) -> Acc (Array ix b)
- zipWith :: (Shape ix, Elt a, Elt b, Elt c) => (Exp a -> Exp b -> Exp c) -> Acc (Array ix a) -> Acc (Array ix b) -> Acc (Array ix c)
- zipWith3 :: (Shape sh, Elt a, Elt b, Elt c, Elt d) => (Exp a -> Exp b -> Exp c -> Exp d) -> Acc (Array sh a) -> Acc (Array sh b) -> Acc (Array sh c) -> Acc (Array sh d)
- zipWith4 :: (Shape sh, Elt a, Elt b, Elt c, Elt d, Elt e) => (Exp a -> Exp b -> Exp c -> Exp d -> Exp e) -> Acc (Array sh a) -> Acc (Array sh b) -> Acc (Array sh c) -> Acc (Array sh d) -> Acc (Array sh e)
- zipWith5 :: (Shape sh, Elt a, Elt b, Elt c, Elt d, Elt e, Elt f) => (Exp a -> Exp b -> Exp c -> Exp d -> Exp e -> Exp f) -> Acc (Array sh a) -> Acc (Array sh b) -> Acc (Array sh c) -> Acc (Array sh d) -> Acc (Array sh e) -> Acc (Array sh f)
- zipWith6 :: (Shape sh, Elt a, Elt b, Elt c, Elt d, Elt e, Elt f, Elt g) => (Exp a -> Exp b -> Exp c -> Exp d -> Exp e -> Exp f -> Exp g) -> Acc (Array sh a) -> Acc (Array sh b) -> Acc (Array sh c) -> Acc (Array sh d) -> Acc (Array sh e) -> Acc (Array sh f) -> Acc (Array sh g)
- zipWith7 :: (Shape sh, Elt a, Elt b, Elt c, Elt d, Elt e, Elt f, Elt g, Elt h) => (Exp a -> Exp b -> Exp c -> Exp d -> Exp e -> Exp f -> Exp g -> Exp h) -> Acc (Array sh a) -> Acc (Array sh b) -> Acc (Array sh c) -> Acc (Array sh d) -> Acc (Array sh e) -> Acc (Array sh f) -> Acc (Array sh g) -> Acc (Array sh h)
- zipWith8 :: (Shape sh, Elt a, Elt b, Elt c, Elt d, Elt e, Elt f, Elt g, Elt h, Elt i) => (Exp a -> Exp b -> Exp c -> Exp d -> Exp e -> Exp f -> Exp g -> Exp h -> Exp i) -> Acc (Array sh a) -> Acc (Array sh b) -> Acc (Array sh c) -> Acc (Array sh d) -> Acc (Array sh e) -> Acc (Array sh f) -> Acc (Array sh g) -> Acc (Array sh h) -> Acc (Array sh i)
- zipWith9 :: (Shape sh, Elt a, Elt b, Elt c, Elt d, Elt e, Elt f, Elt g, Elt h, Elt i, Elt j) => (Exp a -> Exp b -> Exp c -> Exp d -> Exp e -> Exp f -> Exp g -> Exp h -> Exp i -> Exp j) -> Acc (Array sh a) -> Acc (Array sh b) -> Acc (Array sh c) -> Acc (Array sh d) -> Acc (Array sh e) -> Acc (Array sh f) -> Acc (Array sh g) -> Acc (Array sh h) -> Acc (Array sh i) -> Acc (Array sh j)
- zip :: (Shape sh, Elt a, Elt b) => Acc (Array sh a) -> Acc (Array sh b) -> Acc (Array sh (a, b))
- zip3 :: (Shape sh, Elt a, Elt b, Elt c) => Acc (Array sh a) -> Acc (Array sh b) -> Acc (Array sh c) -> Acc (Array sh (a, b, c))
- zip4 :: (Shape sh, Elt a, Elt b, Elt c, Elt d) => Acc (Array sh a) -> Acc (Array sh b) -> Acc (Array sh c) -> Acc (Array sh d) -> Acc (Array sh (a, b, c, d))
- zip5 :: (Shape sh, Elt a, Elt b, Elt c, Elt d, Elt e) => Acc (Array sh a) -> Acc (Array sh b) -> Acc (Array sh c) -> Acc (Array sh d) -> Acc (Array sh e) -> Acc (Array sh (a, b, c, d, e))
- zip6 :: (Shape sh, Elt a, Elt b, Elt c, Elt d, Elt e, Elt f) => Acc (Array sh a) -> Acc (Array sh b) -> Acc (Array sh c) -> Acc (Array sh d) -> Acc (Array sh e) -> Acc (Array sh f) -> Acc (Array sh (a, b, c, d, e, f))
- zip7 :: (Shape sh, Elt a, Elt b, Elt c, Elt d, Elt e, Elt f, Elt g) => Acc (Array sh a) -> Acc (Array sh b) -> Acc (Array sh c) -> Acc (Array sh d) -> Acc (Array sh e) -> Acc (Array sh f) -> Acc (Array sh g) -> Acc (Array sh (a, b, c, d, e, f, g))
- zip8 :: (Shape sh, Elt a, Elt b, Elt c, Elt d, Elt e, Elt f, Elt g, Elt h) => Acc (Array sh a) -> Acc (Array sh b) -> Acc (Array sh c) -> Acc (Array sh d) -> Acc (Array sh e) -> Acc (Array sh f) -> Acc (Array sh g) -> Acc (Array sh h) -> Acc (Array sh (a, b, c, d, e, f, g, h))
- zip9 :: (Shape sh, Elt a, Elt b, Elt c, Elt d, Elt e, Elt f, Elt g, Elt h, Elt i) => Acc (Array sh a) -> Acc (Array sh b) -> Acc (Array sh c) -> Acc (Array sh d) -> Acc (Array sh e) -> Acc (Array sh f) -> Acc (Array sh g) -> Acc (Array sh h) -> Acc (Array sh i) -> Acc (Array sh (a, b, c, d, e, f, g, h, i))
- unzip :: (Shape sh, Elt a, Elt b) => Acc (Array sh (a, b)) -> (Acc (Array sh a), Acc (Array sh b))
- unzip3 :: (Shape sh, Elt a, Elt b, Elt c) => Acc (Array sh (a, b, c)) -> (Acc (Array sh a), Acc (Array sh b), Acc (Array sh c))
- unzip4 :: (Shape sh, Elt a, Elt b, Elt c, Elt d) => Acc (Array sh (a, b, c, d)) -> (Acc (Array sh a), Acc (Array sh b), Acc (Array sh c), Acc (Array sh d))
- unzip5 :: (Shape sh, Elt a, Elt b, Elt c, Elt d, Elt e) => Acc (Array sh (a, b, c, d, e)) -> (Acc (Array sh a), Acc (Array sh b), Acc (Array sh c), Acc (Array sh d), Acc (Array sh e))
- unzip6 :: (Shape sh, Elt a, Elt b, Elt c, Elt d, Elt e, Elt f) => Acc (Array sh (a, b, c, d, e, f)) -> (Acc (Array sh a), Acc (Array sh b), Acc (Array sh c), Acc (Array sh d), Acc (Array sh e), Acc (Array sh f))
- unzip7 :: (Shape sh, Elt a, Elt b, Elt c, Elt d, Elt e, Elt f, Elt g) => Acc (Array sh (a, b, c, d, e, f, g)) -> (Acc (Array sh a), Acc (Array sh b), Acc (Array sh c), Acc (Array sh d), Acc (Array sh e), Acc (Array sh f), Acc (Array sh g))
- unzip8 :: (Shape sh, Elt a, Elt b, Elt c, Elt d, Elt e, Elt f, Elt g, Elt h) => Acc (Array sh (a, b, c, d, e, f, g, h)) -> (Acc (Array sh a), Acc (Array sh b), Acc (Array sh c), Acc (Array sh d), Acc (Array sh e), Acc (Array sh f), Acc (Array sh g), Acc (Array sh h))
- unzip9 :: (Shape sh, Elt a, Elt b, Elt c, Elt d, Elt e, Elt f, Elt g, Elt h, Elt i) => Acc (Array sh (a, b, c, d, e, f, g, h, i)) -> (Acc (Array sh a), Acc (Array sh b), Acc (Array sh c), Acc (Array sh d), Acc (Array sh e), Acc (Array sh f), Acc (Array sh g), Acc (Array sh h), Acc (Array sh i))
- filter :: Elt a => (Exp a -> Exp Bool) -> Acc (Vector a) -> Acc (Vector a)
- scatter :: Elt e => Acc (Vector Int) -> Acc (Vector e) -> Acc (Vector e) -> Acc (Vector e)
- scatterIf :: (Elt e, Elt e') => Acc (Vector Int) -> Acc (Vector e) -> (Exp e -> Exp Bool) -> Acc (Vector e') -> Acc (Vector e') -> Acc (Vector e')
- gather :: Elt e => Acc (Vector Int) -> Acc (Vector e) -> Acc (Vector e)
- gatherIf :: (Elt e, Elt e') => Acc (Vector Int) -> Acc (Vector e) -> (Exp e -> Exp Bool) -> Acc (Vector e') -> Acc (Vector e') -> Acc (Vector e')
- fold :: (Shape ix, Elt a) => (Exp a -> Exp a -> Exp a) -> Exp a -> Acc (Array (ix :. Int) a) -> Acc (Array ix a)
- fold1 :: (Shape ix, Elt a) => (Exp a -> Exp a -> Exp a) -> Acc (Array (ix :. Int) a) -> Acc (Array ix a)
- foldAll :: (Shape sh, Elt a) => (Exp a -> Exp a -> Exp a) -> Exp a -> Acc (Array sh a) -> Acc (Scalar a)
- fold1All :: (Shape sh, Elt a) => (Exp a -> Exp a -> Exp a) -> Acc (Array sh a) -> Acc (Scalar a)
- foldSeg :: (Shape ix, Elt a, Elt i, IsIntegral i) => (Exp a -> Exp a -> Exp a) -> Exp a -> Acc (Array (ix :. Int) a) -> Acc (Segments i) -> Acc (Array (ix :. Int) a)
- fold1Seg :: (Shape ix, Elt a, Elt i, IsIntegral i) => (Exp a -> Exp a -> Exp a) -> Acc (Array (ix :. Int) a) -> Acc (Segments i) -> Acc (Array (ix :. Int) a)
- all :: (Shape sh, Elt e) => (Exp e -> Exp Bool) -> Acc (Array sh e) -> Acc (Scalar Bool)
- any :: (Shape sh, Elt e) => (Exp e -> Exp Bool) -> Acc (Array sh e) -> Acc (Scalar Bool)
- and :: Shape sh => Acc (Array sh Bool) -> Acc (Scalar Bool)
- or :: Shape sh => Acc (Array sh Bool) -> Acc (Scalar Bool)
- sum :: (Shape sh, Elt e, IsNum e) => Acc (Array sh e) -> Acc (Scalar e)
- product :: (Shape sh, Elt e, IsNum e) => Acc (Array sh e) -> Acc (Scalar e)
- minimum :: (Shape sh, Elt e, IsScalar e) => Acc (Array sh e) -> Acc (Scalar e)
- maximum :: (Shape sh, Elt e, IsScalar e) => Acc (Array sh e) -> Acc (Scalar e)
- scanl :: Elt a => (Exp a -> Exp a -> Exp a) -> Exp a -> Acc (Vector a) -> Acc (Vector a)
- scanl1 :: Elt a => (Exp a -> Exp a -> Exp a) -> Acc (Vector a) -> Acc (Vector a)
- scanl' :: Elt a => (Exp a -> Exp a -> Exp a) -> Exp a -> Acc (Vector a) -> (Acc (Vector a), Acc (Scalar a))
- scanr :: Elt a => (Exp a -> Exp a -> Exp a) -> Exp a -> Acc (Vector a) -> Acc (Vector a)
- scanr1 :: Elt a => (Exp a -> Exp a -> Exp a) -> Acc (Vector a) -> Acc (Vector a)
- scanr' :: Elt a => (Exp a -> Exp a -> Exp a) -> Exp a -> Acc (Vector a) -> (Acc (Vector a), Acc (Scalar a))
- prescanl :: Elt a => (Exp a -> Exp a -> Exp a) -> Exp a -> Acc (Vector a) -> Acc (Vector a)
- postscanl :: Elt a => (Exp a -> Exp a -> Exp a) -> Exp a -> Acc (Vector a) -> Acc (Vector a)
- prescanr :: Elt a => (Exp a -> Exp a -> Exp a) -> Exp a -> Acc (Vector a) -> Acc (Vector a)
- postscanr :: Elt a => (Exp a -> Exp a -> Exp a) -> Exp a -> Acc (Vector a) -> Acc (Vector a)
- scanlSeg :: (Elt a, Elt i, IsIntegral i) => (Exp a -> Exp a -> Exp a) -> Exp a -> Acc (Vector a) -> Acc (Segments i) -> Acc (Vector a)
- scanl1Seg :: (Elt a, Elt i, IsIntegral i) => (Exp a -> Exp a -> Exp a) -> Acc (Vector a) -> Acc (Segments i) -> Acc (Vector a)
- scanl'Seg :: forall a i. (Elt a, Elt i, IsIntegral i) => (Exp a -> Exp a -> Exp a) -> Exp a -> Acc (Vector a) -> Acc (Segments i) -> Acc (Vector a, Vector a)
- prescanlSeg :: (Elt a, Elt i, IsIntegral i) => (Exp a -> Exp a -> Exp a) -> Exp a -> Acc (Vector a) -> Acc (Segments i) -> Acc (Vector a)
- postscanlSeg :: (Elt a, Elt i, IsIntegral i) => (Exp a -> Exp a -> Exp a) -> Exp a -> Acc (Vector a) -> Acc (Segments i) -> Acc (Vector a)
- scanrSeg :: (Elt a, Elt i, IsIntegral i) => (Exp a -> Exp a -> Exp a) -> Exp a -> Acc (Vector a) -> Acc (Segments i) -> Acc (Vector a)
- scanr1Seg :: (Elt a, Elt i, IsIntegral i) => (Exp a -> Exp a -> Exp a) -> Acc (Vector a) -> Acc (Segments i) -> Acc (Vector a)
- scanr'Seg :: forall a i. (Elt a, Elt i, IsIntegral i) => (Exp a -> Exp a -> Exp a) -> Exp a -> Acc (Vector a) -> Acc (Segments i) -> Acc (Vector a, Vector a)
- prescanrSeg :: (Elt a, Elt i, IsIntegral i) => (Exp a -> Exp a -> Exp a) -> Exp a -> Acc (Vector a) -> Acc (Segments i) -> Acc (Vector a)
- postscanrSeg :: (Elt a, Elt i, IsIntegral i) => (Exp a -> Exp a -> Exp a) -> Exp a -> Acc (Vector a) -> Acc (Segments i) -> Acc (Vector a)
- stencil :: (Shape ix, Elt a, Elt b, Stencil ix a stencil) => (stencil -> Exp b) -> Boundary a -> Acc (Array ix a) -> Acc (Array ix b)
- stencil2 :: (Shape ix, Elt a, Elt b, Elt c, Stencil ix a stencil1, Stencil ix b stencil2) => (stencil1 -> stencil2 -> Exp c) -> Boundary a -> Acc (Array ix a) -> Boundary b -> Acc (Array ix b) -> Acc (Array ix c)
- class (Elt (StencilRepr sh stencil), Stencil sh a (StencilRepr sh stencil)) => Stencil sh a stencil
- data Boundary a
- type Stencil3 a = (Exp a, Exp a, Exp a)
- type Stencil5 a = (Exp a, Exp a, Exp a, Exp a, Exp a)
- type Stencil7 a = (Exp a, Exp a, Exp a, Exp a, Exp a, Exp a, Exp a)
- type Stencil9 a = (Exp a, Exp a, Exp a, Exp a, Exp a, Exp a, Exp a, Exp a, Exp a)
- type Stencil3x3 a = (Stencil3 a, Stencil3 a, Stencil3 a)
- type Stencil5x3 a = (Stencil5 a, Stencil5 a, Stencil5 a)
- type Stencil3x5 a = (Stencil3 a, Stencil3 a, Stencil3 a, Stencil3 a, Stencil3 a)
- type Stencil5x5 a = (Stencil5 a, Stencil5 a, Stencil5 a, Stencil5 a, Stencil5 a)
- type Stencil3x3x3 a = (Stencil3x3 a, Stencil3x3 a, Stencil3x3 a)
- type Stencil5x3x3 a = (Stencil5x3 a, Stencil5x3 a, Stencil5x3 a)
- type Stencil3x5x3 a = (Stencil3x5 a, Stencil3x5 a, Stencil3x5 a)
- type Stencil3x3x5 a = (Stencil3x3 a, Stencil3x3 a, Stencil3x3 a, Stencil3x3 a, Stencil3x3 a)
- type Stencil5x5x3 a = (Stencil5x5 a, Stencil5x5 a, Stencil5x5 a)
- type Stencil5x3x5 a = (Stencil5x3 a, Stencil5x3 a, Stencil5x3 a, Stencil5x3 a, Stencil5x3 a)
- type Stencil3x5x5 a = (Stencil3x5 a, Stencil3x5 a, Stencil3x5 a, Stencil3x5 a, Stencil3x5 a)
- type Stencil5x5x5 a = (Stencil5x5 a, Stencil5x5 a, Stencil5x5 a, Stencil5x5 a, Stencil5x5 a)
- foreignAcc :: (Arrays acc, Arrays res, Foreign ff) => ff acc res -> (Acc acc -> Acc res) -> Acc acc -> Acc res
- foreignAcc2 :: (Arrays acc, Arrays res, Foreign ff1, Foreign ff2) => ff1 acc res -> ff2 acc res -> (Acc acc -> Acc res) -> Acc acc -> Acc res
- foreignAcc3 :: (Arrays acc, Arrays res, Foreign ff1, Foreign ff2, Foreign ff3) => ff1 acc res -> ff2 acc res -> ff3 acc res -> (Acc acc -> Acc res) -> Acc acc -> Acc res
- foreignExp :: (Elt e, Elt res, Foreign ff) => ff e res -> (Exp e -> Exp res) -> Exp e -> Exp res
- foreignExp2 :: (Elt e, Elt res, Foreign ff1, Foreign ff2) => ff1 e res -> ff2 e res -> (Exp e -> Exp res) -> Exp e -> Exp res
- foreignExp3 :: (Elt e, Elt res, Foreign ff1, Foreign ff2, Foreign ff3) => ff1 e res -> ff2 e res -> ff3 e res -> (Exp e -> Exp res) -> Exp e -> Exp res
- data Exp t
- class Typeable a => IsScalar a
- class (Num a, IsScalar a) => IsNum a
- class IsBounded a
- class (IsScalar a, IsNum a, IsBounded a) => IsIntegral a
- class (Floating a, IsScalar a, IsNum a) => IsFloating a
- class IsNonNum a
- data Int :: *
- data Int8 :: *
- data Int16 :: *
- data Int32 :: *
- data Int64 :: *
- data Word :: *
- data Word8 :: *
- data Word16 :: *
- data Word32 :: *
- data Word64 :: *
- data CShort :: *
- data CUShort :: *
- data CInt :: *
- data CUInt :: *
- data CLong :: *
- data CULong :: *
- data CLLong :: *
- data CULLong :: *
- data Float :: *
- data Double :: *
- data CFloat :: *
- data CDouble :: *
- data Bool :: *
- data Char :: *
- data CChar :: *
- data CSChar :: *
- data CUChar :: *
- class Lift c e where
- class Lift c e => Unlift c e where
- lift1 :: (Unlift Exp e1, Lift Exp e2) => (e1 -> e2) -> Exp (Plain e1) -> Exp (Plain e2)
- lift2 :: (Unlift Exp e1, Unlift Exp e2, Lift Exp e3) => (e1 -> e2 -> e3) -> Exp (Plain e1) -> Exp (Plain e2) -> Exp (Plain e3)
- ilift1 :: (Exp Int -> Exp Int) -> Exp DIM1 -> Exp DIM1
- ilift2 :: (Exp Int -> Exp Int -> Exp Int) -> Exp DIM1 -> Exp DIM1 -> Exp DIM1
- constant :: Elt t => t -> Exp t
- fst :: forall a b. (Elt a, Elt b) => Exp (a, b) -> Exp a
- afst :: forall a b. (Arrays a, Arrays b) => Acc (a, b) -> Acc a
- snd :: forall a b. (Elt a, Elt b) => Exp (a, b) -> Exp b
- asnd :: forall a b. (Arrays a, Arrays b) => Acc (a, b) -> Acc b
- curry :: Lift f (f a, f b) => (f (Plain (f a), Plain (f b)) -> f c) -> f a -> f b -> f c
- uncurry :: Unlift f (f a, f b) => (f a -> f b -> f c) -> f (Plain (f a), Plain (f b)) -> f c
- (?) :: Elt t => Exp Bool -> (Exp t, Exp t) -> Exp t
- caseof :: (Elt a, Elt b) => Exp a -> [(Exp a -> Exp Bool, Exp b)] -> Exp b -> Exp b
- cond :: Elt t => Exp Bool -> Exp t -> Exp t -> Exp t
- while :: Elt e => (Exp e -> Exp Bool) -> (Exp e -> Exp e) -> Exp e -> Exp e
- iterate :: forall a. Elt a => Exp Int -> (Exp a -> Exp a) -> Exp a -> Exp a
- sfoldl :: forall sh a b. (Shape sh, Slice sh, Elt a, Elt b) => (Exp a -> Exp b -> Exp a) -> Exp a -> Exp sh -> Acc (Array (sh :. Int) b) -> Exp a
- (&&*) :: Exp Bool -> Exp Bool -> Exp Bool
- (||*) :: Exp Bool -> Exp Bool -> Exp Bool
- not :: Exp Bool -> Exp Bool
- (==*) :: (Elt t, IsScalar t) => Exp t -> Exp t -> Exp Bool
- (/=*) :: (Elt t, IsScalar t) => Exp t -> Exp t -> Exp Bool
- (<*) :: (Elt t, IsScalar t) => Exp t -> Exp t -> Exp Bool
- (<=*) :: (Elt t, IsScalar t) => Exp t -> Exp t -> Exp Bool
- (>*) :: (Elt t, IsScalar t) => Exp t -> Exp t -> Exp Bool
- (>=*) :: (Elt t, IsScalar t) => Exp t -> Exp t -> Exp Bool
- truncate :: (Elt a, Elt b, IsFloating a, IsIntegral b) => Exp a -> Exp b
- round :: (Elt a, Elt b, IsFloating a, IsIntegral b) => Exp a -> Exp b
- floor :: (Elt a, Elt b, IsFloating a, IsIntegral b) => Exp a -> Exp b
- ceiling :: (Elt a, Elt b, IsFloating a, IsIntegral b) => Exp a -> Exp b
- even :: (Elt a, IsIntegral a) => Exp a -> Exp Bool
- odd :: (Elt a, IsIntegral a) => Exp a -> Exp Bool
- bit :: (Elt t, IsIntegral t) => Exp Int -> Exp t
- setBit :: (Elt t, IsIntegral t) => Exp t -> Exp Int -> Exp t
- clearBit :: (Elt t, IsIntegral t) => Exp t -> Exp Int -> Exp t
- complementBit :: (Elt t, IsIntegral t) => Exp t -> Exp Int -> Exp t
- testBit :: (Elt t, IsIntegral t) => Exp t -> Exp Int -> Exp Bool
- shift :: (Elt t, IsIntegral t) => Exp t -> Exp Int -> Exp t
- shiftL :: (Elt t, IsIntegral t) => Exp t -> Exp Int -> Exp t
- shiftR :: (Elt t, IsIntegral t) => Exp t -> Exp Int -> Exp t
- rotate :: (Elt t, IsIntegral t) => Exp t -> Exp Int -> Exp t
- rotateL :: (Elt t, IsIntegral t) => Exp t -> Exp Int -> Exp t
- rotateR :: (Elt t, IsIntegral t) => Exp t -> Exp Int -> Exp t
- index0 :: Exp Z
- index1 :: Elt i => Exp i -> Exp (Z :. i)
- unindex1 :: Elt i => Exp (Z :. i) -> Exp i
- index2 :: (Elt i, Slice (Z :. i)) => Exp i -> Exp i -> Exp ((Z :. i) :. i)
- unindex2 :: forall i. (Elt i, Slice (Z :. i)) => Exp ((Z :. i) :. i) -> Exp (i, i)
- indexHead :: Slice sh => Exp (sh :. Int) -> Exp Int
- indexTail :: Slice sh => Exp (sh :. Int) -> Exp sh
- toIndex :: Shape sh => Exp sh -> Exp sh -> Exp Int
- fromIndex :: Shape sh => Exp sh -> Exp Int -> Exp sh
- intersect :: Shape sh => Exp sh -> Exp sh -> Exp sh
- ord :: Exp Char -> Exp Int
- chr :: Exp Int -> Exp Char
- boolToInt :: Exp Bool -> Exp Int
- fromIntegral :: (Elt a, Elt b, IsIntegral a, IsNum b) => Exp a -> Exp b
- arrayDim :: Shape sh => sh -> Int
- arrayShape :: Shape sh => Array sh e -> sh
- arraySize :: Shape sh => sh -> Int
- indexArray :: Array sh e -> sh -> e
- fromFunction :: (Shape sh, Elt e) => sh -> (sh -> e) -> Array sh e
- fromList :: (Shape sh, Elt e) => sh -> [e] -> Array sh e
- toList :: forall sh e. Array sh e -> [e]
- fromIArray :: (EltRepr ix ~ EltRepr sh, IArray a e, Ix ix, Shape sh, Elt ix, Elt e) => a ix e -> Array sh e
- toIArray :: (EltRepr ix ~ EltRepr sh, IArray a e, Ix ix, Shape sh, Elt ix, Elt e) => Array sh e -> a ix e
The Accelerate Array Language
Array data types
Array-valued collective computations
class (Typeable (ArrRepr a), Typeable (ArrRepr' a), Typeable a) => Arrays a Source
arrays, arrays', toArr, toArr', fromArr, fromArr'
Arrays () | |
(Arrays b, Arrays a) => Arrays (b, a) | |
(Shape sh, Elt e) => Arrays (Array sh e) | |
(Arrays c, Arrays b, Arrays a) => Arrays (c, b, a) | |
(Arrays d, Arrays c, Arrays b, Arrays a) => Arrays (d, c, b, a) | |
(Arrays e, Arrays d, Arrays c, Arrays b, Arrays a) => Arrays (e, d, c, b, a) | |
(Arrays f, Arrays e, Arrays d, Arrays c, Arrays b, Arrays a) => Arrays (f, e, d, c, b, a) | |
(Arrays g, Arrays f, Arrays e, Arrays d, Arrays c, Arrays b, Arrays a) => Arrays (g, f, e, d, c, b, a) | |
(Arrays h, Arrays g, Arrays f, Arrays e, Arrays d, Arrays c, Arrays b, Arrays a) => Arrays (h, g, f, e, d, c, b, a) | |
(Arrays i, Arrays h, Arrays g, Arrays f, Arrays e, Arrays d, Arrays c, Arrays b, Arrays a) => Arrays (i, h, g, f, e, d, c, b, a) |
Multi-dimensional arrays for array processing.
If device and host memory are separate, arrays will be transferred to the device when necessary (if possible asynchronously and in parallel with other tasks) and cached on the device if sufficient memory is available.
type Segments i = Vector i Source
Segment descriptor (vector of segment lengths).
To represent nested one-dimensional arrays, we use a flat array of data values in conjunction with a segment descriptor, which stores the lengths of the subarrays.
Array element types
class (Show a, Typeable a, Typeable (EltRepr a), Typeable (EltRepr' a), ArrayElt (EltRepr a), ArrayElt (EltRepr' a)) => Elt a Source
Accelerate supports as array elements only simple atomic types, and tuples thereof. These element types are stored efficiently in memory, unpacked as consecutive elements without pointers.
This class characterises the types of values that can be array elements, and hence, appear in scalar Accelerate expressions.
eltType, fromElt, toElt, eltType', fromElt', toElt'
Elt Bool | |
Elt Char | |
Elt Double | |
Elt Float | |
Elt Int | |
Elt Int8 | |
Elt Int16 | |
Elt Int32 | |
Elt Int64 | |
Elt Word | |
Elt Word8 | |
Elt Word16 | |
Elt Word32 | |
Elt Word64 | |
Elt () | |
Elt CChar | |
Elt CSChar | |
Elt CUChar | |
Elt CShort | |
Elt CUShort | |
Elt CInt | |
Elt CUInt | |
Elt CLong | |
Elt CULong | |
Elt CLLong | |
Elt CULLong | |
Elt CFloat | |
Elt CDouble | |
Elt All | |
Elt Z | |
Elt a => Elt (Complex a) | |
Shape sh => Elt (Any ((:.) sh Int)) | |
Elt (Any Z) | |
(Elt a, Elt b) => Elt (a, b) | |
(Elt t, Elt h) => Elt ((:.) t h) | |
(Elt a, Elt b, Elt c) => Elt (a, b, c) | |
(Elt a, Elt b, Elt c, Elt d) => Elt (a, b, c, d) | |
(Elt a, Elt b, Elt c, Elt d, Elt e) => Elt (a, b, c, d, e) | |
(Elt a, Elt b, Elt c, Elt d, Elt e, Elt f) => Elt (a, b, c, d, e, f) | |
(Elt a, Elt b, Elt c, Elt d, Elt e, Elt f, Elt g) => Elt (a, b, c, d, e, f, g) | |
(Elt a, Elt b, Elt c, Elt d, Elt e, Elt f, Elt g, Elt h) => Elt (a, b, c, d, e, f, g, h) | |
(Elt a, Elt b, Elt c, Elt d, Elt e, Elt f, Elt g, Elt h, Elt i) => Elt (a, b, c, d, e, f, g, h, i) |
Shapes & Indices
Array indices are snoc type lists; that is, they are backwards and the
end-of-list token, Z
, occurs on the left. For example, the type of a
rank-2 array index is Z :. Int :. Int
.
Rank-0 index
Eq Z | |
Show Z | |
Slice Z | |
Shape Z | |
Elt Z | |
Typeable * Z | |
Unlift Exp Z | |
Lift Exp Z | |
Elt e => Stencil DIM1 e (Exp e, Exp e, Exp e) | |
Elt e => Stencil DIM1 e (Exp e, Exp e, Exp e, Exp e, Exp e) | |
Elt e => Stencil DIM1 e (Exp e, Exp e, Exp e, Exp e, Exp e, Exp e, Exp e) | |
Elt e => Stencil DIM1 e (Exp e, Exp e, Exp e, Exp e, Exp e, Exp e, Exp e, Exp e, Exp e) | |
Elt e => IsList (Vector e) | |
Elt (Any Z) | |
type SliceShape Z = Z | |
type CoSliceShape Z = Z | |
type FullShape Z = Z | |
type Plain Z = Z | |
type Item (Vector e) = e |
data tail :. head infixl 3 Source
Increase an index rank by one dimension. The :.
operator is
used to construct both values and types.
tail :. head infixl 3 |
Elt e => Stencil DIM1 e (Exp e, Exp e, Exp e) | |
Elt e => Stencil DIM1 e (Exp e, Exp e, Exp e, Exp e, Exp e) | |
Elt e => Stencil DIM1 e (Exp e, Exp e, Exp e, Exp e, Exp e, Exp e, Exp e) | |
Elt e => Stencil DIM1 e (Exp e, Exp e, Exp e, Exp e, Exp e, Exp e, Exp e, Exp e, Exp e) | |
(Elt e, Slice (Plain ix), Unlift Exp ix) => Unlift Exp ((:.) ix (Exp e)) | |
(Elt e, Slice ix) => Unlift Exp ((:.) (Exp ix) (Exp e)) | |
(Elt e, Slice (Plain ix), Lift Exp ix) => Lift Exp ((:.) ix (Exp e)) | |
(Slice (Plain ix), Lift Exp ix) => Lift Exp ((:.) ix All) | |
(Slice (Plain ix), Lift Exp ix) => Lift Exp ((:.) ix Int) | |
Elt e => IsList (Vector e) | |
Shape sh => Elt (Any ((:.) sh Int)) | |
(Eq tail, Eq head) => Eq ((:.) tail head) | |
(Show tail, Show head) => Show ((:.) tail head) | |
Slice sl => Slice ((:.) sl Int) | |
Slice sl => Slice ((:.) sl All) | |
Shape sh => Shape ((:.) sh Int) | |
(Elt t, Elt h) => Elt ((:.) t h) | |
Typeable (* -> * -> *) (:.) | |
(Stencil ((:.) sh Int) a row2, Stencil ((:.) sh Int) a row1, Stencil ((:.) sh Int) a row0) => Stencil ((:.) ((:.) sh Int) Int) a (row2, row1, row0) | |
(Stencil ((:.) sh Int) a row1, Stencil ((:.) sh Int) a row2, Stencil ((:.) sh Int) a row3, Stencil ((:.) sh Int) a row4, Stencil ((:.) sh Int) a row5) => Stencil ((:.) ((:.) sh Int) Int) a (row1, row2, row3, row4, row5) | |
(Stencil ((:.) sh Int) a row1, Stencil ((:.) sh Int) a row2, Stencil ((:.) sh Int) a row3, Stencil ((:.) sh Int) a row4, Stencil ((:.) sh Int) a row5, Stencil ((:.) sh Int) a row6, Stencil ((:.) sh Int) a row7) => Stencil ((:.) ((:.) sh Int) Int) a (row1, row2, row3, row4, row5, row6, row7) | |
(Stencil ((:.) sh Int) a row1, Stencil ((:.) sh Int) a row2, Stencil ((:.) sh Int) a row3, Stencil ((:.) sh Int) a row4, Stencil ((:.) sh Int) a row5, Stencil ((:.) sh Int) a row6, Stencil ((:.) sh Int) a row7, Stencil ((:.) sh Int) a row8, Stencil ((:.) sh Int) a row9) => Stencil ((:.) ((:.) sh Int) Int) a (row1, row2, row3, row4, row5, row6, row7, row8, row9) | |
type Item (Vector e) = e | |
type SliceShape ((:.) sl Int) = SliceShape sl | |
type SliceShape ((:.) sl All) = (:.) (SliceShape sl) Int | |
type CoSliceShape ((:.) sl Int) = (:.) (CoSliceShape sl) Int | |
type CoSliceShape ((:.) sl All) = CoSliceShape sl | |
type FullShape ((:.) sl Int) = (:.) (FullShape sl) Int | |
type FullShape ((:.) sl All) = (:.) (FullShape sl) Int | |
type Plain ((:.) ix (Exp e)) = (:.) (Plain ix) e | |
type Plain ((:.) ix All) = (:.) (Plain ix) All | |
type Plain ((:.) ix Int) = (:.) (Plain ix) Int |
class (Elt sh, Elt (Any sh), Shape (EltRepr sh)) => Shape sh Source
Shapes and indices of multi-dimensional arrays
sliceAnyIndex
Marker for entire dimensions in slice descriptors.
For example, when used in slices passed to replicate
,
the occurrences of All
indicate the dimensions into which the array's
existing extent will be placed, rather than the new dimensions introduced by
replication.
Eq All | |
Show All | |
Elt All | |
Typeable * All | |
(Slice (Plain ix), Lift Exp ix) => Lift Exp ((:.) ix All) | |
Slice sl => Slice ((:.) sl All) | |
type SliceShape ((:.) sl All) = (:.) (SliceShape sl) Int | |
type CoSliceShape ((:.) sl All) = CoSliceShape sl | |
type FullShape ((:.) sl All) = (:.) (FullShape sl) Int | |
type Plain ((:.) ix All) = (:.) (Plain ix) All |
Marker for arbitrary shapes in slice descriptors. Such arbitrary shapes may include an unknown number of dimensions.
Any
can be used in the leftmost position of a slice instead of
Z
, for example (Any :. _ :. _)
. In the following definition
Any
is used to match against whatever shape the type variable
sh
takes:
repN :: (Shape sh, Elt e) => Int -> Acc (Array sh e) -> Acc (Array (sh:.Int) e) repN n a = replicate (constant $ Any :. n) a
class (Elt sl, Shape (SliceShape sl), Shape (CoSliceShape sl), Shape (FullShape sl)) => Slice sl where Source
Slices, aka generalised indices, as n-tuples and mappings of slice indices to slices, co-slices, and slice dimensions
sliceIndex :: sl -> SliceIndex (EltRepr sl) (EltRepr (SliceShape sl)) (EltRepr (CoSliceShape sl)) (EltRepr (FullShape sl)) Source
Accessors
Indexing
(!) :: (Shape ix, Elt e) => Acc (Array ix e) -> Exp ix -> Exp e infixl 9 Source
Expression form that extracts a scalar from an array
(!!) :: (Shape ix, Elt e) => Acc (Array ix e) -> Exp Int -> Exp e infixl 9 Source
Expression form that extracts a scalar from an array at a linear index
Shape information
shape :: (Shape ix, Elt e) => Acc (Array ix e) -> Exp ix Source
Expression form that yields the shape of an array
size :: (Shape ix, Elt e) => Acc (Array ix e) -> Exp Int Source
Expression form that yields the size of an array
shapeSize :: Shape ix => Exp ix -> Exp Int Source
The total number of elements in an array of the given Shape
Extracting sub-arrays
slice :: (Slice slix, Elt e) => Acc (Array (FullShape slix) e) -> Exp slix -> Acc (Array (SliceShape slix) e) Source
Index an array with a generalised array index, supplied as the
second argument. The result is a new array (possibly a singleton)
containing the selected dimensions (All
s) in their entirety.
This can be used to cut out entire dimensions. The opposite of
replicate
. For example, if mat
is a two dimensional array, the
following will select a specific row and yield a one dimensional
result:
slice mat (lift (Z :. (2::Int) :. All))
A fully specified index (with no All
s) would return a single element (zero
dimensional array).
init :: Elt e => Acc (Vector e) -> Acc (Vector e) Source
Yield all but the last element of the input vector. The vector must not be empty.
tail :: Elt e => Acc (Vector e) -> Acc (Vector e) Source
Yield all but the first element of the input vector. The vector must not be empty.
take :: Elt e => Exp Int -> Acc (Vector e) -> Acc (Vector e) Source
Yield the first n
elements of the input vector. The vector must contain
no more than n
elements.
drop :: Elt e => Exp Int -> Acc (Vector e) -> Acc (Vector e) Source
Yield all but the first n
elements of the input vector. The vector must
contain no fewer than n
elements.
slit :: Elt e => Exp Int -> Exp Int -> Acc (Vector e) -> Acc (Vector e) Source
Yield a slit (slice) from the vector. The vector must contain at least
i + n
elements. Denotationally, we have:
slit i n = take n . drop i
Construction
Introduction
use :: Arrays arrays => arrays -> Acc arrays Source
Array inlet: makes an array available for processing using the Accelerate language.
Depending upon the backend used to execute array computations, this may trigger (asynchronous) data transfer.
unit :: Elt e => Exp e -> Acc (Scalar e) Source
Scalar inlet: injects a scalar (or a tuple of scalars) into a singleton array for use in the Accelerate language.
Initialisation
generate :: (Shape ix, Elt a) => Exp ix -> (Exp ix -> Exp a) -> Acc (Array ix a) Source
Construct a new array by applying a function to each index.
For example, the following will generate a one-dimensional array
(Vector
) of three floating point numbers:
generate (index1 3) (\_ -> 1.2)
Or, equivalently:
generate (constant (Z :. (3::Int))) (\_ -> 1.2)
Finally, the following will create an array equivalent to '[1..10]':
generate (index1 10) $ \ ix -> let (Z :. i) = unlift ix in fromIntegral i
- NOTE:
Using generate
, it is possible to introduce nested data parallelism, which
will cause the program to fail.
If the index given by the scalar function is then used to dispatch further
parallel work, whose result is returned into Exp
terms by array indexing
operations such as (!
) or the
, the program will fail with the error:
'./Data/Array/Accelerate/Trafo/Sharing.hs:447 (convertSharingExp): inconsistent valuation @ shared 'Exp' tree ...'.
replicate :: (Slice slix, Elt e) => Exp slix -> Acc (Array (SliceShape slix) e) -> Acc (Array (FullShape slix) e) Source
Replicate an array across one or more dimensions as specified by the generalised array index provided as the first argument.
For example, assuming arr
is a vector (one-dimensional array),
replicate (lift (Z :. (2::Int) :. All :. (3::Int))) arr
yields a three dimensional array, where arr
is replicated twice across the
first and three times across the third dimension.
fill :: (Shape sh, Elt e) => Exp sh -> Exp e -> Acc (Array sh e) Source
Create an array where all elements are the same value.
Enumeration
enumFromN :: (Shape sh, Elt e, IsNum e) => Exp sh -> Exp e -> Acc (Array sh e) Source
Create an array of the given shape containing the values x, x+1, etc (in row-major order).
Create an array of the given shape containing the values x
, x+y
,
x+y+y
etc. (in row-major order).
Concatenation
(++) :: forall sh e. (Slice sh, Shape sh, Elt e) => Acc (Array (sh :. Int) e) -> Acc (Array (sh :. Int) e) -> Acc (Array (sh :. Int) e) infixr 5 Source
Concatenate outermost component of two arrays. The extent of the lower dimensional component is the intersection of the two arrays.
Composition
Flow control
An array-level if-then-else construct.
awhile :: Arrays a => (Acc a -> Acc (Scalar Bool)) -> (Acc a -> Acc a) -> Acc a -> Acc a Source
An array-level while construct
Pipelining
(>->) :: (Arrays a, Arrays b, Arrays c) => (Acc a -> Acc b) -> (Acc b -> Acc c) -> Acc a -> Acc c infixl 1 Source
Pipelining of two array computations.
Denotationally, we have
(acc1 >-> acc2) arrs = let tmp = acc1 arrs in acc2 tmp
Modifying Arrays
Shape manipulation
reshape :: (Shape ix, Shape ix', Elt e) => Exp ix -> Acc (Array ix' e) -> Acc (Array ix e) Source
Change the shape of an array without altering its contents. The size
of
the source and result arrays must be identical.
precondition: size ix == size ix'
flatten :: (Shape ix, Elt a) => Acc (Array ix a) -> Acc (Vector a) Source
Flattens a given array of arbitrary dimension.
Permutations
:: (Shape ix, Shape ix', Elt a) | |
=> (Exp a -> Exp a -> Exp a) | combination function |
-> Acc (Array ix' a) | array of default values |
-> (Exp ix -> Exp ix') | permutation |
-> Acc (Array ix a) | array to be permuted |
-> Acc (Array ix' a) |
Forward permutation specified by an index mapping. The result array is initialised with the given defaults and any further values that are permuted into the result array are added to the current value using the given combination function.
The combination function must be associative and commutative. Elements
that are mapped to the magic value ignore
by the permutation function are
dropped.
:: (Shape ix, Shape ix', Elt a) | |
=> Exp ix' | shape of the result array |
-> (Exp ix' -> Exp ix) | permutation |
-> Acc (Array ix a) | source array |
-> Acc (Array ix' a) |
Backward permutation specified by an index mapping from the destination array specifying which element of the source array to read.
ignore :: Shape ix => Exp ix Source
Magic value identifying elements that are ignored in a forward permutation. Note that this currently does not work for singleton arrays.
Specialised permutations
transpose :: Elt e => Acc (Array DIM2 e) -> Acc (Array DIM2 e) Source
Transpose the rows and columns of a matrix.
Element-wise operations
Mapping
map :: (Shape ix, Elt a, Elt b) => (Exp a -> Exp b) -> Acc (Array ix a) -> Acc (Array ix b) Source
Apply the given function element-wise to the given array.
Zipping
zipWith :: (Shape ix, Elt a, Elt b, Elt c) => (Exp a -> Exp b -> Exp c) -> Acc (Array ix a) -> Acc (Array ix b) -> Acc (Array ix c) Source
Apply the given binary function element-wise to the two arrays. The extent of the resulting array is the intersection of the extents of the two source arrays.
zipWith3 :: (Shape sh, Elt a, Elt b, Elt c, Elt d) => (Exp a -> Exp b -> Exp c -> Exp d) -> Acc (Array sh a) -> Acc (Array sh b) -> Acc (Array sh c) -> Acc (Array sh d) Source
Zip three arrays with the given function, analogous to zipWith
.
zipWith4 :: (Shape sh, Elt a, Elt b, Elt c, Elt d, Elt e) => (Exp a -> Exp b -> Exp c -> Exp d -> Exp e) -> Acc (Array sh a) -> Acc (Array sh b) -> Acc (Array sh c) -> Acc (Array sh d) -> Acc (Array sh e) Source
Zip four arrays with the given function, analogous to zipWith
.
zipWith5 :: (Shape sh, Elt a, Elt b, Elt c, Elt d, Elt e, Elt f) => (Exp a -> Exp b -> Exp c -> Exp d -> Exp e -> Exp f) -> Acc (Array sh a) -> Acc (Array sh b) -> Acc (Array sh c) -> Acc (Array sh d) -> Acc (Array sh e) -> Acc (Array sh f) Source
Zip five arrays with the given function, analogous to zipWith
.
zipWith6 :: (Shape sh, Elt a, Elt b, Elt c, Elt d, Elt e, Elt f, Elt g) => (Exp a -> Exp b -> Exp c -> Exp d -> Exp e -> Exp f -> Exp g) -> Acc (Array sh a) -> Acc (Array sh b) -> Acc (Array sh c) -> Acc (Array sh d) -> Acc (Array sh e) -> Acc (Array sh f) -> Acc (Array sh g) Source
Zip six arrays with the given function, analogous to zipWith
.
zipWith7 :: (Shape sh, Elt a, Elt b, Elt c, Elt d, Elt e, Elt f, Elt g, Elt h) => (Exp a -> Exp b -> Exp c -> Exp d -> Exp e -> Exp f -> Exp g -> Exp h) -> Acc (Array sh a) -> Acc (Array sh b) -> Acc (Array sh c) -> Acc (Array sh d) -> Acc (Array sh e) -> Acc (Array sh f) -> Acc (Array sh g) -> Acc (Array sh h) Source
Zip seven arrays with the given function, analogous to zipWith
.
zipWith8 :: (Shape sh, Elt a, Elt b, Elt c, Elt d, Elt e, Elt f, Elt g, Elt h, Elt i) => (Exp a -> Exp b -> Exp c -> Exp d -> Exp e -> Exp f -> Exp g -> Exp h -> Exp i) -> Acc (Array sh a) -> Acc (Array sh b) -> Acc (Array sh c) -> Acc (Array sh d) -> Acc (Array sh e) -> Acc (Array sh f) -> Acc (Array sh g) -> Acc (Array sh h) -> Acc (Array sh i) Source
Zip eight arrays with the given function, analogous to zipWith
.
zipWith9 :: (Shape sh, Elt a, Elt b, Elt c, Elt d, Elt e, Elt f, Elt g, Elt h, Elt i, Elt j) => (Exp a -> Exp b -> Exp c -> Exp d -> Exp e -> Exp f -> Exp g -> Exp h -> Exp i -> Exp j) -> Acc (Array sh a) -> Acc (Array sh b) -> Acc (Array sh c) -> Acc (Array sh d) -> Acc (Array sh e) -> Acc (Array sh f) -> Acc (Array sh g) -> Acc (Array sh h) -> Acc (Array sh i) -> Acc (Array sh j) Source
Zip nine arrays with the given function, analogous to zipWith
.
zip :: (Shape sh, Elt a, Elt b) => Acc (Array sh a) -> Acc (Array sh b) -> Acc (Array sh (a, b)) Source
Combine the elements of two arrays pairwise. The shape of the result is the intersection of the two argument shapes.
zip3 :: (Shape sh, Elt a, Elt b, Elt c) => Acc (Array sh a) -> Acc (Array sh b) -> Acc (Array sh c) -> Acc (Array sh (a, b, c)) Source
Take three arrays and return an array of triples, analogous to zip.
zip4 :: (Shape sh, Elt a, Elt b, Elt c, Elt d) => Acc (Array sh a) -> Acc (Array sh b) -> Acc (Array sh c) -> Acc (Array sh d) -> Acc (Array sh (a, b, c, d)) Source
Take four arrays and return an array of quadruples, analogous to zip.
zip5 :: (Shape sh, Elt a, Elt b, Elt c, Elt d, Elt e) => Acc (Array sh a) -> Acc (Array sh b) -> Acc (Array sh c) -> Acc (Array sh d) -> Acc (Array sh e) -> Acc (Array sh (a, b, c, d, e)) Source
Take five arrays and return an array of five-tuples, analogous to zip.
zip6 :: (Shape sh, Elt a, Elt b, Elt c, Elt d, Elt e, Elt f) => Acc (Array sh a) -> Acc (Array sh b) -> Acc (Array sh c) -> Acc (Array sh d) -> Acc (Array sh e) -> Acc (Array sh f) -> Acc (Array sh (a, b, c, d, e, f)) Source
Take six arrays and return an array of six-tuples, analogous to zip.
zip7 :: (Shape sh, Elt a, Elt b, Elt c, Elt d, Elt e, Elt f, Elt g) => Acc (Array sh a) -> Acc (Array sh b) -> Acc (Array sh c) -> Acc (Array sh d) -> Acc (Array sh e) -> Acc (Array sh f) -> Acc (Array sh g) -> Acc (Array sh (a, b, c, d, e, f, g)) Source
Take seven arrays and return an array of seven-tuples, analogous to zip.
zip8 :: (Shape sh, Elt a, Elt b, Elt c, Elt d, Elt e, Elt f, Elt g, Elt h) => Acc (Array sh a) -> Acc (Array sh b) -> Acc (Array sh c) -> Acc (Array sh d) -> Acc (Array sh e) -> Acc (Array sh f) -> Acc (Array sh g) -> Acc (Array sh h) -> Acc (Array sh (a, b, c, d, e, f, g, h)) Source
Take seven arrays and return an array of seven-tuples, analogous to zip.
zip9 :: (Shape sh, Elt a, Elt b, Elt c, Elt d, Elt e, Elt f, Elt g, Elt h, Elt i) => Acc (Array sh a) -> Acc (Array sh b) -> Acc (Array sh c) -> Acc (Array sh d) -> Acc (Array sh e) -> Acc (Array sh f) -> Acc (Array sh g) -> Acc (Array sh h) -> Acc (Array sh i) -> Acc (Array sh (a, b, c, d, e, f, g, h, i)) Source
Take seven arrays and return an array of seven-tuples, analogous to zip.
Unzipping
unzip :: (Shape sh, Elt a, Elt b) => Acc (Array sh (a, b)) -> (Acc (Array sh a), Acc (Array sh b)) Source
The converse of zip
, but the shape of the two results is identical to the
shape of the argument.
unzip3 :: (Shape sh, Elt a, Elt b, Elt c) => Acc (Array sh (a, b, c)) -> (Acc (Array sh a), Acc (Array sh b), Acc (Array sh c)) Source
Take an array of triples and return three arrays, analogous to unzip.
unzip4 :: (Shape sh, Elt a, Elt b, Elt c, Elt d) => Acc (Array sh (a, b, c, d)) -> (Acc (Array sh a), Acc (Array sh b), Acc (Array sh c), Acc (Array sh d)) Source
Take an array of quadruples and return four arrays, analogous to unzip.
unzip5 :: (Shape sh, Elt a, Elt b, Elt c, Elt d, Elt e) => Acc (Array sh (a, b, c, d, e)) -> (Acc (Array sh a), Acc (Array sh b), Acc (Array sh c), Acc (Array sh d), Acc (Array sh e)) Source
Take an array of 5-tuples and return five arrays, analogous to unzip.
unzip6 :: (Shape sh, Elt a, Elt b, Elt c, Elt d, Elt e, Elt f) => Acc (Array sh (a, b, c, d, e, f)) -> (Acc (Array sh a), Acc (Array sh b), Acc (Array sh c), Acc (Array sh d), Acc (Array sh e), Acc (Array sh f)) Source
Take an array of 6-tuples and return six arrays, analogous to unzip.
unzip7 :: (Shape sh, Elt a, Elt b, Elt c, Elt d, Elt e, Elt f, Elt g) => Acc (Array sh (a, b, c, d, e, f, g)) -> (Acc (Array sh a), Acc (Array sh b), Acc (Array sh c), Acc (Array sh d), Acc (Array sh e), Acc (Array sh f), Acc (Array sh g)) Source
Take an array of 7-tuples and return seven arrays, analogous to unzip.
unzip8 :: (Shape sh, Elt a, Elt b, Elt c, Elt d, Elt e, Elt f, Elt g, Elt h) => Acc (Array sh (a, b, c, d, e, f, g, h)) -> (Acc (Array sh a), Acc (Array sh b), Acc (Array sh c), Acc (Array sh d), Acc (Array sh e), Acc (Array sh f), Acc (Array sh g), Acc (Array sh h)) Source
Take an array of 8-tuples and return eight arrays, analogous to unzip.
unzip9 :: (Shape sh, Elt a, Elt b, Elt c, Elt d, Elt e, Elt f, Elt g, Elt h, Elt i) => Acc (Array sh (a, b, c, d, e, f, g, h, i)) -> (Acc (Array sh a), Acc (Array sh b), Acc (Array sh c), Acc (Array sh d), Acc (Array sh e), Acc (Array sh f), Acc (Array sh g), Acc (Array sh h), Acc (Array sh i)) Source
Take an array of 8-tuples and return eight arrays, analogous to unzip.
Working with predicates
Filtering
filter :: Elt a => (Exp a -> Exp Bool) -> Acc (Vector a) -> Acc (Vector a) Source
Drop elements that do not satisfy the predicate
Scatter
:: Elt e | |
=> Acc (Vector Int) | index mapping |
-> Acc (Vector e) | default |
-> Acc (Vector e) | input |
-> Acc (Vector e) | output |
Copy elements from source array to destination array according to an index
mapping. This is a forward-permute operation where a to
vector encodes an
input to output index mapping. Output elements for indices that are not
mapped assume the default vector's value.
For example:
default = [0, 0, 0, 0, 0, 0, 0, 0, 0] to = [1, 3, 7, 2, 5, 8] input = [1, 9, 6, 4, 4, 2, 5] output = [0, 1, 4, 9, 0, 4, 0, 6, 2]
Note if the same index appears in the index mapping more than once, the
result is undefined. It does not makes sense for the to
vector to be
larger than the input
vector.
:: (Elt e, Elt e') | |
=> Acc (Vector Int) | index mapping |
-> Acc (Vector e) | mask |
-> (Exp e -> Exp Bool) | predicate |
-> Acc (Vector e') | default |
-> Acc (Vector e') | input |
-> Acc (Vector e') | output |
Conditionally copy elements from source array to destination array according
to an index mapping. This is a forward-permute operation where a to
vector encodes an input to output index mapping. In addition, there is a
mask
vector, and an associated predicate function. The mapping will only
occur if the predicate function applied to the mask at that position
resolves to True
. If not copied, the output array assumes the default
vector's value.
For example:
default = [0, 0, 0, 0, 0, 0, 0, 0, 0] to = [1, 3, 7, 2, 5, 8] mask = [3, 4, 9, 2, 7, 5] pred = (>* 4) input = [1, 9, 6, 4, 4, 2, 5] output = [0, 0, 0, 0, 0, 4, 0, 6, 2]
Note if the same index appears in the mapping more than once, the result is
undefined. The to
and mask
vectors must be the same length. It does not
make sense for these to be larger than the input
vector.
Gather
Copy elements from source array to destination array according to a map. This
is a backpermute operation where a map
vector encodes the output to input
index mapping.
For example:
input = [1, 9, 6, 4, 4, 2, 0, 1, 2] from = [1, 3, 7, 2, 5, 3] output = [9, 4, 1, 6, 2, 4]
:: (Elt e, Elt e') | |
=> Acc (Vector Int) | index mapping |
-> Acc (Vector e) | mask |
-> (Exp e -> Exp Bool) | predicate |
-> Acc (Vector e') | default |
-> Acc (Vector e') | input |
-> Acc (Vector e') | output |
Conditionally copy elements from source array to destination array according
to an index mapping. This is a backpermute operation where a from
vector
encodes the output to input index mapping. In addition, there is a mask
vector, and an associated predication function, that specifies whether an
element will be copied. If not copied, the output array assumes the default
vector's value.
For example:
default = [6, 6, 6, 6, 6, 6] from = [1, 3, 7, 2, 5, 3] mask = [3, 4, 9, 2, 7, 5] pred = (>* 4) input = [1, 9, 6, 4, 4, 2, 0, 1, 2] output = [6, 6, 1, 6, 2, 4]
Folding
fold :: (Shape ix, Elt a) => (Exp a -> Exp a -> Exp a) -> Exp a -> Acc (Array (ix :. Int) a) -> Acc (Array ix a) Source
Reduction of the innermost dimension of an array of arbitrary rank. The first argument needs to be an associative function to enable an efficient parallel implementation.
fold1 :: (Shape ix, Elt a) => (Exp a -> Exp a -> Exp a) -> Acc (Array (ix :. Int) a) -> Acc (Array ix a) Source
Variant of fold
that requires the reduced array to be non-empty and
doesn't need an default value. The first argument needs to be an
associative function to enable an efficient parallel implementation.
foldAll :: (Shape sh, Elt a) => (Exp a -> Exp a -> Exp a) -> Exp a -> Acc (Array sh a) -> Acc (Scalar a) Source
Reduction of an array of arbitrary rank to a single scalar value.
fold1All :: (Shape sh, Elt a) => (Exp a -> Exp a -> Exp a) -> Acc (Array sh a) -> Acc (Scalar a) Source
Variant of foldAll
that requires the reduced array to be non-empty and
doesn't need an default value.
Segmented reductions
foldSeg :: (Shape ix, Elt a, Elt i, IsIntegral i) => (Exp a -> Exp a -> Exp a) -> Exp a -> Acc (Array (ix :. Int) a) -> Acc (Segments i) -> Acc (Array (ix :. Int) a) Source
Segmented reduction along the innermost dimension. Performs one individual reduction per segment of the source array. These reductions proceed in parallel.
The source array must have at least rank 1. The Segments
array determines
the lengths of the logical sub-arrays, each of which is folded separately.
fold1Seg :: (Shape ix, Elt a, Elt i, IsIntegral i) => (Exp a -> Exp a -> Exp a) -> Acc (Array (ix :. Int) a) -> Acc (Segments i) -> Acc (Array (ix :. Int) a) Source
Specialised folds
all :: (Shape sh, Elt e) => (Exp e -> Exp Bool) -> Acc (Array sh e) -> Acc (Scalar Bool) Source
Check if all elements satisfy a predicate
any :: (Shape sh, Elt e) => (Exp e -> Exp Bool) -> Acc (Array sh e) -> Acc (Scalar Bool) Source
Check if any element satisfies the predicate
sum :: (Shape sh, Elt e, IsNum e) => Acc (Array sh e) -> Acc (Scalar e) Source
Compute the sum of elements
product :: (Shape sh, Elt e, IsNum e) => Acc (Array sh e) -> Acc (Scalar e) Source
Compute the product of the elements
minimum :: (Shape sh, Elt e, IsScalar e) => Acc (Array sh e) -> Acc (Scalar e) Source
Yield the minimum element of an array. The array must not be empty.
maximum :: (Shape sh, Elt e, IsScalar e) => Acc (Array sh e) -> Acc (Scalar e) Source
Yield the maximum element of an array. The array must not be empty.
Prefix sums (scans)
scanl :: Elt a => (Exp a -> Exp a -> Exp a) -> Exp a -> Acc (Vector a) -> Acc (Vector a) Source
Data.List style left-to-right scan, but with the additional restriction that the first argument needs to be an associative function to enable an efficient parallel implementation. The initial value (second argument) may be arbitrary.
scanl1 :: Elt a => (Exp a -> Exp a -> Exp a) -> Acc (Vector a) -> Acc (Vector a) Source
Data.List style left-to-right scan without an initial value (aka inclusive scan). Again, the first argument needs to be an associative function. Denotationally, we have
scanl1 f e arr = tail (scanl f e arr)
scanl' :: Elt a => (Exp a -> Exp a -> Exp a) -> Exp a -> Acc (Vector a) -> (Acc (Vector a), Acc (Scalar a)) Source
Variant of scanl
, where the final result of the reduction is returned
separately. Denotationally, we have
scanl' f e arr = (init res, unit (res!len)) where len = shape arr res = scanl f e arr
scanr :: Elt a => (Exp a -> Exp a -> Exp a) -> Exp a -> Acc (Vector a) -> Acc (Vector a) Source
Right-to-left variant of scanl
.
scanr1 :: Elt a => (Exp a -> Exp a -> Exp a) -> Acc (Vector a) -> Acc (Vector a) Source
Right-to-left variant of scanl1
.
scanr' :: Elt a => (Exp a -> Exp a -> Exp a) -> Exp a -> Acc (Vector a) -> (Acc (Vector a), Acc (Scalar a)) Source
Right-to-left variant of scanl'
.
prescanl :: Elt a => (Exp a -> Exp a -> Exp a) -> Exp a -> Acc (Vector a) -> Acc (Vector a) Source
Left-to-right prescan (aka exclusive scan). As for scan
, the first argument must be an
associative function. Denotationally, we have
prescanl f e = Prelude.fst . scanl' f e
postscanl :: Elt a => (Exp a -> Exp a -> Exp a) -> Exp a -> Acc (Vector a) -> Acc (Vector a) Source
Left-to-right postscan, a variant of scanl1
with an initial value. Denotationally, we have
postscanl f e = map (e `f`) . scanl1 f
prescanr :: Elt a => (Exp a -> Exp a -> Exp a) -> Exp a -> Acc (Vector a) -> Acc (Vector a) Source
Right-to-left prescan (aka exclusive scan). As for scan
, the first argument must be an
associative function. Denotationally, we have
prescanr f e = Prelude.fst . scanr' f e
postscanr :: Elt a => (Exp a -> Exp a -> Exp a) -> Exp a -> Acc (Vector a) -> Acc (Vector a) Source
Right-to-left postscan, a variant of scanr1
with an initial value. Denotationally, we have
postscanr f e = map (e `f`) . scanr1 f
Segmented scans
scanlSeg :: (Elt a, Elt i, IsIntegral i) => (Exp a -> Exp a -> Exp a) -> Exp a -> Acc (Vector a) -> Acc (Segments i) -> Acc (Vector a) Source
Segmented version of scanl
scanl1Seg :: (Elt a, Elt i, IsIntegral i) => (Exp a -> Exp a -> Exp a) -> Acc (Vector a) -> Acc (Segments i) -> Acc (Vector a) Source
Segmented version of scanl1
.
scanl'Seg :: forall a i. (Elt a, Elt i, IsIntegral i) => (Exp a -> Exp a -> Exp a) -> Exp a -> Acc (Vector a) -> Acc (Segments i) -> Acc (Vector a, Vector a) Source
Segmented version of scanl'
The first element of the resulting tuple is a vector of scanned values. The second element is a vector of segment scan totals and has the same size as the segment vector.
prescanlSeg :: (Elt a, Elt i, IsIntegral i) => (Exp a -> Exp a -> Exp a) -> Exp a -> Acc (Vector a) -> Acc (Segments i) -> Acc (Vector a) Source
Segmented version of prescanl
.
postscanlSeg :: (Elt a, Elt i, IsIntegral i) => (Exp a -> Exp a -> Exp a) -> Exp a -> Acc (Vector a) -> Acc (Segments i) -> Acc (Vector a) Source
Segmented version of postscanl
.
scanrSeg :: (Elt a, Elt i, IsIntegral i) => (Exp a -> Exp a -> Exp a) -> Exp a -> Acc (Vector a) -> Acc (Segments i) -> Acc (Vector a) Source
Segmented version of scanr
.
scanr1Seg :: (Elt a, Elt i, IsIntegral i) => (Exp a -> Exp a -> Exp a) -> Acc (Vector a) -> Acc (Segments i) -> Acc (Vector a) Source
Segmented version of scanr1
.
scanr'Seg :: forall a i. (Elt a, Elt i, IsIntegral i) => (Exp a -> Exp a -> Exp a) -> Exp a -> Acc (Vector a) -> Acc (Segments i) -> Acc (Vector a, Vector a) Source
Segmented version of scanr'
.
prescanrSeg :: (Elt a, Elt i, IsIntegral i) => (Exp a -> Exp a -> Exp a) -> Exp a -> Acc (Vector a) -> Acc (Segments i) -> Acc (Vector a) Source
Segmented version of prescanr
.
postscanrSeg :: (Elt a, Elt i, IsIntegral i) => (Exp a -> Exp a -> Exp a) -> Exp a -> Acc (Vector a) -> Acc (Segments i) -> Acc (Vector a) Source
Segmented version of postscanr
.
Stencil
:: (Shape ix, Elt a, Elt b, Stencil ix a stencil) | |
=> (stencil -> Exp b) | stencil function |
-> Boundary a | boundary condition |
-> Acc (Array ix a) | source array |
-> Acc (Array ix b) | destination array |
Map a stencil over an array. In contrast to map
, the domain of a stencil function is an
entire neighbourhood of each array element. Neighbourhoods are sub-arrays centred around a
focal point. They are not necessarily rectangular, but they are symmetric in each dimension
and have an extent of at least three in each dimensions — due to the symmetry requirement, the
extent is necessarily odd. The focal point is the array position that is determined by the
stencil.
For those array positions where the neighbourhood extends past the boundaries of the source array, a boundary condition determines the contents of the out-of-bounds neighbourhood positions.
:: (Shape ix, Elt a, Elt b, Elt c, Stencil ix a stencil1, Stencil ix b stencil2) | |
=> (stencil1 -> stencil2 -> Exp c) | binary stencil function |
-> Boundary a | boundary condition #1 |
-> Acc (Array ix a) | source array #1 |
-> Boundary b | boundary condition #2 |
-> Acc (Array ix b) | source array #2 |
-> Acc (Array ix c) | destination array |
Map a binary stencil of an array. The extent of the resulting array is the intersection of the extents of the two source arrays.
Specification
class (Elt (StencilRepr sh stencil), Stencil sh a (StencilRepr sh stencil)) => Stencil sh a stencil Source
stencilPrj
Elt e => Stencil DIM1 e (Exp e, Exp e, Exp e) | |
Elt e => Stencil DIM1 e (Exp e, Exp e, Exp e, Exp e, Exp e) | |
Elt e => Stencil DIM1 e (Exp e, Exp e, Exp e, Exp e, Exp e, Exp e, Exp e) | |
Elt e => Stencil DIM1 e (Exp e, Exp e, Exp e, Exp e, Exp e, Exp e, Exp e, Exp e, Exp e) | |
(Stencil ((:.) sh Int) a row2, Stencil ((:.) sh Int) a row1, Stencil ((:.) sh Int) a row0) => Stencil ((:.) ((:.) sh Int) Int) a (row2, row1, row0) | |
(Stencil ((:.) sh Int) a row1, Stencil ((:.) sh Int) a row2, Stencil ((:.) sh Int) a row3, Stencil ((:.) sh Int) a row4, Stencil ((:.) sh Int) a row5) => Stencil ((:.) ((:.) sh Int) Int) a (row1, row2, row3, row4, row5) | |
(Stencil ((:.) sh Int) a row1, Stencil ((:.) sh Int) a row2, Stencil ((:.) sh Int) a row3, Stencil ((:.) sh Int) a row4, Stencil ((:.) sh Int) a row5, Stencil ((:.) sh Int) a row6, Stencil ((:.) sh Int) a row7) => Stencil ((:.) ((:.) sh Int) Int) a (row1, row2, row3, row4, row5, row6, row7) | |
(Stencil ((:.) sh Int) a row1, Stencil ((:.) sh Int) a row2, Stencil ((:.) sh Int) a row3, Stencil ((:.) sh Int) a row4, Stencil ((:.) sh Int) a row5, Stencil ((:.) sh Int) a row6, Stencil ((:.) sh Int) a row7, Stencil ((:.) sh Int) a row8, Stencil ((:.) sh Int) a row9) => Stencil ((:.) ((:.) sh Int) Int) a (row1, row2, row3, row4, row5, row6, row7, row8, row9) |
Boundary condition specification for stencil operations.
Common stencil patterns
type Stencil3x3 a = (Stencil3 a, Stencil3 a, Stencil3 a) Source
type Stencil5x3 a = (Stencil5 a, Stencil5 a, Stencil5 a) Source
type Stencil3x3x3 a = (Stencil3x3 a, Stencil3x3 a, Stencil3x3 a) Source
type Stencil5x3x3 a = (Stencil5x3 a, Stencil5x3 a, Stencil5x3 a) Source
type Stencil3x5x3 a = (Stencil3x5 a, Stencil3x5 a, Stencil3x5 a) Source
type Stencil3x3x5 a = (Stencil3x3 a, Stencil3x3 a, Stencil3x3 a, Stencil3x3 a, Stencil3x3 a) Source
type Stencil5x5x3 a = (Stencil5x5 a, Stencil5x5 a, Stencil5x5 a) Source
type Stencil5x3x5 a = (Stencil5x3 a, Stencil5x3 a, Stencil5x3 a, Stencil5x3 a, Stencil5x3 a) Source
type Stencil3x5x5 a = (Stencil3x5 a, Stencil3x5 a, Stencil3x5 a, Stencil3x5 a, Stencil3x5 a) Source
type Stencil5x5x5 a = (Stencil5x5 a, Stencil5x5 a, Stencil5x5 a, Stencil5x5 a, Stencil5x5 a) Source
Foreign
foreignAcc :: (Arrays acc, Arrays res, Foreign ff) => ff acc res -> (Acc acc -> Acc res) -> Acc acc -> Acc res Source
Call a foreign function. The form the function takes is dependent on the backend being used. The arguments are passed as either a single array or as a tuple of arrays. In addition a pure Accelerate version of the function needs to be provided to support backends other than the one being targeted.
foreignAcc2 :: (Arrays acc, Arrays res, Foreign ff1, Foreign ff2) => ff1 acc res -> ff2 acc res -> (Acc acc -> Acc res) -> Acc acc -> Acc res Source
Call a foreign function with foreign implementations for two different backends.
foreignAcc3 :: (Arrays acc, Arrays res, Foreign ff1, Foreign ff2, Foreign ff3) => ff1 acc res -> ff2 acc res -> ff3 acc res -> (Acc acc -> Acc res) -> Acc acc -> Acc res Source
Call a foreign function with foreign implementations for three different backends.
foreignExp :: (Elt e, Elt res, Foreign ff) => ff e res -> (Exp e -> Exp res) -> Exp e -> Exp res Source
Call a foreign expression function. The form the function takes is dependent on the backend being used. The arguments are passed as either a single scalar element or as a tuple of elements. In addition a pure Accelerate version of the function needs to be provided to support backends other than the one being targeted.
foreignExp2 :: (Elt e, Elt res, Foreign ff1, Foreign ff2) => ff1 e res -> ff2 e res -> (Exp e -> Exp res) -> Exp e -> Exp res Source
Call a foreign function with foreign implementations for two different backends.
foreignExp3 :: (Elt e, Elt res, Foreign ff1, Foreign ff2, Foreign ff3) => ff1 e res -> ff2 e res -> ff3 e res -> (Exp e -> Exp res) -> Exp e -> Exp res Source
Call a foreign function with foreign implementations for three different backends.
The Accelerate Expression Language
Scalar data types
Scalar expressions for plain array computations.
Type classes
class Typeable a => IsScalar a Source
All scalar type
scalarType
Bounded types
boundedType
class (IsScalar a, IsNum a, IsBounded a) => IsIntegral a Source
Integral types
integralType
Non-numeric types
nonNumType
Element types
data Int :: *
A fixed-precision integer type with at least the range [-2^29 .. 2^29-1]
.
The exact range for a given implementation can be determined by using
minBound
and maxBound
from the Bounded
class.
data Int8 :: *
8-bit signed integer type
Bounded Int8 | |
Enum Int8 | |
Eq Int8 | |
Integral Int8 | |
Data Int8 | |
Num Int8 | |
Ord Int8 | |
Read Int8 | |
Real Int8 | |
Show Int8 | |
Ix Int8 | |
PrintfArg Int8 | |
Storable Int8 | |
Bits Int8 | |
FiniteBits Int8 | |
Hashable Int8 | |
Unbox Int8 | |
IsScalar Int8 | |
IsBounded Int8 | |
IsNum Int8 | |
IsIntegral Int8 | |
Elt Int8 | |
Typeable * Int8 | |
IArray UArray Int8 | |
Vector Vector Int8 | |
MVector MVector Int8 | |
Lift Exp Int8 | |
MArray (STUArray s) Int8 (ST s) | |
data Vector Int8 = V_Int8 (Vector Int8) | |
type Plain Int8 = Int8 | |
data MVector s Int8 = MV_Int8 (MVector s Int8) |
data Int16 :: *
16-bit signed integer type
Bounded Int16 | |
Enum Int16 | |
Eq Int16 | |
Integral Int16 | |
Data Int16 | |
Num Int16 | |
Ord Int16 | |
Read Int16 | |
Real Int16 | |
Show Int16 | |
Ix Int16 | |
PrintfArg Int16 | |
Storable Int16 | |
Bits Int16 | |
FiniteBits Int16 | |
Hashable Int16 | |
Unbox Int16 | |
IsScalar Int16 | |
IsBounded Int16 | |
IsNum Int16 | |
IsIntegral Int16 | |
Elt Int16 | |
Typeable * Int16 | |
IArray UArray Int16 | |
Vector Vector Int16 | |
MVector MVector Int16 | |
Lift Exp Int16 | |
MArray (STUArray s) Int16 (ST s) | |
data Vector Int16 = V_Int16 (Vector Int16) | |
type Plain Int16 = Int16 | |
data MVector s Int16 = MV_Int16 (MVector s Int16) |
data Int32 :: *
32-bit signed integer type
Bounded Int32 | |
Enum Int32 | |
Eq Int32 | |
Integral Int32 | |
Data Int32 | |
Num Int32 | |
Ord Int32 | |
Read Int32 | |
Real Int32 | |
Show Int32 | |
Ix Int32 | |
PrintfArg Int32 | |
Storable Int32 | |
Bits Int32 | |
FiniteBits Int32 | |
Hashable Int32 | |
Unbox Int32 | |
IsScalar Int32 | |
IsBounded Int32 | |
IsNum Int32 | |
IsIntegral Int32 | |
Elt Int32 | |
Typeable * Int32 | |
IArray UArray Int32 | |
Vector Vector Int32 | |
MVector MVector Int32 | |
Lift Exp Int32 | |
MArray (STUArray s) Int32 (ST s) | |
data Vector Int32 = V_Int32 (Vector Int32) | |
type Plain Int32 = Int32 | |
data MVector s Int32 = MV_Int32 (MVector s Int32) |
data Int64 :: *
64-bit signed integer type
Bounded Int64 | |
Enum Int64 | |
Eq Int64 | |
Integral Int64 | |
Data Int64 | |
Num Int64 | |
Ord Int64 | |
Read Int64 | |
Real Int64 | |
Show Int64 | |
Ix Int64 | |
PrintfArg Int64 | |
Storable Int64 | |
Bits Int64 | |
FiniteBits Int64 | |
Hashable Int64 | |
Unbox Int64 | |
IsScalar Int64 | |
IsBounded Int64 | |
IsNum Int64 | |
IsIntegral Int64 | |
Elt Int64 | |
Typeable * Int64 | |
IArray UArray Int64 | |
Vector Vector Int64 | |
MVector MVector Int64 | |
Lift Exp Int64 | |
MArray (STUArray s) Int64 (ST s) | |
data Vector Int64 = V_Int64 (Vector Int64) | |
type Plain Int64 = Int64 | |
data MVector s Int64 = MV_Int64 (MVector s Int64) |
data Word :: *
Bounded Word | |
Enum Word | |
Eq Word | |
Integral Word | |
Data Word | |
Num Word | |
Ord Word | |
Read Word | |
Real Word | |
Show Word | |
Ix Word | |
PrintfArg Word | |
Storable Word | |
Bits Word | |
FiniteBits Word | |
Hashable Word | |
Unbox Word | |
IsScalar Word | |
IsBounded Word | |
IsNum Word | |
IsIntegral Word | |
Elt Word | |
Typeable * Word | |
IArray UArray Word | |
Vector Vector Word | |
MVector MVector Word | |
Lift Exp Word | |
MArray (STUArray s) Word (ST s) | |
data Vector Word = V_Word (Vector Word) | |
type Plain Word = Word | |
data MVector s Word = MV_Word (MVector s Word) |
data Word8 :: *
8-bit unsigned integer type
Bounded Word8 | |
Enum Word8 | |
Eq Word8 | |
Integral Word8 | |
Data Word8 | |
Num Word8 | |
Ord Word8 | |
Read Word8 | |
Real Word8 | |
Show Word8 | |
Ix Word8 | |
PrintfArg Word8 | |
Storable Word8 | |
Bits Word8 | |
FiniteBits Word8 | |
Hashable Word8 | |
Unbox Word8 | |
IsScalar Word8 | |
IsBounded Word8 | |
IsNum Word8 | |
IsIntegral Word8 | |
Elt Word8 | |
Typeable * Word8 | |
IArray UArray Word8 | |
Vector Vector Word8 | |
MVector MVector Word8 | |
Lift Exp Word8 | |
MArray (STUArray s) Word8 (ST s) | |
data Vector Word8 = V_Word8 (Vector Word8) | |
type Plain Word8 = Word8 | |
data MVector s Word8 = MV_Word8 (MVector s Word8) |
data Word16 :: *
16-bit unsigned integer type
Bounded Word16 | |
Enum Word16 | |
Eq Word16 | |
Integral Word16 | |
Data Word16 | |
Num Word16 | |
Ord Word16 | |
Read Word16 | |
Real Word16 | |
Show Word16 | |
Ix Word16 | |
PrintfArg Word16 | |
Storable Word16 | |
Bits Word16 | |
FiniteBits Word16 | |
Hashable Word16 | |
Unbox Word16 | |
IsScalar Word16 | |
IsBounded Word16 | |
IsNum Word16 | |
IsIntegral Word16 | |
Elt Word16 | |
Typeable * Word16 | |
IArray UArray Word16 | |
Vector Vector Word16 | |
MVector MVector Word16 | |
Lift Exp Word16 | |
MArray (STUArray s) Word16 (ST s) | |
data Vector Word16 = V_Word16 (Vector Word16) | |
type Plain Word16 = Word16 | |
data MVector s Word16 = MV_Word16 (MVector s Word16) |
data Word32 :: *
32-bit unsigned integer type
Bounded Word32 | |
Enum Word32 | |
Eq Word32 | |
Integral Word32 | |
Data Word32 | |
Num Word32 | |
Ord Word32 | |
Read Word32 | |
Real Word32 | |
Show Word32 | |
Ix Word32 | |
PrintfArg Word32 | |
Storable Word32 | |
Bits Word32 | |
FiniteBits Word32 | |
Hashable Word32 | |
Unbox Word32 | |
IsScalar Word32 | |
IsBounded Word32 | |
IsNum Word32 | |
IsIntegral Word32 | |
Elt Word32 | |
Typeable * Word32 | |
IArray UArray Word32 | |
Vector Vector Word32 | |
MVector MVector Word32 | |
Lift Exp Word32 | |
MArray (STUArray s) Word32 (ST s) | |
data Vector Word32 = V_Word32 (Vector Word32) | |
type Plain Word32 = Word32 | |
data MVector s Word32 = MV_Word32 (MVector s Word32) |
data Word64 :: *
64-bit unsigned integer type
Bounded Word64 | |
Enum Word64 | |
Eq Word64 | |
Integral Word64 | |
Data Word64 | |
Num Word64 | |
Ord Word64 | |
Read Word64 | |
Real Word64 | |
Show Word64 | |
Ix Word64 | |
PrintfArg Word64 | |
Storable Word64 | |
Bits Word64 | |
FiniteBits Word64 | |
Hashable Word64 | |
Unbox Word64 | |
IsScalar Word64 | |
IsBounded Word64 | |
IsNum Word64 | |
IsIntegral Word64 | |
Elt Word64 | |
Typeable * Word64 | |
IArray UArray Word64 | |
Vector Vector Word64 | |
MVector MVector Word64 | |
Lift Exp Word64 | |
MArray (STUArray s) Word64 (ST s) | |
data Vector Word64 = V_Word64 (Vector Word64) | |
type Plain Word64 = Word64 | |
data MVector s Word64 = MV_Word64 (MVector s Word64) |
data CShort :: *
Haskell type representing the C short
type.
data CUShort :: *
Haskell type representing the C unsigned short
type.
data CInt :: *
Haskell type representing the C int
type.
data CUInt :: *
Haskell type representing the C unsigned int
type.
data CLong :: *
Haskell type representing the C long
type.
data CULong :: *
Haskell type representing the C unsigned long
type.
data CLLong :: *
Haskell type representing the C long long
type.
data CULLong :: *
Haskell type representing the C unsigned long long
type.
data Float :: *
Single-precision floating point numbers. It is desirable that this type be at least equal in range and precision to the IEEE single-precision type.
Enum Float | |
Eq Float | |
Floating Float | |
Fractional Float | |
Data Float | |
Num Float | |
Ord Float | |
Read Float | |
Real Float | |
RealFloat Float | |
RealFrac Float | |
Show Float | |
Generic Float | |
PrintfArg Float | |
Storable Float | |
Hashable Float | |
Unbox Float | |
IsScalar Float | |
IsNum Float | |
IsFloating Float | |
Elt Float | |
Typeable * Float | |
IArray UArray Float | |
Vector Vector Float | |
MVector MVector Float | |
Lift Exp Float | |
MArray (STUArray s) Float (ST s) | |
type Rep Float = D1 D_Float (C1 C_Float (S1 NoSelector (Rec0 Float))) | |
data Vector Float = V_Float (Vector Float) | |
type Plain Float = Float | |
data MVector s Float = MV_Float (MVector s Float) |
data Double :: *
Double-precision floating point numbers. It is desirable that this type be at least equal in range and precision to the IEEE double-precision type.
Enum Double | |
Eq Double | |
Floating Double | |
Fractional Double | |
Data Double | |
Num Double | |
Ord Double | |
Read Double | |
Real Double | |
RealFloat Double | |
RealFrac Double | |
Show Double | |
Generic Double | |
PrintfArg Double | |
Storable Double | |
Hashable Double | |
Unbox Double | |
IsScalar Double | |
IsNum Double | |
IsFloating Double | |
Elt Double | |
Typeable * Double | |
IArray UArray Double | |
Vector Vector Double | |
MVector MVector Double | |
Lift Exp Double | |
MArray (STUArray s) Double (ST s) | |
type Rep Double = D1 D_Double (C1 C_Double (S1 NoSelector (Rec0 Double))) | |
data Vector Double = V_Double (Vector Double) | |
type Plain Double = Double | |
data MVector s Double = MV_Double (MVector s Double) |
data CFloat :: *
Haskell type representing the C float
type.
data CDouble :: *
Haskell type representing the C double
type.
data Bool :: *
Bounded Bool | |
Enum Bool | |
Eq Bool | |
Data Bool | |
Ord Bool | |
Read Bool | |
Show Bool | |
Ix Bool | |
Generic Bool | |
Storable Bool | |
Bits Bool | |
FiniteBits Bool | |
Hashable Bool | |
Lift Bool | |
Unbox Bool | |
IsScalar Bool | |
IsBounded Bool | |
IsNonNum Bool | |
Elt Bool | |
Typeable * Bool | |
IArray UArray Bool | |
Vector Vector Bool | |
MVector MVector Bool | |
Lift Exp Bool | |
MArray (STUArray s) Bool (ST s) | |
type Rep Bool = D1 D1Bool ((:+:) (C1 C1_0Bool U1) (C1 C1_1Bool U1)) | |
data Vector Bool = V_Bool (Vector Word8) | |
type Plain Bool = Bool | |
data MVector s Bool = MV_Bool (MVector s Word8) | |
type (==) Bool a b = EqBool a b |
data Char :: *
The character type Char
is an enumeration whose values represent
Unicode (or equivalently ISO/IEC 10646) characters (see
http://www.unicode.org/ for details). This set extends the ISO 8859-1
(Latin-1) character set (the first 256 characters), which is itself an extension
of the ASCII character set (the first 128 characters). A character literal in
Haskell has type Char
.
To convert a Char
to or from the corresponding Int
value defined
by Unicode, use toEnum
and fromEnum
from the
Enum
class respectively (or equivalently ord
and chr
).
Bounded Char | |
Enum Char | |
Eq Char | |
Data Char | |
Ord Char | |
Read Char | |
Show Char | |
Ix Char | |
Generic Char | |
PrintfArg Char | |
IsChar Char | |
Storable Char | |
Hashable Char | |
Lift Char | |
ErrorList Char | |
Unbox Char | |
IsScalar Char | |
IsBounded Char | |
IsNonNum Char | |
Elt Char | |
Typeable * Char | |
IArray UArray Char | |
Vector Vector Char | |
MVector MVector Char | |
Lift Exp Char | |
MArray (STUArray s) Char (ST s) | |
type Rep Char = D1 D_Char (C1 C_Char (S1 NoSelector (Rec0 Char))) | |
data Vector Char = V_Char (Vector Char) | |
type Plain Char = Char | |
data MVector s Char = MV_Char (MVector s Char) |
data CChar :: *
Haskell type representing the C char
type.
data CSChar :: *
Haskell type representing the C signed char
type.
data CUChar :: *
Haskell type representing the C unsigned char
type.
Lifting and Unlifting
A value of type Int
is a plain Haskell value (unlifted), whereas an
Exp Int
is a lifted value, that is, an integer lifted into the domain
of expressions (an abstract syntax tree in disguise). Both Acc
and Exp
are surface types into which values may be lifted. Lifting plain array
and scalar surface types is equivalent to use
and constant
respectively.
In general an Exp Int
cannot be unlifted into an Int
, because the
actual number will not be available until a later stage of execution (e.g.
during GPU execution, when run
is called). Similarly an Acc array
can
not be unlifted to a vanilla array
; you should instead run
the
expression with a specific backend to evaluate it.
Lifting and unlifting are also used to pack and unpack an expression into and out of constructors such as tuples, respectively. Those expressions, at runtime, will become tuple dereferences. For example:
Exp (Z :. Int :. Int) -> unlift :: (Z :. Exp Int :. Exp Int) -> lift :: Exp (Z :. Int :. Int) -> ...
Acc (Scalar Int, Vector Float) -> unlift :: (Acc (Scalar Int), Acc (Vector Float)) -> lift :: Acc (Scalar Int, Vector Float) -> ...
The class of types e
which can be lifted into c
.
An associated-type (i.e. a type-level function) that strips all
instances of surface type constructors c
from the input type e
.
For example, the tuple types (Exp Int, Int)
and (Int, Exp
Int)
have the same "Plain" representation. That is, the
following type equality holds:
Plain (Exp Int, Int) ~ (Int,Int) ~ Plain (Int, Exp Int)
class Lift c e => Unlift c e where Source
A limited subset of types which can be lifted, can also be unlifted.
unlift :: c (Plain e) -> e Source
Unlift the outermost constructor through the surface type. This is only possible if the constructor is fully determined by its type - i.e., it is a singleton.
lift1 :: (Unlift Exp e1, Lift Exp e2) => (e1 -> e2) -> Exp (Plain e1) -> Exp (Plain e2) Source
Lift a unary function into Exp
.
lift2 :: (Unlift Exp e1, Unlift Exp e2, Lift Exp e3) => (e1 -> e2 -> e3) -> Exp (Plain e1) -> Exp (Plain e2) -> Exp (Plain e3) Source
Lift a binary function into Exp
.
ilift1 :: (Exp Int -> Exp Int) -> Exp DIM1 -> Exp DIM1 Source
Lift a unary function to a computation over rank-1 indices.
ilift2 :: (Exp Int -> Exp Int -> Exp Int) -> Exp DIM1 -> Exp DIM1 -> Exp DIM1 Source
Lift a binary function to a computation over rank-1 indices.
Operations
Some of the standard Haskell 98 typeclass functions need to be reimplemented because their types change. If so, function names kept the same and infix operations are suffixed by an asterisk. If not reimplemented here, the standard typeclass instances apply.
Introduction
constant :: Elt t => t -> Exp t Source
Scalar expression inlet: make a Haskell value available for processing in an Accelerate scalar expression.
Note that this embeds the value directly into the expression. Depending on the backend used to execute the computation, this might not always be desirable. For example, a backend that does external code generation may embed this constant directly into the generated code, which means new code will need to be generated and compiled every time the value changes. In such cases, consider instead lifting scalar values into (singleton) arrays so that they can be passed as an input to the computation and thus the value can change without the need to generate fresh code.
Tuples
fst :: forall a b. (Elt a, Elt b) => Exp (a, b) -> Exp a Source
Extract the first component of a scalar pair.
afst :: forall a b. (Arrays a, Arrays b) => Acc (a, b) -> Acc a Source
Extract the first component of an array pair.
snd :: forall a b. (Elt a, Elt b) => Exp (a, b) -> Exp b Source
Extract the second component of a scalar pair.
asnd :: forall a b. (Arrays a, Arrays b) => Acc (a, b) -> Acc b Source
Extract the second component of an array pair
curry :: Lift f (f a, f b) => (f (Plain (f a), Plain (f b)) -> f c) -> f a -> f b -> f c Source
Converts an uncurried function to a curried function.
uncurry :: Unlift f (f a, f b) => (f a -> f b -> f c) -> f (Plain (f a), Plain (f b)) -> f c Source
Converts a curried function to a function on pairs.
Flow control
:: (Elt a, Elt b) | |
=> Exp a | case subject |
-> [(Exp a -> Exp Bool, Exp b)] | list of cases to attempt |
-> Exp b | default value |
-> Exp b |
A case-like control structure
A scalar-level if-then-else construct.
while :: Elt e => (Exp e -> Exp Bool) -> (Exp e -> Exp e) -> Exp e -> Exp e Source
While construct. Continue to apply the given function, starting with the initial value, until the test function evaluates to true.
iterate :: forall a. Elt a => Exp Int -> (Exp a -> Exp a) -> Exp a -> Exp a Source
Repeatedly apply a function a fixed number of times
Scalar reduction
sfoldl :: forall sh a b. (Shape sh, Slice sh, Elt a, Elt b) => (Exp a -> Exp b -> Exp a) -> Exp a -> Exp sh -> Acc (Array (sh :. Int) b) -> Exp a Source
Reduce along an innermost slice of an array sequentially, by applying a binary operator to a starting value and the array from left to right.
Basic operations
(==*) :: (Elt t, IsScalar t) => Exp t -> Exp t -> Exp Bool infix 4 Source
Equality lifted into Accelerate expressions.
(/=*) :: (Elt t, IsScalar t) => Exp t -> Exp t -> Exp Bool infix 4 Source
Inequality lifted into Accelerate expressions.
(<*) :: (Elt t, IsScalar t) => Exp t -> Exp t -> Exp Bool infix 4 Source
Smaller-than lifted into Accelerate expressions.
(<=*) :: (Elt t, IsScalar t) => Exp t -> Exp t -> Exp Bool infix 4 Source
Smaller-or-equal lifted into Accelerate expressions.
(>*) :: (Elt t, IsScalar t) => Exp t -> Exp t -> Exp Bool infix 4 Source
Greater-than lifted into Accelerate expressions.
(>=*) :: (Elt t, IsScalar t) => Exp t -> Exp t -> Exp Bool infix 4 Source
Greater-or-equal lifted into Accelerate expressions.
Numeric functions
truncate :: (Elt a, Elt b, IsFloating a, IsIntegral b) => Exp a -> Exp b Source
truncate x
returns the integer nearest x
between zero and x
.
round :: (Elt a, Elt b, IsFloating a, IsIntegral b) => Exp a -> Exp b Source
round x
returns the nearest integer to x
, or the even integer if x
is
equidistant between two integers.
floor :: (Elt a, Elt b, IsFloating a, IsIntegral b) => Exp a -> Exp b Source
floor x
returns the greatest integer not greater than x
.
ceiling :: (Elt a, Elt b, IsFloating a, IsIntegral b) => Exp a -> Exp b Source
ceiling x
returns the least integer not less than x
.
Bitwise functions
bit :: (Elt t, IsIntegral t) => Exp Int -> Exp t Source
bit i
is a value with the i
th bit set and all other bits clear
setBit :: (Elt t, IsIntegral t) => Exp t -> Exp Int -> Exp t Source
x `setBit` i
is the same as x .|. bit i
clearBit :: (Elt t, IsIntegral t) => Exp t -> Exp Int -> Exp t Source
x `clearBit` i
is the same as x .&. complement (bit i)
complementBit :: (Elt t, IsIntegral t) => Exp t -> Exp Int -> Exp t Source
x `complementBit` i
is the same as x `xor` bit i
testBit :: (Elt t, IsIntegral t) => Exp t -> Exp Int -> Exp Bool Source
Return True
if the n
th bit of the argument is 1
shift :: (Elt t, IsIntegral t) => Exp t -> Exp Int -> Exp t Source
shifts shift
x ix
left by i
bits if i
is positive, or right by
-i
bits otherwise. Right shifts perform sign extension on signed number
types; i.e. they fill the top bits with 1 if the x
is negative and with 0
otherwise.
shiftL :: (Elt t, IsIntegral t) => Exp t -> Exp Int -> Exp t Source
Shift the argument left by the specified number of bits (which must be non-negative).
shiftR :: (Elt t, IsIntegral t) => Exp t -> Exp Int -> Exp t Source
Shift the first argument right by the specified number of bits. The result
is undefined for negative shift amounts and shift amounts greater or equal to
the bitSize
.
Right shifts perform sign extension on signed number types; i.e. they fill
the top bits with 1 if the x
is negative and with 0 otherwise.
rotate :: (Elt t, IsIntegral t) => Exp t -> Exp Int -> Exp t Source
rotates rotate
x ix
left by i
bits if i
is positive, or right by
-i
bits otherwise.
rotateL :: (Elt t, IsIntegral t) => Exp t -> Exp Int -> Exp t Source
Rotate the argument left by the specified number of bits (which must be non-negative).
rotateR :: (Elt t, IsIntegral t) => Exp t -> Exp Int -> Exp t Source
Rotate the argument right by the specified number of bits (which must be non-negative).
Shape manipulation
index1 :: Elt i => Exp i -> Exp (Z :. i) Source
Turn an Int
expression into a rank-1 indexing expression.
unindex1 :: Elt i => Exp (Z :. i) -> Exp i Source
Turn a rank-1 indexing expression into an Int
expression.
index2 :: (Elt i, Slice (Z :. i)) => Exp i -> Exp i -> Exp ((Z :. i) :. i) Source
Creates a rank-2 index from two Exp Int`s
unindex2 :: forall i. (Elt i, Slice (Z :. i)) => Exp ((Z :. i) :. i) -> Exp (i, i) Source
Destructs a rank-2 index to an Exp tuple of two Int`s.
indexTail :: Slice sh => Exp (sh :. Int) -> Exp sh Source
Get all but the outermost element of a shape
toIndex :: Shape sh => Exp sh -> Exp sh -> Exp Int Source
Map a multi-dimensional index into a linear, row-major representation of an array. The first argument is the array shape, the second is the index.
Conversions
boolToInt :: Exp Bool -> Exp Int Source
Convert a Boolean value to an Int
, where False
turns into '0' and True
into '1'.
fromIntegral :: (Elt a, Elt b, IsIntegral a, IsNum b) => Exp a -> Exp b Source
General coercion from integral types
Plain arrays
Operations
arrayShape :: Shape sh => Array sh e -> sh Source
Array shape in plain Haskell code.
indexArray :: Array sh e -> sh -> e Source
Array indexing in plain Haskell code.
Conversions
For additional conversion routines, see the accelerate-io package: http://hackage.haskell.org/package/accelerate-io
Function
fromFunction :: (Shape sh, Elt e) => sh -> (sh -> e) -> Array sh e Source
Create an array from its representation function.
Lists
fromList :: (Shape sh, Elt e) => sh -> [e] -> Array sh e Source
Convert a list, with elements in row-major order, into an accelerated array.
toList :: forall sh e. Array sh e -> [e] Source
Convert an accelerated array to a list in row-major order.
IArray
fromIArray :: (EltRepr ix ~ EltRepr sh, IArray a e, Ix ix, Shape sh, Elt ix, Elt e) => a ix e -> Array sh e Source
Convert an IArray
to an accelerated array.
While the type signature mentions Accelerate internals that are not exported,
in practice satisfying the type equality is straight forward. The index type
ix
must be the unit type ()
for singleton arrays, or an Int
or tuple of
Int
's for multidimensional arrays.