repa 3.0.0.1 → 3.4.2.0
raw patch · 42 files changed
Files
- Data/Array/Repa.hs +108/−55
- Data/Array/Repa/Arbitrary.hs +125/−0
- Data/Array/Repa/Base.hs +47/−17
- Data/Array/Repa/Eval.hs +74/−48
- Data/Array/Repa/Eval/Chunked.hs +135/−80
- Data/Array/Repa/Eval/Cursored.hs +121/−121
- Data/Array/Repa/Eval/Elt.hs +129/−54
- Data/Array/Repa/Eval/Fill.hs +0/−71
- Data/Array/Repa/Eval/Gang.hs +24/−24
- Data/Array/Repa/Eval/Interleaved.hs +61/−0
- Data/Array/Repa/Eval/Load.hs +36/−0
- Data/Array/Repa/Eval/Reduction.hs +31/−28
- Data/Array/Repa/Eval/Selection.hs +81/−76
- Data/Array/Repa/Eval/Target.hs +49/−0
- Data/Array/Repa/Index.hs +108/−86
- Data/Array/Repa/Operators/IndexSpace.hs +142/−101
- Data/Array/Repa/Operators/Interleave.hs +71/−71
- Data/Array/Repa/Operators/Mapping.hs +106/−69
- Data/Array/Repa/Operators/Reduction.hs +128/−61
- Data/Array/Repa/Operators/Selection.hs +21/−20
- Data/Array/Repa/Operators/Traversal.hs +57/−63
- Data/Array/Repa/Repr/ByteString.hs +18/−16
- Data/Array/Repa/Repr/Cursored.hs +62/−45
- Data/Array/Repa/Repr/Delayed.hs +61/−40
- Data/Array/Repa/Repr/ForeignPtr.hs +44/−33
- Data/Array/Repa/Repr/HintInterleave.hs +76/−0
- Data/Array/Repa/Repr/HintSmall.hs +77/−0
- Data/Array/Repa/Repr/Partitioned.hs +31/−29
- Data/Array/Repa/Repr/Unboxed.hs +59/−49
- Data/Array/Repa/Repr/Undefined.hs +22/−12
- Data/Array/Repa/Repr/Vector.hs +43/−33
- Data/Array/Repa/Shape.hs +44/−44
- Data/Array/Repa/Slice.hs +40/−40
- Data/Array/Repa/Specialised/Dim2.hs +66/−56
- Data/Array/Repa/Stencil.hs +4/−7
- Data/Array/Repa/Stencil/Base.hs +29/−26
- Data/Array/Repa/Stencil/Dim2.hs +193/−130
- Data/Array/Repa/Stencil/Partition.hs +74/−0
- Data/Array/Repa/Stencil/Template.hs +44/−44
- Data/Array/Repa/Unsafe.hs +14/−0
- LICENSE +21/−20
- repa.cabal +51/−18
Data/Array/Repa.hs view
@@ -1,6 +1,8 @@-+{-# OPTIONS -fno-warn-unused-imports #-} -- | Repa arrays are wrappers around a linear structure that holds the element--- data. The representation tag determines what structure holds the data.+-- data. +-- +-- The representation tag determines what structure holds the data. -- -- Delayed Representations (functions that compute elements) --@@ -22,6 +24,14 @@ -- -- * `P` -- Arrays that are partitioned into several representations. --+-- * `S` -- Hints that computing this array is a small amount of work,+-- so computation should be sequential rather than parallel to avoid+-- scheduling overheads.+-- +-- * `I` -- Hints that computing this array will be an unbalanced workload,+-- so computation of successive elements should be interleaved between+-- the processors+-- -- * `X` -- Arrays whose elements are all undefined. -- -- Array fusion is achieved via the delayed (`D`) and cursored (`C`)@@ -29,11 +39,8 @@ -- contained within `D` and `C` arrays without needing to create manifest -- intermediate arrays. ----- Converting between the parallel manifest representations (eg `U` and `B`)--- is either constant time or parallel copy, depending on the compatability--- of the physical representation. ----- /Writing fast code:/+-- /Advice for writing fast code:/ -- -- 1. Repa does not support nested parallellism. -- This means that you cannot `map` a parallel worker function across@@ -43,29 +50,68 @@ -- -- 2. Arrays of type @(Array D sh a)@ or @(Array C sh a)@ are /not real arrays/. -- They are represented as functions that compute each element on demand.--- You need to use a function like `computeS`, `computeP`, `computeUnboxedP`+-- You need to use `computeS`, `computeP`, `computeUnboxedP` -- and so on to actually evaluate the elements. -- --- 3. You should add @INLINE@ pragmas to all leaf-functions in your code, --- expecially ones that compute numberic results. This ensures they are --- specialised at the appropriate element types.+-- 3. Add @INLINE@ pragmas to all leaf-functions in your code, expecially ones+-- that compute numeric results. Non-inlined lazy function calls can cost+-- upwards of 50 cycles each, while each numeric operator only costs one (or less).+-- Inlining leaf functions also ensures they are specialised at the appropriate+-- numeric types.+-- +-- 4. Add bang patterns to all function arguments, and all fields of your data+-- types. In a high-performance Haskell program, the cost of lazy evaluation+-- can easily dominate the run time if not handled correctly. You don't want+-- to rely on the strictness analyser in numeric code because if it does not+-- return a perfect result then the performance of your program will be awful.+-- This is less of a problem for general Haskell code, and in a different+-- context relying on strictness analysis is fine. ----- 4. Scheduling a parallel computation takes about 200us on an OSX machine. --- You should sequential computation for small arrays in inner loops, --- or a the bottom of a divide-and-conquer algorithm.+-- 5. Scheduling an 8-thread parallel computation can take 50us on a Linux machine. +-- You should switch to sequential evaluation functions like `computeS` and+-- `foldS` for small arrays in inner loops, and at the bottom of a +-- divide-and-conquer algorithm. Consider using a `computeP` that evaluates+-- an array defined using `computeS` or `foldS` for each element. --+-- 6. Compile the modules that use Repa with the following flags:+-- @-Odph -rtsopts -threaded@+-- @-fno-liberate-case -funfolding-use-threshold1000 -funfolding-keeness-factor1000@+-- @-fllvm -optlo-O3@+-- You don't want the liberate-case transform because it tends to duplicate+-- too much intermediate code, and is not needed if you use bang patterns+-- as per point 4. The unfolding flags tell the inliner to not to fool around with +-- heuristics, and just inline everything. If the binaries become too big then +-- split the array part of your program into separate modules and only compile+-- those with the unfolding flags.+--+-- 7. Repa writes to the GHC eventlog at the start and end of each parallel computation.+-- Use threadscope to see what your program is doing.+--+-- 8. When you're sure your program works, switch to the unsafe versions+-- of functions like `traverse`. These don't do bounds checks.+--+-- /Changes for Repa 3.2:/+--+-- 1. Renamed some Repa 3.1 type classes to have more intuitive names: +-- `Repr` -> `Source`, `Fill` -> `Load`, `Fillable` -> `Target`, `Combine` -> `Structured`.+--+-- 2. Also renamed `MArray` -> `MVec` to emphasise its linear structure.+--+-- 3. Made `Array` and `MVec` associated types of `Source` and `Target` respectively.+--+-- 4. Added the `S` (Smallness) and `I` (Interleave) hints.+-- module Data.Array.Repa ( -- * Abstract array representation- Array(..)- , module Data.Array.Repa.Shape+ module Data.Array.Repa.Shape , module Data.Array.Repa.Index- , Repr(..), (!), toList+ , Array (..)+ , Source(..), (!), toList , deepSeqArrays - -- * Converting between array representations+ -- * Computation , computeP, computeS , copyP, copyS- , now -- * Concrete array representations -- ** Delayed representation@@ -79,48 +125,52 @@ , fromUnboxed , toUnboxed - -- from Data.Array.Repa.Operators.IndexSpace ----------------+ -- from Data.Array.Repa.Operators.IndexSpace ---------------- -- * Operators- -- ** Index space transformations- , reshape- , append, (++)- , transpose- , extend- , backpermute, unsafeBackpermute- , backpermuteDft+ -- ** Index space transformations+ , reshape+ , append, (++)+ , extract+ , transpose+ , backpermute+ , backpermuteDft - , module Data.Array.Repa.Slice- , slice+ -- ** Slice transformations+ , module Data.Array.Repa.Slice+ , slice+ , extend - -- from Data.Array.Repa.Operators.Mapping -------------------+ -- from Data.Array.Repa.Operators.Mapping ------------------- -- ** Structure preserving operations- , map- , zipWith- , (+^), (-^), (*^), (/^)- , Combine(..)+ , map+ , zipWith+ , (+^), (-^), (*^), (/^)+ , Structured(..) - -- from Data.Array.Repa.Operators.Traversal ------------------- -- ** Generic traversal- , traverse, unsafeTraverse- , traverse2, unsafeTraverse2- , traverse3, unsafeTraverse3- , traverse4, unsafeTraverse4- - -- 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.Selection ------------------- , select)+ -- 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 ------------------+ -- ** Selection+ , selectP) where import Data.Array.Repa.Base import Data.Array.Repa.Shape@@ -132,6 +182,8 @@ import Data.Array.Repa.Repr.Unboxed import Data.Array.Repa.Repr.ByteString import Data.Array.Repa.Repr.ForeignPtr+import Data.Array.Repa.Repr.HintSmall+import Data.Array.Repa.Repr.HintInterleave import Data.Array.Repa.Repr.Cursored import Data.Array.Repa.Repr.Partitioned import Data.Array.Repa.Repr.Undefined ()@@ -141,6 +193,7 @@ import Data.Array.Repa.Operators.Interleave import Data.Array.Repa.Operators.Reduction import Data.Array.Repa.Operators.Selection+import Data.Array.Repa.Arbitrary () import Prelude ()
+ Data/Array/Repa/Arbitrary.hs view
@@ -0,0 +1,125 @@+{-# LANGUAGE TypeOperators, FlexibleInstances, MultiParamTypeClasses, ScopedTypeVariables #-}+{-# OPTIONS_GHC -fno-warn-orphans #-}+module Data.Array.Repa.Arbitrary+ ( -- * Arbitrary Unboxed Arrays+ arbitraryUShaped+ , forAllUShaped+ , forAll2UShaped+ , forAll3UShaped+ , forAll4UShaped+ , forAll5UShaped++ -- * Arbitrary Boxed Arrays+ , arbitraryVShaped+ , forAllVShaped+ , forAll2VShaped+ , forAll3VShaped+ , forAll4VShaped+ , forAll5VShaped)+where+import Data.Array.Repa.Base+import Data.Array.Repa.Repr.Unboxed+import Data.Array.Repa.Shape+import Data.Array.Repa.Index+import Test.QuickCheck.Arbitrary+import Test.QuickCheck.Gen+import Test.QuickCheck.Property (forAll)+import Control.Monad+import qualified Data.Array.Repa.Repr.Vector as V+import qualified Data.Vector.Unboxed as U+++-- Aribrary -------------------------------------------------------------------+-- | This module exports instances of @Arbitrary@ and @CoArbitrary@ for+-- unboxed Repa arrays.+instance Arbitrary Z where+ arbitrary = return Z+++-- Note: this is a shape that is "sized", and then random array for a given+-- shape is generated.+instance Arbitrary a + => Arbitrary (a :. Int) where+ arbitrary + = sized (\n -> do + 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)+++-- | Generates a random unboxed array of a given shape+arbitraryUShaped sh = fromListUnboxed sh `fmap` vector (size sh)+++-- | Generates a random boxed array of a given shape+arbitraryVShaped sh = V.fromListVector sh `fmap` vector (size sh)+++instance (Arbitrary sh, Arbitrary a, U.Unbox a, Shape sh) + => Arbitrary (Array U sh a) where+ arbitrary = arbitrary >>= arbitraryUShaped+++instance (Arbitrary sh, Arbitrary a, Shape sh) + => Arbitrary (Array V.V sh a) where+ arbitrary = arbitrary >>= arbitraryVShaped+++-- CoArbitrary ----------------------------------------------------------------+instance CoArbitrary Z where+ coarbitrary _ = id ++instance (CoArbitrary a) + => CoArbitrary (a :. Int) where+ coarbitrary (a :. b) = coarbitrary a . coarbitrary b++instance (CoArbitrary sh, CoArbitrary a, Source r a, Shape sh) + => CoArbitrary (Array r sh a) where+ coarbitrary arr + = (coarbitrary . extent $ arr) . (coarbitrary . toList $ arr)+++-- Wrappers -------------------------------------------------------------------+-- | Convenience functions for writing tests on 2-,3-,4-tuples of arrays+-- of the same size (or just of a fixed size.)++-- | These are helper functions:+forAll2 arbf = forAll $ liftM2 (,) arbf arbf+forAll3 arbf = forAll $ liftM3 (,,) arbf arbf arbf+forAll4 arbf = forAll $ liftM4 (,,,) arbf arbf arbf arbf+forAll5 arbf = forAll $ liftM5 (,,,,) arbf arbf arbf arbf arbf+++-- | Property tested for unboxed random arrays with a given shape.+forAllUShaped sh = forAll $ arbitraryUShaped sh++-- | Property tested for pair of unboxed random arrays with a given shape.+forAll2UShaped sh = forAll2 $ arbitraryUShaped sh++-- | Property tested for triple of unboxed random arrays with a given shape.+forAll3UShaped sh = forAll3 $ arbitraryUShaped sh++-- | Property tested for quadruple of unboxed random arrays with a given shape.+forAll4UShaped sh = forAll4 $ arbitraryUShaped sh++-- | Property tested for 5-tuple of unboxed random arrays with a given shape.+forAll5UShaped sh = forAll5 $ arbitraryUShaped sh+++-- | Property tested for unboxed random arrays with a given shape.+forAllVShaped sh = forAll $ arbitraryVShaped sh++-- | Property tested for pair of unboxed random arrays with a given shape.+forAll2VShaped sh = forAll2 $ arbitraryVShaped sh++-- | Property tested for triple of unboxed random arrays with a given shape.+forAll3VShaped sh = forAll3 $ arbitraryVShaped sh++-- | Property tested for quadruple of unboxed random arrays with a given shape.+forAll4VShaped sh = forAll4 $ arbitraryVShaped sh++-- | Property tested for 5-tuple of unboxed random arrays with a given shape.+forAll5VShaped sh = forAll5 $ arbitraryVShaped sh
Data/Array/Repa/Base.hs view
@@ -1,25 +1,24 @@ module Data.Array.Repa.Base- ( Array- , Repr (..), (!), toList+ ( Source (..), (!), toList , deepSeqArrays) where import Data.Array.Repa.Shape --- | Arrays with a representation tag, shape, and element type.--- Use one of the type tags like `D`, `U` and so on for @r@, --- one of `DIM1`, `DIM2` ... for @sh@.-data family Array r sh e -+-- Source ----------------------------------------------------------------------- -- | Class of array representations that we can read elements from.----class Repr r e where- -- | O(1). Take the extent of an array.- extent :: Shape sh => Array r sh e -> sh+class Source r e where+ -- Arrays with a representation tag, shape, and element type.+ -- Use one of the type tags like `D`, `U` and so on for @r@, + -- one of `DIM1`, `DIM2` ... for @sh@.+ data Array r sh e + -- | O(1). Take the extent (size) of an array.+ extent :: Shape sh => Array r sh e -> sh+ -- | O(1). Shape polymorphic indexing.- index, unsafeIndex+ index, unsafeIndex :: Shape sh => Array r sh e -> sh -> e {-# INLINE index #-}@@ -36,16 +35,17 @@ unsafeLinearIndex = linearIndex -- | Ensure an array's data structure is fully evaluated.- deepSeqArray :: Shape sh => Array r sh e -> b -> b+ deepSeqArray + :: Shape sh =>Array r sh e -> b -> b -- | O(1). Alias for `index`-(!) :: (Repr r e, Shape sh) => Array r sh e -> sh -> e+(!) :: Shape sh => Source r e => Array r sh e -> sh -> e (!) = index -- | O(n). Convert an array to a list.-toList :: (Shape sh, Repr r e)+toList :: Shape sh => Source r e => Array r sh e -> [e] {-# INLINE toList #-} toList arr @@ -57,12 +57,40 @@ -- | Apply `deepSeqArray` to up to four arrays. ---+---+-- NOTE: this shouldn't be needed anymore, as we've made all the shape fields strict.+-- -- The implementation of this function has been hand-unwound to work for up to -- four arrays. Putting more in the list yields `error`. -- +-- For functions that are /not/ marked as INLINE, you should apply `deepSeqArrays`+-- to argument arrays before using them in a @compute@ or @copy@ expression.+-- For example:+--+-- @ processArrays +-- :: Monad m +-- => Array U DIM2 Int -> Array U DIM2 Int +-- -> m (Array U DIM2 Int)+-- processArrays arr1 arr2+-- = [arr1, arr2] \`deepSeqArrays\` +-- do arr3 <- computeP $ map f arr1+-- arr4 <- computeP $ zipWith g arr3 arr2+-- return arr4+-- @+--+-- Applying `deepSeqArrays` tells the GHC simplifier that it's ok to unbox +-- size fields and the pointers to the underlying array data at the start+-- of the function. Without this, they may be unboxed repeatedly when+-- computing elements in the result arrays, which will make your program slow.+--+-- If you INLINE @processArrays@ into the function that computes @arr1@ and @arr2@,+-- then you don't need to apply `deepSeqArrays`. This is because a pointer+-- to the underlying data will be passed directly to the consumers and never boxed.+--+-- If you're not sure, then just follow the example code above.+-- deepSeqArrays - :: (Shape sh, Repr r e)+ :: Shape sh => Source r e => [Array r sh e] -> b -> b {-# INLINE deepSeqArrays #-} deepSeqArrays arrs x@@ -82,4 +110,6 @@ -> a1 `deepSeqArray` a2 `deepSeqArray` a3 `deepSeqArray` a4 `deepSeqArray` x _ -> error "deepSeqArrays: only works for up to four arrays"++
Data/Array/Repa/Eval.hs view
@@ -6,21 +6,24 @@ Elt (..) -- * Parallel array filling- , Fillable (..)- , Fill (..)- , FillRange (..)+ , Target (..)+ , Load (..)+ , LoadRange (..) , fromList -- * Converting between representations- , computeP, computeS- , copyP, copyS+ , computeS, computeP, suspendedComputeP+ , copyS, copyP, suspendedCopyP , now -- * Chunked filling- , fillChunkedS+ , fillLinearS , fillChunkedP , fillChunkedIOP + -- * Interleaved filling+ , fillInterleavedP+ -- * Blockwise filling , fillBlock2P , fillBlock2S@@ -34,8 +37,10 @@ , selectChunkedP) where import Data.Array.Repa.Eval.Elt-import Data.Array.Repa.Eval.Fill+import Data.Array.Repa.Eval.Target+import Data.Array.Repa.Eval.Load import Data.Array.Repa.Eval.Chunked+import Data.Array.Repa.Eval.Interleaved import Data.Array.Repa.Eval.Cursored import Data.Array.Repa.Eval.Selection import Data.Array.Repa.Repr.Delayed@@ -46,8 +51,8 @@ -- | Parallel computation of array elements. ----- * The `Fill` class is defined so that the source array must have a--- delayed representation (`D` or `C`)+-- * The source array must have a delayed representation like `D`, `C` or `P`, +-- and the result a manifest representation like `U` or `F`. -- -- * If you want to copy data between manifest representations then use -- `copyP` instead.@@ -55,30 +60,48 @@ -- * If you want to convert a manifest array back to a delayed representation -- then use `delay` instead. ---computeP :: Fill r1 r2 sh e- => Array r1 sh e -> Array r2 sh e+computeP + :: ( Load r1 sh e+ , Target r2 e, Source r2 e, Monad m)+ => Array r1 sh e -> m (Array r2 sh e)+computeP arr = now $ suspendedComputeP arr {-# INLINE [4] computeP #-}-computeP arr1- = arr1 `deepSeqArray` - unsafePerformIO- $ do marr2 <- newMArr (size $ extent arr1) - fillP arr1 marr2- unsafeFreezeMArr (extent arr1) marr2 -- | Sequential computation of array elements. computeS - :: Fill r1 r2 sh e+ :: (Load r1 sh e, Target r2 e) => Array r1 sh e -> Array r2 sh e-{-# INLINE [4] computeS #-} computeS arr1 = arr1 `deepSeqArray` unsafePerformIO- $ do marr2 <- newMArr (size $ extent arr1) - fillS arr1 marr2- unsafeFreezeMArr (extent arr1) marr2+ $ do mvec2 <- newMVec (size $ extent arr1) + loadS arr1 mvec2+ unsafeFreezeMVec (extent arr1) mvec2+{-# INLINE [4] computeS #-} +-- | Suspended parallel computation of array elements.+--+-- This version creates a thunk that will evaluate the array on demand.+-- If you force it when another parallel computation is already running+-- then you will get a runtime warning and evaluation will be sequential. +-- Use `deepSeqArray` and `now` to ensure that each array is evaluated+-- before proceeding to the next one. +-- +-- If unsure then just use the monadic version `computeP`. This one ensures+-- that each array is fully evaluated before continuing.+--+suspendedComputeP + :: (Load r1 sh e, Target r2 e)+ => Array r1 sh e -> Array r2 sh e+suspendedComputeP arr1+ = arr1 `deepSeqArray` + unsafePerformIO+ $ do mvec2 <- newMVec (size $ extent arr1) + loadP arr1 mvec2+ unsafeFreezeMVec (extent arr1) mvec2+{-# INLINE [4] suspendedComputeP #-} -- | Parallel copying of arrays.@@ -87,44 +110,47 @@ -- -- * You can use it to copy manifest arrays between representations. ----- * You can also use it to compute elements, but doing this may not be as--- efficient. This is because delaying it the second time can hide--- information about the structure of the original computation.----copyP :: (Repr r1 e, Fill D r2 sh e)- => Array r1 sh e -> Array r2 sh e+copyP :: ( Source r1 e, Source r2 e+ , Load D sh e, Target r2 e+ , Monad m)+ => Array r1 sh e -> m (Array r2 sh e)+copyP arr = now $ suspendedCopyP arr {-# INLINE [4] copyP #-}-copyP arr1 = computeP $ delay arr1 -- | Sequential copying of arrays.-copyS :: (Repr r1 e, Fill D r2 sh e)+copyS :: ( Source r1 e+ , Load D sh e, Target r2 e) => Array r1 sh e -> Array r2 sh e+copyS arr1 = computeS $ delay arr1 {-# INLINE [4] copyS #-}-copyS arr1 = computeS $ delay arr1 - +-- | Suspended parallel copy of array elements.+suspendedCopyP + :: ( Source r1 e+ , Load D sh e, Target r2 e)+ => Array r1 sh e -> Array r2 sh e+suspendedCopyP arr1 = suspendedComputeP $ delay arr1+{-# INLINE [4] suspendedCopyP #-} --- | Apply `deepSeqArray` to an array so the result is actually constructed--- at this point in a monadic computation. ------ * Haskell's laziness means that applications of `computeP` and `copyP` are--- automatically suspended.------ * Laziness can be problematic for data parallel programs, because we want--- each array to be constructed in parallel before moving onto the next one.--- --- For example:++-- | Monadic version of `deepSeqArray`. +-- +-- Forces an suspended array computation to be completed at this point+-- in a monadic computation. ----- @ do arr2 <- now $ computeP $ map f arr1--- arr3 <- now $ computeP $ zipWith arr2 arr1--- return arr3--- @+-- @ do let arr2 = suspendedComputeP arr1+-- ...+-- arr3 <- now $ arr2+-- ...+-- @ ---now :: (Shape sh, Repr r e, Monad m)+now :: (Shape sh, Source r e, Monad m) => Array r sh e -> m (Array r sh e)-{-# INLINE [4] now #-} now arr = do arr `deepSeqArray` return () return arr+{-# INLINE [4] now #-}++
Data/Array/Repa/Eval/Chunked.hs view
@@ -2,120 +2,170 @@ -- | Evaluate an array by breaking it up into linear chunks and filling -- each chunk in parallel. module Data.Array.Repa.Eval.Chunked- ( fillChunkedP- , fillChunkedS- , fillChunkedS'- , fillChunkedIOP)+ ( fillLinearS+ , fillBlock2S+ , fillChunkedP+ , 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. -- -- * The array is filled linearly from start to finish. -- -fillChunkedS- :: 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+ :: 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 () -{-# INLINE [0] fillChunkedS #-}-fillChunkedS !(I# len) !write !getElem+fillLinearS !(I# len) write getElem = fill 0#- where fill !ix- | ix >=# len = return ()- | otherwise- = do write (I# ix) (getElem (I# ix))- fill (ix +# 1#)+ where fill !ix+ | 1# <- ix >=# len+ = return () -fillChunkedS'- :: Int- -> (Int -> IO ())+ | otherwise+ = do write (I# ix) (getElem (I# ix))+ fill (ix +# 1#)+{-# INLINE [0] fillLinearS #-}+++-------------------------------------------------------------------------------+-- | Fill a block in a rank-2 array, sequentially.+--+-- * Blockwise filling can be more cache-efficient than linear filling for+-- rank-2 arrays.+--+-- * The block is filled in row major order from top to bottom.+--+fillBlock2S+ :: (Int -> a -> IO ()) -- ^ Update function to write into result buffer.+ -> (DIM2 -> a) -- ^ Fn to get the value 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 () -fillChunkedS' !(I# len) eat- = fill 0#- where fill !ix- | ix >=# len = return ()- | otherwise- = do eat (I# ix)- fill (ix +# 1#)+fillBlock2S+ write getElem+ !imageWidth !x0 !y0 !w0 h0 + = do fillBlock y0 ix0+ where !x1 = x0 +# w0+ !y1 = y0 +# h0+ !ix0 = x0 +# (y0 *# imageWidth) + {-# INLINE fillBlock #-}+ fillBlock !y !ix+ | 1# <- y >=# y1+ = return () + | otherwise+ = do fillLine1 x0 ix+ fillBlock (y +# 1#) (ix +# imageWidth) + where {-# INLINE fillLine1 #-}+ fillLine1 !x !ix'+ | 1# <- x >=# x1+ = return ()++ | otherwise+ = do write (I# ix') (getElem (Z :. (I# y) :. (I# x)))+ fillLine1 (x +# 1#) (ix' +# 1#)++{-# INLINE [0] fillBlock2S #-}+++------------------------------------------------------------------------------- -- | Fill something in parallel. -- --- * The array is split into linear chunks and each thread fills one chunk.+-- * The array is split into linear chunks,+-- and each thread linearly fills one chunk. -- 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 () -{-# INLINE [0] fillChunkedP #-}-fillChunkedP !(I# len) !write !getElem- = gangIO theGang- $ \(I# thread) -> +fillChunkedP !(I# len) write getElem+ = 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- | thread <# chunkLeftover = thread *# (chunkLen +# 1#)- | otherwise = thread *# chunkLen +# chunkLeftover+ {-# INLINE splitIx #-}+ splitIx thread+ | 1# <- thread <# chunkLeftover + = thread *# (chunkLen +# 1#) - -- Evaluate the elements of a single chunk.- {-# INLINE fill #-}- fill !ix !end- | ix >=# end = return ()- | otherwise- = do write (I# ix) (getElem (I# ix))- fill (ix +# 1#) end+ | otherwise + = thread *# chunkLen +# chunkLeftover + -- 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+{-# INLINE [0] fillChunkedP #-}+++------------------------------------------------------------------------------- -- | Fill something in parallel, using a separate IO action for each thread.+--+-- * The array is split into linear chunks,+-- and each thread linearly fills one chunk.+-- fillChunkedIOP- :: Int -- ^ Number of elements.- -> (Int -> a -> IO ()) -- ^ Update fn to write into result buffer.- -> (Int -> IO (Int -> IO a)) -- ^ Create a fn to get the value at a given index.- -- The first `Int` is the thread number, so you can do some- -- per-thread initialisation.+ :: Int -- ^ Number of elements.+ -> (Int -> a -> IO ()) + -- ^ Update fn to write into result buffer.+ -> (Int -> IO (Int -> IO a)) + -- ^ Create a fn to get the value at a given index.+ -- The first `Int` is the thread number, so you can do some+ -- per-thread initialisation. -> IO () -{-# INLINE [0] fillChunkedIOP #-}-fillChunkedIOP !(I# len) !write !mkGetElem- = gangIO theGang- $ \(I# thread) -> +fillChunkedIOP !(I# len) write mkGetElem+ = 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-- {-# INLINE splitIx #-}- splitIx thread- | thread <# chunkLeftover = thread *# (chunkLen +# 1#)- | otherwise = thread *# chunkLen +# chunkLeftover+ -- 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 -- Given the threadId, starting and ending indices. -- Make a function to get each element for this chunk@@ -127,12 +177,17 @@ -- 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- | ix >=# end = return ()- | otherwise- = do x <- getElem (I# ix)- write (I# ix) x+ {-# 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 go (ix +# 1#)+{-# INLINE [0] fillChunkedIOP #-}++
Data/Array/Repa/Eval/Cursored.hs view
@@ -2,19 +2,17 @@ -- | Evaluate an array by dividing it into rectangular blocks and filling -- each block in parallel. module Data.Array.Repa.Eval.Cursored- ( fillBlock2P- , fillBlock2S- , fillCursoredBlock2P- , fillCursoredBlock2S )+ ( fillBlock2P+ , fillCursoredBlock2P+ , fillCursoredBlock2S ) where import Data.Array.Repa.Index import Data.Array.Repa.Shape import Data.Array.Repa.Eval.Elt import Data.Array.Repa.Eval.Gang-import GHC.Base (remInt, quotInt)-import Prelude as P-import GHC.Exts+import GHC.Base + -- Non-cursored interface ----------------------------------------------------- -- | Fill a block in a rank-2 array in parallel. --@@ -29,22 +27,22 @@ -- 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 -- ^ x1 upper right corner of block to fill- -> Int -- ^ y1+ -> 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 #-}-fillBlock2P !write !getElem !imageWidth !x0 !y0 !x1 !y1+fillBlock2P write getElem !imageWidth !x0 !y0 !w0 h0 = fillCursoredBlock2P write id addDim getElem - imageWidth x0 y0 x1 y1-+ imageWidth x0 y0 w0 h0 +{- -- | Fill a block in a rank-2 array sequentially. -- -- * Blockwise filling can be more cache-efficient than linear filling for@@ -56,21 +54,21 @@ -- 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# -- ^ x1 upper right corner of block to fill- -> Int# -- ^ y1+ -> 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 #-}-fillBlock2S !write !getElem imageWidth x0 y0 x1 y1+fillBlock2S write getElem !imageWidth !x0 !y0 !w0 !h0 = fillCursoredBlock2S write id addDim getElem - imageWidth x0 y0 x1 y1-+ imageWidth x0 y0 w0 h0+-} -- Block filling ---------------------------------------------------------------------------------- -- | Fill a block in a rank-2 array in parallel.@@ -87,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 -- ^ x1 upper right corner of block to fill- -> Int -- ^ y1- -> 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- !(I# imageWidth) !x0 !y0 !x1 !y1- = gangIO theGang fillBlock- where !threads = gangSize theGang- !blockWidth = x1 - x0 + 1+ 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 = blockWidth `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 = blockWidth `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- | 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 !ix- = let !(I# x0') = colIx ix- !(I# x1') = colIx (ix + 1) - 1- !(I# y0') = y0- !(I# y1') = y1- in fillCursoredBlock2S- write- makeCursorFCB shiftCursorFCB getElemFCB- imageWidth x0' y0' x1' y1'+ -- 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.@@ -146,72 +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# -- ^ x1 upper right corner of block to fill.- -> Int# -- ^ y1- -> 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 !x1 !y1+ write+ makeCursor shiftCursor getElem+ !imageWidth !x0 !y0 !w0 h0 - = fillBlock y0+ = do fillBlock y0+ where !x1 = x0 +# w0+ !y1 = y0 +# h0 - where {-# INLINE fillBlock #-}- fillBlock !y- | y ># y1 = return ()- | otherwise- = do fillLine4 x0- fillBlock (y +# 1#)+ {-# INLINE fillBlock #-}+ fillBlock !y+ | 1# <- y >=# y1 = return ()+ | otherwise+ = do fillLine4 x0+ fillBlock (y +# 1#) - where {-# INLINE fillLine4 #-}- fillLine4 !x- | 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+ 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- | x ># x1 = return ()- | otherwise- = do write (I# (x +# (y *# imageWidth)))- (getElem $ makeCursor (Z :. (I# y) :. (I# x)))- fillLine1 (x +# 1#)+ {-# 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#)
Data/Array/Repa/Eval/Elt.hs view
@@ -1,20 +1,21 @@ -- | Values that can be stored in Repa Arrays. {-# 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 import GHC.Int+import GHC.Generics -- Note that the touch# function is special because we can pass it boxed or unboxed -- values. The argument type has kind ?, not just * or #. -- | Element types that can be used with the blockwise filling functions.--- +-- -- This class is mainly used to define the `touch` method. This is used internally -- in the imeplementation of Repa to prevent let-binding from being floated -- inappropriately by the GHC simplifier. Doing a `seq` sometimes isn't enough,@@ -22,22 +23,96 @@ -- class Elt a where - -- | Place a demand on a value at a particular point in an IO computation.- touch :: a -> IO ()+ -- | Place a demand on a value at a particular point in an IO computation.+ touch :: a -> IO () - -- | Generic zero value, helpful for debugging.- zero :: a+ default touch :: (Generic a, GElt (Rep a)) => a -> IO ()+ touch = gtouch . from+ {-# INLINE touch #-} - -- | Generic one value, helpful for debugging.- one :: a+ -- | Generic zero value, helpful for debugging.+ zero :: a + default zero :: (Generic a, GElt (Rep a)) => a+ zero = to gzero+ {-# INLINE zero #-} + -- | Generic one value, helpful for debugging.+ one :: a++ default one :: (Generic a, GElt (Rep a)) => a+ one = to gone+ {-# INLINE one #-}++class GElt f where+ -- | Generic version of touch+ gtouch :: f a -> IO ()++ -- | Generic version of zero+ gzero :: f a++ -- | Generic version of gone+ gone :: f a++-- Generic Definition ----------------------------------------------------------++instance GElt U1 where+ gtouch _ = return ()+ {-# INLINE gtouch #-}++ gzero = U1+ {-# INLINE gzero #-}++ gone = U1+ {-# INLINE gone #-}++instance (GElt a, GElt b) => GElt (a :*: b) where+ gtouch (x :*: y) = gtouch x >> gtouch y+ {-# INLINE gtouch #-}++ gzero = gzero :*: gzero+ {-# INLINE gzero #-}++ gone = gone :*: gone+ {-# INLINE gone #-}++instance (GElt a, GElt b) => GElt (a :+: b) where+ gtouch (L1 x) = gtouch x+ gtouch (R1 x) = gtouch x+ {-# INLINE gtouch #-}++ gzero = L1 gzero+ {-# INLINE gzero #-}++ gone = R1 gone+ {-# INLINE gone #-}++instance (GElt a) => GElt (M1 i c a) where+ gtouch (M1 x) = gtouch x+ {-# INLINE gtouch #-}++ gzero = M1 gzero+ {-# INLINE gzero #-}++ gone = M1 gone+ {-# INLINE gone #-}++instance (Elt a) => GElt (K1 i a) where+ gtouch (K1 x) = touch x+ {-# INLINE gtouch #-}++ gzero = K1 zero+ {-# INLINE gzero #-}++ gone = K1 one+ {-# INLINE gone #-}+ -- Bool ----------------------------------------------------------------------- instance Elt Bool where {-# INLINE touch #-} touch b = IO (\state -> case touch# b state of- state' -> (# state', () #))+ state' -> (# state', () #)) {-# INLINE zero #-} zero = False@@ -49,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@@ -62,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@@ -76,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@@ -88,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@@ -101,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@@ -114,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@@ -127,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@@ -141,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@@ -154,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@@ -167,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@@ -180,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@@ -193,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@@ -208,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)@@ -221,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)@@ -235,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)@@ -250,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)@@ -266,12 +341,12 @@ instance (Elt a, Elt b, Elt c, Elt d, Elt e, Elt f) => Elt (a, b, c, d, e, f) where {-# INLINE touch #-} touch (a, b, c, d, e, f)- = do touch a- touch b- touch c- touch d- touch e- touch f+ = do touch a+ touch b+ touch c+ touch d+ touch e+ touch f {-# INLINE zero #-} zero = (zero, zero, zero, zero, zero, zero)
− Data/Array/Repa/Eval/Fill.hs
@@ -1,71 +0,0 @@--module Data.Array.Repa.Eval.Fill- ( Fillable (..), fromList- , Fill (..)- , FillRange (..))-where-import Data.Array.Repa.Base-import Data.Array.Repa.Shape-import Control.Monad-import System.IO.Unsafe---- Fillable ---------------------------------------------------------------------- | Class of manifest array representations that can be filled in parallel --- and then frozen into immutable Repa arrays.-class Fillable r e where-- -- | Mutable version of the representation.- data MArr r e-- -- | Allocate a new mutable array of the given size.- newMArr :: Int -> IO (MArr r e)-- -- | Write an element into the mutable array.- unsafeWriteMArr :: MArr r e -> Int -> e -> IO ()-- -- | Freeze the mutable array into an immutable Repa array.- unsafeFreezeMArr :: sh -> MArr r e -> IO (Array r sh e)----- | O(n). Construct a manifest array from a list.-fromList- :: (Shape sh, Fillable r e)- => sh -> [e] -> Array r sh e-fromList sh xx- = unsafePerformIO- $ do let len = length xx- if len /= size sh- then error "Data.Array.Repa.Eval.Fill.fromList: provide array shape does not match list length"- else do- marr <- newMArr len- zipWithM_ (unsafeWriteMArr marr) [0..] xx- unsafeFreezeMArr sh marr----- Fill -------------------------------------------------------------------------- | Compute all elements defined by an array and write them to a fillable--- representation.--- --- Note that instances require that the source array to have a delayed--- representation such as `D` or `C`. If you want to use a pre-existing--- manifest array as the source then `delay` it first.-class (Shape sh, Repr r1 e, Fillable r2 e) => Fill r1 r2 sh e where- -- | Fill an entire array sequentially.- fillS :: Array r1 sh e -> MArr r2 e -> IO ()-- -- | Fill an entire array in parallel.- fillP :: Array r1 sh e -> MArr r2 e -> IO ()----- FillRange --------------------------------------------------------------------- | Compute a range of elements defined by an array and write them to a fillable--- representation.-class (Shape sh, Repr r1 e, Fillable r2 e) => FillRange r1 r2 sh e where- -- | Fill a range of an array sequentially.- fillRangeS :: Array r1 sh e -> MArr r2 e -> sh -> sh -> IO ()-- -- | Fill a range of an array in parallel.- fillRangeP :: Array r1 sh e -> MArr r2 e -> sh -> sh -> IO ()---
Data/Array/Repa/Eval/Gang.hs view
@@ -3,7 +3,7 @@ -- | Gang Primitives. module Data.Array.Repa.Eval.Gang ( theGang- , Gang, forkGang, gangSize, gangIO, gangST) + , Gang, forkGang, gangSize, gangIO, gangST) where import GHC.IO import GHC.ST@@ -11,7 +11,7 @@ import Control.Concurrent.MVar import Control.Exception (assert) import Control.Monad-import GHC.Conc (numCapabilities)+import GHC.Conc (numCapabilities) import System.IO @@ -48,18 +48,18 @@ -- | The 'Req' type encapsulates work requests for individual members of a gang. data Req -- | Instruct the worker to run the given action.- = ReqDo (Int -> IO ())+ = ReqDo (Int -> IO ()) - -- | Tell the worker that we're shutting the gang down.+ -- | Tell the worker that we're shutting the gang down. -- The worker should signal that it's receieved the request by -- writing to its result var before returning to the caller (forkGang).- | ReqShutdown+ | ReqShutdown -- Gang ----------------------------------------------------------------------- -- | A 'Gang' is a group of threads that execute arbitrary work requests. data Gang- = Gang + = Gang { -- | Number of threads in the gang. _gangThreads :: !Int @@ -75,7 +75,7 @@ instance Show Gang where showsPrec p (Gang n _ _ _)- = showString "<<"+ = showString "<<" . showsPrec p n . showString " threads>>" @@ -100,7 +100,7 @@ -- Add finalisers so we can shut the workers down cleanly if they -- become unreachable. zipWithM_ (\varReq varDone - -> addMVarFinalizer varReq (finaliseWorker varReq varDone)) + -> mkWeakMVar varReq (finaliseWorker varReq varDone)) mvsRequest mvsDone @@ -122,21 +122,21 @@ gangWorker threadId varRequest varDone = do -- Wait for a request - req <- takeMVar varRequest+ req <- takeMVar varRequest - case req of- ReqDo action- -> do -- Run the action we were given.+ case req of+ ReqDo action+ -> do -- Run the action we were given. action threadId -- Signal that the action is complete.- putMVar varDone ()+ putMVar varDone () -- Wait for more requests.- gangWorker threadId varRequest varDone+ gangWorker threadId varRequest varDone - ReqShutdown- -> putMVar varDone ()+ ReqShutdown+ -> putMVar varDone () -- | Finaliser for worker threads.@@ -160,22 +160,22 @@ finaliseWorker :: MVar Req -> MVar () -> IO () finaliseWorker varReq varDone = do putMVar varReq ReqShutdown- takeMVar varDone- return ()+ takeMVar varDone+ return () -- | Issue work requests for the 'Gang' and wait until they complete. -- -- If the gang is already busy then print a warning to `stderr` and just -- run the actions sequentially in the requesting thread.-gangIO :: Gang- -> (Int -> IO ())- -> IO ()+gangIO :: Gang+ -> (Int -> IO ())+ -> IO () {-# NOINLINE gangIO #-} gangIO gang@(Gang _ _ _ busy) action = do b <- swapMVar busy True- if b+ if b then do seqIO gang action @@ -202,12 +202,12 @@ -- | Run an action on the gang in parallel. parIO :: Gang -> (Int -> IO ()) -> IO () parIO (Gang _ mvsRequest mvsResult _) action- = do + = do -- Send requests to all the threads. mapM_ (\v -> putMVar v (ReqDo action)) mvsRequest -- Wait for all the requests to complete.- mapM_ takeMVar mvsResult+ mapM_ takeMVar mvsResult -- | Same as 'gangIO' but in the 'ST' monad.
+ Data/Array/Repa/Eval/Interleaved.hs view
@@ -0,0 +1,61 @@+{-# LANGUAGE MagicHash #-}+-- | Evaluate an array in parallel in an interleaved fashion,+-- with each by having each processor computing alternate elements.+module Data.Array.Repa.Eval.Interleaved+ ( fillInterleavedP)+where+import Data.Array.Repa.Eval.Gang+import GHC.Exts+import Prelude as P+++-- | Fill something in parallel.+-- +-- * The array is split into linear chunks and each thread fills one chunk.+-- +fillInterleavedP+ :: 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 ()++{-# INLINE [0] fillInterleavedP #-}+fillInterleavedP !(I# len) write getElem+ = gangIO theGang+ $ \(I# thread) -> + let !step = threads+ !start = thread+ !count = elemsForThread thread+ in fill step start count++ where+ -- Decide now to split the work across the threads.+ !(I# threads) = gangSize theGang++ -- All threads get this many elements.+ !chunkLenBase = len `quotInt#` threads++ -- Leftover elements to divide between first few threads.+ !chunkLenSlack = len `remInt#` threads++ -- How many elements to compute with this thread.+ elemsForThread thread+ | 1# <- thread <# chunkLenSlack+ = chunkLenBase +# 1#++ | otherwise+ = chunkLenBase+ {-# INLINE elemsForThread #-}++ -- Evaluate the elements of a single chunk.+ fill !step !ix0 !count0+ = go ix0 count0+ where+ go !ix !count+ | 1# <- count <=# 0# + = return ()++ | otherwise+ = do write (I# ix) (getElem (I# ix))+ go (ix +# step) (count -# 1#)+ {-# INLINE fill #-}
+ Data/Array/Repa/Eval/Load.hs view
@@ -0,0 +1,36 @@++module Data.Array.Repa.Eval.Load+ ( Load (..)+ , LoadRange (..))+where+import Data.Array.Repa.Eval.Target+import Data.Array.Repa.Shape+import Data.Array.Repa.Base++-- Load -----------------------------------------------------------------------+-- | Compute all elements defined by an array and write them to a manifest+-- target representation.+-- +-- Note that instances require that the source array to have a delayed+-- representation such as `D` or `C`. If you want to use a pre-existing+-- manifest array as the source then `delay` it first.+class (Source r1 e, Shape sh) => Load r1 sh e where+ -- | Fill an entire array sequentially.+ loadS :: Target r2 e => Array r1 sh e -> MVec r2 e -> IO ()++ -- | Fill an entire array in parallel.+ loadP :: Target r2 e => Array r1 sh e -> MVec r2 e -> IO ()+++-- FillRange ------------------------------------------------------------------+-- | Compute a range of elements defined by an array and write them to a fillable+-- representation.+class (Source r1 e, Shape sh) => LoadRange r1 sh e where+ -- | Fill a range of an array sequentially.+ loadRangeS :: Target r2 e => Array r1 sh e -> MVec r2 e -> sh -> sh -> IO ()++ -- | Fill a range of an array in parallel.+ loadRangeP :: Target r2 e => Array r1 sh e -> MVec r2 e -> sh -> sh -> IO ()+++
Data/Array/Repa/Eval/Reduction.hs view
@@ -3,15 +3,15 @@ ( foldS, foldP , foldAllS, foldAllP) where-import Data.Array.Repa.Eval.Elt import Data.Array.Repa.Eval.Gang import qualified Data.Vector.Unboxed as V import qualified Data.Vector.Unboxed.Mutable as M import GHC.Base ( quotInt, divInt ) import GHC.Exts + -- | Sequential reduction of a multidimensional array along the innermost dimension.-foldS :: (Elt a, V.Unbox a)+foldS :: V.Unbox a => M.IOVector a -- ^ vector to write elements into -> (Int# -> a) -- ^ function to get an element from the given index -> (a -> a -> a) -- ^ binary associative combination function@@ -19,14 +19,16 @@ -> Int# -- ^ inner dimension (length to fold over) -> IO () {-# INLINE [1] foldS #-}-foldS vec !get !c !r !n+foldS !vec get c !r !n = iter 0# 0# where !(I# end) = M.length vec {-# INLINE iter #-} iter !sh !sz - | sh >=# end = return ()+ | 1# <- sh >=# end + = return ()+ | otherwise = do let !next = sz +# n M.unsafeWrite vec (I# sh) (reduceAny get c r sz next)@@ -36,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 @@ -45,7 +47,7 @@ -> Int -- ^ inner dimension (length to fold over) -> IO () {-# INLINE [1] foldP #-}-foldP vec !f !c !r !(I# n)+foldP vec f c !r (I# n) = gangIO theGang $ \(I# tid) -> fill (split tid) (split (tid +# 1#)) where@@ -56,9 +58,9 @@ {-# INLINE split #-} split !ix = let !ix' = ix *# step- in if len <# ix' - then len- else ix'+ in case len <# ix' of+ 0# -> ix'+ _ -> len {-# INLINE fill #-} fill !start !end @@ -66,7 +68,9 @@ where {-# INLINE iter #-} iter !sh !sz - | sh >=# end = return ()+ | 1# <- sh >=# end + = return ()+ | otherwise = do let !next = sz +# n M.unsafeWrite vec (I# sh) (reduce f c r (I# sz) (I# next))@@ -74,15 +78,14 @@ -- | 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 -> a {-# INLINE [1] foldAllS #-}-foldAllS !f !c !r !len+foldAllS f c !r !len = reduceAny (\i -> f i) c r 0# len @@ -95,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@@ -103,7 +106,7 @@ -> IO a {-# INLINE [1] foldAllP #-} -foldAllP !f !c !r !len+foldAllP f c !r !len | len == 0 = return r | otherwise = do mvec <- M.unsafeNew chunks@@ -136,20 +139,20 @@ -> Int -- ^ Starting index in array. -> Int -- ^ Ending index in array. -> a -- ^ Result.-reduce f c r (I# start) (I# end)+reduce f c !r (I# start) (I# end) = reduceAny (\i -> f (I# i)) c r start end -- | Sequentially reduce values between the given indices {-# INLINE [0] reduceAny #-} reduceAny :: (Int# -> a) -> (a -> a -> a) -> a -> Int# -> Int# -> a-reduceAny !f !c !r !start !end +reduceAny f c !r !start !end = iter start r where {-# INLINE iter #-} iter !i !z - | i >=# end = z - | otherwise = iter (i +# 1#) (f i `c` z)+ | 1# <- i >=# end = z + | otherwise = iter (i +# 1#) (z `c` f i) {-# INLINE [0] reduceInt #-}@@ -160,13 +163,13 @@ -> Int# -> Int# -> Int# -reduceInt !f !c !r !start !end +reduceInt f c !r !start !end = iter start r where {-# INLINE iter #-} iter !i !z - | i >=# end = z - | otherwise = iter (i +# 1#) (f i `c` z)+ | 1# <- i >=# end = z + | otherwise = iter (i +# 1#) (z `c` f i) {-# INLINE [0] reduceFloat #-}@@ -177,13 +180,13 @@ -> Int# -> Int# -> Float# -reduceFloat !f !c !r !start !end +reduceFloat f c !r !start !end = iter start r where {-# INLINE iter #-} iter !i !z - | i >=# end = z - | otherwise = iter (i +# 1#) (f i `c` z)+ | 1# <- i >=# end = z + | otherwise = iter (i +# 1#) (z `c` f i) {-# INLINE [0] reduceDouble #-}@@ -194,13 +197,13 @@ -> Int# -> Int# -> Double# -reduceDouble !f !c !r !start !end +reduceDouble f c !r !start !end = iter start r where {-# INLINE iter #-} iter !i !z - | i >=# end = z - | otherwise = iter (i +# 1#) (f i `c` z)+ | 1# <- i >=# end = z + | otherwise = iter (i +# 1#) (z `c` f i) {-# INLINE unboxInt #-}
Data/Array/Repa/Eval/Selection.hs view
@@ -1,14 +1,14 @@ {-# LANGUAGE BangPatterns, ExplicitForAll, ScopedTypeVariables, PatternGuards #-} module Data.Array.Repa.Eval.Selection- (selectChunkedS, selectChunkedP)+ (selectChunkedS, selectChunkedP) where import Data.Array.Repa.Eval.Gang import Data.Array.Repa.Shape-import Data.Vector.Unboxed as V-import Data.Vector.Unboxed.Mutable as VM-import GHC.Base (remInt, quotInt)-import Prelude as P-import Control.Monad as P+import Data.Vector.Unboxed as V+import Data.Vector.Unboxed.Mutable as VM+import GHC.Base (remInt, quotInt)+import Prelude as P+import Control.Monad as P import Data.IORef @@ -17,28 +17,28 @@ -- * This primitive can be useful for writing filtering functions. -- selectChunkedS- :: Shape sh- => (sh -> a -> IO ()) -- ^ Update function to write into result.- -> (sh -> Bool) -- ^ See if this predicate matches.- -> (sh -> a) -- ^ .. and apply fn to the matching index- -> sh -- ^ Extent of indices to apply to predicate.- -> IO Int -- ^ Number of elements written to destination array.+ :: Shape sh+ => (sh -> a -> IO ()) -- ^ Update function to write into result.+ -> (sh -> Bool) -- ^ See if this predicate matches.+ -> (sh -> a) -- ^ .. and apply fn to the matching index+ -> sh -- ^ Extent of indices to apply to predicate.+ -> IO Int -- ^ Number of elements written to destination array. {-# INLINE selectChunkedS #-}-selectChunkedS !fnWrite !fnMatch !fnProduce !shSize+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,75 +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+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- = do vecDst <- VM.new (len `div` threads)- vecDst' <- fillChunk ixSrc ixSrcEnd vecDst 0 (VM.length vecDst - 1)- writeIORef ref vecDst'+ -- 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' - -- The main filling loop.- fillChunk :: Int -> Int -> IOVector a -> Int -> Int -> IO (IOVector a)- fillChunk !ixSrc !ixSrcEnd !vecDst !ixDst !ixDstEnd++ -- 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 >= ixDstEnd- = do let ixDstEnd' = VM.length vecDst * 2 - 1- vecDst' <- VM.grow vecDst (ixDstEnd + 1)- fillChunk (ixSrc + 1) ixSrcEnd vecDst' (ixDst + 1) ixDstEnd'+ -- 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) ixDstEnd+ -- 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 ixDstEnd+ -- The element doesnt match, so keep going.+ | otherwise+ = fillChunk (ixSrc + 1) ixSrcEnd vecDst ixDst ixDstLen
+ Data/Array/Repa/Eval/Target.hs view
@@ -0,0 +1,49 @@++module Data.Array.Repa.Eval.Target+ ( Target (..)+ , fromList)+where+import Data.Array.Repa.Base+import Data.Array.Repa.Shape+import Control.Monad+import System.IO.Unsafe+++-- Target ---------------------------------------------------------------------+-- | Class of manifest array representations that can be constructed in parallel.+class Target r e where++ -- | Mutable version of the representation.+ data MVec r e++ -- | Allocate a new mutable array of the given size.+ newMVec :: Int -> IO (MVec r e)++ -- | Write an element into the mutable array.+ unsafeWriteMVec :: MVec r e -> Int -> e -> IO ()++ -- | Freeze the mutable array into an immutable Repa array.+ unsafeFreezeMVec :: sh -> MVec r e -> IO (Array r sh e)++ -- | Ensure the strucure of a mutable array is fully evaluated.+ deepSeqMVec :: MVec r e -> a -> a++ -- | Ensure the array is still live at this point.+ -- Needed when the mutable array is a ForeignPtr with a finalizer.+ touchMVec :: MVec r e -> IO ()+++-- | O(n). Construct a manifest array from a list.+fromList :: (Shape sh, Target r e)+ => sh -> [e] -> Array r sh e+fromList sh xx+ = unsafePerformIO+ $ do let len = length xx+ if len /= size sh+ then error "Data.Array.Repa.Eval.Fill.fromList: provide array shape does not match list length"+ else do+ mvec <- newMVec len+ zipWithM_ (unsafeWriteMVec mvec) [0..] xx+ unsafeFreezeMVec sh mvec++
Data/Array/Repa/Index.hs view
@@ -2,124 +2,146 @@ -- | 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, 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, 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 --- Shape ------------------------------------------------------------------------------------------+-- | Helper for index construction.+--+-- Use this instead of explicit constructors like @(Z :. (x :: Int))@.+-- The this is sometimes needed to ensure that 'x' is constrained to +-- be in @Int@.+ix1 :: Int -> DIM1+ix1 x = Z :. x+{-# INLINE ix1 #-}++ix2 :: Int -> Int -> DIM2+ix2 y x = Z :. y :. x+{-# INLINE ix2 #-}++ix3 :: Int -> Int -> Int -> DIM3+ix3 z y x = Z :. z :. y :. x+{-# INLINE ix3 #-}++ix4 :: Int -> Int -> Int -> Int -> DIM4+ix4 a z y x = Z :. a :. z :. y :. x+{-# INLINE ix4 #-}++ix5 :: Int -> Int -> Int -> Int -> Int -> DIM5+ix5 b a z y x = Z :. b :. a :. z :. y :. x+{-# INLINE ix5 #-}+++-- 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@@ -130,20 +152,20 @@ r | rank ds == 0 = n | otherwise = n `remInt` d - {-# INLINE [1] inShapeRange #-}- inShapeRange (zs :. z) (sh1 :. n1) (sh2 :. n2)- = (n2 >= z) && (n2 < n1) && (inShapeRange zs sh1 sh2)+ {-# INLINE [1] inShapeRange #-}+ inShapeRange (zs :. z) (sh1 :. n1) (sh2 :. n2)+ = (n2 >= z) && (n2 < n1) && (inShapeRange zs sh1 sh2) {-# NOINLINE listOfShape #-}- listOfShape (sh :. n)- = n : listOfShape sh+ listOfShape (sh :. n)+ = n : listOfShape sh {-# NOINLINE shapeOfList #-}- shapeOfList xx- = case xx of- [] -> error $ stage ++ ".toList: empty list when converting to (_ :. Int)"- x:xs -> shapeOfList xs :. x+ shapeOfList xx+ = case xx of+ [] -> error $ stage ++ ".toList: empty list when converting to (_ :. Int)"+ x:xs -> shapeOfList xs :. x - {-# INLINE deepSeq #-}- deepSeq (sh :. n) x = deepSeq sh (n `seq` x)+ {-# INLINE deepSeq #-}+ deepSeq (sh :. n) x = deepSeq sh (n `seq` x)
Data/Array/Repa/Operators/IndexSpace.hs view
@@ -1,166 +1,207 @@ {-# LANGUAGE TypeOperators, ExplicitForAll, FlexibleContexts #-} module Data.Array.Repa.Operators.IndexSpace- ( reshape- , append, (++)- , transpose- , extend- , slice- , backpermute, unsafeBackpermute- , backpermuteDft, unsafeBackpermuteDft)+ ( reshape+ , append, (++)+ , transpose+ , extract+ , backpermute, unsafeBackpermute+ , backpermuteDft, unsafeBackpermuteDft+ , extend, unsafeExtend + , slice, unsafeSlice) where import Data.Array.Repa.Index import Data.Array.Repa.Slice 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 sh2, Shape sh1- , Repr r1 e)- => sh2- -> Array r1 sh1 e- -> Array D sh2 e+reshape :: ( Shape sh1, Shape sh2+ , Source r1 e)+ => sh2+ -> Array r1 sh1 e+ -> Array D sh2 e -{-# INLINE [3] reshape #-} 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 = fromFunction sh2 $ unsafeIndex arr . fromIndex (extent arr) . toIndex sh2+{-# INLINE [2] reshape #-} -- | Append two arrays. append, (++)- :: ( Shape sh- , Repr r1 e, Repr r2 e)- => Array r1 (sh :. Int) e- -> Array r2 (sh :. Int) e- -> Array D (sh :. Int) e+ :: ( Shape sh+ , Source r1 e, Source r2 e)+ => Array r1 (sh :. Int) e+ -> Array r2 (sh :. Int) e+ -> Array D (sh :. Int) e -{-# INLINE [3] append #-} 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 #-} -{-# INLINE (++) #-}+ (++) arr1 arr2 = append arr1 arr2+{-# INLINE (++) #-} -- | 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- , Repr 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 -{-# INLINE [3] transpose #-} 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 #-} --- | Extend an array, according to a given slice specification.-extend- :: ( Slice sl- , Shape (FullShape sl)- , Shape (SliceShape sl)- , Repr r e)- => sl- -> Array r (SliceShape sl) e- -> Array D (FullShape sl) e--{-# INLINE [3] extend #-}-extend sl arr- = unsafeBackpermute- (fullOfSlice sl (extent arr))- (sliceOfFull sl)- arr---- | Take a slice from an array, according to a given specification.-slice :: ( Slice sl- , Shape (FullShape sl)- , Shape (SliceShape sl)- , Repr r e)- => Array r (FullShape sl) e- -> sl- -> Array D (SliceShape sl) e--{-# INLINE [3] slice #-}-slice arr sl- = unsafeBackpermute- (sliceOfFull sl (extent arr))- (fullOfSlice sl)- arr+-- | Extract a sub-range of elements from an array.+extract :: (Shape sh, Source r e)+ => sh -- ^ Starting index.+ -> sh -- ^ Size of result.+ -> Array r sh e + -> Array D sh e+extract start sz arr+ = fromFunction sz (\ix -> arr `unsafeIndex` (addDim start ix))+{-# INLINE [2] extract #-} -- | Backwards permutation of an array's elements.--- The result array has the same extent as the original. backpermute, unsafeBackpermute- :: forall r sh1 sh2 e- . ( Shape sh1, Shape sh2- , Repr 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 -{-# INLINE [3] backpermute #-} backpermute newExtent perm arr- = traverse arr (const newExtent) (. perm)+ = traverse arr (const newExtent) (. perm)+{-# INLINE [2] backpermute #-} -{-# INLINE [3] unsafeBackpermute #-} unsafeBackpermute newExtent perm arr = unsafeTraverse arr (const newExtent) (. perm)+{-# INLINE [2] unsafeBackpermute #-} -- | 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 r0 r1 sh1 sh2 e- . ( Shape sh1, Shape sh2- , Repr r0 e, Repr r1 e)- => Array r0 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+ :: 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 -{-# INLINE [3] backpermuteDft #-} 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 #-} -{-# INLINE [3] unsafeBackpermuteDft #-} unsafeBackpermuteDft arrDft fnIndex arrSrc = fromFunction (extent arrDft) fnElem where fnElem ix = case fnIndex ix of Just ix' -> arrSrc `unsafeIndex` ix' Nothing -> arrDft `unsafeIndex` ix+{-# INLINE [2] unsafeBackpermuteDft #-} +++-- | Extend an array, according to a given slice specification.+--+-- For example, to replicate the rows of an array use the following:+--+-- @extend (Any :. (5::Int) :. All) arr@+--+extend, unsafeExtend+ :: ( Slice sl+ , Shape (SliceShape sl)+ , Source r e)+ => sl+ -> Array r (SliceShape sl) e+ -> Array D (FullShape sl) e++extend sl arr+ = backpermute+ (fullOfSlice sl (extent arr))+ (sliceOfFull sl)+ arr+{-# INLINE [2] extend #-}++unsafeExtend sl arr+ = unsafeBackpermute+ (fullOfSlice sl (extent arr))+ (sliceOfFull sl)+ arr+{-# INLINE [2] unsafeExtend #-}++++-- | Take a slice from an array, according to a given specification.+--+-- For example, to take a row from a matrix use the following:+--+-- @slice arr (Any :. (5::Int) :. All)@+--+-- To take a column use:+--+-- @slice arr (Any :. (5::Int))@+--+slice, unsafeSlice+ :: ( Slice sl+ , Shape (FullShape sl)+ , Source r e)+ => Array r (FullShape sl) e+ -> sl+ -> Array D (SliceShape sl) e++slice arr sl+ = backpermute+ (sliceOfFull sl (extent arr))+ (fullOfSlice sl)+ arr+{-# INLINE [2] slice #-}+++unsafeSlice arr sl+ = unsafeBackpermute+ (sliceOfFull sl (extent arr))+ (fullOfSlice sl)+ arr+{-# INLINE [2] unsafeSlice #-}
Data/Array/Repa/Operators/Interleave.hs view
@@ -1,17 +1,18 @@ {-# 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 Data.Array.Repa.Shape as S-import Prelude hiding ((++))+import Prelude hiding ((++)) + -- Interleave ----------------------------------------------------------------- -- | Interleave the elements of two arrays. -- All the input arrays must have the same extent, else `error`.@@ -23,92 +24,91 @@ -- @ -- interleave2- :: (Shape sh- , Repr r1 a, Repr r2 a)- => Array r1 (sh :. Int) a- -> Array r2 (sh :. Int) a- -> Array D (sh :. Int) a+ :: ( Shape sh+ , Source r1 a, Source r2 a)+ => Array r1 (sh :. Int) a+ -> Array r2 (sh :. Int) a+ -> Array D (sh :. Int) a -{-# INLINE [3] interleave2 #-}+{-# INLINE [2] interleave2 #-} interleave2 arr1 arr2- = arr1 `deepSeqArray` arr2 `deepSeqArray`- unsafeTraverse2 arr1 arr2 shapeFn elemFn+ = 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` 3 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- , Repr r1 a, Repr r2 a, Repr r3 a)- => Array r1 (sh :. Int) a- -> Array r2 (sh :. Int) a- -> Array r3 (sh :. Int) a- -> Array D (sh :. Int) a+ :: ( 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 -{-# INLINE [3] interleave3 #-}+{-# INLINE [2] interleave3 #-} interleave3 arr1 arr2 arr3- = arr1 `deepSeqArray` arr2 `deepSeqArray` arr3 `deepSeqArray`- unsafeTraverse3 arr1 arr2 arr3 shapeFn elemFn+ = 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- , Repr r1 a, Repr r2 a, Repr r3 a, Repr 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+ :: ( 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 -{-# INLINE [3] interleave4 #-}+{-# INLINE [2] interleave4 #-} interleave4 arr1 arr2 arr3 arr4- = arr1 `deepSeqArray` arr2 `deepSeqArray` arr3 `deepSeqArray` arr4 `deepSeqArray`- unsafeTraverse4 arr1 arr2 arr3 arr4 shapeFn elemFn+ = unsafeTraverse4 arr1 arr2 arr3 arr4 shapeFn elemFn where- shapeFn dim1 dim2 dim3 dim4- | dim1 == dim2- , dim1 == dim3- , dim1 == dim4- , sh :. len <- dim1- = sh :. (len * 4)+ shapeFn dim1 dim2 dim3 dim4+ | dim1 == dim2+ , dim1 == dim3+ , dim1 == dim4+ , sh :. len <- dim1+ = sh :. (len * 4) - | otherwise- = error "Data.Array.Repa.interleave4: arrays must have same extent"+ | otherwise+ = error "Data.Array.Repa.interleave4: arrays must have same extent" - elemFn get1 get2 get3 get4 (sh :. ix)- = case ix `mod` 4 of- 0 -> get1 (sh :. ix `div` 4)- 1 -> get2 (sh :. ix `div` 4)- 2 -> get3 (sh :. ix `div` 4)- 3 -> get4 (sh :. ix `div` 4)- _ -> error "Data.Array.Repa.interleave4: this never happens :-P"+ elemFn get1 get2 get3 get4 (sh :. ix)+ = case ix `mod` 4 of+ 0 -> get1 (sh :. ix `div` 4)+ 1 -> get2 (sh :. ix `div` 4)+ 2 -> get3 (sh :. ix `div` 4)+ 3 -> get4 (sh :. ix `div` 4)+ _ -> error "Data.Array.Repa.interleave4: this never happens :-P"++
Data/Array/Repa/Operators/Mapping.hs view
@@ -6,8 +6,8 @@ , zipWith , (+^), (-^), (*^), (/^) - -- * Combining maps- , Combine(..))+ -- * Structured maps+ , Structured(..)) where import Data.Array.Repa.Shape import Data.Array.Repa.Base@@ -15,6 +15,8 @@ import Data.Array.Repa.Repr.Cursored import Data.Array.Repa.Repr.Delayed import Data.Array.Repa.Repr.ForeignPtr+import Data.Array.Repa.Repr.HintSmall+import Data.Array.Repa.Repr.HintInterleave import Data.Array.Repa.Repr.Partitioned import Data.Array.Repa.Repr.Unboxed import Data.Array.Repa.Repr.Undefined@@ -25,51 +27,50 @@ -- | Apply a worker function to each element of an array, -- yielding a new array with the same extent. ---map :: (Shape sh, Repr r a)+map :: (Shape sh, Source r a) => (a -> b) -> Array r sh a -> Array D sh b-{-# INLINE [4] map #-} map f arr = case delay arr of ADelayed sh g -> ADelayed sh (f . g)+{-# INLINE [3] map #-} -- 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, Repr r1 a, Repr r2 b)+zipWith :: (Shape sh, Source r1 a, Source r2 b) => (a -> b -> c) -> Array r1 sh a -> Array r2 sh b -> Array D sh c-{-# INLINE [3] zipWith #-} zipWith f arr1 arr2- = arr1 `deepSeqArray` arr2 `deepSeqArray`- let + = let get ix = f (arr1 `unsafeIndex` ix) (arr2 `unsafeIndex` ix) {-# INLINE get #-}- get ix = f (arr1 `unsafeIndex` ix) (arr2 `unsafeIndex` ix)-+ in fromFunction (intersectDim (extent arr1) (extent arr2)) get+{-# INLINE [2] zipWith #-} +infixl 7 *^, /^+infixl 6 +^, -^ +(+^) = zipWith (+) {-# INLINE (+^) #-}-(+^) = zipWith (+) +(-^) = zipWith (-) {-# INLINE (-^) #-}-(-^) = zipWith (-) +(*^) = zipWith (*) {-# INLINE (*^) #-}-(*^) = zipWith (*) +(/^) = zipWith (/) {-# INLINE (/^) #-}-(/^) = zipWith (/) ---- Combine ----------------------------------------------------------------------- | Combining versions of @map@ and @zipWith@ that preserve the representation+-- Structured -------------------------------------------------------------------+-- | Structured versions of @map@ and @zipWith@ that preserve the representation -- of cursored and partitioned arrays. -- -- For cursored (@C@) arrays, the cursoring of the source array is preserved.@@ -82,93 +83,129 @@ -- is will make follow-on computation more efficient than if the array was -- converted to a vanilla Delayed (@D@) array as with plain `map` and `zipWith`. ----- If the source array is not cursored or partitioned then `cmap` and --- `czipWith` are identical to the plain functions.+-- If the source array is not cursored or partitioned then `smap` and +-- `szipWith` are identical to the plain functions. ---class Combine r1 a r2 b | r1 -> r2 where+class Structured r1 a b where+ -- | The target result representation.+ type TR r1 - -- | Combining @map@.- cmap :: Shape sh + -- | Structured @map@.+ smap :: Shape sh => (a -> b) - -> Array r1 sh a - -> Array r2 sh b+ -> Array r1 sh a + -> Array (TR r1) sh b - -- | Combining @zipWith@.+ -- | Structured @zipWith@. -- If you have a cursored or partitioned source array then use that as -- the third argument (corresponding to @r1@ here)- czipWith- :: (Shape sh, Repr r c)+ szipWith+ :: (Shape sh, Source r c) => (c -> a -> b)- -> Array r sh c- -> Array r1 sh a- -> Array r2 sh b+ -> Array r sh c+ -> Array r1 sh a+ -> Array (TR r1) sh b -- ByteString --------------------------instance Combine B Word8 D b where- cmap = map- czipWith = zipWith+instance Structured B Word8 b where+ type TR B = D+ smap = map+ szipWith = zipWith -- Cursored ----------------------------instance Combine C a C b where- {-# INLINE [4] cmap #-}- cmap f (ACursored sh makec shiftc loadc)- = ACursored sh makec shiftc (f . loadc)+instance Structured C a b where+ type TR C = C - {-# INLINE [3] czipWith #-}- czipWith f arr1 (ACursored sh makec shiftc loadc)- = let {-# INLINE makec' #-}- makec' ix = (ix, makec ix)+ smap f (ACursored sh makec shiftc loadc)+ = ACursored sh makec shiftc (f . loadc)+ {-# INLINE [3] smap #-} - {-# INLINE shiftc' #-}+ szipWith f arr1 (ACursored sh makec shiftc loadc)+ = let makec' ix = (ix, makec ix)+ {-# INLINE makec' #-}+ shiftc' off (ix, cur) = (addDim off ix, shiftc off cur)+ {-# INLINE shiftc' #-} - {-# INLINE load' #-} load' (ix, cur) = f (arr1 `unsafeIndex` ix) (loadc cur)+ {-# INLINE load' #-} in ACursored (intersectDim (extent arr1) sh) makec' shiftc' load'+ {-# INLINE [2] szipWith #-} -- Delayed -----------------------------instance Combine D a D b where- cmap = map- czipWith = zipWith+instance Structured D a b where+ type TR D = D+ smap = map+ szipWith = zipWith -- ForeignPtr --------------------------instance Storable a => Combine F a D b where- cmap = map- czipWith = zipWith+instance Storable a => Structured F a b where+ type TR F = D+ smap = map+ szipWith = zipWith -- Partitioned -------------------------instance (Combine r11 a r21 b- , Combine r12 a r22 b)- => Combine (P r11 r12) a (P r21 r22) b where+instance (Structured r1 a b+ , Structured r2 a b)+ => Structured (P r1 r2) a b where+ type TR (P r1 r2) = P (TR r1) (TR r2) - {-# INLINE [4] cmap #-}- cmap f (APart sh range arr1 arr2)- = APart sh range (cmap f arr1) (cmap f arr2)+ smap f (APart sh range arr1 arr2)+ = APart sh range (smap f arr1) (smap f arr2)+ {-# INLINE [3] smap #-} - {-# INLINE [3] czipWith #-}- czipWith f arr1 (APart sh range arr21 arr22)- = APart sh range (czipWith f arr1 arr21)- (czipWith f arr1 arr22)+ szipWith f arr1 (APart sh range arr21 arr22)+ = APart sh range (szipWith f arr1 arr21)+ (szipWith f arr1 arr22)+ {-# INLINE [2] szipWith #-} +-- Small ------------------------------+instance Structured r1 a b+ => Structured (S r1) a b where+ type TR (S r1) = S (TR r1)++ smap f (ASmall arr1)+ = ASmall (smap f arr1)+ {-# INLINE [3] smap #-}++ szipWith f arr1 (ASmall arr2)+ = ASmall (szipWith f arr1 arr2)+ {-# INLINE [3] szipWith #-}+++-- Interleaved ------------------------+instance Structured r1 a b+ => Structured (I r1) a b where+ type TR (I r1) = I (TR r1)++ smap f (AInterleave arr1)+ = AInterleave (smap f arr1)+ {-# INLINE [3] smap #-}++ szipWith f arr1 (AInterleave arr2)+ = AInterleave (szipWith f arr1 arr2)+ {-# INLINE [3] szipWith #-}++ -- Unboxed -----------------------------instance Unbox a => Combine U a D b where- cmap = map- czipWith = zipWith+instance Unbox a => Structured U a b where+ type TR U = D+ smap = map+ szipWith = zipWith -- Undefined ---------------------------instance Combine X a D b where- cmap = map- czipWith = zipWith-+instance Structured X a b where+ type TR X = X+ smap _ (AUndefined sh) = AUndefined sh+ szipWith _ _ (AUndefined sh) = AUndefined sh -
Data/Array/Repa/Operators/Reduction.hs view
@@ -1,41 +1,54 @@ {-# 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 import Data.Array.Repa.Index-import Data.Array.Repa.Eval.Elt+import Data.Array.Repa.Eval import Data.Array.Repa.Repr.Unboxed-import Data.Array.Repa.Shape as S-import qualified Data.Vector.Unboxed as V+import Data.Array.Repa.Operators.Mapping as R+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 --- foldS ----------------------------------------------------------------------+-- fold ---------------------------------------------------------------------- -- | Sequential reduction of the innermost dimension of an arbitrary rank array. -- -- Combine this with `transpose` to fold any other dimension.-foldS :: (Shape sh, Elt a, Unbox a, Repr r a)- => (a -> a -> a)- -> a- -> Array r (sh :. Int) a- -> Array U sh a-{-# INLINE [2] foldS #-}+--+-- 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+ -> Array U sh a+ foldS f z arr- = let sh@(sz :. n') = extent arr+ = arr `deepSeqArray`+ let sh@(sz :. n') = extent arr !(I# n) = n' in unsafePerformIO $ do mvec <- M.unsafeNew (S.size sz) E.foldS mvec (\ix -> arr `unsafeIndex` fromIndex sh (I# ix)) f z n !vec <- V.unsafeFreeze mvec- return $ fromUnboxed sz vec+ now $ fromUnboxed sz vec+{-# INLINE [1] foldS #-} -- | Parallel reduction of the innermost dimension of an arbitray rank array.@@ -45,38 +58,54 @@ -- 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, Elt a, Unbox a, Repr r a)- => (a -> a -> a)- -> a- -> Array r (sh :. Int) a- -> Array U sh a-{-# INLINE [2] foldP #-}+--+-- 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+ -> m (Array U sh a)+ foldP f z arr - = let sh@(sz :. n) = extent arr+ = arr `deepSeqArray`+ let sh@(sz :. n) = extent arr in case rank sh of -- specialise rank-1 arrays, else one thread does all the work. -- We can't match against the shape constructor, -- otherwise type error: (sz ~ Z) --- 1 -> let !vec = V.singleton $ foldAllP f z arr- in fromUnboxed sz vec+ 1 -> do+ x <- foldAllP f z arr+ now $ fromUnboxed sz $ V.singleton x - _ -> unsafePerformIO + _ -> now+ $ unsafePerformIO $ do mvec <- M.unsafeNew (S.size sz) E.foldP mvec (\ix -> arr `unsafeIndex` fromIndex sh ix) f z n !vec <- V.unsafeFreeze mvec- return $ fromUnboxed sz vec+ now $ fromUnboxed sz vec+{-# INLINE [1] foldP #-} -- foldAll -------------------------------------------------------------------- -- | Sequential reduction of an array of arbitrary rank to a single scalar value. ---foldAllS :: (Shape sh, Elt a, Unbox a, Repr r a)- => (a -> a -> a)- -> a- -> Array r sh a- -> a-{-# INLINE [2] foldAllS #-}+-- 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` let !ex = extent arr@@ -84,6 +113,7 @@ in E.foldAllS (\ix -> arr `unsafeIndex` fromIndex ex (I# ix)) f z n +{-# INLINE [1] foldAllS #-} -- | Parallel reduction of an array of arbitrary rank to a single scalar value.@@ -93,49 +123,86 @@ -- 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.-foldAllP :: (Shape sh, Elt a, Unbox a, Repr r a)- => (a -> a -> a)- -> a- -> Array r sh a- -> a-{-# INLINE [2] foldAllP #-}+--+-- Elements are reduced in row-major order. Applications of the operator are+-- associated arbitrarily.+--+foldAllP + :: (Shape sh, Source r a, Unbox a, Monad m)+ => (a -> a -> a)+ -> a+ -> Array r sh a+ -> m a+ foldAllP f z arr - = let sh = extent arr+ = arr `deepSeqArray`+ let sh = extent arr n = size sh- in unsafePerformIO + in return+ $ unsafePerformIO $ E.foldAllP (\ix -> arr `unsafeIndex` fromIndex sh ix) f z n+{-# INLINE [1] foldAllP #-} -- sum ------------------------------------------------------------------------ -- | Sequential sum the innermost dimension of an array.-sumS :: (Shape sh, Num a, Elt a, Unbox a, Repr r a)- => Array r (sh :. Int) a- -> Array U sh a-{-# INLINE [4] sumS #-}+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 #-} --- | Sequential sum the innermost dimension of an array.-sumP :: (Shape sh, Num a, Elt a, Unbox a, Repr r a)- => Array r (sh :. Int) a- -> Array U sh a-{-# INLINE [4] sumP #-}-sumP = foldP (+) 0+-- | Parallel sum the innermost dimension of an array.+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, Elt a, Unbox a, Num a, Repr r a)- => Array r sh a- -> a-{-# INLINE [4] sumAllS #-}+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, Elt a, Unbox a, Num a, Repr r a)- => Array r sh a- -> a-{-# INLINE [4] sumAllP #-}+sumAllP :: (Shape sh, Source r a, Unbox a, Num a, Monad m)+ => Array r sh a+ -> m a sumAllP = foldAllP (+) 0+{-# INLINE [3] sumAllP #-}+++-- Equality ------------------------------------------------------------------+instance (Shape sh, Eq sh, Source r a, Eq a) => Eq (Array r sh a) where+ (==) arr1 arr2+ = extent arr1 == extent arr2+ && (foldAllS (&&) True (R.zipWith (==) arr1 arr2))+++-- | Check whether two arrays have the same shape and contain equal elements,+-- in parallel.+equalsP :: (Shape sh, Source r1 a, Source r2 a, Eq a, Monad m) + => Array r1 sh a + -> Array r2 sh a+ -> m Bool+equalsP arr1 arr2+ = do same <- foldAllP (&&) True (R.zipWith (==) arr1 arr2)+ return $ (extent arr1 == extent arr2) && same+++-- | Check whether two arrays have the same shape and contain equal elements,+-- sequentially.+equalsS :: (Shape sh, Source r1 a, Source r2 a, Eq a) + => Array r1 sh a + -> Array r2 sh a+ -> Bool+equalsS arr1 arr2+ = extent arr1 == extent arr2+ && (foldAllS (&&) True (R.zipWith (==) arr1 arr2))
Data/Array/Repa/Operators/Selection.hs view
@@ -1,12 +1,12 @@ {-# LANGUAGE BangPatterns #-} module Data.Array.Repa.Operators.Selection- (select)+ (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,25 +19,26 @@ -- -- * Use the integer as the index into the array you're filtering. ---select :: Unbox a- => (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.- -> 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. -{-# INLINE [2] select #-}-select match produce len- = unsafePerformIO- $ do (sh, vec) <- selectIO- return $ sh `seq` vec `seq`- fromUnboxed sh vec+selectP match produce len+ = return+ $ unsafePerformIO+ $ do (sh, vec) <- selectIO+ return $ sh `seq` vec `seq`+ fromUnboxed sh vec - where {-# INLINE selectIO #-}- selectIO- = do vecs <- selectChunkedP match produce len- vecs' <- mapM V.unsafeFreeze vecs+ where {-# INLINE selectIO #-}+ selectIO+ = do vecs <- selectChunkedP match produce len+ vecs' <- mapM V.unsafeFreeze vecs - -- TODO: avoid copy somehow.- let result = V.concat vecs'+ -- TODO: avoid copy somehow.+ let result = V.concat vecs' - return (Z :. V.length result, result)+ return (Z :. V.length result, result)+{-# INLINE [1] selectP #-}
Data/Array/Repa/Operators/Traversal.hs view
@@ -1,120 +1,114 @@ -- 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- . (Shape sh, Shape sh', Repr r a)- => 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 -{-# INLINE [4] traverse #-} traverse arr transExtent newElem- = arr `deepSeqArray` - fromFunction (transExtent (extent arr)) (newElem (index arr))+ = fromFunction (transExtent (extent arr)) (newElem (index arr))+{-# INLINE [3] traverse #-} -{-# INLINE [4] unsafeTraverse #-} unsafeTraverse arr transExtent newElem- = arr `deepSeqArray`- fromFunction (transExtent (extent arr)) (newElem (unsafeIndex arr))+ = fromFunction (transExtent (extent arr)) (newElem (unsafeIndex arr))+{-# INLINE [3] unsafeTraverse #-} -- | Unstructured traversal over two arrays at once. traverse2, unsafeTraverse2- :: forall r1 r2 sh sh' sh'' a b c- . ( Shape sh, Shape sh', Shape sh''- , Repr r1 a, Repr r2 b)- => 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 -{-# INLINE [4] traverse2 #-} traverse2 arrA arrB transExtent newElem- = arrA `deepSeqArray` arrB `deepSeqArray`- fromFunction (transExtent (extent arrA) (extent arrB))- (newElem (index arrA) (index arrB))+ = fromFunction (transExtent (extent arrA) (extent arrB))+ (newElem (index arrA) (index arrB))+{-# INLINE [3] traverse2 #-} -{-# INLINE [4] unsafeTraverse2 #-} unsafeTraverse2 arrA arrB transExtent newElem- = arrA `deepSeqArray` arrB `deepSeqArray`- fromFunction (transExtent (extent arrA) (extent arrB))+ = fromFunction (transExtent (extent arrA) (extent arrB)) (newElem (unsafeIndex arrA) (unsafeIndex arrB))+{-# INLINE [3] unsafeTraverse2 #-} -- | Unstructured traversal over three arrays at once. traverse3, unsafeTraverse3- :: forall r1 r2 r3- sh1 sh2 sh3 sh4- a b c d- . ( Shape sh1, Shape sh2, Shape sh3, Shape sh4- , Repr r1 a, Repr r2 b, Repr r3 c)+ :: 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) -> sh4 -> d ) -> Array D sh4 d -{-# INLINE [4] traverse3 #-} traverse3 arrA arrB arrC transExtent newElem- = arrA `deepSeqArray` arrB `deepSeqArray` arrC `deepSeqArray`- fromFunction (transExtent (extent arrA) (extent arrB) (extent arrC))- (newElem (index arrA) (index arrB) (index arrC))+ = fromFunction (transExtent (extent arrA) (extent arrB) (extent arrC))+ (newElem (index arrA) (index arrB) (index arrC))+{-# INLINE [3] traverse3 #-} -{-# INLINE [4] unsafeTraverse3 #-} unsafeTraverse3 arrA arrB arrC transExtent newElem- = arrA `deepSeqArray` arrB `deepSeqArray` arrC `deepSeqArray`- 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- . ( Shape sh1, Shape sh2, Shape sh3, Shape sh4, Shape sh5- , Repr r1 a, Repr r2 b, Repr r3 c, Repr r4 d)+ :: 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) -> sh5 -> e ) -> Array D sh5 e -{-# INLINE [4] traverse4 #-} traverse4 arrA arrB arrC arrD transExtent newElem- = arrA `deepSeqArray` arrB `deepSeqArray` arrC `deepSeqArray` arrD `deepSeqArray`- 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 #-} -{-# INLINE [4] unsafeTraverse4 #-} unsafeTraverse4 arrA arrB arrC arrD transExtent newElem- = arrA `deepSeqArray` arrB `deepSeqArray` arrC `deepSeqArray` arrD `deepSeqArray`- fromFunction (transExtent (extent arrA) (extent arrB) (extent arrC) (extent arrD))- (newElem (unsafeIndex arrA) (unsafeIndex arrB) (unsafeIndex arrC) (unsafeIndex arrD))+ = fromFunction (transExtent (extent arrA) (extent arrB) (extent arrC) (extent arrD))+ (newElem (unsafeIndex arrA) (unsafeIndex arrB) (unsafeIndex arrC) (unsafeIndex arrD))+{-# INLINE [3] unsafeTraverse4 #-}
Data/Array/Repa/Repr/ByteString.hs view
@@ -14,44 +14,46 @@ -- | Strict ByteStrings arrays are represented as ForeignPtr buffers of Word8 data B-data instance Array B sh Word8- = AByteString sh !ByteString -deriving instance Show sh- => Show (Array B sh Word8)----- Repr ----------------------------------------------------------------------- -- | Read elements from a `ByteString`.-instance Repr B Word8 where- {-# INLINE linearIndex #-}+instance Source B Word8 where+ data Array B sh Word8+ = AByteString !sh !ByteString+ linearIndex (AByteString _ bs) ix = bs `B.index` ix+ {-# INLINE linearIndex #-} - {-# INLINE unsafeLinearIndex #-} unsafeLinearIndex (AByteString _ bs) ix = bs `BU.unsafeIndex` ix+ {-# INLINE unsafeLinearIndex #-} - {-# INLINE extent #-} extent (AByteString sh _) = sh+ {-# INLINE extent #-} - {-# INLINE deepSeqArray #-} deepSeqArray (AByteString sh bs) x = sh `deepSeq` bs `seq` x+ {-# INLINE deepSeqArray #-} +deriving instance Show sh+ => Show (Array B sh Word8)++deriving instance Read sh+ => Read (Array B sh Word8)++ -- Conversions ---------------------------------------------------------------- -- | O(1). Wrap a `ByteString` as an array. fromByteString- :: Shape sh- => sh -> ByteString -> Array B sh Word8-{-# INLINE fromByteString #-}+ :: sh -> ByteString -> Array B sh Word8 fromByteString sh bs = AByteString sh bs+{-# INLINE fromByteString #-} -- | O(1). Unpack a `ByteString` from an array. toByteString :: Array B sh Word8 -> ByteString-{-# INLINE toByteString #-} toByteString (AByteString _ bs) = bs+{-# INLINE toByteString #-}
Data/Array/Repa/Repr/Cursored.hs view
@@ -8,10 +8,12 @@ import Data.Array.Repa.Index import Data.Array.Repa.Repr.Delayed import Data.Array.Repa.Repr.Undefined-import Data.Array.Repa.Eval.Fill+import Data.Array.Repa.Eval.Load import Data.Array.Repa.Eval.Elt import Data.Array.Repa.Eval.Cursored+import Data.Array.Repa.Eval.Target import GHC.Exts+import Debug.Trace -- | Cursored Arrays. -- These are produced by Repa's stencil functions, and help the fusion@@ -22,80 +24,94 @@ -- array representation has changed since this paper was published. data C -data instance Array C sh e++-- | Compute elements of a cursored array.+instance Source C a where++ data Array C sh a = forall cursor. ACursored- { cursoredExtent :: sh + { cursoredExtent :: !sh -- | Make a cursor to a particular element.- , makeCursor :: sh -> cursor+ , makeCursor :: sh -> cursor - -- | Shift the cursor by an offset, to get to another element.- , shiftCursor :: sh -> cursor -> cursor+ -- | Shift the cursor by an offset, to get to another element.+ , shiftCursor :: sh -> cursor -> cursor - -- | Load\/compute the element at the given cursor.- , loadCursor :: cursor -> e }+ -- | Load\/compute the element at the given cursor.+ , loadCursor :: cursor -> a } --- Repr -------------------------------------------------------------------------- | Compute elements of a cursored array.-instance Repr C a where- {-# INLINE index #-} index (ACursored _ makec _ loadc) = loadc . makec+ {-# INLINE index #-} - {-# INLINE unsafeIndex #-} unsafeIndex = index+ {-# INLINE unsafeIndex #-} - {-# INLINE linearIndex #-} linearIndex (ACursored sh makec _ loadc) = loadc . makec . fromIndex sh+ {-# INLINE linearIndex #-} - {-# INLINE extent #-} extent (ACursored sh _ _ _) = sh+ {-# INLINE extent #-} - {-# INLINE deepSeqArray #-} deepSeqArray (ACursored sh makec shiftc loadc) y = sh `deepSeq` makec `seq` shiftc `seq` loadc `seq` y+ {-# INLINE deepSeqArray #-} -- Fill ----------------------------------------------------------------------- -- | Compute all elements in an rank-2 array. -instance (Fillable r2 e, Elt e) => Fill C r2 DIM2 e where- {-# INLINE fillP #-}- fillP (ACursored (Z :. h :. w) makec shiftc loadc) marr- = fillCursoredBlock2P - (unsafeWriteMArr marr) +instance Elt e => Load C DIM2 e where+ loadP (ACursored (Z :. (I# h) :. (I# w)) makec shiftc loadc) marr+ = do traceEventIO "Repa.loadP[Cursored]: start"+ fillCursoredBlock2P + (unsafeWriteMVec marr) makec shiftc loadc- w 0 0 (w - 1) (h - 1) -- {-# INLINE fillS #-}- fillS (ACursored (Z :. (I# h) :. (I# w)) makec shiftc loadc) marr- = fillCursoredBlock2S - (unsafeWriteMArr marr) + w 0# 0# w h+ touchMVec marr+ traceEventIO "Repa.loadP[Cursored]: end"+ {-# INLINE loadP #-}+ + loadS (ACursored (Z :. (I# h) :. (I# w)) makec shiftc loadc) marr+ = do traceEventIO "Repa.loadS[Cursored]: start"+ fillCursoredBlock2S + (unsafeWriteMVec marr) makec shiftc loadc- w 0# 0# (w -# 1#) (h -# 1#) -+ w 0# 0# w h+ touchMVec marr+ traceEventIO "Repa.loadS[Cursored]: end"+ {-# INLINE loadS #-}+ -- | Compute a range of elements in a rank-2 array.-instance (Fillable r2 e, Elt e) => FillRange C r2 DIM2 e where- {-# INLINE fillRangeP #-}- fillRangeP (ACursored (Z :. _h :. w) makec shiftc loadc) marr- (Z :. y0 :. x0) (Z :. y1 :. x1)- = fillCursoredBlock2P - (unsafeWriteMArr marr) +instance Elt e => LoadRange C DIM2 e where+ loadRangeP (ACursored (Z :. _h :. (I# w)) makec shiftc loadc) marr+ (Z :. (I# y0) :. (I# x0)) (Z :. (I# h0) :. (I# w0))+ = do traceEventIO "Repa.loadRangeP[Cursored]: start"+ fillCursoredBlock2P + (unsafeWriteMVec marr) makec shiftc loadc- w x0 y0 x1 y1-- {-# INLINE fillRangeS #-}- fillRangeS (ACursored (Z :. _h :. (I# w)) makec shiftc loadc) marr+ w x0 y0 w0 h0+ touchMVec marr+ traceEventIO "Repa.loadRangeP[Cursored]: end"+ {-# INLINE loadRangeP #-}+ + loadRangeS (ACursored (Z :. _h :. (I# w)) makec shiftc loadc) marr (Z :. (I# y0) :. (I# x0)) - (Z :. (I# y1) :. (I# x1))- = fillCursoredBlock2S- (unsafeWriteMArr marr) + (Z :. (I# h0) :. (I# w0))+ = do traceEventIO "Repa.loadRangeS[Cursored]: start"+ fillCursoredBlock2S+ (unsafeWriteMVec marr) makec shiftc loadc- w x0 y0 x1 y1- + w x0 y0 w0 h0+ touchMVec marr+ traceEventIO "Repa.loadRangeS[Cursored]: end"+ {-# INLINE loadRangeS #-}+ + -- Conversions ---------------------------------------------------------------- -- | Define a new cursored array. makeCursored @@ -105,5 +121,6 @@ -> (cursor -> e) -- ^ Compute the element at the cursor. -> Array C sh e -{-# INLINE makeCursored #-} makeCursored = ACursored+{-# INLINE makeCursored #-}+
Data/Array/Repa/Repr/Delayed.hs view
@@ -4,86 +4,107 @@ , fromFunction, toFunction , delay) where-import Data.Array.Repa.Eval.Elt-import Data.Array.Repa.Eval.Cursored+import Data.Array.Repa.Eval.Load+import Data.Array.Repa.Eval.Target import Data.Array.Repa.Eval.Chunked-import Data.Array.Repa.Eval.Fill+import Data.Array.Repa.Eval.Cursored+import Data.Array.Repa.Eval.Elt import Data.Array.Repa.Index import Data.Array.Repa.Shape import Data.Array.Repa.Base+import Debug.Trace import GHC.Exts -- | Delayed arrays are represented as functions from the index to element value.+--+-- Every time you index into a delayed array the element at that position +-- is recomputed. data D-data instance Array D sh e- = ADelayed - sh - (sh -> e) ---- Repr ----------------------------------------------------------------------- -- | Compute elements of a delayed array.-instance Repr D a where- {-# INLINE index #-}+instance Source D a where+ data Array D sh a+ = ADelayed + !sh + (sh -> a) + index (ADelayed _ f) ix = f ix+ {-# INLINE index #-} - {-# INLINE linearIndex #-} linearIndex (ADelayed sh f) ix = f (fromIndex sh ix)+ {-# INLINE linearIndex #-} - {-# INLINE extent #-} extent (ADelayed sh _) = sh+ {-# INLINE extent #-} - {-# INLINE deepSeqArray #-} deepSeqArray (ADelayed sh f) y = sh `deepSeq` f `seq` y+ {-# INLINE deepSeqArray #-} --- Fill -----------------------------------------------------------------------+-- Load ----------------------------------------------------------------------- -- | Compute all elements in an array.-instance (Fillable r2 e, Shape sh) => Fill D r2 sh e where- {-# INLINE [4] fillP #-}- fillP (ADelayed sh getElem) marr- = fillChunkedP (size sh) (unsafeWriteMArr marr) (getElem . fromIndex sh) +instance Shape sh => Load D sh e where+ loadP (ADelayed sh getElem) mvec+ = mvec `deepSeqMVec` + do traceEventIO "Repa.loadP[Delayed]: start"+ fillChunkedP (size sh) (unsafeWriteMVec mvec) (getElem . fromIndex sh) + touchMVec mvec+ traceEventIO "Repa.loadP[Delayed]: end"+ {-# INLINE [4] loadP #-} - {-# INLINE [4] fillS #-}- fillS (ADelayed sh getElem) marr- = fillChunkedS (size sh) (unsafeWriteMArr marr) (getElem . fromIndex sh)+ loadS (ADelayed sh getElem) mvec+ = mvec `deepSeqMVec` + do traceEventIO "Repa.loadS[Delayed]: start"+ fillLinearS (size sh) (unsafeWriteMVec mvec) (getElem . fromIndex sh)+ touchMVec mvec+ traceEventIO "Repa.loadS[Delayed]: end"+ {-# INLINE [4] loadS #-} -- | Compute a range of elements in a rank-2 array.-instance (Fillable r2 e, Elt e) => FillRange D r2 DIM2 e where- {-# INLINE [1] fillRangeP #-}- fillRangeP (ADelayed (Z :. _h :. w) getElem) marr- (Z :. y0 :. x0) (Z :. y1 :. x1)- = fillBlock2P (unsafeWriteMArr marr) - getElem- w x0 y0 x1 y1+instance Elt e => LoadRange D DIM2 e where+ loadRangeP (ADelayed (Z :. _h :. (I# w)) getElem) mvec+ (Z :. (I# y0) :. (I# x0)) (Z :. (I# h0) :. (I# w0))+ = mvec `deepSeqMVec` + do traceEventIO "Repa.loadRangeP[Delayed]: start"+ fillBlock2P (unsafeWriteMVec mvec) + getElem+ w x0 y0 w0 h0+ touchMVec mvec+ traceEventIO "Repa.loadRangeP[Delayed]: end"+ {-# INLINE [1] loadRangeP #-} - {-# INLINE [1] fillRangeS #-}- fillRangeS (ADelayed (Z :. _h :. (I# w)) getElem) marr- (Z :. (I# y0) :. (I# x0)) (Z :. (I# y1) :. (I# x1))- = fillBlock2S (unsafeWriteMArr marr) + loadRangeS (ADelayed (Z :. _h :. (I# w)) getElem) mvec+ (Z :. (I# y0) :. (I# x0)) (Z :. (I# h0) :. (I# w0))+ = mvec `deepSeqMVec`+ do traceEventIO "Repa.loadRangeS[Delayed]: start"+ fillBlock2S (unsafeWriteMVec mvec) getElem- w x0 y0 x1 y1+ w x0 y0 w0 h0+ touchMVec mvec+ traceEventIO "Repa.loadRangeS[Delayed]: end"+ {-# INLINE [1] loadRangeS #-} -- Conversions ---------------------------------------------------------------- -- | O(1). Wrap a function as a delayed array. fromFunction :: sh -> (sh -> a) -> Array D sh a-{-# INLINE fromFunction #-} fromFunction sh f = ADelayed sh f +{-# INLINE fromFunction #-} --- | O(1). Produce the extent of an array and a function to retrieve an arbitrary element.+-- | O(1). Produce the extent of an array, and a function to retrieve an+-- arbitrary element. toFunction - :: (Shape sh, Repr r1 a)+ :: (Shape sh, Source r1 a) => Array r1 sh a -> (sh, sh -> a)-{-# INLINE toFunction #-} toFunction arr = case delay arr of ADelayed sh f -> (sh, f)+{-# INLINE toFunction #-} -- | O(1). Delay an array.@@ -91,9 +112,9 @@ -- indices to elements, so consumers don't need to worry about -- what the previous representation was. ---delay :: (Shape sh, Repr r e)+delay :: Shape sh => Source r e => Array r sh e -> Array D sh e+delay arr = ADelayed (extent arr) (unsafeIndex arr) {-# INLINE delay #-}-delay arr = ADelayed (extent arr) (index arr)
Data/Array/Repa/Repr/ForeignPtr.hs view
@@ -6,22 +6,23 @@ where import Data.Array.Repa.Shape import Data.Array.Repa.Base-import Data.Array.Repa.Eval.Fill+import Data.Array.Repa.Eval.Load+import Data.Array.Repa.Eval.Target import Data.Array.Repa.Repr.Delayed import Foreign.Storable import Foreign.ForeignPtr import Foreign.Marshal.Alloc import System.IO.Unsafe+import qualified Foreign.ForeignPtr.Unsafe as Unsafe -- | Arrays represented as foreign buffers in the C heap. data F-data instance Array F sh e- = AForeignPtr !sh !Int !(ForeignPtr e) --- Repr ----------------------------------------------------------------------- -- | Read elements from a foreign buffer.-instance Storable a => Repr F a where- {-# INLINE linearIndex #-}+instance Storable a => Source F a where+ data Array F sh a+ = AForeignPtr !sh !Int !(ForeignPtr a)+ linearIndex (AForeignPtr _ len fptr) ix | ix < len = unsafePerformIO @@ -30,82 +31,92 @@ | otherwise = error "Repa: foreign array index out of bounds"-- {-# INLINE unsafeLinearIndex #-}+ {-# INLINE linearIndex #-}+ unsafeLinearIndex (AForeignPtr _ _ fptr) ix = unsafePerformIO $ withForeignPtr fptr $ \ptr -> peekElemOff ptr ix+ {-# INLINE unsafeLinearIndex #-} - {-# INLINE extent #-} extent (AForeignPtr sh _ _) = sh+ {-# INLINE extent #-} - {-# INLINE deepSeqArray #-} deepSeqArray (AForeignPtr sh len fptr) x = sh `deepSeq` len `seq` fptr `seq` x-+ {-# INLINE deepSeqArray #-}+ --- Fill -------------------------------------------------------------------------- | Filling of foreign buffers.-instance Storable e => Fillable F e where- data MArr F e - = FPArr !Int !(ForeignPtr e)+-- Load -----------------------------------------------------------------------+-- | Filling foreign buffers.+instance Storable e => Target F e where+ data MVec F e + = FPVec !Int !(ForeignPtr e) - {-# INLINE newMArr #-}- newMArr n+ newMVec n = do let (proxy :: e) = undefined ptr <- mallocBytes (sizeOf proxy * n) _ <- peek ptr `asTypeOf` return proxy fptr <- newForeignPtr finalizerFree ptr- return $ FPArr n fptr+ return $ FPVec n fptr+ {-# INLINE newMVec #-} - {-# INLINE unsafeWriteMArr #-}- unsafeWriteMArr (FPArr _ fptr) !ix !x- = withForeignPtr fptr- $ \ptr -> pokeElemOff ptr ix x+ -- CAREFUL: Unwrapping the foreignPtr like this means we need to be careful+ -- to touch it after the last use, otherwise the finaliser might run too early.+ unsafeWriteMVec (FPVec _ fptr) !ix !x+ = pokeElemOff (Unsafe.unsafeForeignPtrToPtr fptr) ix x+ {-# INLINE unsafeWriteMVec #-} - {-# INLINE unsafeFreezeMArr #-}- unsafeFreezeMArr !sh (FPArr len fptr) + unsafeFreezeMVec !sh (FPVec len fptr) = return $ AForeignPtr sh len fptr+ {-# INLINE unsafeFreezeMVec #-} + deepSeqMVec !(FPVec _ fptr) x+ = Unsafe.unsafeForeignPtrToPtr fptr `seq` x+ {-# INLINE deepSeqMVec #-} + touchMVec (FPVec _ fptr)+ = touchForeignPtr fptr+ {-# INLINE touchMVec #-}++ -- Conversions ---------------------------------------------------------------- -- | O(1). Wrap a `ForeignPtr` as an array. fromForeignPtr :: Shape sh => sh -> ForeignPtr e -> Array F sh e-{-# INLINE fromForeignPtr #-} fromForeignPtr !sh !fptr = AForeignPtr sh (size sh) fptr+{-# INLINE fromForeignPtr #-} -- | O(1). Unpack a `ForeignPtr` from an array. toForeignPtr :: Array F sh e -> ForeignPtr e-{-# INLINE toForeignPtr #-} toForeignPtr (AForeignPtr _ _ fptr) = fptr+{-# INLINE toForeignPtr #-} -- | Compute an array sequentially and write the elements into a foreign -- buffer without intermediate copying. If you want to copy a -- pre-existing manifest array to a foreign buffer then `delay` it first. computeIntoS- :: Fill r1 F sh e+ :: (Load r1 sh e, Storable e) => ForeignPtr e -> Array r1 sh e -> IO ()-{-# INLINE computeIntoS #-} computeIntoS !fptr !arr- = fillS arr (FPArr 0 fptr)+ = loadS arr (FPVec 0 fptr)+{-# INLINE computeIntoS #-} -- | Compute an array in parallel and write the elements into a foreign -- buffer without intermediate copying. If you want to copy a -- pre-existing manifest array to a foreign buffer then `delay` it first. computeIntoP- :: Fill r1 F sh e+ :: (Load r1 sh e, Storable e) => ForeignPtr e -> Array r1 sh e -> IO ()-{-# INLINE computeIntoP #-} computeIntoP !fptr !arr- = fillP arr (FPArr 0 fptr)+ = loadP arr (FPVec 0 fptr)+{-# INLINE computeIntoP #-}
+ Data/Array/Repa/Repr/HintInterleave.hs view
@@ -0,0 +1,76 @@++module Data.Array.Repa.Repr.HintInterleave+ (I, Array (..), hintInterleave)+where+import Data.Array.Repa.Eval.Load+import Data.Array.Repa.Eval.Target+import Data.Array.Repa.Eval.Interleaved+import Data.Array.Repa.Repr.Delayed+import Data.Array.Repa.Shape+import Data.Array.Repa.Base+import Debug.Trace+++-- | Hints that computing this array will be an unbalanced workload+-- and evaluation should be interleaved between the processors.+data I r1++instance Source r1 a => Source (I r1) a where+ data Array (I r1) sh a+ = AInterleave !(Array r1 sh a)++ extent (AInterleave arr) + = extent arr+ {-# INLINE extent #-}++ index (AInterleave arr) ix+ = index arr ix+ {-# INLINE index #-}++ unsafeIndex (AInterleave arr) ix+ = unsafeIndex arr ix+ {-# INLINE unsafeIndex #-}++ linearIndex (AInterleave arr) ix+ = linearIndex arr ix+ {-# INLINE linearIndex #-}++ unsafeLinearIndex (AInterleave arr) ix+ = unsafeLinearIndex arr ix+ {-# INLINE unsafeLinearIndex #-}++ deepSeqArray (AInterleave arr) x+ = deepSeqArray arr x+ {-# INLINE deepSeqArray #-}+++deriving instance Show (Array r1 sh e) + => Show (Array (I r1) sh e)++deriving instance Read (Array r1 sh e) + => Read (Array (I r1) sh e)+++-- | Wrap an array with a unbalanced-ness hint.+hintInterleave :: Array r1 sh e -> Array (I r1) sh e+hintInterleave = AInterleave+++-- Load -----------------------------------------------------------------------+instance (Shape sh, Load D sh e) + => Load (I D) sh e where+ loadP (AInterleave (ADelayed sh getElem)) marr+ = marr `deepSeqMVec`+ do traceEventIO "Repa.loadP[Interleaved]: start"+ fillInterleavedP (size sh) (unsafeWriteMVec marr) (getElem . fromIndex sh) + touchMVec marr+ traceEventIO "Repa.loadP[Interleaved]: end"+ {-# INLINE [4] loadP #-}++ -- The fact that the workload is unbalanced doesn't affect us when the+ -- program is run sequentially, so just use the filling method of the inner+ -- representation+ loadS (AInterleave arr) marr+ = loadS arr marr+ {-# INLINE loadS #-}+
+ Data/Array/Repa/Repr/HintSmall.hs view
@@ -0,0 +1,77 @@++module Data.Array.Repa.Repr.HintSmall+ (S, Array (..), hintSmall)+where+import Data.Array.Repa.Eval.Load+import Data.Array.Repa.Base+import Data.Array.Repa.Shape+++-- | Hints that evaluating this array is only a small amount of work.+-- It will be evaluated sequentially in the main thread, instead of+-- in parallel on the gang. This avoids the associated scheduling overhead.+data S r1++instance Source r1 a => Source (S r1) a where+ data Array (S r1) sh a+ = ASmall !(Array r1 sh a)++ extent (ASmall arr) + = extent arr+ {-# INLINE extent #-}++ index (ASmall arr) ix+ = index arr ix+ {-# INLINE index #-}++ unsafeIndex (ASmall arr) ix+ = unsafeIndex arr ix+ {-# INLINE unsafeIndex #-}++ linearIndex (ASmall arr) ix+ = linearIndex arr ix+ {-# INLINE linearIndex #-}++ unsafeLinearIndex (ASmall arr) ix+ = unsafeLinearIndex arr ix+ {-# INLINE unsafeLinearIndex #-}++ deepSeqArray (ASmall arr) x+ = deepSeqArray arr x+ {-# INLINE deepSeqArray #-}+++-- | Wrap an array with a smallness hint.+hintSmall :: Array r1 sh e -> Array (S r1) sh e+hintSmall = ASmall+++deriving instance Show (Array r1 sh e) + => Show (Array (S r1) sh e)++deriving instance Read (Array r1 sh e) + => Read (Array (S r1) sh e)+++-- Load ----------------------------------------------------------------------+instance ( Shape sh, Load r1 sh e) + => Load (S r1) sh e where+ loadP (ASmall arr) marr+ = loadS arr marr+ {-# INLINE loadP #-}++ loadS (ASmall arr) marr+ = loadS arr marr+ {-# INLINE loadS #-}+++-- LoadRange ------------------------------------------------------------------+instance ( Shape sh, LoadRange r1 sh e)+ => LoadRange (S r1) sh e where+ loadRangeP (ASmall arr) marr ix1 ix2+ = loadRangeS arr marr ix1 ix2+ {-# INLINE loadRangeP #-}++ loadRangeS (ASmall arr) marr ix1 ix2+ = loadRangeS arr marr ix1 ix2+ {-# INLINE loadRangeS #-}
Data/Array/Repa/Repr/Partitioned.hs view
@@ -9,7 +9,6 @@ import Data.Array.Repa.Shape import Data.Array.Repa.Eval import Data.Array.Repa.Repr.Delayed-import Data.Array.Repa.Repr.Undefined -- | Partitioned arrays.@@ -24,59 +23,62 @@ -- data P r1 r2 -data instance Array (P r1 r2) sh e- = APart sh -- size of the whole array- (Range sh) (Array r1 sh e) -- if in range use this array- (Array r2 sh e) -- otherwise use this array- data Range sh- = Range sh sh -- indices defining the range- (sh -> Bool) -- predicate to check whether were in range+ = Range !sh !sh -- indices defining the range+ (sh -> Bool) -- predicate to check whether were in range -- | Check whether an index is within the given range.-{-# INLINE inRange #-} inRange :: Range sh -> sh -> Bool inRange (Range _ _ p) ix = p ix+{-# INLINE inRange #-} -- Repr ----------------------------------------------------------------------- -- | Read elements from a partitioned array.-instance (Repr r1 e, Repr r2 e) => Repr (P r1 r2) e where- {-# INLINE index #-}+instance (Source r1 e, Source r2 e) => Source (P r1 r2) e where+ data Array (P r1 r2) sh e+ = APart !sh -- size of the whole array+ !(Range sh) !(Array r1 sh e) -- if in range use this array+ !(Array r2 sh e) -- otherwise use this array++ index (APart _ range arr1 arr2) ix | inRange range ix = index arr1 ix | otherwise = index arr2 ix+ {-# INLINE index #-} - {-# INLINE linearIndex #-} linearIndex arr@(APart sh _ _ _) ix = index arr $ fromIndex sh ix+ {-# INLINE linearIndex #-} - {-# INLINE extent #-} extent (APart sh _ _ _) = sh+ {-# INLINE extent #-} - {-# INLINE deepSeqArray #-} deepSeqArray (APart sh range arr1 arr2) y = sh `deepSeq` range `deepSeqRange` arr1 `deepSeqArray` arr2 `deepSeqArray` y+ {-# INLINE deepSeqArray #-} -{-# INLINE deepSeqRange #-} deepSeqRange :: Shape sh => Range sh -> b -> b-deepSeqRange (Range low high f) y- = low `deepSeq` high `deepSeq` f `seq` y+deepSeqRange (Range ix sz f) y+ = ix `deepSeq` sz `deepSeq` f `seq` y+{-# INLINE deepSeqRange #-} --- Fill ------------------------------------------------------------------------instance ( FillRange r1 r3 sh e, Fill r2 r3 sh e- , Fillable r3 e)- => Fill (P r1 r2) r3 sh e where- {-# INLINE fillP #-}- fillP (APart _ (Range ix10 ix11 _) arr1 arr2) marr- = do fillRangeP arr1 marr ix10 ix11- fillP arr2 marr+-- Load -----------------------------------------------------------------------+instance (LoadRange r1 sh e, Load r2 sh e)+ => Load (P r1 r2) sh e where+ loadP (APart _ (Range ix sz _) arr1 arr2) marr+ = do loadRangeP arr1 marr ix sz+ loadP arr2 marr+ {-# INLINE loadP #-} - {-# INLINE fillS #-}- fillS (APart _ (Range ix10 ix11 _) arr1 arr2) marr- = do fillRangeS arr1 marr ix10 ix11- fillS arr2 marr+ loadS (APart _ (Range ix sz _) arr1 arr2) marr+ = do loadRangeS arr1 marr ix sz+ loadS arr2 marr+ {-# INLINE loadS #-}+++
Data/Array/Repa/Repr/Unboxed.hs view
@@ -19,68 +19,81 @@ -- | Unboxed arrays are represented as unboxed vectors. ----- The implementation of `Data.Vector.Unboxed` is based on type families and--- picks an efficient, specialised representation for every element type. In--- particular, unboxed vectors of pairs are represented as pairs of unboxed--- vectors. This is the most efficient representation for numerical data.+-- The implementation uses @Data.Vector.Unboxed@ which is based on type+-- families and picks an efficient, specialised representation for every+-- element type. In particular, unboxed vectors of pairs are represented+-- as pairs of unboxed vectors.+-- This is the most efficient representation for numerical data. -- data U-data instance U.Unbox e => Array U sh e- = AUnboxed sh !(U.Vector e)- -deriving instance (Show sh, Show e, U.Unbox e)- => Show (Array U sh e) --- Repr ----------------------------------------------------------------------- -- | Read elements from an unboxed vector array.-instance U.Unbox a => Repr U a where- {-# INLINE linearIndex #-}+instance U.Unbox a => Source U a where+ data Array U sh a+ = AUnboxed !sh !(U.Vector a)+ linearIndex (AUnboxed _ vec) ix = vec U.! ix+ {-# INLINE linearIndex #-} - {-# INLINE unsafeLinearIndex #-} unsafeLinearIndex (AUnboxed _ vec) ix = vec `U.unsafeIndex` ix+ {-# INLINE unsafeLinearIndex #-} - {-# INLINE extent #-} extent (AUnboxed sh _) = sh+ {-# INLINE extent #-} - {-# INLINE deepSeqArray #-} deepSeqArray (AUnboxed sh vec) x = sh `deepSeq` vec `seq` x+ {-# INLINE deepSeqArray #-} +deriving instance (Show sh, Show e, U.Unbox e)+ => Show (Array U sh e)++deriving instance (Read sh, Read e, U.Unbox e)+ => Read (Array U sh e)++ -- Fill ----------------------------------------------------------------------- -- | Filling of unboxed vector arrays.-instance U.Unbox e => Fillable U e where- data MArr U e - = UMArr (UM.IOVector e)+instance U.Unbox e => Target U e where+ data MVec U e + = UMVec (UM.IOVector e) - {-# INLINE newMArr #-}- newMArr n- = liftM UMArr (UM.new n)+ newMVec n+ = liftM UMVec (UM.new n)+ {-# INLINE newMVec #-} - {-# INLINE unsafeWriteMArr #-}- unsafeWriteMArr (UMArr v) ix+ unsafeWriteMVec (UMVec v) ix = UM.unsafeWrite v ix+ {-# INLINE unsafeWriteMVec #-} - {-# INLINE unsafeFreezeMArr #-}- unsafeFreezeMArr sh (UMArr mvec) + unsafeFreezeMVec sh (UMVec mvec) = do vec <- U.unsafeFreeze mvec return $ AUnboxed sh vec+ {-# INLINE unsafeFreezeMVec #-} + deepSeqMVec (UMVec vec) x+ = vec `seq` x+ {-# INLINE deepSeqMVec #-} + touchMVec _ + = return ()+ {-# INLINE touchMVec #-}++ -- Conversions ---------------------------------------------------------------- -- | Sequential computation of array elements.. -- -- * This is an alias for `computeS` with a more specific type. -- computeUnboxedS- :: Fill r1 U sh e+ :: (Load r1 sh e, U.Unbox e) => Array r1 sh e -> Array U sh e-{-# INLINE computeUnboxedS #-} computeUnboxedS = computeS+{-# INLINE computeUnboxedS #-} -- | Parallel computation of array elements.@@ -88,10 +101,10 @@ -- * This is an alias for `computeP` with a more specific type. -- computeUnboxedP- :: Fill r1 U sh e- => Array r1 sh e -> Array U sh e-{-# INLINE computeUnboxedP #-}+ :: (Load r1 sh e, Monad m, U.Unbox e)+ => Array r1 sh e -> m (Array U sh e) computeUnboxedP = computeP+{-# INLINE computeUnboxedP #-} -- | O(n). Convert a list to an unboxed vector array.@@ -101,37 +114,34 @@ fromListUnboxed :: (Shape sh, U.Unbox a) => sh -> [a] -> Array U sh a-{-# INLINE fromListUnboxed #-} fromListUnboxed = R.fromList+{-# INLINE fromListUnboxed #-} -- | O(1). Wrap an unboxed vector as an array.-fromUnboxed- :: (Shape sh, U.Unbox e)- => sh -> U.Vector e -> Array U sh e-{-# INLINE fromUnboxed #-}+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-{-# INLINE toUnboxed #-}+toUnboxed :: Array U sh e -> U.Vector e toUnboxed (AUnboxed _ vec) = vec+{-# INLINE toUnboxed #-} + -- Zip ------------------------------------------------------------------------ -- | O(1). Zip some unboxed arrays. -- The shapes must be identical else `error`. zip :: (Shape sh, U.Unbox a, U.Unbox b) => Array U sh a -> Array U sh b -> Array U sh (a, b)-{-# INLINE zip #-} zip (AUnboxed sh1 vec1) (AUnboxed sh2 vec2) | sh1 /= sh2 = error "Repa: zip array shapes not identical" | otherwise = AUnboxed sh1 (U.zip vec1 vec2)+{-# INLINE zip #-} -- | O(1). Zip some unboxed arrays.@@ -139,11 +149,11 @@ zip3 :: (Shape sh, U.Unbox a, U.Unbox b, U.Unbox c) => Array U sh a -> Array U sh b -> Array U sh c -> Array U sh (a, b, c)-{-# INLINE zip3 #-} zip3 (AUnboxed sh1 vec1) (AUnboxed sh2 vec2) (AUnboxed sh3 vec3) | sh1 /= sh2 || sh1 /= sh3 = error "Repa: zip array shapes not identical" | otherwise = AUnboxed sh1 (U.zip3 vec1 vec2 vec3)+{-# INLINE zip3 #-} -- | O(1). Zip some unboxed arrays.@@ -151,11 +161,11 @@ zip4 :: (Shape sh, U.Unbox a, U.Unbox b, U.Unbox c, U.Unbox d) => Array U sh a -> Array U sh b -> Array U sh c -> Array U sh d -> Array U sh (a, b, c, d)-{-# INLINE zip4 #-} zip4 (AUnboxed sh1 vec1) (AUnboxed sh2 vec2) (AUnboxed sh3 vec3) (AUnboxed sh4 vec4) | sh1 /= sh2 || sh1 /= sh3 || sh1 /= sh4 = error "Repa: zip array shapes not identical" | otherwise = AUnboxed sh1 (U.zip4 vec1 vec2 vec3 vec4)+{-# INLINE zip4 #-} -- | O(1). Zip some unboxed arrays.@@ -163,11 +173,11 @@ zip5 :: (Shape sh, U.Unbox a, U.Unbox b, U.Unbox c, U.Unbox d, U.Unbox e) => Array U sh a -> Array U sh b -> Array U sh c -> Array U sh d -> Array U sh e -> Array U sh (a, b, c, d, e)-{-# INLINE zip5 #-} zip5 (AUnboxed sh1 vec1) (AUnboxed sh2 vec2) (AUnboxed sh3 vec3) (AUnboxed sh4 vec4) (AUnboxed sh5 vec5) | sh1 /= sh2 || sh1 /= sh3 || sh1 /= sh4 || sh1 /= sh5 = error "Repa: zip array shapes not identical" | otherwise = AUnboxed sh1 (U.zip5 vec1 vec2 vec3 vec4 vec5)+{-# INLINE zip5 #-} -- | O(1). Zip some unboxed arrays.@@ -175,11 +185,11 @@ zip6 :: (Shape sh, U.Unbox a, U.Unbox b, U.Unbox c, U.Unbox d, U.Unbox e, U.Unbox f) => Array U sh a -> Array U sh b -> Array U sh c -> Array U sh d -> Array U sh e -> Array U sh f -> Array U sh (a, b, c, d, e, f)-{-# INLINE zip6 #-} zip6 (AUnboxed sh1 vec1) (AUnboxed sh2 vec2) (AUnboxed sh3 vec3) (AUnboxed sh4 vec4) (AUnboxed sh5 vec5) (AUnboxed sh6 vec6) | sh1 /= sh2 || sh1 /= sh3 || sh1 /= sh4 || sh1 /= sh5 || sh1 /= sh6 = error "Repa: zip array shapes not identical" | otherwise = AUnboxed sh1 (U.zip6 vec1 vec2 vec3 vec4 vec5 vec6)+{-# INLINE zip6 #-} -- Unzip ----------------------------------------------------------------------@@ -187,47 +197,47 @@ unzip :: (U.Unbox a, U.Unbox b) => Array U sh (a, b) -> (Array U sh a, Array U sh b)-{-# INLINE unzip #-} unzip (AUnboxed sh vec) = let (as, bs) = U.unzip vec in (AUnboxed sh as, AUnboxed sh bs)+{-# INLINE unzip #-} -- | O(1). Unzip an unboxed array. unzip3 :: (U.Unbox a, U.Unbox b, U.Unbox c) => Array U sh (a, b, c) -> (Array U sh a, Array U sh b, Array U sh c)-{-# INLINE unzip3 #-} unzip3 (AUnboxed sh vec) = let (as, bs, cs) = U.unzip3 vec in (AUnboxed sh as, AUnboxed sh bs, AUnboxed sh cs)+{-# INLINE unzip3 #-} -- | O(1). Unzip an unboxed array. unzip4 :: (U.Unbox a, U.Unbox b, U.Unbox c, U.Unbox d) => Array U sh (a, b, c, d) -> (Array U sh a, Array U sh b, Array U sh c, Array U sh d)-{-# INLINE unzip4 #-} unzip4 (AUnboxed sh vec) = let (as, bs, cs, ds) = U.unzip4 vec in (AUnboxed sh as, AUnboxed sh bs, AUnboxed sh cs, AUnboxed sh ds)+{-# INLINE unzip4 #-} -- | O(1). Unzip an unboxed array. unzip5 :: (U.Unbox a, U.Unbox b, U.Unbox c, U.Unbox d, U.Unbox e) => Array U sh (a, b, c, d, e) -> (Array U sh a, Array U sh b, Array U sh c, Array U sh d, Array U sh e)-{-# INLINE unzip5 #-} unzip5 (AUnboxed sh vec) = let (as, bs, cs, ds, es) = U.unzip5 vec in (AUnboxed sh as, AUnboxed sh bs, AUnboxed sh cs, AUnboxed sh ds, AUnboxed sh es)+{-# INLINE unzip5 #-} -- | O(1). Unzip an unboxed array. unzip6 :: (U.Unbox a, U.Unbox b, U.Unbox c, U.Unbox d, U.Unbox e, U.Unbox f) => Array U sh (a, b, c, d, e, f) -> (Array U sh a, Array U sh b, Array U sh c, Array U sh d, Array U sh e, Array U sh f)-{-# INLINE unzip6 #-} unzip6 (AUnboxed sh vec) = let (as, bs, cs, ds, es, fs) = U.unzip6 vec in (AUnboxed sh as, AUnboxed sh bs, AUnboxed sh cs, AUnboxed sh ds, AUnboxed sh es, AUnboxed sh fs)+{-# INLINE unzip6 #-}
Data/Array/Repa/Repr/Undefined.hs view
@@ -4,7 +4,7 @@ where import Data.Array.Repa.Base import Data.Array.Repa.Shape-import Data.Array.Repa.Eval.Fill+import Data.Array.Repa.Eval -- | An array with undefined elements.@@ -12,30 +12,40 @@ -- * This is normally used as the last representation in a partitioned array, -- as the previous partitions are expected to provide full coverage. data X-data instance Array X sh e- = AUndefined sh -- | Undefined array elements. Inspecting them yields `error`. ---instance Repr X e where- {-# INLINE deepSeqArray #-}+instance Source X e where+ data Array X sh e+ = AUndefined !sh+ deepSeqArray _ x = x+ {-# INLINE deepSeqArray #-} - {-# INLINE extent #-} extent (AUndefined sh) = sh+ {-# INLINE extent #-} + index (AUndefined _) _ + = error $ "Repa: array element is undefined." {-# INLINE index #-}- index (AUndefined _) _ = error "Repa: array element is undefined." + linearIndex (AUndefined _) ix+ = error $ "Repa: array element at " ++ show ix ++ " is undefined." {-# INLINE linearIndex #-}- linearIndex (AUndefined _) _ = error "Repa: array element is undefined."- -instance (Shape sh, Fillable r2 e, Num e) => Fill X r2 sh e where- fillS _ _ = return ()- fillP _ _ = return ()++deriving instance Show sh + => Show (Array X sh e)++deriving instance Read sh + => Read (Array X sh e)+++instance Shape sh => Load X sh e where+ loadS _ _ = return ()+ loadP _ _ = return ()
Data/Array/Repa/Repr/Vector.hs view
@@ -19,70 +19,82 @@ -- have an `Unbox` instsance. If it does, then use the Unboxed `U` -- representation will be faster. data V-data instance Array V sh e- = AVector sh !(V.Vector e) -deriving instance (Show sh, Show e)- => Show (Array V sh e)---- Repr ----------------------------------------------------------------------- -- | Read elements from a boxed vector array.-instance Repr V a where- {-# INLINE linearIndex #-}+instance Source V a where+ data Array V sh a+ = AVector !sh !(V.Vector a)+ linearIndex (AVector _ vec) ix = vec V.! ix+ {-# INLINE linearIndex #-} - {-# INLINE unsafeLinearIndex #-} unsafeLinearIndex (AVector _ vec) ix = vec `V.unsafeIndex` ix+ {-# INLINE unsafeLinearIndex #-} - {-# INLINE extent #-} extent (AVector sh _) = sh+ {-# INLINE extent #-} - {-# INLINE deepSeqArray #-} deepSeqArray (AVector sh vec) x = sh `deepSeq` vec `seq` x+ {-# INLINE deepSeqArray #-} +deriving instance (Show sh, Show e)+ => Show (Array V sh e)++deriving instance (Read sh, Read e)+ => Read (Array V sh e)++ -- Fill ----------------------------------------------------------------------- -- | Filling of boxed vector arrays.-instance Fillable V e where- data MArr V e - = MVec (VM.IOVector e)+instance Target V e where+ data MVec V e + = MVector (VM.IOVector e) - {-# INLINE newMArr #-}- newMArr n- = liftM MVec (VM.new n)+ newMVec n+ = liftM MVector (VM.new n)+ {-# INLINE newMVec #-} - {-# INLINE unsafeWriteMArr #-}- unsafeWriteMArr (MVec v) ix+ unsafeWriteMVec (MVector v) ix = VM.unsafeWrite v ix+ {-# INLINE unsafeWriteMVec #-} - {-# INLINE unsafeFreezeMArr #-}- unsafeFreezeMArr sh (MVec mvec) + unsafeFreezeMVec sh (MVector mvec) = do vec <- V.unsafeFreeze mvec return $ AVector sh vec+ {-# INLINE unsafeFreezeMVec #-} + deepSeqMVec !_vec x+ = x+ {-# INLINE deepSeqMVec #-} + touchMVec _ + = return ()+ {-# INLINE touchMVec #-}++ -- Conversions ---------------------------------------------------------------- -- | Sequential computation of array elements. -- -- * This is an alias for `compute` with a more specific type. -- computeVectorS- :: Fill r1 V sh e+ :: Load r1 sh e => Array r1 sh e -> Array V sh e-{-# INLINE computeVectorS #-} computeVectorS = computeS+{-# INLINE computeVectorS #-} -- | Parallel computation of array elements. computeVectorP- :: Fill r1 V sh e- => Array r1 sh e -> Array V sh e-{-# INLINE computeVectorP #-}+ :: (Load r1 sh e, Monad m)+ => Array r1 sh e -> m (Array V sh e) computeVectorP = computeP+{-# INLINE computeVectorP #-} -- | O(n). Convert a list to a boxed vector array.@@ -90,23 +102,21 @@ -- * This is an alias for `fromList` with a more specific type. -- fromListVector :: Shape sh => sh -> [a] -> Array V sh a-{-# INLINE fromListVector #-} fromListVector = fromList+{-# INLINE fromListVector #-} -- | O(1). Wrap a boxed vector as an array.-fromVector- :: Shape sh- => sh -> V.Vector e -> Array V sh e-{-# INLINE fromVector #-}+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-{-# INLINE toVector #-}+toVector :: Array V sh e -> V.Vector e toVector (AVector _ vec) = vec+{-# INLINE toVector #-}
Data/Array/Repa/Shape.hs view
@@ -2,7 +2,7 @@ -- | Class of types that can be used as array shapes and indices. module Data.Array.Repa.Shape- ( Shape(..)+ ( Shape(..) , inShape , showShape ) where@@ -11,69 +11,69 @@ -- | Class of types that can be used as array shapes and indices. class Eq sh => Shape sh where - -- | Get the number of dimensions in a shape.- rank :: sh -> Int+ -- | Get the number of dimensions in a shape.+ rank :: sh -> Int - -- | The shape of an array of size zero, with a particular dimensionality.- zeroDim :: sh+ -- | The shape of an array of size zero, with a particular dimensionality.+ zeroDim :: sh - -- | The shape of an array with size one, with a particular dimensionality.- unitDim :: sh+ -- | The shape of an array with size one, with a particular dimensionality.+ unitDim :: sh - -- | Compute the intersection of two shapes.- intersectDim :: sh -> sh -> sh+ -- | Compute the intersection of two shapes.+ intersectDim :: sh -> sh -> sh - -- | Add the coordinates of two shapes componentwise- addDim :: sh -> sh -> sh+ -- | Add the coordinates of two shapes componentwise+ addDim :: sh -> sh -> sh - -- | Get the total number of elements in an array with this shape.- size :: sh -> Int+ -- | Get the total number of elements in an array with this shape.+ size :: sh -> Int - -- | Check whether this shape is small enough so that its flat- -- indices an be represented as `Int`. If this returns `False` then your- -- array is too big. Mostly used for writing QuickCheck tests.- sizeIsValid :: sh -> Bool+ -- | Check whether this shape is small enough so that its flat+ -- indices an be represented as `Int`. If this returns `False` then your+ -- array is too big. Mostly used for writing QuickCheck tests.+ sizeIsValid :: sh -> Bool - -- | Convert an index into its equivalent flat, linear, row-major version.- toIndex :: sh -- ^ Shape of the array.- -> sh -- ^ Index into the array.- -> Int+ -- | Convert an index into its equivalent flat, linear, row-major version.+ toIndex :: sh -- ^ Shape of the array.+ -> sh -- ^ Index into the array.+ -> Int - -- | Inverse of `toIndex`.- fromIndex- :: sh -- ^ Shape of the array.- -> Int -- ^ Index into linear representation.- -> sh+ -- | Inverse of `toIndex`.+ fromIndex+ :: sh -- ^ Shape of the array.+ -> Int -- ^ Index into linear representation.+ -> sh - -- | Check whether an index is within a given shape.- inShapeRange- :: sh -- ^ Start index for range.- -> sh -- ^ Final index for range.- -> sh -- ^ Index to check for.- -> Bool+ -- | Check whether an index is within a given shape.+ inShapeRange+ :: sh -- ^ Start index for range.+ -> sh -- ^ Final index for range.+ -> sh -- ^ Index to check for.+ -> Bool - -- | Convert a shape into its list of dimensions.- listOfShape :: sh -> [Int]+ -- | Convert a shape into its list of dimensions.+ listOfShape :: sh -> [Int] - -- | Convert a list of dimensions to a shape- shapeOfList :: [Int] -> sh+ -- | Convert a list of dimensions to a shape+ shapeOfList :: [Int] -> sh - -- | Ensure that a shape is completely evaluated.- infixr 0 `deepSeq`- deepSeq :: sh -> a -> a+ -- | Ensure that a shape is completely evaluated.+ infixr 0 `deepSeq`+ deepSeq :: sh -> a -> a -- | Check whether an index is a part of a given shape. inShape :: forall sh- . Shape sh- => sh -- ^ Shape of the array.- -> sh -- ^ Index.- -> Bool+ . Shape sh+ => sh -- ^ Shape of the array.+ -> sh -- ^ Index.+ -> Bool {-# INLINE inShape #-} inShape sh ix- = inShapeRange zeroDim sh ix+ = inShapeRange zeroDim sh ix -- | Nicely format a shape as a string
Data/Array/Repa/Slice.hs view
@@ -3,81 +3,81 @@ -- | Index space transformation between arrays and slices. module Data.Array.Repa.Slice- ( All (..)- , Any (..)- , FullShape- , SliceShape- , Slice (..))+ ( All (..)+ , Any (..)+ , FullShape+ , SliceShape+ , Slice (..)) where import Data.Array.Repa.Index-import Prelude hiding (replicate, drop)+import Prelude hiding (replicate, drop) -- | Select all indices at a certain position.-data All = All+data All = All -- | Place holder for any possible shape.-data Any sh = Any+data Any sh = Any -- | Map a type of the index in the full shape, to the type of the index in the slice. type family FullShape ss-type instance FullShape Z = Z-type instance FullShape (Any sh) = sh-type instance FullShape (sl :. Int) = FullShape sl :. Int-type instance FullShape (sl :. All) = FullShape sl :. Int+type instance FullShape Z = Z+type instance FullShape (Any sh) = sh+type instance FullShape (sl :. Int) = FullShape sl :. Int+type instance FullShape (sl :. All) = FullShape sl :. Int -- | Map the type of an index in the slice, to the type of the index in the full shape. type family SliceShape ss-type instance SliceShape Z = Z-type instance SliceShape (Any sh) = sh-type instance SliceShape (sl :. Int) = SliceShape sl-type instance SliceShape (sl :. All) = SliceShape sl :. Int+type instance SliceShape Z = Z+type instance SliceShape (Any sh) = sh+type instance SliceShape (sl :. Int) = SliceShape sl+type instance SliceShape (sl :. All) = SliceShape sl :. Int -- | Class of index types that can map to slices. class Slice ss where- -- | Map an index of a full shape onto an index of some slice.- sliceOfFull :: ss -> FullShape ss -> SliceShape ss+ -- | Map an index of a full shape onto an index of some slice.+ sliceOfFull :: ss -> FullShape ss -> SliceShape ss - -- | Map an index of a slice onto an index of the full shape.- fullOfSlice :: ss -> SliceShape ss -> FullShape ss+ -- | Map an index of a slice onto an index of the full shape.+ fullOfSlice :: ss -> SliceShape ss -> FullShape ss instance Slice Z where- {-# INLINE [1] sliceOfFull #-}- sliceOfFull _ _ = Z+ {-# INLINE [1] sliceOfFull #-}+ sliceOfFull _ _ = Z - {-# INLINE [1] fullOfSlice #-}- fullOfSlice _ _ = Z+ {-# INLINE [1] fullOfSlice #-}+ fullOfSlice _ _ = Z instance Slice (Any sh) where- {-# INLINE [1] sliceOfFull #-}- sliceOfFull _ sh = sh+ {-# INLINE [1] sliceOfFull #-}+ sliceOfFull _ sh = sh - {-# INLINE [1] fullOfSlice #-}- fullOfSlice _ sh = sh+ {-# INLINE [1] fullOfSlice #-}+ fullOfSlice _ sh = sh instance Slice sl => Slice (sl :. Int) where- {-# INLINE [1] sliceOfFull #-}- sliceOfFull (fsl :. _) (ssl :. _)- = sliceOfFull fsl ssl+ {-# INLINE [1] sliceOfFull #-}+ sliceOfFull (fsl :. _) (ssl :. _)+ = sliceOfFull fsl ssl - {-# INLINE [1] fullOfSlice #-}- fullOfSlice (fsl :. n) ssl- = fullOfSlice fsl ssl :. n+ {-# INLINE [1] fullOfSlice #-}+ fullOfSlice (fsl :. n) ssl+ = fullOfSlice fsl ssl :. n instance Slice sl => Slice (sl :. All) where- {-# INLINE [1] sliceOfFull #-}- sliceOfFull (fsl :. All) (ssl :. s)- = sliceOfFull fsl ssl :. s+ {-# INLINE [1] sliceOfFull #-}+ sliceOfFull (fsl :. All) (ssl :. s)+ = sliceOfFull fsl ssl :. s - {-# INLINE [1] fullOfSlice #-}- fullOfSlice (fsl :. All) (ssl :. s)- = fullOfSlice fsl ssl :. s+ {-# INLINE [1] fullOfSlice #-}+ fullOfSlice (fsl :. All) (ssl :. s)+ = fullOfSlice fsl ssl :. s
Data/Array/Repa/Specialised/Dim2.hs view
@@ -2,12 +2,13 @@ -- | 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 import Data.Array.Repa.Repr.Partitioned import Data.Array.Repa.Repr.Undefined @@ -16,94 +17,103 @@ -- 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 + -- | Make a 2D partitioned array from two others, one to produce the elements -- in the internal region, and one to produce elements in the border region. -- The two arrays must have the same extent. -- The border must be the same width on all sides. ----- TODO: Check arrays have same extent.--- makeBordered2- :: 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) borderWidth arrInternal arrBorder- = let- -- minimum and maximum indicies of values in the inner part of the image.- !xMin = borderWidth- !yMin = borderWidth- !xMax = aWidth - borderWidth - 1- !yMax = aHeight - borderWidth - 1-+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+ !inW = aWidth - 2 * bWidth + !inH = aHeight - 2 * bWidth - {-# INLINE inInternal #-}- inInternal (Z :. y :. x)- = x >= xMin && x <= xMax- && y >= yMin && y <= yMax+ inInternal (Z :. y :. x)+ = x >= inX && x < (inX + inW)+ && y >= inY && y < (inY + inH)+ {-# INLINE inInternal #-} - {-# INLINE inBorder #-}- inBorder = not . inInternal+ inBorder = not . inInternal+ {-# INLINE inBorder #-} - in + in -- internal region- APart sh (Range (Z :. yMin :. xMin) (Z :. yMax :. xMax ) inInternal) arrInternal+ APart sh (Range (Z :. inY :. inX) (Z :. inH :. inW ) inInternal) arrInternal -- border regions- $ APart sh (Range (Z :. 0 :. 0) (Z :. yMin -1 :. aWidth - 1) inBorder) arrBorder- $ APart sh (Range (Z :. yMax + 1 :. 0) (Z :. aHeight - 1 :. aWidth - 1) inBorder) arrBorder- $ APart sh (Range (Z :. yMin :. 0) (Z :. yMax :. xMin - 1) inBorder) arrBorder- $ APart sh (Range (Z :. yMin :. xMax + 1) (Z :. yMax :. aWidth - 1) inBorder) arrBorder+ $ APart sh (Range (Z :. 0 :. 0) (Z :. bWidth :. aWidth) inBorder) arrBorder+ $ APart sh (Range (Z :. inY + inH :. 0) (Z :. bWidth :. aWidth) inBorder) arrBorder+ $ APart sh (Range (Z :. inY :. 0) (Z :. inH :. bWidth) inBorder) arrBorder+ $ APart sh (Range (Z :. inY :. inX + inW) (Z :. inH :. bWidth) inBorder) arrBorder $ AUndefined sh++ where+ checkDims+ = if (extent arrInternal) == (extent arrBorder)+ then ()+ else error "makeBordered2: internal and border arrays have different extents"+ {-# NOINLINE checkDims #-}+ -- NOINLINE because we don't want the branch in the core code.+
Data/Array/Repa/Stencil.hs view
@@ -1,19 +1,16 @@-{-# LANGUAGE MagicHash, PatternGuards, BangPatterns, TemplateHaskell, QuasiQuotes,- ParallelListComp, TypeOperators, ExplicitForAll, ScopedTypeVariables #-} {-# OPTIONS -Wnot #-} -- | Efficient computation of stencil based convolutions. -- module Data.Array.Repa.Stencil- ( Stencil (..)- , Boundary (..)+ ( Stencil (..)+ , Boundary (..) - -- * Stencil creation.- , makeStencil)+ -- * Stencil creation.+ , makeStencil) where import Data.Array.Repa import Data.Array.Repa.Base import Data.Array.Repa.Stencil.Base-import Data.Array.Repa.Stencil.Template import Data.Array.Repa.Specialised.Dim2
Data/Array/Repa/Stencil/Base.hs view
@@ -1,58 +1,61 @@ -- | 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 -- | How to handle the case when the stencil lies partly outside the array. data Boundary a- -- | Treat points outside as having a constant value.- = BoundConst a+ -- | Use a fixed value for border regions.+ = BoundFixed !a - -- | Clamp points outside to the same value as the edge pixel.- | BoundClamp- deriving (Show)+ -- | 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) + -- | Represents a convolution stencil that we can apply to array. -- Only statically known stencils are supported right now. data Stencil sh a - -- | Static stencils are used when the coefficients are fixed,- -- and known at compile time.- = StencilStatic- { stencilExtent :: !sh- , stencilZero :: !a- , stencilAcc :: !(sh -> a -> a -> a) }+ -- | Static stencils are used when the coefficients are fixed,+ -- and known at compile time.+ = StencilStatic+ { stencilExtent :: !sh+ , stencilZero :: !a+ , stencilAcc :: !(sh -> a -> a -> a) } -- | Make a stencil from a function yielding coefficients at each index. makeStencil- :: Num a- => sh -- ^ Extent of stencil.- -> (sh -> Maybe a) -- ^ Get the coefficient at this index.- -> Stencil sh a+ :: Num a+ => sh -- ^ Extent of stencil.+ -> (sh -> Maybe a) -- ^ Get the coefficient at this index.+ -> Stencil sh a {-# INLINE makeStencil #-} makeStencil ex getCoeff = StencilStatic ex 0 $ \ix val acc- -> case getCoeff ix of- Nothing -> acc- Just coeff -> acc + val * coeff+ -> case getCoeff ix of+ Nothing -> acc+ Just coeff -> acc + val * coeff -- | Wrapper for `makeStencil` that requires a DIM2 stencil. makeStencil2- :: Num a- => Int -> Int -- ^ extent of stencil- -> (DIM2 -> Maybe a) -- ^ Get the coefficient at this index.- -> Stencil DIM2 a+ :: Num a+ => Int -> Int -- ^ extent of stencil+ -> (DIM2 -> Maybe a) -- ^ Get the coefficient at this index.+ -> Stencil DIM2 a {-# INLINE makeStencil2 #-} makeStencil2 height width getCoeff- = makeStencil (Z :. height :. width) getCoeff+ = makeStencil (Z :. height :. width) getCoeff
Data/Array/Repa/Stencil/Dim2.hs view
@@ -1,3 +1,4 @@+{-# 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@@ -10,141 +11,153 @@ -- 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+import Data.Array.Repa.Base+import Data.Array.Repa.Index+import Data.Array.Repa.Shape+import Data.Array.Repa.Repr.Delayed import Data.Array.Repa.Repr.Cursored import Data.Array.Repa.Repr.Partitioned+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 D (P D (P D (P D X))))+type PC5 = P C (P (S D) (P (S D) (P (S D) (P (S D) X)))) -- Wrappers ------------------------------------------------------------------- -- | Like `mapStencil2` but with the parameters flipped. forStencil2- :: Repr r a+ :: 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- :: Repr 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+ :: 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 {-# INLINE mapStencil2 #-} mapStencil2 boundary stencil@(StencilStatic sExtent _zero _load) arr- = let sh = extent arr+ = let sh = extent arr (_ :. aHeight :. aWidth) = sh- (_ :. sHeight :. sWidth) = sExtent-- sHeight2 = sHeight `div` 2- sWidth2 = sWidth `div` 2-- -- minimum and maximum indicies of values in the inner part of the image.- !xMin = sWidth2- !yMin = sHeight2- !xMax = aWidth - sWidth2 - 1- !yMax = aHeight - sHeight2 - 1+ (_ :. sHeight :. sWidth) = sExtent - {-# INLINE inInternal #-}- inInternal (Z :. y :. x)- = x >= xMin && x <= xMax- && y >= yMin && y <= yMax+ sHeight2 = sHeight `div` 2+ sWidth2 = sWidth `div` 2 - {-# INLINE inBorder #-}- inBorder = not . inInternal+ -- Partition the array into the internal and border regions.+ ![ Region inX inY inW inH+ , Region westX westY westW westH+ , Region eastX eastY eastW eastH+ , Region northX northY northW northH + , Region southX southY southW southH ] + = partitionForStencil + (Size aWidth aHeight) + (Size sWidth sHeight)+ (Offset sWidth2 sHeight2) - -- Cursor functions ----------------- {-# INLINE makec #-}- makec (Z :. y :. x)- = Cursor (x + y * aWidth)+ {-# INLINE inInternal #-}+ inInternal (Z :. y :. x)+ = x >= inX && x < (inX + inW)+ && y >= inY && y < (inY + inH) - {-# INLINE shiftc #-}- shiftc ix (Cursor off)- = Cursor- $ case ix of- Z :. y :. x -> off + y * aWidth + x+ {-# INLINE inBorder #-}+ inBorder = not . inInternal - {-# INLINE getInner' #-}- getInner' cur- = unsafeAppStencilCursor2 shiftc stencil arr cur+ -- Cursor functions ----------------+ {-# INLINE makec #-}+ makec (Z :. y :. x)+ = Cursor (x + y * aWidth) - {-# INLINE getBorder' #-}- getBorder' ix- = case boundary of- BoundConst c -> c- BoundClamp -> unsafeAppStencilCursor2_clamp addDim stencil- arr ix+ {-# 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' - ++ {-# INLINE getInner' #-}+ getInner' cur = unsafeAppStencilCursor2 shiftc stencil arr cur+ {-# INLINE arrBorder #-}- arrBorder = fromFunction (extent arr) getBorder'+ arrBorder = ASmall (fromFunction (extent arr) getBorder') + {-# INLINE getBorder' #-}+ getBorder' ix+ = case boundary of+ BoundFixed c -> c+ BoundConst c -> unsafeAppStencilCursor2_const addDim stencil c arr ix+ BoundClamp -> unsafeAppStencilCursor2_clamp addDim stencil arr ix in -- internal region- APart sh (Range (Z :. yMin :. xMin) (Z :. yMax :. xMax ) inInternal) arrInternal+ APart sh (Range (Z :. inY :. inX) (Z :. inH :. inW) inInternal) arrInternal -- border regions- $ APart sh (Range (Z :. 0 :. 0) (Z :. yMin -1 :. aWidth - 1) inBorder) arrBorder- $ APart sh (Range (Z :. yMax + 1 :. 0) (Z :. aHeight - 1 :. aWidth - 1) inBorder) arrBorder- $ APart sh (Range (Z :. yMin :. 0) (Z :. yMax :. xMin - 1) inBorder) arrBorder- $ APart sh (Range (Z :. yMin :. xMax + 1) (Z :. yMax :. aWidth - 1) inBorder) arrBorder+ $ APart sh (Range (Z :. westY :. westX) (Z :. westH :. westW) inBorder) arrBorder+ $ APart sh (Range (Z :. eastY :. eastX) (Z :. eastH :. eastW) inBorder) arrBorder+ $ APart sh (Range (Z :. northY :. northX) (Z :. northH :. northW) inBorder) arrBorder+ $ APart sh (Range (Z :. southY :. southX) (Z :. southH :. southW) inBorder) arrBorder $ AUndefined sh unsafeAppStencilCursor2- :: Repr 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 @@ -152,57 +165,107 @@ , " It must fit within a 7x7 tile to be compiled statically." ] +-- | Like above, but treat elements outside the array has having a constant value.+unsafeAppStencilCursor2_const+ :: forall r a+ . Source r a+ => (DIM2 -> DIM2 -> DIM2)+ -> Stencil DIM2 a+ -> a+ -> Array r DIM2 a+ -> DIM2+ -> a++{-# INLINE unsafeAppStencilCursor2_const #-}+unsafeAppStencilCursor2_const shift+ (StencilStatic sExtent zero loads)+ fixed 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))+ = getData' x y++ {-# NOINLINE getData' #-}+ getData' :: Int# -> Int# -> a+ getData' !x !y+ | 1# <- (x <# 0#) `orI#` (x >=# aWidth)+ `orI#` (y <# 0#) `orI#` (y >=# aHeight)+ = fixed++ | otherwise+ = 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')++ in template7x7 oload zero++ | otherwise+ = error $ unlines + [ "mapStencil2: Your stencil is too big for this method."+ , " It must fit within a 7x7 tile to be compiled statically." ]++ -- | Like above, but clamp out of bounds array values to the closest real value. unsafeAppStencilCursor2_clamp- :: forall r a- . Repr 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- , _ :. aHeight :. aWidth <- extent arr- , sHeight <= 7, sWidth <= 7- = let- -- Get data from the manifest array.- {-# INLINE getData #-}- getData :: DIM2 -> a- getData (Z :. y :. 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 - -- TODO: Inlining this into above makes SpecConstr choke- wrapLoadX :: Int -> Int -> a- wrapLoadX !x !y- | x < 0 = wrapLoadY 0 y- | x >= aWidth = wrapLoadY (aWidth - 1) y- | otherwise = wrapLoadY 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 - {-# INLINE wrapLoadY #-}- wrapLoadY :: Int -> Int -> a- wrapLoadY !x !y- | y < 0 = loadXY x 0- | 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 :. y :. 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 @@ -212,17 +275,17 @@ -- | Data template for stencils up to 7x7. template7x7- :: (Int -> Int -> a -> a)- -> a -> a+ :: (Int -> Int -> a -> a)+ -> a -> a {-# INLINE template7x7 #-} template7x7 f zero- = f (-3) (-3) $ f (-3) (-2) $ f (-3) (-1) $ f (-3) 0 $ f (-3) 1 $ f (-3) 2 $ f (-3) 3- $ f (-2) (-3) $ f (-2) (-2) $ f (-2) (-1) $ f (-2) 0 $ f (-2) 1 $ f (-2) 2 $ f (-2) 3- $ f (-1) (-3) $ f (-1) (-2) $ f (-1) (-1) $ f (-1) 0 $ f (-1) 1 $ f (-1) 2 $ f (-1) 3- $ f 0 (-3) $ f 0 (-2) $ f 0 (-1) $ f 0 0 $ f 0 1 $ f 0 2 $ f 0 3- $ f 1 (-3) $ f 1 (-2) $ f 1 (-1) $ f 1 0 $ f 1 1 $ f 1 2 $ f 1 3- $ f 2 (-3) $ f 2 (-2) $ f 2 (-1) $ f 2 0 $ f 2 1 $ f 2 2 $ f 2 3- $ f 3 (-3) $ f 3 (-2) $ f 3 (-1) $ f 3 0 $ f 3 1 $ f 3 2 $ f 3 3- $ zero+ = f (-3) (-3) $ f (-3) (-2) $ f (-3) (-1) $ f (-3) 0 $ f (-3) 1 $ f (-3) 2 $ f (-3) 3+ $ f (-2) (-3) $ f (-2) (-2) $ f (-2) (-1) $ f (-2) 0 $ f (-2) 1 $ f (-2) 2 $ f (-2) 3+ $ f (-1) (-3) $ f (-1) (-2) $ f (-1) (-1) $ f (-1) 0 $ f (-1) 1 $ f (-1) 2 $ f (-1) 3+ $ f 0 (-3) $ f 0 (-2) $ f 0 (-1) $ f 0 0 $ f 0 1 $ f 0 2 $ f 0 3+ $ f 1 (-3) $ f 1 (-2) $ f 1 (-1) $ f 1 0 $ f 1 1 $ f 1 2 $ f 1 3+ $ f 2 (-3) $ f 2 (-2) $ f 2 (-1) $ f 2 0 $ f 2 1 $ f 2 2 $ f 2 3+ $ f 3 (-3) $ f 3 (-2) $ f 3 (-1) $ f 3 0 $ f 3 1 $ f 3 2 $ f 3 3+ $ zero
+ Data/Array/Repa/Stencil/Partition.hs view
@@ -0,0 +1,74 @@++module Data.Array.Repa.Stencil.Partition+ ( Offset (..)+ , Size (..)+ , Region (..)+ , partitionForStencil)+where++-- | An offset in the 2d plane.+data Offset+ = Offset !Int !Int++-- | Size of a region in the 2d plane.+data Size+ = Size !Int !Int++-- | A region in the 2d plane.+data Region + = Region+ { regionX :: !Int+ , regionY :: !Int+ , regionWidth :: !Int+ , regionHeight :: !Int }+ deriving Show+++-- | Create a new region of the given size.+regionOfSize :: Size -> Region+regionOfSize (Size w h)+ = Region 0 0 w h+{-# INLINE regionOfSize #-}++-- | Offset a region.+offsetRegion :: Offset -> Region -> Region+offsetRegion (Offset x y) (Region x0 y0 w h)+ = Region (x0 + x) (y0 + y) w h+{-# INLINE offsetRegion #-}++-- | Partition a region into inner and border regions for the given stencil.+partitionForStencil+ :: Size -- ^ Size of array+ -> Size -- ^ Size of stencil+ -> Offset -- ^ Focus of stencil+ -> [Region]++partitionForStencil+ (Size arrW arrH)+ (Size krnW krnH)+ (Offset focX focY)+ = let + gapNorth = focY+ gapSouth = krnH - focY - 1+ gapWest = focX+ gapEast = krnW - focX - 1++ innerW = arrW - gapWest - gapEast+ innerH = arrH - gapNorth - gapSouth++ regionInner = offsetRegion (Offset gapWest gapNorth)+ $ regionOfSize (Size innerW innerH)++ regionNorth = regionOfSize (Size arrW gapNorth)++ regionSouth = offsetRegion (Offset 0 (gapNorth + innerH))+ $ regionOfSize (Size arrW gapSouth)++ regionWest = offsetRegion (Offset 0 gapNorth)+ $ regionOfSize (Size gapWest innerH)++ regionEast = offsetRegion (Offset (gapWest + innerW) gapNorth)+ $ regionOfSize (Size gapEast innerH)++ in [regionInner, regionNorth, regionSouth, regionWest, regionEast]+{-# INLINE partitionForStencil #-}
Data/Array/Repa/Stencil/Template.hs view
@@ -2,12 +2,12 @@ -- | Template module Data.Array.Repa.Stencil.Template- (stencil2)+ (stencil2) where import Data.Array.Repa.Index import Language.Haskell.TH import Language.Haskell.TH.Quote-import qualified Data.List as List+import qualified Data.List as List -- | QuasiQuoter for producing a static stencil defintion. --@@ -33,10 +33,10 @@ -- stencil2 :: QuasiQuoter stencil2 = QuasiQuoter- { quoteExp = parseStencil2- , quotePat = undefined- , quoteType = undefined- , quoteDec = undefined }+ { quoteExp = parseStencil2+ , quotePat = undefined+ , quoteType = undefined+ , quoteDec = undefined } -- | Parse a stencil definition.@@ -44,55 +44,55 @@ parseStencil2 :: String -> Q Exp parseStencil2 str = let- -- Determine the extent of the stencil based on the layout.- -- TODO: make this more robust. In particular, handle blank- -- lines at the start of the definition.- line1 : _ = lines str- sizeX = fromIntegral $ length $ lines str- sizeY = fromIntegral $ length $ words line1+ -- Determine the extent of the stencil based on the layout.+ -- TODO: make this more robust. In particular, handle blank+ -- lines at the start of the definition.+ line1 : _ = lines str+ sizeX = fromIntegral $ length $ lines str+ sizeY = fromIntegral $ length $ words line1 - -- TODO: this probably doesn't work for stencils who's extents are even.- minX = negate (sizeX `div` 2)- minY = negate (sizeY `div` 2)- maxX = sizeX `div` 2- maxY = sizeY `div` 2+ -- TODO: this probably doesn't work for stencils who's extents are even.+ minX = negate (sizeX `div` 2)+ minY = negate (sizeY `div` 2)+ maxX = sizeX `div` 2+ maxY = sizeY `div` 2 - -- List of coefficients for the stencil.- coeffs = (List.map read $ words str) :: [Integer]+ -- List of coefficients for the stencil.+ coeffs = (List.map read $ words str) :: [Integer] - in makeStencil2' sizeX sizeY- $ filter (\(_, _, v) -> v /= 0)- $ [ (fromIntegral y, fromIntegral x, fromIntegral v)- | y <- [minX, minX + 1 .. maxX]- , x <- [minY, minY + 1 .. maxY]- | v <- coeffs ]+ in makeStencil2' sizeX sizeY+ $ filter (\(_, _, v) -> v /= 0)+ $ [ (fromIntegral y, fromIntegral x, fromIntegral v)+ | y <- [minX, minX + (1 :: Integer) .. maxX]+ , x <- [minY, minY + (1 :: Integer) .. maxY]+ | v <- coeffs ] makeStencil2'- :: Integer -> Integer- -> [(Integer, Integer, Integer)]- -> Q Exp+ :: Integer -> Integer+ -> [(Integer, Integer, Integer)]+ -> Q Exp makeStencil2' sizeX sizeY coeffs- = do ix' <- newName "ix"- z' <- [p| Z |]- coeffs' <- newName "coeffs"+ = do ix' <- newName "ix"+ z' <- [p| Z |]+ coeffs' <- newName "coeffs" - let fnCoeffs- = LamE [VarP ix']- $ CaseE (VarE (mkName "ix"))- $ [ Match (InfixP (InfixP z' (mkName ":.") (LitP (IntegerL oy)))+ let fnCoeffs+ = LamE [VarP ix']+ $ CaseE (VarE (mkName "ix"))+ $ [ Match (InfixP (InfixP z' (mkName ":.") (LitP (IntegerL oy))) (mkName ":.") (LitP (IntegerL ox)))- (NormalB $ ConE (mkName "Just") `AppE` LitE (IntegerL v))- [] | (oy, ox, v) <- coeffs ]- ++ [Match WildP- (NormalB $ ConE (mkName "Nothing")) []]+ (NormalB $ ConE (mkName "Just") `AppE` LitE (IntegerL v))+ [] | (oy, ox, v) <- coeffs ]+ ++ [Match WildP+ (NormalB $ ConE (mkName "Nothing")) []] - return- $ AppE (VarE (mkName "makeStencil2") + return+ $ AppE (VarE (mkName "makeStencil2") `AppE` (LitE (IntegerL sizeX)) `AppE` (LitE (IntegerL sizeY)))- $ LetE [ PragmaD (InlineP (mkName "coeffs") (InlineSpec True False Nothing))- , ValD (VarP coeffs') (NormalB fnCoeffs) [] ]- (VarE (mkName "coeffs"))+ $ LetE [ PragmaD (InlineP (mkName "coeffs") Inline FunLike (BeforePhase 0))+ , ValD (VarP coeffs') (NormalB fnCoeffs) [] ]+ (VarE (mkName "coeffs"))
+ Data/Array/Repa/Unsafe.hs view
@@ -0,0 +1,14 @@++-- | Functions without sanity or bounds checks.+module Data.Array.Repa.Unsafe+ ( unsafeBackpermute+ , unsafeBackpermuteDft+ , unsafeSlice+ , unsafeExtend+ , unsafeTraverse+ , unsafeTraverse2+ , unsafeTraverse3+ , unsafeTraverse4)+where+import Data.Array.Repa.Operators.IndexSpace+import Data.Array.Repa.Operators.Traversal
LICENSE view
@@ -1,24 +1,25 @@-Copyright (c) 2010-2012, University of New South Wales.-All rights reserved.+Copyright (c) 2001-2014, The Data Parallel Haskell Team Redistribution and use in source and binary forms, with or without modification, are permitted provided that the following conditions are met:- * Redistributions of source code must retain the above copyright- notice, this list of conditions and the following disclaimer.- * Redistributions in binary form must reproduce the above copyright- notice, this list of conditions and the following disclaimer in the- documentation and/or other materials provided with the distribution.- * Neither the name of the University of New South Wales nor the- names of its contributors may be used to endorse or promote products- derived from this software without specific prior written permission. -THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS ''AS IS'' AND ANY-EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED-WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE-DISCLAIMED. IN NO EVENT SHALL COPYRIGHT HOLDERS BE LIABLE FOR ANY-DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES-(INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES;-LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND-ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT-(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS-SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.+- Redistributions of source code must retain the above copyright notice,+ this list of conditions and the following disclaimer.++- Redistributions in binary form must reproduce the above copyright notice,+ this list of conditions and the following disclaimer in the documentation+ and/or other materials provided with the distribution.++- The names of the copyright holders may not be used to endorse or promote+ products derived from this software without specific prior written permission.++THIS SOFTWARE IS PROVIDED "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES,+INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND+FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE+COPYRIGHT HOLDERS OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT,+INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT+LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA,+OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF+LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE+OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF+ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
repa.cabal view
@@ -1,15 +1,15 @@ Name: repa-Version: 3.0.0.1+Version: 3.4.2.0 License: BSD3 License-file: LICENSE Author: The DPH Team Maintainer: Ben Lippmeier <benl@ouroborus.net> Build-Type: Simple-Cabal-Version: >=1.6+Cabal-Version: >=1.10 Stability: experimental Category: Data Structures Homepage: http://repa.ouroborus.net-Bug-reports: repa@ouroborus.net+Bug-reports: http://groups.google.com/d/forum/haskell-repa Description: Repa provides high performance, regular, multi-dimensional, shape polymorphic parallel arrays. All numeric data is stored unboxed. Functions written with@@ -19,24 +19,38 @@ Synopsis: High performance, regular, shape polymorphic parallel arrays. -Tested-with: GHC == 7.0.1+Flag no-template-haskell+ Default: False+ Description: Disable Template Haskell Library- Build-Depends: - base == 4.5.*,- ghc-prim == 0.2.*,- vector == 0.9.*,- bytestring == 0.9.*,- QuickCheck >= 2.3 && < 2.5,- template-haskell >= 2.5 && < 2.8+ 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,7 +62,15 @@ StandaloneDeriving ScopedTypeVariables 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@@ -61,27 +83,38 @@ Data.Array.Repa.Repr.Cursored Data.Array.Repa.Repr.Delayed Data.Array.Repa.Repr.ForeignPtr+ Data.Array.Repa.Repr.HintSmall+ Data.Array.Repa.Repr.HintInterleave Data.Array.Repa.Repr.Partitioned Data.Array.Repa.Repr.Unboxed Data.Array.Repa.Repr.Undefined Data.Array.Repa.Repr.Vector Data.Array.Repa.Specialised.Dim2 Data.Array.Repa.Stencil.Dim2+ Data.Array.Repa.Arbitrary Data.Array.Repa.Eval Data.Array.Repa.Index Data.Array.Repa.Shape Data.Array.Repa.Slice Data.Array.Repa.Stencil+ Data.Array.Repa.Unsafe Data.Array.Repa Other-modules: Data.Array.Repa.Eval.Chunked Data.Array.Repa.Eval.Cursored+ Data.Array.Repa.Eval.Interleaved Data.Array.Repa.Eval.Elt- Data.Array.Repa.Eval.Fill+ Data.Array.Repa.Eval.Target+ Data.Array.Repa.Eval.Load 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