diff --git a/Data/Repa/Array.hs b/Data/Repa/Array.hs --- a/Data/Repa/Array.hs +++ b/Data/Repa/Array.hs @@ -3,119 +3,6 @@ -- 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 @@ -136,208 +23,92 @@ -- produces better object code that GHC's internal native code generator. -- module Data.Repa.Array - ( module Data.Repa.Array.Index + ( Array + , Elem, Build - , Name (..) - , Bulk (..), BulkI + -- * Basics + , index , (!) , 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 + , head, tail, init - , D2(..) - , delay2 + -- * Conversion + , fromList + , fromLists + , fromListss - -- ** Windowed arrays - , W(..) - , Windowable (..) - , windowed - , entire + , toList + , toLists + , toListss - -- ** Tupled arrays - , T2(..) - , tup2 - , untup2 + -- * Operators - -- * 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 + -- ** Mapping + , map + , map2 + , mapElems - -- ** Dense arrays - , E (..) - , vector - , matrix - , cube + -- ** Folding + , foldl + , folds + , foldsWith - -- * Conversion - , fromList, fromListInto - , toList + -- *** Special Folds + , sum, prod + , mean, std + , correlate + -- ** Filtering + , filter + , slices + , trims + , trimEnds + , trimStarts - -- * Computation - , Load - , Target - , computeS, computeIntoS + -- ** Zipping + , zip + , unzip - -- * 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. + -- ** Sloshing , reverse + , concat + , concats + , concatWith + , unlines + , intercalate + , ragspose3 - -- ** Mapping - , map, map2 - , mapS, map2S + -- ** Slicing + , slice - -- ** Filtering - , filter + -- ** Inserting + , insert - -- ** Searching + -- ** Searching , findIndex - -- ** Sloshing - -- | Sloshing operators copy array elements into a different arrangement, - -- but do not create new element values. - , concat - , concatWith, unlines - , intercalate - , ConcatDict + -- ** Merging + , merge + , mergeMaybe - , partition - , partitionBy - , partitionByIx + -- ** Compacting + , compact + , compactIn - -- ** Grouping + -- ** Grouping , groups , groupsWith - , GroupsDict - -- ** Folding - , foldl - , folds - , foldsWith - , Folds(..) - , FoldsDict) + -- ** Splitting + , segment + , segmentOn + , dice + , diceSep + ) 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 #-} +import Data.Repa.Array.Auto +import Prelude + hiding ( map, length, reverse, filter, concat, unlines, foldl, sum + , head, init, tail, zip, unzip) diff --git a/Data/Repa/Array/Auto.hs b/Data/Repa/Array/Auto.hs new file mode 100644 --- /dev/null +++ b/Data/Repa/Array/Auto.hs @@ -0,0 +1,88 @@ + +module Data.Repa.Array.Auto + ( Array + , Elem, Build + + -- * Basics + , index + , (!) + , length + , head, init, tail + + -- * Conversion + , fromList + , fromLists + , fromListss + + , toList + , toLists + , toListss + + -- * Operators + + -- ** Mapping + , map + , map2 + , mapElems + + -- ** Folding + , foldl + , sum, prod + , mean, std + , correlate + , folds + , foldsWith + + -- ** Filtering + , filter + , slices + , trims + , trimEnds + , trimStarts + + -- ** Zipping + , zip + , unzip + + -- ** Sloshing + , reverse + , concat + , concats + , concatWith + , unlines + , intercalate + , ragspose3 + + -- ** Slicing + , slice + + -- ** Inserting + , insert + + -- ** Searching + , findIndex + + -- ** Merging + , merge + , mergeMaybe + + -- ** Compacting + , compact + , compactIn + + -- ** Grouping + , groups + , groupsWith + + -- ** Splitting + , segment + , segmentOn + , dice + , diceSep) +where +import Data.Repa.Array.Auto.Base +import Data.Repa.Array.Auto.Operator +import Prelude + hiding ( map, length, reverse, filter, concat, unlines, foldl, sum, zip, unzip + , head, init, tail) + diff --git a/Data/Repa/Array/Auto/Base.hs b/Data/Repa/Array/Auto/Base.hs new file mode 100644 --- /dev/null +++ b/Data/Repa/Array/Auto/Base.hs @@ -0,0 +1,38 @@ + +module Data.Repa.Array.Auto.Base + ( Array + , Elem + , Build) +where +import Data.Repa.Array.Material.Auto (A(..)) +import qualified Data.Repa.Array.Generic as G +import qualified Data.Repa.Array.Meta.Window as A +import qualified Data.Repa.Array.Internals.Target as G +import qualified Data.Repa.Fusion.Unpack as F + + + +-- | Arrays of elements that are automatically layed out into some +-- efficient runtime representation. +-- +-- The implementation uses type families to chose unboxed representations +-- for all elements that can be unboxed. In particular: arrays of unboxed +-- tuples are represented as tuples of unboxed arrays, and nested arrays +-- are represented using a segment descriptor and a single single flat +-- vector containing all the elements. +-- + +type Array a + = G.Array A a + +-- | Class of elements that can be automatically organised into arrays. +type Elem a + = ( G.Bulk A a + , A.Windowable A a) + +-- | Class of elements where arrays of those elements can be constructed +-- in arbitrary order. +type Build a t + = ( G.Bulk A a + , G.Target A a + , F.Unpack (G.Buffer A a) t) diff --git a/Data/Repa/Array/Auto/Convert.hs b/Data/Repa/Array/Auto/Convert.hs new file mode 100644 --- /dev/null +++ b/Data/Repa/Array/Auto/Convert.hs @@ -0,0 +1,187 @@ + +module Data.Repa.Array.Auto.Convert + ( -- * Int Conversion + readIntFromOffset, readIntFromOffset# + + -- * Double Conversion + -- | Read and Show `Double`s for a reasonable runtime cost. + , readDouble, readDoubleFromBytes + , showDouble, showDoubleAsBytes + , showDoubleFixed, showDoubleFixedAsBytes) +where +import Data.Repa.Array.Auto.Base +import Data.Repa.Array.Generic.Convert +import System.IO.Unsafe +import Data.Word +import Data.Char +import GHC.Ptr +import GHC.Exts + +import qualified Data.Repa.Array.Material.Auto as A +import qualified Data.Repa.Array.Material.Foreign as A +import qualified Data.Repa.Array.Meta as A +import qualified Data.Repa.Array.Generic as A + +import qualified Data.Double.Conversion.ByteString as DC + +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 + + +------------------------------------------------------------------------------- +-- | Try to read an `Int` from the given offset in an array. +-- +-- If the conversion succeeded then you get the value, +-- along with the index of the next character, +-- otherwise `Nothing`. +-- +readIntFromOffset :: Array Char -> Int -> Maybe (Int, Int) +readIntFromOffset arr (I# ix0) + = case readIntFromOffset# arr ix0 of + (# 0#, _, _ #) -> Nothing + (# _ , n, ix #) -> Just (I# n, I# ix) +{-# INLINE readIntFromOffset #-} + + +-- | Unboxed version of `readIntFromOffset`. +-- +-- We still pay to unbox the input array, +-- but avoid boxing the result by construction. +-- +readIntFromOffset# :: Array Char -> Int# -> (# Int#, Int#, Int# #) +readIntFromOffset# !arr !ix0_ + = start ix0 + where + + !ix0 = I# ix0_ + !len = A.length arr + + start !ix + | ix >= len = (# 0#, 0#, 0# #) + | otherwise = sign ix + + -- Check for explicit sign character, + -- and encode what it was as an integer. + sign !ix + | !s <- A.index arr 0 + = case s of + '-' -> loop 1 (ix + 1) 0 + '+' -> loop 2 (ix + 1) 0 + _ -> loop 0 ix 0 + + loop !(neg :: Int) !ix !n + -- We've hit the end of the array. + | ix >= len + = end neg ix n + + | otherwise + = case ord $ A.index arr ix of + -- Current character is a digit, so add it to the accmulator. + w | w >= 0x30 && w <= 0x039 + -> loop neg (ix + 1) (n * 10 + (fromIntegral w - 0x30)) + + -- Current character is not a digit. + | otherwise + -> end neg ix n + + end !neg !ix !n + -- We didn't find any digits, and there was no explicit sign. + | ix == ix0 + , neg == 0 + = (# 0#, 0#, 0# #) + + -- We didn't find any digits, but there was an explicit sign. + | ix == (ix0 + 1) + , neg /= 0 + = (# 0#, 0#, 0# #) + + -- Number was explicitly negated. + | neg == 1 + , I# n' <- negate n + , I# ix' <- ix + = (# 1#, n', ix' #) + + -- Number was not negated. + | otherwise + , I# n' <- n + , I# ix' <- ix + = (# 1#, n', ix' #) +{-# NOINLINE readIntFromOffset# #-} + + +------------------------------------------------------------------------------- +-- | 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 Char -> Double +readDouble vec + = readDoubleFromBytes + $ A.computeS A.A $ A.map (fromIntegral . ord) vec +{-# INLINE readDouble #-} + + +-- | Convert a foreign vector of bytes to a Double. +readDoubleFromBytes :: Array Word8 -> Double +readDoubleFromBytes + (A.toForeignPtr . convert -> (start, len, fptr :: F.ForeignPtr Word8)) + = 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 Char +showDouble !d + = A.computeS A.A $ A.map (chr . fromIntegral) + $ showDoubleAsBytes d +{-# INLINE showDouble #-} + + +-- | Convert a `Double` to ASCII text packed into a foreign `Vector`. +showDoubleAsBytes :: Double -> Array Word8 +showDoubleAsBytes !d + = convert + $ A.fromByteString $ DC.toShortest d +{-# INLINE showDoubleAsBytes #-} + + +-- | Like `showDouble`, but use a fixed number of digits after +-- the decimal point. +showDoubleFixed :: Int -> Double -> Array Char +showDoubleFixed !prec !d + = A.computeS A.A $ 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 Word8 +showDoubleFixedAsBytes !prec !d + = convert + $ A.fromByteString $ DC.toFixed prec d +{-# INLINE showDoubleFixedAsBytes #-} + diff --git a/Data/Repa/Array/Auto/IO.hs b/Data/Repa/Array/Auto/IO.hs new file mode 100644 --- /dev/null +++ b/Data/Repa/Array/Auto/IO.hs @@ -0,0 +1,165 @@ + +-- | Array IO +module Data.Repa.Array.Auto.IO + ( -- * Raw Array IO + hGetArray, hGetArrayPre + , hPutArray + + -- * XSV files + -- ** Reading + , getArrayFromXSV, hGetArrayFromXSV + + -- ** Writing + , putArrayAsXSV, hPutArrayAsXSV) +where +import Data.Repa.Array.Auto.Base +import Data.Repa.Array.Generic.Convert +import System.IO +import Data.Word +import Data.Char +import qualified Data.Repa.Array.Material.Auto as A +import qualified Data.Repa.Array.Material.Foreign as A +import qualified Data.Repa.Array.Material.Nested as A +import qualified Data.Repa.Array.Meta as A +import qualified Data.Repa.Array.Generic 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 + + +-- | Get data from a file, up to the given number of bytes. +hGetArray :: Handle -> Int -> IO (Array Word8) +hGetArray h len + = do buf :: F.Ptr Word8 <- F.mallocBytes len + bytesRead <- hGetBuf h buf len + fptr <- F.newForeignPtr F.finalizerFree buf + return $! convert $! A.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. +hGetArrayPre :: Handle -> Int -> Array Word8 -> IO (Array Word8) +hGetArrayPre h len arr + | (offset, lenPre, fptrPre :: F.ForeignPtr Word8) + <- A.toForeignPtr $ convert arr + = 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 $ convert $! A.fromForeignPtr bytesTotal fptrBuf +{-# NOINLINE hGetArrayPre #-} + + +-- | Write data into a file. +hPutArray :: Handle -> Array Word8 -> IO () +hPutArray h arr + | (offset, lenPre, fptrPre :: F.ForeignPtr Word8) + <- A.toForeignPtr $ convert arr + = F.withForeignPtr fptrPre + $ \ptr' -> do + let ptr = F.plusPtr ptr' offset + hPutBuf h ptr lenPre +{-# NOINLINE hPutArray #-} + + +--------------------------------------------------------------------------------------------------- +-- | Read a XSV file as a nested array. +-- We get an array of rows:fields:characters. +getArrayFromXSV + :: Char -- ^ Field separator character, eg '|', ',' or '\t'. + -> FilePath -- ^ Source file handle. + -> IO (Array (Array (Array Char))) + +getArrayFromXSV !cSep !filePath + = do h <- openFile filePath ReadMode + arr <- hGetArrayFromXSV cSep h + hClose h + return arr + + +-- | Read an XSV file as a nested array. +-- We get an array of rows:fields:characters. +hGetArrayFromXSV + :: Char -- ^ Field separator character, eg '|', ',' or '\t'. + -> Handle -- ^ Source file handle. + -> IO (Array (Array (Array Char))) + +hGetArrayFromXSV !cSep !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 the given separator character. + let !nl = fromIntegral $ ord '\n' + let !nc = fromIntegral $ ord cSep + + -- Split XSV 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 A.F . A.map (chr . fromIntegral))) + (A.diceSep nc nl arr8) + + return $ convert arrChar + + +-------------------------------------------------------------------------------------------------- +-- | Write a nested array as an XSV file. +-- +-- The array contains rows:fields:characters. +putArrayAsXSV + :: Char -- ^ Separator character, eg '|', ',' or '\t' + -> FilePath -- ^ Source file handle. + -> Array (Array (Array Char)) -- ^ Array of row, field, character. + -> IO () + +putArrayAsXSV !cSep !filePath !arrChar + = do h <- openFile filePath WriteMode + hPutArrayAsXSV cSep h arrChar + hClose h + + +-- | Write a nested array as an XSV file. +-- +-- The array contains rows:fields:characters. +hPutArrayAsXSV + :: Char -- ^ Separator character, eg '|', ',' or '\t' + -> Handle -- ^ Source file handle. + -> Array (Array (Array Char)) -- ^ Array of row, field, character. + -> IO () + +hPutArrayAsXSV !cSep !hOut !arrChar + = do + -- Concat result back into Word8s + let !arrC = A.fromList A.U [cSep] + let !arrNL = A.fromList A.U ['\n'] + + let !arrOut + = A.mapS A.A (fromIntegral . ord) + $ A.concat A.U + $ A.mapS A.B (\arrFields + -> A.concat A.U $ A.fromList A.B + [ A.intercalate A.U arrC arrFields, arrNL]) + $ arrChar + + hPutArray hOut arrOut +{-# INLINE hPutArrayAsXSV #-} + diff --git a/Data/Repa/Array/Auto/Operator.hs b/Data/Repa/Array/Auto/Operator.hs new file mode 100644 --- /dev/null +++ b/Data/Repa/Array/Auto/Operator.hs @@ -0,0 +1,663 @@ + +-- | Repa Array API that automatically choses an array layout based +-- on the element type. +-- +-- This is a re-export of the module "Data.Repa.Array". +-- +module Data.Repa.Array.Auto.Operator + ( Array + , Elem, Build + + -- * Basics + , index + , (!) + , length + , head, tail, init + + -- * Conversion + , fromList + , fromLists + , fromListss + + , toList + , toLists + , toListss + + -- * Operators + + -- ** Mapping + , map + , map2 + , mapElems + + -- ** Folding + , foldl + , sum, prod + , mean, std + + -- *** Special Folds + , correlate + , folds + , foldsWith + + -- ** Filtering + , filter + , slices + , trims + , trimEnds + , trimStarts + + -- ** Zipping + , zip + , unzip + + -- ** Sloshing + , reverse + , concat + , concats + , concatWith + , unlines + , intercalate + , ragspose3 + + -- ** Slicing + , slice + + -- ** Inserting + , insert + + -- ** Searching + , findIndex + + -- ** Merging + , merge + , mergeMaybe + + -- ** Compacting + , compact + , compactIn + + -- ** Grouping + , groups + , groupsWith + + -- ** Splitting + , segment + , segmentOn + , dice + , diceSep) +where +import Data.Repa.Array.Auto.Base +import Data.Repa.Array.Material.Auto (Name(..)) +import Data.Repa.Array.Generic.Convert as A +import Control.Monad +import GHC.Exts hiding (fromList, toList) +import qualified Data.Repa.Array.Generic as G +import qualified Data.Repa.Array.Material.Auto as A +import qualified Data.Repa.Array.Material.Nested as N +import qualified Data.Repa.Array.Meta.Tuple as A +import qualified Data.Repa.Array.Meta.Window as A +import qualified Data.Repa.Array.Meta.Delayed as A +import qualified Data.Repa.Array.Meta.Delayed2 as A +import qualified Data.Repa.Array.Internals.Bulk as G +import qualified Data.Repa.Fusion.Unpack as F +import qualified Data.Repa.Chain as C +import qualified Data.Vector.Unboxed as U +import Prelude + hiding ( map, length, reverse, filter, concat, unlines, foldl, sum, zip, unzip + , head, tail, init) + + +-- Basic ------------------------------------------------------------------------------------------ +-- | 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 :: Elem a => Array a -> Int -> a +index = (G.!) +{-# INLINE index #-} + + +-- | O(1). Alias for `index` +(!) :: Elem a => Array a -> Int -> a +(!) = index +{-# INLINE (!) #-} + + +-- | O(1). Get the number of elements in an array. +length :: Elem a => Array a -> Int +length = G.length +{-# INLINE length #-} + + +-- | O(1). Take the head of an array, or `Nothing` if it's empty. +head :: Elem a => Array a -> Maybe a +head arr = if G.length arr < 1 + then Nothing + else Just (arr `index` 0) +{-# INLINE head #-} + + +-- | O(1). Take the tail of an array, or `Nothing` if it's empty. +tail :: Elem a => Array a -> Maybe (Array a) +tail = A.tail +{-# INLINE tail #-} + + +-- | O(1). Take the initial elements of an array, or `Nothing` if it's empty. +init :: Elem a => Array a -> Maybe (Array a) +init = A.init +{-# INLINE init #-} + + +-- Conversion ------------------------------------------------------------------------------------- +-- | Convert a list to an array. +fromList :: Build a at + => [a] -> Array a +fromList = G.fromList A +{-# INLINE fromList #-} + + +-- | Convert a nested list to an array. +fromLists :: Build a at + => [[a]] -> Array (Array a) +fromLists xs = convert $! N.fromLists A xs +{-# INLINE fromLists #-} + + +-- | Convert a triply nested list to a triply nested array. +fromListss :: Build a at + => [[[a]]] -> Array (Array (Array a)) +fromListss xs = convert $! N.fromListss A xs +{-# INLINE fromListss #-} + + +-- | Convert an array to a list. +toList :: Elem a => Array a -> [a] +toList = G.toList +{-# INLINE toList #-} + + +-- | Convert a nested array to some lists. +toLists :: (Elem a, Elem (Array a)) + => Array (Array a) -> [[a]] +toLists = G.toLists +{-# INLINE toLists #-} + + +-- | Convert a triply nested array to a triply nested list. +toListss :: (Elem a, Elem (Array a), Elem (Array (Array a))) + => Array (Array (Array a)) -> [[[a]]] +toListss = G.toListss +{-# INLINE toListss #-} + + +-- Index space ------------------------------------------------------------------------------------ +-- | O(n). Reverse the elements of a list. +-- +-- @ +-- > toList $ reverse $ fromList [0 .. 10 :: Int] +-- [10,9,8,7,6,5,4,3,2,1,0] +-- @ +-- +reverse :: Build a at => Array a -> Array a +reverse arr = G.computeS A $! A.reverse arr +{-# INLINE reverse #-} + + +-- Mapping ---------------------------------------------------------------------------------------- +-- | Apply a function to all the elements of a list. +map :: (Elem a, Build b bt) + => (a -> b) -> Array a -> Array b +map f arr + = G.computeS A $! A.map f arr +{-# INLINE map #-} + + +-- | Combine two arrays of the same length element-wise. +-- +-- If the arrays don't have the same length then `Nothing`. +-- +map2 :: (Elem a, Elem b, Build c ct) + => (a -> b -> c) -> Array a -> Array b -> Maybe (Array c) +map2 f xs ys + = liftM (G.computeS A) $! A.map2 f xs ys +{-# INLINE map2 #-} + + +-- | Apply a function to all the elements of a doubly nested +-- array, preserving the nesting structure. +-- +-- * This function has a non-standard time complexity. +-- As nested arrays use a segment descriptor based representation, +-- detatching and reattaching the nesting structure is a constant time +-- operation. However, the array passed to the worker function will +-- also contain any elements in the array representation that are +-- not reachable from the segment descriptor. This matters if the +-- source array was produced by a function that filters the segments +-- directly, like `slices`. +-- +mapElems :: (Array a -> Array b) + -> Array (Array a) -> (Array (Array b)) +mapElems f (A.AArray_Array arr) + = A.AArray_Array (N.mapElems f arr) +{-# INLINE mapElems #-} + + +-- Folding ---------------------------------------------------------------------------------------- +-- | Left fold of all elements in an array. +foldl :: Elem b + => (a -> b -> a) -> a -> Array b -> a +foldl = G.foldl +{-# INLINE foldl #-} + + +-- | Yield the sum of the elements of an array. +sum :: (Elem a, Num a) => Array a -> a +sum = G.sum +{-# INLINE sum #-} + + +-- | Yield the product of the elements of an array. +prod :: (Elem a, Num a) => Array a -> a +prod = G.prod +{-# INLINE prod #-} + + +-- | Yield the mean value of the elements of an array. +mean :: (Elem a, Fractional a) + => Array a -> a +mean = G.mean +{-# INLINE mean #-} + + +-- | Yield the standard deviation of the elements of an array +std :: (Elem a, Floating a) + => Array a -> a +std = G.std +{-# INLINE std #-} + + +-- | Compute the Pearson correlation of two arrays. +-- +-- If the arrays differ in length then only the common +-- prefix is correlated. +-- +correlate + :: ( Elem a, Floating a) + => Array a -> Array a -> a +correlate = G.correlate +{-# INLINE correlate #-} + + +-- | 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. +-- +folds :: (Elem a, Build n nt, Build b bt) + => (a -> b -> b) -- ^ Worker function. + -> b -- ^ Initial state when folding segments. + -> Array (n, Int) -- ^ Segment names and lengths. + -> Array a -- ^ Elements. + -> (Array (n, b), C.Folds Int Int n a b) +folds f z lens vals + = let (arr', result) = G.folds A A f z lens vals + in (A.AArray_T2 arr', result) +{-# INLINE folds #-} + + +-- | Like `folds`, but take an initial state for the first segment. +-- +foldsWith + :: (Elem a, Build n nt, Build b bt) + => (a -> b -> b) -- ^ Worker function. + -> b -- ^ Initial state when folding segments. + -> Maybe (n, Int, b) -- ^ Name, length and initial state for first segment. + -> Array (n, Int) -- ^ Segment names and lengths. + -> Array a -- ^ Elements. + -> (Array (n, b), C.Folds Int Int n a b) +foldsWith f z start lens vals + = let (arr', result) = G.foldsWith A A f z start lens vals + in (A.AArray_T2 arr', result) +{-# INLINE foldsWith #-} + + +-- Filtering -------------------------------------------------------------------------------------- +-- | O(len src) Keep the elements of an array that match the given predicate. +filter :: Build a at + => (a -> Bool) -> Array a -> Array a +filter = G.filter A +{-# INLINE filter #-} + + +-- | 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 Int -- ^ Segment starting positions. + -> Array Int -- ^ Segment lengths. + -> Array a -- ^ Array elements. + -> Array (Array a) + +slices (A.AArray_Int starts) (A.AArray_Int lens) elems + = A.AArray_Array + $! N.slices starts lens elems +{-# INLINE slices #-} + + +-- | For each segment of a nested vector, trim elements off the start +-- and end of the segment that match the given predicate. +trims :: Elem a + => (a -> Bool) + -> Array (Array a) + -> Array (Array a) + +trims f (A.AArray_Array arr) + = A.AArray_Array $! N.trims f arr +{-# INLINE trims #-} + + +-- | For each segment of a nested array, trim elements off the end of +-- the segment that match the given predicate. +trimEnds :: Elem a + => (a -> Bool) + -> Array (Array a) + -> Array (Array a) + +trimEnds f (A.AArray_Array arr) + = A.AArray_Array $! N.trimEnds f arr +{-# INLINE trimEnds #-} + + +-- | For each segment of a nested array, trim elements off the start of +-- the segment that match the given predicate. +trimStarts :: Elem a + => (a -> Bool) + -> Array (Array a) + -> Array (Array a) +trimStarts f (A.AArray_Array arr) + = A.AArray_Array $! N.trimStarts f arr +{-# INLINE trimStarts #-} + + +-- Zipping ---------------------------------------------------------------------------------------- +-- | O(1). Pack a pair of arrays to an array of pairs. +zip :: (Elem a, Elem b) + => Array a -> Array b -> Array (a, b) +zip arr1 arr2 + = let len = max (length arr1) (length arr2) + arr1' = A.window 0 len arr1 + arr2' = A.window 0 len arr2 + in A.AArray_T2 (A.tup2 arr1' arr2') +{-# INLINE zip #-} + + +-- | O(1). Unpack an array of pairs to a pair of arrays. +unzip :: (Elem a, Elem b) + => Array (a, b) -> (Array a, Array b) +unzip arr@(A.AArray_T2 arr') + = let len = length arr + (arr1, arr2) = A.untup2 arr' + arr1' = A.window 0 len arr1 + arr2' = A.window 0 len arr2 + in (arr1', arr2') + + +-- Sloshing --------------------------------------------------------------------------------------- +-- | Concatenate nested arrays. +concat :: (Elem a, Build a at, F.Unpack (Array a) aat) + => Array (Array a) -- ^ Arrays to concatenate. + -> Array a +concat = G.concat A +{-# INLINE concat #-} + + +-- | O(len result) Concatenate the elements of some nested vector, +-- inserting a copy of the provided separator array between each element. +concatWith + :: (Elem a, Build a at, F.Unpack (Array a) aat) + => Array a -- ^ Separator array. + -> Array (Array a) -- ^ Arrays to concatenate. + -> Array a +concatWith = G.concatWith A +{-# INLINE concatWith #-} + + +-- | O(len result) Concatenate the outer two layers of a triply nested array. +-- (Segmented concatenation). +-- +-- * The operation is performed entirely on the segment descriptors of the +-- array, and does not require the inner array elements to be copied. +-- * This version is faster than plain `concat` on triply nested arrays. +-- +concats :: Array (Array (Array a)) + -> Array (Array a) + +concats (A.AArray_Array (N.NArray starts1 lens1 (A.AArray_Array arr))) + = A.AArray_Array $ N.concats (N.NArray starts1 lens1 arr) +{-# INLINE concats #-} + + +-- | O(len result) Perform a `concatWith`, adding a newline character to +-- the end of each inner array. +unlines :: F.Unpack (Array Char) aat + => Array (Array Char) -> Array Char +unlines = G.unlines A +{-# INLINE unlines #-} + + +-- | O(len result) Insert a copy of the separator array between the elements of +-- the second and concatenate the result. +intercalate + :: (Elem a, Build a at, F.Unpack (Array a) aat) + => Array a -- ^ Separator array. + -> Array (Array a) -- ^ Arrays to concatenate. + -> Array a +intercalate = G.intercalate A +{-# INLINE intercalate #-} + + +-- | 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 (Array (Array a)) + -> Array (Array (Array a)) + +ragspose3 (A.AArray_Array (N.NArray starts0 lens0 (A.AArray_Array arr))) + = let N.NArray starts1 elems1 (N.NArray starts2 elems2 arr') + = N.ragspose3 (N.NArray starts0 lens0 arr) + + in A.AArray_Array + $! N.NArray starts1 elems1 + $! A.AArray_Array + $! N.NArray starts2 elems2 arr' +{-# INLINE ragspose3 #-} + + +-- Slicing ---------------------------------------------------------------------------------------- +-- | Take a slice out of an array, given a starting position and length. +slice :: Elem a => Int -> Int -> Array a -> Maybe (Array a) +slice from len arr + | from >= 0, len >= 0 + , len <= G.length arr - from + = Just $ A.window from len arr + + | otherwise + = Nothing +{-# INLINE slice #-} + + +-- Merging ---------------------------------------------------------------------------------------- +-- | Merge two sorted key-value streams. +merge :: (Ord k, Elem (k, a), Elem (k, b), Build (k, c) ct) + => (k -> a -> b -> c) -- ^ Combine two values with the same key. + -> (k -> a -> c) -- ^ Handle a left value without a right value. + -> (k -> b -> c) -- ^ Handle a right value without a left value. + -> Array (k, a) -- ^ Array of keys and left values. + -> Array (k, b) -- ^ Array of keys and right values. + -> Array (k, c) -- ^ Array of keys and results. +merge = G.merge A +{-# INLINE merge #-} + + +-- | Like `merge`, but only produce the elements where the worker functions +-- return `Just`. +mergeMaybe + :: (Ord k, Elem (k, a), Elem (k, b), Build (k, c) ct) + => (k -> a -> b -> Maybe c) -- ^ Combine two values with the same key. + -> (k -> a -> Maybe c) -- ^ Handle a left value without a right value. + -> (k -> b -> Maybe c) -- ^ Handle a right value without a left value. + -> Array (k, a) -- ^ Array of keys and left values. + -> Array (k, b) -- ^ Array of keys and right values. + -> Array (k, c) -- ^ Array of keys and results. +mergeMaybe = G.mergeMaybe A +{-# INLINE mergeMaybe #-} + + +-- Splitting -------------------------------------------------------------------------------------- +-- | Combination of `fold` and `filter`. +-- +-- We walk over the stream front to back, maintaining an accumulator. +-- At each point we can chose to emit an element (or not) +-- +compact :: (Elem a, Build b bt) + => (s -> a -> (Maybe b, s)) + -> s + -> Array a + -> Array b +compact = G.compact A +{-# INLINE compact #-} + + +-- | Like `compact` but use the first value of the stream as the +-- initial state, and add the final state to the end of the output. +compactIn + :: Build a at + => (a -> a -> (Maybe a, a)) + -> Array a + -> Array a +compactIn = G.compactIn A +{-# INLINE compactIn #-} + + +-- Inserting -------------------------------------------------------------------------------------- +-- | Insert elements produced by the given function in to an array. +insert :: Build a at + => (Int -> Maybe a) -> Array a -> Array a +insert = G.insert A +{-# INLINE insert #-} + + +-- Searching -------------------------------------------------------------------------------------- +-- | O(len src) Yield `Just` the index of the first element matching the predicate +-- or `Nothing` if no such element exists. +findIndex :: Elem a => (a -> Bool) -> Array a -> Maybe Int +findIndex = G.findIndex +{-# INLINE findIndex #-} + + +-- Splitting -------------------------------------------------------------------------------------- +-- | O(len src). Given predicates which detect the start and end of a segment, +-- split an vector into the indicated segments. +segment :: (Elem a, U.Unbox a) + => (a -> Bool) -- ^ Detect the start of a segment. + -> (a -> Bool) -- ^ Detect the end of a segment. + -> Array a -- ^ Array to segment. + -> Array (Array a) + +segment pStart pEnd elems + = A.AArray_Array $! N.segment pStart pEnd elems +{-# INLINE segment #-} + + +-- | O(len src). Given a terminating value, split an vector into segments. +-- +-- The result segments do not include the terminator. +segmentOn + :: (Elem a, Eq a, U.Unbox a) + => (a -> Bool) -- ^ Detect the end of a segment. + -> Array a -- ^ Array to segment. + -> Array (Array a) + +segmentOn pEnd arr + = A.AArray_Array $! N.segmentOn pEnd arr +{-# INLINE segmentOn #-} + + +-- | O(len src). Like `segment`, but cut the source array twice. +dice :: (Elem 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 a -- ^ Array to dice. + -> Array (Array (Array a)) + +dice pStart1 pEnd1 pStart2 pEnd2 arr + = let N.NArray starts1 elems1 (N.NArray starts2 elems2 arr') + = N.dice pStart1 pEnd1 pStart2 pEnd2 arr + + in A.AArray_Array + $! N.NArray starts1 elems1 + $! A.AArray_Array + $! N.NArray starts2 elems2 arr' +{-# INLINE dice #-} + + +-- | O(len src). Given field and row terminating values, +-- split an array into rows and fields. +-- +diceSep :: (Elem a, Eq a, U.Unbox a) + => a -- ^ Terminating element for inner segments. + -> a -- ^ Terminating element for outer segments. + -> Array a -- ^ Vector to dice. + -> Array (Array (Array a)) + +diceSep xEndCol xEndRow arr + = let N.NArray starts1 elems1 (N.NArray starts2 elems2 arr') + = N.diceSep xEndCol xEndRow arr + + in A.AArray_Array + $! N.NArray starts1 elems1 + $! A.AArray_Array + $! N.NArray starts2 elems2 arr' +{-# INLINE diceSep #-} + + +-- Grouping --------------------------------------------------------------------------------------- +-- | From a stream of values which has consecutive runs of idential values, +-- produce a stream of the lengths of these runs. +groups :: (Eq a, Build a at) + => Array a -- ^ Input elements. + -> (Array (a, Int), Maybe (a, Int)) + -- ^ Completed and final segment lengths. +groups arr + = let (arr', result) = G.groups A A arr + in (A.AArray_T2 arr', result) +{-# 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. +groupsWith + :: Build a at + => (a -> a -> Bool) -- ^ Comparison function. + -> Maybe (a, Int) -- ^ Starting element and count. + -> Array a -- ^ Input elements. + -> (Array (a, Int), Maybe (a, Int)) + -- ^ Completed and final segment lengths. +groupsWith f start arr + = let (arr', result) = G.groupsWith A A f start arr + in (A.AArray_T2 arr', result) +{-# INLINE groupsWith #-} + + diff --git a/Data/Repa/Array/Auto/Unpack.hs b/Data/Repa/Array/Auto/Unpack.hs new file mode 100644 --- /dev/null +++ b/Data/Repa/Array/Auto/Unpack.hs @@ -0,0 +1,115 @@ + +module Data.Repa.Array.Auto.Unpack + ( module Data.Repa.Convert.Format + , packForeign + , unpackForeign) +where +import Data.Repa.Array.Auto.Base as A +import Data.Repa.Array.Generic.Convert as A +import qualified Data.Repa.Array.Material.Auto as A +import qualified Data.Repa.Array.Material.Foreign as A +import qualified Data.Repa.Array.Internals.Target as A +import qualified Data.Repa.Array.Internals.Bulk as A +import Data.Repa.Convert.Format + +import Foreign.ForeignPtr +import Foreign.Ptr + +import System.IO.Unsafe +import Control.Monad +import Data.Word + +import qualified Data.Vector.Storable.Mutable as SM +#include "repa-array.h" + + +--------------------------------------------------------------------------------------------------- +-- | Pack some array elements into a foreign buffer using the given binary +-- format. +packForeign + :: (Packable format, A.Bulk A.A (Value format)) + => format -- ^ Binary format for each element. + -> Array (Value format) -- ^ Source elements. + -> Maybe (Array Word8) -- ^ Packed binary data. + +packForeign !format !arrElems + | Just rowSize <- fixedSize format + , lenElems <- A.length arrElems + , lenBytes <- rowSize * lenElems + + = unsafePerformIO + $ do + buf@(A.FBuffer mvec) :: A.Buffer A.F Word8 + <- A.unsafeNewBuffer (A.Foreign lenBytes) + + let (fptr, oStart, _) = SM.unsafeToForeignPtr mvec + + withForeignPtr fptr $ \ptr_ + -> do let ptr = plusPtr ptr_ oStart + + let loop !ixSrc !ixDst + | ixSrc >= lenElems + = return $ Just () + + | otherwise + = Data.Repa.Convert.Format.pack + (plusPtr ptr ixDst) format (A.index arrElems ixSrc) + $ \oElem -> loop (ixSrc + 1) (ixDst + oElem) + + mFinal <- loop 0 0 + case mFinal of + Nothing -> return Nothing + Just _ -> liftM (Just . A.convert) $ A.unsafeFreezeBuffer buf + + | otherwise + = Nothing +{-# INLINE_ARRAY packForeign #-} + + +--------------------------------------------------------------------------------------------------- +-- | Unpack an array of elements from a foreign buffer into their standard +-- in-memory representation. +-- +-- The binary format of the elements in the buffer is given by the +-- format specififier, while the in-memory representation is chosen +-- automagically based on the type of the elements. +-- +unpackForeign + :: (Packable format, A.Target A.A (Value format)) + => format -- ^ Binary format for each element. + -> Array Word8 -- ^ Packed binary data. + -> Maybe (Array (Value format)) -- ^ Unpacked elements. + +unpackForeign !format !arrBytes + | Just rowSize <- fixedSize format + , lenBytes <- A.length arrBytes + , lenBytes `mod` rowSize == 0 + , lenElems <- lenBytes `div` rowSize + = unsafePerformIO + $ do + let (oStart, _, fptr :: ForeignPtr Word8) + = A.toForeignPtr $ A.convert arrBytes + + withForeignPtr fptr $ \ptr_ + -> do let ptr = plusPtr ptr_ oStart + buf <- A.unsafeNewBuffer (A.Auto lenElems) + + let loop !ixSrc !ixDst + | ixDst >= lenElems + = return $ Just ixSrc + + | otherwise + = Data.Repa.Convert.Format.unpack + (plusPtr ptr ixSrc) format + $ \(value, oElem) -> do + A.unsafeWriteBuffer buf ixDst value + loop (ixSrc + oElem) (ixDst + 1) + + mFinal <- loop 0 0 + case mFinal of + Nothing -> return Nothing + Just _ -> liftM Just $ A.unsafeFreezeBuffer buf + + | otherwise + = Nothing +{-# INLINE_ARRAY unpackForeign #-} diff --git a/Data/Repa/Array/Delayed.hs b/Data/Repa/Array/Delayed.hs deleted file mode 100644 --- a/Data/Repa/Array/Delayed.hs +++ /dev/null @@ -1,134 +0,0 @@ -{-# 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 #-} diff --git a/Data/Repa/Array/Delayed2.hs b/Data/Repa/Array/Delayed2.hs deleted file mode 100644 --- a/Data/Repa/Array/Delayed2.hs +++ /dev/null @@ -1,129 +0,0 @@ -{-# 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 #-} - - diff --git a/Data/Repa/Array/Dense.hs b/Data/Repa/Array/Dense.hs deleted file mode 100644 --- a/Data/Repa/Array/Dense.hs +++ /dev/null @@ -1,165 +0,0 @@ -{-# 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) - diff --git a/Data/Repa/Array/Generic.hs b/Data/Repa/Array/Generic.hs new file mode 100644 --- /dev/null +++ b/Data/Repa/Array/Generic.hs @@ -0,0 +1,162 @@ + +-- | Generic array API. +-- +-- 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. +-- +-- The operators provided by this module do not depend on any particular +-- array representation. +-- +module Data.Repa.Array.Generic + ( Name + + -- * Array Access + , Bulk (..), BulkI + , (!) + , length + + -- * Array Computation + , Load + , Target, TargetI + , computeS, computeIntoS + + -- * Operators + -- ** Conversion + , fromList, fromListInto + , toList + , convert, copy + + -- ** Mapping + , mapS, map2S + + -- ** Merging + , merge + , mergeMaybe + + -- ** Splitting + , compact + , compactIn + + -- ** Filtering + , filter + + -- ** Inserting + , insert + + -- ** Searching + , findIndex + + -- ** Sloshing + -- | Sloshing operators copy array elements into a different arrangement, + -- but do not create new element values. + , concat + , concatWith, unlines + , intercalate + , ConcatDict + + -- ** Grouping + , groups + , groupsWith + , GroupsDict + + -- ** Folding + -- *** Complete fold + , foldl, sum, prod, mean, std + , correlate + + -- *** Segmented fold + , folds + , foldsWith + , Folds(..) + , FoldsDict) +where +import Data.Repa.Array.Generic.Target as A +import Data.Repa.Array.Generic.Load as A +import Data.Repa.Array.Generic.Index as A +import Data.Repa.Array.Meta 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.Compact as A +import Data.Repa.Array.Internals.Operator.Filter as A +import Data.Repa.Array.Internals.Operator.Fold as A +import Data.Repa.Array.Internals.Operator.Group as A +import Data.Repa.Array.Internals.Operator.Merge as A +import Data.Repa.Array.Internals.Operator.Insert as A +import Data.Repa.Array.Internals.Operator.Reduce as A +import qualified Data.Repa.Array.Generic.Convert as A +import qualified Data.Vector.Fusion.Stream.Monadic as V +import Control.Monad +import Prelude + hiding ( reverse, length, map, zipWith, concat, unlines + , foldl, sum + , filter) +#include "repa-array.h" + + +-- | 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 $! 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) $! map2 f xs ys +{-# INLINE map2S #-} + + +-- | O(1). Constant time conversion of one array representation to another. +convert :: A.Convert l1 a1 l2 a2 + => Name l2 -> Array l1 a1 -> Array l2 a2 +convert _ = A.convert +{-# INLINE convert #-} + + +-- | O(n). Linear time copy of one array representation to another. +-- +-- This function must be used instead of `convert` when the bit-wise +-- layout of the two array representations are different. +-- +copy :: (Bulk l1 a, Target l2 a, Index l1 ~ Index l2) + => Name l2 -> Array l1 a -> Array l2 a +copy n2 arr = computeS n2 $! delay arr +{-# INLINE copy #-} + + diff --git a/Data/Repa/Array/Generic/Convert.hs b/Data/Repa/Array/Generic/Convert.hs new file mode 100644 --- /dev/null +++ b/Data/Repa/Array/Generic/Convert.hs @@ -0,0 +1,12 @@ +{-# LANGUAGE IncoherentInstances #-} +module Data.Repa.Array.Generic.Convert + (Convert (..)) +where +import Data.Repa.Array.Internals.Bulk + +-- | Constant time conversion of one array representation to another. +class Convert r1 a1 r2 a2 where + convert :: Array r1 a1 -> Array r2 a2 + +instance Convert r a r a where + convert = id diff --git a/Data/Repa/Array/Generic/Index.hs b/Data/Repa/Array/Generic/Index.hs new file mode 100644 --- /dev/null +++ b/Data/Repa/Array/Generic/Index.hs @@ -0,0 +1,23 @@ + +-- | Shapes and Indices +module Data.Repa.Array.Generic.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 diff --git a/Data/Repa/Array/Generic/Load.hs b/Data/Repa/Array/Generic/Load.hs new file mode 100644 --- /dev/null +++ b/Data/Repa/Array/Generic/Load.hs @@ -0,0 +1,48 @@ + +module Data.Repa.Array.Generic.Load + ( 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.Generic.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 #-} + + diff --git a/Data/Repa/Array/Generic/Slice.hs b/Data/Repa/Array/Generic/Slice.hs new file mode 100644 --- /dev/null +++ b/Data/Repa/Array/Generic/Slice.hs @@ -0,0 +1,82 @@ + +-- | Index space transformation between arrays and slices. +module Data.Repa.Array.Generic.Slice + ( All (..) + , Any (..) + , FullShape + , SliceShape + , Slice (..)) +where +import Data.Repa.Array.Generic.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 #-} + diff --git a/Data/Repa/Array/Generic/Target.hs b/Data/Repa/Array/Generic/Target.hs new file mode 100644 --- /dev/null +++ b/Data/Repa/Array/Generic/Target.hs @@ -0,0 +1,9 @@ + +module Data.Repa.Array.Generic.Target + ( -- * Array Targets + Target (..), TargetI + , fromList + , fromListInto) +where +import Data.Repa.Array.Internals.Target + diff --git a/Data/Repa/Array/Index.hs b/Data/Repa/Array/Index.hs deleted file mode 100644 --- a/Data/Repa/Array/Index.hs +++ /dev/null @@ -1,23 +0,0 @@ - --- | 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 diff --git a/Data/Repa/Array/Index/Slice.hs b/Data/Repa/Array/Index/Slice.hs deleted file mode 100644 --- a/Data/Repa/Array/Index/Slice.hs +++ /dev/null @@ -1,82 +0,0 @@ - --- | 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 #-} - diff --git a/Data/Repa/Array/Internals/Bulk.hs b/Data/Repa/Array/Internals/Bulk.hs --- a/Data/Repa/Array/Internals/Bulk.hs +++ b/Data/Repa/Array/Internals/Bulk.hs @@ -13,6 +13,7 @@ #include "repa-array.h" + -- Bulk ----------------------------------------------------------------------- -- | Class of array representations that we can read elements from in a -- random-access manner. diff --git a/Data/Repa/Array/Internals/Check.hs b/Data/Repa/Array/Internals/Check.hs --- a/Data/Repa/Array/Internals/Check.hs +++ b/Data/Repa/Array/Internals/Check.hs @@ -4,7 +4,7 @@ , Safe (..) , Unsafe (..)) where -import Data.Repa.Array.Index +import Data.Repa.Array.Generic.Index as A class Check m where diff --git a/Data/Repa/Array/Internals/Load.hs b/Data/Repa/Array/Internals/Load.hs --- a/Data/Repa/Array/Internals/Load.hs +++ b/Data/Repa/Array/Internals/Load.hs @@ -17,9 +17,9 @@ 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 () + loadS :: Array l1 a -> Buffer l2 a -> IO () -- | Fill an entire array in parallel. loadP :: Gang - -> Array l1 a -> IOBuffer l2 a -> IO () + -> Array l1 a -> Buffer l2 a -> IO () diff --git a/Data/Repa/Array/Internals/Operator/Compact.hs b/Data/Repa/Array/Internals/Operator/Compact.hs new file mode 100644 --- /dev/null +++ b/Data/Repa/Array/Internals/Operator/Compact.hs @@ -0,0 +1,50 @@ + +module Data.Repa.Array.Internals.Operator.Compact + ( compact + , compactIn ) +where +import Data.Repa.Array.Internals.Layout as A +import Data.Repa.Array.Internals.Target as A +import Data.Repa.Array.Internals.Bulk as A +import Data.Repa.Eval.Stream as A +import Data.Repa.Fusion.Unpack as A +import Data.Repa.Stream as S +#include "repa-array.h" + + +-- | Combination of `fold` and `filter`. +-- +-- We walk over the stream front to back, maintaining an accumulator. +-- At each point we can chose to emit an element (or not) +compact :: ( BulkI lSrc a, TargetI lDst b + , Unpack (Buffer lDst b) t0) + => Name lDst + -> (s -> a -> (Maybe b, s)) + -> s + -> Array lSrc a + -> Array lDst b + +compact nDst f s0 arr + = A.unstreamToArray nDst + $ S.compactS f s0 + $ A.streamOfArray arr +{-# INLINE_ARRAY compact #-} + + +-- | Like `compact` but use the first value of the stream as the +-- initial state, and add the final state to the end of the output. +compactIn + :: ( BulkI lSrc a, TargetI lDst a + , Unpack (Buffer lDst a) t0) + => Name lDst + -> (a -> a -> (Maybe a, a)) + -> Array lSrc a + -> Array lDst a + +compactIn nDst f arr + = A.unstreamToArray nDst + $ S.compactInS f + $ A.streamOfArray arr +{-# INLINE_ARRAY compactIn #-} + + diff --git a/Data/Repa/Array/Internals/Operator/Concat.hs b/Data/Repa/Array/Internals/Operator/Concat.hs --- a/Data/Repa/Array/Internals/Operator/Concat.hs +++ b/Data/Repa/Array/Internals/Operator/Concat.hs @@ -1,20 +1,20 @@ -{-# LANGUAGE CPP #-} -- | Concatenation operators on arrays. module Data.Repa.Array.Internals.Operator.Concat ( concat , concatWith - , unlines , intercalate + , unlines , 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.Material.Unboxed as A +import Data.Repa.Array.Material.Foreign.Base as A +import Data.Repa.Array.Meta.Delayed as A +import Data.Repa.Array.Generic.Index as A +import Data.Repa.Array.Generic.Load 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.Repa.Fusion.Unpack as Fusion import qualified Data.Vector.Unboxed as U import qualified Data.Vector.Fusion.Stream.Monadic as V import System.IO.Unsafe @@ -28,7 +28,7 @@ = ( BulkI lOut (Array lIn a) , BulkI lIn a , TargetI lDst a - , Unpack (Array lIn a) tIn) + , Fusion.Unpack (Array lIn a) tIn) --------------------------------------------------------------------------------------------------- @@ -140,7 +140,7 @@ -- Keep copying the source row. | otherwise - -> do let !x = (repack row0 row) `index` (I# iX) + -> do let !x = (Fusion.repack row0 row) `index` (I# iX) unsafeWriteBuffer buf (I# iO) x loop_concatWith sPEC 0# (iO +# 1#) iY row (iX +# 1#) iLenX iS @@ -158,7 +158,7 @@ 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# + loop_concatWith sPEC 0# iO iY' (Fusion.unpack row') 0# iLenX' 0# -- Keep copying from the separator array. | otherwise @@ -168,13 +168,13 @@ -- First row. let !(I# iLenX0) = A.length row0 - loop_concatWith V.SPEC 0# 0# 0# (unpack row0) 0# iLenX0 0# + loop_concatWith V.SPEC 0# 0# 0# (Fusion.unpack row0) 0# iLenX0 0# unsafeFreezeBuffer buf {-# INLINE_ARRAY concatWith #-} --- | Perform a `concatWith`, adding a newline character to the end of each --- inner array. +-- | O(len result). 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. @@ -246,11 +246,11 @@ 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' + loop_intercalate sPEC iO' iY' (Fusion.unpack row') 0# iLenX' -- Keep copying a source element. | otherwise - = do let x = (repack row0 row) `index` (I# iX) + = do let x = (Fusion.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 #-} @@ -265,7 +265,7 @@ {-# INLINE_INNER loop_intercalate_inject #-} let !(I# iLenX0) = A.length row0 - loop_intercalate V.SPEC 0# 0# (unpack row0) 0# iLenX0 + loop_intercalate V.SPEC 0# 0# (Fusion.unpack row0) 0# iLenX0 unsafeFreezeBuffer buf {-# INLINE_ARRAY intercalate #-} diff --git a/Data/Repa/Array/Internals/Operator/Filter.hs b/Data/Repa/Array/Internals/Operator/Filter.hs --- a/Data/Repa/Array/Internals/Operator/Filter.hs +++ b/Data/Repa/Array/Internals/Operator/Filter.hs @@ -2,8 +2,7 @@ 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.Generic.Index as A import Data.Repa.Array.Internals.Target as A import Data.Repa.Array.Internals.Bulk as A import System.IO.Unsafe diff --git a/Data/Repa/Array/Internals/Operator/Fold.hs b/Data/Repa/Array/Internals/Operator/Fold.hs --- a/Data/Repa/Array/Internals/Operator/Fold.hs +++ b/Data/Repa/Array/Internals/Operator/Fold.hs @@ -4,8 +4,8 @@ , foldsWith , C.Folds(..), FoldsDict) where -import Data.Repa.Array.Index as A -import Data.Repa.Array.Tuple as A +import Data.Repa.Array.Generic.Index as A +import Data.Repa.Array.Meta.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 @@ -94,5 +94,5 @@ , Target lGrp n , Target lRes b , Index lGrp ~ Index lRes - , Unpack (IOBuffer lGrp n) tGrp - , Unpack (IOBuffer lRes b) tRes) + , Unpack (Buffer lGrp n) tGrp + , Unpack (Buffer lRes b) tRes) diff --git a/Data/Repa/Array/Internals/Operator/Group.hs b/Data/Repa/Array/Internals/Operator/Group.hs --- a/Data/Repa/Array/Internals/Operator/Group.hs +++ b/Data/Repa/Array/Internals/Operator/Group.hs @@ -4,8 +4,8 @@ , groupsWith , GroupsDict) where -import Data.Repa.Array.Index as A -import Data.Repa.Array.Tuple as A +import Data.Repa.Array.Generic.Index as A +import Data.Repa.Array.Meta.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 @@ -49,7 +49,7 @@ groupsWith :: GroupsDict lElt lGrp tGrp lLen tLen n => Name lGrp -- ^ Layout for group names. - -> Name lLen -- ^ Layour for group lengths. + -> Name lLen -- ^ Layout for group lengths. -> (n -> n -> Bool) -- ^ Comparison function. -> Maybe (n, Int) -- ^ Starting element and count. -> Array lElt n -- ^ Input elements. @@ -75,7 +75,7 @@ , Target lGrp n , Target lLen Int , Index lGrp ~ Index lLen - , Unpack (IOBuffer lLen Int) tLen - , Unpack (IOBuffer lGrp n) tGrp) + , Unpack (Buffer lLen Int) tLen + , Unpack (Buffer lGrp n) tGrp) diff --git a/Data/Repa/Array/Internals/Operator/Insert.hs b/Data/Repa/Array/Internals/Operator/Insert.hs new file mode 100644 --- /dev/null +++ b/Data/Repa/Array/Internals/Operator/Insert.hs @@ -0,0 +1,28 @@ + +module Data.Repa.Array.Internals.Operator.Insert + (insert) +where +import Data.Repa.Array.Generic.Index as A +import Data.Repa.Array.Meta.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.Stream as A +import qualified Data.Repa.Stream as S +#include "repa-array.h" + + +-- | Insert elements produced by the given function in to an array. +insert :: ( BulkI lSrc a, TargetI lDst a + , Unpack (Buffer lDst a) t0) + => Name lDst -- ^ Name of destination layout. + -> (Int -> Maybe a) -- ^ Produce an element for this index. + -> Array lSrc a -- ^ Array of source elements. + -> Array lDst a + +insert nDst fNew aSrc + = A.unstreamToArray nDst + $ S.insertS fNew + $ A.streamOfArray aSrc +{-# INLINE_ARRAY insert #-} + diff --git a/Data/Repa/Array/Internals/Operator/Merge.hs b/Data/Repa/Array/Internals/Operator/Merge.hs new file mode 100644 --- /dev/null +++ b/Data/Repa/Array/Internals/Operator/Merge.hs @@ -0,0 +1,65 @@ + +module Data.Repa.Array.Internals.Operator.Merge + ( merge + , mergeMaybe) +where +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.Stream as S +import Data.Repa.Eval.Stream as A +import Data.Repa.Fusion.Unpack as A +import qualified Data.Vector.Fusion.Stream as S +#include "repa-array.h" + + +-- | Merge two sorted key-value streams. +merge :: ( Ord k + , BulkI l1 (k, a), BulkI l2 (k, b) + , TargetI lDst (k, c) + , Unpack (Buffer lDst (k, c)) t0) + => Name lDst -- ^ Name of destination layout. + -> (k -> a -> b -> c) -- ^ Combine two values with the same key. + -> (k -> a -> c) -- ^ Handle a left value without a right value. + -> (k -> b -> c) -- ^ Handle a right value without a left value. + -> Array l1 (k, a) -- ^ Array of keys and left values. + -> Array l2 (k, b) -- ^ Array of keys and right values. + -> Array lDst (k, c) -- ^ Array of keys and results. + +merge nDst fBoth fLeft fRight arrA arrB + = A.unstreamToArray nDst + $ S.mergeS fBoth fLeft fRight + (A.streamOfArray arrA) + (A.streamOfArray arrB) +{-# INLINE_ARRAY merge #-} + + +-- | Like `merge`, but only produce the elements where the worker functions +-- return `Just`. +mergeMaybe + :: ( Ord k + , BulkI l1 (k, a), BulkI l2 (k, b) + , TargetI lDst (k, c) + , Unpack (Buffer lDst (k, c)) t0) + => Name lDst + -> (k -> a -> b -> Maybe c) -- ^ Combine two values with the same key. + -> (k -> a -> Maybe c) -- ^ Handle a left value without a right value. + -> (k -> b -> Maybe c) -- ^ Handle a right value without a left value. + -> Array l1 (k, a) -- ^ Array of keys and left values. + -> Array l2 (k, b) -- ^ Array of keys and right values. + -> Array lDst (k, c) -- ^ Array of keys and results. + +mergeMaybe nDst fBoth fLeft fRight arrA arrB + = A.unstreamToArray nDst + $ catMaybesS + $ S.map munge_mergeMaybe + $ mergeS fBoth fLeft fRight + (A.streamOfArray arrA) + (A.streamOfArray arrB) + + where munge_mergeMaybe (_k, Nothing) = Nothing + munge_mergeMaybe (k, Just x) = Just (k, x) + {-# INLINE munge_mergeMaybe #-} +{-# INLINE_ARRAY mergeMaybe #-} + + diff --git a/Data/Repa/Array/Internals/Operator/Partition.hs b/Data/Repa/Array/Internals/Operator/Partition.hs --- a/Data/Repa/Array/Internals/Operator/Partition.hs +++ b/Data/Repa/Array/Internals/Operator/Partition.hs @@ -4,9 +4,9 @@ , 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.Meta.Delayed as A +import Data.Repa.Array.Meta.Linear as A +import Data.Repa.Array.Meta.Tuple 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 diff --git a/Data/Repa/Array/Internals/Operator/Reduce.hs b/Data/Repa/Array/Internals/Operator/Reduce.hs --- a/Data/Repa/Array/Internals/Operator/Reduce.hs +++ b/Data/Repa/Array/Internals/Operator/Reduce.hs @@ -1,20 +1,90 @@ module Data.Repa.Array.Internals.Operator.Reduce - (foldl) + ( foldl + + -- | Specialised reductions. + , prod, sum + , mean, std + , correlate) where -import Data.Repa.Array.Index as A +import Data.Repa.Array.Generic.Index as A +import Data.Repa.Array.Meta.Delayed as A +import Data.Repa.Array.Meta.Tuple 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) +import Prelude + as P hiding (foldl, sum) #include "repa-array.h" -- | Left fold of all elements in an array, sequentially. -foldl :: (Bulk l b, Index l ~ Int) +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 #-} +{-# INLINE_ARRAY foldl #-} + + +-- | Yield the sum of the elements of an array. +sum :: (BulkI l a, Num a) => Array l a -> a +sum arr = foldl (+) 0 arr +{-# INLINE sum #-} + + +-- | Yield the product of the elements of an array. +prod :: (BulkI l a, Num a) => Array l a -> a +prod arr = foldl (*) 1 arr +{-# INLINE prod #-} + + +-- | Yield the mean value of the elements of an array. +mean :: (BulkI l a, Fractional a) + => Array l a -> a +mean arr = sum arr / fromIntegral (A.length arr) +{-# INLINE mean #-} + + +-- | Yield the standard deviation of the elements of an array +std :: (BulkI l a, Floating a) + => Array l a -> a +std arr + = let !u = mean arr + in sqrt $ mean $ A.map (\x -> (x - u) ^ (2 :: Int)) arr +{-# INLINE std #-} + + +-- | Compute the Pearson correlation of two arrays. +-- +-- If the arrays differ in length then only the common +-- prefix is correlated. +-- +correlate + :: ( BulkI l1 a, BulkI l2 a + , Floating a) + => Array l1 a + -> Array l2 a + -> a + +correlate arr1 arr2 + = let + (sX, sX2, sY, sY2, sXY) + = foldl (\ ( sXa, sX2a, sYa, sY2a, sXYa) (x, y) + -> ( sXa + x, sX2a + (x * x) + , sYa + y, sY2a + (y * y) + , sXYa + (x * y))) + (0, 0, 0, 0, 0) + $ tup2 arr1 arr2 + + !n = min (A.length arr1) (A.length arr2) + !n' = fromIntegral n + + !corr = (/) ((n' * sXY) - (sX * sY)) + ((*) (sqrt ((n' * sX2) - (sX * sX))) + (sqrt ((n' * sY2) - (sY * sY)))) + + in corr +{-# INLINE correlate #-} + diff --git a/Data/Repa/Array/Internals/Shape.hs b/Data/Repa/Array/Internals/Shape.hs --- a/Data/Repa/Array/Internals/Shape.hs +++ b/Data/Repa/Array/Internals/Shape.hs @@ -70,7 +70,7 @@ rank _ = 1 zeroDim = 0 unitDim = 1 - intersectDim s1 s2 = max s1 s2 + intersectDim s1 s2 = min s1 s2 addDim s1 s2 = s1 + s2 size s = s inShapeRange i1 i2 i = i >= i1 && i <= i2 diff --git a/Data/Repa/Array/Internals/Target.hs b/Data/Repa/Array/Internals/Target.hs --- a/Data/Repa/Array/Internals/Target.hs +++ b/Data/Repa/Array/Internals/Target.hs @@ -1,75 +1,68 @@ module Data.Repa.Array.Internals.Target - ( Target (..), IOBuffer, TargetI + ( Target (..), TargetI , fromList, fromListInto) where -import Data.Repa.Array.Index as A -import Data.Repa.Array.Internals.Bulk as A +import Data.Repa.Array.Generic.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 +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 + data Buffer 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) + unsafeNewBuffer :: l -> IO (Buffer 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 + unsafeReadBuffer :: Buffer l a -> Int -> IO 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 () + unsafeWriteBuffer :: Buffer l a -> Int -> a -> IO () -- | 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) + unsafeGrowBuffer :: Buffer l a -> Int -> IO (Buffer 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) + unsafeSliceBuffer :: Int -> Int -> Buffer l a -> IO (Buffer 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) + unsafeFreezeBuffer :: Buffer l a -> IO (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) + unsafeThawBuffer :: Array l a -> IO (Buffer 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 () + touchBuffer :: Buffer l a -> IO () -- | O(1). Get the layout from a Buffer. - bufferLayout :: Buffer s l a -> l - -type IOBuffer = Buffer RealWorld + bufferLayout :: Buffer l a -> l -- | Constraint synonym that requires an integer index space. type TargetI l a = (Target l a, Index l ~ Int) diff --git a/Data/Repa/Array/Linear.hs b/Data/Repa/Array/Linear.hs deleted file mode 100644 --- a/Data/Repa/Array/Linear.hs +++ /dev/null @@ -1,62 +0,0 @@ -{-# 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 #-} - diff --git a/Data/Repa/Array/Material.hs b/Data/Repa/Array/Material.hs --- a/Data/Repa/Array/Material.hs +++ b/Data/Repa/Array/Material.hs @@ -1,17 +1,28 @@ +-- | Material arrays are represented as concrete data in memory. +-- +-- 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. +-- +-- * `A` -- Type directed automatic layout. +-- +-- * `F` -- Foreign memory buffers. +-- +-- * `N` -- Nested arrays. +-- +-- * `B` -- Boxed vectors, via "Data.Vector.Boxed" +-- +-- * `U` -- Adaptive unboxed vectors, via "Data.Vector.Unboxed" +-- module Data.Repa.Array.Material - ( Name (..) - , Array (..) + ( Material - -- * Boxed arrays - , B (..) - , fromBoxed, toBoxed - , decimate + , Name (..) + , Array (..) - -- * Unboxed arrays - , U (..) - , Unbox - , fromUnboxed, toUnboxed + -- * Auto arrays + , A (..) -- * Foreign arrays , F (..) @@ -19,20 +30,38 @@ , fromByteString, toByteString , fromStorableVector, toStorableVector - -- * Nested arrays , N (..) - - -- ** Conversion , fromLists , fromListss + -- * Boxed arrays + , B (..) + , fromBoxed, toBoxed + + -- * Unboxed arrays + , U (..) + , Unbox + , fromUnboxed, toUnboxed + + -- * Material operators + -- | These operators work on particular material representations, + -- rather than being generic like the ones in "Data.Repa.Array.Generic" + -- ** Mapping , mapElems + -- ** Filtering + , decimate + -- ** Slicing , slices + -- ** Partitioning + , partition + , partitionBy + , partitionByIx + -- ** Concatenation , concats @@ -51,10 +80,26 @@ -- ** Transpose , ragspose3) where +import Data.Repa.Array.Internals.Operator.Partition +import Data.Repa.Array.Material.Auto import Data.Repa.Array.Material.Boxed import Data.Repa.Array.Material.Unboxed import Data.Repa.Array.Material.Foreign import Data.Repa.Array.Material.Nested +import Data.Repa.Array.Meta.Window +import Data.Repa.Array.Internals.Bulk +import Data.Repa.Array.Internals.Target +-- | 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) diff --git a/Data/Repa/Array/Material/Auto.hs b/Data/Repa/Array/Material/Auto.hs new file mode 100644 --- /dev/null +++ b/Data/Repa/Array/Material/Auto.hs @@ -0,0 +1,12 @@ + +module Data.Repa.Array.Material.Auto + ( A (..) + , Name (..) + , Array (..) + , Buffer (..)) +where +import Data.Repa.Array.Material.Auto.Base +import Data.Repa.Array.Material.Auto.InstFloat +import Data.Repa.Array.Material.Auto.InstInt +import Data.Repa.Array.Material.Auto.InstWord +import Data.Repa.Array.Internals.Target diff --git a/Data/Repa/Array/Material/Auto/Base.hs b/Data/Repa/Array/Material/Auto/Base.hs new file mode 100644 --- /dev/null +++ b/Data/Repa/Array/Material/Auto/Base.hs @@ -0,0 +1,483 @@ +{-# LANGUAGE UndecidableInstances, IncoherentInstances #-} +module Data.Repa.Array.Material.Auto.Base + ( A (..) + , Name (..) + , Array (..)) +where +import Data.Repa.Array.Meta.Tuple as A +import Data.Repa.Array.Meta.Window as A +import Data.Repa.Array.Generic.Convert 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.Boxed as A +import Data.Repa.Array.Material.Unboxed as A +import Data.Repa.Array.Material.Foreign as A +import Data.Repa.Array.Material.Nested as A +import Data.Repa.Fusion.Unpack as F +import Data.Repa.Product as B +import Control.Monad +#include "repa-array.h" + +-- | Arrays where the elements that are automatically layed out into some +-- efficient runtime representation. +-- +-- The implementation uses type families to chose unboxed representations +-- for all elements that can be unboxed. In particular: arrays of unboxed +-- tuples are represented as tuples of unboxed arrays, and nested arrays +-- are represented using a segment descriptor and a single single flat +-- vector containing all the elements. +-- +data A = Auto { autoLength :: Int } + deriving (Show, Eq) + + +instance Layout A where + data Name A = A + type Index A = Int + name = A + create A len = Auto len + extent (Auto 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 A) +deriving instance Show (Name A) + + +---------------------------------------------------------------------------------------------- Char +instance Bulk A Char where + data Array A Char = AArray_Char !(Array F Char) + layout (AArray_Char arr) = Auto (A.length arr) + index (AArray_Char arr) ix = A.index arr ix + {-# INLINE_ARRAY layout #-} + {-# INLINE_ARRAY index #-} + + +deriving instance Show (Array A Char) + + +instance A.Convert F Char A Char where + convert arr = AArray_Char arr + + +instance A.Convert A Char F Char where + convert (AArray_Char arr) = arr + + +instance Windowable A Char where + window st len (AArray_Char arr) + = AArray_Char (window st len arr) + {-# INLINE_ARRAY window #-} + + +instance Unpack (Array F Char) t + => Unpack (Array A Char) t where + unpack (AArray_Char arr) = unpack arr + repack (AArray_Char x) arr = AArray_Char (repack x arr) + + +instance Target A Char where + data Buffer A Char + = ABuffer_Char !(Buffer F Char) + + unsafeNewBuffer (Auto len) + = liftM ABuffer_Char $ unsafeNewBuffer (Foreign len) + {-# INLINE_ARRAY unsafeNewBuffer #-} + + unsafeReadBuffer (ABuffer_Char arr) ix + = unsafeReadBuffer arr ix + {-# INLINE_ARRAY unsafeReadBuffer #-} + + unsafeWriteBuffer (ABuffer_Char arr) ix x + = unsafeWriteBuffer arr ix x + {-# INLINE_ARRAY unsafeWriteBuffer #-} + + unsafeGrowBuffer (ABuffer_Char arr) bump + = liftM ABuffer_Char $ unsafeGrowBuffer arr bump + {-# INLINE_ARRAY unsafeGrowBuffer #-} + + unsafeFreezeBuffer (ABuffer_Char arr) + = liftM AArray_Char $ unsafeFreezeBuffer arr + {-# INLINE_ARRAY unsafeFreezeBuffer #-} + + unsafeThawBuffer (AArray_Char arr) + = liftM ABuffer_Char $ unsafeThawBuffer arr + {-# INLINE_ARRAY unsafeThawBuffer #-} + + unsafeSliceBuffer st len (ABuffer_Char buf) + = liftM ABuffer_Char $ unsafeSliceBuffer st len buf + {-# INLINE_ARRAY unsafeSliceBuffer #-} + + touchBuffer (ABuffer_Char buf) + = touchBuffer buf + {-# INLINE_ARRAY touchBuffer #-} + + bufferLayout (ABuffer_Char buf) + = Auto $ A.extent $ bufferLayout buf + {-# INLINE_ARRAY bufferLayout #-} + + +instance (Unpack (Buffer F Char)) t + => (Unpack (Buffer A Char)) t where + unpack (ABuffer_Char buf) = unpack buf + repack (ABuffer_Char x) buf = ABuffer_Char (repack x buf) + {-# INLINE unpack #-} + {-# INLINE repack #-} + + +instance Eq (Array A Char) where + (==) (AArray_Char arr1) (AArray_Char arr2) = arr1 == arr2 + {-# INLINE (==) #-} + + +----------------------------------------------------------------------------------------------- (,) +instance (Bulk A a, Bulk A b) => Bulk A (a, b) where + data Array A (a, b) = AArray_T2 !(Array (T2 A A) (a, b)) + layout (AArray_T2 arr) = Auto (A.length arr) + index (AArray_T2 arr) ix = A.index arr ix + {-# INLINE_ARRAY layout #-} + {-# INLINE_ARRAY index #-} + + +deriving instance (Show (Array (T2 A A) (a, b))) + => Show (Array A (a, b)) + + +instance ( A.Convert A a1 A a2 + , A.Convert A b1 A b2) + => A.Convert (T2 A A) (a1, b1) A (a2, b2) where + convert (T2Array arrA arrB) + = AArray_T2 (T2Array (convert arrA) (convert arrB)) + {-# INLINE convert #-} + + +instance ( A.Convert A a1 A a2 + , A.Convert A b1 A b2) + => A.Convert A (a1, b1) (T2 A A) (a2, b2) where + convert (AArray_T2 (T2Array arrA arrB)) + = T2Array (convert arrA) (convert arrB) + {-# INLINE convert #-} + + +instance (Windowable A a, Windowable A b) + => Windowable A (a, b) where + window st len (AArray_T2 arr) + = AArray_T2 (window st len arr) + {-# INLINE_ARRAY window #-} + + +instance (Target A a, Target A b) + => Target A (a, b) where + data Buffer A (a, b) + = ABuffer_T2 !(Buffer (T2 A A) (a, b)) + + unsafeNewBuffer (Auto len) + = liftM ABuffer_T2 $ unsafeNewBuffer (Tup2 (Auto len) (Auto len)) + {-# INLINE_ARRAY unsafeNewBuffer #-} + + unsafeReadBuffer (ABuffer_T2 arr) ix + = unsafeReadBuffer arr ix + {-# INLINE_ARRAY unsafeReadBuffer #-} + + unsafeWriteBuffer (ABuffer_T2 arr) ix x + = unsafeWriteBuffer arr ix x + {-# INLINE_ARRAY unsafeWriteBuffer #-} + + unsafeGrowBuffer (ABuffer_T2 arr) bump + = liftM ABuffer_T2 $ unsafeGrowBuffer arr bump + {-# INLINE_ARRAY unsafeGrowBuffer #-} + + unsafeFreezeBuffer (ABuffer_T2 arr) + = liftM AArray_T2 $ unsafeFreezeBuffer arr + {-# INLINE_ARRAY unsafeFreezeBuffer #-} + + unsafeThawBuffer (AArray_T2 arr) + = liftM ABuffer_T2 $ unsafeThawBuffer arr + {-# INLINE_ARRAY unsafeThawBuffer #-} + + unsafeSliceBuffer st len (ABuffer_T2 buf) + = liftM ABuffer_T2 $ unsafeSliceBuffer st len buf + {-# INLINE_ARRAY unsafeSliceBuffer #-} + + touchBuffer (ABuffer_T2 buf) + = touchBuffer buf + {-# INLINE_ARRAY touchBuffer #-} + + bufferLayout (ABuffer_T2 buf) + = Auto $ A.extent $ bufferLayout buf + {-# INLINE_ARRAY bufferLayout #-} + + +instance Unpack (Buffer (T2 A A) (a, b)) t + => Unpack (Buffer A (a, b)) t where + unpack (ABuffer_T2 buf) = unpack buf + repack (ABuffer_T2 x) buf = ABuffer_T2 (repack x buf) + {-# INLINE unpack #-} + {-# INLINE repack #-} + + +instance Eq (Array (T2 A A) (a, b)) + => Eq (Array A (a, b)) where + (==) (AArray_T2 arr1) (AArray_T2 arr2) = arr1 == arr2 + {-# INLINE (==) #-} + + +----------------------------------------------------------------------------------------------- :*: +instance (Bulk A a, Bulk A b) => Bulk A (a :*: b) where + data Array A (a :*: b) = AArray_Prod !(Array A a) !(Array A b) + layout (AArray_Prod arrA _ ) = Auto (A.length arrA) + index (AArray_Prod arrA arrB) ix = A.index arrA ix :*: A.index arrB ix + {-# INLINE_ARRAY layout #-} + {-# INLINE_ARRAY index #-} + + +deriving instance (Show (Array A a), Show (Array A b)) + => Show (Array A (a :*: b)) + + +instance (Windowable A a, Windowable A b) + => Windowable A (a :*: b) where + window st len (AArray_Prod arrA arrB) + = AArray_Prod (window st len arrA) (window st len arrB) + {-# INLINE_ARRAY window #-} + + +instance (Target A a, Target A b) + => Target A (a :*: b) where + data Buffer A (a :*: b) + = ABuffer_Prod !(Buffer A a) !(Buffer A b) + + unsafeNewBuffer l + = liftM2 ABuffer_Prod (unsafeNewBuffer l) (unsafeNewBuffer l) + {-# INLINE_ARRAY unsafeNewBuffer #-} + + unsafeReadBuffer (ABuffer_Prod bufA bufB) ix + = do xA <- unsafeReadBuffer bufA ix + xB <- unsafeReadBuffer bufB ix + return (xA :*: xB) + {-# INLINE_ARRAY unsafeReadBuffer #-} + + unsafeWriteBuffer (ABuffer_Prod bufA bufB) ix (xA :*: xB) + = do unsafeWriteBuffer bufA ix xA + unsafeWriteBuffer bufB ix xB + {-# INLINE_ARRAY unsafeWriteBuffer #-} + + unsafeGrowBuffer (ABuffer_Prod bufA bufB) bump + = do bufA' <- unsafeGrowBuffer bufA bump + bufB' <- unsafeGrowBuffer bufB bump + return $ ABuffer_Prod bufA' bufB' + {-# INLINE_ARRAY unsafeGrowBuffer #-} + + unsafeFreezeBuffer (ABuffer_Prod bufA bufB) + = do arrA <- unsafeFreezeBuffer bufA + arrB <- unsafeFreezeBuffer bufB + return $ AArray_Prod arrA arrB + {-# INLINE_ARRAY unsafeFreezeBuffer #-} + + unsafeThawBuffer (AArray_Prod arrA arrB) + = do bufA <- unsafeThawBuffer arrA + bufB <- unsafeThawBuffer arrB + return $ ABuffer_Prod bufA bufB + {-# INLINE_ARRAY unsafeThawBuffer #-} + + unsafeSliceBuffer st len (ABuffer_Prod bufA bufB) + = do bufA' <- unsafeSliceBuffer st len bufA + bufB' <- unsafeSliceBuffer st len bufB + return $ ABuffer_Prod bufA' bufB' + {-# INLINE_ARRAY unsafeSliceBuffer #-} + + touchBuffer (ABuffer_Prod bufA bufB) + = do touchBuffer bufA + touchBuffer bufB + {-# INLINE_ARRAY touchBuffer #-} + + bufferLayout (ABuffer_Prod bufA _) + = bufferLayout bufA + {-# INLINE_ARRAY bufferLayout #-} + + +instance ( Unpack (Buffer A a) tA + , Unpack (Buffer A b) tB) + => Unpack (Buffer A (a :*: b)) (tA, tB) where + unpack (ABuffer_Prod bufA bufB) + = (unpack bufA, unpack bufB) + + repack (ABuffer_Prod xA xB) (bufA, bufB) + = ABuffer_Prod (repack xA bufA) (repack xB bufB) + {-# INLINE unpack #-} + {-# INLINE repack #-} + + +instance (Eq (Array A a), Eq (Array A b)) + => Eq (Array A (a :*: b)) where + (==) (AArray_Prod arrA1 arrA2) (AArray_Prod arrB1 arrB2) + = arrA1 == arrB1 && arrA2 == arrB2 + {-# INLINE (==) #-} + + +----------------------------------------------------------------------------------------------- [] +instance Bulk A a => Bulk A [a] where + data Array A [a] = AArray_List !(Array B [a]) + layout (AArray_List arr) = Auto (A.length arr) + index (AArray_List arr) ix = A.index arr ix + {-# INLINE_ARRAY layout #-} + {-# INLINE_ARRAY index #-} + +deriving instance Show a => Show (Array A [a]) + + +instance Bulk A a => Windowable A [a] where + window st len (AArray_List arr) + = AArray_List (window st len arr) + {-# INLINE_ARRAY window #-} + + +instance Target A [a] where + data Buffer A [a] + = ABuffer_List !(Buffer B [a]) + + unsafeNewBuffer (Auto len) + = liftM ABuffer_List $ unsafeNewBuffer (Boxed len) + {-# INLINE_ARRAY unsafeNewBuffer #-} + + unsafeReadBuffer (ABuffer_List arr) ix + = unsafeReadBuffer arr ix + {-# INLINE_ARRAY unsafeReadBuffer #-} + + unsafeWriteBuffer (ABuffer_List arr) ix x + = unsafeWriteBuffer arr ix x + {-# INLINE_ARRAY unsafeWriteBuffer #-} + + unsafeGrowBuffer (ABuffer_List arr) bump + = liftM ABuffer_List $ unsafeGrowBuffer arr bump + {-# INLINE_ARRAY unsafeGrowBuffer #-} + + unsafeFreezeBuffer (ABuffer_List arr) + = liftM AArray_List $ unsafeFreezeBuffer arr + {-# INLINE_ARRAY unsafeFreezeBuffer #-} + + unsafeThawBuffer (AArray_List arr) + = liftM ABuffer_List $ unsafeThawBuffer arr + {-# INLINE_ARRAY unsafeThawBuffer #-} + + unsafeSliceBuffer st len (ABuffer_List buf) + = liftM ABuffer_List $ unsafeSliceBuffer st len buf + {-# INLINE_ARRAY unsafeSliceBuffer #-} + + touchBuffer (ABuffer_List buf) + = touchBuffer buf + {-# INLINE_ARRAY touchBuffer #-} + + bufferLayout (ABuffer_List buf) + = Auto $ A.extent $ bufferLayout buf + {-# INLINE_ARRAY bufferLayout #-} + + +instance Unpack (Buffer A [a]) (Buffer A [a]) where + unpack buf = buf + repack _ buf = buf + {-# INLINE unpack #-} + {-# INLINE repack #-} + + +instance Eq a + => Eq (Array A [a]) where + (==) (AArray_List arr1) (AArray_List arr2) = arr1 == arr2 + {-# INLINE (==) #-} + + +--------------------------------------------------------------------------------------------- Array +instance (Bulk A a, Windowable r a, Index r ~ Int) + => Bulk A (Array r a) where + data Array A (Array r a) = AArray_Array !(Array N (Array r a)) + layout (AArray_Array arr) = Auto (A.length arr) + index (AArray_Array arr) ix = A.index arr ix + {-# INLINE_ARRAY layout #-} + {-# INLINE_ARRAY index #-} + +deriving instance Show (Array A a) => Show (Array A (Array A a)) + + +instance Convert r1 a1 r2 a2 + => Convert A (Array r1 a1) N (Array r2 a2) where + convert (AArray_Array (NArray starts lens arr)) + = NArray starts lens (convert arr) + {-# INLINE convert #-} + + +instance Convert r1 a1 r2 a2 + => Convert N (Array r1 a1) A (Array r2 a2) where + convert (NArray starts lens arr) + = AArray_Array (NArray starts lens (convert arr)) + {-# INLINE convert #-} + + +instance Convert r1 a1 r2 a2 + => Convert A (Array r1 a1) A (Array r2 a2) where + convert (AArray_Array (NArray starts lens arr)) + = AArray_Array (NArray starts lens (convert arr)) + {-# INLINE convert #-} + + +instance (Bulk l a, Target l a, Index l ~ Int) + => Target A (Array l a) where + data Buffer A (Array l a) + = ABuffer_Array !(Buffer N (Array l a)) + + unsafeNewBuffer (Auto len) + = liftM ABuffer_Array $ unsafeNewBuffer (Nested len) + {-# INLINE_ARRAY unsafeNewBuffer #-} + + unsafeReadBuffer (ABuffer_Array arr) ix + = unsafeReadBuffer arr ix + {-# INLINE_ARRAY unsafeReadBuffer #-} + + unsafeWriteBuffer (ABuffer_Array arr) ix x + = unsafeWriteBuffer arr ix x + {-# INLINE_ARRAY unsafeWriteBuffer #-} + + unsafeGrowBuffer (ABuffer_Array arr) bump + = liftM ABuffer_Array $ unsafeGrowBuffer arr bump + {-# INLINE_ARRAY unsafeGrowBuffer #-} + + unsafeFreezeBuffer (ABuffer_Array arr) + = liftM AArray_Array $ unsafeFreezeBuffer arr + {-# INLINE_ARRAY unsafeFreezeBuffer #-} + + unsafeThawBuffer (AArray_Array arr) + = liftM ABuffer_Array $ unsafeThawBuffer arr + {-# INLINE_ARRAY unsafeThawBuffer #-} + + unsafeSliceBuffer st len (ABuffer_Array buf) + = liftM ABuffer_Array $ unsafeSliceBuffer st len buf + {-# INLINE_ARRAY unsafeSliceBuffer #-} + + touchBuffer (ABuffer_Array buf) + = touchBuffer buf + {-# INLINE_ARRAY touchBuffer #-} + + bufferLayout (ABuffer_Array buf) + = Auto $ A.extent $ bufferLayout buf + {-# INLINE_ARRAY bufferLayout #-} + + +instance Unpack (Buffer N (Array l a)) t + => Unpack (Buffer A (Array l a)) t where + unpack (ABuffer_Array buf) = unpack buf + repack (ABuffer_Array x) buf = ABuffer_Array (repack x buf) + {-# INLINE unpack #-} + {-# INLINE repack #-} + + +instance (Bulk A a, Windowable l a, Index l ~ Int) + => Windowable A (Array l a) where + window st len (AArray_Array arr) + = AArray_Array (window st len arr) + {-# INLINE_ARRAY window #-} + diff --git a/Data/Repa/Array/Material/Auto/InstFloat.hs b/Data/Repa/Array/Material/Auto/InstFloat.hs new file mode 100644 --- /dev/null +++ b/Data/Repa/Array/Material/Auto/InstFloat.hs @@ -0,0 +1,154 @@ +{-# OPTIONS_GHC -fno-warn-orphans #-} +{-# LANGUAGE UndecidableInstances #-} +module Data.Repa.Array.Material.Auto.InstFloat +where +import Data.Repa.Array.Generic.Convert as A +import Data.Repa.Array.Material.Auto.Base as A +import Data.Repa.Array.Material.Boxed as A +import Data.Repa.Array.Material.Foreign as A +import Data.Repa.Array.Meta.Window 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.Fusion.Unpack as F +import Control.Monad +#include "repa-array.h" + +--------------------------------------------------------------------------------------------- Float +instance Bulk A Float where + data Array A Float = AArray_Float !(Array F Float) + layout (AArray_Float arr) = Auto (A.length arr) + index (AArray_Float arr) ix = A.index arr ix + {-# INLINE_ARRAY layout #-} + {-# INLINE_ARRAY index #-} + +deriving instance Show (Array A Float) + +instance Convert F Float A Float where + convert arr = AArray_Float arr + +instance Convert A Float F Float where + convert (AArray_Float arr) = arr + +instance Windowable A Float where + window st len (AArray_Float arr) + = AArray_Float (window st len arr) + {-# INLINE_ARRAY window #-} + +instance Target A Float where + data Buffer A Float + = ABuffer_Float !(Buffer F Float) + + unsafeNewBuffer (Auto len) + = liftM ABuffer_Float $ unsafeNewBuffer (Foreign len) + {-# INLINE_ARRAY unsafeNewBuffer #-} + + unsafeReadBuffer (ABuffer_Float arr) ix + = unsafeReadBuffer arr ix + {-# INLINE_ARRAY unsafeReadBuffer #-} + + unsafeWriteBuffer (ABuffer_Float arr) ix x + = unsafeWriteBuffer arr ix x + {-# INLINE_ARRAY unsafeWriteBuffer #-} + + unsafeGrowBuffer (ABuffer_Float arr) bump + = liftM ABuffer_Float $ unsafeGrowBuffer arr bump + {-# INLINE_ARRAY unsafeGrowBuffer #-} + + unsafeFreezeBuffer (ABuffer_Float arr) + = liftM AArray_Float $ unsafeFreezeBuffer arr + {-# INLINE_ARRAY unsafeFreezeBuffer #-} + + unsafeThawBuffer (AArray_Float arr) + = liftM ABuffer_Float $ unsafeThawBuffer arr + {-# INLINE_ARRAY unsafeThawBuffer #-} + + unsafeSliceBuffer st len (ABuffer_Float buf) + = liftM ABuffer_Float $ unsafeSliceBuffer st len buf + {-# INLINE_ARRAY unsafeSliceBuffer #-} + + touchBuffer (ABuffer_Float buf) + = touchBuffer buf + {-# INLINE_ARRAY touchBuffer #-} + + bufferLayout (ABuffer_Float buf) + = Auto $ A.extent $ bufferLayout buf + {-# INLINE_ARRAY bufferLayout #-} + + +instance (Unpack (Buffer F Float)) t + => (Unpack (Buffer A Float)) t where + unpack (ABuffer_Float buf) = unpack buf + repack (ABuffer_Float x) buf = ABuffer_Float (repack x buf) + {-# INLINE unpack #-} + {-# INLINE repack #-} + + +-------------------------------------------------------------------------------------------- Double +instance Bulk A Double where + data Array A Double = AArray_Double !(Array F Double) + layout (AArray_Double arr) = Auto (A.length arr) + index (AArray_Double arr) ix = A.index arr ix + {-# INLINE_ARRAY layout #-} + {-# INLINE_ARRAY index #-} + +deriving instance Show (Array A Double) + +instance Convert F Double A Double where + convert arr = AArray_Double arr + +instance Convert A Double F Double where + convert (AArray_Double arr) = arr + +instance Windowable A Double where + window st len (AArray_Double arr) + = AArray_Double (window st len arr) + {-# INLINE_ARRAY window #-} + +instance Target A Double where + data Buffer A Double + = ABuffer_Double !(Buffer F Double) + + unsafeNewBuffer (Auto len) + = liftM ABuffer_Double $ unsafeNewBuffer (Foreign len) + {-# INLINE_ARRAY unsafeNewBuffer #-} + + unsafeReadBuffer (ABuffer_Double arr) ix + = unsafeReadBuffer arr ix + {-# INLINE_ARRAY unsafeReadBuffer #-} + + unsafeWriteBuffer (ABuffer_Double arr) ix x + = unsafeWriteBuffer arr ix x + {-# INLINE_ARRAY unsafeWriteBuffer #-} + + unsafeGrowBuffer (ABuffer_Double arr) bump + = liftM ABuffer_Double $ unsafeGrowBuffer arr bump + {-# INLINE_ARRAY unsafeGrowBuffer #-} + + unsafeFreezeBuffer (ABuffer_Double arr) + = liftM AArray_Double $ unsafeFreezeBuffer arr + {-# INLINE_ARRAY unsafeFreezeBuffer #-} + + unsafeThawBuffer (AArray_Double arr) + = liftM ABuffer_Double $ unsafeThawBuffer arr + {-# INLINE_ARRAY unsafeThawBuffer #-} + + unsafeSliceBuffer st len (ABuffer_Double buf) + = liftM ABuffer_Double $ unsafeSliceBuffer st len buf + {-# INLINE_ARRAY unsafeSliceBuffer #-} + + touchBuffer (ABuffer_Double buf) + = touchBuffer buf + {-# INLINE_ARRAY touchBuffer #-} + + bufferLayout (ABuffer_Double buf) + = Auto $ A.extent $ bufferLayout buf + {-# INLINE_ARRAY bufferLayout #-} + + +instance (Unpack (Buffer F Double)) t + => (Unpack (Buffer A Double)) t where + unpack (ABuffer_Double buf) = unpack buf + repack (ABuffer_Double x) buf = ABuffer_Double (repack x buf) + {-# INLINE unpack #-} + {-# INLINE repack #-} diff --git a/Data/Repa/Array/Material/Auto/InstInt.hs b/Data/Repa/Array/Material/Auto/InstInt.hs new file mode 100644 --- /dev/null +++ b/Data/Repa/Array/Material/Auto/InstInt.hs @@ -0,0 +1,367 @@ +{-# OPTIONS_GHC -fno-warn-orphans #-} +{-# LANGUAGE UndecidableInstances #-} +module Data.Repa.Array.Material.Auto.InstInt +where +import Data.Repa.Array.Material.Auto.Base as A +import Data.Repa.Array.Material.Boxed as A +import Data.Repa.Array.Material.Foreign as A +import Data.Repa.Array.Generic.Convert as A +import Data.Repa.Array.Meta.Window 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.Fusion.Unpack as F +import Data.Int +import Control.Monad +#include "repa-array.h" + + +----------------------------------------------------------------------------------------------- Int +instance Bulk A Int where + data Array A Int = AArray_Int !(Array F Int) + layout (AArray_Int arr) = Auto (A.length arr) + index (AArray_Int arr) ix = A.index arr ix + {-# INLINE_ARRAY layout #-} + {-# INLINE_ARRAY index #-} + +deriving instance Show (Array A Int) + +instance Convert F Int A Int where + convert arr = AArray_Int arr + +instance Convert A Int F Int where + convert (AArray_Int arr) = arr + +instance Windowable A Int where + window st len (AArray_Int arr) + = AArray_Int (window st len arr) + {-# INLINE_ARRAY window #-} + +instance Target A Int where + data Buffer A Int + = ABuffer_Int !(Buffer F Int) + + unsafeNewBuffer (Auto len) + = liftM ABuffer_Int $ unsafeNewBuffer (Foreign len) + {-# INLINE_ARRAY unsafeNewBuffer #-} + + unsafeReadBuffer (ABuffer_Int arr) ix + = unsafeReadBuffer arr ix + {-# INLINE_ARRAY unsafeReadBuffer #-} + + unsafeWriteBuffer (ABuffer_Int arr) ix x + = unsafeWriteBuffer arr ix x + {-# INLINE_ARRAY unsafeWriteBuffer #-} + + unsafeGrowBuffer (ABuffer_Int arr) bump + = liftM ABuffer_Int $ unsafeGrowBuffer arr bump + {-# INLINE_ARRAY unsafeGrowBuffer #-} + + unsafeFreezeBuffer (ABuffer_Int arr) + = liftM AArray_Int $ unsafeFreezeBuffer arr + {-# INLINE_ARRAY unsafeFreezeBuffer #-} + + unsafeThawBuffer (AArray_Int arr) + = liftM ABuffer_Int $ unsafeThawBuffer arr + {-# INLINE_ARRAY unsafeThawBuffer #-} + + unsafeSliceBuffer st len (ABuffer_Int buf) + = liftM ABuffer_Int $ unsafeSliceBuffer st len buf + {-# INLINE_ARRAY unsafeSliceBuffer #-} + + touchBuffer (ABuffer_Int buf) + = touchBuffer buf + {-# INLINE_ARRAY touchBuffer #-} + + bufferLayout (ABuffer_Int buf) + = Auto $ A.extent $ bufferLayout buf + {-# INLINE_ARRAY bufferLayout #-} + + +instance (Unpack (Buffer F Int)) t + => (Unpack (Buffer A Int)) t where + unpack (ABuffer_Int buf) = unpack buf + repack (ABuffer_Int x) buf = ABuffer_Int (repack x buf) + {-# INLINE unpack #-} + {-# INLINE repack #-} + + +--------------------------------------------------------------------------------------------- Int8 +instance Bulk A Int8 where + data Array A Int8 = AArray_Int8 !(Array F Int8) + layout (AArray_Int8 arr) = Auto (A.length arr) + index (AArray_Int8 arr) ix = A.index arr ix + {-# INLINE_ARRAY layout #-} + {-# INLINE_ARRAY index #-} + +deriving instance Show (Array A Int8) + +instance Convert F Int8 A Int8 where + convert arr = AArray_Int8 arr + +instance Convert A Int8 F Int8 where + convert (AArray_Int8 arr) = arr + +instance Windowable A Int8 where + window st len (AArray_Int8 arr) + = AArray_Int8 (window st len arr) + {-# INLINE_ARRAY window #-} + +instance Target A Int8 where + data Buffer A Int8 + = ABuffer_Int8 !(Buffer F Int8) + + unsafeNewBuffer (Auto len) + = liftM ABuffer_Int8 $ unsafeNewBuffer (Foreign len) + {-# INLINE_ARRAY unsafeNewBuffer #-} + + unsafeReadBuffer (ABuffer_Int8 arr) ix + = unsafeReadBuffer arr ix + {-# INLINE_ARRAY unsafeReadBuffer #-} + + unsafeWriteBuffer (ABuffer_Int8 arr) ix x + = unsafeWriteBuffer arr ix x + {-# INLINE_ARRAY unsafeWriteBuffer #-} + + unsafeGrowBuffer (ABuffer_Int8 arr) bump + = liftM ABuffer_Int8 $ unsafeGrowBuffer arr bump + {-# INLINE_ARRAY unsafeGrowBuffer #-} + + unsafeFreezeBuffer (ABuffer_Int8 arr) + = liftM AArray_Int8 $ unsafeFreezeBuffer arr + {-# INLINE_ARRAY unsafeFreezeBuffer #-} + + unsafeThawBuffer (AArray_Int8 arr) + = liftM ABuffer_Int8 $ unsafeThawBuffer arr + {-# INLINE_ARRAY unsafeThawBuffer #-} + + unsafeSliceBuffer st len (ABuffer_Int8 buf) + = liftM ABuffer_Int8 $ unsafeSliceBuffer st len buf + {-# INLINE_ARRAY unsafeSliceBuffer #-} + + touchBuffer (ABuffer_Int8 buf) + = touchBuffer buf + {-# INLINE_ARRAY touchBuffer #-} + + bufferLayout (ABuffer_Int8 buf) + = Auto $ A.extent $ bufferLayout buf + {-# INLINE_ARRAY bufferLayout #-} + + +instance (Unpack (Buffer F Int8)) t + => (Unpack (Buffer A Int8)) t where + unpack (ABuffer_Int8 buf) = unpack buf + repack (ABuffer_Int8 x) buf = ABuffer_Int8 (repack x buf) + {-# INLINE unpack #-} + {-# INLINE repack #-} + + +--------------------------------------------------------------------------------------------- Int16 +instance Bulk A Int16 where + data Array A Int16 = AArray_Int16 !(Array F Int16) + layout (AArray_Int16 arr) = Auto (A.length arr) + index (AArray_Int16 arr) ix = A.index arr ix + {-# INLINE_ARRAY layout #-} + {-# INLINE_ARRAY index #-} + +deriving instance Show (Array A Int16) + +instance Convert F Int16 A Int16 where + convert arr = AArray_Int16 arr + +instance Convert A Int16 F Int16 where + convert (AArray_Int16 arr) = arr + +instance Windowable A Int16 where + window st len (AArray_Int16 arr) + = AArray_Int16 (window st len arr) + {-# INLINE_ARRAY window #-} + +instance Target A Int16 where + data Buffer A Int16 + = ABuffer_Int16 !(Buffer F Int16) + + unsafeNewBuffer (Auto len) + = liftM ABuffer_Int16 $ unsafeNewBuffer (Foreign len) + {-# INLINE_ARRAY unsafeNewBuffer #-} + + unsafeReadBuffer (ABuffer_Int16 arr) ix + = unsafeReadBuffer arr ix + {-# INLINE_ARRAY unsafeReadBuffer #-} + + unsafeWriteBuffer (ABuffer_Int16 arr) ix x + = unsafeWriteBuffer arr ix x + {-# INLINE_ARRAY unsafeWriteBuffer #-} + + unsafeGrowBuffer (ABuffer_Int16 arr) bump + = liftM ABuffer_Int16 $ unsafeGrowBuffer arr bump + {-# INLINE_ARRAY unsafeGrowBuffer #-} + + unsafeFreezeBuffer (ABuffer_Int16 arr) + = liftM AArray_Int16 $ unsafeFreezeBuffer arr + {-# INLINE_ARRAY unsafeFreezeBuffer #-} + + unsafeThawBuffer (AArray_Int16 arr) + = liftM ABuffer_Int16 $ unsafeThawBuffer arr + {-# INLINE_ARRAY unsafeThawBuffer #-} + + unsafeSliceBuffer st len (ABuffer_Int16 buf) + = liftM ABuffer_Int16 $ unsafeSliceBuffer st len buf + {-# INLINE_ARRAY unsafeSliceBuffer #-} + + touchBuffer (ABuffer_Int16 buf) + = touchBuffer buf + {-# INLINE_ARRAY touchBuffer #-} + + bufferLayout (ABuffer_Int16 buf) + = Auto $ A.extent $ bufferLayout buf + {-# INLINE_ARRAY bufferLayout #-} + + +instance (Unpack (Buffer F Int16)) t + => (Unpack (Buffer A Int16)) t where + unpack (ABuffer_Int16 buf) = unpack buf + repack (ABuffer_Int16 x) buf = ABuffer_Int16 (repack x buf) + {-# INLINE unpack #-} + {-# INLINE repack #-} + + +--------------------------------------------------------------------------------------------- Int32 +instance Bulk A Int32 where + data Array A Int32 = AArray_Int32 !(Array F Int32) + layout (AArray_Int32 arr) = Auto (A.length arr) + index (AArray_Int32 arr) ix = A.index arr ix + {-# INLINE_ARRAY layout #-} + {-# INLINE_ARRAY index #-} + +deriving instance Show (Array A Int32) + +instance Convert F Int32 A Int32 where + convert arr = AArray_Int32 arr + +instance Convert A Int32 F Int32 where + convert (AArray_Int32 arr) = arr + +instance Windowable A Int32 where + window st len (AArray_Int32 arr) + = AArray_Int32 (window st len arr) + {-# INLINE_ARRAY window #-} + +instance Target A Int32 where + data Buffer A Int32 + = ABuffer_Int32 !(Buffer F Int32) + + unsafeNewBuffer (Auto len) + = liftM ABuffer_Int32 $ unsafeNewBuffer (Foreign len) + {-# INLINE_ARRAY unsafeNewBuffer #-} + + unsafeReadBuffer (ABuffer_Int32 arr) ix + = unsafeReadBuffer arr ix + {-# INLINE_ARRAY unsafeReadBuffer #-} + + unsafeWriteBuffer (ABuffer_Int32 arr) ix x + = unsafeWriteBuffer arr ix x + {-# INLINE_ARRAY unsafeWriteBuffer #-} + + unsafeGrowBuffer (ABuffer_Int32 arr) bump + = liftM ABuffer_Int32 $ unsafeGrowBuffer arr bump + {-# INLINE_ARRAY unsafeGrowBuffer #-} + + unsafeFreezeBuffer (ABuffer_Int32 arr) + = liftM AArray_Int32 $ unsafeFreezeBuffer arr + {-# INLINE_ARRAY unsafeFreezeBuffer #-} + + unsafeThawBuffer (AArray_Int32 arr) + = liftM ABuffer_Int32 $ unsafeThawBuffer arr + {-# INLINE_ARRAY unsafeThawBuffer #-} + + unsafeSliceBuffer st len (ABuffer_Int32 buf) + = liftM ABuffer_Int32 $ unsafeSliceBuffer st len buf + {-# INLINE_ARRAY unsafeSliceBuffer #-} + + touchBuffer (ABuffer_Int32 buf) + = touchBuffer buf + {-# INLINE_ARRAY touchBuffer #-} + + bufferLayout (ABuffer_Int32 buf) + = Auto $ A.extent $ bufferLayout buf + {-# INLINE_ARRAY bufferLayout #-} + + +instance (Unpack (Buffer F Int32)) t + => (Unpack (Buffer A Int32)) t where + unpack (ABuffer_Int32 buf) = unpack buf + repack (ABuffer_Int32 x) buf = ABuffer_Int32 (repack x buf) + {-# INLINE unpack #-} + {-# INLINE repack #-} + + +--------------------------------------------------------------------------------------------- Int64 +instance Bulk A Int64 where + data Array A Int64 = AArray_Int64 !(Array F Int64) + layout (AArray_Int64 arr) = Auto (A.length arr) + index (AArray_Int64 arr) ix = A.index arr ix + {-# INLINE_ARRAY layout #-} + {-# INLINE_ARRAY index #-} + +deriving instance Show (Array A Int64) + +instance Convert F Int64 A Int64 where + convert arr = AArray_Int64 arr + +instance Convert A Int64 F Int64 where + convert (AArray_Int64 arr) = arr + +instance Windowable A Int64 where + window st len (AArray_Int64 arr) + = AArray_Int64 (window st len arr) + {-# INLINE_ARRAY window #-} + +instance Target A Int64 where + data Buffer A Int64 + = ABuffer_Int64 !(Buffer F Int64) + + unsafeNewBuffer (Auto len) + = liftM ABuffer_Int64 $ unsafeNewBuffer (Foreign len) + {-# INLINE_ARRAY unsafeNewBuffer #-} + + unsafeReadBuffer (ABuffer_Int64 arr) ix + = unsafeReadBuffer arr ix + {-# INLINE_ARRAY unsafeReadBuffer #-} + + unsafeWriteBuffer (ABuffer_Int64 arr) ix x + = unsafeWriteBuffer arr ix x + {-# INLINE_ARRAY unsafeWriteBuffer #-} + + unsafeGrowBuffer (ABuffer_Int64 arr) bump + = liftM ABuffer_Int64 $ unsafeGrowBuffer arr bump + {-# INLINE_ARRAY unsafeGrowBuffer #-} + + unsafeFreezeBuffer (ABuffer_Int64 arr) + = liftM AArray_Int64 $ unsafeFreezeBuffer arr + {-# INLINE_ARRAY unsafeFreezeBuffer #-} + + unsafeThawBuffer (AArray_Int64 arr) + = liftM ABuffer_Int64 $ unsafeThawBuffer arr + {-# INLINE_ARRAY unsafeThawBuffer #-} + + unsafeSliceBuffer st len (ABuffer_Int64 buf) + = liftM ABuffer_Int64 $ unsafeSliceBuffer st len buf + {-# INLINE_ARRAY unsafeSliceBuffer #-} + + touchBuffer (ABuffer_Int64 buf) + = touchBuffer buf + {-# INLINE_ARRAY touchBuffer #-} + + bufferLayout (ABuffer_Int64 buf) + = Auto $ A.extent $ bufferLayout buf + {-# INLINE_ARRAY bufferLayout #-} + + +instance (Unpack (Buffer F Int64)) t + => (Unpack (Buffer A Int64)) t where + unpack (ABuffer_Int64 buf) = unpack buf + repack (ABuffer_Int64 x) buf = ABuffer_Int64 (repack x buf) + {-# INLINE unpack #-} + {-# INLINE repack #-} + diff --git a/Data/Repa/Array/Material/Auto/InstWord.hs b/Data/Repa/Array/Material/Auto/InstWord.hs new file mode 100644 --- /dev/null +++ b/Data/Repa/Array/Material/Auto/InstWord.hs @@ -0,0 +1,86 @@ +{-# OPTIONS_GHC -fno-warn-orphans #-} +{-# LANGUAGE UndecidableInstances #-} +module Data.Repa.Array.Material.Auto.InstWord +where +import Data.Repa.Array.Material.Auto.Base as A +import Data.Repa.Array.Material.Boxed as A +import Data.Repa.Array.Material.Foreign as A +import Data.Repa.Array.Generic.Convert as A +import Data.Repa.Array.Meta.Window 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.Fusion.Unpack as F +import Data.Word +import Control.Monad +#include "repa-array.h" + + +--------------------------------------------------------------------------------------------- Word8 +instance Bulk A Word8 where + data Array A Word8 = AArray_Word8 !(Array F Word8) + layout (AArray_Word8 arr) = Auto (A.length arr) + index (AArray_Word8 arr) ix = A.index arr ix + {-# INLINE_ARRAY layout #-} + {-# INLINE_ARRAY index #-} + +deriving instance Show (Array A Word8) + +instance Convert F Word8 A Word8 where + convert arr = AArray_Word8 arr + +instance Convert A Word8 F Word8 where + convert (AArray_Word8 arr) = arr + +instance Windowable A Word8 where + window st len (AArray_Word8 arr) + = AArray_Word8 (window st len arr) + {-# INLINE_ARRAY window #-} + +instance Target A Word8 where + data Buffer A Word8 + = ABuffer_Word8 !(Buffer F Word8) + + unsafeNewBuffer (Auto len) + = liftM ABuffer_Word8 $ unsafeNewBuffer (Foreign len) + {-# INLINE_ARRAY unsafeNewBuffer #-} + + unsafeReadBuffer (ABuffer_Word8 arr) ix + = unsafeReadBuffer arr ix + {-# INLINE_ARRAY unsafeReadBuffer #-} + + unsafeWriteBuffer (ABuffer_Word8 arr) ix x + = unsafeWriteBuffer arr ix x + {-# INLINE_ARRAY unsafeWriteBuffer #-} + + unsafeGrowBuffer (ABuffer_Word8 arr) bump + = liftM ABuffer_Word8 $ unsafeGrowBuffer arr bump + {-# INLINE_ARRAY unsafeGrowBuffer #-} + + unsafeFreezeBuffer (ABuffer_Word8 arr) + = liftM AArray_Word8 $ unsafeFreezeBuffer arr + {-# INLINE_ARRAY unsafeFreezeBuffer #-} + + unsafeThawBuffer (AArray_Word8 arr) + = liftM ABuffer_Word8 $ unsafeThawBuffer arr + {-# INLINE_ARRAY unsafeThawBuffer #-} + + unsafeSliceBuffer st len (ABuffer_Word8 buf) + = liftM ABuffer_Word8 $ unsafeSliceBuffer st len buf + {-# INLINE_ARRAY unsafeSliceBuffer #-} + + touchBuffer (ABuffer_Word8 buf) + = touchBuffer buf + {-# INLINE_ARRAY touchBuffer #-} + + bufferLayout (ABuffer_Word8 buf) + = Auto $ A.extent $ bufferLayout buf + {-# INLINE_ARRAY bufferLayout #-} + + +instance (Unpack (Buffer F Word8)) t + => (Unpack (Buffer A Word8)) t where + unpack (ABuffer_Word8 buf) = unpack buf + repack (ABuffer_Word8 x) buf = ABuffer_Word8 (repack x buf) + {-# INLINE unpack #-} + {-# INLINE repack #-} diff --git a/Data/Repa/Array/Material/Boxed.hs b/Data/Repa/Array/Material/Boxed.hs --- a/Data/Repa/Array/Material/Boxed.hs +++ b/Data/Repa/Array/Material/Boxed.hs @@ -11,8 +11,8 @@ -- * Utils , decimate) where -import Data.Repa.Array.Window as A -import Data.Repa.Array.Index as A +import Data.Repa.Array.Meta.Window as A +import Data.Repa.Array.Generic.Index as A import Data.Repa.Array.Internals.Bulk as A import Data.Repa.Array.Internals.Target as A import Data.Repa.Fusion.Unpack @@ -63,6 +63,11 @@ deriving instance Show a => Show (Array B a) +instance Eq a => Eq (Array B a) where + (==) (BArray arr1) (BArray arr2) = arr1 == arr2 + {-# INLINE_ARRAY (==) #-} + + ------------------------------------------------------------------------------- -- | Boxed windows. instance Windowable B a where @@ -74,8 +79,8 @@ ------------------------------------------------------------------------------- -- | Boxed buffers. instance Target B a where - data Buffer s B a - = BBuffer !(VM.MVector s a) + data Buffer B a + = BBuffer !(VM.IOVector a) unsafeNewBuffer (Boxed len) = liftM BBuffer (VM.unsafeNew len) @@ -123,7 +128,7 @@ {-# SPECIALIZE instance Target B Word64 #-} -instance Unpack (Buffer s B a) (VM.MVector s a) where +instance Unpack (Buffer B a) (VM.IOVector a) where unpack (BBuffer vec) = vec repack _ vec = BBuffer vec {-# INLINE_ARRAY unpack #-} diff --git a/Data/Repa/Array/Material/Foreign.hs b/Data/Repa/Array/Material/Foreign.hs --- a/Data/Repa/Array/Material/Foreign.hs +++ b/Data/Repa/Array/Material/Foreign.hs @@ -1,176 +1,14 @@ -{-# LANGUAGE ViewPatterns #-} + module Data.Repa.Array.Material.Foreign - ( F (..) - , Name (..) - , Array (..) - , Buffer (..) + ( F (..) + , Name (..) + , Array (..) + , Buffer (..) - -- * Conversions - , fromForeignPtr, toForeignPtr - , fromStorableVector, toStorableVector - , fromByteString, toByteString) + -- * Format conversion + , unsafeCast + , 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 (==) #-} - +import Data.Repa.Array.Material.Foreign.Base diff --git a/Data/Repa/Array/Material/Foreign/Base.hs b/Data/Repa/Array/Material/Foreign/Base.hs new file mode 100644 --- /dev/null +++ b/Data/Repa/Array/Material/Foreign/Base.hs @@ -0,0 +1,192 @@ + +module Data.Repa.Array.Material.Foreign.Base + ( F (..) + , Name (..) + , Array (..) + , Buffer (..) + + -- * Conversions + , unsafeCast + , fromForeignPtr, toForeignPtr + , fromStorableVector, toStorableVector + , fromByteString, toByteString) +where +import Data.Repa.Array.Meta.Delayed as A +import Data.Repa.Array.Meta.Window as A +import Data.Repa.Array.Generic.Index as A +import Data.Repa.Array.Internals.Target as A +import Data.Repa.Array.Internals.Bulk as A + +import Data.Repa.Fusion.Unpack + +import Foreign.ForeignPtr +import Foreign.Storable + +import Control.Monad +import Control.Monad.Primitive +import Data.Word + +import Data.ByteString (ByteString) +import qualified Data.ByteString.Internal as BS +import qualified Data.Vector.Storable as S +import qualified Data.Vector.Storable.Mutable as M +#include "repa-array.h" + + +-- | Layout for dense 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 F a = FBuffer !(M.IOVector 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 F a) (M.IOVector a) where + unpack (FBuffer mv) = mv + repack _ mv = FBuffer mv + {-# INLINE_ARRAY unpack #-} + {-# INLINE_ARRAY repack #-} + + +------------------------------------------------------------------------------- +-- | O(1). Cast a foreign array from one element type to another. +unsafeCast + :: (Storable a, Storable b) + => Array F a -> Array F b +unsafeCast (FArray vec) + = FArray $ S.unsafeCast vec +{-# INLINE_ARRAY unsafeCast #-} + + +-- | 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 #-} + + +-- | O(1). Unwrap a `ForeignPtr` from an array. +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 (==) #-} + + diff --git a/Data/Repa/Array/Material/Nested.hs b/Data/Repa/Array/Material/Nested.hs --- a/Data/Repa/Array/Material/Nested.hs +++ b/Data/Repa/Array/Material/Nested.hs @@ -33,24 +33,32 @@ -- * Transpose , ragspose3) where -import Data.Repa.Array.Delayed -import Data.Repa.Array.Window -import Data.Repa.Array.Index +import Data.Repa.Array.Meta.Delayed as A +import Data.Repa.Array.Meta.Window as A +import Data.Repa.Array.Generic.Index as A import Data.Repa.Array.Material.Unboxed as A +import Data.Repa.Array.Material.Foreign.Base 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.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 qualified Data.Vector.Unboxed as U +import qualified Data.Vector.Fusion.Stream as S +import qualified Data.Vector.Mutable as VM +import qualified Data.Vector as VV import Control.Monad.ST +import Control.Monad +import Control.Monad.Primitive +import GHC.Exts hiding (fromList) import Prelude as P import Prelude hiding (concat) #include "repa-array.h" +-------------------------------------------------------------------------------------------- Layout -- | 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 @@ -73,7 +81,6 @@ deriving instance Show N -------------------------------------------------------------------------------- -- | Nested arrays. instance Layout N where data Name N = N @@ -92,15 +99,17 @@ deriving instance Show (Name N) -------------------------------------------------------------------------------- +---------------------------------------------------------------------------------------------- Bulk -- | 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 + = NArray + { nArrayStarts :: !(U.Vector Int) -- ^ Segment start positions. + , nArrayLengths :: !(U.Vector Int) -- ^ Segment lengths. + , nArrayElems :: !(Array l a) -- ^ Element values. + } layout (NArray starts _lengths _elems) = Nested (U.length starts) @@ -113,10 +122,118 @@ {-# INLINE_ARRAY index #-} -deriving instance Show (Array l a) => Show (Array N (Array l a)) +deriving instance Show (Array l a) + => Show (Array N (Array l a)) -------------------------------------------------------------------------------- +-------------------------------------------------------------------------------------------- Target +-- Nested arrays cannot be constructed directly when the array elements +-- are supplied in random order, as we don't know where each array should +-- be placed in the underlying vector of elements. +-- +-- We handle this problem by recording all the elements in a boxed vector +-- as they are provided, then concatenating them down to the usual nested +-- array representation on freezing. +-- +instance (Bulk l a, Target l a, Index l ~ Int) + => Target N (Array l a) where + + data Buffer N (Array l a) + = NBuffer !(VM.IOVector (Array l a)) + + unsafeNewBuffer (Nested n) + = NBuffer `liftM` VM.unsafeNew n + {-# INLINE_ARRAY unsafeNewBuffer #-} + + unsafeReadBuffer (NBuffer mv) i + = VM.unsafeRead mv i + {-# INLINE_ARRAY unsafeReadBuffer #-} + + -- IMPORTANT: the write functinon is strict in the element value so that + -- we don't write lazy thunks into the buffer. When the buffer is frozen + -- we'll demanand all the elements anyway, so we want the producer thread + -- to be responsible for evaluating them. + unsafeWriteBuffer (NBuffer mv) i !x + = VM.unsafeWrite mv i x + {-# INLINE_ARRAY unsafeWriteBuffer #-} + + unsafeGrowBuffer (NBuffer mv) x + = NBuffer `liftM` VM.unsafeGrow mv x + {-# INLINE_ARRAY unsafeGrowBuffer #-} + + unsafeSliceBuffer i n (NBuffer mv) + = return $ NBuffer (VM.unsafeSlice i n mv) + {-# INLINE_ARRAY unsafeSliceBuffer #-} + + touchBuffer _ + = return () + {-# INLINE_ARRAY touchBuffer #-} + + bufferLayout (NBuffer mv) + = Nested $ VM.length mv + {-# INLINE_ARRAY bufferLayout #-} + + unsafeFreezeBuffer (NBuffer mvec) + = do + -- Freeze the mutable vector so we can use the usual boxed vector API. + !(vec :: VV.Vector (Array l a)) <- VV.unsafeFreeze mvec + + -- Scan through all the boxed array elements to produce the + -- lengths vector. + let !(lengths :: U.Vector Int) = U.convert $ VV.map A.length vec + let !(starts :: U.Vector Int) = U.unsafeInit $ U.scanl (+) 0 lengths + let !(I# lenElems) = U.sum lengths + let !(I# lenArrs) = VV.length vec + + !bufElems <- unsafeNewBuffer (create name (I# lenElems)) + + -- Concatenate all the elements from the source arrays + -- into a single, flat elements buffer. + let loop_freeze !iDst !iSrcArr + -- We've finished copying all the arrays + | I# iSrcArr >= I# lenArrs + = return () + + | otherwise + = do let !arrSrc = VV.unsafeIndex vec (I# iSrcArr) + let !(I# lenSrc) = A.length arrSrc + + let loop_freeze_copy iDst' iSrc' + | I# iSrc' >= I# lenSrc + = loop_freeze iDst' (iSrcArr +# 1#) + + | otherwise + = do let !x = A.index arrSrc (I# iSrc') + unsafeWriteBuffer bufElems (I# iDst') x + loop_freeze_copy (iDst' +# 1#) (iSrc' +# 1#) + {-# INLINE loop_freeze_copy #-} + + loop_freeze_copy iDst 0# + + {-# INLINE_INNER loop_freeze #-} + + -- If there are no inner arrays then we can't take the length + -- of the first one. + loop_freeze 0# 0# + + !arrElems <- unsafeFreezeBuffer bufElems + return $ NArray starts lengths arrElems + {-# INLINE_ARRAY unsafeFreezeBuffer #-} + +-- unsafeThawBuffer (NArray v) +-- = FBuffer `liftM` S.unsafeThaw v +-- {-# INLINE unsafeThawBuffer #-} + + +instance Unpack (Buffer N (Array l a)) + (VM.IOVector (Array l a)) where + unpack (NBuffer mv) = mv + repack _ mv = NBuffer mv + {-# INLINE_ARRAY unpack #-} + {-# INLINE_ARRAY repack #-} + + +---------------------------------------------------------------------------------------- Windowable -- | Windowing Nested arrays. instance (BulkI l a, Windowable l a) => Windowable N (Array l a) where @@ -127,7 +244,7 @@ {-# INLINE_ARRAY window #-} -------------------------------------------------------------------------------- +--------------------------------------------------------------------------------------------------- -- | O(size src) Convert some lists to a nested array. fromLists :: TargetI l a @@ -162,7 +279,7 @@ {-# 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) @@ -174,23 +291,25 @@ {-# 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. +slices :: Array F Int -- ^ Segment starting positions. + -> Array F Int -- ^ Segment lengths. -> Array l a -- ^ Array elements. -> Array N (Array l a) -slices (UArray starts) (UArray lens) !elems - = NArray starts lens elems +slices (FArray starts) (FArray lens) !elems + = NArray (VV.convert starts) + (VV.convert lens) + elems {-# INLINE_ARRAY slices #-} -------------------------------------------------------------------------------- +--------------------------------------------------------------------------------------------------- -- | Segmented concatenation. -- Concatenate triply nested vector, producing a doubly nested vector. -- @@ -219,13 +338,13 @@ {-# 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. + => (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 @@ -250,8 +369,8 @@ -- segmentOn :: (BulkI l a, Eq a, U.Unbox a) - => (a -> Bool) -- ^ Detect the end of a segment. - -> Array l a -- ^ Vector to segment. + => (a -> Bool) -- ^ Detect the end of a segment. + -> Array l a -- ^ Vector to segment. -> Array N (Array l a) segmentOn !pEnd !arr @@ -259,14 +378,14 @@ {-# 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. + => (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 @@ -319,8 +438,8 @@ {-# INLINE_ARRAY diceSep #-} -------------------------------------------------------------------------------- --- | For each segment of a nested vector, trim elements off the start +--------------------------------------------------------------------------------------------------- +-- | For each segment of a nested array, trim elements off the start -- and end of the segment that match the given predicate. trims :: BulkI l a => (a -> Bool) @@ -350,7 +469,7 @@ {-# INLINE_ARRAY trims #-} --- | For each segment of a nested vector, trim elements off the end of +-- | For each segment of a nested array, trim elements off the end of -- the segment that match the given predicate. trimEnds :: BulkI l a => (a -> Bool) @@ -372,7 +491,7 @@ {-# INLINE_ARRAY trimEnds #-} --- | For each segment of a nested vector, trim elements off the start of +-- | For each segment of a nested array, trim elements off the start of -- the segment that match the given predicate. trimStarts :: BulkI l a => (a -> Bool) @@ -389,13 +508,13 @@ {-# INLINE_INNER loop_trimStarts #-} (starts', lengths') - = U.unzip $ U.zipWith 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 diff --git a/Data/Repa/Array/Material/Strided.hs b/Data/Repa/Array/Material/Strided.hs new file mode 100644 --- /dev/null +++ b/Data/Repa/Array/Material/Strided.hs @@ -0,0 +1,138 @@ + +module Data.Repa.Array.Material.Strided + ( S (..) + , Name (..) + , Array (..) + + -- * Conversions + , unsafeCast + , fromForeignPtr, toForeignPtr) +where +import Data.Repa.Array.Meta.Window +import Data.Repa.Array.Internals.Bulk +import Data.Repa.Array.Internals.Layout +import Data.Repa.Fusion.Unpack +import Data.Word +import qualified Foreign.Storable as S +import qualified Foreign.ForeignPtr as F +import qualified Data.ByteString.Internal as BS +#include "repa-array.h" + + +-- | Layout for Foreign Strided arrays. +-- +-- UNSAFE: indexing into foreign strided arrays is not bounds checked. +-- You may want to wrap this with a Checked layout as well. +-- +data S = Strided + { stridedLength :: !Int } + deriving (Show, Eq) + + +------------------------------------------------------------------------------- +instance Layout S where + data Name S = S + type Index S = Int + + name = S + create S len = Strided len + extent (Strided 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 S) +deriving instance Show (Name S) + + +------------------------------------------------------------------------------- +instance S.Storable a => Bulk S a where + data Array S a + = SArray + { sArrayStartBytes :: !Int + , sArrayStrideBytes :: !Int + , sArrayLenElems :: !Int + , sArrayPtr :: !(F.ForeignPtr a) } + + layout (SArray _ _ len _) + = Strided len + + index (SArray start stride len fptr) ix + = BS.inlinePerformIO + $ F.withForeignPtr fptr + $ \ptr -> S.peekByteOff ptr + (start + (toIndex (Strided len) ix) * stride) + {-# INLINE_ARRAY layout #-} + {-# INLINE_ARRAY index #-} + {-# SPECIALIZE instance Bulk S Char #-} + {-# SPECIALIZE instance Bulk S Int #-} + {-# SPECIALIZE instance Bulk S Float #-} + {-# SPECIALIZE instance Bulk S Double #-} + {-# SPECIALIZE instance Bulk S Word8 #-} + {-# SPECIALIZE instance Bulk S Word16 #-} + {-# SPECIALIZE instance Bulk S Word32 #-} + {-# SPECIALIZE instance Bulk S Word64 #-} + + +deriving instance (S.Storable a, Show a) => Show (Array S a) + + +instance Unpack (Array S a) (Int, Int, Int, F.ForeignPtr a) where + unpack (SArray start stride len fptr) = (start, stride, len, fptr) + repack _ (start, stride, len, fptr) = (SArray start stride len fptr) + {-# INLINE unpack #-} + {-# INLINE repack #-} + + +------------------------------------------------------------------------------- +instance S.Storable a => Windowable S a where + window startElems' lenElems' + (SArray startBytes strideBytes _lenElems fptr) + = let lenElem = S.sizeOf (undefined :: a) + in SArray (startBytes + (lenElem * startElems')) + strideBytes lenElems' fptr + {-# INLINE_ARRAY window #-} + {-# SPECIALIZE instance Windowable S Char #-} + {-# SPECIALIZE instance Windowable S Int #-} + {-# SPECIALIZE instance Windowable S Float #-} + {-# SPECIALIZE instance Windowable S Double #-} + {-# SPECIALIZE instance Windowable S Word8 #-} + {-# SPECIALIZE instance Windowable S Word16 #-} + {-# SPECIALIZE instance Windowable S Word32 #-} + {-# SPECIALIZE instance Windowable S Word64 #-} + + +------------------------------------------------------------------------------- +-- | O(1). Cast a foreign array from one element type to another. +unsafeCast + :: (S.Storable a, S.Storable b) + => Array S a -> Array S b +unsafeCast (SArray startBytes strideBytes lenElems fptr) + = (SArray startBytes strideBytes lenElems $ F.castForeignPtr fptr) + + +-- | O(1). Wrap a `ForeignPtr` as a strided array. +fromForeignPtr + :: Int -- ^ Starting position in bytes. + -> Int -- ^ Stride to get to next element, in bytes. + -> Int -- ^ Length of array in elements. + -> F.ForeignPtr a -- ^ `ForeignPtr` holding the data. + -> Array S a + +fromForeignPtr startBytes strideBytes lenElems fptr + = SArray startBytes strideBytes lenElems fptr +{-# INLINE_ARRAY fromForeignPtr #-} + + +-- | O(1). Unwrap a `ForeignPtr` from a strided array. +toForeignPtr + :: Array S a + -> (Int, Int, Int, F.ForeignPtr a) +toForeignPtr (SArray startBytes strideBytes lenElems fptr) + = (startBytes, strideBytes, lenElems, fptr) +{-# INLINE_ARRAY toForeignPtr #-} + diff --git a/Data/Repa/Array/Material/Unboxed.hs b/Data/Repa/Array/Material/Unboxed.hs --- a/Data/Repa/Array/Material/Unboxed.hs +++ b/Data/Repa/Array/Material/Unboxed.hs @@ -8,12 +8,13 @@ -- * 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.Array.Meta.Window as A +import Data.Repa.Array.Meta.Delayed as A +import Data.Repa.Array.Generic.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 Control.Monad import Data.Word @@ -36,7 +37,8 @@ data U = Unboxed { unboxedLength :: !Int } deriving (Show, Eq) -------------------------------------------------------------------------------- + +--------------------------------------------------------------------------------------------------- -- | Unboxed arrays. instance Layout U where data Name U = U @@ -56,7 +58,7 @@ deriving instance Show (Name U) -------------------------------------------------------------------------------- +--------------------------------------------------------------------------------------------------- -- | Unboxed arrays. instance U.Unbox a => Bulk U a where data Array U a = UArray !(U.Vector a) @@ -78,6 +80,11 @@ deriving instance (Show a, U.Unbox a) => Show (Array U a) +instance (UM.Unbox a, Eq a) => Eq (Array U a) where + (==) (UArray arr1) (UArray arr2) = arr1 == arr2 + {-# INLINE_ARRAY (==) #-} + + instance Unpack (Array U a) (U.Vector a) where unpack (UArray vec) = vec repack !_ !vec = UArray vec @@ -85,7 +92,7 @@ {-# INLINE_ARRAY repack #-} -------------------------------------------------------------------------------- +--------------------------------------------------------------------------------------------------- -- | Windowing Unboxed arrays. instance U.Unbox a => Windowable U a where window st len (UArray vec) @@ -100,11 +107,11 @@ {-# 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) + data Buffer U a + = UBuffer !(UM.IOVector a) unsafeNewBuffer (Unboxed len) = liftM UBuffer (UM.unsafeNew len) @@ -153,14 +160,14 @@ {-# SPECIALIZE instance Target U Word64 #-} -instance Unpack (Buffer s U a) (UM.MVector s a) where +instance Unpack (Buffer U a) (UM.IOVector 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 diff --git a/Data/Repa/Array/Meta.hs b/Data/Repa/Array/Meta.hs new file mode 100644 --- /dev/null +++ b/Data/Repa/Array/Meta.hs @@ -0,0 +1,141 @@ + +-- | Meta arrays either generate elements on the fly, +-- or wrap an inner array to provide an extra features. +-- +-- === 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. +-- +-- === Combining layouts +-- +-- Combining 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). +-- +module Data.Repa.Array.Meta + ( -- * Delayed arrays + D(..) + , fromFunction + , toFunction + , delay + , map + + , D2(..) + , delay2 + , map2 + + -- * Linear spaces + , L(..) + , linear + + -- * RowWise spaces + , RW(..) + , rowWise + + -- * Windowed arrays + , W(..) + , Windowable (..) + , windowed + , entire + , tail, init + + -- * Dense arrays + , E (..) + , vector + , matrix + , cube + + -- * Tupled arrays + , T2(..) + , tup2 + , untup2) +where +import Data.Repa.Array.Meta.Delayed +import Data.Repa.Array.Meta.Delayed2 +import Data.Repa.Array.Meta.Dense +import Data.Repa.Array.Meta.Linear +import Data.Repa.Array.Meta.RowWise +import Data.Repa.Array.Meta.Tuple +import Data.Repa.Array.Meta.Window + +import Prelude + hiding (map, tail, init) + diff --git a/Data/Repa/Array/Meta/Delayed.hs b/Data/Repa/Array/Meta/Delayed.hs new file mode 100644 --- /dev/null +++ b/Data/Repa/Array/Meta/Delayed.hs @@ -0,0 +1,151 @@ +{-# LANGUAGE UndecidableInstances #-} +module Data.Repa.Array.Meta.Delayed + ( D(..), Array(..) + , fromFunction, toFunction + , delay + , map + , reverse) +where +import Data.Repa.Array.Generic.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, reverse) +#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 #-} + + +-- | 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 #-} diff --git a/Data/Repa/Array/Meta/Delayed2.hs b/Data/Repa/Array/Meta/Delayed2.hs new file mode 100644 --- /dev/null +++ b/Data/Repa/Array/Meta/Delayed2.hs @@ -0,0 +1,129 @@ +{-# LANGUAGE UndecidableInstances #-} +module Data.Repa.Array.Meta.Delayed2 + ( D2(..), Array(..) + , delay2 + , map2) +where +import Data.Repa.Array.Generic.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 #-} + + diff --git a/Data/Repa/Array/Meta/Dense.hs b/Data/Repa/Array/Meta/Dense.hs new file mode 100644 --- /dev/null +++ b/Data/Repa/Array/Meta/Dense.hs @@ -0,0 +1,165 @@ +{-# LANGUAGE UndecidableInstances #-} +module Data.Repa.Array.Meta.Dense + ( E (..) + , Name (..) + , Array (..) + , Buffer (..) + + -- * Common layouts + , vector + , matrix + , cube) +where +import Data.Repa.Array.Meta.RowWise +import Data.Repa.Array.Generic.Index +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 (E r l) a + = EBuffer !l !(Buffer 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 r a) tBuf + => Unpack (Buffer (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) + diff --git a/Data/Repa/Array/Meta/Linear.hs b/Data/Repa/Array/Meta/Linear.hs new file mode 100644 --- /dev/null +++ b/Data/Repa/Array/Meta/Linear.hs @@ -0,0 +1,62 @@ +{-# LANGUAGE UndecidableInstances #-} +module Data.Repa.Array.Meta.Linear + ( L(..) + , Name (..) + , Array (..) + , linear) +where +import Data.Repa.Array.Generic.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 #-} + diff --git a/Data/Repa/Array/Meta/RowWise.hs b/Data/Repa/Array/Meta/RowWise.hs new file mode 100644 --- /dev/null +++ b/Data/Repa/Array/Meta/RowWise.hs @@ -0,0 +1,189 @@ + +module Data.Repa.Array.Meta.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 #-} + diff --git a/Data/Repa/Array/Meta/Tuple.hs b/Data/Repa/Array/Meta/Tuple.hs new file mode 100644 --- /dev/null +++ b/Data/Repa/Array/Meta/Tuple.hs @@ -0,0 +1,182 @@ +{-# LANGUAGE UndecidableInstances #-} +module Data.Repa.Array.Meta.Tuple + ( T2 (..) + , Name (..) + , Array (..) + , Buffer (..) + , tup2, untup2) +where +import Data.Repa.Array.Meta.Window +import Data.Repa.Array.Generic.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 (T2 l1 l2) (a, b) + = T2Buffer !(Buffer l1 a) !(Buffer 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 r1 a) t1, Unpack (Buffer r2 b) t2) + => Unpack (Buffer (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 #-} + + diff --git a/Data/Repa/Array/Meta/Window.hs b/Data/Repa/Array/Meta/Window.hs new file mode 100644 --- /dev/null +++ b/Data/Repa/Array/Meta/Window.hs @@ -0,0 +1,117 @@ +{-# LANGUAGE UndecidableInstances #-} +module Data.Repa.Array.Meta.Window + ( W (..) + , Array (..) + , Windowable (..) + , windowed + , entire + , tail + , init) +where +import Data.Repa.Array.Generic.Index +import Data.Repa.Array.Internals.Bulk +import Prelude hiding (length, tail, init) +#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 #-} + + +------------------------------------------------------------------------------- +-- | O(1). Take the tail of an array, or `Nothing` if it's empty. +tail :: (Windowable l a, Index l ~ Int) + => Array l a -> Maybe (Array l a) +tail arr + | length arr == 0 = Nothing + | otherwise = Just $! window 1 (length arr - 1) arr +{-# INLINE tail #-} + + +-- | O(1). Take the initial elements of an array, or `Nothing` if it's empty. +init :: (Windowable l a, Index l ~ Int) + => Array l a -> Maybe (Array l a) +init arr + | length arr == 0 = Nothing + | otherwise = Just $! window 0 (length arr - 1) arr +{-# INLINE init #-} + diff --git a/Data/Repa/Array/RowWise.hs b/Data/Repa/Array/RowWise.hs deleted file mode 100644 --- a/Data/Repa/Array/RowWise.hs +++ /dev/null @@ -1,189 +0,0 @@ - -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 #-} - diff --git a/Data/Repa/Array/Tuple.hs b/Data/Repa/Array/Tuple.hs deleted file mode 100644 --- a/Data/Repa/Array/Tuple.hs +++ /dev/null @@ -1,182 +0,0 @@ -{-# 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 #-} - - diff --git a/Data/Repa/Array/Window.hs b/Data/Repa/Array/Window.hs deleted file mode 100644 --- a/Data/Repa/Array/Window.hs +++ /dev/null @@ -1,96 +0,0 @@ -{-# 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 #-} - - diff --git a/Data/Repa/Bits/Date32.hs b/Data/Repa/Bits/Date32.hs --- a/Data/Repa/Bits/Date32.hs +++ b/Data/Repa/Bits/Date32.hs @@ -1,21 +1,31 @@ - +{-# LANGUAGE UndecidableInstances #-} module Data.Repa.Bits.Date32 ( Date32 , pack, unpack , next , range - , readYYYYsMMsDD) + , pretty + , readYYYYsMMsDD + , readDDsMMsYYYY) 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.Repa.Array +import Data.Repa.Array.Auto.Convert +import qualified Data.Repa.Array.Generic.Target as A +import qualified Data.Repa.Array.Generic.Index as A +import qualified Data.Repa.Array.Material.Auto as A +import qualified Data.Repa.Array.Material.Foreign as A +import qualified Data.Repa.Array.Generic as A +import qualified Data.Repa.Array.Meta.Window as A +import qualified Data.Repa.Fusion.Unpack as A import Data.Word import Data.Bits import GHC.Exts import GHC.Word +import Foreign.Storable +import Foreign.Ptr +import Control.Monad import Prelude as P - +#include "repa-array.h" -- | A date packed into a 32-bit word. -- @@ -34,10 +44,88 @@ -- 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 +newtype Date32 + = Date32 Word32 + deriving (Eq, Ord, Show) +instance Storable Date32 where + sizeOf (Date32 w) = sizeOf w + alignment (Date32 w) = alignment w + peek ptr = liftM Date32 (peek (castPtr ptr)) + poke ptr (Date32 w) = poke (castPtr ptr) w + {-# INLINE sizeOf #-} + {-# INLINE alignment #-} + {-# INLINE peek #-} + {-# INLINE poke #-} + + +instance A.Bulk A.A Date32 where + data Array A.A Date32 = AArray_Date32 !(A.Array A.F Date32) + layout (AArray_Date32 arr) = A.Auto (A.length arr) + index (AArray_Date32 arr) ix = A.index arr ix + {-# INLINE_ARRAY layout #-} + {-# INLINE_ARRAY index #-} + +deriving instance Show (A.Array A.A Date32) + + +instance A.Windowable A.A Date32 where + window st len (AArray_Date32 arr) + = AArray_Date32 (A.window st len arr) + {-# INLINE_ARRAY window #-} + + +instance A.Target A.A Date32 where + data Buffer A.A Date32 + = ABuffer_Date32 !(A.Buffer A.F Date32) + + unsafeNewBuffer (A.Auto len) + = liftM ABuffer_Date32 $ A.unsafeNewBuffer (A.Foreign len) + {-# INLINE_ARRAY unsafeNewBuffer #-} + + unsafeReadBuffer (ABuffer_Date32 arr) ix + = A.unsafeReadBuffer arr ix + {-# INLINE_ARRAY unsafeReadBuffer #-} + + unsafeWriteBuffer (ABuffer_Date32 arr) ix x + = A.unsafeWriteBuffer arr ix x + {-# INLINE_ARRAY unsafeWriteBuffer #-} + + unsafeGrowBuffer (ABuffer_Date32 arr) bump + = liftM ABuffer_Date32 $ A.unsafeGrowBuffer arr bump + {-# INLINE_ARRAY unsafeGrowBuffer #-} + + unsafeFreezeBuffer (ABuffer_Date32 arr) + = liftM AArray_Date32 $ A.unsafeFreezeBuffer arr + {-# INLINE_ARRAY unsafeFreezeBuffer #-} + + unsafeThawBuffer (AArray_Date32 arr) + = liftM ABuffer_Date32 $ A.unsafeThawBuffer arr + {-# INLINE_ARRAY unsafeThawBuffer #-} + + unsafeSliceBuffer st len (ABuffer_Date32 buf) + = liftM ABuffer_Date32 $ A.unsafeSliceBuffer st len buf + {-# INLINE_ARRAY unsafeSliceBuffer #-} + + touchBuffer (ABuffer_Date32 buf) + = A.touchBuffer buf + {-# INLINE_ARRAY touchBuffer #-} + + bufferLayout (ABuffer_Date32 buf) + = A.Auto $ A.extent $ A.bufferLayout buf + {-# INLINE_ARRAY bufferLayout #-} + + +instance (A.Unpack (A.Buffer A.F Date32)) t + => (A.Unpack (A.Buffer A.A Date32)) t where + unpack (ABuffer_Date32 buf) = A.unpack buf + repack (ABuffer_Date32 x) buf = ABuffer_Date32 (A.repack x buf) + {-# INLINE unpack #-} + {-# INLINE repack #-} + + +--------------------------------------------------------------------------------------------------- -- | 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 @@ -45,7 +133,8 @@ -- pack :: (Word, Word, Word) -> Date32 pack (yy, mm, dd) - = ((fromIntegral yy .&. 0x0ffff) `shiftL` 16) + = Date32 + $ ((fromIntegral yy .&. 0x0ffff) `shiftL` 16) .|. ((fromIntegral mm .&. 0x0ff) `shiftL` 8) .|. (fromIntegral dd .&. 0x0ff) {-# INLINE pack #-} @@ -58,26 +147,27 @@ -- range for the given calendar date. -- unpack :: Date32 -> (Word, Word, Word) -unpack date +unpack (Date32 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) +next (Date32 (W32# date)) + = Date32 (W32# (next' date)) {-# INLINE next #-} next' :: Word# -> Word# next' !date - | (yy, mm, dd) <- unpack (W32# date) + | (yy, mm, dd) <- unpack (Date32 (W32# date)) , (yy', mm', dd') <- case mm of 1 -> if dd >= 31 then (yy, 2, 1) else (yy, mm, dd + 1) -- Jan @@ -102,7 +192,7 @@ 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 + Date32 (W32# w) -> w {-# NOINLINE next' #-} @@ -110,12 +200,10 @@ --- -- 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 +range :: Date32 -> Date32 -> Array Date32 +range from to + | to < from = A.fromList A.A [] + | otherwise = A.fromList A.A $ go [] from where go !acc !d | d > to = P.reverse acc @@ -123,20 +211,77 @@ {-# NOINLINE range #-} --- | Read a `Date32` in ASCII YYYYsMMsDD format, using the given separator --- character 's'. +--------------------------------------------------------------------------------------------------- +-- | Pretty print a `Date32` --- --- TODO: avoid going via lists. +-- TODO: avoid going via lists. -- -readYYYYsMMsDD - :: BulkI l Char - => Char -> Array l Char -> Maybe Date32 +pretty :: Char -- ^ Separator for components. + -> Date32 -- ^ Date to pretty print. + -> Array Char -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 #-} +pretty !cSep !date + = let (yy, mm, dd) = unpack date + yy' = show yy + mm' = if mm < 10 then "0" ++ show mm else show mm + dd' = if dd < 10 then "0" ++ show dd else show dd + in A.fromList A.A $ P.concat [yy', [cSep], mm', [cSep], dd'] + + +--------------------------------------------------------------------------------------------------- +-- | Read a `Date32` in ASCII YYYYsMMsDD format, +-- using the given separator character 's'. +readYYYYsMMsDD :: Char -> Array Char -> Maybe Date32 +readYYYYsMMsDD !c !arr + | I# len <- A.length arr + + -- year part + , (# 1#, yy, ix1 #) <- readIntFromOffset# arr 0# + + -- month part + , 1# <- ix1 <# len + , arr `index` (I# ix1) == c + , (# 1#, mm, ix2 #) <- readIntFromOffset# arr (ix1 +# 1#) + + -- day part + , 1# <- ix2 <# len + , arr `index` (I# ix2) == c + , (# 1#, dd, _ #) <- readIntFromOffset# arr (ix2 +# 1#) + + = Just (pack ( fromIntegral (I# yy) + , fromIntegral (I# mm) + , fromIntegral (I# dd))) + + | otherwise + = Nothing +{-# INLINE [0] readYYYYsMMsDD #-} + + +--------------------------------------------------------------------------------------------------- +-- | Read a `Date32` in ASCII DDsMMsYYYY format, +-- using the given separator character 's'. +readDDsMMsYYYY :: Char -> Array Char -> Maybe Date32 +readDDsMMsYYYY !c !arr + | I# len <- A.length arr + + -- day part + , (# 1#, dd, ix1 #) <- readIntFromOffset# arr 0# + + -- month part + , 1# <- ix1 <# len + , arr `index` (I# ix1) == c + , (# 1#, mm, ix2 #) <- readIntFromOffset# arr (ix1 +# 1#) + + -- year part + , 1# <- ix2 <# len + , arr `index` (I# ix2) == c + , (# 1#, yy, _ #) <- readIntFromOffset# arr (ix2 +# 1#) + + = Just (pack ( fromIntegral (I# yy) + , fromIntegral (I# mm) + , fromIntegral (I# dd))) + + | otherwise + = Nothing +{-# INLINE [0] readDDsMMsYYYY #-} diff --git a/Data/Repa/Eval/Array.hs b/Data/Repa/Eval/Array.hs deleted file mode 100644 --- a/Data/Repa/Eval/Array.hs +++ /dev/null @@ -1,54 +0,0 @@ - -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 #-} - - diff --git a/Data/Repa/Eval/Chain.hs b/Data/Repa/Eval/Chain.hs --- a/Data/Repa/Eval/Chain.hs +++ b/Data/Repa/Eval/Chain.hs @@ -5,11 +5,11 @@ , unchainToArray , unchainToArrayIO) where -import Data.Repa.Fusion.Unpack import Data.Repa.Chain (Chain(..), Step(..)) +import Data.Repa.Fusion.Unpack +import Data.Repa.Array.Generic.Index as A 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 @@ -49,7 +49,7 @@ -- | Compute the elements of a pure `Chain`, -- writing them into a new array `Array`. unchainToArray - :: (Target l a, Unpack (IOBuffer l a) t) + :: (Target l a, Unpack (Buffer l a) t) => Name l -> Chain S.Id s a -> (Array l a, s) unchainToArray nDst c = unsafePerformIO @@ -61,7 +61,7 @@ -- | Compute the elements of an `IO` `Chain`, -- writing them to a new `Array`. unchainToArrayIO - :: (Target l a, Unpack (IOBuffer l a) t) + :: (Target l a, Unpack (Buffer l a) t) => Name l -> Chain IO s a -> IO (Array l a, s) unchainToArrayIO nDst (Chain sz s0 step) diff --git a/Data/Repa/Eval/Stream.hs b/Data/Repa/Eval/Stream.hs --- a/Data/Repa/Eval/Stream.hs +++ b/Data/Repa/Eval/Stream.hs @@ -1,12 +1,19 @@ -{-# LANGUAGE CPP #-} -- | Interface with stream fusion. module Data.Repa.Eval.Stream - (streamOfArray) + ( streamOfArray + , unstreamToArray + , unstreamToArrayIO) where -import Data.Repa.Array.Index as A +import Data.Repa.Fusion.Unpack +import Data.Repa.Array.Generic.Index as A import Data.Repa.Array.Internals.Bulk as A +import Data.Repa.Array.Internals.Target as A +import qualified Data.Vector.Fusion.Stream as SS 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" @@ -20,3 +27,89 @@ = S.generate (A.length vec) (\i -> A.index vec i) {-# INLINE_STREAM streamOfArray #-} + + +------------------------------------------------------------------------------- +-- | Compute the elements of a pure `Stream`, +-- writing them into a new array `Array`. +unstreamToArray + :: (Target l a, Unpack (Buffer l a) t) + => Name l -> S.Stream S.Id a -> Array l a + +unstreamToArray nDst s + = unsafePerformIO + $ unstreamToArrayIO nDst + $ SS.liftStream s +{-# INLINE_STREAM unstreamToArray #-} + + +-- | Compute the elements of an `IO` `Stream`, +-- writing them to a new `Array`. +unstreamToArrayIO + :: (Target l a, Unpack (Buffer l a) t) + => Name l -> S.Stream IO a -> IO (Array l a) + +unstreamToArrayIO nDst (S.Stream step s0 sz) + = case sz of + S.Exact i -> unstreamToArrayIO_max i + S.Max i -> unstreamToArrayIO_max i + S.Unknown -> unstreamToArrayIO_unknown 32 + + -- unstream when we known the maximum size of the vector. + where unstreamToArrayIO_max !nMax + = do !vec0 <- unsafeNewBuffer (create nDst zeroDim) + !vec <- unsafeGrowBuffer vec0 nMax + + let go_unstreamIO_max !sPEC !i !s + = step s >>= \m + -> case m of + S.Yield e s' + -> do unsafeWriteBuffer vec i e + go_unstreamIO_max sPEC (i + 1) s' + + S.Skip s' + -> go_unstreamIO_max sPEC i s' + + S.Done + -> do buf' <- unsafeSliceBuffer 0 i vec + arr <- unsafeFreezeBuffer buf' + return arr + {-# INLINE_INNER go_unstreamIO_max #-} + + go_unstreamIO_max S.SPEC 0 s0 + {-# INLINE_INNER unstreamToArrayIO_max #-} + + -- unstream when we don't know the maximum size of the vector. + unstreamToArrayIO_unknown !nStart + = do !vec0 <- unsafeNewBuffer (create nDst zeroDim) + !vec1 <- unsafeGrowBuffer vec0 nStart + + let go_unstreamIO_unknown !sPEC !uvec !i !n !s + = go_unstreamIO_unknown1 (repack vec0 uvec) i n s + (\vec' i' n' s' -> go_unstreamIO_unknown sPEC (unpack vec') i' n' s') + (\result -> return result) + + go_unstreamIO_unknown1 !vec !i !n !s cont done + = step s >>= \r + -> case r of + S.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' + + S.Skip s' + -> cont vec i n s' + + S.Done + -> do + vec' <- unsafeSliceBuffer 0 i vec + arr <- unsafeFreezeBuffer vec' + done arr + + go_unstreamIO_unknown S.SPEC (unpack vec1) 0 nStart s0 + {-# INLINE_INNER unstreamToArrayIO_unknown #-} +{-# INLINE_STREAM unstreamToArrayIO #-} diff --git a/Data/Repa/IO/Array.hs b/Data/Repa/IO/Array.hs deleted file mode 100644 --- a/Data/Repa/IO/Array.hs +++ /dev/null @@ -1,137 +0,0 @@ -{-# 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 #-} - diff --git a/Data/Repa/IO/Convert.hs b/Data/Repa/IO/Convert.hs deleted file mode 100644 --- a/Data/Repa/IO/Convert.hs +++ /dev/null @@ -1,89 +0,0 @@ - -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 #-} - diff --git a/Data/Repa/Nice.hs b/Data/Repa/Nice.hs --- a/Data/Repa/Nice.hs +++ b/Data/Repa/Nice.hs @@ -4,9 +4,11 @@ , Str (..) , Tok (..)) where -import Data.Repa.Array as A +import Data.Repa.Array.Generic as A +import Data.Repa.Product as B import Control.Monad import Data.Word +import Data.Int import Prelude as P @@ -49,10 +51,12 @@ type Nice () = () nice x = x -instance Nicer Int where - type Nice Int = Int +-- Chars +instance Nicer Char where + type Nice Char = Char nice x = x +-- Floats instance Nicer Float where type Nice Float = Float nice x = x @@ -61,10 +65,32 @@ type Nice Double = Double nice x = x -instance Nicer Char where - type Nice Char = Char +-- Ints +instance Nicer Int where + type Nice Int = Int nice x = x +instance Nicer Int8 where + type Nice Int8 = Int8 + nice x = x + +instance Nicer Int16 where + type Nice Int16 = Int16 + nice x = x + +instance Nicer Int32 where + type Nice Int32 = Int32 + nice x = x + +instance Nicer Int64 where + type Nice Int64 = Int64 + nice x = x + +-- Words +instance Nicer Word where + type Nice Word = Word + nice x = x + instance Nicer Word8 where type Nice Word8 = Word8 nice x = x @@ -105,6 +131,22 @@ type Nice [Double] = [Double] nice xs = xs +instance Nicer [Int8] where + type Nice [Int8] = [Int8] + nice xs = xs + +instance Nicer [Int16] where + type Nice [Int16] = [Int16] + nice xs = xs + +instance Nicer [Int32] where + type Nice [Int32] = [Int32] + nice xs = xs + +instance Nicer [Int64] where + type Nice [Int64] = [Int64] + nice xs = xs + instance Nicer [Word8] where type Nice [Word8] = [Word8] nice xs = xs @@ -133,11 +175,17 @@ type Nice (a, b) = (Nice a, Nice b) nice (x, y) = (nice x, nice y) +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)] @@ -146,6 +194,11 @@ instance (Nicer a, Nicer b) => Nicer [(a, b)] where type Nice [(a, b)] = [Nice (a, b)] + 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]) diff --git a/repa-array.cabal b/repa-array.cabal --- a/repa-array.cabal +++ b/repa-array.cabal @@ -1,5 +1,5 @@ Name: repa-array -Version: 4.0.0.2 +Version: 4.1.0.1 License: BSD3 License-file: LICENSE Author: The Repa Development Team @@ -32,38 +32,47 @@ double-conversion == 2.0.*, text == 1.2.*, repa-eval == 4.0.0.*, - repa-stream == 4.0.0.* + repa-stream == 4.1.0.*, + repa-convert == 4.1.0.* exposed-modules: - Data.Repa.Array.Index.Slice + Data.Repa.Array.Auto + Data.Repa.Array.Auto.IO + Data.Repa.Array.Auto.Convert + Data.Repa.Array.Auto.Unpack + Data.Repa.Array.Generic.Convert + Data.Repa.Array.Generic.Index + Data.Repa.Array.Generic.Load + Data.Repa.Array.Generic.Slice + Data.Repa.Array.Generic.Target + Data.Repa.Array.Generic + + Data.Repa.Array.Material.Auto Data.Repa.Array.Material.Boxed Data.Repa.Array.Material.Foreign + Data.Repa.Array.Material.Strided 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.Array.Meta.Delayed + Data.Repa.Array.Meta.Delayed2 + Data.Repa.Array.Meta.Dense + Data.Repa.Array.Meta.Linear + Data.Repa.Array.Meta.RowWise + Data.Repa.Array.Meta.Tuple + Data.Repa.Array.Meta.Window + Data.Repa.Array.Meta + 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 @@ -72,12 +81,26 @@ Data.Repa.Nice other-modules: + Data.Repa.Array.Auto.Base + Data.Repa.Array.Auto.Operator + + Data.Repa.Array.Material.Auto.Base + Data.Repa.Array.Material.Auto.InstFloat + Data.Repa.Array.Material.Auto.InstInt + Data.Repa.Array.Material.Auto.InstWord + + Data.Repa.Array.Material.Foreign.Base + Data.Repa.Array.Internals.Operator.Concat + Data.Repa.Array.Internals.Operator.Compact Data.Repa.Array.Internals.Operator.Fold Data.Repa.Array.Internals.Operator.Group + Data.Repa.Array.Internals.Operator.Merge + Data.Repa.Array.Internals.Operator.Insert 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 @@ -116,5 +139,7 @@ ConstraintKinds ForeignFunctionInterface ViewPatterns + ExistentialQuantification + InstanceSigs