accelerate-io 0.15.1.0 → 1.0.0.0
raw patch · 9 files changed
+148/−138 lines, 9 filesdep ~acceleratedep ~base
Dependency ranges changed: accelerate, base
Files
- Data/Array/Accelerate/IO.hs +5/−3
- Data/Array/Accelerate/IO/BMP.hs +11/−98
- Data/Array/Accelerate/IO/BlockCopy.hs +1/−1
- Data/Array/Accelerate/IO/ByteString.hs +1/−1
- Data/Array/Accelerate/IO/IArray.hs +81/−0
- Data/Array/Accelerate/IO/Ptr.hs +1/−2
- Data/Array/Accelerate/IO/Repa.hs +1/−2
- Data/Array/Accelerate/IO/Vector.hs +12/−8
- accelerate-io.cabal +35/−23
Data/Array/Accelerate/IO.hs view
@@ -1,10 +1,10 @@ -- | -- Module : Data.Array.Accelerate.IO -- Copyright : [2010..2012] Sean Seefried--- [2010..2014] Trevor L. McDonell+-- [2010..2016] Trevor L. McDonell -- License : BSD3 ----- Maintainer : Manuel M T Chakravarty <chak@cse.unsw.edu.au>+-- Maintainer : Trevor L. McDonell <tmcdonell@cse.unsw.edu.au> -- Stability : experimental -- Portability : non-portable (GHC extensions) --@@ -17,6 +17,7 @@ -- * Array libraries module Data.Array.Accelerate.IO.Repa, module Data.Array.Accelerate.IO.Vector,+ module Data.Array.Accelerate.IO.IArray, -- * Specialised file IO module Data.Array.Accelerate.IO.BMP,@@ -37,8 +38,9 @@ ) where -import Data.Array.Accelerate.IO.ByteString import Data.Array.Accelerate.IO.BMP+import Data.Array.Accelerate.IO.ByteString+import Data.Array.Accelerate.IO.IArray 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
@@ -1,14 +1,16 @@-{-# LANGUAGE ScopedTypeVariables #-}-{-# LANGUAGE ViewPatterns #-} -- | -- Module : Data.Array.Accelerate.IO.BMP -- Copyright : [2012..2014] Trevor L. McDonell -- License : BSD3 ----- Maintainer : Manuel M T Chakravarty <chak@cse.unsw.edu.au>+-- Maintainer : Trevor L. McDonell <tmcdonell@cse.unsw.edu.au> -- Stability : experimental -- Portability : non-portable (GHC extensions) --+-- Read and write BMP images into a packed-word RGBA format. See the+-- /colour-accelerate/ package for colour representations and utilities such as+-- packing and unpacking.+-- module Data.Array.Accelerate.IO.BMP ( @@ -20,12 +22,8 @@ RGBA32, readImageFromBMP, writeImageToBMP, - -- *** Manipulating pixels- unpackRGBA32, packRGBA32, luminanceOfRGBA32, rgba32OfLuminance, rgba32OfFloat,- ) where -import Data.Bits import Data.Word import Codec.BMP @@ -33,6 +31,10 @@ import Data.Array.Accelerate.IO.ByteString as A +-- | Packed RGBA pixel data+--+type RGBA32 = Word32+ -- File IO --------------------------------------------------------------------- -- | Read RGBA components from a BMP file.@@ -46,7 +48,7 @@ let (w,h) = bmpDimensions bmp bs = unpackBMPToRGBA32 bmp --- Right `fmap` A.fromByteString (Z :. h :. w) ((), bs)+ Right `fmap` A.fromByteString (Z :. h :. w) bs -- | Write the image data to a file.@@ -54,96 +56,7 @@ writeImageToBMP :: FilePath -> Array DIM2 RGBA32 -> IO () writeImageToBMP file rgba = do let Z :. h :. w = A.arrayShape rgba- ((), bs) <- A.toByteString 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 (little-endian) 'RGBA32' value into a tuple of (Red, Green, Blue,--- Alpha) values.----unpackRGBA32, unpackRGBA32le, unpackRGBA32be- :: Exp RGBA32- -> Exp (Word8, Word8, Word8, Word8)-unpackRGBA32 = unpackRGBA32le--unpackRGBA32le rgba =- let a = A.fromIntegral (rgba `A.shiftR` 24)- b = A.fromIntegral (rgba `A.shiftR` 16)- g = A.fromIntegral (rgba `A.shiftR` 8)- r = A.fromIntegral rgba- in- lift (r, g, b, a)--unpackRGBA32be rgba =- let r = A.fromIntegral (rgba `A.shiftR` 24)- g = A.fromIntegral (rgba `A.shiftR` 16)- b = A.fromIntegral (rgba `A.shiftR` 8)- a = A.fromIntegral rgba- in- lift (r, g, b, a)----- | Promote a tuple of (Red, Green, Blue, Alpha) values into a packed--- (little-endian) 'RGBA32' value.----packRGBA32, packRGBA32le, packRGBA32be- :: Exp (Word8, Word8, Word8, Word8)- -> Exp RGBA32-packRGBA32 = packRGBA32le--packRGBA32le (unlift -> (r, g, b, a))- = A.fromIntegral a `A.shiftL` 24- .|. A.fromIntegral b `A.shiftL` 16- .|. A.fromIntegral g `A.shiftL` 8- .|. A.fromIntegral r--packRGBA32be (unlift -> (r, g, b, a))- = A.fromIntegral r `A.shiftL` 24- .|. A.fromIntegral g `A.shiftL` 16- .|. A.fromIntegral b `A.shiftL` 8- .|. A.fromIntegral a----- | Convert an RGBA colour to its luminance value in the range [0..1].----luminanceOfRGBA32 :: (Elt a, IsFloating a) => Exp RGBA32 -> Exp a-luminanceOfRGBA32 (unlift . unpackRGBA32 -> (r, g, b, _a :: Exp Word8)) =- let r' = 0.3 * A.fromIntegral r- g' = 0.59 * A.fromIntegral g- b' = 0.11 * A.fromIntegral b- 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)- in- packRGBA32 (lift (v, v, v, constant 0xFF))----- | 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 (unlift -> (r,g,b,a)) =- let r' = A.truncate (255 * r)- g' = A.truncate (255 * g)- b' = A.truncate (255 * b)- a' = A.truncate (255 * a)- in- packRGBA32 (lift (r', g', b', a'))
Data/Array/Accelerate/IO/BlockCopy.hs view
@@ -9,7 +9,7 @@ -- [2010..2014] Trevor L. McDonell -- License : BSD3 ----- Maintainer : Manuel M T Chakravarty <chak@cse.unsw.edu.au>+-- Maintainer : Trevor L. McDonell <tmcdonell@cse.unsw.edu.au> -- Stability : experimental -- Portability : non-portable (GHC extensions) --
Data/Array/Accelerate/IO/ByteString.hs view
@@ -4,7 +4,7 @@ -- [2010..2014] Trevor L. McDonell -- License : BSD3 ----- Maintainer : Manuel M T Chakravarty <chak@cse.unsw.edu.au>+-- Maintainer : Trevor L. McDonell <tmcdonell@cse.unsw.edu.au> -- Stability : experimental -- Portability : non-portable (GHC extensions) --
+ Data/Array/Accelerate/IO/IArray.hs view
@@ -0,0 +1,81 @@+{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE TypeFamilies #-}+-- |+-- Module : Data.Array.Accelerate.IO.IArray+-- Copyright : [2016] Trevor L. McDonell+-- License : BSD3+--+-- Maintainer : Trevor L. McDonell <tmcdonell@cse.unsw.edu.au>+-- Stability : experimental+-- Portability : non-portable (GHC extensions)+--+-- Convert immutable arrays of the <https://hackage.haskell.org/package/array+-- array> library into Accelerate 'Array's.+--++module Data.Array.Accelerate.IO.IArray (++ -- ** 'Data.Array.IArray.IArray'+ fromIArray,+ toIArray,++) where++import Data.Array.Accelerate.Array.Sugar+import Data.Array.Accelerate.Type++import Data.Array.IArray ( IArray )+import qualified Data.Array.IArray as IArray+++-- | Convert an 'IArray' to an accelerated array.+--+-- While the type signature mentions Accelerate internals that are not exported,+-- in practice satisfying the type equality is straight forward. The index type+-- @ix@ must be the unit type @()@ for singleton arrays, or an @Int@ or tuple of+-- @Int@'s for multidimensional arrays.+--+fromIArray+ :: (IxShapeRepr (EltRepr ix) ~ EltRepr sh, IArray a e, IArray.Ix ix, Shape sh, Elt ix, Elt e)+ => a ix e+ -> Array sh e+fromIArray iarr = fromFunction sh (\ix -> iarr IArray.! fromIxShapeRepr ix)+ where+ (lo,hi) = IArray.bounds iarr+ sh = rangeToShape (toIxShapeRepr lo, toIxShapeRepr hi)++-- | Convert an accelerated array to an 'IArray'.+--+toIArray+ :: (IxShapeRepr (EltRepr ix) ~ EltRepr sh, IArray a e, IArray.Ix ix, Shape sh, Elt ix)+ => Array sh e+ -> a ix e+toIArray arr = IArray.array bnds [(ix, arr ! toIxShapeRepr ix) | ix <- IArray.range bnds]+ where+ (lo,hi) = shapeToRange (shape arr)+ bnds = (fromIxShapeRepr lo, fromIxShapeRepr hi)+++type family IxShapeRepr e where+ IxShapeRepr () = ()+ IxShapeRepr Int = ((),Int)+ IxShapeRepr (t,h) = (IxShapeRepr t, h)++fromIxShapeRepr :: forall ix sh. (IxShapeRepr (EltRepr ix) ~ EltRepr sh, Shape sh, Elt ix) => sh -> ix+fromIxShapeRepr sh = toElt (go (eltType (undefined::ix)) (fromElt sh))+ where+ go :: forall ix'. TupleType ix' -> IxShapeRepr ix' -> ix'+ go UnitTuple () = ()+ go (SingleTuple (NumScalarType (IntegralNumType TypeInt{}))) ((),h) = h+ go (PairTuple tt _) (t, h) = (go tt t, h)+ go _ _ = error "Not a valid IArray.Ix"++toIxShapeRepr :: forall ix sh. (IxShapeRepr (EltRepr ix) ~ EltRepr sh, Shape sh, Elt ix) => ix -> sh+toIxShapeRepr ix = toElt (go (eltType (undefined::ix)) (fromElt ix))+ where+ go :: forall ix'. TupleType ix' -> ix' -> IxShapeRepr ix'+ go UnitTuple () = ()+ go (SingleTuple (NumScalarType (IntegralNumType TypeInt{}))) h = ((), h)+ go (PairTuple tt _) (t, h) = (go tt t, h)+ go _ _ = error "Not a valid IArray.Ix"+
Data/Array/Accelerate/IO/Ptr.hs view
@@ -4,7 +4,7 @@ -- [2010..2014] Trevor L. McDonell -- License : BSD3 ----- Maintainer : Manuel M T Chakravarty <chak@cse.unsw.edu.au>+-- Maintainer : Trevor L. McDonell <tmcdonell@cse.unsw.edu.au> -- Stability : experimental -- Portability : non-portable (GHC extensions) --@@ -21,7 +21,6 @@ import Data.Array.Accelerate.IO.BlockCopy import Data.Array.Accelerate.Array.Sugar- -- | Block copy regions of memory into a freshly allocated Accelerate array. The
Data/Array/Accelerate/IO/Repa.hs view
@@ -13,7 +13,7 @@ -- Copyright : [2012..2014] Trevor L. McDonell -- License : BSD3 ----- Maintainer : Manuel M T Chakravarty <chak@cse.unsw.edu.au>+-- Maintainer : Trevor L. McDonell <tmcdonell@cse.unsw.edu.au> -- Stability : experimental -- Portability : non-portable (GHC extensions) --@@ -85,7 +85,6 @@ instance A.Elt e => R.Source A e where data Array A sh e = AAccelerate !sh !(A.ArrayData (A.EltRepr e))- {-# INLINE extent #-} extent (AAccelerate sh _)
Data/Array/Accelerate/IO/Vector.hs view
@@ -3,10 +3,10 @@ -- | -- Module : Data.Array.Accelerate.IO.Vector -- Copyright : [2012] Adam C. Foltzer--- [2012..2014] Trevor L. McDonell+-- [2012..2015] Trevor L. McDonell -- License : BSD3 ----- Maintainer : Manuel M T Chakravarty <chak@cse.unsw.edu.au>+-- Maintainer : Trevor L. McDonell <tmcdonell@cse.unsw.edu.au> -- Stability : experimental -- Portability : non-portable (GHC extensions) --@@ -30,11 +30,14 @@ import Data.Word import Foreign.C.Types import Data.Vector.Storable-import Data.Array.Storable.Internals ( StorableArray(..) )+import System.IO.Unsafe -- friends+import Data.Array.Accelerate.Lifetime+import Data.Array.Accelerate.Array.Unique import Data.Array.Accelerate.Array.Data-import Data.Array.Accelerate.Array.Sugar hiding ( Vector )+import Data.Array.Accelerate.Array.Sugar hiding ( Vector, size )+import Data.Array.Accelerate.Array.Representation ( size ) -- | A family of types that represents a collection of storable 'Vector's. The@@ -89,8 +92,8 @@ fromVectors :: (Shape sh, Elt e) => sh -> Vectors (EltRepr e) -> Array sh e fromVectors sh vecs = Array (fromElt sh) (aux arrayElt vecs) where- wrap k v = let (p,n) = unsafeToForeignPtr0 v- in k (StorableArray 0 n n p)+ wrap k v = let (fp,_) = unsafeToForeignPtr0 v+ in k (unsafePerformIO $ newUniqueArray fp) aux :: ArrayEltR e -> Vectors e -> ArrayData e aux ArrayEltRunit = const AD_Unit@@ -131,9 +134,10 @@ -- Data will be output in row-major order. -- toVectors :: (Shape sh, Elt e) => Array sh e -> Vectors (EltRepr e)-toVectors (Array _ adata) = aux arrayElt adata+toVectors (Array sh adata) = aux arrayElt adata where- wrap (StorableArray _ _ n p) = unsafeFromForeignPtr0 p n+ wrap :: Storable a => UniqueArray a -> Vector a+ wrap ua = unsafeFromForeignPtr0 (unsafeGetValue (uniqueArrayData ua)) (size sh) aux :: ArrayEltR e -> ArrayData e -> Vectors e aux ArrayEltRunit AD_Unit = ()
accelerate-io.cabal view
@@ -1,5 +1,5 @@ Name: accelerate-io-Version: 0.15.1.0+Version: 1.0.0.0 Cabal-version: >= 1.6 Tested-with: GHC >= 7.8 Build-type: Simple@@ -18,7 +18,7 @@ Gabriele Keller, Sean Seefried, Trevor L. McDonell-Maintainer: Manuel M T Chakravarty <chak@cse.unsw.edu.au>+Maintainer: Trevor L. McDonell <tmcdonell@cse.unsw.edu.au> Homepage: https://github.com/AccelerateHS/accelerate-io Bug-reports: https://github.com/AccelerateHS/accelerate/issues @@ -39,22 +39,32 @@ Default: False Library- Build-depends: accelerate == 0.15.1.*,- array >= 0.3,- base >= 4.7 && < 4.9,- bmp >= 1.2,- bytestring >= 0.9,- repa >= 3.2,- vector >= 0.9+ Build-depends:+ base >= 4.7 && < 4.10+ , accelerate == 1.0.*+ , array >= 0.3+ , bmp >= 1.2+ , bytestring >= 0.9+ , repa >= 3.2+ , vector >= 0.9 - 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+ Exposed-modules:+ Data.Array.Accelerate.IO + Other-modules:+ Data.Array.Accelerate.IO.BlockCopy+ Data.Array.Accelerate.IO.BMP+ Data.Array.Accelerate.IO.ByteString+ Data.Array.Accelerate.IO.IArray+ Data.Array.Accelerate.IO.Ptr+ Data.Array.Accelerate.IO.Repa+ Data.Array.Accelerate.IO.Vector++ ghc-options:+ -O2+ -Wall+ -funbox-strict-fields+ if flag(bounds-checks) cpp-options: -DACCELERATE_BOUNDS_CHECKS @@ -64,18 +74,20 @@ if flag(internal-checks) cpp-options: -DACCELERATE_INTERNAL_CHECKS - ghc-options: -O2 -Wall -funbox-strict-fields-- -- 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+ Source-repository this- type: git- location: git://github.com/AccelerateHS/accelerate-io.git- branch: release/0.15- tag: 0.15.1.0+ Type: git+ Tag: 1.0.0.0+ Location: git://github.com/AccelerateHS/accelerate-io.git++-- vim: nospell