hashable 1.1.2.5 → 1.2.0.0
raw patch · 18 files changed
+2024/−489 lines, 18 filesdep −QuickCheckdep −hashabledep −randomPVP ok
version bump matches the API change (PVP)
Dependencies removed: QuickCheck, hashable, random, test-framework, test-framework-quickcheck2
API changes (from Hackage documentation)
- Data.Hashable: combine :: Int -> Int -> Int
- Data.Hashable: instance (Hashable a, Hashable b) => Hashable (Either a b)
- Data.Hashable: instance (Hashable a1, Hashable a2) => Hashable (a1, a2)
- Data.Hashable: instance (Hashable a1, Hashable a2, Hashable a3) => Hashable (a1, a2, a3)
- Data.Hashable: instance (Hashable a1, Hashable a2, Hashable a3, Hashable a4) => Hashable (a1, a2, a3, a4)
- Data.Hashable: instance (Hashable a1, Hashable a2, Hashable a3, Hashable a4, Hashable a5) => Hashable (a1, a2, a3, a4, a5)
- Data.Hashable: instance (Hashable a1, Hashable a2, Hashable a3, Hashable a4, Hashable a5, Hashable a6) => Hashable (a1, a2, a3, a4, a5, a6)
- Data.Hashable: instance (Hashable a1, Hashable a2, Hashable a3, Hashable a4, Hashable a5, Hashable a6, Hashable a7) => Hashable (a1, a2, a3, a4, a5, a6, a7)
- Data.Hashable: instance (Integral a, Hashable a) => Hashable (Ratio a)
- Data.Hashable: instance Hashable ()
- Data.Hashable: instance Hashable (StableName a)
- Data.Hashable: instance Hashable Bool
- Data.Hashable: instance Hashable ByteString
- Data.Hashable: instance Hashable Char
- Data.Hashable: instance Hashable Double
- Data.Hashable: instance Hashable Float
- Data.Hashable: instance Hashable Int
- Data.Hashable: instance Hashable Int16
- Data.Hashable: instance Hashable Int32
- Data.Hashable: instance Hashable Int64
- Data.Hashable: instance Hashable Int8
- Data.Hashable: instance Hashable Integer
- Data.Hashable: instance Hashable Text
- Data.Hashable: instance Hashable ThreadId
- Data.Hashable: instance Hashable TypeRep
- Data.Hashable: instance Hashable Word
- Data.Hashable: instance Hashable Word16
- Data.Hashable: instance Hashable Word32
- Data.Hashable: instance Hashable Word64
- Data.Hashable: instance Hashable Word8
- Data.Hashable: instance Hashable a => Hashable (Maybe a)
- Data.Hashable: instance Hashable a => Hashable [a]
+ Data.Hashable: hashUsing :: Hashable b => (a -> b) -> Int -> a -> Int
- Data.Hashable: class Hashable a where hash = hashWithSalt defaultSalt hashWithSalt salt x = salt `combine` hash x
+ Data.Hashable: class Hashable a where hashWithSalt salt = ghashWithSalt salt . from
Files
- Data/Hashable.hs +159/−382
- Data/Hashable/Class.hs +516/−0
- Data/Hashable/Generic.hs +74/−0
- Data/Hashable/RandomSource.hs +29/−0
- Data/Hashable/SipHash.hs +159/−0
- benchmarks/Benchmarks.hs +230/−8
- benchmarks/Makefile +0/−25
- benchmarks/cbits/fnv.c +53/−0
- benchmarks/cbits/inthash.c +28/−0
- cbits/getRandomBytes.c +93/−0
- cbits/hashByteString.c +0/−53
- cbits/inthash.c +29/−0
- cbits/siphash-sse2.c +72/−0
- cbits/siphash-sse41.c +84/−0
- cbits/siphash.c +247/−0
- cbits/siphash.h +22/−0
- hashable.cabal +79/−4
- tests/Properties.hs +150/−17
Data/Hashable.hs view
@@ -1,12 +1,11 @@-{-# LANGUAGE BangPatterns, CPP, ForeignFunctionInterface, MagicHash,- UnliftedFFITypes #-}+{-# LANGUAGE CPP #-} ------------------------------------------------------------------------ -- |--- Module : Data.Hash+-- Module : Data.Hashable -- Copyright : (c) Milan Straka 2010 -- (c) Johan Tibell 2011--- (c) Bryan O'Sullivan 2011+-- (c) Bryan O'Sullivan 2011, 2012 -- License : BSD-style -- Maintainer : johan.tibell@gmail.com -- Stability : provisional@@ -15,337 +14,120 @@ -- This module defines a class, 'Hashable', for types that can be -- converted to a hash value. This class exists for the benefit of -- hashing-based data structures. The module provides instances for--- basic types and a way to combine hash values.+-- most standard types. Efficient instances for other types can be+-- generated automatically and effortlessly using the generics support+-- in GHC 7.2 and above. ----- The 'hash' function should be as collision-free as possible, which--- means that the 'hash' function must map the inputs to the hash--- values as evenly as possible.+-- The easiest way to get started is to use the 'hash' function. Here+-- is an example session with @ghci@.+--+-- > Prelude> import Data.Hashable+-- > Prelude> hash "foo"+-- > 60853164 module Data.Hashable ( -- * Computing hash values- Hashable(..)+ hash+ , Hashable(..) + -- ** Avalanche behavior+ -- $avalanche+ -- * Creating new instances+ -- | There are two ways to create new instances: by deriving+ -- instances automatically using GHC's generic programming+ -- support or by writing instances manually.++ -- ** Generic instances+ -- $generics++ -- *** Understanding a compiler error+ -- $generic_err++ -- ** Writing instances by hand -- $blocks+ , hashUsing , hashPtr , hashPtrWithSalt #if defined(__GLASGOW_HASKELL__) , hashByteArray , hashByteArrayWithSalt #endif- , combine+ -- ** Hashing types with multiple constructors+ -- $ctors ) where -import Control.Exception (assert)-import Data.Bits (bitSize, shiftL, shiftR, xor)-import Data.Int (Int8, Int16, Int32, Int64)-import Data.Word (Word, Word8, Word16, Word32, Word64)-import Data.List (foldl')-import Data.Ratio (Ratio, denominator, numerator)-import qualified Data.ByteString as B-import qualified Data.ByteString.Internal as B-import qualified Data.ByteString.Unsafe as B-import qualified Data.ByteString.Lazy as BL-#if !MIN_VERSION_bytestring(0,10,0)-import qualified Data.ByteString.Lazy.Internal as BL -- foldlChunks-#endif-#if defined(__GLASGOW_HASKELL__)-import qualified Data.Text as T-import qualified Data.Text.Array as TA-import qualified Data.Text.Internal as T-import qualified Data.Text.Lazy as LT-#endif-import Foreign.C (CString)-#if __GLASGOW_HASKELL__ >= 703-import Foreign.C (CLong(..))-#else-import Foreign.C (CLong)-#endif-import Foreign.Marshal.Utils (with)-import Foreign.Ptr (Ptr, castPtr)-import Foreign.Storable (alignment, peek, sizeOf)-import System.IO.Unsafe (unsafePerformIO)---- Byte arrays and Integers.-#if defined(__GLASGOW_HASKELL__)-import GHC.Base (ByteArray#)-# ifdef VERSION_integer_gmp-import GHC.Exts (Int(..))-import GHC.Integer.GMP.Internals (Integer(..))-# endif-#endif---- ThreadId-#if defined(__GLASGOW_HASKELL__)-import GHC.Conc (ThreadId(..))-import GHC.Prim (ThreadId#)-# if __GLASGOW_HASKELL__ >= 703-import Foreign.C.Types (CInt(..))-# else-import Foreign.C.Types (CInt)-# endif-#else-import Control.Concurrent (ThreadId)-#endif--#if defined(__GLASGOW_HASKELL__) || defined(__HUGS__)-import System.Mem.StableName-#endif--import Data.Typeable-#if __GLASGOW_HASKELL__ >= 702-import GHC.Fingerprint.Type(Fingerprint(..))-import Data.Typeable.Internal(TypeRep(..))+import Data.Hashable.Class+#ifdef GENERICS+import Data.Hashable.Generic () #endif -#include "MachDeps.h"--infixl 0 `combine`, `hashWithSalt`----------------------------------------------------------------------------- * Computing hash values---- | A default salt used in the default implementation of 'hashWithSalt'.--- It is specified by FNV-1 hash as a default salt for hashing string like--- types.-defaultSalt :: Int-defaultSalt = 2166136261-{-# INLINE defaultSalt #-}---- | The class of types that can be converted to a hash value.+-- $avalanche ----- Minimal implementation: 'hash' or 'hashWithSalt'.-class Hashable a where- -- | Return a hash value for the argument.- --- -- The general contract of 'hash' is:- --- -- * This integer need not remain consistent from one execution- -- of an application to another execution of the same- -- application.- --- -- * If two values are equal according to the '==' method, then- -- applying the 'hash' method on each of the two values must- -- produce the same integer result.- --- -- * It is /not/ required that if two values are unequal- -- according to the '==' method, then applying the 'hash'- -- method on each of the two values must produce distinct- -- integer results. However, the programmer should be aware- -- that producing distinct integer results for unequal values- -- may improve the performance of hashing-based data- -- structures.- hash :: a -> Int- hash = hashWithSalt defaultSalt-- -- | Return a hash value for the argument, using the given salt.- --- -- This method can be used to compute different hash values for- -- the same input by providing a different salt in each- -- application of the method.- --- -- The contract for 'hashWithSalt' is the same as for 'hash', with- -- the additional requirement that any instance that defines- -- 'hashWithSalt' must make use of the salt in its implementation.- hashWithSalt :: Int -> a -> Int- hashWithSalt salt x = salt `combine` hash x--instance Hashable () where hash _ = 0--instance Hashable Bool where hash x = case x of { True -> 1; False -> 0 }--instance Hashable Int where hash = id-instance Hashable Int8 where hash = fromIntegral-instance Hashable Int16 where hash = fromIntegral-instance Hashable Int32 where hash = fromIntegral-instance Hashable Int64 where- hash n- | bitSize (undefined :: Int) == 64 = fromIntegral n- | otherwise = fromIntegral (fromIntegral n `xor`- (fromIntegral n `shiftR` 32 :: Word64))--instance Hashable Word where hash = fromIntegral-instance Hashable Word8 where hash = fromIntegral-instance Hashable Word16 where hash = fromIntegral-instance Hashable Word32 where hash = fromIntegral-instance Hashable Word64 where- hash n- | bitSize (undefined :: Int) == 64 = fromIntegral n- | otherwise = fromIntegral (n `xor` (n `shiftR` 32))--instance Hashable Integer where-#if defined(__GLASGOW_HASKELL__) && defined(VERSION_integer_gmp)- hash (S# int) = I# int- hash n@(J# size byteArray) | n >= fromIntegral (minBound :: Int) && n <= fromIntegral (maxBound :: Int) = fromInteger n- | otherwise = hashByteArrayWithSalt byteArray 0 (SIZEOF_HSWORD * (I# size)) 0-- hashWithSalt salt (S# int) = salt `combine` I# int- hashWithSalt salt n@(J# size byteArray) | n >= fromIntegral (minBound :: Int) && n <= fromIntegral (maxBound :: Int) = salt `combine` fromInteger n- | otherwise = hashByteArrayWithSalt byteArray 0 (SIZEOF_HSWORD * (I# size)) salt-#else- hashWithSalt salt = foldl' hashWithSalt salt . go- where- go n | inBounds n = [fromIntegral n :: Int]- | otherwise = fromIntegral n : go (n `shiftR` WORD_SIZE_IN_BITS)- maxInt = fromIntegral (maxBound :: Int)- inBounds x = x >= fromIntegral (minBound :: Int) && x <= maxInt-#endif--instance (Integral a, Hashable a) => Hashable (Ratio a) where- {-# SPECIALIZE instance Hashable (Ratio Integer) #-}- hash a = hash (numerator a) `hashWithSalt` denominator a- hashWithSalt s a = s `hashWithSalt` numerator a `hashWithSalt` denominator a--instance Hashable Float where- hash x- | isIEEE x =- assert (sizeOf x >= sizeOf (0::Word32) &&- alignment x >= alignment (0::Word32)) $- hash ((unsafePerformIO $ with x $ peek . castPtr) :: Word32)- | otherwise = hash (show x)--instance Hashable Double where- hash x- | isIEEE x =- assert (sizeOf x >= sizeOf (0::Word64) &&- alignment x >= alignment (0::Word64)) $- hash ((unsafePerformIO $ with x $ peek . castPtr) :: Word64)- | otherwise = hash (show x)--instance Hashable Char where hash = fromEnum---- | A value with bit pattern (01)* (or 5* in hexa), for any size of Int.--- It is used as data constructor distinguisher. GHC computes its value during--- compilation.-distinguisher :: Int-distinguisher = fromIntegral $ (maxBound :: Word) `quot` 3-{-# INLINE distinguisher #-}--instance Hashable a => Hashable (Maybe a) where- hash Nothing = 0- hash (Just a) = distinguisher `hashWithSalt` a- hashWithSalt s Nothing = s `combine` 0- hashWithSalt s (Just a) = s `combine` distinguisher `hashWithSalt` a--instance (Hashable a, Hashable b) => Hashable (Either a b) where- hash (Left a) = 0 `hashWithSalt` a- hash (Right b) = distinguisher `hashWithSalt` b- hashWithSalt s (Left a) = s `combine` 0 `hashWithSalt` a- hashWithSalt s (Right b) = s `combine` distinguisher `hashWithSalt` b--instance (Hashable a1, Hashable a2) => Hashable (a1, a2) where- hash (a1, a2) = hash a1 `hashWithSalt` a2- hashWithSalt s (a1, a2) = s `hashWithSalt` a1 `hashWithSalt` a2--instance (Hashable a1, Hashable a2, Hashable a3) => Hashable (a1, a2, a3) where- hash (a1, a2, a3) = hash a1 `hashWithSalt` a2 `hashWithSalt` a3- hashWithSalt s (a1, a2, a3) = s `hashWithSalt` a1 `hashWithSalt` a2- `hashWithSalt` a3--instance (Hashable a1, Hashable a2, Hashable a3, Hashable a4) =>- Hashable (a1, a2, a3, a4) where- hash (a1, a2, a3, a4) = hash a1 `hashWithSalt` a2- `hashWithSalt` a3 `hashWithSalt` a4- hashWithSalt s (a1, a2, a3, a4) = s `hashWithSalt` a1 `hashWithSalt` a2- `hashWithSalt` a3 `hashWithSalt` a4--instance (Hashable a1, Hashable a2, Hashable a3, Hashable a4, Hashable a5)- => Hashable (a1, a2, a3, a4, a5) where- hash (a1, a2, a3, a4, a5) =- hash a1 `hashWithSalt` a2 `hashWithSalt` a3- `hashWithSalt` a4 `hashWithSalt` a5- hashWithSalt s (a1, a2, a3, a4, a5) =- s `hashWithSalt` a1 `hashWithSalt` a2 `hashWithSalt` a3- `hashWithSalt` a4 `hashWithSalt` a5--instance (Hashable a1, Hashable a2, Hashable a3, Hashable a4, Hashable a5,- Hashable a6) => Hashable (a1, a2, a3, a4, a5, a6) where- hash (a1, a2, a3, a4, a5, a6) =- hash a1 `hashWithSalt` a2 `hashWithSalt` a3- `hashWithSalt` a4 `hashWithSalt` a5 `hashWithSalt` a6- hashWithSalt s (a1, a2, a3, a4, a5, a6) =- s `hashWithSalt` a1 `hashWithSalt` a2 `hashWithSalt` a3- `hashWithSalt` a4 `hashWithSalt` a5 `hashWithSalt` a6--instance (Hashable a1, Hashable a2, Hashable a3, Hashable a4, Hashable a5,- Hashable a6, Hashable a7) =>- Hashable (a1, a2, a3, a4, a5, a6, a7) where- hash (a1, a2, a3, a4, a5, a6, a7) =- hash a1 `hashWithSalt` a2 `hashWithSalt` a3- `hashWithSalt` a4 `hashWithSalt` a5 `hashWithSalt` a6 `hashWithSalt` a7- hashWithSalt s (a1, a2, a3, a4, a5, a6, a7) =- s `hashWithSalt` a1 `hashWithSalt` a2 `hashWithSalt` a3- `hashWithSalt` a4 `hashWithSalt` a5 `hashWithSalt` a6 `hashWithSalt` a7--#if defined(__GLASGOW_HASKELL__) || defined(__HUGS__)-instance Hashable (StableName a) where- hash = hashStableName-#endif--instance Hashable a => Hashable [a] where- {-# SPECIALIZE instance Hashable [Char] #-}- hashWithSalt = foldl' hashWithSalt--instance Hashable B.ByteString where- hashWithSalt salt bs = B.inlinePerformIO $- B.unsafeUseAsCStringLen bs $ \(p, len) ->- hashPtrWithSalt p (fromIntegral len) salt--instance Hashable BL.ByteString where- hashWithSalt salt = BL.foldlChunks hashWithSalt salt--#if defined(__GLASGOW_HASKELL__)-instance Hashable T.Text where- hashWithSalt salt (T.Text arr off len) =- hashByteArrayWithSalt (TA.aBA arr) (off `shiftL` 1) (len `shiftL` 1)- salt--instance Hashable LT.Text where- hashWithSalt salt = LT.foldlChunks hashWithSalt salt-#endif----- | Compute the hash of a ThreadId. For GHC, we happen to know a--- trick to make this fast.-hashThreadId :: ThreadId -> Int-{-# INLINE hashThreadId #-}-#if defined(__GLASGOW_HASKELL__)-hashThreadId (ThreadId t) = hash (fromIntegral (getThreadId t) :: Int)-foreign import ccall unsafe "rts_getThreadId" getThreadId :: ThreadId# -> CInt-#else-hashThreadId = hash . show-#endif--instance Hashable ThreadId where- hash = hashThreadId- {-# INLINE hash #-}----- | Compute the hash of a TypeRep, in various GHC versions we can do this quickly.-hashTypeRep :: TypeRep -> Int-{-# INLINE hashTypeRep #-}-#if __GLASGOW_HASKELL__ >= 702--- Fingerprint is just the MD5, so taking any Int from it is fine-hashTypeRep (TypeRep (Fingerprint x _) _ _) = fromIntegral x-#elif __GLASGOW_HASKELL__ >= 606-hashTypeRep = B.inlinePerformIO . typeRepKey-#else-hashTypeRep = hash . show-#endif--instance Hashable TypeRep where- hash = hashTypeRep- {-# INLINE hash #-}+-- A good hash function has a 50% probability of flipping every bit of+-- its result in response to a change of just one bit in its+-- input. This property is called /avalanche/. To be truly general+-- purpose, hash functions must have strong avalanche behavior.+--+-- All of the 'Hashable' instances provided by this module have+-- excellent avalanche properties. +-- $generics+--+-- Beginning with GHC 7.2, the recommended way to make instances of+-- 'Hashable' for most types is to use the compiler's support for+-- automatically generating default instances.+--+-- > {-# LANGUAGE DeriveGeneric #-}+-- >+-- > import GHC.Generics (Generic)+-- > import Data.Hashable+-- >+-- > data Foo a = Foo a String+-- > deriving (Eq, Generic)+-- >+-- > instance Hashable a => Hashable (Foo a)+-- >+-- > data Colour = Red | Green | Blue+-- > deriving Generic+-- >+-- > instance Hashable Colour+--+-- If you omit a body for the instance declaration, GHC will generate+-- a default instance that correctly and efficiently hashes every+-- constructor and parameter. ---------------------------------------------------------------------------- * Creating new instances+-- $generic_err+--+-- Suppose you intend to use the generic machinery to automatically+-- generate a 'Hashable' instance.+--+-- > data Oops = Oops+-- > -- forgot to add "deriving Generic" here!+-- >+-- > instance Hashable Oops+--+-- And imagine that, as in the example above, you forget to add a+-- \"@deriving 'Generic'@\" clause to your data type. At compile time,+-- you will get an error message from GHC that begins roughly as+-- follows:+--+-- > No instance for (GHashable (Rep Oops))+--+-- This error can be confusing, as 'GHashable' is not exported (it is+-- an internal typeclass used by this library's generics machinery).+-- The correct fix is simply to add the missing \"@deriving+-- 'Generic'@\". -- $blocks --+-- To maintain high quality hashes, new 'Hashable' instances should be+-- built using existing 'Hashable' instances, combinators, and hash+-- functions.+-- -- The functions below can be used when creating new instances of--- 'Hashable'. For example, for many string-like types the+-- 'Hashable'. For many string-like types the -- 'hashWithSalt' method can be defined in terms of either -- 'hashPtrWithSalt' or 'hashByteArrayWithSalt'. Here's how you could -- implement an instance for the 'B.ByteString' data type, from the@@ -362,83 +144,78 @@ -- > B.unsafeUseAsCStringLen bs $ \(p, len) -> -- > hashPtrWithSalt p (fromIntegral len) salt ----- Use 'hashWithSalt' to create a hash value from several values,--- using this recipe:+-- Use 'hashWithSalt' to compute a hash from several values, using+-- this recipe: ----- > instance (Hashable a1, Hashable a2) => Hashable (a1, a2) where--- > hash (a1, a2) = hash a1 `hashWithSalt` a2+-- > data Product a b = P a b+-- >+-- > instance (Hashable a, Hashable b) => Hashable (Product a b) where+-- > hashWithSalt s (P a b) = s `hashWithSalt` a `hashWithSalt` b ----- You can combine multiple hash values using 'combine', using this--- recipe:+-- You can chain hashes together using 'hashWithSalt', by following+-- this recipe: ----- > combineTwo h1 h2 = 17 `combine` h1 `combine` h2+-- > combineTwo h1 h2 = h1 `hashWithSalt` h2++-- $ctors ----- As zero is a left identity of 'combine', a nonzero "seed" is used--- so that the number of combined hash values affects the final--- result, even if the first hash values are zero. The value 17 is--- arbitrary.+-- For a type with several value constructors, there are a few+-- possible approaches to writing a 'Hashable' instance. ----- When possible, use 'hashWithSalt' to compute a hash value from--- multiple values instead of computing separate hashes for each value--- and then combining them using 'combine'.---- | Compute a hash value for the content of this pointer.-hashPtr :: Ptr a -- ^ pointer to the data to hash- -> Int -- ^ length, in bytes- -> 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.+-- If the type is an instance of 'Enum', the easiest (and safest) path+-- is to convert it to an 'Int', and use the existing 'Hashable'+-- instance for 'Int'. ----- 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 ccall unsafe "hashable_fnv_hash" c_hashCString- :: CString -> CLong -> CLong -> IO CLong--#if defined(__GLASGOW_HASKELL__)--- | Compute a hash value for the content of this 'ByteArray#',--- beginning at the specified offset, using specified number of bytes.--- Availability: GHC.-hashByteArray :: ByteArray# -- ^ data to hash- -> Int -- ^ offset, in bytes- -> Int -- ^ length, in bytes- -> Int -- ^ hash value-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.+-- > data Color = Red | Green | Blue+-- > deriving Enum+-- >+-- > instance Hashable Color where+-- > hashWithSalt = hashUsing fromEnum ----- 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.+-- This instance benefits from the fact that the 'Hashable' instance+-- for 'Int' has excellent avalanche properties. ----- Availability: GHC.-hashByteArrayWithSalt- :: ByteArray# -- ^ data to hash- -> Int -- ^ offset, in bytes- -> Int -- ^ length, in bytes- -> Int -- ^ salt- -> Int -- ^ hash value-hashByteArrayWithSalt ba !off !len !h0 =- fromIntegral $ c_hashByteArray ba (fromIntegral off) (fromIntegral len)- (fromIntegral h0)--foreign import ccall unsafe "hashable_fnv_hash_offset" c_hashByteArray- :: ByteArray# -> CLong -> CLong -> CLong -> CLong-#endif---- | Combine two given hash values. 'combine' has zero as a left--- identity.-combine :: Int -> Int -> Int-combine h1 h2 = (h1 * 16777619) `xor` h2+-- In contrast, a very weak hash function would be:+--+-- > terribleHash :: Color -> Int+-- > terribleHash salt = fromEnum+--+-- This has terrible avalanche properties, as the salt is ignored, and+-- every input is mapped to a small integer.+--+-- If the type's constructors accept parameters, it can be important+-- to distinguish the constructors.+--+-- > data Time = Days Int+-- > | Weeks Int+-- > | Months Int+--+-- The weak hash function below guarantees a high probability of days,+-- weeks, and months all colliding when hashed.+--+-- > veryBadHash :: Time -> Int+-- > veryBadHash (Days d) = hash d+-- > veryBadHash (Weeks w) = hash w+-- > veryBadHash (Months m) = hash m+--+-- It is easy to distinguish the constructors using the `hashWithSalt`+-- function.+--+-- > instance Hashable Time where+-- > hashWithSalt s (Days n) = s `hashWithSalt`+-- > (0::Int) `hashWithSalt` n+-- > hashWithSalt s (Weeks n) = s `hashWithSalt`+-- > (1::Int) `hashWithSalt` n+-- > hashWithSalt s (Months n) = s `hashWithSalt`+-- > (2::Int) `hashWithSalt` n+--+-- If a constructor accepts multiple parameters, their hashes can be+-- chained.+--+-- > data Date = Date Int Int Int+-- >+-- > instance Hashable Date where+-- > hashWithSalt s (Date yr mo dy) =+-- > s `hashWithSalt`+-- > yr `hashWithSalt`+-- > mo `hashWithSalt` dy
+ Data/Hashable/Class.hs view
@@ -0,0 +1,516 @@+{-# LANGUAGE BangPatterns, CPP, ForeignFunctionInterface, MagicHash,+ ScopedTypeVariables, UnliftedFFITypes #-}+#ifdef GENERICS+{-# LANGUAGE DefaultSignatures, FlexibleContexts #-}+#endif++------------------------------------------------------------------------+-- |+-- Module : Data.Hashable.Class+-- Copyright : (c) Milan Straka 2010+-- (c) Johan Tibell 2011+-- (c) Bryan O'Sullivan 2011, 2012+-- License : BSD-style+-- Maintainer : johan.tibell@gmail.com+-- Stability : provisional+-- Portability : portable+--+-- This module defines a class, 'Hashable', for types that can be+-- converted to a hash value. This class exists for the benefit of+-- hashing-based data structures. The module provides instances for+-- most standard types.++module Data.Hashable.Class+ (+ -- * Computing hash values+ Hashable(..)+#ifdef GENERICS+ -- ** Support for generics+ , GHashable(..)+#endif+ , hash++ -- * Creating new instances+ , hashUsing+ , hashPtr+ , hashPtrWithSalt+#if defined(__GLASGOW_HASKELL__)+ , hashByteArray+ , hashByteArrayWithSalt+#endif+ ) where++import Control.Exception (assert)+import Data.Bits (shiftL, xor)+import Data.Int (Int8, Int16, Int32, Int64)+import Data.Word (Word, Word8, Word16, Word32, Word64)+import Data.List (foldl')+import Data.Ratio (Ratio, denominator, numerator)+import qualified Data.ByteString as B+import qualified Data.ByteString.Internal as B+import qualified Data.ByteString.Unsafe as B+import qualified Data.ByteString.Lazy as BL+import qualified Data.ByteString.Lazy.Internal as BL+#if defined(__GLASGOW_HASKELL__)+import qualified Data.Text as T+import qualified Data.Text.Array as TA+import qualified Data.Text.Internal as T+import qualified Data.Text.Lazy as TL+import qualified Data.Text.Lazy.Internal as TL+# ifdef GENERICS+import GHC.Generics+# endif+#endif+#if __GLASGOW_HASKELL__ >= 703+import Foreign.C (CSize(..))+#else+import Foreign.C (CSize)+#endif+import Foreign.Marshal.Utils (with)+import Foreign.Ptr (Ptr, castPtr, nullPtr)+import Foreign.Storable (alignment, peek, sizeOf)+import System.IO.Unsafe (unsafePerformIO)+import Foreign.Marshal.Array (advancePtr, allocaArray)++-- Byte arrays and Integers.+#if defined(__GLASGOW_HASKELL__)+import GHC.Base (ByteArray#)+# ifdef VERSION_integer_gmp+import GHC.Exts (Int(..))+import GHC.Integer.GMP.Internals (Integer(..))+# else+import Data.Bits (shiftR)+# endif+#endif++-- ThreadId+#if defined(__GLASGOW_HASKELL__)+import GHC.Conc (ThreadId(..))+import GHC.Prim (ThreadId#)+# if __GLASGOW_HASKELL__ >= 703+import Foreign.C.Types (CInt(..))+# else+import Foreign.C.Types (CInt)+# endif+#else+import Control.Concurrent (ThreadId)+#endif++#if defined(__GLASGOW_HASKELL__) || defined(__HUGS__)+import System.Mem.StableName+#endif++import Data.Typeable+#if __GLASGOW_HASKELL__ >= 702+import GHC.Fingerprint.Type(Fingerprint(..))+import Data.Typeable.Internal(TypeRep(..))+#endif++#ifndef FIXED_SALT+import Data.Hashable.RandomSource (getRandomBytes_)+import Foreign.Marshal.Alloc (alloca)+#endif++#include "MachDeps.h"++infixl 0 `hashWithSalt`++------------------------------------------------------------------------+-- * Computing hash values++-- | A default salt used in the implementation of 'hash'.+--+-- To reduce the probability of hash collisions, the value of the+-- default salt will vary from one program invocation to the next+-- unless this package is compiled with the @fixed-salt@ flag set.+defaultSalt :: Int++#ifdef FIXED_SALT++defaultSalt = 0xdc36d1615b7400a4+{-# INLINE defaultSalt #-}++#else++defaultSalt = unsafePerformIO . alloca $ \p -> do+ getRandomBytes_ "defaultSalt" p (sizeOf (undefined :: Int))+ peek p+{-# NOINLINE defaultSalt #-}++#endif++-- | The class of types that can be converted to a hash value.+class Hashable a where+ -- | Return a hash value for the argument, using the given salt.+ --+ -- The general contract of 'hashWithSalt' is:+ --+ -- * If a value is hashed using the same salt during distinct+ -- runs of an application, the result must remain the+ -- same. (This is necessary to make it possible to store hashes+ -- on persistent media.)+ --+ -- * If two values are equal according to the '==' method, then+ -- applying the 'hashWithSalt' method on each of the two values+ -- /must/ produce the same integer result if the same salt is+ -- used in each case.+ --+ -- * It is /not/ required that if two values are unequal+ -- according to the '==' method, then applying the+ -- 'hashWithSalt' method on each of the two values must produce+ -- distinct integer results. (Every programmer will be aware+ -- that producing distinct integer results for unequal values+ -- will improve the performance of hashing-based data+ -- structures.)+ --+ -- This method can be used to compute different hash values for+ -- the same input by providing a different salt in each+ -- application of the method. This implies that any instance that+ -- defines 'hashWithSalt' /must/ make use of the salt in its+ -- implementation.+ hashWithSalt :: Int -> a -> Int++#ifdef GENERICS+ default hashWithSalt :: (Generic a, GHashable (Rep a)) => Int -> a -> Int+ hashWithSalt salt = ghashWithSalt salt . from++-- | The class of types that can be generically hashed.+class GHashable f where+ ghashWithSalt :: Int -> f a -> Int+#endif++-- | Return a hash value for the argument. Defined in terms of+-- 'hashWithSalt' and a default salt.+--+-- At application startup time, the default salt is initialized with a+-- new value from the system's cryptographic pseudo-random number+-- generator. This means that the result of 'hash' will vary from one+-- application run to the next.+--+-- If you need hashes that do not vary from run to run, use+-- 'hashWithSalt' instead, and supply a salt of your choosing. (Be+-- aware that if you hash untrusted, uncontrolled input data using a+-- fixed salt, you may expose your application to hash collision+-- attacks.)+hash :: Hashable a => a -> Int+hash = hashWithSalt defaultSalt++-- | Transform a value into a 'Hashable' value, then hash the+-- transformed value using the given salt.+--+-- This is a useful shorthand in cases where a type can easily be+-- mapped to another type that is already an instance of 'Hashable'.+-- Example:+--+-- > data Foo = Foo | Bar+-- > deriving (Enum)+-- >+-- > instance Hashable Foo where+-- > hashWithSalt = hashUsing fromEnum+hashUsing :: (Hashable b) =>+ (a -> b) -- ^ Transformation function.+ -> Int -- ^ Salt.+ -> a -- ^ Value to transform.+ -> Int+hashUsing f salt x = hashWithSalt salt (f x)+{-# INLINE hashUsing #-}++instance Hashable Int where hashWithSalt = hashNative+instance Hashable Int8 where hashWithSalt = hashNative+instance Hashable Int16 where hashWithSalt = hashNative+instance Hashable Int32 where hashWithSalt = hashNative+instance Hashable Int64 where hashWithSalt = hash64++instance Hashable Word where hashWithSalt = hashNative+instance Hashable Word8 where hashWithSalt = hashNative+instance Hashable Word16 where hashWithSalt = hashNative+instance Hashable Word32 where hashWithSalt = hashNative+instance Hashable Word64 where hashWithSalt = hash64++instance Hashable () where hashWithSalt = hashUsing fromEnum+instance Hashable Bool where hashWithSalt = hashUsing fromEnum+instance Hashable Ordering where hashWithSalt = hashUsing fromEnum+instance Hashable Char where hashWithSalt = hashUsing fromEnum++-- | Hash an integer of at most the native width supported by the+-- machine.+hashNative :: (Integral a) => Int -> a -> Int+hashNative salt = fromIntegral . go . xor (fromIntegral salt) . fromIntegral+ where+#if WORD_SIZE_IN_BITS == 32+ go = c_wang32+#else+ go = c_wang64+#endif++-- | Hash a 64-bit integer.+hash64 :: (Integral a) => Int -> a -> Int+hash64 salt = fromIntegral . c_wang64 . xor (fromIntegral salt) . fromIntegral++instance Hashable Integer where+#if defined(__GLASGOW_HASKELL__) && defined(VERSION_integer_gmp)+ hashWithSalt salt (S# int) = hashWithSalt salt (I# int)+ hashWithSalt salt n@(J# size byteArray)+ | n >= minInt && n <= maxInt = hashWithSalt salt (fromInteger n :: Int)+ | otherwise = let numBytes = SIZEOF_HSWORD * (I# size)+ in hashByteArrayWithSalt byteArray 0 numBytes salt+ where minInt = fromIntegral (minBound :: Int)+ maxInt = fromIntegral (maxBound :: Int)+#else+ hashWithSalt salt = foldl' hashWithSalt salt . go+ where+ go n | inBounds n = [fromIntegral n :: Int]+ | otherwise = fromIntegral n : go (n `shiftR` WORD_SIZE_IN_BITS)+ maxInt = fromIntegral (maxBound :: Int)+ inBounds x = x >= fromIntegral (minBound :: Int) && x <= maxInt+#endif++instance (Integral a, Hashable a) => Hashable (Ratio a) where+ {-# SPECIALIZE instance Hashable (Ratio Integer) #-}+ hashWithSalt s a = s `hashWithSalt` numerator a `hashWithSalt` denominator a++instance Hashable Float where+ hashWithSalt salt x+ | isIEEE x =+ assert (sizeOf x >= sizeOf (0::Word32) &&+ alignment x >= alignment (0::Word32)) $+ hashWithSalt salt+ ((unsafePerformIO $ with x $ peek . castPtr) :: Word32)+ | otherwise = hashWithSalt salt (show x)++instance Hashable Double where+ hashWithSalt salt x+ | isIEEE x =+ assert (sizeOf x >= sizeOf (0::Word64) &&+ alignment x >= alignment (0::Word64)) $+ hashWithSalt salt+ ((unsafePerformIO $ with x $ peek . castPtr) :: Word64)+ | otherwise = hashWithSalt salt (show x)++-- | A value with bit pattern (01)* (or 5* in hexa), for any size of Int.+-- It is used as data constructor distinguisher. GHC computes its value during+-- compilation.+distinguisher :: Int+distinguisher = fromIntegral $ (maxBound :: Word) `quot` 3+{-# INLINE distinguisher #-}++instance Hashable a => Hashable (Maybe a) where+ hashWithSalt s Nothing = hashWithSalt s (0::Int)+ hashWithSalt s (Just a) = hashWithSalt s a `hashWithSalt` distinguisher++instance (Hashable a, Hashable b) => Hashable (Either a b) where+ hashWithSalt s (Left a) = hashWithSalt s a+ hashWithSalt s (Right b) = hashWithSalt s b `hashWithSalt` distinguisher++instance (Hashable a1, Hashable a2) => Hashable (a1, a2) where+ hashWithSalt s (a1, a2) = s `hashWithSalt` a1 `hashWithSalt` a2++instance (Hashable a1, Hashable a2, Hashable a3) => Hashable (a1, a2, a3) where+ hashWithSalt s (a1, a2, a3) = s `hashWithSalt` a1 `hashWithSalt` a2+ `hashWithSalt` a3++instance (Hashable a1, Hashable a2, Hashable a3, Hashable a4) =>+ Hashable (a1, a2, a3, a4) where+ hashWithSalt s (a1, a2, a3, a4) = s `hashWithSalt` a1 `hashWithSalt` a2+ `hashWithSalt` a3 `hashWithSalt` a4++instance (Hashable a1, Hashable a2, Hashable a3, Hashable a4, Hashable a5)+ => Hashable (a1, a2, a3, a4, a5) where+ hashWithSalt s (a1, a2, a3, a4, a5) =+ s `hashWithSalt` a1 `hashWithSalt` a2 `hashWithSalt` a3+ `hashWithSalt` a4 `hashWithSalt` a5++instance (Hashable a1, Hashable a2, Hashable a3, Hashable a4, Hashable a5,+ Hashable a6) => Hashable (a1, a2, a3, a4, a5, a6) where+ hashWithSalt s (a1, a2, a3, a4, a5, a6) =+ s `hashWithSalt` a1 `hashWithSalt` a2 `hashWithSalt` a3+ `hashWithSalt` a4 `hashWithSalt` a5 `hashWithSalt` a6++instance (Hashable a1, Hashable a2, Hashable a3, Hashable a4, Hashable a5,+ Hashable a6, Hashable a7) =>+ Hashable (a1, a2, a3, a4, a5, a6, a7) where+ hashWithSalt s (a1, a2, a3, a4, a5, a6, a7) =+ s `hashWithSalt` a1 `hashWithSalt` a2 `hashWithSalt` a3+ `hashWithSalt` a4 `hashWithSalt` a5 `hashWithSalt` a6 `hashWithSalt` a7++#if defined(__GLASGOW_HASKELL__) || defined(__HUGS__)+instance Hashable (StableName a) where+ hashWithSalt = hashUsing hashStableName+#endif++instance Hashable a => Hashable [a] where+ hashWithSalt = foldl' hashWithSalt++{-# RULES "hashWithSalt/String"+ forall s v. hashWithSalt s (v::[Char]) = hashWithSalt s (T.pack v) #-}++{-# RULES "hash/String"+ forall v. hash (v::[Char]) = hash (T.pack v) #-}++instance Hashable B.ByteString where+ hashWithSalt salt bs = B.inlinePerformIO $+ B.unsafeUseAsCStringLen bs $ \(p, len) ->+ hashPtrWithSalt p (fromIntegral len) salt++instance Hashable BL.ByteString where+ hashWithSalt = hashLazyByteStringWithSalt++#if defined(__GLASGOW_HASKELL__)+instance Hashable T.Text where+ hashWithSalt salt (T.Text arr off len) =+ hashByteArrayWithSalt (TA.aBA arr) (off `shiftL` 1) (len `shiftL` 1)+ salt++instance Hashable TL.Text where+ hashWithSalt = hashLazyTextWithSalt+#endif+++-- | Compute the hash of a ThreadId. For GHC, we happen to know a+-- trick to make this fast.+hashThreadId :: ThreadId -> Int+{-# INLINE hashThreadId #-}+#if defined(__GLASGOW_HASKELL__)+hashThreadId (ThreadId t) = hash (fromIntegral (getThreadId t) :: Int)+foreign import ccall unsafe "rts_getThreadId" getThreadId :: ThreadId# -> CInt+#else+hashThreadId = hash . show+#endif++instance Hashable ThreadId where+ hashWithSalt = hashUsing hashThreadId+ {-# INLINE hashWithSalt #-}+++-- | Compute the hash of a TypeRep, in various GHC versions we can do this quickly.+hashTypeRep :: Int -> TypeRep -> Int+{-# INLINE hashTypeRep #-}+#if __GLASGOW_HASKELL__ >= 702+-- Fingerprint is just the MD5, so taking any Int from it is fine+hashTypeRep salt (TypeRep (Fingerprint x _) _ _) = hashWithSalt salt x+#elif __GLASGOW_HASKELL__ >= 606+hashTypeRep = hashUsing (B.inlinePerformIO . typeRepKey)+#else+hashTypeRep = hashUsing show+#endif++instance Hashable TypeRep where+ hashWithSalt = hashTypeRep+ {-# INLINE hashWithSalt #-}++-- | Compute a hash value for the content of this pointer.+hashPtr :: Ptr a -- ^ pointer to the data to hash+ -> Int -- ^ length, in bytes+ -> 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_siphash24 k0 (fromSalt salt) (castPtr p)+ (fromIntegral len)++k0 :: Word64+k0 = 0x56e2b8a0aee1721a+{-# INLINE k0 #-}++hashLazyByteStringWithSalt :: Int -> BL.ByteString -> Int+hashLazyByteStringWithSalt salt cs0 = unsafePerformIO . allocaArray 5 $ \v -> do+ c_siphash_init k0 (fromSalt salt) v+ let go !buffered !totallen (BL.Chunk c cs) =+ B.unsafeUseAsCStringLen c $ \(ptr, len) -> do+ let len' = fromIntegral len+ buffered' <- c_siphash24_chunk buffered v (castPtr ptr) len' (-1)+ go buffered' (totallen + len') cs+ go buffered totallen _ = do+ _ <- c_siphash24_chunk buffered v nullPtr 0 totallen+ fromIntegral `fmap` peek (v `advancePtr` 4)+ go 0 0 cs0++#if defined(__GLASGOW_HASKELL__)+hashLazyTextWithSalt :: Int -> TL.Text -> Int+hashLazyTextWithSalt salt cs0 = unsafePerformIO . allocaArray 5 $ \v -> do+ c_siphash_init k0 (fromSalt salt) v+ let go !buffered !totallen (TL.Chunk (T.Text arr off len) cs) = do+ let len' = fromIntegral (len `shiftL` 1)+ buffered' <- c_siphash24_chunk_offset buffered v (TA.aBA arr)+ (fromIntegral (off `shiftL` 1)) len' (-1)+ go buffered' (totallen + len') cs+ go buffered totallen _ = do+ _ <- c_siphash24_chunk buffered v nullPtr 0 totallen+ fromIntegral `fmap` peek (v `advancePtr` 4)+ go 0 0 cs0+#endif++fromSalt :: Int -> Word64+#if WORD_SIZE_IN_BITS == 64+fromSalt = fromIntegral+#else+fromSalt v = fromIntegral v `xor` k1++k1 :: Word64+k1 = 0x7654954208bdfef9+{-# INLINE k1 #-}+#endif++foreign import ccall unsafe "hashable_siphash24" c_siphash24+ :: Word64 -> Word64 -> Ptr Word8 -> CSize -> IO Word64++#if defined(__GLASGOW_HASKELL__)+-- | Compute a hash value for the content of this 'ByteArray#',+-- beginning at the specified offset, using specified number of bytes.+-- Availability: GHC.+hashByteArray :: ByteArray# -- ^ data to hash+ -> Int -- ^ offset, in bytes+ -> Int -- ^ length, in bytes+ -> Int -- ^ hash value+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.+--+-- Availability: GHC.+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_siphash24_offset k0 (fromSalt h) ba (fromIntegral off) (fromIntegral len)++foreign import ccall unsafe "hashable_siphash24_offset" c_siphash24_offset+ :: Word64 -> Word64 -> ByteArray# -> CSize -> CSize -> Word64++foreign import ccall unsafe "hashable_siphash24_chunk_offset"+ c_siphash24_chunk_offset+ :: CInt -> Ptr Word64 -> ByteArray# -> CSize -> CSize -> CSize -> IO CInt+#endif++#if WORD_SIZE_IN_BITS == 32+foreign import ccall unsafe "hashable_wang_32" c_wang32+ :: Word32 -> Word32+#endif++foreign import ccall unsafe "hashable_wang_64" c_wang64+ :: Word64 -> Word64++foreign import ccall unsafe "hashable_siphash_init" c_siphash_init+ :: Word64 -> Word64 -> Ptr Word64 -> IO ()++foreign import ccall unsafe "hashable_siphash24_chunk" c_siphash24_chunk+ :: CInt -> Ptr Word64 -> Ptr Word8 -> CSize -> CSize -> IO CInt
+ Data/Hashable/Generic.hs view
@@ -0,0 +1,74 @@+{-# LANGUAGE BangPatterns, FlexibleInstances, KindSignatures,+ ScopedTypeVariables, TypeOperators #-}+{-# OPTIONS_GHC -fno-warn-orphans #-}++------------------------------------------------------------------------+-- |+-- Module : Data.Hashable.Generic+-- Copyright : (c) Bryan O'Sullivan 2012+-- License : BSD-style+-- Maintainer : bos@serpentine.com+-- Stability : provisional+-- Portability : GHC >= 7.2+--+-- Hashable support for GHC generics.++module Data.Hashable.Generic+ (+ ) where++import Data.Bits (Bits, shiftR)+import Data.Hashable.Class+import GHC.Generics++-- Type without constructors+instance GHashable V1 where+ ghashWithSalt salt _ = hashWithSalt salt ()++-- Constructor without arguments+instance GHashable U1 where+ ghashWithSalt salt U1 = hashWithSalt salt ()++instance (GHashable a, GHashable b) => GHashable (a :*: b) where+ ghashWithSalt salt (x :*: y) = salt `ghashWithSalt` x `ghashWithSalt` y++-- Metadata (constructor name, etc)+instance GHashable a => GHashable (M1 i c a) where+ ghashWithSalt salt = ghashWithSalt salt . unM1++-- Constants, additional parameters, and rank-1 recursion+instance Hashable a => GHashable (K1 i a) where+ ghashWithSalt = hashUsing unK1++class GSum f where+ hashSum :: Int -> Int -> Int -> f a -> Int++instance (GSum a, GSum b, GHashable a, GHashable b,+ SumSize a, SumSize b) => GHashable (a :+: b) where+ ghashWithSalt salt = hashSum salt 0 size+ where size = unTagged (sumSize :: Tagged (a :+: b))++instance (GSum a, GSum b, GHashable a, GHashable b) => GSum (a :+: b) where+ hashSum !salt !code !size s = case s of+ L1 x -> hashSum salt code sizeL x+ R1 x -> hashSum salt (code + sizeL) sizeR x+ where+ sizeL = size `shiftR` 1+ sizeR = size - sizeL+ {-# INLINE hashSum #-}++instance GHashable a => GSum (C1 c a) where+ hashSum !salt !code _ x = salt `hashWithSalt` code `ghashWithSalt` x+ {-# INLINE hashSum #-}++class SumSize f where+ sumSize :: Tagged f++newtype Tagged (s :: * -> *) = Tagged {unTagged :: Int}++instance (SumSize a, SumSize b) => SumSize (a :+: b) where+ sumSize = Tagged $ unTagged (sumSize :: Tagged a) ++ unTagged (sumSize :: Tagged b)++instance SumSize (C1 c a) where+ sumSize = Tagged 1
+ Data/Hashable/RandomSource.hs view
@@ -0,0 +1,29 @@+{-# LANGUAGE CPP, ForeignFunctionInterface #-}++module Data.Hashable.RandomSource+ (+ getRandomBytes+ , getRandomBytes_+ ) where++import Data.ByteString as B+import Data.ByteString.Internal (create)+import Foreign.C.Error (throwErrnoIfMinus1_)+#if MIN_VERSION_base(4,5,0)+import Foreign.C.Types (CInt(CInt))+#else+import Foreign.C.Types (CInt)+#endif+import Foreign.Ptr (Ptr)++getRandomBytes :: Int -> IO ByteString+getRandomBytes nbytes+ | nbytes <= 0 = return B.empty+ | otherwise = create nbytes $ flip (getRandomBytes_ "getRandomBytes") nbytes++getRandomBytes_ :: String -> Ptr a -> Int -> IO ()+getRandomBytes_ what ptr nbytes = do+ throwErrnoIfMinus1_ what $ c_getRandomBytes ptr (fromIntegral nbytes)++foreign import ccall unsafe "hashable_getRandomBytes" c_getRandomBytes+ :: Ptr a -> CInt -> IO CInt
+ Data/Hashable/SipHash.hs view
@@ -0,0 +1,159 @@+{-# LANGUAGE BangPatterns, CPP, GeneralizedNewtypeDeriving, RecordWildCards #-}+{-# OPTIONS_GHC -fno-warn-name-shadowing #-}++module Data.Hashable.SipHash+ (+ LE64+ , Sip+ , fromWord64+ , fullBlock+ , lastBlock+ , finalize+ , hashByteString+ ) where++#include "MachDeps.h"++import Data.Bits ((.|.), (.&.), rotateL, shiftL, xor)+#if MIN_VERSION_base(4,5,0)+import Data.Bits (unsafeShiftL)+#endif+import Data.Word (Word8, Word64)+import Foreign.ForeignPtr (withForeignPtr)+import Foreign.Ptr (Ptr, castPtr, plusPtr)+import Data.ByteString.Internal (ByteString(PS), inlinePerformIO)+import Foreign.Storable (peek)+import Numeric (showHex)++newtype LE64 = LE64 { fromLE64 :: Word64 }+ deriving (Eq)++instance Show LE64 where+ show (LE64 !v) = let s = showHex v ""+ in "0x" ++ replicate (16 - length s) '0' ++ s++data Sip = Sip {+ v0 :: {-# UNPACK #-} !Word64, v1 :: {-# UNPACK #-} !Word64+ , v2 :: {-# UNPACK #-} !Word64, v3 :: {-# UNPACK #-} !Word64+ }++fromWord64 :: Word64 -> LE64+#ifndef WORDS_BIGENDIAN+fromWord64 = LE64+#else+#error big endian support TBD+#endif++initState :: (Sip -> r) -> Word64 -> Word64 -> r+initState k k0 k1 = k (Sip s0 s1 s2 s3)+ where !s0 = (k0 `xor` 0x736f6d6570736575)+ !s1 = (k1 `xor` 0x646f72616e646f6d)+ !s2 = (k0 `xor` 0x6c7967656e657261)+ !s3 = (k1 `xor` 0x7465646279746573)++sipRound :: (Sip -> r) -> Sip -> r+sipRound k Sip{..} = k (Sip v0_c v1_d v2_c v3_d)+ where v0_a = v0 + v1+ v2_a = v2 + v3+ v1_a = v1 `rotateL` 13+ v3_a = v3 `rotateL` 16+ v1_b = v1_a `xor` v0_a+ v3_b = v3_a `xor` v2_a+ v0_b = v0_a `rotateL` 32+ v2_b = v2_a + v1_b+ v0_c = v0_b + v3_b+ v1_c = v1_b `rotateL` 17+ v3_c = v3_b `rotateL` 21+ v1_d = v1_c `xor` v2_b+ v3_d = v3_c `xor` v0_c+ v2_c = v2_b `rotateL` 32++fullBlock :: Int -> LE64 -> (Sip -> r) -> Sip -> r+fullBlock c m k st@Sip{..}+ | c == 2 = sipRound (sipRound k') st'+ | otherwise = runRounds c k' st'+ where k' st1@Sip{..} = k st1{ v0 = v0 `xor` fromLE64 m }+ st' = st{ v3 = v3 `xor` fromLE64 m }+{-# INLINE fullBlock #-}++runRounds :: Int -> (Sip -> r) -> Sip -> r+runRounds c k = go 0+ where go i st+ | i < c = sipRound (go (i+1)) st+ | otherwise = k st+{-# INLINE runRounds #-}++lastBlock :: Int -> Int -> LE64 -> (Sip -> r) -> Sip -> r+lastBlock !c !len !m k st =+#ifndef WORDS_BIGENDIAN+ fullBlock c (LE64 m') k st+#else+#error big endian support TBD+#endif+ where m' = fromLE64 m .|. ((fromIntegral len .&. 0xff) `shiftL` 56)+{-# INLINE lastBlock #-}++finalize :: Int -> (Word64 -> r) -> Sip -> r+finalize d k st@Sip{..}+ | d == 4 = sipRound (sipRound (sipRound (sipRound k'))) st'+ | otherwise = runRounds d k' st'+ where k' Sip{..} = k $! v0 `xor` v1 `xor` v2 `xor` v3+ st' = st{ v2 = v2 `xor` 0xff }+{-# INLINE finalize #-}++hashByteString :: Int -> Int -> Word64 -> Word64 -> ByteString -> Word64+hashByteString !c !d k0 k1 (PS fp off len) =+ inlinePerformIO . withForeignPtr fp $ \basePtr ->+ let ptr0 = basePtr `plusPtr` off+ scant = len .&. 7+ endBlocks = ptr0 `plusPtr` (len - scant)+ go !ptr st+ | ptr == endBlocks = readLast ptr+ | otherwise = do+ m <- peekLE64 ptr+ fullBlock c m (go (ptr `plusPtr` 8)) st+ where+ zero !m _ _ = lastBlock c len (LE64 m) (finalize d return) st+ one k m p s = do+ w <- fromIntegral `fmap` peekByte p+ k (m .|. (w `unsafeShiftL` s)) (p `plusPtr` 1) (s+8)+ readLast p =+ case scant of+ 0 -> zero 0 p (0::Int)+ 1 -> one zero 0 p 0+ 2 -> one (one zero) 0 p 0+ 3 -> one (one (one zero)) 0 p 0+ 4 -> one (one (one (one zero))) 0 p 0+ 5 -> one (one (one (one (one zero)))) 0 p 0+ 6 -> one (one (one (one (one (one zero))))) 0 p 0+ _ -> one (one (one (one (one (one (one zero)))))) 0 p 0+ in initState (go ptr0) k0 k1++peekByte :: Ptr Word8 -> IO Word8+peekByte = peek++peekLE64 :: Ptr Word8 -> IO LE64+#if defined(x86_64_HOST_ARCH) || defined(i386_HOST_ARCH)+-- platforms on which unaligned loads are legal and usually fast+peekLE64 p = LE64 `fmap` peek (castPtr p)+#else+peekLE64 p = do+ let peek8 d = fromIntegral `fmap` peekByte (p `plusPtr` d)+ b0 <- peek8 0+ b1 <- peek8 1+ b2 <- peek8 2+ b3 <- peek8 3+ b4 <- peek8 4+ b5 <- peek8 5+ b6 <- peek8 6+ b7 <- peek8 7+ let !w = (b7 `shiftL` 56) .|. (b6 `shiftL` 48) .|. (b5 `shiftL` 40) .|.+ (b4 `shiftL` 32) .|. (b3 `shiftL` 24) .|. (b2 `shiftL` 16) .|.+ (b1 `shiftL` 8) .|. b0+ return (fromWord64 w)+#endif++#if !MIN_VERSION_base(4,5,0)+unsafeShiftL :: Word64 -> Int -> Word64+unsafeShiftL = shiftL+#endif
benchmarks/Benchmarks.hs view
@@ -1,13 +1,25 @@-{-# LANGUAGE BangPatterns, MagicHash, UnboxedTuples #-}+{-# LANGUAGE BangPatterns, CPP, ForeignFunctionInterface, MagicHash,+ UnboxedTuples #-} module Main (main) where import Control.Monad.ST import Criterion.Main import Data.Hashable+import Data.Hashable.SipHash+import Data.Int import Foreign.ForeignPtr import GHC.Exts import GHC.ST (ST(..))+import Data.Word+import Foreign.C.Types (CInt(..), CLong(..), CSize(..))+import Foreign.Ptr+import Data.ByteString.Internal+import qualified Data.ByteString.Lazy as BL+import qualified Data.Text as T+import qualified Data.Text.Lazy as TL+import qualified Crypto.MAC.SipHash as HS+import qualified Data.ByteString.Char8 as B8 -- Benchmark English words (5 and 8), base64 encoded integers (11), -- SHA1 hashes as hex (40), and large blobs (1 Mb).@@ -18,20 +30,69 @@ fp8 <- mallocForeignPtrBytes 8 fp11 <- mallocForeignPtrBytes 11 fp40 <- mallocForeignPtrBytes 40+ fp128 <- mallocForeignPtrBytes 128+ fp512 <- mallocForeignPtrBytes 512 let !mb = 2^(20 :: Int) -- 1 Mb fp1Mb <- mallocForeignPtrBytes mb- + -- We don't care about the contents of these either.- let !ba5 = new 5- !ba8 = new 8- !ba11 = new 11- !ba40 = new 40- !ba1Mb = new mb- + let !ba5 = new 5; !ba8 = new 8; !ba11 = new 11; !ba40 = new 40+ !ba128 = new 128; !ba512 = new 512; !ba1Mb = new mb++ s5 = ['\0'..'\4']; s8 = ['\0'..'\7']; s11 = ['\0'..'\10']+ s40 = ['\0'..'\39']; s128 = ['\0'..'\127']; s512 = ['\0'..'\511']+ s1Mb = ['\0'..'\999999']++ !bs5 = B8.pack s5; !bs8 = B8.pack s8; !bs11 = B8.pack s11+ !bs40 = B8.pack s40; !bs128 = B8.pack s128; !bs512 = B8.pack s512+ !bs1Mb = B8.pack s1Mb++ blmeg = BL.take (fromIntegral mb) . BL.fromChunks . repeat+ bl5 = BL.fromChunks [bs5]; bl8 = BL.fromChunks [bs8]+ bl11 = BL.fromChunks [bs11]; bl40 = BL.fromChunks [bs40]+ bl128 = BL.fromChunks [bs128]; bl512 = BL.fromChunks [bs512]+ bl1Mb_40 = blmeg bs40; bl1Mb_128 = blmeg bs128+ bl1Mb_64k = blmeg (B8.take 65536 bs1Mb)++ !t5 = T.pack s5; !t8 = T.pack s8; !t11 = T.pack s11+ !t40 = T.pack s40; !t128 = T.pack s128; !t512 = T.pack s512+ !t1Mb = T.pack s1Mb++ tlmeg = TL.take (fromIntegral mb) . TL.fromChunks . repeat+ tl5 = TL.fromStrict t5; tl8 = TL.fromStrict t8+ tl11 = TL.fromStrict t11; tl40 = TL.fromStrict t40+ tl128 = TL.fromStrict t128; tl512 = TL.fromChunks (replicate 4 t128)+ tl1Mb_40 = tlmeg t40; tl1Mb_128 = tlmeg t128+ tl1Mb_64k = tlmeg (T.take 65536 t1Mb)++ let k0 = 0x4a7330fae70f52e8+ k1 = 0x919ea5953a9a1ec9+ sipHash = hashByteString 2 4 k0 k1+ hsSipHash = HS.hash (HS.SipKey k0 k1)+ cSipHash (PS fp off len) =+ inlinePerformIO . withForeignPtr fp $ \ptr ->+ return $! c_siphash 2 4 k0 k1 (ptr `plusPtr` off) (fromIntegral len)+ cSipHash24 (PS fp off len) =+ inlinePerformIO . withForeignPtr fp $ \ptr ->+ return $! c_siphash24 k0 k1 (ptr `plusPtr` off) (fromIntegral len)+ fnvHash (PS fp off len) =+ inlinePerformIO . withForeignPtr fp $ \ptr ->+ return $! fnv_hash (ptr `plusPtr` off) (fromIntegral len) 2166136261+#ifdef HAVE_SSE+ sse2SipHash (PS fp off len) =+ inlinePerformIO . withForeignPtr fp $ \ptr ->+ return $! sse2_siphash k0 k1 (ptr `plusPtr` off) (fromIntegral len)+ sse41SipHash (PS fp off len) =+ inlinePerformIO . withForeignPtr fp $ \ptr ->+ return $! sse41_siphash k0 k1 (ptr `plusPtr` off) (fromIntegral len)+#endif+ withForeignPtr fp5 $ \ p5 -> withForeignPtr fp8 $ \ p8 -> withForeignPtr fp11 $ \ p11 -> withForeignPtr fp40 $ \ p40 ->+ withForeignPtr fp128 $ \ p128 ->+ withForeignPtr fp512 $ \ p512 -> withForeignPtr fp1Mb $ \ p1Mb -> defaultMain [ bgroup "hashPtr"@@ -39,6 +100,8 @@ , bench "8" $ hashPtr p8 8 , bench "11" $ hashPtr p11 11 , bench "40" $ hashPtr p40 40+ , bench "128" $ hashPtr p128 128+ , bench "512" $ hashPtr p512 512 , bench "2^20" $ hashPtr p1Mb mb ] , bgroup "hashByteArray"@@ -46,8 +109,144 @@ , bench "8" $ whnf (hashByteArray ba8 0) 8 , bench "11" $ whnf (hashByteArray ba11 0) 11 , bench "40" $ whnf (hashByteArray ba40 0) 40+ , bench "128" $ whnf (hashByteArray ba128 0) 128+ , bench "512" $ whnf (hashByteArray ba512 0) 512 , bench "2^20" $ whnf (hashByteArray ba1Mb 0) mb ]+ , bgroup "hash"+ [ bgroup "ByteString"+ [ bgroup "strict"+ [ bench "5" $ whnf hash bs5+ , bench "8" $ whnf hash bs8+ , bench "11" $ whnf hash bs11+ , bench "40" $ whnf hash bs40+ , bench "128" $ whnf hash bs128+ , bench "512" $ whnf hash bs512+ , bench "2^20" $ whnf hash bs1Mb+ ]+ , bgroup "lazy"+ [ bench "5" $ whnf hash bl5+ , bench "8" $ whnf hash bl8+ , bench "11" $ whnf hash bl11+ , bench "40" $ whnf hash bl40+ , bench "128" $ whnf hash bl128+ , bench "512" $ whnf hash bl512+ , bench "2^20_40" $ whnf hash bl1Mb_40+ , bench "2^20_128" $ whnf hash bl1Mb_128+ , bench "2^20_64k" $ whnf hash bl1Mb_64k+ ]+ ]+ , bgroup "String"+ [ bench "5" $ whnf hash s5+ , bench "8" $ whnf hash s8+ , bench "11" $ whnf hash s11+ , bench "40" $ whnf hash s40+ , bench "128" $ whnf hash s128+ , bench "512" $ whnf hash s512+ , bench "2^20" $ whnf hash s1Mb+ ]+ , bgroup "Text"+ [ bgroup "strict"+ [ bench "5" $ whnf hash t5+ , bench "8" $ whnf hash t8+ , bench "11" $ whnf hash t11+ , bench "40" $ whnf hash t40+ , bench "128" $ whnf hash t128+ , bench "512" $ whnf hash t512+ , bench "2^20" $ whnf hash t1Mb+ ]+ , bgroup "lazy"+ [ bench "5" $ whnf hash tl5+ , bench "8" $ whnf hash tl8+ , bench "11" $ whnf hash tl11+ , bench "40" $ whnf hash tl40+ , bench "128" $ whnf hash tl128+ , bench "512" $ whnf hash tl512+ , bench "2^20_40" $ whnf hash tl1Mb_40+ , bench "2^20_128" $ whnf hash tl1Mb_128+ , bench "2^20_64k" $ whnf hash tl1Mb_64k+ ]+ ]+ , bench "Int8" $ whnf hash (0xef :: Int8)+ , bench "Int16" $ whnf hash (0x7eef :: Int16)+ , bench "Int32" $ whnf hash (0x7eadbeef :: Int32)+ , bench "Int" $ whnf hash (0x7eadbeefdeadbeef :: Int)+ , bench "Int64" $ whnf hash (0x7eadbeefdeadbeef :: Int64)+ , bench "Double" $ whnf hash (0.3780675796601578 :: Double)+ ]+ , bgroup "sipHash"+ [ bench "5" $ whnf sipHash bs5+ , bench "8" $ whnf sipHash bs8+ , bench "11" $ whnf sipHash bs11+ , bench "40" $ whnf sipHash bs40+ , bench "128" $ whnf sipHash bs128+ , bench "512" $ whnf sipHash bs512+ , bench "2^20" $ whnf sipHash bs1Mb+ ]+ , bgroup "cSipHash"+ [ bench "5" $ whnf cSipHash bs5+ , bench "8" $ whnf cSipHash bs8+ , bench "11" $ whnf cSipHash bs11+ , bench "40" $ whnf cSipHash bs40+ , bench "128" $ whnf cSipHash bs128+ , bench "512" $ whnf cSipHash bs512+ , bench "2^20" $ whnf cSipHash bs1Mb+ ]+ , bgroup "cSipHash24"+ [ bench "5" $ whnf cSipHash24 bs5+ , bench "8" $ whnf cSipHash24 bs8+ , bench "11" $ whnf cSipHash24 bs11+ , bench "40" $ whnf cSipHash24 bs40+ , bench "128" $ whnf cSipHash24 bs128+ , bench "512" $ whnf cSipHash24 bs512+ , bench "2^20" $ whnf cSipHash24 bs1Mb+ ]+#ifdef HAVE_SSE+ , bgroup "sse2SipHash"+ [ bench "5" $ whnf sse2SipHash bs5+ , bench "8" $ whnf sse2SipHash bs8+ , bench "11" $ whnf sse2SipHash bs11+ , bench "40" $ whnf sse2SipHash bs40+ , bench "128" $ whnf sse2SipHash bs128+ , bench "512" $ whnf sse2SipHash bs512+ , bench "2^20" $ whnf sse2SipHash bs1Mb+ ]+ , bgroup "sse41SipHash"+ [ bench "5" $ whnf sse41SipHash bs5+ , bench "8" $ whnf sse41SipHash bs8+ , bench "11" $ whnf sse41SipHash bs11+ , bench "40" $ whnf sse41SipHash bs40+ , bench "128" $ whnf sse41SipHash bs128+ , bench "512" $ whnf sse41SipHash bs512+ , bench "2^20" $ whnf sse41SipHash bs1Mb+ ]+#endif+ , bgroup "pkgSipHash"+ [ bench "5" $ whnf hsSipHash bs5+ , bench "8" $ whnf hsSipHash bs8+ , bench "11" $ whnf hsSipHash bs11+ , bench "40" $ whnf hsSipHash bs40+ , bench "128" $ whnf hsSipHash bs128+ , bench "512" $ whnf hsSipHash bs512+ , bench "2^20" $ whnf hsSipHash bs1Mb+ ]+ , bgroup "fnv"+ [ bench "5" $ whnf fnvHash bs5+ , bench "8" $ whnf fnvHash bs8+ , bench "11" $ whnf fnvHash bs11+ , bench "40" $ whnf fnvHash bs40+ , bench "128" $ whnf fnvHash bs128+ , bench "512" $ whnf fnvHash bs512+ , bench "2^20" $ whnf fnvHash bs1Mb+ ]+ , bgroup "Int"+ [ bench "id32" $ whnf id (0x7eadbeef :: Int32)+ , bench "id64" $ whnf id (0x7eadbeefdeadbeef :: Int64)+ , bench "wang32" $ whnf hash_wang_32 0xdeadbeef+ , bench "wang64" $ whnf hash_wang_64 0xdeadbeefdeadbeef+ , bench "jenkins32a" $ whnf hash_jenkins_32a 0xdeadbeef+ , bench "jenkins32b" $ whnf hash_jenkins_32b 0xdeadbeef+ ] ] data ByteArray = BA { unBA :: !ByteArray# }@@ -57,3 +256,26 @@ case newByteArray# n# s1 of (# s2, ary #) -> case unsafeFreezeByteArray# ary s2 of (# s3, ba #) -> (# s3, BA ba #))++foreign import ccall unsafe "hashable_siphash" c_siphash+ :: CInt -> CInt -> Word64 -> Word64 -> Ptr Word8 -> CSize -> Word64+foreign import ccall unsafe "hashable_siphash24" c_siphash24+ :: Word64 -> Word64 -> Ptr Word8 -> CSize -> Word64+#ifdef HAVE_SSE+foreign import ccall unsafe "hashable_siphash24_sse2" sse2_siphash+ :: Word64 -> Word64 -> Ptr Word8 -> CSize -> Word64+foreign import ccall unsafe "hashable_siphash24_sse41" sse41_siphash+ :: Word64 -> Word64 -> Ptr Word8 -> CSize -> Word64+#endif++foreign import ccall unsafe "hashable_fnv_hash" fnv_hash+ :: Ptr Word8 -> CLong -> CLong -> CLong++foreign import ccall unsafe "hashable_wang_32" hash_wang_32+ :: Word32 -> Word32+foreign import ccall unsafe "hashable_wang_64" hash_wang_64+ :: Word64 -> Word64+foreign import ccall unsafe "hash_jenkins_32a" hash_jenkins_32a+ :: Word32 -> Word32+foreign import ccall unsafe "hash_jenkins_32b" hash_jenkins_32b+ :: Word32 -> Word32
− benchmarks/Makefile
@@ -1,25 +0,0 @@-package := hashable-version := $(shell awk '/^Version:/{print $$2}' ../$(package).cabal)-lib := ../dist/build/libHS$(package)-$(version).a-ghc := ghc-ghc-flags := -Wall -O -hide-all-packages \- -package-conf ../dist/package.conf.inplace -package base \- -package hashable -package criterion \- -package deepseq -package ghc-prim--%.o: %.hs- $(ghc) $(ghc-flags) -c -o $@ $<--programs := bench--.PHONY: all-all: $(programs)--bench: $(lib) Benchmarks.o- ranlib $(lib)- $(ghc) $(ghc-flags) -threaded -o $@ $(filter %.o,$^) $(lib)--.PHONY: clean-clean:- -find . \( -name '*.o' -o -name '*.hi' \) -exec rm {} \;- -rm -f $(programs)
+ benchmarks/cbits/fnv.c view
@@ -0,0 +1,53 @@+/*+Copyright Johan Tibell 2011++All rights reserved.++Redistribution and use in source and binary forms, with or without+modification, are permitted provided that the following conditions are met:++ * Redistributions of source code must retain the above copyright+ notice, this list of conditions and the following disclaimer.++ * Redistributions in binary form must reproduce the above+ copyright notice, this list of conditions and the following+ disclaimer in the documentation and/or other materials provided+ with the distribution.++ * Neither the name of Johan Tibell nor the names of other+ contributors may be used to endorse or promote products derived+ from this software without specific prior written permission.++THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS+"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT+LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR+A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT+OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,+SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT+LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,+DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY+THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT+(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE+OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.+*/++/* FNV-1 hash+ *+ * The FNV-1 hash description: http://isthe.com/chongo/tech/comp/fnv/+ * The FNV-1 hash is public domain: http://isthe.com/chongo/tech/comp/fnv/#public_domain+ */+long hashable_fnv_hash(const unsigned char* str, long len, long hash) {++ while (len--) {+ hash = (hash * 16777619) ^ *str++;+ }++ return hash;+}++/* Used for ByteArray#s. We can't treat them like pointers in+ native Haskell, but we can in unsafe FFI calls.+ */+long hashable_fnv_hash_offset(const unsigned char* str, long offset, long len, long hash) {+ return hashable_fnv_hash(str + offset, len, hash);+}
+ benchmarks/cbits/inthash.c view
@@ -0,0 +1,28 @@+#include <stdint.h>++/*+ * 32-bit hashes by Bob Jenkins.+ */++uint32_t hash_jenkins_32a(uint32_t a)+{+ a = (a+0x7ed55d16) + (a<<12);+ a = (a^0xc761c23c) ^ (a>>19);+ a = (a+0x165667b1) + (a<<5);+ a = (a+0xd3a2646c) ^ (a<<9);+ a = (a+0xfd7046c5) + (a<<3);+ a = (a^0xb55a4f09) ^ (a>>16);+ return a;+}++uint32_t hash_jenkins_32b(uint32_t a)+{+ a -= (a<<6);+ a ^= (a>>17);+ a -= (a<<9);+ a ^= (a<<4);+ a -= (a<<3);+ a ^= (a<<10);+ a ^= (a>>15);+ return a;+}
+ cbits/getRandomBytes.c view
@@ -0,0 +1,93 @@+/*+Copyright Bryan O'Sullivan 2012++All rights reserved.++Redistribution and use in source and binary forms, with or without+modification, are permitted provided that the following conditions are met:++ * Redistributions of source code must retain the above copyright+ notice, this list of conditions and the following disclaimer.++ * Redistributions in binary form must reproduce the above+ copyright notice, this list of conditions and the following+ disclaimer in the documentation and/or other materials provided+ with the distribution.++ * Neither the name of Johan Tibell nor the names of other+ contributors may be used to endorse or promote products derived+ from this software without specific prior written permission.++THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS+"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT+LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR+A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT+OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,+SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT+LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,+DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY+THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT+(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE+OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.+*/++#include "MachDeps.h"++int hashable_getRandomBytes(unsigned char *dest, int nbytes);++#if defined(mingw32_HOST_OS) || defined(__MINGW32__) ++#include <windows.h>+#include <wincrypt.h>++int hashable_getRandomBytes(unsigned char *dest, int nbytes)+{+ HCRYPTPROV hCryptProv;+ int ret;++ if (!CryptAcquireContextA(&hCryptProv, NULL, NULL, PROV_RSA_FULL,+ CRYPT_VERIFYCONTEXT)) + return -1;+ + ret = CryptGenRandom(hCryptProv, (DWORD) nbytes, (BYTE *) dest) ? nbytes : -1;++ CryptReleaseContext(hCryptProv, 0);++ bail:+ return ret;+}++#else++#include <fcntl.h>+#include <sys/types.h>+#include <unistd.h>++/* Assumptions: /dev/urandom exists and does something sane, and does+ not block. */++int hashable_getRandomBytes(unsigned char *dest, int nbytes)+{+ ssize_t off, nread;+ int fd;+ + fd = open("/dev/urandom", O_RDONLY);+ if (fd == -1)+ return -1;++ for (off = 0; nbytes > 0; nbytes -= nread) {+ nread = read(fd, dest + off, nbytes);+ off += nread;+ if (nread == -1) {+ off = -1;+ break;+ }+ }++ bail:+ close(fd);++ return off;+}++#endif
− cbits/hashByteString.c
@@ -1,53 +0,0 @@-/*-Copyright Johan Tibell 2011--All rights reserved.--Redistribution and use in source and binary forms, with or without-modification, are permitted provided that the following conditions are met:-- * Redistributions of source code must retain the above copyright- notice, this list of conditions and the following disclaimer.-- * Redistributions in binary form must reproduce the above- copyright notice, this list of conditions and the following- disclaimer in the documentation and/or other materials provided- with the distribution.-- * Neither the name of Johan Tibell nor the names of other- contributors may be used to endorse or promote products derived- from this software without specific prior written permission.--THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS-"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT-LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR-A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT-OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,-SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT-LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,-DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY-THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT-(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE-OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.-*/--/* FNV-1 hash- *- * The FNV-1 hash description: http://isthe.com/chongo/tech/comp/fnv/- * The FNV-1 hash is public domain: http://isthe.com/chongo/tech/comp/fnv/#public_domain- */-long hashable_fnv_hash(const unsigned char* str, long len, long hash) {-- while (len--) {- hash = (hash * 16777619) ^ *str++;- }-- return hash;-}--/* Used for ByteArray#s. We can't treat them like pointers in- native Haskell, but we can in unsafe FFI calls.- */-long hashable_fnv_hash_offset(const unsigned char* str, long offset, long len, long hash) {- return hashable_fnv_hash(str + offset, len, hash);-}
+ cbits/inthash.c view
@@ -0,0 +1,29 @@+/*+ * These hash functions were developed by Thomas Wang.+ *+ * http://www.concentric.net/~ttwang/tech/inthash.htm+ */++#include <stdint.h>++uint32_t hashable_wang_32(uint32_t a)+{+ a = (a ^ 61) ^ (a >> 16);+ a = a + (a << 3);+ a = a ^ (a >> 4);+ a = a * 0x27d4eb2d;+ a = a ^ (a >> 15);+ return a;+}++uint64_t hashable_wang_64(uint64_t key)+{+ key = (~key) + (key << 21); // key = (key << 21) - key - 1;+ key = key ^ ((key >> 24) | (key << 40));+ key = (key + (key << 3)) + (key << 8); // key * 265+ key = key ^ ((key >> 14) | (key << 50));+ key = (key + (key << 2)) + (key << 4); // key * 21+ key = key ^ ((key >> 28) | (key << 36));+ key = key + (key << 31);+ return key;+}
+ cbits/siphash-sse2.c view
@@ -0,0 +1,72 @@+/*+ * The original code was developed by Samuel Neves, and has been+ * only lightly modified.+ *+ * Used with permission.+ */+#include <emmintrin.h>+#include "siphash.h"++#define _mm_roti_epi64(x, c) ((16 == (c)) ? _mm_shufflelo_epi16((x), _MM_SHUFFLE(2,1,0,3)) : _mm_xor_si128(_mm_slli_epi64((x), (c)), _mm_srli_epi64((x), 64-(c))))++u64 hashable_siphash24_sse2(u64 ik0, u64 ik1, const u8 *m, size_t n)+{+ __m128i v0, v1, v2, v3;+ __m128i k0, k1;+ __m128i mi, mask, len;+ size_t i, k;+ union { u64 gpr; __m128i xmm; } hash;++ k0 = _mm_loadl_epi64((__m128i*)(&ik0));+ k1 = _mm_loadl_epi64((__m128i*)(&ik1));++ v0 = _mm_xor_si128(k0, _mm_set_epi32(0, 0, 0x736f6d65, 0x70736575));+ v1 = _mm_xor_si128(k1, _mm_set_epi32(0, 0, 0x646f7261, 0x6e646f6d));+ v2 = _mm_xor_si128(k0, _mm_set_epi32(0, 0, 0x6c796765, 0x6e657261));+ v3 = _mm_xor_si128(k1, _mm_set_epi32(0, 0, 0x74656462, 0x79746573));++#define HALF_ROUND(a,b,c,d,s,t) \+ do \+ { \+ a = _mm_add_epi64(a, b); c = _mm_add_epi64(c, d); \+ b = _mm_roti_epi64(b, s); d = _mm_roti_epi64(d, t); \+ b = _mm_xor_si128(b, a); d = _mm_xor_si128(d, c); \+ } while(0)++#define COMPRESS(v0,v1,v2,v3) \+ do \+ { \+ HALF_ROUND(v0,v1,v2,v3,13,16); \+ v0 = _mm_shufflelo_epi16(v0, _MM_SHUFFLE(1,0,3,2)); \+ HALF_ROUND(v2,v1,v0,v3,17,21); \+ v2 = _mm_shufflelo_epi16(v2, _MM_SHUFFLE(1,0,3,2)); \+ } while(0)++ for(i = 0; i < (n-n%8); i += 8)+ {+ mi = _mm_loadl_epi64((__m128i*)(m + i));+ v3 = _mm_xor_si128(v3, mi);+ for(k = 0; k < SIPHASH_ROUNDS; ++k) COMPRESS(v0,v1,v2,v3);+ v0 = _mm_xor_si128(v0, mi);+ }++ mi = _mm_loadl_epi64((__m128i*)(m + i));+ len = _mm_set_epi32(0, 0, (n&0xff) << 24, 0);+ mask = _mm_srli_epi64(_mm_set_epi32(0, 0, 0xffffffff, 0xffffffff), 8*(8-n%8));+ mi = _mm_xor_si128(_mm_and_si128(mi, mask), len);++ v3 = _mm_xor_si128(v3, mi);+ for(k = 0; k < SIPHASH_ROUNDS; ++k) COMPRESS(v0,v1,v2,v3);+ v0 = _mm_xor_si128(v0, mi);++ v2 = _mm_xor_si128(v2, _mm_set_epi32(0, 0, 0, 0xff));+ for(k = 0; k < SIPHASH_FINALROUNDS; ++k) COMPRESS(v0,v1,v2,v3);++ v0 = _mm_xor_si128(_mm_xor_si128(v0, v1), _mm_xor_si128(v2, v3));+ hash.xmm = v0;++#undef COMPRESS+#undef HALF_ROUND+ //return _mm_extract_epi32(v0, 0) | (((u64)_mm_extract_epi32(v0, 1)) << 32);+ return hash.gpr;+}
+ cbits/siphash-sse41.c view
@@ -0,0 +1,84 @@+/*+ * The original code was developed by Samuel Neves, and has been+ * only lightly modified.+ *+ * Used with permission.+ */+#include <smmintrin.h>+#include "siphash.h"++// Specialized for siphash, do not reuse+#define rotate16(x) _mm_shufflehi_epi16((x), _MM_SHUFFLE(2,1,0,3))++#define _mm_roti_epi64(x, c) (((c) == 16) ? rotate16((x)) : _mm_xor_si128(_mm_slli_epi64((x), (c)), _mm_srli_epi64((x), 64-(c))))+//#define _mm_roti_epi64(x, c) _mm_xor_si128(_mm_slli_epi64((x), (c)), _mm_srli_epi64((x), 64-(c)))+++u64 hashable_siphash24_sse41(u64 _k0, u64 _k1, const unsigned char *m, size_t n)+{+ __m128i v0, v1, v02, v13;+ __m128i k0;+ __m128i mi, mask, len, h;+ const __m128i zero = _mm_setzero_si128();+ size_t i, k;+ union { u64 gpr; __m128i xmm; } hash;+ unsigned char key[16];++ ((u64 *)key)[0] = _k0;+ ((u64 *)key)[1] = _k1;++ k0 = _mm_loadu_si128((__m128i*)(key + 0));++ v0 = _mm_xor_si128(k0, _mm_set_epi32(0x646f7261, 0x6e646f6d, 0x736f6d65, 0x70736575));+ v1 = _mm_xor_si128(k0, _mm_set_epi32(0x74656462, 0x79746573, 0x6c796765, 0x6e657261));++ v02 = _mm_unpacklo_epi64(v0, v1);+ v13 = _mm_unpackhi_epi64(v0, v1);++#define HALF_ROUND(a,b,s,t) \+do \+{ \+ __m128i b1,b2; \+ a = _mm_add_epi64(a, b); \+ b1 = _mm_roti_epi64(b, s); b2 = _mm_roti_epi64(b, t); b = _mm_blend_epi16(b1, b2, 0xF0); \+ b = _mm_xor_si128(b, a); \+} while(0)++#define COMPRESS(v02,v13) \+ do \+ { \+ HALF_ROUND(v02,v13,13,16); \+ v02 = _mm_shuffle_epi32(v02, _MM_SHUFFLE(0,1,3,2)); \+ HALF_ROUND(v02,v13,17,21); \+ v02 = _mm_shuffle_epi32(v02, _MM_SHUFFLE(0,1,3,2)); \+ } while(0)++ for(i = 0; i < (n-n%8); i += 8)+ {+ mi = _mm_loadl_epi64((__m128i*)(m + i));+ v13 = _mm_xor_si128(v13, _mm_unpacklo_epi64(zero, mi));+ for(k = 0; k < SIPHASH_ROUNDS; ++k) COMPRESS(v02,v13);+ v02 = _mm_xor_si128(v02, mi);+ }++ mi = _mm_loadl_epi64((__m128i*)(m + i));+ len = _mm_set_epi32(0, 0, (n&0xff) << 24, 0);+ mask = _mm_srli_epi64(_mm_set_epi32(0, 0, 0xffffffff, 0xffffffff), 8*(8-n%8));+ mi = _mm_xor_si128(_mm_and_si128(mi, mask), len);++ v13 = _mm_xor_si128(v13, _mm_unpacklo_epi64(zero, mi));+ for(k = 0; k < SIPHASH_ROUNDS; ++k) COMPRESS(v02,v13);+ v02 = _mm_xor_si128(v02, mi);++ v02 = _mm_xor_si128(v02, _mm_set_epi32(0, 0xff, 0, 0));+ for(k = 0; k < SIPHASH_FINALROUNDS; ++k) COMPRESS(v02,v13);++ v0 = _mm_xor_si128(v02, v13);+ v0 = _mm_xor_si128(v0, _mm_castps_si128(_mm_movehl_ps(_mm_castsi128_ps(zero), _mm_castsi128_ps(v0))));+ hash.xmm = v0;++#undef COMPRESS+#undef HALF_ROUND+ //return _mm_extract_epi32(v0, 0) | (((u64)_mm_extract_epi32(v0, 1)) << 32);+ return hash.gpr;+}
+ cbits/siphash.c view
@@ -0,0 +1,247 @@+/* Almost a verbatim copy of the reference implementation. */++#include <stddef.h>+#include "siphash.h"++#define ROTL(x,b) (u64)(((x) << (b)) | ((x) >> (64 - (b))))++#define SIPROUND \+ do { \+ v0 += v1; v1=ROTL(v1,13); v1 ^= v0; v0=ROTL(v0,32); \+ v2 += v3; v3=ROTL(v3,16); v3 ^= v2; \+ v0 += v3; v3=ROTL(v3,21); v3 ^= v0; \+ v2 += v1; v1=ROTL(v1,17); v1 ^= v2; v2=ROTL(v2,32); \+ } while(0)++#if defined(__i386)+# define _siphash24 plain_siphash24+#endif++static inline u64 odd_read(const u8 *p, int count, u64 val, int shift)+{+ switch (count) {+ case 7: val |= ((u64)p[6]) << (shift + 48);+ case 6: val |= ((u64)p[5]) << (shift + 40);+ case 5: val |= ((u64)p[4]) << (shift + 32);+ case 4: val |= ((u64)p[3]) << (shift + 24);+ case 3: val |= ((u64)p[2]) << (shift + 16);+ case 2: val |= ((u64)p[1]) << (shift + 8);+ case 1: val |= ((u64)p[0]) << shift;+ }+ return val;+}++static inline u64 _siphash(int c, int d, u64 k0, u64 k1,+ const u8 *str, size_t len)+{+ u64 v0 = 0x736f6d6570736575ull ^ k0;+ u64 v1 = 0x646f72616e646f6dull ^ k1;+ u64 v2 = 0x6c7967656e657261ull ^ k0;+ u64 v3 = 0x7465646279746573ull ^ k1;+ const u8 *end, *p;+ u64 b;+ int i;++ for (p = str, end = str + (len & ~7); p < end; p += 8) {+ u64 m = *(u64 *) p;+ v3 ^= m;+ if (c == 2) {+ SIPROUND;+ SIPROUND;+ } else {+ for (i = 0; i < c; i++)+ SIPROUND;+ }+ v0 ^= m;+ }++ b = odd_read(p, len & 7, ((u64) len) << 56, 0);++ v3 ^= b;+ if (c == 2) {+ SIPROUND;+ SIPROUND;+ } else {+ for (i = 0; i < c; i++)+ SIPROUND;+ }+ v0 ^= b;++ v2 ^= 0xff;+ if (d == 4) {+ SIPROUND;+ SIPROUND;+ SIPROUND;+ SIPROUND;+ } else {+ for (i = 0; i < d; i++)+ SIPROUND;+ }+ b = v0 ^ v1 ^ v2 ^ v3;+ return b;+}+++static inline u64 _siphash24(u64 k0, u64 k1, const u8 *str, size_t len)+{+ return _siphash(2, 4, k0, k1, str, len);+}++#if defined(__i386)+# undef _siphash24++static u64 (*_siphash24)(u64 k0, u64 k1, const u8 *, size_t);++static void maybe_use_sse()+ __attribute__((constructor));++static void maybe_use_sse()+{+ uint32_t eax = 1, ebx, ecx, edx;++ __asm volatile+ ("mov %%ebx, %%edi;" /* 32bit PIC: don't clobber ebx */+ "cpuid;"+ "mov %%ebx, %%esi;"+ "mov %%edi, %%ebx;"+ :"+a" (eax), "=S" (ebx), "=c" (ecx), "=d" (edx)+ : :"edi");++ if (edx & (1 << 26))+ _siphash24 = hashable_siphash24_sse2;+ if (ecx & (1 << 19))+ _siphash24 = hashable_siphash24_sse41;+ else+ _siphash24 = plain_siphash24;+}++#endif++u64 hashable_siphash(int c, int d, u64 k0, u64 k1, const u8 *str, size_t len)+{+ return _siphash(c, d, k0, k1, str, len);+}++u64 hashable_siphash24(u64 k0, u64 k1, const u8 *str, size_t len)+{+ return _siphash24(k0, k1, str, len);+}++/* Used for ByteArray#s. We can't treat them like pointers in+ native Haskell, but we can in unsafe FFI calls.+ */+u64 hashable_siphash24_offset(u64 k0, u64 k1,+ const u8 *str, size_t off, size_t len)+{+ return _siphash24(k0, k1, str + off, len);+}++static int _siphash_chunk(int c, int d, int buffered, u64 v[5],+ const u8 *str, size_t len, size_t totallen)+{+ u64 v0 = v[0], v1 = v[1], v2 = v[2], v3 = v[3], m, b;+ const u8 *p, *end;+ u64 carry = 0;+ int i;++ if (buffered > 0) {+ int unbuffered = 8 - buffered;+ int tobuffer = unbuffered > len ? len : unbuffered;+ int shift = buffered << 3;++ m = odd_read(str, tobuffer, v[4], shift);+ str += tobuffer;+ buffered += tobuffer;+ len -= tobuffer;++ if (buffered < 8)+ carry = m;+ else {+ v3 ^= m;+ if (c == 2) {+ SIPROUND;+ SIPROUND;+ } else {+ for (i = 0; i < c; i++)+ SIPROUND;+ }+ v0 ^= m;+ buffered = 0;+ m = 0;+ }+ }++ for (p = str, end = str + (len & ~7); p < end; p += 8) {+ m = *(u64 *) p;+ v3 ^= m;+ if (c == 2) {+ SIPROUND;+ SIPROUND;+ } else {+ for (i = 0; i < c; i++)+ SIPROUND;+ }+ v0 ^= m;+ }++ b = odd_read(p, len & 7, 0, 0);++ if (totallen == -1) {+ v[0] = v0;+ v[1] = v1;+ v[2] = v2;+ v[3] = v3;+ v[4] = b | carry;++ return buffered + (len & 7);+ }++ b |= ((u64) totallen) << 56;++ v3 ^= b;+ if (c == 2) {+ SIPROUND;+ SIPROUND;+ } else {+ for (i = 0; i < c; i++)+ SIPROUND;+ }+ v0 ^= b;++ v2 ^= 0xff;+ if (d == 4) {+ SIPROUND;+ SIPROUND;+ SIPROUND;+ SIPROUND;+ } else {+ for (i = 0; i < d; i++)+ SIPROUND;+ }+ v[4] = v0 ^ v1 ^ v2 ^ v3;+ return 0;+}++void hashable_siphash_init(u64 k0, u64 k1, u64 *v)+{+ v[0] = 0x736f6d6570736575ull ^ k0;+ v[1] = 0x646f72616e646f6dull ^ k1;+ v[2] = 0x6c7967656e657261ull ^ k0;+ v[3] = 0x7465646279746573ull ^ k1;+ v[4] = 0;+}++int hashable_siphash24_chunk(int buffered, u64 v[5], const u8 *str,+ size_t len, size_t totallen)+{+ return _siphash_chunk(2, 4, buffered, v, str, len, totallen);+}++/*+ * Used for ByteArray#.+ */+int hashable_siphash24_chunk_offset(int buffered, u64 v[5], const u8 *str,+ size_t off, size_t len, size_t totallen)+{+ return _siphash_chunk(2, 4, buffered, v, str + off, len, totallen);+}
+ cbits/siphash.h view
@@ -0,0 +1,22 @@+#ifndef _hashable_siphash_h+#define _hashable_siphash_h++#include <stdint.h>++typedef uint64_t u64;+typedef uint32_t u32;+typedef uint16_t u16;+typedef uint8_t u8;++#define SIPHASH_ROUNDS 2+#define SIPHASH_FINALROUNDS 4++u64 hashable_siphash(int, int, u64, u64, const u8 *, size_t);+u64 hashable_siphash24(u64, u64, const u8 *, size_t);++#if defined(__i386)+u64 hashable_siphash24_sse2(u64, u64, const u8 *, size_t);+u64 hashable_siphash24_sse41(u64, u64, const u8 *, size_t);+#endif++#endif /* _hashable_siphash_h */
hashable.cabal view
@@ -1,5 +1,5 @@ Name: hashable-Version: 1.1.2.5+Version: 1.2.0.0 Synopsis: A class for types that can be converted to a hash value Description: This package defines a class, 'Hashable', for types that can be converted to a hash value. This class@@ -20,15 +20,22 @@ -- tests/Properties.hs shouldn't have to go here, but the source files -- for the test-suite stanzas don't get picked up by `cabal sdist`. Extra-source-files:- CHANGES, README.md, tests/Properties.hs, benchmarks/Benchmarks.hs- benchmarks/Makefile+ CHANGES, README.md, tests/Properties.hs, benchmarks/Benchmarks.hs,+ cbits/siphash.h Flag integer-gmp Description: Are we using integer-gmp to provide fast Integer instances? Default: True +Flag fixed-salt+ Description: Do we use a single fixed salt every time the program runs?+ Default: False+ Library Exposed-modules: Data.Hashable+ Other-modules: Data.Hashable.Class+ Data.Hashable.RandomSource+ Data.Hashable.SipHash Build-depends: base >= 4.0 && < 5.0, bytestring >= 0.9 if impl(ghc)@@ -37,16 +44,33 @@ if impl(ghc) && flag(integer-gmp) Build-depends: integer-gmp >= 0.2 - C-sources: cbits/hashByteString.c+ if impl(ghc >= 7.2.1)+ CPP-Options: -DGENERICS+ Other-modules: Data.Hashable.Generic++ C-sources: cbits/getRandomBytes.c+ cbits/inthash.c+ cbits/siphash.c+ if arch(i386)+ C-sources: cbits/siphash-sse2.c+ cbits/siphash-sse41.c+ CC-options: -msse2 -msse4.1+ Ghc-options: -Wall if impl(ghc >= 6.8) Ghc-options: -fwarn-tabs+ if flag(fixed-salt)+ Cpp-options: -DFIXED_SALT+ if os(windows)+ extra-libraries: advapi32 Test-suite tests Type: exitcode-stdio-1.0 Hs-source-dirs: tests Main-is: Properties.hs Build-depends: base >= 4.0 && < 5.0,+ bytestring,+ ghc-prim, hashable, test-framework >= 0.3.3, test-framework-quickcheck2 >= 0.2.9,@@ -55,6 +79,57 @@ text >= 0.11.0.5 Ghc-options: -Wall -fno-warn-orphans+ if impl(ghc >= 7.2.1)+ CPP-Options: -DGENERICS++benchmark benchmarks+ -- We cannot depend on the hashable library directly as that creates+ -- a dependency cycle.+ hs-source-dirs: . benchmarks++ main-is: Benchmarks.hs+ other-modules:+ Data.Hashable+ Data.Hashable.Class+ Data.Hashable.RandomSource+ Data.Hashable.SipHash+ type: exitcode-stdio-1.0++ build-depends:+ base,+ bytestring,+ criterion,+ ghc-prim,+ siphash,+ text++ if impl(ghc)+ Build-depends: ghc-prim,+ text >= 0.11.0.5+ if impl(ghc) && flag(integer-gmp)+ Build-depends: integer-gmp >= 0.2++ c-sources:+ cbits/getRandomBytes.c+ cbits/inthash.c+ cbits/siphash.c+ benchmarks/cbits/fnv.c+ benchmarks/cbits/inthash.c++ if arch(i386) || arch(x86_64)+ cpp-options: -DHAVE_SSE+ cc-options: -msse2 -msse4.1+ c-sources:+ cbits/siphash-sse2.c+ cbits/siphash-sse41.c++ Ghc-options: -Wall -O2+ if impl(ghc >= 6.8)+ Ghc-options: -fwarn-tabs+ if flag(fixed-salt)+ Cpp-options: -DFIXED_SALT+ if os(windows)+ extra-libraries: advapi32 source-repository head type: git
tests/Properties.hs view
@@ -1,14 +1,21 @@-{-# LANGUAGE BangPatterns, GeneralizedNewtypeDeriving, MagicHash, Rank2Types,- UnboxedTuples #-}+{-# LANGUAGE BangPatterns, CPP, GeneralizedNewtypeDeriving, MagicHash,+ Rank2Types, UnboxedTuples #-}+#ifdef GENERICS+{-# LANGUAGE DeriveGeneric, ScopedTypeVariables #-}+#endif -- | Tests for the 'Data.Hashable' module. We test functions by -- comparing the C and Haskell implementations. module Main (main) where -import Data.Hashable (Hashable(hash), hashByteArray, hashPtr)+import Data.Hashable (Hashable, hash, hashByteArray, hashPtr)+import qualified Data.ByteString as B+import qualified Data.ByteString.Lazy as BL import qualified Data.Text as T-import qualified Data.Text.Lazy as L+import qualified Data.Text.Lazy as TL+import Data.List (nub)+import Control.Monad (ap, liftM) import System.IO.Unsafe (unsafePerformIO) import Foreign.Marshal.Array (withArray) import GHC.Base (ByteArray#, Int(..), newByteArray#, unsafeCoerce#,@@ -18,6 +25,9 @@ import Test.QuickCheck hiding ((.&.)) import Test.Framework (Test, defaultMain, testGroup) import Test.Framework.Providers.QuickCheck2 (testProperty)+#ifdef GENERICS+import GHC.Generics+#endif ------------------------------------------------------------------------ -- * Properties@@ -25,9 +35,17 @@ instance Arbitrary T.Text where arbitrary = T.pack `fmap` arbitrary -instance Arbitrary L.Text where- arbitrary = L.pack `fmap` arbitrary+instance Arbitrary TL.Text where+ arbitrary = TL.pack `fmap` arbitrary +instance Arbitrary B.ByteString where+ arbitrary = B.pack `fmap` arbitrary++instance Arbitrary BL.ByteString where+ arbitrary = sized $ \n -> resize (round (sqrt (toEnum n :: Double)))+ ((BL.fromChunks . map (B.pack . nonEmpty)) `fmap` arbitrary)+ where nonEmpty (NonEmpty a) = a+ -- | Validate the implementation by comparing the C and Haskell -- versions. pHash :: [Word8] -> Bool@@ -40,13 +58,15 @@ pText a b = if (a == b) then (hash a == hash b) else True -- | Content equality implies hash equality.-pTextLazy :: L.Text -> L.Text -> Bool+pTextLazy :: TL.Text -> TL.Text -> Bool pTextLazy a b = if (a == b) then (hash a == hash b) else True -- | A small positive integer. newtype ChunkSize = ChunkSize { unCS :: Int }- deriving (Eq, Ord, Num, Integral, Real, Enum, Show)+ deriving (Eq, Ord, Num, Integral, Real, Enum) +instance Show ChunkSize where show = show . unCS+ instance Arbitrary ChunkSize where arbitrary = (ChunkSize . (`mod` maxChunkSize)) `fmap` (arbitrary `suchThat` ((/=0) . (`mod` maxChunkSize)))@@ -54,22 +74,53 @@ -- | Ensure that the rechunk function causes a rechunked string to -- still match its original form.-pRechunk :: T.Text -> NonEmptyList ChunkSize -> Bool-pRechunk t cs = L.fromStrict t == rechunk t cs+pTextRechunk :: T.Text -> NonEmptyList ChunkSize -> Bool+pTextRechunk t cs = TL.fromStrict t == rechunkText t cs --- | Content equality implies hash equality.-pLazyRechunked :: T.Text -> NonEmptyList ChunkSize -> Bool-pLazyRechunked t cs = hash (L.fromStrict t) == hash (rechunk t cs)+-- | Lazy strings must hash to the same value no matter how they are+-- chunked.+pTextLazyRechunked :: T.Text+ -> NonEmptyList ChunkSize -> NonEmptyList ChunkSize -> Bool+pTextLazyRechunked t cs0 cs1 =+ hash (rechunkText t cs0) == hash (rechunkText t cs1) -- | Break up a string into chunks of different sizes.-rechunk :: T.Text -> NonEmptyList ChunkSize -> L.Text-rechunk t0 (NonEmpty cs0) = L.fromChunks . go t0 . cycle $ cs0+rechunkText :: T.Text -> NonEmptyList ChunkSize -> TL.Text+rechunkText t0 (NonEmpty cs0) = TL.fromChunks . go t0 . cycle $ cs0 where go t _ | T.null t = [] go t (c:cs) = a : go b cs where (a,b) = T.splitAt (unCS c) t go _ [] = error "Properties.rechunk - The 'impossible' happened!" +-- | Content equality implies hash equality.+pBS :: B.ByteString -> B.ByteString -> Bool+pBS a b = if (a == b) then (hash a == hash b) else True++-- | Content equality implies hash equality.+pBSLazy :: BL.ByteString -> BL.ByteString -> Bool+pBSLazy a b = if (a == b) then (hash a == hash b) else True++-- | Break up a string into chunks of different sizes.+rechunkBS :: B.ByteString -> NonEmptyList ChunkSize -> BL.ByteString+rechunkBS t0 (NonEmpty cs0) = BL.fromChunks . go t0 . cycle $ cs0+ where+ go t _ | B.null t = []+ go t (c:cs) = a : go b cs+ where (a,b) = B.splitAt (unCS c) t+ go _ [] = error "Properties.rechunkBS - The 'impossible' happened!"++-- | Ensure that the rechunk function causes a rechunked string to+-- still match its original form.+pBSRechunk :: B.ByteString -> NonEmptyList ChunkSize -> Bool+pBSRechunk t cs = fromStrict t == rechunkBS t cs++-- | Lazy bytestrings must hash to the same value no matter how they+-- are chunked.+pBSLazyRechunked :: B.ByteString+ -> NonEmptyList ChunkSize -> NonEmptyList ChunkSize -> Bool+pBSLazyRechunked t cs1 cs2 = hash (rechunkBS t cs1) == hash (rechunkBS t cs2)+ -- This wrapper is required by 'runST'. data ByteArray = BA { unBA :: ByteArray# } @@ -86,6 +137,62 @@ case writeWord8Array# marr# i# x s# of s2# -> go s2# (i + 1) marr# xs +-- Generics++#ifdef GENERICS++data Product2 a b = Product2 a b+ deriving (Generic)++instance (Arbitrary a, Arbitrary b) => Arbitrary (Product2 a b) where+ arbitrary = Product2 `liftM` arbitrary `ap` arbitrary++instance (Hashable a, Hashable b) => Hashable (Product2 a b)++data Product3 a b c = Product3 a b c+ deriving (Generic)++instance (Arbitrary a, Arbitrary b, Arbitrary c) =>+ Arbitrary (Product3 a b c) where+ arbitrary = Product3 `liftM` arbitrary `ap` arbitrary `ap` arbitrary++instance (Hashable a, Hashable b, Hashable c) => Hashable (Product3 a b c)++-- Hashes of all product types of the same shapes should be the same.++pProduct2 :: Int -> String -> Bool+pProduct2 x y = hash (x, y) == hash (Product2 x y)++pProduct3 :: Double -> Maybe Bool -> (Int, String) -> Bool+pProduct3 x y z = hash (x, y, z) == hash (Product3 x y z)++data Sum2 a b = S2a a | S2b b+ deriving (Eq, Ord, Show, Generic)++instance (Hashable a, Hashable b) => Hashable (Sum2 a b)++data Sum3 a b c = S3a a | S3b b | S3c c+ deriving (Eq, Ord, Show, Generic)++instance (Hashable a, Hashable b, Hashable c) => Hashable (Sum3 a b c)++-- Hashes of the same parameter, but with different sum constructors,+-- should differ. (They might legitimately collide, but that's+-- vanishingly unlikely.)++pSum2_differ :: Int -> Bool+pSum2_differ x = nub hs == hs+ where hs = [ hash (S2a x :: Sum2 Int Int)+ , hash (S2b x :: Sum2 Int Int) ]++pSum3_differ :: Int -> Bool+pSum3_differ x = nub hs == hs+ where hs = [ hash (S3a x :: Sum3 Int Int Int)+ , hash (S3b x :: Sum3 Int Int Int)+ , hash (S3c x :: Sum3 Int Int Int) ]++#endif+ ------------------------------------------------------------------------ -- Test harness @@ -98,7 +205,33 @@ , testGroup "text" [ testProperty "text/strict" pText , testProperty "text/lazy" pTextLazy- , testProperty "rechunk" pRechunk- , testProperty "text/rechunked" pLazyRechunked+ , testProperty "text/rechunk" pTextRechunk+ , testProperty "text/rechunked" pTextLazyRechunked ]+ , testGroup "bytestring"+ [ testProperty "bytestring/strict" pBS+ , testProperty "bytestring/lazy" pBSLazy+ , testProperty "bytestring/rechunk" pBSRechunk+ , testProperty "bytestring/rechunked" pBSLazyRechunked+ ]+#ifdef GENERICS+ , testGroup "generics"+ [+ testProperty "product2" pProduct2+ , testProperty "product3" pProduct3+ , testProperty "sum2_differ" pSum2_differ+ , testProperty "sum3_differ" pSum3_differ+ ]+#endif ]++------------------------------------------------------------------------+-- Utilities++fromStrict :: B.ByteString -> BL.ByteString+#if MIN_VERSION_bytestring(0,10,0)+fromStrict = BL.fromStrict+#else+fromStrict b = BL.fromChunks [b]+#endif+