packages feed

memory 0.14.1 → 0.14.2

raw patch · 9 files changed

+55/−24 lines, 9 filesdep ~base

Dependency ranges changed: base

Files

Data/ByteArray/Bytes.hs view
@@ -55,9 +55,11 @@  touchBytes :: Bytes -> IO () touchBytes (Bytes mba) = IO $ \s -> case touch# mba s of s' -> (# s', () #)+{-# INLINE touchBytes #-}  sizeofBytes :: Bytes -> Int sizeofBytes (Bytes mba) = I# (sizeofMutableByteArray# mba)+{-# INLINE sizeofBytes #-}  withPtr :: Bytes -> (Ptr p -> IO a) -> IO a withPtr b@(Bytes mba) f = do@@ -75,23 +77,23 @@ bytesConcat :: [Bytes] -> IO Bytes bytesConcat l = bytesAlloc retLen (copy l)   where-    retLen = sum $ map bytesLength l+    !retLen = sum $ map bytesLength l      copy []     _   = return ()     copy (x:xs) dst = do         withPtr x $ \src -> memCopy dst src chunkLen         copy xs (dst `plusPtr` chunkLen)       where-        chunkLen = bytesLength x+        !chunkLen = bytesLength x  bytesAppend :: Bytes -> Bytes -> IO Bytes bytesAppend b1 b2 = bytesAlloc retLen $ \dst -> do     withPtr b1 $ \s1 -> memCopy dst                  s1 len1     withPtr b2 $ \s2 -> memCopy (dst `plusPtr` len1) s2 len2   where-    len1   = bytesLength b1-    len2   = bytesLength b2-    retLen = len1 + len2+    !len1   = bytesLength b1+    !len2   = bytesLength b2+    !retLen = len1 + len2  bytesAllocRet :: Int -> (Ptr p -> IO a) -> IO (a, Bytes) bytesAllocRet sz f = do@@ -101,6 +103,7 @@  bytesLength :: Bytes -> Int bytesLength = sizeofBytes+{-# LANGUAGE bytesLength #-}  withBytes :: Bytes -> (Ptr p -> IO a) -> IO a withBytes = withPtr@@ -122,6 +125,7 @@                         if booleanPrim (eqWord# e1 e2)                             then loop (i +# 1#) s''                             else (# s', False #)+    {-# INLINE loop #-}  bytesCompare :: Bytes -> Bytes -> Ordering bytesCompare b1@(Bytes m1) b2@(Bytes m2) = unsafeDoIO $ IO $ \s -> loop 0# s
Data/ByteArray/Methods.hs view
@@ -55,6 +55,7 @@ alloc n f     | n < 0     = alloc 0 f     | otherwise = snd `fmap` allocRet n f+{-# INLINE alloc #-}  -- | Allocate a new bytearray of specific size, and run the initializer on this memory create :: ByteArray ba => Int -> (Ptr p -> IO ()) -> IO ba@@ -70,6 +71,10 @@ unsafeCreate sz f = unsafeDoIO (alloc sz f) {-# NOINLINE unsafeCreate #-} +inlineUnsafeCreate :: ByteArray a => Int -> (Ptr p -> IO ()) -> a+inlineUnsafeCreate !sz f = unsafeDoIO (alloc sz f)+{-# INLINE inlineUnsafeCreate #-}+ -- | Create an empty byte array empty :: ByteArray a => a empty = unsafeDoIO (alloc 0 $ \_ -> return ())@@ -80,9 +85,11 @@  -- | Pack a list of bytes into a bytearray pack :: ByteArray a => [Word8] -> a-pack l = unsafeCreate (Prelude.length l) (fill 0 l)-  where fill _ []     _ = return ()-        fill i (x:xs) p = pokeByteOff p i x >> fill (i+1) xs p+pack l = inlineUnsafeCreate (Prelude.length l) (fill l)+  where fill []     _  = return ()+        fill (x:xs) !p = poke p x >> fill xs (p `plusPtr` 1)+        {-# INLINE fill #-}+{-# NOINLINE pack #-}  -- | Un-pack a bytearray into a list of bytes unpack :: ByteArrayAccess a => a -> [Word8]@@ -156,8 +163,8 @@     | n <= 0    = empty     | otherwise = unsafeCreate m $ \d -> withByteArray bs $ \s -> memCopy d s m   where-    m   = min len n-    len = length bs+    !m   = min len n+    !len = length bs  -- | drop the first @n@ byte of a bytearray drop :: ByteArray bs => Int -> bs -> bs@@ -176,8 +183,10 @@     | null bs   = (bs, bs)     | otherwise = let n = loop 0 in (take n bs, drop n bs)   where loop !i+            | i >= len          = len             | pred (index bs i) = loop (i+1)             | otherwise         = i+        len = length bs  -- | Concatenate bytearray into a larger bytearray concat :: (ByteArrayAccess bin, ByteArray bout) => [bin] -> bout@@ -213,16 +222,17 @@ -- | Similiar to 'copy' but expect the resulting bytearray in a pure context copyAndFreeze :: (ByteArrayAccess bs1, ByteArray bs2) => bs1 -> (Ptr p -> IO ()) -> bs2 copyAndFreeze bs f =-    unsafeCreate (length bs) $ \d -> do+    inlineUnsafeCreate (length bs) $ \d -> do         withByteArray bs $ \s -> memCopy d s (length bs)         f (castPtr d)+{-# NOINLINE copyAndFreeze #-}  -- | Create a bytearray of a specific size containing a repeated byte value replicate :: ByteArray ba => Int -> Word8 -> ba replicate 0 _ = empty replicate n b     | n < 0     = empty-    | otherwise = unsafeCreate n $ \ptr -> memSet ptr b n+    | otherwise = inlineUnsafeCreate n $ \ptr -> memSet ptr b n {-# NOINLINE replicate #-}  -- | Create a bytearray of a specific size initialized to 0@@ -258,8 +268,8 @@     | l1 /= l2  = False     | otherwise = unsafeDoIO $ withByteArray b1 $ \p1 -> withByteArray b2 $ \p2 -> memConstEqual p1 p2 l1   where-    l1 = length b1-    l2 = length b2+    !l1 = length b1+    !l2 = length b2  -- | Check if any element of a byte array satisfies a predicate any :: (ByteArrayAccess ba) => (Word8 -> Bool) -> ba -> Bool
Data/ByteArray/ScrubbedBytes.hs view
@@ -73,12 +73,7 @@                  in case mkWeak# mbarr () (finalize scrubber mba) s1 of                     (# s2, _ #) -> (# s2, mba #)   where-#if __GLASGOW_HASKELL__ > 801-    finalize :: (State# RealWorld -> State# RealWorld) -> ScrubbedBytes -> State# RealWorld -> State# RealWorld-    finalize scrubber mba@(ScrubbedBytes _) = \s1 ->-        case scrubber s1 of-            s2 -> touch# mba s2-#elif __GLASGOW_HASKELL__ >= 800+#if __GLASGOW_HASKELL__ >= 800     finalize :: (State# RealWorld -> State# RealWorld) -> ScrubbedBytes -> State# RealWorld -> (# State# RealWorld, () #)     finalize scrubber mba@(ScrubbedBytes _) = \s1 ->         case scrubber s1 of
Data/ByteArray/Types.hs view
@@ -6,6 +6,7 @@ -- Portability : Good -- {-# LANGUAGE CPP #-}+{-# LANGUAGE BangPatterns #-} module Data.ByteArray.Types     ( ByteArrayAccess(..)     , ByteArray(..)@@ -34,8 +35,7 @@ #ifdef WITH_BYTESTRING_SUPPORT instance ByteArrayAccess B.ByteString where     length = B.length-    withByteArray b f = withForeignPtr fptr $ \ptr -> f (ptr `plusPtr` off)-      where (fptr, off, _) = B.toForeignPtr b+    withByteArray (B.PS fptr off _) f = withForeignPtr fptr $ \ptr -> f $! (ptr `plusPtr` off)  instance ByteArray B.ByteString where     allocRet sz f = do
Data/Memory/Internal/CompatPrim.hs view
@@ -69,6 +69,7 @@ booleanPrim :: Bool -> Bool booleanPrim b = b #endif+{-# INLINE booleanPrim #-}  -- | Apply or or another function if 8 divides the number of bytes eitherDivideBy8# :: Int#        -- ^ number of bytes
Data/Memory/Internal/Scrubber.hs view
@@ -26,29 +26,35 @@     | otherwise                = scrubBytes sz   where         scrub4 a = \s -> writeWord32OffAddr# a 0# 0## s+        {-# INLINE scrub4 #-} #if WORD_SIZE_IN_BITS == 64         scrub8 a = \s -> writeWord64OffAddr# a 0# 0## s+        {-# INLINE scrub8 #-}         scrub16 a = \s1 ->             let !s2 = writeWord64OffAddr# a 0# 0## s1                 !s3 = writeWord64OffAddr# a 1# 0## s2              in s3+        {-# INLINE scrub16 #-}         scrub32 a = \s1 ->             let !s2 = writeWord64OffAddr# a 0# 0## s1                 !s3 = writeWord64OffAddr# a 1# 0## s2                 !s4 = writeWord64OffAddr# a 2# 0## s3                 !s5 = writeWord64OffAddr# a 3# 0## s4              in s5+        {-# INLINE scrub32 #-} #else         scrub8 a = \s1 ->             let !s2 = writeWord32OffAddr# a 0# 0## s1                 !s3 = writeWord32OffAddr# a 1# 0## s2              in s3+        {-# INLINE scrub8 #-}         scrub16 a = \s1 ->             let !s2 = writeWord32OffAddr# a 0# 0## s1                 !s3 = writeWord32OffAddr# a 1# 0## s2                 !s4 = writeWord32OffAddr# a 2# 0## s3                 !s5 = writeWord32OffAddr# a 3# 0## s4              in s5+        {-# INLINE scrub16 #-}         scrub32 a = \s1 ->             let !s2 = writeWord32OffAddr# a 0# 0## s1                 !s3 = writeWord32OffAddr# a 1# 0## s2@@ -59,6 +65,7 @@                 !s8 = writeWord32OffAddr# a 6# 0## s7                 !s9 = writeWord32OffAddr# a 7# 0## s8              in s9+        {-# INLINE scrub32 #-} #endif  scrubBytes :: Int# -> Addr# -> State# RealWorld -> State# RealWorld@@ -69,3 +76,5 @@             | otherwise              =                 case writeWord8OffAddr# a 0# 0## s of                     s' -> loop (n -# 1#) (plusAddr# a 1#) s'+        {-# INLINE loop #-}+{-# INLINE scrubBytes #-}
Data/Memory/PtrMethods.hs view
@@ -59,10 +59,12 @@ -- | 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)+{-# INLINE memCopy #-}  -- | Set @n number of bytes to the same value @v memSet :: Ptr Word8 -> Word8 -> Int -> IO ()-memSet start v n = c_memset start (fromIntegral v) (fromIntegral n) >>= \_ -> return ()+memSet start v n = c_memset start v (fromIntegral n) >>= \_ -> return ()+{-# INLINE memSet #-}  -- | Check if two piece of memory are equals memEqual :: Ptr Word8 -> Ptr Word8 -> Int -> IO Bool
memory.cabal view
@@ -1,5 +1,5 @@ Name:                memory-Version:             0.14.1+Version:             0.14.2 Synopsis:            memory and related abstraction stuff Description:     Chunk of memory, polymorphic byte array management and manipulation
tests/Tests.hs view
@@ -202,4 +202,14 @@              in B.any p b1 == any p l         , testProperty "singleton b == pack [b]" $ \b ->             witnessID (B.singleton b) == B.pack [b]+        , testProperty "span" $ \x (Words8 l) ->+            let c = witnessID (B.pack l)+                (a, b) = B.span (== x) c+             in c == B.append a b+        , testProperty "span (const True)" $ \(Words8 l) ->+            let a = witnessID (B.pack l)+             in B.span (const True) a == (a, B.empty)+        , testProperty "span (const False)" $ \(Words8 l) ->+            let b = witnessID (B.pack l)+             in B.span (const False) b == (B.empty, b)         ]