diff --git a/CHANGELOG.md b/CHANGELOG.md --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -6,6 +6,11 @@ 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. @@ -29,6 +34,7 @@ * stable release +[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 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,28 +1,28 @@ Name: accelerate-io -Version: 1.2.0.0 +Version: 1.3.0.0 Cabal-version: >= 1.10 -Tested-with: GHC >= 7.8 +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: @@ -31,43 +31,15 @@ library build-depends: - base >= 4.7 && < 4.12 - , accelerate >= 1.2 - , array >= 0.3 - , bmp >= 1.2 - , bytestring >= 0.9 - , primitive >= 0.6 - , repa >= 3.2 - , vector >= 0.9 + base >= 4.8 && < 5 + , accelerate >= 1.3 exposed-modules: - -- bmp - Data.Array.Accelerate.IO.Codec.BMP - - -- bytestring - Data.Array.Accelerate.IO.Data.ByteString - - -- vector - Data.Array.Accelerate.IO.Data.Vector.Generic - Data.Array.Accelerate.IO.Data.Vector.Generic.Mutable - Data.Array.Accelerate.IO.Data.Vector.Primitive - Data.Array.Accelerate.IO.Data.Vector.Storable - Data.Array.Accelerate.IO.Data.Vector.Unboxed - - -- array - Data.Array.Accelerate.IO.Data.Array.IArray - Data.Array.Accelerate.IO.Data.Array.Unboxed - - -- foeign Data.Array.Accelerate.IO.Foreign.Ptr Data.Array.Accelerate.IO.Foreign.ForeignPtr - -- repa - Data.Array.Repa.Repr.Accelerate - other-modules: - Data.Array.Accelerate.IO.Data.Array.Internal - Data.Array.Accelerate.IO.Data.Vector.Primitive.Internal + Data.Array.Accelerate.IO.Foreign.Internal default-language: Haskell2010 @@ -84,43 +56,13 @@ -fprof-auto -test-suite test-io - type: exitcode-stdio-1.0 - default-language: Haskell2010 - hs-source-dirs: test - main-is: Test.hs - ghc-options: -main-is Test - - build-depends: - base >= 4.7 && < 4.12 - , accelerate - , accelerate-io - , array - , hedgehog >= 0.5 - , tasty >= 0.11 - , tasty-hedgehog >= 0.1 - , vector - - ghc-options: - -Wall - -threaded - -rtsopts - - other-modules: - Test.Array.IArray - Test.Array.Unboxed - Test.Vector.Storable - Test.Vector.Unboxed - Test.Util - - source-repository head - Type: git - Location: git://github.com/AccelerateHS/accelerate-io.git + type: git + location: git://github.com/AccelerateHS/accelerate-io.git source-repository this - Type: git - Tag: 1.2.0.0 - Location: git://github.com/AccelerateHS/accelerate-io.git + 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/Codec/BMP.hs b/src/Data/Array/Accelerate/IO/Codec/BMP.hs deleted file mode 100644 --- a/src/Data/Array/Accelerate/IO/Codec/BMP.hs +++ /dev/null @@ -1,82 +0,0 @@ -{-# LANGUAGE CPP #-} -{-# LANGUAGE RecordWildCards #-} -{-# LANGUAGE TemplateHaskell #-} --- | --- Module : Data.Array.Accelerate.IO.Codec.BMP --- Copyright : [2012..2014] Trevor L. McDonell --- License : BSD3 --- --- Maintainer : Trevor L. McDonell --- Stability : experimental --- Portability : non-portable (GHC extensions) --- --- Read and write uncompressed 24 or 32-bit Windows 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.Codec.BMP ( - - RGBA32, - readImageFromBMP, writeImageToBMP, - -) where - -import Data.Word -import Codec.BMP - -import Data.Array.Accelerate.Array.Sugar -import Data.Array.Accelerate.IO.Data.ByteString - - --- | 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' - arr = fromByteStrings (Z :. h :. w) bs - -- - bmp' = bmp { bmpBitmapInfo = info' } - info' = case bmpBitmapInfo bmp of - InfoV3 i -> InfoV3 (info3 i) - InfoV4 i -> InfoV4 (info4 i) - InfoV5 i -> InfoV5 (info5 i) - - info3 BitmapInfoV3{..} = BitmapInfoV3 { dib3HeightFlipped = not dib3HeightFlipped, .. } - info4 BitmapInfoV4{..} = BitmapInfoV4 { dib4InfoV3 = info3 dib4InfoV3, .. } - info5 BitmapInfoV5{..} = BitmapInfoV5 { dib5InfoV4 = info4 dib5InfoV4, .. } - -- - return $ Right arr - - --- | Write the image data to a file. --- -writeImageToBMP :: FilePath -> Array DIM2 RGBA32 -> IO () -writeImageToBMP file rgba = writeBMP file bmp' - where - Z :. h :. w = shape rgba - bs = toByteStrings rgba - bmp = packRGBA32ToBMP w h bs - -- - bmp' = bmp { bmpBitmapInfo = info' } - info' = case bmpBitmapInfo bmp of - InfoV3 i -> InfoV3 (info3 i) - InfoV4 i -> InfoV4 (info4 i) - InfoV5 i -> InfoV5 (info5 i) - - info3 BitmapInfoV3{..} = BitmapInfoV3 { dib3Height = -dib3Height, dib3HeightFlipped = True, .. } - info4 BitmapInfoV4{..} = BitmapInfoV4 { dib4InfoV3 = info3 dib4InfoV3, .. } - info5 BitmapInfoV5{..} = BitmapInfoV5 { dib5InfoV4 = info4 dib5InfoV4, .. } - diff --git a/src/Data/Array/Accelerate/IO/Data/Array/IArray.hs b/src/Data/Array/Accelerate/IO/Data/Array/IArray.hs deleted file mode 100644 --- a/src/Data/Array/Accelerate/IO/Data/Array/IArray.hs +++ /dev/null @@ -1,107 +0,0 @@ -{-# LANGUAGE ScopedTypeVariables #-} -{-# LANGUAGE TemplateHaskell #-} -{-# LANGUAGE TypeFamilies #-} --- | --- Module : Data.Array.Accelerate.IO.Data.Array.IArray --- Copyright : [2016..2017] Trevor L. McDonell --- License : BSD3 --- --- Maintainer : Trevor L. McDonell --- Stability : experimental --- Portability : non-portable (GHC extensions) --- --- Convert between immutable 'IArray's and Accelerate 'Array's. --- - -module Data.Array.Accelerate.IO.Data.Array.IArray ( - - IxShapeRepr, - fromIArray, - toIArray, - -) where - -import Data.Array.Accelerate.Array.Sugar -import Data.Array.Accelerate.Type -import Data.Array.Accelerate.Error - -import Data.Array.Accelerate.IO.Data.Array.Internal - -import Data.Array.IArray ( IArray ) -import qualified Data.Array.IArray as IArray - - --- | /O(n)/. Convert an 'IArray' to an Accelerate 'Array'. --- --- The index type @ix@ of the 'IArray' corresponds to the shape @sh@ of the --- Accelerate 'Array' in the following way: --- --- > DIM0 ~ () --- > DIM1 ~ Int --- > DIM2 ~ (Int,Int) --- > DIM3 ~ (Int,Int,Int) --- --- ...and so forth. --- -{-# INLINE fromIArray #-} -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 TypeRunit () () = () - go (TypeRpair tl tr) (l0, r0) (l,r) = (go tl l0 l, go tr r0 r) - go (TypeRscalar (SingleScalarType (NumSingleType (IntegralNumType TypeInt{})))) i0 i = i0+i - go _ _ _ = - $internalError "fromIArray" "error in index offset" - - --- | /O(n)/. Convert an Accelerate 'Array' to an 'IArray'. --- --- See 'fromIArray' for a discussion on the expected shape types. --- -{-# INLINE toIArray #-} -toIArray - :: forall ix sh a e. (IxShapeRepr (EltRepr ix) ~ EltRepr sh, IArray a e, IArray.Ix ix, Shape sh, Elt ix) - => Maybe ix -- ^ if 'Just' this as the index lower bound, otherwise the array is indexed from zero - -> Array sh e - -> a ix e -toIArray mix0 arr = IArray.array bnds0 [(offset ix, arr ! toIxShapeRepr ix) | ix <- IArray.range bnds] - where - (u,v) = shapeToRange (shape arr) - bnds@(lo,hi) = (fromIxShapeRepr u, fromIxShapeRepr v) - bnds0 = (offset lo, offset hi) - - offset :: ix -> ix - offset ix = - case mix0 of - Nothing -> ix - Just ix0 -> offset' ix0 ix - - offset' :: ix -> ix -> ix - offset' ix0 ix - = fromIxShapeRepr - . (toElt :: EltRepr sh -> sh) - $ go (eltType (undefined::sh)) (fromElt (toIxShapeRepr ix0 :: sh)) (fromElt (toIxShapeRepr ix :: sh)) - where - go :: TupleType sh' -> sh' -> sh' -> sh' - go TypeRunit () () = () - go (TypeRpair tl tr) (l0,r0) (l,r) = (go tl l0 l, go tr r0 r) - go (TypeRscalar (SingleScalarType (NumSingleType (IntegralNumType TypeInt{})))) i0 i = i0+i - go _ _ _ = - $internalError "toIArray" "error in index offset" - diff --git a/src/Data/Array/Accelerate/IO/Data/Array/Internal.hs b/src/Data/Array/Accelerate/IO/Data/Array/Internal.hs deleted file mode 100644 --- a/src/Data/Array/Accelerate/IO/Data/Array/Internal.hs +++ /dev/null @@ -1,46 +0,0 @@ -{-# LANGUAGE ScopedTypeVariables #-} -{-# LANGUAGE TemplateHaskell #-} -{-# LANGUAGE TypeFamilies #-} --- | --- Module : Data.Array.Accelerate.IO.Data.Array.Internal --- Copyright : [2017] Trevor L. McDonell --- License : BSD3 --- --- Maintainer : Trevor L. McDonell --- Stability : experimental --- Portability : non-portable (GHC extensions) --- - -module Data.Array.Accelerate.IO.Data.Array.Internal - where - -import Data.Array.Accelerate.Array.Sugar -import Data.Array.Accelerate.Error -import Data.Array.Accelerate.Type - - -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 TypeRunit () = () - go (TypeRpair tt _) (t, h) = (go tt t, h) - go (TypeRscalar (SingleScalarType (NumSingleType (IntegralNumType TypeInt{})))) ((),h) = h - go _ _ = - $internalError "fromIxShapeRepr" "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 TypeRunit () = () - go (TypeRpair tt _) (t, h) = (go tt t, h) - go (TypeRscalar (SingleScalarType (NumSingleType (IntegralNumType TypeInt{})))) h = ((),h) - go _ _ = - $internalError "toIxShapeRepr" "not a valid IArray.Ix" - diff --git a/src/Data/Array/Accelerate/IO/Data/Array/Unboxed.hs b/src/Data/Array/Accelerate/IO/Data/Array/Unboxed.hs deleted file mode 100644 --- a/src/Data/Array/Accelerate/IO/Data/Array/Unboxed.hs +++ /dev/null @@ -1,148 +0,0 @@ -{-# LANGUAGE FlexibleContexts #-} -{-# LANGUAGE MagicHash #-} -{-# LANGUAGE ScopedTypeVariables #-} -{-# LANGUAGE TemplateHaskell #-} -{-# LANGUAGE TypeFamilies #-} --- | --- Module : Data.Array.Accelerate.IO.Data.Array.Unboxed --- Copyright : [2016..2017] Trevor L. McDonell --- License : BSD3 --- --- Maintainer : Trevor L. McDonell --- Stability : experimental --- Portability : non-portable (GHC extensions) --- --- Efficient conversion between immutable unboxed 'IArray's and Accelerate --- 'Array's. --- - -module Data.Array.Accelerate.IO.Data.Array.Unboxed ( - - IxShapeRepr, - fromUArray, - toUArray, - -) where - -import Data.Array.Accelerate.Array.Data -import Data.Array.Accelerate.Array.Sugar -import Data.Array.Accelerate.Array.Unique -import Data.Array.Accelerate.Error -import Data.Array.Accelerate.Lifetime -import Data.Array.Accelerate.Type -import qualified Data.Array.Accelerate.Array.Representation as R - -import Data.Array.Accelerate.IO.Data.Array.Internal -import Data.Array.Accelerate.IO.Data.Vector.Primitive.Internal - -import Data.Primitive ( Prim, sizeOf ) -import Data.Primitive.ByteArray - -import Data.Array.Base -import Data.Array.Unboxed as U hiding ( Array ) -import System.IO.Unsafe - - --- | /O(n)/. Convert an unboxed 'UArray' into an Accelerate array. --- --- See 'Data.Array.Accelerate.IO.Data.Array.IArray.fromIArray' for more --- information about the array index type. --- --- If the underlying vectors are pinned then this can be done without copying. --- --- See also: --- --- @since 1.1.0.0@ --- -{-# INLINE fromUArray #-} -fromUArray - :: forall ix sh e. (IxShapeRepr (EltRepr ix) ~ EltRepr sh, IArray UArray e, Ix ix, Shape sh, Elt ix, Elt e) - => UArray ix e - -> Array sh e -fromUArray (UArray lo hi n ba#) = Array (fromElt sh) (aux (arrayElt :: ArrayEltR (EltRepr e))) - where - sh = rangeToShape (toIxShapeRepr lo, toIxShapeRepr hi) :: sh - - wrap :: forall a. Prim a => (UniqueArray a -> ArrayData a) -> ArrayData a - wrap k = k $ unsafePerformIO (newUniqueArray =<< foreignPtrOfByteArray 0 (n * sizeOf (undefined::a)) (ByteArray ba#)) - - aux :: ArrayEltR a -> ArrayData a - 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 ArrayEltRfloat = wrap AD_Float - aux ArrayEltRdouble = wrap AD_Double - aux ArrayEltRchar = wrap AD_Char - aux ArrayEltRbool = $internalError "fromUArray" "TODO: Bool" -- need to unpack bit array - aux _ = $internalError "fromUArray" "unsupported type" - - --- | /O(1)/ (typically). Convert an Accelerate 'Array' to an unboxed 'UArray'. --- --- See 'Data.Array.Accelerate.IO.Data.Array.IArray.fromIArray' for more --- information about the array index type. --- --- If the array data was allocated by Accelerate, this can typically be done --- without copying. --- --- @since 1.1.0.0@ --- -{-# INLINE toUArray #-} -toUArray - :: forall ix sh e. (IxShapeRepr (EltRepr ix) ~ EltRepr sh, IArray UArray e, Ix ix, Shape sh, Elt ix) - => Maybe ix -- ^ if 'Just' this is the index lower bound, otherwise the array is indexed from zero - -> Array sh e - -> UArray ix e -toUArray mix0 arr@(Array sh adata) = - case ba of - ByteArray ba# -> UArray lo hi n ba# - where - n = R.size sh - bnds = shapeToRange (shape arr) - lo = fromIxShapeRepr (offset (fst bnds)) - hi = fromIxShapeRepr (offset (snd bnds)) - ba = aux arrayElt adata - - offset :: sh -> sh - offset ix = - case mix0 of - Nothing -> ix - Just ix0 -> offset' ix0 ix - - offset' :: ix -> sh -> sh - offset' ix0 = toElt . go (eltType (undefined::sh)) (fromElt (toIxShapeRepr ix0 :: sh)) . fromElt - where - go :: TupleType sh' -> sh' -> sh' -> sh' - go TypeRunit () () = () - go (TypeRpair tl tr) (l0, r0) (l,r) = (go tl l0 l, go tr r0 r) - go (TypeRscalar (SingleScalarType (NumSingleType (IntegralNumType TypeInt{})))) i0 i = i0+i - go _ _ _ = - $internalError "toUArray" "error in index offset" - - wrap :: forall a. Prim a => UniqueArray a -> ByteArray - wrap ua = unsafePerformIO $ byteArrayOfForeignPtr (n * sizeOf (undefined::a)) (unsafeGetValue (uniqueArrayData ua)) - - aux :: ArrayEltR a -> ArrayData a -> ByteArray - aux ArrayEltRint (AD_Int v) = wrap v - aux ArrayEltRint8 (AD_Int8 v) = wrap v - aux ArrayEltRint16 (AD_Int16 v) = wrap v - aux ArrayEltRint32 (AD_Int32 v) = wrap v - aux ArrayEltRint64 (AD_Int64 v) = wrap v - aux ArrayEltRword (AD_Word v) = wrap v - aux ArrayEltRword8 (AD_Word8 v) = wrap v - aux ArrayEltRword16 (AD_Word16 v) = wrap v - aux ArrayEltRword32 (AD_Word32 v) = wrap v - aux ArrayEltRword64 (AD_Word64 v) = wrap v - aux ArrayEltRfloat (AD_Float v) = wrap v - aux ArrayEltRdouble (AD_Double v) = wrap v - aux ArrayEltRchar (AD_Char v) = wrap v - aux ArrayEltRbool (AD_Bool _) = $internalError "toUArray" "TODO: Bool" -- need to pack bit array - aux _ _ = $internalError "toUArray" "unsupported type" - diff --git a/src/Data/Array/Accelerate/IO/Data/ByteString.hs b/src/Data/Array/Accelerate/IO/Data/ByteString.hs deleted file mode 100644 --- a/src/Data/Array/Accelerate/IO/Data/ByteString.hs +++ /dev/null @@ -1,206 +0,0 @@ -{-# LANGUAGE CPP #-} -{-# LANGUAGE MagicHash #-} -{-# LANGUAGE ScopedTypeVariables #-} -{-# LANGUAGE TypeFamilies #-} -{-# LANGUAGE ViewPatterns #-} --- | --- Module : Data.Array.Accelerate.IO.Data.ByteString --- Copyright : [2010..2011] Sean Seefried --- [2010..2017] Trevor L. McDonell --- License : BSD3 --- --- Maintainer : Trevor L. McDonell --- Stability : experimental --- Portability : non-portable (GHC extensions) --- --- Conversion between strict 'ByteString's and Accelerate 'Array's. --- - -module Data.Array.Accelerate.IO.Data.ByteString ( - - ByteStrings, - fromByteStrings, toByteStrings, - -) where - -import Data.Array.Accelerate.Array.Data -import Data.Array.Accelerate.Array.Sugar -import Data.Array.Accelerate.Array.Unique -import Data.Array.Accelerate.Lifetime -import Data.Array.Accelerate.Type -import qualified Data.Array.Accelerate.Array.Representation as R - -import Data.ByteString as B -import Data.ByteString.Internal as B -import Foreign.ForeignPtr -import Foreign.Storable -import System.IO.Unsafe - -#if !MIN_VERSION_base(4,10,0) -import GHC.ForeignPtr -import GHC.Base -#endif - - --- | A family of types that represents a collection of 'ByteString's. The --- structure of the collection depends on the element type @e@. --- -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 Half = 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 (V2 a) = ByteStrings a -type instance ByteStrings (V3 a) = ByteStrings a -type instance ByteStrings (V4 a) = ByteStrings a -type instance ByteStrings (V8 a) = ByteStrings a -type instance ByteStrings (V16 a) = ByteStrings a -type instance ByteStrings (a,b) = (ByteStrings a, ByteStrings b) - - --- | /O(1)/. Treat a set of strict 'ByteStrings' as an Accelerate array. The --- type of the 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 input --- contains the right number of bytes (this is not checked). --- --- The input data may not be modified through the 'ByteString's afterwards. --- --- @since 1.1.0.0@ --- -{-# INLINE fromByteStrings #-} -fromByteStrings :: (Shape sh, Elt e) => sh -> ByteStrings (EltRepr e) -> Array sh e -fromByteStrings sh bs = Array (fromElt sh) (aux arrayElt bs) - where - wrap :: (UniqueArray e -> r) -> ByteString -> r - wrap k (B.toForeignPtr -> (ps,s,_)) = - k (unsafePerformIO $ newUniqueArray (castForeignPtr (plusForeignPtr ps s))) - - aux :: ArrayEltR e -> ByteStrings 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 ArrayEltRhalf = wrap AD_Half - 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 (ArrayEltRvec2 ae) = AD_V2 . aux ae - aux (ArrayEltRvec3 ae) = AD_V3 . aux ae - aux (ArrayEltRvec4 ae) = AD_V4 . aux ae - aux (ArrayEltRvec8 ae) = AD_V8 . aux ae - aux (ArrayEltRvec16 ae) = AD_V16 . aux ae - aux (ArrayEltRpair ae1 ae2) = \(v1,v2) -> AD_Pair (aux ae1 v1) (aux ae2 v2) - - --- | /O(1)/. Convert an Accelerate 'Array' into a collection of strict --- 'ByteStrings'. 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 toByteStrings #-} -toByteStrings :: (Shape sh, Elt e) => Array sh e -> ByteStrings (EltRepr e) -toByteStrings (Array sh adata) = aux arrayElt adata - where - n :: Int - n = R.size sh - - wrap :: forall a. Storable a => UniqueArray a -> ByteString - wrap (unsafeGetValue . uniqueArrayData -> fp) = - B.fromForeignPtr (castForeignPtr fp) 0 (n * sizeOf (undefined::a)) - - aux :: ArrayEltR e -> ArrayData e -> ByteStrings 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 ArrayEltRhalf (AD_Half 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 (ArrayEltRvec2 ae) (AD_V2 s) = aux ae s - aux (ArrayEltRvec3 ae) (AD_V3 s) = aux ae s - aux (ArrayEltRvec4 ae) (AD_V4 s) = aux ae s - aux (ArrayEltRvec8 ae) (AD_V8 s) = aux ae s - aux (ArrayEltRvec16 ae) (AD_V16 s) = aux ae s - aux (ArrayEltRpair ae1 ae2) (AD_Pair s1 s2) = (aux ae1 s1, aux ae2 s2) - - -#if !MIN_VERSION_base(4,10,0) -plusForeignPtr :: ForeignPtr a -> Int -> ForeignPtr b -plusForeignPtr (ForeignPtr addr# c) (I# d#) = ForeignPtr (plusAddr# addr# d#) c -#endif - diff --git a/src/Data/Array/Accelerate/IO/Data/Vector/Generic.hs b/src/Data/Array/Accelerate/IO/Data/Vector/Generic.hs deleted file mode 100644 --- a/src/Data/Array/Accelerate/IO/Data/Vector/Generic.hs +++ /dev/null @@ -1,57 +0,0 @@ -{-# LANGUAGE FlexibleInstances #-} -{-# LANGUAGE MultiParamTypeClasses #-} -{-# LANGUAGE ScopedTypeVariables #-} -{-# LANGUAGE TypeFamilies #-} -{-# LANGUAGE TypeSynonymInstances #-} -{-# OPTIONS_GHC -fno-warn-orphans #-} --- | --- Module : Data.Array.Accelerate.IO.Data.Vector.Generic --- Copyright : [2017] Trevor L. McDonell --- License : BSD3 --- --- Maintainer : Trevor L. McDonell --- Stability : experimental --- Portability : non-portable (GHC extensions) --- --- This module provides an instance for 'Data.Vector.Generic.Vector', for --- immutable vectors from the @vector@ package backed by Accelerate arrays. --- --- This allows computations written with the @vector@ library to read from and --- store into, arrays which can then be passed directly to an Accelerate --- computation. --- --- @since 1.2.0.0 --- - -module Data.Array.Accelerate.IO.Data.Vector.Generic - where - -import Data.Array.Accelerate.Array.Sugar as A -import Data.Array.Accelerate.Array.Data as A -import Data.Array.Accelerate.IO.Data.Vector.Generic.Mutable as A - -import qualified Data.Vector.Generic as V -import qualified Data.Vector.Generic.Mutable as M - - -type instance V.Mutable Vector = MVector - -instance Elt e => V.Vector Vector e where - {-# INLINE basicUnsafeFreeze #-} - {-# INLINE basicUnsafeThaw #-} - {-# INLINE basicLength #-} - {-# INLINE basicUnsafeSlice #-} - {-# INLINE basicUnsafeIndexM #-} - {-# INLINE basicUnsafeCopy #-} - basicUnsafeFreeze (MArray sh mad) = return (Array sh mad) - basicUnsafeThaw (Array sh ad) = return (MArray sh ad) - basicLength (Array ((),n) _) = n - - basicUnsafeSlice i n (Array sh ad) = - case M.basicUnsafeSlice i n (MArray sh ad :: MVector s e) of - MArray sh' mad' -> Array sh' mad' - - basicUnsafeIndexM (Array _ ad) i = return $ toElt (unsafeIndexArrayData ad i) - - basicUnsafeCopy dst (Array sh ad) = M.basicUnsafeCopy dst (MArray sh ad) - diff --git a/src/Data/Array/Accelerate/IO/Data/Vector/Generic/Mutable.hs b/src/Data/Array/Accelerate/IO/Data/Vector/Generic/Mutable.hs deleted file mode 100644 --- a/src/Data/Array/Accelerate/IO/Data/Vector/Generic/Mutable.hs +++ /dev/null @@ -1,263 +0,0 @@ -{-# LANGUAGE BangPatterns #-} -{-# LANGUAGE CPP #-} -{-# LANGUAGE DeriveDataTypeable #-} -{-# LANGUAGE FlexibleInstances #-} -{-# LANGUAGE GADTs #-} -{-# LANGUAGE MagicHash #-} -{-# LANGUAGE MultiParamTypeClasses #-} -{-# LANGUAGE ScopedTypeVariables #-} -{-# LANGUAGE StandaloneDeriving #-} -{-# LANGUAGE TypeSynonymInstances #-} --- | --- Module : Data.Array.Accelerate.IO.Data.Vector.Generic.Mutable --- Copyright : [2017] Trevor L. McDonell --- License : BSD3 --- --- Maintainer : Trevor L. McDonell --- Stability : experimental --- Portability : non-portable (GHC extensions) --- --- This module provides instance for 'Data.Vector.Generic.Mutable.MVector', for --- generic mutable vectors backed by Accelerate. --- --- @since 1.2.0.0 --- - -module Data.Array.Accelerate.IO.Data.Vector.Generic.Mutable - where - -import Data.Array.Accelerate.Array.Data as A -import Data.Array.Accelerate.Array.Sugar as A -import Data.Array.Accelerate.Array.Unique as A -import Data.Array.Accelerate.Lifetime - -import qualified Data.Vector.Generic.Mutable as V - -import Control.Monad.Primitive -import Data.Typeable -import Foreign.Ptr -import Foreign.Marshal.Utils -import Foreign.Storable -import Prelude hiding ( length ) - -import GHC.Base -import GHC.ForeignPtr - - --- | Dense, regular, mutable, multi-dimensional arrays --- -data MArray sh s e where - MArray :: (Shape sh, Elt e) - => EltRepr sh -- extent of dimensions == shape - -> MutableArrayData (EltRepr e) -- mutable array payload - -> MArray sh s e - -deriving instance Typeable MArray - -type MVector = MArray DIM1 - -instance Elt e => V.MVector MVector e where - {-# INLINE basicLength #-} - {-# INLINE basicUnsafeSlice #-} - {-# INLINE basicOverlaps #-} - {-# INLINE basicUnsafeNew #-} - {-# INLINE basicInitialize #-} - {-# INLINE basicUnsafeRead #-} - {-# INLINE basicUnsafeWrite #-} - {-# INLINE basicUnsafeCopy #-} - basicLength (MArray ((), n) _) = n - - basicUnsafeSlice j m (MArray _ mad) = MArray ((),m) (go arrayElt mad 1) - where - go :: ArrayEltR a -> MutableArrayData a -> Int -> MutableArrayData a - go ArrayEltRunit AD_Unit !_ = AD_Unit - go ArrayEltRint (AD_Int v) !s = AD_Int (slice v s) - go ArrayEltRint8 (AD_Int8 v) !s = AD_Int8 (slice v s) - go ArrayEltRint16 (AD_Int16 v) !s = AD_Int16 (slice v s) - go ArrayEltRint32 (AD_Int32 v) !s = AD_Int32 (slice v s) - go ArrayEltRint64 (AD_Int64 v) !s = AD_Int64 (slice v s) - go ArrayEltRword (AD_Word v) !s = AD_Word (slice v s) - go ArrayEltRword8 (AD_Word8 v) !s = AD_Word8 (slice v s) - go ArrayEltRword16 (AD_Word16 v) !s = AD_Word16 (slice v s) - go ArrayEltRword32 (AD_Word32 v) !s = AD_Word32 (slice v s) - go ArrayEltRword64 (AD_Word64 v) !s = AD_Word64 (slice v s) - go ArrayEltRcshort (AD_CShort v) !s = AD_CShort (slice v s) - go ArrayEltRcushort (AD_CUShort v) !s = AD_CUShort (slice v s) - go ArrayEltRcint (AD_CInt v) !s = AD_CInt (slice v s) - go ArrayEltRcuint (AD_CUInt v) !s = AD_CUInt (slice v s) - go ArrayEltRclong (AD_CLong v) !s = AD_CLong (slice v s) - go ArrayEltRculong (AD_CULong v) !s = AD_CULong (slice v s) - go ArrayEltRcllong (AD_CLLong v) !s = AD_CLLong (slice v s) - go ArrayEltRcullong (AD_CULLong v) !s = AD_CULLong (slice v s) - go ArrayEltRhalf (AD_Half v) !s = AD_Half (slice v s) - go ArrayEltRfloat (AD_Float v) !s = AD_Float (slice v s) - go ArrayEltRdouble (AD_Double v) !s = AD_Double (slice v s) - go ArrayEltRcfloat (AD_CFloat v) !s = AD_CFloat (slice v s) - go ArrayEltRcdouble (AD_CDouble v) !s = AD_CDouble (slice v s) - go ArrayEltRbool (AD_Bool v) !s = AD_Bool (slice v s) - go ArrayEltRchar (AD_Char v) !s = AD_Char (slice v s) - go ArrayEltRcchar (AD_CChar v) !s = AD_CChar (slice v s) - go ArrayEltRcschar (AD_CSChar v) !s = AD_CSChar (slice v s) - go ArrayEltRcuchar (AD_CUChar v) !s = AD_CUChar (slice v s) - go (ArrayEltRvec2 ae) (AD_V2 v) !s = AD_V2 (go ae v (s*2)) - go (ArrayEltRvec3 ae) (AD_V3 v) !s = AD_V3 (go ae v (s*3)) - go (ArrayEltRvec4 ae) (AD_V4 v) !s = AD_V4 (go ae v (s*4)) - go (ArrayEltRvec8 ae) (AD_V8 v) !s = AD_V8 (go ae v (s*8)) - go (ArrayEltRvec16 ae) (AD_V16 v) !s = AD_V16 (go ae v (s*16)) - go (ArrayEltRpair ae1 ae2) (AD_Pair v1 v2) !s = AD_Pair (go ae1 v1 s) (go ae2 v2 s) - - slice :: forall a. Storable a => UniqueArray a -> Int -> UniqueArray a - slice (UniqueArray uid (Lifetime lft w fp)) s = - UniqueArray uid (Lifetime lft w (plusForeignPtr fp (j * s * sizeOf (undefined::a)))) - - basicOverlaps (MArray ((),m) mad1) (MArray ((),n) mad2) = go arrayElt mad1 mad2 1 - where - go :: ArrayEltR a -> MutableArrayData a -> MutableArrayData a -> Int -> Bool - go ArrayEltRunit AD_Unit AD_Unit !_ = False - go ArrayEltRint (AD_Int v1) (AD_Int v2) !s = overlaps v1 v2 s - go ArrayEltRint8 (AD_Int8 v1) (AD_Int8 v2) !s = overlaps v1 v2 s - go ArrayEltRint16 (AD_Int16 v1) (AD_Int16 v2) !s = overlaps v1 v2 s - go ArrayEltRint32 (AD_Int32 v1) (AD_Int32 v2) !s = overlaps v1 v2 s - go ArrayEltRint64 (AD_Int64 v1) (AD_Int64 v2) !s = overlaps v1 v2 s - go ArrayEltRword (AD_Word v1) (AD_Word v2) !s = overlaps v1 v2 s - go ArrayEltRword8 (AD_Word8 v1) (AD_Word8 v2) !s = overlaps v1 v2 s - go ArrayEltRword16 (AD_Word16 v1) (AD_Word16 v2) !s = overlaps v1 v2 s - go ArrayEltRword32 (AD_Word32 v1) (AD_Word32 v2) !s = overlaps v1 v2 s - go ArrayEltRword64 (AD_Word64 v1) (AD_Word64 v2) !s = overlaps v1 v2 s - go ArrayEltRcshort (AD_CShort v1) (AD_CShort v2) !s = overlaps v1 v2 s - go ArrayEltRcushort (AD_CUShort v1) (AD_CUShort v2) !s = overlaps v1 v2 s - go ArrayEltRcint (AD_CInt v1) (AD_CInt v2) !s = overlaps v1 v2 s - go ArrayEltRcuint (AD_CUInt v1) (AD_CUInt v2) !s = overlaps v1 v2 s - go ArrayEltRclong (AD_CLong v1) (AD_CLong v2) !s = overlaps v1 v2 s - go ArrayEltRculong (AD_CULong v1) (AD_CULong v2) !s = overlaps v1 v2 s - go ArrayEltRcllong (AD_CLLong v1) (AD_CLLong v2) !s = overlaps v1 v2 s - go ArrayEltRcullong (AD_CULLong v1) (AD_CULLong v2) !s = overlaps v1 v2 s - go ArrayEltRhalf (AD_Half v1) (AD_Half v2) !s = overlaps v1 v2 s - go ArrayEltRfloat (AD_Float v1) (AD_Float v2) !s = overlaps v1 v2 s - go ArrayEltRdouble (AD_Double v1) (AD_Double v2) !s = overlaps v1 v2 s - go ArrayEltRcfloat (AD_CFloat v1) (AD_CFloat v2) !s = overlaps v1 v2 s - go ArrayEltRcdouble (AD_CDouble v1) (AD_CDouble v2) !s = overlaps v1 v2 s - go ArrayEltRbool (AD_Bool v1) (AD_Bool v2) !s = overlaps v1 v2 s - go ArrayEltRchar (AD_Char v1) (AD_Char v2) !s = overlaps v1 v2 s - go ArrayEltRcchar (AD_CChar v1) (AD_CChar v2) !s = overlaps v1 v2 s - go ArrayEltRcschar (AD_CSChar v1) (AD_CSChar v2) !s = overlaps v1 v2 s - go ArrayEltRcuchar (AD_CUChar v1) (AD_CUChar v2) !s = overlaps v1 v2 s - go (ArrayEltRvec2 ae) (AD_V2 v1) (AD_V2 v2) !s = go ae v1 v2 (s*2) - go (ArrayEltRvec3 ae) (AD_V3 v1) (AD_V3 v3) !s = go ae v1 v3 (s*3) - go (ArrayEltRvec4 ae) (AD_V4 v1) (AD_V4 v4) !s = go ae v1 v4 (s*4) - go (ArrayEltRvec8 ae) (AD_V8 v1) (AD_V8 v8) !s = go ae v1 v8 (s*8) - go (ArrayEltRvec16 ae) (AD_V16 v1) (AD_V16 v16) !s = go ae v1 v16 (s*16) - go (ArrayEltRpair ae1 ae2) (AD_Pair v11 v12) (AD_Pair v21 v22) !s = go ae1 v11 v21 s || go ae2 v12 v22 s - - overlaps :: forall a. Storable a => UniqueArray a -> UniqueArray a -> Int -> Bool - overlaps (UniqueArray _ (Lifetime _ _ (ForeignPtr addr1# c1))) (UniqueArray _ (Lifetime _ _ (ForeignPtr addr2# c2))) s = - let i = I# (addr2Int# addr1#) - j = I# (addr2Int# addr2#) - k = s * sizeOf (undefined::a) - in - same c1 c2 && (between i j (j + n*k) || between j i (i + m*k)) - - same :: ForeignPtrContents -> ForeignPtrContents -> Bool - same (PlainPtr mba1#) (PlainPtr mba2#) = isTrue# (sameMutableByteArray# mba1# mba2#) - same (MallocPtr mba1# _) (MallocPtr mba2# _) = isTrue# (sameMutableByteArray# mba1# mba2#) - -- same PlainForeignPtr{} PlainForeignPtr{} = False -- probably? - same _ _ = False -- probably? should we still check whether the address ranges overlap? - - between :: Int -> Int -> Int -> Bool - between x y z = x >= y && x < z - - basicUnsafeNew n = unsafePrimToPrim $ MArray ((),n) <$> newArrayData n - - basicInitialize (MArray ((),n) mad) = unsafePrimToPrim $ go (arrayElt :: ArrayEltR (EltRepr e)) (ptrsOfArrayData mad) 1 - where - go :: ArrayEltR a -> ArrayPtrs a -> Int -> IO () - go ArrayEltRunit () !_ = return () - go ArrayEltRint p !s = initialise p s - go ArrayEltRint8 p !s = initialise p s - go ArrayEltRint16 p !s = initialise p s - go ArrayEltRint32 p !s = initialise p s - go ArrayEltRint64 p !s = initialise p s - go ArrayEltRword p !s = initialise p s - go ArrayEltRword8 p !s = initialise p s - go ArrayEltRword16 p !s = initialise p s - go ArrayEltRword32 p !s = initialise p s - go ArrayEltRword64 p !s = initialise p s - go ArrayEltRcshort p !s = initialise p s - go ArrayEltRcushort p !s = initialise p s - go ArrayEltRcint p !s = initialise p s - go ArrayEltRcuint p !s = initialise p s - go ArrayEltRclong p !s = initialise p s - go ArrayEltRculong p !s = initialise p s - go ArrayEltRcllong p !s = initialise p s - go ArrayEltRcullong p !s = initialise p s - go ArrayEltRhalf p !s = initialise p s - go ArrayEltRfloat p !s = initialise p s - go ArrayEltRdouble p !s = initialise p s - go ArrayEltRcfloat p !s = initialise p s - go ArrayEltRcdouble p !s = initialise p s - go ArrayEltRbool p !s = initialise p s - go ArrayEltRchar p !s = initialise p s - go ArrayEltRcchar p !s = initialise p s - go ArrayEltRcschar p !s = initialise p s - go ArrayEltRcuchar p !s = initialise p s - go (ArrayEltRvec2 ae) p !s = go ae p (s*2) - go (ArrayEltRvec3 ae) p !s = go ae p (s*3) - go (ArrayEltRvec4 ae) p !s = go ae p (s*4) - go (ArrayEltRvec8 ae) p !s = go ae p (s*8) - go (ArrayEltRvec16 ae) p !s = go ae p (s*16) - go (ArrayEltRpair ae1 ae2) (p1,p2) s = go ae1 p1 s >> go ae2 p2 s - - initialise :: forall a. Storable a => Ptr a -> Int -> IO () - initialise p s = fillBytes p 0 (n * s * sizeOf (undefined::a)) - - basicUnsafeRead (MArray _ mad) i = unsafePrimToPrim $ toElt <$> unsafeReadArrayData mad i - basicUnsafeWrite (MArray _ mad) i v = unsafePrimToPrim $ unsafeWriteArrayData mad i (fromElt v) - - basicUnsafeCopy (MArray _ dst) (MArray ((),n) src) = unsafePrimToPrim $ go (arrayElt :: ArrayEltR (EltRepr e)) (ptrsOfArrayData dst) (ptrsOfArrayData src) 1 - where - go :: ArrayEltR a -> ArrayPtrs a -> ArrayPtrs a -> Int -> IO () - go ArrayEltRunit () () !_ = return () - go ArrayEltRint u v !s = copy u v s - go ArrayEltRint8 u v !s = copy u v s - go ArrayEltRint16 u v !s = copy u v s - go ArrayEltRint32 u v !s = copy u v s - go ArrayEltRint64 u v !s = copy u v s - go ArrayEltRword u v !s = copy u v s - go ArrayEltRword8 u v !s = copy u v s - go ArrayEltRword16 u v !s = copy u v s - go ArrayEltRword32 u v !s = copy u v s - go ArrayEltRword64 u v !s = copy u v s - go ArrayEltRcshort u v !s = copy u v s - go ArrayEltRcushort u v !s = copy u v s - go ArrayEltRcint u v !s = copy u v s - go ArrayEltRcuint u v !s = copy u v s - go ArrayEltRclong u v !s = copy u v s - go ArrayEltRculong u v !s = copy u v s - go ArrayEltRcllong u v !s = copy u v s - go ArrayEltRcullong u v !s = copy u v s - go ArrayEltRhalf u v !s = copy u v s - go ArrayEltRfloat u v !s = copy u v s - go ArrayEltRdouble u v !s = copy u v s - go ArrayEltRcfloat u v !s = copy u v s - go ArrayEltRcdouble u v !s = copy u v s - go ArrayEltRbool u v !s = copy u v s - go ArrayEltRchar u v !s = copy u v s - go ArrayEltRcchar u v !s = copy u v s - go ArrayEltRcschar u v !s = copy u v s - go ArrayEltRcuchar u v !s = copy u v s - go (ArrayEltRvec2 ae) u v !s = go ae u v (s*2) - go (ArrayEltRvec3 ae) u v !s = go ae u v (s*3) - go (ArrayEltRvec4 ae) u v !s = go ae u v (s*4) - go (ArrayEltRvec8 ae) u v !s = go ae u v (s*8) - go (ArrayEltRvec16 ae) u v !s = go ae u v (s*16) - go (ArrayEltRpair ae1 ae2) (u1,u2) (v1,v2) s = go ae1 u1 v1 s >> go ae2 u2 v2 s - - copy :: forall a. Storable a => Ptr a -> Ptr a -> Int -> IO () - copy u v s = copyBytes u v (n * s * sizeOf (undefined::a)) - - -#if !MIN_VERSION_base(4,10,0) -plusForeignPtr :: ForeignPtr a -> Int -> ForeignPtr b -plusForeignPtr (ForeignPtr addr# c) (I# i#) = ForeignPtr (plusAddr# addr# i#) c -#endif - diff --git a/src/Data/Array/Accelerate/IO/Data/Vector/Primitive.hs b/src/Data/Array/Accelerate/IO/Data/Vector/Primitive.hs deleted file mode 100644 --- a/src/Data/Array/Accelerate/IO/Data/Vector/Primitive.hs +++ /dev/null @@ -1,140 +0,0 @@ -{-# LANGUAGE BangPatterns #-} -{-# LANGUAGE TemplateHaskell #-} -{-# LANGUAGE TypeFamilies #-} --- | --- Module : Data.Array.Accelerate.IO.Data.Vector.Primitive --- Copyright : [2017] Trevor L. McDonell --- License : BSD3 --- --- Maintainer : Trevor L. McDonell --- Stability : experimental --- Portability : non-portable (GHC extensions) --- --- Efficient conversion between 'Data.Vector.Primitive' vectors and Accelerate --- 'Array's. --- - -module Data.Array.Accelerate.IO.Data.Vector.Primitive ( - - Vectors, - toVectors, - fromVectors, - -) where - -import Data.Vector.Primitive - -import Data.Array.Accelerate.IO.Data.Vector.Primitive.Internal - -import Data.Array.Accelerate.Array.Data -import Data.Array.Accelerate.Array.Sugar hiding ( Vector ) -import Data.Array.Accelerate.Array.Unique -import Data.Array.Accelerate.Error -import qualified Data.Array.Accelerate.Array.Representation as R - -import Data.Int -import Data.Word - - --- | A family of types which represent a collection of Primitive Vectors. The --- structure of the collection depends on the element type @e@ of the --- corresponding Accelerate array. --- -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 Float = Vector Float -type instance Vectors Double = Vector Double -type instance Vectors Char = Vector Char -type instance Vectors (a,b) = (Vectors a, Vectors b) - - --- | /O(n)/ (typically). Convert a collection of primitive vectors into an --- Accelerate array. --- --- If the underlying vectors are pinned then this can be done without. --- --- See also: --- --- @since 1.1.0.0@ --- -{-# INLINE fromVectors #-} -fromVectors :: (Shape sh, Elt e) => sh -> Vectors (EltRepr e) -> Array sh e -fromVectors sh vecs = Array (fromElt sh) (aux arrayElt vecs) - where - {-# INLINE wrap #-} - wrap :: Prim a => Vector a -> UniqueArray a - wrap v@(Vector _ l _) - = $boundsCheck "fromVectors" "shape mismatch" (size sh == l) - $ uniqueArrayOfVector v - - {-# INLINE aux #-} - aux :: ArrayEltR e -> Vectors e -> ArrayData e - aux ArrayEltRunit _ = AD_Unit - aux ArrayEltRint v = AD_Int (wrap v) - aux ArrayEltRint8 v = AD_Int8 (wrap v) - aux ArrayEltRint16 v = AD_Int16 (wrap v) - aux ArrayEltRint32 v = AD_Int32 (wrap v) - aux ArrayEltRint64 v = AD_Int64 (wrap v) - aux ArrayEltRword v = AD_Word (wrap v) - aux ArrayEltRword8 v = AD_Word8 (wrap v) - aux ArrayEltRword16 v = AD_Word16 (wrap v) - aux ArrayEltRword32 v = AD_Word32 (wrap v) - aux ArrayEltRword64 v = AD_Word64 (wrap v) - aux ArrayEltRchar v = AD_Char (wrap v) - aux ArrayEltRfloat v = AD_Float (wrap v) - aux ArrayEltRdouble v = AD_Double (wrap v) - aux (ArrayEltRpair ad1 ad2) (v1,v2) = AD_Pair (aux ad1 v1) (aux ad2 v2) - -- - aux _ _ = $internalError "fromVectors" "unsupported type" - - --- | /O(1)/ (typically). Convert an Accelerate array into a collection of --- primitive vectors. --- --- If the array data was allocated by Accelerate, this can typically be done --- without copying. --- --- @since 1.1.0.0@ --- -{-# INLINE toVectors #-} -toVectors :: (Shape sh, Elt e) => Array sh e -> Vectors (EltRepr e) -toVectors (Array sh adata) = aux arrayElt adata - where - n :: Int - !n = R.size sh - - {-# INLINE wrap #-} - wrap :: Prim a => UniqueArray a -> Vector a - wrap ua = vectorOfUniqueArray n ua - - {-# INLINE aux #-} - aux :: ArrayEltR e -> ArrayData e -> Vectors e - aux ArrayEltRunit AD_Unit = () - aux ArrayEltRint (AD_Int v) = wrap v - aux ArrayEltRint8 (AD_Int8 v) = wrap v - aux ArrayEltRint16 (AD_Int16 v) = wrap v - aux ArrayEltRint32 (AD_Int32 v) = wrap v - aux ArrayEltRint64 (AD_Int64 v) = wrap v - aux ArrayEltRword (AD_Word v) = wrap v - aux ArrayEltRword8 (AD_Word8 v) = wrap v - aux ArrayEltRword16 (AD_Word16 v) = wrap v - aux ArrayEltRword32 (AD_Word32 v) = wrap v - aux ArrayEltRword64 (AD_Word64 v) = wrap v - aux ArrayEltRchar (AD_Char v) = wrap v - aux ArrayEltRfloat (AD_Float v) = wrap v - aux ArrayEltRdouble (AD_Double v) = wrap v - aux (ArrayEltRpair ad1 ad2) (AD_Pair v1 v2) = (aux ad1 v1, aux ad2 v2) - -- - aux _ _ = $internalError "toVectors" "unsupported type" - diff --git a/src/Data/Array/Accelerate/IO/Data/Vector/Primitive/Internal.hs b/src/Data/Array/Accelerate/IO/Data/Vector/Primitive/Internal.hs deleted file mode 100644 --- a/src/Data/Array/Accelerate/IO/Data/Vector/Primitive/Internal.hs +++ /dev/null @@ -1,82 +0,0 @@ -{-# LANGUAGE CPP #-} -{-# LANGUAGE MagicHash #-} -{-# LANGUAGE ScopedTypeVariables #-} -{-# LANGUAGE UnboxedTuples #-} --- | --- Module : Data.Array.Accelerate.IO.Data.Vector.Primitive.Internal --- Copyright : [2017] Trevor L. McDonell --- License : BSD3 --- --- Maintainer : Trevor L. McDonell --- Stability : experimental --- Portability : non-portable (GHC extensions) --- - -module Data.Array.Accelerate.IO.Data.Vector.Primitive.Internal - where - -import Data.Primitive ( sizeOf ) -import Data.Primitive.ByteArray - -import Data.Vector.Primitive - -import Data.Array.Accelerate.Array.Unique -import Data.Array.Accelerate.Lifetime - -import GHC.Base -import GHC.ForeignPtr -import System.IO.Unsafe - - --- Convert a primitive vector into a unique array --- -{-# INLINE uniqueArrayOfVector #-} -uniqueArrayOfVector :: forall a. Prim a => Vector a -> UniqueArray a -uniqueArrayOfVector (Vector o l ba) - = unsafePerformIO - $ newUniqueArray =<< foreignPtrOfByteArray o (l * sizeOf (undefined::a)) ba - --- Convert a unique array into a primitive vector --- -{-# INLINE vectorOfUniqueArray #-} -vectorOfUniqueArray :: forall a. Prim a => Int -> UniqueArray a -> Vector a -vectorOfUniqueArray n ua - = unsafePerformIO - $ Vector 0 n `fmap` byteArrayOfForeignPtr (n * sizeOf (undefined::a)) (unsafeGetValue (uniqueArrayData ua)) - - --- Return the ByteArray underlying a ForeignPtr, or a new byte array if it is --- not a Plain ForeignPtr. --- -{-# INLINE byteArrayOfForeignPtr #-} -byteArrayOfForeignPtr :: Int -> ForeignPtr a -> IO ByteArray -byteArrayOfForeignPtr (I# bytes#) (ForeignPtr addr# c) = IO $ \s -> - case c of - PlainPtr mba# -> case unsafeFreezeByteArray# mba# s of - (# s', ba# #) -> (# s', ByteArray ba# #) - - _ -> case newAlignedPinnedByteArray# bytes# 16# s of - (# s1, mba# #) -> case copyAddrToByteArray# addr# mba# 0# bytes# s1 of - s2 -> case unsafeFreezeByteArray# mba# s2 of - (# s3, ba# #) -> (# s3, ByteArray ba# #) - - --- Return the ByteArray as a ForeignPtr. This will attempt a non-copying --- conversion, if the underlying byte array is pinned. --- -{-# INLINE foreignPtrOfByteArray #-} -foreignPtrOfByteArray :: Int -> Int -> ByteArray -> IO (ForeignPtr a) -foreignPtrOfByteArray (I# soff#) (I# bytes#) (ByteArray ba#) = IO $ \s -> - case isByteArrayPinned# ba# of - 0# -> case newAlignedPinnedByteArray# bytes# 16# s of - (# s1, mba# #) -> case copyByteArray# ba# 0# mba# soff# bytes# s1 of - s2 -> (# s2, ForeignPtr (byteArrayContents# (unsafeCoerce# mba#)) (PlainPtr mba#) #) - - _ -> (# s, ForeignPtr (byteArrayContents# ba#) (PlainPtr (unsafeCoerce# ba#)) #) - - -#if !MIN_VERSION_base(4,10,0) -isByteArrayPinned# :: ByteArray# -> Int# -isByteArrayPinned# _ = 0# -#endif - diff --git a/src/Data/Array/Accelerate/IO/Data/Vector/Storable.hs b/src/Data/Array/Accelerate/IO/Data/Vector/Storable.hs deleted file mode 100644 --- a/src/Data/Array/Accelerate/IO/Data/Vector/Storable.hs +++ /dev/null @@ -1,197 +0,0 @@ -{-# LANGUAGE GADTs #-} -{-# LANGUAGE TemplateHaskell #-} -{-# LANGUAGE TypeFamilies #-} --- | --- Module : Data.Array.Accelerate.IO.Data.Vector.Storable --- Copyright : [2012] Adam C. Foltzer --- [2012..2017] Trevor L. McDonell --- License : BSD3 --- --- Maintainer : Trevor L. McDonell --- Stability : experimental --- Portability : non-portable (GHC extensions) --- --- Efficient non-copying conversion between 'Data.Vector.Storable' vectors and --- Accelerate 'Array's. --- - -module Data.Array.Accelerate.IO.Data.Vector.Storable ( - - Vectors, - toVectors, - fromVectors, - -) where - --- friends -import Data.Array.Accelerate.Array.Data -import Data.Array.Accelerate.Array.Sugar hiding ( Vector ) -import Data.Array.Accelerate.Array.Unique -import Data.Array.Accelerate.Error -import Data.Array.Accelerate.Lifetime -import Data.Array.Accelerate.Type -import qualified Data.Array.Accelerate.Array.Representation as R - --- standard libraries -import Data.Vector.Storable -import System.IO.Unsafe - - --- | 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 Half = Vector Half -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 (V2 a) = Vectors a -type instance Vectors (V3 a) = Vectors a -type instance Vectors (V4 a) = Vectors a -type instance Vectors (V8 a) = Vectors a -type instance Vectors (V16 a) = Vectors a -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 --- -{-# INLINE fromVectors #-} -fromVectors :: (Shape sh, Elt e) => sh -> Vectors (EltRepr e) -> Array sh e -fromVectors sh vecs = Array (fromElt sh) (aux arrayElt vecs 1) - where - {-# INLINE wrap #-} - wrap :: Storable e => (UniqueArray e -> a) -> Vector e -> Int -> a - wrap k v s - = $boundsCheck "fromVectors" "shape mismatch" (vsize `quot` s == size sh) - $ k (unsafePerformIO $ newUniqueArray fp) - where - (fp,vsize) = unsafeToForeignPtr0 v - - {-# INLINE aux #-} - aux :: ArrayEltR e -> Vectors e -> Int -> ArrayData e - aux ArrayEltRunit _ _ = AD_Unit - aux ArrayEltRint v s = wrap AD_Int v s - aux ArrayEltRint8 v s = wrap AD_Int8 v s - aux ArrayEltRint16 v s = wrap AD_Int16 v s - aux ArrayEltRint32 v s = wrap AD_Int32 v s - aux ArrayEltRint64 v s = wrap AD_Int64 v s - aux ArrayEltRword v s = wrap AD_Word v s - aux ArrayEltRword8 v s = wrap AD_Word8 v s - aux ArrayEltRword16 v s = wrap AD_Word16 v s - aux ArrayEltRword32 v s = wrap AD_Word32 v s - aux ArrayEltRword64 v s = wrap AD_Word64 v s - aux ArrayEltRcshort v s = wrap AD_CShort v s - aux ArrayEltRcushort v s = wrap AD_CUShort v s - aux ArrayEltRcint v s = wrap AD_CInt v s - aux ArrayEltRcuint v s = wrap AD_CUInt v s - aux ArrayEltRclong v s = wrap AD_CLong v s - aux ArrayEltRculong v s = wrap AD_CULong v s - aux ArrayEltRcllong v s = wrap AD_CLLong v s - aux ArrayEltRcullong v s = wrap AD_CULLong v s - aux ArrayEltRhalf v s = wrap AD_Half v s - aux ArrayEltRfloat v s = wrap AD_Float v s - aux ArrayEltRdouble v s = wrap AD_Double v s - aux ArrayEltRcfloat v s = wrap AD_CFloat v s - aux ArrayEltRcdouble v s = wrap AD_CDouble v s - aux ArrayEltRbool v s = wrap AD_Bool v s - aux ArrayEltRchar v s = wrap AD_Char v s - aux ArrayEltRcchar v s = wrap AD_CChar v s - aux ArrayEltRcschar v s = wrap AD_CSChar v s - aux ArrayEltRcuchar v s = wrap AD_CUChar v s - aux (ArrayEltRvec2 ae) v s = AD_V2 (aux ae v (s*2)) - aux (ArrayEltRvec3 ae) v s = AD_V3 (aux ae v (s*3)) - aux (ArrayEltRvec4 ae) v s = AD_V4 (aux ae v (s*4)) - aux (ArrayEltRvec8 ae) v s = AD_V8 (aux ae v (s*8)) - aux (ArrayEltRvec16 ae) v s = AD_V16 (aux ae v (s*16)) - aux (ArrayEltRpair ae1 ae2) (v1,v2) s = AD_Pair (aux ae1 v1 s) (aux ae2 v2 s) - - --- | /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. --- -{-# INLINE toVectors #-} -toVectors :: (Shape sh, Elt e) => Array sh e -> Vectors (EltRepr e) -toVectors (Array sh adata) = aux arrayElt adata 1 - where - {-# INLINE wrap #-} - wrap :: Storable a => UniqueArray a -> Int -> Vector a - wrap ua k = unsafeFromForeignPtr0 (unsafeGetValue (uniqueArrayData ua)) (R.size sh * k) - - {-# INLINE aux #-} - aux :: ArrayEltR e -> ArrayData e -> Int -> Vectors e - aux ArrayEltRunit AD_Unit _ = () - aux ArrayEltRint (AD_Int s) k = wrap s k - aux ArrayEltRint8 (AD_Int8 s) k = wrap s k - aux ArrayEltRint16 (AD_Int16 s) k = wrap s k - aux ArrayEltRint32 (AD_Int32 s) k = wrap s k - aux ArrayEltRint64 (AD_Int64 s) k = wrap s k - aux ArrayEltRword (AD_Word s) k = wrap s k - aux ArrayEltRword8 (AD_Word8 s) k = wrap s k - aux ArrayEltRword16 (AD_Word16 s) k = wrap s k - aux ArrayEltRword32 (AD_Word32 s) k = wrap s k - aux ArrayEltRword64 (AD_Word64 s) k = wrap s k - aux ArrayEltRcshort (AD_CShort s) k = wrap s k - aux ArrayEltRcushort (AD_CUShort s) k = wrap s k - aux ArrayEltRcint (AD_CInt s) k = wrap s k - aux ArrayEltRcuint (AD_CUInt s) k = wrap s k - aux ArrayEltRclong (AD_CLong s) k = wrap s k - aux ArrayEltRculong (AD_CULong s) k = wrap s k - aux ArrayEltRcllong (AD_CLLong s) k = wrap s k - aux ArrayEltRcullong (AD_CULLong s) k = wrap s k - aux ArrayEltRhalf (AD_Half s) k = wrap s k - aux ArrayEltRfloat (AD_Float s) k = wrap s k - aux ArrayEltRdouble (AD_Double s) k = wrap s k - aux ArrayEltRcfloat (AD_CFloat s) k = wrap s k - aux ArrayEltRcdouble (AD_CDouble s) k = wrap s k - aux ArrayEltRbool (AD_Bool s) k = wrap s k - aux ArrayEltRchar (AD_Char s) k = wrap s k - aux ArrayEltRcchar (AD_CChar s) k = wrap s k - aux ArrayEltRcschar (AD_CSChar s) k = wrap s k - aux ArrayEltRcuchar (AD_CUChar s) k = wrap s k - aux (ArrayEltRvec2 ae) (AD_V2 s) k = aux ae s (k*2) - aux (ArrayEltRvec3 ae) (AD_V3 s) k = aux ae s (k*3) - aux (ArrayEltRvec4 ae) (AD_V4 s) k = aux ae s (k*4) - aux (ArrayEltRvec8 ae) (AD_V8 s) k = aux ae s (k*8) - aux (ArrayEltRvec16 ae) (AD_V16 s) k = aux ae s (k*16) - aux (ArrayEltRpair ae1 ae2) (AD_Pair s1 s2) k = (aux ae1 s1 k, aux ae2 s2 k) - diff --git a/src/Data/Array/Accelerate/IO/Data/Vector/Unboxed.hs b/src/Data/Array/Accelerate/IO/Data/Vector/Unboxed.hs deleted file mode 100644 --- a/src/Data/Array/Accelerate/IO/Data/Vector/Unboxed.hs +++ /dev/null @@ -1,356 +0,0 @@ -{-# LANGUAGE BangPatterns #-} -{-# LANGUAGE CPP #-} -{-# LANGUAGE GADTs #-} -{-# LANGUAGE ScopedTypeVariables #-} -{-# LANGUAGE TypeFamilies #-} --- | --- Module : Data.Array.Accelerate.IO.Data.Vector.Unboxed --- Copyright : [2017] Trevor L. McDonell --- License : BSD3 --- --- Maintainer : Trevor L. McDonell --- Stability : experimental --- Portability : non-portable (GHC extensions) --- --- Efficient conversion between 'Data.Vector.Unboxed' vectors and Accelerate --- 'Array's. --- - -module Data.Array.Accelerate.IO.Data.Vector.Unboxed ( - - Unbox(..), - toUnboxed, - fromUnboxed, - -) where - -import Data.Vector.Unboxed.Base hiding ( Unbox ) -import qualified Data.Vector.Unboxed as U - -import Data.Array.Accelerate.IO.Data.Vector.Primitive.Internal - -import Data.Array.Accelerate.Array.Data -import Data.Array.Accelerate.Array.Sugar as A hiding ( Vector ) -import qualified Data.Array.Accelerate.Array.Representation as R - -import Data.Int -import Data.Word - - --- | /O(n)/ (typically). Convert an Unboxed vector into an Accelerate array --- Accelerate array. --- --- If the underlying vectors are pinned then this can be done without copying. --- --- See also: --- --- @since 1.1.0.0@ --- -{-# INLINE fromUnboxed #-} -fromUnboxed :: Unbox e => Vector e -> Array DIM1 e -fromUnboxed v = Array ((), U.length v) (arrayDataOfUnboxed v) - - --- | /O(1)/ (typically). Convert an Accelerate array into an Unboxed vector. --- --- If the array data was allocated by Accelerate, this can typically be done --- without copying. The resulting vector will be pinned. --- --- @since 1.1.0.0@ --- -{-# INLINE toUnboxed #-} -toUnboxed :: (Shape sh, Unbox e) => Array sh e -> Vector e -toUnboxed (Array sh adata) = unboxedOfArrayData (R.size sh) adata - - --- Instances --- --------- - -class (U.Unbox e, A.Elt e) => Unbox e where - arrayDataOfUnboxed :: U.Vector e -> ArrayData (EltRepr e) - unboxedOfArrayData :: Int -> ArrayData (EltRepr e) -> U.Vector e - -instance Unbox Int where - {-# INLINE arrayDataOfUnboxed #-} - {-# INLINE unboxedOfArrayData #-} - arrayDataOfUnboxed (V_Int v) = AD_Int (uniqueArrayOfVector v) - unboxedOfArrayData !n (AD_Int v) = V_Int (vectorOfUniqueArray n v) - -instance Unbox Int8 where - {-# INLINE arrayDataOfUnboxed #-} - {-# INLINE unboxedOfArrayData #-} - arrayDataOfUnboxed (V_Int8 v) = AD_Int8 (uniqueArrayOfVector v) - unboxedOfArrayData !n (AD_Int8 v) = V_Int8 (vectorOfUniqueArray n v) - -instance Unbox Int16 where - {-# INLINE arrayDataOfUnboxed #-} - {-# INLINE unboxedOfArrayData #-} - arrayDataOfUnboxed (V_Int16 v) = AD_Int16 (uniqueArrayOfVector v) - unboxedOfArrayData !n (AD_Int16 v) = V_Int16 (vectorOfUniqueArray n v) - -instance Unbox Int32 where - {-# INLINE arrayDataOfUnboxed #-} - {-# INLINE unboxedOfArrayData #-} - arrayDataOfUnboxed (V_Int32 v) = AD_Int32 (uniqueArrayOfVector v) - unboxedOfArrayData !n (AD_Int32 v) = V_Int32 (vectorOfUniqueArray n v) - -instance Unbox Int64 where - {-# INLINE arrayDataOfUnboxed #-} - {-# INLINE unboxedOfArrayData #-} - arrayDataOfUnboxed (V_Int64 v) = AD_Int64 (uniqueArrayOfVector v) - unboxedOfArrayData !n (AD_Int64 v) = V_Int64 (vectorOfUniqueArray n v) - -instance Unbox Word where - {-# INLINE arrayDataOfUnboxed #-} - {-# INLINE unboxedOfArrayData #-} - arrayDataOfUnboxed (V_Word v) = AD_Word (uniqueArrayOfVector v) - unboxedOfArrayData !n (AD_Word v) = V_Word (vectorOfUniqueArray n v) - -instance Unbox Word8 where - {-# INLINE arrayDataOfUnboxed #-} - {-# INLINE unboxedOfArrayData #-} - arrayDataOfUnboxed (V_Word8 v) = AD_Word8 (uniqueArrayOfVector v) - unboxedOfArrayData !n (AD_Word8 v) = V_Word8 (vectorOfUniqueArray n v) - -instance Unbox Word16 where - {-# INLINE arrayDataOfUnboxed #-} - {-# INLINE unboxedOfArrayData #-} - arrayDataOfUnboxed (V_Word16 v) = AD_Word16 (uniqueArrayOfVector v) - unboxedOfArrayData !n (AD_Word16 v) = V_Word16 (vectorOfUniqueArray n v) - -instance Unbox Word32 where - {-# INLINE arrayDataOfUnboxed #-} - {-# INLINE unboxedOfArrayData #-} - arrayDataOfUnboxed (V_Word32 v) = AD_Word32 (uniqueArrayOfVector v) - unboxedOfArrayData !n (AD_Word32 v) = V_Word32 (vectorOfUniqueArray n v) - -instance Unbox Word64 where - {-# INLINE arrayDataOfUnboxed #-} - {-# INLINE unboxedOfArrayData #-} - arrayDataOfUnboxed (V_Word64 v) = AD_Word64 (uniqueArrayOfVector v) - unboxedOfArrayData !n (AD_Word64 v) = V_Word64 (vectorOfUniqueArray n v) - -instance Unbox Float where - {-# INLINE arrayDataOfUnboxed #-} - {-# INLINE unboxedOfArrayData #-} - arrayDataOfUnboxed (V_Float v) = AD_Float (uniqueArrayOfVector v) - unboxedOfArrayData !n (AD_Float v) = V_Float (vectorOfUniqueArray n v) - -instance Unbox Double where - {-# INLINE arrayDataOfUnboxed #-} - {-# INLINE unboxedOfArrayData #-} - arrayDataOfUnboxed (V_Double v) = AD_Double (uniqueArrayOfVector v) - unboxedOfArrayData !n (AD_Double v) = V_Double (vectorOfUniqueArray n v) - -instance Unbox Char where - {-# INLINE arrayDataOfUnboxed #-} - {-# INLINE unboxedOfArrayData #-} - arrayDataOfUnboxed (V_Char v) = AD_Char (uniqueArrayOfVector v) - unboxedOfArrayData !n (AD_Char v) = V_Char (vectorOfUniqueArray n v) - -instance Unbox Bool where - {-# INLINE arrayDataOfUnboxed #-} - {-# INLINE unboxedOfArrayData #-} - arrayDataOfUnboxed (V_Bool v) = AD_Bool (uniqueArrayOfVector v) - unboxedOfArrayData !n (AD_Bool v) = V_Bool (vectorOfUniqueArray n v) - -instance Unbox () where - {-# INLINE arrayDataOfUnboxed #-} - {-# INLINE unboxedOfArrayData #-} - arrayDataOfUnboxed V_Unit{} = AD_Unit - unboxedOfArrayData !n AD_Unit = V_Unit n - -instance (Unbox a, Unbox b) => Unbox (a, b) where - {-# INLINE arrayDataOfUnboxed #-} - arrayDataOfUnboxed (V_2 _ a b) = - AD_Unit `AD_Pair` arrayDataOfUnboxed a - `AD_Pair` arrayDataOfUnboxed b - -- - {-# INLINE unboxedOfArrayData #-} - unboxedOfArrayData !n (AD_Unit `AD_Pair` a `AD_Pair` b) = - V_2 n (unboxedOfArrayData n a) - (unboxedOfArrayData n b) - -instance (Unbox a, Unbox b, Unbox c) => Unbox (a, b, c) where - {-# INLINE arrayDataOfUnboxed #-} - arrayDataOfUnboxed (V_3 _ a b c) = - AD_Unit `AD_Pair` arrayDataOfUnboxed a - `AD_Pair` arrayDataOfUnboxed b - `AD_Pair` arrayDataOfUnboxed c - -- - {-# INLINE unboxedOfArrayData #-} - unboxedOfArrayData !n (AD_Unit `AD_Pair` a `AD_Pair` b `AD_Pair` c) = - V_3 n (unboxedOfArrayData n a) - (unboxedOfArrayData n b) - (unboxedOfArrayData n c) - -instance (Unbox a, Unbox b, Unbox c, Unbox d) => Unbox (a, b, c, d) where - {-# INLINE arrayDataOfUnboxed #-} - arrayDataOfUnboxed (V_4 _ a b c d) = - AD_Unit `AD_Pair` arrayDataOfUnboxed a - `AD_Pair` arrayDataOfUnboxed b - `AD_Pair` arrayDataOfUnboxed c - `AD_Pair` arrayDataOfUnboxed d - -- - {-# INLINE unboxedOfArrayData #-} - unboxedOfArrayData !n (AD_Unit `AD_Pair` a `AD_Pair` b `AD_Pair` c `AD_Pair` d) = - V_4 n (unboxedOfArrayData n a) - (unboxedOfArrayData n b) - (unboxedOfArrayData n c) - (unboxedOfArrayData n d) - -instance (Unbox a, Unbox b, Unbox c, Unbox d, Unbox e) => Unbox (a, b, c, d, e) where - {-# INLINE arrayDataOfUnboxed #-} - arrayDataOfUnboxed (V_5 _ a b c d e) = - AD_Unit `AD_Pair` arrayDataOfUnboxed a - `AD_Pair` arrayDataOfUnboxed b - `AD_Pair` arrayDataOfUnboxed c - `AD_Pair` arrayDataOfUnboxed d - `AD_Pair` arrayDataOfUnboxed e - -- - {-# INLINE unboxedOfArrayData #-} - unboxedOfArrayData !n (AD_Unit `AD_Pair` a `AD_Pair` b `AD_Pair` c `AD_Pair` d `AD_Pair` e) = - V_5 n (unboxedOfArrayData n a) - (unboxedOfArrayData n b) - (unboxedOfArrayData n c) - (unboxedOfArrayData n d) - (unboxedOfArrayData n e) - -instance (Unbox a, Unbox b, Unbox c, Unbox d, Unbox e, Unbox f) => Unbox (a, b, c, d, e, f) where - {-# INLINE arrayDataOfUnboxed #-} - arrayDataOfUnboxed (V_6 _ a b c d e f) = - AD_Unit `AD_Pair` arrayDataOfUnboxed a - `AD_Pair` arrayDataOfUnboxed b - `AD_Pair` arrayDataOfUnboxed c - `AD_Pair` arrayDataOfUnboxed d - `AD_Pair` arrayDataOfUnboxed e - `AD_Pair` arrayDataOfUnboxed f - -- - {-# INLINE unboxedOfArrayData #-} - unboxedOfArrayData !n (AD_Unit `AD_Pair` a `AD_Pair` b `AD_Pair` c `AD_Pair` d `AD_Pair` e `AD_Pair` f) = - V_6 n (unboxedOfArrayData n a) - (unboxedOfArrayData n b) - (unboxedOfArrayData n c) - (unboxedOfArrayData n d) - (unboxedOfArrayData n e) - (unboxedOfArrayData n f) - -{-- -#if MIN_VERSION_vector(0,12,0) -instance Unbox a => Unbox (Complex a) where -#else -instance (RealFloat a, Unbox a) => Unbox (Complex a) where -#endif - {-# INLINE arrayDataOfUnboxed #-} - {-# INLINE unboxedOfArrayData #-} - arrayDataOfUnboxed (V_Complex v2) = arrayDataOfUnboxed v2 - unboxedOfArrayData !n v2 = V_Complex (unboxedOfArrayData n v2) ---} - - -{-- --- | A family of types which represent a collection of Primitive Vectors. The --- structure of the collection depends on the element type @e@ of the --- corresponding Accelerate array. --- -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 Float = Vector Float -type instance Vectors Double = Vector Double -type instance Vectors Char = Vector Char -type instance Vectors Bool = Vector Bool -type instance Vectors (a,b) = (Vectors a, Vectors b) - - --- | /O(n)/ (typically). Convert a collection of unboxed vectors into an --- Accelerate array. --- --- Remember that unboxed vectors can be zipped and unzipped in O(1), so creating --- the required 'Vectors' structure is free. --- --- If the underlying vectors are pinned then this can be done without copying. --- --- @since 1.1.0.0@ --- -fromVectors :: (Shape sh, Elt e) => sh -> Vectors (EltRepr e) -> Array sh e -fromVectors sh vecs = Array (fromElt sh) (aux arrayElt vecs) - where - wrap :: forall a. P.Prim a => P.Vector a -> UniqueArray a - wrap v@(P.Vector _ l _) - = $boundsCheck "fromVectors" "shape mismatch" (size sh == l) - $ uniqueArrayOfVector v - -- - aux :: ArrayEltR e -> Vectors e -> ArrayData e - aux ArrayEltRunit () = AD_Unit - aux ArrayEltRint (V_Int v) = AD_Int (wrap v) - aux ArrayEltRint8 (V_Int8 v) = AD_Int8 (wrap v) - aux ArrayEltRint16 (V_Int16 v) = AD_Int16 (wrap v) - aux ArrayEltRint32 (V_Int32 v) = AD_Int32 (wrap v) - aux ArrayEltRint64 (V_Int64 v) = AD_Int64 (wrap v) - aux ArrayEltRword (V_Word v) = AD_Word (wrap v) - aux ArrayEltRword8 (V_Word8 v) = AD_Word8 (wrap v) - aux ArrayEltRword16 (V_Word16 v) = AD_Word16 (wrap v) - aux ArrayEltRword32 (V_Word32 v) = AD_Word32 (wrap v) - aux ArrayEltRword64 (V_Word64 v) = AD_Word64 (wrap v) - aux ArrayEltRfloat (V_Float v) = AD_Float (wrap v) - aux ArrayEltRdouble (V_Double v) = AD_Double (wrap v) - aux ArrayEltRchar (V_Char v) = AD_Char (wrap v) - aux ArrayEltRbool (V_Bool v) = AD_Bool (wrap v) - aux (ArrayEltRpair ad1 ad2) (v1,v2) = AD_Pair (aux ad1 v1) (aux ad2 v2) - -- - aux _ _ = $internalError "fromVectors" "unsupported type" - - --- | /O(1)/ (typically). Convert an Accelerate array into a collection of --- unboxed vectors. --- --- If the array data was allocated by Accelerate, this can typically be done --- without copying. --- --- Remember that unboxed vectors can be zipped and unzipped in O(1), so you can --- convert the result of this function into a more natural unboxed tuple --- representation for free. --- --- @since 1.1.0.0@ --- -toVectors :: (Shape sh, Elt e) => Array sh e -> Vectors (EltRepr e) -toVectors (Array sh adata) = aux arrayElt adata - where - n :: Int - n = R.size sh - - wrap :: forall a. P.Prim a => UniqueArray a -> P.Vector a - wrap ua = vectorOfUniqueArray n ua - - aux :: ArrayEltR e -> ArrayData e -> Vectors e - aux ArrayEltRunit AD_Unit = () - aux ArrayEltRint (AD_Int v) = V_Int (wrap v) - aux ArrayEltRint8 (AD_Int8 v) = V_Int8 (wrap v) - aux ArrayEltRint16 (AD_Int16 v) = V_Int16 (wrap v) - aux ArrayEltRint32 (AD_Int32 v) = V_Int32 (wrap v) - aux ArrayEltRint64 (AD_Int64 v) = V_Int64 (wrap v) - aux ArrayEltRword (AD_Word v) = V_Word (wrap v) - aux ArrayEltRword8 (AD_Word8 v) = V_Word8 (wrap v) - aux ArrayEltRword16 (AD_Word16 v) = V_Word16 (wrap v) - aux ArrayEltRword32 (AD_Word32 v) = V_Word32 (wrap v) - aux ArrayEltRword64 (AD_Word64 v) = V_Word64 (wrap v) - aux ArrayEltRfloat (AD_Float v) = V_Float (wrap v) - aux ArrayEltRdouble (AD_Double v) = V_Double (wrap v) - aux ArrayEltRchar (AD_Char v) = V_Char (wrap v) - aux ArrayEltRbool (AD_Bool v) = V_Bool (wrap v) - aux (ArrayEltRpair ad1 ad2) (AD_Pair v1 v2) = (aux ad1 v1, aux ad2 v2) - -- - aux _ _ = $internalError "toVectors" "unsupported type" ---} - diff --git a/src/Data/Array/Accelerate/IO/Foreign/ForeignPtr.hs b/src/Data/Array/Accelerate/IO/Foreign/ForeignPtr.hs --- a/src/Data/Array/Accelerate/IO/Foreign/ForeignPtr.hs +++ b/src/Data/Array/Accelerate/IO/Foreign/ForeignPtr.hs @@ -1,10 +1,12 @@ -{-# LANGUAGE TypeFamilies #-} +{-# LANGUAGE GADTs #-} +{-# LANGUAGE ScopedTypeVariables #-} +{-# LANGUAGE TypeApplications #-} -- | -- Module : Data.Array.Accelerate.IO.Foreign.ForeignPtr --- Copyright : [2017] Trevor L. McDonell +-- Copyright : [2017..2020] The Accelerate Team -- License : BSD3 -- --- Maintainer : Trevor L. McDonell +-- Maintainer : Trevor L. McDonell -- Stability : experimental -- Portability : non-portable (GHC extensions) -- @@ -12,12 +14,17 @@ module Data.Array.Accelerate.IO.Foreign.ForeignPtr where -import Data.Array.Accelerate.Array.Data -import Data.Array.Accelerate.Array.Sugar +import Data.Array.Accelerate.Array.Data ( ArrayData, GArrayDataR ) import Data.Array.Accelerate.Array.Unique import Data.Array.Accelerate.Lifetime -import Data.Array.Accelerate.Type +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 @@ -25,43 +32,7 @@ -- | A family of types which represent a collection of 'ForeignPtr's. The -- structure of the collection depends on the element type @e@. -- -type family ForeignPtrs e - -type instance ForeignPtrs () = () -type instance ForeignPtrs Int = ForeignPtr Int -type instance ForeignPtrs Int8 = ForeignPtr Int8 -type instance ForeignPtrs Int16 = ForeignPtr Int16 -type instance ForeignPtrs Int32 = ForeignPtr Int32 -type instance ForeignPtrs Int64 = ForeignPtr Int64 -type instance ForeignPtrs Word = ForeignPtr Word -type instance ForeignPtrs Word8 = ForeignPtr Word8 -type instance ForeignPtrs Word16 = ForeignPtr Word16 -type instance ForeignPtrs Word32 = ForeignPtr Word32 -type instance ForeignPtrs Word64 = ForeignPtr Word64 -type instance ForeignPtrs CShort = ForeignPtr Int16 -type instance ForeignPtrs CUShort = ForeignPtr Word16 -type instance ForeignPtrs CInt = ForeignPtr Int32 -type instance ForeignPtrs CUInt = ForeignPtr Word32 -type instance ForeignPtrs CLong = ForeignPtr HTYPE_LONG -type instance ForeignPtrs CULong = ForeignPtr HTYPE_UNSIGNED_LONG -type instance ForeignPtrs CLLong = ForeignPtr Int64 -type instance ForeignPtrs CULLong = ForeignPtr Word64 -type instance ForeignPtrs Half = ForeignPtr Half -type instance ForeignPtrs Float = ForeignPtr Float -type instance ForeignPtrs Double = ForeignPtr Double -type instance ForeignPtrs CFloat = ForeignPtr Float -type instance ForeignPtrs CDouble = ForeignPtr Double -type instance ForeignPtrs Bool = ForeignPtr Word8 -type instance ForeignPtrs Char = ForeignPtr Char -type instance ForeignPtrs CChar = ForeignPtr HTYPE_CCHAR -type instance ForeignPtrs CSChar = ForeignPtr Int8 -type instance ForeignPtrs CUChar = ForeignPtr Word8 -type instance ForeignPtrs (V2 a) = ForeignPtrs a -type instance ForeignPtrs (V3 a) = ForeignPtrs a -type instance ForeignPtrs (V4 a) = ForeignPtrs a -type instance ForeignPtrs (V8 a) = ForeignPtrs a -type instance ForeignPtrs (V16 a) = ForeignPtrs a -type instance ForeignPtrs (a,b) = (ForeignPtrs a, ForeignPtrs b) +type ForeignPtrs e = GArrayDataR ForeignPtr e -- | /O(1)/. Treat the set of 'ForeignPtrs' as an Accelerate array. The type of @@ -78,48 +49,15 @@ -- @since 1.1.0.0@ -- {-# INLINE fromForeignPtrs #-} -fromForeignPtrs :: (Shape sh, Elt e) => sh -> ForeignPtrs (EltRepr e) -> Array sh e -fromForeignPtrs sh fps = Array (fromElt sh) (aux arrayElt fps) +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 - wrap :: (UniqueArray e -> r) -> ForeignPtr e -> r - wrap k fp = k (unsafePerformIO $ newUniqueArray fp) - - aux :: ArrayEltR e -> ForeignPtrs 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 ArrayEltRhalf = wrap AD_Half - 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 (ArrayEltRvec2 ae) = AD_V2 . aux ae - aux (ArrayEltRvec3 ae) = AD_V3 . aux ae - aux (ArrayEltRvec4 ae) = AD_V4 . aux ae - aux (ArrayEltRvec8 ae) = AD_V8 . aux ae - aux (ArrayEltRvec16 ae) = AD_V16 . aux ae - aux (ArrayEltRpair ae1 ae2) = \(v1,v2) -> AD_Pair (aux ae1 v1) (aux ae2 v2) + 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'. @@ -129,47 +67,14 @@ -- -- @since 1.1.0.0@ -- -{-# LANGUAGE toForeignPts #-} -toForeignPtrs :: (Shape sh, Elt e) => Array sh e -> ForeignPtrs (EltRepr e) -toForeignPtrs (Array _ adata) = aux arrayElt adata +{-# 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 - wrap :: UniqueArray a -> ForeignPtr a - wrap ua = unsafeGetValue (uniqueArrayData ua) - - aux :: ArrayEltR e -> ArrayData e -> ForeignPtrs 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 ArrayEltRhalf (AD_Half 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 (ArrayEltRvec2 ae) (AD_V2 s) = aux ae s - aux (ArrayEltRvec3 ae) (AD_V3 s) = aux ae s - aux (ArrayEltRvec4 ae) (AD_V4 s) = aux ae s - aux (ArrayEltRvec8 ae) (AD_V8 s) = aux ae s - aux (ArrayEltRvec16 ae) (AD_V16 s) = aux ae s - aux (ArrayEltRpair ae1 ae2) (AD_Pair s1 s2) = (aux ae1 s1, aux ae2 s2) + 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 --- a/src/Data/Array/Accelerate/IO/Foreign/Ptr.hs +++ b/src/Data/Array/Accelerate/IO/Foreign/Ptr.hs @@ -1,10 +1,12 @@ -{-# LANGUAGE TypeFamilies #-} +{-# LANGUAGE GADTs #-} +{-# LANGUAGE ScopedTypeVariables #-} +{-# LANGUAGE TypeApplications #-} -- | -- Module : Data.Array.Accelerate.IO.Foreign.Ptr --- Copyright : [2017] Trevor L. McDonell +-- Copyright : [2017..2020] The Accelerate Team -- License : BSD3 -- --- Maintainer : Trevor L. McDonell +-- Maintainer : Trevor L. McDonell -- Stability : experimental -- Portability : non-portable (GHC extensions) -- @@ -12,19 +14,27 @@ module Data.Array.Accelerate.IO.Foreign.Ptr where -import Data.Array.Accelerate.Array.Data -import Data.Array.Accelerate.Array.Sugar +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 = ArrayPtrs e +type Ptrs e = GArrayDataR Ptr e -- | /O(1)/. Treat the set of 'Ptrs' as an Accelerate array. The type of @@ -44,48 +54,15 @@ -- @since 1.1.0.0@ -- {-# INLINE fromPtrs #-} -fromPtrs :: (Shape sh, Elt e) => sh -> Ptrs (EltRepr e) -> Array sh e -fromPtrs sh ps = Array (fromElt sh) (aux arrayElt ps) +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 - wrap :: (UniqueArray e -> r) -> Ptr e -> r - wrap k p = k (unsafePerformIO $ newUniqueArray =<< newForeignPtr_ p) - - aux :: ArrayEltR e -> Ptrs 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 ArrayEltRhalf = wrap AD_Half - 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 (ArrayEltRvec2 ae) = AD_V2 . aux ae - aux (ArrayEltRvec3 ae) = AD_V3 . aux ae - aux (ArrayEltRvec4 ae) = AD_V4 . aux ae - aux (ArrayEltRvec8 ae) = AD_V8 . aux ae - aux (ArrayEltRvec16 ae) = AD_V16 . aux ae - aux (ArrayEltRpair ae1 ae2) = \(v1,v2) -> AD_Pair (aux ae1 v1) (aux ae2 v2) + 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 @@ -96,6 +73,13 @@ -- @since 1.1.0.0@ -- {-# INLINE toPtrs #-} -toPtrs :: (Shape sh, Elt e) => Array sh e -> Ptrs (EltRepr e) -toPtrs (Array _ adata) = ptrsOfArrayData adata +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)) diff --git a/src/Data/Array/Repa/Repr/Accelerate.hs b/src/Data/Array/Repa/Repr/Accelerate.hs deleted file mode 100644 --- a/src/Data/Array/Repa/Repr/Accelerate.hs +++ /dev/null @@ -1,176 +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.Repa.Repr.Accelerate --- Copyright : [2012..2014] Trevor L. McDonell --- License : BSD3 --- --- Maintainer : Trevor L. McDonell --- Stability : experimental --- Portability : non-portable (GHC extensions) --- --- 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. --- - -module Data.Array.Repa.Repr.Accelerate ( - - 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/test/Test.hs b/test/Test.hs deleted file mode 100644 --- a/test/Test.hs +++ /dev/null @@ -1,29 +0,0 @@ --- | --- Module : Test --- Copyright : [2017] Trevor L. McDonell --- License : BSD3 --- --- Maintainer : Trevor L. McDonell --- Stability : experimental --- Portability : non-portable (GHC extensions) --- - -module Test where - -import Test.Tasty - -import Test.Array.IArray -import Test.Array.Unboxed -import Test.Vector.Storable -import Test.Vector.Unboxed - -main :: IO () -main - = defaultMain - $ testGroup "IO" - [ test_vector_unboxed - , test_vector_storable - , test_array_iarray - , test_array_unboxed - ] - diff --git a/test/Test/Array/IArray.hs b/test/Test/Array/IArray.hs deleted file mode 100644 --- a/test/Test/Array/IArray.hs +++ /dev/null @@ -1,148 +0,0 @@ -{-# LANGUAGE FlexibleContexts #-} -{-# LANGUAGE ScopedTypeVariables #-} -{-# LANGUAGE TypeFamilies #-} --- | --- Module : Test.Array.IArray --- Copyright : [2017] Trevor L. McDonell --- License : BSD3 --- --- Maintainer : Trevor L. McDonell --- Stability : experimental --- Portability : non-portable (GHC extensions) --- - -module Test.Array.IArray - where - -import Test.Util -import Test.Tasty -import Test.Tasty.Hedgehog - -import Data.Array.Accelerate ( Shape, Elt ) -import Data.Array.Accelerate.Array.Sugar ( EltRepr ) -import Data.Array.Accelerate.IO.Data.Array.IArray as A -import qualified Data.Array.Accelerate as A - -import Data.Array.IArray hiding ( array, indices, elems ) -import qualified Data.Array.IArray as I - -import Hedgehog -import qualified Hedgehog.Gen as Gen -import qualified Hedgehog.Range as Range - -import Data.Proxy -import Prelude - - -iarray :: (Ix ix, IArray a e) => Gen (ix,ix) -> Gen e -> Gen (a ix e) -iarray ix e = do - (lo,hi) <- ix - let n = rangeSize (lo,hi) - indices = range (lo,hi) - -- - elems <- Gen.list (Range.singleton n) e - return $ I.array (lo,hi) (zip indices elems) - - -test_i2a - :: forall ix sh a e. (Ix ix, IArray a e, Elt ix, Shape sh, Elt e, Eq e, Show (a ix e), Eq (a ix e), IxShapeRepr (EltRepr ix) ~ EltRepr sh) - => Proxy a - -> Gen sh - -> Gen (ix,ix) - -> Gen e - -> Property -test_i2a _ _ ix e = - property $ do - ia <- forAll (iarray ix e :: Gen (a ix e)) - let - (lo,_) = bounds ia - acc = fromIArray ia :: A.Array sh e - ia' = toIArray (Just lo) acc - -- - I.elems ia === A.toList acc -- elements convert correctly - ia === ia' -- indices round-trip correctly - -test_a2i - :: forall ix sh a e. (Ix ix, IArray a e, Elt ix, Shape sh, Elt e, Eq e, Show (a ix e), Eq sh, Eq e, IxShapeRepr (EltRepr ix) ~ EltRepr sh) - => Proxy a - -> Gen sh - -> Gen (ix,ix) - -> Gen e - -> Property -test_a2i _ dim _ e = - property $ do - sh <- forAll dim - acc <- forAll (array sh e) - -- - A.toList acc === I.elems (toIArray Nothing acc :: a ix e) - - -test_array_iarray :: TestTree -test_array_iarray = - testGroup "Data.Array.IArray" - [ testGroup "iarray->accelerate" - [ testGroup "DIM1" - [ testProperty "Int" $ test_i2a (Proxy::Proxy I.Array) dim1 ix1 int - , testProperty "Int8" $ test_i2a (Proxy::Proxy I.Array) dim1 ix1 i8 - , testProperty "Int16" $ test_i2a (Proxy::Proxy I.Array) dim1 ix1 i16 - , testProperty "Int32" $ test_i2a (Proxy::Proxy I.Array) dim1 ix1 i32 - , testProperty "Int64" $ test_i2a (Proxy::Proxy I.Array) dim1 ix1 i64 - , testProperty "Word" $ test_i2a (Proxy::Proxy I.Array) dim1 ix1 word - , testProperty "Word8" $ test_i2a (Proxy::Proxy I.Array) dim1 ix1 w8 - , testProperty "Word16" $ test_i2a (Proxy::Proxy I.Array) dim1 ix1 w16 - , testProperty "Word32" $ test_i2a (Proxy::Proxy I.Array) dim1 ix1 w32 - , testProperty "Word64" $ test_i2a (Proxy::Proxy I.Array) dim1 ix1 w64 - , testProperty "Float" $ test_i2a (Proxy::Proxy I.Array) dim1 ix1 f32 - , testProperty "Double" $ test_i2a (Proxy::Proxy I.Array) dim1 ix1 f64 - , testProperty "Complex Float" $ test_i2a (Proxy::Proxy I.Array) dim1 ix1 (complex f32) - ] - , testGroup "DIM2" - [ testProperty "Int" $ test_i2a (Proxy::Proxy I.Array) dim2 ix2 int - , testProperty "Int8" $ test_i2a (Proxy::Proxy I.Array) dim2 ix2 i8 - , testProperty "Int16" $ test_i2a (Proxy::Proxy I.Array) dim2 ix2 i16 - , testProperty "Int32" $ test_i2a (Proxy::Proxy I.Array) dim2 ix2 i32 - , testProperty "Int64" $ test_i2a (Proxy::Proxy I.Array) dim2 ix2 i64 - , testProperty "Word" $ test_i2a (Proxy::Proxy I.Array) dim2 ix2 word - , testProperty "Word8" $ test_i2a (Proxy::Proxy I.Array) dim2 ix2 w8 - , testProperty "Word16" $ test_i2a (Proxy::Proxy I.Array) dim2 ix2 w16 - , testProperty "Word32" $ test_i2a (Proxy::Proxy I.Array) dim2 ix2 w32 - , testProperty "Word64" $ test_i2a (Proxy::Proxy I.Array) dim2 ix2 w64 - , testProperty "Float" $ test_i2a (Proxy::Proxy I.Array) dim2 ix2 f32 - , testProperty "Double" $ test_i2a (Proxy::Proxy I.Array) dim2 ix2 f64 - , testProperty "Complex Float" $ test_i2a (Proxy::Proxy I.Array) dim2 ix2 (complex f32) - ] - ] - , testGroup "accelerate->iarray" - [ testGroup "DIM1" - [ testProperty "Int" $ test_a2i (Proxy::Proxy I.Array) dim1 ix1 int - , testProperty "Int8" $ test_a2i (Proxy::Proxy I.Array) dim1 ix1 i8 - , testProperty "Int16" $ test_a2i (Proxy::Proxy I.Array) dim1 ix1 i16 - , testProperty "Int32" $ test_a2i (Proxy::Proxy I.Array) dim1 ix1 i32 - , testProperty "Int64" $ test_a2i (Proxy::Proxy I.Array) dim1 ix1 i64 - , testProperty "Word" $ test_a2i (Proxy::Proxy I.Array) dim1 ix1 word - , testProperty "Word8" $ test_a2i (Proxy::Proxy I.Array) dim1 ix1 w8 - , testProperty "Word16" $ test_a2i (Proxy::Proxy I.Array) dim1 ix1 w16 - , testProperty "Word32" $ test_a2i (Proxy::Proxy I.Array) dim1 ix1 w32 - , testProperty "Word64" $ test_a2i (Proxy::Proxy I.Array) dim1 ix1 w64 - , testProperty "Float" $ test_a2i (Proxy::Proxy I.Array) dim1 ix1 f32 - , testProperty "Double" $ test_a2i (Proxy::Proxy I.Array) dim1 ix1 f64 - , testProperty "Complex Float" $ test_a2i (Proxy::Proxy I.Array) dim1 ix1 (complex f32) - ] - , testGroup "DIM2" - [ testProperty "Int" $ test_a2i (Proxy::Proxy I.Array) dim2 ix2 int - , testProperty "Int8" $ test_a2i (Proxy::Proxy I.Array) dim2 ix2 i8 - , testProperty "Int16" $ test_a2i (Proxy::Proxy I.Array) dim2 ix2 i16 - , testProperty "Int32" $ test_a2i (Proxy::Proxy I.Array) dim2 ix2 i32 - , testProperty "Int64" $ test_a2i (Proxy::Proxy I.Array) dim2 ix2 i64 - , testProperty "Word" $ test_a2i (Proxy::Proxy I.Array) dim2 ix2 word - , testProperty "Word8" $ test_a2i (Proxy::Proxy I.Array) dim2 ix2 w8 - , testProperty "Word16" $ test_a2i (Proxy::Proxy I.Array) dim2 ix2 w16 - , testProperty "Word32" $ test_a2i (Proxy::Proxy I.Array) dim2 ix2 w32 - , testProperty "Word64" $ test_a2i (Proxy::Proxy I.Array) dim2 ix2 w64 - , testProperty "Float" $ test_a2i (Proxy::Proxy I.Array) dim2 ix2 f32 - , testProperty "Double" $ test_a2i (Proxy::Proxy I.Array) dim2 ix2 f64 - , testProperty "Complex Float" $ test_a2i (Proxy::Proxy I.Array) dim2 ix2 (complex f32) - ] - ] - ] - diff --git a/test/Test/Array/Unboxed.hs b/test/Test/Array/Unboxed.hs deleted file mode 100644 --- a/test/Test/Array/Unboxed.hs +++ /dev/null @@ -1,128 +0,0 @@ -{-# LANGUAGE FlexibleContexts #-} -{-# LANGUAGE ScopedTypeVariables #-} -{-# LANGUAGE TypeFamilies #-} --- | --- Module : Test.Array.Unboxed --- Copyright : [2017] Trevor L. McDonell --- License : BSD3 --- --- Maintainer : Trevor L. McDonell --- Stability : experimental --- Portability : non-portable (GHC extensions) --- - -module Test.Array.Unboxed - where - -import Test.Array.IArray - -import Test.Util -import Test.Tasty -import Test.Tasty.Hedgehog - -import Data.Array.Accelerate ( Shape, Elt ) -import Data.Array.Accelerate.Array.Sugar ( EltRepr ) -import Data.Array.Accelerate.IO.Data.Array.Unboxed as A -import qualified Data.Array.Accelerate as A - -import Data.Array.Unboxed as U hiding ( array ) - -import Hedgehog - - -test_u2a - :: forall ix sh e. (Ix ix, IArray UArray e, Elt ix, Shape sh, Elt e, Eq e, Show (UArray ix e), Eq (UArray ix e), IxShapeRepr (EltRepr ix) ~ EltRepr sh) - => Gen sh - -> Gen (ix,ix) - -> Gen e - -> Property -test_u2a _ ix e = - property $ do - ua <- forAll (iarray ix e :: Gen (UArray ix e)) - let - (lo,_) = bounds ua - acc = fromUArray ua :: A.Array sh e - ua' = toUArray (Just lo) acc - -- - U.elems ua === A.toList acc -- elements convert correctly - ua === ua' -- indices round-trip correctly - -test_a2u - :: forall ix sh e. (Ix ix, IArray UArray e, Elt ix, Shape sh, Elt e, Show (UArray ix e), Eq (UArray ix e), Eq sh, Eq e, IxShapeRepr (EltRepr ix) ~ EltRepr sh) - => Gen sh - -> Gen (ix,ix) - -> Gen e - -> Property -test_a2u dim _ e = - property $ do - sh <- forAll dim - arr <- forAll (array sh e) - -- - A.toList arr === U.elems (toUArray Nothing arr :: UArray ix e) - - -test_array_unboxed :: TestTree -test_array_unboxed = - testGroup "Data.Array.Unboxed" - [ testGroup "uarray->accelerate" - [ testGroup "DIM1" - [ testProperty "Int" $ test_u2a dim1 ix1 int - , testProperty "Int8" $ test_u2a dim1 ix1 i8 - , testProperty "Int16" $ test_u2a dim1 ix1 i16 - , testProperty "Int32" $ test_u2a dim1 ix1 i32 - , testProperty "Int64" $ test_u2a dim1 ix1 i64 - , testProperty "Word" $ test_u2a dim1 ix1 word - , testProperty "Word8" $ test_u2a dim1 ix1 w8 - , testProperty "Word16" $ test_u2a dim1 ix1 w16 - , testProperty "Word32" $ test_u2a dim1 ix1 w32 - , testProperty "Word64" $ test_u2a dim1 ix1 w64 - , testProperty "Float" $ test_u2a dim1 ix1 f32 - , testProperty "Double" $ test_u2a dim1 ix1 f64 - ] - , testGroup "DIM2" - [ testProperty "Int" $ test_u2a dim2 ix2 int - , testProperty "Int8" $ test_u2a dim2 ix2 i8 - , testProperty "Int16" $ test_u2a dim2 ix2 i16 - , testProperty "Int32" $ test_u2a dim2 ix2 i32 - , testProperty "Int64" $ test_u2a dim2 ix2 i64 - , testProperty "Word" $ test_u2a dim2 ix2 word - , testProperty "Word8" $ test_u2a dim2 ix2 w8 - , testProperty "Word16" $ test_u2a dim2 ix2 w16 - , testProperty "Word32" $ test_u2a dim2 ix2 w32 - , testProperty "Word64" $ test_u2a dim2 ix2 w64 - , testProperty "Float" $ test_u2a dim2 ix2 f32 - , testProperty "Double" $ test_u2a dim2 ix2 f64 - ] - ] - , testGroup "accelerate->uarray" - [ testGroup "DIM1" - [ testProperty "Int" $ test_a2u dim1 ix1 int - , testProperty "Int8" $ test_a2u dim1 ix1 i8 - , testProperty "Int16" $ test_a2u dim1 ix1 i16 - , testProperty "Int32" $ test_a2u dim1 ix1 i32 - , testProperty "Int64" $ test_a2u dim1 ix1 i64 - , testProperty "Word" $ test_a2u dim1 ix1 word - , testProperty "Word8" $ test_a2u dim1 ix1 w8 - , testProperty "Word16" $ test_a2u dim1 ix1 w16 - , testProperty "Word32" $ test_a2u dim1 ix1 w32 - , testProperty "Word64" $ test_a2u dim1 ix1 w64 - , testProperty "Float" $ test_a2u dim1 ix1 f32 - , testProperty "Double" $ test_a2u dim1 ix1 f64 - ] - , testGroup "DIM2" - [ testProperty "Int" $ test_a2u dim2 ix2 int - , testProperty "Int8" $ test_a2u dim2 ix2 i8 - , testProperty "Int16" $ test_a2u dim2 ix2 i16 - , testProperty "Int32" $ test_a2u dim2 ix2 i32 - , testProperty "Int64" $ test_a2u dim2 ix2 i64 - , testProperty "Word" $ test_a2u dim2 ix2 word - , testProperty "Word8" $ test_a2u dim2 ix2 w8 - , testProperty "Word16" $ test_a2u dim2 ix2 w16 - , testProperty "Word32" $ test_a2u dim2 ix2 w32 - , testProperty "Word64" $ test_a2u dim2 ix2 w64 - , testProperty "Float" $ test_a2u dim2 ix2 f32 - , testProperty "Double" $ test_a2u dim2 ix2 f64 - ] - ] - ] - diff --git a/test/Test/Util.hs b/test/Test/Util.hs deleted file mode 100644 --- a/test/Test/Util.hs +++ /dev/null @@ -1,122 +0,0 @@ -{-# LANGUAGE ConstraintKinds #-} -{-# LANGUAGE FlexibleContexts #-} -{-# LANGUAGE RankNTypes #-} -{-# LANGUAGE ScopedTypeVariables #-} -{-# LANGUAGE TypeOperators #-} -{-# LANGUAGE ViewPatterns #-} --- | --- Module : Test.Util --- Copyright : [2017] Trevor L. McDonell --- License : BSD3 --- --- Maintainer : Trevor L. McDonell --- Stability : experimental --- Portability : non-portable (GHC extensions) --- - -module Test.Util where - -import Data.Array.Accelerate ( Arrays, Array, Acc, Shape, Elt ) -import Data.Array.Accelerate.Trafo ( Afunction, AfunctionR ) -import Data.Array.Accelerate.Array.Sugar ( DIM1, DIM2, Z(..), (:.)(..), fromList, size ) -import Data.Array.Accelerate.Data.Complex - -import Hedgehog -import qualified Hedgehog.Gen as Gen -import qualified Hedgehog.Range as Range - -import Data.Int -import Data.Word -import Prelude as P - - -type Run = forall a. Arrays a => Acc a -> a -type RunN = forall f. Afunction f => f -> AfunctionR f - -floating :: P.RealFloat a => Gen a -floating = Gen.realFloat (Range.linearFracFrom 0 (-1) 1) - -complex :: Gen a -> Gen (Complex a) -complex f = (:+) <$> f <*> f - -dim0 :: Gen Z -dim0 = return Z - -dim1 :: Gen DIM1 -dim1 = (Z :.) <$> Gen.int (Range.linear 0 1024) - -dim2 :: Gen DIM2 -dim2 = do - x <- Gen.int (Range.linear 0 128) - y <- Gen.int (Range.linear 0 128) - return (Z :. y :. x) - -ix1 :: Gen (Int,Int) -ix1 = do - lo <- Gen.int (Range.linearFrom 0 (-128) 128) - hi <- Gen.int (Range.linear lo (lo+256)) - return (lo,hi) - -ix2 :: Gen ((Int,Int), (Int,Int)) -ix2 = do - l0 <- Gen.int (Range.linearFrom 0 (-64) (64)) - l1 <- Gen.int (Range.linearFrom 0 (-64) (64)) - h0 <- Gen.int (Range.linear l0 (l0+128)) - h1 <- Gen.int (Range.linear l1 (l1+128)) - return ((l0,l1), (h0,h1)) - -array :: (Shape sh, Elt e) => sh -> Gen e -> Gen (Array sh e) -array sh gen = fromList sh <$> Gen.list (Range.singleton (size sh)) gen - -int :: Gen Int -int = Gen.int Range.linearBounded - -i8 :: Gen Int8 -i8 = Gen.int8 Range.linearBounded - -i16 :: Gen Int16 -i16 = Gen.int16 Range.linearBounded - -i32 :: Gen Int32 -i32 = Gen.int32 Range.linearBounded - -i64 :: Gen Int64 -i64 = Gen.int64 Range.linearBounded - -word :: Gen Word -word = Gen.word Range.linearBounded - -w8 :: Gen Word8 -w8 = Gen.word8 Range.linearBounded - -w16 :: Gen Word16 -w16 = Gen.word16 Range.linearBounded - -w32 :: Gen Word32 -w32 = Gen.word32 Range.linearBounded - -w64 :: Gen Word64 -w64 = Gen.word64 Range.linearBounded - -f32 :: Gen Float -f32 = Gen.float (Range.linearFracFrom 0 flt_min flt_max) - -f64 :: Gen Double -f64 = Gen.double (Range.linearFracFrom 0 flt_min flt_max) - -flt_max :: RealFloat a => a -flt_max = x - where - n = floatDigits x - b = floatRadix x - (_, u) = floatRange x - x = encodeFloat (b^n - 1) (u - n) - -flt_min :: RealFloat a => a -flt_min = x - where - n = floatDigits x - b = floatRadix x - (l, _) = floatRange x - x = encodeFloat (b^n - 1) (l - n - 1) - diff --git a/test/Test/Vector/Storable.hs b/test/Test/Vector/Storable.hs deleted file mode 100644 --- a/test/Test/Vector/Storable.hs +++ /dev/null @@ -1,184 +0,0 @@ -{-# LANGUAGE FlexibleContexts #-} -{-# LANGUAGE ScopedTypeVariables #-} -{-# LANGUAGE TypeFamilies #-} --- | --- Module : Test.Vector.Storable --- Copyright : [2017] Trevor L. McDonell --- License : BSD3 --- --- Maintainer : Trevor L. McDonell --- Stability : experimental --- Portability : non-portable (GHC extensions) --- - -module Test.Vector.Storable - where - -import Test.Util -import Test.Tasty -import Test.Tasty.Hedgehog - -import Data.Array.Accelerate ( Shape, Elt, Z(..), (:.)(..) ) -import Data.Array.Accelerate.Array.Sugar ( rank, EltRepr ) -import Data.Array.Accelerate.Data.Complex -import Data.Array.Accelerate.IO.Data.Vector.Storable as A -import qualified Data.Array.Accelerate as A - -import Data.Vector.Storable as S - -import Hedgehog -import qualified Hedgehog.Gen as Gen -import qualified Hedgehog.Range as Range - -import Data.Word -import Text.Printf -import Prelude as P - - -storable :: Storable e => Int -> Gen e -> Gen (S.Vector e) -storable n gen = - S.fromListN n <$> Gen.list (Range.singleton n) gen - -boolToWord8 :: Bool -> Word8 -boolToWord8 True = 1 -boolToWord8 False = 0 - -test_s2a - :: forall e. (Storable e, Elt e, Eq e, Vectors (EltRepr e) ~ Vector e) - => Gen e - -> Property -test_s2a e = - property $ do - sh@(Z :. n) <- forAll dim1 - svec <- forAll (storable n e) - -- - S.toList svec === A.toList (A.fromVectors sh svec) - -test_s2a_t2 - :: forall a b. ( Storable a, Elt a, Eq a, Vectors (EltRepr a) ~ Vector a - , Storable b, Elt b, Eq b, Vectors (EltRepr b) ~ Vector b - ) - => Gen a - -> Gen b - -> Property -test_s2a_t2 a b = - property $ do - sh@(Z :. n) <- forAll dim1 - sa <- forAll (storable n a) - sb <- forAll (storable n b) - -- - P.zip (S.toList sa) (S.toList sb) === A.toList (A.fromVectors sh (((), sa), sb)) - - -test_a2s - :: forall sh e. (Shape sh, Storable e, Elt e, Eq sh, Eq e, Vectors (EltRepr e) ~ Vector e) - => Gen sh - -> Gen e - -> Property -test_a2s dim e = - property $ do - sh <- forAll dim - arr <- forAll (array sh e) - -- - A.toList arr === S.toList (A.toVectors arr) - -test_a2s_t2 - :: forall sh a b. ( Shape sh, Eq sh, Eq a, Eq b, Elt a, Elt b, Storable a, Storable b - , Vectors (EltRepr (a,b)) ~ (((), Vector a), Vector b) - ) - => Gen sh - -> Gen (a,b) - -> Property -test_a2s_t2 dim e = - property $ do - sh <- forAll dim - arr <- forAll (array sh e) - let - (((), va), vb) = A.toVectors arr - -- - A.toList arr === P.zip (S.toList va) (S.toList vb) - - -test_s2a_complex - :: forall e. ( Storable e, Elt (Complex e), Eq e - , Vectors (EltRepr (Complex e)) ~ Vector e - ) - => Gen (Complex e) - -> Property -test_s2a_complex e = - property $ do - sh@(Z :. n) <- forAll dim1 - svec <- forAll (storable n e) - -- - S.toList svec === A.toList (A.fromVectors sh (S.unsafeCast svec :: S.Vector e)) - -test_a2s_complex - :: forall sh e. ( Shape sh, Storable e, Elt (Complex e), Eq sh, Eq e - , Vectors (EltRepr (Complex e)) ~ Vector e - ) - => Gen sh - -> Gen (Complex e) - -> Property -test_a2s_complex dim e = - property $ do - sh <- forAll dim - arr <- forAll (array sh e) - -- - A.toList arr === S.toList (S.unsafeCast (A.toVectors arr) :: S.Vector (Complex e)) - - -test_a2s_dim - :: forall sh. (Shape sh, Eq sh) - => Gen sh - -> TestTree -test_a2s_dim dim = - testGroup (printf "DIM%d" (rank (undefined::sh))) - [ testProperty "Int" $ test_a2s dim int - , testProperty "Int8" $ test_a2s dim i8 - , testProperty "Int16" $ test_a2s dim i16 - , testProperty "Int32" $ test_a2s dim i32 - , testProperty "Int64" $ test_a2s dim i64 - , testProperty "Word" $ test_a2s dim word - , testProperty "Word8" $ test_a2s dim w8 - , testProperty "Word16" $ test_a2s dim w16 - , testProperty "Word32" $ test_a2s dim w32 - , testProperty "Word64" $ test_a2s dim w64 - , testProperty "Char" $ test_a2s dim Gen.unicode - -- , testProperty "Bool" $ test_a2s dim Gen.bool - , testProperty "Float" $ test_a2s dim f32 - , testProperty "Double" $ test_a2s dim f64 - , testProperty "Complex Float" $ test_a2s_complex dim (complex f32) - , testProperty "(Double, Int16)" $ test_a2s_t2 dim ((,) <$> f64 <*> i16) - , testProperty "(Float, Float)" $ test_a2s_t2 dim ((,) <$> f32 <*> f32) - -- , testProperty "(Float, (Double,Int))" $ test_a2s dim ((,) <$> f32 <*> ((,) <$> f64 <*> int)) - ] - -test_vector_storable :: TestTree -test_vector_storable = - testGroup "Data.Vector.Storable" - [ testGroup "storable->accelerate" - [ testProperty "Int" $ test_s2a int - , testProperty "Int8" $ test_s2a i8 - , testProperty "Int16" $ test_s2a i16 - , testProperty "Int32" $ test_s2a i32 - , testProperty "Int64" $ test_s2a i64 - , testProperty "Word" $ test_s2a word - , testProperty "Word8" $ test_s2a w8 - , testProperty "Word16" $ test_s2a w16 - , testProperty "Word32" $ test_s2a w32 - , testProperty "Word64" $ test_s2a w64 - , testProperty "Char" $ test_s2a Gen.unicode - , testProperty "Bool" $ test_s2a (boolToWord8 <$> Gen.bool) - , testProperty "Float" $ test_s2a f32 - , testProperty "Double" $ test_s2a f64 - , testProperty "Complex Float" $ test_s2a_complex (complex f32) - , testProperty "(Int,Float)" $ test_s2a_t2 int f32 - , testProperty "(Int8,Word)" $ test_s2a_t2 i8 word - ] - , testGroup"accelerate->storable" - [ test_a2s_dim dim0 - , test_a2s_dim dim1 - , test_a2s_dim dim2 - ] - ] - diff --git a/test/Test/Vector/Unboxed.hs b/test/Test/Vector/Unboxed.hs deleted file mode 100644 --- a/test/Test/Vector/Unboxed.hs +++ /dev/null @@ -1,113 +0,0 @@ -{-# LANGUAGE ScopedTypeVariables #-} --- | --- Module : Test.Vector.Unboxed --- Copyright : [2017] Trevor L. McDonell --- License : BSD3 --- --- Maintainer : Trevor L. McDonell --- Stability : experimental --- Portability : non-portable (GHC extensions) --- - -module Test.Vector.Unboxed - where - -import Test.Util -import Test.Tasty -import Test.Tasty.Hedgehog - -import Data.Array.Accelerate ( Shape, Elt, Z(..), (:.)(..) ) -import Data.Array.Accelerate.Array.Sugar ( rank ) -import Data.Array.Accelerate.IO.Data.Vector.Unboxed as A -import qualified Data.Array.Accelerate as A - -import Data.Vector.Unboxed as U - -import Hedgehog -import qualified Hedgehog.Gen as Gen -import qualified Hedgehog.Range as Range - -import Text.Printf - - -unboxed :: U.Unbox e => Int -> Gen e -> Gen (U.Vector e) -unboxed n gen = - U.fromListN n <$> Gen.list (Range.singleton n) gen - -test_u2a - :: (A.Unbox e, Show e, Eq e) - => Gen e - -> Property -test_u2a e = - property $ do - Z :. n <- forAll dim1 - uvec <- forAll (unboxed n e) - -- - U.toList uvec === A.toList (A.fromUnboxed uvec) - -test_a2u - :: forall sh e. (A.Unbox e, Shape sh, Elt e, Eq sh, Eq e) - => Gen sh - -> Gen e - -> Property -test_a2u dim e = - property $ do - sh <- forAll dim - arr <- forAll (array sh e) - -- - A.toList arr === U.toList (A.toUnboxed arr) - -test_a2u_dim - :: forall sh. (Shape sh, Eq sh) - => Gen sh - -> TestTree -test_a2u_dim dim = - testGroup (printf "DIM%d" (rank (undefined::sh))) - [ testProperty "Int" $ test_a2u dim int - , testProperty "Int8" $ test_a2u dim i8 - , testProperty "Int16" $ test_a2u dim i16 - , testProperty "Int32" $ test_a2u dim i32 - , testProperty "Int64" $ test_a2u dim i64 - , testProperty "Word" $ test_a2u dim word - , testProperty "Word8" $ test_a2u dim w8 - , testProperty "Word16" $ test_a2u dim w16 - , testProperty "Word32" $ test_a2u dim w32 - , testProperty "Word64" $ test_a2u dim w64 - , testProperty "Char" $ test_a2u dim Gen.unicode - , testProperty "Bool" $ test_a2u dim Gen.bool - , testProperty "Float" $ test_a2u dim f32 - , testProperty "Double" $ test_a2u dim f64 - -- , testProperty "Complex Float" $ test_a2u dim (complex f32) - , testProperty "(Double, Int16)" $ test_a2u dim ((,) <$> f64 <*> i16) - , testProperty "(Float, (Double,Int))" $ test_a2u dim ((,) <$> f32 <*> ((,) <$> f64 <*> int)) - ] - -test_vector_unboxed :: TestTree -test_vector_unboxed = - testGroup "Data.Vector.Unboxed" - [ testGroup "unboxed->accelerate" - [ testProperty "Int" $ test_u2a int - , testProperty "Int8" $ test_u2a i8 - , testProperty "Int16" $ test_u2a i16 - , testProperty "Int32" $ test_u2a i32 - , testProperty "Int64" $ test_u2a i64 - , testProperty "Word" $ test_u2a word - , testProperty "Word8" $ test_u2a w8 - , testProperty "Word16" $ test_u2a w16 - , testProperty "Word32" $ test_u2a w32 - , testProperty "Word64" $ test_u2a w64 - , testProperty "Char" $ test_u2a Gen.unicode - , testProperty "Bool" $ test_u2a Gen.bool - , testProperty "Float" $ test_u2a f32 - , testProperty "Double" $ test_u2a f64 - -- , testProperty "Complex Float" $ test_u2a (complex f32) - , testProperty "(Int,Float)" $ test_u2a ((,) <$> int <*> f32) - , testProperty "((Int8,Word),Double)" $ test_u2a ((,) <$> ((,) <$> i8 <*> word) <*> f64) - ] - , testGroup"accelerate->unboxed" - [ test_a2u_dim dim0 - , test_a2u_dim dim1 - , test_a2u_dim dim2 - ] - ] -