accelerate-io 0.12.1.0 → 0.13.0.0
raw patch · 8 files changed
+489/−136 lines, 8 filesdep +bmpdep ~acceleratedep ~arraydep ~bytestringnew-uploader
Dependencies added: bmp
Dependency ranges changed: accelerate, array, bytestring, repa, vector
Files
- Data/Array/Accelerate/IO.hs +20/−14
- Data/Array/Accelerate/IO/BMP.hs +132/−0
- Data/Array/Accelerate/IO/BlockCopy.hs +116/−63
- Data/Array/Accelerate/IO/ByteString.hs +1/−1
- Data/Array/Accelerate/IO/Ptr.hs +2/−2
- Data/Array/Accelerate/IO/Repa.hs +23/−9
- Data/Array/Accelerate/IO/Vector.hs +172/−36
- accelerate-io.cabal +23/−11
Data/Array/Accelerate/IO.hs view
@@ -10,29 +10,35 @@ -- This module provides efficient conversion routines between different array -- types and Accelerate arrays. ----- The Repa interface provides an efficient non-copying instance for Repa to--- read and write directly into arrays that can then be passed to Accelerate.--- Additional copying conversions of low-level primitive arrays (i.e. one--- dimensional, row-major blocks of contiguous memory) are provided, however to--- use these you should really know what you are doing. Potential pitfalls--- include:------ * copying from memory your program doesn't have access to (e.g. it may be--- unallocated, or not enough memory is allocated)------ * memory alignment errors--- module Data.Array.Accelerate.IO ( - module Data.Array.Accelerate.IO.ByteString,- module Data.Array.Accelerate.IO.Ptr,+ -- * Array libraries module Data.Array.Accelerate.IO.Repa, module Data.Array.Accelerate.IO.Vector, + -- * Specialised file IO+ module Data.Array.Accelerate.IO.BMP,++ -- * Low-level conversions+ --+ -- | Copying conversions of low-level primitive data, stored in+ -- one-dimensional row-major blocks of contiguous memory. To use these, you+ -- should really know what you are doing. Potential pitfalls include:+ --+ -- * copying from memory your program doesn't have access to (e.g. it may be+ -- unallocated, or not enough memory is allocated)+ --+ -- * memory alignment errors+ --+ module Data.Array.Accelerate.IO.ByteString,+ module Data.Array.Accelerate.IO.Ptr,+ ) where import Data.Array.Accelerate.IO.ByteString+import Data.Array.Accelerate.IO.BMP import Data.Array.Accelerate.IO.Ptr import Data.Array.Accelerate.IO.Repa import Data.Array.Accelerate.IO.Vector+
+ Data/Array/Accelerate/IO/BMP.hs view
@@ -0,0 +1,132 @@+-- |+-- Module : Data.Array.Accelerate.IO.BMP+-- Copyright : [2012] Trevor L. McDonell+-- License : BSD3+--+-- Maintainer : Manuel M T Chakravarty <chak@cse.unsw.edu.au>+-- Stability : experimental+-- Portability : non-portable (GHC extensions)+--++module Data.Array.Accelerate.IO.BMP (++ -- ** Bitmap images+ --+ -- | Reading and writing arrays as uncompressed 24 or 32-bit Windows BMP+ -- files.+ --+ RGBA32,+ readImageFromBMP, writeImageToBMP,++ -- *** Manipulating pixels+ unpackRGBA32, packRGBA32, luminanceOfRGBA32, rgba32OfLuminance, rgba32OfFloat,++) where++import Data.Bits+import Data.Word+import Codec.BMP++import Data.Array.Accelerate as A+import Data.Array.Accelerate.IO.ByteString as A+++-- File IO ---------------------------------------------------------------------++-- | Read RGBA components from a BMP file.+--+readImageFromBMP :: FilePath -> IO (Either Error (Array DIM2 RGBA32))+readImageFromBMP file = do+ ebmp <- readBMP file+ case ebmp of+ Left err -> return $ Left err+ Right bmp -> do+ let (w,h) = bmpDimensions bmp+ bs = unpackBMPToRGBA32 bmp+ --+ Right `fmap` A.fromByteString (Z :. h :. w) ((), bs)+++-- | Write the image data to a file.+--+writeImageToBMP :: FilePath -> Array DIM2 RGBA32 -> IO ()+writeImageToBMP file rgba = do+ let Z :. h :. w = A.arrayShape rgba+ ((), bs) <- A.toByteString rgba+ --+ writeBMP file (packRGBA32ToBMP w h bs)+++-- Manipulating pixels ---------------------------------------------------------+--+-- TLM: perhaps this should be moved into something like:+-- accelerate-algorithms:Data.Array.Accelerate.Algorithms.Pixel+--++-- | Packed RGBA pixel data+--+type RGBA32 = Word32++-- | Unpack a 'RGBA32' value into a tuple of (Red, Green, Blue, Alpha) values.+--+unpackRGBA32 :: Exp RGBA32 -> Exp (Word8, Word8, Word8, Word8)+unpackRGBA32 rgba =+ let r = A.fromIntegral $ rgba .&. 0xFF+ g = A.fromIntegral $ (rgba `div` 0x100) .&. 0xFF+ b = A.fromIntegral $ (rgba `div` 0x10000) .&. 0xFF+ a = A.fromIntegral $ (rgba `div` 0x1000000) .&. 0xFF+ in+ lift (r, g, b, a)+++-- | Promote a tuple of (Red, Green, Blue, Alpha) values into a packed 'RGBA32'+-- value.+--+packRGBA32 :: Exp (Word8, Word8, Word8, Word8) -> Exp RGBA32+packRGBA32 rgba =+ let (r', g', b', a') = unlift rgba+ r = A.fromIntegral r'+ g = (A.fromIntegral g') * 0x100+ b = (A.fromIntegral b') * 0x10000+ a = (A.fromIntegral a') * 0x1000000+ in+ r + g + b + a+++-- | Convert an RGBA colour to its luminance value in the range [0..1].+--+luminanceOfRGBA32 :: (Elt a, IsFloating a) => Exp RGBA32 -> Exp a+luminanceOfRGBA32 rgba =+ let r = 0.3 * A.fromIntegral (rgba .&. 0xFF)+ g = 0.59 * A.fromIntegral ((rgba `div` 0x100) .&. 0xFF)+ b = 0.11 * A.fromIntegral ((rgba `div` 0x10000) .&. 0xFF)+ in+ (r + g + b) / 255+++-- | Convert a value in the range [0..1] to a grey RGB colour.+--+rgba32OfLuminance :: (Elt a, IsFloating a) => Exp a -> Exp RGBA32+rgba32OfLuminance val =+ let v = A.truncate (255 * val) -- (0 `A.max` val `A.min` 1)+ r = v+ g = v * 0x100+ b = v * 0x10000+ a = 0xFF000000+ in+ r + g + b + a+++-- | Promote a tuple of (Red, Green, Blue, Alpha) values in the range [0..1]+-- into a packed 'RGBA32'.+--+rgba32OfFloat :: (Elt a, IsFloating a) => Exp (a, a, a, a) -> Exp RGBA32+rgba32OfFloat rgba =+ let (r, g, b, a) = unlift rgba+ r' = A.truncate (255 * r) * 0x1000000+ g' = A.truncate (255 * g) * 0x10000+ b' = A.truncate (255 * b) * 0x100+ a' = A.truncate (255 * a)+ in+ r' + g' + b' + a'+
Data/Array/Accelerate/IO/BlockCopy.hs view
@@ -15,7 +15,7 @@ BlockCopyFun, BlockCopyFuns, BlockPtrs, ByteStrings, -- * The low-level machinery- allocateArray, blockCopyFunGenerator+ allocateArray, blockCopy, blockCopyFunGenerator ) where @@ -51,22 +51,35 @@ -- type family BlockCopyFuns e -type instance BlockCopyFuns () = ()-type instance BlockCopyFuns Int = BlockCopyFun Int-type instance BlockCopyFuns Int8 = BlockCopyFun Int8-type instance BlockCopyFuns Int16 = BlockCopyFun Int16-type instance BlockCopyFuns Int32 = BlockCopyFun Int32-type instance BlockCopyFuns Int64 = BlockCopyFun Int64-type instance BlockCopyFuns Word = BlockCopyFun Word-type instance BlockCopyFuns Word8 = BlockCopyFun Word8-type instance BlockCopyFuns Word16 = BlockCopyFun Word16-type instance BlockCopyFuns Word32 = BlockCopyFun Word32-type instance BlockCopyFuns Word64 = BlockCopyFun Word64-type instance BlockCopyFuns Float = BlockCopyFun Float-type instance BlockCopyFuns Double = BlockCopyFun Double-type instance BlockCopyFuns Bool = BlockCopyFun Word8-type instance BlockCopyFuns Char = BlockCopyFun Char-type instance BlockCopyFuns (a,b) = (BlockCopyFuns a, BlockCopyFuns b)+type instance BlockCopyFuns () = ()+type instance BlockCopyFuns Int = BlockCopyFun Int+type instance BlockCopyFuns Int8 = BlockCopyFun Int8+type instance BlockCopyFuns Int16 = BlockCopyFun Int16+type instance BlockCopyFuns Int32 = BlockCopyFun Int32+type instance BlockCopyFuns Int64 = BlockCopyFun Int64+type instance BlockCopyFuns Word = BlockCopyFun Word+type instance BlockCopyFuns Word8 = BlockCopyFun Word8+type instance BlockCopyFuns Word16 = BlockCopyFun Word16+type instance BlockCopyFuns Word32 = BlockCopyFun Word32+type instance BlockCopyFuns Word64 = BlockCopyFun Word64+type instance BlockCopyFuns CShort = BlockCopyFun Int16+type instance BlockCopyFuns CUShort = BlockCopyFun Word16+type instance BlockCopyFuns CInt = BlockCopyFun Int32+type instance BlockCopyFuns CUInt = BlockCopyFun Word32+type instance BlockCopyFuns CLong = BlockCopyFun Int64+type instance BlockCopyFuns CULong = BlockCopyFun Word64+type instance BlockCopyFuns CLLong = BlockCopyFun Int64+type instance BlockCopyFuns CULLong = BlockCopyFun Word64+type instance BlockCopyFuns Float = BlockCopyFun Float+type instance BlockCopyFuns Double = BlockCopyFun Double+type instance BlockCopyFuns CFloat = BlockCopyFun Float+type instance BlockCopyFuns CDouble = BlockCopyFun Double+type instance BlockCopyFuns Bool = BlockCopyFun Word8+type instance BlockCopyFuns Char = BlockCopyFun Char+type instance BlockCopyFuns CChar = BlockCopyFun Int8+type instance BlockCopyFuns CSChar = BlockCopyFun Int8+type instance BlockCopyFuns CUChar = BlockCopyFun Word8+type instance BlockCopyFuns (a,b) = (BlockCopyFuns a, BlockCopyFuns b) -- | A family of types that represents a collection of pointers that are the -- source/destination addresses for a block copy. The structure of the@@ -80,22 +93,35 @@ -- type family BlockPtrs e -type instance BlockPtrs () = ()-type instance BlockPtrs Int = Ptr Int-type instance BlockPtrs Int8 = Ptr Int8-type instance BlockPtrs Int16 = Ptr Int16-type instance BlockPtrs Int32 = Ptr Int32-type instance BlockPtrs Int64 = Ptr Int64-type instance BlockPtrs Word = Ptr Word-type instance BlockPtrs Word8 = Ptr Word8-type instance BlockPtrs Word16 = Ptr Word16-type instance BlockPtrs Word32 = Ptr Word32-type instance BlockPtrs Word64 = Ptr Word64-type instance BlockPtrs Float = Ptr Float-type instance BlockPtrs Double = Ptr Double-type instance BlockPtrs Bool = Ptr Word8-type instance BlockPtrs Char = Ptr Char-type instance BlockPtrs (a,b) = (BlockPtrs a, BlockPtrs b)+type instance BlockPtrs () = ()+type instance BlockPtrs Int = Ptr Int+type instance BlockPtrs Int8 = Ptr Int8+type instance BlockPtrs Int16 = Ptr Int16+type instance BlockPtrs Int32 = Ptr Int32+type instance BlockPtrs Int64 = Ptr Int64+type instance BlockPtrs Word = Ptr Word+type instance BlockPtrs Word8 = Ptr Word8+type instance BlockPtrs Word16 = Ptr Word16+type instance BlockPtrs Word32 = Ptr Word32+type instance BlockPtrs Word64 = Ptr Word64+type instance BlockPtrs CShort = Ptr Int16+type instance BlockPtrs CUShort = Ptr Word16+type instance BlockPtrs CInt = Ptr Int32+type instance BlockPtrs CUInt = Ptr Word32+type instance BlockPtrs CLong = Ptr Int64+type instance BlockPtrs CULong = Ptr Word64+type instance BlockPtrs CLLong = Ptr Int64+type instance BlockPtrs CULLong = Ptr Word64+type instance BlockPtrs Float = Ptr Float+type instance BlockPtrs Double = Ptr Double+type instance BlockPtrs CFloat = Ptr Float+type instance BlockPtrs CDouble = Ptr Double+type instance BlockPtrs Bool = Ptr Word8+type instance BlockPtrs Char = Ptr Char+type instance BlockPtrs CChar = Ptr Int8+type instance BlockPtrs CSChar = Ptr Int8+type instance BlockPtrs CUChar = Ptr Word8+type instance BlockPtrs (a,b) = (BlockPtrs a, BlockPtrs b) -- | A family of types that represents a collection of 'ByteString's. They are -- the source data for function 'fromByteString' and the result data for@@ -103,22 +129,36 @@ -- type family ByteStrings e -type instance ByteStrings () = ()-type instance ByteStrings Int = ByteString-type instance ByteStrings Int8 = ByteString-type instance ByteStrings Int16 = ByteString-type instance ByteStrings Int32 = ByteString-type instance ByteStrings Int64 = ByteString-type instance ByteStrings Word = ByteString-type instance ByteStrings Word8 = ByteString-type instance ByteStrings Word16 = ByteString-type instance ByteStrings Word32 = ByteString-type instance ByteStrings Word64 = ByteString-type instance ByteStrings Float = ByteString-type instance ByteStrings Double = ByteString-type instance ByteStrings Bool = ByteString-type instance ByteStrings Char = ByteString-type instance ByteStrings (a,b) = (ByteStrings a, ByteStrings b)+type instance ByteStrings () = ()+type instance ByteStrings Int = ByteString+type instance ByteStrings Int8 = ByteString+type instance ByteStrings Int16 = ByteString+type instance ByteStrings Int32 = ByteString+type instance ByteStrings Int64 = ByteString+type instance ByteStrings Word = ByteString+type instance ByteStrings Word8 = ByteString+type instance ByteStrings Word16 = ByteString+type instance ByteStrings Word32 = ByteString+type instance ByteStrings Word64 = ByteString+type instance ByteStrings CShort = ByteString+type instance ByteStrings CUShort = ByteString+type instance ByteStrings CInt = ByteString+type instance ByteStrings CUInt = ByteString+type instance ByteStrings CLong = ByteString+type instance ByteStrings CULong = ByteString+type instance ByteStrings CLLong = ByteString+type instance ByteStrings CULLong = ByteString+type instance ByteStrings CShort = ByteString+type instance ByteStrings Float = ByteString+type instance ByteStrings Double = ByteString+type instance ByteStrings CFloat = ByteString+type instance ByteStrings CDouble = ByteString+type instance ByteStrings Bool = ByteString+type instance ByteStrings Char = ByteString+type instance ByteStrings CChar = ByteString+type instance ByteStrings CSChar = ByteString+type instance ByteStrings CUChar = ByteString+type instance ByteStrings (a,b) = (ByteStrings a, ByteStrings b) type GenFuns e = (( BlockPtrs e -> IO ()@@ -152,20 +192,33 @@ sizeA = size (shape array) aux :: ArrayEltR e -> ArrayData e -> GenFuns e aux ArrayEltRunit _ = let f () = return () in ((f,f),(f,return ()),f)- aux ArrayEltRint ad = base (ptrsOfArrayData ad) (box wORD_SCALE sizeA)- aux ArrayEltRint8 ad = base (ptrsOfArrayData ad) sizeA- aux ArrayEltRint16 ad = base (ptrsOfArrayData ad) (sizeA * 2)- aux ArrayEltRint32 ad = base (ptrsOfArrayData ad) (sizeA * 4)- aux ArrayEltRint64 ad = base (ptrsOfArrayData ad) (sizeA * 8)- aux ArrayEltRword ad = base (ptrsOfArrayData ad) (box wORD_SCALE sizeA)- aux ArrayEltRword8 ad = base (ptrsOfArrayData ad) sizeA- aux ArrayEltRword16 ad = base (ptrsOfArrayData ad) (sizeA * 2)- aux ArrayEltRword32 ad = base (ptrsOfArrayData ad) (sizeA * 4)- aux ArrayEltRword64 ad = base (ptrsOfArrayData ad) (sizeA * 8)- aux ArrayEltRfloat ad = base (ptrsOfArrayData ad) (box fLOAT_SCALE sizeA)- aux ArrayEltRdouble ad = base (ptrsOfArrayData ad) (box dOUBLE_SCALE sizeA)- aux ArrayEltRbool ad = base (ptrsOfArrayData ad) sizeA- aux ArrayEltRchar ad = base (ptrsOfArrayData ad) (sizeA * 4)+ aux ArrayEltRint ad = base (ptrsOfArrayData ad) (box wORD_SCALE sizeA)+ aux ArrayEltRint8 ad = base (ptrsOfArrayData ad) sizeA+ aux ArrayEltRint16 ad = base (ptrsOfArrayData ad) (sizeA * 2)+ aux ArrayEltRint32 ad = base (ptrsOfArrayData ad) (sizeA * 4)+ aux ArrayEltRint64 ad = base (ptrsOfArrayData ad) (sizeA * 8)+ aux ArrayEltRword ad = base (ptrsOfArrayData ad) (box wORD_SCALE sizeA)+ aux ArrayEltRword8 ad = base (ptrsOfArrayData ad) sizeA+ aux ArrayEltRword16 ad = base (ptrsOfArrayData ad) (sizeA * 2)+ aux ArrayEltRword32 ad = base (ptrsOfArrayData ad) (sizeA * 4)+ aux ArrayEltRword64 ad = base (ptrsOfArrayData ad) (sizeA * 8)+ aux ArrayEltRcshort ad = base (ptrsOfArrayData ad) (sizeA * 2)+ aux ArrayEltRcushort ad = base (ptrsOfArrayData ad) (sizeA * 2)+ aux ArrayEltRcint ad = base (ptrsOfArrayData ad) (sizeA * 4)+ aux ArrayEltRcuint ad = base (ptrsOfArrayData ad) (sizeA * 4)+ aux ArrayEltRclong ad = base (ptrsOfArrayData ad) (sizeA * 8)+ aux ArrayEltRculong ad = base (ptrsOfArrayData ad) (sizeA * 8)+ aux ArrayEltRcllong ad = base (ptrsOfArrayData ad) (sizeA * 8)+ aux ArrayEltRcullong ad = base (ptrsOfArrayData ad) (sizeA * 8)+ aux ArrayEltRfloat ad = base (ptrsOfArrayData ad) (box fLOAT_SCALE sizeA)+ aux ArrayEltRcfloat ad = base (ptrsOfArrayData ad) (box fLOAT_SCALE sizeA)+ aux ArrayEltRdouble ad = base (ptrsOfArrayData ad) (box dOUBLE_SCALE sizeA)+ aux ArrayEltRcdouble ad = base (ptrsOfArrayData ad) (box dOUBLE_SCALE sizeA)+ aux ArrayEltRbool ad = base (ptrsOfArrayData ad) sizeA+ aux ArrayEltRchar ad = base (ptrsOfArrayData ad) (sizeA * 4)+ aux ArrayEltRcchar ad = base (ptrsOfArrayData ad) sizeA+ aux ArrayEltRcschar ad = base (ptrsOfArrayData ad) sizeA+ aux ArrayEltRcuchar ad = base (ptrsOfArrayData ad) sizeA aux (ArrayEltRpair a b) (AD_Pair ad1 ad2) = ((bpFromC, bsFromC), (bpToC, bsToC), toH) where ((bpFromC1, bsFromC1), (bpToC1, bsToC1), toH1) = aux a ad1
Data/Array/Accelerate/IO/ByteString.hs view
@@ -10,7 +10,7 @@ module Data.Array.Accelerate.IO.ByteString ( - -- * Copy to/from (strict) ByteString`s+ -- ** Data.ByteString ByteStrings, fromByteString, toByteString ) where
Data/Array/Accelerate/IO/Ptr.hs view
@@ -10,10 +10,10 @@ module Data.Array.Accelerate.IO.Ptr ( - -- * Copying to/from raw pointers+ -- ** Raw pointers BlockPtrs, fromPtr, toPtr, - -- * Direct copying into/from an Accelerate array+ -- ** Direct copying functions BlockCopyFun, BlockCopyFuns, fromArray, toArray ) where
Data/Array/Accelerate/IO/Repa.hs view
@@ -19,6 +19,18 @@ module Data.Array.Accelerate.IO.Repa ( + -- ** Data.Array.Repa+ --+ -- | This provides an efficient non-copying Repa manifest array representation+ -- that can be passed directly to Accelerate.+ --+ -- The standard rules for dealing with manifest Repa arrays apply:+ --+ -- * If you want to have Repa 'R.computeP' directly into an Accelerate array,+ -- the source array must have a delayed representation.+ --+ -- * If you want to copy between manifest arrays, use 'R.copyP' instead.+ -- A, Shapes, fromRepa, toRepa, computeAccS, computeAccP@@ -36,7 +48,7 @@ -- | Index conversion and equivalence statement between Repa and Accelerate -- array shapes. That is, a n-dimensional Repa array will produce an--- n-dimensional accelerate array of the same extent, and vice-versa.+-- n-dimensional Accelerate array of the same extent, and vice-versa. -- class (R.Shape r, A.Shape a) => Shapes r a | a -> r, r -> a where -- these are really equivalent representations, so unsafeCoerce would probably@@ -57,12 +69,13 @@ toA (sr R.:. sz) = toA sr A.:. sz --- | An implementation based on `Data.Array.Accelerate` arrays. The Accelerate--- array implementation is based on type families and picks an efficient,--- unboxed representation for every element type. Moreover, these arrays can be--- handed efficiently (without copying) to Accelerate programs for, example,--- further parallel computation on the GPU.+-- | The representation tag for manifest arrays based on Data.Array.Accelerate. --+-- The Accelerate array implementation is based on type families and picks an+-- efficient, unboxed representation for every element type. Moreover, these+-- arrays can be handed efficiently (without copying) to Accelerate programs+-- for further computation.+-- data A -- Repr ------------------------------------------------------------------------@@ -81,14 +94,14 @@ {-# INLINE linearIndex #-} linearIndex (AAccelerate sh adata) ix | ix >= 0 && ix < R.size sh- = A.toElt (adata `A.indexArrayData` ix)+ = A.toElt (adata `A.unsafeIndexArrayData` ix) | otherwise = error "Repa: accelerate array out of bounds" {-# INLINE unsafeLinearIndex #-} unsafeLinearIndex (AAccelerate _ adata) ix- = A.toElt (adata `A.indexArrayData` ix)+ = A.toElt (adata `A.unsafeIndexArrayData` ix) {-# INLINE deepSeqArray #-} deepSeqArray (AAccelerate sh adata) x@@ -108,7 +121,7 @@ {-# INLINE unsafeWriteMVec #-} unsafeWriteMVec (MAVec mad) n e = unsafeSTToIO- $ A.writeArrayData mad n (A.fromElt e)+ $ A.unsafeWriteArrayData mad n (A.fromElt e) {-# INLINE unsafeFreezeMVec #-} unsafeFreezeMVec sh (MAVec mad)@@ -163,3 +176,4 @@ -> m (R.Array A sh e) {-# INLINE computeAccP #-} computeAccP = R.computeP+
Data/Array/Accelerate/IO/Vector.hs view
@@ -1,6 +1,10 @@+{-# LANGUAGE GADTs #-}+{-# LANGUAGE MagicHash #-}+{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE TypeFamilies #-} -- | -- Module : Data.Array.Accelerate.IO.Vector--- Copyright : [2012] Adam C. Foltzer+-- Copyright : [2012] Adam C. Foltzer, Trevor L. McDonell -- License : BSD3 -- -- Maintainer : Manuel M T Chakravarty <chak@cse.unsw.edu.au>@@ -9,47 +13,179 @@ -- -- Helpers for fast conversion of 'Data.Vector.Storable' vectors into -- Accelerate arrays.+--+ module Data.Array.Accelerate.IO.Vector (- -- * Vector conversions- fromVector- , toVector- , fromVectorIO- , toVectorIO-) where -import Data.Array.Accelerate ( arrayShape- , Array- , DIM1- , Elt- , Z(..)- , (:.)(..))-import Data.Array.Accelerate.Array.Sugar (EltRepr)-import Data.Array.Accelerate.IO.Ptr-import Data.Vector.Storable ( unsafeFromForeignPtr0- , unsafeToForeignPtr0- , Vector)+ -- ** Data.Vector.Storable+ Vectors, toVectors, fromVectors, -import Foreign (mallocForeignPtrArray, Ptr, Storable, withForeignPtr)+) where +-- standard libraries+import Data.Int+import Data.Word+import Data.Vector.Storable+import Foreign.Ptr+import Foreign.C.Types+import Foreign.ForeignPtr import System.IO.Unsafe+import GHC.Base ( Int(..), Int# )+import Data.Array.Base ( wORD_SCALE, fLOAT_SCALE, dOUBLE_SCALE ) -fromVectorIO :: (Storable a, Elt a, BlockPtrs (EltRepr a) ~ ((), Ptr a))- => Vector a -> IO (Array DIM1 a)-fromVectorIO v = withForeignPtr fp $ \ptr -> fromPtr (Z :. len) ((), ptr)- where (fp, len) = unsafeToForeignPtr0 v+-- friends+import Data.Array.Accelerate.Array.Data+import Data.Array.Accelerate.Array.Sugar hiding ( Vector )+import Data.Array.Accelerate.IO.BlockCopy -toVectorIO :: (Storable a, Elt a, BlockPtrs (EltRepr a) ~ ((), Ptr a)) - => Array DIM1 a -> IO (Vector a)-toVectorIO arr = do- let (Z :. len) = arrayShape arr- fp <- mallocForeignPtrArray len- withForeignPtr fp $ \ptr -> toPtr arr ((), ptr)- return $ unsafeFromForeignPtr0 fp len -fromVector :: (Storable a, Elt a, BlockPtrs (EltRepr a) ~ ((), Ptr a))- => Vector a -> Array DIM1 a-fromVector v = unsafePerformIO $ fromVectorIO v+-- | A family of types that represents a collection of storable 'Vector's. The+-- structure of the collection depends on the element type @e@.+--+-- For example:+--+-- * if @e :: Int@, then @Vectors (EltRepr e) :: ((), Vector Int)@+--+-- * if @e :: (Double, Float)@, then @Vectors (EltRepr e) :: (((), Vector Double), Vector Float)@+--+type family Vectors e -toVector :: (Storable a, Elt a, BlockPtrs (EltRepr a) ~ ((), Ptr a)) - => Array DIM1 a -> Vector a-toVector arr = unsafePerformIO $ toVectorIO arr+type instance Vectors () = ()+type instance Vectors Int = Vector Int+type instance Vectors Int8 = Vector Int8+type instance Vectors Int16 = Vector Int16+type instance Vectors Int32 = Vector Int32+type instance Vectors Int64 = Vector Int64+type instance Vectors Word = Vector Word+type instance Vectors Word8 = Vector Word8+type instance Vectors Word16 = Vector Word16+type instance Vectors Word32 = Vector Word32+type instance Vectors Word64 = Vector Word64+type instance Vectors CShort = Vector Int16+type instance Vectors CUShort = Vector Word16+type instance Vectors CInt = Vector Int32+type instance Vectors CUInt = Vector Word32+type instance Vectors CLong = Vector Int64+type instance Vectors CULong = Vector Word64+type instance Vectors CLLong = Vector Int64+type instance Vectors CULLong = Vector Word64+type instance Vectors Float = Vector Float+type instance Vectors CFloat = Vector Float+type instance Vectors Double = Vector Double+type instance Vectors CDouble = Vector Double+type instance Vectors Bool = Vector Word8+type instance Vectors Char = Vector Char+type instance Vectors CChar = Vector Int8+type instance Vectors CSChar = Vector Int8+type instance Vectors CUChar = Vector Word8+type instance Vectors (a,b) = (Vectors a, Vectors b)+++-- | /O(n)/. Copy a set of storable vectors into freshly allocated Accelerate+-- arrays. The type of elements @e@ in the output Accelerate array determines+-- the structure of the collection that will be required as the second argument.+-- See 'Vectors'.+--+-- Data will be consumed from the vector in row-major order. You must make sure+-- that each of the input vectors contains the right number of elements.+--+fromVectors :: (Shape sh, Elt e) => sh -> Vectors (EltRepr e) -> Array sh e+fromVectors sh vecs = unsafePerformIO $! do+ aux arrayElt adata vecs+ return array+ where+ sizeA = size sh+ array@(Array _ adata) = allocateArray sh+ base accPtr bytes vec = unsafeWith vec $ \vecPtr -> blockCopy vecPtr accPtr bytes++ aux :: ArrayEltR e -> ArrayData e -> Vectors e -> IO ()+ aux ArrayEltRunit _ = return+ aux ArrayEltRint ad = base (ptrsOfArrayData ad) (box wORD_SCALE sizeA)+ aux ArrayEltRint8 ad = base (ptrsOfArrayData ad) sizeA+ aux ArrayEltRint16 ad = base (ptrsOfArrayData ad) (sizeA * 2)+ aux ArrayEltRint32 ad = base (ptrsOfArrayData ad) (sizeA * 4)+ aux ArrayEltRint64 ad = base (ptrsOfArrayData ad) (sizeA * 8)+ aux ArrayEltRword ad = base (ptrsOfArrayData ad) (box wORD_SCALE sizeA)+ aux ArrayEltRword8 ad = base (ptrsOfArrayData ad) sizeA+ aux ArrayEltRword16 ad = base (ptrsOfArrayData ad) (sizeA * 2)+ aux ArrayEltRword32 ad = base (ptrsOfArrayData ad) (sizeA * 4)+ aux ArrayEltRword64 ad = base (ptrsOfArrayData ad) (sizeA * 8)+ aux ArrayEltRcshort ad = base (ptrsOfArrayData ad) (sizeA * 2)+ aux ArrayEltRcushort ad = base (ptrsOfArrayData ad) (sizeA * 2)+ aux ArrayEltRcint ad = base (ptrsOfArrayData ad) (sizeA * 4)+ aux ArrayEltRcuint ad = base (ptrsOfArrayData ad) (sizeA * 4)+ aux ArrayEltRclong ad = base (ptrsOfArrayData ad) (sizeA * 8)+ aux ArrayEltRculong ad = base (ptrsOfArrayData ad) (sizeA * 8)+ aux ArrayEltRcllong ad = base (ptrsOfArrayData ad) (sizeA * 8)+ aux ArrayEltRcullong ad = base (ptrsOfArrayData ad) (sizeA * 8)+ aux ArrayEltRfloat ad = base (ptrsOfArrayData ad) (box fLOAT_SCALE sizeA)+ aux ArrayEltRcfloat ad = base (ptrsOfArrayData ad) (box fLOAT_SCALE sizeA)+ aux ArrayEltRdouble ad = base (ptrsOfArrayData ad) (box dOUBLE_SCALE sizeA)+ aux ArrayEltRcdouble ad = base (ptrsOfArrayData ad) (box dOUBLE_SCALE sizeA)+ aux ArrayEltRbool ad = base (ptrsOfArrayData ad) sizeA+ aux ArrayEltRchar ad = base (ptrsOfArrayData ad) (sizeA * 4)+ aux ArrayEltRcchar ad = base (ptrsOfArrayData ad) sizeA+ aux ArrayEltRcschar ad = base (ptrsOfArrayData ad) sizeA+ aux ArrayEltRcuchar ad = base (ptrsOfArrayData ad) sizeA+ aux (ArrayEltRpair ae1 ae2) (AD_Pair ad1 ad2) = \(v1, v2) -> do+ aux ae1 ad1 v1+ aux ae2 ad2 v2+++-- | /O(n)/. Turn the Accelerate array into a collection of storable 'Vector's.+-- The element type of the array @e@ will determine the structure of the output+-- collection. See 'Vectors'.+--+-- Data will be output in row-major order.+--+toVectors :: (Shape sh, Elt e) => Array sh e -> Vectors (EltRepr e)+toVectors array@(Array _ adata) = unsafePerformIO $! aux arrayElt adata+ where+ sizeA = size (shape array)++ base :: Storable a => Ptr a -> Int -> IO (Vector a)+ base accPtr bytes = do+ fp <- mallocForeignPtrBytes bytes+ withForeignPtr fp $ \vecPtr -> blockCopy accPtr vecPtr bytes+ return $! unsafeFromForeignPtr0 fp sizeA++ aux :: ArrayEltR e -> ArrayData e -> IO (Vectors e)+ aux ArrayEltRunit _ = return ()+ aux ArrayEltRint ad = base (ptrsOfArrayData ad) (box wORD_SCALE sizeA)+ aux ArrayEltRint8 ad = base (ptrsOfArrayData ad) sizeA+ aux ArrayEltRint16 ad = base (ptrsOfArrayData ad) (sizeA * 2)+ aux ArrayEltRint32 ad = base (ptrsOfArrayData ad) (sizeA * 4)+ aux ArrayEltRint64 ad = base (ptrsOfArrayData ad) (sizeA * 8)+ aux ArrayEltRword ad = base (ptrsOfArrayData ad) (box wORD_SCALE sizeA)+ aux ArrayEltRword8 ad = base (ptrsOfArrayData ad) sizeA+ aux ArrayEltRword16 ad = base (ptrsOfArrayData ad) (sizeA * 2)+ aux ArrayEltRword32 ad = base (ptrsOfArrayData ad) (sizeA * 4)+ aux ArrayEltRword64 ad = base (ptrsOfArrayData ad) (sizeA * 8)+ aux ArrayEltRcshort ad = base (ptrsOfArrayData ad) (sizeA * 2)+ aux ArrayEltRcushort ad = base (ptrsOfArrayData ad) (sizeA * 2)+ aux ArrayEltRcint ad = base (ptrsOfArrayData ad) (sizeA * 4)+ aux ArrayEltRcuint ad = base (ptrsOfArrayData ad) (sizeA * 4)+ aux ArrayEltRclong ad = base (ptrsOfArrayData ad) (sizeA * 8)+ aux ArrayEltRculong ad = base (ptrsOfArrayData ad) (sizeA * 8)+ aux ArrayEltRcllong ad = base (ptrsOfArrayData ad) (sizeA * 8)+ aux ArrayEltRcullong ad = base (ptrsOfArrayData ad) (sizeA * 8)+ aux ArrayEltRfloat ad = base (ptrsOfArrayData ad) (box fLOAT_SCALE sizeA)+ aux ArrayEltRcfloat ad = base (ptrsOfArrayData ad) (box fLOAT_SCALE sizeA)+ aux ArrayEltRdouble ad = base (ptrsOfArrayData ad) (box dOUBLE_SCALE sizeA)+ aux ArrayEltRcdouble ad = base (ptrsOfArrayData ad) (box dOUBLE_SCALE sizeA)+ aux ArrayEltRbool ad = base (ptrsOfArrayData ad) sizeA+ aux ArrayEltRchar ad = base (ptrsOfArrayData ad) (sizeA * 4)+ aux ArrayEltRcchar ad = base (ptrsOfArrayData ad) sizeA+ aux ArrayEltRcschar ad = base (ptrsOfArrayData ad) sizeA+ aux ArrayEltRcuchar ad = base (ptrsOfArrayData ad) sizeA+ aux (ArrayEltRpair ae1 ae2) (AD_Pair ad1 ad2) =+ do v1 <- aux ae1 ad1+ v2 <- aux ae2 ad2+ return (v1, v2)+++-- Helpers+--+box :: (Int# -> Int#) -> Int -> Int+box f (I# x) = I# (f x)+
accelerate-io.cabal view
@@ -1,12 +1,16 @@ Name: accelerate-io-Version: 0.12.1.0+Version: 0.13.0.0 Cabal-version: >= 1.6 Tested-with: GHC >= 7.0.3 Build-type: Simple Synopsis: Read and write Accelerate arrays in various formats-Description: This package provides efficient conversion routines between a range of array types- and Accelerate arrays.+Description:+ This package provides efficient conversion routines between a range of array+ types and Accelerate arrays.+ .+ Refer to the main /Accelerate/ package for more information:+ <http://hackage.haskell.org/package/accelerate> License: BSD3 License-file: LICENSE@@ -15,10 +19,10 @@ Sean Lee, Trevor L. McDonell Maintainer: Manuel M T Chakravarty <chak@cse.unsw.edu.au>-Homepage: http://www.cse.unsw.edu.au/~chak/project/accelerate/+Homepage: https://github.com/AccelerateHS/accelerate-io Bug-reports: https://github.com/AccelerateHS/accelerate/issues -Category: Compilers/Interpreters, Concurrency, Data+Category: Compilers/Interpreters, Concurrency, Data, Parallelism Stability: Experimental Extra-source-files: include/accelerate.h@@ -37,16 +41,18 @@ Library Include-Dirs: include- Build-depends: accelerate >= 0.12.1 && < 0.13,- array >= 0.3,+ Build-depends: accelerate == 0.13.*, base == 4.*,- bytestring >= 0.9,- repa >= 3.2,- vector >= 0.9+ array >= 0.3 && < 0.5,+ bmp >= 1.2 && < 1.3,+ bytestring >= 0.9 && < 0.11,+ repa >= 3.2 && < 3.3,+ vector >= 0.9 && < 0.11 Exposed-modules: Data.Array.Accelerate.IO Other-modules: Data.Array.Accelerate.IO.BlockCopy Data.Array.Accelerate.IO.ByteString+ Data.Array.Accelerate.IO.BMP Data.Array.Accelerate.IO.Ptr Data.Array.Accelerate.IO.Repa Data.Array.Accelerate.IO.Vector@@ -62,8 +68,14 @@ ghc-options: -O2 -Wall -funbox-strict-fields - Extensions: TypeFamilies + -- Don't add the extensions list here. Instead, place individual LANGUAGE+ -- pragmas in the files that require a specific extension. This means the+ -- project loads in GHCi, and avoids extension clashes.+ --+ -- Extensions:+ Source-repository head Type: git Location: git://github.com/AccelerateHS/accelerate-io.git+