packages feed

primitive-unaligned (empty) → 0.1.1.0

raw patch · 7 files changed

+478/−0 lines, 7 filesdep +basedep +primitivedep +primitive-unalignedsetup-changed

Dependencies added: base, primitive, primitive-unaligned

Files

+ LICENSE view
@@ -0,0 +1,30 @@+Copyright (c) 2019, Andrew Martin++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 name of Andrew Martin nor the names of other+      contributors 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 AND CONTRIBUTORS+"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 THE COPYRIGHT+OWNER OR CONTRIBUTORS 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.
+ Setup.hs view
@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain
+ primitive-unaligned.cabal view
@@ -0,0 +1,47 @@+cabal-version: 2.2+name: primitive-unaligned+version: 0.1.1.0+synopsis: Unaligned access to primitive arrays+description: Unaligned access to primitive arrays. The offsets are given in bytes rather than elements.+homepage: https://github.com/haskell-primitive/primitive-unaligned+bug-reports: https://github.com/haskell-primitive/primitive-unaligned/issues+license: BSD-3-Clause+license-file: LICENSE+author: Andrew Martin+maintainer: Andrew Martin <andrew.thaddeus@gmail.com>+copyright: 2019 Andrew Martin+category: Data+tested-with: GHC == 8.6.4++library+  exposed-modules:+    Data.Primitive.ByteArray.Unaligned+  other-modules:+    Data.Primitive.Unaligned.Mach+  build-depends:+    , base >=4.12.0.0 && <5+    , primitive >=0.6.4 && <0.8+  hs-source-dirs: src+  if arch(x86_64) || arch(aarch64) || arch(ppc64)+    hs-source-dirs: src-64+  if arch(i386) || arch(arm)+    hs-source-dirs: src-32+  ghc-options: -Wall -O2+  default-language: Haskell2010++test-suite unit+  type: exitcode-stdio-1.0+  hs-source-dirs: test+  main-is: Unit.hs+  build-depends:+    , base+    , primitive-unaligned+    , primitive+  ghc-options: -Wall -O2+  default-language: Haskell2010++source-repository head+  type: git+  location: git://github.com/haskell-primitive/primitive-unaligned.git++
+ src-32/Data/Primitive/Unaligned/Mach.hs view
@@ -0,0 +1,60 @@+{-# language MagicHash #-}+{-# language UnboxedTuples #-}++module Data.Primitive.Unaligned.Mach+  ( indexUnalignedInt64Array#+  , indexUnalignedWord64Array#+  , readUnalignedInt64Array#+  , readUnalignedWord64Array#+  , writeUnalignedInt64Array#+  , writeUnalignedWord64Array#+  ) where++import GHC.Exts (Int#,ByteArray#,MutableByteArray#,State#)+import GHC.Word (Word64(W64#))+import GHC.Int (Int64(I64#))+import qualified GHC.Exts as E++indexUnalignedWord64Array# :: ByteArray# -> Int# -> Word64+indexUnalignedWord64Array# a i =+  W64# (E.indexWord8ArrayAsWord64# a i)++indexUnalignedInt64Array# :: ByteArray# -> Int# -> Int64+indexUnalignedInt64Array# a i =+  I64# (E.indexWord8ArrayAsInt64# a i)++readUnalignedWord64Array# ::+     MutableByteArray# s+  -> Int#+  -> State# s+  -> (# State# s, Word64 #)+readUnalignedWord64Array# a i s0 =+  case E.readWord8ArrayAsWord64# a i s0 of+    (# s1, r #) -> (# s1, W64# r #)++readUnalignedInt64Array# ::+     MutableByteArray# s+  -> Int#+  -> State# s+  -> (# State# s, Int64 #)+readUnalignedInt64Array# a i s0 =+  case E.readWord8ArrayAsInt64# a i s0 of+    (# s1, r #) -> (# s1, I64# r #)++writeUnalignedWord64Array# ::+       MutableByteArray# s+    -> Int#+    -> Word64+    -> State# s+    -> State# s+writeUnalignedWord64Array# a i (W64# w) =+  E.writeWord8ArrayAsWord64# a i w++writeUnalignedInt64Array# ::+       MutableByteArray# s+    -> Int#+    -> Int64+    -> State# s+    -> State# s+writeUnalignedInt64Array# a i (I64# w) =+  E.writeWord8ArrayAsInt64# a i w
+ src-64/Data/Primitive/Unaligned/Mach.hs view
@@ -0,0 +1,60 @@+{-# language MagicHash #-}+{-# language UnboxedTuples #-}++module Data.Primitive.Unaligned.Mach+  ( indexUnalignedInt64Array#+  , indexUnalignedWord64Array#+  , readUnalignedInt64Array#+  , readUnalignedWord64Array#+  , writeUnalignedInt64Array#+  , writeUnalignedWord64Array#+  ) where++import GHC.Exts (Int#,ByteArray#,MutableByteArray#,State#)+import GHC.Word (Word64(W64#))+import GHC.Int (Int64(I64#))+import qualified GHC.Exts as E++indexUnalignedWord64Array# :: ByteArray# -> Int# -> Word64+indexUnalignedWord64Array# a i =+  W64# (E.indexWord8ArrayAsWord# a i)++indexUnalignedInt64Array# :: ByteArray# -> Int# -> Int64+indexUnalignedInt64Array# a i =+  I64# (E.indexWord8ArrayAsInt# a i)++readUnalignedWord64Array# ::+     MutableByteArray# s+  -> Int#+  -> State# s+  -> (# State# s, Word64 #)+readUnalignedWord64Array# a i s0 =+  case E.readWord8ArrayAsWord# a i s0 of+    (# s1, r #) -> (# s1, W64# r #)++readUnalignedInt64Array# ::+     MutableByteArray# s+  -> Int#+  -> State# s+  -> (# State# s, Int64 #)+readUnalignedInt64Array# a i s0 =+  case E.readWord8ArrayAsInt# a i s0 of+    (# s1, r #) -> (# s1, I64# r #)++writeUnalignedWord64Array# ::+       MutableByteArray# s+    -> Int#+    -> Word64+    -> State# s+    -> State# s+writeUnalignedWord64Array# a i (W64# w) =+  E.writeWord8ArrayAsWord# a i w++writeUnalignedInt64Array# ::+       MutableByteArray# s+    -> Int#+    -> Int64+    -> State# s+    -> State# s+writeUnalignedInt64Array# a i (I64# w) =+  E.writeWord8ArrayAsInt# a i w
+ src/Data/Primitive/ByteArray/Unaligned.hs view
@@ -0,0 +1,253 @@+{-# language MagicHash #-}+{-# language UnboxedTuples #-}+{-# language DerivingStrategies #-}+{-# language StandaloneDeriving #-}+{-# language GeneralizedNewtypeDeriving #-}+{-# language PolyKinds #-}+{-# language DataKinds #-}++module Data.Primitive.ByteArray.Unaligned+  ( -- * Class+    PrimUnaligned(..)+    -- * Array access+  , indexUnalignedByteArray+  , readUnalignedByteArray+  , writeUnalignedByteArray+  ) where++import Control.Monad.Primitive (PrimMonad,PrimState)+import Control.Monad.Primitive (primitive,primitive_)+import Data.Primitive.ByteArray (MutableByteArray(..))+import Data.Primitive.ByteArray (ByteArray(..))+import Data.Word (Word8,Word64)+import Data.Int (Int8,Int64)+import GHC.Int (Int16(I16#),Int32(I32#),Int(I#))+import GHC.Word (Word16(W16#),Word32(W32#),Word(W#))+import GHC.Exts (Int#,State#,MutableByteArray#,ByteArray#)+import GHC.Exts (Char(C#),Double(D#),Float(F#),Ptr(Ptr))+import qualified Foreign.C.Types as C+import qualified System.Posix.Types as P+import qualified Data.Primitive.Unaligned.Mach as M+import qualified Data.Primitive as PM+import qualified GHC.Exts as E++-- | Class of types supporting primitive array operations+-- that are not necessarily aligned. The offsets for all+-- of the typeclass methods are interpreted as bytes,+-- not elements.+class PrimUnaligned a where+  indexUnalignedByteArray# :: +    ByteArray# -> Int# -> a+  readUnalignedByteArray# :: +       MutableByteArray# s+    -> Int#+    -> State# s+    -> (# State# s, a #)+  writeUnalignedByteArray# :: +       MutableByteArray# s+    -> Int#+    -> a+    -> State# s+    -> State# s++instance PrimUnaligned Word8 where+  indexUnalignedByteArray# = PM.indexByteArray#+  readUnalignedByteArray# = PM.readByteArray#+  writeUnalignedByteArray# = PM.writeByteArray#++instance PrimUnaligned Word16 where+  {-# inline indexUnalignedByteArray# #-}+  {-# inline readUnalignedByteArray# #-}+  {-# inline writeUnalignedByteArray# #-}+  indexUnalignedByteArray# a i =+    W16# (E.indexWord8ArrayAsWord16# a i)+  readUnalignedByteArray# a i s0 =+    case E.readWord8ArrayAsWord16# a i s0 of+      (# s1, r #) -> (# s1, W16# r #)+  writeUnalignedByteArray# a i (W16# w) =+    E.writeWord8ArrayAsWord16# a i w++instance PrimUnaligned Word32 where+  {-# inline indexUnalignedByteArray# #-}+  {-# inline readUnalignedByteArray# #-}+  {-# inline writeUnalignedByteArray# #-}+  indexUnalignedByteArray# a i =+    W32# (E.indexWord8ArrayAsWord32# a i)+  readUnalignedByteArray# a i s0 =+    case E.readWord8ArrayAsWord32# a i s0 of+      (# s1, r #) -> (# s1, W32# r #)+  writeUnalignedByteArray# a i (W32# w) =+    E.writeWord8ArrayAsWord32# a i w++instance PrimUnaligned Word where+  {-# inline indexUnalignedByteArray# #-}+  {-# inline readUnalignedByteArray# #-}+  {-# inline writeUnalignedByteArray# #-}+  indexUnalignedByteArray# a i =+    W# (E.indexWord8ArrayAsWord# a i)+  readUnalignedByteArray# a i s0 =+    case E.readWord8ArrayAsWord# a i s0 of+      (# s1, r #) -> (# s1, W# r #)+  writeUnalignedByteArray# a i (W# w) =+    E.writeWord8ArrayAsWord# a i w++instance PrimUnaligned Word64 where+  {-# inline indexUnalignedByteArray# #-}+  {-# inline readUnalignedByteArray# #-}+  {-# inline writeUnalignedByteArray# #-}+  indexUnalignedByteArray# = M.indexUnalignedWord64Array#+  readUnalignedByteArray# = M.readUnalignedWord64Array#+  writeUnalignedByteArray# = M.writeUnalignedWord64Array#++instance PrimUnaligned Int8 where+  indexUnalignedByteArray# = PM.indexByteArray#+  readUnalignedByteArray# = PM.readByteArray#+  writeUnalignedByteArray# = PM.writeByteArray#++instance PrimUnaligned Int16 where+  {-# inline indexUnalignedByteArray# #-}+  {-# inline readUnalignedByteArray# #-}+  {-# inline writeUnalignedByteArray# #-}+  indexUnalignedByteArray# a i =+    I16# (E.indexWord8ArrayAsInt16# a i)+  readUnalignedByteArray# a i s0 =+    case E.readWord8ArrayAsInt16# a i s0 of+      (# s1, r #) -> (# s1, I16# r #)+  writeUnalignedByteArray# a i (I16# w) =+    E.writeWord8ArrayAsInt16# a i w++instance PrimUnaligned Int32 where+  {-# inline indexUnalignedByteArray# #-}+  {-# inline readUnalignedByteArray# #-}+  {-# inline writeUnalignedByteArray# #-}+  indexUnalignedByteArray# a i =+    I32# (E.indexWord8ArrayAsInt32# a i)+  readUnalignedByteArray# a i s0 =+    case E.readWord8ArrayAsInt32# a i s0 of+      (# s1, r #) -> (# s1, I32# r #)+  writeUnalignedByteArray# a i (I32# w) =+    E.writeWord8ArrayAsInt32# a i w++instance PrimUnaligned Int where+  {-# inline indexUnalignedByteArray# #-}+  {-# inline readUnalignedByteArray# #-}+  {-# inline writeUnalignedByteArray# #-}+  indexUnalignedByteArray# a i =+    I# (E.indexWord8ArrayAsInt# a i)+  readUnalignedByteArray# a i s0 =+    case E.readWord8ArrayAsInt# a i s0 of+      (# s1, r #) -> (# s1, I# r #)+  writeUnalignedByteArray# a i (I# w) =+    E.writeWord8ArrayAsInt# a i w++instance PrimUnaligned Int64 where+  {-# inline indexUnalignedByteArray# #-}+  {-# inline readUnalignedByteArray# #-}+  {-# inline writeUnalignedByteArray# #-}+  indexUnalignedByteArray# = M.indexUnalignedInt64Array#+  readUnalignedByteArray# = M.readUnalignedInt64Array#+  writeUnalignedByteArray# = M.writeUnalignedInt64Array#++instance PrimUnaligned Char where+  {-# inline indexUnalignedByteArray# #-}+  {-# inline readUnalignedByteArray# #-}+  {-# inline writeUnalignedByteArray# #-}+  indexUnalignedByteArray# a i =+    C# (E.indexWord8ArrayAsWideChar# a i)+  readUnalignedByteArray# a i s0 =+    case E.readWord8ArrayAsWideChar# a i s0 of+      (# s1, r #) -> (# s1, C# r #)+  writeUnalignedByteArray# a i (C# w) =+    E.writeWord8ArrayAsWideChar# a i w++instance PrimUnaligned Double where+  {-# inline indexUnalignedByteArray# #-}+  {-# inline readUnalignedByteArray# #-}+  {-# inline writeUnalignedByteArray# #-}+  indexUnalignedByteArray# a i =+    D# (E.indexWord8ArrayAsDouble# a i)+  readUnalignedByteArray# a i s0 =+    case E.readWord8ArrayAsDouble# a i s0 of+      (# s1, r #) -> (# s1, D# r #)+  writeUnalignedByteArray# a i (D# w) =+    E.writeWord8ArrayAsDouble# a i w++instance PrimUnaligned Float where+  {-# inline indexUnalignedByteArray# #-}+  {-# inline readUnalignedByteArray# #-}+  {-# inline writeUnalignedByteArray# #-}+  indexUnalignedByteArray# a i =+    F# (E.indexWord8ArrayAsFloat# a i)+  readUnalignedByteArray# a i s0 =+    case E.readWord8ArrayAsFloat# a i s0 of+      (# s1, r #) -> (# s1, F# r #)+  writeUnalignedByteArray# a i (F# w) =+    E.writeWord8ArrayAsFloat# a i w++instance PrimUnaligned (Ptr a) where+  {-# inline indexUnalignedByteArray# #-}+  {-# inline readUnalignedByteArray# #-}+  {-# inline writeUnalignedByteArray# #-}+  indexUnalignedByteArray# a i =+    Ptr (E.indexWord8ArrayAsAddr# a i)+  readUnalignedByteArray# a i s0 =+    case E.readWord8ArrayAsAddr# a i s0 of+      (# s1, r #) -> (# s1, Ptr r #)+  writeUnalignedByteArray# a i (Ptr w) =+    E.writeWord8ArrayAsAddr# a i w++deriving newtype instance PrimUnaligned P.CCc+deriving newtype instance PrimUnaligned C.CChar+deriving newtype instance PrimUnaligned P.CDev+deriving newtype instance PrimUnaligned C.CDouble+deriving newtype instance PrimUnaligned P.CGid+deriving newtype instance PrimUnaligned P.CIno+deriving newtype instance PrimUnaligned C.CInt+deriving newtype instance PrimUnaligned C.CLLong+deriving newtype instance PrimUnaligned C.CLong+deriving newtype instance PrimUnaligned P.CMode+deriving newtype instance PrimUnaligned P.CNlink+deriving newtype instance PrimUnaligned P.COff+deriving newtype instance PrimUnaligned P.CPid+deriving newtype instance PrimUnaligned C.CSChar+deriving newtype instance PrimUnaligned P.CSsize+deriving newtype instance PrimUnaligned C.CShort+deriving newtype instance PrimUnaligned C.CUInt+deriving newtype instance PrimUnaligned C.CULLong+deriving newtype instance PrimUnaligned C.CULong+deriving newtype instance PrimUnaligned P.CUid+deriving newtype instance PrimUnaligned P.Fd++-- | Read a primitive value from the byte array.+-- The offset is given in bytes rather than in elements+-- of type @a@.+indexUnalignedByteArray ::+     PrimUnaligned a+  => ByteArray -- ^ Immutable array+  -> Int -- ^ Offset in bytes+  -> a+indexUnalignedByteArray (ByteArray a) (I# i) =+  indexUnalignedByteArray# a i++-- | Read a primitive value from the byte array.+-- The offset is given in bytes rather than in elements+-- of type @a@.+readUnalignedByteArray ::+     (PrimMonad m, PrimUnaligned a)+  => MutableByteArray (PrimState m) -- ^ Mutable array+  -> Int -- ^ Offset in bytes+  -> m a+readUnalignedByteArray (MutableByteArray a) (I# i) =+  primitive (readUnalignedByteArray# a i)++-- | Write a primitive value to the byte array.+-- The offset is given in bytes rather than in elements+-- of type @a@.+writeUnalignedByteArray ::+     (PrimMonad m, PrimUnaligned a)+  => MutableByteArray (PrimState m) -- ^ Mutable array+  -> Int -- ^ Offset in bytes+  -> a -- ^ Element+  -> m ()+writeUnalignedByteArray (MutableByteArray a) (I# i) x =+  primitive_ (writeUnalignedByteArray# a i x)
+ test/Unit.hs view
@@ -0,0 +1,26 @@+{-# language BangPatterns #-}+{-# language ScopedTypeVariables #-}++import Control.Monad (when)+import Data.Word+import Data.Primitive.ByteArray+import Data.Primitive.ByteArray.Unaligned++main :: IO ()+main = do+  putStrLn "Start"+  putStrLn "A"+  testA+  putStrLn "Finished"++testA :: IO ()+testA = do+  let expected = 0x0123456789ABCDEF :: Word64+  marr <- newByteArray 16+  setByteArray marr 0 16 (0x00 :: Word8)+  writeUnalignedByteArray marr 3 expected+  actualX :: Word64 <- readUnalignedByteArray marr 3+  when (expected /= actualX) $ fail "testA"+  arr <- unsafeFreezeByteArray marr+  let actualY = indexUnalignedByteArray arr 3+  when (expected /= actualY) $ fail "testA"