diff --git a/CHANGELOG.md b/CHANGELOG.md new file mode 100644 --- /dev/null +++ b/CHANGELOG.md @@ -0,0 +1,12 @@ +# Change Log + +Notable changes to the project will be documented in this file. + +The format is based on [Keep a Changelog](http://keepachangelog.com/) and the +project adheres to the [Haskell Package Versioning +Policy (PVP)](https://pvp.haskell.org) + +## [0.1.0.0] - 2020-08-26 +### Changed + * Split from the `accelerate-io` package + diff --git a/LICENSE b/LICENSE new file mode 100644 --- /dev/null +++ b/LICENSE @@ -0,0 +1,23 @@ +Copyright (c) [2007..2012] The Accelerate Team. All rights reserved. + +Redistribution and use in source and binary forms, with or without +modification, are permitted provided that the following conditions are met: + * Redistributions of source code must retain the above copyright + notice, this list of conditions and the following disclaimer. + * Redistributions in binary form must reproduce the above copyright + notice, this list of conditions and the following disclaimer in the + documentation and/or other materials provided with the distribution. + * Neither the names of the contributors nor of their affiliations may + be used to endorse or promote products derived from this software + without specific prior written permission. + +THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS ''AS IS'' AND ANY +EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED +WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE +DISCLAIMED. IN NO EVENT SHALL COPYRIGHT HOLDERS BE LIABLE FOR ANY +DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES +(INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; +LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND +ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT +(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS +SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. diff --git a/README.md b/README.md new file mode 100644 --- /dev/null +++ b/README.md @@ -0,0 +1,25 @@ +
+henlo, my name is Theia + +# Array conversion components for the Accelerate language + +[![GitHub CI](https://github.com/tmcdonell/accelerate-io/workflows/CI/badge.svg)](https://github.com/tmcdonell/accelerate-io/actions) +[![Gitter](https://img.shields.io/gitter/room/nwjs/nw.js.svg)](https://gitter.im/AccelerateHS/Lobby) +
+[![Stackage LTS](https://stackage.org/package/accelerate-io/badge/lts)](https://stackage.org/lts/package/accelerate-io) +[![Stackage Nightly](https://stackage.org/package/accelerate-io/badge/nightly)](https://stackage.org/nightly/package/accelerate-io) +[![Hackage](https://img.shields.io/hackage/v/accelerate-io.svg)](https://hackage.haskell.org/package/accelerate-io) + +
+ +Efficient conversion routines between Accelerate arrays and a range of data +formats. + +For details on Accelerate, refer to the [main repository][GitHub]. + +Contributions and bug reports are welcome!
+Please feel free to contact me through [GitHub][GitHub] or [gitter.im][gitter.im]. + + [GitHub]: https://github.com/AccelerateHS/accelerate + [gitter.im]: https://gitter.im/AccelerateHS/Lobby + diff --git a/Setup.hs b/Setup.hs new file mode 100644 --- /dev/null +++ b/Setup.hs @@ -0,0 +1,2 @@ +import Distribution.Simple +main = defaultMain diff --git a/accelerate-io-bytestring.cabal b/accelerate-io-bytestring.cabal new file mode 100644 --- /dev/null +++ b/accelerate-io-bytestring.cabal @@ -0,0 +1,50 @@ +name: accelerate-io-bytestring +version: 0.1.0.0 +cabal-version: >= 1.10 +build-type: Simple + +synopsis: Convert between Accelerate and ByteString +Description: + This package provides efficient conversion routines between Accelerate arrays + and ByteStrings. + . + Refer to the main /Accelerate/ package for more information: + + +license: BSD3 +license-file: LICENSE +author: The Accelerate Team +maintainer: Trevor L. McDonell +homepage: https://github.com/AccelerateHS/accelerate-io#readme +bug-reports: https://github.com/AccelerateHS/accelerate-io/issues +category: Accelerate, Data + +extra-source-files: + README.md + CHANGELOG.md + +library + build-depends: + base >= 4.8 && < 5 + , accelerate >= 1.3 + , bytestring >= 0.9 + + exposed-modules: + Data.Array.Accelerate.IO.Data.ByteString + + ghc-options: + -O2 + -Wall + -funbox-strict-fields + + ghc-prof-options: + -fprof-auto + + hs-source-dirs: src + default-language: Haskell2010 + +source-repository head + type: git + location: https://github.com/AccelerateHS/accelerate-io + +-- vim: nospell diff --git a/src/Data/Array/Accelerate/IO/Data/ByteString.hs b/src/Data/Array/Accelerate/IO/Data/ByteString.hs new file mode 100644 --- /dev/null +++ b/src/Data/Array/Accelerate/IO/Data/ByteString.hs @@ -0,0 +1,185 @@ +{-# LANGUAGE CPP #-} +{-# LANGUAGE ScopedTypeVariables #-} +{-# LANGUAGE TypeApplications #-} +{-# LANGUAGE TypeFamilies #-} +{-# LANGUAGE ViewPatterns #-} +-- | +-- Module : Data.Array.Accelerate.IO.Data.ByteString +-- Copyright : [2010..2020] The Accelerate Team +-- License : BSD3 +-- +-- Maintainer : Trevor L. McDonell +-- Stability : experimental +-- Portability : non-portable (GHC extensions) +-- +-- Conversion between strict 'ByteString's and Accelerate 'Array's. +-- + +module Data.Array.Accelerate.IO.Data.ByteString + where + +import Data.Array.Accelerate.Array.Data -- ( ArrayData, GArrayDataR, ScalarArrayDataR ) +import Data.Array.Accelerate.Array.Unique +import Data.Array.Accelerate.Lifetime +import Data.Array.Accelerate.Sugar.Array +import Data.Array.Accelerate.Sugar.Elt +import Data.Array.Accelerate.Sugar.Shape +import Data.Array.Accelerate.Representation.Type +import Data.Array.Accelerate.Type +import qualified Data.Array.Accelerate.Representation.Array as R +import qualified Data.Array.Accelerate.Representation.Shape as R + +import Data.Primitive.Vec + +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 +#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 where + ByteStrings () = () + ByteStrings Int = ByteString + ByteStrings Int8 = ByteString + ByteStrings Int16 = ByteString + ByteStrings Int32 = ByteString + ByteStrings Int64 = ByteString + ByteStrings Word = ByteString + ByteStrings Word8 = ByteString + ByteStrings Word16 = ByteString + ByteStrings Word32 = ByteString + ByteStrings Word64 = ByteString + ByteStrings Half = ByteString + ByteStrings Float = ByteString + ByteStrings Double = ByteString + ByteStrings Bool = ByteString + ByteStrings Char = ByteString + ByteStrings (Vec n a) = ByteStrings a + 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 0.1.0.0@ +-- +{-# INLINE fromByteStrings #-} +fromByteStrings :: forall sh e. (Shape sh, Elt e) => sh -> ByteStrings (EltR e) -> Array sh e +fromByteStrings sh bs = Array (R.Array (fromElt sh) (tuple (eltR @e) bs)) + where + wrap :: ByteString -> UniqueArray a + wrap (B.toForeignPtr -> (ps,s,_)) = + unsafePerformIO $ newUniqueArray (castForeignPtr (plusForeignPtr ps s)) + + tuple :: TypeR a -> ByteStrings a -> ArrayData a + tuple TupRunit () = () + tuple (TupRpair aR1 aR2) (a1, a2) = (tuple aR1 a1, tuple aR2 a2) + tuple (TupRsingle t) a = scalar t a + + scalar :: ScalarType a -> ByteStrings a -> ArrayData a + scalar (SingleScalarType t) = single t + scalar (VectorScalarType t) = vector t + + vector :: VectorType a -> ByteStrings a -> ArrayData a + vector (VectorType _ t) + | SingleArrayDict <- singleArrayDict t + = single t + + single :: SingleType a -> ByteStrings a -> ArrayData a + single (NumSingleType t) = num t + + num :: NumType a -> ByteStrings a -> ArrayData a + num (IntegralNumType t) = integral t + num (FloatingNumType t) = floating t + + integral :: IntegralType a -> ByteStrings a -> ArrayData a + integral TypeInt = wrap + integral TypeInt8 = wrap + integral TypeInt16 = wrap + integral TypeInt32 = wrap + integral TypeInt64 = wrap + integral TypeWord = wrap + integral TypeWord8 = wrap + integral TypeWord16 = wrap + integral TypeWord32 = wrap + integral TypeWord64 = wrap + + floating :: FloatingType a -> ByteStrings a -> ArrayData a + floating TypeHalf = wrap + floating TypeFloat = wrap + floating TypeDouble = wrap + + +-- | /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 0.1.0.0@ +-- +{-# INLINE toByteStrings #-} +toByteStrings :: forall sh e. (Shape sh, Elt e) => Array sh e -> ByteStrings (EltR e) +toByteStrings (Array (R.Array sh adata)) = tuple (eltR @e) adata + where + wrap :: forall a. Storable a => UniqueArray a -> Int -> ByteString + wrap (unsafeGetValue . uniqueArrayData -> fp) k = + B.fromForeignPtr (castForeignPtr fp) 0 (R.size (shapeR @sh) sh * k * sizeOf (undefined::a)) + + tuple :: TypeR a -> ArrayData a -> ByteStrings a + tuple TupRunit () = () + tuple (TupRpair aR1 aR2) (a1, a2) = (tuple aR1 a1, tuple aR2 a2) + tuple (TupRsingle t) a = scalar t a 1 + + scalar :: ScalarType a -> ArrayData a -> Int -> ByteStrings a + scalar (SingleScalarType t) = single t + scalar (VectorScalarType t) = vector t + + vector :: VectorType a -> ArrayData a -> Int -> ByteStrings a + vector (VectorType w t) a _ + | SingleArrayDict <- singleArrayDict t + = single t a w + + single :: SingleType a -> ArrayData a -> Int -> ByteStrings a + single (NumSingleType t) = num t + + num :: NumType a -> ArrayData a -> Int -> ByteStrings a + num (IntegralNumType t) = integral t + num (FloatingNumType t) = floating t + + integral :: IntegralType a -> ArrayData a -> Int -> ByteStrings a + integral TypeInt = wrap + integral TypeInt8 = wrap + integral TypeInt16 = wrap + integral TypeInt32 = wrap + integral TypeInt64 = wrap + integral TypeWord = wrap + integral TypeWord8 = wrap + integral TypeWord16 = wrap + integral TypeWord32 = wrap + integral TypeWord64 = wrap + + floating :: FloatingType a -> ArrayData a -> Int -> ByteStrings a + floating TypeHalf = wrap + floating TypeFloat = wrap + floating TypeDouble = wrap + +#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 +