hashable 1.3.3.0 → 1.3.4.0
raw patch · 5 files changed
+299/−115 lines, 5 filesdep +containersdep ~basePVP: major bump suggested
API removals or changes: PVP suggests a major version bump
Dependencies added: containers
Dependency ranges changed: base
API changes (from Hackage documentation)
- Data.Hashable: hashByteArrayWithSalt :: ByteArray# -> Int -> Int -> Int -> Int
+ Data.Hashable: hashByteArrayWithSalt :: ByteArray# -> Int -> Int -> Salt -> Salt
- Data.Hashable: hashPtrWithSalt :: Ptr a -> Int -> Int -> IO Int
+ Data.Hashable: hashPtrWithSalt :: Ptr a -> Int -> Salt -> IO Salt
Files
- CHANGES.md +13/−0
- hashable.cabal +4/−1
- src/Data/Hashable/Class.hs +98/−112
- src/Data/Hashable/LowLevel.hs +134/−0
- tests/Regress.hs +50/−2
CHANGES.md view
@@ -1,5 +1,18 @@ See also https://pvp.haskell.org/faq +## Version 1.3.4.0+ * `Text` and `ByteString` hashes include length.+ This fixes a variant of https://github.com/haskell-unordered-containers/hashable/issues/74+ for texts and bytestrings.+ https://github.com/haskell-unordered-containers/hashable/pull/223+ * Use correct prime in `combine`.+ This should improve the hash quality of compound structures on 64bit systems.+ https://github.com/haskell-unordered-containers/hashable/pull/224+ * Add instance for types in `containers` package+ https://github.com/haskell-unordered-containers/hashable/pull/226+ * Change `Int`, `Int64` and `Word64` `hashWithSalt` slightly.+ https://github.com/haskell-unordered-containers/hashable/pull/227+ ## Version 1.3.3.0 * `Text` hashing uses 64-bit FNV prime
hashable.cabal view
@@ -1,6 +1,6 @@ cabal-version: 1.12 name: hashable-version: 1.3.3.0+version: 1.3.4.0 synopsis: A class for types that can be converted to a hash value description: This package defines a class, 'Hashable', for types that@@ -56,6 +56,7 @@ Randomly initialize the initial seed on each final executable invocation This is useful for catching cases when you rely on (non-existent) stability of hashable's hash functions.+ This is not a security feature. manual: True default: False@@ -68,6 +69,7 @@ other-modules: Data.Hashable.Class+ Data.Hashable.LowLevel Data.Hashable.Generic.Instances c-sources: cbits/fnv.c@@ -76,6 +78,7 @@ build-depends: base >=4.5 && <4.17 , bytestring >=0.9 && <0.12+ , containers >=0.4.2.1 && <0.7 , deepseq >=1.3 && <1.5 , ghc-prim , text >=0.12 && <1.3
src/Data/Hashable/Class.hs view
@@ -78,7 +78,6 @@ import qualified Data.Text.Lazy as TL import Data.Version (Version(..)) import Data.Word (Word8, Word16, Word32, Word64)-import Foreign.C (CString) import Foreign.Marshal.Utils (with) import Foreign.Ptr (Ptr, FunPtr, IntPtr, WordPtr, castPtr, castFunPtrToPtr, ptrToIntPtr) import Foreign.Storable (alignment, peek, sizeOf)@@ -88,6 +87,12 @@ import System.IO.Unsafe (unsafeDupablePerformIO) import System.Mem.StableName import Data.Unique (Unique, hashUnique)+import qualified Data.IntMap as IntMap+import qualified Data.IntSet as IntSet+import qualified Data.Map as Map+import qualified Data.Sequence as Seq+import qualified Data.Set as Set+import qualified Data.Tree as Tree -- As we use qualified F.Foldable, we don't get warnings with newer base import qualified Data.Foldable as F@@ -188,10 +193,9 @@ #define Type * #endif -#ifdef HASHABLE_RANDOM_SEED-import System.IO.Unsafe (unsafePerformIO)-#endif +import Data.Hashable.LowLevel+ #include "MachDeps.h" infixl 0 `hashWithSalt`@@ -199,31 +203,6 @@ ------------------------------------------------------------------------ -- * Computing hash values -#ifdef HASHABLE_RANDOM_SEED-initialSeed :: Word64-initialSeed = unsafePerformIO initialSeedC-{-# NOINLINE initialSeed #-}--foreign import capi "HsHashable.h hs_hashable_init" initialSeedC :: IO Word64-#endif---- | A default salt used in the implementation of 'hash'.-defaultSalt :: Int-#ifdef HASHABLE_RANDOM_SEED-defaultSalt = hashWithSalt defaultSalt' initialSeed-#else-defaultSalt = defaultSalt'-#endif-{-# INLINE defaultSalt #-}--defaultSalt' :: Int-#if WORD_SIZE_IN_BITS == 64-defaultSalt' = -3750763034362895579 -- 14695981039346656037 :: Int64-#else-defaultSalt' = -2128831035 -- 2166136261 :: Int32-#endif-{-# INLINE defaultSalt' #-}- -- | The class of types that can be converted to a hash value. -- -- Minimal implementation: 'hashWithSalt'.@@ -334,7 +313,7 @@ -- the non-generic instance use case. Instead we provide -- 'defaultHashWith'. defaultHashWithSalt :: Hashable a => Int -> a -> Int-defaultHashWithSalt salt x = salt `combine` hash x+defaultHashWithSalt salt x = salt `hashInt` hash x -- | Transform a value into a 'Hashable' value, then hash the -- transformed value using the given salt.@@ -360,7 +339,7 @@ instance Hashable Int where hash = id- hashWithSalt = defaultHashWithSalt+ hashWithSalt = hashInt instance Hashable Int8 where hash = fromIntegral@@ -375,15 +354,8 @@ hashWithSalt = defaultHashWithSalt instance Hashable Int64 where- hash n-#if MIN_VERSION_base(4,7,0)- | finiteBitSize (undefined :: Int) == 64 = fromIntegral n-#else- | bitSize (undefined :: Int) == 64 = fromIntegral n-#endif- | otherwise = fromIntegral (fromIntegral n `xor`- (fromIntegral n `shiftR` 32 :: Word64))- hashWithSalt = defaultHashWithSalt+ hash = fromIntegral+ hashWithSalt = hashInt64 instance Hashable Word where hash = fromIntegral@@ -402,14 +374,7 @@ hashWithSalt = defaultHashWithSalt instance Hashable Word64 where- hash n-#if MIN_VERSION_base(4,7,0)- | finiteBitSize (undefined :: Int) == 64 = fromIntegral n-#else- | bitSize (undefined :: Int) == 64 = fromIntegral n-#endif- | otherwise = fromIntegral (n `xor` (n `shiftR` 32))- hashWithSalt = defaultHashWithSalt+ hashWithSalt = hashWord64 instance Hashable () where hash = fromEnum@@ -570,8 +535,8 @@ hashWithSalt = hashWithSalt1 instance Hashable1 Maybe where- liftHashWithSalt _ s Nothing = s `combine` 0- liftHashWithSalt h s (Just a) = s `combine` distinguisher `h` a+ liftHashWithSalt _ s Nothing = s `hashInt` 0+ liftHashWithSalt h s (Just a) = s `hashInt` distinguisher `h` a instance (Hashable a, Hashable b) => Hashable (Either a b) where hash (Left a) = 0 `hashWithSalt` a@@ -582,8 +547,8 @@ liftHashWithSalt = defaultLiftHashWithSalt instance Hashable2 Either where- liftHashWithSalt2 h _ s (Left a) = s `combine` 0 `h` a- liftHashWithSalt2 _ h s (Right b) = s `combine` distinguisher `h` b+ liftHashWithSalt2 h _ s (Left a) = s `hashInt` 0 `h` a+ liftHashWithSalt2 _ h s (Right b) = s `hashInt` distinguisher `h` b instance (Hashable a1, Hashable a2) => Hashable (a1, a2) where hash (a1, a2) = hash a1 `hashWithSalt` a2@@ -694,24 +659,35 @@ instance Hashable B.ByteString where hashWithSalt salt bs = unsafeDupablePerformIO $ B.unsafeUseAsCStringLen bs $ \(p, len) ->- hashPtrWithSalt p (fromIntegral len) salt+ hashPtrWithSalt p (fromIntegral len) (hashWithSalt salt len) instance Hashable BL.ByteString where- hashWithSalt = BL.foldlChunks hashWithSalt+ hashWithSalt salt = finalise . BL.foldlChunks step (SP salt 0)+ where+ finalise (SP s l) = hashWithSalt s l+ step (SP s l) bs = unsafeDupablePerformIO $+ B.unsafeUseAsCStringLen bs $ \(p, len) -> do+ s' <- hashPtrWithSalt p (fromIntegral len) s+ return (SP s' (l + len)) #if MIN_VERSION_bytestring(0,10,4) instance Hashable BSI.ShortByteString where hashWithSalt salt sbs@(BSI.SBS ba) =- hashByteArrayWithSalt ba 0 (BSI.length sbs) salt+ hashByteArrayWithSalt ba 0 (BSI.length sbs) (hashWithSalt salt (BSI.length sbs)) #endif instance Hashable T.Text where hashWithSalt salt (T.Text arr off len) = hashByteArrayWithSalt (TA.aBA arr) (off `shiftL` 1) (len `shiftL` 1)- salt+ (hashWithSalt salt len) instance Hashable TL.Text where- hashWithSalt = TL.foldlChunks hashWithSalt+ hashWithSalt salt = finalise . TL.foldlChunks step (SP salt 0)+ where+ finalise (SP s l) = hashWithSalt s l+ step (SP s l) (T.Text arr off len) = SP+ (hashByteArrayWithSalt (TA.aBA arr) (off `shiftL` 1) (len `shiftL` 1) s)+ (l + len) -- | Compute the hash of a ThreadId. hashThreadId :: ThreadId -> Int@@ -797,27 +773,6 @@ -> IO Int -- ^ hash value hashPtr p len = hashPtrWithSalt p len defaultSalt --- | Compute a hash value for the content of this pointer, using an--- initial salt.------ This function can for example be used to hash non-contiguous--- segments of memory as if they were one contiguous segment, by using--- the output of one hash as the salt for the next.-hashPtrWithSalt :: Ptr a -- ^ pointer to the data to hash- -> Int -- ^ length, in bytes- -> Int -- ^ salt- -> IO Int -- ^ hash value-hashPtrWithSalt p len salt =- fromIntegral `fmap` c_hashCString (castPtr p) (fromIntegral len)- (fromIntegral salt)--foreign import capi unsafe "HsHashable.h hashable_fnv_hash" c_hashCString-#if WORD_SIZE_IN_BITS == 64- :: CString -> Int64 -> Int64 -> IO Word64-#else- :: CString -> Int32 -> Int32 -> IO Word32-#endif- -- | Compute a hash value for the content of this 'ByteArray#', -- beginning at the specified offset, using specified number of bytes. hashByteArray :: ByteArray# -- ^ data to hash@@ -827,38 +782,6 @@ hashByteArray ba0 off len = hashByteArrayWithSalt ba0 off len defaultSalt {-# INLINE hashByteArray #-} --- | Compute a hash value for the content of this 'ByteArray#', using--- an initial salt.------ This function can for example be used to hash non-contiguous--- segments of memory as if they were one contiguous segment, by using--- the output of one hash as the salt for the next.-hashByteArrayWithSalt- :: ByteArray# -- ^ data to hash- -> Int -- ^ offset, in bytes- -> Int -- ^ length, in bytes- -> Int -- ^ salt- -> Int -- ^ hash value-hashByteArrayWithSalt ba !off !len !h =- fromIntegral $ c_hashByteArray ba (fromIntegral off) (fromIntegral len)- (fromIntegral h)--#if __GLASGOW_HASKELL__ >= 802-foreign import capi unsafe "HsHashable.h hashable_fnv_hash_offset" c_hashByteArray-#else-foreign import ccall unsafe "hashable_fnv_hash_offset" c_hashByteArray-#endif-#if WORD_SIZE_IN_BITS == 64- :: ByteArray# -> Int64 -> Int64 -> Int64 -> Word64-#else- :: ByteArray# -> Int32 -> Int32 -> Int32 -> Word32-#endif---- | Combine two given hash values. 'combine' has zero as a left--- identity.-combine :: Int -> Int -> Int-combine h1 h2 = (h1 * 16777619) `xor` h2- instance Hashable Unique where hash = hashUnique hashWithSalt = defaultHashWithSalt@@ -976,8 +899,8 @@ hashWithSalt = hashWithSalt1 instance (Hashable1 f, Hashable1 g) => Hashable1 (FS.Sum f g) where- liftHashWithSalt h s (FS.InL a) = liftHashWithSalt h (s `combine` 0) a- liftHashWithSalt h s (FS.InR a) = liftHashWithSalt h (s `combine` distinguisher) a+ liftHashWithSalt h s (FS.InL a) = liftHashWithSalt h (s `hashInt` 0) a+ liftHashWithSalt h s (FS.InR a) = liftHashWithSalt h (s `hashInt` distinguisher) a instance (Hashable1 f, Hashable1 g, Hashable a) => Hashable (FS.Sum f g a) where hashWithSalt = hashWithSalt1@@ -1045,3 +968,66 @@ instance Show1 Hashed where liftShowsPrec sp _ d (Hashed a _) = showsUnaryWith sp "hashed" d a #endif++-------------------------------------------------------------------------------+-- containers+-------------------------------------------------------------------------------++-- | @since 1.3.4.0+instance Hashable2 Map.Map where+ liftHashWithSalt2 hk hv s m = Map.foldlWithKey'+ (\s' k v -> hv (hk s' k) v)+ (hashWithSalt s (Map.size m))+ m++-- | @since 1.3.4.0+instance Hashable k => Hashable1 (Map.Map k) where+ liftHashWithSalt h s m = Map.foldlWithKey'+ (\s' k v -> h (hashWithSalt s' k) v)+ (hashWithSalt s (Map.size m))+ m++-- | @since 1.3.4.0+instance (Hashable k, Hashable v) => Hashable (Map.Map k v) where+ hashWithSalt = hashWithSalt2++-- | @since 1.3.4.0+instance Hashable1 IntMap.IntMap where+ liftHashWithSalt h s m = IntMap.foldlWithKey'+ (\s' k v -> h (hashWithSalt s' k) v)+ (hashWithSalt s (IntMap.size m))+ m++-- | @since 1.3.4.0+instance Hashable v => Hashable (IntMap.IntMap v) where+ hashWithSalt = hashWithSalt1++-- | @since 1.3.4.0+instance Hashable1 Set.Set where+ liftHashWithSalt h s x = Set.foldl' h (hashWithSalt s (Set.size x)) x++-- | @since 1.3.4.0+instance Hashable v => Hashable (Set.Set v) where+ hashWithSalt = hashWithSalt1++-- | @since 1.3.4.0+instance Hashable IntSet.IntSet where+ hashWithSalt salt x = IntSet.foldl' hashWithSalt+ (hashWithSalt salt (IntSet.size x))+ x++-- | @since 1.3.4.0+instance Hashable1 Seq.Seq where+ liftHashWithSalt h s x = F.foldl' h (hashWithSalt s (Seq.length x)) x++-- | @since 1.3.4.0+instance Hashable v => Hashable (Seq.Seq v) where+ hashWithSalt = hashWithSalt1++-- | @since 1.3.4.0+instance Hashable1 Tree.Tree where+ liftHashWithSalt h s (Tree.Node x xs) = h s x++-- | @since 1.3.4.0+instance Hashable v => Hashable (Tree.Tree v) where+ hashWithSalt = hashWithSalt1
+ src/Data/Hashable/LowLevel.hs view
@@ -0,0 +1,134 @@+{-# LANGUAGE CPP, BangPatterns, MagicHash, CApiFFI, UnliftedFFITypes #-}+{-# LANGUAGE Trustworthy #-}+-- | A module containing low-level hash primitives.+module Data.Hashable.LowLevel (+ Salt,+ defaultSalt,+ hashInt,+ hashInt64,+ hashWord64,+ hashPtrWithSalt,+ hashByteArrayWithSalt,+) where++#include "MachDeps.h"++import Data.Bits (xor)+import Data.Int (Int64)+import Data.Word (Word64)+import Foreign.C (CString)+import Foreign.Ptr (Ptr, castPtr)+import GHC.Base (ByteArray#)++#ifdef HASHABLE_RANDOM_SEED+import System.IO.Unsafe (unsafePerformIO)+#endif++#if WORD_SIZE_IN_BITS != 64+import Data.Bits (shiftR)+#endif++-------------------------------------------------------------------------------+-- Initial seed+-------------------------------------------------------------------------------++type Salt = Int++#ifdef HASHABLE_RANDOM_SEED+initialSeed :: Word64+initialSeed = unsafePerformIO initialSeedC+{-# NOINLINE initialSeed #-}++foreign import capi "HsHashable.h hs_hashable_init" initialSeedC :: IO Word64+#endif++-- | A default salt used in the implementation of 'hash'.+defaultSalt :: Salt+#ifdef HASHABLE_RANDOM_SEED+defaultSalt = hashInt defaultSalt' (fromIntegral initialSeed)+#else+defaultSalt = defaultSalt'+#endif+{-# INLINE defaultSalt #-}++defaultSalt' :: Salt+#if WORD_SIZE_IN_BITS == 64+defaultSalt' = -3750763034362895579 -- 14695981039346656037 :: Int64+#else+defaultSalt' = -2128831035 -- 2166136261 :: Int32+#endif+{-# INLINE defaultSalt' #-}++-------------------------------------------------------------------------------+-- Hash primitives+-------------------------------------------------------------------------------++-- | Hash 'Int'. First argument is a salt, second argument is an 'Int'.+-- The result is new salt / hash value.+hashInt :: Salt -> Int -> Salt+#if WORD_SIZE_IN_BITS == 64+hashInt s x = (s * 1099511628211) `xor` x+#else+hashInt s x = (s * 16777619) `xor` x+#endif+-- Note: FNV-1 hash takes a byte of data at once, here we take an 'Int',+-- which is 4 or 8 bytes. Whether that's bad or not, I don't know.++hashInt64 :: Salt -> Int64 -> Salt+hashWord64 :: Salt -> Word64 -> Salt++#if WORD_SIZE_IN_BITS == 64+hashInt64 s x = hashInt s (fromIntegral x)+hashWord64 s x = hashInt s (fromIntegral x)+#else+hashInt64 s x = hashInt (hashInt s (fromIntegral x)) (fromIntegral (x `shiftR` 32))+hashWord64 s x = hashInt (hashInt s (fromIntegral x)) (fromIntegral (x `shiftR` 32))+#endif++-- | Compute a hash value for the content of this pointer, using an+-- initial salt.+--+-- This function can for example be used to hash non-contiguous+-- segments of memory as if they were one contiguous segment, by using+-- the output of one hash as the salt for the next.+hashPtrWithSalt :: Ptr a -- ^ pointer to the data to hash+ -> Int -- ^ length, in bytes+ -> Salt -- ^ salt+ -> IO Salt -- ^ hash value+hashPtrWithSalt p len salt =+ fromIntegral `fmap` c_hashCString (castPtr p) (fromIntegral len)+ (fromIntegral salt)++-- | Compute a hash value for the content of this 'ByteArray#', using+-- an initial salt.+--+-- This function can for example be used to hash non-contiguous+-- segments of memory as if they were one contiguous segment, by using+-- the output of one hash as the salt for the next.+hashByteArrayWithSalt+ :: ByteArray# -- ^ data to hash+ -> Int -- ^ offset, in bytes+ -> Int -- ^ length, in bytes+ -> Salt -- ^ salt+ -> Salt -- ^ hash value+hashByteArrayWithSalt ba !off !len !h =+ fromIntegral $ c_hashByteArray ba (fromIntegral off) (fromIntegral len)+ (fromIntegral h)++foreign import capi unsafe "HsHashable.h hashable_fnv_hash" c_hashCString+#if WORD_SIZE_IN_BITS == 64+ :: CString -> Int64 -> Int64 -> IO Word64+#else+ :: CString -> Int32 -> Int32 -> IO Word32+#endif++#if __GLASGOW_HASKELL__ >= 802+foreign import capi unsafe "HsHashable.h hashable_fnv_hash_offset" c_hashByteArray+#else+foreign import ccall unsafe "hashable_fnv_hash_offset" c_hashByteArray+#endif+#if WORD_SIZE_IN_BITS == 64+ :: ByteArray# -> Int64 -> Int64 -> Int64 -> Word64+#else+ :: ByteArray# -> Int32 -> Int32 -> Int32 -> Word32+#endif
tests/Regress.hs view
@@ -5,13 +5,20 @@ module Regress (regressions) where import qualified Test.Framework as F+import Control.Monad (when) import Test.Framework.Providers.HUnit (testCase)-import Test.HUnit ((@=?))+import Test.HUnit (assertFailure, (@=?)) import GHC.Generics (Generic) import Data.List (nub) import Data.Fixed (Pico) import Data.Text (Text)+import Data.ByteString (ByteString) +import qualified Data.Text.Lazy as TL+import qualified Data.ByteString.Char8 as BS8+import qualified Data.ByteString.Lazy as BSL+import qualified Data.ByteString.Lazy.Char8 as BSL8+ #ifdef HAVE_MMAP import qualified Regress.Mmap as Mmap #endif@@ -41,8 +48,49 @@ hs @=? nub hs #if WORD_SIZE_IN_BITS == 64 , testCase "64 bit Text" $ do- hash ("hello world" :: Text) @=? 2668910425102664189+ hash ("hello world" :: Text) @=? -3875242662334356092 #endif+ , F.testGroup "concatenation"+ [ testCase "String" $ do+ let lhs, rhs :: (String, String)+ lhs = ("foo", "bar")+ rhs = ("foobar", "")++ when (hash lhs == hash rhs) $ do+ assertFailure "Should have different hashes"++ , testCase "Text" $ do+ let lhs, rhs :: (Text, Text)+ lhs = ("foo", "bar")+ rhs = ("foobar", "")++ when (hash lhs == hash rhs) $ do+ assertFailure "Should have different hashes"++ , testCase "Lazy Text" $ do+ let lhs, rhs :: (TL.Text, TL.Text)+ lhs = ("foo", "bar")+ rhs = ("foobar", "")++ when (hash lhs == hash rhs) $ do+ assertFailure "Should have different hashes"++ , testCase "ByteString" $ do+ let lhs, rhs :: (ByteString, ByteString)+ lhs = (BS8.pack "foo", BS8.pack "bar")+ rhs = (BS8.pack "foobar", BS8.empty)++ when (hash lhs == hash rhs) $ do+ assertFailure "Should have different hashes"++ , testCase "Lazy ByteString" $ do+ let lhs, rhs :: (BSL.ByteString, BSL.ByteString)+ lhs = (BSL8.pack "foo", BSL8.pack "bar")+ rhs = (BSL8.pack "foobar", BSL.empty)++ when (hash lhs == hash rhs) $ do+ assertFailure "Should have different hashes"+ ] ] where nullaryCase :: Int -> SumOfNullary -> IO ()