accelerate-io-cereal (empty) → 0.1.0.0

raw patch · 6 files changed

+251/−0 lines, 6 filesdep +acceleratedep +accelerate-io-bytestringdep +basesetup-changed

Dependencies added: accelerate, accelerate-io-bytestring, base, cereal

Files

• CHANGELOG.md +12/−0
• LICENSE +23/−0
• README.md +25/−0
• Setup.hs +2/−0
• accelerate-io-cereal.cabal +51/−0
• src/Data/Array/Accelerate/IO/Data/Serialize.hs +138/−0

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

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

@@ -0,0 +1,25 @@+<div align="center">+<img width="450" src="https://github.com/AccelerateHS/accelerate/raw/master/images/accelerate-logo-text-v.png?raw=true" alt="henlo, my name is Theia"/>++# Array conversion components for the Accelerate language++[![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)++</div>++Efficient conversion routines between Accelerate arrays and a range of data+formats.++For details on Accelerate, refer to the [main repository][GitHub].++Contributions and bug reports are welcome!<br>+Please feel free to contact me through [GitHub][GitHub] or [gitter.im][gitter.im].++  [GitHub]:     https://github.com/AccelerateHS/accelerate+  [gitter.im]:  https://gitter.im/AccelerateHS/Lobby+

@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain

@@ -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:+  <http://hackage.haskell.org/package/accelerate>++license:                BSD3+license-file:           LICENSE+author:                 The Accelerate Team+maintainer:             Trevor L. McDonell <trevor.mcdonell@gmail.com>+homepage:               https://github.com/AccelerateHS/accelerate-io#readme+bug-reports:            https://github.com/AccelerateHS/accelerate-io/issues+category:               Accelerate, Data++extra-source-files:+    README.md+    CHANGELOG.md++library+  build-depends:+          base                      >= 4.8 && < 5+        , accelerate                >= 1.3+        , 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

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