repa-array (empty) → 4.0.0.1
raw patch · 42 files changed
+4798/−0 lines, 42 filesdep +basedep +bytestringdep +double-conversionsetup-changed
Dependencies added: base, bytestring, double-conversion, mtl, primitive, repa-eval, repa-stream, text, vector
Files
- Data/Repa/Array.hs +343/−0
- Data/Repa/Array/Delayed.hs +134/−0
- Data/Repa/Array/Delayed2.hs +129/−0
- Data/Repa/Array/Dense.hs +165/−0
- Data/Repa/Array/Index.hs +23/−0
- Data/Repa/Array/Index/Slice.hs +82/−0
- Data/Repa/Array/Internals/Bulk.hs +88/−0
- Data/Repa/Array/Internals/Check.hs +27/−0
- Data/Repa/Array/Internals/Layout.hs +39/−0
- Data/Repa/Array/Internals/Load.hs +25/−0
- Data/Repa/Array/Internals/Operator/Concat.hs +271/−0
- Data/Repa/Array/Internals/Operator/Filter.hs +43/−0
- Data/Repa/Array/Internals/Operator/Fold.hs +98/−0
- Data/Repa/Array/Internals/Operator/Group.hs +81/−0
- Data/Repa/Array/Internals/Operator/Partition.hs +138/−0
- Data/Repa/Array/Internals/Operator/Reduce.hs +20/−0
- Data/Repa/Array/Internals/Shape.hs +202/−0
- Data/Repa/Array/Internals/Target.hs +109/−0
- Data/Repa/Array/Linear.hs +62/−0
- Data/Repa/Array/Material.hs +60/−0
- Data/Repa/Array/Material/Boxed.hs +168/−0
- Data/Repa/Array/Material/Foreign.hs +176/−0
- Data/Repa/Array/Material/Nested.hs +423/−0
- Data/Repa/Array/Material/Unboxed.hs +176/−0
- Data/Repa/Array/RowWise.hs +189/−0
- Data/Repa/Array/Tuple.hs +182/−0
- Data/Repa/Array/Window.hs +96/−0
- Data/Repa/Bits/Date32.hs +142/−0
- Data/Repa/Eval/Array.hs +54/−0
- Data/Repa/Eval/Chain.hs +167/−0
- Data/Repa/Eval/Stream.hs +22/−0
- Data/Repa/Fusion/Unpack.hs +15/−0
- Data/Repa/IO/Array.hs +137/−0
- Data/Repa/IO/Convert.hs +89/−0
- Data/Repa/Nice.hs +160/−0
- Data/Repa/Nice/Display.hs +71/−0
- Data/Repa/Nice/Present.hs +125/−0
- Data/Repa/Nice/Tabulate.hs +110/−0
- LICENSE +25/−0
- Setup.hs +2/−0
- include/repa-array.h +10/−0
- repa-array.cabal +120/−0
+ Data/Repa/Array.hs view
@@ -0,0 +1,343 @@+--+-- | NOTE: This is an ALPHA version of Repa 4. The API is not yet complete with+-- respect to Repa 3. Some important functions are still missing, and the +-- docs may not be up-to-date.+-- +-- A Repa array is a wrapper around an underlying container structure that+-- holds the array elements.+--+-- In the type (`Array` @l@ @a@), the @l@ specifies the `Layout` of data,+-- which includes the type of the underlying container, as well as how +-- the elements should be arranged in that container. The @a@ specifies +-- the element type.+--+-- === Material layouts +--+-- Material layouts hold real data and are defined in "Data.Repa.Array.Material".+--+-- For performance reasons, random access indexing into these layouts+-- is not bounds checked. However, all bulk operators like @map@ and @concat@+-- are guaranteed to be safe.+--+-- * `B` -- Boxed vectors.+--+-- * `U` -- Adaptive unboxed vectors.+--+-- * `F` -- Foreign memory buffers.+--+-- * `N` -- Nested arrays.+--+--+-- === Delayed layouts+--+-- Delayed layouts represent the elements of an array by a function that+-- computes those elements on demand.+--+-- * `D` -- Functions from indices to elements.+--+-- === Index-space layouts +--+-- Index-space produce the corresponding index for each element of the array,+-- rather than real data. They can be used to define an array shape+-- without needing to provide element data.+-- +-- * `L` -- Linear spaces.+--+-- * `RW` -- RowWise spaces.+--+-- === Meta layouts+--+-- Meta layouts combine existing layouts into new ones.+--+-- * `W` -- Windowed arrays.+--+-- * `E` -- Dense arrays.+--+-- * `T2` -- Tupled arrays.+-- +-- === Array fusion+--+-- Array fusion is achieved via the delayed (`D`) layout +-- and the `computeS` function. For example:+--+-- @+-- > import Data.Repa.Array+-- > computeS U $ A.map (+ 1) $ A.map (* 2) $ fromList U [1 .. 100 :: Int]+-- @+--+-- Lets look at the result of the first `map`:+--+-- @+-- > :type A.map (* 2) $ fromList U [1 .. 100 :: Int]+-- A.map (* 2) $ fromList U [1 .. 100 :: Int] +-- :: Array (D U) Int+-- @+--+-- In the type @Array (D U) Int@, the outer `D` indicates that the array+-- is represented as a function that computes each element on demand.+--+-- Applying a second `map` layers another element-producing function on top:+--+-- @ +-- > :type A.map (+ 1) $ A.map (* 2) $ fromList U [1 .. 100 :: Int]+-- A.map (+ 1) $ A.map (* 2) $ fromList U [1 .. 100 :: Int]+-- :: Array (D (D U)) Int+-- @+--+-- At runtime, indexing into an array of the above type involves calling+-- the outer @D@-elayed function, which calls the inner @D@-elayed function,+-- which retrieves source data from the inner @U@-nboxed array. Although+-- this works, indexing into a deep stack of delayed arrays can be quite+-- expensive.+--+-- To fully evaluate a delayed array, use the `computeS` function, +-- which computes each element of the array sequentially. We pass @computeS@+-- the name of the desired result layout, in this case we use `U` to indicate+-- an unboxed array of values:+--+-- @+-- > :type computeS U $ A.map (+ 1) $ A.map (* 2) $ fromList U [1 .. 100 :: Int]+-- computeS U $ A.map (+ 1) $ A.map (* 2) $ fromList U [1 .. 100 :: Int]+-- :: Array U Int+-- @+--+-- At runtime, each element of the result will be computed by first reading+-- the source element, applying @(*2)@ to it, then applying @(+1)@ to it, +-- then writing to the result array. Array \"fusion\" is achieved by the fact+-- that result of applying @(*2)@ to an element is used directly, without+-- writing it to an intermediate buffer. +-- +-- An added bonus is that during compilation, the GHC simplifier will inline+-- the definitions of `map` and `computeS`, then eliminate the intermediate +-- function calls. In the compiled code all intermediate values will be stored+-- unboxed in registers, without any overhead due to boxing or laziness.+--+-- When used correctly, array fusion allows Repa programs to run as fast as+-- equivalents in C or Fortran. However, without fusion the programs typically+-- run 10-20x slower (so remember apply `computeS` to delayed arrays).+--+-- === How to write fast code+--+-- 1. 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.+--+-- 2. 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.+--+-- 3. Compile your program with @ghc -O2 -fllvm -optlo-O3@. The LLVM compiler+-- produces better object code that GHC's internal native code generator.+--+module Data.Repa.Array+ ( module Data.Repa.Array.Index++ , Name (..) + , Bulk (..), BulkI+ , (!)+ , length++ -- * Index arrays+ -- | Index arrays define an index space but do not contain concrete+ -- element values. Indexing into any point in the array produces+ -- the index at that point. Index arrays are typically used to + -- provide an array shape to other array operators.++ -- ** Linear spaces+ , L(..)+ , linear++ -- ** RowWise spaces+ , RW(..)+ , rowWise++ -- * Meta arrays++ -- ** Delayed arrays+ , D(..)+ , fromFunction+ , toFunction+ , delay ++ , D2(..)+ , delay2++ -- ** Windowed arrays+ , W(..)+ , Windowable (..)+ , windowed+ , entire++ -- ** Tupled arrays+ , T2(..)+ , tup2+ , untup2++ -- * Material arrays+ -- | Material arrays are represented as concrete data in memory+ -- and are defined in "Data.Repa.Array.Material". Indexing into these+ -- arrays is not bounds checked, so you may want to use them in+ -- conjunction with a @C@hecked layout.+ , Material++ -- ** Dense arrays+ , E (..)+ , vector+ , matrix+ , cube++ -- * Conversion+ , fromList, fromListInto+ , toList+++ -- * Computation+ , Load+ , Target+ , computeS, computeIntoS++ -- * Operators+ -- ** Index space+ -- | Index space transforms view the elements of an array in a different+ -- order, but do not compute new elements. They are all constant time+ -- operations as the location of the required element in the source+ -- array is computed on demand.+ , reverse++ -- ** Mapping+ , map, map2+ , mapS, map2S++ -- ** Filtering+ , filter++ -- ** Searching+ , findIndex++ -- ** Sloshing+ -- | Sloshing operators copy array elements into a different arrangement, + -- but do not create new element values.+ , concat+ , concatWith, unlines+ , intercalate+ , ConcatDict++ , partition+ , partitionBy+ , partitionByIx++ -- ** Grouping+ , groups+ , groupsWith+ , GroupsDict++ -- ** Folding+ , foldl+ , folds+ , foldsWith+ , Folds(..)+ , FoldsDict)+where+import Data.Repa.Array.Index+import Data.Repa.Array.Linear as A+import Data.Repa.Array.Dense as A+import Data.Repa.Array.RowWise as A+import Data.Repa.Array.Delayed as A+import Data.Repa.Array.Delayed2 as A+import Data.Repa.Array.Window as A+import Data.Repa.Array.Tuple as A+import Data.Repa.Eval.Array as A+import Data.Repa.Array.Internals.Target as A+import Data.Repa.Array.Internals.Bulk as A+import Data.Repa.Array.Internals.Operator.Concat as A+import Data.Repa.Array.Internals.Operator.Group as A+import Data.Repa.Array.Internals.Operator.Fold as A+import Data.Repa.Array.Internals.Operator.Partition as A+import Data.Repa.Array.Internals.Operator.Reduce as A+import Data.Repa.Array.Internals.Operator.Filter as A+import qualified Data.Vector.Fusion.Stream.Monadic as V+import Control.Monad+import Prelude + hiding (reverse, length, map, zipWith, concat, unlines, foldl, filter)+#include "repa-array.h"+++-- | Classes supported by all material representations.+--+-- We can index them in a random-access manner, +-- window them in constant time, +-- and use them as targets for a computation.+-- +-- In particular, delayed arrays are not material as we cannot use them+-- as targets for a computation.+--+type Material l a+ = (Bulk l a, Windowable l a, Target l a)+++-- | O(1). View the elements of a vector in reverse order.+--+-- @+-- > toList $ reverse $ fromList U [0..10 :: Int]+-- [10,9,8,7,6,5,4,3,2,1,0]+-- @+reverse :: BulkI l a+ => Array l a -> Array (D l) a++reverse !arr+ = let !len = size (extent $ layout arr)+ get ix = arr `index` (len - ix - 1)+ in fromFunction (layout arr) get+{-# INLINE_ARRAY reverse #-}+++-- | O(len src) Yield `Just` the index of the first element matching the predicate+-- or `Nothing` if no such element exists.+findIndex :: BulkI l a+ => (a -> Bool) -> Array l a -> Maybe Int++findIndex p !arr+ = loop_findIndex V.SPEC 0+ where + !len = size (extent $ layout arr)++ loop_findIndex !sPEC !ix+ | ix >= len = Nothing+ | otherwise + = let !x = arr `index` ix+ in if p x then Just ix+ else loop_findIndex sPEC (ix + 1)+ {-# INLINE_INNER loop_findIndex #-}+{-# INLINE_ARRAY findIndex #-}+++-- | Like `A.map`, but immediately `computeS` the result.+mapS :: (Bulk lSrc a, Target lDst b, Index lSrc ~ Index lDst) + => Name lDst -- ^ Name of destination layout.+ -> (a -> b) -- ^ Worker function.+ -> Array lSrc a -- ^ Source array.+ -> Array lDst b+mapS l f !xs = computeS l $! A.map f xs+{-# INLINE mapS #-}+++-- | Like `A.map2`, but immediately `computeS` the result.+map2S :: (Bulk lSrc1 a, Bulk lSrc2 b, Target lDst c+ , Index lSrc1 ~ Index lDst+ , Index lSrc2 ~ Index lDst)+ => Name lDst -- ^ Name of destination layout.+ -> (a -> b -> c ) -- ^ Worker function.+ -> Array lSrc1 a -- ^ Source array.+ -> Array lSrc2 b -- ^ Source array+ -> Maybe (Array lDst c)+map2S l f xs ys+ = liftM (computeS l) $! A.map2 f xs ys+{-# INLINE map2S #-}++
+ Data/Repa/Array/Delayed.hs view
@@ -0,0 +1,134 @@+{-# LANGUAGE UndecidableInstances #-}+module Data.Repa.Array.Delayed+ ( D(..), Array(..)+ , fromFunction, toFunction+ , delay+ , map)+where+import Data.Repa.Array.Index+import Data.Repa.Array.Internals.Bulk+import Data.Repa.Array.Internals.Load+import Data.Repa.Array.Internals.Target+import Debug.Trace+import GHC.Exts+import qualified Data.Repa.Eval.Generic.Par as Par+import qualified Data.Repa.Eval.Generic.Seq as Seq+import Prelude hiding (map, zipWith)+#include "repa-array.h"+++-------------------------------------------------------------------------------+-- | Delayed arrays wrap functions from an index to element value.+-- The index space is specified by an inner layout, @l@.+--+-- Every time you index into a delayed array the element at that position+-- is recomputed.+data D l+ = Delayed+ { delayedLayout :: l }++deriving instance Eq l => Eq (D l)+deriving instance Show l => Show (D l)+++-------------------------------------------------------------------------------+-- | Delayed arrays.+instance Layout l => Layout (D l) where+ data Name (D l) = D (Name l)+ type Index (D l) = Index l+ name = D name+ create (D n) len = Delayed (create n len)+ extent (Delayed l) = extent l+ toIndex (Delayed l) ix = toIndex l ix+ fromIndex (Delayed l) i = fromIndex l i+ {-# INLINE_ARRAY name #-}+ {-# INLINE_ARRAY create #-}+ {-# INLINE_ARRAY extent #-}+ {-# INLINE_ARRAY toIndex #-}+ {-# INLINE_ARRAY fromIndex #-}++deriving instance Eq (Name l) => Eq (Name (D l))+deriving instance Show (Name l) => Show (Name (D l))+++-------------------------------------------------------------------------------+-- | Delayed arrays.+instance Layout l => Bulk (D l) a where+ data Array (D l) a+ = ADelayed !l (Index l -> a)++ layout (ADelayed l _) = Delayed l+ index (ADelayed _l f) ix = f ix+ {-# INLINE_ARRAY index #-}+ {-# INLINE_ARRAY layout #-}+++-- Load -----------------------------------------------------------------------+instance (Layout l1, Target l2 a)+ => Load (D l1) l2 a where+ loadS (ADelayed l1 get) !buf+ = do let !(I# len) = size (extent l1)++ let write ix x = unsafeWriteBuffer buf (I# ix) x+ get' ix = get $ fromIndex l1 (I# ix)+ {-# INLINE write #-}+ {-# INLINE get' #-}++ Seq.fillLinear write get' len+ touchBuffer buf+ {-# INLINE_ARRAY loadS #-}++ loadP gang (ADelayed l1 get) !buf+ = do traceEventIO "Repa.loadP[Delayed]: start"+ let !(I# len) = size (extent l1)++ let write ix x = unsafeWriteBuffer buf (I# ix) x+ get' ix = get $ fromIndex l1 (I# ix)+ {-# INLINE write #-}+ {-# INLINE get' #-}++ Par.fillChunked gang write get' len+ touchBuffer buf+ traceEventIO "Repa.loadP[Delayed]: end"+ {-# INLINE_ARRAY loadP #-}+++-- Conversions ----------------------------------------------------------------+-- | Wrap a function as a delayed array.+--+-- @> toList $ fromFunction (Linear 10) (* 2)+-- = [0, 2, 4, 6, 8, 10, 12, 14, 16, 18]@+--+fromFunction :: l -> (Index l -> a) -> Array (D l) a+fromFunction l f+ = ADelayed l f+{-# INLINE_ARRAY fromFunction #-}+++-- | Produce the extent of an array, and a function to retrieve an+-- arbitrary element.+toFunction :: Bulk l a+ => Array (D l) a -> (l, Index l -> a)+toFunction (ADelayed l f) = (l, f)+{-# INLINE_ARRAY toFunction #-}+++-- Operators ------------------------------------------------------------------+-- | Wrap an existing array in a delayed one.+delay :: Bulk l a+ => Array l a -> Array (D l) a+delay arr = map id arr+{-# INLINE delay #-}+++-- | Apply a worker function to each element of an array,+-- yielding a new array with the same extent.+--+-- The resulting array is delayed, meaning every time you index into+-- it the element at that index is recomputed. +--+map :: Bulk l a+ => (a -> b) -> Array l a -> Array (D l) b+map f arr+ = ADelayed (layout arr) (f . index arr)+{-# INLINE_ARRAY map #-}
+ Data/Repa/Array/Delayed2.hs view
@@ -0,0 +1,129 @@+{-# LANGUAGE UndecidableInstances #-}+module Data.Repa.Array.Delayed2+ ( D2(..), Array(..)+ , delay2+ , map2)+where+import Data.Repa.Array.Index+import Data.Repa.Array.Internals.Bulk+import Data.Repa.Array.Internals.Load+import Data.Repa.Array.Internals.Target+import Debug.Trace+import GHC.Exts+import qualified Data.Repa.Eval.Generic.Par as Par+import qualified Data.Repa.Eval.Generic.Seq as Seq+#include "repa-array.h"+++-------------------------------------------------------------------------------+-- | A delayed array formed from two source arrays.+-- The source arrays can have different layouts but must+-- have the same extent.+data D2 l1 l2+ = Delayed2+ { delayed2Layout1 :: l1+ , delayed2Layout2 :: l2 }++deriving instance (Eq l1, Eq l2) => Eq (D2 l1 l2)+deriving instance (Show l1, Show l2) => Show (D2 l1 l2)+++-------------------------------------------------------------------------------+-- | Delayed arrays.+instance (Layout l1, Layout l2, Index l1 ~ Index l2)+ => Layout (D2 l1 l2) where+ data Name (D2 l1 l2) = D2 (Name l1) (Name l2)+ type Index (D2 l1 l2) = Index l1+ name = D2 name name+ create (D2 n1 n2) len = Delayed2 (create n1 len) (create n2 len)+ extent (Delayed2 l1 _l2) = extent l1+ toIndex (Delayed2 l1 _l2) ix = toIndex l1 ix+ fromIndex (Delayed2 l1 _l2) i = fromIndex l1 i+ {-# INLINE_ARRAY name #-}+ {-# INLINE_ARRAY create #-}+ {-# INLINE_ARRAY extent #-}+ {-# INLINE_ARRAY toIndex #-}+ {-# INLINE_ARRAY fromIndex #-}++deriving instance + (Eq (Name l1), Eq (Name l2)) + => Eq (Name (D2 l1 l2))++deriving instance + (Show (Name l1), Show (Name l2)) + => Show (Name (D2 l1 l2))+++-------------------------------------------------------------------------------+-- | Delayed arrays.+instance (Layout l1, Layout l2, Index l1 ~ Index l2)+ => Bulk (D2 l1 l2) a where++ data Array (D2 l1 l2) a+ = ADelayed2 !l1 !l2 (Index l1 -> a)++ layout (ADelayed2 l1 l2 _) = Delayed2 l1 l2+ index (ADelayed2 _ _ f) ix = f ix+ {-# INLINE_ARRAY layout #-}+ {-# INLINE_ARRAY index #-}+++-- Load -----------------------------------------------------------------------+instance ( Layout lSrc1, Layout lSrc2, Target lDst a+ , Index lSrc1 ~ Index lSrc2)+ => Load (D2 lSrc1 lSrc2) lDst a where++ loadS (ADelayed2 lSrc1 _lSrc2 get) !buf+ = do let !(I# len) = size (extent lSrc1)++ let write ix x = unsafeWriteBuffer buf (I# ix) x+ get' ix = get (fromIndex lSrc1 (I# ix))+ {-# INLINE write #-}+ {-# INLINE get' #-}++ Seq.fillLinear write get' len+ touchBuffer buf+ {-# INLINE_ARRAY loadS #-}++ loadP gang (ADelayed2 lSrc1 _lSrc2 get) !buf+ = do traceEventIO "Repa.loadP[Delayed2]: start"+ let !(I# len) = size (extent lSrc1)++ let write ix x = unsafeWriteBuffer buf (I# ix) x+ get' ix = get (fromIndex lSrc1 (I# ix))+ {-# INLINE write #-}+ {-# INLINE get' #-}++ Par.fillChunked gang write get' len + touchBuffer buf+ traceEventIO "Repa.loadP[Delayed2]: end"+ {-# INLINE_ARRAY loadP #-}+++-- Operators ------------------------------------------------------------------+-- | Wrap two existing arrays in a delayed array.+delay2 :: (Bulk l1 a, Bulk l2 b, Index l1 ~ Index l2)+ => Array l1 a -> Array l2 b -> Maybe (Array (D2 l1 l2) (a, b))+delay2 arr1 arr2 = map2 (,) arr1 arr2+{-# INLINE delay2 #-}+++-- | Combine two arrays element-wise using the given worker function.+--+-- The two source arrays must have the same extent, else `Nothing`.+map2 :: (Bulk l1 a, Bulk l2 b, Index l1 ~ Index l2)+ => (a -> b -> c) + -> Array l1 a -> Array l2 b+ -> Maybe (Array (D2 l1 l2) c)++map2 f arr1 arr2+ | extent (layout arr1) == extent (layout arr2)+ = let get_map2 ix = f (index arr1 ix) (index arr2 ix)+ {-# INLINE get_map2 #-}+ in Just $ ADelayed2 (layout arr1) (layout arr2) get_map2++ | otherwise+ = Nothing+{-# INLINE_ARRAY map2 #-}++
+ Data/Repa/Array/Dense.hs view
@@ -0,0 +1,165 @@+{-# LANGUAGE UndecidableInstances #-}+module Data.Repa.Array.Dense+ ( E (..)+ , Name (..)+ , Array (..)+ , Buffer (..)++ -- * Common layouts+ , vector+ , matrix+ , cube)+where+import Data.Repa.Array.Index+import Data.Repa.Array.RowWise+import Data.Repa.Array.Internals.Bulk+import Data.Repa.Array.Internals.Target+import Data.Repa.Fusion.Unpack+import Control.Monad+import Prelude as P+++-- | The Dense layout maps a higher-ranked index space to some underlying+-- linear index space.+--+-- For example, we can create a dense 2D row-wise array where the elements are+-- stored in a flat unboxed vector:+--+-- @+-- > import Data.Repa.Array.Material+-- > let Just arr = fromListInto (matrix U 10 10) [1000..1099 :: Float]+--+-- > :type arr+-- arr :: Array (E U (RW DIM2) Float+--+-- > arr ! (Z :. 5 :. 4)+-- > 1054.0+-- @+--+data E r l+ = Dense r l++deriving instance (Eq r, Eq l) => Eq (E r l)+deriving instance (Show r, Show l) => Show (E r l)+++-------------------------------------------------------------------------------+-- | Dense arrays.+instance (Index r ~ Int, Layout r, Layout l)+ => Layout (E r l) where++ data Name (E r l) = E (Name r) (Name l)+ type Index (E r l) = Index l++ name = E name name++ create (E nR nL) ix+ = Dense (create nR (size ix)) (create nL ix)++ extent (Dense _ l) = extent l+ toIndex (Dense _ l) ix = toIndex l ix+ fromIndex (Dense _ l) n = fromIndex l n+ {-# INLINE name #-}+ {-# INLINE create #-}+ {-# INLINE extent #-}+ {-# INLINE toIndex #-}+ {-# INLINE fromIndex #-}++deriving instance (Eq (Name r), Eq (Name l)) => Eq (Name (E r l))+deriving instance (Show (Name r), Show (Name l)) => Show (Name (E r l))+++-------------------------------------------------------------------------------+-- | Dense arrays.+instance (Index r ~ Int, Layout l, Bulk r a)+ => Bulk (E r l) a where++ data Array (E r l) a = Array l (Array r a)+ layout (Array l inner) = Dense (layout inner) l+ index (Array l inner) ix = index inner (toIndex l ix)+ {-# INLINE layout #-}+ {-# INLINE index #-}+++-------------------------------------------------------------------------------+-- | Dense buffers.+instance (Layout l, Index r ~ Int, Target r a)+ => Target (E r l) a where++ data Buffer s (E r l) a+ = EBuffer !l !(Buffer s r a)++ unsafeNewBuffer (Dense r l)+ = do buf <- unsafeNewBuffer r+ return $ EBuffer l buf++ unsafeReadBuffer (EBuffer _ buf) ix+ = unsafeReadBuffer buf ix++ unsafeWriteBuffer (EBuffer _ buf) ix x+ = unsafeWriteBuffer buf ix x++ unsafeGrowBuffer (EBuffer l buf) ix+ = do buf' <- unsafeGrowBuffer buf ix+ return $ EBuffer l buf'++ unsafeSliceBuffer _st _sz _buf+ = error "repa-array: dense sliceBuffer, can't window inner"++ unsafeFreezeBuffer (EBuffer l buf)+ = do inner <- unsafeFreezeBuffer buf+ return $ Array l inner++ unsafeThawBuffer (Array l inner)+ = EBuffer l `liftM` unsafeThawBuffer inner++ touchBuffer (EBuffer _ buf)+ = touchBuffer buf++ bufferLayout (EBuffer l buf)+ = Dense (bufferLayout buf) l++ {-# INLINE unsafeNewBuffer #-}+ {-# INLINE unsafeWriteBuffer #-}+ {-# INLINE unsafeGrowBuffer #-}+ {-# INLINE unsafeSliceBuffer #-}+ {-# INLINE unsafeFreezeBuffer #-}+ {-# INLINE touchBuffer #-}+ {-# INLINE bufferLayout #-}+++instance Unpack (Buffer s r a) tBuf+ => Unpack (Buffer s (E r l) a) (l, tBuf) where++ unpack (EBuffer l buf) = (l, unpack buf)+ repack (EBuffer _ buf) (l, ubuf) = EBuffer l (repack buf ubuf)+ {-# INLINE unpack #-}+ {-# INLINE repack #-}+++-------------------------------------------------------------------------------+-- | Yield a layout for a dense vector of the given length.+--+-- The first argument is the name of the underlying linear layout+-- which stores the elements.+vector :: LayoutI l+ => Name l -> Int -> E l DIM1+vector n len+ = create (E n (RC RZ)) (Z :. len)+++-- | Yield a layout for a matrix with the given number of+-- rows and columns.+matrix :: LayoutI l+ => Name l -> Int -> Int -> E l DIM2+matrix n rows cols+ = create (E n (RC (RC RZ))) (Z :. rows :. cols)+++-- | Yield a layout for a cube with the given number of+-- planes, rows, and columns.+cube :: LayoutI l+ => Name l -> Int -> Int -> Int -> E l DIM3+cube n planes rows cols+ = create (E n (RC (RC (RC RZ)))) (Z :. planes :. rows :. cols)+
+ Data/Repa/Array/Index.hs view
@@ -0,0 +1,23 @@++-- | Shapes and Indices+module Data.Repa.Array.Index+ ( -- * Shapes+ Shape (..)+ , inShape+ , showShape++ -- ** Polymorphic Shapes+ , Z (..)+ , (:.) (..)++ -- | Synonyms for common layouts.+ , SH0, SH1, SH2, SH3, SH4, SH5++ -- | Helpers that constrain the coordinates to be @Int@s.+ , ish0, ish1, ish2, ish3, ish4, ish5++ -- * Layouts+ , Layout(..), LayoutI)+where+import Data.Repa.Array.Internals.Shape+import Data.Repa.Array.Internals.Layout
+ Data/Repa/Array/Index/Slice.hs view
@@ -0,0 +1,82 @@++-- | Index space transformation between arrays and slices.+module Data.Repa.Array.Index.Slice+ ( All (..)+ , Any (..)+ , FullShape+ , SliceShape+ , Slice (..))+where+import Data.Repa.Array.Index+import Prelude hiding (replicate, drop)+#include "repa-array.h"+++-- | Select all indices at a certain position.+data All = All+++-- | Place holder for any possible shape.+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+++-- | 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+++-- | 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 slice onto an index of the full shape.+ fullOfSlice :: ss -> SliceShape ss -> FullShape ss+++instance Slice Z where+ sliceOfFull _ _ = Z+ {-# INLINE sliceOfFull #-}++ fullOfSlice _ _ = Z+ {-# INLINE fullOfSlice #-}+++instance Slice (Any sh) where+ sliceOfFull _ sh = sh+ {-# INLINE sliceOfFull #-}++ fullOfSlice _ sh = sh+ {-# INLINE fullOfSlice #-}+++instance Slice sl => Slice (sl :. Int) where+ sliceOfFull (fsl :. _) (ssl :. _)+ = sliceOfFull fsl ssl+ {-# INLINE sliceOfFull #-}++ fullOfSlice (fsl :. n) ssl+ = fullOfSlice fsl ssl :. n+ {-# INLINE fullOfSlice #-}+++instance Slice sl => Slice (sl :. All) where+ sliceOfFull (fsl :. All) (ssl :. s)+ = sliceOfFull fsl ssl :. s+ {-# INLINE sliceOfFull #-}++ fullOfSlice (fsl :. All) (ssl :. s)+ = fullOfSlice fsl ssl :. s+ {-# INLINE fullOfSlice #-}+
+ Data/Repa/Array/Internals/Bulk.hs view
@@ -0,0 +1,88 @@++module Data.Repa.Array.Internals.Bulk+ ( Bulk (..), BulkI+ , (!)+ , length+ , toList+ , toLists+ , toListss)+where+import Data.Repa.Array.Internals.Shape+import Data.Repa.Array.Internals.Layout+import Prelude hiding (length)+#include "repa-array.h"+++-- Bulk -----------------------------------------------------------------------+-- | Class of array representations that we can read elements from in a +-- random-access manner. +class Layout l => Bulk l a where++ -- | An Array supplies an element of type @a@ to each position in the+ -- index space associated with layout @l@.+ data Array l a++ -- | O(1). Get the layout of an array.+ layout :: Array l a -> l++ -- | O(1). Get an element from an array. + -- If the provided index is outside the extent of the array then the+ -- result depends on the layout.+ index :: Array l a -> Index l -> a+++-- | Constraint synonym that requires an integer index space.+type BulkI l a = (Bulk l a, Index l ~ Int)+++-- | O(1). Alias for `index`.+(!) :: Bulk l a => Array l a -> Index l -> a+(!) = index+{-# INLINE (!) #-}+++-- | O(1). Get the number of elements in an array.+length :: Bulk l a + => Array l a -> Int+length !arr = size (extent (layout arr))+{-# INLINE_ARRAY length #-}+++-- Conversion -----------------------------------------------------------------+-- | Convert an array to a list.+toList :: Bulk l a+ => Array l a -> [a]+toList !arr+ = loop_fromList [] 0+ where !lo = layout arr+ !len = length arr+ loop_fromList !acc !ix+ | ix >= len = reverse acc+ | otherwise + = let !x = arr `index` (fromIndex lo ix)+ in loop_fromList (x : acc) (ix + 1)+{-# INLINE_ARRAY toList #-}+++-- | Convert a nested array to some lists.+toLists :: ( Bulk l1 (Array l2 a)+ , Bulk l2 a)+ => Array l1 (Array l2 a) -- ^ Source array.+ -> [[a]] -- ^ Result list.+toLists arr+ = let !ll' = toList arr+ in map toList ll'+{-# INLINE_ARRAY toLists #-}+++-- | Convert a triply nested array to a triply nested list.+toListss :: ( Bulk l1 (Array l2 (Array l3 a))+ , Bulk l2 (Array l3 a)+ , Bulk l3 a)+ => Array l1 (Array l2 (Array l3 a)) -- ^ Source array.+ -> [[[a]]] -- ^ Result list.+toListss arr+ = let !ll' = toLists arr+ in map (map toList) ll'+{-# INLINE_ARRAY toListss #-}+
+ Data/Repa/Array/Internals/Check.hs view
@@ -0,0 +1,27 @@++module Data.Repa.Array.Internals.Check+ ( Check (..)+ , Safe (..)+ , Unsafe (..))+where+import Data.Repa.Array.Index+++class Check m where+ method :: m+ check :: Shape sh => m -> sh -> sh -> Bool+++data Safe = Safe++instance Check Safe where+ method = Safe+ check _ _ _ = True -- TODO: bounds checks+++data Unsafe = Unsafe++instance Check Unsafe where+ method = Unsafe+ check _ _ _ = True+
+ Data/Repa/Array/Internals/Layout.hs view
@@ -0,0 +1,39 @@++module Data.Repa.Array.Internals.Layout+ (Layout (..), LayoutI)+where+import Data.Repa.Array.Internals.Shape+++-- | A layout provides a total order on the elements of an index space.+--+-- We can talk about the n-th element of an array, independent of its+-- shape and dimensionality.+--+class Shape (Index l) => Layout l where++ -- | Short name for a layout which does not include details of+ -- the exact extent.+ data Name l++ -- | Type used to index into this array layout.+ type Index l++ -- | O(1). Proxy for the layout name.+ name :: Name l++ -- | O(1). Create a default layout of the given extent.+ create :: Name l -> Index l -> l++ -- | O(1). Yield the extent of the layout.+ extent :: l -> Index l++ -- | O(1). Convert a polymorphic index to a linear one.+ toIndex :: l -> Index l -> Int++ -- | O(1). Convert a linear index to a polymorphic one.+ fromIndex :: l -> Int -> Index l+++type LayoutI l = (Layout l, Index l ~ Int)+
+ Data/Repa/Array/Internals/Load.hs view
@@ -0,0 +1,25 @@++module Data.Repa.Array.Internals.Load+ (Load (..))+where+import Data.Repa.Array.Internals.Target+import Data.Repa.Array.Internals.Bulk+import Data.Repa.Eval.Gang+++-- | Compute all elements defined by a delayed array and write them to a+-- manifest target representation.+--+-- The instances of this class require that the source array has a delayed+-- representation. If you want to use a pre-existing manifest array as the+-- source then `delay` it first.+--+class (Bulk l1 a, Target l2 a) => Load l1 l2 a where++ -- | Fill an entire array sequentially.+ loadS :: Array l1 a -> IOBuffer l2 a -> IO ()++ -- | Fill an entire array in parallel.+ loadP :: Gang+ -> Array l1 a -> IOBuffer l2 a -> IO ()+
+ Data/Repa/Array/Internals/Operator/Concat.hs view
@@ -0,0 +1,271 @@+{-# LANGUAGE CPP #-}++-- | Concatenation operators on arrays.+module Data.Repa.Array.Internals.Operator.Concat+ ( concat+ , concatWith+ , unlines+ , intercalate+ , ConcatDict)+where+import Data.Repa.Array.Material as A+import Data.Repa.Array.Delayed as A+import Data.Repa.Array.Index as A+import Data.Repa.Array.Internals.Target as A+import Data.Repa.Array.Internals.Bulk as A+import Data.Repa.Eval.Array as A+import Data.Repa.Fusion.Unpack as A+import qualified Data.Vector.Unboxed as U+import qualified Data.Vector.Fusion.Stream.Monadic as V+import System.IO.Unsafe+import GHC.Exts hiding (fromList, toList)+import Prelude hiding (reverse, length, map, zipWith, concat, unlines)+#include "repa-array.h"+++-- | Dictionaries needed to perform a concatenation.+type ConcatDict lOut lIn tIn lDst a+ = ( BulkI lOut (Array lIn a)+ , BulkI lIn a+ , TargetI lDst a+ , Unpack (Array lIn a) tIn)+++---------------------------------------------------------------------------------------------------+-- | O(len result) Concatenate nested arrays.+--+-- @+-- > import Data.Repa.Array.Material+-- > let arrs = fromList B [fromList U [1, 2, 3], fromList U [5, 6, 7 :: Int]]+-- > toList $ concat U arrs+-- [1,2,3,5,6,7]+-- @+-- +concat :: ConcatDict lOut lIn tIn lDst a+ => Name lDst -- ^ Layout for destination.+ -> Array lOut (Array lIn a) -- ^ Arrays to concatenate.+ -> Array lDst a+concat nDst vs+ | A.length vs == 0+ = A.fromList nDst []++ | otherwise+ = unsafePerformIO+ $ do let !lens = toUnboxed $ computeS U $ A.map A.length vs+ let !len = U.sum lens+ !buf_ <- unsafeNewBuffer (create nDst 0)+ !buf <- unsafeGrowBuffer buf_ len+ let !iLenY = U.length lens++ let loop_concat !iO !iY !row !iX !iLenX+ | iX >= iLenX+ = if iY >= iLenY - 1+ then return ()+ else let iY' = iY + 1+ row' = vs `index` iY'+ iLenX' = A.length row'+ in loop_concat iO iY' row' 0 iLenX'++ | otherwise+ = do let x = row `index` iX+ unsafeWriteBuffer buf iO x+ loop_concat (iO + 1) iY row (iX + 1) iLenX+ {-# INLINE_INNER loop_concat #-}++ let !row0 = vs `index` 0+ let !iLenX0 = A.length row0+ loop_concat 0 0 row0 0 iLenX0++ unsafeFreezeBuffer buf+{-# INLINE_ARRAY concat #-}+++---------------------------------------------------------------------------------------------------+-- | O(len result) Concatenate the elements of some nested vector,+-- inserting a copy of the provided separator array between each element.+--+-- @+-- > import Data.Repa.Array.Material+-- > let sep = fromList U [0, 0, 0]+-- > let arrs = fromList B [fromList U [1, 2, 3], fromList U [5, 6, 7 :: Int]]+-- > toList $ concatWith U sep arrs+-- [1,2,3,0,0,0,5,6,7,0,0,0]+-- @+--+concatWith+ :: ( ConcatDict lOut lIn tIn lDst a+ , BulkI lSep a)+ => Name lDst -- ^ Result representation.+ -> Array lSep a -- ^ Separator array.+ -> Array lOut (Array lIn a) -- ^ Arrays to concatenate.+ -> Array lDst a++concatWith nDst !is !vs+ | A.length vs == 0+ = A.fromList nDst []++ | otherwise+ = unsafePerformIO+ $ do + -- Lengths of the source vectors.+ let !lens = toUnboxed $ computeS U $ A.map A.length vs++ -- Length of the final result vector.+ let !(I# len) = U.sum lens+ + U.length lens * A.length is++ -- New buffer for the result vector.+ !buf_ <- unsafeNewBuffer (create nDst 0)+ !buf <- unsafeGrowBuffer buf_ (I# len)++ -- We checked that vs > 0 at the start, so this is safe.+ let !row0 = vs `index` 0++ -- Number of columns.+ let !(I# iLenY) = U.length lens++ -- Length of separator array.+ let !(I# iLenS) = A.length is++ let -- Source from column,+ loop_concatWith !sPEC !mode !iO !iY !row !iX !iLenX !iS + = case mode of++ -- Source from row+ 0# + -- We've finished one of the source rows, + -- so injet the separator array.+ | 1# <- iX >=# iLenX+ -> loop_concatWith sPEC 1# iO iY row iX iLenX 0# ++ -- Keep copying the source row.+ | otherwise+ -> do let !x = (repack row0 row) `index` (I# iX)+ unsafeWriteBuffer buf (I# iO) x+ loop_concatWith sPEC 0# (iO +# 1#) iY row (iX +# 1#) iLenX iS++ -- Source from separator array+ _+ -- We've finished the separator array.+ | 1# <- iS >=# iLenS + -> case iY >=# (iLenY -# 1#) of++ -- We've also finished all the rows, so we're done.+ 1# -> return ()++ -- Move to the next row.+ _ -> do+ let !iY' = iY +# 1#+ let !row' = vs `index` (I# iY')+ let !(I# iLenX') = A.length row'+ loop_concatWith sPEC 0# iO iY' (unpack row') 0# iLenX' 0#++ -- Keep copying from the separator array.+ | otherwise+ -> do let !x = is `index` (I# iS)+ unsafeWriteBuffer buf (I# iO) x+ loop_concatWith sPEC 1# (iO +# 1#) iY row iX iLenX (iS +# 1#)++ -- First row.+ let !(I# iLenX0) = A.length row0+ loop_concatWith V.SPEC 0# 0# 0# (unpack row0) 0# iLenX0 0#+ unsafeFreezeBuffer buf+{-# INLINE_ARRAY concatWith #-}+++-- | Perform a `concatWith`, adding a newline character to the end of each+-- inner array.+unlines :: ( ConcatDict lOut lIn tIn lDst Char)+ => Name lDst -- ^ Result representation.+ -> Array lOut (Array lIn Char) -- ^ Arrays to concatenate.+ -> Array lDst Char++unlines nDst arrs+ = let !fl = A.fromList F ['\n']+ in concatWith nDst fl arrs+{-# INLINE unlines #-}+++-- Intercalate ------------------------------------------------------------------------------------+-- | O(len result) Insert a copy of the separator array between the elements of+-- the second and concatenate the result.+--+-- @+-- > import Data.Repa.Array.Material+-- > let sep = fromList U [0, 0, 0]+-- > let arrs = fromList B [fromList U [1, 2, 3], fromList U [5, 6, 7 :: Int]]+-- > toList $ intercalate U sep arrs+-- [1,2,3,0,0,0,5,6,7]+-- @+--+intercalate + :: ( ConcatDict lOut lIn tIn lDst a+ , BulkI lSep a)+ => Name lDst -- ^ Result representation.+ -> Array lSep a -- ^ Separator array.+ -> Array lOut (Array lIn a) -- ^ Arrays to concatenate.+ -> Array lDst a++intercalate nDst !is !vs+ | A.length vs == 0+ = A.fromList nDst []++ | otherwise+ = unsafePerformIO+ $ do + -- Lengths of the source vectors.+ let !lens = toUnboxed $ computeS U $ A.map A.length vs++ -- Length of the final result vector.+ let !(I# len) = U.sum lens+ + (U.length lens - 1) * A.length is++ -- New buffer for the result vector.+ !buf_ <- unsafeNewBuffer (create nDst 0)+ !buf <- unsafeGrowBuffer buf_ (I# len)+ let !(I# iLenY) = U.length lens+ let !(I# iLenI) = A.length is+ let !row0 = vs `index` 0++ let loop_intercalate !sPEC !iO !iY !row !iX !iLenX+ -- We've finished copying one of the source elements.+ | 1# <- iX >=# iLenX+ = case iY >=# iLenY -# 1# of++ -- We've finished all of the source elements.+ 1# -> return ()++ -- We've finished one of the source elements, but it wasn't+ -- the last one. Inject the separator array then copy the + -- next element.+ _ -> do++ -- TODO: We're probably getting an unboxing an reboxing+ -- here. Check the fused code.+ I# iO' <- loop_intercalate_inject sPEC iO 0#+ let !iY' = iY +# 1#+ let !row' = vs `index` (I# iY')+ let !(I# iLenX') = A.length row'+ loop_intercalate sPEC iO' iY' (unpack row') 0# iLenX'++ -- Keep copying a source element.+ | otherwise+ = do let x = (repack row0 row) `index` (I# iX)+ unsafeWriteBuffer buf (I# iO) x+ loop_intercalate sPEC (iO +# 1#) iY row (iX +# 1#) iLenX+ {-# INLINE_INNER loop_intercalate #-}++ -- Inject the separator array.+ loop_intercalate_inject !sPEC !iO !n+ | 1# <- n >=# iLenI = return (I# iO)+ | otherwise+ = do let x = is `index` (I# n)+ unsafeWriteBuffer buf (I# iO) x+ loop_intercalate_inject sPEC (iO +# 1#) (n +# 1#)+ {-# INLINE_INNER loop_intercalate_inject #-}++ let !(I# iLenX0) = A.length row0+ loop_intercalate V.SPEC 0# 0# (unpack row0) 0# iLenX0+ unsafeFreezeBuffer buf+{-# INLINE_ARRAY intercalate #-}+
+ Data/Repa/Array/Internals/Operator/Filter.hs view
@@ -0,0 +1,43 @@+-- | Filtering operators on arrays.+module Data.Repa.Array.Internals.Operator.Filter+ ( filter)+where+import Data.Repa.Array.Material as A+import Data.Repa.Array.Index as A+import Data.Repa.Array.Internals.Target as A+import Data.Repa.Array.Internals.Bulk as A+import System.IO.Unsafe+import Prelude as P hiding (filter)+#include "repa-array.h"+++-- | Keep the elements of an array that match the given predicate.+filter :: (BulkI lSrc a, TargetI lDst a)+ => Name lDst -> (a -> Bool) -> Array lSrc a -> Array lDst a++filter nDst p arr+ = unsafePerformIO+ $ do + let !len = A.length arr+ !buf <- unsafeNewBuffer (create nDst len)++ let loop_filter !ixSrc !ixDst+ | ixSrc >= len + = return ixDst++ | otherwise+ = do let !x = arr `index` ixSrc+ case p x of+ False + -> do loop_filter (ixSrc + 1) ixDst++ True+ -> do unsafeWriteBuffer buf ixDst x+ loop_filter (ixSrc + 1) (ixDst + 1)++ lenDst <- loop_filter 0 0++ buf' <- unsafeSliceBuffer 0 lenDst buf+ unsafeFreezeBuffer buf'+{-# INLINE filter #-}+
+ Data/Repa/Array/Internals/Operator/Fold.hs view
@@ -0,0 +1,98 @@++module Data.Repa.Array.Internals.Operator.Fold+ ( folds+ , foldsWith+ , C.Folds(..), FoldsDict)+where+import Data.Repa.Array.Index as A+import Data.Repa.Array.Tuple as A+import Data.Repa.Array.Internals.Bulk as A+import Data.Repa.Array.Internals.Target as A+import Data.Repa.Eval.Chain as A+import Data.Repa.Fusion.Unpack as A+import qualified Data.Repa.Chain as C+import Data.Repa.Fusion.Option+import System.IO.Unsafe+#include "repa-array.h"+++-- | Segmented fold over vectors of segment lengths and input values.+--+-- * The total lengths of all segments need not match the length of the+-- input elements vector. The returned `C.Folds` state can be inspected+-- to determine whether all segments were completely folded, or the+-- vector of segment lengths or elements was too short relative to the+-- other.+--+-- @+-- > import Data.Repa.Array.Material+-- > import Data.Repa.Nice+-- > let segs = fromList B [("red", 3), ("green", 5)]+-- > let vals = fromList U [0..100 :: Int]+-- > nice $ fst $ folds B U (+) 0 segs vals+-- [("red",3),("green",25)]+-- @+--+folds :: FoldsDict lSeg lElt lGrp tGrp lRes tRes n a b+ => Name lGrp -- ^ Layout for group names.+ -> Name lRes -- ^ Layout for fold results.+ -> (a -> b -> b) -- ^ Worker function.+ -> b -- ^ Initial state when folding segments.+ -> Array lSeg (n, Int) -- ^ Segment names and lengths.+ -> Array lElt a -- ^ Elements.+ -> (Array (T2 lGrp lRes) (n, b), C.Folds Int Int n a b)++folds nGrp nRes f z vLens vVals+ = foldsWith nGrp nRes f z Nothing vLens vVals+{-# INLINE folds #-}+++-- | Like `folds`, but take an initial state for the first segment.+--+-- @+-- > import Data.Repa.Array.Material+-- > import Data.Repa.Nice+-- > let state = Just ("white", 4, 100)+-- > let segs = fromList B [("red", 3), ("green", 5)]+-- > let vals = fromList U [0..100 :: Int]+-- > nice $ fst $ foldsWith B U (+) 0 state segs vals+-- [("white",106),("red",15),("green",45)]+-- @+--+foldsWith+ :: FoldsDict lSeg lElt lGrp tGrp lRes tRes n a b+ => Name lGrp -- ^ Layout for group names.+ -> Name lRes -- ^ Layout for fold results.+ -> (a -> b -> b) -- ^ Worker function.+ -> b -- ^ Initial state when folding segments.+ -> Maybe (n, Int, b) -- ^ Name, length and initial state for first segment.+ -> Array lSeg (n, Int) -- ^ Segment names and lengths.+ -> Array lElt a -- ^ Elements.+ -> (Array (T2 lGrp lRes) (n, b), C.Folds Int Int n a b)++foldsWith nGrp nRes f z s0 vLens vVals+ = unsafePerformIO+ $ do+ let f' !x !y = return $ f x y+ {-# INLINE f' #-}++ let !s0' = case s0 of+ Nothing -> None3+ Just (a1, a2, a3) -> Some3 a1 a2 a3++ A.unchainToArrayIO (T2 nGrp nRes)+ $ C.foldsC f' z s0'+ (A.chainOfArray vLens)+ (A.chainOfArray vVals)+{-# INLINE_ARRAY foldsWith #-}+++-- | Dictionaries need to perform a segmented fold.+type FoldsDict lSeg lElt lGrp tGrp lRes tRes n a b+ = ( Bulk lSeg (n, Int)+ , Bulk lElt a+ , Target lGrp n+ , Target lRes b+ , Index lGrp ~ Index lRes+ , Unpack (IOBuffer lGrp n) tGrp+ , Unpack (IOBuffer lRes b) tRes)
+ Data/Repa/Array/Internals/Operator/Group.hs view
@@ -0,0 +1,81 @@++module Data.Repa.Array.Internals.Operator.Group+ ( groups+ , groupsWith+ , GroupsDict)+where+import Data.Repa.Array.Index as A+import Data.Repa.Array.Tuple as A+import Data.Repa.Array.Internals.Bulk as A+import Data.Repa.Array.Internals.Target as A+import Data.Repa.Fusion.Unpack as A+import Data.Repa.Eval.Chain as A+import qualified Data.Repa.Chain as C+#include "repa-array.h"+++-- | From a stream of values which has consecutive runs of idential values,+-- produce a stream of the lengths of these runs.+--+-- @+-- > import Data.Repa.Array.Material+-- > import Data.Repa.Nice+-- > nice $ groups U U (fromList U "waaabllle")+-- ([('w',1),('a',3),('b',1),('l',3)],Just ('e',1))+-- @+--+groups :: (GroupsDict lElt lGrp tGrp lLen tLen n, Eq n)+ => Name lGrp -- ^ Layout for group names.+ -> Name lLen -- ^ Layout gor group lengths.+ -> Array lElt n -- ^ Input elements.+ -> (Array (T2 lGrp lLen) (n, Int), Maybe (n, Int))++groups nGrp nLen arr+ = groupsWith nGrp nLen (==) Nothing arr+{-# INLINE groups #-}+++-- | Like `groups`, but use the given function to determine whether two+-- consecutive elements should be in the same group. Also take+-- an initial starting group and count.+--+-- @+-- > import Data.Repa.Array.Material+-- > import Data.Repa.Nice+-- > nice $ groupsWith U U (==) (Just ('w', 5)) (fromList U "waaabllle")+-- ([('w',6),('a',3),('b',1),('l',3)],Just ('e',1))+-- @+--+groupsWith+ :: GroupsDict lElt lGrp tGrp lLen tLen n+ => Name lGrp -- ^ Layout for group names.+ -> Name lLen -- ^ Layour for group lengths.+ -> (n -> n -> Bool) -- ^ Comparison function.+ -> Maybe (n, Int) -- ^ Starting element and count.+ -> Array lElt n -- ^ Input elements.+ -> (Array (T2 lGrp lLen) (n, Int), Maybe (n, Int))++groupsWith nGrp nLen f !c !vec0+ = (vec1, snd k1)+ where+ f' x y = return $ f x y+ {-# INLINE f' #-}++ (vec1, k1)+ = A.unchainToArray (T2 nGrp nLen)+ $ C.liftChain+ $ C.groupsByC f' c+ $ A.chainOfArray vec0+{-# INLINE_ARRAY groupsWith #-}+++-- | Dictionaries need to perform a grouping.+type GroupsDict lElt lGrp tGrp lLen tLen n+ = ( Bulk lElt n+ , Target lGrp n+ , Target lLen Int+ , Index lGrp ~ Index lLen+ , Unpack (IOBuffer lLen Int) tLen+ , Unpack (IOBuffer lGrp n) tGrp)++
+ Data/Repa/Array/Internals/Operator/Partition.hs view
@@ -0,0 +1,138 @@++module Data.Repa.Array.Internals.Operator.Partition+ ( partition+ , partitionBy+ , partitionByIx)+where+import Data.Repa.Array.Tuple as A+import Data.Repa.Array.Linear as A+import Data.Repa.Array.Delayed as A+import Data.Repa.Array.Internals.Bulk as A+import Data.Repa.Array.Internals.Target as A+import Data.Repa.Array.Internals.Layout as A+import Data.Repa.Array.Material.Nested as A+import Data.Repa.Eval.Elt as A+import qualified Data.Vector.Unboxed as U+import qualified Data.Vector.Unboxed.Mutable as UM+import System.IO.Unsafe+#include "repa-array.h"+++-- | Take a desired number of segments, and array of key value pairs where+-- the key is the segment number. Partition the values into the stated+-- number of segments, discarding values where the key falls outside+-- the given range.+--+-- * This function operates by first allocating a buffer of size+-- (segs * len src) and filling it with a default value. Both the+-- worst case runtime and memory use will be poor for a large+-- number of destination segments.+--+-- TODO: we need the pre-init because otherwise unused values in the elems+-- array are undefined. We could avoid this by copying out the used elements+-- after the partition loop finishes. Use a segmented extract function.+-- This would also remove the dependency on the `Elt` class.++partition + :: (BulkI lSrc (Int, a), Target lDst a, Index lDst ~ Int, Elt a)+ => Name lDst -- ^ Name of destination layout.+ -> Int -- ^ Total number of segments.+ -> Array lSrc (Int, a) -- ^ Segment numbers and values.+ -> Array N (Array lDst a) -- ^ Result array++partition nDst iSegs aSrc+ | iSegs <= 0+ = A.fromLists nDst []++ | otherwise+ = unsafePerformIO+ $ do+ -- Length of source array.+ let !len = A.length aSrc++ -- Segment start positions and lengths.+ let !vStarts = U.prescanl (+) 0 $ U.replicate iSegs len + !mLens <- UM.replicate iSegs 0++ -- Elements of result array.+ let !lenDst = iSegs * len+ !buf <- unsafeNewBuffer (A.create nDst lenDst)++ let loop_partition_init !iDst+ | iDst >= lenDst = return ()+ | otherwise+ = do unsafeWriteBuffer buf iDst zero+ loop_partition_init (iDst + 1)+ {-# INLINE_INNER loop_partition_init #-}++ loop_partition_init 0+++ let loop_partition !iSrc+ | iSrc >= len = return ()+ | otherwise+ = do let !(k, v) = aSrc `A.index` iSrc++ if k >= iSegs+ then loop_partition (iSrc + 1)+ else do+ -- Current start length of this segment.+ let !s = U.unsafeIndex vStarts k+ !o <- UM.unsafeRead mLens k++ -- Write element into the result.+ unsafeWriteBuffer buf (s + o) v++ -- Update segment length.+ UM.unsafeWrite mLens k (o + 1)++ loop_partition (iSrc + 1)+ {-# INLINE_INNER loop_partition #-}++ loop_partition 0++ vLens <- U.unsafeFreeze mLens+ aElems <- unsafeFreezeBuffer buf++ return $ NArray vStarts vLens aElems+{-# INLINE_ARRAY partition #-}+++-- | Like `partition` but use the provided function to compute the segment+-- number for each element. +partitionBy+ :: (BulkI lSrc a, Target lDst a, Index lDst ~ Int, Elt a)+ => Name lDst -- ^ Name of destination layout.+ -> Int -- ^ Total number of Segments.+ -> (a -> Int) -- ^ Get the segment number for this element.+ -> Array lSrc a -- ^ Source values.+ -> Array N (Array lDst a)++partitionBy nDst iSeg fSeg aSrc+ = partition nDst iSeg + $ tup2 (A.map fSeg aSrc) aSrc+{-# INLINE partitionBy #-}+++-- | Like `partition` but use the provided function to compute the segment+-- number for each element. The function is given the index of the each +-- element, along with the element itself.+partitionByIx + :: (BulkI lSrc a, Target lDst a, Index lDst ~ Int, Elt a)+ => Name lDst -- ^ Name of destination layout.+ -> Int -- ^ Total number of Segments.+ -> (Int -> a -> Int) -- ^ Get the segment number for this element.+ -> Array lSrc a -- ^ Source values.+ -> Array N (Array lDst a)++partitionByIx nDst iSeg fSeg aSrc+ = partition nDst iSeg + $ tup2 aSegVals aSrc+ where + fSeg' (ix, x) = fSeg ix x+ {-# INLINE fSeg' #-}++ aIxSrc = tup2 (linear $ A.length aSrc) aSrc+ aSegVals = A.map fSeg' aIxSrc+{-# INLINE partitionByIx #-}+
+ Data/Repa/Array/Internals/Operator/Reduce.hs view
@@ -0,0 +1,20 @@++module Data.Repa.Array.Internals.Operator.Reduce+ (foldl)+where+import Data.Repa.Array.Index as A+import Data.Repa.Array.Internals.Bulk as A+import Data.Repa.Eval.Stream as A+import qualified Data.Vector.Fusion.Stream as S+import Prelude as P hiding (foldl)+#include "repa-array.h"+++-- | Left fold of all elements in an array, sequentially.+foldl :: (Bulk l b, Index l ~ Int)+ => (a -> b -> a) -> a -> Array l b -> a++foldl f z arr+ = S.foldl f z + $ streamOfArray arr+{-# INLINE foldl #-}
+ Data/Repa/Array/Internals/Shape.hs view
@@ -0,0 +1,202 @@++-- | Class of types that can be used as array shapes and indices.+module Data.Repa.Array.Internals.Shape+ ( -- * Shapes+ Shape(..)++ -- * Shape operators+ , inShape+ , showShape ++ -- * Polymorphic shapes+ , Z (..)+ , (:.) (..)+ , SH0, SH1, SH2, SH3, SH4, SH5+ , ish0, ish1, ish2, ish3, ish4, ish5)+where+#include "repa-array.h"+++-- | 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++ -- | 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++ -- | Compute the intersection of two shapes.+ intersectDim :: 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++ -- | Given a starting and ending index, check if some index is with+ -- that range.+ inShapeRange :: sh -> sh -> sh -> Bool++ -- | Convert a shape into its list of dimensions.+ listOfShape :: sh -> [Int]++ -- | Convert a list of dimensions to a shape+ shapeOfList :: [Int] -> Maybe sh+++-------------------------------------------------------------------------------+-- | Given an array shape and index, check whether the index is in the shape.+inShape :: Shape sh => sh -> sh -> Bool+inShape sh ix+ = inShapeRange zeroDim sh ix+{-# INLINE_ARRAY inShape #-}+++-- | Nicely format a shape as a string+showShape :: Shape sh => sh -> String+showShape = foldr (\sh str -> str ++ " :. " ++ show sh) "Z" . listOfShape+{-# NOINLINE showShape #-}+++-------------------------------------------------------------------------------+instance Shape Int where+ rank _ = 1+ zeroDim = 0+ unitDim = 1+ intersectDim s1 s2 = max s1 s2+ addDim s1 s2 = s1 + s2+ size s = s+ inShapeRange i1 i2 i = i >= i1 && i <= i2+ listOfShape i = [i]+ shapeOfList [i] = Just i+ shapeOfList _ = Nothing+ {-# INLINE rank #-}+ {-# INLINE zeroDim #-}+ {-# INLINE unitDim #-}+ {-# INLINE intersectDim #-}+ {-# INLINE addDim #-}+ {-# INLINE size #-}+ {-# INLINE inShapeRange #-}+ {-# INLINE listOfShape #-}+ {-# INLINE shapeOfList #-}+++-------------------------------------------------------------------------------+-- | An index of dimension zero+data Z = Z+ deriving (Show, Read, Eq, Ord)+++-- | Our index type, used for both shapes and indices.+infixl 3 :.+data tail :. head+ = !tail :. !head+ deriving (Show, Read, Eq, Ord)+++instance Shape Z where+ rank _ = 0+ {-# INLINE rank #-}++ zeroDim = Z+ {-# INLINE zeroDim #-}++ unitDim = Z+ {-# INLINE unitDim #-}++ intersectDim _ _ = Z+ {-# INLINE intersectDim #-}++ addDim _ _ = Z+ {-# INLINE addDim #-}++ size _ = 1+ {-# INLINE size #-}++ inShapeRange Z Z Z = True+ {-# INLINE inShapeRange #-}++ listOfShape _ = []+ {-# NOINLINE listOfShape #-}++ shapeOfList [] = Just Z+ shapeOfList _ = Nothing+ {-# NOINLINE shapeOfList #-}++++instance Shape sh => Shape (sh :. Int) where+ rank (sh :. _)+ = rank sh + 1+ {-# INLINE rank #-}++ zeroDim = zeroDim :. 0+ {-# INLINE zeroDim #-}++ unitDim = unitDim :. 1+ {-# INLINE unitDim #-}++ intersectDim (sh1 :. n1) (sh2 :. n2)+ = (intersectDim sh1 sh2 :. (min n1 n2))+ {-# INLINE intersectDim #-}++ addDim (sh1 :. n1) (sh2 :. n2)+ = addDim sh1 sh2 :. (n1 + n2)+ {-# INLINE addDim #-}++ size (sh1 :. n)+ = size sh1 * n+ {-# INLINE size #-}++ inShapeRange (zs :. z) (sh1 :. n1) (sh2 :. n2)+ = (n2 >= z) && (n2 < n1) && (inShapeRange zs sh1 sh2)+ {-# INLINE inShapeRange #-}++ listOfShape (sh :. n)+ = n : listOfShape sh+ {-# NOINLINE listOfShape #-}++ shapeOfList xx+ = case xx of+ [] -> Nothing+ x : xs -> do ss <- shapeOfList xs + return $ ss :. x+ {-# NOINLINE shapeOfList #-}+++-------------------------------------------------------------------------------+-- Common shapes+type SH0 = Z+type SH1 = SH0 :. Int+type SH2 = SH1 :. Int+type SH3 = SH2 :. Int+type SH4 = SH3 :. Int+type SH5 = SH4 :. Int+++ish0 :: SH0+ish0 = Z++ish1 :: Int -> SH1+ish1 x1 = Z :. x1++ish2 :: Int -> Int -> SH2+ish2 x2 x1 = Z :. x2 :. x1++ish3 :: Int -> Int -> Int -> SH3+ish3 x3 x2 x1 = Z :. x3 :. x2 :. x1++ish4 :: Int -> Int -> Int -> Int -> SH4+ish4 x4 x3 x2 x1 = Z :. x4 :. x3 :. x2 :. x1+++ish5 :: Int -> Int -> Int -> Int -> Int -> SH5+ish5 x5 x4 x3 x2 x1 = Z :. x5 :. x4 :. x3 :. x2 :. x1+
+ Data/Repa/Array/Internals/Target.hs view
@@ -0,0 +1,109 @@++module Data.Repa.Array.Internals.Target+ ( Target (..), IOBuffer, TargetI+ , fromList, fromListInto)+where+import Data.Repa.Array.Index as A+import Data.Repa.Array.Internals.Bulk as A+import System.IO.Unsafe+import Control.Monad+import Control.Monad.Primitive+import Prelude as P+++-- Target ---------------------------------------------------------------------+-- | Class of manifest array representations that can be constructed+-- in a random-access manner.+--+---+-- TODO: generalise to work with higher ranked indices.+class Layout l => Target l a where++ -- | Mutable buffer for some array representation.+ data Buffer s l a++ -- | Allocate a new mutable buffer for the given layout.+ --+ -- UNSAFE: The integer must be positive, but this is not checked.+ unsafeNewBuffer :: PrimMonad m => l -> m (Buffer (PrimState m) l a)++ -- | Read an element from the mutable buffer.+ --+ -- UNSAFE: The index bounds are not checked.+ unsafeReadBuffer :: PrimMonad m => Buffer (PrimState m) l a -> Int -> m a++ -- | Write an element into the mutable buffer.+ --+ -- UNSAFE: The index bounds are not checked.+ unsafeWriteBuffer :: PrimMonad m => Buffer (PrimState m) l a -> Int -> a -> m ()++ -- | O(n). Copy the contents of a buffer that is larger by the given+ -- number of elements.+ --+ -- UNSAFE: The integer must be positive, but this is not checked.+ unsafeGrowBuffer :: PrimMonad m => Buffer (PrimState m) l a -> Int+ -> m (Buffer (PrimState m) l a)++ -- | O(1). Yield a slice of the buffer without copying.+ --+ -- UNSAFE: The given starting position and length must be within the bounds+ -- of the of the source buffer, but this is not checked.+ unsafeSliceBuffer :: PrimMonad m => Int -> Int -> Buffer (PrimState m) l a+ -> m (Buffer (PrimState m) l a)++ -- | O(1). Freeze a mutable buffer into an immutable Repa array.+ --+ -- UNSAFE: If the buffer is mutated further then the result of reading from+ -- the returned array will be non-deterministic.+ unsafeFreezeBuffer :: PrimMonad m => Buffer (PrimState m) l a -> m (Array l a)++ -- | O(1). Thaw an Array into a mutable buffer.+ --+ -- UNSAFE: The Array is no longer safe to use.+ unsafeThawBuffer :: PrimMonad m => Array l a -> m (Buffer (PrimState m) l a)++ -- | Ensure the array is still live at this point.+ -- Sometimes needed when the mutable buffer is a ForeignPtr with a finalizer.+ touchBuffer :: PrimMonad m => Buffer (PrimState m) l a -> m ()++ -- | O(1). Get the layout from a Buffer.+ bufferLayout :: Buffer s l a -> l++type IOBuffer = Buffer RealWorld++-- | Constraint synonym that requires an integer index space.+type TargetI l a = (Target l a, Index l ~ Int)+++-------------------------------------------------------------------------------+-- | O(length src). Construct a linear array from a list of elements.+fromList :: TargetI l a+ => Name l -> [a] -> Array l a+fromList nDst xx+ = let len = P.length xx+ lDst = create nDst len+ Just arr = fromListInto lDst xx+ in arr+{-# NOINLINE fromList #-}+++-- | O(length src). Construct an array from a list of elements,+-- and give it the provided layout.+--+-- The `length` of the provided shape must match the length of the list,+-- else `Nothing`.+--+fromListInto :: Target l a+ => l -> [a] -> Maybe (Array l a)+fromListInto lDst xx+ = unsafePerformIO+ $ do let !len = P.length xx+ if len /= size (extent lDst)+ then return Nothing+ else do+ buf <- unsafeNewBuffer lDst+ zipWithM_ (unsafeWriteBuffer buf) [0..] xx+ arr <- unsafeFreezeBuffer buf+ return $ Just arr+{-# NOINLINE fromListInto #-}+
+ Data/Repa/Array/Linear.hs view
@@ -0,0 +1,62 @@+{-# LANGUAGE UndecidableInstances #-}+module Data.Repa.Array.Linear+ ( L(..)+ , Name (..)+ , Array (..)+ , linear)+where+import Data.Repa.Array.Index+import Data.Repa.Array.Internals.Bulk+#include "repa-array.h"+++-- | A linear layout with the elements indexed by integers.+--+-- * Indexing is not bounds checked. Indexing outside the extent+-- yields the corresponding index.+--+data L = Linear+ { linearLength :: Int }++deriving instance Eq L+deriving instance Show L+++-- | Linear layout.+instance Layout L where+ data Name L = L+ type Index L = Int+ name = L+ create L len = Linear len+ extent (Linear len) = len+ toIndex _ ix = ix+ fromIndex _ ix = ix+ {-# INLINE_ARRAY name #-}+ {-# INLINE_ARRAY create #-}+ {-# INLINE_ARRAY extent #-}+ {-# INLINE_ARRAY toIndex #-}+ {-# INLINE_ARRAY fromIndex #-}++deriving instance Eq (Name L)+deriving instance Show (Name L)+++-- | Linear arrays.+instance Bulk L Int where+ data Array L Int = LArray Int+ layout (LArray len) = Linear len+ index (LArray _) ix = ix+ {-# INLINE_ARRAY layout #-}+ {-# INLINE_ARRAY index #-}+++-- | Construct a linear array that produces the corresponding index+-- for every element.+--+-- @> toList $ linear 10+-- [0, 1, 2, 3, 4, 5, 6, 7, 8, 9]@+--+linear :: Int -> Array L Int+linear len = LArray len+{-# INLINE linear #-}+
+ Data/Repa/Array/Material.hs view
@@ -0,0 +1,60 @@++module Data.Repa.Array.Material+ ( Name (..)+ , Array (..)++ -- * Boxed arrays+ , B (..)+ , fromBoxed, toBoxed+ , decimate++ -- * Unboxed arrays+ , U (..)+ , Unbox+ , fromUnboxed, toUnboxed++ -- * Foreign arrays+ , F (..)+ , fromForeignPtr, toForeignPtr+ , fromByteString, toByteString+ , fromStorableVector, toStorableVector+++ -- * Nested arrays+ , N (..)++ -- ** Conversion+ , fromLists+ , fromListss++ -- ** Mapping+ , mapElems++ -- ** Slicing+ , slices++ -- ** Concatenation+ , concats++ -- ** Splitting+ , segment+ , segmentOn++ , dice+ , diceSep++ -- ** Trimming+ , trims+ , trimEnds+ , trimStarts++ -- ** Transpose+ , ragspose3)+where+import Data.Repa.Array.Material.Boxed+import Data.Repa.Array.Material.Unboxed+import Data.Repa.Array.Material.Foreign+import Data.Repa.Array.Material.Nested+++
+ Data/Repa/Array/Material/Boxed.hs view
@@ -0,0 +1,168 @@++module Data.Repa.Array.Material.Boxed+ ( B (..)+ , Name (..)+ , Array (..)+ , Buffer (..)++ -- * Conversions+ , fromBoxed, toBoxed++ -- * Utils+ , decimate)+where+import Data.Repa.Array.Window as A+import Data.Repa.Array.Index as A+import Data.Repa.Array.Internals.Bulk as A+import Data.Repa.Array.Internals.Target as A+import Data.Repa.Fusion.Unpack+import Data.Word+import Control.Monad+import qualified Data.Vector as V+import qualified Data.Vector.Mutable as VM+#include "repa-array.h"+++-- | Layout an array as flat vector of boxed elements.+--+-- UNSAFE: Indexing into raw material arrays is not bounds checked.+-- You may want to wrap this with a Checked layout as well.+--+data B = Boxed { boxedLength :: !Int }+ deriving (Show, Eq)++------------------------------------------------------------------------------+-- | Boxed arrays.+instance Layout B where+ data Name B = B+ type Index B = Int+ name = B+ create B len = Boxed len+ extent (Boxed len) = len+ toIndex _ ix = ix+ fromIndex _ ix = ix+ {-# INLINE_ARRAY name #-}+ {-# INLINE_ARRAY create #-}+ {-# INLINE_ARRAY extent #-}+ {-# INLINE_ARRAY toIndex #-}+ {-# INLINE_ARRAY fromIndex #-}++deriving instance Eq (Name B)+deriving instance Show (Name B)+++------------------------------------------------------------------------------+-- | Boxed arrays.+instance Bulk B a where+ data Array B a = BArray !(V.Vector a)+ layout (BArray vec) = Boxed (V.length vec)+ index (BArray vec) ix = V.unsafeIndex vec ix+ {-# INLINE_ARRAY layout #-}+ {-# INLINE_ARRAY index #-}++deriving instance Show a => Show (Array B a)+++-------------------------------------------------------------------------------+-- | Boxed windows.+instance Windowable B a where+ window st len (BArray vec)+ = BArray (V.slice st len vec)+ {-# INLINE_ARRAY window #-}+++-------------------------------------------------------------------------------+-- | Boxed buffers.+instance Target B a where+ data Buffer s B a+ = BBuffer !(VM.MVector s a)++ unsafeNewBuffer (Boxed len)+ = liftM BBuffer (VM.unsafeNew len)+ {-# INLINE_ARRAY unsafeNewBuffer #-}++ unsafeReadBuffer (BBuffer mvec) ix+ = VM.unsafeRead mvec ix+ {-# INLINE_ARRAY unsafeReadBuffer #-}++ unsafeWriteBuffer (BBuffer mvec) ix+ = VM.unsafeWrite mvec ix+ {-# INLINE_ARRAY unsafeWriteBuffer #-}++ unsafeGrowBuffer (BBuffer mvec) bump+ = liftM BBuffer (VM.unsafeGrow mvec bump)+ {-# INLINE_ARRAY unsafeGrowBuffer #-}++ unsafeFreezeBuffer (BBuffer mvec)+ = liftM BArray (V.unsafeFreeze mvec)+ {-# INLINE_ARRAY unsafeFreezeBuffer #-}++ unsafeThawBuffer (BArray vec)+ = liftM BBuffer (V.unsafeThaw vec)+ {-# INLINE_ARRAY unsafeThawBuffer #-}++ unsafeSliceBuffer start len (BBuffer mvec)+ = let mvec' = VM.unsafeSlice start len mvec+ in return $ BBuffer mvec'+ {-# INLINE_ARRAY unsafeSliceBuffer #-}++ touchBuffer _+ = return ()+ {-# INLINE_ARRAY touchBuffer #-}++ bufferLayout (BBuffer mvec)+ = Boxed (VM.length mvec)+ {-# INLINE_ARRAY bufferLayout #-}++ {-# SPECIALIZE instance Target B Int #-}+ {-# SPECIALIZE instance Target B Float #-}+ {-# SPECIALIZE instance Target B Double #-}+ {-# SPECIALIZE instance Target B Word8 #-}+ {-# SPECIALIZE instance Target B Word16 #-}+ {-# SPECIALIZE instance Target B Word32 #-}+ {-# SPECIALIZE instance Target B Word64 #-}+++instance Unpack (Buffer s B a) (VM.MVector s a) where+ unpack (BBuffer vec) = vec+ repack _ vec = BBuffer vec+ {-# INLINE_ARRAY unpack #-}+ {-# INLINE_ARRAY repack #-}+++-------------------------------------------------------------------------------+-- | O(1). Wrap a boxed vector as an array.+fromBoxed :: V.Vector a -> Array B a+fromBoxed vec = BArray vec+{-# INLINE_ARRAY fromBoxed #-}+++-- | O(1). Unwrap a boxed vector from an array.+toBoxed :: Array B a -> V.Vector a+toBoxed (BArray vec) = vec+{-# INLINE_ARRAY toBoxed #-}++++-- | Scan through an array from front to back.+-- For pairs of successive elements, drop the second one when the given+-- predicate returns true.+--+-- This function can be used to remove duplicates from a sorted array.+--+-- TODO: generalise to other array types.+decimate+ :: (a -> a -> Bool)+ -> Array B a -> Array B a++decimate f arr+ | A.length arr == 0 + = A.fromList B []++ | otherwise+ = fromBoxed+ $ V.cons (arr `A.index` 0)+ (V.map snd+ $ V.filter (\(prev, here) -> not $ f prev here)+ $ V.zip (toBoxed arr) (V.tail $ toBoxed arr))+
+ Data/Repa/Array/Material/Foreign.hs view
@@ -0,0 +1,176 @@+{-# LANGUAGE ViewPatterns #-}+module Data.Repa.Array.Material.Foreign+ ( F (..)+ , Name (..)+ , Array (..)+ , Buffer (..)++ -- * Conversions+ , fromForeignPtr, toForeignPtr+ , fromStorableVector, toStorableVector+ , fromByteString, toByteString)+where+import Data.Repa.Array.Delayed+import Data.Repa.Array.Window+import Data.Repa.Array.Index+import Data.Repa.Array.Internals.Target+import Data.Repa.Array.Internals.Bulk+import Data.Word+import Foreign.ForeignPtr+import Foreign.Storable+import Data.Repa.Fusion.Unpack+import Data.ByteString (ByteString)+import qualified Data.ByteString.Internal as BS+import Control.Monad++import qualified Data.Vector.Storable as S+import qualified Data.Vector.Storable.Mutable as M++import Control.Monad.Primitive++#include "repa-array.h"+++-- | Layout for Foreign arrays.+--+-- UNSAFE: Indexing into raw material arrays is not bounds checked.+-- You may want to wrap this with a Checked layout as well.+--+data F = Foreign { foreignLength :: Int }+ deriving (Show, Eq)++------------------------------------------------------------------------------+-- | Foreign arrays.+instance Layout F where+ data Name F = F+ type Index F = Int+ name = F+ create F len = Foreign len+ extent (Foreign len) = len+ toIndex _ ix = ix+ fromIndex _ ix = ix+ {-# INLINE_ARRAY name #-}+ {-# INLINE_ARRAY create #-}+ {-# INLINE_ARRAY extent #-}+ {-# INLINE_ARRAY toIndex #-}+ {-# INLINE_ARRAY fromIndex #-}++deriving instance Eq (Name F)+deriving instance Show (Name F)++-------------------------------------------------------------------------------+-- | Foreign arrays.+instance Storable a => Bulk F a where+ data Array F a = FArray !(S.Vector a)+ layout (FArray v) = Foreign (S.length v)+ index (FArray v) i = S.unsafeIndex v i+ {-# INLINE_ARRAY layout #-}+ {-# INLINE_ARRAY index #-}+ {-# SPECIALIZE instance Bulk F Char #-}+ {-# SPECIALIZE instance Bulk F Int #-}+ {-# SPECIALIZE instance Bulk F Float #-}+ {-# SPECIALIZE instance Bulk F Double #-}+ {-# SPECIALIZE instance Bulk F Word8 #-}+ {-# SPECIALIZE instance Bulk F Word16 #-}+ {-# SPECIALIZE instance Bulk F Word32 #-}+ {-# SPECIALIZE instance Bulk F Word64 #-}++deriving instance (S.Storable a, Show a) => Show (Array F a)++instance Unpack (Array F a) (S.Vector a) where+ unpack (FArray v) = v+ repack _ v = FArray v+ {-# INLINE_ARRAY unpack #-}+ {-# INLINE_ARRAY repack #-}++-------------------------------------------------------------------------------+-- | Windowing Foreign arrays.+instance Storable a => Windowable F a where+ window st len (FArray vec)+ = FArray (S.slice st len vec)+ {-# INLINE_ARRAY window #-}+ {-# SPECIALIZE instance Windowable F Char #-}+ {-# SPECIALIZE instance Windowable F Int #-}+ {-# SPECIALIZE instance Windowable F Float #-}+ {-# SPECIALIZE instance Windowable F Double #-}+ {-# SPECIALIZE instance Windowable F Word8 #-}+ {-# SPECIALIZE instance Windowable F Word16 #-}+ {-# SPECIALIZE instance Windowable F Word32 #-}+ {-# SPECIALIZE instance Windowable F Word64 #-}+++-------------------------------------------------------------------------------+-- | Foreign buffers++instance Storable a => Target F a where+ data Buffer s F a = FBuffer !(M.MVector s a)++ unsafeNewBuffer (Foreign n) = FBuffer `liftM` M.unsafeNew n+ unsafeReadBuffer (FBuffer mv) i = M.unsafeRead mv i+ unsafeWriteBuffer (FBuffer mv) i a = M.unsafeWrite mv i a+ unsafeGrowBuffer (FBuffer mv) x = FBuffer `liftM` M.unsafeGrow mv x+ unsafeThawBuffer (FArray v) = FBuffer `liftM` S.unsafeThaw v+ unsafeFreezeBuffer (FBuffer mv) = FArray `liftM` S.unsafeFreeze mv+ unsafeSliceBuffer i n (FBuffer mv) = return $ FBuffer (M.unsafeSlice i n mv)+ touchBuffer (FBuffer (M.MVector _ p)) = unsafePrimToPrim $ touchForeignPtr p+ bufferLayout (FBuffer mv) = Foreign $ M.length mv+ {-# INLINE unsafeNewBuffer #-}+ {-# INLINE unsafeWriteBuffer #-}+ {-# INLINE unsafeReadBuffer #-}+ {-# INLINE unsafeGrowBuffer #-}+ {-# INLINE unsafeThawBuffer #-}+ {-# INLINE unsafeFreezeBuffer #-}+ {-# INLINE unsafeSliceBuffer #-}+ {-# INLINE touchBuffer #-}+ {-# INLINE bufferLayout #-}++-- | Unpack Foreign buffers+instance Unpack (Buffer s F a) (M.MVector s a) where+ unpack (FBuffer mv) = mv+ repack _ mv = FBuffer mv+ {-# INLINE_ARRAY unpack #-}+ {-# INLINE_ARRAY repack #-}++-------------------------------------------------------------------------------+-- | O(1). Wrap a `ForeignPtr` as an array.+fromForeignPtr :: Storable a => Int -> ForeignPtr a -> Array F a+fromForeignPtr n p = FArray $ S.unsafeFromForeignPtr p 0 n+{-# INLINE_ARRAY fromForeignPtr #-}+++toForeignPtr :: Storable a => Array F a -> (Int, Int, ForeignPtr a)+toForeignPtr (FArray (S.unsafeToForeignPtr -> (p,i,n))) = (i,n,p)+{-# INLINE_ARRAY toForeignPtr #-}+++-- | O(1). Convert a foreign array to a storable `Vector`.+toStorableVector :: Array F a -> S.Vector a+toStorableVector (FArray vec) = vec+{-# INLINE_ARRAY toStorableVector #-}+++-- | O(1). Convert a storable `Vector` to a foreign `Array`+fromStorableVector :: S.Vector a -> Array F a +fromStorableVector vec = FArray vec+{-# INLINE_ARRAY fromStorableVector #-}+++-- | O(1). Convert a foreign 'Vector' to a `ByteString`.+toByteString :: Array F Word8 -> ByteString+toByteString (FArray (S.unsafeToForeignPtr -> (p,i,n)))+ = BS.PS p i n+{-# INLINE_ARRAY toByteString #-}+++-- | O(1). Convert a `ByteString` to an foreign `Array`.+fromByteString :: ByteString -> Array F Word8+fromByteString (BS.PS p i n)+ = FArray (S.unsafeFromForeignPtr p i n)+{-# INLINE_ARRAY fromByteString #-}++++instance (Eq a, Storable a) => Eq (Array F a) where+ (FArray a1) == (FArray a2) = a1 == a2+ {-# INLINE_ARRAY (==) #-}+
+ Data/Repa/Array/Material/Nested.hs view
@@ -0,0 +1,423 @@++module Data.Repa.Array.Material.Nested+ ( N (..)+ , Name (..)+ , Array (..)+ , U.Unbox++ -- * Conversion+ , fromLists+ , fromListss++ -- * Mapping+ , mapElems++ -- * Slicing+ , slices++ -- * Concatenation+ , concats++ -- * Splitting+ , segment+ , segmentOn++ , dice+ , diceSep++ -- * Trimming+ , trims+ , trimEnds+ , trimStarts++ -- * Transpose+ , ragspose3)+where+import Data.Repa.Array.Delayed+import Data.Repa.Array.Window+import Data.Repa.Array.Index+import Data.Repa.Array.Material.Unboxed as A+import Data.Repa.Array.Internals.Bulk as A+import Data.Repa.Array.Internals.Target as A+import Data.Repa.Eval.Stream as A+import Data.Repa.Stream as S+import qualified Data.Vector.Unboxed as U+import qualified Data.Vector.Fusion.Stream as S+import qualified Data.Repa.Vector.Generic as G+import qualified Data.Repa.Vector.Unboxed as U+import Control.Monad.ST+import Prelude as P+import Prelude hiding (concat)+#include "repa-array.h"+++-- | Nested array represented as a flat array of elements, and a segment+-- descriptor that describes how the elements are partitioned into+-- the sub-arrays. Using this representation for multidimentional arrays+-- is significantly more efficient than using a boxed array of arrays, +-- as there is no need to allocate the sub-arrays individually in the heap.+--+-- With a nested type like:+-- @Array N (Array N (Array U Int))@, the concrete representation consists+-- of five flat unboxed vectors: two for each of the segment descriptors+-- associated with each level of nesting, and one unboxed vector to hold+-- all the integer elements.+--+-- UNSAFE: Indexing into raw material arrays is not bounds checked.+-- You may want to wrap this with a Checked layout as well.+--+data N = Nested + { nestedLength :: !Int }++deriving instance Eq N+deriving instance Show N+++-------------------------------------------------------------------------------+-- | Nested arrays.+instance Layout N where+ data Name N = N+ type Index N = Int+ name = N+ create N len = Nested len+ extent (Nested len) = len+ toIndex _ ix = ix+ fromIndex _ ix = ix+ {-# INLINE_ARRAY name #-}+ {-# INLINE_ARRAY extent #-}+ {-# INLINE_ARRAY toIndex #-}+ {-# INLINE_ARRAY fromIndex #-}++deriving instance Eq (Name N)+deriving instance Show (Name N)+++-------------------------------------------------------------------------------+-- | Nested arrays.+instance (BulkI l a, Windowable l a)+ => Bulk N (Array l a) where++ data Array N (Array l a)+ = NArray !(U.Vector Int) -- segment start positions.+ !(U.Vector Int) -- segment lengths.+ !(Array l a) -- data values++ layout (NArray starts _lengths _elems)+ = Nested (U.length starts)+ {-# INLINE_ARRAY layout #-}++ index (NArray starts lengths elems) ix+ = window (starts `U.unsafeIndex` ix)+ (lengths `U.unsafeIndex` ix)+ elems+ {-# INLINE_ARRAY index #-}+++deriving instance Show (Array l a) => Show (Array N (Array l a))+++-------------------------------------------------------------------------------+-- | Windowing Nested arrays.+instance (BulkI l a, Windowable l a)+ => Windowable N (Array l a) where+ window start len (NArray starts lengths elems)+ = NArray (U.unsafeSlice start len starts)+ (U.unsafeSlice start len lengths)+ elems+ {-# INLINE_ARRAY window #-}+++-------------------------------------------------------------------------------+-- | O(size src) Convert some lists to a nested array.+fromLists + :: TargetI l a+ => Name l -> [[a]] -> Array N (Array l a)+fromLists nDst xss+ = let xs = concat xss+ elems = fromList nDst xs+ lengths = U.fromList $ P.map P.length xss+ starts = U.unsafeInit $ U.scanl (+) 0 lengths+ in NArray starts lengths elems+{-# INLINE_ARRAY fromLists #-}+ ++-- | O(size src) Convert a triply nested list to a triply nested array.+fromListss + :: TargetI l a+ => Name l -> [[[a]]] -> Array N (Array N (Array l a))+fromListss nDst xs+ = let xs1 = concat xs+ xs2 = concat xs1+ elems = fromList nDst xs2+ + lengths1 = U.fromList $ P.map P.length xs+ starts1 = U.unsafeInit $ U.scanl (+) 0 lengths1++ lengths2 = U.fromList $ P.map P.length xs1+ starts2 = U.unsafeInit $ U.scanl (+) 0 lengths2++ in NArray starts1 lengths1 + $ NArray starts2 lengths2 + $ elems+{-# INLINE_ARRAY fromListss #-}+++-------------------------------------------------------------------------------+-- | Apply a function to all the elements of a doubly nested array,+-- preserving the nesting structure.+mapElems :: (Array l1 a -> Array l2 b)+ -> Array N (Array l1 a)+ -> Array N (Array l2 b)++mapElems f (NArray starts lengths elems)+ = NArray starts lengths (f elems)+{-# INLINE_ARRAY mapElems #-}+++-------------------------------------------------------------------------------+-- | O(1). Produce a nested array by taking slices from some array of elements.+-- +-- This is a constant time operation, as the representation for nested +-- vectors just wraps the starts, lengths and elements vectors.+--+slices :: Array U Int -- ^ Segment starting positions.+ -> Array U Int -- ^ Segment lengths.+ -> Array l a -- ^ Array elements.+ -> Array N (Array l a)++slices (UArray starts) (UArray lens) !elems+ = NArray starts lens elems+{-# INLINE_ARRAY slices #-}+++-------------------------------------------------------------------------------+-- | Segmented concatenation.+-- Concatenate triply nested vector, producing a doubly nested vector.+--+-- * Unlike the plain `concat` function, this operation is performed entirely+-- on the segment descriptors of the nested arrays, and does not require+-- the inner array elements to be copied.+--+-- @+-- > import Data.Repa.Nice+-- > nice $ concats $ fromListss U [["red", "green", "blue"], ["grey", "white"], [], ["black"]]+-- ["red","green","blue","grey","white","black"]+-- @+--+concats :: Array N (Array N (Array l a)) + -> Array N (Array l a)++concats (NArray starts1 lengths1 (NArray starts2 lengths2 elems))+ = let+ !starts2' = U.extract (U.unsafeIndex starts2)+ $ U.zip starts1 lengths1++ !lengths2' = U.extract (U.unsafeIndex lengths2)+ $ U.zip starts1 lengths1++ in NArray starts2' lengths2' elems+{-# INLINE_ARRAY concats #-}+++-------------------------------------------------------------------------------+-- | O(len src). Given predicates which detect the start and end of a segment, +-- split an vector into the indicated segments.+segment :: (BulkI l a, U.Unbox a)+ => (a -> Bool) -- ^ Detect the start of a segment.+ -> (a -> Bool) -- ^ Detect the end of a segment.+ -> Array l a -- ^ Vector to segment.+ -> Array N (Array l a) ++segment pStart pEnd !elems+ = let len = size (extent $ layout elems)+ (starts, lens) + = U.findSegments pStart pEnd + $ U.generate len (\ix -> index elems ix)++ in NArray starts lens elems+{-# INLINE_ARRAY segment #-}+++-- | O(len src). Given a terminating value, split an vector into segments.+--+-- The result segments do not include the terminator.+-- +-- @+-- > import Data.Repa.Nice+-- > nice $ segmentOn (== ' ') (fromList U "fresh fried fish ") +-- ["fresh "," "," ","fried ","fish "," "]+-- @+--+segmentOn + :: (BulkI l a, Eq a, U.Unbox a)+ => (a -> Bool) -- ^ Detect the end of a segment.+ -> Array l a -- ^ Vector to segment.+ -> Array N (Array l a)++segmentOn !pEnd !arr+ = segment (const True) pEnd arr+{-# INLINE_ARRAY segmentOn #-}+++-------------------------------------------------------------------------------+-- | O(len src). Like `segment`, but cut the source array twice.+dice :: (BulkI l a, Windowable l a, U.Unbox a)+ => (a -> Bool) -- ^ Detect the start of an inner segment.+ -> (a -> Bool) -- ^ Detect the end of an inner segment.+ -> (a -> Bool) -- ^ Detect the start of an outer segment.+ -> (a -> Bool) -- ^ Detect the end of an outer segment.+ -> Array l a -- ^ Array to dice.+ -> Array N (Array N (Array l a))++dice pStart1 pEnd1 pStart2 pEnd2 !arr+ = let lenArr = size (extent $ layout arr)++ -- Do the inner segmentation.+ (starts1, lens1) = U.findSegments pStart1 pEnd1 + $ U.generate lenArr (index arr)++ -- To do the outer segmentation we want to check if the first+ -- and last characters in each of the inner segments match+ -- the predicates.+ pStart2' arr' + = pStart2 $ index arr' 0++ pEnd2' arr' + = pEnd2 $ index arr' (size (extent $ layout arr') - 1)++ -- Do the outer segmentation.+ !lenArrInner = U.length starts1+ !arrInner = NArray starts1 lens1 arr+ (starts2, lens2) = U.findSegmentsFrom pStart2' pEnd2'+ lenArrInner (index arrInner)++ in NArray starts2 lens2 arrInner+{-# INLINE_ARRAY dice #-}+++-- | O(len src). Given field and row terminating values, +-- split an array into rows and fields.+--+diceSep :: (BulkI l a, Windowable l a, U.Unbox a, Eq a)+ => a -- ^ Terminating element for inner segments.+ -> a -- ^ Terminating element for outer segments.+ -> Array l a -- ^ Vector to dice.+ -> Array N (Array N (Array l a))++diceSep !xEndCol !xEndRow !arr+ = let (startsLensCol, startsLensRow)+ = runST+ $ G.unstreamToVector2+ $ S.diceSepS (== xEndCol) (== xEndRow)+ $ S.liftStream+ $ streamOfArray arr++ (startsCol, endsCol) = U.unzip startsLensCol+ (startsRow, endsRow) = U.unzip startsLensRow++ in NArray startsRow endsRow $ NArray startsCol endsCol arr+{-# INLINE_ARRAY diceSep #-}+++-------------------------------------------------------------------------------+-- | For each segment of a nested vector, trim elements off the start+-- and end of the segment that match the given predicate.+trims :: BulkI l a+ => (a -> Bool)+ -> Array N (Array l a)+ -> Array N (Array l a)++trims pTrim (NArray starts lengths elems)+ = let+ loop_trimEnds !start !len + | len == 0 = (start, len)+ | pTrim (elems `index` (start + len - 1))+ = loop_trimEnds start (len - 1)+ | otherwise = loop_trimStarts start len+ {-# INLINE_INNER loop_trimEnds #-}++ loop_trimStarts !start !len + | len == 0 = (start, len)+ | pTrim (elems `index` (start + len - 1)) + = loop_trimStarts (start + 1) (len - 1)+ | otherwise = (start, len)+ {-# INLINE_INNER loop_trimStarts #-}++ (starts', lengths')+ = U.unzip $ U.zipWith loop_trimEnds starts lengths++ in NArray starts' lengths' elems+{-# INLINE_ARRAY trims #-}+++-- | For each segment of a nested vector, trim elements off the end of +-- the segment that match the given predicate.+trimEnds :: BulkI l a+ => (a -> Bool)+ -> Array N (Array l a)+ -> Array N (Array l a)++trimEnds pTrim (NArray starts lengths elems)+ = let+ loop_trimEnds !start !len + | len == 0 = 0+ | pTrim (elems `index` (start + len - 1)) + = loop_trimEnds start (len - 1)+ | otherwise = len+ {-# INLINE_INNER loop_trimEnds #-}++ lengths' = U.zipWith loop_trimEnds starts lengths++ in NArray starts lengths' elems+{-# INLINE_ARRAY trimEnds #-}+++-- | For each segment of a nested vector, trim elements off the start of+-- the segment that match the given predicate.+trimStarts :: BulkI l a+ => (a -> Bool)+ -> Array N (Array l a)+ -> Array N (Array l a)++trimStarts pTrim (NArray starts lengths elems)+ = let+ loop_trimStarts !start !len + | len == 0 = (start, len)+ | pTrim (elems `index` (start + len - 1))+ = loop_trimStarts (start + 1) (len - 1)+ | otherwise = (start, len)+ {-# INLINE_INNER loop_trimStarts #-}++ (starts', lengths')+ = U.unzip $ U.zipWith loop_trimStarts starts lengths++ in NArray starts' lengths' elems+{-# INLINE_ARRAY trimStarts #-}+++-------------------------------------------------------------------------------+-- | Ragged transpose of a triply nested array.+-- +-- * This operation is performed entirely on the segment descriptors+-- of the nested arrays, and does not require the inner array elements+-- to be copied.+--+ragspose3 :: Array N (Array N (Array l a)) + -> Array N (Array N (Array l a))++ragspose3 (NArray starts1 lengths1 (NArray starts2 lengths2 elems))+ = let + startStops1 = U.zipWith (\s l -> (s, s + l)) starts1 lengths1+ (ixs', lengths1') = U.ratchet startStops1++ starts2' = U.map (U.unsafeIndex starts2) ixs'+ lengths2' = U.map (U.unsafeIndex lengths2) ixs'++ starts1' = U.unsafeInit $ U.scanl (+) 0 lengths1'++ in NArray starts1' lengths1' (NArray starts2' lengths2' elems)+{-# INLINE_ARRAY ragspose3 #-}+-- NOINLINE Because the operation is entirely on the segment descriptor.+-- This function won't fuse with anything externally, +-- and it does not need to be specialiased.+
+ Data/Repa/Array/Material/Unboxed.hs view
@@ -0,0 +1,176 @@++module Data.Repa.Array.Material.Unboxed+ ( U (..)+ , Name (..)+ , Array (..)+ , Buffer (..)+ , U.Unbox++ -- * Conversions+ , fromUnboxed, toUnboxed)+where+import Data.Repa.Array.Window+import Data.Repa.Array.Delayed+import Data.Repa.Array.Index+import Data.Repa.Array.Internals.Bulk+import Data.Repa.Array.Internals.Target+import Data.Repa.Fusion.Unpack+import Control.Monad+import Data.Word+import qualified Data.Vector.Unboxed as U+import qualified Data.Vector.Unboxed.Mutable as UM+#include "repa-array.h"+++-- | Layout an array as a flat vector of unboxed elements.+--+-- This is the most efficient representation for numerical data.+--+-- The implementation uses @Data.Vector.Unboxed@ which picks an efficient,+-- specialised representation for every element type. In particular,+-- unboxed vectors of pairs are represented as pairs of unboxed vectors.+--+-- UNSAFE: Indexing into raw material arrays is not bounds checked.+-- You may want to wrap this with a Checked layout as well.+--+data U = Unboxed { unboxedLength :: !Int }+ deriving (Show, Eq)++-------------------------------------------------------------------------------+-- | Unboxed arrays.+instance Layout U where+ data Name U = U+ type Index U = Int+ name = U+ create U len = Unboxed len+ extent (Unboxed len) = len+ toIndex _ ix = ix+ fromIndex _ ix = ix+ {-# INLINE_ARRAY name #-}+ {-# INLINE_ARRAY create #-}+ {-# INLINE_ARRAY extent #-}+ {-# INLINE_ARRAY toIndex #-}+ {-# INLINE_ARRAY fromIndex #-}++deriving instance Eq (Name U)+deriving instance Show (Name U)+++-------------------------------------------------------------------------------+-- | Unboxed arrays.+instance U.Unbox a => Bulk U a where+ data Array U a = UArray !(U.Vector a)+ layout (UArray vec) = Unboxed (U.length vec)+ index (UArray vec) ix = U.unsafeIndex vec ix+ {-# INLINE_ARRAY layout #-}+ {-# INLINE_ARRAY index #-}+ {-# SPECIALIZE instance Bulk U () #-}+ {-# SPECIALIZE instance Bulk U Bool #-}+ {-# SPECIALIZE instance Bulk U Char #-}+ {-# SPECIALIZE instance Bulk U Int #-}+ {-# SPECIALIZE instance Bulk U Float #-}+ {-# SPECIALIZE instance Bulk U Double #-}+ {-# SPECIALIZE instance Bulk U Word8 #-}+ {-# SPECIALIZE instance Bulk U Word16 #-}+ {-# SPECIALIZE instance Bulk U Word32 #-}+ {-# SPECIALIZE instance Bulk U Word64 #-}++deriving instance (Show a, U.Unbox a) => Show (Array U a)+++instance Unpack (Array U a) (U.Vector a) where+ unpack (UArray vec) = vec+ repack !_ !vec = UArray vec+ {-# INLINE_ARRAY unpack #-}+ {-# INLINE_ARRAY repack #-}+++-------------------------------------------------------------------------------+-- | Windowing Unboxed arrays.+instance U.Unbox a => Windowable U a where+ window st len (UArray vec)+ = UArray (U.slice st len vec)+ {-# INLINE_ARRAY window #-}+ {-# SPECIALIZE instance Windowable U Int #-}+ {-# SPECIALIZE instance Windowable U Float #-}+ {-# SPECIALIZE instance Windowable U Double #-}+ {-# SPECIALIZE instance Windowable U Word8 #-}+ {-# SPECIALIZE instance Windowable U Word16 #-}+ {-# SPECIALIZE instance Windowable U Word32 #-}+ {-# SPECIALIZE instance Windowable U Word64 #-}+++-------------------------------------------------------------------------------+-- | Unboxed buffers.+instance U.Unbox a => Target U a where+ data Buffer s U a+ = UBuffer !(UM.MVector s a)++ unsafeNewBuffer (Unboxed len)+ = liftM UBuffer (UM.unsafeNew len)+ {-# INLINE_ARRAY unsafeNewBuffer #-}++ unsafeReadBuffer (UBuffer mvec) ix+ = UM.unsafeRead mvec ix+ {-# INLINE_ARRAY unsafeReadBuffer #-}++ unsafeWriteBuffer (UBuffer mvec) ix+ = UM.unsafeWrite mvec ix+ {-# INLINE_ARRAY unsafeWriteBuffer #-}++ unsafeGrowBuffer (UBuffer mvec) bump+ = do mvec' <- UM.unsafeGrow mvec bump+ return $ UBuffer mvec'+ {-# INLINE_ARRAY unsafeGrowBuffer #-}++ unsafeFreezeBuffer (UBuffer mvec)+ = do vec <- U.unsafeFreeze mvec+ return $ UArray vec+ {-# INLINE_ARRAY unsafeFreezeBuffer #-}++ unsafeThawBuffer (UArray mvec)+ = liftM UBuffer (U.unsafeThaw mvec)+ {-# INLINE_ARRAY unsafeThawBuffer #-}++ unsafeSliceBuffer st len (UBuffer mvec)+ = do let mvec' = UM.unsafeSlice st len mvec+ return $ UBuffer mvec'+ {-# INLINE_ARRAY unsafeSliceBuffer #-}++ touchBuffer _+ = return ()+ {-# INLINE_ARRAY touchBuffer #-}++ bufferLayout (UBuffer mvec)+ = Unboxed (UM.length mvec)++ {-# SPECIALIZE instance Target U Int #-}+ {-# SPECIALIZE instance Target U Float #-}+ {-# SPECIALIZE instance Target U Double #-}+ {-# SPECIALIZE instance Target U Word8 #-}+ {-# SPECIALIZE instance Target U Word16 #-}+ {-# SPECIALIZE instance Target U Word32 #-}+ {-# SPECIALIZE instance Target U Word64 #-}+++instance Unpack (Buffer s U a) (UM.MVector s a) where+ unpack (UBuffer vec) = vec `seq` vec+ repack !_ !vec = UBuffer vec+ {-# INLINE_ARRAY unpack #-}+ {-# INLINE_ARRAY repack #-}+++-------------------------------------------------------------------------------+-- | O(1). Wrap an unboxed vector as an array.+fromUnboxed :: U.Unbox a+ => U.Vector a -> Array U a+fromUnboxed vec = UArray vec+{-# INLINE_ARRAY fromUnboxed #-}+++-- | O(1). Unwrap an unboxed vector from an array.+toUnboxed :: U.Unbox a+ => Array U a -> U.Vector a+toUnboxed (UArray vec) = vec+{-# INLINE_ARRAY toUnboxed #-}+
+ Data/Repa/Array/RowWise.hs view
@@ -0,0 +1,189 @@++module Data.Repa.Array.RowWise+ ( RW (..)+ , Name (..)+ , Array (..)+ , rowWise++ -- | Synonyms for common layouts.+ , DIM1, DIM2, DIM3, DIM4, DIM5++ -- | Helpers that contrain the coordinates to be @Ints@.+ , ix1, ix2, ix3, ix4, ix5)+where+import Data.Repa.Array.Internals.Shape+import Data.Repa.Array.Internals.Layout+import Data.Repa.Array.Internals.Bulk+import Control.Monad+import GHC.Base (quotInt, remInt)+#include "repa-array.h"+++-- | A row-wise layout that maps higher rank indices to linear ones in a+-- row-major order.+--+-- Indices are ordered so the inner-most coordinate varies most frequently:+--+-- @> Prelude.map (fromIndex (RowWise (ish2 2 3))) [0..5]+-- [(Z :. 0) :. 0, (Z :. 0) :. 1, (Z :. 0) :. 2, +-- (Z :. 1) :. 0, (Z :. 1) :. 1, (Z :. 1) :. 2]@+--+-- * Indexing is not bounds checked. Indexing outside the extent +-- yields the corresponding index.+--+data RW sh + = RowWise + { rowWiseShape :: !sh }++deriving instance Eq sh => Eq (RW sh)+deriving instance Show sh => Show (RW sh)+++-------------------------------------------------------------------------------+instance Shape sh + => Shape (RW sh) where++ rank (RowWise sh) + = rank sh+ {-# INLINE rank #-}++ zeroDim = RowWise zeroDim+ {-# INLINE zeroDim #-}++ unitDim = RowWise unitDim+ {-# INLINE unitDim #-}++ intersectDim (RowWise sh1) (RowWise sh2)+ = RowWise (intersectDim sh1 sh2)+ {-# INLINE intersectDim #-}++ addDim (RowWise sh1) (RowWise sh2)+ = RowWise (addDim sh1 sh2)+ {-# INLINE addDim #-}++ size (RowWise sh)+ = size sh+ {-# INLINE size #-}++ inShapeRange (RowWise sh1) (RowWise sh2) (RowWise sh3)+ = inShapeRange sh1 sh2 sh3+ {-# INLINE inShapeRange #-}++ listOfShape (RowWise sh)+ = listOfShape sh+ {-# INLINE listOfShape #-}++ shapeOfList xx+ = liftM RowWise $ shapeOfList xx+ {-# INLINE shapeOfList #-}+++-------------------------------------------------------------------------------+instance Layout (RW Z) where + data Name (RW Z) = RZ+ type Index (RW Z) = Z+ name = RZ+ create RZ Z = RowWise Z+ extent _ = Z+ toIndex _ _ = 0+ fromIndex _ _ = Z+ {-# INLINE_ARRAY name #-}+ {-# INLINE_ARRAY create #-}+ {-# INLINE_ARRAY extent #-}+ {-# INLINE_ARRAY toIndex #-}+ {-# INLINE_ARRAY fromIndex #-}++deriving instance Eq (Name (RW Z))+deriving instance Show (Name (RW Z))+++-------------------------------------------------------------------------------+instance ( Layout (RW sh)+ , Index (RW sh) ~ sh)+ => Layout (RW (sh :. Int)) where++ data Name (RW (sh :. Int)) = RC (Name (RW sh))+ type Index (RW (sh :. Int)) = sh :. Int++ name = RC name++ create (RC nSh) (sh :. i)+ = let RowWise iSh = create nSh sh+ in RowWise (iSh :. i)++ extent (RowWise sh) = sh++ toIndex (RowWise (sh1 :. sh2)) (sh1' :. sh2')+ = toIndex (RowWise sh1) sh1' * sh2 + sh2'++ fromIndex (RowWise (ds :. d)) n+ = fromIndex (RowWise ds) (n `quotInt` d) :. r+ -- If we assume that the index is in range, there is no point+ -- in computing the remainder for the highest dimension since+ -- n < d must hold. This saves one remInt per element access+ -- which is quite a big deal.+ where r | rank ds == 0 = n+ | otherwise = n `remInt` d++ {-# INLINE_ARRAY name #-}+ {-# INLINE_ARRAY create #-}+ {-# INLINE_ARRAY toIndex #-}+ {-# INLINE_ARRAY extent #-}+ {-# INLINE_ARRAY fromIndex #-}++deriving instance Eq (Name (RW sh)) => Eq (Name (RW (sh :. Int)))+deriving instance Show (Name (RW sh)) => Show (Name (RW (sh :. Int)))+++-------------------------------------------------------------------------------+-- | Row-wise arrays.+instance (Layout (RW sh), Index (RW sh) ~ sh)+ => Bulk (RW sh) sh where+ data Array (RW sh) sh = RArray sh+ layout (RArray sh) = RowWise sh+ index (RArray _) ix = ix+ {-# INLINE_ARRAY layout #-}+ {-# INLINE_ARRAY index #-}+++-- | Construct a rowWise array that produces the corresponding index+-- for every element.+--+-- @> toList $ rowWise (ish2 3 2) +-- [(Z :. 0) :. 0, (Z :. 0) :. 1,+-- (Z :. 1) :. 0, (Z :. 1) :. 1,+-- (Z :. 2) :. 0, (Z :. 2) :. 1]@+--+rowWise :: sh -> Array (RW sh) sh+rowWise sh = RArray sh+{-# INLINE_ARRAY rowWise #-}+++-------------------------------------------------------------------------------+type DIM1 = RW SH1+type DIM2 = RW SH2+type DIM3 = RW SH3+type DIM4 = RW SH4+type DIM5 = RW SH5+++ix1 :: Int -> DIM1+ix1 x = RowWise (Z :. x)+{-# INLINE ix1 #-}++ix2 :: Int -> Int -> DIM2+ix2 y x = RowWise (Z :. y :. x)+{-# INLINE ix2 #-}++ix3 :: Int -> Int -> Int -> DIM3+ix3 z y x = RowWise (Z :. z :. y :. x)+{-# INLINE ix3 #-}++ix4 :: Int -> Int -> Int -> Int -> DIM4+ix4 a z y x = RowWise (Z :. a :. z :. y :. x)+{-# INLINE ix4 #-}++ix5 :: Int -> Int -> Int -> Int -> Int -> DIM5+ix5 b a z y x = RowWise (Z :. b :. a :. z :. y :. x)+{-# INLINE ix5 #-}+
+ Data/Repa/Array/Tuple.hs view
@@ -0,0 +1,182 @@+{-# LANGUAGE UndecidableInstances #-}+module Data.Repa.Array.Tuple+ ( T2 (..)+ , Name (..)+ , Array (..)+ , Buffer (..)+ , tup2, untup2)+where+import Data.Repa.Array.Window+import Data.Repa.Array.Index+import Data.Repa.Array.Internals.Bulk+import Data.Repa.Array.Internals.Target+import Data.Repa.Fusion.Unpack+import Control.Monad+import Prelude hiding (zip, unzip)+#include "repa-array.h"+++-- | Tupled arrays where the components are unpacked and can have+-- separate representations.+data T2 l1 l2+ = Tup2 !l1 !l2+++deriving instance (Eq l1, Eq l2) => Eq (T2 l1 l2)+deriving instance (Show l1, Show l2) => Show (T2 l1 l2)+++-------------------------------------------------------------------------------+instance ( Index l1 ~ Index l2+ , Layout l1, Layout l2)+ => Layout (T2 l1 l2) where++ data Name (T2 l1 l2) = T2 !(Name l1) !(Name l2)+ type Index (T2 l1 l2) = Index l1+ name = T2 name name+ create (T2 n1 n2) ix = Tup2 (create n1 ix) (create n2 ix)+ extent (Tup2 l1 l2) = intersectDim (extent l1) (extent l2)+ toIndex (Tup2 l1 _l2) ix = toIndex l1 ix+ fromIndex (Tup2 l1 _l2) ix = fromIndex l1 ix+ -- TODO: using just l1 will be wrong for load functions if + -- the two layouts have different extents.+ {-# INLINE name #-}+ {-# INLINE create #-}+ {-# INLINE extent #-}+ {-# INLINE toIndex #-}+ {-# INLINE fromIndex #-}+++deriving instance+ (Eq (Name l1), Eq (Name l2))+ => Eq (Name (T2 l1 l2))++deriving instance+ (Show (Name l1), Show (Name l2))+ => Show (Name (T2 l1 l2))+++-------------------------------------------------------------------------------+-- | Tupled arrays.+instance (Bulk l1 a, Bulk l2 b, Index l1 ~ Index l2)+ => Bulk (T2 l1 l2) (a, b) where++ data Array (T2 l1 l2) (a, b)+ = T2Array !(Array l1 a) !(Array l2 b)++ layout (T2Array arr1 arr2) = Tup2 (layout arr1) (layout arr2)+ index (T2Array arr1 arr2) ix = (index arr1 ix, index arr2 ix)+ {-# INLINE_ARRAY layout #-}+ {-# INLINE_ARRAY index #-}+++deriving instance+ (Show (Array l1 a), Show (Array l2 b))+ => Show (Array (T2 l1 l2) (a, b))+++-------------------------------------------------------------------------------+-- | Tupled windows.+instance (Windowable l1 a, Windowable l2 b, Index l1 ~ Index l2)+ => Windowable (T2 l1 l2) (a, b) where+ window st sz (T2Array arr1 arr2)+ = T2Array (window st sz arr1) (window st sz arr2)+ {-# INLINE_ARRAY window #-}+++-------------------------------------------------------------------------------+-- | Tupled buffers.+instance ( Target l1 a, Target l2 b+ , Index l1 ~ Index l2)+ => Target (T2 l1 l2) (a, b) where++ data Buffer s (T2 l1 l2) (a, b)+ = T2Buffer !(Buffer s l1 a) !(Buffer s l2 b)++ unsafeNewBuffer (Tup2 l1 l2)+ = liftM2 T2Buffer (unsafeNewBuffer l1) (unsafeNewBuffer l2)+ {-# INLINE_ARRAY unsafeNewBuffer #-}++ unsafeReadBuffer (T2Buffer buf1 buf2) ix+ = do a <- unsafeReadBuffer buf1 ix+ b <- unsafeReadBuffer buf2 ix+ return (a,b)+ {-# INLINE_ARRAY unsafeReadBuffer #-}++ unsafeWriteBuffer (T2Buffer buf1 buf2) ix (x1, x2)+ = do unsafeWriteBuffer buf1 ix x1+ unsafeWriteBuffer buf2 ix x2+ {-# INLINE_ARRAY unsafeWriteBuffer #-}++ unsafeGrowBuffer (T2Buffer buf1 buf2) bump+ = do buf1' <- unsafeGrowBuffer buf1 bump+ buf2' <- unsafeGrowBuffer buf2 bump+ return $ T2Buffer buf1' buf2'+ {-# INLINE_ARRAY unsafeGrowBuffer #-}++ unsafeFreezeBuffer (T2Buffer buf1 buf2)+ = do arr1 <- unsafeFreezeBuffer buf1+ arr2 <- unsafeFreezeBuffer buf2+ return $ T2Array arr1 arr2+ {-# INLINE_ARRAY unsafeFreezeBuffer #-}++ unsafeThawBuffer (T2Array arr1 arr2)+ = do buf1 <- unsafeThawBuffer arr1+ buf2 <- unsafeThawBuffer arr2+ return $ T2Buffer buf1 buf2+ {-# INLINE_ARRAY unsafeThawBuffer #-}++ unsafeSliceBuffer start len (T2Buffer buf1 buf2)+ = do buf1' <- unsafeSliceBuffer start len buf1+ buf2' <- unsafeSliceBuffer start len buf2+ return $ T2Buffer buf1' buf2'+ {-# INLINE_ARRAY unsafeSliceBuffer #-}++ touchBuffer (T2Buffer buf1 buf2)+ = do touchBuffer buf1+ touchBuffer buf2+ {-# INLINE_ARRAY touchBuffer #-}++ bufferLayout (T2Buffer buf1 buf2)+ = Tup2 (bufferLayout buf1) (bufferLayout buf2)++instance (Unpack (Buffer s r1 a) t1, Unpack (Buffer s r2 b) t2)+ => Unpack (Buffer s (T2 r1 r2) (a, b)) (t1, t2) where+ unpack (T2Buffer buf1 buf2)+ = buf1 `seq` buf2 `seq` (unpack buf1, unpack buf2)+ {-# INLINE_ARRAY unpack #-}++ repack !(T2Buffer x1 x2) (buf1, buf2)+ = buf1 `seq` buf2 `seq` (T2Buffer (repack x1 buf1) (repack x2 buf2))+ {-# INLINE_ARRAY repack #-}+++-------------------------------------------------------------------------------+-- | Tuple two arrays into an array of pairs.+--+-- The two argument arrays must have the same index type, but can have+-- different extents. The extent of the result is the intersection+-- of the extents of the two argument arrays.+--+tup2 :: (Bulk l1 a, Bulk l2 b, Index l1 ~ Index l2)+ => Array l1 a -> Array l2 b+ -> Array (T2 l1 l2) (a, b)+tup2 arr1 arr2+ = T2Array arr1 arr2+{-# INLINE_ARRAY tup2 #-}+++-- | Untuple an array of tuples in to a tuple of arrays.+--+-- * The two returned components may have different extents, though they are+-- guaranteed to be at least as big as the argument array. This is the+-- key property that makes `untup2` different from `unzip`.+--+untup2 :: Array (T2 l1 l2) (a, b)+ -> (Array l1 a, Array l2 b)++untup2 (T2Array arr1 arr2)+ = (arr1, arr2)+{-# INLINE_ARRAY untup2 #-}++
+ Data/Repa/Array/Window.hs view
@@ -0,0 +1,96 @@+{-# LANGUAGE UndecidableInstances #-}+module Data.Repa.Array.Window+ ( W (..)+ , Array (..)+ , Windowable (..)+ , windowed+ , entire)+where+import Data.Repa.Array.Index+import Data.Repa.Array.Internals.Bulk+#include "repa-array.h"+++-- Windows --------------------------------------------------------------------+data W l + = Window + { windowStart :: Index l+ , windowSize :: Index l+ , windowInner :: l }++deriving instance (Show l, Show (Index l)) => Show (W l)+deriving instance (Eq l, Eq (Index l)) => Eq (W l)+++-------------------------------------------------------------------------------+-- | Windowed arrays.+instance Layout l => Layout (W l) where+ data Name (W l) = W (Name l)+ type Index (W l) = Index l++ name = W name++ create (W n) len + = let inner = create n len+ in Window zeroDim (extent inner) inner++ extent (Window _ sz _) + = sz++ toIndex (Window _st _sz inner) ix + = toIndex inner ix -- TODO: wrong, use offsets++ fromIndex (Window _st _sz inner) ix -- TODO: wrong, use offsets+ = fromIndex inner ix++ {-# INLINE_ARRAY name #-}+ {-# INLINE_ARRAY create #-}+ {-# INLINE_ARRAY toIndex #-}+ {-# INLINE_ARRAY extent #-}+ {-# INLINE_ARRAY fromIndex #-}+++deriving instance Eq (Name l) => Eq (Name (W l))+deriving instance Show (Name l) => Show (Name (W l))+++-------------------------------------------------------------------------------+-- | Windowed arrays.+instance Bulk l a => Bulk (W l) a where+ data Array (W l) a = WArray !(Index l) !(Index l) !(Array l a)+ layout (WArray st sz inner) = Window st sz (layout inner)+ index (WArray st _ inner) ix = index inner (addDim st ix)+ {-# INLINE_ARRAY layout #-}+ {-# INLINE_ARRAY index #-}+++-- | Wrap a window around an exiting array.+windowed :: Index l -> Index l -> Array l a -> Array (W l) a+windowed start shape arr+ = WArray start shape arr+{-# INLINE_ARRAY windowed #-}+++-- | Wrap a window around an existing array that encompases the entire array.+entire :: Bulk l a => Array l a -> Array (W l) a+entire arr+ = WArray zeroDim (extent $ layout arr) arr+{-# INLINE_ARRAY entire #-}+++-------------------------------------------------------------------------------+-- | Class of array representations that can be windowed directly.+--+-- The underlying representation can encode the window, +-- without needing to add a wrapper to the existing layout.+--+class Bulk l a => Windowable l a where+ window :: Index l -> Index l -> Array l a -> Array l a++-- | Windows are windowable.+instance Bulk l a => Windowable (W l) a where+ window start _shape (WArray wStart wShape arr)+ = WArray (addDim wStart start) wShape arr+ {-# INLINE_ARRAY window #-}++
+ Data/Repa/Bits/Date32.hs view
@@ -0,0 +1,142 @@++module Data.Repa.Bits.Date32+ ( Date32+ , pack, unpack+ , next+ , range+ , readYYYYsMMsDD)+where+import Data.Repa.Array.Material.Foreign as A+import Data.Repa.Array.Material.Unboxed as A+import Data.Repa.Array as A+import Data.Repa.Eval.Array as A+import Data.Word+import Data.Bits+import GHC.Exts+import GHC.Word+import Prelude as P+++-- | A date packed into a 32-bit word.+--+-- The bitwise format is:+--+-- @+-- 32 16 8 0 +-- | year | month | day |+-- @+--+-- Pros: Packing and unpacking a Date32 is simpler than using other formats+-- that represent dates as a number of days from some epoch. We can also+-- avoid worrying about what the epoch should be, and the representation+-- will not overflow until year 65536. +--+-- Cons: Computing a range of dates is slower than with representations+-- using an epoch, as we cannot simply add one to get to the next valid date.+--+type Date32 + = Word32+++-- | Pack a year, month and day into a `Word32`. +--+-- If any components of the date are out-of-range then they will be bit-wise+-- truncated so they fit in their destination fields.+--+pack :: (Word, Word, Word) -> Date32+pack (yy, mm, dd) + = ((fromIntegral yy .&. 0x0ffff) `shiftL` 16) + .|. ((fromIntegral mm .&. 0x0ff) `shiftL` 8)+ .|. (fromIntegral dd .&. 0x0ff)+{-# INLINE pack #-}+++-- | Inverse of `pack`.+--+-- This function does a simple bit-wise unpacking of the given `Word32`, +-- and does not guarantee that the returned fields are within a valid +-- range for the given calendar date.+--+unpack :: Date32 -> (Word, Word, Word)+unpack date+ = ( fromIntegral $ (date `shiftR` 16) .&. 0x0ffff+ , fromIntegral $ (date `shiftR` 8) .&. 0x0ff+ , fromIntegral $ date .&. 0x0ff)+{-# INLINE unpack #-}+++-- | Yield the next date in the series.+--+-- This assumes leap years occur every four years, +-- which is valid after year 1900 and before year 2100.+--+next :: Date32 -> Date32+next (W32# date)+ = W32# (next' date)+{-# INLINE next #-}++next' :: Word# -> Word#+next' !date+ | (yy, mm, dd) <- unpack (W32# date)+ , (yy', mm', dd') + <- case mm of+ 1 -> if dd >= 31 then (yy, 2, 1) else (yy, mm, dd + 1) -- Jan++ 2 -> if yy `mod` 4 == 0 -- Feb+ then if dd >= 29+ then (yy, 3, 1) + else (yy, mm, dd + 1)+ else if dd >= 28+ then (yy, 3, 1)+ else (yy, mm, dd + 1)++ 3 -> if dd >= 31 then (yy, 4, 1) else (yy, mm, dd + 1) -- Mar+ 4 -> if dd >= 30 then (yy, 5, 1) else (yy, mm, dd + 1) -- Apr+ 5 -> if dd >= 31 then (yy, 6, 1) else (yy, mm, dd + 1) -- May+ 6 -> if dd >= 30 then (yy, 7, 1) else (yy, mm, dd + 1) -- Jun+ 7 -> if dd >= 31 then (yy, 8, 1) else (yy, mm, dd + 1) -- Jul+ 8 -> if dd >= 31 then (yy, 9, 1) else (yy, mm, dd + 1) -- Aug+ 9 -> if dd >= 30 then (yy, 10, 1) else (yy, mm, dd + 1) -- Sep+ 10 -> if dd >= 31 then (yy, 11, 1) else (yy, mm, dd + 1) -- Oct+ 11 -> if dd >= 30 then (yy, 12, 1) else (yy, mm, dd + 1) -- Nov+ 12 -> if dd >= 31 then (yy + 1, 1, 1) else (yy, mm, dd + 1) -- Dec+ _ -> (0, 0, 0)+ = case pack (yy', mm', dd') of+ W32# w -> w+{-# NOINLINE next' #-}+++-- | Yield an array containing a range of dates, inclusive of the end points.+---+-- TODO: avoid going via lists.+--+range :: TargetI l Date32+ => Name l -> Date32 -> Date32 -> Array l Date32++range n from to + | to < from = A.fromList n []+ | otherwise = A.fromList n $ go [] from+ where+ go !acc !d + | d > to = P.reverse acc+ | otherwise = go (d : acc) (next d)+{-# NOINLINE range #-}+++-- | Read a `Date32` in ASCII YYYYsMMsDD format, using the given separator+-- character 's'.+---+-- TODO: avoid going via lists.+--+readYYYYsMMsDD + :: BulkI l Char+ => Char -> Array l Char -> Maybe Date32++readYYYYsMMsDD sep arr+ = case words + $ A.toList+ $ A.mapS U (\c -> if c == sep then ' ' else c) arr of+ [yy, mm, dd] -> Just $ pack (read yy, read mm, read dd)+ _ -> Nothing+{-# INLINE readYYYYsMMsDD #-}+
+ Data/Repa/Eval/Array.hs view
@@ -0,0 +1,54 @@++module Data.Repa.Eval.Array+ ( -- * Array Targets+ Target (..), TargetI+ , IOBuffer++ -- * Array Loading+ , Load (..)++ , computeS+ , computeIntoS)+where+import Data.Repa.Array.Internals.Target as A+import Data.Repa.Array.Internals.Load as A+import Data.Repa.Array.Internals.Bulk as A+import Data.Repa.Array.Index as A+import System.IO.Unsafe+#include "repa-array.h"+++-- | Sequential computation of delayed array elements.+--+-- Elements of the source array are computed sequentially and +-- written to a new array of the specified layout.+--+computeS :: (Load lSrc lDst a, Index lSrc ~ Index lDst)+ => Name lDst -> Array lSrc a -> Array lDst a+computeS !nDst !aSrc+ = let !lDst = create nDst (extent $ layout aSrc)+ Just aDst = computeIntoS lDst aSrc+ in aDst `seq` aDst+{-# INLINE computeS #-}+++-- | Like `computeS` but use the provided desination layout.+--+-- The size of the destination layout must match the size of the source+-- array, else `Nothing`.+--+computeIntoS :: Load lSrc lDst a+ => lDst -> Array lSrc a -> Maybe (Array lDst a)+computeIntoS !lDst !aSrc+ | (A.size $ A.extent lDst) == A.length aSrc+ = unsafePerformIO+ $ do !buf <- unsafeNewBuffer lDst+ loadS aSrc buf+ !arr <- unsafeFreezeBuffer buf+ return $ Just arr++ | otherwise+ = Nothing+{-# INLINE_ARRAY computeIntoS #-}++
+ Data/Repa/Eval/Chain.hs view
@@ -0,0 +1,167 @@++-- | Interface with chain fusion.+module Data.Repa.Eval.Chain+ ( chainOfArray+ , unchainToArray+ , unchainToArrayIO)+where+import Data.Repa.Fusion.Unpack+import Data.Repa.Chain (Chain(..), Step(..))+import Data.Repa.Array.Internals.Bulk as A+import Data.Repa.Array.Internals.Target as A+import Data.Repa.Array.Index as A+import qualified Data.Vector.Fusion.Stream.Monadic as S+import qualified Data.Vector.Fusion.Stream.Size as S+import qualified Data.Vector.Fusion.Util as S+import System.IO.Unsafe+#include "repa-array.h"+++-------------------------------------------------------------------------------+-- | Produce a `Chain` for the elements of the given array.+-- The order in which the elements appear in the chain is+-- determined by the layout of the array.+chainOfArray+ :: (Monad m, Bulk l a)+ => Array l a -> Chain m Int a++chainOfArray !arr+ = Chain (S.Exact len) 0 step+ where+ !len = A.length arr++ step !i+ | i >= len = return $ Done i+ | otherwise+ = return $ Yield (A.index arr $ A.fromIndex (A.layout arr) i) (i + 1)+ {-# INLINE_INNER step #-}+{-# INLINE_STREAM chainOfArray #-}+++-- | Lift a pure chain to a monadic chain.+liftChain :: Monad m => Chain S.Id s a -> Chain m s a+liftChain (Chain sz s step)+ = Chain sz s (return . S.unId . step)+{-# INLINE_STREAM liftChain #-}+++-------------------------------------------------------------------------------+-- | Compute the elements of a pure `Chain`,+-- writing them into a new array `Array`.+unchainToArray+ :: (Target l a, Unpack (IOBuffer l a) t)+ => Name l -> Chain S.Id s a -> (Array l a, s)+unchainToArray nDst c+ = unsafePerformIO+ $ unchainToArrayIO nDst+ $ liftChain c+{-# INLINE_STREAM unchainToArray #-}+++-- | Compute the elements of an `IO` `Chain`,+-- writing them to a new `Array`.+unchainToArrayIO+ :: (Target l a, Unpack (IOBuffer l a) t)+ => Name l -> Chain IO s a -> IO (Array l a, s)++unchainToArrayIO nDst (Chain sz s0 step)+ = case sz of+ S.Exact i -> unchainToArrayIO_max i+ S.Max i -> unchainToArrayIO_max i+ S.Unknown -> unchainToArrayIO_unknown 32++ -- unchain when we known the maximum size of the vector.+ where unchainToArrayIO_max !nMax+ = do !vec0 <- unsafeNewBuffer (create nDst zeroDim)+ !vec <- unsafeGrowBuffer vec0 nMax++ let go_unchainIO_max !sPEC !i !s+ = step s >>= \m+ -> case m of+ Yield e s'+ -> do unsafeWriteBuffer vec i e+ go_unchainIO_max sPEC (i + 1) s'++ Skip s'+ -> go_unchainIO_max sPEC i s'++ Done s'+ -> do buf' <- unsafeSliceBuffer 0 i vec+ arr <- unsafeFreezeBuffer buf'+ return (arr, s')+ {-# INLINE_INNER go_unchainIO_max #-}++ go_unchainIO_max S.SPEC 0 s0+ {-# INLINE_INNER unchainToArrayIO_max #-}++ -- unchain when we don't know the maximum size of the vector.+ unchainToArrayIO_unknown !nStart+ = do !vec0 <- unsafeNewBuffer (create nDst zeroDim)+ !vec1 <- unsafeGrowBuffer vec0 nStart++ let go_unchainIO_unknown !sPEC !uvec !i !n !s+ = go_unchainIO_unknown1 (repack vec0 uvec) i n s+ (\vec' i' n' s' -> go_unchainIO_unknown sPEC (unpack vec') i' n' s')+ (\result -> return result)++ go_unchainIO_unknown1 !vec !i !n !s cont done+ = step s >>= \r+ -> case r of+ Yield e s'+ -> do (vec', n')+ <- if i >= n+ then do vec' <- unsafeGrowBuffer vec n+ return (vec', n + n)+ else return (vec, n)+ unsafeWriteBuffer vec' i e+ cont vec' (i + 1) n' s'++ Skip s'+ -> cont vec i n s'++ Done s'+ -> do+ vec' <- unsafeSliceBuffer 0 i vec+ arr <- unsafeFreezeBuffer vec'+ done (arr, s')++ go_unchainIO_unknown S.SPEC (unpack vec1) 0 nStart s0+ {-# INLINE_INNER unchainToArrayIO_unknown #-}+{-# INLINE_STREAM unchainToArrayIO #-}++++{-+ -- This consuming function has been desugared so that the recursion+ -- is via RealWorld, rather than using a function of type IO.+ -- If the recursion is at IO then GHC tries to coerce to and from+ -- IO at every recursive call, which messes up SpecConstr.+ let go_unchainIO_unknown+ :: Unpack (Buffer r a) t+ => S.SPEC -> t -> Int -> Int -> s+ -> State# RealWorld -> (# State# RealWorld, (Array r DIM1 a, s) #)++ go_unchainIO_unknown !sPEC !uvec !i !n !s !w0+ = case unIO (step s) w0 of+ (# w1, Yield e s' #)+ | (# w2, (uvec', i', n') #)+ <- unIO (do (vec', n')+ <- if i >= n+ then do vec' <- unsafeGrowBuffer (repack vec0 uvec) n+ return (vec', n + n)+ else return (repack vec0 uvec, n)+ unsafeWriteBuffer vec' i e+ return (unpack vec', i + 1, n'))+ w1+ -> (go_unchainIO_unknown sPEC uvec' i' n' s') w2++ (# w1, Skip s' #)+ -> (go_unchainIO_unknown sPEC uvec i n s') w1++ (# w1, Done s' #)+ -> (unIO $ do+ vec' <- unsafeSliceBuffer 0 i (repack vec0 uvec)+ arr <- unsafeFreezeBuffer (Z :. i) vec'+ return (arr, s')) w1+ {-# INLINE go_unchainIO_unknown #-}+-}
+ Data/Repa/Eval/Stream.hs view
@@ -0,0 +1,22 @@+{-# LANGUAGE CPP #-}++-- | Interface with stream fusion.+module Data.Repa.Eval.Stream+ (streamOfArray)+where+import Data.Repa.Array.Index as A+import Data.Repa.Array.Internals.Bulk as A+import qualified Data.Vector.Fusion.Stream.Monadic as S+#include "repa-array.h"+++-- | Produce a `Stream` for the elements of the given array.+streamOfArray + :: (Monad m, Bulk l a, Index l ~ Int)+ => A.Array l a+ -> S.Stream m a++streamOfArray vec+ = S.generate (A.length vec)+ (\i -> A.index vec i)+{-# INLINE_STREAM streamOfArray #-}
+ Data/Repa/Fusion/Unpack.hs view
@@ -0,0 +1,15 @@++module Data.Repa.Fusion.Unpack+ (Unpack (..))+where+++-- | Unpack the pieces of a structure into a tuple.+--+-- This is used in a low-level fusion optimisation to ensure that+-- intermediate values are unboxed.+--+class Unpack a t | a -> t where+ unpack :: a -> t+ repack :: a -> t -> a+
+ Data/Repa/IO/Array.hs view
@@ -0,0 +1,137 @@+{-# LANGUAGE ViewPatterns #-}++module Data.Repa.IO.Array+ ( hGetArray, hGetArrayPre+ , hPutArray+ , hGetArrayFromCSV+ , hPutArrayAsCSV)+where+import Data.Repa.Fusion.Unpack+import Data.Repa.Array.Material.Foreign+import Data.Repa.Array.Material.Boxed as A+import Data.Repa.Array.Material.Nested as A+import Data.Repa.Array as A+import qualified Foreign.Ptr as F+import qualified Foreign.ForeignPtr as F+import qualified Foreign.Marshal.Alloc as F+import qualified Foreign.Marshal.Utils as F+import System.IO+import Data.Word+import Data.Char+++-- | Get data from a file, up to the given number of bytes.+--+-- * Data is read into foreign memory without copying it through the GHC heap.+--+hGetArray :: Handle -> Int -> IO (Array F Word8)+hGetArray h len+ = do+ buf :: F.Ptr Word8 <- F.mallocBytes len+ bytesRead <- hGetBuf h buf len+ fptr <- F.newForeignPtr F.finalizerFree buf+ return $ fromForeignPtr bytesRead fptr+{-# NOINLINE hGetArray #-}+++-- | Get data from a file, up to the given number of bytes, also+-- copying the given data to the front of the new buffer.+--+-- * Data is read into foreign memory without copying it through the GHC heap.+--+hGetArrayPre :: Handle -> Int -> Array F Word8 -> IO (Array F Word8)+hGetArrayPre h len (toForeignPtr -> (offset,lenPre,fptrPre))+ = F.withForeignPtr fptrPre+ $ \ptrPre' -> do+ let ptrPre = F.plusPtr ptrPre' offset+ ptrBuf :: F.Ptr Word8 <- F.mallocBytes (lenPre + len)+ F.copyBytes ptrBuf ptrPre lenPre+ lenRead <- hGetBuf h (F.plusPtr ptrBuf lenPre) len+ let bytesTotal = lenPre + lenRead+ fptrBuf <- F.newForeignPtr F.finalizerFree ptrBuf+ return $ fromForeignPtr bytesTotal fptrBuf+{-# NOINLINE hGetArrayPre #-}+++-- | Write data into a file.+--+-- * Data is written to file directly from foreign memory,+-- without copying it through the GHC heap.+--+hPutArray :: Handle -> Array F Word8 -> IO ()+hPutArray h (toForeignPtr -> (offset,lenPre,fptr))+ = F.withForeignPtr fptr+ $ \ptr' -> do+ let ptr = F.plusPtr ptr' offset+ hPutBuf h ptr lenPre+{-# NOINLINE hPutArray #-}+++-- | Read a CSV file as a nested array.+-- We get an array of rows:fields:characters.+--+hGetArrayFromCSV + :: Handle + -> IO (Array N (Array N (Array F Char)))++hGetArrayFromCSV !hIn+ = do + -- Find out how much data there is remaining in the file.+ start <- hTell hIn+ hSeek hIn SeekFromEnd 0+ end <- hTell hIn+ let !len = end - start+ hSeek hIn AbsoluteSeek start++ -- Read array as Word8s.+ !arr8 <- hGetArray hIn (fromIntegral len)++ -- Rows are separated by new lines, fields are separated by commas.+ let !nc = fromIntegral $ ord ','+ let !nl = fromIntegral $ ord '\n'++ let !arrSep = A.diceSep nc nl arr8++ -- Split CSV file into rows and fields.+ -- Convert element data from Word8 to Char.+ -- Chars take 4 bytes each, but are standard Haskell and pretty+ -- print properly. We've done the dicing on the smaller Word8+ -- version, and now map across the elements vector in the array+ -- to do the conversion.+ let !arrChar + = A.mapElems + (A.mapElems (A.computeS F . A.map (chr . fromIntegral))) + arrSep++ return arrChar+++-- | Write a nested array as a CSV file.+-- The array contains rows:fields:characters.+--+hPutArrayAsCSV + :: ( BulkI l1 (Array l2 (Array l3 Char))+ , BulkI l2 (Array l3 Char)+ , BulkI l3 Char+ , Unpack (Array l3 Char) t)+ => Handle+ -> Array l1 (Array l2 (Array l3 Char))+ -> IO ()++hPutArrayAsCSV !hOut !arrChar+ = do+ -- Concat result back into Word8s+ let !arrC = A.fromList U [',']+ let !arrNL = A.fromList U ['\n']++ let !arrOut + = A.mapS F (fromIntegral . ord) + $ A.concat U + $ A.mapS B (\arrFields+ -> A.concat U $ A.fromList B+ [ A.intercalate U arrC arrFields, arrNL])+ $ arrChar++ hPutArray hOut arrOut+{-# INLINE hPutArrayAsCSV #-}+
+ Data/Repa/IO/Convert.hs view
@@ -0,0 +1,89 @@++module Data.Repa.IO.Convert+ ( -- * Conversion+ -- | Read and Show `Double`s for a reasonable runtime cost.+ readDouble, readDoubleFromBytes+ , showDouble, showDoubleAsBytes+ , showDoubleFixed, showDoubleFixedAsBytes)+where+import Data.Repa.Array.Material.Foreign as A+import Data.Repa.Array as A+import System.IO.Unsafe+import Data.Word+import Data.Char+import GHC.Ptr+import qualified Foreign.ForeignPtr as F+import qualified Foreign.Storable as F+import qualified Foreign.Marshal.Alloc as F+import qualified Foreign.Marshal.Utils as F+import qualified Data.Double.Conversion.ByteString as DC+++-- | Convert a foreign vector of characters to a Double.+--+-- * The standard Haskell `Char` type is four bytes in length.+-- If you already have a vector of `Word8` then use `readDoubleFromBytes`+-- instead to avoid the conversion.+--+readDouble :: Array F Char -> Double+readDouble vec+ = readDoubleFromBytes+ $ A.computeS F $ A.map (fromIntegral . ord) vec+{-# INLINE readDouble #-}+++-- | Convert a foreign vector of bytes to a Double.+readDoubleFromBytes :: Array F Word8 -> Double+readDoubleFromBytes (toForeignPtr -> (start,len,fptr))+ = unsafePerformIO+ $ F.allocaBytes (len + 1) $ \pBuf ->+ F.alloca $ \pRes ->+ F.withForeignPtr fptr $ \pIn ->+ do+ -- Copy the data to our new buffer.+ F.copyBytes pBuf (pIn `plusPtr` start) (fromIntegral len)++ -- Poke a 0 on the end to ensure it's null terminated.+ F.pokeByteOff pBuf len (0 :: Word8)++ -- Call the C strtod function+ let !d = strtod pBuf pRes++ return d+{-# NOINLINE readDoubleFromBytes #-}++foreign import ccall unsafe+ strtod :: Ptr Word8 -> Ptr (Ptr Word8) -> Double+++-- | Convert a `Double` to ASCII text packed into a foreign `Vector`.+showDouble :: Double -> Array F Char+showDouble !d+ = A.computeS F $ A.map (chr . fromIntegral)+ $ showDoubleAsBytes d+{-# INLINE showDouble #-}+++-- | Convert a `Double` to ASCII text packed into a foreign `Vector`.+showDoubleAsBytes :: Double -> Array F Word8+showDoubleAsBytes !d+ = fromByteString $ DC.toShortest d+{-# INLINE showDoubleAsBytes #-}+++-- | Like `showDouble`, but use a fixed number of digits after+-- the decimal point.+showDoubleFixed :: Int -> Double -> Array F Char+showDoubleFixed !prec !d+ = A.computeS F $ A.map (chr . fromIntegral)+ $ showDoubleFixedAsBytes prec d+{-# INLINE showDoubleFixed #-}+++-- | Like `showDoubleAsBytes`, but use a fixed number of digits after+-- the decimal point.+showDoubleFixedAsBytes :: Int -> Double -> Array F Word8+showDoubleFixedAsBytes !prec !d+ = fromByteString $ DC.toFixed prec d+{-# INLINE showDoubleFixedAsBytes #-}+
+ Data/Repa/Nice.hs view
@@ -0,0 +1,160 @@+{-# LANGUAGE UndecidableInstances #-}+module Data.Repa.Nice+ ( Nicer (..)+ , Str (..)+ , Tok (..))+where+import Data.Repa.Array as A+import Control.Monad+import Data.Word+import Prelude as P+++-- | Wrapper to indicate a list of characters should be printed as a string,+-- including double quotes.+data Str = Str [Char]++instance Show Str where+ show (Str xs) = show xs+++-- | Wrapper to indicate a list of characters should be printed as a string,+-- without double quotes.+data Tok = Tok [Char]++instance Show Tok where+ show (Tok xs) = xs+++-- | Convert some value to a nice form.+--+-- In particular:+--+-- * Nested Arrays are converted to nested lists, so that they are easier+-- to work with on the ghci console.+--+-- * Lists of characters are wrapped into the `Str` data type, so that+-- they can be pretty printed differently by follow-on processing.+-- +-- As ghci automatically pretty prints lists, using @nice@ is more+-- fun than trying to @show@ the raw Repa array representations.+--+class Nicer a where+ type Nice a + nice :: a -> Nice a+++-- Atomic ---------------------------------------------------------------------+instance Nicer () where+ type Nice () = ()+ nice x = x++instance Nicer Int where+ type Nice Int = Int+ nice x = x++instance Nicer Float where+ type Nice Float = Float+ nice x = x++instance Nicer Double where+ type Nice Double = Double+ nice x = x++instance Nicer Char where+ type Nice Char = Char+ nice x = x++instance Nicer Word8 where+ type Nice Word8 = Word8+ nice x = x++instance Nicer Word16 where+ type Nice Word16 = Word16+ nice x = x++instance Nicer Word32 where+ type Nice Word32 = Word32+ nice x = x++instance Nicer Word64 where+ type Nice Word64 = Word64+ nice x = x+++-- Lists ----------------------------------------------------------------------+-- instance (Nicer a) => Nicer [a] where+-- type Nice [a] = [Nice a]+-- nice xs = P.map nice xs++-- Special case instance for lists of chars to pretty print them +-- without the [,] list syntax.+instance Nicer [Char] where+ type Nice [Char] = Str+ nice xs = Str xs++instance Nicer [Int] where+ type Nice [Int] = [Int]+ nice xs = xs++instance Nicer [Float] where+ type Nice [Float] = [Float]+ nice xs = xs++instance Nicer [Double] where+ type Nice [Double] = [Double]+ nice xs = xs++instance Nicer [Word8] where+ type Nice [Word8] = [Word8]+ nice xs = xs++instance Nicer [Word16] where+ type Nice [Word16] = [Word16]+ nice xs = xs++instance Nicer [Word32] where+ type Nice [Word32] = [Word32]+ nice xs = xs++instance Nicer [Word64] where+ type Nice [Word64] = [Word64]+ nice xs = xs+++-- Parametric -----------------------------------------------------------------+instance Nicer a + => Nicer (Maybe a) where+ type Nice (Maybe a) = Maybe (Nice a)+ nice x = liftM nice x++instance (Nicer a, Nicer b) + => Nicer (a, b) where+ type Nice (a, b) = (Nice a, Nice b)+ nice (x, y) = (nice x, nice y)++instance (Bulk l a, Nicer [a]) + => Nicer (Array l a) where+ type Nice (Array l a) = Nice [a]+ nice vec = nice $ toList vec++instance Nicer a + => Nicer [Maybe a] where+ type Nice [Maybe a] = [Nice (Maybe a)]+ nice xs = P.map nice xs++instance (Nicer a, Nicer b) + => Nicer [(a, b)] where+ type Nice [(a, b)] = [Nice (a, b)]+ nice xs = P.map nice xs++instance (Bulk l a, Nicer [a])+ => Nicer [(Array l a)] where+ type Nice [Array l a] = [Nice [a]]+ nice xs = P.map (nice . toList) xs++instance Nicer [a]+ => Nicer [[a]] where+ type Nice [[a]] = [Nice [a]]+ nice xs = P.map nice xs+
+ Data/Repa/Nice/Display.hs view
@@ -0,0 +1,71 @@++module Data.Repa.Nice.Display+ ( Display (..)+ , Format (..)+ , display+ , takeDisplay+ , padL+ , padR)+where+import Data.Monoid+import Data.Char+import Data.Text (Text)+import qualified Data.Text as T++-- | How a given value should be displayed.+data Display+ = Display Format Int+ deriving (Eq, Show)+++-- | Common display formats.+data Format+ = FormatNumeric + | FormatText+ deriving (Eq, Show)+++instance Monoid Display where+ mempty = Display FormatNumeric 0++ mappend (Display m1 len1) (Display m2 len2)+ | m1 == FormatNumeric && m2 == FormatNumeric+ = Display FormatNumeric (max len1 len2)++ | otherwise+ = Display FormatText (max len1 len2)+++-- | Display a string with the given mode.+display :: Display -> Text -> Text+display (Display FormatNumeric width) str+ = padR width str++display (Display FormatText width) str+ = padL width str+++-- | Examine a string to decide how we should display it.+takeDisplay :: Text -> Display+takeDisplay str+ | all (\c -> isDigit c || c == '.') $ T.unpack str+ = Display FormatNumeric (T.length str)++ | otherwise+ = Display FormatText (T.length str)+++-- | Left justify some text in a column of the given width.+padL n xs+ = let len = T.length xs+ in if len >= n + then xs+ else xs <> T.replicate (n - len) (T.pack " ")+++-- | Right justify some text in a column of the given width.+padR n xs+ = let len = T.length xs+ in if len >= n + then xs+ else T.replicate (n - len) (T.pack " ") <> xs
+ Data/Repa/Nice/Present.hs view
@@ -0,0 +1,125 @@+{-# LANGUAGE TypeSynonymInstances, FlexibleInstances, OverlappingInstances #-}+module Data.Repa.Nice.Present+ ( Presentable (..)+ , Present (..)+ , Str (..)+ , Tok (..)+ , depth+ , strip1+ , strip2+ , flatten)+where+import Data.Monoid+import Data.Word+import Data.Text (Text)+import qualified Data.Text as T+import Data.Repa.Nice (Str(..), Tok(..))++-- | A value, wrapped up nicely.+data Present+ -- | An atomic thing.+ = Atom Text++ -- | Many of the same thing, to display with list brackets @[.. , ..]@+ | Many [Present]++ -- | Some different things, to display with tuple brackets @(.. , ..)@+ | Some [Present]+ deriving (Eq, Show)+++-- | Yield the nesting depth of a `Present`+depth :: Present -> Int+depth pp+ = case pp of+ Atom{} -> 0+ Many ps -> 1 + (case ps of+ [] -> 0+ _ -> maximum $ map depth ps)+ Some _ -> 0+++-- | Strip the top two layers of nesting into lists.+strip2 :: Present -> Maybe [[Present]]+strip2 (Many xs) = mapM strip1 xs+strip2 _ = Nothing+++-- | Strip the top layer of nesting into a list.+strip1 :: Present -> Maybe [Present]+strip1 (Many xs) = Just xs+strip1 _ = Nothing+++-- | Flatten a present into text+flatten :: Present -> Text +flatten (Atom str) = str+flatten (Many ps) + = T.pack "[" <> (T.intercalate (T.pack ",") $ map flatten ps) <> T.pack "]"++flatten (Some ps) + = T.pack "(" <> (T.intercalate (T.pack ",") $ map flatten ps) <> T.pack ")"+++-- | Convert some value to a form presentable to the user.+-- +-- Like `show` but we allow the nesting structure to be preserved+-- so it can be displayed in tabular format.+--+class Presentable a where+ present :: a -> Present ++instance Presentable Char where+ present = Atom . T.pack . show++instance Presentable Int where+ present = Atom . T.pack . show++instance Presentable Float where+ present = Atom . T.pack . show++instance Presentable Double where+ present = Atom . T.pack . show++instance Presentable Word8 where+ present = Atom . T.pack . show++instance Presentable Word16 where+ present = Atom . T.pack . show++instance Presentable Word32 where+ present = Atom . T.pack . show++instance Presentable Word64 where+ present = Atom . T.pack . show++instance Presentable Str where+ present (Str xs) = Atom $ T.pack (show xs)++instance Presentable Tok where+ present (Tok xs) = Atom $ T.pack xs++instance Presentable a + => Presentable [a] where+ present xs = Many $ map present xs++instance (Presentable a, Presentable b)+ => Presentable (a, b) where+ present (a, b) + = Some [present a, present b]++instance (Presentable a, Presentable b, Presentable c)+ => Presentable (a, b, c) where+ present (a, b, c) + = Some [present a, present b, present c]++instance (Presentable a, Presentable b, Presentable c, Presentable d)+ => Presentable (a, b, c, d) where+ present (a, b, c, d)+ = Some [present a, present b, present c, present d]++instance (Presentable a, Presentable b, Presentable c, Presentable d, Presentable e)+ => Presentable (a, b, c, d, e) where+ present (a, b, c, d, e) + = Some [present a, present b, present c, present d, present e]+
+ Data/Repa/Nice/Tabulate.hs view
@@ -0,0 +1,110 @@+{-# LANGUAGE UndecidableInstances, OverlappingInstances #-}+module Data.Repa.Nice.Tabulate+ ( tab+ , tabulate+ , Str (..)+ , Tok (..))+where+import Data.Repa.Nice.Present as A+import Data.Repa.Nice.Display as A+import Data.List as L+import qualified Data.Text as T+import Data.Text (Text)+import Data.Monoid+import Data.Maybe+++-- | Print a nested value to the console in tabular form.+--+-- The first two layers of nesting are displayed as rows and columns.+-- Numeric data is right-justified, while the rest is left-justified.+--+-- @+-- > tab [[10, 20, 302], [40, 50], [60, 7001, 80, 90 :: Int]]+-- 10 20 302+-- 40 50+-- 60 7001 80 90+-- @+--+-- Deeper layers of nesting are preserved in the output:+--+-- @+-- > tab [[[10], [20, 21]], [[30, 31], [40, 41, 41], [50 :: Int]]]+-- [10] [20,21] +-- [30,31] [40,41,41] [50]+-- @+--+-- By default, strings are printed as lists of characters:+--+-- @+-- > tab [[("red", 10), ("green", 20), ("blue", 30)], [("grey", 40), ("white", 50 :: Int)]]+-- ([\'r\',\'e\',\'d\'],10) ([\'g\',\'r\',\'e\',\'e\',\'n\'],20) ([\'b\',\'l\',\'u\',\'e\'],30)+-- ([\'g\',\'r\',\'e\',\'y\'],40) ([\'w\',\'h\',\'i\',\'t\',\'e\'],50)+-- @+--+-- If you want double-quotes then wrap the strings with a @Str@ constructor:+--+-- @ +-- > tab [[(Str "red", 10), (Str "green", 20), (Str "blue", 30)], [(Str "grey", 40), (Str "white", 50 :: Int)]]+-- ("red",10) ("green",20) ("blue",30)+-- ("grey",40) ("white",50)+-- @+--+-- If you don't want any quotes then wrap them with a @Tok@ constructor:+--+-- @+-- > tab [[(Tok "red", 10), (Tok "green", 20), (Tok "blue", 30)], [(Tok "grey", 40), (Tok "white", 50 :: Int)]]+-- (red,10) (green,20) (blue,30)+-- (grey,40) (white,50)+-- @+--+tab :: Presentable a => a -> IO ()+tab val+ = putStrLn $ T.unpack $ tabulate val+++-- | Display a nested value in tabular form.+--+tabulate :: Presentable a => a -> Text+tabulate xx+ = let pp = present xx+ in case depth pp of+ 0 -> flatten pp++ 1 -> let Just pss = strip1 pp+ in tabulate1 $ map flatten pss++ _ -> let Just pss = strip2 pp+ in tabulate2 $ map (map flatten) pss++tabulate1 :: [Text] -> Text+tabulate1 strs+ = let d = mconcat $ map takeDisplay strs+ in T.intercalate (T.pack "\n") + $ L.map (display d) strs+++tabulate2 :: [[Text]] -> Text+tabulate2 strss+ = let + -- Decide how to display a single column.+ displayOfCol c+ = mconcat+ $ mapMaybe (\line -> if c >= length line+ then Nothing+ else Just (takeDisplay (line !! c)))+ $ strss++ -- How many columns we have.+ nCols = maximum $ L.map L.length strss++ -- Decide how to display all the columns.+ displays = L.map displayOfCol [0.. nCols - 1]++ makeLine line+ = T.intercalate (T.pack " ") + $ L.zipWith display displays line++ in T.intercalate (T.pack "\n") + $ L.map makeLine strss+
+ LICENSE view
@@ -0,0 +1,25 @@+Copyright (c) 2014-2015, The Repa Development 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.++- 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.
+ Setup.hs view
@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain
+ include/repa-array.h view
@@ -0,0 +1,10 @@++#define PHASE_FLOW [3]+#define PHASE_ARRAY [2]+#define PHASE_STREAM [1]+#define PHASE_INNER [0]++#define INLINE_FLOW INLINE PHASE_FLOW+#define INLINE_ARRAY INLINE PHASE_ARRAY+#define INLINE_STREAM INLINE PHASE_STREAM+#define INLINE_INNER INLINE PHASE_INNER
+ repa-array.cabal view
@@ -0,0 +1,120 @@+Name: repa-array+Version: 4.0.0.1+License: BSD3+License-file: LICENSE+Author: The Repa Development Team+Maintainer: Ben Lippmeier <benl@ouroborus.net>+Build-Type: Simple+Cabal-Version: >=1.6+Stability: experimental+Category: Data Structures+Homepage: http://repa.ouroborus.net+Bug-reports: repa@ouroborus.net+Description:+ NOTE: This is an ALPHA version of Repa 4. The API is not yet complete with+ respect to Repa 3. Some important functions are still missing, and the docs+ may not be up-to-date.++Synopsis:+ Bulk array representations and operators.++source-repository head+ type: git+ location: https://github.com/DDCSF/repa.git++Library+ build-Depends: + base == 4.7.*,+ primitive == 0.5.*,+ vector == 0.10.*,+ bytestring == 0.10.*,+ mtl == 2.2.*,+ double-conversion == 2.0.*,+ text == 1.2.*,+ repa-eval == 4.0.0.0,+ repa-stream == 4.0.0.0+++ exposed-modules:+ Data.Repa.Array.Index.Slice++ Data.Repa.Array.Material.Boxed+ Data.Repa.Array.Material.Foreign+ Data.Repa.Array.Material.Nested+ Data.Repa.Array.Material.Unboxed++ Data.Repa.Array.Dense+ Data.Repa.Array.Delayed+ Data.Repa.Array.Delayed2+ Data.Repa.Array.Index+ Data.Repa.Array.Tuple+ Data.Repa.Array.Window+ Data.Repa.Array.Material+ Data.Repa.Array.RowWise+ Data.Repa.Array.Linear++ Data.Repa.Bits.Date32++ Data.Repa.Eval.Array+ Data.Repa.Eval.Chain+ Data.Repa.Eval.Stream++ Data.Repa.Fusion.Unpack++ Data.Repa.IO.Array+ Data.Repa.IO.Convert++ Data.Repa.Nice.Display+ Data.Repa.Nice.Tabulate+ Data.Repa.Nice.Present++ Data.Repa.Array+ Data.Repa.Nice+ + other-modules:+ Data.Repa.Array.Internals.Operator.Concat+ Data.Repa.Array.Internals.Operator.Fold+ Data.Repa.Array.Internals.Operator.Group+ Data.Repa.Array.Internals.Operator.Partition+ Data.Repa.Array.Internals.Operator.Reduce+ Data.Repa.Array.Internals.Operator.Filter+ Data.Repa.Array.Internals.Bulk+ Data.Repa.Array.Internals.Check+ Data.Repa.Array.Internals.Layout+ Data.Repa.Array.Internals.Load+ Data.Repa.Array.Internals.Shape+ Data.Repa.Array.Internals.Target++ include-dirs:+ include++ install-includes:+ repa-array.h++ ghc-options:+ -Wall -fno-warn-missing-signatures+ -O2++ extensions:+ CPP+ BangPatterns+ NoMonomorphismRestriction+ RankNTypes+ MagicHash+ UnboxedTuples+ ScopedTypeVariables+ PatternGuards+ FlexibleInstances+ FlexibleContexts+ TypeOperators+ TypeFamilies+ DefaultSignatures+ MultiParamTypeClasses+ EmptyDataDecls+ StandaloneDeriving+ FunctionalDependencies+ ConstraintKinds+ ForeignFunctionInterface+ ViewPatterns++