yarr-1.4.0.2: Yet another array library

Safe HaskellNone
LanguageHaskell98

Data.Yarr.Shape

Contents

Synopsis

Flow types hierarchy

type Work sh a Source #

Arguments

 = sh

Lower bound

-> sh

Upper bound

-> IO a

Result

Abstracts interval works: Fills, Walks.

To be passed to functions from Data.Yarr.Utils.Fork module or called directly.

type Walk sh a Source #

Arguments

 = sh

Lower bound (start for left walks, end for right ones)

-> sh

Upper bound (end or start)

-> IO a

Result

Curried version of StatefulWalk. Identical to Work, indeed.

type Fill sh a Source #

Arguments

 = (sh -> IO a)

Indexing function

-> (sh -> a -> IO ())

Writing function

-> Work sh ()

Curried result function -- worker

Alias to frequently used get-write-from-to arguments combo.

To be passed as 1st parameter of all Loading functions from Data.Yarr.Eval module.

type StatefulWalk sh a s Source #

Arguments

 = IO s

Initial state

-> (sh -> IO a)

Indexing function

-> Walk sh s

Curried result function -- walker, emits final state

Generalizes both partially applied left and right folds, as well as walks with mutable state.

To be passed to walk runners from Data.Yarr.Walk module.

type Foldl sh a b Source #

Arguments

 = (b -> sh -> a -> IO b)

Generalized left reduce

-> StatefulWalk sh a b

Curried result stateful walk

Generalizes left folds.

To be passed to fold combinators from Data.Yarr.Walk module.

type Foldr sh a b Source #

Arguments

 = (sh -> a -> b -> IO b)

Generalized right reduce

-> StatefulWalk sh a b

Curried result stateful walk

Generalizes right folds.

To be passed to fold combinators from Data.Yarr.Walk module.

Shape and BlockShape

type Block sh = (sh, sh) Source #

Mainly for internal use. Abstracts top-left -- bottom-right pair of indices.

class (Eq sh, Bounded sh, Show sh, NFData sh) => Shape sh where Source #

Class for column-major, regular composite array indices.

Methods

zero :: sh Source #

0, (0, 0), (0, 0, 0)

size :: sh -> Int Source #

Dim1 size is id, size (3, 5) == 15

inc :: sh -> sh Source #

plus :: sh -> sh -> sh Source #

(1, 2, 3) `plus` (0, 0, 1) == (1, 2, 4)

minus :: sh -> sh -> sh Source #

(1, 2) `minus` (1, 0) == (0, 2)

offset :: sh -> sh -> sh Source #

offset == flip minus

fromLinear :: sh -> Int -> sh Source #

Converts linear, memory index of shaped array to shape index without bound checks.

fromLinear (3, 4) 5 == (1, 1)

toLinear :: sh -> sh -> Int Source #

Opposite to fromLinear, converts composite array index to linear, "memory" index without bounds checks.

id for Dim1 shapes.

toLinear (5, 5) (3, 0) == 15

intersect :: (Arity n, n ~ S n0) => VecList n sh -> sh Source #

Component-wise minimum, returns maximum legal index for all given array extents

complement :: (Arity n, n ~ S n0) => VecList n sh -> sh Source #

Component-wise maximum, used in Data.Yarr.Convolution implementation.

intersectBlocks :: (Arity n, n ~ S n0) => VecList n (Block sh) -> Block sh Source #

blockSize :: Block sh -> Int Source #

insideBlock :: Block sh -> sh -> Bool Source #

makeChunkRange :: Int -> sh -> sh -> Int -> Block sh Source #

foldl :: Foldl sh a b Source #

Standard left fold wothout unrolling.

This one and 5 following functions shouldn't be called directly, they are intented to be passed as first argument to Load and functions from Data.Yarr.Work module.

unrolledFoldl :: forall a b uf. Arity uf => uf -> (a -> IO ()) -> Foldl sh a b Source #

foldr :: Foldr sh a b Source #

Standard right folding function without unrolling.

unrolledFoldr :: forall a b uf. Arity uf => uf -> (a -> IO ()) -> Foldr sh a b Source #

