repa-array 4.1.0.1 → 4.2.2.1
raw patch · 57 files changed
+2614/−1496 lines, 57 filesdep +filelockdep +repa-scalardep ~basedep ~primitivedep ~repa-convert
Dependencies added: filelock, repa-scalar
Dependency ranges changed: base, primitive, repa-convert, repa-stream
Files
- Data/Repa/Array.hs +37/−4
- Data/Repa/Array/Auto.hs +42/−4
- Data/Repa/Array/Auto/Base.hs +2/−6
- Data/Repa/Array/Auto/Format.hs +212/−0
- Data/Repa/Array/Auto/IO.hs +58/−121
- Data/Repa/Array/Auto/Operator.hs +142/−38
- Data/Repa/Array/Auto/Unpack.hs +0/−115
- Data/Repa/Array/Auto/XSV.hs +116/−0
- Data/Repa/Array/Generic.hs +23/−4
- Data/Repa/Array/Generic/Index.hs +1/−1
- Data/Repa/Array/Generic/Slice.hs +32/−32
- Data/Repa/Array/Generic/Target.hs +5/−5
- Data/Repa/Array/Generic/Unpacks.hs +134/−0
- Data/Repa/Array/Internals/Bulk.hs +22/−1
- Data/Repa/Array/Internals/Operator/Compact.hs +15/−15
- Data/Repa/Array/Internals/Operator/Concat.hs +37/−26
- Data/Repa/Array/Internals/Operator/Filter.hs +1/−0
- Data/Repa/Array/Internals/Operator/Fold.hs +8/−8
- Data/Repa/Array/Internals/Operator/Group.hs +2/−4
- Data/Repa/Array/Internals/Operator/Insert.hs +2/−3
- Data/Repa/Array/Internals/Operator/Merge.hs +3/−5
- Data/Repa/Array/Internals/Operator/Partition.hs +1/−0
- Data/Repa/Array/Internals/Operator/Process.hs +72/−0
- Data/Repa/Array/Internals/Operator/Reduce.hs +7/−6
- Data/Repa/Array/Internals/Operator/Replicate.hs +26/−0
- Data/Repa/Array/Internals/Target.hs +189/−4
- Data/Repa/Array/Material/Auto.hs +14/−1
- Data/Repa/Array/Material/Auto/Base.hs +1/−439
- Data/Repa/Array/Material/Auto/InstArray.hs +116/−0
- Data/Repa/Array/Material/Auto/InstBox.hs +77/−0
- Data/Repa/Array/Material/Auto/InstChar.hs +87/−0
- Data/Repa/Array/Material/Auto/InstDate32.hs +90/−0
- Data/Repa/Array/Material/Auto/InstFloat.hs +4/−16
- Data/Repa/Array/Material/Auto/InstInt.hs +10/−41
- Data/Repa/Array/Material/Auto/InstList.hs +81/−0
- Data/Repa/Array/Material/Auto/InstMaybe.hs +85/−0
- Data/Repa/Array/Material/Auto/InstProduct.hs +230/−0
- Data/Repa/Array/Material/Auto/InstText.hs +81/−0
- Data/Repa/Array/Material/Auto/InstTuple.hs +98/−0
- Data/Repa/Array/Material/Auto/InstUnit.hs +65/−0
- Data/Repa/Array/Material/Auto/InstWord.hs +3/−8
- Data/Repa/Array/Material/Auto/Operator/Lines.hs +44/−0
- Data/Repa/Array/Material/Auto/Operator/Unpackables.hs +207/−0
- Data/Repa/Array/Material/Boxed.hs +1/−9
- Data/Repa/Array/Material/Foreign/Base.hs +1/−17
- Data/Repa/Array/Material/Nested.hs +0/−14
- Data/Repa/Array/Material/Strided.hs +0/−138
- Data/Repa/Array/Material/Unboxed.hs +1/−16
- Data/Repa/Array/Meta/Dense.hs +0/−10
- Data/Repa/Array/Meta/Tuple.hs +0/−11
- Data/Repa/Bits/Date32.hs +0/−287
- Data/Repa/Eval/Chain.hs +6/−43
- Data/Repa/Eval/Stream.hs +7/−7
- Data/Repa/Nice.hs +12/−5
- Data/Repa/Nice/Present.hs +62/−5
- Data/Repa/Nice/Tabulate.hs +1/−2
- repa-array.cabal +41/−25
Data/Repa/Array.hs view
@@ -30,8 +30,15 @@ , index , (!) , length- , head, tail, init+ , first, last+ , head, tail, init + -- * Construction+ , empty+ , singleton+ , generateMaybeS+ , generateEitherS+ -- * Conversion , fromList , fromLists@@ -43,6 +50,9 @@ -- * Operators + -- ** Replicating+ , replicates+ -- ** Mapping , map , map2@@ -54,7 +64,7 @@ , foldsWith -- *** Special Folds- , sum, prod+ , sum, product , mean, std , correlate @@ -104,11 +114,34 @@ , segmentOn , dice , diceSep++ -- ** Products++ -- *** Generic+ , prod+ , unprod++ -- *** Pattern synonyms+ -- | These patterns patterns work on arrays of arbitrary element type.+ -- + -- (Haddock 2.16.0 has a bug where the type signatures come out monomorphic)+ --+ , pattern Prod2+ , pattern Prod3+ , pattern Prod4+ , pattern Prod5+ , pattern Prod6+ , pattern Prod7+ , pattern Prod8+ , pattern Prod9 ) where import Data.Repa.Array.Auto import Prelude - hiding ( map, length, reverse, filter, concat, unlines, foldl, sum- , head, init, tail, zip, unzip)+ hiding ( map, length, reverse, filter, concat, unlines, foldl+ , sum, product+ , last+ , head, init, tail+ , zip, unzip)
Data/Repa/Array/Auto.hs view
@@ -7,8 +7,15 @@ , index , (!) , length+ , first, last , head, init, tail + -- * Construction+ , empty+ , singleton+ , generateMaybeS, mapMaybeS+ , generateEitherS, mapEitherS+ -- * Conversion , fromList , fromLists@@ -20,6 +27,9 @@ -- * Operators + -- ** Replicating+ , replicates+ -- ** Mapping , map , map2@@ -27,7 +37,7 @@ -- ** Folding , foldl- , sum, prod+ , sum, product , mean, std , correlate , folds@@ -70,6 +80,9 @@ , compact , compactIn + -- ** Processing+ , process+ -- ** Grouping , groups , groupsWith@@ -78,11 +91,36 @@ , segment , segmentOn , dice- , diceSep)+ , diceSep++ -- ** Products++ -- *** Generic+ , prod+ , unprod++ -- *** Pattern synonyms+ -- | These patterns patterns work on arrays of arbitrary element type.+ -- + -- (Haddock 2.16.0 has a bug where the type signatures come out monomorphic)+ --+ , pattern Prod2+ , pattern Prod3+ , pattern Prod4+ , pattern Prod5+ , pattern Prod6+ , pattern Prod7+ , pattern Prod8+ , pattern Prod9) where import Data.Repa.Array.Auto.Base import Data.Repa.Array.Auto.Operator+import Data.Repa.Array.Material.Auto.InstProduct import Prelude - hiding ( map, length, reverse, filter, concat, unlines, foldl, sum, zip, unzip- , head, init, tail)+ hiding ( map, length, reverse, filter, concat, unlines, foldl+ , sum, product+ , zip, unzip+ , head, init, tail, last)++
Data/Repa/Array/Auto/Base.hs view
@@ -7,11 +7,8 @@ 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. --@@ -32,7 +29,6 @@ -- | Class of elements where arrays of those elements can be constructed -- in arbitrary order.-type Build a t+type Build a = ( G.Bulk A a- , G.Target A a- , F.Unpack (G.Buffer A a) t)+ , G.Target A a)
+ Data/Repa/Array/Auto/Format.hs view
@@ -0,0 +1,212 @@++module Data.Repa.Array.Auto.Format+ ( module Data.Repa.Convert.Format+ , module Data.Repa.Convert.Formats+ + -- * Packing+ , packFormat+ , packsFormat+ , packsFormatLn++ -- * Unpacking+ , unpackFormat+ , unpacksFormatLn+ , UnpackableRow+ , A.Unpackables)+where+import Data.Repa.Array.Auto.Base as A+import Data.Repa.Array.Generic.Convert as A+import qualified Data.Repa.Array.Generic as AG+import qualified Data.Repa.Array.Material.Auto as A+import qualified Data.Repa.Array.Material.Auto.Operator.Lines as A+import qualified Data.Repa.Array.Material.Auto.Operator.Unpackables as A+import qualified Data.Repa.Array.Material.Foreign as AF+import qualified Data.Repa.Array.Internals.Target as A+import qualified Data.Repa.Array.Internals.Layout as A+import qualified Data.Repa.Array.Internals.Bulk as A+import qualified Data.Repa.Convert.Format as C+import Data.Repa.Convert.Format+import Data.Repa.Convert.Formats++import Foreign.ForeignPtr as F+import Foreign.Ptr as F++import System.IO.Unsafe+import Data.Word+import Data.Char++import qualified Data.Vector.Storable.Mutable as SM+#include "repa-array.h"+++---------------------------------------------------------------------------------------------------+-- | Pack a value into a buffer using the given format.+packFormat+ :: C.Packable format+ => format -- ^ Format for the value.+ -> Value format -- ^ Source value.+ -> Maybe (Array Word8) -- ^ Packed binary data.++packFormat !format !v+ | Just lenBytes <- packedSize format v+ = unsafePerformIO+ $ do + -- The 'lenBytes' we get above is an upper bound on the+ -- number of used by the serialised data.+ buf@(AF.FBuffer mvec) :: A.Buffer AF.F Word8+ <- A.unsafeNewBuffer (AF.Foreign lenBytes)++ let (fptr, oStart, _) = SM.unsafeToForeignPtr mvec ++ -- When we pack the data into the buffer we get the number+ -- of bytes actually used, then slice the original buffer+ -- down to this size.+ withForeignPtr fptr $ \ptr+ -> do Just ptr' <- C.unsafeRunPacker (C.pack format v) + (plusPtr ptr oStart)+ let len = minusPtr ptr' ptr+ buf' <- A.unsafeSliceBuffer 0 len buf+ arr <- A.unsafeFreezeBuffer buf'+ return $ Just $ A.convert arr++ | otherwise = Nothing+{-# INLINE_ARRAY packFormat #-}+++-- | Pack an array of values into a buffer using the given format.+--+-- * The bytes representing each value are concatenated together with no delimitor.+--+packsFormat+ :: (C.Packable format, Show format, A.Bulk A.A (Value format))+ => format -- ^ Format for each value+ -> Array (Value format) -- ^ Source values.+ -> Maybe (Array Word8) -- ^ Packed binary data.++packsFormat !format !arr+ = let + packRow v + = case packFormat format v of+ Nothing+ -> error $ unlines+ [ "repa-array.packsFormat: conversion failed"]++ Just arr8 -> arr8+ {-# INLINE packRow #-}++ in Just $ AG.concat A.A $ AG.mapS A.N packRow arr+{-# INLINE_ARRAY packsFormat #-}+++-- | Like `packsFormat`, but append a newline character after+-- every packed element.+--+-- * If a value cannot be converted then this function just returns `error`.+--+packsFormatLn+ :: (C.Packable format, A.Bulk A.A (Value format))+ => format -- ^ Format for each value+ -> Array (Value format) -- ^ Source values.+ -> Maybe (Array Word8) -- ^ Packed binary data.++packsFormatLn !format !arr+ = let + !arrNL + = A.fromList A.A [fromIntegral $ ord '\n'] -- TODO: kill lists++ packRow v + = case packFormat format v of+ Nothing+ -> error $ unlines+ [ "repa-array.packsFormat: conversion failed"]++ Just arr8 -> AG.concat A.A $ A.fromList A.A [ arr8, arrNL ]+ {-# INLINE packRow #-}++ in Just $ AG.concat A.A $ AG.mapS A.N packRow arr+{-# INLINE_ARRAY packsFormatLn #-}++++---------------------------------------------------------------------------------------------------+-- | Unpack a value from a buffer using the given format.+unpackFormat+ :: C.Unpackable format+ => format -- ^ Format for the value.+ -> Array Word8 -- ^ Packed binary data.+ -> Maybe (C.Value format) -- ^ Unpacked value.++unpackFormat !format !arrBytes+ | lenBytes <- A.length arrBytes+ = unsafePerformIO+ $ let (oStart, _, fptr :: ForeignPtr Word8) + = AF.toForeignPtr $ A.convert arrBytes+ in withForeignPtr fptr $ \ptr_+ -> do r <- C.unsafeRunUnpacker + (C.unpack format) + (plusPtr ptr_ oStart)+ lenBytes (const False)+ case r of+ Just (v, _) -> return $ Just v+ _ -> return Nothing++ | otherwise = Nothing+{-# INLINE_ARRAY unpackFormat #-}++++-- | Unpack an encoded table of values from an array of bytes.+unpacksFormatLn+ :: UnpackableRow format+ => Sep format -- ^ Format of each row.+ -> Array Word8 -- ^ Source data.+ -> Array (Value (Sep format)) -- ^ Array of rows.++unpacksFormatLn format arrSrc@(A.AArray_Word8 arrSrcF)+ = unsafePerformIO+ $ do + -- Rows are separated by newline characters.+ let !wSepRow + = fromIntegral $ ord '\n'++ -- Determine the field separator character.+ -- If the format is just () then we're only counting the + -- number of lines in the table, so it doesn't matter+ -- what we use for the field separator.+ let !wSepField + = case takeSepChar format of + Nothing -> fromIntegral $ ord ' '+ Just c -> fromIntegral $ ord c++ -- Scan through the input data to determine where the lines begin+ -- and end.+ let (ixsStarts, ixsEnds) + = A.findRowsStartEnd wSepRow arrSrc++ -- Allocate a buffer for the output data.+ let len = A.extent $ A.bufferLayout ixsStarts+ buf <- A.unsafeNewBuffer (A.Auto len)++ -- Unpack all the rows into the buffer.+ mErr <- A.unpacksToBuffer + format + wSepField + arrSrcF + ixsStarts ixsEnds buf++ case mErr of+ Nothing + -> A.unsafeFreezeBuffer buf++ -- TODO: return error.+ Just err+ -> error $ "unsafeFormatLn: parse error " ++ show err+{-# INLINE unpacksFormatLn #-}+++-- | Dictionaries needed to unpack a row of the given format.+type UnpackableRow format+ = ( SepFormat format+ , A.Unpackables (Sep format)+ , A.Target A.A (Value (Sep format)))+
Data/Repa/Array/Auto/IO.hs view
@@ -1,46 +1,80 @@ --- | Array IO+-- | Raw Array IO. module Data.Repa.Array.Auto.IO- ( -- * Raw Array IO- hGetArray, hGetArrayPre- , hPutArray-- -- * XSV files- -- ** Reading- , getArrayFromXSV, hGetArrayFromXSV+ ( -- * Via File Names+ readFile+ , writeFile+ , appendFile - -- ** Writing- , putArrayAsXSV, hPutArrayAsXSV)+ -- * Via File Handles+ , hGetArray, hGetArrayPre+ , hPutArray) 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+import qualified System.IO as S+import qualified System.FileLock as S+import Prelude hiding (readFile, writeFile, appendFile) --- | Get data from a file, up to the given number of bytes.-hGetArray :: Handle -> Int -> IO (Array Word8)+---------------------------------------------------------------------------------------------------+-- | Read an entire file as an array of bytes.+readFile :: FilePath -> IO (Array Word8)+readFile path+ = S.withFileLock path S.Shared+ $ \_lock -> do+ h <- S.openFile path S.ReadMode+ S.hSeek h S.SeekFromEnd 0+ len <- S.hTell h+ S.hSeek h S.AbsoluteSeek 0+ !arr <- hGetArray h (fromIntegral len)+ S.hClose h+ return arr+{-# NOINLINE readFile #-}+++-- | Write an array of bytes to a file.+writeFile :: FilePath -> Array Word8 -> IO ()+writeFile path arr+ = S.withFileLock path S.Exclusive+ $ \_lock -> do+ h <- S.openFile path S.WriteMode+ hPutArray h arr+ S.hClose h+{-# NOINLINE writeFile #-}+++-- | Append an array of bytes to a file.+appendFile :: FilePath -> Array Word8 -> IO ()+appendFile path arr+ = S.withFileLock path S.Exclusive+ $ \_lock -> do+ h <- S.openFile path S.AppendMode+ hPutArray h arr+ S.hClose h+{-# NOINLINE appendFile #-}+++---------------------------------------------------------------------------------------------------+-- | Get data from a file handle, up to the given number of bytes.+hGetArray :: S.Handle -> Int -> IO (Array Word8) hGetArray h len = do buf :: F.Ptr Word8 <- F.mallocBytes len- bytesRead <- hGetBuf h buf len+ bytesRead <- S.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+-- | Get data from a file handle, 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 :: S.Handle -> Int -> Array Word8 -> IO (Array Word8) hGetArrayPre h len arr | (offset, lenPre, fptrPre :: F.ForeignPtr Word8) <- A.toForeignPtr $ convert arr@@ -49,7 +83,7 @@ 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+ lenRead <- S.hGetBuf h (F.plusPtr ptrBuf lenPre) len let bytesTotal = lenPre + lenRead fptrBuf <- F.newForeignPtr F.finalizerFree ptrBuf return $ convert $! A.fromForeignPtr bytesTotal fptrBuf@@ -57,109 +91,12 @@ -- | Write data into a file.-hPutArray :: Handle -> Array Word8 -> IO ()+hPutArray :: S.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+ S.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 #-}-
Data/Repa/Array/Auto/Operator.hs view
@@ -12,8 +12,15 @@ , index , (!) , length- , head, tail, init+ , first, last+ , head, tail, init + -- * Construction+ , empty+ , singleton+ , generateMaybeS, mapMaybeS+ , generateEitherS, mapEitherS+ -- * Conversion , fromList , fromLists@@ -25,6 +32,9 @@ -- * Operators + -- ** Replicating+ , replicates+ -- ** Mapping , map , map2@@ -32,7 +42,7 @@ -- ** Folding , foldl- , sum, prod+ , sum, product , mean, std -- *** Special Folds@@ -77,6 +87,9 @@ , compact , compactIn + -- ** Processing+ , process+ -- ** Grouping , groups , groupsWith@@ -100,12 +113,12 @@ 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)+ hiding ( map, length, reverse, filter, concat, unlines, foldl+ , sum, product, zip, unzip+ , head, tail, init, last) -- Basic ------------------------------------------------------------------------------------------@@ -130,11 +143,21 @@ {-# INLINE length #-} --- | O(1). Take the head of an array, or `Nothing` if it's empty.+-- | O(1). Take the first element of an array, or `Nothing` if it's empty.+first :: Elem a => Array a -> Maybe a+first = G.first+{-# INLINE first #-}+++-- | O(1). Take the last element of an array, or `Nothing` if it's empty.+last :: Elem a => Array a -> Maybe a+last = G.last+{-# INLINE last #-}+++-- | O(1). alias for `first`. head :: Elem a => Array a -> Maybe a-head arr = if G.length arr < 1- then Nothing- else Just (arr `index` 0)+head = G.first {-# INLINE head #-} @@ -150,23 +173,82 @@ {-# INLINE init #-} +-- Construction -----------------------------------------------------------------------------------+-- | O(1). An empty array of the given layout.+empty :: Build a+ => Array a+empty = G.empty A+{-# INLINE empty #-}+++-- | O(1). Create a new empty array containing a single element.+singleton + :: Build a+ => a -> Array a+singleton = G.singleton A+{-# INLINE singleton #-}+++-- | Like `generateS` but use a function that produces Maybe an element.+-- If any element returns `Nothing`, then `Nothing` for the whole array.+generateMaybeS+ :: Build a+ => Int -> (Int -> Maybe a) + -> Maybe (Array a)+generateMaybeS = G.generateMaybeS A+{-# INLINE generateMaybeS #-}+++-- | Apply a function to every element of an array, +-- if any application returns `Nothing`, then `Nothing` for the whole result.+mapMaybeS + :: (Elem a, Build b)+ => (a -> Maybe b) + -> Array a+ -> Maybe (Array b)+mapMaybeS = G.mapMaybeS A+{-# INLINE mapMaybeS #-}+++-- | Like `generateS` but use a function that produces Either some error+-- or an element. If any element returns `Nothing`, then `Nothing` for+-- the whole array.+generateEitherS+ :: Build a+ => Int -> (Int -> Either err a) + -> Either err (Array a)+generateEitherS = G.generateEitherS A+{-# INLINE generateEitherS #-}+++-- | Apply a function to every element of an array, +-- if any application returns `Left`, then `Left` for the whole result.+mapEitherS + :: (Elem a, Build b)+ => (a -> Either err b) + -> Array a+ -> Either err (Array b)+mapEitherS = G.mapEitherS A+{-# INLINE mapEitherS #-}++ -- Conversion ------------------------------------------------------------------------------------- -- | Convert a list to an array.-fromList :: Build a at +fromList :: Build a => [a] -> Array a fromList = G.fromList A {-# INLINE fromList #-} -- | Convert a nested list to an array.-fromLists :: Build a at+fromLists :: Build a => [[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+fromListss :: Build a => [[[a]]] -> Array (Array (Array a)) fromListss xs = convert $! N.fromListss A xs {-# INLINE fromListss #-}@@ -200,14 +282,25 @@ -- [10,9,8,7,6,5,4,3,2,1,0] -- @ ---reverse :: Build a at => Array a -> Array a+reverse :: Build a => Array a -> Array a reverse arr = G.computeS A $! A.reverse arr {-# INLINE reverse #-} +-- Replicating ------------------------------------------------------------------------------------+-- | Segmented replicate.+replicates + :: (Elem a, Build a)+ => Array (Int, a) -> Array a++replicates arr+ = G.replicates A arr+{-# INLINE replicates #-}++ -- Mapping ---------------------------------------------------------------------------------------- -- | Apply a function to all the elements of a list.-map :: (Elem a, Build b bt)+map :: (Elem a, Build b) => (a -> b) -> Array a -> Array b map f arr = G.computeS A $! A.map f arr@@ -218,7 +311,7 @@ -- -- If the arrays don't have the same length then `Nothing`. ---map2 :: (Elem a, Elem b, Build c ct)+map2 :: (Elem a, Elem b, Build c) => (a -> b -> c) -> Array a -> Array b -> Maybe (Array c) map2 f xs ys = liftM (G.computeS A) $! A.map2 f xs ys@@ -259,9 +352,9 @@ -- | Yield the product of the elements of an array.-prod :: (Elem a, Num a) => Array a -> a-prod = G.prod-{-# INLINE prod #-}+product :: (Elem a, Num a) => Array a -> a+product = G.product+{-# INLINE product #-} -- | Yield the mean value of the elements of an array.@@ -284,7 +377,7 @@ -- prefix is correlated. -- correlate - :: ( Elem a, Floating a)+ :: (Elem a, Floating a) => Array a -> Array a -> a correlate = G.correlate {-# INLINE correlate #-}@@ -298,7 +391,7 @@ -- vector of segment lengths or elements was too short relative to the -- other. ---folds :: (Elem a, Build n nt, Build b bt)+folds :: (Elem a, Build n, Build b) => (a -> b -> b) -- ^ Worker function. -> b -- ^ Initial state when folding segments. -> Array (n, Int) -- ^ Segment names and lengths.@@ -313,7 +406,7 @@ -- | Like `folds`, but take an initial state for the first segment. -- foldsWith- :: (Elem a, Build n nt, Build b bt)+ :: (Elem a, Build n, Build b) => (a -> b -> b) -- ^ Worker function. -> b -- ^ Initial state when folding segments. -> Maybe (n, Int, b) -- ^ Name, length and initial state for first segment.@@ -328,7 +421,7 @@ -- Filtering -------------------------------------------------------------------------------------- -- | O(len src) Keep the elements of an array that match the given predicate.-filter :: Build a at+filter :: Build a => (a -> Bool) -> Array a -> Array a filter = G.filter A {-# INLINE filter #-}@@ -410,17 +503,18 @@ -- Sloshing --------------------------------------------------------------------------------------- -- | Concatenate nested arrays.-concat :: (Elem a, Build a at, F.Unpack (Array a) aat)+concat :: (Elem a, Build a) => Array (Array a) -- ^ Arrays to concatenate. -> Array a-concat = G.concat A-{-# INLINE concat #-}+concat arr + = (inline G.concat) A arr+{-# INLINABLE 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)+ :: (Elem a, Build a) => Array a -- ^ Separator array. -> Array (Array a) -- ^ Arrays to concatenate. -> Array a@@ -445,8 +539,7 @@ -- | 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 :: Array (Array Char) -> Array Char unlines = G.unlines A {-# INLINE unlines #-} @@ -454,7 +547,7 @@ -- | 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)+ :: (Elem a, Build a) => Array a -- ^ Separator array. -> Array (Array a) -- ^ Arrays to concatenate. -> Array a@@ -497,7 +590,7 @@ -- Merging ---------------------------------------------------------------------------------------- -- | Merge two sorted key-value streams.-merge :: (Ord k, Elem (k, a), Elem (k, b), Build (k, c) ct)+merge :: (Ord k, Elem (k, a), Elem (k, b), Build (k, c)) => (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.@@ -511,7 +604,7 @@ -- | 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)+ :: (Ord k, Elem (k, a), Elem (k, b), Build (k, c)) => (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.@@ -528,8 +621,8 @@ -- 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))+compact :: (Elem a, Build b)+ => (s -> a -> (s, Maybe b)) -> s -> Array a -> Array b@@ -540,17 +633,28 @@ -- | 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))+ :: Build a+ => (a -> a -> (a, Maybe a)) -> Array a -> Array a compactIn = G.compactIn A {-# INLINE compactIn #-} +-- | Apply a generic stream process to an array.+process :: ( Build a, Build b, Elem b+ , G.Target A.A b)+ => (s -> a -> (s, Array b)) -- ^ Worker function+ -> s -- ^ Initial state.+ -> Array a -- ^ Input array.+ -> (s, Array b) -- ^ Result state and array.+process = G.process A+{-# INLINE process #-}++ -- Inserting -------------------------------------------------------------------------------------- -- | Insert elements produced by the given function in to an array.-insert :: Build a at+insert :: Build a => (Int -> Maybe a) -> Array a -> Array a insert = G.insert A {-# INLINE insert #-}@@ -635,7 +739,7 @@ -- 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)+groups :: (Eq a, Build a) => Array a -- ^ Input elements. -> (Array (a, Int), Maybe (a, Int)) -- ^ Completed and final segment lengths.@@ -649,7 +753,7 @@ -- consecutive elements should be in the same group. -- Also take an initial starting group and count. groupsWith- :: Build a at+ :: Build a => (a -> a -> Bool) -- ^ Comparison function. -> Maybe (a, Int) -- ^ Starting element and count. -> Array a -- ^ Input elements.
− Data/Repa/Array/Auto/Unpack.hs
@@ -1,115 +0,0 @@--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 #-}
+ Data/Repa/Array/Auto/XSV.hs view
@@ -0,0 +1,116 @@++module Data.Repa.Array.Auto.XSV+ ( getArrayFromXSV, hGetArrayFromXSV+ , putArrayAsXSV, hPutArrayAsXSV)+where+import Data.Repa.Array.Auto.IO+import Data.Repa.Array.Auto.Base+import Data.Repa.Array.Generic.Convert+import Data.Char+import qualified Data.Repa.Array.Material.Auto 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 System.IO as S+import qualified System.FileLock as S+++---------------------------------------------------------------------------------------------------+-- | 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 !path+ = S.withFileLock path S.Shared+ $ \_lock -> do+ h <- S.openFile path S.ReadMode+ arr <- hGetArrayFromXSV cSep h+ S.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'.+ -> S.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 <- S.hTell hIn+ S.hSeek hIn S.SeekFromEnd 0+ end <- S.hTell hIn+ let !len = end - start+ S.hSeek hIn S.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 !path !arrChar+ = S.withFileLock path S.Exclusive+ $ \_lock -> do+ h <- S.openFile path S.WriteMode+ hPutArrayAsXSV cSep h arrChar+ S.hClose h+++-- | Write a nested array as an XSV file.+--+-- The array contains rows:fields:characters.+hPutArrayAsXSV+ :: Char -- ^ Separator character, eg '|', ',' or '\t'+ -> S.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 #-}+
Data/Repa/Array/Generic.hs view
@@ -19,6 +19,7 @@ , Bulk (..), BulkI , (!) , length+ , first, last -- * Array Computation , Load@@ -26,11 +27,20 @@ , computeS, computeIntoS -- * Operators+ -- ** Construction+ , empty+ , singleton+ , generateMaybeS, mapMaybeS+ , generateEitherS, mapEitherS+ -- ** Conversion , fromList, fromListInto , toList , convert, copy + -- ** Replicating+ , replicates+ -- ** Mapping , mapS, map2S @@ -42,6 +52,13 @@ , compact , compactIn + -- ** Processing+ , process++ -- ** Unfolding+ , unfolds+ , StepUnfold (..)+ -- ** Filtering , filter @@ -66,7 +83,7 @@ -- ** Folding -- *** Complete fold- , foldl, sum, prod, mean, std+ , foldl, sum, product, mean, std , correlate -- *** Segmented fold@@ -75,25 +92,27 @@ , 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.Target 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.Merge as A+import Data.Repa.Array.Internals.Operator.Process as A import Data.Repa.Array.Internals.Operator.Reduce as A+import Data.Repa.Array.Internals.Operator.Replicate 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+ , foldl, sum, product, last , filter) #include "repa-array.h"
Data/Repa/Array/Generic/Index.hs view
@@ -1,7 +1,7 @@ -- | Shapes and Indices module Data.Repa.Array.Generic.Index- ( -- * Shapes+ ( -- * Shapes Shape (..) , inShape , showShape
Data/Repa/Array/Generic/Slice.hs view
@@ -1,82 +1,82 @@ -- | Index space transformation between arrays and slices. module Data.Repa.Array.Generic.Slice- ( All (..)- , Any (..)- , FullShape- , SliceShape- , Slice (..))+ ( All (..)+ , Any (..)+ , FullShape+ , SliceShape+ , Slice (..)) where import Data.Repa.Array.Generic.Index-import Prelude hiding (replicate, drop)+import Prelude hiding (replicate, drop) #include "repa-array.h" -- | Select all indices at a certain position.-data All = All+data All = All -- | Place holder for any possible shape.-data Any sh = Any+data Any sh = Any -- | Map a type of the index in the full shape, to the type of the index in the slice. type family FullShape ss-type instance FullShape Z = Z-type instance FullShape (Any sh) = sh-type instance FullShape (sl :. Int) = FullShape sl :. Int-type instance FullShape (sl :. All) = FullShape sl :. Int+type instance FullShape Z = Z+type instance FullShape (Any sh) = sh+type instance FullShape (sl :. Int) = FullShape sl :. Int+type instance FullShape (sl :. All) = FullShape sl :. Int -- | Map the type of an index in the slice, to the type of the index in the full shape. type family SliceShape ss-type instance SliceShape Z = Z-type instance SliceShape (Any sh) = sh-type instance SliceShape (sl :. Int) = SliceShape sl-type instance SliceShape (sl :. All) = SliceShape sl :. Int+type instance SliceShape Z = Z+type instance SliceShape (Any sh) = sh+type instance SliceShape (sl :. Int) = SliceShape sl+type instance SliceShape (sl :. All) = SliceShape sl :. Int -- | Class of index types that can map to slices. class Slice ss where- -- | Map an index of a full shape onto an index of some slice.- sliceOfFull :: ss -> FullShape ss -> SliceShape ss+ -- | Map an index of a full shape onto an index of some slice.+ sliceOfFull :: ss -> FullShape ss -> SliceShape ss - -- | Map an index of a slice onto an index of the full shape.- fullOfSlice :: ss -> SliceShape ss -> FullShape ss+ -- | Map an index of a slice onto an index of the full shape.+ fullOfSlice :: ss -> SliceShape ss -> FullShape ss instance Slice Z where- sliceOfFull _ _ = Z+ sliceOfFull _ _ = Z {-# INLINE sliceOfFull #-} - fullOfSlice _ _ = Z+ fullOfSlice _ _ = Z {-# INLINE fullOfSlice #-} instance Slice (Any sh) where- sliceOfFull _ sh = sh+ sliceOfFull _ sh = sh {-# INLINE sliceOfFull #-} - fullOfSlice _ sh = sh+ fullOfSlice _ sh = sh {-# INLINE fullOfSlice #-} instance Slice sl => Slice (sl :. Int) where- sliceOfFull (fsl :. _) (ssl :. _)- = sliceOfFull fsl ssl+ sliceOfFull (fsl :. _) (ssl :. _)+ = sliceOfFull fsl ssl {-# INLINE sliceOfFull #-} - fullOfSlice (fsl :. n) ssl- = fullOfSlice fsl ssl :. n+ 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+ sliceOfFull (fsl :. All) (ssl :. s)+ = sliceOfFull fsl ssl :. s {-# INLINE sliceOfFull #-} - fullOfSlice (fsl :. All) (ssl :. s)- = fullOfSlice fsl ssl :. s+ fullOfSlice (fsl :. All) (ssl :. s)+ = fullOfSlice fsl ssl :. s {-# INLINE fullOfSlice #-}
Data/Repa/Array/Generic/Target.hs view
@@ -1,9 +1,9 @@ module Data.Repa.Array.Generic.Target- ( -- * Array Targets- Target (..), TargetI- , fromList- , fromListInto)+ ( Target (..), TargetI+ , empty, singleton+ , fromList, fromListInto+ , generateMaybeS, mapMaybeS+ , generateEitherS, mapEitherS) where import Data.Repa.Array.Internals.Target-
+ Data/Repa/Array/Generic/Unpacks.hs view
@@ -0,0 +1,134 @@++module Data.Repa.Array.Generic.Unpacks + (unsafeUnpacksToBuffer)+where+import Data.Repa.Convert.Format+import Data.Repa.Array.Material.Foreign+import Data.Repa.Array.Internals.Target+import Data.Repa.Array.Internals.Layout++import Data.IORef+import Data.Word+import qualified Foreign.ForeignPtr as F+import qualified Foreign.Ptr as F+++-- | Given a buffer containing an encoded table where the values in each+-- column all have the same time, decode all the values from a single+-- column and write them to a buffer.+--+-- For example, suppose we have a table as follows, where the rows are+-- separated by newline characters and the field separated by spaces.+--+-- @+-- RED 1.0 0.0 0.0+-- GREEN 0.0 1.0 0.0+-- BLUE 0.0 0.0 1.0+-- CYAN 0.0 1.0 1.0+-- @+--+-- To decode the second column use:+--+-- * Format: DoubleAsc, as they are encoded doubles.+-- * Field separator: ' ' as the fields are separated by spaces.+-- * Starting offsets: [3, 21, 38, 55], which are the indices of the starting+-- character of each field in the second column.+-- * Ending offsets: [16, 34, 51, 68], which are the indices of the newline+-- characters.+-- * Destination buffer: an new buffer with at least as many elements as there+-- are lines in the input data.+--+-- If the parse succeeds then the buffer containing the starting offets is+-- updated so each element is the index of the NEXT field in each column.+-- This allows the client to easilly decode the next column.+--+-- If there was a parse error then this function returns a pair of the row+-- index and offset in the buffer of the field which could not be parsed.+--+-- UNSAFE: Both the buffer containing ending offsets, and the destination+-- buffer must be at least as long as the buffer containing starting offsets+-- but this is not checked. If this is not true then the function will+-- will perform an out of bounds access.+--+-- INLINE: This function is set to INLINE so that it will be specialised+-- at the call site for the given format. For standard formats it's better+-- to use the pre-specialised versions for Auto arrays.+--+unsafeUnpacksToBuffer+ :: forall format lStart lEnd lVal+ . ( Unpackable format+ , TargetI lStart Int+ , TargetI lEnd Int+ , TargetI lVal (Value format))+ => format -- ^ Format for each element.+ -> Word8 -- ^ Field separator character.+ -> Array F Word8 -- ^ Packed binary source data.+ -> Buffer lStart Int -- ^ Starting offsets for fields.+ -> Buffer lEnd Int -- ^ Ending offsets of rows.+ -> Buffer lVal (Value format) -- ^ Destination buffer for parsed fields.+ -> IO (Maybe (Int, Int)) -- ^ Nothing on successful parse.++unsafeUnpacksToBuffer+ format cTerm src + ixsStart ixsEnd+ bufOut+ = do+ refError <- newIORef Nothing+ loop refError 0+ readIORef refError++ where+ -- Length of the column, in rows.+ !lenColumn+ = extent $ bufferLayout ixsStart++ -- Get unpack the starting pointer form the source buffer.+ !(offSrc, _lenSrc, fptrSrc)+ = toForeignPtr src++ -- Read all the fields of the column in turn.+ loop refError ixField+ | ixField >= lenColumn + = return ()++ | otherwise+ = F.withForeignPtr fptrSrc+ $ \ptrSrc + -> do + -- Starting offset of field in source array.+ ixStart <- unsafeReadBuffer ixsStart ixField++ -- Ending offset of row in source array.+ ixEnd <- unsafeReadBuffer ixsEnd ixField++ -- Get a pointer to the field data in the source array.+ let ptrStart + = F.plusPtr ptrSrc (offSrc + ixStart)++ -- Unpack a single field.+ r <- unsafeRunUnpacker + (unpack format) + ptrStart+ (ixEnd - ixStart + 1)+ (== cTerm)++ case r of+ -- The field didn't parse.+ Nothing + -> writeIORef refError (Just (ixField, ixStart))++ -- We parsed the field.+ Just (x, ptrNext)+ -> do + -- Update the starting offset for this field,+ -- for when we read the next column.+ let !ixStart' = ixStart + F.minusPtr ptrNext ptrStart + 1+ unsafeWriteBuffer ixsStart ixField ixStart'++ -- Write the read field value.+ unsafeWriteBuffer bufOut ixField x++ -- Read the next field in the column.+ loop refError (ixField + 1)+{-# INLINE unsafeUnpacksToBuffer #-}+
Data/Repa/Array/Internals/Bulk.hs view
@@ -3,13 +3,14 @@ ( Bulk (..), BulkI , (!) , length+ , first, last , toList , toLists , toListss) where import Data.Repa.Array.Internals.Shape import Data.Repa.Array.Internals.Layout-import Prelude hiding (length)+import Prelude hiding (length, last) #include "repa-array.h" @@ -47,6 +48,26 @@ => Array l a -> Int length !arr = size (extent (layout arr)) {-# INLINE_ARRAY length #-}+++-- | O(1). Take the first element of an array, if there is one.+first :: BulkI l a+ => Array l a -> Maybe a+first !arr+ = if length arr >= 1+ then Just $ index arr 0+ else Nothing+{-# INLINE first #-}+++-- O(1). Take the last element of an array, if there is one.+last :: BulkI l a+ => Array l a -> Maybe a+last !arr+ = if length arr >= 1+ then Just $ index arr (length arr - 1)+ else Nothing+{-# INLINE last #-} -- Conversion -----------------------------------------------------------------
Data/Repa/Array/Internals/Operator/Compact.hs view
@@ -1,25 +1,26 @@ +-- | Compacting operations on arrays. module Data.Repa.Array.Internals.Operator.Compact ( compact- , compactIn )+ , 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+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.Stream as S+import Prelude hiding (concat) #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)+-- At each point we can chose to emit an element (or not).+--+compact :: (BulkI lSrc a, TargetI lDst b) => Name lDst- -> (s -> a -> (Maybe b, s))+ -> (s -> a -> (s, Maybe b)) -> s -> Array lSrc a -> Array lDst b@@ -33,11 +34,11 @@ -- | 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)+ :: (BulkI lSrc a, TargetI lDst a) => Name lDst- -> (a -> a -> (Maybe a, a))+ -> (a -> a -> (a, Maybe a)) -> Array lSrc a -> Array lDst a @@ -46,5 +47,4 @@ $ S.compactInS f $ A.streamOfArray arr {-# INLINE_ARRAY compactIn #-}-
Data/Repa/Array/Internals/Operator/Concat.hs view
@@ -14,7 +14,6 @@ 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 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@@ -27,8 +26,7 @@ type ConcatDict lOut lIn tIn lDst a = ( BulkI lOut (Array lIn a) , BulkI lIn a- , TargetI lDst a- , Fusion.Unpack (Array lIn a) tIn)+ , TargetI lDst a) ---------------------------------------------------------------------------------------------------@@ -45,7 +43,7 @@ => Name lDst -- ^ Layout for destination. -> Array lOut (Array lIn a) -- ^ Arrays to concatenate. -> Array lDst a-concat nDst vs+concat !nDst !vs | A.length vs == 0 = A.fromList nDst [] @@ -57,29 +55,42 @@ !buf <- unsafeGrowBuffer buf_ len let !iLenY = U.length lens - let loop_concat !iO !iY !row !iX !iLenX- | iX >= iLenX- = if iY >= iLenY - 1- then return ()- else let iY' = iY + 1- row' = vs `index` iY'- iLenX' = A.length row'- in loop_concat iO iY' row' 0 iLenX'-- | otherwise- = do let x = row `index` iX- unsafeWriteBuffer buf iO x- loop_concat (iO + 1) iY row (iX + 1) iLenX- {-# INLINE_INNER loop_concat #-}- let !row0 = vs `index` 0 let !iLenX0 = A.length row0- loop_concat 0 0 row0 0 iLenX0+ loop_concat vs row0 buf 0 0 0 iLenX0 iLenY unsafeFreezeBuffer buf {-# INLINE_ARRAY concat #-} +loop_concat + :: ConcatDict lOut lIn tIn lDst a+ => Array lOut (Array lIn a)+ -> Array lIn a+ -> Buffer lDst a+ -> Int + -> Int + -> Int + -> Int + -> Int + -> IO ()++loop_concat !arr !row !buf !iO !iY !iX !iLenX !iLenY+ | iX >= iLenX+ = if iY >= iLenY - 1+ then return ()+ else let !iY' = iY + 1+ !row' = arr `index` iY'+ !iLenX' = A.length row'+ in loop_concat arr row' buf iO iY' 0 iLenX' iLenY++ | otherwise+ = do let x = row `index` iX+ unsafeWriteBuffer buf iO x+ loop_concat arr row buf (iO + 1) iY (iX + 1) iLenX iLenY+{-# INLINE [0] loop_concat #-}++ --------------------------------------------------------------------------------------------------- -- | O(len result) Concatenate the elements of some nested vector, -- inserting a copy of the provided separator array between each element.@@ -140,7 +151,7 @@ -- Keep copying the source row. | otherwise- -> do let !x = (Fusion.repack row0 row) `index` (I# iX)+ -> do let !x = row `index` (I# iX) unsafeWriteBuffer buf (I# iO) x loop_concatWith sPEC 0# (iO +# 1#) iY row (iX +# 1#) iLenX iS @@ -158,7 +169,7 @@ let !iY' = iY +# 1# let !row' = vs `index` (I# iY') let !(I# iLenX') = A.length row'- loop_concatWith sPEC 0# iO iY' (Fusion.unpack row') 0# iLenX' 0#+ loop_concatWith sPEC 0# iO iY' row' 0# iLenX' 0# -- Keep copying from the separator array. | otherwise@@ -168,7 +179,7 @@ -- First row. let !(I# iLenX0) = A.length row0- loop_concatWith V.SPEC 0# 0# 0# (Fusion.unpack row0) 0# iLenX0 0#+ loop_concatWith V.SPEC 0# 0# 0# row0 0# iLenX0 0# unsafeFreezeBuffer buf {-# INLINE_ARRAY concatWith #-} @@ -246,11 +257,11 @@ let !iY' = iY +# 1# let !row' = vs `index` (I# iY') let !(I# iLenX') = A.length row'- loop_intercalate sPEC iO' iY' (Fusion.unpack row') 0# iLenX'+ loop_intercalate sPEC iO' iY' row' 0# iLenX' -- Keep copying a source element. | otherwise- = do let x = (Fusion.repack row0 row) `index` (I# iX)+ = do let x = 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 +276,7 @@ {-# INLINE_INNER loop_intercalate_inject #-} let !(I# iLenX0) = A.length row0- loop_intercalate V.SPEC 0# 0# (Fusion.unpack row0) 0# iLenX0+ loop_intercalate V.SPEC 0# 0# row0 0# iLenX0 unsafeFreezeBuffer buf {-# INLINE_ARRAY intercalate #-}
Data/Repa/Array/Internals/Operator/Filter.hs view
@@ -1,3 +1,4 @@+ -- | Filtering operators on arrays. module Data.Repa.Array.Internals.Operator.Filter ( filter)
Data/Repa/Array/Internals/Operator/Fold.hs view
@@ -1,6 +1,8 @@ +-- | Folding operations on arrays. module Data.Repa.Array.Internals.Operator.Fold- ( folds+ ( -- * Segmented fold+ folds , foldsWith , C.Folds(..), FoldsDict) where@@ -9,10 +11,10 @@ import Data.Repa.Array.Internals.Bulk as A import Data.Repa.Array.Internals.Target as A import Data.Repa.Eval.Chain as A-import Data.Repa.Fusion.Unpack as A-import qualified Data.Repa.Chain as C-import Data.Repa.Option+import Data.Repa.Scalar.Option import System.IO.Unsafe+import qualified Data.Repa.Chain as C+import Prelude hiding (foldl) #include "repa-array.h" @@ -44,7 +46,7 @@ folds nGrp nRes f z vLens vVals = foldsWith nGrp nRes f z Nothing vLens vVals-{-# INLINE folds #-}+{-# INLINE_ARRAY folds #-} -- | Like `folds`, but take an initial state for the first segment.@@ -93,6 +95,4 @@ , Bulk lElt a , Target lGrp n , Target lRes b- , Index lGrp ~ Index lRes- , Unpack (Buffer lGrp n) tGrp- , Unpack (Buffer lRes b) tRes)+ , Index lGrp ~ Index lRes)
Data/Repa/Array/Internals/Operator/Group.hs view
@@ -1,4 +1,5 @@ +-- | Grouping operations on arrays. module Data.Repa.Array.Internals.Operator.Group ( groups , groupsWith@@ -8,7 +9,6 @@ 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.Chain as A import qualified Data.Repa.Chain as C #include "repa-array.h"@@ -74,8 +74,6 @@ = ( Bulk lElt n , Target lGrp n , Target lLen Int- , Index lGrp ~ Index lLen- , Unpack (Buffer lLen Int) tLen- , Unpack (Buffer lGrp n) tGrp)+ , Index lGrp ~ Index lLen)
Data/Repa/Array/Internals/Operator/Insert.hs view
@@ -1,4 +1,5 @@ +-- | Insertion operations on arrays. module Data.Repa.Array.Internals.Operator.Insert (insert) where@@ -6,15 +7,13 @@ 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)+insert :: (BulkI lSrc a, TargetI lDst a) => Name lDst -- ^ Name of destination layout. -> (Int -> Maybe a) -- ^ Produce an element for this index. -> Array lSrc a -- ^ Array of source elements.
Data/Repa/Array/Internals/Operator/Merge.hs view
@@ -1,4 +1,5 @@ +-- | Merge operations on arrays. module Data.Repa.Array.Internals.Operator.Merge ( merge , mergeMaybe)@@ -8,7 +9,6 @@ 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" @@ -16,8 +16,7 @@ -- | 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)+ , TargetI lDst (k, c)) => 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.@@ -39,8 +38,7 @@ mergeMaybe :: ( Ord k , BulkI l1 (k, a), BulkI l2 (k, b)- , TargetI lDst (k, c)- , Unpack (Buffer lDst (k, c)) t0)+ , TargetI lDst (k, c)) => 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.
Data/Repa/Array/Internals/Operator/Partition.hs view
@@ -1,4 +1,5 @@ +-- | Partition operations on arrays. module Data.Repa.Array.Internals.Operator.Partition ( partition , partitionBy
+ Data/Repa/Array/Internals/Operator/Process.hs view
@@ -0,0 +1,72 @@++module Data.Repa.Array.Internals.Operator.Process+ ( process+ , unfolds, StepUnfold (..))+where+import Data.Repa.Array.Internals.Operator.Concat as A+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.Chain as C+import Data.Repa.Eval.Chain as A+import Prelude hiding (concat)+#include "repa-array.h"+++-- | Apply a generic stream process to an array.+--+process :: ( BulkI lSrc a+ , BulkI lDst b, Bulk lDst (Array lDst b)+ , TargetI lDst b+ , TargetI lDst (Array lDst b))+ => Name lDst -- ^ Name of destination layout.+ -> (s -> a -> (s, Array lDst b)) -- ^ Worker function.+ -> s -- ^ Initial state.+ -> Array lSrc a -- ^ Input array.+ -> (s, Array lDst b) -- ^ Result state and array.++process nDst f s0 arr+ = let + work_process s x+ = case f s x of+ (s', arr') -> return (s', Just arr')+ {-# INLINE_ARRAY work_process #-}+ + (arrs, (_, s2))+ = A.unchainToArray nDst+ $ C.scanMaybeC work_process s0 + $ A.chainOfArray arr++ -- TODO: this concat here is a performance disaster.+ -- Callers using 'process' should be rewritten to use 'unfolds'+ in (s2, concat nDst arrs)+{-# INLINE_ARRAY process #-}++++-- | Apply a generic stream process to an array.+--+unfolds :: ( BulkI lSrc a+ , BulkI lDst b+ , TargetI lDst b)+ => Name lDst -- ^ Name of destination layout.+ -> (a -> s -> (StepUnfold s b)) -- ^ Worker function.+ -> s -- ^ Initial state.+ -> Array lSrc a -- ^ Input array.+ -> (s, Array lDst b) -- ^ Result state and array.++unfolds nDst f s0 arr+ = let + work_process xa s+ = case f xa s of+ mxb -> return mxb+ {-# INLINE_ARRAY work_process #-}++ (arr', (_, s2, _))+ = A.unchainToArray nDst+ $ C.unfoldsC work_process s0 + $ A.chainOfArray arr++ in (s2, arr')+{-# INLINE_ARRAY unfolds #-}+
Data/Repa/Array/Internals/Operator/Reduce.hs view
@@ -1,9 +1,10 @@ +-- | Reduction operations on arrays. module Data.Repa.Array.Internals.Operator.Reduce ( foldl -- | Specialised reductions.- , prod, sum+ , product, sum , mean, std , correlate) where@@ -14,7 +15,7 @@ import Data.Repa.Eval.Stream as A import qualified Data.Vector.Fusion.Stream as S import Prelude - as P hiding (foldl, sum)+ as P hiding (foldl, sum, product) #include "repa-array.h" @@ -23,7 +24,7 @@ => (a -> b -> a) -> a -> Array l b -> a foldl f z arr- = S.foldl f z + = S.foldl' f z $ streamOfArray arr {-# INLINE_ARRAY foldl #-} @@ -35,9 +36,9 @@ -- | 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 #-}+product :: (BulkI l a, Num a) => Array l a -> a+product arr = foldl (*) 1 arr+{-# INLINE product #-} -- | Yield the mean value of the elements of an array.
+ Data/Repa/Array/Internals/Operator/Replicate.hs view
@@ -0,0 +1,26 @@++-- | Replicate operations on arrays.+module Data.Repa.Array.Internals.Operator.Replicate+ ( replicates )+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.Stream as S+#include "repa-array.h"+++-- | Segmented replicate.+replicates + :: (BulkI lSrc (Int, a), TargetI lDst a)+ => Name lDst+ -> Array lSrc (Int, a)+ -> Array lDst a++replicates nDst arr+ = A.unstreamToArray nDst+ $ S.replicatesS+ $ A.streamOfArray arr+{-# INLINE_ARRAY replicates #-}+
Data/Repa/Array/Internals/Target.hs view
@@ -1,15 +1,23 @@ module Data.Repa.Array.Internals.Target- ( Target (..), TargetI- , fromList, fromListInto)+ ( Target (..), TargetI+ , empty, singleton+ , fromList, fromListInto+ , mapMaybeS, mapEitherS+ , generateMaybeS, generateEitherS+ , unfoldEitherOfLengthIO) where import Data.Repa.Array.Generic.Index as A import Data.Repa.Array.Internals.Bulk as A import System.IO.Unsafe import Control.Monad-import Prelude as P+import qualified Data.Vector.Fusion.Stream.Monadic as S +import Prelude hiding (length)+import qualified Prelude as P+#include "repa-array.h" + -- Target --------------------------------------------------------------------- -- | Class of manifest array representations that can be constructed -- in a random-access manner.@@ -69,6 +77,30 @@ -------------------------------------------------------------------------------+-- | O(1). An empty array of the given layout.+empty :: TargetI l a+ => Name l -> Array l a+empty nDst+ = unsafePerformIO+ $ do let lDst = create nDst 0+ buf <- unsafeNewBuffer lDst+ unsafeFreezeBuffer buf+{-# INLINE_ARRAY empty #-}+++-- | O(1). Create a new empty array containing a single element.+singleton + :: TargetI l a+ => Name l -> a -> Array l a+singleton nDst x+ = unsafePerformIO+ $ do let lDst = create nDst 1+ buf <- unsafeNewBuffer lDst+ unsafeWriteBuffer buf 0 x+ unsafeFreezeBuffer buf+{-# INLINE_ARRAY singleton #-}++ -- | O(length src). Construct a linear array from a list of elements. fromList :: TargetI l a => Name l -> [a] -> Array l a@@ -94,9 +126,162 @@ if len /= size (extent lDst) then return Nothing else do- buf <- unsafeNewBuffer lDst+ !buf <- unsafeNewBuffer lDst zipWithM_ (unsafeWriteBuffer buf) [0..] xx arr <- unsafeFreezeBuffer buf return $ Just arr {-# NOINLINE fromListInto #-}+++-------------------------------------------------------------------------------+-- | Apply a function to every element of an array, +-- if any application returns `Nothing`, then `Nothing` for the whole result.+mapMaybeS + :: (BulkI lSrc a, TargetI lDst b)+ => Name lDst + -> (a -> Maybe b) + -> Array lSrc a+ -> Maybe (Array lDst b)++mapMaybeS !nDst f arr+ = generateMaybeS nDst (length arr) get_maybeS+ where + get_maybeS ix+ = f (index arr ix)+ {-# INLINE get_maybeS #-}+{-# INLINE_ARRAY mapMaybeS #-}+++-- | Apply a function to every element of an array, +-- if any application returns `Left`, then `Left` for the whole result.+mapEitherS + :: (BulkI lSrc a, TargetI lDst b)+ => Name lDst + -> (a -> Either err b) + -> Array lSrc a+ -> Either err (Array lDst b)++mapEitherS !nDst f arr+ = generateEitherS nDst (length arr) get_eitherS+ where + get_eitherS ix+ = f (index arr ix)+ {-# INLINE get_eitherS #-}+{-# INLINE_ARRAY mapEitherS #-}+++-------------------------------------------------------------------------------+-- | Generate an array of the given length by applying a function to+-- every index, sequentially. If any element returns `Nothing`,+-- then `Nothing` for the whole array.+generateMaybeS+ :: TargetI l a+ => Name l -> Int -> (Int -> Maybe a) + -> Maybe (Array l a)++generateMaybeS !nDst !len get+ = unsafePerformIO+ $ do+ let lDst = create nDst len+ !buf <- unsafeNewBuffer lDst++ let fill_generateMaybeS !ix+ | ix >= len+ = return ix++ | otherwise+ = case get ix of+ Nothing + -> return ix++ Just x + -> do unsafeWriteBuffer buf ix $! x+ fill_generateMaybeS (ix + 1)+ {-# INLINE fill_generateMaybeS #-}++ !pos <- fill_generateMaybeS 0+ if pos < len+ then return Nothing+ else fmap Just $! unsafeFreezeBuffer buf+{-# INLINE_ARRAY generateMaybeS #-}+++-- | Generate an array of the given length by applying a function to+-- every index, sequentially. If any element returns `Left`, +-- then `Left` for the whole array.+generateEitherS+ :: TargetI l a+ => Name l -> Int -> (Int -> Either err a) + -> Either err (Array l a)++generateEitherS !nDst !len get+ = unsafePerformIO+ $ do+ let lDst = create nDst len+ !buf <- unsafeNewBuffer lDst++ let fill_generateEitherS !ix+ | ix >= len+ = return Nothing++ | otherwise+ = case get ix of+ Left err + -> return $ Just err++ Right x + -> do unsafeWriteBuffer buf ix $! x+ fill_generateEitherS (ix + 1)+ {-# INLINE fill_generateEitherS #-}++ !mErr <- fill_generateEitherS 0+ case mErr of+ Just err -> return $ Left err+ Nothing -> fmap Right $! unsafeFreezeBuffer buf+{-# INLINE_ARRAY generateEitherS #-}+++---------------------------------------------------------------------------------------------------+-- | Unfold a new array using the given length and worker function.+--+-- This is like `generateEither`, except that an accumulator is +-- threaded sequentially through the elements.+--+unfoldEitherOfLengthIO+ :: TargetI l a+ => Name l -- ^ Destination format.+ -> Int -- ^ Length of array. + -> (Int -> acc -> IO (Either err (acc, a))) -- ^ Worker function.+ -> acc -- ^ Starting accumluator+ -> IO (Either err (acc, Array l a))++unfoldEitherOfLengthIO nDst len get acc0+ = do+ let lDst = create nDst len+ !buf <- unsafeNewBuffer lDst++ let fill_unfoldEither !sPEC !acc !ix+ | ix >= len + = return $ Right acc++ | otherwise+ = get ix acc >>= \r+ -> case r of+ Left err + -> return $ Left err++ Right (acc', x)+ -> do unsafeWriteBuffer buf ix $! x+ fill_unfoldEither sPEC acc' (ix + 1)+ {-# INLINE_INNER fill_unfoldEither #-}++ eErr <- fill_unfoldEither S.SPEC acc0 0+ case eErr of+ Left err + -> return $ Left err++ Right acc + -> do arr <- unsafeFreezeBuffer buf+ return $ Right (acc, arr)+{-# INLINE_ARRAY unfoldEitherOfLengthIO #-}
Data/Repa/Array/Material/Auto.hs view
@@ -3,10 +3,23 @@ ( A (..) , Name (..) , Array (..)- , Buffer (..))+ , Buffer (..)++ -- * Date utils+ , rangeDate32) where import Data.Repa.Array.Material.Auto.Base+import Data.Repa.Array.Material.Auto.InstArray+import Data.Repa.Array.Material.Auto.InstBox+import Data.Repa.Array.Material.Auto.InstChar+import Data.Repa.Array.Material.Auto.InstDate32 import Data.Repa.Array.Material.Auto.InstFloat import Data.Repa.Array.Material.Auto.InstInt+import Data.Repa.Array.Material.Auto.InstList+import Data.Repa.Array.Material.Auto.InstMaybe+import Data.Repa.Array.Material.Auto.InstProduct+import Data.Repa.Array.Material.Auto.InstTuple+import Data.Repa.Array.Material.Auto.InstText+import Data.Repa.Array.Material.Auto.InstUnit import Data.Repa.Array.Material.Auto.InstWord import Data.Repa.Array.Internals.Target
Data/Repa/Array/Material/Auto/Base.hs view
@@ -5,20 +5,14 @@ , 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. --@@ -48,436 +42,4 @@ 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 #-}
+ Data/Repa/Array/Material/Auto/InstArray.hs view
@@ -0,0 +1,116 @@+{-# OPTIONS_GHC -fno-warn-orphans #-}+{-# LANGUAGE UndecidableInstances #-}+module Data.Repa.Array.Material.Auto.InstArray where+import Data.Repa.Array.Material.Auto.InstWord as A+import Data.Repa.Array.Material.Auto.Base as A+import Data.Repa.Array.Material.Boxed as A+import Data.Repa.Array.Material.Nested as A+import Data.Repa.Array.Material.Foreign as A+import Data.Repa.Array.Meta.Window as A+import Data.Repa.Array.Generic.Convert as A+import Data.Repa.Array.Internals.Layout as A+import Data.Repa.Array.Internals.Bulk as A+import Data.Repa.Array.Internals.Target as A+import qualified Data.Vector.Unboxed as U+import qualified Data.Vector as V+import qualified Data.ByteString.Internal as BS+import qualified Data.Text.Encoding as T+import Data.Text (Text)+import Control.Monad+import Data.Word+#include "repa-array.h"+++instance (Bulk A 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_ARRAY 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_ARRAY 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_ARRAY convert #-}+++instance Convert A (Array A Word8) B Text where+ convert (AArray_Array (NArray starts lens (AArray_Word8 farrElems)))+ = let (BS.PS pElems iElems _nElems) + = toByteString farrElems+ in BArray $ V.fromList + $ zipWith + (\start len -> T.decodeUtf8 + $ BS.PS pElems (iElems + start) len)+ (U.toList starts)+ (U.toList lens)+ {-# INLINE_ARRAY convert #-}+++instance (Bulk l a, A.Target l a, Index l ~ Int) + => A.Target A (Array l a) where+ data Buffer A (Array l a)+ = ABuffer_Array !(A.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 (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 #-}+
+ Data/Repa/Array/Material/Auto/InstBox.hs view
@@ -0,0 +1,77 @@+{-# LANGUAGE UndecidableInstances, IncoherentInstances #-}+{-# OPTIONS_GHC -fno-warn-orphans #-}+module Data.Repa.Array.Material.Auto.InstBox where+import Data.Repa.Array.Material.Auto.Base as A+import Data.Repa.Array.Material.Boxed 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.Scalar.Box+import Control.Monad+#include "repa-array.h"+++instance Bulk B a => Bulk A (Box a) where+ data Array A (Box a) = AArray_Box !(Array B a)+ layout (AArray_Box arr) = Auto (A.length arr)+ index (AArray_Box arr) !ix = Box (A.index arr ix)+ {-# INLINE_ARRAY layout #-}+ {-# INLINE_ARRAY index #-}++deriving instance Show a => Show (Array A (Box a))+++instance Bulk B a => Windowable A (Box a) where+ window st len (AArray_Box arr) + = AArray_Box (window st len arr)+ {-# INLINE_ARRAY window #-}+++instance Target B a => Target A (Box a) where+ data Buffer A (Box a)+ = ABuffer_Box !(Buffer B a)++ unsafeNewBuffer (Auto len)+ = liftM ABuffer_Box $ unsafeNewBuffer (Boxed len)+ {-# INLINE_ARRAY unsafeNewBuffer #-}++ unsafeReadBuffer (ABuffer_Box arr) ix+ = do x <- unsafeReadBuffer arr ix+ return $ Box x+ {-# INLINE_ARRAY unsafeReadBuffer #-}++ unsafeWriteBuffer (ABuffer_Box arr) ix (Box x)+ = x `seq` unsafeWriteBuffer arr ix x+ {-# INLINE_ARRAY unsafeWriteBuffer #-}++ unsafeGrowBuffer (ABuffer_Box arr) bump+ = liftM ABuffer_Box $ unsafeGrowBuffer arr bump+ {-# INLINE_ARRAY unsafeGrowBuffer #-}++ unsafeFreezeBuffer (ABuffer_Box arr)+ = liftM AArray_Box $ unsafeFreezeBuffer arr + {-# INLINE_ARRAY unsafeFreezeBuffer #-}++ unsafeThawBuffer (AArray_Box arr)+ = liftM ABuffer_Box $ unsafeThawBuffer arr+ {-# INLINE_ARRAY unsafeThawBuffer #-}++ unsafeSliceBuffer st len (ABuffer_Box buf)+ = liftM ABuffer_Box $ unsafeSliceBuffer st len buf+ {-# INLINE_ARRAY unsafeSliceBuffer #-}++ touchBuffer (ABuffer_Box buf)+ = touchBuffer buf+ {-# INLINE_ARRAY touchBuffer #-}++ bufferLayout (ABuffer_Box buf)+ = Auto $ A.extent $ bufferLayout buf+ {-# INLINE_ARRAY bufferLayout #-}+++instance Eq a+ => Eq (Array A (Box a)) where+ (==) (AArray_Box arr1) (AArray_Box arr2) = arr1 == arr2+ {-# INLINE_ARRAY (==) #-}+
+ Data/Repa/Array/Material/Auto/InstChar.hs view
@@ -0,0 +1,87 @@+{-# OPTIONS_GHC -fno-warn-orphans #-}+{-# LANGUAGE UndecidableInstances #-}+module Data.Repa.Array.Material.Auto.InstChar 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.Meta.Window as A+import Data.Repa.Array.Generic.Convert as A+import Data.Repa.Array.Internals.Layout as A+import Data.Repa.Array.Internals.Bulk as A+import Data.Repa.Array.Internals.Target as A+import Control.Monad+#include "repa-array.h"+++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+ {-# INLINE_ARRAY convert #-}+++instance A.Convert A Char F Char where+ convert (AArray_Char arr) = arr+ {-# INLINE_ARRAY convert #-}+++instance Windowable A Char where+ window st len (AArray_Char arr) + = AArray_Char (window st len arr)+ {-# INLINE_ARRAY window #-}+++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 Eq (Array A Char) where+ (==) (AArray_Char arr1) (AArray_Char arr2) = arr1 == arr2+ {-# INLINE_ARRAY (==) #-}+
+ Data/Repa/Array/Material/Auto/InstDate32.hs view
@@ -0,0 +1,90 @@+{-# LANGUAGE UndecidableInstances #-}+{-# OPTIONS_GHC -fno-warn-orphans #-}+module Data.Repa.Array.Material.Auto.InstDate32+ (rangeDate32)+where+import Data.Repa.Array.Material.Auto.InstChar ()+import qualified Data.Repa.Array.Material.Auto.Base 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.Generic.Index as A+import qualified Data.Repa.Array.Generic as A+import qualified Data.Repa.Array.Meta.Window as A+import Data.Repa.Scalar.Date32+import Control.Monad+import Prelude as P+#include "repa-array.h"+++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 #-}+++---------------------------------------------------------------------------------------------------+-- | Yield an array containing a range of dates, inclusive of the end points.+---+-- TODO: avoid going via lists.+--+rangeDate32 :: Date32 -> Date32 -> A.Array A.A Date32+rangeDate32 from to + | to < from = A.fromList A.A []+ | otherwise = A.fromList A.A $ go [] from+ where+ go !acc !d + | d > to = P.reverse acc+ | otherwise = go (d : acc) (next d)+{-# NOINLINE rangeDate32 #-}+
Data/Repa/Array/Material/Auto/InstFloat.hs view
@@ -10,7 +10,6 @@ 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" @@ -26,9 +25,11 @@ instance Convert F Float A Float where convert arr = AArray_Float arr+ {-# INLINE_ARRAY convert #-} instance Convert A Float F Float where convert (AArray_Float arr) = arr+ {-# INLINE_ARRAY convert #-} instance Windowable A Float where window st len (AArray_Float arr) @@ -76,14 +77,6 @@ {-# 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)@@ -96,9 +89,11 @@ instance Convert F Double A Double where convert arr = AArray_Double arr+ {-# INLINE_ARRAY convert #-} instance Convert A Double F Double where convert (AArray_Double arr) = arr+ {-# INLINE_ARRAY convert #-} instance Windowable A Double where window st len (AArray_Double arr) @@ -145,10 +140,3 @@ = 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 #-}
Data/Repa/Array/Material/Auto/InstInt.hs view
@@ -10,7 +10,6 @@ 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"@@ -28,9 +27,11 @@ instance Convert F Int A Int where convert arr = AArray_Int arr+ {-# INLINE_ARRAY convert #-} instance Convert A Int F Int where convert (AArray_Int arr) = arr+ {-# INLINE_ARRAY convert #-} instance Windowable A Int where window st len (AArray_Int arr) @@ -78,14 +79,6 @@ {-# 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)@@ -98,9 +91,11 @@ instance Convert F Int8 A Int8 where convert arr = AArray_Int8 arr+ {-# INLINE_ARRAY convert #-} instance Convert A Int8 F Int8 where convert (AArray_Int8 arr) = arr+ {-# INLINE_ARRAY convert #-} instance Windowable A Int8 where window st len (AArray_Int8 arr) @@ -148,14 +143,6 @@ {-# 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)@@ -168,9 +155,11 @@ instance Convert F Int16 A Int16 where convert arr = AArray_Int16 arr+ {-# INLINE_ARRAY convert #-} instance Convert A Int16 F Int16 where convert (AArray_Int16 arr) = arr+ {-# INLINE_ARRAY convert #-} instance Windowable A Int16 where window st len (AArray_Int16 arr) @@ -218,14 +207,6 @@ {-# 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)@@ -238,9 +219,11 @@ instance Convert F Int32 A Int32 where convert arr = AArray_Int32 arr+ {-# INLINE_ARRAY convert #-} instance Convert A Int32 F Int32 where convert (AArray_Int32 arr) = arr+ {-# INLINE_ARRAY convert #-} instance Windowable A Int32 where window st len (AArray_Int32 arr) @@ -288,14 +271,6 @@ {-# 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)@@ -308,9 +283,11 @@ instance Convert F Int64 A Int64 where convert arr = AArray_Int64 arr+ {-# INLINE_ARRAY convert #-} instance Convert A Int64 F Int64 where convert (AArray_Int64 arr) = arr+ {-# INLINE_ARRAY convert #-} instance Windowable A Int64 where window st len (AArray_Int64 arr) @@ -356,12 +333,4 @@ 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 #-}
+ Data/Repa/Array/Material/Auto/InstList.hs view
@@ -0,0 +1,81 @@+{-# LANGUAGE UndecidableInstances, IncoherentInstances #-}+{-# OPTIONS_GHC -fno-warn-orphans #-}+module Data.Repa.Array.Material.Auto.InstList+ ( A (..)+ , Name (..)+ , Array (..))+where+import Data.Repa.Array.Material.Auto.Base as A+import Data.Repa.Array.Material.Boxed 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 Control.Monad+#include "repa-array.h"+++----------------------------------------------------------------------------------------------- []+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 Eq a+ => Eq (Array A [a]) where+ (==) (AArray_List arr1) (AArray_List arr2) = arr1 == arr2+ {-# INLINE (==) #-}++
+ Data/Repa/Array/Material/Auto/InstMaybe.hs view
@@ -0,0 +1,85 @@+{-# LANGUAGE UndecidableInstances, IncoherentInstances #-}+{-# OPTIONS_GHC -fno-warn-orphans #-}+module Data.Repa.Array.Material.Auto.InstMaybe+ ( A (..)+ , Name (..)+ , Array (..))+where+import Data.Repa.Array.Material.Auto.Base as A+import Data.Repa.Array.Material.Boxed 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 Control.Monad+#include "repa-array.h"+++instance Bulk A a => Bulk A (Maybe a) where+ data Array A (Maybe a)+ = AArray_Maybe !(Array B (Maybe a))++ layout (AArray_Maybe arr)+ = Auto (A.length arr)+ {-# INLINE_ARRAY layout #-}++ index (AArray_Maybe arr) ix + = A.index arr ix+ {-# INLINE_ARRAY index #-}++deriving instance Show a => Show (Array A (Maybe a))+++instance Bulk A a => Windowable A (Maybe a) where+ window st len (AArray_Maybe arr) + = AArray_Maybe (window st len arr)+ {-# INLINE_ARRAY window #-}+++instance Target A (Maybe a) where+ data Buffer A (Maybe a)+ = ABuffer_Maybe !(Buffer B (Maybe a))++ unsafeNewBuffer (Auto len)+ = liftM ABuffer_Maybe $ unsafeNewBuffer (Boxed len)+ {-# INLINE_ARRAY unsafeNewBuffer #-}++ unsafeReadBuffer (ABuffer_Maybe arr) ix+ = unsafeReadBuffer arr ix+ {-# INLINE_ARRAY unsafeReadBuffer #-}++ unsafeWriteBuffer (ABuffer_Maybe arr) ix !mx+ = unsafeWriteBuffer arr ix mx+ {-# INLINE_ARRAY unsafeWriteBuffer #-}++ unsafeGrowBuffer (ABuffer_Maybe arr) bump+ = liftM ABuffer_Maybe $ unsafeGrowBuffer arr bump+ {-# INLINE_ARRAY unsafeGrowBuffer #-}++ unsafeFreezeBuffer (ABuffer_Maybe arr)+ = liftM AArray_Maybe $ unsafeFreezeBuffer arr + {-# INLINE_ARRAY unsafeFreezeBuffer #-}++ unsafeThawBuffer (AArray_Maybe arr)+ = liftM ABuffer_Maybe $ unsafeThawBuffer arr+ {-# INLINE_ARRAY unsafeThawBuffer #-}++ unsafeSliceBuffer st len (ABuffer_Maybe buf)+ = liftM ABuffer_Maybe $ unsafeSliceBuffer st len buf+ {-# INLINE_ARRAY unsafeSliceBuffer #-}++ touchBuffer (ABuffer_Maybe buf)+ = touchBuffer buf+ {-# INLINE_ARRAY touchBuffer #-}++ bufferLayout (ABuffer_Maybe buf)+ = Auto $ A.extent $ bufferLayout buf+ {-# INLINE_ARRAY bufferLayout #-}+++instance Eq a+ => Eq (Array A (Maybe a)) where+ (==) (AArray_Maybe arr1) (AArray_Maybe arr2) = arr1 == arr2+ {-# INLINE (==) #-}++
+ Data/Repa/Array/Material/Auto/InstProduct.hs view
@@ -0,0 +1,230 @@+{-# OPTIONS_GHC -fno-warn-orphans -fno-warn-incomplete-patterns #-}+{-# LANGUAGE UndecidableInstances #-}+module Data.Repa.Array.Material.Auto.InstProduct+where+import Data.Repa.Array.Material.Auto.Base as A+import Data.Repa.Array.Material.Auto.InstUnit as A+import Data.Repa.Array.Meta.Tuple 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.Scalar.Singleton.Nat as D+import Data.Repa.Scalar.Product as D+import Control.Monad+#include "repa-array.h"+++---------------------------------------------------------------------------------------------------+-- Arrays of products are stored in columnar format to allow easy selecting+-- and addition of columns. +-- +-- Given an array of type (Array A (Int :*: Char :*: Bool :*: ())), this is+-- stored as a flat array of Int, a flat array of Char, and a flat array of+-- Bool. The unit colunm is stored as a simple count of the number of elements, +-- and serves as the Nil element in the list of column types.+--+-- Extracting particular column, getting the array of type (Array A Char)+-- is linear in the number of columns. Doing so takes about as long as+-- retrieving a single element from a cons-list.++----------------------------------------------------------------------------------------------- :*:+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 arrB) = Auto (min (A.length arrA) (A.length arrB))+ 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 (A.Windowable A a, A.Windowable A b)+ => A.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 (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 (==) #-}+++--------------------------------------------------------------------------------------------- Valid+instance IsProdList (Array A ()) where+ isProdList _ = True+ {-# INLINE isProdList #-}+++instance IsProdList (Array A ts) + => IsProdList (Array A (f :*: ts)) where+ isProdList (AArray_Prod _ arr2) = isProdList arr2+ {-# INLINE isProdList #-}+++-------------------------------------------------------------------------------------------- Select+instance IsProdList (Array A ts)+ => Select 'Z (Array A (t1 :*: ts)) where+ type Select' 'Z (Array A (t1 :*: ts)) = Array A t1+ select Zero (AArray_Prod x1 _) = x1+ {-# INLINE select #-}+++instance Select n (Array A ts)+ => Select ('S n) (Array A (t1 :*: ts)) where+ type Select' ('S n) (Array A (t1 :*: ts)) = Select' n (Array A ts)+ select (Succ n) (AArray_Prod _ xs) = select n xs+ {-# INLINE select #-}+++------------------------------------------------------------------------------------------- Discard+instance IsProdList (Array A ts)+ => Discard 'Z (Array A (t1 :*: ts)) where+ type Discard' 'Z (Array A (t1 :*: ts)) = Array A ts+ discard Zero (AArray_Prod _ xs) = xs+ {-# INLINE discard #-}+++instance ( Discard n (Array A ts)+ , Discard' n (Array A ts) ~ Array A (Discard' n ts))+ => Discard ('S n) (Array A (t1 :*: ts)) where+ type Discard' ('S n) (Array A (t1 :*: ts)) = Array A (t1 :*: Discard' n ts)+ discard (Succ n) (AArray_Prod x xs) = AArray_Prod x (discard n xs)+ {-# INLINE discard #-}+++---------------------------------------------------------------------------------------------- Mask+instance Mask () (Array A ()) where+ type Mask' () (Array A ()) = Array A ()+ mask () arr = arr+ {-# INLINE mask #-}+++instance ( Mask ms (Array A ts)+ , Mask' ms (Array A ts) ~ Array A (Mask' ms ts))+ => Mask (Keep :*: ms) (Array A (t1 :*: ts)) where+ type Mask' (Keep :*: ms) (Array A (t1 :*: ts)) = Array A (t1 :*: Mask' ms ts)+ mask (Keep :*: ms) (AArray_Prod x1 xs) = AArray_Prod x1 (mask ms xs)+ {-# INLINE mask #-}+++instance ( Mask ms (Array A ts))+ => Mask (Drop :*: ms) (Array A (t1 :*: ts)) where+ type Mask' (Drop :*: ms) (Array A (t1 :*: ts)) = Mask' ms (Array A ts)+ mask (Drop :*: ms) (AArray_Prod _ xs) = mask ms xs+ {-# INLINE mask #-}+++---------------------------------------------------------------------------------------------------+-- | Form the product of two arrays, in constant time.+prod :: Array A a -> Array A b -> Array A (a :*: b)+prod a1 a2 = AArray_Prod a1 a2+{-# INLINE prod #-}++-- | Unpack a product of two arrays, in constant time.+unprod :: Array A (a :*: b) -> (Array A a, Array A b)+unprod (AArray_Prod a1 a2) = (a1, a2)+{-# INLINE unprod #-}+++---------------------------------------------------------------------------------------------------+pattern Prod1 n a1 + = AArray_Prod a1+ (AArray_Unit n)++pattern Prod2 n a1 a2+ = AArray_Prod a1 (AArray_Prod a2+ (AArray_Unit n))++pattern Prod3 n a1 a2 a3+ = AArray_Prod a1 (AArray_Prod a2 (AArray_Prod a3+ (AArray_Unit n)))++pattern Prod4 n a1 a2 a3 a4+ = AArray_Prod a1 (AArray_Prod a2 (AArray_Prod a3 (AArray_Prod a4 + (AArray_Unit n))))++pattern Prod5 n a1 a2 a3 a4 a5 + = AArray_Prod a1 (AArray_Prod a2 (AArray_Prod a3 (AArray_Prod a4 + (AArray_Prod a5+ (AArray_Unit n)))))++pattern Prod6 n a1 a2 a3 a4 a5 a6+ = AArray_Prod a1 (AArray_Prod a2 (AArray_Prod a3 (AArray_Prod a4 + (AArray_Prod a5 (AArray_Prod a6+ (AArray_Unit n))))))++pattern Prod7 n a1 a2 a3 a4 a5 a6 a7+ = AArray_Prod a1 (AArray_Prod a2 (AArray_Prod a3 (AArray_Prod a4 + (AArray_Prod a5 (AArray_Prod a6 (AArray_Prod a7+ (AArray_Unit n)))))))++pattern Prod8 n a1 a2 a3 a4 a5 a6 a7 a8+ = AArray_Prod a1 (AArray_Prod a2 (AArray_Prod a3 (AArray_Prod a4 + (AArray_Prod a5 (AArray_Prod a6 (AArray_Prod a7 (AArray_Prod a8+ (AArray_Unit n))))))))++pattern Prod9 n a1 a2 a3 a4 a5 a6 a7 a8 a9+ = AArray_Prod a1 (AArray_Prod a2 (AArray_Prod a3 (AArray_Prod a4 + (AArray_Prod a5 (AArray_Prod a6 (AArray_Prod a7 (AArray_Prod a8+ (AArray_Prod a9 + (AArray_Unit n)))))))))+
+ Data/Repa/Array/Material/Auto/InstText.hs view
@@ -0,0 +1,81 @@+{-# LANGUAGE UndecidableInstances, IncoherentInstances #-}+{-# OPTIONS_GHC -fno-warn-orphans #-}+module Data.Repa.Array.Material.Auto.InstText+ ( A (..)+ , Name (..)+ , Array (..))+where+import Data.Repa.Array.Material.Auto.Base as A+import Data.Repa.Array.Material.Boxed 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 Control.Monad+import Data.Text (Text)+#include "repa-array.h"+++----------------------------------------------------------------------------------------------- []+-- TODO: The current representation is just a boxed array of Text strings,+-- we want to unpack these into a segmented rep during freezing.+instance Bulk A Text where+ data Array A Text = AArray_Text !(Array B Text)+ layout (AArray_Text arr) = Auto (A.length arr)+ index (AArray_Text arr) ix = A.index arr ix+ {-# INLINE_ARRAY layout #-}+ {-# INLINE_ARRAY index #-}++deriving instance Show (Array A Text)+++instance Windowable A Text where+ window st len (AArray_Text arr) + = AArray_Text (window st len arr)+ {-# INLINE_ARRAY window #-}+++instance Target A Text where+ data Buffer A Text+ = ABuffer_Text !(Buffer B Text)++ unsafeNewBuffer (Auto len) + = liftM ABuffer_Text $ unsafeNewBuffer (Boxed len)+ {-# INLINE_ARRAY unsafeNewBuffer #-}++ unsafeReadBuffer (ABuffer_Text arr) ix+ = unsafeReadBuffer arr ix+ {-# INLINE_ARRAY unsafeReadBuffer #-}++ unsafeWriteBuffer (ABuffer_Text arr) ix x+ = unsafeWriteBuffer arr ix x+ {-# INLINE_ARRAY unsafeWriteBuffer #-}++ unsafeGrowBuffer (ABuffer_Text arr) bump+ = liftM ABuffer_Text $ unsafeGrowBuffer arr bump+ {-# INLINE_ARRAY unsafeGrowBuffer #-}++ unsafeFreezeBuffer (ABuffer_Text arr)+ = liftM AArray_Text $ unsafeFreezeBuffer arr + {-# INLINE_ARRAY unsafeFreezeBuffer #-}++ unsafeThawBuffer (AArray_Text arr)+ = liftM ABuffer_Text $ unsafeThawBuffer arr+ {-# INLINE_ARRAY unsafeThawBuffer #-}++ unsafeSliceBuffer st len (ABuffer_Text buf)+ = liftM ABuffer_Text $ unsafeSliceBuffer st len buf+ {-# INLINE_ARRAY unsafeSliceBuffer #-}++ touchBuffer (ABuffer_Text buf)+ = touchBuffer buf+ {-# INLINE_ARRAY touchBuffer #-}++ bufferLayout (ABuffer_Text buf)+ = Auto $ A.extent $ bufferLayout buf+ {-# INLINE_ARRAY bufferLayout #-}+++instance Eq (Array A Text) where+ (==) (AArray_Text arr1) (AArray_Text arr2) = arr1 == arr2+ {-# INLINE (==) #-}
+ Data/Repa/Array/Material/Auto/InstTuple.hs view
@@ -0,0 +1,98 @@+{-# OPTIONS_GHC -fno-warn-orphans #-}+{-# LANGUAGE UndecidableInstances #-}+module Data.Repa.Array.Material.Auto.InstTuple where+import Data.Repa.Array.Material.Auto.Base as A+import Data.Repa.Array.Material.Boxed as A+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.Layout as A+import Data.Repa.Array.Internals.Bulk as A+import Data.Repa.Array.Internals.Target as A+import Control.Monad+#include "repa-array.h"+++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_ARRAY 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_ARRAY 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 Eq (Array (T2 A A) (a, b))+ => Eq (Array A (a, b)) where+ (==) (AArray_T2 arr1) (AArray_T2 arr2) = arr1 == arr2+ {-# INLINE (==) #-}+
+ Data/Repa/Array/Material/Auto/InstUnit.hs view
@@ -0,0 +1,65 @@+{-# OPTIONS_GHC -fno-warn-orphans #-}+module Data.Repa.Array.Material.Auto.InstUnit where+import Data.Repa.Array.Material.Auto.Base as A+import Data.Repa.Array.Material.Boxed 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+#include "repa-array.h"+++instance Bulk A () where+ data Array A () = AArray_Unit !Int+ layout (AArray_Unit len) = Auto len+ index (AArray_Unit _len) _ix = ()+ {-# INLINE_ARRAY layout #-}+ {-# INLINE_ARRAY index #-}++deriving instance Show (Array A ())+++instance Windowable A () where+ window _st len' (AArray_Unit _len)+ = AArray_Unit len'+++instance Target A () where+ data Buffer A () + = ABuffer_Unit !Int++ unsafeNewBuffer (Auto len) + = return $ ABuffer_Unit len+ {-# INLINE_ARRAY unsafeNewBuffer #-}++ unsafeReadBuffer (ABuffer_Unit _len) _ix+ = return ()+ {-# INLINE_ARRAY unsafeReadBuffer #-}++ unsafeWriteBuffer (ABuffer_Unit _len) _ix _x+ = return ()+ {-# INLINE_ARRAY unsafeWriteBuffer #-}++ unsafeGrowBuffer (ABuffer_Unit len) bump+ = return $ ABuffer_Unit (len + bump)+ {-# INLINE_ARRAY unsafeGrowBuffer #-}++ unsafeFreezeBuffer (ABuffer_Unit len)+ = return $ AArray_Unit len + {-# INLINE_ARRAY unsafeFreezeBuffer #-}++ unsafeThawBuffer (AArray_Unit len)+ = return $ ABuffer_Unit len+ {-# INLINE_ARRAY unsafeThawBuffer #-}++ unsafeSliceBuffer _st len (ABuffer_Unit _len)+ = return $ ABuffer_Unit len+ {-# INLINE_ARRAY unsafeSliceBuffer #-}++ touchBuffer (ABuffer_Unit _len)+ = return ()+ {-# INLINE_ARRAY touchBuffer #-}++ bufferLayout (ABuffer_Unit len)+ = Auto len+ {-# INLINE_ARRAY bufferLayout #-}+
Data/Repa/Array/Material/Auto/InstWord.hs view
@@ -10,7 +10,6 @@ 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"@@ -24,13 +23,16 @@ {-# INLINE_ARRAY layout #-} {-# INLINE_ARRAY index #-} + deriving instance Show (Array A Word8) instance Convert F Word8 A Word8 where convert arr = AArray_Word8 arr+ {-# INLINE_ARRAY convert #-} instance Convert A Word8 F Word8 where convert (AArray_Word8 arr) = arr+ {-# INLINE_ARRAY convert #-} instance Windowable A Word8 where window st len (AArray_Word8 arr) @@ -77,10 +79,3 @@ = 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 #-}
+ Data/Repa/Array/Material/Auto/Operator/Lines.hs view
@@ -0,0 +1,44 @@++module Data.Repa.Array.Material.Auto.Operator.Lines+ (findRowsStartEnd)+where+import Data.Repa.Array.Material.Auto.Base+import Data.Repa.Array.Material.Auto.InstInt ()+import Data.Repa.Array.Material.Auto.InstWord+import Data.Repa.Array.Material.Auto.InstTuple++import qualified Data.Repa.Array.Generic as G+import qualified Data.Repa.Array.Generic.Target as G+import qualified Data.Repa.Array.Generic.Index as G++import qualified Data.Repa.Stream as S+import qualified Data.Repa.Eval.Stream as S+import qualified Data.Vector.Fusion.Stream.Monadic as S++import Data.Word+import System.IO.Unsafe++-- | Given a row ending byte and a buffer containing encoded rows,+-- get buffers of row starting and ending indices.+findRowsStartEnd+ :: Word8+ -> G.Array A Word8+ -> (G.Buffer A Int, G.Buffer A Int)++findRowsStartEnd wSepLine (AArray_Word8 arrWords)+ = unsafePerformIO+ $ do+ let len = G.extent $ G.layout arrWords++ let (AArray_T2 (T2Array arr1 arr2))+ = S.unstreamToArray A+ $ S.findSegmentsS (const True) (== wSepLine) (len - 1)+ $ S.indexed+ $ S.streamOfArray+ $ arrWords++ buf1 <- G.unsafeThawBuffer arr1+ buf2 <- G.unsafeThawBuffer arr2++ return (buf1, buf2)+{-# NOINLINE findRowsStartEnd #-}
+ Data/Repa/Array/Material/Auto/Operator/Unpackables.hs view
@@ -0,0 +1,207 @@++module Data.Repa.Array.Material.Auto.Operator.Unpackables+ (Unpackables (..))+where++import Data.Repa.Convert.Format+import Data.Repa.Array.Material.Foreign+import Data.Repa.Array.Material.Auto+import qualified Data.Repa.Array.Generic.Unpacks as G++import Data.Repa.Convert.Formats++import Data.Word+++---------------------------------------------------------------------------------------------------+class Unpackables format where++ -- | Unpack an encoded table of values from an array of bytes,+ -- and write the result into an existing buffer.+ --+ -- The implementation invokes specialised code for each format.+ --+ unpacksToBuffer+ :: format+ -> Word8+ -> Array F Word8 -- ^ Encoded source data.+ -> Buffer A Int -- ^ Starting indices fields in current column.+ -> Buffer A Int -- ^ Ending indices each row.+ -> Buffer A (Value format) -- ^ Buffer to write the result fields to.+ -> IO (Maybe (Int, Int))+++instance Unpackable a => Unpackables (MaybeChars a) where+ unpacksToBuffer f c arr ixsStart ixsEnd bufOut+ = unpacksToBuffer_MaybeChars f c arr ixsStart ixsEnd bufOut+ {-# INLINE unpacksToBuffer #-}+++instance Unpackables VarChars where+ unpacksToBuffer f c arr ixsStart ixsEnd bufOut+ = unpacksToBuffer_VarChars f c arr ixsStart ixsEnd bufOut+ {-# INLINE unpacksToBuffer #-}+++instance Unpackables VarCharString where+ unpacksToBuffer f c arr ixsStart ixsEnd bufOut+ = unpacksToBuffer_VarCharString f c arr ixsStart ixsEnd bufOut+ {-# INLINE unpacksToBuffer #-}+++instance Unpackables VarText where+ unpacksToBuffer f c arr ixsStart ixsEnd bufOut + = unpacksToBuffer_VarText f c arr ixsStart ixsEnd bufOut+ {-# INLINE unpacksToBuffer #-}+++instance Unpackables VarTextString where+ unpacksToBuffer f c arr ixsStart ixsEnd bufOut+ = unpacksToBuffer_VarTextString f c arr ixsStart ixsEnd bufOut+ {-# INLINE unpacksToBuffer #-}+++instance Unpackables IntAsc where+ unpacksToBuffer f c arr ixsStart ixsEnd bufOut+ = unpacksToBuffer_IntAsc f c arr ixsStart ixsEnd bufOut+ {-# INLINE unpacksToBuffer #-}+++instance Unpackables IntAsc0 where+ unpacksToBuffer f c arr ixsStart ixsEnd bufOut+ = unpacksToBuffer_IntAsc0 f c arr ixsStart ixsEnd bufOut+ {-# INLINE unpacksToBuffer #-}+++instance Unpackables DoubleAsc where+ unpacksToBuffer f c arr ixsStart ixsEnd bufOut+ = unpacksToBuffer_DoubleAsc f c arr ixsStart ixsEnd bufOut+ {-# INLINE unpacksToBuffer #-}+++instance Unpackables DoubleFixedPack where+ unpacksToBuffer f c arr ixsStart ixsEnd bufOut+ = unpacksToBuffer_DoubleFixedPack f c arr ixsStart ixsEnd bufOut+ {-# INLINE unpacksToBuffer #-}+++instance Unpackables YYYYsMMsDD where+ unpacksToBuffer f c arr ixsStart ixsEnd bufOut+ = unpacksToBuffer_YYYYsMMsDD f c arr ixsStart ixsEnd bufOut+ {-# INLINE unpacksToBuffer #-}+++instance Unpackables DDsMMsYYYY where+ unpacksToBuffer f c arr ixsStart ixsEnd bufOut+ = unpacksToBuffer_DDsMMsYYYY f c arr ixsStart ixsEnd bufOut+ {-# INLINE unpacksToBuffer #-}+++instance Unpackables (Sep ()) where+ unpacksToBuffer _f _c _arr _ixsStart _ixsEnd _bufOut+ = return Nothing+ {-# INLINE unpacksToBuffer #-}+++instance ( Unpackables f1+ , Unpackables (Sep fs)+ , Value (Sep fs) ~ Value fs)+ => Unpackables (Sep (f1 :*: fs)) where++ unpacksToBuffer+ (SepCons _ fmt1 fmts) + c arr ixsStart ixsEnd + (ABuffer_Prod bufA bufs)+ = do mErr <- unpacksToBuffer fmt1 c arr ixsStart ixsEnd bufA+ case mErr of + Nothing -> unpacksToBuffer fmts c arr ixsStart ixsEnd bufs+ Just err -> return (Just err)+ {-# INLINE unpacksToBuffer #-}+ -- INLINE so that the sequence of calls to 'unpacksToBuffer' will+ -- be unfolded into the client module. The instances themselves are+ -- set to NOINLINE, so this won't cause code explosion.+++---------------------------------------------------------------------------------------------------+-- The following instances are hand specialised and set to NOINLINE+-- so that we only generate them once, and in this module. +-- We don't want to re-derive this code in client programs.+--+-- We define a top level binding for each instance to force specialisation.+-- Using the same code directly in a type class instance doesn't seem+-- to work.+--+type UnpacksColumn format+ = format+ -> Word8+ -> Array F Word8+ -> Buffer A Int+ -> Buffer A Int+ -> Buffer A (Value format)+ -> IO (Maybe (Int, Int))++unpacksToBuffer_MaybeChars :: Unpackable a => UnpacksColumn (MaybeChars a)+unpacksToBuffer_MaybeChars f@(MaybeChars _ _) c arr ixsStart ixsEnd ixsOut+ = G.unsafeUnpacksToBuffer f c arr ixsStart ixsEnd ixsOut+{-# NOINLINE unpacksToBuffer_MaybeChars #-}+++unpacksToBuffer_VarChars :: UnpacksColumn VarChars+unpacksToBuffer_VarChars f@VarChars c arr ixsStart ixsEnd ixsOut+ = G.unsafeUnpacksToBuffer f c arr ixsStart ixsEnd ixsOut+{-# NOINLINE unpacksToBuffer_VarChars #-}+++unpacksToBuffer_VarCharString :: UnpacksColumn VarCharString+unpacksToBuffer_VarCharString f@VarCharString c arr ixsStart ixsEnd ixsOut+ = G.unsafeUnpacksToBuffer f c arr ixsStart ixsEnd ixsOut+{-# NOINLINE unpacksToBuffer_VarCharString #-}+++unpacksToBuffer_VarText :: UnpacksColumn VarText+unpacksToBuffer_VarText f@VarText c arr ixsStart ixsEnd ixsOut+ = G.unsafeUnpacksToBuffer f c arr ixsStart ixsEnd ixsOut+{-# NOINLINE unpacksToBuffer_VarText #-}+++unpacksToBuffer_VarTextString :: UnpacksColumn VarTextString+unpacksToBuffer_VarTextString f@VarTextString c arr ixsStart ixsEnd ixsOut+ = G.unsafeUnpacksToBuffer f c arr ixsStart ixsEnd ixsOut+{-# NOINLINE unpacksToBuffer_VarTextString #-}+++unpacksToBuffer_IntAsc :: UnpacksColumn IntAsc+unpacksToBuffer_IntAsc f@IntAsc c arr ixsStart ixsEnd ixsOut+ = G.unsafeUnpacksToBuffer f c arr ixsStart ixsEnd ixsOut+{-# NOINLINE unpacksToBuffer_IntAsc #-}+++unpacksToBuffer_IntAsc0 :: UnpacksColumn IntAsc0+unpacksToBuffer_IntAsc0 f@(IntAsc0 _) c arr ixsStart ixsEnd ixsOut+ = G.unsafeUnpacksToBuffer f c arr ixsStart ixsEnd ixsOut+{-# NOINLINE unpacksToBuffer_IntAsc0 #-}+++unpacksToBuffer_DoubleAsc :: UnpacksColumn DoubleAsc+unpacksToBuffer_DoubleAsc f@DoubleAsc c arr ixsStart ixsEnd ixsOut+ = G.unsafeUnpacksToBuffer f c arr ixsStart ixsEnd ixsOut+{-# NOINLINE unpacksToBuffer_DoubleAsc #-}+++unpacksToBuffer_DoubleFixedPack :: UnpacksColumn DoubleFixedPack+unpacksToBuffer_DoubleFixedPack f@(DoubleFixedPack _) c arr ixsStart ixsEnd ixsOut+ = G.unsafeUnpacksToBuffer f c arr ixsStart ixsEnd ixsOut+{-# NOINLINE unpacksToBuffer_DoubleFixedPack #-}+++unpacksToBuffer_YYYYsMMsDD :: UnpacksColumn YYYYsMMsDD+unpacksToBuffer_YYYYsMMsDD f@(YYYYsMMsDD _) c arr ixsStart ixsEnd ixsOut+ = G.unsafeUnpacksToBuffer f c arr ixsStart ixsEnd ixsOut+{-# NOINLINE unpacksToBuffer_YYYYsMMsDD #-}+++unpacksToBuffer_DDsMMsYYYY :: UnpacksColumn DDsMMsYYYY+unpacksToBuffer_DDsMMsYYYY f@(DDsMMsYYYY _) c arr ixsStart ixsEnd ixsOut+ = G.unsafeUnpacksToBuffer f c arr ixsStart ixsEnd ixsOut+{-# NOINLINE unpacksToBuffer_DDsMMsYYYY #-}+
Data/Repa/Array/Material/Boxed.hs view
@@ -15,7 +15,6 @@ 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 Data.Word import Control.Monad import qualified Data.Vector as V@@ -72,7 +71,7 @@ -- | Boxed windows. instance Windowable B a where window st len (BArray vec)- = BArray (V.slice st len vec)+ = BArray (V.unsafeSlice st len vec) {-# INLINE_ARRAY window #-} @@ -126,13 +125,6 @@ {-# SPECIALIZE instance Target B Word16 #-} {-# SPECIALIZE instance Target B Word32 #-} {-# SPECIALIZE instance Target B Word64 #-}---instance Unpack (Buffer B a) (VM.IOVector a) where- unpack (BBuffer vec) = vec- repack _ vec = BBuffer vec- {-# INLINE_ARRAY unpack #-}- {-# INLINE_ARRAY repack #-} -------------------------------------------------------------------------------
Data/Repa/Array/Material/Foreign/Base.hs view
@@ -17,8 +17,6 @@ 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 @@ -81,18 +79,12 @@ 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)+ = FArray (S.unsafeSlice st len vec) {-# INLINE_ARRAY window #-} {-# SPECIALIZE instance Windowable F Char #-} {-# SPECIALIZE instance Windowable F Int #-}@@ -127,14 +119,6 @@ {-# 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 #-} -------------------------------------------------------------------------------
Data/Repa/Array/Material/Nested.hs view
@@ -40,7 +40,6 @@ 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.Repa.Vector.Generic as G@@ -51,7 +50,6 @@ 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)@@ -219,18 +217,6 @@ !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
− Data/Repa/Array/Material/Strided.hs
@@ -1,138 +0,0 @@--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 #-}-
Data/Repa/Array/Material/Unboxed.hs view
@@ -15,7 +15,6 @@ 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 import qualified Data.Vector.Unboxed as U@@ -85,18 +84,11 @@ {-# INLINE_ARRAY (==) #-} -instance Unpack (Array U a) (U.Vector a) where- unpack (UArray vec) = vec- repack !_ !vec = UArray vec- {-# INLINE_ARRAY unpack #-}- {-# INLINE_ARRAY repack #-}-- --------------------------------------------------------------------------------------------------- -- | Windowing Unboxed arrays. instance U.Unbox a => Windowable U a where window st len (UArray vec)- = UArray (U.slice st len vec)+ = UArray (U.unsafeSlice st len vec) {-# INLINE_ARRAY window #-} {-# SPECIALIZE instance Windowable U Int #-} {-# SPECIALIZE instance Windowable U Float #-}@@ -158,13 +150,6 @@ {-# SPECIALIZE instance Target U Word16 #-} {-# SPECIALIZE instance Target U Word32 #-} {-# SPECIALIZE instance Target U Word64 #-}---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 #-} ---------------------------------------------------------------------------------------------------
Data/Repa/Array/Meta/Dense.hs view
@@ -14,7 +14,6 @@ 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 @@ -126,15 +125,6 @@ {-# 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 #-} -------------------------------------------------------------------------------
Data/Repa/Array/Meta/Tuple.hs view
@@ -10,7 +10,6 @@ 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"@@ -139,16 +138,6 @@ 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 #-} -------------------------------------------------------------------------------
− Data/Repa/Bits/Date32.hs
@@ -1,287 +0,0 @@-{-# LANGUAGE UndecidableInstances #-}-module Data.Repa.Bits.Date32- ( Date32- , pack, unpack- , next- , range- , pretty- , readYYYYsMMsDD- , readDDsMMsYYYY)-where-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.------ The bitwise format is:------ @--- 32 16 8 0 --- | year | month | day |--- @------ Pros: Packing and unpacking a Date32 is simpler than using other formats--- that represent dates as a number of days from some epoch. We can also--- avoid worrying about what the epoch should be, and the representation--- will not overflow until year 65536. ------ Cons: Computing a range of dates is slower than with representations--- using an epoch, as we cannot simply add one to get to the next valid date.----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--- truncated so they fit in their destination fields.----pack :: (Word, Word, Word) -> Date32-pack (yy, mm, dd) - = Date32- $ ((fromIntegral yy .&. 0x0ffff) `shiftL` 16) - .|. ((fromIntegral mm .&. 0x0ff) `shiftL` 8)- .|. (fromIntegral dd .&. 0x0ff)-{-# INLINE pack #-}----- | Inverse of `pack`.------ This function does a simple bit-wise unpacking of the given `Word32`, --- and does not guarantee that the returned fields are within a valid --- range for the given calendar date.----unpack :: Date32 -> (Word, Word, Word)-unpack (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 (Date32 (W32# date))- = Date32 (W32# (next' date))-{-# INLINE next #-}--next' :: Word# -> Word#-next' !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-- 2 -> if yy `mod` 4 == 0 -- Feb- then if dd >= 29- then (yy, 3, 1) - else (yy, mm, dd + 1)- else if dd >= 28- then (yy, 3, 1)- else (yy, mm, dd + 1)-- 3 -> if dd >= 31 then (yy, 4, 1) else (yy, mm, dd + 1) -- Mar- 4 -> if dd >= 30 then (yy, 5, 1) else (yy, mm, dd + 1) -- Apr- 5 -> if dd >= 31 then (yy, 6, 1) else (yy, mm, dd + 1) -- May- 6 -> if dd >= 30 then (yy, 7, 1) else (yy, mm, dd + 1) -- Jun- 7 -> if dd >= 31 then (yy, 8, 1) else (yy, mm, dd + 1) -- Jul- 8 -> if dd >= 31 then (yy, 9, 1) else (yy, mm, dd + 1) -- Aug- 9 -> if dd >= 30 then (yy, 10, 1) else (yy, mm, dd + 1) -- Sep- 10 -> if dd >= 31 then (yy, 11, 1) else (yy, mm, dd + 1) -- Oct- 11 -> if dd >= 30 then (yy, 12, 1) else (yy, mm, dd + 1) -- Nov- 12 -> if dd >= 31 then (yy + 1, 1, 1) else (yy, mm, dd + 1) -- Dec- _ -> (0, 0, 0)- = case pack (yy', mm', dd') of- Date32 (W32# w) -> w-{-# NOINLINE next' #-}----- | Yield an array containing a range of dates, inclusive of the end points.------- TODO: avoid going via lists.----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- | otherwise = go (d : acc) (next d)-{-# NOINLINE range #-}--------------------------------------------------------------------------------------------------------- | Pretty print a `Date32`------- TODO: avoid going via lists.----pretty :: Char -- ^ Separator for components.- -> Date32 -- ^ Date to pretty print.- -> Array Char--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 #-}-
Data/Repa/Eval/Chain.hs view
@@ -6,7 +6,6 @@ , unchainToArrayIO) where 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@@ -49,7 +48,7 @@ -- | Compute the elements of a pure `Chain`, -- writing them into a new array `Array`. unchainToArray- :: (Target l a, Unpack (Buffer l a) t)+ :: Target l a => Name l -> Chain S.Id s a -> (Array l a, s) unchainToArray nDst c = unsafePerformIO@@ -61,7 +60,7 @@ -- | Compute the elements of an `IO` `Chain`, -- writing them to a new `Array`. unchainToArrayIO- :: (Target l a, Unpack (Buffer l a) t)+ :: Target l a => Name l -> Chain IO s a -> IO (Array l a, s) unchainToArrayIO nDst (Chain sz s0 step)@@ -99,9 +98,9 @@ = do !vec0 <- unsafeNewBuffer (create nDst zeroDim) !vec1 <- unsafeGrowBuffer vec0 nStart - let go_unchainIO_unknown !sPEC !uvec !i !n !s- = go_unchainIO_unknown1 (repack vec0 uvec) i n s- (\vec' i' n' s' -> go_unchainIO_unknown sPEC (unpack vec') i' n' s')+ let go_unchainIO_unknown !uvec !i !n !s + = go_unchainIO_unknown1 uvec i n s+ (\vec' i' n' s' -> go_unchainIO_unknown vec' i' n' s') (\result -> return result) go_unchainIO_unknown1 !vec !i !n !s cont done@@ -125,43 +124,7 @@ arr <- unsafeFreezeBuffer vec' done (arr, s') - go_unchainIO_unknown S.SPEC (unpack vec1) 0 nStart s0+ go_unchainIO_unknown vec1 0 nStart s0 {-# INLINE_INNER unchainToArrayIO_unknown #-} {-# INLINE_STREAM unchainToArrayIO #-} ---{-- -- This consuming function has been desugared so that the recursion- -- is via RealWorld, rather than using a function of type IO.- -- If the recursion is at IO then GHC tries to coerce to and from- -- IO at every recursive call, which messes up SpecConstr.- let go_unchainIO_unknown- :: Unpack (Buffer r a) t- => S.SPEC -> t -> Int -> Int -> s- -> State# RealWorld -> (# State# RealWorld, (Array r DIM1 a, s) #)-- go_unchainIO_unknown !sPEC !uvec !i !n !s !w0- = case unIO (step s) w0 of- (# w1, Yield e s' #)- | (# w2, (uvec', i', n') #)- <- unIO (do (vec', n')- <- if i >= n- then do vec' <- unsafeGrowBuffer (repack vec0 uvec) n- return (vec', n + n)- else return (repack vec0 uvec, n)- unsafeWriteBuffer vec' i e- return (unpack vec', i + 1, n'))- w1- -> (go_unchainIO_unknown sPEC uvec' i' n' s') w2-- (# w1, Skip s' #)- -> (go_unchainIO_unknown sPEC uvec i n s') w1-- (# w1, Done s' #)- -> (unIO $ do- vec' <- unsafeSliceBuffer 0 i (repack vec0 uvec)- arr <- unsafeFreezeBuffer (Z :. i) vec'- return (arr, s')) w1- {-# INLINE go_unchainIO_unknown #-}--}
Data/Repa/Eval/Stream.hs view
@@ -5,7 +5,6 @@ , unstreamToArray , unstreamToArrayIO) where-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@@ -33,7 +32,7 @@ -- | Compute the elements of a pure `Stream`, -- writing them into a new array `Array`. unstreamToArray- :: (Target l a, Unpack (Buffer l a) t)+ :: Target l a => Name l -> S.Stream S.Id a -> Array l a unstreamToArray nDst s@@ -46,7 +45,7 @@ -- | Compute the elements of an `IO` `Stream`, -- writing them to a new `Array`. unstreamToArrayIO- :: (Target l a, Unpack (Buffer l a) t)+ :: Target l a => Name l -> S.Stream IO a -> IO (Array l a) unstreamToArrayIO nDst (S.Stream step s0 sz)@@ -84,9 +83,9 @@ = 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')+ let go_unstreamIO_unknown !sPEC !vec !i !n !s+ = go_unstreamIO_unknown1 vec i n s+ (\vec' i' n' s' -> go_unstreamIO_unknown sPEC vec' i' n' s') (\result -> return result) go_unstreamIO_unknown1 !vec !i !n !s cont done@@ -110,6 +109,7 @@ arr <- unsafeFreezeBuffer vec' done arr - go_unstreamIO_unknown S.SPEC (unpack vec1) 0 nStart s0+ go_unstreamIO_unknown S.SPEC vec1 0 nStart s0 {-# INLINE_INNER unstreamToArrayIO_unknown #-} {-# INLINE_STREAM unstreamToArrayIO #-}+
Data/Repa/Nice.hs view
@@ -4,12 +4,13 @@ , Str (..) , Tok (..)) where-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+import Data.Word+import Control.Monad+import Data.Repa.Array.Generic as A+import Data.Repa.Scalar.Product as B+import Data.Repa.Scalar.Date32 (Date32)+import Prelude as P -- | Wrapper to indicate a list of characters should be printed as a string,@@ -106,6 +107,12 @@ instance Nicer Word64 where type Nice Word64 = Word64 nice x = x++-- Dates+instance Nicer Date32 where+ type Nice Date32 = Date32+ nice x = x+ -- Lists ----------------------------------------------------------------------
Data/Repa/Nice/Present.hs view
@@ -1,4 +1,4 @@-{-# LANGUAGE TypeSynonymInstances, FlexibleInstances, OverlappingInstances #-}+{-# LANGUAGE TypeSynonymInstances, FlexibleInstances #-} module Data.Repa.Nice.Present ( Presentable (..) , Present (..)@@ -11,14 +11,22 @@ where import Data.Monoid import Data.Word-import Data.Text (Text)-import qualified Data.Text as T-import Data.Repa.Nice (Str(..), Tok(..))+import Data.Text (Text)+import Data.Repa.Nice (Str(..), Tok(..))+import Data.Repa.Scalar.Product ((:*:) (..))+import Data.Repa.Scalar.Date32 (Date32)+import qualified Data.Text as T+import qualified Data.Repa.Scalar.Date32 as Date32+import Prelude as P + -- | A value, wrapped up nicely. data Present+ -- | Nothing to present.+ = Blank+ -- | An atomic thing.- = Atom Text+ | Atom Text -- | Many of the same thing, to display with list brackets @[.. , ..]@ | Many [Present]@@ -32,6 +40,7 @@ depth :: Present -> Int depth pp = case pp of+ Blank{} -> 0 Atom{} -> 0 Many ps -> 1 + (case ps of [] -> 0@@ -53,6 +62,7 @@ -- | Flatten a present into text flatten :: Present -> Text +flatten Blank = T.pack "" flatten (Atom str) = str flatten (Many ps) = T.pack "[" <> (T.intercalate (T.pack ",") $ map flatten ps) <> T.pack "]"@@ -69,54 +79,101 @@ class Presentable a where present :: a -> Present ++instance Presentable () where+ present _ = Blank++ instance Presentable Char where present = Atom . T.pack . show + instance Presentable Int where present = Atom . T.pack . show + instance Presentable Float where present = Atom . T.pack . show + instance Presentable Double where present = Atom . T.pack . show + instance Presentable Word8 where present = Atom . T.pack . show + instance Presentable Word16 where present = Atom . T.pack . show + instance Presentable Word32 where present = Atom . T.pack . show + instance Presentable Word64 where present = Atom . T.pack . show ++instance Presentable Date32 where+ present d+ | (yy, mm, dd) <- Date32.unpack d+ = let cSep = '/'+ 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 Atom $ T.pack $ P.concat [yy', [cSep], mm', [cSep], dd']++ instance Presentable Str where present (Str xs) = Atom $ T.pack (show xs) + instance Presentable Tok where present (Tok xs) = Atom $ T.pack xs + instance Presentable a => Presentable [a] where present xs = Many $ map present xs + instance (Presentable a, Presentable b)+ => Presentable (a :*: b) where++ present (xa :*: xb)+ = let aa = case present xa of+ Blank -> []+ Atom x -> [Atom x]+ Many xx -> xx+ Some xx -> xx++ bb = case present xb of+ Blank -> []+ Atom x -> [Atom x]+ Many xx -> xx+ Some xx -> xx+ in Some (aa ++ bb)+++instance (Presentable a, Presentable b) => Presentable (a, b) where present (a, b) = Some [present a, present b] + instance (Presentable a, Presentable b, Presentable c) => Presentable (a, b, c) where present (a, b, c) = Some [present a, present b, present c] + instance (Presentable a, Presentable b, Presentable c, Presentable d) => Presentable (a, b, c, d) where present (a, b, c, d) = Some [present a, present b, present c, present d]+ instance (Presentable a, Presentable b, Presentable c, Presentable d, Presentable e) => Presentable (a, b, c, d, e) where
Data/Repa/Nice/Tabulate.hs view
@@ -1,4 +1,4 @@-{-# LANGUAGE UndecidableInstances, OverlappingInstances #-}+{-# LANGUAGE UndecidableInstances #-} module Data.Repa.Nice.Tabulate ( tab , tabulate@@ -10,7 +10,6 @@ import Data.List as L import qualified Data.Text as T import Data.Text (Text)-import Data.Monoid import Data.Maybe
repa-array.cabal view
@@ -1,5 +1,5 @@ Name: repa-array-Version: 4.1.0.1+Version: 4.2.2.1 License: BSD3 License-file: LICENSE Author: The Repa Development Team@@ -24,35 +24,39 @@ Library build-Depends: - base == 4.7.*,- primitive == 0.5.*,+ base == 4.8.*,+ primitive == 0.6.*, vector == 0.10.*, bytestring == 0.10.*, mtl == 2.2.*, double-conversion == 2.0.*, text == 1.2.*, repa-eval == 4.0.0.*,- repa-stream == 4.1.0.*,- repa-convert == 4.1.0.*+ repa-stream == 4.2.2.*,+ repa-scalar == 4.2.2.*,+ repa-convert == 4.2.2.*,+ filelock >= 0.1.0 && < 0.2 + exposed-modules: Data.Repa.Array.Auto Data.Repa.Array.Auto.IO+ Data.Repa.Array.Auto.XSV Data.Repa.Array.Auto.Convert- Data.Repa.Array.Auto.Unpack+ Data.Repa.Array.Auto.Format Data.Repa.Array.Generic.Convert Data.Repa.Array.Generic.Index- Data.Repa.Array.Generic.Load Data.Repa.Array.Generic.Slice+ Data.Repa.Array.Generic.Load Data.Repa.Array.Generic.Target+ Data.Repa.Array.Generic.Unpacks 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.Material@@ -66,8 +70,6 @@ Data.Repa.Array.Meta.Window Data.Repa.Array.Meta - Data.Repa.Bits.Date32- Data.Repa.Eval.Chain Data.Repa.Eval.Stream @@ -84,9 +86,21 @@ Data.Repa.Array.Auto.Base Data.Repa.Array.Auto.Operator + Data.Repa.Array.Material.Auto.Operator.Lines+ Data.Repa.Array.Material.Auto.Operator.Unpackables Data.Repa.Array.Material.Auto.Base+ Data.Repa.Array.Material.Auto.InstArray+ Data.Repa.Array.Material.Auto.InstBox+ Data.Repa.Array.Material.Auto.InstChar+ Data.Repa.Array.Material.Auto.InstDate32 Data.Repa.Array.Material.Auto.InstFloat Data.Repa.Array.Material.Auto.InstInt+ Data.Repa.Array.Material.Auto.InstList+ Data.Repa.Array.Material.Auto.InstMaybe+ Data.Repa.Array.Material.Auto.InstProduct+ Data.Repa.Array.Material.Auto.InstText+ Data.Repa.Array.Material.Auto.InstTuple+ Data.Repa.Array.Material.Auto.InstUnit Data.Repa.Array.Material.Auto.InstWord Data.Repa.Array.Material.Foreign.Base@@ -98,7 +112,9 @@ Data.Repa.Array.Internals.Operator.Merge Data.Repa.Array.Internals.Operator.Insert Data.Repa.Array.Internals.Operator.Partition+ Data.Repa.Array.Internals.Operator.Process Data.Repa.Array.Internals.Operator.Reduce+ Data.Repa.Array.Internals.Operator.Replicate Data.Repa.Array.Internals.Operator.Filter Data.Repa.Array.Internals.Bulk@@ -120,26 +136,26 @@ extensions: CPP- BangPatterns- NoMonomorphismRestriction- RankNTypes MagicHash- UnboxedTuples- ScopedTypeVariables+ DataKinds+ RankNTypes+ InstanceSigs+ TypeFamilies+ ViewPatterns+ BangPatterns PatternGuards- FlexibleInstances- FlexibleContexts+ UnboxedTuples TypeOperators- TypeFamilies- DefaultSignatures- MultiParamTypeClasses EmptyDataDecls+ ConstraintKinds+ PatternSynonyms+ FlexibleContexts+ DefaultSignatures+ FlexibleInstances StandaloneDeriving+ ScopedTypeVariables+ MultiParamTypeClasses FunctionalDependencies- ConstraintKinds ForeignFunctionInterface- ViewPatterns+ NoMonomorphismRestriction ExistentialQuantification- InstanceSigs--