memory 0.15.0 → 0.18.0
raw patch · 19 files changed
Files
- CHANGELOG.md +7/−0
- Data/ByteArray/Bytes.hs +27/−19
- Data/ByteArray/Encoding.hs +7/−0
- Data/ByteArray/MemView.hs +1/−1
- Data/ByteArray/Pack/Internal.hs +1/−1
- Data/ByteArray/Parse.hs +2/−2
- Data/ByteArray/ScrubbedBytes.hs +31/−20
- Data/ByteArray/Sized.hs +1/−1
- Data/ByteArray/Types.hs +0/−5
- Data/Memory/Encoding/Base16.hs +21/−16
- Data/Memory/Encoding/Base32.hs +16/−16
- Data/Memory/Encoding/Base64.hs +18/−21
- Data/Memory/Hash/FNV.hs +49/−49
- Data/Memory/Internal/CompatPrim.hs +0/−20
- Data/Memory/Internal/CompatPrim64.hs +2/−0
- Data/Memory/Internal/Imports.hs +1/−1
- Data/Memory/Internal/Scrubber.hs +0/−80
- Data/Memory/PtrMethods.hs +2/−4
- memory.cabal +8/−20
CHANGELOG.md view
@@ -1,3 +1,10 @@+## 0.18++* drop support for ghc < 8.8+* compat with ghc 9.4++## ...+ ## 0.14.18 * Branch/Release Snafu
Data/ByteArray/Bytes.hs view
@@ -16,6 +16,11 @@ ( Bytes ) where +#if MIN_VERSION_base(4,15,0)+import GHC.Exts (unsafeCoerce#)+#endif+import GHC.Word+import GHC.Char (chr) import GHC.Types import GHC.Prim import GHC.Ptr@@ -35,6 +40,7 @@ #ifdef MIN_VERSION_basement import Basement.NormalForm #endif+import Basement.IntegralConv -- | Simplest Byte Array data Bytes = Bytes (MutableByteArray# RealWorld)@@ -146,33 +152,35 @@ case readWord8Array# m1 i s of (# s', e1 #) -> case readWord8Array# m2 i s' of (# s'', e2 #) ->- if booleanPrim (eqWord# e1 e2)+ if (W8# e1) == (W8# 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+bytesCompare b1@(Bytes m1) b2@(Bytes m2) = unsafeDoIO $ loop 0 where- !l1 = bytesLength b1- !l2 = bytesLength b2- !(I# len) = min l1 l2+ !l1 = bytesLength b1+ !l2 = bytesLength b2+ !len = min l1 l2 - loop i s1- | booleanPrim (i ==# len) =+ loop !i+ | i == len = if l1 == l2- then (# s1, EQ #)- else if l1 > l2 then (# s1, GT #)- else (# s1, LT #)- | otherwise =- case readWord8Array# m1 i s1 of- (# s2, e1 #) -> case readWord8Array# m2 i s2 of- (# s3, e2 #) ->- if booleanPrim (eqWord# e1 e2)- then loop (i +# 1#) s3- else if booleanPrim (ltWord# e1 e2) then (# s3, LT #)- else (# s3, GT #)+ then pure EQ+ else if l1 > l2 then pure GT+ else pure LT+ | otherwise = do+ e1 <- read8 m1 i+ e2 <- read8 m2 i+ if e1 == e2+ then loop (i+1)+ else if e1 < e2 then pure LT+ else pure GT + read8 m (I# i) = IO $ \s -> case readWord8Array# m i s of+ (# s2, e #) -> (# s2, W8# e #)+ bytesUnpackChars :: Bytes -> String -> String bytesUnpackChars (Bytes mba) xs = chunkLoop 0# where@@ -199,7 +207,7 @@ rChar :: Int# -> IO Char rChar idx = IO $ \s -> case readWord8Array# mba idx s of- (# s2, w #) -> (# s2, C# (chr# (word2Int# w)) #)+ (# s2, w #) -> (# s2, chr (integralUpsize (W8# w)) #) {- bytesShowHex :: Bytes -> String
Data/ByteArray/Encoding.hs view
@@ -33,6 +33,13 @@ -- encoding is often used in other specifications without -- <http://tools.ietf.org/html/rfc4648#section-3.2 padding> characters. --+-- <https://www.ietf.org/rfc/rfc2045.txt RFC 2045>+-- defines a separate Base64 encoding, which is not supported. This format+-- requires a newline at least every 76 encoded characters, which works around+-- limitations of older email programs that could not handle long lines.+-- Be aware that other languages, such as Ruby, encode the RFC 2045 version+-- by default. To decode their output, remove all newlines before decoding.+-- -- ==== Examples -- -- A quick example to show the differences:
Data/ByteArray/MemView.hs view
@@ -32,7 +32,7 @@ -- | Increase the memory view while reducing the size of the window ----- this is useful as an abtraction to represent the current offset+-- this is useful as an abstraction to represent the current offset -- in a buffer, and the remaining bytes left. memViewPlus :: MemView -> Int -> MemView memViewPlus (MemView p len) n = MemView (p `plusPtr` n) (len - n)
Data/ByteArray/Pack/Internal.hs view
@@ -38,7 +38,7 @@ (<*>) = appendPacker instance Monad Packer where- return = returnPacker+ return = pure (>>=) = bindPacker fmapPacker :: (a -> b) -> Packer a -> Packer b
Data/ByteArray/Parse.hs view
@@ -82,13 +82,13 @@ fmap f p = Parser $ \buf err ok -> runParser p buf err (\b a -> ok b (f a)) instance Applicative (Parser byteArray) where- pure = return+ pure v = Parser $ \buf _ ok -> ok buf v (<*>) d e = d >>= \b -> e >>= \a -> return (b a) instance Monad (Parser byteArray) where #if !(MIN_VERSION_base(4,13,0)) fail = Fail.fail #endif- return v = Parser $ \buf _ ok -> ok buf v+ return = pure m >>= k = Parser $ \buf err ok -> runParser m buf err (\buf' a -> runParser (k a) buf' err ok) instance Fail.MonadFail (Parser byteArray) where
Data/ByteArray/ScrubbedBytes.hs view
@@ -17,6 +17,10 @@ import GHC.Types import GHC.Prim import GHC.Ptr+import GHC.Word+#if MIN_VERSION_base(4,15,0)+import GHC.Exts (unsafeCoerce#)+#endif #if MIN_VERSION_base(4,9,0) import Data.Semigroup import Data.Foldable (toList)@@ -25,11 +29,10 @@ #endif import Data.String (IsString(..)) import Data.Typeable-import Data.Memory.PtrMethods (memCopy, memConstEqual)+import Data.Memory.PtrMethods import Data.Memory.Internal.CompatPrim import Data.Memory.Internal.Compat (unsafeDoIO) import Data.Memory.Internal.Imports-import Data.Memory.Internal.Scrubber (getScrubber) import Data.ByteArray.Types import Foreign.Storable #ifdef MIN_VERSION_basement@@ -90,11 +93,17 @@ | otherwise = IO $ \s -> case newAlignedPinnedByteArray# sz 8# s of (# s1, mbarr #) ->- let !scrubber = (getScrubber sz) (byteArrayContents# (unsafeCoerce# mbarr))+ let !scrubber = getScrubber (byteArrayContents# (unsafeCoerce# mbarr)) !mba = ScrubbedBytes mbarr in case mkWeak# mbarr () (finalize scrubber mba) s1 of (# s2, _ #) -> (# s2, mba #) where+ getScrubber :: Addr# -> State# RealWorld -> State# RealWorld+ getScrubber addr s =+ let IO scrubBytes = memSet (Ptr addr) 0 (I# sz)+ in case scrubBytes s of+ (# s', _ #) -> s'+ #if __GLASGOW_HASKELL__ >= 800 finalize :: (State# RealWorld -> State# RealWorld) -> ScrubbedBytes -> State# RealWorld -> (# State# RealWorld, () #) finalize scrubber mba@(ScrubbedBytes _) = \s1 ->@@ -164,26 +173,28 @@ l2 = sizeofScrubbedBytes b scrubbedBytesCompare :: ScrubbedBytes -> ScrubbedBytes -> Ordering-scrubbedBytesCompare b1@(ScrubbedBytes m1) b2@(ScrubbedBytes m2) = unsafeDoIO $ IO $ \s -> loop 0# s+scrubbedBytesCompare b1@(ScrubbedBytes m1) b2@(ScrubbedBytes m2) = unsafeDoIO $ loop 0 where- !l1 = sizeofScrubbedBytes b1- !l2 = sizeofScrubbedBytes b2- !(I# len) = min l1 l2+ !l1 = sizeofScrubbedBytes b1+ !l2 = sizeofScrubbedBytes b2+ !len = min l1 l2 - loop i s1- | booleanPrim (i ==# len) =+ loop !i+ | i == len = if l1 == l2- then (# s1, EQ #)- else if l1 > l2 then (# s1, GT #)- else (# s1, LT #)- | otherwise =- case readWord8Array# m1 i s1 of- (# s2, e1 #) -> case readWord8Array# m2 i s2 of- (# s3, e2 #) ->- if booleanPrim (eqWord# e1 e2)- then loop (i +# 1#) s3- else if booleanPrim (ltWord# e1 e2) then (# s3, LT #)- else (# s3, GT #)+ then pure EQ+ else if l1 > l2 then pure GT+ else pure LT+ | otherwise = do+ e1 <- read8 m1 i+ e2 <- read8 m2 i+ if e1 == e2+ then loop (i+1)+ else if e1 < e2 then pure LT+ else pure GT++ read8 m (I# i) = IO $ \s -> case readWord8Array# m i s of+ (# s2, e #) -> (# s2, W8# e #) scrubbedFromChar8 :: [Char] -> ScrubbedBytes scrubbedFromChar8 l = unsafeDoIO $ scrubbedBytesAlloc len (fill l)
Data/ByteArray/Sized.hs view
@@ -99,7 +99,7 @@ -- | Wrapper around any collection type with the size as type parameter -- newtype SizedByteArray (n :: Nat) ba = SizedByteArray { unSizedByteArray :: ba }- deriving (Eq, Show, Typeable, Ord, NormalForm, Semigroup, Monoid)+ deriving (Eq, Show, Typeable, Ord, NormalForm) -- | create a 'SizedByteArray' from the given 'ByteArrayAccess' if the -- size is the same as the target size.
Data/ByteArray/Types.hs view
@@ -28,15 +28,12 @@ import Data.Memory.PtrMethods (memCopy) -#ifdef WITH_BASEMENT_SUPPORT- import Data.Proxy (Proxy(..)) import Data.Word (Word8) import qualified Basement.Types.OffsetSize as Base import qualified Basement.UArray as Base import qualified Basement.String as Base (String, toBytes, Encoding(UTF8))-import qualified Basement.PrimType as Base (primSizeInBytes) import qualified Basement.UArray.Mutable as BaseMutable (withMutablePtrHint) import qualified Basement.Block as Block@@ -44,8 +41,6 @@ import Basement.Nat import qualified Basement.Sized.Block as BlockN--#endif import Prelude hiding (length)
Data/Memory/Encoding/Base16.hs view
@@ -23,10 +23,12 @@ import Data.Memory.Internal.Compat import Data.Word-import Data.Bits ((.|.))+import Basement.Bits+import Basement.IntegralConv import GHC.Prim import GHC.Types import GHC.Word+import GHC.Char (chr) import Control.Monad import Foreign.Storable import Foreign.Ptr (Ptr)@@ -42,7 +44,7 @@ doChunks ofs len | len < 4 = doUnique ofs len | otherwise = do- let !(W8# a, W8# b, W8# c, W8# d) = unsafeDoIO $ withPtr (read4 ofs)+ let !(a, b, c, d) = unsafeDoIO $ withPtr (read4 ofs) !(# w1, w2 #) = convertByte a !(# w3, w4 #) = convertByte b !(# w5, w6 #) = convertByte c@@ -54,7 +56,7 @@ doUnique ofs len | len == 0 = [] | otherwise =- let !(W8# b) = unsafeDoIO $ withPtr (byteIndex ofs)+ let !b = unsafeDoIO $ withPtr (byteIndex ofs) !(# w1, w2 #) = convertByte b in wToChar w1 : wToChar w2 : doUnique (ofs + 1) (len - 1) @@ -63,8 +65,8 @@ liftM4 (,,,) (byteIndex ofs p) (byteIndex (ofs+1) p) (byteIndex (ofs+2) p) (byteIndex (ofs+3) p) - wToChar :: Word# -> Char- wToChar w = toEnum (I# (word2Int# w))+ wToChar :: Word8 -> Char+ wToChar w = chr (integralUpsize w) byteIndex :: Int -> Ptr Word8 -> IO Word8 byteIndex i p = peekByteOff p i@@ -81,19 +83,20 @@ where loop i | i == n = return () | otherwise = do- (W8# w) <- peekByteOff bin i- let !(# w1, w2 #) = convertByte w- pokeByteOff bout (i * 2) (W8# w1)- pokeByteOff bout (i * 2 + 1) (W8# w2)+ !w <- peekByteOff bin i+ let !(# !w1, !w2 #) = convertByte w+ pokeByteOff bout (i * 2) w1+ pokeByteOff bout (i * 2 + 1) w2 loop (i+1) -- | Convert a value Word# to two Word#s containing -- the hexadecimal representation of the Word#-convertByte :: Word# -> (# Word#, Word# #)-convertByte b = (# r tableHi b, r tableLo b #)+convertByte :: Word8 -> (# Word8, Word8 #)+convertByte bwrap = (# r tableHi b, r tableLo b #) where- r :: Addr# -> Word# -> Word#- r table index = indexWord8OffAddr# table (word2Int# index)+ !(W# b) = integralUpsize bwrap+ r :: Addr# -> Word# -> Word8+ r table index = W8# (indexWord8OffAddr# table (word2Int# index)) !tableLo = "0123456789abcdef0123456789abcdef\@@ -131,8 +134,11 @@ then return $ Just i else pokeByteOff dst di (a .|. b) >> loop (di+1) (i+2) - rLo (W8# index) = W8# (indexWord8OffAddr# tableLo (word2Int# index))- rHi (W8# index) = W8# (indexWord8OffAddr# tableHi (word2Int# index))+ rLo, rHi :: Word8 -> Word8+ rLo index = W8# (indexWord8OffAddr# tableLo (word2Int# widx))+ where !(W# widx) = integralUpsize index+ rHi index = W8# (indexWord8OffAddr# tableHi (word2Int# widx))+ where !(W# widx) = integralUpsize index !tableLo = "\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\@@ -168,4 +174,3 @@ \\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\ \\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\ \\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff"#-
Data/Memory/Encoding/Base32.hs view
@@ -22,9 +22,9 @@ ) where import Data.Memory.Internal.Compat-import Data.Memory.Internal.CompatPrim import Data.Word-import Data.Bits ((.|.))+import Basement.Bits+import Basement.IntegralConv import GHC.Prim import GHC.Word import Control.Monad@@ -84,30 +84,31 @@ toBase32Per5Bytes :: (Word8, Word8, Word8, Word8, Word8) -> (Word8, Word8, Word8, Word8, Word8, Word8, Word8, Word8)-toBase32Per5Bytes (W8# i1, W8# i2, W8# i3, W8# i4, W8# i5) =+toBase32Per5Bytes (!i1, !i2, !i3, !i4, !i5) = (index o1, index o2, index o3, index o4, index o5, index o6, index o7, index o8) where -- 1111 1000 >> 3- !o1 = (uncheckedShiftRL# (and# i1 0xF8##) 3#)+ !o1 = (i1 .&. 0xF8) .>>. 3 -- 0000 0111 << 2 | 1100 0000 >> 6- !o2 = or# (uncheckedShiftL# (and# i1 0x07##) 2#) (uncheckedShiftRL# (and# i2 0xC0##) 6#)+ !o2 = ((i1 .&. 0x07) .<<. 2) .|. ((i2 .&. 0xC0) .>>. 6) -- 0011 1110 >> 1- !o3 = (uncheckedShiftRL# (and# i2 0x3E##) 1#)+ !o3 = ((i2 .&. 0x3E) .>>. 1) -- 0000 0001 << 4 | 1111 0000 >> 4- !o4 = or# (uncheckedShiftL# (and# i2 0x01##) 4#) (uncheckedShiftRL# (and# i3 0xF0##) 4#)+ !o4 = ((i2 .&. 0x01) .<<. 4) .|. ((i3 .&. 0xF0) .>>. 4) -- 0000 1111 << 1 | 1000 0000 >> 7- !o5 = or# (uncheckedShiftL# (and# i3 0x0F##) 1#) (uncheckedShiftRL# (and# i4 0x80##) 7#)+ !o5 = ( (i3 .&. 0x0F) .<<. 1) .|. ((i4 .&. 0x80) .>>. 7) -- 0111 1100 >> 2- !o6 = (uncheckedShiftRL# (and# i4 0x7C##) 2#)+ !o6 = (i4 .&. 0x7C) .>>. 2 -- 0000 0011 << 3 | 1110 0000 >> 5- !o7 = or# (uncheckedShiftL# (and# i4 0x03##) 3#) (uncheckedShiftRL# (and# i5 0xE0##) 5#)+ !o7 = ((i4 .&. 0x03) .<<. 3) .|. ((i5 .&. 0xE0) .>>. 5) -- 0001 1111- !o8 = ((and# i5 0x1F##))+ !o8 = i5 .&. 0x1F !set = "ABCDEFGHIJKLMNOPQRSTUVWXYZ234567"# - index :: Word# -> Word8- index idx = W8# (indexWord8OffAddr# set (word2Int# idx))+ index :: Word8 -> Word8+ index idx = W8# (indexWord8OffAddr# set (word2Int# widx))+ where !(W# widx) = integralUpsize idx -- | Get the length needed for the destination buffer for a base32 decoding. --@@ -234,9 +235,8 @@ in Right (o1, o2, o3, o4, o5) where rset :: Word8 -> Word8- rset (W8# w)- | booleanPrim (w `leWord#` 0xff##) = W8# (indexWord8OffAddr# rsetTable (word2Int# w))- | otherwise = 0xff+ rset w = W8# (indexWord8OffAddr# rsetTable (word2Int# widx))+ where !(W# widx) = integralUpsize w !rsetTable = "\xFF\xFF\xFF\xFF\xFF\xFF\xFF\xFF\xFF\xFF\xFF\xFF\xFF\xFF\xFF\xFF\ \\xFF\xFF\xFF\xFF\xFF\xFF\xFF\xFF\xFF\xFF\xFF\xFF\xFF\xFF\xFF\xFF\
Data/Memory/Encoding/Base64.hs view
@@ -26,11 +26,10 @@ , fromBase64OpenBSD ) where -import Control.Monad import Data.Memory.Internal.Compat-import Data.Memory.Internal.CompatPrim import Data.Memory.Internal.Imports-import Data.Bits ((.|.))+import Basement.Bits+import Basement.IntegralConv (integralUpsize) import GHC.Prim import GHC.Word import Foreign.Storable@@ -92,15 +91,16 @@ loop (i+3) (di+4) convert3 :: Addr# -> Word8 -> Word8 -> Word8 -> (Word8, Word8, Word8, Word8)-convert3 table (W8# a) (W8# b) (W8# c) =- let !w = narrow8Word# (uncheckedShiftRL# a 2#)- !x = or# (and# (uncheckedShiftL# a 4#) 0x30##) (uncheckedShiftRL# b 4#)- !y = or# (and# (uncheckedShiftL# b 2#) 0x3c##) (uncheckedShiftRL# c 6#)- !z = and# c 0x3f##+convert3 table !a !b !c =+ let !w = a .>>. 2+ !x = ((a .<<. 4) .&. 0x30) .|. (b .>>. 4)+ !y = ((b .<<. 2) .&. 0x3c) .|. (c .>>. 6)+ !z = c .&. 0x3f in (index w, index x, index y, index z) where- index :: Word# -> Word8- index idx = W8# (indexWord8OffAddr# table (word2Int# idx))+ index :: Word8 -> Word8+ index !idxb = W8# (indexWord8OffAddr# table (word2Int# idx))+ where !(W# idx) = integralUpsize idxb -- | Get the length needed for the destination buffer for a base64 decoding. --@@ -211,10 +211,9 @@ in Right (x,y,z) rsetURL :: Word8 -> Word8-rsetURL (W8# w)- | booleanPrim (w `leWord#` 0xff##) = W8# (indexWord8OffAddr# rsetTable (word2Int# w))- | otherwise = 0xff- where !rsetTable = "\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\+rsetURL !w = W8# (indexWord8OffAddr# rsetTable (word2Int# widx))+ where !(W# widx) = integralUpsize w+ !rsetTable = "\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\ \\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\ \\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x3e\xff\xff\ \\x34\x35\x36\x37\x38\x39\x3a\x3b\x3c\x3d\xff\xff\xff\xff\xff\xff\@@ -232,10 +231,9 @@ \\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff"# rsetOpenBSD :: Word8 -> Word8-rsetOpenBSD (W8# w)- | booleanPrim (w `leWord#` 0xff##) = W8# (indexWord8OffAddr# rsetTable (word2Int# w))- | otherwise = 0xff- where !rsetTable = "\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\+rsetOpenBSD !w = W8# (indexWord8OffAddr# rsetTable (word2Int# widx))+ where !(W# widx) = integralUpsize w+ !rsetTable = "\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\ \\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\ \\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x00\x01\ \\x36\x37\x38\x39\x3a\x3b\x3c\x3d\x3e\x3f\xff\xff\xff\xff\xff\xff\@@ -309,9 +307,8 @@ in Right (x,y,z) rset :: Word8 -> Word8- rset (W8# w)- | booleanPrim (w `leWord#` 0xff##) = W8# (indexWord8OffAddr# rsetTable (word2Int# w))- | otherwise = 0xff+ rset !w = W8# (indexWord8OffAddr# rsetTable (word2Int# widx))+ where !(W# widx) = integralUpsize w !rsetTable = "\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\ \\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\
Data/Memory/Hash/FNV.hs view
@@ -24,9 +24,9 @@ , fnv1a_64 ) where +import Basement.Bits+import Basement.IntegralConv import Data.Memory.Internal.Compat ()-import Data.Memory.Internal.CompatPrim-import Data.Memory.Internal.CompatPrim64 import Data.Memory.Internal.Imports import GHC.Word import GHC.Prim hiding (Word64#, Int64#)@@ -41,66 +41,66 @@ newtype FnvHash64 = FnvHash64 Word64 deriving (Show,Eq,Ord,NFData) +fnv1_32_Mix8 :: Word8 -> FnvHash32 -> FnvHash32+fnv1_32_Mix8 !w (FnvHash32 acc) = FnvHash32 ((0x01000193 * acc) .^. integralUpsize w)+{-# INLINE fnv1_32_Mix8 #-}++fnv1a_32_Mix8 :: Word8 -> FnvHash32 -> FnvHash32+fnv1a_32_Mix8 !w (FnvHash32 acc) = FnvHash32 (0x01000193 * (acc .^. integralUpsize w))+{-# INLINE fnv1a_32_Mix8 #-}++fnv1_64_Mix8 :: Word8 -> FnvHash64 -> FnvHash64+fnv1_64_Mix8 !w (FnvHash64 acc) = FnvHash64 ((0x100000001b3 * acc) .^. integralUpsize w)+{-# INLINE fnv1_64_Mix8 #-}++fnv1a_64_Mix8 :: Word8 -> FnvHash64 -> FnvHash64+fnv1a_64_Mix8 !w (FnvHash64 acc) = FnvHash64 (0x100000001b3 * (acc .^. integralUpsize w))+{-# INLINE fnv1a_64_Mix8 #-}+ -- | compute FNV1 (32 bit variant) of a raw piece of memory fnv1 :: Ptr Word8 -> Int -> IO FnvHash32-fnv1 (Ptr addr) (I# n) = IO $ \s -> loop 0x811c9dc5## 0# s+fnv1 (Ptr addr) n = loop (FnvHash32 0x811c9dc5) 0 where - loop :: Word# -> Int# -> State# s -> (# State# s, FnvHash32 #)- loop !acc i s- | booleanPrim (i ==# n) = (# s, FnvHash32 $ W32# (narrow32Word# acc) #)- | otherwise =- case readWord8OffAddr# addr i s of- (# s2, v #) ->- let !nacc = (0x01000193## `timesWord#` acc) `xor#` v- in loop nacc (i +# 1#) s2+ loop :: FnvHash32 -> Int -> IO FnvHash32+ loop !acc !i+ | i == n = pure $ acc+ | otherwise = do+ v <- read8 addr i+ loop (fnv1_32_Mix8 v acc) (i + 1) -- | compute FNV1a (32 bit variant) of a raw piece of memory fnv1a :: Ptr Word8 -> Int -> IO FnvHash32-fnv1a (Ptr addr) (I# n) = IO $ \s -> loop 0x811c9dc5## 0# s+fnv1a (Ptr addr) n = loop (FnvHash32 0x811c9dc5) 0 where - loop :: Word# -> Int# -> State# s -> (# State# s, FnvHash32 #)- loop !acc i s- | booleanPrim (i ==# n) = (# s, FnvHash32 $ W32# (narrow32Word# acc) #)- | otherwise =- case readWord8OffAddr# addr i s of- (# s2, v #) ->- let !nacc = 0x01000193## `timesWord#` (acc `xor#` v)- in loop nacc (i +# 1#) s2+ loop :: FnvHash32 -> Int -> IO FnvHash32+ loop !acc !i+ | i == n = pure $ acc+ | otherwise = do+ v <- read8 addr i+ loop (fnv1a_32_Mix8 v acc) (i + 1) -- | compute FNV1 (64 bit variant) of a raw piece of memory fnv1_64 :: Ptr Word8 -> Int -> IO FnvHash64-fnv1_64 (Ptr addr) (I# n) = IO $ \s -> loop fnv64Const 0# s+fnv1_64 (Ptr addr) n = loop (FnvHash64 0xcbf29ce484222325) 0 where - loop :: Word64# -> Int# -> State# s -> (# State# s, FnvHash64 #)- loop !acc i s- | booleanPrim (i ==# n) = (# s, FnvHash64 $ W64# acc #)- | otherwise =- case readWord8OffAddr# addr i s of- (# s2, v #) ->- let !nacc = (fnv64Prime `timesWord64#` acc) `xor64#` (wordToWord64# v)- in loop nacc (i +# 1#) s2-- fnv64Const :: Word64#- !fnv64Const = w64# 0xcbf29ce484222325## 0xcbf29ce4## 0x84222325##-- fnv64Prime :: Word64#- !fnv64Prime = w64# 0x100000001b3## 0x100## 0x000001b3##+ loop :: FnvHash64 -> Int -> IO FnvHash64+ loop !acc !i+ | i == n = pure $ acc+ | otherwise = do+ v <- read8 addr i+ loop (fnv1_64_Mix8 v acc) (i + 1) -- | compute FNV1a (64 bit variant) of a raw piece of memory fnv1a_64 :: Ptr Word8 -> Int -> IO FnvHash64-fnv1a_64 (Ptr addr) (I# n) = IO $ \s -> loop fnv64Const 0# s+fnv1a_64 (Ptr addr) n = loop (FnvHash64 0xcbf29ce484222325) 0 where - loop :: Word64# -> Int# -> State# s -> (# State# s, FnvHash64 #)- loop !acc i s- | booleanPrim (i ==# n) = (# s, FnvHash64 $ W64# acc #)- | otherwise =- case readWord8OffAddr# addr i s of- (# s2, v #) ->- let !nacc = fnv64Prime `timesWord64#` (acc `xor64#` wordToWord64# v)- in loop nacc (i +# 1#) s2-- fnv64Const :: Word64#- !fnv64Const = w64# 0xcbf29ce484222325## 0xcbf29ce4## 0x84222325##+ loop :: FnvHash64 -> Int -> IO FnvHash64+ loop !acc !i+ | i == n = pure $ acc+ | otherwise = do+ v <- read8 addr i+ loop (fnv1a_64_Mix8 v acc) (i + 1) - fnv64Prime :: Word64#- !fnv64Prime = w64# 0x100000001b3## 0x100## 0x000001b3##+read8 :: Addr# -> Int -> IO Word8+read8 addr (I# i) = IO $ \s -> case readWord8OffAddr# addr i s of+ (# s2, e #) -> (# s2, W8# e #)
Data/Memory/Internal/CompatPrim.hs view
@@ -14,13 +14,11 @@ {-# LANGUAGE CPP #-} {-# LANGUAGE BangPatterns #-} {-# LANGUAGE MagicHash #-}-{-# LANGUAGE UnboxedTuples #-} module Data.Memory.Internal.CompatPrim ( be32Prim , le32Prim , byteswap32Prim , booleanPrim- , eitherDivideBy8# ) where import GHC.Prim@@ -70,21 +68,3 @@ booleanPrim b = b #endif {-# INLINE booleanPrim #-}---- | Apply or or another function if 8 divides the number of bytes-eitherDivideBy8# :: Int# -- ^ number of bytes- -> (Int# -> a) -- ^ if it divided by 8, the argument is the number of 8 bytes words- -> (Int# -> a) -- ^ if it doesn't, just the number of bytes- -> a-#if __GLASGOW_HASKELL__ > 704-eitherDivideBy8# v f8 f1 =- let !(# q, r #) = quotRemInt# v 8#- in if booleanPrim (r ==# 0#)- then f8 q- else f1 v-#else-eitherDivideBy8# v f8 f1 =- if booleanPrim ((remInt# v 8#) ==# 0#)- then f8 (quotInt# v 8#)- else f1 v-#endif
Data/Memory/Internal/CompatPrim64.hs view
@@ -63,6 +63,7 @@ type Word64# = Word# type Int64# = Int# +#if __GLASGOW_HASKELL__ < 904 eqWord64# :: Word64# -> Word64# -> OutBool eqWord64# = eqWord# @@ -143,6 +144,7 @@ timesWord64# :: Word64# -> Word64# -> Word64# timesWord64# = timesWord#+#endif w64# :: Word# -> Word# -> Word# -> Word64# w64# w _ _ = w
Data/Memory/Internal/Imports.hs view
@@ -12,6 +12,6 @@ import Data.Word as X import Control.Applicative as X-import Control.Monad as X (forM, forM_, void)+import Control.Monad as X (forM, forM_, void, when) import Control.Arrow as X (first, second) import Data.Memory.Internal.DeepSeq as X
− Data/Memory/Internal/Scrubber.hs
@@ -1,80 +0,0 @@--- |--- Module : Data.Memory.Internal.Scrubber--- License : BSD-style--- Maintainer : Vincent Hanquez <vincent@snarc.org>--- Stability : stable--- Portability : Compat----{-# LANGUAGE CPP #-}-{-# LANGUAGE BangPatterns #-}-{-# LANGUAGE MagicHash #-}-{-# LANGUAGE UnboxedTuples #-}-#include "MachDeps.h"-module Data.Memory.Internal.Scrubber- ( getScrubber- ) where--import GHC.Prim-import Data.Memory.Internal.CompatPrim (booleanPrim)--getScrubber :: Int# -> (Addr# -> State# RealWorld -> State# RealWorld)-getScrubber sz - | booleanPrim (sz ==# 4#) = scrub4- | booleanPrim (sz ==# 8#) = scrub8- | booleanPrim (sz ==# 16#) = scrub16- | booleanPrim (sz ==# 32#) = scrub32- | 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- !s4 = writeWord32OffAddr# a 2# 0## s3- !s5 = writeWord32OffAddr# a 3# 0## s4- !s6 = writeWord32OffAddr# a 4# 0## s5- !s7 = writeWord32OffAddr# a 5# 0## s6- !s8 = writeWord32OffAddr# a 6# 0## s7- !s9 = writeWord32OffAddr# a 7# 0## s8- in s9- {-# INLINE scrub32 #-}-#endif--scrubBytes :: Int# -> Addr# -> State# RealWorld -> State# RealWorld-scrubBytes sz8 addr = \s -> loop sz8 addr s- where loop :: Int# -> Addr# -> State# RealWorld -> State# RealWorld- loop n a s- | booleanPrim (n ==# 0#) = s- | 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
@@ -53,13 +53,11 @@ | destination == source = loopInplace source bytes | otherwise = loop destination source bytes where- loop _ _ 0 = return ()- loop !d !s !n = do+ loop !d !s n = when (n > 0) $ do peek s >>= poke d . xor v loop (d `plusPtr` 1) (s `plusPtr` 1) (n-1) - loopInplace _ 0 = return ()- loopInplace !s !n = do+ loopInplace !s n = when (n > 0) $ do peek s >>= poke s . xor v loopInplace (s `plusPtr` 1) (n-1)
memory.cabal view
@@ -1,5 +1,5 @@ Name: memory-version: 0.15.0+version: 0.18.0 Synopsis: memory and related abstraction stuff Description: Chunk of memory, polymorphic byte array management and manipulation@@ -37,16 +37,6 @@ Default: True Manual: True -Flag support_foundation- Description: add support for foundation strings and unboxed array (deprecated use support_basement)- Default: True- Manual: True--Flag support_basement- Description: add support for foundation strings and unboxed array- Default: True- Manual: True- Flag support_deepseq Description: add deepseq instances for memory types Default: True@@ -70,7 +60,6 @@ Data.Memory.Internal.CompatPrim64 Data.Memory.Internal.DeepSeq Data.Memory.Internal.Imports- Data.Memory.Internal.Scrubber Data.Memory.Hash.SipHash Data.Memory.Hash.FNV Data.ByteArray.Pack.Internal@@ -80,7 +69,7 @@ Data.ByteArray.Methods Data.ByteArray.MemView Data.ByteArray.View- if impl(ghc < 8.0)+ if impl(ghc < 8.8) buildable: False else build-depends: base@@ -102,11 +91,11 @@ if flag(support_deepseq) CPP-options: -DWITH_DEEPSEQ_SUPPORT Build-depends: deepseq >= 1.1- if flag(support_foundation) || flag(support_basement)- CPP-options: -DWITH_BASEMENT_SUPPORT- Build-depends: basement >= 0.0.7- exposed-modules: Data.ByteArray.Sized + CPP-options: -DWITH_BASEMENT_SUPPORT+ Build-depends: basement >= 0.0.7+ exposed-modules: Data.ByteArray.Sized+ ghc-options: -Wall -fwarn-tabs default-language: Haskell2010 @@ -117,7 +106,7 @@ Other-modules: Imports SipHash Utils- if impl(ghc < 8.0)+ if impl(ghc < 8.8) buildable: False else build-depends: base@@ -127,8 +116,7 @@ , foundation ghc-options: -Wall -fno-warn-orphans -fno-warn-missing-signatures -threaded default-language: Haskell2010- if flag(support_foundation)- CPP-options: -DWITH_BASEMENT_SUPPORT+ CPP-options: -DWITH_BASEMENT_SUPPORT -- Test-Suite test-examples -- default-language: Haskell2010