diff --git a/Data/Array/Repa.hs b/Data/Array/Repa.hs --- a/Data/Array/Repa.hs +++ b/Data/Array/Repa.hs @@ -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 diff --git a/Data/Array/Repa/Arbitrary.hs b/Data/Array/Repa/Arbitrary.hs --- a/Data/Array/Repa/Arbitrary.hs +++ b/Data/Array/Repa/Arbitrary.hs @@ -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 diff --git a/Data/Array/Repa/Eval/Chunked.hs b/Data/Array/Repa/Eval/Chunked.hs --- a/Data/Array/Repa/Eval/Chunked.hs +++ b/Data/Array/Repa/Eval/Chunked.hs @@ -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 #-} diff --git a/Data/Array/Repa/Eval/Cursored.hs b/Data/Array/Repa/Eval/Cursored.hs --- a/Data/Array/Repa/Eval/Cursored.hs +++ b/Data/Array/Repa/Eval/Cursored.hs @@ -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#) diff --git a/Data/Array/Repa/Eval/Elt.hs b/Data/Array/Repa/Eval/Elt.hs --- a/Data/Array/Repa/Eval/Elt.hs +++ b/Data/Array/Repa/Eval/Elt.hs @@ -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) diff --git a/Data/Array/Repa/Eval/Gang.hs b/Data/Array/Repa/Eval/Gang.hs --- a/Data/Array/Repa/Eval/Gang.hs +++ b/Data/Array/Repa/Eval/Gang.hs @@ -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. diff --git a/Data/Array/Repa/Eval/Reduction.hs b/Data/Array/Repa/Eval/Reduction.hs --- a/Data/Array/Repa/Eval/Reduction.hs +++ b/Data/Array/Repa/Eval/Reduction.hs @@ -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 #-} diff --git a/Data/Array/Repa/Eval/Selection.hs b/Data/Array/Repa/Eval/Selection.hs --- a/Data/Array/Repa/Eval/Selection.hs +++ b/Data/Array/Repa/Eval/Selection.hs @@ -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 diff --git a/Data/Array/Repa/Index.hs b/Data/Array/Repa/Index.hs --- a/Data/Array/Repa/Index.hs +++ b/Data/Array/Repa/Index.hs @@ -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) diff --git a/Data/Array/Repa/Operators/IndexSpace.hs b/Data/Array/Repa/Operators/IndexSpace.hs --- a/Data/Array/Repa/Operators/IndexSpace.hs +++ b/Data/Array/Repa/Operators/IndexSpace.hs @@ -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 diff --git a/Data/Array/Repa/Operators/Interleave.hs b/Data/Array/Repa/Operators/Interleave.hs --- a/Data/Array/Repa/Operators/Interleave.hs +++ b/Data/Array/Repa/Operators/Interleave.hs @@ -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" diff --git a/Data/Array/Repa/Operators/Mapping.hs b/Data/Array/Repa/Operators/Mapping.hs --- a/Data/Array/Repa/Operators/Mapping.hs +++ b/Data/Array/Repa/Operators/Mapping.hs @@ -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 (/^) #-} diff --git a/Data/Array/Repa/Operators/Reduction.hs b/Data/Array/Repa/Operators/Reduction.hs --- a/Data/Array/Repa/Operators/Reduction.hs +++ b/Data/Array/Repa/Operators/Reduction.hs @@ -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 diff --git a/Data/Array/Repa/Operators/Selection.hs b/Data/Array/Repa/Operators/Selection.hs --- a/Data/Array/Repa/Operators/Selection.hs +++ b/Data/Array/Repa/Operators/Selection.hs @@ -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 #-} diff --git a/Data/Array/Repa/Operators/Traversal.hs b/Data/Array/Repa/Operators/Traversal.hs --- a/Data/Array/Repa/Operators/Traversal.hs +++ b/Data/Array/Repa/Operators/Traversal.hs @@ -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 #-} diff --git a/Data/Array/Repa/Repr/ByteString.hs b/Data/Array/Repa/Repr/ByteString.hs --- a/Data/Array/Repa/Repr/ByteString.hs +++ b/Data/Array/Repa/Repr/ByteString.hs @@ -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 #-} diff --git a/Data/Array/Repa/Repr/Unboxed.hs b/Data/Array/Repa/Repr/Unboxed.hs --- a/Data/Array/Repa/Repr/Unboxed.hs +++ b/Data/Array/Repa/Repr/Unboxed.hs @@ -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 #-} diff --git a/Data/Array/Repa/Repr/Undefined.hs b/Data/Array/Repa/Repr/Undefined.hs --- a/Data/Array/Repa/Repr/Undefined.hs +++ b/Data/Array/Repa/Repr/Undefined.hs @@ -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 () diff --git a/Data/Array/Repa/Repr/Vector.hs b/Data/Array/Repa/Repr/Vector.hs --- a/Data/Array/Repa/Repr/Vector.hs +++ b/Data/Array/Repa/Repr/Vector.hs @@ -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 #-} diff --git a/Data/Array/Repa/Shape.hs b/Data/Array/Repa/Shape.hs --- a/Data/Array/Repa/Shape.hs +++ b/Data/Array/Repa/Shape.hs @@ -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 diff --git a/Data/Array/Repa/Slice.hs b/Data/Array/Repa/Slice.hs --- a/Data/Array/Repa/Slice.hs +++ b/Data/Array/Repa/Slice.hs @@ -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 diff --git a/Data/Array/Repa/Specialised/Dim2.hs b/Data/Array/Repa/Specialised/Dim2.hs --- a/Data/Array/Repa/Specialised/Dim2.hs +++ b/Data/Array/Repa/Specialised/Dim2.hs @@ -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 diff --git a/Data/Array/Repa/Stencil.hs b/Data/Array/Repa/Stencil.hs --- a/Data/Array/Repa/Stencil.hs +++ b/Data/Array/Repa/Stencil.hs @@ -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 diff --git a/Data/Array/Repa/Stencil/Base.hs b/Data/Array/Repa/Stencil/Base.hs --- a/Data/Array/Repa/Stencil/Base.hs +++ b/Data/Array/Repa/Stencil/Base.hs @@ -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 diff --git a/Data/Array/Repa/Stencil/Dim2.hs b/Data/Array/Repa/Stencil/Dim2.hs --- a/Data/Array/Repa/Stencil/Dim2.hs +++ b/Data/Array/Repa/Stencil/Dim2.hs @@ -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 diff --git a/Data/Array/Repa/Stencil/Template.hs b/Data/Array/Repa/Stencil/Template.hs --- a/Data/Array/Repa/Stencil/Template.hs +++ b/Data/Array/Repa/Stencil/Template.hs @@ -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")) diff --git a/repa.cabal b/repa.cabal --- a/repa.cabal +++ b/repa.cabal @@ -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 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