accelerate-io 1.2.0.0 → 1.3.0.0

raw patch · 25 files changed

+190/−2843 lines, 25 filesdep −accelerate-iodep −arraydep −bmpdep ~acceleratedep ~basePVP ok

version bump matches the API change (PVP)

Dependencies removed: accelerate-io, array, bmp, bytestring, hedgehog, primitive, repa, tasty, tasty-hedgehog, vector

Dependency ranges changed: accelerate, base

API changes (from Hackage documentation)

Files

• CHANGELOG.md +6/−0
• LICENSE +2/−2
• README.md +20/−5
• accelerate-io.cabal +19/−77
• src/Data/Array/Accelerate/IO/Codec/BMP.hs +0/−82
• src/Data/Array/Accelerate/IO/Data/Array/IArray.hs +0/−107
• src/Data/Array/Accelerate/IO/Data/Array/Internal.hs +0/−46
• src/Data/Array/Accelerate/IO/Data/Array/Unboxed.hs +0/−148
• src/Data/Array/Accelerate/IO/Data/ByteString.hs +0/−206
• src/Data/Array/Accelerate/IO/Data/Vector/Generic.hs +0/−57
• src/Data/Array/Accelerate/IO/Data/Vector/Generic/Mutable.hs +0/−263
• src/Data/Array/Accelerate/IO/Data/Vector/Primitive.hs +0/−140
• src/Data/Array/Accelerate/IO/Data/Vector/Primitive/Internal.hs +0/−82
• src/Data/Array/Accelerate/IO/Data/Vector/Storable.hs +0/−197
• src/Data/Array/Accelerate/IO/Data/Vector/Unboxed.hs +0/−356
• src/Data/Array/Accelerate/IO/Foreign/ForeignPtr.hs +31/−126
• src/Data/Array/Accelerate/IO/Foreign/Internal.hs +79/−0
• src/Data/Array/Accelerate/IO/Foreign/Ptr.hs +33/−49
• src/Data/Array/Repa/Repr/Accelerate.hs +0/−176
• test/Test.hs +0/−29
• test/Test/Array/IArray.hs +0/−148
• test/Test/Array/Unboxed.hs +0/−128
• test/Test/Util.hs +0/−122
• test/Test/Vector/Storable.hs +0/−184
• test/Test/Vector/Unboxed.hs +0/−113

@@ -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

@@ -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

@@ -1,10 +1,25 @@-Array Conversion Component for the Accelerate Array Language-============================================================+<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"/> -[![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)+<br>+[![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].+</div> -  [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!<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 

@@ -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:   <http://hackage.haskell.org/package/accelerate>  License:                BSD3 License-file:           LICENSE-Author:                 Manuel M T Chakravarty,-                        Gabriele Keller,-                        Sean Seefried,-                        Trevor L. McDonell-Maintainer:             Trevor L. McDonell <tmcdonell@cse.unsw.edu.au>+Author:                 The Accelerate Team+Maintainer:             Trevor L. McDonell <trevor.mcdonell@gmail.com> 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

@@ -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 <tmcdonell@cse.unsw.edu.au>--- 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, .. }-

@@ -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 <tmcdonell@cse.unsw.edu.au>--- 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"-

@@ -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 <tmcdonell@cse.unsw.edu.au>--- 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"-

@@ -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 <tmcdonell@cse.unsw.edu.au>--- 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: <https://ghc.haskell.org/trac/ghc/ticket/5556>------ @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"-

@@ -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 <tmcdonell@cse.unsw.edu.au>--- 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-

@@ -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 <tmcdonell@cse.unsw.edu.au>--- 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)-

@@ -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 <tmcdonell@cse.unsw.edu.au>--- 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-

@@ -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 <tmcdonell@cse.unsw.edu.au>--- 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: <https://ghc.haskell.org/trac/ghc/ticket/5556>------ @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"-

@@ -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 <tmcdonell@cse.unsw.edu.au>--- 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-

@@ -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 <tmcdonell@cse.unsw.edu.au>--- 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)-

@@ -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 <tmcdonell@cse.unsw.edu.au>--- 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: <https://ghc.haskell.org/trac/ghc/ticket/5556>------ @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"---}-

@@ -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 <tmcdonell@cse.unsw.edu.au>+-- Maintainer  : Trevor L. McDonell <trevor.mcdonell@gmail.com> -- 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) 

@@ -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 <trevor.mcdonell@gmail.com>+-- 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+

@@ -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 <tmcdonell@cse.unsw.edu.au>+-- Maintainer  : Trevor L. McDonell <trevor.mcdonell@gmail.com> -- 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)) 

@@ -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 <tmcdonell@cse.unsw.edu.au>--- 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-

@@ -1,29 +0,0 @@--- |--- Module      : Test--- Copyright   : [2017] Trevor L. McDonell--- License     : BSD3------ Maintainer  : Trevor L. McDonell <tmcdonell@cse.unsw.edu.au>--- 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-    ]-

@@ -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 <tmcdonell@cse.unsw.edu.au>--- 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)-        ]-      ]-    ]-

@@ -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 <tmcdonell@cse.unsw.edu.au>--- 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-        ]-      ]-    ]-

@@ -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 <tmcdonell@cse.unsw.edu.au>--- 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)-

@@ -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 <tmcdonell@cse.unsw.edu.au>--- 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-      ]-    ]-

@@ -1,113 +0,0 @@-{-# LANGUAGE ScopedTypeVariables #-}--- |--- Module      : Test.Vector.Unboxed--- Copyright   : [2017] Trevor L. McDonell--- License     : BSD3------ Maintainer  : Trevor L. McDonell <tmcdonell@cse.unsw.edu.au>--- 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-      ]-    ]-