diff --git a/Data/ByteArray/Bytes.hs b/Data/ByteArray/Bytes.hs index 5610fbe..16f8690 100644 --- a/Data/ByteArray/Bytes.hs +++ b/Data/ByteArray/Bytes.hs @@ -28,6 +28,7 @@ import Data.Foldable (toList) #else import Data.Monoid #endif +import Data.Memory.HeadHackageUtils import Data.Memory.PtrMethods import Data.Memory.Internal.Imports import Data.Memory.Internal.CompatPrim @@ -149,7 +150,7 @@ bytesEq b1@(Bytes m1) b2@(Bytes m2) case readWord8Array# m1 i s of (# s', e1 #) -> case readWord8Array# m2 i s' of (# s'', e2 #) -> - if booleanPrim (eqWord# e1 e2) + if booleanPrim (eqWord# (word8ToWordCompat# e1) (word8ToWordCompat# e2)) then loop (i +# 1#) s'' else (# s'', False #) {-# INLINE loop #-} @@ -171,9 +172,9 @@ bytesCompare b1@(Bytes m1) b2@(Bytes m2) = unsafeDoIO $ IO $ \s -> loop 0# s case readWord8Array# m1 i s1 of (# s2, e1 #) -> case readWord8Array# m2 i s2 of (# s3, e2 #) -> - if booleanPrim (eqWord# e1 e2) + if booleanPrim (eqWord# (word8ToWordCompat# e1) (word8ToWordCompat# e2)) then loop (i +# 1#) s3 - else if booleanPrim (ltWord# e1 e2) then (# s3, LT #) + else if booleanPrim (ltWord# (word8ToWordCompat# e1) (word8ToWordCompat# e2)) then (# s3, LT #) else (# s3, GT #) bytesUnpackChars :: Bytes -> String -> String @@ -202,7 +203,7 @@ bytesUnpackChars (Bytes mba) xs = chunkLoop 0# rChar :: Int# -> IO Char rChar idx = IO $ \s -> case readWord8Array# mba idx s of - (# s2, w #) -> (# s2, C# (chr# (word2Int# w)) #) + (# s2, w #) -> (# s2, C# (chr# (word2Int# (word8ToWordCompat# w))) #) {- bytesShowHex :: Bytes -> String diff --git a/Data/ByteArray/ScrubbedBytes.hs b/Data/ByteArray/ScrubbedBytes.hs index 41c7ca6..5c2ef60 100644 --- a/Data/ByteArray/ScrubbedBytes.hs +++ b/Data/ByteArray/ScrubbedBytes.hs @@ -28,6 +28,7 @@ import Data.Monoid #endif import Data.String (IsString(..)) import Data.Typeable +import Data.Memory.HeadHackageUtils import Data.Memory.PtrMethods import Data.Memory.Internal.CompatPrim import Data.Memory.Internal.Compat (unsafeDoIO) @@ -188,9 +189,9 @@ scrubbedBytesCompare b1@(ScrubbedBytes m1) b2@(ScrubbedBytes m2) = unsafeDoIO $ case readWord8Array# m1 i s1 of (# s2, e1 #) -> case readWord8Array# m2 i s2 of (# s3, e2 #) -> - if booleanPrim (eqWord# e1 e2) + if booleanPrim (eqWord# (word8ToWordCompat# e1) (word8ToWordCompat# e2)) then loop (i +# 1#) s3 - else if booleanPrim (ltWord# e1 e2) then (# s3, LT #) + else if booleanPrim (ltWord# (word8ToWordCompat# e1) (word8ToWordCompat# e2)) then (# s3, LT #) else (# s3, GT #) scrubbedFromChar8 :: [Char] -> ScrubbedBytes diff --git a/Data/Memory/Encoding/Base16.hs b/Data/Memory/Encoding/Base16.hs index fd230ec..8bd03a7 100644 --- a/Data/Memory/Encoding/Base16.hs +++ b/Data/Memory/Encoding/Base16.hs @@ -21,6 +21,7 @@ module Data.Memory.Encoding.Base16 , fromHexadecimal ) where +import Data.Memory.HeadHackageUtils import Data.Memory.Internal.Compat import Data.Word import Data.Bits ((.|.)) @@ -32,7 +33,7 @@ import Foreign.Storable import Foreign.Ptr (Ptr) -- | Transform a raw memory to an hexadecimal 'String' --- +-- -- user beware, no checks are made showHexadecimal :: (forall a . (Ptr Word8 -> IO a) -> IO a) -- ^ a 'with' type of function to hold reference to the object -> Int -- ^ length in bytes @@ -43,10 +44,10 @@ showHexadecimal withPtr = doChunks 0 | len < 4 = doUnique ofs len | otherwise = do let !(W8# a, W8# b, W8# c, W8# d) = unsafeDoIO $ withPtr (read4 ofs) - !(# w1, w2 #) = convertByte a - !(# w3, w4 #) = convertByte b - !(# w5, w6 #) = convertByte c - !(# w7, w8 #) = convertByte d + !(# w1, w2 #) = convertByte (word8ToWordCompat# a) + !(# w3, w4 #) = convertByte (word8ToWordCompat# b) + !(# w5, w6 #) = convertByte (word8ToWordCompat# c) + !(# w7, w8 #) = convertByte (word8ToWordCompat# d) in wToChar w1 : wToChar w2 : wToChar w3 : wToChar w4 : wToChar w5 : wToChar w6 : wToChar w7 : wToChar w8 : doChunks (ofs + 4) (len - 4) @@ -55,7 +56,7 @@ showHexadecimal withPtr = doChunks 0 | len == 0 = [] | otherwise = let !(W8# b) = unsafeDoIO $ withPtr (byteIndex ofs) - !(# w1, w2 #) = convertByte b + !(# w1, w2 #) = convertByte (word8ToWordCompat# b) in wToChar w1 : wToChar w2 : doUnique (ofs + 1) (len - 1) read4 :: Int -> Ptr Word8 -> IO (Word8, Word8, Word8, Word8) @@ -82,9 +83,9 @@ toHexadecimal bout bin n = loop 0 | 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) + let !(# w1, w2 #) = convertByte (word8ToWordCompat# w) + pokeByteOff bout (i * 2) (W8# (wordToWord8Compat# w1)) + pokeByteOff bout (i * 2 + 1) (W8# (wordToWord8Compat# w2)) loop (i+1) -- | Convert a value Word# to two Word#s containing @@ -93,7 +94,7 @@ convertByte :: Word# -> (# Word#, Word# #) convertByte b = (# r tableHi b, r tableLo b #) where r :: Addr# -> Word# -> Word# - r table index = indexWord8OffAddr# table (word2Int# index) + r table index = word8ToWordCompat# (indexWord8OffAddr# table (word2Int# index)) !tableLo = "0123456789abcdef0123456789abcdef\ @@ -131,9 +132,9 @@ fromHexadecimal dst src n 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 (W8# index) = W8# (indexWord8OffAddr# tableLo (word2Int# (word8ToWordCompat# index))) + rHi (W8# index) = W8# (indexWord8OffAddr# tableHi (word2Int# (word8ToWordCompat# index))) + !tableLo = "\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\ diff --git a/Data/Memory/Encoding/Base32.hs b/Data/Memory/Encoding/Base32.hs index 9f492a2..947c658 100644 --- a/Data/Memory/Encoding/Base32.hs +++ b/Data/Memory/Encoding/Base32.hs @@ -21,6 +21,7 @@ module Data.Memory.Encoding.Base32 , fromBase32 ) where +import Data.Memory.HeadHackageUtils import Data.Memory.Internal.Compat import Data.Memory.Internal.CompatPrim import Data.Word @@ -88,21 +89,21 @@ toBase32Per5Bytes (W8# i1, W8# i2, W8# i3, W8# i4, W8# 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 = (uncheckedShiftRL# (and# (word8ToWordCompat# i1) 0xF8##) 3#) -- 0000 0111 << 2 | 1100 0000 >> 6 - !o2 = or# (uncheckedShiftL# (and# i1 0x07##) 2#) (uncheckedShiftRL# (and# i2 0xC0##) 6#) + !o2 = or# (uncheckedShiftL# (and# (word8ToWordCompat# i1) 0x07##) 2#) (uncheckedShiftRL# (and# (word8ToWordCompat# i2) 0xC0##) 6#) -- 0011 1110 >> 1 - !o3 = (uncheckedShiftRL# (and# i2 0x3E##) 1#) + !o3 = (uncheckedShiftRL# (and# (word8ToWordCompat# i2) 0x3E##) 1#) -- 0000 0001 << 4 | 1111 0000 >> 4 - !o4 = or# (uncheckedShiftL# (and# i2 0x01##) 4#) (uncheckedShiftRL# (and# i3 0xF0##) 4#) + !o4 = or# (uncheckedShiftL# (and# (word8ToWordCompat# i2) 0x01##) 4#) (uncheckedShiftRL# (and# (word8ToWordCompat# i3) 0xF0##) 4#) -- 0000 1111 << 1 | 1000 0000 >> 7 - !o5 = or# (uncheckedShiftL# (and# i3 0x0F##) 1#) (uncheckedShiftRL# (and# i4 0x80##) 7#) + !o5 = or# (uncheckedShiftL# (and# (word8ToWordCompat# i3) 0x0F##) 1#) (uncheckedShiftRL# (and# (word8ToWordCompat# i4) 0x80##) 7#) -- 0111 1100 >> 2 - !o6 = (uncheckedShiftRL# (and# i4 0x7C##) 2#) + !o6 = (uncheckedShiftRL# (and# (word8ToWordCompat# i4) 0x7C##) 2#) -- 0000 0011 << 3 | 1110 0000 >> 5 - !o7 = or# (uncheckedShiftL# (and# i4 0x03##) 3#) (uncheckedShiftRL# (and# i5 0xE0##) 5#) + !o7 = or# (uncheckedShiftL# (and# (word8ToWordCompat# i4) 0x03##) 3#) (uncheckedShiftRL# (and# (word8ToWordCompat# i5) 0xE0##) 5#) -- 0001 1111 - !o8 = ((and# i5 0x1F##)) + !o8 = ((and# (word8ToWordCompat# i5) 0x1F##)) !set = "ABCDEFGHIJKLMNOPQRSTUVWXYZ234567"# @@ -235,8 +236,8 @@ fromBase32Per8Bytes (i1, i2, i3, i4, i5, i6, i7, i8) = where rset :: Word8 -> Word8 rset (W8# w) - | booleanPrim (w `leWord#` 0xff##) = W8# (indexWord8OffAddr# rsetTable (word2Int# w)) - | otherwise = 0xff + | booleanPrim (word8ToWordCompat# w `leWord#` 0xff##) + = W8# (indexWord8OffAddr# rsetTable (word2Int# (word8ToWordCompat# 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\ diff --git a/Data/Memory/Encoding/Base64.hs b/Data/Memory/Encoding/Base64.hs index 9803875..659c07f 100644 --- a/Data/Memory/Encoding/Base64.hs +++ b/Data/Memory/Encoding/Base64.hs @@ -26,6 +26,7 @@ module Data.Memory.Encoding.Base64 , fromBase64OpenBSD ) where +import Data.Memory.HeadHackageUtils import Data.Memory.Internal.Compat import Data.Memory.Internal.CompatPrim import Data.Memory.Internal.Imports @@ -92,10 +93,10 @@ toBase64Internal table dst src len padded = loop 0 0 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## + let !w = narrow8Word# (uncheckedShiftRL# (word8ToWordCompat# a) 2#) + !x = or# (and# (uncheckedShiftL# (word8ToWordCompat# a) 4#) 0x30##) (uncheckedShiftRL# (word8ToWordCompat# b) 4#) + !y = or# (and# (uncheckedShiftL# (word8ToWordCompat# b) 2#) 0x3c##) (uncheckedShiftRL# (word8ToWordCompat# c) 6#) + !z = and# (word8ToWordCompat# c) 0x3f## in (index w, index x, index y, index z) where index :: Word# -> Word8 @@ -211,7 +212,8 @@ fromBase64Unpadded rset dst src len = loop 0 0 rsetURL :: Word8 -> Word8 rsetURL (W8# w) - | booleanPrim (w `leWord#` 0xff##) = W8# (indexWord8OffAddr# rsetTable (word2Int# w)) + | booleanPrim (word8ToWordCompat# w `leWord#` 0xff##) + = W8# (indexWord8OffAddr# rsetTable (word2Int# (word8ToWordCompat# w))) | otherwise = 0xff where !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\ @@ -232,7 +234,8 @@ rsetURL (W8# w) rsetOpenBSD :: Word8 -> Word8 rsetOpenBSD (W8# w) - | booleanPrim (w `leWord#` 0xff##) = W8# (indexWord8OffAddr# rsetTable (word2Int# w)) + | booleanPrim (word8ToWordCompat# w `leWord#` 0xff##) + = W8# (indexWord8OffAddr# rsetTable (word2Int# (word8ToWordCompat# w))) | otherwise = 0xff where !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\ @@ -309,7 +312,8 @@ fromBase64 dst src len rset :: Word8 -> Word8 rset (W8# w) - | booleanPrim (w `leWord#` 0xff##) = W8# (indexWord8OffAddr# rsetTable (word2Int# w)) + | booleanPrim (word8ToWordCompat# w `leWord#` 0xff##) + = W8# (indexWord8OffAddr# rsetTable (word2Int# (word8ToWordCompat# w))) | otherwise = 0xff !rsetTable = "\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\ diff --git a/Data/Memory/Hash/FNV.hs b/Data/Memory/Hash/FNV.hs index 89d78b5..be572a7 100644 --- a/Data/Memory/Hash/FNV.hs +++ b/Data/Memory/Hash/FNV.hs @@ -8,6 +8,7 @@ -- Fowler Noll Vo Hash (1 and 1a / 32 / 64 bits versions) -- -- +{-# LANGUAGE CPP #-} {-# LANGUAGE GeneralizedNewtypeDeriving #-} {-# LANGUAGE MagicHash #-} {-# LANGUAGE UnboxedTuples #-} @@ -24,12 +25,17 @@ module Data.Memory.Hash.FNV , fnv1a_64 ) where +import Data.Memory.HeadHackageUtils 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#) +import GHC.Prim hiding ( Word64#, Int64# +#if __GLASGOW_HASKELL__ >= 903 + , timesWord64#, xor64#, wordToWord64# +#endif + ) import GHC.Types import GHC.Ptr @@ -44,40 +50,40 @@ newtype FnvHash64 = FnvHash64 Word64 -- | 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 - where + where loop :: Word# -> Int# -> State# s -> (# State# s, FnvHash32 #) loop !acc i s - | booleanPrim (i ==# n) = (# s, FnvHash32 $ W32# (narrow32Word# acc) #) + | booleanPrim (i ==# n) = (# s, FnvHash32 $ W32# (narrow32WordCompat# acc) #) | otherwise = case readWord8OffAddr# addr i s of (# s2, v #) -> - let !nacc = (0x01000193## `timesWord#` acc) `xor#` v + let !nacc = (0x01000193## `timesWord#` acc) `xor#` word8ToWordCompat# v in loop nacc (i +# 1#) s2 -- | 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 - where + where loop :: Word# -> Int# -> State# s -> (# State# s, FnvHash32 #) loop !acc i s - | booleanPrim (i ==# n) = (# s, FnvHash32 $ W32# (narrow32Word# acc) #) + | booleanPrim (i ==# n) = (# s, FnvHash32 $ W32# (narrow32WordCompat# acc) #) | otherwise = case readWord8OffAddr# addr i s of (# s2, v #) -> - let !nacc = 0x01000193## `timesWord#` (acc `xor#` v) + let !nacc = 0x01000193## `timesWord#` (acc `xor#` word8ToWordCompat# v) in loop nacc (i +# 1#) s2 -- | 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 - where + 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) + let !nacc = (fnv64Prime `timesWord64#` acc) `xor64#` (wordToWord64# (word8ToWordCompat# v)) in loop nacc (i +# 1#) s2 fnv64Const :: Word64# @@ -89,14 +95,14 @@ fnv1_64 (Ptr addr) (I# n) = IO $ \s -> loop fnv64Const 0# s -- | 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 - where + 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) + let !nacc = fnv64Prime `timesWord64#` (acc `xor64#` wordToWord64# (word8ToWordCompat# v)) in loop nacc (i +# 1#) s2 fnv64Const :: Word64# diff --git a/Data/Memory/HeadHackageUtils.hs b/Data/Memory/HeadHackageUtils.hs new file mode 100644 index 0000000..d6ab707 --- /dev/null +++ b/Data/Memory/HeadHackageUtils.hs @@ -0,0 +1,35 @@ +{-# LANGUAGE CPP #-} +{-# LANGUAGE MagicHash #-} +module Data.Memory.HeadHackageUtils where + +import GHC.Exts + +#if MIN_VERSION_base(4,16,0) +word8ToWordCompat# :: Word8# -> Word# +word8ToWordCompat# = word8ToWord# + +wordToWord8Compat# :: Word# -> Word8# +wordToWord8Compat# = wordToWord8# + +wordToWord32Compat# :: Word# -> Word32# +wordToWord32Compat# = wordToWord32# + +-- + +narrow32WordCompat# :: Word# -> Word32# +narrow32WordCompat# = wordToWord32# +#else +-- No-ops +word8ToWordCompat# :: Word# -> Word# +word8ToWordCompat# x = x + +wordToWord8Compat# :: Word# -> Word# +wordToWord8Compat# x = x + +wordToWord32Compat# :: Word# -> Word# +wordToWord32Compat# x = x + +-- Actual narrowing +narrow32WordCompat# :: Word# -> Word# +narrow32WordCompat# = narrow32Word# +#endif diff --git a/Data/Memory/Internal/CompatPrim64.hs b/Data/Memory/Internal/CompatPrim64.hs index b6d2bd7..c16a9dd 100644 --- a/Data/Memory/Internal/CompatPrim64.hs +++ b/Data/Memory/Internal/CompatPrim64.hs @@ -52,8 +52,44 @@ module Data.Memory.Internal.CompatPrim64 #if WORD_SIZE_IN_BITS == 64 -import GHC.Prim hiding (Word64#, Int64#) +#if __GLASGOW_HASKELL__ >= 903 +import GHC.Prim +#else +import GHC.Prim hiding ( 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# + ) +#endif +#if __GLASGOW_HASKELL__ >= 903 +w64# :: Word# -> Word# -> Word# -> Word64# +w64# w _ _ = wordToWord64# w +#else #if __GLASGOW_HASKELL__ >= 708 type OutBool = Int# #else @@ -146,6 +182,7 @@ timesWord64# = timesWord# w64# :: Word# -> Word# -> Word# -> Word64# w64# w _ _ = w +#endif #elif WORD_SIZE_IN_BITS == 32 import GHC.IntWord64 diff --git a/memory.cabal b/memory.cabal index 2db3f39..eec3b16 100644 --- a/memory.cabal +++ b/memory.cabal @@ -72,6 +72,7 @@ Library Data.Memory.Internal.Imports Data.Memory.Hash.SipHash Data.Memory.Hash.FNV + Data.Memory.HeadHackageUtils Data.ByteArray.Pack.Internal Data.ByteArray.Types Data.ByteArray.Bytes