accelerate-io-array (empty) → 0.1.0.0
raw patch · 13 files changed
+973/−0 lines, 13 filesdep +acceleratedep +accelerate-io-arraydep +arraysetup-changed
Dependencies added: accelerate, accelerate-io-array, array, base, hedgehog, primitive, tasty, tasty-hedgehog
Files
- CHANGELOG.md +12/−0
- LICENSE +23/−0
- README.md +25/−0
- Setup.hs +2/−0
- accelerate-io-array.cabal +82/−0
- src/Data/Array/Accelerate/IO/Data/Array/IArray.hs +110/−0
- src/Data/Array/Accelerate/IO/Data/Array/Internal.hs +54/−0
- src/Data/Array/Accelerate/IO/Data/Array/Unboxed.hs +182/−0
- src/Data/Array/Accelerate/IO/Data/Primitive/ByteArray.hs +58/−0
- test/Test.hs +25/−0
- test/Test/Array/IArray.hs +148/−0
- test/Test/Array/Unboxed.hs +128/−0
- test/Test/Util.hs +124/−0
+ CHANGELOG.md view
@@ -0,0 +1,12 @@+# Change Log++Notable changes to the project will be documented in this file.++The format is based on [Keep a Changelog](http://keepachangelog.com/) and the+project adheres to the [Haskell Package Versioning+Policy (PVP)](https://pvp.haskell.org)++## [0.1.0.0] - 2020-08-26+### Changed+ * Split from the `accelerate-io` package+
+ LICENSE view
@@ -0,0 +1,23 @@+Copyright (c) [2007..2012] The Accelerate Team. All rights reserved.++Redistribution and use in source and binary forms, with or without+modification, are permitted provided that the following conditions are met:+ * Redistributions of source code must retain the above copyright+ notice, this list of conditions and the following disclaimer.+ * 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+ without specific prior written permission.++THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS ''AS IS'' AND ANY+EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED+WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE+DISCLAIMED. IN NO EVENT SHALL COPYRIGHT HOLDERS BE LIABLE FOR ANY+DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES+(INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES;+LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND+ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT+(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS+SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+ README.md view
@@ -0,0 +1,25 @@+<div align="center">+<img width="450" src="https://github.com/AccelerateHS/accelerate/raw/master/images/accelerate-logo-text-v.png?raw=true" alt="henlo, my name is Theia"/>++# Array conversion components for the Accelerate language++[](https://github.com/tmcdonell/accelerate-io/actions)+[](https://gitter.im/AccelerateHS/Lobby)+<br>+[](https://stackage.org/lts/package/accelerate-io)+[](https://stackage.org/nightly/package/accelerate-io)+[](https://hackage.haskell.org/package/accelerate-io)++</div>++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!<br>+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+
+ Setup.hs view
@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain
+ accelerate-io-array.cabal view
@@ -0,0 +1,82 @@+name: accelerate-io-array+version: 0.1.0.0+cabal-version: >= 1.10+build-type: Simple++synopsis: Convert between Accelerate and array+Description:+ This package provides efficient conversion routines between Accelerate arrays+ and those from the array library.+ .+ Refer to the main /Accelerate/ package for more information:+ <http://hackage.haskell.org/package/accelerate>++license: BSD3+license-file: LICENSE+author: The Accelerate Team+maintainer: Trevor L. McDonell <trevor.mcdonell@gmail.com>+homepage: https://github.com/AccelerateHS/accelerate-io#readme+bug-reports: https://github.com/AccelerateHS/accelerate-io/issues+category: Accelerate, Data++extra-source-files:+ README.md+ CHANGELOG.md++library+ build-depends:+ base >= 4.8 && < 5+ , accelerate >= 1.3+ , array >= 0.3+ , primitive >= 0.6++ exposed-modules:+ Data.Array.Accelerate.IO.Data.Array.IArray+ Data.Array.Accelerate.IO.Data.Array.Unboxed++ other-modules:+ Data.Array.Accelerate.IO.Data.Array.Internal+ Data.Array.Accelerate.IO.Data.Primitive.ByteArray++ ghc-options:+ -O2+ -Wall+ -funbox-strict-fields++ ghc-prof-options:+ -fprof-auto++ hs-source-dirs: src+ default-language: Haskell2010++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.8 && < 5+ , accelerate+ , accelerate-io-array+ , array+ , hedgehog >= 0.5+ , tasty >= 0.11+ , tasty-hedgehog >= 0.1++ ghc-options:+ -Wall+ -threaded+ -rtsopts++ other-modules:+ Test.Array.IArray+ Test.Array.Unboxed+ Test.Util++source-repository head+ type: git+ location: https://github.com/AccelerateHS/accelerate-io++-- vim: nospell
+ src/Data/Array/Accelerate/IO/Data/Array/IArray.hs view
@@ -0,0 +1,110 @@+{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE TypeApplications #-}+{-# LANGUAGE TypeFamilies #-}+-- |+-- Module : Data.Array.Accelerate.IO.Data.Array.IArray+-- Copyright : [2016..2020] The Accelerate Team+-- License : BSD3+--+-- Maintainer : Trevor L. McDonell <trevor.mcdonell@gmail.com>+-- 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.Error+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 Data.Array.Accelerate.Type++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+ :: (HasCallStack, IxShapeRepr (EltR ix) ~ EltR 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 (eltR @sh) (fromElt ix0) (fromElt ix)+ where+ go :: TypeR ix -> ix -> ix -> ix+ go TupRunit () () = ()+ go (TupRpair tl tr) (l0, r0) (l,r) = (go tl l0 l, go tr r0 r)+ go (TupRsingle (SingleScalarType (NumSingleType (IntegralNumType TypeInt{})))) i0 i = i0+i+ go _ _ _ =+ internalError "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. (HasCallStack, IxShapeRepr (EltR ix) ~ EltR sh, IArray a e, IArray.Ix ix, Shape sh, Elt e, 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 :: EltR sh -> sh)+ $ go (eltR @sh) (fromElt (toIxShapeRepr ix0 :: sh)) (fromElt (toIxShapeRepr ix :: sh))+ where+ go :: TypeR sh' -> sh' -> sh' -> sh'+ go TupRunit () () = ()+ go (TupRpair tl tr) (l0,r0) (l,r) = (go tl l0 l, go tr r0 r)+ go (TupRsingle (SingleScalarType (NumSingleType (IntegralNumType TypeInt{})))) i0 i = i0+i+ go _ _ _ =+ internalError "error in index offset"+
+ src/Data/Array/Accelerate/IO/Data/Array/Internal.hs view
@@ -0,0 +1,54 @@+{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE TypeApplications #-}+{-# LANGUAGE TypeFamilies #-}+-- |+-- Module : Data.Array.Accelerate.IO.Data.Array.Internal+-- Copyright : [2017..2020] The Accelerate Team+-- License : BSD3+--+-- Maintainer : Trevor L. McDonell <trevor.mcdonell@gmail.com>+-- Stability : experimental+-- Portability : non-portable (GHC extensions)+--++module Data.Array.Accelerate.IO.Data.Array.Internal+ where++import Data.Array.Accelerate.Error+import Data.Array.Accelerate.Representation.Type+import Data.Array.Accelerate.Sugar.Elt+import Data.Array.Accelerate.Sugar.Shape+import Data.Array.Accelerate.Type+++type family IxShapeRepr e where+ IxShapeRepr () = ()+ IxShapeRepr Int = ((),Int)+ IxShapeRepr (t,h) = (IxShapeRepr t, h)++fromIxShapeRepr+ :: forall ix sh. (HasCallStack, IxShapeRepr (EltR ix) ~ EltR sh, Shape sh, Elt ix)+ => sh+ -> ix+fromIxShapeRepr sh = toElt (go (eltR @ix) (fromElt sh))+ where+ go :: forall ix'. TypeR ix' -> IxShapeRepr ix' -> ix'+ go TupRunit () = ()+ go (TupRpair tt _) (t, h) = (go tt t, h)+ go (TupRsingle (SingleScalarType (NumSingleType (IntegralNumType TypeInt{})))) ((),h) = h+ go _ _ =+ internalError "not a valid IArray.Ix"++toIxShapeRepr+ :: forall ix sh. (HasCallStack, IxShapeRepr (EltR ix) ~ EltR sh, Shape sh, Elt ix)+ => ix+ -> sh+toIxShapeRepr ix = toElt (go (eltR @ix) (fromElt ix))+ where+ go :: forall ix'. TypeR ix' -> ix' -> IxShapeRepr ix'+ go TupRunit () = ()+ go (TupRpair tt _) (t, h) = (go tt t, h)+ go (TupRsingle (SingleScalarType (NumSingleType (IntegralNumType TypeInt{})))) h = ((),h)+ go _ _ =+ internalError "not a valid IArray.Ix"+
+ src/Data/Array/Accelerate/IO/Data/Array/Unboxed.hs view
@@ -0,0 +1,182 @@+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE MagicHash #-}+{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE TypeApplications #-}+{-# LANGUAGE TypeFamilies #-}+-- |+-- Module : Data.Array.Accelerate.IO.Data.Array.Unboxed+-- Copyright : [2016..2020] The Accelerate Team+-- License : BSD3+--+-- Maintainer : Trevor L. McDonell <trevor.mcdonell@gmail.com>+-- 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.Unique+import Data.Array.Accelerate.Error+import Data.Array.Accelerate.Lifetime+import Data.Array.Accelerate.Representation.Type+import Data.Array.Accelerate.Sugar.Array+import Data.Array.Accelerate.Sugar.Elt+import Data.Array.Accelerate.Sugar.Shape+import Data.Array.Accelerate.Type+import qualified Data.Array.Accelerate.Representation.Array as R++import Data.Array.Accelerate.IO.Data.Array.Internal+import Data.Array.Accelerate.IO.Data.Primitive.ByteArray++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: <https://ghc.haskell.org/trac/ghc/ticket/5556>+--+-- @since 0.1.0.0@+--+{-# INLINE fromUArray #-}+fromUArray+ :: forall ix sh e. (HasCallStack, IxShapeRepr (EltR ix) ~ EltR 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 (R.Array (fromElt sh) (tuple (eltR @e)))+ where+ sh = rangeToShape (toIxShapeRepr lo, toIxShapeRepr hi) :: sh++ wrap :: forall a. Prim a => UniqueArray a+ wrap = unsafePerformIO (newUniqueArray =<< foreignPtrOfByteArray 0 (n * sizeOf (undefined::a)) (ByteArray ba#))++ tuple :: TypeR a -> ArrayData a+ tuple TupRunit = ()+ tuple (TupRpair aR1 aR2) = (tuple aR1, tuple aR2)+ tuple (TupRsingle t) = scalar t++ scalar :: ScalarType t -> ArrayData t+ scalar (SingleScalarType t) = single t+ scalar (VectorScalarType _) = internalError "unsupported type"++ single :: SingleType t -> ArrayData t+ single (NumSingleType t) = num t++ num :: NumType t -> ArrayData t+ num (IntegralNumType t) = integral t+ num (FloatingNumType t) = floating t++ integral :: IntegralType t -> ArrayData t+ integral TypeInt = wrap+ integral TypeInt8 = wrap+ integral TypeInt16 = wrap+ integral TypeInt32 = wrap+ integral TypeInt64 = wrap+ integral TypeWord = wrap+ integral TypeWord8 = wrap+ integral TypeWord16 = wrap+ integral TypeWord32 = wrap+ integral TypeWord64 = wrap++ floating :: FloatingType t -> ArrayData t+ floating TypeHalf = wrap+ floating TypeFloat = wrap+ floating TypeDouble = wrap+++-- | /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 0.1.0.0@+--+{-# INLINE toUArray #-}+toUArray+ :: forall ix sh e. (HasCallStack, IxShapeRepr (EltR ix) ~ EltR sh, IArray UArray e, Ix ix, Shape sh, Elt e, 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 (R.Array _ adata)) =+ case ba of+ ByteArray ba# -> UArray lo hi n ba#+ where+ n = size (shape arr)+ bnds = shapeToRange (shape arr)+ lo = fromIxShapeRepr (offset (fst bnds))+ hi = fromIxShapeRepr (offset (snd bnds))+ ba = tuple (eltR @e) adata++ offset :: sh -> sh+ offset ix =+ case mix0 of+ Nothing -> ix+ Just ix0 -> offset' ix0 ix++ offset' :: ix -> sh -> sh+ offset' ix0 = toElt . go (eltR @sh) (fromElt (toIxShapeRepr ix0 :: sh)) . fromElt+ where+ go :: TypeR sh' -> sh' -> sh' -> sh'+ go TupRunit () () = ()+ go (TupRpair tl tr) (l0, r0) (l,r) = (go tl l0 l, go tr r0 r)+ go (TupRsingle (SingleScalarType (NumSingleType (IntegralNumType TypeInt{})))) i0 i = i0+i+ go _ _ _ =+ internalError "error in index offset"++ wrap :: forall a. Prim a => UniqueArray a -> ByteArray+ wrap ua = unsafePerformIO $ byteArrayOfForeignPtr (n * sizeOf (undefined::a)) (unsafeGetValue (uniqueArrayData ua))++ tuple :: TypeR a -> ArrayData a -> ByteArray+ tuple (TupRsingle t) = scalar t+ tuple _ = internalError "unsupported type"++ scalar :: ScalarType t -> ArrayData t -> ByteArray+ scalar (SingleScalarType t) = single t+ scalar (VectorScalarType _) = internalError "unsupported type"++ single :: SingleType t -> ArrayData t -> ByteArray+ single (NumSingleType t) = num t++ num :: NumType t -> ArrayData t -> ByteArray+ num (IntegralNumType t) = integral t+ num (FloatingNumType t) = floating t++ integral :: IntegralType t -> ArrayData t -> ByteArray+ integral TypeInt = wrap+ integral TypeInt8 = wrap+ integral TypeInt16 = wrap+ integral TypeInt32 = wrap+ integral TypeInt64 = wrap+ integral TypeWord = wrap+ integral TypeWord8 = wrap+ integral TypeWord16 = wrap+ integral TypeWord32 = wrap+ integral TypeWord64 = wrap++ floating :: FloatingType t -> ArrayData t -> ByteArray+ floating TypeHalf = wrap+ floating TypeFloat = wrap+ floating TypeDouble = wrap+
+ src/Data/Array/Accelerate/IO/Data/Primitive/ByteArray.hs view
@@ -0,0 +1,58 @@+{-# LANGUAGE CPP #-}+{-# LANGUAGE MagicHash #-}+{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE UnboxedTuples #-}+-- |+-- Module : Data.Array.Accelerate.IO.Data.Vector.Primitive.Internal+-- Copyright : [2017..2020] The Accelerate Team+-- License : BSD3+--+-- Maintainer : Trevor L. McDonell <trevor.mcdonell@gmail.com>+-- Stability : experimental+-- Portability : non-portable (GHC extensions)+--++module Data.Array.Accelerate.IO.Data.Primitive.ByteArray+ where++import Data.Primitive.ByteArray++import GHC.Base+import GHC.ForeignPtr+++-- 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# 64# 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# 64# 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+
+ test/Test.hs view
@@ -0,0 +1,25 @@+-- |+-- Module : Test+-- Copyright : [2017..2020] Trevor L. McDonell+-- License : BSD3+--+-- Maintainer : Trevor L. McDonell <trevor.mcdonell@gmail.com>+-- Stability : experimental+-- Portability : non-portable (GHC extensions)+--++module Test where++import Test.Tasty++import Test.Array.IArray+import Test.Array.Unboxed++main :: IO ()+main+ = defaultMain+ $ testGroup "IO"+ [ test_array_iarray+ , test_array_unboxed+ ]+
+ test/Test/Array/IArray.hs view
@@ -0,0 +1,148 @@+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE TypeFamilies #-}+-- |+-- Module : Test.Array.IArray+-- Copyright : [2017..2020] The Accelerate Team+-- License : BSD3+--+-- Maintainer : Trevor L. McDonell <trevor.mcdonell@gmail.com>+-- 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.Sugar.Elt ( EltR )+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, Show sh, Shape sh, Show e, Elt e, Eq e, Show (a ix e), Eq (a ix e), IxShapeRepr (EltR ix) ~ EltR 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, Show sh, Shape sh, Show e, Elt e, Eq e, Show (a ix e), Eq sh, Eq e, IxShapeRepr (EltR ix) ~ EltR 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)+ ]+ ]+ ]+
+ test/Test/Array/Unboxed.hs view
@@ -0,0 +1,128 @@+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE TypeFamilies #-}+-- |+-- Module : Test.Array.Unboxed+-- Copyright : [2017..2020] The Accelerate Team+-- License : BSD3+--+-- Maintainer : Trevor L. McDonell <trevor.mcdonell@gmail.com>+-- 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.Sugar.Elt ( EltR )+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, Show sh, Shape sh, Show e, Elt e, Eq e, Show (UArray ix e), Eq (UArray ix e), IxShapeRepr (EltR ix) ~ EltR 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, Show sh, Shape sh, Show e, Elt e, Show (UArray ix e), Eq (UArray ix e), Eq sh, Eq e, IxShapeRepr (EltR ix) ~ EltR 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+ ]+ ]+ ]+
+ test/Test/Util.hs view
@@ -0,0 +1,124 @@+{-# LANGUAGE ConstraintKinds #-}+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE RankNTypes #-}+{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE TypeOperators #-}+{-# LANGUAGE ViewPatterns #-}+-- |+-- Module : Test.Util+-- Copyright : [2017..2020] The Accelerate Team+-- License : BSD3+--+-- Maintainer : Trevor L. McDonell <trevor.mcdonell@gmail.com>+-- 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 )+import Data.Array.Accelerate.Trafo.Sharing ( AfunctionR )+import Data.Array.Accelerate.Sugar.Array ( fromList )+import Data.Array.Accelerate.Sugar.Shape ( DIM1, DIM2, Z(..), (:.)(..), 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)+