diff --git a/CHANGELOG.md b/CHANGELOG.md --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -6,15 +6,39 @@ project adheres to the [Haskell Package Versioning Policy (PVP)](https://pvp.haskell.org) + +## [1.3.0.0] - 2020-08-26 +### Changed + * Split into separate packages + +## [1.2.0.0] - 2018-04-03 +### Changed + * Split the different conversion functions into separate modules, rather than having a single `Data.Array.Accelerate.IO` module which export everything. + * Conversion to/from `ByteString` is now non-copying + +### Added + * Conversions between `Data.Vector.Unboxed` + * Instances for `Data.Vector.Generic` + * Support for AoS representations + +### Fixed + * Image created by `writeImageToBMP` flipped vertically ([#289]) + + ## [1.0.0.1] - 2017-10-14 ### Fixed - * `fromIArray` would fail with exception "Error in array index" when the IArray - indices were not zero-based. This has been fixed. + * `fromIArray` would fail with exception "Error in array index" when the IArray indices were not zero-based. This has been fixed. + ## [1.0.0.0] - 2017-03-31 * stable release -[1.1.0.0]: https://github.com/AccelerateHS/accelerate-llvm/compare/1.0.0.0...1.0.0.1 -[1.0.0.0]: https://github.com/AccelerateHS/accelerate-llvm/compare/0.15.1.0...1.0.0.0 +[1.3.0.0]: https://github.com/AccelerateHS/accelerate-io/compare/1.2.0.0...v1.3.0.0 +[1.2.0.0]: https://github.com/AccelerateHS/accelerate-io/compare/1.0.0.1...1.2.0.0 +[1.0.0.1]: https://github.com/AccelerateHS/accelerate-io/compare/1.0.0.0...1.0.0.1 +[1.0.0.0]: https://github.com/AccelerateHS/accelerate-io/compare/0.15.1.0...1.0.0.0 + + +[#289]: https://github.com/AccelerateHS/accelerate/issues/289 diff --git a/Data/Array/Accelerate/IO.hs b/Data/Array/Accelerate/IO.hs deleted file mode 100644 --- a/Data/Array/Accelerate/IO.hs +++ /dev/null @@ -1,47 +0,0 @@ --- | --- Module : Data.Array.Accelerate.IO --- Copyright : [2010..2012] Sean Seefried --- [2010..2016] Trevor L. McDonell --- License : BSD3 --- --- Maintainer : Trevor L. McDonell --- Stability : experimental --- Portability : non-portable (GHC extensions) --- --- This module provides efficient conversion routines between different array --- types and Accelerate arrays. --- - -module Data.Array.Accelerate.IO ( - - -- * 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, - - -- * 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.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 - diff --git a/Data/Array/Accelerate/IO/BMP.hs b/Data/Array/Accelerate/IO/BMP.hs deleted file mode 100644 --- a/Data/Array/Accelerate/IO/BMP.hs +++ /dev/null @@ -1,62 +0,0 @@ --- | --- Module : Data.Array.Accelerate.IO.BMP --- Copyright : [2012..2014] Trevor L. McDonell --- License : BSD3 --- --- Maintainer : Trevor L. McDonell --- 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 ( - - -- ** Bitmap images - -- - -- | Reading and writing arrays as uncompressed 24 or 32-bit Windows BMP - -- files. - -- - RGBA32, - readImageFromBMP, writeImageToBMP, - -) where - -import Data.Word -import Codec.BMP - -import Data.Array.Accelerate as A -import Data.Array.Accelerate.IO.ByteString as A - - --- | Packed RGBA pixel data --- -type RGBA32 = Word32 - --- 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) - diff --git a/Data/Array/Accelerate/IO/BlockCopy.hs b/Data/Array/Accelerate/IO/BlockCopy.hs deleted file mode 100644 --- a/Data/Array/Accelerate/IO/BlockCopy.hs +++ /dev/null @@ -1,247 +0,0 @@ -{-# LANGUAGE GADTs #-} -{-# LANGUAGE ForeignFunctionInterface #-} -{-# LANGUAGE MagicHash #-} -{-# LANGUAGE ScopedTypeVariables #-} -{-# LANGUAGE TypeFamilies #-} --- | --- Module : Data.Array.Accelerate.IO.BlockCopy --- Copyright : [2010..2011] Sean Seefried --- [2010..2014] Trevor L. McDonell --- License : BSD3 --- --- Maintainer : Trevor L. McDonell --- Stability : experimental --- Portability : non-portable (GHC extensions) --- - -module Data.Array.Accelerate.IO.BlockCopy ( - - -- * Types - BlockCopyFun, BlockCopyFuns, BlockPtrs, ByteStrings, - - -- * The low-level machinery - allocateArray, blockCopy, blockCopyFunGenerator - -) where - --- standard libraries -import Foreign -import Foreign.C -import GHC.Base -import Data.Array.Base (wORD_SCALE, fLOAT_SCALE, dOUBLE_SCALE) -import Data.ByteString - --- friends -import Data.Array.Accelerate.Array.Data -import Data.Array.Accelerate.Array.Sugar - - --- | Functions of this type are passed as arguments to 'toArray'. A function of --- this type should copy a number of bytes (equal to the value of the --- parameter of type 'Int') to the destination memory pointed to by @Ptr e@. --- -type BlockCopyFun e = Ptr e -> Int -> IO () - --- | Represents a collection of "block copy functions" (see 'BlockCopyFun'). The --- structure of the collection of 'BlockCopyFun's depends on the element type --- @e@. --- --- e.g. --- --- If @e :: Float@ --- then @BlockCopyFuns (EltRepr e) :: ((), Ptr Float -> Int -> IO ())@ --- --- If @e :: (Double, Float)@ --- then @BlockCopyFuns (EltRepr e) :: (((), Ptr Double -> Int -> IO ()), Ptr Float -> Int -> IO ())@ --- -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 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 HTYPE_LONG -type instance BlockCopyFuns CULong = BlockCopyFun HTYPE_UNSIGNED_LONG -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 HTYPE_CCHAR -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 --- collection of pointers depends on the element type @e@. --- --- e.g. --- --- If @e :: Int@, then @BlockPtrs (EltRepr e) :: ((), Ptr Int)@ --- --- If @e :: (Double, Float)@ then @BlockPtrs (EltRepr e) :: (((), Ptr Double), Ptr Float)@ --- -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 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 HTYPE_LONG -type instance BlockPtrs CULong = Ptr HTYPE_UNSIGNED_LONG -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 HTYPE_CCHAR -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 --- 'toByteString' --- -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 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 () - , ByteStrings e -> IO ()) - ,( BlockPtrs e -> IO () - , IO (ByteStrings e)) - , BlockCopyFuns e -> IO ()) - -base :: forall a b. Ptr b -> Int -> (( Ptr a -> IO (), ByteString -> IO ()) - ,( Ptr a -> IO (), IO ByteString) - ,(Ptr b -> Int -> IO ()) -> IO ()) -base accArrayPtr byteSize = - ((blockPtrToArray, byteStringToArray) - ,(arrayToBlockPtr, arrayToByteString) - , blockCopyFunToOrFromArray) - where - blockPtrToArray :: Ptr a -> IO () - blockPtrToArray blockPtr = blockCopy blockPtr accArrayPtr byteSize - arrayToBlockPtr :: Ptr a -> IO () - arrayToBlockPtr blockPtr = blockCopy accArrayPtr blockPtr byteSize - blockCopyFunToOrFromArray :: (Ptr b -> Int -> IO ()) -> IO () - blockCopyFunToOrFromArray blockCopyFun = blockCopyFun accArrayPtr byteSize - byteStringToArray :: ByteString -> IO () - byteStringToArray bs = useAsCString bs (blockPtrToArray . castPtr) - arrayToByteString :: IO ByteString - arrayToByteString = packCStringLen (castPtr accArrayPtr, byteSize) - -blockCopyFunGenerator :: Array sh e -> GenFuns (EltRepr e) -blockCopyFunGenerator array@(Array _ arrayData) = aux arrayElt arrayData - where - 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 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 - ((bpFromC2, bsFromC2), (bpToC2, bsToC2), toH2) = aux b ad2 - toH (funs1, funs2) = toH1 funs1 >> toH2 funs2 - bpToC (ptrA, ptrB) = bpToC1 ptrA >> bpToC2 ptrB - bsToC = do { bsA <- bsToC1; bsB <- bsToC2; return (bsA, bsB) } - bpFromC (ptrA, ptrB) = bpFromC1 ptrA >> bpFromC2 ptrB - bsFromC (bsA, bsB) = bsFromC1 bsA >> bsFromC2 bsB - -blockCopy :: Ptr a -> Ptr b -> Int -> IO () -blockCopy src dst byteSize = memcpy dst src (fromIntegral byteSize) - - --- Foreign imports -foreign import ccall memcpy :: Ptr a -> Ptr b -> CInt -> IO () - --- Helpers -box :: (Int# -> Int#) -> Int -> Int -box f (I# x) = I# (f x) - diff --git a/Data/Array/Accelerate/IO/ByteString.hs b/Data/Array/Accelerate/IO/ByteString.hs deleted file mode 100644 --- a/Data/Array/Accelerate/IO/ByteString.hs +++ /dev/null @@ -1,49 +0,0 @@ --- | --- Module : Data.Array.Accelerate.IO.ByteString --- Copyright : [2010..2011] Sean Seefried --- [2010..2014] Trevor L. McDonell --- License : BSD3 --- --- Maintainer : Trevor L. McDonell --- Stability : experimental --- Portability : non-portable (GHC extensions) --- - -module Data.Array.Accelerate.IO.ByteString ( - - -- ** Data.ByteString - ByteStrings, fromByteString, toByteString - -) where - -import Data.Array.Accelerate.IO.BlockCopy -import Data.Array.Accelerate.Array.Sugar - - --- | Block copies bytes from a collection of 'ByteString's to freshly allocated --- Accelerate array. --- --- The type of elements (@e@) in the output Accelerate array determines the --- structure of the collection of 'ByteString's that will be required as the --- second argument to this function. See 'ByteStrings' --- -fromByteString :: (Shape sh, Elt e) => sh -> ByteStrings (EltRepr e) -> IO (Array sh e) -fromByteString sh byteStrings = do - arr <- allocateArray sh - let copier = let ((_,f),_,_) = blockCopyFunGenerator arr in f - copier byteStrings - return arr - - --- | Block copy from an Accelerate array to a collection of freshly allocated --- 'ByteString's. --- --- The type of elements (@e@) in the input Accelerate array determines the --- structure of the collection of 'ByteString's that will be output. See --- 'ByteStrings' --- -toByteString :: (Shape sh, Elt e) => Array sh e -> IO (ByteStrings (EltRepr e)) -toByteString arr = do - let copier = let (_,(_,f),_) = blockCopyFunGenerator arr in f - copier - diff --git a/Data/Array/Accelerate/IO/IArray.hs b/Data/Array/Accelerate/IO/IArray.hs deleted file mode 100644 --- a/Data/Array/Accelerate/IO/IArray.hs +++ /dev/null @@ -1,97 +0,0 @@ -{-# LANGUAGE ScopedTypeVariables #-} -{-# LANGUAGE TypeFamilies #-} --- | --- Module : Data.Array.Accelerate.IO.IArray --- Copyright : [2016] Trevor L. McDonell --- License : BSD3 --- --- Maintainer : Trevor L. McDonell --- Stability : experimental --- Portability : non-portable (GHC extensions) --- --- Convert immutable arrays of the 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 (offset lo' ix)) - where - (lo,hi) = IArray.bounds iarr - lo' = toIxShapeRepr lo - hi' = toIxShapeRepr hi - sh = rangeToShape (lo', hi') - - -- IArray does not necessarily start indexing from zero. Thus, we need to - -- add some offset to the Accelerate indices to map them onto the valid - -- index range of the IArray - -- - offset :: forall sh. Shape sh => sh -> sh -> sh - offset ix0 ix = toElt $ go (eltType (undefined::sh)) (fromElt ix0) (fromElt ix) - where - go :: TupleType ix -> ix -> ix -> ix - go UnitTuple () () = () - go (PairTuple tl tr) (l0, r0) (l,r) = (go tl l0 l, go tr r0 r) - go (SingleTuple (NumScalarType (IntegralNumType TypeInt{}))) i0 i = i0+i - go _ _ _ - = error "Data.Array.Accelerate.IO.IArray: error in index offset" - --- | 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 "Data.Array.Accelerate.IO.IArray: 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 "Data.Array.Accelerate.IO.IArray: not a valid IArray.Ix" - diff --git a/Data/Array/Accelerate/IO/Ptr.hs b/Data/Array/Accelerate/IO/Ptr.hs deleted file mode 100644 --- a/Data/Array/Accelerate/IO/Ptr.hs +++ /dev/null @@ -1,100 +0,0 @@ --- | --- Module : Data.Array.Accelerate.IO.Ptr --- Copyright : [2010..2011] Sean Seefried --- [2010..2014] Trevor L. McDonell --- License : BSD3 --- --- Maintainer : Trevor L. McDonell --- Stability : experimental --- Portability : non-portable (GHC extensions) --- - -module Data.Array.Accelerate.IO.Ptr ( - - -- ** Raw pointers - BlockPtrs, fromPtr, toPtr, - - -- ** Direct copying functions - BlockCopyFun, BlockCopyFuns, fromArray, toArray - -) where - -import Data.Array.Accelerate.IO.BlockCopy -import Data.Array.Accelerate.Array.Sugar - - --- | Block copy regions of memory into a freshly allocated Accelerate array. The --- type of elements (@e@) in the output Accelerate array determines the --- structure of the collection of pointers that will be required as the second --- argument to this function. See 'BlockPtrs' --- --- Each one of these pointers points to a block of memory that is the source --- of data for the Accelerate array (unlike function 'toArray' where one --- passes in function which copies data to a destination address.). --- -fromPtr :: (Shape sh, Elt e) => sh -> BlockPtrs (EltRepr e) -> IO (Array sh e) -fromPtr sh blkPtrs = do - arr <- allocateArray sh - let copier = let ((f,_),_,_) = blockCopyFunGenerator arr in f - copier blkPtrs - return arr - - --- | Block copy from Accelerate array to pre-allocated regions of memory. The --- type of element of the input Accelerate array (@e@) determines the --- structure of the collection of pointers that will be required as the second --- argument to this function. See 'BlockPtrs' --- --- The memory associated with the pointers must have already been allocated. --- -toPtr :: (Shape sh, Elt e) => Array sh e -> BlockPtrs (EltRepr e) -> IO () -toPtr arr blockPtrs = do - let copier = let (_,(f,_),_) = blockCopyFunGenerator arr in f - copier blockPtrs - return () - - --- | Copy values from an Accelerate array using a collection of functions that --- have type 'BlockCopyFun'. The argument of type @Ptr e@ in each of these --- functions refers to the address of the /source/ block of memory in the --- Accelerate Array. The /destination/ address is implicit. e.g. the --- 'BlockCopyFun' could be the result of partially application to a @Ptr e@ --- pointing to the destination block. --- --- The structure of this collection of functions depends on the elemente type --- @e@. Each function (of type 'BlockCopyFun') copies data to a destination --- address (pointed to by the argument of type @Ptr ()@). --- --- Unless there is a particularly pressing reason to use this function, the --- 'fromPtr' function is sufficient as it uses an efficient low-level call to --- libc's @memcpy@ to perform the copy. --- -fromArray :: (Shape sh, Elt e) => Array sh e -> BlockCopyFuns (EltRepr e) -> IO () -fromArray arr blockCopyFuns = do - let copier = let (_,_,f) = blockCopyFunGenerator arr in f - copier blockCopyFuns - return () - - --- | Copy values to a freshly allocated Accelerate array using a collection of --- functions that have type 'BlockCopyFun'. The argument of type @Ptr e@ in --- each of these functions refers to the address of the /destination/ block of --- memory in the Accelerate Array. The /source/ address is implicit. e.g. the --- 'BlockCopyFun' could be the result of a partial application to a @Ptr e@ --- pointing to the source block. --- --- The structure of this collection of functions depends on the elemente type --- @e@. Each function (of type 'BlockCopyFun') copies data to a destination --- address (pointed to by the argument of type @Ptr ()@). --- --- Unless there is a particularly pressing reason to use this function, the --- 'fromPtr' function is sufficient as it uses an efficient low-level call to --- libc's @memcpy@ to perform the copy. --- -toArray :: (Shape sh, Elt e) => sh -> BlockCopyFuns (EltRepr e) -> IO (Array sh e) -toArray sh blockCopyFuns = do - arr <- allocateArray sh - let copier = let (_,_,f) = blockCopyFunGenerator arr in f - copier blockCopyFuns - return arr - diff --git a/Data/Array/Accelerate/IO/Repa.hs b/Data/Array/Accelerate/IO/Repa.hs deleted file mode 100644 --- a/Data/Array/Accelerate/IO/Repa.hs +++ /dev/null @@ -1,177 +0,0 @@ -{-# LANGUAGE EmptyDataDecls #-} -{-# LANGUAGE ExistentialQuantification #-} -{-# LANGUAGE ExplicitForAll #-} -{-# LANGUAGE FlexibleContexts #-} -{-# LANGUAGE FlexibleInstances #-} -{-# LANGUAGE FunctionalDependencies #-} -{-# LANGUAGE MultiParamTypeClasses #-} -{-# LANGUAGE TypeFamilies #-} -{-# LANGUAGE TypeOperators #-} -{-# LANGUAGE UndecidableInstances #-} --- | --- Module : Data.Array.Accelerate.IO.Repa --- Copyright : [2012..2014] Trevor L. McDonell --- License : BSD3 --- --- Maintainer : Trevor L. McDonell --- Stability : experimental --- Portability : non-portable (GHC extensions) --- - -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 - -) where - -import Control.Monad - -import qualified Data.Array.Repa as R -import qualified Data.Array.Repa.Eval as R -import qualified Data.Array.Accelerate.Array.Data as A -import qualified Data.Array.Accelerate.Array.Sugar as A - - --- | 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. --- -class (R.Shape r, A.Shape a) => Shapes r a | a -> r, r -> a where - -- these are really equivalent representations, so unsafeCoerce would probably - -- work, but bad programmers get no cookies. - toR :: a -> r - toA :: r -> a - -instance Shapes R.Z A.Z where - {-# INLINE toR #-} - toR A.Z = R.Z - {-# INLINE toA #-} - toA R.Z = A.Z - -instance Shapes sr sa => Shapes (sr R.:. Int) (sa A.:. Int) where - {-# INLINE toR #-} - toR (sa A.:. sz) = toR sa R.:. sz - {-# INLINE toA #-} - toA (sr R.:. sz) = toA sr A.:. sz - - --- | 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 ------------------------------------------------------------------------ - --- | Reading elements of the Accelerate array --- -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 _) - = sh - - {-# INLINE linearIndex #-} - linearIndex (AAccelerate sh adata) ix - | ix >= 0 && ix < R.size sh - = A.toElt (adata `A.unsafeIndexArrayData` ix) - - | otherwise - = error "Repa: accelerate array out of bounds" - - {-# INLINE unsafeLinearIndex #-} - unsafeLinearIndex (AAccelerate _ adata) ix - = A.toElt (adata `A.unsafeIndexArrayData` ix) - - {-# INLINE deepSeqArray #-} - deepSeqArray (AAccelerate sh adata) x - = sh `R.deepSeq` adata `seq` x - - --- | Filling Accelerate arrays --- -instance A.Elt e => R.Target A e where - data MVec A e - = MAVec (A.MutableArrayData (A.EltRepr e)) - - {-# INLINE newMVec #-} - newMVec n - = MAVec `liftM` A.newArrayData n - - {-# INLINE unsafeWriteMVec #-} - unsafeWriteMVec (MAVec mad) n e - = A.unsafeWriteArrayData mad n (A.fromElt e) - - {-# INLINE unsafeFreezeMVec #-} - unsafeFreezeMVec sh (MAVec mad) - = do adata <- A.unsafeFreezeArrayData mad - return $! AAccelerate sh adata - - {-# INLINE deepSeqMVec #-} - deepSeqMVec (MAVec arr) x -- maybe? - = arr `seq` x - - {-# INLINE touchMVec #-} - touchMVec _ -- maybe? - = return () - - --- Conversions ----------------------------------------------------------------- - --- | /O(1)/. Wrap an Accelerate array. --- -toRepa - :: Shapes sh sh' - => A.Array sh' e -> R.Array A sh e -{-# INLINE toRepa #-} -toRepa arr@(A.Array _ adata) - = AAccelerate (toR (A.shape arr)) adata - --- | /O(1)/. Unpack to an Accelerate array. --- -fromRepa - :: (Shapes sh sh', A.Elt e) - => R.Array A sh e -> A.Array sh' e -{-# INLINE fromRepa #-} -fromRepa (AAccelerate sh adata) - = A.Array (A.fromElt (toA sh)) adata - - --- Computations ---------------------------------------------------------------- - --- | Sequential computation of array elements --- -computeAccS - :: (R.Load r sh e, A.Elt e) - => R.Array r sh e -> R.Array A sh e -{-# INLINE computeAccS #-} -computeAccS = R.computeS - --- | Parallel computation of array elements --- -computeAccP - :: (R.Load r sh e, A.Elt e, Monad m) - => R.Array r sh e - -> m (R.Array A sh e) -{-# INLINE computeAccP #-} -computeAccP = R.computeP - diff --git a/Data/Array/Accelerate/IO/Vector.hs b/Data/Array/Accelerate/IO/Vector.hs deleted file mode 100644 --- a/Data/Array/Accelerate/IO/Vector.hs +++ /dev/null @@ -1,172 +0,0 @@ -{-# LANGUAGE GADTs #-} -{-# LANGUAGE TypeFamilies #-} --- | --- Module : Data.Array.Accelerate.IO.Vector --- Copyright : [2012] Adam C. Foltzer --- [2012..2015] Trevor L. McDonell --- License : BSD3 --- --- Maintainer : Trevor L. McDonell --- Stability : experimental --- Portability : non-portable (GHC extensions) --- --- Helpers for fast conversion between 'Data.Vector.Storable' vectors into --- Accelerate arrays. --- - -module Data.Array.Accelerate.IO.Vector ( - - -- ** Data.Vector.Storable - -- - -- | This provides an efficient non-copying conversion between storable - -- vectors and Accelerate arrays. - -- - Vectors, toVectors, fromVectors, - -) where - --- standard libraries -import Data.Int -import Data.Word -import Foreign.C.Types -import Data.Vector.Storable -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, size ) -import Data.Array.Accelerate.Array.Representation ( size ) - - --- | 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 - -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 HTYPE_LONG -type instance Vectors CULong = Vector HTYPE_UNSIGNED_LONG -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 HTYPE_CCHAR -type instance Vectors CSChar = Vector Int8 -type instance Vectors CUChar = Vector Word8 -type instance Vectors (a,b) = (Vectors a, Vectors b) - - --- | /O(1)/. Treat a set of storable vectors as 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 = Array (fromElt sh) (aux arrayElt vecs) - where - wrap k v = let (fp,_) = unsafeToForeignPtr0 v - in k (unsafePerformIO $ newUniqueArray fp) - - aux :: ArrayEltR e -> Vectors e -> ArrayData e - aux ArrayEltRunit = const AD_Unit - aux ArrayEltRint = wrap AD_Int - aux ArrayEltRint8 = wrap AD_Int8 - aux ArrayEltRint16 = wrap AD_Int16 - aux ArrayEltRint32 = wrap AD_Int32 - aux ArrayEltRint64 = wrap AD_Int64 - aux ArrayEltRword = wrap AD_Word - aux ArrayEltRword8 = wrap AD_Word8 - aux ArrayEltRword16 = wrap AD_Word16 - aux ArrayEltRword32 = wrap AD_Word32 - aux ArrayEltRword64 = wrap AD_Word64 - aux ArrayEltRcshort = wrap AD_CShort - aux ArrayEltRcushort = wrap AD_CUShort - aux ArrayEltRcint = wrap AD_CInt - aux ArrayEltRcuint = wrap AD_CUInt - aux ArrayEltRclong = wrap AD_CLong - aux ArrayEltRculong = wrap AD_CULong - aux ArrayEltRcllong = wrap AD_CLLong - aux ArrayEltRcullong = wrap AD_CULLong - aux ArrayEltRfloat = wrap AD_Float - aux ArrayEltRdouble = wrap AD_Double - aux ArrayEltRcfloat = wrap AD_CFloat - aux ArrayEltRcdouble = wrap AD_CDouble - aux ArrayEltRbool = wrap AD_Bool - aux ArrayEltRchar = wrap AD_Char - aux ArrayEltRcchar = wrap AD_CChar - aux ArrayEltRcschar = wrap AD_CSChar - aux ArrayEltRcuchar = wrap AD_CUChar - aux (ArrayEltRpair ae1 ae2) = \(v1,v2) -> AD_Pair (aux ae1 v1) (aux ae2 v2) - - --- | /O(1)/. 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 sh adata) = aux arrayElt adata - where - 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 = () - aux ArrayEltRint (AD_Int s) = wrap s - aux ArrayEltRint8 (AD_Int8 s) = wrap s - aux ArrayEltRint16 (AD_Int16 s) = wrap s - aux ArrayEltRint32 (AD_Int32 s) = wrap s - aux ArrayEltRint64 (AD_Int64 s) = wrap s - aux ArrayEltRword (AD_Word s) = wrap s - aux ArrayEltRword8 (AD_Word8 s) = wrap s - aux ArrayEltRword16 (AD_Word16 s) = wrap s - aux ArrayEltRword32 (AD_Word32 s) = wrap s - aux ArrayEltRword64 (AD_Word64 s) = wrap s - aux ArrayEltRcshort (AD_CShort s) = wrap s - aux ArrayEltRcushort (AD_CUShort s) = wrap s - aux ArrayEltRcint (AD_CInt s) = wrap s - aux ArrayEltRcuint (AD_CUInt s) = wrap s - aux ArrayEltRclong (AD_CLong s) = wrap s - aux ArrayEltRculong (AD_CULong s) = wrap s - aux ArrayEltRcllong (AD_CLLong s) = wrap s - aux ArrayEltRcullong (AD_CULLong s) = wrap s - aux ArrayEltRfloat (AD_Float s) = wrap s - aux ArrayEltRdouble (AD_Double s) = wrap s - aux ArrayEltRcfloat (AD_CFloat s) = wrap s - aux ArrayEltRcdouble (AD_CDouble s) = wrap s - aux ArrayEltRbool (AD_Bool s) = wrap s - aux ArrayEltRchar (AD_Char s) = wrap s - aux ArrayEltRcchar (AD_CChar s) = wrap s - aux ArrayEltRcschar (AD_CSChar s) = wrap s - aux ArrayEltRcuchar (AD_CUChar s) = wrap s - aux (ArrayEltRpair ae1 ae2) (AD_Pair s1 s2) = (aux ae1 s1, aux ae2 s2) - diff --git a/LICENSE b/LICENSE --- a/LICENSE +++ b/LICENSE @@ -7,8 +7,8 @@ * Redistributions in binary form must reproduce the above copyright notice, this list of conditions and the following disclaimer in the documentation and/or other materials provided with the distribution. - * Neither the names of the contributors nor of their affiliations may - be used to endorse or promote products derived from this software + * Neither the names of the contributors nor of their affiliations may + be used to endorse or promote products derived from this software without specific prior written permission. THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS ''AS IS'' AND ANY diff --git a/README.md b/README.md --- a/README.md +++ b/README.md @@ -1,10 +1,25 @@ -Array Conversion Component for the Accelerate Array Language -============================================================ +
+henlo, my name is Theia -[![Build Status](https://travis-ci.org/AccelerateHS/accelerate-io.svg?branch=master)](https://travis-ci.org/AccelerateHS/accelerate-io) +# Array conversion components for the Accelerate language + +[![GitHub CI](https://github.com/tmcdonell/accelerate-io/workflows/CI/badge.svg)](https://github.com/tmcdonell/accelerate-io/actions) +[![Gitter](https://img.shields.io/gitter/room/nwjs/nw.js.svg)](https://gitter.im/AccelerateHS/Lobby) +
+[![Stackage LTS](https://stackage.org/package/accelerate-io/badge/lts)](https://stackage.org/lts/package/accelerate-io) +[![Stackage Nightly](https://stackage.org/package/accelerate-io/badge/nightly)](https://stackage.org/nightly/package/accelerate-io) [![Hackage](https://img.shields.io/hackage/v/accelerate-io.svg)](https://hackage.haskell.org/package/accelerate-io) -This package provides efficient conversion routines between a range of array types and Accelerate arrays. For details on Accelerate, refer to the [main repository][GitHub]. +
- [GitHub]: https://github.com/AccelerateHS/accelerate +Efficient conversion routines between Accelerate arrays and a range of data +formats. + +For details on Accelerate, refer to the [main repository][GitHub]. + +Contributions and bug reports are welcome!
+Please feel free to contact me through [GitHub][GitHub] or [gitter.im][gitter.im]. + + [GitHub]: https://github.com/AccelerateHS/accelerate + [gitter.im]: https://gitter.im/AccelerateHS/Lobby diff --git a/accelerate-io.cabal b/accelerate-io.cabal --- a/accelerate-io.cabal +++ b/accelerate-io.cabal @@ -1,96 +1,68 @@ Name: accelerate-io -Version: 1.0.0.1 -Cabal-version: >= 1.6 -Tested-with: GHC >= 7.8 +Version: 1.3.0.0 +Cabal-version: >= 1.10 +Tested-with: GHC >= 8.6 Build-type: Simple -Synopsis: Read and write Accelerate arrays in various formats +Synopsis: Convert between Accelerate arrays and raw pointers Description: - This package provides efficient conversion routines between a range of array - types and Accelerate arrays. + This package provides efficient conversion routines between Accelerate arrays + and raw pointers. . + As of version 1.3 this package has been split up into smaller components each + targeting a specific data type. + . Refer to the main /Accelerate/ package for more information: License: BSD3 License-file: LICENSE -Author: Manuel M T Chakravarty, - Gabriele Keller, - Sean Seefried, - Trevor L. McDonell -Maintainer: Trevor L. McDonell +Author: The Accelerate Team +Maintainer: Trevor L. McDonell Homepage: https://github.com/AccelerateHS/accelerate-io Bug-reports: https://github.com/AccelerateHS/accelerate/issues -Category: Compilers/Interpreters, Concurrency, Data, Parallelism +Category: Accelerate, Data Stability: Experimental Extra-source-files: README.md CHANGELOG.md -Flag bounds-checks - Description: Enable bounds checking - Default: True - -Flag unsafe-checks - Description: Enable bounds checking in unsafe operations - Default: False +library + build-depends: + base >= 4.8 && < 5 + , accelerate >= 1.3 -Flag internal-checks - Description: Enable internal consistency checks - Default: False + exposed-modules: + Data.Array.Accelerate.IO.Foreign.Ptr + Data.Array.Accelerate.IO.Foreign.ForeignPtr -Library - Build-depends: - base >= 4.7 && < 4.11 - , accelerate >= 1.0 - , array >= 0.3 - , bmp >= 1.2 - , bytestring >= 0.9 - , repa >= 3.2 - , vector >= 0.9 + other-modules: + Data.Array.Accelerate.IO.Foreign.Internal - Exposed-modules: - Data.Array.Accelerate.IO + default-language: + Haskell2010 - 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 + hs-source-dirs: + src ghc-options: -O2 -Wall -funbox-strict-fields - if flag(bounds-checks) - cpp-options: -DACCELERATE_BOUNDS_CHECKS + ghc-prof-options: + -fprof-auto - if flag(unsafe-checks) - cpp-options: -DACCELERATE_UNSAFE_CHECKS - if flag(internal-checks) - cpp-options: -DACCELERATE_INTERNAL_CHECKS - - -- 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 head + type: git + location: git://github.com/AccelerateHS/accelerate-io.git -Source-repository this - Type: git - Tag: 1.0.0.1 - Location: git://github.com/AccelerateHS/accelerate-io.git +source-repository this + type: git + tag: v1.3.0.0 + location: git://github.com/AccelerateHS/accelerate-io.git -- vim: nospell - diff --git a/src/Data/Array/Accelerate/IO/Foreign/ForeignPtr.hs b/src/Data/Array/Accelerate/IO/Foreign/ForeignPtr.hs new file mode 100644 --- /dev/null +++ b/src/Data/Array/Accelerate/IO/Foreign/ForeignPtr.hs @@ -0,0 +1,80 @@ +{-# LANGUAGE GADTs #-} +{-# LANGUAGE ScopedTypeVariables #-} +{-# LANGUAGE TypeApplications #-} +-- | +-- Module : Data.Array.Accelerate.IO.Foreign.ForeignPtr +-- Copyright : [2017..2020] The Accelerate Team +-- License : BSD3 +-- +-- Maintainer : Trevor L. McDonell +-- Stability : experimental +-- Portability : non-portable (GHC extensions) +-- + +module Data.Array.Accelerate.IO.Foreign.ForeignPtr + where + +import Data.Array.Accelerate.Array.Data ( ArrayData, GArrayDataR ) +import Data.Array.Accelerate.Array.Unique +import Data.Array.Accelerate.Lifetime +import Data.Array.Accelerate.Representation.Type +import Data.Array.Accelerate.Sugar.Array +import Data.Array.Accelerate.Sugar.Elt +import Data.Array.Accelerate.Sugar.Shape +import qualified Data.Array.Accelerate.Representation.Array as R + +import Data.Array.Accelerate.IO.Foreign.Internal + +import Foreign.ForeignPtr +import System.IO.Unsafe + + +-- | A family of types which represent a collection of 'ForeignPtr's. The +-- structure of the collection depends on the element type @e@. +-- +type ForeignPtrs e = GArrayDataR ForeignPtr e + + +-- | /O(1)/. Treat the set of 'ForeignPtrs' as an Accelerate array. The type of +-- elements @e@ in the output Accelerate array determines the structure of the +-- collection. +-- +-- Data is considered to be in row-major order. You must ensure that each of the +-- input pointers contains the right number of elements. +-- +-- The data may not be modified through the 'ForeignPtr's afterwards. +-- +-- You should make sure that the data is suitably aligned. +-- +-- @since 1.1.0.0@ +-- +{-# INLINE fromForeignPtrs #-} +fromForeignPtrs :: forall sh e. (Shape sh, Elt e) => sh -> ForeignPtrs (EltR e) -> Array sh e +fromForeignPtrs sh fps = Array (R.Array (fromElt sh) (go (eltR @e) fps)) + where + go :: TypeR a -> ForeignPtrs a -> ArrayData a + go TupRunit () = () + go (TupRpair aR1 aR2) (a1, a2) = (go aR1 a1, go aR2 a2) + go (TupRsingle t) a + | ScalarArrayDict{} <- scalarArrayDict t + = unsafePerformIO $ newUniqueArray a + + +-- | /O(1)/. Yield the 'ForeignPtr's underlying the given Accelerate 'Array'. +-- The element type @e@ will determine the structure of the output collection. +-- +-- Data is considered to be in row-major order. +-- +-- @since 1.1.0.0@ +-- +{-# INLINE toForeignPtrs #-} +toForeignPtrs :: forall sh e. (Shape sh, Elt e) => Array sh e -> ForeignPtrs (EltR e) +toForeignPtrs (Array (R.Array _ adata)) = go (eltR @e) adata + where + go :: TypeR a -> ArrayData a -> ForeignPtrs a + go TupRunit () = () + go (TupRpair aR1 aR2) (a1, a2) = (go aR1 a1, go aR2 a2) + go (TupRsingle t) a + | ScalarArrayDict{} <- scalarArrayDict t + = unsafeGetValue (uniqueArrayData a) + diff --git a/src/Data/Array/Accelerate/IO/Foreign/Internal.hs b/src/Data/Array/Accelerate/IO/Foreign/Internal.hs new file mode 100644 --- /dev/null +++ b/src/Data/Array/Accelerate/IO/Foreign/Internal.hs @@ -0,0 +1,79 @@ +{-# LANGUAGE GADTs #-} +-- | +-- Module : Data.Array.Accelerate.IO.Foreign.Internal +-- Copyright : [2017..2020] The Accelerate Team +-- License : BSD3 +-- +-- Maintainer : Trevor L. McDonell +-- Stability : experimental +-- Portability : non-portable (GHC extensions) +-- + +module Data.Array.Accelerate.IO.Foreign.Internal + where + +import Data.Array.Accelerate.Array.Data ( GArrayDataR, ScalarArrayDataR ) +import Data.Array.Accelerate.Array.Unique +import Data.Array.Accelerate.Type + +import Foreign.Ptr +import Foreign.ForeignPtr + + +data ScalarArrayDict a where + ScalarArrayDict :: ( GArrayDataR Ptr a ~ Ptr (ScalarArrayDataR a) + , GArrayDataR ForeignPtr a ~ ForeignPtr (ScalarArrayDataR a) + , GArrayDataR UniqueArray a ~ UniqueArray (ScalarArrayDataR a) + , ScalarArrayDataR a ~ ScalarArrayDataR b ) + => {-# UNPACK #-} !Int + -> SingleType b + -> ScalarArrayDict a + +data SingleArrayDict a where + SingleArrayDict :: ( GArrayDataR Ptr a ~ Ptr (ScalarArrayDataR a) + , GArrayDataR ForeignPtr a ~ ForeignPtr (ScalarArrayDataR a) + , GArrayDataR UniqueArray a ~ UniqueArray (ScalarArrayDataR a) + , ScalarArrayDataR a ~ a ) + => SingleArrayDict a + +scalarArrayDict :: ScalarType a -> ScalarArrayDict a +scalarArrayDict = scalar + where + scalar :: ScalarType a -> ScalarArrayDict a + scalar (VectorScalarType t) = vector t + scalar (SingleScalarType t) + | SingleArrayDict <- singleArrayDict t + = ScalarArrayDict 1 t + + vector :: VectorType a -> ScalarArrayDict a + vector (VectorType w s) + | SingleArrayDict <- singleArrayDict s + = ScalarArrayDict w s + +singleArrayDict :: SingleType a -> SingleArrayDict a +singleArrayDict = single + where + single :: SingleType a -> SingleArrayDict a + single (NumSingleType t) = num t + + num :: NumType a -> SingleArrayDict a + num (IntegralNumType t) = integral t + num (FloatingNumType t) = floating t + + integral :: IntegralType a -> SingleArrayDict a + integral TypeInt = SingleArrayDict + integral TypeInt8 = SingleArrayDict + integral TypeInt16 = SingleArrayDict + integral TypeInt32 = SingleArrayDict + integral TypeInt64 = SingleArrayDict + integral TypeWord = SingleArrayDict + integral TypeWord8 = SingleArrayDict + integral TypeWord16 = SingleArrayDict + integral TypeWord32 = SingleArrayDict + integral TypeWord64 = SingleArrayDict + + floating :: FloatingType a -> SingleArrayDict a + floating TypeHalf = SingleArrayDict + floating TypeFloat = SingleArrayDict + floating TypeDouble = SingleArrayDict + diff --git a/src/Data/Array/Accelerate/IO/Foreign/Ptr.hs b/src/Data/Array/Accelerate/IO/Foreign/Ptr.hs new file mode 100644 --- /dev/null +++ b/src/Data/Array/Accelerate/IO/Foreign/Ptr.hs @@ -0,0 +1,85 @@ +{-# LANGUAGE GADTs #-} +{-# LANGUAGE ScopedTypeVariables #-} +{-# LANGUAGE TypeApplications #-} +-- | +-- Module : Data.Array.Accelerate.IO.Foreign.Ptr +-- Copyright : [2017..2020] The Accelerate Team +-- License : BSD3 +-- +-- Maintainer : Trevor L. McDonell +-- Stability : experimental +-- Portability : non-portable (GHC extensions) +-- + +module Data.Array.Accelerate.IO.Foreign.Ptr + where + +import Data.Array.Accelerate.Array.Data ( ArrayData, GArrayDataR ) +import Data.Array.Accelerate.Array.Unique +import Data.Array.Accelerate.Sugar.Array +import Data.Array.Accelerate.Sugar.Elt +import Data.Array.Accelerate.Sugar.Shape +import Data.Array.Accelerate.Lifetime +import Data.Array.Accelerate.Representation.Type +import qualified Data.Array.Accelerate.Representation.Array as R + +import Data.Array.Accelerate.IO.Foreign.Internal + +import Foreign.Ptr +import Foreign.ForeignPtr +import Foreign.ForeignPtr.Unsafe +import System.IO.Unsafe + + +-- | A family of types which represent a collection of 'Ptr's. The +-- structure of the collection depends on the element type @e@. +-- +type Ptrs e = GArrayDataR Ptr e + + +-- | /O(1)/. Treat the set of 'Ptrs' as an Accelerate array. The type of +-- elements @e@ in the output Accelerate array determines the structure of the +-- collection. +-- +-- Data is considered to be in row-major order. You must ensure that each of the +-- input pointers contains the right number of elements. +-- +-- The data may not be modified through the 'Ptrs' afterwards. +-- +-- You are responsible for ensuring that the data remains alive for the duration +-- of the Accelerate computation, and for freeing it afterwards. +-- +-- You should make sure that the data is suitably aligned. +-- +-- @since 1.1.0.0@ +-- +{-# INLINE fromPtrs #-} +fromPtrs :: forall sh e. (Shape sh, Elt e) => sh -> Ptrs (EltR e) -> Array sh e +fromPtrs sh ps = Array (R.Array (fromElt sh) (go (eltR @e) ps)) + where + go :: TypeR a -> Ptrs a -> ArrayData a + go TupRunit () = () + go (TupRpair aR1 aR2) (a1, a2) = (go aR1 a1, go aR2 a2) + go (TupRsingle t) p + | ScalarArrayDict{} <- scalarArrayDict t + = unsafePerformIO $ newUniqueArray =<< newForeignPtr_ p + + +-- | /O(1)/. Yield the underlying 'Ptrs' backing the given Accelerate array. The +-- element type @e@ will determine the structure of the output collection. +-- +-- Data is considered to be in row-major order. +-- +-- @since 1.1.0.0@ +-- +{-# INLINE toPtrs #-} +toPtrs :: forall sh e. (Shape sh, Elt e) => Array sh e -> Ptrs (EltR e) +toPtrs (Array (R.Array _ adata)) = go (eltR @e) adata + where + go :: TypeR a -> ArrayData a -> Ptrs a + go TupRunit () = () + go (TupRpair aR1 aR2) (a1, a2) = (go aR1 a1, go aR2 a2) + go (TupRsingle t) a + | ScalarArrayDict{} <- scalarArrayDict t + = unsafeForeignPtrToPtr (unsafeGetValue (uniqueArrayData a)) +