fill :: Fill sh a Source #

Standard fill without unrolling. To avoid premature optimization just type fill each time you want to Load array to manifest representation.

unrolledFill :: forall a uf. Arity uf => uf -> (a -> IO ()) -> Fill sh a Source #

Instances

Shape Dim3 Source # 

Methods

zero :: Dim3 Source #

size :: Dim3 -> Int Source #

inc :: Dim3 -> Dim3 Source #

plus :: Dim3 -> Dim3 -> Dim3 Source #

minus :: Dim3 -> Dim3 -> Dim3 Source #

offset :: Dim3 -> Dim3 -> Dim3 Source #

fromLinear :: Dim3 -> Int -> Dim3 Source #

toLinear :: Dim3 -> Dim3 -> Int Source #

intersect :: (Arity n, (* ~ n) (S n0)) => VecList n Dim3 -> Dim3 Source #

complement :: (Arity n, (* ~ n) (S n0)) => VecList n Dim3 -> Dim3 Source #

intersectBlocks :: (Arity n, (* ~ n) (S n0)) => VecList n (Block Dim3) -> Block Dim3 Source #

blockSize :: Block Dim3 -> Int Source #

insideBlock :: Block Dim3 -> Dim3 -> Bool Source #

makeChunkRange :: Int -> Dim3 -> Dim3 -> Int -> Block Dim3 Source #

foldl :: Foldl Dim3 a b Source #

unrolledFoldl :: Arity uf => uf -> (a -> IO ()) -> Foldl Dim3 a b Source #

foldr :: Foldr Dim3 a b Source #

unrolledFoldr :: Arity uf => uf -> (a -> IO ()) -> Foldr Dim3 a b Source #

fill :: Fill Dim3 a Source #

unrolledFill :: Arity uf => uf -> (a -> IO ()) -> Fill Dim3 a Source #

Shape Dim2 Source # 

Methods

zero :: Dim2 Source #

size :: Dim2 -> Int Source #

inc :: Dim2 -> Dim2 Source #

plus :: Dim2 -> Dim2 -> Dim2 Source #

minus :: Dim2 -> Dim2 -> Dim2 Source #

offset :: Dim2 -> Dim2 -> Dim2 Source #

fromLinear :: Dim2 -> Int -> Dim2 Source #

toLinear :: Dim2 -> Dim2 -> Int Source #

intersect :: (Arity n, (* ~ n) (S n0)) => VecList n Dim2 -> Dim2 Source #

complement :: (Arity n, (* ~ n) (S n0)) => VecList n Dim2 -> Dim2 Source #

intersectBlocks :: (Arity n, (* ~ n) (S n0)) => VecList n (Block Dim2) -> Block Dim2 Source #

blockSize :: Block Dim2 -> Int Source #

insideBlock :: Block Dim2 -> Dim2 -> Bool Source #

makeChunkRange :: Int -> Dim2 -> Dim2 -> Int -> Block Dim2 Source #

foldl :: Foldl Dim2 a b Source #

unrolledFoldl :: Arity uf => uf -> (a -> IO ()) -> Foldl Dim2 a b Source #

foldr :: Foldr Dim2 a b Source #

unrolledFoldr :: Arity uf => uf -> (a -> IO ()) -> Foldr Dim2 a b Source #

fill :: Fill Dim2 a Source #

unrolledFill :: Arity uf => uf -> (a -> IO ()) -> Fill Dim2 a Source #

Shape Dim1 Source # 

Methods

zero :: Dim1 Source #

size :: Dim1 -> Int Source #

inc :: Dim1 -> Dim1 Source #

plus :: Dim1 -> Dim1 -> Dim1 Source #

minus :: Dim1 -> Dim1 -> Dim1 Source #

offset :: Dim1 -> Dim1 -> Dim1 Source #

fromLinear :: Dim1 -> Int -> Dim1 Source #

toLinear :: Dim1 -> Dim1 -> Int Source #

intersect :: (Arity n, (* ~ n) (S n0)) => VecList n Dim1 -> Dim1 Source #

