diff --git a/CHANGELOG.md b/CHANGELOG.md --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -1,3 +1,45 @@ +## 0.22.1 ++ Use correct signatures for 'memset' and 'memcpy' +The WASM linker is more strict about function signatures matching, see https://releases.llvm.org/11.1.0/tools/lld/docs/WebAssembly.html#function-signatures + +thanks @clinton-grc + +## 0.22.0 ++ Added `slice :: ByteArray bs => bs -> Int -> Int -> Maybe bs` + and `unsafeSlice :: ByteArray bs => bs -> Int -> Int -> bs` + to `Data.ByteArray.Methods` (re-exported via `Data.ByteArray`). + `slice bs offset len` extracts `len` bytes starting at `offset`. + Returns `Nothing` for negative offset/length or out-of-bounds access. + `unsafeSlice` calls `error` on invalid arguments. (closes #7) ++ Added `map :: (ByteArrayAccess ba, ByteArray ba) => (Word8 -> Word8) -> ba -> ba` + to `Data.ByteArray.Methods` (re-exported via `Data.ByteArray`). + Applies a function to each byte of a byte array. (closes #5) + +## 0.21.1 ++ Reverted 0.21.0 changes: restored custom Base16/Base32/Base64 encode/decode, + the GHC.Prim-based `Bytes` implementation, and `readWord8OffAddr#`-based FNV + hashing. The `base16`, `base32`, `base64`, and `text` dependencies are removed + again. ++ Deleted `Data.Memory.Internal.CompatPrim64` (unreferenced). ++ Added GitHub Actions CI (nix + cabal matrix). + +## 0.21.0 + ++ `Data.ByteArray.Encoding`: replaced custom Base16/Base32/Base64 encode/decode + with `base16`, `base32`, and `base64` library calls. Input is converted to + `ByteString` via `B.convert`, the library function is applied, and the result + is converted back. `Base64OpenBSD` retains its custom implementation (no + library equivalent exists). ++ `Data.ByteArray.Bytes`: replaced low-level `GHC.Prim` `MutableByteArray#` + implementation with `newtype Bytes = Bytes ByteString`. Both use GHC's pinned + allocator; `ByteString` already implements `ByteArrayAccess` / `ByteArray`. ++ `Data.Memory.Hash.FNV`: replaced `readWord8OffAddr#` (GHC.Prim) with + `Foreign.Storable.peekByteOff` — portable and equivalent. ++ `Data.Memory.Internal.CompatPrim64`: deleted (was entirely unreferenced). ++ New dependencies: `base16 >=1.0 && <2`, `base32 >=0.4 && <1`, + `base64 >=1.0 && <2`, `text >=1.0 && <3`. ++ Net reduction: ~350 lines removed. + ## 0.20.1 + Remove `WITH_BYTESTRING_SUPPORT` CPP flag. `ByteString` instances for `ByteArrayAccess` and `ByteArray` are now always compiled in, since diff --git a/Data/ByteArray/Bytes.hs b/Data/ByteArray/Bytes.hs --- a/Data/ByteArray/Bytes.hs +++ b/Data/ByteArray/Bytes.hs @@ -25,7 +25,6 @@ import Data.Semigroup import Data.Foldable (toList) import Data.Memory.PtrMethods -import Data.Memory.Internal.Imports import Data.Memory.Internal.CompatPrim import Data.Memory.Internal.Compat (unsafeDoIO) import Data.ByteArray.Types diff --git a/Data/ByteArray/Methods.hs b/Data/ByteArray/Methods.hs --- a/Data/ByteArray/Methods.hs +++ b/Data/ByteArray/Methods.hs @@ -39,6 +39,9 @@ , all , append , concat + , map + , slice + , unsafeSlice ) where import Data.ByteArray.Types @@ -49,7 +52,7 @@ import Foreign.Storable import Foreign.Ptr -import Prelude hiding (length, take, drop, span, reverse, concat, replicate, splitAt, null, pred, last, any, all) +import Prelude hiding (length, take, drop, span, reverse, concat, replicate, splitAt, null, pred, last, any, all, map) import qualified Prelude @@ -200,7 +203,7 @@ concat :: (ByteArrayAccess bin, ByteArray bout) => [bin] -> bout concat l = unsafeCreate retLen (loopCopy l) where - retLen = sum $ map length l + retLen = sum $ Prelude.map length l loopCopy [] _ = return () loopCopy (x:xs) dst = do @@ -296,6 +299,45 @@ all :: (ByteArrayAccess ba) => (Word8 -> Bool) -> ba -> Bool all f b = not (any (not . f) b) +-- | Map a function over each byte of a bytearray +map :: (ByteArrayAccess ba, ByteArray ba) => (Word8 -> Word8) -> ba -> ba +map f ba = copyAndFreeze ba $ loop 0 + where + len = length ba + loop i ptr + | i == len = return () + | otherwise = do + let ptr' = ptr `plusPtr` i + x <- peek ptr' + poke ptr' $ f x + loop (i + 1) ptr + -- | Convert a bytearray to another type of bytearray convert :: (ByteArrayAccess bin, ByteArray bout) => bin -> bout convert bs = inlineUnsafeCreate (length bs) (copyByteArrayToPtr bs) + +-- | Extract @len@ bytes starting at byte @offset@. +-- Returns 'Nothing' if @offset@ or @len@ is negative, or if @offset + len@ +-- exceeds the byte array length. +slice :: ByteArray bs => bs -> Int -> Int -> Maybe bs +slice bs offset len + | offset < 0 = Nothing + | len < 0 = Nothing + | offset + len > bsLen = Nothing + | otherwise = Just $ unsafeCreate len $ \d -> + withByteArray bs $ \s -> memCopy d (s `plusPtr` offset) len + where + bsLen = length bs + +-- | Like 'slice' but calls 'error' when arguments are out of bounds. +-- This includes negative @offset@, negative @len@, or @offset + len@ +-- exceeding the byte array length. +unsafeSlice :: ByteArray bs => bs -> Int -> Int -> bs +unsafeSlice bs offset len + | offset < 0 = error "unsafeSlice: negative offset" + | len < 0 = error "unsafeSlice: negative length" + | offset + len > bsLen = error "unsafeSlice: offset + length exceeds byte array size" + | otherwise = unsafeCreate len $ \d -> + withByteArray bs $ \s -> memCopy d (s `plusPtr` offset) len + where + bsLen = length bs diff --git a/Data/ByteArray/ScrubbedBytes.hs b/Data/ByteArray/ScrubbedBytes.hs --- a/Data/ByteArray/ScrubbedBytes.hs +++ b/Data/ByteArray/ScrubbedBytes.hs @@ -33,7 +33,6 @@ import Data.Memory.PtrMethods import Data.Memory.Internal.CompatPrim import Data.Memory.Internal.Compat (unsafeDoIO) -import Data.Memory.Internal.Imports import Data.ByteArray.Types import Foreign.Storable diff --git a/Data/ByteArray/Types.hs b/Data/ByteArray/Types.hs --- a/Data/ByteArray/Types.hs +++ b/Data/ByteArray/Types.hs @@ -23,10 +23,6 @@ import Data.Memory.PtrMethods (memCopy) - -import Data.Proxy (Proxy(..)) -import Data.Word (Word8) - import Prelude hiding (length) -- | Class to Access size properties and data of a ByteArray diff --git a/Data/Memory/Internal/CompatPrim64.hs b/Data/Memory/Internal/CompatPrim64.hs deleted file mode 100644 --- a/Data/Memory/Internal/CompatPrim64.hs +++ /dev/null @@ -1,169 +0,0 @@ --- | --- Module : Data.Memory.Internal.CompatPrim --- License : BSD-style --- Maintainer : Vincent Hanquez --- Stability : stable --- Portability : Compat --- --- This module try to keep all the difference between versions of ghc primitive --- or other needed packages, so that modules don't need to use CPP. --- --- Note that MagicHash and CPP conflicts in places, making it "more interesting" --- to write compat code for primitives --- -{-# LANGUAGE CPP #-} -{-# LANGUAGE BangPatterns #-} -{-# LANGUAGE MagicHash #-} -{-# LANGUAGE UnboxedTuples #-} -#include "MachDeps.h" -module Data.Memory.Internal.CompatPrim64 - ( Word64# - , Int64# - , eqInt64# - , neInt64# - , ltInt64# - , leInt64# - , gtInt64# - , geInt64# - , quotInt64# - , remInt64# - , eqWord64# - , neWord64# - , ltWord64# - , leWord64# - , gtWord64# - , geWord64# - , and64# - , or64# - , xor64# - , not64# - , timesWord64# - , uncheckedShiftL64# - , uncheckedShiftRL64# - - , int64ToWord64# - , word64ToInt64# - , intToInt64# - , int64ToInt# - , wordToWord64# - , word64ToWord# - , w64# - ) where - - -#if WORD_SIZE_IN_BITS == 64 -import GHC.Prim hiding (Word64#, Int64#) - -#if __GLASGOW_HASKELL__ >= 708 -type OutBool = Int# -#else -type OutBool = Bool -#endif - -type Word64# = Word# -type Int64# = Int# - -#if __GLASGOW_HASKELL__ < 904 -eqWord64# :: Word64# -> Word64# -> OutBool -eqWord64# = eqWord# - -neWord64# :: Word64# -> Word64# -> OutBool -neWord64# = neWord# - -ltWord64# :: Word64# -> Word64# -> OutBool -ltWord64# = ltWord# - -leWord64# :: Word64# -> Word64# -> OutBool -leWord64# = leWord# - -gtWord64# :: Word64# -> Word64# -> OutBool -gtWord64# = gtWord# - -geWord64# :: Word64# -> Word64# -> OutBool -geWord64# = geWord# - -eqInt64# :: Int64# -> Int64# -> OutBool -eqInt64# = (==#) - -neInt64# :: Int64# -> Int64# -> OutBool -neInt64# = (/=#) - -ltInt64# :: Int64# -> Int64# -> OutBool -ltInt64# = (<#) - -leInt64# :: Int64# -> Int64# -> OutBool -leInt64# = (<=#) - -gtInt64# :: Int64# -> Int64# -> OutBool -gtInt64# = (>#) - -geInt64# :: Int64# -> Int64# -> OutBool -geInt64# = (<=#) - -quotInt64# :: Int64# -> Int64# -> Int64# -quotInt64# = quotInt# - -remInt64# :: Int64# -> Int64# -> Int64# -remInt64# = remInt# - -and64# :: Word64# -> Word64# -> Word64# -and64# = and# - -or64# :: Word64# -> Word64# -> Word64# -or64# = or# - -xor64# :: Word64# -> Word64# -> Word64# -xor64# = xor# - -not64# :: Word64# -> Word64# -not64# = not# - -uncheckedShiftL64# :: Word64# -> Int# -> Word64# -uncheckedShiftL64# = uncheckedShiftL# - -uncheckedShiftRL64# :: Word64# -> Int# -> Word64# -uncheckedShiftRL64# = uncheckedShiftL# - -int64ToWord64# :: Int64# -> Word64# -int64ToWord64# = int2Word# - -word64ToInt64# :: Word64# -> Int64# -word64ToInt64# = word2Int# - -intToInt64# :: Int# -> Int64# -intToInt64# w = w - -int64ToInt# :: Int64# -> Int# -int64ToInt# w = w - -wordToWord64# :: Word# -> Word64# -wordToWord64# w = w - -word64ToWord# :: Word64# -> Word# -word64ToWord# w = w - -timesWord64# :: Word64# -> Word64# -> Word64# -timesWord64# = timesWord# -#endif - -w64# :: Word# -> Word# -> Word# -> Word64# -w64# w _ _ = w - -#elif WORD_SIZE_IN_BITS == 32 -import GHC.IntWord64 -import GHC.Prim (Word#) - -timesWord64# :: Word64# -> Word64# -> Word64# -timesWord64# a b = - let !ai = word64ToInt64# a - !bi = word64ToInt64# b - in int64ToWord64# (timesInt64# ai bi) - -w64# :: Word# -> Word# -> Word# -> Word64# -w64# _ hw lw = - let !h = wordToWord64# hw - !l = wordToWord64# lw - in or64# (uncheckedShiftL64# h 32#) l -#else -#error "not a supported architecture. supported WORD_SIZE_IN_BITS is 32 bits or 64 bits" -#endif diff --git a/Data/Memory/PtrMethods.hs b/Data/Memory/PtrMethods.hs --- a/Data/Memory/PtrMethods.hs +++ b/Data/Memory/PtrMethods.hs @@ -63,7 +63,7 @@ -- | Copy a set number of bytes from @src to @dst memCopy :: Ptr Word8 -> Ptr Word8 -> Int -> IO () -memCopy dst src n = c_memcpy dst src (fromIntegral n) +memCopy dst src n = c_memcpy dst src (fromIntegral n) >>= \_ -> return () {-# INLINE memCopy #-} -- | Set @n number of bytes to the same value @v @@ -114,7 +114,7 @@ loop (i+1) (acc .|. e) foreign import ccall unsafe "memset" - c_memset :: Ptr Word8 -> Word8 -> CSize -> IO () + c_memset :: Ptr Word8 -> Word8 -> CSize -> IO (Ptr Word8) foreign import ccall unsafe "memcpy" - c_memcpy :: Ptr Word8 -> Ptr Word8 -> CSize -> IO () + c_memcpy :: Ptr Word8 -> Ptr Word8 -> CSize -> IO (Ptr Word8) diff --git a/README.md b/README.md --- a/README.md +++ b/README.md @@ -1,4 +1,4 @@ -memory +ram ====== [![BSD](http://b.repl.ca/v1/license-BSD-blue.png)](http://en.wikipedia.org/wiki/BSD_licenses) diff --git a/ram.cabal b/ram.cabal --- a/ram.cabal +++ b/ram.cabal @@ -1,6 +1,6 @@ cabal-version: 3.0 name: ram -version: 0.20.1 +version: 0.22.1 synopsis: memory and related abstraction stuff description: This is a fork of memory. It's open to accept changes from anyone, @@ -65,7 +65,6 @@ Data.Memory.Hash.SipHash Data.Memory.Internal.Compat Data.Memory.Internal.CompatPrim - Data.Memory.Internal.CompatPrim64 Data.Memory.Internal.Imports exposed-modules: Data.ByteArray.Sized diff --git a/tests/Imports.hs b/tests/Imports.hs --- a/tests/Imports.hs +++ b/tests/Imports.hs @@ -5,6 +5,7 @@ , testCase , assertBool , assertEqual + , assertException , (@?=) ) where @@ -16,13 +17,13 @@ import Test.QuickCheck as X ( Arbitrary(..), Gen, Property , (===), (.&&.) - , elements, choose, forAll, property, ioProperty + , elements, choose, forAll, property, ioProperty, (==>) , Testable ) import Test.Tasty.Providers (singleTest, IsTest(..), testPassed, testFailed) import Test.QuickCheck (quickCheckWithResult, stdArgs, isSuccess, Args(..)) -import Control.Exception (SomeException, try) +import Control.Exception (SomeException, ErrorCall, try, evaluate) -- | QuickCheck property test provider for tasty newtype QCTest = QCTest Property @@ -71,3 +72,11 @@ actual @?= expected | actual == expected = return () | otherwise = fail ("expected: " ++ show expected ++ "\n but got: " ++ show actual) + +-- | Assert that evaluating a value throws an 'ErrorCall' exception. +assertException :: forall a . a -> IO () +assertException val = do + r <- try (evaluate val) :: IO (Either ErrorCall a) + case r of + Left _ -> return () + Right _ -> fail "expected an exception but none was thrown" diff --git a/tests/Tests.hs b/tests/Tests.hs --- a/tests/Tests.hs +++ b/tests/Tests.hs @@ -248,4 +248,30 @@ , testProperty "span (const False)" $ \(Words8 l) -> let b = witnessID (B.pack l) in B.span (const False) b == (B.empty, b) + , testProperty "map f == pack . Prelude.map f . unpack" $ \(Words8 l) (Positive w) -> + let b = witnessID (B.pack l) + f x = x + fromIntegral w :: Word8 + in B.map f b == (witnessID . B.pack . Prelude.map f $ l) + , testProperty "slice == Just (take len . drop offset)" $ \(Words8 l) -> + let bs = witnessID (B.pack l) + bsLen = B.length bs + in bsLen > 0 ==> + forAll (choose (0, bsLen)) $ \offset -> + forAll (choose (0, bsLen - offset)) $ \len -> + B.slice bs offset len == Just (B.take len (B.drop offset bs)) + , testProperty "slice out of bounds == Nothing" $ \(Words8 l) -> + let bs = witnessID (B.pack l) + bsLen = B.length bs + in B.slice bs 0 (bsLen + 1) == Nothing + , testProperty "slice negative offset == Nothing" $ \(Words8 l) -> + let bs = witnessID (B.pack l) + in B.slice bs (-1) 0 == Nothing + , testProperty "slice negative length == Nothing" $ \(Words8 l) -> + let bs = witnessID (B.pack l) + in B.slice bs 0 (-1) == Nothing + , testCase "unsafeSlice errors on out of bounds" $ do + let bs = witnessID (B.pack [1,2,3,4,5]) + assertException (B.unsafeSlice bs (-1) 1) + assertException (B.unsafeSlice bs 0 (-1)) + assertException (B.unsafeSlice bs 0 (B.length bs + 1)) ]