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-27 +### New + * Initial release + 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-cereal.cabal b/accelerate-io-cereal.cabal new file mode 100644 --- /dev/null +++ b/accelerate-io-cereal.cabal @@ -0,0 +1,51 @@ +name: accelerate-io-cereal +version: 0.1.0.0 +cabal-version: >= 1.10 +build-type: Simple + +synopsis: Binary serialisation of Accelerate arrays using cereal +Description: + This package provides efficient binary serialisation of Accelerate arrays + via the cereal libary. + . + 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 + , accelerate-io-bytestring >= 0.1 + , cereal >= 0.5 + + exposed-modules: + Data.Array.Accelerate.IO.Data.Serialize + + 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/Serialize.hs b/src/Data/Array/Accelerate/IO/Data/Serialize.hs new file mode 100644 --- /dev/null +++ b/src/Data/Array/Accelerate/IO/Data/Serialize.hs @@ -0,0 +1,138 @@ +{-# LANGUAGE BangPatterns #-} +{-# LANGUAGE GADTs #-} +{-# LANGUAGE MagicHash #-} +{-# LANGUAGE ScopedTypeVariables #-} +{-# LANGUAGE TypeApplications #-} +{-# LANGUAGE TypeOperators #-} +{-# OPTIONS_GHC -fno-warn-orphans #-} +-- | +-- Module : Data.Array.Accelerate.IO.Data.Serialize +-- Copyright : [2012..2020] The Accelerate Team +-- License : BSD3 +-- +-- Maintainer : Trevor L. McDonell +-- Stability : experimental +-- Portability : non-portable (GHC extensions) +-- +-- Orphan instance for binary serialisation of 'Array' +-- + +module Data.Array.Accelerate.IO.Data.Serialize () + where + +import Data.Serialize + +import Data.Array.Accelerate.Array.Data +import Data.Array.Accelerate.Sugar.Array +import Data.Array.Accelerate.Sugar.Elt +import Data.Array.Accelerate.Sugar.Shape +import Data.Array.Accelerate.Representation.Shape +import Data.Array.Accelerate.Representation.Type +import Data.Array.Accelerate.Type +import qualified Data.Array.Accelerate.Representation.Array as R + +import Data.Array.Accelerate.IO.Data.ByteString + + +instance (Shape sh, Elt e) => Serialize (Array sh e) where + {-# INLINE get #-} + get = do + sh <- getShapeR (shapeR @sh) + bs <- getArrayR (eltR @e) + return $ fromByteStrings (toElt sh) bs + where + getShapeR :: ShapeR t -> Get t + getShapeR ShapeRz = return () + getShapeR (ShapeRsnoc shR) = do + sz <- get + sh <- getShapeR shR + return (sh, sz) + + getArrayR :: TypeR a -> Get (ByteStrings a) + getArrayR TupRunit = return () + getArrayR (TupRpair aR1 aR2) = do + a1 <- getArrayR aR1 + a2 <- getArrayR aR2 + return (a1, a2) + getArrayR (TupRsingle aR) = scalar aR + where + scalar :: ScalarType a -> Get (ByteStrings a) + scalar (SingleScalarType t) = single t + scalar (VectorScalarType t) = vector t + + vector :: VectorType a -> Get (ByteStrings a) + vector (VectorType _ t) + | SingleArrayDict <- singleArrayDict t + = single t + + single :: SingleType a -> Get (ByteStrings a) + single (NumSingleType t) = num t + + num :: NumType a -> Get (ByteStrings a) + num (IntegralNumType t) = integral t + num (FloatingNumType t) = floating t + + integral :: IntegralType a -> Get (ByteStrings a) + integral TypeInt = get + integral TypeInt8 = get + integral TypeInt16 = get + integral TypeInt32 = get + integral TypeInt64 = get + integral TypeWord = get + integral TypeWord8 = get + integral TypeWord16 = get + integral TypeWord32 = get + integral TypeWord64 = get + + floating :: FloatingType a -> Get (ByteStrings a) + floating TypeHalf = get + floating TypeFloat = get + floating TypeDouble = get + + {-# INLINE put #-} + put arr@(Array (R.Array sh _)) = do + putShapeR (shapeR @sh) sh + putArrayR (eltR @e) (toByteStrings arr) + where + putShapeR :: ShapeR t -> t -> Put + putShapeR ShapeRz () = return () + putShapeR (ShapeRsnoc stR) (st, sz) = put sz >> putShapeR stR st + + putArrayR :: TypeR a -> ByteStrings a -> Put + putArrayR TupRunit () = return () + putArrayR (TupRpair aR1 aR2) (a1, a2) = putArrayR aR1 a1 >> putArrayR aR2 a2 + putArrayR (TupRsingle aR) a = scalar aR a + where + scalar :: ScalarType a -> ByteStrings a -> Put + scalar (SingleScalarType t) = single t + scalar (VectorScalarType t) = vector t + + vector :: VectorType a -> ByteStrings a -> Put + vector (VectorType _ t) + | SingleArrayDict <- singleArrayDict t + = single t + + single :: SingleType a -> ByteStrings a -> Put + single (NumSingleType t) = num t + + num :: NumType a -> ByteStrings a -> Put + num (IntegralNumType t) = integral t + num (FloatingNumType t) = floating t + + integral :: IntegralType a -> ByteStrings a -> Put + integral TypeInt = put + integral TypeInt8 = put + integral TypeInt16 = put + integral TypeInt32 = put + integral TypeInt64 = put + integral TypeWord = put + integral TypeWord8 = put + integral TypeWord16 = put + integral TypeWord32 = put + integral TypeWord64 = put + + floating :: FloatingType a -> ByteStrings a -> Put + floating TypeHalf = put + floating TypeFloat = put + floating TypeDouble = put +