memory 0.14.11 → 0.14.12
raw patch · 6 files changed
+101/−11 lines, 6 filesPVP ok
version bump matches the API change (PVP)
API changes (from Hackage documentation)
+ Data.ByteArray: copyByteArrayToPtr :: ByteArrayAccess ba => ba -> Ptr p -> IO ()
Files
- CHANGELOG.md +6/−0
- Data/ByteArray/Methods.hs +15/−2
- Data/ByteArray/Types.hs +48/−7
- memory.cabal +2/−2
- tests/Tests.hs +15/−0
- tests/Utils.hs +15/−0
CHANGELOG.md view
@@ -1,3 +1,9 @@+## 0.14.12++* Optimise copy operations and convert+* Add instance of ByteArrayAccess and ByteArray for Block+* Add Block and UArray in memory's tests+ ## 0.14.11 * Fix issue in unBase64 with an empty bytestring that would cause a segfault
Data/ByteArray/Methods.hs view
@@ -5,6 +5,7 @@ -- Stability : stable -- Portability : Good --+{-# LANGUAGE CPP #-} {-# LANGUAGE BangPatterns #-} module Data.ByteArray.Methods ( alloc@@ -50,6 +51,12 @@ import Prelude hiding (length, take, drop, span, concat, replicate, splitAt, null, pred, last, any, all) import qualified Prelude +#if defined(WITH_BYTESTRING_SUPPORT) && defined(WITH_FOUNDATION_SUPPORT)+import qualified Data.ByteString as SPE (ByteString)+import qualified Basement.UArray as SPE (UArray)+import qualified Basement.Block as SPE (Block)+#endif+ -- | Allocate a new bytearray of specific size, and run the initializer on this memory alloc :: ByteArray ba => Int -> (Ptr p -> IO ()) -> IO ba alloc n f@@ -223,7 +230,7 @@ copyAndFreeze :: (ByteArrayAccess bs1, ByteArray bs2) => bs1 -> (Ptr p -> IO ()) -> bs2 copyAndFreeze bs f = inlineUnsafeCreate (length bs) $ \d -> do- withByteArray bs $ \s -> memCopy d s (length bs)+ copyByteArrayToPtr bs d f (castPtr d) {-# NOINLINE copyAndFreeze #-} @@ -290,4 +297,10 @@ -- | Convert a bytearray to another type of bytearray convert :: (ByteArrayAccess bin, ByteArray bout) => bin -> bout-convert = flip copyAndFreeze (\_ -> return ())+convert bs = inlineUnsafeCreate (length bs) (copyByteArrayToPtr bs)+#if defined(WITH_BYTESTRING_SUPPORT) && defined(WITH_FOUNDATION_SUPPORT)+{-# SPECIALIZE convert :: SPE.ByteString -> SPE.UArray Word8 #-}+{-# SPECIALIZE convert :: SPE.ByteString -> SPE.Block Word8 #-}+{-# SPECIALIZE convert :: SPE.UArray Word8 -> SPE.ByteString #-}+{-# SPECIALIZE convert :: SPE.Block Word8 -> SPE.ByteString #-}+#endif
Data/ByteArray/Types.hs view
@@ -37,6 +37,14 @@ import qualified Basement.String as Base (String, toBytes, Encoding(UTF8)) import qualified Basement.PrimType as Base (primSizeInBytes) +import Data.Memory.PtrMethods (memCopy)++#if MIN_VERSION_basement(0,0,5)+import qualified Basement.UArray.Mutable as BaseMutable (withMutablePtrHint, copyToPtr)+import qualified Basement.Block as Block+import qualified Basement.Block.Mutable as Block+#endif+ #ifdef LEGACY_FOUNDATION_SUPPORT import qualified Foundation as F@@ -49,12 +57,17 @@ #endif +import Prelude hiding (length)+ -- | Class to Access size properties and data of a ByteArray class ByteArrayAccess ba where -- | Return the length in bytes of a bytearray length :: ba -> Int -- | Allow to use using a pointer withByteArray :: ba -> (Ptr p -> IO a) -> IO a+ -- | Copy the data of a bytearray to a ptr+ copyByteArrayToPtr :: ba -> Ptr p -> IO ()+ copyByteArrayToPtr a dst = withByteArray a $ \src -> memCopy (castPtr dst) src (length a) -- | Class to allocate new ByteArray of specific size class (Eq ba, Ord ba, Monoid ba, ByteArrayAccess ba) => ByteArray ba where@@ -79,12 +92,27 @@ #ifdef WITH_FOUNDATION_SUPPORT +#if MIN_VERSION_basement(0,0,5)+baseBlockRecastW8 :: Base.PrimType ty => Block.Block ty -> Block.Block Word8+baseBlockRecastW8 = Block.unsafeCast -- safe with Word8 destination++instance Base.PrimType ty => ByteArrayAccess (Block.Block ty) where+ length a = let Base.CountOf i = Block.length (baseBlockRecastW8 a) in i+ withByteArray a f = Block.withPtr (baseBlockRecastW8 a) (f . castPtr)+ copyByteArrayToPtr ba dst = do+ mb <- Block.unsafeThaw (baseBlockRecastW8 ba)+ Block.copyToPtr mb 0 (castPtr dst) (Block.length $ baseBlockRecastW8 ba)+#endif+ baseUarrayRecastW8 :: Base.PrimType ty => Base.UArray ty -> Base.UArray Word8 baseUarrayRecastW8 = Base.recast instance Base.PrimType ty => ByteArrayAccess (Base.UArray ty) where length a = let Base.CountOf i = Base.length (baseUarrayRecastW8 a) in i withByteArray a f = Base.withPtr (baseUarrayRecastW8 a) (f . castPtr)+#if MIN_VERSION_basement(0,0,5)+ copyByteArrayToPtr ba dst = Base.copyToPtr ba (castPtr dst)+#endif instance ByteArrayAccess Base.String where length str = let Base.CountOf i = Base.length bytes in i@@ -95,19 +123,32 @@ bytes = Base.toBytes Base.UTF8 str withByteArray s f = withByteArray (Base.toBytes Base.UTF8 s) f +#if MIN_VERSION_basement(0,0,5)+instance (Ord ty, Base.PrimType ty) => ByteArray (Block.Block ty) where+ allocRet sz f = do+ mba <- Block.new $ sizeRecastBytes sz Proxy+ a <- Block.withMutablePtrHint True False mba (f . castPtr)+ ba <- Block.unsafeFreeze mba+ return (a, ba)+#endif+ instance (Ord ty, Base.PrimType ty) => ByteArray (Base.UArray ty) where allocRet sz f = do mba <- Base.new $ sizeRecastBytes sz Proxy+#if MIN_VERSION_basement(0,0,5)+ a <- BaseMutable.withMutablePtrHint True False mba (f . castPtr)+#else a <- Base.withMutablePtr mba (f . castPtr)+#endif ba <- Base.unsafeFreeze mba return (a, ba)- where- sizeRecastBytes :: Base.PrimType ty => Int -> Proxy ty -> Base.CountOf ty- sizeRecastBytes w p = Base.CountOf $- let (q,r) = w `Prelude.quotRem` szTy- in q + (if r == 0 then 0 else 1)- where !(Base.CountOf szTy) = Base.primSizeInBytes p- {-# INLINE [1] sizeRecastBytes #-}++sizeRecastBytes :: Base.PrimType ty => Int -> Proxy ty -> Base.CountOf ty+sizeRecastBytes w p = Base.CountOf $+ let (q,r) = w `Prelude.quotRem` szTy+ in q + (if r == 0 then 0 else 1)+ where !(Base.CountOf szTy) = Base.primSizeInBytes p+{-# INLINE [1] sizeRecastBytes #-} #ifdef LEGACY_FOUNDATION_SUPPORT
memory.cabal view
@@ -1,5 +1,5 @@ Name: memory-version: 0.14.11+version: 0.14.12 Synopsis: memory and related abstraction stuff Description: Chunk of memory, polymorphic byte array management and manipulation@@ -118,4 +118,4 @@ default-language: Haskell2010 if flag(support_foundation) CPP-options: -DWITH_FOUNDATION_SUPPORT- Build-depends: foundation >= 0.0.8+ Build-depends: basement, foundation >= 0.0.8
tests/Tests.hs view
@@ -16,9 +16,14 @@ #ifdef WITH_FOUNDATION_SUPPORT import qualified Foundation as F+import Basement.Block (Block)+import Basement.UArray (UArray) #endif data Backend = BackendByte | BackendScrubbedBytes+#ifdef WITH_FOUNDATION_SUPPORT+ | BackendBlock | BackendUArray+#endif deriving (Show,Eq,Bounded,Enum) allBackends :: [Backend]@@ -32,6 +37,10 @@ case backend of BackendByte -> ArbitraryBS `fmap` ((B.pack `fmap` replicateM n arbitrary) :: Gen Bytes) BackendScrubbedBytes -> ArbitraryBS `fmap` ((B.pack `fmap` replicateM n arbitrary) :: Gen ScrubbedBytes)+#ifdef WITH_FOUNDATION_SUPPORT+ BackendBlock -> ArbitraryBS `fmap` ((B.pack `fmap` replicateM n arbitrary) :: Gen (Block Word8))+ BackendUArray -> ArbitraryBS `fmap` ((B.pack `fmap` replicateM n arbitrary) :: Gen (UArray Word8))+#endif arbitraryBSof :: Int -> Int -> Gen ArbitraryBS arbitraryBSof minBytes maxBytes = choose (minBytes, maxBytes) >>= arbitraryBS@@ -56,6 +65,12 @@ testGroup x [ testGroup "Bytes" (l withBytesWitness) , testGroup "ScrubbedBytes" (l withScrubbedBytesWitness)+#ifdef WITH_FOUNDATION_SUPPORT+#if MIN_VERSION_basement(0,0,5)+ , testGroup "Block" (l withBlockWitness)+#endif+ , testGroup "UArray" (l withBlockWitness)+#endif ] testShowProperty :: Testable a
tests/Utils.hs view
@@ -1,8 +1,15 @@+{-# LANGUAGE CPP #-} module Utils where import Data.Word import Data.ByteArray (Bytes, ScrubbedBytes) +#ifdef WITH_FOUNDATION_SUPPORT+import qualified Foundation as F+import Basement.Block (Block)+import Basement.UArray (UArray)+#endif+ unS :: String -> [Word8] unS = map (fromIntegral . fromEnum) @@ -20,6 +27,14 @@ withScrubbedBytesWitness :: ScrubbedBytes -> ScrubbedBytes withScrubbedBytesWitness = id++#ifdef WITH_FOUNDATION_SUPPORT+withBlockWitness :: Block Word8 -> Block Word8+withBlockWitness = withWitness (Witness :: Witness (Block Word8))++withUArrayWitness :: UArray Word8 -> UArray Word8+withUArrayWitness = withWitness (Witness :: Witness (UArray Word8))+#endif numberedList :: [a] -> [(Int, a)] numberedList = zip [1..]