complement :: (Arity n, (* ~ n) (S n0)) => VecList n Dim1 -> Dim1 Source #

intersectBlocks :: (Arity n, (* ~ n) (S n0)) => VecList n (Block Dim1) -> Block Dim1 Source #

blockSize :: Block Dim1 -> Int Source #

insideBlock :: Block Dim1 -> Dim1 -> Bool Source #

makeChunkRange :: Int -> Dim1 -> Dim1 -> Int -> Block Dim1 Source #

foldl :: Foldl Dim1 a b Source #

unrolledFoldl :: Arity uf => uf -> (a -> IO ()) -> Foldl Dim1 a b Source #

foldr :: Foldr Dim1 a b Source #

unrolledFoldr :: Arity uf => uf -> (a -> IO ()) -> Foldr Dim1 a b Source #

fill :: Fill Dim1 a Source #

unrolledFill :: Arity uf => uf -> (a -> IO ()) -> Fill Dim1 a Source #

class (Shape sh, Arity (BorderCount sh)) => BlockShape sh where Source #

For internal use.

TODO: implement for Dim3 and merge with Shape class

Minimal complete definition

clipBlock

Associated Types

type BorderCount sh Source #

Methods

clipBlock :: Block sh -> Block sh -> VecList (BorderCount sh) (Block sh) Source #

class (Shape sh, Shape lsh) => MultiShape sh lsh | sh -> lsh, lsh -> sh where Source #

Minimal complete definition

lower, inner, combine

Methods

lower :: sh -> lsh Source #

inner :: sh -> Int Source #

combine :: lsh -> Int -> sh Source #

Shape instances

type Dim1 = Int Source #

type Dim2 = (Int, Int) Source #

type Dim3 = (Int, Int, Int) Source #

Specialized flow

dim2BlockFill Source #

Arguments

:: (Arity bsx, Arity bsy) 
=> bsx

Block size by x. Use n1 - n8 values.

-> bsy

Block size by y

-> (a -> IO ())

touch or noTouch

-> Fill Dim2 a

Result curried function to be passed to loading functions.

2D-unrolled filling to maximize profit from "Global value numbering" LLVM optimization.

Example:

blurred <- compute (loadS (dim2BlockFill n1 n4 touch)) delayedBlurred

Touch functions

class Touchable a where Source #

Mainly used to fight against GHC simplifier, which gives no chance to LLVM to perform Global Value Numbering optimization.

Copied from repa, see http://hackage.haskell.org/packages/archive/repa/3.2.3.1/doc/html/Data-Array-Repa-Eval.html

Minimal complete definition

touch

Methods

touch :: a -> IO () Source #

The function intented to be passed as 3rd parameter to unrolled- functions in Shape class and dim2BlockFill.

If your loading operation is strictly local by elements (in most cases), use noTouch instead of this function.

Instances

Touchable Bool Source # 

Methods

touch :: Bool -> IO () Source #

Touchable Double Source # 

Methods

touch :: Double -> IO () Source #

Touchable Float Source # 

Methods

touch :: Float -> IO () Source #

Touchable Int Source # 

Methods

touch :: Int -> IO () Source #

Touchable Int8 Source # 

Methods

touch :: Int8 -> IO () Source #

Touchable Int16 Source # 

Methods

touch :: Int16 -> IO () Source #

Touchable Int32 Source # 

Methods

touch :: Int32 -> IO () Source #

Touchable Int64 Source # 

Methods

touch :: Int64 -> IO () Source #

Touchable Word Source # 

Methods

touch :: Word -> IO () Source #

Touchable Word8 Source # 

Methods

touch :: Word8 -> IO () Source #

Touchable Word16 Source # 

Methods

touch :: Word16 -> IO () Source #

Touchable Word32 Source # 

Methods

touch :: Word32 -> IO () Source #

Touchable Word64 Source # 

Methods

touch :: Word64 -> IO () Source #

(Vector v e, Touchable e) => Touchable (v e) Source # 

Methods

touch :: v e -> IO () Source #

noTouch :: a -> IO () Source #

Alias to (\_ -> return ()).