repa 3.2.5.1 → 3.4.2.0
raw patch · 27 files changed
Files
- Data/Array/Repa.hs +35/−35
- Data/Array/Repa/Arbitrary.hs +7/−5
- Data/Array/Repa/Eval/Chunked.hs +54/−54
- Data/Array/Repa/Eval/Cursored.hs +108/−108
- Data/Array/Repa/Eval/Elt.hs +46/−47
- Data/Array/Repa/Eval/Gang.hs +23/−23
- Data/Array/Repa/Eval/Reduction.hs +9/−10
- Data/Array/Repa/Eval/Selection.hs +74/−74
- Data/Array/Repa/Index.hs +80/−80
- Data/Array/Repa/Operators/IndexSpace.hs +54/−56
- Data/Array/Repa/Operators/Interleave.hs +58/−58
- Data/Array/Repa/Operators/Mapping.hs +6/−6
- Data/Array/Repa/Operators/Reduction.hs +58/−33
- Data/Array/Repa/Operators/Selection.hs +17/−17
- Data/Array/Repa/Operators/Traversal.hs +43/−42
- Data/Array/Repa/Repr/ByteString.hs +1/−2
- Data/Array/Repa/Repr/Unboxed.hs +4/−10
- Data/Array/Repa/Repr/Undefined.hs +1/−1
- Data/Array/Repa/Repr/Vector.hs +4/−6
- Data/Array/Repa/Shape.hs +44/−44
- Data/Array/Repa/Slice.hs +40/−40
- Data/Array/Repa/Specialised/Dim2.hs +43/−43
- Data/Array/Repa/Stencil.hs +4/−7
- Data/Array/Repa/Stencil/Base.hs +26/−26
- Data/Array/Repa/Stencil/Dim2.hs +106/−102
- Data/Array/Repa/Stencil/Template.hs +43/−43
- repa.cabal +43/−16
Data/Array/Repa.hs view
@@ -125,52 +125,52 @@ , fromUnboxed , toUnboxed - -- from Data.Array.Repa.Operators.IndexSpace ----------------+ -- from Data.Array.Repa.Operators.IndexSpace ---------------- -- * Operators- -- ** Index space transformations- , reshape- , append, (++)+ -- ** Index space transformations+ , reshape+ , append, (++) , extract- , transpose- , backpermute- , backpermuteDft+ , transpose+ , backpermute+ , backpermuteDft -- ** Slice transformations- , module Data.Array.Repa.Slice- , slice+ , module Data.Array.Repa.Slice+ , slice , extend - -- from Data.Array.Repa.Operators.Mapping -------------------+ -- from Data.Array.Repa.Operators.Mapping ------------------- -- ** Structure preserving operations- , map- , zipWith- , (+^), (-^), (*^), (/^)+ , map+ , zipWith+ , (+^), (-^), (*^), (/^) , Structured(..) - -- from Data.Array.Repa.Operators.Traversal ------------------- -- ** Generic traversal- , traverse - , traverse2- , traverse3- , traverse4- - -- from Data.Array.Repa.Operators.Interleave ------------------ -- ** Interleaving- , interleave2- , interleave3- , interleave4- - -- from Data.Array.Repa.Operators.Reduction ------------------- -- ** Reduction- , foldP, foldS- , foldAllP, foldAllS- , sumP, sumS- , sumAllP, sumAllS+ -- from Data.Array.Repa.Operators.Traversal ------------------+ -- ** Generic traversal+ , traverse + , traverse2+ , traverse3+ , traverse4+ + -- from Data.Array.Repa.Operators.Interleave -----------------+ -- ** Interleaving+ , interleave2+ , interleave3+ , interleave4+ + -- from Data.Array.Repa.Operators.Reduction ------------------+ -- ** Reduction+ , foldP, foldS+ , foldAllP, foldAllS+ , sumP, sumS+ , sumAllP, sumAllS , equalsP, equalsS- - -- from Data.Array.Repa.Operators.Selection ------------------+ + -- from Data.Array.Repa.Operators.Selection ------------------ -- ** Selection- , selectP)+ , selectP) where import Data.Array.Repa.Base import Data.Array.Repa.Shape
Data/Array/Repa/Arbitrary.hs view
@@ -38,12 +38,14 @@ -- Note: this is a shape that is "sized", and then random array for a given -- shape is generated.-instance (Shape a, Arbitrary a) => Arbitrary (a :. Int) where+instance Arbitrary a + => Arbitrary (a :. Int) where arbitrary = sized (\n -> do - b <- choose (1, n)- let dimLimit :: Int = ceiling (fromIntegral n / fromIntegral b :: Double)- a <- resize dimLimit arbitrary+ b <- if n == 0+ then return 1+ else choose (1, n)+ a <- resize ((n + b - 1) `div` b) arbitrary -- each dimension should be at least 1-wide return $ a :. b) @@ -70,7 +72,7 @@ instance CoArbitrary Z where coarbitrary _ = id -instance (Shape a, CoArbitrary a) +instance (CoArbitrary a) => CoArbitrary (a :. Int) where coarbitrary (a :. b) = coarbitrary a . coarbitrary b
Data/Array/Repa/Eval/Chunked.hs view
@@ -2,16 +2,16 @@ -- | Evaluate an array by breaking it up into linear chunks and filling -- each chunk in parallel. module Data.Array.Repa.Eval.Chunked- ( fillLinearS+ ( fillLinearS , fillBlock2S , fillChunkedP- , fillChunkedIOP)+ , fillChunkedIOP) where import Data.Array.Repa.Index import Data.Array.Repa.Eval.Gang import GHC.Exts-import Prelude as P+import Prelude as P ------------------------------------------------------------------------------- -- | Fill something sequentially.@@ -19,20 +19,20 @@ -- * The array is filled linearly from start to finish. -- fillLinearS- :: Int -- ^ Number of elements.- -> (Int -> a -> IO ()) -- ^ Update function to write into result buffer.- -> (Int -> a) -- ^ Fn to get the value at a given index.- -> IO ()+ :: Int -- ^ Number of elements.+ -> (Int -> a -> IO ()) -- ^ Update function to write into result buffer.+ -> (Int -> a) -- ^ Fn to get the value at a given index.+ -> IO () fillLinearS !(I# len) write getElem = fill 0#- where fill !ix- | 1# <- ix >=# len+ where fill !ix+ | 1# <- ix >=# len = return () - | otherwise- = do write (I# ix) (getElem (I# ix))- fill (ix +# 1#)+ | otherwise+ = do write (I# ix) (getElem (I# ix))+ fill (ix +# 1#) {-# INLINE [0] fillLinearS #-} @@ -92,42 +92,42 @@ -- fillChunkedP :: Int -- ^ Number of elements.- -> (Int -> a -> IO ()) -- ^ Update function to write into result buffer.- -> (Int -> a) -- ^ Fn to get the value at a given index.- -> IO ()+ -> (Int -> a -> IO ()) -- ^ Update function to write into result buffer.+ -> (Int -> a) -- ^ Fn to get the value at a given index.+ -> IO () fillChunkedP !(I# len) write getElem- = gangIO theGang- $ \(I# thread) -> + = gangIO theGang+ $ \(I# thread) -> let !start = splitIx thread !end = splitIx (thread +# 1#) in fill start end where- -- Decide now to split the work across the threads.- -- If the length of the vector doesn't divide evenly among the threads,- -- then the first few get an extra element.- !(I# threads) = gangSize theGang- !chunkLen = len `quotInt#` threads- !chunkLeftover = len `remInt#` threads+ -- Decide now to split the work across the threads.+ -- If the length of the vector doesn't divide evenly among the threads,+ -- then the first few get an extra element.+ !(I# threads) = gangSize theGang+ !chunkLen = len `quotInt#` threads+ !chunkLeftover = len `remInt#` threads - {-# INLINE splitIx #-}- splitIx thread- | 1# <- thread <# chunkLeftover + {-# INLINE splitIx #-}+ splitIx thread+ | 1# <- thread <# chunkLeftover = thread *# (chunkLen +# 1#) - | otherwise + | otherwise = thread *# chunkLen +# chunkLeftover - -- Evaluate the elements of a single chunk.- {-# INLINE fill #-}- fill !ix !end- | 1# <- ix >=# end + -- Evaluate the elements of a single chunk.+ {-# INLINE fill #-}+ fill !ix !end+ | 1# <- ix >=# end = return () - | otherwise- = do write (I# ix) (getElem (I# ix))- fill (ix +# 1#) end+ | otherwise+ = do write (I# ix) (getElem (I# ix))+ fill (ix +# 1#) end {-# INLINE [0] fillChunkedP #-} @@ -148,24 +148,24 @@ -> IO () fillChunkedIOP !(I# len) write mkGetElem- = gangIO theGang- $ \(I# thread) -> + = gangIO theGang+ $ \(I# thread) -> let !start = splitIx thread !end = splitIx (thread +# 1#) in fillChunk thread start end where- -- Decide now to split the work across the threads.- -- If the length of the vector doesn't divide evenly among the threads,- -- then the first few get an extra element.- !(I# threads) = gangSize theGang- !chunkLen = len `quotInt#` threads- !chunkLeftover = len `remInt#` threads+ -- Decide now to split the work across the threads.+ -- If the length of the vector doesn't divide evenly among the threads,+ -- then the first few get an extra element.+ !(I# threads) = gangSize theGang+ !chunkLen = len `quotInt#` threads+ !chunkLeftover = len `remInt#` threads - {-# INLINE splitIx #-}- splitIx thread- | 1# <- thread <# chunkLeftover = thread *# (chunkLen +# 1#)- | otherwise = thread *# chunkLen +# chunkLeftover+ {-# INLINE splitIx #-}+ splitIx thread+ | 1# <- thread <# chunkLeftover = thread *# (chunkLen +# 1#)+ | otherwise = thread *# chunkLen +# chunkLeftover -- Given the threadId, starting and ending indices. -- Make a function to get each element for this chunk@@ -177,16 +177,16 @@ -- Call the provided getElem function for every element -- in a chunk, and feed the result to the write function.- {-# INLINE fill #-}- fill !getElem !ix0 !end- = go ix0 - where go !ix- | 1# <- ix >=# end+ {-# INLINE fill #-}+ fill !getElem !ix0 !end+ = go ix0 + where go !ix+ | 1# <- ix >=# end = return () - | otherwise- = do x <- getElem (I# ix)- write (I# ix) x+ | otherwise+ = do x <- getElem (I# ix)+ write (I# ix) x go (ix +# 1#) {-# INLINE [0] fillChunkedIOP #-}
Data/Array/Repa/Eval/Cursored.hs view
@@ -2,9 +2,9 @@ -- | Evaluate an array by dividing it into rectangular blocks and filling -- each block in parallel. module Data.Array.Repa.Eval.Cursored- ( fillBlock2P- , fillCursoredBlock2P- , fillCursoredBlock2S )+ ( fillBlock2P+ , fillCursoredBlock2P+ , fillCursoredBlock2S ) where import Data.Array.Repa.Index import Data.Array.Repa.Shape@@ -27,13 +27,13 @@ -- fillBlock2P :: Elt a- => (Int -> a -> IO ()) -- ^ Update function to write into result buffer.+ => (Int -> a -> IO ()) -- ^ Update function to write into result buffer. -> (DIM2 -> a) -- ^ Function to evaluate the element at an index.- -> Int# -- ^ Width of the whole array.- -> Int# -- ^ x0 lower left corner of block to fill- -> Int# -- ^ y0 - -> Int# -- ^ w0 width of block to fill.- -> Int# -- ^ h0 height of block to fill.+ -> Int# -- ^ Width of the whole array.+ -> Int# -- ^ x0 lower left corner of block to fill+ -> Int# -- ^ y0 + -> Int# -- ^ w0 width of block to fill.+ -> Int# -- ^ h0 height of block to fill. -> IO () {-# INLINE [0] fillBlock2P #-}@@ -54,13 +54,13 @@ -- fillBlock2S :: Elt a- => (Int -> a -> IO ()) -- ^ Update function to write into result buffer.+ => (Int -> a -> IO ()) -- ^ Update function to write into result buffer. -> (DIM2 -> a) -- ^ Function to evaluate the element at an index.- -> Int# -- ^ Width of the whole array.- -> Int# -- ^ x0 lower left corner of block to fill- -> Int# -- ^ y0- -> Int# -- ^ w0 width of block to fill- -> Int# -- ^ h0 height of block to filll+ -> Int# -- ^ Width of the whole array.+ -> Int# -- ^ x0 lower left corner of block to fill+ -> Int# -- ^ y0+ -> Int# -- ^ w0 width of block to fill+ -> Int# -- ^ h0 height of block to filll -> IO () {-# INLINE [0] fillBlock2S #-}@@ -85,51 +85,51 @@ -- * Each column is filled in row major order from top to bottom. -- fillCursoredBlock2P- :: Elt a- => (Int -> a -> IO ()) -- ^ Update function to write into result buffer.- -> (DIM2 -> cursor) -- ^ Make a cursor to a particular element.- -> (DIM2 -> cursor -> cursor) -- ^ Shift the cursor by an offset.- -> (cursor -> a) -- ^ Function to evaluate the element at an index.- -> Int# -- ^ Width of the whole array.- -> Int# -- ^ x0 lower left corner of block to fill- -> Int# -- ^ y0- -> Int# -- ^ w0 width of block to fill- -> Int# -- ^ h0 height of block to fill- -> IO ()+ :: Elt a+ => (Int -> a -> IO ()) -- ^ Update function to write into result buffer.+ -> (DIM2 -> cursor) -- ^ Make a cursor to a particular element.+ -> (DIM2 -> cursor -> cursor) -- ^ Shift the cursor by an offset.+ -> (cursor -> a) -- ^ Function to evaluate the element at an index.+ -> Int# -- ^ Width of the whole array.+ -> Int# -- ^ x0 lower left corner of block to fill+ -> Int# -- ^ y0+ -> Int# -- ^ w0 width of block to fill+ -> Int# -- ^ h0 height of block to fill+ -> IO () {-# INLINE [0] fillCursoredBlock2P #-} fillCursoredBlock2P- write- makeCursorFCB shiftCursorFCB getElemFCB- !imageWidth !x0 !y0 !w0 !h0- = gangIO theGang fillBlock- where + write+ makeCursorFCB shiftCursorFCB getElemFCB+ !imageWidth !x0 !y0 !w0 !h0+ = gangIO theGang fillBlock+ where !(I# threads) = gangSize theGang - -- All columns have at least this many pixels.- !colChunkLen = w0 `quotInt#` threads+ -- All columns have at least this many pixels.+ !colChunkLen = w0 `quotInt#` threads - -- Extra pixels that we have to divide between some of the threads.- !colChunkSlack = w0 `remInt#` threads+ -- Extra pixels that we have to divide between some of the threads.+ !colChunkSlack = w0 `remInt#` threads - -- Get the starting pixel of a column in the image.- {-# INLINE colIx #-}- colIx !ix- | 1# <- ix <# colChunkSlack = x0 +# (ix *# (colChunkLen +# 1#))- | otherwise = x0 +# (ix *# colChunkLen) +# colChunkSlack+ -- Get the starting pixel of a column in the image.+ {-# INLINE colIx #-}+ colIx !ix+ | 1# <- ix <# colChunkSlack = x0 +# (ix *# (colChunkLen +# 1#))+ | otherwise = x0 +# (ix *# colChunkLen) +# colChunkSlack - -- Give one column to each thread- {-# INLINE fillBlock #-}- fillBlock :: Int -> IO ()- fillBlock !(I# ix)- = let !x0' = colIx ix- !w0' = colIx (ix +# 1#) -# x0'- !y0' = y0- !h0' = h0- in fillCursoredBlock2S- write- makeCursorFCB shiftCursorFCB getElemFCB- imageWidth x0' y0' w0' h0'+ -- Give one column to each thread+ {-# INLINE fillBlock #-}+ fillBlock :: Int -> IO ()+ fillBlock !(I# ix)+ = let !x0' = colIx ix+ !w0' = colIx (ix +# 1#) -# x0'+ !y0' = y0+ !h0' = h0+ in fillCursoredBlock2S+ write+ makeCursorFCB shiftCursorFCB getElemFCB+ imageWidth x0' y0' w0' h0' -- | Fill a block in a rank-2 array, sequentially.@@ -144,74 +144,74 @@ -- * The block is filled in row major order from top to bottom. -- fillCursoredBlock2S- :: Elt a- => (Int -> a -> IO ()) -- ^ Update function to write into result buffer.- -> (DIM2 -> cursor) -- ^ Make a cursor to a particular element.- -> (DIM2 -> cursor -> cursor) -- ^ Shift the cursor by an offset.- -> (cursor -> a) -- ^ Function to evaluate an element at the given index.- -> Int# -- ^ Width of the whole array.- -> Int# -- ^ x0 lower left corner of block to fill.- -> Int# -- ^ y0- -> Int# -- ^ w0 width of block to fill- -> Int# -- ^ h0 height of block to fill- -> IO ()+ :: Elt a+ => (Int -> a -> IO ()) -- ^ Update function to write into result buffer.+ -> (DIM2 -> cursor) -- ^ Make a cursor to a particular element.+ -> (DIM2 -> cursor -> cursor) -- ^ Shift the cursor by an offset.+ -> (cursor -> a) -- ^ Function to evaluate an element at the given index.+ -> Int# -- ^ Width of the whole array.+ -> Int# -- ^ x0 lower left corner of block to fill.+ -> Int# -- ^ y0+ -> Int# -- ^ w0 width of block to fill+ -> Int# -- ^ h0 height of block to fill+ -> IO () {-# INLINE [0] fillCursoredBlock2S #-} fillCursoredBlock2S- write- makeCursor shiftCursor getElem- !imageWidth !x0 !y0 !w0 h0+ write+ makeCursor shiftCursor getElem+ !imageWidth !x0 !y0 !w0 h0 = do fillBlock y0- where !x1 = x0 +# w0+ where !x1 = x0 +# w0 !y1 = y0 +# h0 {-# INLINE fillBlock #-}- fillBlock !y- | 1# <- y >=# y1 = return ()- | otherwise- = do fillLine4 x0- fillBlock (y +# 1#)+ fillBlock !y+ | 1# <- y >=# y1 = return ()+ | otherwise+ = do fillLine4 x0+ fillBlock (y +# 1#) - where {-# INLINE fillLine4 #-}- fillLine4 !x- | 1# <- x +# 4# >=# x = fillLine1 x- | otherwise- = do -- Compute each source cursor based on the previous one so that- -- the variable live ranges in the generated code are shorter.- let srcCur0 = makeCursor (Z :. (I# y) :. (I# x))- let srcCur1 = shiftCursor (Z :. 0 :. 1) srcCur0- let srcCur2 = shiftCursor (Z :. 0 :. 1) srcCur1- let srcCur3 = shiftCursor (Z :. 0 :. 1) srcCur2+ where {-# INLINE fillLine4 #-}+ fillLine4 !x+ | 1# <- x +# 4# >=# x1 = fillLine1 x+ | otherwise+ = do -- Compute each source cursor based on the previous one so that+ -- the variable live ranges in the generated code are shorter.+ let srcCur0 = makeCursor (Z :. (I# y) :. (I# x))+ let srcCur1 = shiftCursor (Z :. 0 :. 1) srcCur0+ let srcCur2 = shiftCursor (Z :. 0 :. 1) srcCur1+ let srcCur3 = shiftCursor (Z :. 0 :. 1) srcCur2 - -- Get the result value for each cursor.- let val0 = getElem srcCur0- let val1 = getElem srcCur1- let val2 = getElem srcCur2- let val3 = getElem srcCur3+ -- Get the result value for each cursor.+ let val0 = getElem srcCur0+ let val1 = getElem srcCur1+ let val2 = getElem srcCur2+ let val3 = getElem srcCur3 - -- Ensure that we've computed each of the result values before we- -- write into the array. If the backend code generator can't tell- -- our destination array doesn't alias with the source then writing- -- to it can prevent the sharing of intermediate computations.- touch val0- touch val1- touch val2- touch val3+ -- Ensure that we've computed each of the result values before we+ -- write into the array. If the backend code generator can't tell+ -- our destination array doesn't alias with the source then writing+ -- to it can prevent the sharing of intermediate computations.+ touch val0+ touch val1+ touch val2+ touch val3 - -- Compute cursor into destination array.- let !dstCur0 = x +# (y *# imageWidth)- write (I# dstCur0) val0- write (I# (dstCur0 +# 1#)) val1- write (I# (dstCur0 +# 2#)) val2- write (I# (dstCur0 +# 3#)) val3- fillLine4 (x +# 4#)+ -- Compute cursor into destination array.+ let !dstCur0 = x +# (y *# imageWidth)+ write (I# dstCur0) val0+ write (I# (dstCur0 +# 1#)) val1+ write (I# (dstCur0 +# 2#)) val2+ write (I# (dstCur0 +# 3#)) val3+ fillLine4 (x +# 4#) - {-# INLINE fillLine1 #-}- fillLine1 !x- | 1# <- x >=# x1 = return ()- | otherwise- = do let val0 = (getElem $ makeCursor (Z :. (I# y) :. (I# x)))+ {-# INLINE fillLine1 #-}+ fillLine1 !x+ | 1# <- x >=# x1 = return ()+ | otherwise+ = do let val0 = (getElem $ makeCursor (Z :. (I# y) :. (I# x))) write (I# (x +# (y *# imageWidth))) val0- fillLine1 (x +# 1#)+ fillLine1 (x +# 1#)
Data/Array/Repa/Eval/Elt.hs view
@@ -2,9 +2,8 @@ {-# LANGUAGE MagicHash, UnboxedTuples, TypeSynonymInstances, FlexibleInstances #-} {-# LANGUAGE DefaultSignatures, FlexibleContexts, TypeOperators #-} module Data.Array.Repa.Eval.Elt- (Elt (..))+ (Elt (..)) where-import GHC.Prim import GHC.Exts import GHC.Types import GHC.Word@@ -113,7 +112,7 @@ {-# INLINE touch #-} touch b = IO (\state -> case touch# b state of- state' -> (# state', () #))+ state' -> (# state', () #)) {-# INLINE zero #-} zero = False@@ -125,9 +124,9 @@ -- Floating ------------------------------------------------------------------- instance Elt Float where {-# INLINE touch #-}- touch (F# f)+ touch f = IO (\state -> case touch# f state of- state' -> (# state', () #))+ state' -> (# state', () #)) {-# INLINE zero #-} zero = 0@@ -138,9 +137,9 @@ instance Elt Double where {-# INLINE touch #-}- touch (D# d)+ touch d = IO (\state -> case touch# d state of- state' -> (# state', () #))+ state' -> (# state', () #)) {-# INLINE zero #-} zero = 0@@ -152,9 +151,9 @@ -- Int ------------------------------------------------------------------------ instance Elt Int where {-# INLINE touch #-}- touch (I# i)+ touch i = IO (\state -> case touch# i state of- state' -> (# state', () #))+ state' -> (# state', () #)) {-# INLINE zero #-} zero = 0@@ -164,9 +163,9 @@ instance Elt Int8 where {-# INLINE touch #-}- touch (I8# w)+ touch w = IO (\state -> case touch# w state of- state' -> (# state', () #))+ state' -> (# state', () #)) {-# INLINE zero #-} zero = 0@@ -177,9 +176,9 @@ instance Elt Int16 where {-# INLINE touch #-}- touch (I16# w)+ touch w = IO (\state -> case touch# w state of- state' -> (# state', () #))+ state' -> (# state', () #)) {-# INLINE zero #-} zero = 0@@ -190,9 +189,9 @@ instance Elt Int32 where {-# INLINE touch #-}- touch (I32# w)+ touch w = IO (\state -> case touch# w state of- state' -> (# state', () #))+ state' -> (# state', () #)) {-# INLINE zero #-} zero = 0@@ -203,9 +202,9 @@ instance Elt Int64 where {-# INLINE touch #-}- touch (I64# w)+ touch w = IO (\state -> case touch# w state of- state' -> (# state', () #))+ state' -> (# state', () #)) {-# INLINE zero #-} zero = 0@@ -217,9 +216,9 @@ -- Word ----------------------------------------------------------------------- instance Elt Word where {-# INLINE touch #-}- touch (W# i)+ touch i = IO (\state -> case touch# i state of- state' -> (# state', () #))+ state' -> (# state', () #)) {-# INLINE zero #-} zero = 0@@ -230,9 +229,9 @@ instance Elt Word8 where {-# INLINE touch #-}- touch (W8# w)+ touch w = IO (\state -> case touch# w state of- state' -> (# state', () #))+ state' -> (# state', () #)) {-# INLINE zero #-} zero = 0@@ -243,9 +242,9 @@ instance Elt Word16 where {-# INLINE touch #-}- touch (W16# w)+ touch w = IO (\state -> case touch# w state of- state' -> (# state', () #))+ state' -> (# state', () #)) {-# INLINE zero #-} zero = 0@@ -256,9 +255,9 @@ instance Elt Word32 where {-# INLINE touch #-}- touch (W32# w)+ touch w = IO (\state -> case touch# w state of- state' -> (# state', () #))+ state' -> (# state', () #)) {-# INLINE zero #-} zero = 0@@ -269,9 +268,9 @@ instance Elt Word64 where {-# INLINE touch #-}- touch (W64# w)+ touch w = IO (\state -> case touch# w state of- state' -> (# state', () #))+ state' -> (# state', () #)) {-# INLINE zero #-} zero = 0@@ -284,8 +283,8 @@ instance (Elt a, Elt b) => Elt (a, b) where {-# INLINE touch #-} touch (a, b)- = do touch a- touch b+ = do touch a+ touch b {-# INLINE zero #-} zero = (zero, zero)@@ -297,9 +296,9 @@ instance (Elt a, Elt b, Elt c) => Elt (a, b, c) where {-# INLINE touch #-} touch (a, b, c)- = do touch a- touch b- touch c+ = do touch a+ touch b+ touch c {-# INLINE zero #-} zero = (zero, zero, zero)@@ -311,10 +310,10 @@ instance (Elt a, Elt b, Elt c, Elt d) => Elt (a, b, c, d) where {-# INLINE touch #-} touch (a, b, c, d)- = do touch a- touch b- touch c- touch d+ = do touch a+ touch b+ touch c+ touch d {-# INLINE zero #-} zero = (zero, zero, zero, zero)@@ -326,11 +325,11 @@ instance (Elt a, Elt b, Elt c, Elt d, Elt e) => Elt (a, b, c, d, e) where {-# INLINE touch #-} touch (a, b, c, d, e)- = do touch a- touch b- touch c- touch d- touch e+ = do touch a+ touch b+ touch c+ touch d+ touch e {-# INLINE zero #-} zero = (zero, zero, zero, zero, zero)@@ -342,12 +341,12 @@ instance (Elt a, Elt b, Elt c, Elt d, Elt e, Elt f) => Elt (a, b, c, d, e, f) where {-# INLINE touch #-} touch (a, b, c, d, e, f)- = do touch a- touch b- touch c- touch d- touch e- touch f+ = do touch a+ touch b+ touch c+ touch d+ touch e+ touch f {-# INLINE zero #-} zero = (zero, zero, zero, zero, zero, zero)
Data/Array/Repa/Eval/Gang.hs view
@@ -3,7 +3,7 @@ -- | Gang Primitives. module Data.Array.Repa.Eval.Gang ( theGang- , Gang, forkGang, gangSize, gangIO, gangST) + , Gang, forkGang, gangSize, gangIO, gangST) where import GHC.IO import GHC.ST@@ -11,7 +11,7 @@ import Control.Concurrent.MVar import Control.Exception (assert) import Control.Monad-import GHC.Conc (numCapabilities)+import GHC.Conc (numCapabilities) import System.IO @@ -48,18 +48,18 @@ -- | The 'Req' type encapsulates work requests for individual members of a gang. data Req -- | Instruct the worker to run the given action.- = ReqDo (Int -> IO ())+ = ReqDo (Int -> IO ()) - -- | Tell the worker that we're shutting the gang down.+ -- | Tell the worker that we're shutting the gang down. -- The worker should signal that it's receieved the request by -- writing to its result var before returning to the caller (forkGang).- | ReqShutdown+ | ReqShutdown -- Gang ----------------------------------------------------------------------- -- | A 'Gang' is a group of threads that execute arbitrary work requests. data Gang- = Gang + = Gang { -- | Number of threads in the gang. _gangThreads :: !Int @@ -75,7 +75,7 @@ instance Show Gang where showsPrec p (Gang n _ _ _)- = showString "<<"+ = showString "<<" . showsPrec p n . showString " threads>>" @@ -122,21 +122,21 @@ gangWorker threadId varRequest varDone = do -- Wait for a request - req <- takeMVar varRequest+ req <- takeMVar varRequest - case req of- ReqDo action- -> do -- Run the action we were given.+ case req of+ ReqDo action+ -> do -- Run the action we were given. action threadId -- Signal that the action is complete.- putMVar varDone ()+ putMVar varDone () -- Wait for more requests.- gangWorker threadId varRequest varDone+ gangWorker threadId varRequest varDone - ReqShutdown- -> putMVar varDone ()+ ReqShutdown+ -> putMVar varDone () -- | Finaliser for worker threads.@@ -160,22 +160,22 @@ finaliseWorker :: MVar Req -> MVar () -> IO () finaliseWorker varReq varDone = do putMVar varReq ReqShutdown- takeMVar varDone- return ()+ takeMVar varDone+ return () -- | Issue work requests for the 'Gang' and wait until they complete. -- -- If the gang is already busy then print a warning to `stderr` and just -- run the actions sequentially in the requesting thread.-gangIO :: Gang- -> (Int -> IO ())- -> IO ()+gangIO :: Gang+ -> (Int -> IO ())+ -> IO () {-# NOINLINE gangIO #-} gangIO gang@(Gang _ _ _ busy) action = do b <- swapMVar busy True- if b+ if b then do seqIO gang action @@ -202,12 +202,12 @@ -- | Run an action on the gang in parallel. parIO :: Gang -> (Int -> IO ()) -> IO () parIO (Gang _ mvsRequest mvsResult _) action- = do + = do -- Send requests to all the threads. mapM_ (\v -> putMVar v (ReqDo action)) mvsRequest -- Wait for all the requests to complete.- mapM_ takeMVar mvsResult+ mapM_ takeMVar mvsResult -- | Same as 'gangIO' but in the 'ST' monad.
Data/Array/Repa/Eval/Reduction.hs view
@@ -3,15 +3,15 @@ ( foldS, foldP , foldAllS, foldAllP) where-import Data.Array.Repa.Eval.Elt import Data.Array.Repa.Eval.Gang import qualified Data.Vector.Unboxed as V import qualified Data.Vector.Unboxed.Mutable as M import GHC.Base ( quotInt, divInt ) import GHC.Exts + -- | Sequential reduction of a multidimensional array along the innermost dimension.-foldS :: (Elt a, V.Unbox a)+foldS :: V.Unbox a => M.IOVector a -- ^ vector to write elements into -> (Int# -> a) -- ^ function to get an element from the given index -> (a -> a -> a) -- ^ binary associative combination function@@ -38,7 +38,7 @@ -- | Parallel reduction of a multidimensional array along the innermost dimension. -- Each output value is computed by a single thread, with the output values -- distributed evenly amongst the available threads.-foldP :: (Elt a, V.Unbox a)+foldP :: V.Unbox a => M.IOVector a -- ^ vector to write elements into -> (Int -> a) -- ^ function to get an element from the given index -> (a -> a -> a) -- ^ binary associative combination operator @@ -78,8 +78,7 @@ -- | Sequential reduction of all the elements in an array.-foldAllS :: (Elt a, V.Unbox a)- => (Int# -> a) -- ^ function to get an element from the given index+foldAllS :: (Int# -> a) -- ^ function to get an element from the given index -> (a -> a -> a) -- ^ binary associative combining function -> a -- ^ starting value -> Int# -- ^ number of elements@@ -99,7 +98,7 @@ -- computes a fold1 on its chunk of the data, and the seed element is only -- applied in the final reduction step. ---foldAllP :: (Elt a, V.Unbox a)+foldAllP :: V.Unbox a => (Int -> a) -- ^ function to get an element from the given index -> (a -> a -> a) -- ^ binary associative combining function -> a -- ^ starting value@@ -153,7 +152,7 @@ {-# INLINE iter #-} iter !i !z | 1# <- i >=# end = z - | otherwise = iter (i +# 1#) (f i `c` z)+ | otherwise = iter (i +# 1#) (z `c` f i) {-# INLINE [0] reduceInt #-}@@ -170,7 +169,7 @@ {-# INLINE iter #-} iter !i !z | 1# <- i >=# end = z - | otherwise = iter (i +# 1#) (f i `c` z)+ | otherwise = iter (i +# 1#) (z `c` f i) {-# INLINE [0] reduceFloat #-}@@ -187,7 +186,7 @@ {-# INLINE iter #-} iter !i !z | 1# <- i >=# end = z - | otherwise = iter (i +# 1#) (f i `c` z)+ | otherwise = iter (i +# 1#) (z `c` f i) {-# INLINE [0] reduceDouble #-}@@ -204,7 +203,7 @@ {-# INLINE iter #-} iter !i !z | 1# <- i >=# end = z - | otherwise = iter (i +# 1#) (f i `c` z)+ | otherwise = iter (i +# 1#) (z `c` f i) {-# INLINE unboxInt #-}
Data/Array/Repa/Eval/Selection.hs view
@@ -1,14 +1,14 @@ {-# LANGUAGE BangPatterns, ExplicitForAll, ScopedTypeVariables, PatternGuards #-} module Data.Array.Repa.Eval.Selection- (selectChunkedS, selectChunkedP)+ (selectChunkedS, selectChunkedP) where import Data.Array.Repa.Eval.Gang import Data.Array.Repa.Shape-import Data.Vector.Unboxed as V-import Data.Vector.Unboxed.Mutable as VM-import GHC.Base (remInt, quotInt)-import Prelude as P-import Control.Monad as P+import Data.Vector.Unboxed as V+import Data.Vector.Unboxed.Mutable as VM+import GHC.Base (remInt, quotInt)+import Prelude as P+import Control.Monad as P import Data.IORef @@ -17,28 +17,28 @@ -- * This primitive can be useful for writing filtering functions. -- selectChunkedS- :: Shape sh- => (sh -> a -> IO ()) -- ^ Update function to write into result.- -> (sh -> Bool) -- ^ See if this predicate matches.- -> (sh -> a) -- ^ .. and apply fn to the matching index- -> sh -- ^ Extent of indices to apply to predicate.- -> IO Int -- ^ Number of elements written to destination array.+ :: Shape sh+ => (sh -> a -> IO ()) -- ^ Update function to write into result.+ -> (sh -> Bool) -- ^ See if this predicate matches.+ -> (sh -> a) -- ^ .. and apply fn to the matching index+ -> sh -- ^ Extent of indices to apply to predicate.+ -> IO Int -- ^ Number of elements written to destination array. {-# INLINE selectChunkedS #-} selectChunkedS fnWrite fnMatch fnProduce !shSize = fill 0 0- where lenSrc = size shSize+ where lenSrc = size shSize - fill !nSrc !nDst- | nSrc >= lenSrc = return nDst+ fill !nSrc !nDst+ | nSrc >= lenSrc = return nDst - | ixSrc <- fromIndex shSize nSrc- , fnMatch ixSrc- = do fnWrite ixSrc (fnProduce ixSrc)- fill (nSrc + 1) (nDst + 1)+ | ixSrc <- fromIndex shSize nSrc+ , fnMatch ixSrc+ = do fnWrite ixSrc (fnProduce ixSrc)+ fill (nSrc + 1) (nDst + 1) - | otherwise- = fill (nSrc + 1) nDst+ | otherwise+ = fill (nSrc + 1) nDst -- | Select indices matching a predicate, in parallel.@@ -52,80 +52,80 @@ -- you're running the program with. -- selectChunkedP- :: forall a- . Unbox a- => (Int -> Bool) -- ^ See if this predicate matches.- -> (Int -> a) -- .. and apply fn to the matching index- -> Int -- Extent of indices to apply to predicate.- -> IO [IOVector a] -- Chunks containing array elements.+ :: forall a+ . Unbox a+ => (Int -> Bool) -- ^ See if this predicate matches.+ -> (Int -> a) -- .. and apply fn to the matching index+ -> Int -- Extent of indices to apply to predicate.+ -> IO [IOVector a] -- Chunks containing array elements. {-# INLINE selectChunkedP #-} selectChunkedP fnMatch fnProduce !len = do- -- Make IORefs that the threads will write their result chunks to.- -- We start with a chunk size proportial to the number of threads we have,- -- but the threads themselves can grow the chunks if they run out of space.- refs <- P.replicateM threads- $ do vec <- VM.new $ len `div` threads- newIORef vec+ -- Make IORefs that the threads will write their result chunks to.+ -- We start with a chunk size proportial to the number of threads we have,+ -- but the threads themselves can grow the chunks if they run out of space.+ refs <- P.replicateM threads+ $ do vec <- VM.new $ len `div` threads+ newIORef vec - -- Fire off a thread to fill each chunk.- gangIO theGang- $ \thread -> makeChunk (refs !! thread)- (splitIx thread)- (splitIx (thread + 1) - 1)+ -- Fire off a thread to fill each chunk.+ gangIO theGang+ $ \thread -> makeChunk (refs !! thread)+ (splitIx thread)+ (splitIx (thread + 1) - 1) - -- Read the result chunks back from the IORefs.- -- If a thread had to grow a chunk, then these might not be the same ones- -- we created back in the first step.- P.mapM readIORef refs+ -- Read the result chunks back from the IORefs.+ -- If a thread had to grow a chunk, then these might not be the same ones+ -- we created back in the first step.+ P.mapM readIORef refs - where -- See how many threads we have available.- !threads = gangSize theGang- !chunkLen = len `quotInt` threads- !chunkLeftover = len `remInt` threads+ where -- See how many threads we have available.+ !threads = gangSize theGang+ !chunkLen = len `quotInt` threads+ !chunkLeftover = len `remInt` threads - -- Decide where to split the source array.- {-# INLINE splitIx #-}- splitIx thread- | thread < chunkLeftover = thread * (chunkLen + 1)- | otherwise = thread * chunkLen + chunkLeftover+ -- Decide where to split the source array.+ {-# INLINE splitIx #-}+ splitIx thread+ | thread < chunkLeftover = thread * (chunkLen + 1)+ | otherwise = thread * chunkLen + chunkLeftover - -- Fill the given chunk with elements selected from this range of indices.- makeChunk :: IORef (IOVector a) -> Int -> Int -> IO ()- makeChunk !ref !ixSrc !ixSrcEnd+ -- Fill the given chunk with elements selected from this range of indices.+ makeChunk :: IORef (IOVector a) -> Int -> Int -> IO ()+ makeChunk !ref !ixSrc !ixSrcEnd | ixSrc > ixSrcEnd = do vecDst <- VM.new 0 writeIORef ref vecDst | otherwise- = do vecDst <- VM.new (len `div` threads)- vecDst' <- fillChunk ixSrc ixSrcEnd vecDst 0 (VM.length vecDst)- writeIORef ref vecDst'+ = do vecDst <- VM.new (len `div` threads)+ vecDst' <- fillChunk ixSrc ixSrcEnd vecDst 0 (VM.length vecDst)+ writeIORef ref vecDst' - -- The main filling loop.- fillChunk :: Int -> Int -> IOVector a -> Int -> Int -> IO (IOVector a)- fillChunk !ixSrc !ixSrcEnd !vecDst !ixDst !ixDstLen+ -- The main filling loop.+ fillChunk :: Int -> Int -> IOVector a -> Int -> Int -> IO (IOVector a)+ fillChunk !ixSrc !ixSrcEnd !vecDst !ixDst !ixDstLen -- If we've finished selecting elements, then slice the vector down -- so it doesn't have any empty space at the end.- | ixSrc > ixSrcEnd- = return $ VM.slice 0 ixDst vecDst+ | ixSrc > ixSrcEnd+ = return $ VM.slice 0 ixDst vecDst - -- If we've run out of space in the chunk then grow it some more.- | ixDst >= ixDstLen- = do let ixDstLen' = (VM.length vecDst + 1) * 2- vecDst' <- VM.grow vecDst ixDstLen'- fillChunk ixSrc ixSrcEnd vecDst' ixDst ixDstLen'+ -- If we've run out of space in the chunk then grow it some more.+ | ixDst >= ixDstLen+ = do let ixDstLen' = (VM.length vecDst + 1) * 2+ vecDst' <- VM.grow vecDst ixDstLen'+ fillChunk ixSrc ixSrcEnd vecDst' ixDst ixDstLen' - -- We've got a maching element, so add it to the chunk.- | fnMatch ixSrc- = do VM.unsafeWrite vecDst ixDst (fnProduce ixSrc)- fillChunk (ixSrc + 1) ixSrcEnd vecDst (ixDst + 1) ixDstLen+ -- We've got a maching element, so add it to the chunk.+ | fnMatch ixSrc+ = do VM.unsafeWrite vecDst ixDst (fnProduce ixSrc)+ fillChunk (ixSrc + 1) ixSrcEnd vecDst (ixDst + 1) ixDstLen - -- The element doesnt match, so keep going.- | otherwise- = fillChunk (ixSrc + 1) ixSrcEnd vecDst ixDst ixDstLen+ -- The element doesnt match, so keep going.+ | otherwise+ = fillChunk (ixSrc + 1) ixSrcEnd vecDst ixDst ixDstLen
Data/Array/Repa/Index.hs view
@@ -2,37 +2,37 @@ -- | Index types. module Data.Array.Repa.Index- (- -- * Index types- Z (..)- , (:.) (..)+ (+ -- * Index types+ Z (..)+ , (:.) (..) - -- * Common dimensions.- , DIM0, DIM1, DIM2, DIM3, DIM4, DIM5+ -- * Common dimensions.+ , DIM0, DIM1, DIM2, DIM3, DIM4, DIM5 , ix1, ix2, ix3, ix4, ix5) where import Data.Array.Repa.Shape-import GHC.Base (quotInt, remInt)+import GHC.Base (quotInt, remInt) -stage = "Data.Array.Repa.Index"+stage = "Data.Array.Repa.Index" -- | An index of dimension zero-data Z = Z- deriving (Show, Read, Eq, Ord)+data Z = Z+ deriving (Show, Read, Eq, Ord) -- | Our index type, used for both shapes and indices. infixl 3 :. data tail :. head- = !tail :. !head- deriving (Show, Read, Eq, Ord)+ = !tail :. !head+ deriving (Show, Read, Eq, Ord) -- Common dimensions-type DIM0 = Z-type DIM1 = DIM0 :. Int-type DIM2 = DIM1 :. Int-type DIM3 = DIM2 :. Int-type DIM4 = DIM3 :. Int-type DIM5 = DIM4 :. Int+type DIM0 = Z+type DIM1 = DIM0 :. Int+type DIM2 = DIM1 :. Int+type DIM3 = DIM2 :. Int+type DIM4 = DIM3 :. Int+type DIM5 = DIM4 :. Int -- | Helper for index construction.@@ -63,85 +63,85 @@ -- Shape ---------------------------------------------------------------------- instance Shape Z where- {-# INLINE [1] rank #-}- rank _ = 0+ {-# INLINE [1] rank #-}+ rank _ = 0 - {-# INLINE [1] zeroDim #-}- zeroDim = Z+ {-# INLINE [1] zeroDim #-}+ zeroDim = Z - {-# INLINE [1] unitDim #-}- unitDim = Z+ {-# INLINE [1] unitDim #-}+ unitDim = Z - {-# INLINE [1] intersectDim #-}- intersectDim _ _ = Z+ {-# INLINE [1] intersectDim #-}+ intersectDim _ _ = Z - {-# INLINE [1] addDim #-}- addDim _ _ = Z+ {-# INLINE [1] addDim #-}+ addDim _ _ = Z - {-# INLINE [1] size #-}- size _ = 1+ {-# INLINE [1] size #-}+ size _ = 1 - {-# INLINE [1] sizeIsValid #-}- sizeIsValid _ = True+ {-# INLINE [1] sizeIsValid #-}+ sizeIsValid _ = True - {-# INLINE [1] toIndex #-}- toIndex _ _ = 0+ {-# INLINE [1] toIndex #-}+ toIndex _ _ = 0 - {-# INLINE [1] fromIndex #-}- fromIndex _ _ = Z+ {-# INLINE [1] fromIndex #-}+ fromIndex _ _ = Z - {-# INLINE [1] inShapeRange #-}- inShapeRange Z Z Z = True+ {-# INLINE [1] inShapeRange #-}+ inShapeRange Z Z Z = True {-# NOINLINE listOfShape #-}- listOfShape _ = []+ listOfShape _ = [] {-# NOINLINE shapeOfList #-}- shapeOfList [] = Z- shapeOfList _ = error $ stage ++ ".fromList: non-empty list when converting to Z."+ shapeOfList [] = Z+ shapeOfList _ = error $ stage ++ ".fromList: non-empty list when converting to Z." - {-# INLINE deepSeq #-}- deepSeq Z x = x+ {-# INLINE deepSeq #-}+ deepSeq Z x = x instance Shape sh => Shape (sh :. Int) where- {-# INLINE [1] rank #-}- rank (sh :. _)- = rank sh + 1+ {-# INLINE [1] rank #-}+ rank (sh :. _)+ = rank sh + 1 - {-# INLINE [1] zeroDim #-}- zeroDim = zeroDim :. 0+ {-# INLINE [1] zeroDim #-}+ zeroDim = zeroDim :. 0 - {-# INLINE [1] unitDim #-}- unitDim = unitDim :. 1+ {-# INLINE [1] unitDim #-}+ unitDim = unitDim :. 1 - {-# INLINE [1] intersectDim #-}- intersectDim (sh1 :. n1) (sh2 :. n2)- = (intersectDim sh1 sh2 :. (min n1 n2))+ {-# INLINE [1] intersectDim #-}+ intersectDim (sh1 :. n1) (sh2 :. n2)+ = (intersectDim sh1 sh2 :. (min n1 n2)) - {-# INLINE [1] addDim #-}- addDim (sh1 :. n1) (sh2 :. n2)- = addDim sh1 sh2 :. (n1 + n2)+ {-# INLINE [1] addDim #-}+ addDim (sh1 :. n1) (sh2 :. n2)+ = addDim sh1 sh2 :. (n1 + n2) - {-# INLINE [1] size #-}- size (sh1 :. n)- = size sh1 * n+ {-# INLINE [1] size #-}+ size (sh1 :. n)+ = size sh1 * n - {-# INLINE [1] sizeIsValid #-}- sizeIsValid (sh1 :. n)- | size sh1 > 0- = n <= maxBound `div` size sh1+ {-# INLINE [1] sizeIsValid #-}+ sizeIsValid (sh1 :. n)+ | size sh1 > 0+ = n <= maxBound `div` size sh1 - | otherwise- = False+ | otherwise+ = False - {-# INLINE [1] toIndex #-}- toIndex (sh1 :. sh2) (sh1' :. sh2')- = toIndex sh1 sh1' * sh2 + sh2'+ {-# INLINE [1] toIndex #-}+ toIndex (sh1 :. sh2) (sh1' :. sh2')+ = toIndex sh1 sh1' * sh2 + sh2' - {-# INLINE [1] fromIndex #-}+ {-# INLINE [1] fromIndex #-} fromIndex (ds :. d) n = fromIndex ds (n `quotInt` d) :. r where@@ -152,20 +152,20 @@ r | rank ds == 0 = n | otherwise = n `remInt` d - {-# INLINE [1] inShapeRange #-}- inShapeRange (zs :. z) (sh1 :. n1) (sh2 :. n2)- = (n2 >= z) && (n2 < n1) && (inShapeRange zs sh1 sh2)+ {-# INLINE [1] inShapeRange #-}+ inShapeRange (zs :. z) (sh1 :. n1) (sh2 :. n2)+ = (n2 >= z) && (n2 < n1) && (inShapeRange zs sh1 sh2) {-# NOINLINE listOfShape #-}- listOfShape (sh :. n)- = n : listOfShape sh+ listOfShape (sh :. n)+ = n : listOfShape sh {-# NOINLINE shapeOfList #-}- shapeOfList xx- = case xx of- [] -> error $ stage ++ ".toList: empty list when converting to (_ :. Int)"- x:xs -> shapeOfList xs :. x+ shapeOfList xx+ = case xx of+ [] -> error $ stage ++ ".toList: empty list when converting to (_ :. Int)"+ x:xs -> shapeOfList xs :. x - {-# INLINE deepSeq #-}- deepSeq (sh :. n) x = deepSeq sh (n `seq` x)+ {-# INLINE deepSeq #-}+ deepSeq (sh :. n) x = deepSeq sh (n `seq` x)
Data/Array/Repa/Operators/IndexSpace.hs view
@@ -1,12 +1,12 @@ {-# LANGUAGE TypeOperators, ExplicitForAll, FlexibleContexts #-} module Data.Array.Repa.Operators.IndexSpace- ( reshape- , append, (++)- , transpose+ ( reshape+ , append, (++)+ , transpose , extract- , backpermute, unsafeBackpermute- , backpermuteDft, unsafeBackpermuteDft+ , backpermute, unsafeBackpermute+ , backpermuteDft, unsafeBackpermuteDft , extend, unsafeExtend , slice, unsafeSlice) where@@ -15,24 +15,24 @@ import Data.Array.Repa.Base import Data.Array.Repa.Repr.Delayed import Data.Array.Repa.Operators.Traversal-import Data.Array.Repa.Shape as S-import Prelude hiding ((++))-import qualified Prelude as P+import Data.Array.Repa.Shape as S+import Prelude hiding ((++), traverse)+import qualified Prelude as P -stage = "Data.Array.Repa.Operators.IndexSpace"+stage = "Data.Array.Repa.Operators.IndexSpace" -- Index space transformations ------------------------------------------------ -- | Impose a new shape on the elements of an array. -- The new extent must be the same size as the original, else `error`.-reshape :: ( Shape sh1, Shape sh2+reshape :: ( Shape sh1, Shape sh2 , Source r1 e)- => sh2- -> Array r1 sh1 e- -> Array D sh2 e+ => sh2+ -> Array r1 sh1 e+ -> Array D sh2 e reshape sh2 arr- | not $ S.size sh2 == S.size (extent arr)- = error + | not $ S.size sh2 == S.size (extent arr)+ = error $ stage P.++ ".reshape: reshaped array will not match size of the original" reshape sh2 arr@@ -43,23 +43,23 @@ -- | Append two arrays. append, (++)- :: ( Shape sh+ :: ( Shape sh , Source r1 e, Source r2 e)- => Array r1 (sh :. Int) e- -> Array r2 (sh :. Int) e- -> Array D (sh :. Int) e+ => Array r1 (sh :. Int) e+ -> Array r2 (sh :. Int) e+ -> Array D (sh :. Int) e append arr1 arr2 = unsafeTraverse2 arr1 arr2 fnExtent fnElem where- (_ :. n) = extent arr1+ (_ :. n) = extent arr1 - fnExtent (sh :. i) (_ :. j)- = sh :. (i + j)+ fnExtent (sh1 :. i) (sh2 :. j)+ = intersectDim sh1 sh2 :. (i + j) - fnElem f1 f2 (sh :. i)- | i < n = f1 (sh :. i)- | otherwise = f2 (sh :. (i - n))+ fnElem f1 f2 (sh :. i)+ | i < n = f1 (sh :. i)+ | otherwise = f2 (sh :. (i - n)) {-# INLINE [2] append #-} @@ -68,16 +68,16 @@ -- | Transpose the lowest two dimensions of an array.--- Transposing an array twice yields the original.+-- Transposing an array twice yields the original. transpose- :: (Shape sh, Source r e)- => Array r (sh :. Int :. Int) e- -> Array D (sh :. Int :. Int) e+ :: (Shape sh, Source r e)+ => Array r (sh :. Int :. Int) e+ -> Array D (sh :. Int :. Int) e transpose arr = unsafeTraverse arr- (\(sh :. m :. n) -> (sh :. n :.m))- (\f -> \(sh :. i :. j) -> f (sh :. j :. i))+ (\(sh :. m :. n) -> (sh :. n :.m))+ (\f -> \(sh :. i :. j) -> f (sh :. j :. i)) {-# INLINE [2] transpose #-} @@ -94,17 +94,17 @@ -- | Backwards permutation of an array's elements. backpermute, unsafeBackpermute- :: forall r sh1 sh2 e- . ( Shape sh1, Shape sh2- , Source r e)- => sh2 -- ^ Extent of result array.- -> (sh2 -> sh1) -- ^ Function mapping each index in the result array- -- to an index of the source array.- -> Array r sh1 e -- ^ Source array.- -> Array D sh2 e+ :: forall r sh1 sh2 e+ . ( Shape sh1+ , Source r e)+ => sh2 -- ^ Extent of result array.+ -> (sh2 -> sh1) -- ^ Function mapping each index in the result array+ -- to an index of the source array.+ -> Array r sh1 e -- ^ Source array.+ -> Array D sh2 e backpermute newExtent perm arr- = traverse arr (const newExtent) (. perm)+ = traverse arr (const newExtent) (. perm) {-# INLINE [2] backpermute #-} unsafeBackpermute newExtent perm arr@@ -113,24 +113,24 @@ -- | Default backwards permutation of an array's elements.--- If the function returns `Nothing` then the value at that index is taken--- from the default array (@arrDft@)+-- If the function returns `Nothing` then the value at that index is taken+-- from the default array (@arrDft@) backpermuteDft, unsafeBackpermuteDft- :: forall r1 r2 sh1 sh2 e+ :: forall r1 r2 sh1 sh2 e . ( Shape sh1, Shape sh2 , Source r1 e, Source r2 e)- => Array r2 sh2 e -- ^ Default values (@arrDft@)- -> (sh2 -> Maybe sh1) -- ^ Function mapping each index in the result array- -- to an index in the source array.- -> Array r1 sh1 e -- ^ Source array.- -> Array D sh2 e+ => Array r2 sh2 e -- ^ Default values (@arrDft@)+ -> (sh2 -> Maybe sh1) -- ^ Function mapping each index in the result array+ -- to an index in the source array.+ -> Array r1 sh1 e -- ^ Source array.+ -> Array D sh2 e backpermuteDft arrDft fnIndex arrSrc- = fromFunction (extent arrDft) fnElem- where fnElem ix- = case fnIndex ix of- Just ix' -> arrSrc `index` ix'- Nothing -> arrDft `index` ix+ = fromFunction (extent arrDft) fnElem+ where fnElem ix+ = case fnIndex ix of+ Just ix' -> arrSrc `index` ix'+ Nothing -> arrDft `index` ix {-# INLINE [2] backpermuteDft #-} unsafeBackpermuteDft arrDft fnIndex arrSrc@@ -147,12 +147,11 @@ -- -- For example, to replicate the rows of an array use the following: ----- @extend arr (Any :. (5::Int) :. All)@+-- @extend (Any :. (5::Int) :. All) arr@ -- extend, unsafeExtend :: ( Slice sl , Shape (SliceShape sl)- , Shape (FullShape sl) , Source r e) => sl -> Array r (SliceShape sl) e@@ -187,7 +186,6 @@ slice, unsafeSlice :: ( Slice sl , Shape (FullShape sl)- , Shape (SliceShape sl) , Source r e) => Array r (FullShape sl) e -> sl
Data/Array/Repa/Operators/Interleave.hs view
@@ -1,16 +1,16 @@ {-# LANGUAGE TypeOperators, ExplicitForAll, FlexibleContexts #-} module Data.Array.Repa.Operators.Interleave- ( interleave2- , interleave3- , interleave4)+ ( interleave2+ , interleave3+ , interleave4) where import Data.Array.Repa.Shape import Data.Array.Repa.Index import Data.Array.Repa.Base import Data.Array.Repa.Repr.Delayed import Data.Array.Repa.Operators.Traversal-import Prelude hiding ((++))+import Prelude hiding ((++)) -- Interleave -----------------------------------------------------------------@@ -24,91 +24,91 @@ -- @ -- interleave2- :: ( Shape sh+ :: ( Shape sh , Source r1 a, Source r2 a)- => Array r1 (sh :. Int) a- -> Array r2 (sh :. Int) a- -> Array D (sh :. Int) a+ => Array r1 (sh :. Int) a+ -> Array r2 (sh :. Int) a+ -> Array D (sh :. Int) a {-# INLINE [2] interleave2 #-} interleave2 arr1 arr2 = unsafeTraverse2 arr1 arr2 shapeFn elemFn where- shapeFn dim1 dim2- | dim1 == dim2- , sh :. len <- dim1- = sh :. (len * 2)+ shapeFn dim1 dim2+ | dim1 == dim2+ , sh :. len <- dim1+ = sh :. (len * 2) - | otherwise- = error "Data.Array.Repa.interleave2: arrays must have same extent"+ | otherwise+ = error "Data.Array.Repa.interleave2: arrays must have same extent" - elemFn get1 get2 (sh :. ix)- = case ix `mod` 2 of- 0 -> get1 (sh :. ix `div` 2)- 1 -> get2 (sh :. ix `div` 2)- _ -> error "Data.Array.Repa.interleave2: this never happens :-P"+ elemFn get1 get2 (sh :. ix)+ = case ix `mod` 2 of+ 0 -> get1 (sh :. ix `div` 2)+ 1 -> get2 (sh :. ix `div` 2)+ _ -> error "Data.Array.Repa.interleave2: this never happens :-P" -- | Interleave the elements of three arrays. interleave3- :: ( Shape sh+ :: ( Shape sh , Source r1 a, Source r2 a, Source r3 a)- => Array r1 (sh :. Int) a- -> Array r2 (sh :. Int) a- -> Array r3 (sh :. Int) a- -> Array D (sh :. Int) a+ => Array r1 (sh :. Int) a+ -> Array r2 (sh :. Int) a+ -> Array r3 (sh :. Int) a+ -> Array D (sh :. Int) a {-# INLINE [2] interleave3 #-} interleave3 arr1 arr2 arr3 = unsafeTraverse3 arr1 arr2 arr3 shapeFn elemFn where- shapeFn dim1 dim2 dim3- | dim1 == dim2- , dim1 == dim3- , sh :. len <- dim1- = sh :. (len * 3)+ shapeFn dim1 dim2 dim3+ | dim1 == dim2+ , dim1 == dim3+ , sh :. len <- dim1+ = sh :. (len * 3) - | otherwise- = error "Data.Array.Repa.interleave3: arrays must have same extent"+ | otherwise+ = error "Data.Array.Repa.interleave3: arrays must have same extent" - elemFn get1 get2 get3 (sh :. ix)- = case ix `mod` 3 of- 0 -> get1 (sh :. ix `div` 3)- 1 -> get2 (sh :. ix `div` 3)- 2 -> get3 (sh :. ix `div` 3)- _ -> error "Data.Array.Repa.interleave3: this never happens :-P"+ elemFn get1 get2 get3 (sh :. ix)+ = case ix `mod` 3 of+ 0 -> get1 (sh :. ix `div` 3)+ 1 -> get2 (sh :. ix `div` 3)+ 2 -> get3 (sh :. ix `div` 3)+ _ -> error "Data.Array.Repa.interleave3: this never happens :-P" -- | Interleave the elements of four arrays. interleave4- :: ( Shape sh+ :: ( Shape sh , Source r1 a, Source r2 a, Source r3 a, Source r4 a)- => Array r1 (sh :. Int) a- -> Array r2 (sh :. Int) a- -> Array r3 (sh :. Int) a- -> Array r4 (sh :. Int) a- -> Array D (sh :. Int) a+ => Array r1 (sh :. Int) a+ -> Array r2 (sh :. Int) a+ -> Array r3 (sh :. Int) a+ -> Array r4 (sh :. Int) a+ -> Array D (sh :. Int) a {-# INLINE [2] interleave4 #-} interleave4 arr1 arr2 arr3 arr4 = unsafeTraverse4 arr1 arr2 arr3 arr4 shapeFn elemFn where- shapeFn dim1 dim2 dim3 dim4- | dim1 == dim2- , dim1 == dim3- , dim1 == dim4- , sh :. len <- dim1- = sh :. (len * 4)+ shapeFn dim1 dim2 dim3 dim4+ | dim1 == dim2+ , dim1 == dim3+ , dim1 == dim4+ , sh :. len <- dim1+ = sh :. (len * 4) - | otherwise- = error "Data.Array.Repa.interleave4: arrays must have same extent"+ | otherwise+ = error "Data.Array.Repa.interleave4: arrays must have same extent" - elemFn get1 get2 get3 get4 (sh :. ix)- = case ix `mod` 4 of- 0 -> get1 (sh :. ix `div` 4)- 1 -> get2 (sh :. ix `div` 4)- 2 -> get3 (sh :. ix `div` 4)- 3 -> get4 (sh :. ix `div` 4)- _ -> error "Data.Array.Repa.interleave4: this never happens :-P"+ elemFn get1 get2 get3 get4 (sh :. ix)+ = case ix `mod` 4 of+ 0 -> get1 (sh :. ix `div` 4)+ 1 -> get2 (sh :. ix `div` 4)+ 2 -> get3 (sh :. ix `div` 4)+ 3 -> get4 (sh :. ix `div` 4)+ _ -> error "Data.Array.Repa.interleave4: this never happens :-P"
Data/Array/Repa/Operators/Mapping.hs view
@@ -37,8 +37,8 @@ -- ZipWith -------------------------------------------------------------------- -- | Combine two arrays, element-wise, with a binary operator.--- If the extent of the two array arguments differ,--- then the resulting array's extent is their intersection.+-- If the extent of the two array arguments differ,+-- then the resulting array's extent is their intersection. -- zipWith :: (Shape sh, Source r1 a, Source r2 b) => (a -> b -> c)@@ -56,16 +56,16 @@ infixl 7 *^, /^ infixl 6 +^, -^ -(+^) = zipWith (+)+(+^) = zipWith (+) {-# INLINE (+^) #-} -(-^) = zipWith (-)+(-^) = zipWith (-) {-# INLINE (-^) #-} -(*^) = zipWith (*)+(*^) = zipWith (*) {-# INLINE (*^) #-} -(/^) = zipWith (/)+(/^) = zipWith (/) {-# INLINE (/^) #-}
Data/Array/Repa/Operators/Reduction.hs view
@@ -1,10 +1,10 @@ {-# LANGUAGE BangPatterns, ExplicitForAll, TypeOperators, MagicHash #-} {-# OPTIONS -fno-warn-orphans #-} module Data.Array.Repa.Operators.Reduction- ( foldS, foldP- , foldAllS, foldAllP- , sumS, sumP- , sumAllS, sumAllP+ ( foldS, foldP+ , foldAllS, foldAllP+ , sumS, sumP+ , sumAllS, sumAllP , equalsS, equalsP) where import Data.Array.Repa.Base@@ -12,10 +12,10 @@ import Data.Array.Repa.Eval import Data.Array.Repa.Repr.Unboxed import Data.Array.Repa.Operators.Mapping as R-import Data.Array.Repa.Shape as S-import qualified Data.Vector.Unboxed as V+import Data.Array.Repa.Shape as S+import qualified Data.Vector.Unboxed as V import qualified Data.Vector.Unboxed.Mutable as M-import Prelude hiding (sum)+import Prelude hiding (sum) import qualified Data.Array.Repa.Eval.Reduction as E import System.IO.Unsafe import GHC.Exts@@ -24,7 +24,16 @@ -- | Sequential reduction of the innermost dimension of an arbitrary rank array. -- -- Combine this with `transpose` to fold any other dimension.-foldS :: (Shape sh, Source r a, Elt a, Unbox a)+--+-- Elements are reduced in the order of their indices, from lowest to highest.+-- Applications of the operator are associatied arbitrarily.+--+-- >>> let c 0 x = x; c x 0 = x; c x y = y+-- >>> let a = fromListUnboxed (Z :. 2 :. 2) [1,2,3,4] :: Array U (Z :. Int :. Int) Int+-- >>> foldS c 0 a+-- AUnboxed (Z :. 2) (fromList [2,4])+--+foldS :: (Shape sh, Source r a, Unbox a) => (a -> a -> a) -> a -> Array r (sh :. Int) a@@ -49,7 +58,16 @@ -- example @0@ is neutral with respect to @(+)@ as @0 + a = a@. -- These restrictions are required to support parallel evaluation, as the -- starting element may be used multiple times depending on the number of threads.-foldP :: (Shape sh, Source r a, Elt a, Unbox a, Monad m)+--+-- Elements are reduced in the order of their indices, from lowest to highest.+-- Applications of the operator are associatied arbitrarily.+--+-- >>> let c 0 x = x; c x 0 = x; c x y = y+-- >>> let a = fromListUnboxed (Z :. 2 :. 2) [1,2,3,4] :: Array U (Z :. Int :. Int) Int+-- >>> foldP c 0 a+-- AUnboxed (Z :. 2) (fromList [2,4])+--+foldP :: (Shape sh, Source r a, Unbox a, Monad m) => (a -> a -> a) -> a -> Array r (sh :. Int) a@@ -79,11 +97,14 @@ -- foldAll -------------------------------------------------------------------- -- | Sequential reduction of an array of arbitrary rank to a single scalar value. ---foldAllS :: (Shape sh, Source r a, Elt a, Unbox a)- => (a -> a -> a)- -> a- -> Array r sh a- -> a+-- Elements are reduced in row-major order. Applications of the operator are+-- associated arbitrarily.+--+foldAllS :: (Shape sh, Source r a)+ => (a -> a -> a)+ -> a+ -> Array r sh a+ -> a foldAllS f z arr = arr `deepSeqArray`@@ -102,12 +123,16 @@ -- for example @0@ is neutral with respect to @(+)@ as @0 + a = a@. -- These restrictions are required to support parallel evaluation, as the -- starting element may be used multiple times depending on the number of threads.+--+-- Elements are reduced in row-major order. Applications of the operator are+-- associated arbitrarily.+-- foldAllP - :: (Shape sh, Source r a, Elt a, Unbox a, Monad m)- => (a -> a -> a)- -> a- -> Array r sh a- -> m a+ :: (Shape sh, Source r a, Unbox a, Monad m)+ => (a -> a -> a)+ -> a+ -> Array r sh a+ -> m a foldAllP f z arr = arr `deepSeqArray`@@ -121,34 +146,34 @@ -- sum ------------------------------------------------------------------------ -- | Sequential sum the innermost dimension of an array.-sumS :: (Shape sh, Source r a, Num a, Elt a, Unbox a)- => Array r (sh :. Int) a- -> Array U sh a+sumS :: (Shape sh, Source r a, Num a, Unbox a)+ => Array r (sh :. Int) a+ -> Array U sh a sumS = foldS (+) 0 {-# INLINE [3] sumS #-} -- | Parallel sum the innermost dimension of an array.-sumP :: (Shape sh, Source r a, Num a, Elt a, Unbox a, Monad m)- => Array r (sh :. Int) a- -> m (Array U sh a)+sumP :: (Shape sh, Source r a, Num a, Unbox a, Monad m)+ => Array r (sh :. Int) a+ -> m (Array U sh a) sumP = foldP (+) 0 {-# INLINE [3] sumP #-} -- sumAll --------------------------------------------------------------------- -- | Sequential sum of all the elements of an array.-sumAllS :: (Shape sh, Source r a, Elt a, Unbox a, Num a)- => Array r sh a- -> a+sumAllS :: (Shape sh, Source r a, Num a)+ => Array r sh a+ -> a sumAllS = foldAllS (+) 0 {-# INLINE [3] sumAllS #-} -- | Parallel sum all the elements of an array.-sumAllP :: (Shape sh, Source r a, Elt a, Unbox a, Num a, Monad m)- => Array r sh a- -> m a+sumAllP :: (Shape sh, Source r a, Unbox a, Num a, Monad m)+ => Array r sh a+ -> m a sumAllP = foldAllP (+) 0 {-# INLINE [3] sumAllP #-} @@ -162,7 +187,7 @@ -- | Check whether two arrays have the same shape and contain equal elements, -- in parallel.-equalsP :: (Shape sh, Eq sh, Source r1 a, Source r2 a, Eq a, Monad m) +equalsP :: (Shape sh, Source r1 a, Source r2 a, Eq a, Monad m) => Array r1 sh a -> Array r2 sh a -> m Bool@@ -173,7 +198,7 @@ -- | Check whether two arrays have the same shape and contain equal elements, -- sequentially.-equalsS :: (Shape sh, Eq sh, Source r1 a, Source r2 a, Eq a) +equalsS :: (Shape sh, Source r1 a, Source r2 a, Eq a) => Array r1 sh a -> Array r2 sh a -> Bool
Data/Array/Repa/Operators/Selection.hs view
@@ -1,12 +1,12 @@ {-# LANGUAGE BangPatterns #-} module Data.Array.Repa.Operators.Selection- (selectP)+ (selectP) where import Data.Array.Repa.Index import Data.Array.Repa.Base import Data.Array.Repa.Eval.Selection import Data.Array.Repa.Repr.Unboxed as U-import qualified Data.Vector.Unboxed as V+import qualified Data.Vector.Unboxed as V import System.IO.Unsafe @@ -19,26 +19,26 @@ -- -- * Use the integer as the index into the array you're filtering. ---selectP :: (Unbox a, Monad m)- => (Int -> Bool) -- ^ If the Int matches this predicate,- -> (Int -> a) -- ^ ... then pass it to this fn to produce a value- -> Int -- ^ Range between 0 and this maximum.- -> m (Array U DIM1 a) -- ^ Array containing produced values.+selectP :: (Unbox a, Monad m)+ => (Int -> Bool) -- ^ If the Int matches this predicate,+ -> (Int -> a) -- ^ ... then pass it to this fn to produce a value+ -> Int -- ^ Range between 0 and this maximum.+ -> m (Array U DIM1 a) -- ^ Array containing produced values. selectP match produce len = return $ unsafePerformIO- $ do (sh, vec) <- selectIO- return $ sh `seq` vec `seq`- fromUnboxed sh vec+ $ do (sh, vec) <- selectIO+ return $ sh `seq` vec `seq`+ fromUnboxed sh vec - where {-# INLINE selectIO #-}- selectIO- = do vecs <- selectChunkedP match produce len- vecs' <- mapM V.unsafeFreeze vecs+ where {-# INLINE selectIO #-}+ selectIO+ = do vecs <- selectChunkedP match produce len+ vecs' <- mapM V.unsafeFreeze vecs - -- TODO: avoid copy somehow.- let result = V.concat vecs'+ -- TODO: avoid copy somehow.+ let result = V.concat vecs' - return (Z :. V.length result, result)+ return (Z :. V.length result, result) {-# INLINE [1] selectP #-}
Data/Array/Repa/Operators/Traversal.hs view
@@ -1,25 +1,26 @@ -- Generic Traversal module Data.Array.Repa.Operators.Traversal- ( traverse, unsafeTraverse+ ( traverse, unsafeTraverse , traverse2, unsafeTraverse2- , traverse3, unsafeTraverse3- , traverse4, unsafeTraverse4)+ , traverse3, unsafeTraverse3+ , traverse4, unsafeTraverse4) where import Data.Array.Repa.Base import Data.Array.Repa.Shape import Data.Array.Repa.Repr.Delayed+import Prelude hiding (traverse) -- | Unstructured traversal. traverse, unsafeTraverse- :: forall r sh sh' a b- . ( Source r a- , Shape sh, Shape sh')- => Array r sh a -- ^ Source array.- -> (sh -> sh') -- ^ Function to produce the extent of the result.- -> ((sh -> a) -> sh' -> b) -- ^ Function to produce elements of the result.- -- It is passed a lookup function to get elements of the source.- -> Array D sh' b+ :: forall r sh sh' a b+ . ( Source r a+ , Shape sh)+ => Array r sh a -- ^ Source array.+ -> (sh -> sh') -- ^ Function to produce the extent of the result.+ -> ((sh -> a) -> sh' -> b) -- ^ Function to produce elements of the result.+ -- It is passed a lookup function to get elements of the source.+ -> Array D sh' b traverse arr transExtent newElem = fromFunction (transExtent (extent arr)) (newElem (index arr))@@ -32,21 +33,21 @@ -- | Unstructured traversal over two arrays at once. traverse2, unsafeTraverse2- :: forall r1 r2 sh sh' sh'' a b c- . ( Source r1 a, Source r2 b- , Shape sh, Shape sh', Shape sh'')- => Array r1 sh a -- ^ First source array.- -> Array r2 sh' b -- ^ Second source array.- -> (sh -> sh' -> sh'') -- ^ Function to produce the extent of the result.+ :: forall r1 r2 sh sh' sh'' a b c+ . ( Source r1 a, Source r2 b+ , Shape sh, Shape sh')+ => Array r1 sh a -- ^ First source array.+ -> Array r2 sh' b -- ^ Second source array.+ -> (sh -> sh' -> sh'') -- ^ Function to produce the extent of the result. -> ((sh -> a) -> (sh' -> b)- -> (sh'' -> c)) -- ^ Function to produce elements of the result.- -- It is passed lookup functions to get elements of the- -- source arrays.+ -> (sh'' -> c)) -- ^ Function to produce elements of the result.+ -- It is passed lookup functions to get elements of the+ -- source arrays. -> Array D sh'' c traverse2 arrA arrB transExtent newElem = fromFunction (transExtent (extent arrA) (extent arrB))- (newElem (index arrA) (index arrB))+ (newElem (index arrA) (index arrB)) {-# INLINE [3] traverse2 #-} unsafeTraverse2 arrA arrB transExtent newElem@@ -57,14 +58,14 @@ -- | Unstructured traversal over three arrays at once. traverse3, unsafeTraverse3- :: forall r1 r2 r3- sh1 sh2 sh3 sh4- a b c d- . ( Source r1 a, Source r2 b, Source r3 c- , Shape sh1, Shape sh2, Shape sh3, Shape sh4)+ :: forall r1 r2 r3+ sh1 sh2 sh3 sh4+ a b c d+ . ( Source r1 a, Source r2 b, Source r3 c+ , Shape sh1, Shape sh2, Shape sh3) => Array r1 sh1 a- -> Array r2 sh2 b- -> Array r3 sh3 c+ -> Array r2 sh2 b+ -> Array r3 sh3 c -> (sh1 -> sh2 -> sh3 -> sh4) -> ( (sh1 -> a) -> (sh2 -> b) -> (sh3 -> c)@@ -73,26 +74,26 @@ traverse3 arrA arrB arrC transExtent newElem = fromFunction (transExtent (extent arrA) (extent arrB) (extent arrC))- (newElem (index arrA) (index arrB) (index arrC))+ (newElem (index arrA) (index arrB) (index arrC)) {-# INLINE [3] traverse3 #-} unsafeTraverse3 arrA arrB arrC transExtent newElem- = fromFunction (transExtent (extent arrA) (extent arrB) (extent arrC))- (newElem (unsafeIndex arrA) (unsafeIndex arrB) (unsafeIndex arrC))+ = fromFunction (transExtent (extent arrA) (extent arrB) (extent arrC))+ (newElem (unsafeIndex arrA) (unsafeIndex arrB) (unsafeIndex arrC)) {-# INLINE [3] unsafeTraverse3 #-} -- | Unstructured traversal over four arrays at once. traverse4, unsafeTraverse4- :: forall r1 r2 r3 r4- sh1 sh2 sh3 sh4 sh5- a b c d e- . ( Source r1 a, Source r2 b, Source r3 c, Source r4 d- , Shape sh1, Shape sh2, Shape sh3, Shape sh4, Shape sh5)+ :: forall r1 r2 r3 r4+ sh1 sh2 sh3 sh4 sh5+ a b c d e+ . ( Source r1 a, Source r2 b, Source r3 c, Source r4 d+ , Shape sh1, Shape sh2, Shape sh3, Shape sh4) => Array r1 sh1 a- -> Array r2 sh2 b- -> Array r3 sh3 c- -> Array r4 sh4 d+ -> Array r2 sh2 b+ -> Array r3 sh3 c+ -> Array r4 sh4 d -> (sh1 -> sh2 -> sh3 -> sh4 -> sh5 ) -> ( (sh1 -> a) -> (sh2 -> b) -> (sh3 -> c) -> (sh4 -> d)@@ -100,14 +101,14 @@ -> Array D sh5 e traverse4 arrA arrB arrC arrD transExtent newElem- = fromFunction (transExtent (extent arrA) (extent arrB) (extent arrC) (extent arrD))- (newElem (index arrA) (index arrB) (index arrC) (index arrD))+ = fromFunction (transExtent (extent arrA) (extent arrB) (extent arrC) (extent arrD))+ (newElem (index arrA) (index arrB) (index arrC) (index arrD)) {-# INLINE [3] traverse4 #-} unsafeTraverse4 arrA arrB arrC arrD transExtent newElem = fromFunction (transExtent (extent arrA) (extent arrB) (extent arrC) (extent arrD))- (newElem (unsafeIndex arrA) (unsafeIndex arrB) (unsafeIndex arrC) (unsafeIndex arrD))+ (newElem (unsafeIndex arrA) (unsafeIndex arrB) (unsafeIndex arrC) (unsafeIndex arrD)) {-# INLINE [3] unsafeTraverse4 #-}
Data/Array/Repa/Repr/ByteString.hs view
@@ -47,8 +47,7 @@ -- Conversions ---------------------------------------------------------------- -- | O(1). Wrap a `ByteString` as an array. fromByteString- :: Shape sh- => sh -> ByteString -> Array B sh Word8+ :: sh -> ByteString -> Array B sh Word8 fromByteString sh bs = AByteString sh bs {-# INLINE fromByteString #-}
Data/Array/Repa/Repr/Unboxed.hs view
@@ -90,8 +90,7 @@ -- * This is an alias for `computeS` with a more specific type. -- computeUnboxedS- :: ( Shape sh- , Load r1 sh e, U.Unbox e)+ :: (Load r1 sh e, U.Unbox e) => Array r1 sh e -> Array U sh e computeUnboxedS = computeS {-# INLINE computeUnboxedS #-}@@ -102,8 +101,7 @@ -- * This is an alias for `computeP` with a more specific type. -- computeUnboxedP- :: ( Shape sh- , Load r1 sh e, Monad m, U.Unbox e)+ :: (Load r1 sh e, Monad m, U.Unbox e) => Array r1 sh e -> m (Array U sh e) computeUnboxedP = computeP {-# INLINE computeUnboxedP #-}@@ -121,18 +119,14 @@ -- | O(1). Wrap an unboxed vector as an array.-fromUnboxed- :: (Shape sh, U.Unbox e)- => sh -> U.Vector e -> Array U sh e+fromUnboxed :: sh -> U.Vector e -> Array U sh e fromUnboxed sh vec = AUnboxed sh vec {-# INLINE fromUnboxed #-} -- | O(1). Unpack an unboxed vector from an array.-toUnboxed- :: U.Unbox e- => Array U sh e -> U.Vector e+toUnboxed :: Array U sh e -> U.Vector e toUnboxed (AUnboxed _ vec) = vec {-# INLINE toUnboxed #-}
Data/Array/Repa/Repr/Undefined.hs view
@@ -44,7 +44,7 @@ => Read (Array X sh e) -instance (Shape sh, Num e) => Load X sh e where+instance Shape sh => Load X sh e where loadS _ _ = return () loadP _ _ = return ()
Data/Array/Repa/Repr/Vector.hs view
@@ -83,7 +83,7 @@ -- * This is an alias for `compute` with a more specific type. -- computeVectorS- :: (Shape sh, Load r1 sh e)+ :: Load r1 sh e => Array r1 sh e -> Array V sh e computeVectorS = computeS {-# INLINE computeVectorS #-}@@ -91,7 +91,7 @@ -- | Parallel computation of array elements. computeVectorP- :: (Shape sh, Load r1 sh e, Monad m)+ :: (Load r1 sh e, Monad m) => Array r1 sh e -> m (Array V sh e) computeVectorP = computeP {-# INLINE computeVectorP #-}@@ -107,16 +107,14 @@ -- | O(1). Wrap a boxed vector as an array.-fromVector- :: Shape sh- => sh -> V.Vector e -> Array V sh e+fromVector :: sh -> V.Vector e -> Array V sh e fromVector sh vec = AVector sh vec {-# INLINE fromVector #-} -- | O(1). Unpack a boxed vector from an array.-toVector :: Array V sh e -> V.Vector e+toVector :: Array V sh e -> V.Vector e toVector (AVector _ vec) = vec {-# INLINE toVector #-}
Data/Array/Repa/Shape.hs view
@@ -2,7 +2,7 @@ -- | Class of types that can be used as array shapes and indices. module Data.Array.Repa.Shape- ( Shape(..)+ ( Shape(..) , inShape , showShape ) where@@ -11,69 +11,69 @@ -- | Class of types that can be used as array shapes and indices. class Eq sh => Shape sh where - -- | Get the number of dimensions in a shape.- rank :: sh -> Int+ -- | Get the number of dimensions in a shape.+ rank :: sh -> Int - -- | The shape of an array of size zero, with a particular dimensionality.- zeroDim :: sh+ -- | The shape of an array of size zero, with a particular dimensionality.+ zeroDim :: sh - -- | The shape of an array with size one, with a particular dimensionality.- unitDim :: sh+ -- | The shape of an array with size one, with a particular dimensionality.+ unitDim :: sh - -- | Compute the intersection of two shapes.- intersectDim :: sh -> sh -> sh+ -- | Compute the intersection of two shapes.+ intersectDim :: sh -> sh -> sh - -- | Add the coordinates of two shapes componentwise- addDim :: sh -> sh -> sh+ -- | Add the coordinates of two shapes componentwise+ addDim :: sh -> sh -> sh - -- | Get the total number of elements in an array with this shape.- size :: sh -> Int+ -- | Get the total number of elements in an array with this shape.+ size :: sh -> Int - -- | Check whether this shape is small enough so that its flat- -- indices an be represented as `Int`. If this returns `False` then your- -- array is too big. Mostly used for writing QuickCheck tests.- sizeIsValid :: sh -> Bool+ -- | Check whether this shape is small enough so that its flat+ -- indices an be represented as `Int`. If this returns `False` then your+ -- array is too big. Mostly used for writing QuickCheck tests.+ sizeIsValid :: sh -> Bool - -- | Convert an index into its equivalent flat, linear, row-major version.- toIndex :: sh -- ^ Shape of the array.- -> sh -- ^ Index into the array.- -> Int+ -- | Convert an index into its equivalent flat, linear, row-major version.+ toIndex :: sh -- ^ Shape of the array.+ -> sh -- ^ Index into the array.+ -> Int - -- | Inverse of `toIndex`.- fromIndex- :: sh -- ^ Shape of the array.- -> Int -- ^ Index into linear representation.- -> sh+ -- | Inverse of `toIndex`.+ fromIndex+ :: sh -- ^ Shape of the array.+ -> Int -- ^ Index into linear representation.+ -> sh - -- | Check whether an index is within a given shape.- inShapeRange- :: sh -- ^ Start index for range.- -> sh -- ^ Final index for range.- -> sh -- ^ Index to check for.- -> Bool+ -- | Check whether an index is within a given shape.+ inShapeRange+ :: sh -- ^ Start index for range.+ -> sh -- ^ Final index for range.+ -> sh -- ^ Index to check for.+ -> Bool - -- | Convert a shape into its list of dimensions.- listOfShape :: sh -> [Int]+ -- | Convert a shape into its list of dimensions.+ listOfShape :: sh -> [Int] - -- | Convert a list of dimensions to a shape- shapeOfList :: [Int] -> sh+ -- | Convert a list of dimensions to a shape+ shapeOfList :: [Int] -> sh - -- | Ensure that a shape is completely evaluated.- infixr 0 `deepSeq`- deepSeq :: sh -> a -> a+ -- | Ensure that a shape is completely evaluated.+ infixr 0 `deepSeq`+ deepSeq :: sh -> a -> a -- | Check whether an index is a part of a given shape. inShape :: forall sh- . Shape sh- => sh -- ^ Shape of the array.- -> sh -- ^ Index.- -> Bool+ . Shape sh+ => sh -- ^ Shape of the array.+ -> sh -- ^ Index.+ -> Bool {-# INLINE inShape #-} inShape sh ix- = inShapeRange zeroDim sh ix+ = inShapeRange zeroDim sh ix -- | Nicely format a shape as a string
Data/Array/Repa/Slice.hs view
@@ -3,81 +3,81 @@ -- | Index space transformation between arrays and slices. module Data.Array.Repa.Slice- ( All (..)- , Any (..)- , FullShape- , SliceShape- , Slice (..))+ ( All (..)+ , Any (..)+ , FullShape+ , SliceShape+ , Slice (..)) where import Data.Array.Repa.Index-import Prelude hiding (replicate, drop)+import Prelude hiding (replicate, drop) -- | Select all indices at a certain position.-data All = All+data All = All -- | Place holder for any possible shape.-data Any sh = Any+data Any sh = Any -- | Map a type of the index in the full shape, to the type of the index in the slice. type family FullShape ss-type instance FullShape Z = Z-type instance FullShape (Any sh) = sh-type instance FullShape (sl :. Int) = FullShape sl :. Int-type instance FullShape (sl :. All) = FullShape sl :. Int+type instance FullShape Z = Z+type instance FullShape (Any sh) = sh+type instance FullShape (sl :. Int) = FullShape sl :. Int+type instance FullShape (sl :. All) = FullShape sl :. Int -- | Map the type of an index in the slice, to the type of the index in the full shape. type family SliceShape ss-type instance SliceShape Z = Z-type instance SliceShape (Any sh) = sh-type instance SliceShape (sl :. Int) = SliceShape sl-type instance SliceShape (sl :. All) = SliceShape sl :. Int+type instance SliceShape Z = Z+type instance SliceShape (Any sh) = sh+type instance SliceShape (sl :. Int) = SliceShape sl+type instance SliceShape (sl :. All) = SliceShape sl :. Int -- | Class of index types that can map to slices. class Slice ss where- -- | Map an index of a full shape onto an index of some slice.- sliceOfFull :: ss -> FullShape ss -> SliceShape ss+ -- | Map an index of a full shape onto an index of some slice.+ sliceOfFull :: ss -> FullShape ss -> SliceShape ss - -- | Map an index of a slice onto an index of the full shape.- fullOfSlice :: ss -> SliceShape ss -> FullShape ss+ -- | Map an index of a slice onto an index of the full shape.+ fullOfSlice :: ss -> SliceShape ss -> FullShape ss instance Slice Z where- {-# INLINE [1] sliceOfFull #-}- sliceOfFull _ _ = Z+ {-# INLINE [1] sliceOfFull #-}+ sliceOfFull _ _ = Z - {-# INLINE [1] fullOfSlice #-}- fullOfSlice _ _ = Z+ {-# INLINE [1] fullOfSlice #-}+ fullOfSlice _ _ = Z instance Slice (Any sh) where- {-# INLINE [1] sliceOfFull #-}- sliceOfFull _ sh = sh+ {-# INLINE [1] sliceOfFull #-}+ sliceOfFull _ sh = sh - {-# INLINE [1] fullOfSlice #-}- fullOfSlice _ sh = sh+ {-# INLINE [1] fullOfSlice #-}+ fullOfSlice _ sh = sh instance Slice sl => Slice (sl :. Int) where- {-# INLINE [1] sliceOfFull #-}- sliceOfFull (fsl :. _) (ssl :. _)- = sliceOfFull fsl ssl+ {-# INLINE [1] sliceOfFull #-}+ sliceOfFull (fsl :. _) (ssl :. _)+ = sliceOfFull fsl ssl - {-# INLINE [1] fullOfSlice #-}- fullOfSlice (fsl :. n) ssl- = fullOfSlice fsl ssl :. n+ {-# INLINE [1] fullOfSlice #-}+ fullOfSlice (fsl :. n) ssl+ = fullOfSlice fsl ssl :. n instance Slice sl => Slice (sl :. All) where- {-# INLINE [1] sliceOfFull #-}- sliceOfFull (fsl :. All) (ssl :. s)- = sliceOfFull fsl ssl :. s+ {-# INLINE [1] sliceOfFull #-}+ sliceOfFull (fsl :. All) (ssl :. s)+ = sliceOfFull fsl ssl :. s - {-# INLINE [1] fullOfSlice #-}- fullOfSlice (fsl :. All) (ssl :. s)- = fullOfSlice fsl ssl :. s+ {-# INLINE [1] fullOfSlice #-}+ fullOfSlice (fsl :. All) (ssl :. s)+ = fullOfSlice fsl ssl :. s
Data/Array/Repa/Specialised/Dim2.hs view
@@ -2,10 +2,10 @@ -- | Functions specialised for arrays of dimension 2. module Data.Array.Repa.Specialised.Dim2- ( isInside2- , isOutside2- , clampToBorder2- , makeBordered2)+ ( isInside2+ , isOutside2+ , clampToBorder2+ , makeBordered2) where import Data.Array.Repa.Index import Data.Array.Repa.Base@@ -17,53 +17,53 @@ -- As opposed to `inRange` from "Data.Array.Repa.Index", -- this is a short-circuited test that checks that lowest dimension first. isInside2- :: DIM2 -- ^ Extent of array.- -> DIM2 -- ^ Index to check.- -> Bool+ :: DIM2 -- ^ Extent of array.+ -> DIM2 -- ^ Index to check.+ -> Bool {-# INLINE isInside2 #-}-isInside2 ex = not . isOutside2 ex+isInside2 ex = not . isOutside2 ex -- | Check if an index lies outside the given extent. -- As opposed to `inRange` from "Data.Array.Repa.Index", -- this is a short-circuited test that checks the lowest dimension first. isOutside2- :: DIM2 -- ^ Extent of array.- -> DIM2 -- ^ Index to check.- -> Bool+ :: DIM2 -- ^ Extent of array.+ -> DIM2 -- ^ Index to check.+ -> Bool {-# INLINE isOutside2 #-} isOutside2 (_ :. yLen :. xLen) (_ :. yy :. xx)- | xx < 0 = True- | xx >= xLen = True- | yy < 0 = True- | yy >= yLen = True- | otherwise = False+ | xx < 0 = True+ | xx >= xLen = True+ | yy < 0 = True+ | yy >= yLen = True+ | otherwise = False -- | Given the extent of an array, clamp the components of an index so they -- lie within the given array. Outlying indices are clamped to the index -- of the nearest border element. clampToBorder2- :: DIM2 -- ^ Extent of array.- -> DIM2 -- ^ Index to clamp.- -> DIM2+ :: DIM2 -- ^ Extent of array.+ -> DIM2 -- ^ Index to clamp.+ -> DIM2 {-# INLINE clampToBorder2 #-} clampToBorder2 (_ :. yLen :. xLen) (sh :. j :. i) = clampX j i- where {-# INLINE clampX #-}- clampX !y !x- | x < 0 = clampY y 0- | x >= xLen = clampY y (xLen - 1)- | otherwise = clampY y x+ where {-# INLINE clampX #-}+ clampX !y !x+ | x < 0 = clampY y 0+ | x >= xLen = clampY y (xLen - 1)+ | otherwise = clampY y x - {-# INLINE clampY #-}- clampY !y !x- | y < 0 = sh :. 0 :. x- | y >= yLen = sh :. (yLen - 1) :. x- | otherwise = sh :. y :. x+ {-# INLINE clampY #-}+ clampY !y !x+ | y < 0 = sh :. 0 :. x+ | y >= yLen = sh :. (yLen - 1) :. x+ | otherwise = sh :. y :. x @@ -73,32 +73,32 @@ -- The border must be the same width on all sides. -- makeBordered2- :: (Source r1 a, Source r2 a)- => DIM2 -- ^ Extent of array.- -> Int -- ^ Width of border.- -> Array r1 DIM2 a -- ^ Array for internal elements.- -> Array r2 DIM2 a -- ^ Array for border elements.- -> Array (P r1 (P r2 (P r2 (P r2 (P r2 X))))) DIM2 a+ :: (Source r1 a, Source r2 a)+ => DIM2 -- ^ Extent of array.+ -> Int -- ^ Width of border.+ -> Array r1 DIM2 a -- ^ Array for internal elements.+ -> Array r2 DIM2 a -- ^ Array for border elements.+ -> Array (P r1 (P r2 (P r2 (P r2 (P r2 X))))) DIM2 a {-# INLINE makeBordered2 #-} makeBordered2 sh@(_ :. aHeight :. aWidth) bWidth arrInternal arrBorder = checkDims `seq` let- -- minimum and maximum indicies of values in the inner part of the image.- !inX = bWidth- !inY = bWidth+ -- minimum and maximum indicies of values in the inner part of the image.+ !inX = bWidth+ !inY = bWidth !inW = aWidth - 2 * bWidth !inH = aHeight - 2 * bWidth - inInternal (Z :. y :. x)- = x >= inX && x < (inX + inW)- && y >= inY && y < (inY + inH)+ inInternal (Z :. y :. x)+ = x >= inX && x < (inX + inW)+ && y >= inY && y < (inY + inH) {-# INLINE inInternal #-} - inBorder = not . inInternal+ inBorder = not . inInternal {-# INLINE inBorder #-} - in + in -- internal region APart sh (Range (Z :. inY :. inX) (Z :. inH :. inW ) inInternal) arrInternal
Data/Array/Repa/Stencil.hs view
@@ -1,19 +1,16 @@-{-# LANGUAGE MagicHash, PatternGuards, BangPatterns, TemplateHaskell, QuasiQuotes,- ParallelListComp, TypeOperators, ExplicitForAll, ScopedTypeVariables #-} {-# OPTIONS -Wnot #-} -- | Efficient computation of stencil based convolutions. -- module Data.Array.Repa.Stencil- ( Stencil (..)- , Boundary (..)+ ( Stencil (..)+ , Boundary (..) - -- * Stencil creation.- , makeStencil)+ -- * Stencil creation.+ , makeStencil) where import Data.Array.Repa import Data.Array.Repa.Base import Data.Array.Repa.Stencil.Base-import Data.Array.Repa.Stencil.Template import Data.Array.Repa.Specialised.Dim2
Data/Array/Repa/Stencil/Base.hs view
@@ -1,9 +1,9 @@ -- | Basic definitions for stencil handling. module Data.Array.Repa.Stencil.Base- ( Boundary (..)- , Stencil (..)- , makeStencil, makeStencil2)+ ( Boundary (..)+ , Stencil (..)+ , makeStencil, makeStencil2) where import Data.Array.Repa.Index @@ -12,50 +12,50 @@ -- | Use a fixed value for border regions. = BoundFixed !a - -- | Treat points outside the array as having a constant value.- | BoundConst !a+ -- | Treat points outside the array as having a constant value.+ | BoundConst !a - -- | Clamp points outside to the same value as the edge pixel.- | BoundClamp- deriving (Show)+ -- | Clamp points outside to the same value as the edge pixel.+ | BoundClamp+ deriving (Show) -- | Represents a convolution stencil that we can apply to array. -- Only statically known stencils are supported right now. data Stencil sh a - -- | Static stencils are used when the coefficients are fixed,- -- and known at compile time.- = StencilStatic- { stencilExtent :: !sh- , stencilZero :: !a- , stencilAcc :: !(sh -> a -> a -> a) }+ -- | Static stencils are used when the coefficients are fixed,+ -- and known at compile time.+ = StencilStatic+ { stencilExtent :: !sh+ , stencilZero :: !a+ , stencilAcc :: !(sh -> a -> a -> a) } -- | Make a stencil from a function yielding coefficients at each index. makeStencil- :: Num a- => sh -- ^ Extent of stencil.- -> (sh -> Maybe a) -- ^ Get the coefficient at this index.- -> Stencil sh a+ :: Num a+ => sh -- ^ Extent of stencil.+ -> (sh -> Maybe a) -- ^ Get the coefficient at this index.+ -> Stencil sh a {-# INLINE makeStencil #-} makeStencil ex getCoeff = StencilStatic ex 0 $ \ix val acc- -> case getCoeff ix of- Nothing -> acc- Just coeff -> acc + val * coeff+ -> case getCoeff ix of+ Nothing -> acc+ Just coeff -> acc + val * coeff -- | Wrapper for `makeStencil` that requires a DIM2 stencil. makeStencil2- :: Num a- => Int -> Int -- ^ extent of stencil- -> (DIM2 -> Maybe a) -- ^ Get the coefficient at this index.- -> Stencil DIM2 a+ :: Num a+ => Int -> Int -- ^ extent of stencil+ -> (DIM2 -> Maybe a) -- ^ Get the coefficient at this index.+ -> Stencil DIM2 a {-# INLINE makeStencil2 #-} makeStencil2 height width getCoeff- = makeStencil (Z :. height :. width) getCoeff+ = makeStencil (Z :. height :. width) getCoeff
Data/Array/Repa/Stencil/Dim2.hs view
@@ -1,4 +1,4 @@-{-# LANGUAGE MagicHash #-}+{-# LANGUAGE CPP, MagicHash #-} -- This is specialised for stencils up to 7x7. -- Due to limitations in the GHC optimiser, using larger stencils doesn't -- work, and will yield `error` at runtime. We can probably increase the@@ -11,11 +11,13 @@ -- fits in the 7x7 tile. -- module Data.Array.Repa.Stencil.Dim2- ( -- * Stencil creation- makeStencil2, stencil2-- -- * Stencil operators- , PC5, mapStencil2, forStencil2)+ ( -- * Stencil creation+ makeStencil2,+#ifndef REPA_NO_TH+ stencil2,+#endif+ -- * Stencil operators+ PC5, mapStencil2, forStencil2) where import Data.Array.Repa.Base import Data.Array.Repa.Index@@ -26,14 +28,16 @@ import Data.Array.Repa.Repr.HintSmall import Data.Array.Repa.Repr.Undefined import Data.Array.Repa.Stencil.Base+#ifndef REPA_NO_TH import Data.Array.Repa.Stencil.Template+#endif import Data.Array.Repa.Stencil.Partition import GHC.Exts -- | A index into the flat array. -- Should be abstract outside the stencil modules. data Cursor- = Cursor Int+ = Cursor Int type PC5 = P C (P (S D) (P (S D) (P (S D) (P (S D) X)))) @@ -43,32 +47,32 @@ forStencil2 :: Source r a => Boundary a- -> Array r DIM2 a- -> Stencil DIM2 a- -> Array PC5 DIM2 a+ -> Array r DIM2 a+ -> Stencil DIM2 a+ -> Array PC5 DIM2 a {-# INLINE forStencil2 #-} forStencil2 boundary arr stencil- = mapStencil2 boundary stencil arr+ = mapStencil2 boundary stencil arr ------------------------------------------------------------------------------- -- | Apply a stencil to every element of a 2D array. mapStencil2 :: Source r a- => Boundary a -- ^ How to handle the boundary of the array.- -> Stencil DIM2 a -- ^ Stencil to apply.- -> Array r DIM2 a -- ^ Array to apply stencil to.- -> Array PC5 DIM2 a+ => Boundary a -- ^ How to handle the boundary of the array.+ -> Stencil DIM2 a -- ^ Stencil to apply.+ -> Array r DIM2 a -- ^ Array to apply stencil to.+ -> Array PC5 DIM2 a {-# INLINE mapStencil2 #-} mapStencil2 boundary stencil@(StencilStatic sExtent _zero _load) arr- = let sh = extent arr+ = let sh = extent arr (_ :. aHeight :. aWidth) = sh- (_ :. sHeight :. sWidth) = sExtent+ (_ :. sHeight :. sWidth) = sExtent - sHeight2 = sHeight `div` 2- sWidth2 = sWidth `div` 2+ sHeight2 = sHeight `div` 2+ sWidth2 = sWidth `div` 2 -- Partition the array into the internal and border regions. ![ Region inX inY inW inH@@ -81,24 +85,24 @@ (Size sWidth sHeight) (Offset sWidth2 sHeight2) - {-# INLINE inInternal #-}- inInternal (Z :. y :. x)- = x >= inX && x < (inX + inW)- && y >= inY && y < (inY + inH)+ {-# INLINE inInternal #-}+ inInternal (Z :. y :. x)+ = x >= inX && x < (inX + inW)+ && y >= inY && y < (inY + inH) - {-# INLINE inBorder #-}- inBorder = not . inInternal+ {-# INLINE inBorder #-}+ inBorder = not . inInternal - -- Cursor functions ----------------- {-# INLINE makec #-}- makec (Z :. y :. x)- = Cursor (x + y * aWidth)+ -- Cursor functions ----------------+ {-# INLINE makec #-}+ makec (Z :. y :. x)+ = Cursor (x + y * aWidth) - {-# INLINE shiftc #-}- shiftc ix (Cursor off)- = Cursor- $ case ix of- Z :. y :. x -> off + y * aWidth + x+ {-# INLINE shiftc #-}+ shiftc ix (Cursor off)+ = Cursor+ $ case ix of+ Z :. y :. x -> off + y * aWidth + x {-# INLINE arrInternal #-} arrInternal = makeCursored (extent arr) makec shiftc getInner' @@ -128,32 +132,32 @@ unsafeAppStencilCursor2- :: Source r a- => (DIM2 -> Cursor -> Cursor)- -> Stencil DIM2 a- -> Array r DIM2 a- -> Cursor- -> a+ :: Source r a+ => (DIM2 -> Cursor -> Cursor)+ -> Stencil DIM2 a+ -> Array r DIM2 a+ -> Cursor+ -> a {-# INLINE unsafeAppStencilCursor2 #-} unsafeAppStencilCursor2 shift (StencilStatic sExtent zero loads)- arr cur0+ arr cur0 - | _ :. sHeight :. sWidth <- sExtent- , sHeight <= 7, sWidth <= 7- = let- -- Get data from the manifest array.- {-# INLINE getData #-}- getData (Cursor cur) = arr `unsafeLinearIndex` cur+ | _ :. sHeight :. sWidth <- sExtent+ , sHeight <= 7, sWidth <= 7+ = let+ -- Get data from the manifest array.+ {-# INLINE getData #-}+ getData (Cursor cur) = arr `unsafeLinearIndex` cur - -- Build a function to pass data from the array to our stencil.- {-# INLINE oload #-}- oload oy ox- = let !cur' = shift (Z :. oy :. ox) cur0- in loads (Z :. oy :. ox) (getData cur')+ -- Build a function to pass data from the array to our stencil.+ {-# INLINE oload #-}+ oload oy ox+ = let !cur' = shift (Z :. oy :. ox) cur0+ in loads (Z :. oy :. ox) (getData cur') - in template7x7 oload zero+ in template7x7 oload zero | otherwise = error $ unlines @@ -213,55 +217,55 @@ -- | Like above, but clamp out of bounds array values to the closest real value. unsafeAppStencilCursor2_clamp- :: forall r a- . Source r a- => (DIM2 -> DIM2 -> DIM2)- -> Stencil DIM2 a- -> Array r DIM2 a- -> DIM2- -> a+ :: forall r a+ . Source r a+ => (DIM2 -> DIM2 -> DIM2)+ -> Stencil DIM2 a+ -> Array r DIM2 a+ -> DIM2+ -> a {-# INLINE unsafeAppStencilCursor2_clamp #-} unsafeAppStencilCursor2_clamp shift- (StencilStatic sExtent zero loads)- arr cur+ (StencilStatic sExtent zero loads)+ arr cur - | _ :. sHeight :. sWidth <- sExtent- , _ :. (I# aHeight) :. (I# aWidth) <- extent arr- , sHeight <= 7, sWidth <= 7- = let- -- Get data from the manifest array.- {-# INLINE getData #-}- getData :: DIM2 -> a- getData (Z :. (I# y) :. (I# x))- = wrapLoadX x y+ | _ :. sHeight :. sWidth <- sExtent+ , _ :. (I# aHeight) :. (I# aWidth) <- extent arr+ , sHeight <= 7, sWidth <= 7+ = let+ -- Get data from the manifest array.+ {-# INLINE getData #-}+ getData :: DIM2 -> a+ getData (Z :. (I# y) :. (I# x))+ = wrapLoadX x y {-# NOINLINE wrapLoadX #-}- wrapLoadX :: Int# -> Int# -> a- wrapLoadX !x !y- | 1# <- x <# 0# = wrapLoadY 0# y- | 1# <- x >=# aWidth = wrapLoadY (aWidth -# 1#) y- | otherwise = wrapLoadY x y+ wrapLoadX :: Int# -> Int# -> a+ wrapLoadX !x !y+ | 1# <- x <# 0# = wrapLoadY 0# y+ | 1# <- x >=# aWidth = wrapLoadY (aWidth -# 1#) y+ | otherwise = wrapLoadY x y - {-# NOINLINE wrapLoadY #-}- wrapLoadY :: Int# -> Int# -> a- wrapLoadY !x !y- | 1# <- y <# 0# = loadXY x 0#- | 1# <- y >=# aHeight = loadXY x (aHeight -# 1#)- | otherwise = loadXY x y+ {-# NOINLINE wrapLoadY #-}+ wrapLoadY :: Int# -> Int# -> a+ wrapLoadY !x !y+ | 1# <- y <# 0# = loadXY x 0#+ | 1# <- y >=# aHeight = loadXY x (aHeight -# 1#)+ | otherwise = loadXY x y - {-# INLINE loadXY #-}- loadXY :: Int# -> Int# -> a- loadXY !x !y- = arr `unsafeIndex` (Z :. (I# y) :. (I# x))+ {-# INLINE loadXY #-}+ loadXY :: Int# -> Int# -> a+ loadXY !x !y+ = arr `unsafeIndex` (Z :. (I# y) :. (I# x)) - -- Build a function to pass data from the array to our stencil.- {-# INLINE oload #-}- oload oy ox- = let !cur' = shift (Z :. oy :. ox) cur- in loads (Z :. oy :. ox) (getData cur')+ -- Build a function to pass data from the array to our stencil.+ {-# INLINE oload #-}+ oload oy ox+ = let !cur' = shift (Z :. oy :. ox) cur+ in loads (Z :. oy :. ox) (getData cur') - in template7x7 oload zero+ in template7x7 oload zero | otherwise = error $ unlines @@ -271,17 +275,17 @@ -- | Data template for stencils up to 7x7. template7x7- :: (Int -> Int -> a -> a)- -> a -> a+ :: (Int -> Int -> a -> a)+ -> a -> a {-# INLINE template7x7 #-} template7x7 f zero- = f (-3) (-3) $ f (-3) (-2) $ f (-3) (-1) $ f (-3) 0 $ f (-3) 1 $ f (-3) 2 $ f (-3) 3- $ f (-2) (-3) $ f (-2) (-2) $ f (-2) (-1) $ f (-2) 0 $ f (-2) 1 $ f (-2) 2 $ f (-2) 3- $ f (-1) (-3) $ f (-1) (-2) $ f (-1) (-1) $ f (-1) 0 $ f (-1) 1 $ f (-1) 2 $ f (-1) 3- $ f 0 (-3) $ f 0 (-2) $ f 0 (-1) $ f 0 0 $ f 0 1 $ f 0 2 $ f 0 3- $ f 1 (-3) $ f 1 (-2) $ f 1 (-1) $ f 1 0 $ f 1 1 $ f 1 2 $ f 1 3- $ f 2 (-3) $ f 2 (-2) $ f 2 (-1) $ f 2 0 $ f 2 1 $ f 2 2 $ f 2 3- $ f 3 (-3) $ f 3 (-2) $ f 3 (-1) $ f 3 0 $ f 3 1 $ f 3 2 $ f 3 3- $ zero+ = f (-3) (-3) $ f (-3) (-2) $ f (-3) (-1) $ f (-3) 0 $ f (-3) 1 $ f (-3) 2 $ f (-3) 3+ $ f (-2) (-3) $ f (-2) (-2) $ f (-2) (-1) $ f (-2) 0 $ f (-2) 1 $ f (-2) 2 $ f (-2) 3+ $ f (-1) (-3) $ f (-1) (-2) $ f (-1) (-1) $ f (-1) 0 $ f (-1) 1 $ f (-1) 2 $ f (-1) 3+ $ f 0 (-3) $ f 0 (-2) $ f 0 (-1) $ f 0 0 $ f 0 1 $ f 0 2 $ f 0 3+ $ f 1 (-3) $ f 1 (-2) $ f 1 (-1) $ f 1 0 $ f 1 1 $ f 1 2 $ f 1 3+ $ f 2 (-3) $ f 2 (-2) $ f 2 (-1) $ f 2 0 $ f 2 1 $ f 2 2 $ f 2 3+ $ f 3 (-3) $ f 3 (-2) $ f 3 (-1) $ f 3 0 $ f 3 1 $ f 3 2 $ f 3 3+ $ zero
Data/Array/Repa/Stencil/Template.hs view
@@ -2,12 +2,12 @@ -- | Template module Data.Array.Repa.Stencil.Template- (stencil2)+ (stencil2) where import Data.Array.Repa.Index import Language.Haskell.TH import Language.Haskell.TH.Quote-import qualified Data.List as List+import qualified Data.List as List -- | QuasiQuoter for producing a static stencil defintion. --@@ -33,10 +33,10 @@ -- stencil2 :: QuasiQuoter stencil2 = QuasiQuoter- { quoteExp = parseStencil2- , quotePat = undefined- , quoteType = undefined- , quoteDec = undefined }+ { quoteExp = parseStencil2+ , quotePat = undefined+ , quoteType = undefined+ , quoteDec = undefined } -- | Parse a stencil definition.@@ -44,55 +44,55 @@ parseStencil2 :: String -> Q Exp parseStencil2 str = let- -- Determine the extent of the stencil based on the layout.- -- TODO: make this more robust. In particular, handle blank- -- lines at the start of the definition.- line1 : _ = lines str- sizeX = fromIntegral $ length $ lines str- sizeY = fromIntegral $ length $ words line1+ -- Determine the extent of the stencil based on the layout.+ -- TODO: make this more robust. In particular, handle blank+ -- lines at the start of the definition.+ line1 : _ = lines str+ sizeX = fromIntegral $ length $ lines str+ sizeY = fromIntegral $ length $ words line1 - -- TODO: this probably doesn't work for stencils who's extents are even.- minX = negate (sizeX `div` 2)- minY = negate (sizeY `div` 2)- maxX = sizeX `div` 2- maxY = sizeY `div` 2+ -- TODO: this probably doesn't work for stencils who's extents are even.+ minX = negate (sizeX `div` 2)+ minY = negate (sizeY `div` 2)+ maxX = sizeX `div` 2+ maxY = sizeY `div` 2 - -- List of coefficients for the stencil.- coeffs = (List.map read $ words str) :: [Integer]+ -- List of coefficients for the stencil.+ coeffs = (List.map read $ words str) :: [Integer] - in makeStencil2' sizeX sizeY- $ filter (\(_, _, v) -> v /= 0)- $ [ (fromIntegral y, fromIntegral x, fromIntegral v)- | y <- [minX, minX + 1 .. maxX]- , x <- [minY, minY + 1 .. maxY]- | v <- coeffs ]+ in makeStencil2' sizeX sizeY+ $ filter (\(_, _, v) -> v /= 0)+ $ [ (fromIntegral y, fromIntegral x, fromIntegral v)+ | y <- [minX, minX + (1 :: Integer) .. maxX]+ , x <- [minY, minY + (1 :: Integer) .. maxY]+ | v <- coeffs ] makeStencil2'- :: Integer -> Integer- -> [(Integer, Integer, Integer)]- -> Q Exp+ :: Integer -> Integer+ -> [(Integer, Integer, Integer)]+ -> Q Exp makeStencil2' sizeX sizeY coeffs- = do ix' <- newName "ix"- z' <- [p| Z |]- coeffs' <- newName "coeffs"+ = do ix' <- newName "ix"+ z' <- [p| Z |]+ coeffs' <- newName "coeffs" - let fnCoeffs- = LamE [VarP ix']- $ CaseE (VarE (mkName "ix"))- $ [ Match (InfixP (InfixP z' (mkName ":.") (LitP (IntegerL oy)))+ let fnCoeffs+ = LamE [VarP ix']+ $ CaseE (VarE (mkName "ix"))+ $ [ Match (InfixP (InfixP z' (mkName ":.") (LitP (IntegerL oy))) (mkName ":.") (LitP (IntegerL ox)))- (NormalB $ ConE (mkName "Just") `AppE` LitE (IntegerL v))- [] | (oy, ox, v) <- coeffs ]- ++ [Match WildP- (NormalB $ ConE (mkName "Nothing")) []]+ (NormalB $ ConE (mkName "Just") `AppE` LitE (IntegerL v))+ [] | (oy, ox, v) <- coeffs ]+ ++ [Match WildP+ (NormalB $ ConE (mkName "Nothing")) []] - return- $ AppE (VarE (mkName "makeStencil2") + return+ $ AppE (VarE (mkName "makeStencil2") `AppE` (LitE (IntegerL sizeX)) `AppE` (LitE (IntegerL sizeY))) $ LetE [ PragmaD (InlineP (mkName "coeffs") Inline FunLike (BeforePhase 0))- , ValD (VarP coeffs') (NormalB fnCoeffs) [] ]- (VarE (mkName "coeffs"))+ , ValD (VarP coeffs') (NormalB fnCoeffs) [] ]+ (VarE (mkName "coeffs"))
repa.cabal view
@@ -1,15 +1,15 @@ Name: repa-Version: 3.2.5.1+Version: 3.4.2.0 License: BSD3 License-file: LICENSE Author: The DPH Team Maintainer: Ben Lippmeier <benl@ouroborus.net> Build-Type: Simple-Cabal-Version: >=1.6+Cabal-Version: >=1.10 Stability: experimental Category: Data Structures Homepage: http://repa.ouroborus.net-Bug-reports: repa@ouroborus.net+Bug-reports: http://groups.google.com/d/forum/haskell-repa Description: Repa provides high performance, regular, multi-dimensional, shape polymorphic parallel arrays. All numeric data is stored unboxed. Functions written with@@ -19,22 +19,38 @@ Synopsis: High performance, regular, shape polymorphic parallel arrays. +Flag no-template-haskell+ Default: False+ Description: Disable Template Haskell+ Library- Build-Depends: - base == 4.7.*,- template-haskell == 2.9.*,- vector == 0.10.*,- ghc-prim == 0.3.*,- bytestring == 0.10.*,- QuickCheck == 2.7.*+ Build-Depends:+ base >= 4.8 && < 4.21+ , template-haskell+ , ghc-prim+ , vector >= 0.11 && < 0.14+ , bytestring >= 0.10 && < 0.13+ , QuickCheck >= 2.8 && < 2.16 ghc-options:- -Wall -fno-warn-missing-signatures- -Odph+ -Wall+ -O2+ -fmax-simplifier-iterations=20+ -fsimplifier-phases=3 -funbox-strict-fields- -fcpr-off+ -fno-warn-missing-signatures - extensions:+ if impl(ghc >= 8.0)+ ghc-options: -fno-cpr-anal+ else+ ghc-options: -fcpr-off++ if flag(no-template-haskell)+ cpp-options: -DREPA_NO_TH++ default-language: Haskell2010++ default-extensions: NoMonomorphismRestriction ExplicitForAll EmptyDataDecls@@ -48,6 +64,13 @@ PatternGuards ExistentialQuantification + other-extensions:+ CPP++ if !flag(no-template-haskell)+ other-extensions:+ TemplateHaskell+ Exposed-modules: Data.Array.Repa.Eval.Gang Data.Array.Repa.Operators.IndexSpace@@ -87,7 +110,11 @@ Data.Array.Repa.Eval.Reduction Data.Array.Repa.Eval.Selection Data.Array.Repa.Stencil.Base- Data.Array.Repa.Stencil.Template Data.Array.Repa.Stencil.Partition Data.Array.Repa.Base- ++ if !flag(no-template-haskell)+ Other-modules:+ Data.Array.Repa.Stencil.Template++-- vim: nospell