hashable 1.3.0.0 → 1.3.1.0
raw patch · 23 files changed
+1500/−2626 lines, 23 filesdep +ghc-bignumdep −criteriondep −siphashdep ~basedep ~bytestringdep ~integer-gmpnew-uploaderPVP: major bump suggested
API removals or changes: PVP suggests a major version bump
Dependencies added: ghc-bignum
Dependencies removed: criterion, siphash
Dependency ranges changed: base, bytestring, integer-gmp, text
API changes (from Hackage documentation)
- Data.Hashable.Generic: data family HashArgs arity a :: *
+ Data.Hashable.Generic: data family HashArgs arity a :: Type
Files
- CHANGES.md +10/−0
- Data/Hashable.hs +0/−211
- Data/Hashable/Class.hs +0/−940
- Data/Hashable/Generic.hs +0/−25
- Data/Hashable/Generic/Instances.hs +0/−121
- Data/Hashable/Lifted.hs +0/−98
- Data/Hashable/RandomSource.hs +0/−32
- Data/Hashable/SipHash.hs +0/−159
- benchmarks/Benchmarks.hs +0/−314
- benchmarks/cbits/inthash.c +0/−28
- benchmarks/cbits/siphash-sse2.c +0/−129
- benchmarks/cbits/siphash-sse41.c +0/−86
- benchmarks/cbits/siphash.c +0/−262
- benchmarks/cbits/wang.c +0/−29
- cbits/fnv.c +8/−0
- cbits/getRandomBytes.c +0/−93
- hashable.cabal +21/−97
- src/Data/Hashable.hs +211/−0
- src/Data/Hashable/Class.hs +997/−0
- src/Data/Hashable/Generic.hs +25/−0
- src/Data/Hashable/Generic/Instances.hs +128/−0
- src/Data/Hashable/Lifted.hs +98/−0
- tests/Properties.hs +2/−2
CHANGES.md view
@@ -1,5 +1,15 @@ See also https://pvp.haskell.org/faq +## Version 1.3.1.0++ * Add `Hashable1` instances to `semigroups` types.++ * Use `ghc-bignum` with GHC-9.0++ * Use FNV-1 constants.++ * Make `hashable-examples` a test-suite+ ## Version 1.3.0.0 * Semantic change of `Hashable Arg` instance to *not* hash the second
− Data/Hashable.hs
@@ -1,211 +0,0 @@-{-# LANGUAGE DeriveDataTypeable #-}-{-# LANGUAGE Trustworthy #-}----------------------------------------------------------------------------- |--- Module : Data.Hashable--- Copyright : (c) Milan Straka 2010--- (c) Johan Tibell 2011--- (c) Bryan O'Sullivan 2011, 2012--- SPDX-License-Identifier : BSD-3-Clause--- 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. Efficient instances for other types can be--- generated automatically and effortlessly using the generics support--- in GHC 7.4 and above.------ The easiest way to get started is to use the 'hash' function. Here--- is an example session with @ghci@.------ > ghci> import Data.Hashable--- > ghci> hash "foo"--- > 60853164--module Data.Hashable- (- -- * Hashing and security- -- $security-- -- * Computing hash values- Hashable(..)-- -- * 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-- -- *** Hashing contructors with multiple fields- -- $multiple-fields-- -- *** Hashing types with multiple constructors- -- $multiple-ctors-- , hashUsing- , hashPtr- , hashPtrWithSalt- , hashByteArray- , hashByteArrayWithSalt-- -- * Caching hashes- , Hashed- , hashed- , unhashed- , mapHashed- , traverseHashed- ) where--import Data.Hashable.Class-import Data.Hashable.Generic ()---- $security--- #security#------ Applications that use hash-based data structures to store input--- from untrusted users can be susceptible to \"hash DoS\", a class of--- denial-of-service attack that uses deliberately chosen colliding--- inputs to force an application into unexpectedly behaving with--- quadratic time complexity.------ At this time, the string hashing functions used in this library are--- susceptible to such attacks and users are recommended to either use--- a 'Data.Map' to store keys derived from untrusted input or to use a--- hash function (e.g. SipHash) that's resistant to such attacks. A--- future version of this library might ship with such hash functions.---- $generics------ The recommended way to make instances of--- 'Hashable' for most types is to use the compiler's support for--- automatically generating default instances using "GHC.Generics".------ > {-# 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.------ The default implementations are provided by--- 'genericHashWithSalt' and 'genericLiftHashWithSalt'; those together with--- the generic type class 'GHashable' and auxiliary functions are exported--- from the "Data.Hashable.Generic" module.---- $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--- '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--- @bytestring@ package:------ > import qualified Data.ByteString as B--- > import qualified Data.ByteString.Internal as B--- > import qualified Data.ByteString.Unsafe as B--- > import Data.Hashable--- > import Foreign.Ptr (castPtr)--- >--- > instance Hashable B.ByteString where--- > hashWithSalt salt bs = B.inlinePerformIO $--- > B.unsafeUseAsCStringLen bs $ \(p, len) ->--- > hashPtrWithSalt p (fromIntegral len) salt---- $multiple-fields------ Hash constructors with multiple fields by chaining 'hashWithSalt':------ > data Date = Date Int Int Int--- >--- > instance Hashable Date where--- > hashWithSalt s (Date yr mo dy) =--- > s `hashWithSalt`--- > yr `hashWithSalt`--- > mo `hashWithSalt` dy------ If you need to chain hashes together, use 'hashWithSalt' and follow--- this recipe:------ > combineTwo h1 h2 = h1 `hashWithSalt` h2---- $multiple-ctors------ For a type with several value constructors, there are a few--- possible approaches to writing a 'Hashable' instance.------ If the type is an instance of 'Enum', the easiest path is to--- convert it to an 'Int', and use the existing 'Hashable' instance--- for 'Int'.------ > data Color = Red | Green | Blue--- > deriving Enum--- >--- > instance Hashable Color where--- > hashWithSalt = hashUsing fromEnum------ If the type's constructors accept parameters, it is important to--- distinguish the constructors. To distinguish the constructors, add--- a different integer to the hash computation of each constructor:------ > data Time = Days Int--- > | Weeks Int--- > | Months Int--- >--- > 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
− Data/Hashable/Class.hs
@@ -1,940 +0,0 @@-{-# LANGUAGE BangPatterns, CPP, MagicHash,- ScopedTypeVariables, UnliftedFFITypes, DeriveDataTypeable,- DefaultSignatures, FlexibleContexts, TypeFamilies,- MultiParamTypeClasses #-}--#if __GLASGOW_HASKELL__ >= 801-{-# LANGUAGE PolyKinds #-} -- For TypeRep instances-#endif----------------------------------------------------------------------------- |--- Module : Data.Hashable.Class--- Copyright : (c) Milan Straka 2010--- (c) Johan Tibell 2011--- (c) Bryan O'Sullivan 2011, 2012--- SPDX-License-Identifier : BSD-3-Clause--- 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(..)- , Hashable1(..)- , Hashable2(..)-- -- ** Support for generics- , genericHashWithSalt- , genericLiftHashWithSalt- , GHashable(..)- , HashArgs(..)- , Zero- , One-- -- * Creating new instances- , hashUsing- , hashPtr- , hashPtrWithSalt- , hashByteArray- , hashByteArrayWithSalt- , defaultHashWithSalt- -- * Higher Rank Functions- , hashWithSalt1- , hashWithSalt2- , defaultLiftHashWithSalt- -- * Caching hashes- , Hashed- , hashed- , unhashed- , mapHashed- , traverseHashed- ) where--import Control.Applicative (Const(..))-import Control.Exception (assert)-import Control.DeepSeq (NFData(rnf))-import Data.Bits (shiftL, shiftR, xor)-import qualified Data.ByteString as B-import qualified Data.ByteString.Lazy as BL-import qualified Data.ByteString.Unsafe as B-import Data.Complex (Complex(..))-import Data.Int (Int8, Int16, Int32, Int64)-import Data.List (foldl')-import Data.Ratio (Ratio, denominator, numerator)-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 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)-import GHC.Base (ByteArray#)-import GHC.Conc (ThreadId(..))-import GHC.Prim (ThreadId#)-import System.IO.Unsafe (unsafeDupablePerformIO)-import System.Mem.StableName-import Data.Unique (Unique, hashUnique)---- As we use qualified F.Foldable, we don't get warnings with newer base-import qualified Data.Foldable as F--#if MIN_VERSION_base(4,7,0)-import Data.Proxy (Proxy)-#endif--#if MIN_VERSION_base(4,7,0)-import Data.Fixed (Fixed(..))-#endif--#if MIN_VERSION_base(4,8,0)-import Data.Functor.Identity (Identity(..))-#endif--import GHC.Generics--#if MIN_VERSION_base(4,10,0)-import Type.Reflection (Typeable, TypeRep, SomeTypeRep(..))-import Type.Reflection.Unsafe (typeRepFingerprint)-import GHC.Fingerprint.Type(Fingerprint(..))-#elif MIN_VERSION_base(4,8,0)-import Data.Typeable (typeRepFingerprint, Typeable, TypeRep)-import GHC.Fingerprint.Type(Fingerprint(..))-#else-import Data.Typeable.Internal (Typeable, TypeRep (..))-import GHC.Fingerprint.Type(Fingerprint(..))-#endif--#if MIN_VERSION_base(4,5,0)-import Foreign.C (CLong(..))-import Foreign.C.Types (CInt(..))-#else-import Foreign.C (CLong)-import Foreign.C.Types (CInt)-#endif--#if !(MIN_VERSION_base(4,8,0))-import Data.Word (Word)-#endif--#if MIN_VERSION_base(4,7,0)-import Data.Bits (finiteBitSize)-#else-import Data.Bits (bitSize)-#endif--#if !(MIN_VERSION_bytestring(0,10,0))-import qualified Data.ByteString.Lazy.Internal as BL -- foldlChunks-#endif--#if MIN_VERSION_bytestring(0,10,4)-import qualified Data.ByteString.Short.Internal as BSI-#endif--#ifdef VERSION_integer_gmp--# if MIN_VERSION_integer_gmp(1,0,0)-# define MIN_VERSION_integer_gmp_1_0_0-# endif--import GHC.Exts (Int(..))-import GHC.Integer.GMP.Internals (Integer(..))-# if defined(MIN_VERSION_integer_gmp_1_0_0)-import GHC.Exts (sizeofByteArray#)-import GHC.Integer.GMP.Internals (BigNat(BN#))-# endif-#endif--#if MIN_VERSION_base(4,8,0)-import Data.Void (Void, absurd)-import GHC.Natural (Natural(..))-import GHC.Exts (Word(..))-#endif--#if MIN_VERSION_base(4,9,0)-import qualified Data.List.NonEmpty as NE-import Data.Semigroup-import Data.Functor.Classes (Eq1(..),Ord1(..),Show1(..),showsUnaryWith)--import Data.Functor.Compose (Compose(..))-import qualified Data.Functor.Product as FP-import qualified Data.Functor.Sum as FS-#endif--import Data.String (IsString(..))--#include "MachDeps.h"--infixl 0 `hashWithSalt`----------------------------------------------------------------------------- * Computing hash values---- | A default salt used in the implementation of 'hash'.-defaultSalt :: Int-#if WORD_SIZE_IN_BITS == 64-defaultSalt = -2578643520546668380 -- 0xdc36d1615b7400a4-#else-defaultSalt = 0x087fc72c-#endif-{-# INLINE defaultSalt #-}---- | The class of types that can be converted to a hash value.------ Minimal implementation: 'hashWithSalt'.-class Hashable a where- -- | Return a hash value for the argument, using the given salt.- --- -- The general contract of 'hashWithSalt' is:- --- -- * 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. However, the programmer should be- -- aware that producing distinct integer results for unequal- -- values may 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-- -- | Like 'hashWithSalt', but no salt is used. The default- -- implementation uses 'hashWithSalt' with some default salt.- -- Instances might want to implement this method to provide a more- -- efficient implementation than the default implementation.- hash :: a -> Int- hash = hashWithSalt defaultSalt-- default hashWithSalt :: (Generic a, GHashable Zero (Rep a)) => Int -> a -> Int- hashWithSalt = genericHashWithSalt- {-# INLINE hashWithSalt #-}---- | Generic 'hashWithSalt'.------ @since 1.3.0.0-genericHashWithSalt :: (Generic a, GHashable Zero (Rep a)) => Int -> a -> Int-genericHashWithSalt = \salt -> ghashWithSalt HashArgs0 salt . from-{-# INLINE genericHashWithSalt #-}--data Zero-data One--data family HashArgs arity a :: *-data instance HashArgs Zero a = HashArgs0-newtype instance HashArgs One a = HashArgs1 (Int -> a -> Int)---- | The class of types that can be generically hashed.-class GHashable arity f where- ghashWithSalt :: HashArgs arity a -> Int -> f a -> Int--class Hashable1 t where- -- | Lift a hashing function through the type constructor.- liftHashWithSalt :: (Int -> a -> Int) -> Int -> t a -> Int-- default liftHashWithSalt :: (Generic1 t, GHashable One (Rep1 t)) => (Int -> a -> Int) -> Int -> t a -> Int- liftHashWithSalt = genericLiftHashWithSalt- {-# INLINE liftHashWithSalt #-}---- | Generic 'liftHashWithSalt'.------ @since 1.3.0.0-genericLiftHashWithSalt :: (Generic1 t, GHashable One (Rep1 t)) => (Int -> a -> Int) -> Int -> t a -> Int-genericLiftHashWithSalt = \h salt -> ghashWithSalt (HashArgs1 h) salt . from1-{-# INLINE genericLiftHashWithSalt #-}--class Hashable2 t where- -- | Lift a hashing function through the binary type constructor.- liftHashWithSalt2 :: (Int -> a -> Int) -> (Int -> b -> Int) -> Int -> t a b -> Int---- | Lift the 'hashWithSalt' function through the type constructor.------ > hashWithSalt1 = liftHashWithSalt hashWithSalt-hashWithSalt1 :: (Hashable1 f, Hashable a) => Int -> f a -> Int-hashWithSalt1 = liftHashWithSalt hashWithSalt---- | Lift the 'hashWithSalt' function through the type constructor.------ > hashWithSalt2 = liftHashWithSalt2 hashWithSalt hashWithSalt-hashWithSalt2 :: (Hashable2 f, Hashable a, Hashable b) => Int -> f a b -> Int-hashWithSalt2 = liftHashWithSalt2 hashWithSalt hashWithSalt---- | Lift the 'hashWithSalt' function halfway through the type constructor.--- This function makes a suitable default implementation of 'liftHashWithSalt',--- given that the type constructor @t@ in question can unify with @f a@.-defaultLiftHashWithSalt :: (Hashable2 f, Hashable a) => (Int -> b -> Int) -> Int -> f a b -> Int-defaultLiftHashWithSalt h = liftHashWithSalt2 hashWithSalt h---- | Since we support a generic implementation of 'hashWithSalt' we--- cannot also provide a default implementation for that method for--- the non-generic instance use case. Instead we provide--- 'defaultHashWith'.-defaultHashWithSalt :: Hashable a => Int -> a -> Int-defaultHashWithSalt salt x = salt `combine` hash x---- | 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- hash = id- hashWithSalt = defaultHashWithSalt--instance Hashable Int8 where- hash = fromIntegral- hashWithSalt = defaultHashWithSalt--instance Hashable Int16 where- hash = fromIntegral- hashWithSalt = defaultHashWithSalt--instance Hashable Int32 where- hash = fromIntegral- 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--instance Hashable Word where- hash = fromIntegral- hashWithSalt = defaultHashWithSalt--instance Hashable Word8 where- hash = fromIntegral- hashWithSalt = defaultHashWithSalt--instance Hashable Word16 where- hash = fromIntegral- hashWithSalt = defaultHashWithSalt--instance Hashable Word32 where- hash = fromIntegral- 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--instance Hashable () where- hash = fromEnum- hashWithSalt = defaultHashWithSalt--instance Hashable Bool where- hash = fromEnum- hashWithSalt = defaultHashWithSalt--instance Hashable Ordering where- hash = fromEnum- hashWithSalt = defaultHashWithSalt--instance Hashable Char where- hash = fromEnum- hashWithSalt = defaultHashWithSalt--#if defined(MIN_VERSION_integer_gmp_1_0_0)-instance Hashable BigNat where- hashWithSalt salt (BN# ba) = hashByteArrayWithSalt ba 0 numBytes salt- `hashWithSalt` size- where- size = numBytes `quot` SIZEOF_HSWORD- numBytes = I# (sizeofByteArray# ba)-#endif--#if MIN_VERSION_base(4,8,0)-instance Hashable Natural where-# if defined(MIN_VERSION_integer_gmp_1_0_0)- hash (NatS# n) = hash (W# n)- hash (NatJ# bn) = hash bn-- hashWithSalt salt (NatS# n) = hashWithSalt salt (W# n)- hashWithSalt salt (NatJ# bn) = hashWithSalt salt bn-# else- hash (Natural n) = hash n-- hashWithSalt salt (Natural n) = hashWithSalt salt n-# endif-#endif--instance Hashable Integer where-#if defined(VERSION_integer_gmp)-# if defined(MIN_VERSION_integer_gmp_1_0_0)- hash (S# n) = (I# n)- hash (Jp# bn) = hash bn- hash (Jn# bn) = negate (hash bn)-- hashWithSalt salt (S# n) = hashWithSalt salt (I# n)- hashWithSalt salt (Jp# bn) = hashWithSalt salt bn- hashWithSalt salt (Jn# bn) = negate (hashWithSalt salt bn)-# else- hash (S# int) = I# int- hash n@(J# size# byteArray)- | n >= minInt && n <= maxInt = fromInteger n :: Int- | otherwise = let size = I# size#- numBytes = SIZEOF_HSWORD * abs size- in hashByteArrayWithSalt byteArray 0 numBytes defaultSalt- `hashWithSalt` size- where minInt = fromIntegral (minBound :: Int)- maxInt = fromIntegral (maxBound :: Int)-- hashWithSalt salt (S# n) = hashWithSalt salt (I# n)- hashWithSalt salt n@(J# size# byteArray)- | n >= minInt && n <= maxInt = hashWithSalt salt (fromInteger n :: Int)- | otherwise = let size = I# size#- numBytes = SIZEOF_HSWORD * abs size- in hashByteArrayWithSalt byteArray 0 numBytes salt- `hashWithSalt` size- where minInt = fromIntegral (minBound :: Int)- maxInt = fromIntegral (maxBound :: Int)-# endif-#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 Hashable a => Hashable (Complex a) where- {-# SPECIALIZE instance Hashable (Complex Double) #-}- {-# SPECIALIZE instance Hashable (Complex Float) #-}- hash (r :+ i) = hash r `hashWithSalt` i- hashWithSalt = hashWithSalt1-instance Hashable1 Complex where- liftHashWithSalt h s (r :+ i) = s `h` r `h` i--#if MIN_VERSION_base(4,9,0)--- Starting with base-4.9, numerator/denominator don't need 'Integral' anymore-instance Hashable a => Hashable (Ratio a) where-#else-instance (Integral a, Hashable a) => Hashable (Ratio a) where-#endif- {-# SPECIALIZE instance Hashable (Ratio Integer) #-}- hash a = hash (numerator a) `hashWithSalt` denominator a- hashWithSalt s a = s `hashWithSalt` numerator a `hashWithSalt` denominator a---- | __Note__: prior to @hashable-1.3.0.0@, @hash 0.0 /= hash (-0.0)@------ The 'hash' of NaN is not well defined.------ @since 1.3.0.0-instance Hashable Float where- hash x- | x == -0.0 || x == 0.0 = 0 -- see note in 'Hashable Double'- | isIEEE x =- assert (sizeOf x >= sizeOf (0::Word32) &&- alignment x >= alignment (0::Word32)) $- hash ((unsafeDupablePerformIO $ with x $ peek . castPtr) :: Word32)- | otherwise = hash (show x)- hashWithSalt = defaultHashWithSalt---- | __Note__: prior to @hashable-1.3.0.0@, @hash 0.0 /= hash (-0.0)@------ The 'hash' of NaN is not well defined.------ @since 1.3.0.0-instance Hashable Double where- hash x- | x == -0.0 || x == 0.0 = 0 -- s.t. @hash -0.0 == hash 0.0@ ; see #173- | isIEEE x =- assert (sizeOf x >= sizeOf (0::Word64) &&- alignment x >= alignment (0::Word64)) $- hash ((unsafeDupablePerformIO $ with x $ peek . castPtr) :: Word64)- | otherwise = hash (show x)- hashWithSalt = defaultHashWithSalt---- | 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 = hashWithSalt1--instance Hashable1 Maybe where- liftHashWithSalt _ s Nothing = s `combine` 0- liftHashWithSalt h s (Just a) = s `combine` distinguisher `h` a--instance (Hashable a, Hashable b) => Hashable (Either a b) where- hash (Left a) = 0 `hashWithSalt` a- hash (Right b) = distinguisher `hashWithSalt` b- hashWithSalt = hashWithSalt1--instance Hashable a => Hashable1 (Either a) where- 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--instance (Hashable a1, Hashable a2) => Hashable (a1, a2) where- hash (a1, a2) = hash a1 `hashWithSalt` a2- hashWithSalt = hashWithSalt1--instance Hashable a1 => Hashable1 ((,) a1) where- liftHashWithSalt = defaultLiftHashWithSalt--instance Hashable2 (,) where- liftHashWithSalt2 h1 h2 s (a1, a2) = s `h1` a1 `h2` a2--instance (Hashable a1, Hashable a2, Hashable a3) => Hashable (a1, a2, a3) where- hash (a1, a2, a3) = hash a1 `hashWithSalt` a2 `hashWithSalt` a3- hashWithSalt = hashWithSalt1--instance (Hashable a1, Hashable a2) => Hashable1 ((,,) a1 a2) where- liftHashWithSalt = defaultLiftHashWithSalt--instance Hashable a1 => Hashable2 ((,,) a1) where- liftHashWithSalt2 h1 h2 s (a1, a2, a3) =- (s `hashWithSalt` a1) `h1` a2 `h2` 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 = hashWithSalt1--instance (Hashable a1, Hashable a2, Hashable a3) => Hashable1 ((,,,) a1 a2 a3) where- liftHashWithSalt = defaultLiftHashWithSalt--instance (Hashable a1, Hashable a2) => Hashable2 ((,,,) a1 a2) where- liftHashWithSalt2 h1 h2 s (a1, a2, a3, a4) =- (s `hashWithSalt` a1 `hashWithSalt` a2) `h1` a3 `h2` 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 = hashWithSalt1--instance (Hashable a1, Hashable a2, Hashable a3,- Hashable a4) => Hashable1 ((,,,,) a1 a2 a3 a4) where- liftHashWithSalt = defaultLiftHashWithSalt--instance (Hashable a1, Hashable a2, Hashable a3)- => Hashable2 ((,,,,) a1 a2 a3) where- liftHashWithSalt2 h1 h2 s (a1, a2, a3, a4, a5) =- (s `hashWithSalt` a1 `hashWithSalt` a2- `hashWithSalt` a3) `h1` a4 `h2` 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 = hashWithSalt1--instance (Hashable a1, Hashable a2, Hashable a3, Hashable a4,- Hashable a5) => Hashable1 ((,,,,,) a1 a2 a3 a4 a5) where- liftHashWithSalt = defaultLiftHashWithSalt--instance (Hashable a1, Hashable a2, Hashable a3,- Hashable a4) => Hashable2 ((,,,,,) a1 a2 a3 a4) where- liftHashWithSalt2 h1 h2 s (a1, a2, a3, a4, a5, a6) =- (s `hashWithSalt` a1 `hashWithSalt` a2 `hashWithSalt` a3- `hashWithSalt` a4) `h1` a5 `h2` 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--instance (Hashable a1, Hashable a2, Hashable a3, Hashable a4, Hashable a5, Hashable a6) => Hashable1 ((,,,,,,) a1 a2 a3 a4 a5 a6) where- liftHashWithSalt = defaultLiftHashWithSalt--instance (Hashable a1, Hashable a2, Hashable a3, Hashable a4,- Hashable a5) => Hashable2 ((,,,,,,) a1 a2 a3 a4 a5) where- liftHashWithSalt2 h1 h2 s (a1, a2, a3, a4, a5, a6, a7) =- (s `hashWithSalt` a1 `hashWithSalt` a2 `hashWithSalt` a3- `hashWithSalt` a4 `hashWithSalt` a5) `h1` a6 `h2` a7--instance Hashable (StableName a) where- hash = hashStableName- hashWithSalt = defaultHashWithSalt---- Auxillary type for Hashable [a] definition-data SPInt = SP !Int !Int--instance Hashable a => Hashable [a] where- {-# SPECIALIZE instance Hashable [Char] #-}- hashWithSalt = hashWithSalt1--instance Hashable1 [] where- liftHashWithSalt h salt arr = finalise (foldl' step (SP salt 0) arr)- where- finalise (SP s l) = hashWithSalt s l- step (SP s l) x = SP (h s x) (l + 1)--instance Hashable B.ByteString where- hashWithSalt salt bs = unsafeDupablePerformIO $- B.unsafeUseAsCStringLen bs $ \(p, len) ->- hashPtrWithSalt p (fromIntegral len) salt--instance Hashable BL.ByteString where- hashWithSalt = BL.foldlChunks hashWithSalt--#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-#endif--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 = TL.foldlChunks hashWithSalt---- | Compute the hash of a ThreadId.-hashThreadId :: ThreadId -> Int-hashThreadId (ThreadId t) = hash (fromIntegral (getThreadId t) :: Int)--foreign import ccall unsafe "rts_getThreadId" getThreadId- :: ThreadId# -> CInt--instance Hashable ThreadId where- hash = hashThreadId- hashWithSalt = defaultHashWithSalt--instance Hashable (Ptr a) where- hashWithSalt salt p = hashWithSalt salt $ ptrToIntPtr p--instance Hashable (FunPtr a) where- hashWithSalt salt p = hashWithSalt salt $ castFunPtrToPtr p--instance Hashable IntPtr where- hash n = fromIntegral n- hashWithSalt = defaultHashWithSalt--instance Hashable WordPtr where- hash n = fromIntegral n- hashWithSalt = defaultHashWithSalt--------------------------------------------------------------------------------- Fingerprint & TypeRep instances---- | @since 1.3.0.0-instance Hashable Fingerprint where- hash (Fingerprint x _) = fromIntegral x- hashWithSalt = defaultHashWithSalt- {-# INLINE hash #-}--#if MIN_VERSION_base(4,10,0)--hashTypeRep :: Type.Reflection.TypeRep a -> Int-hashTypeRep tr =- let Fingerprint x _ = typeRepFingerprint tr in fromIntegral x--instance Hashable Type.Reflection.SomeTypeRep where- hash (Type.Reflection.SomeTypeRep r) = hashTypeRep r- hashWithSalt = defaultHashWithSalt- {-# INLINE hash #-}--instance Hashable (Type.Reflection.TypeRep a) where- hash = hashTypeRep- hashWithSalt = defaultHashWithSalt- {-# INLINE hash #-}--#else---- | Compute the hash of a TypeRep, in various GHC versions we can do this quickly.-hashTypeRep :: TypeRep -> Int-{-# INLINE hashTypeRep #-}-#if MIN_VERSION_base(4,8,0)--- Fingerprint is just the MD5, so taking any Int from it is fine-hashTypeRep tr = let Fingerprint x _ = typeRepFingerprint tr in fromIntegral x-#else--- Fingerprint is just the MD5, so taking any Int from it is fine-hashTypeRep (TypeRep (Fingerprint x _) _ _) = fromIntegral x-#endif--instance Hashable TypeRep where- hash = hashTypeRep- hashWithSalt = defaultHashWithSalt- {-# INLINE hash #-}--#endif--------------------------------------------------------------------------------#if MIN_VERSION_base(4,8,0)-instance Hashable Void where- hashWithSalt _ = absurd-#endif---- | 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_hashCString (castPtr p) (fromIntegral len)- (fromIntegral salt)--foreign import ccall unsafe "hashable_fnv_hash" c_hashCString- :: CString -> CLong -> CLong -> IO CLong---- | 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- -> 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.-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)--foreign import ccall unsafe "hashable_fnv_hash_offset" c_hashByteArray- :: ByteArray# -> CLong -> CLong -> CLong -> CLong---- | 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--instance Hashable Version where- hashWithSalt salt (Version branch tags) =- salt `hashWithSalt` branch `hashWithSalt` tags--#if MIN_VERSION_base(4,7,0)--- Using hashWithSalt1 would cause needless constraint-instance Hashable (Fixed a) where- hashWithSalt salt (MkFixed i) = hashWithSalt salt i-instance Hashable1 Fixed where- liftHashWithSalt _ salt (MkFixed i) = hashWithSalt salt i-#endif--#if MIN_VERSION_base(4,8,0)-instance Hashable a => Hashable (Identity a) where- hashWithSalt = hashWithSalt1-instance Hashable1 Identity where- liftHashWithSalt h salt (Identity x) = h salt x-#endif---- Using hashWithSalt1 would cause needless constraint-instance Hashable a => Hashable (Const a b) where- hashWithSalt salt (Const x) = hashWithSalt salt x--instance Hashable a => Hashable1 (Const a) where- liftHashWithSalt = defaultLiftHashWithSalt--instance Hashable2 Const where- liftHashWithSalt2 f _ salt (Const x) = f salt x--#if MIN_VERSION_base(4,7,0)-instance Hashable (Proxy a) where- hash _ = 0- hashWithSalt s _ = s--instance Hashable1 Proxy where- liftHashWithSalt _ s _ = s-#endif---- instances formerly provided by 'semigroups' package-#if MIN_VERSION_base(4,9,0)-instance Hashable a => Hashable (NE.NonEmpty a) where- hashWithSalt p (a NE.:| as) = p `hashWithSalt` a `hashWithSalt` as--instance Hashable a => Hashable (Min a) where- hashWithSalt p (Min a) = hashWithSalt p a--instance Hashable a => Hashable (Max a) where- hashWithSalt p (Max a) = hashWithSalt p a---- | __Note__: Prior to @hashable-1.3.0.0@ the hash computation included the second argument of 'Arg' which wasn't consistent with its 'Eq' instance.------ @since 1.3.0.0-instance Hashable a => Hashable (Arg a b) where- hashWithSalt p (Arg a _) = hashWithSalt p a--instance Hashable a => Hashable (First a) where- hashWithSalt p (First a) = hashWithSalt p a--instance Hashable a => Hashable (Last a) where- hashWithSalt p (Last a) = hashWithSalt p a--instance Hashable a => Hashable (WrappedMonoid a) where- hashWithSalt p (WrapMonoid a) = hashWithSalt p a--instance Hashable a => Hashable (Option a) where- hashWithSalt p (Option a) = hashWithSalt p a-#endif---- instances for @Data.Functor.{Product,Sum,Compose}@, present--- in base-4.9 and onward.-#if MIN_VERSION_base(4,9,0)--- | In general, @hash (Compose x) ≠ hash x@. However, @hashWithSalt@ satisfies--- its variant of this equivalence.-instance (Hashable1 f, Hashable1 g, Hashable a) => Hashable (Compose f g a) where- hashWithSalt = hashWithSalt1--instance (Hashable1 f, Hashable1 g) => Hashable1 (Compose f g) where- liftHashWithSalt h s = liftHashWithSalt (liftHashWithSalt h) s . getCompose--instance (Hashable1 f, Hashable1 g) => Hashable1 (FP.Product f g) where- liftHashWithSalt h s (FP.Pair a b) = liftHashWithSalt h (liftHashWithSalt h s a) b--instance (Hashable1 f, Hashable1 g, Hashable a) => Hashable (FP.Product f g a) where- 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--instance (Hashable1 f, Hashable1 g, Hashable a) => Hashable (FS.Sum f g a) where- hashWithSalt = hashWithSalt1-#endif---- | A hashable value along with the result of the 'hash' function.-data Hashed a = Hashed a {-# UNPACK #-} !Int- deriving (Typeable)---- | Wrap a hashable value, caching the 'hash' function result.-hashed :: Hashable a => a -> Hashed a-hashed a = Hashed a (hash a)---- | Unwrap hashed value.-unhashed :: Hashed a -> a-unhashed (Hashed a _) = a---- | Uses precomputed hash to detect inequality faster-instance Eq a => Eq (Hashed a) where- Hashed a ha == Hashed b hb = ha == hb && a == b--instance Ord a => Ord (Hashed a) where- Hashed a _ `compare` Hashed b _ = a `compare` b--instance Show a => Show (Hashed a) where- showsPrec d (Hashed a _) = showParen (d > 10) $- showString "hashed" . showChar ' ' . showsPrec 11 a--instance Hashable (Hashed a) where- hashWithSalt = defaultHashWithSalt- hash (Hashed _ h) = h---- This instance is a little unsettling. It is unusal for--- 'liftHashWithSalt' to ignore its first argument when a--- value is actually available for it to work on.-instance Hashable1 Hashed where- liftHashWithSalt _ s (Hashed _ h) = defaultHashWithSalt s h--instance (IsString a, Hashable a) => IsString (Hashed a) where- fromString s = let r = fromString s in Hashed r (hash r)--instance F.Foldable Hashed where- foldr f acc (Hashed a _) = f a acc--instance NFData a => NFData (Hashed a) where- rnf = rnf . unhashed---- | 'Hashed' cannot be 'Functor'-mapHashed :: Hashable b => (a -> b) -> Hashed a -> Hashed b-mapHashed f (Hashed a _) = hashed (f a)---- | 'Hashed' cannot be 'Traversable'-traverseHashed :: (Hashable b, Functor f) => (a -> f b) -> Hashed a -> f (Hashed b)-traverseHashed f (Hashed a _) = fmap hashed (f a)---- instances for @Data.Functor.Classes@ higher rank typeclasses--- in base-4.9 and onward.-#if MIN_VERSION_base(4,9,0)-instance Eq1 Hashed where- liftEq f (Hashed a ha) (Hashed b hb) = ha == hb && f a b--instance Ord1 Hashed where- liftCompare f (Hashed a _) (Hashed b _) = f a b--instance Show1 Hashed where- liftShowsPrec sp _ d (Hashed a _) = showsUnaryWith sp "hashed" d a-#endif
− Data/Hashable/Generic.hs
@@ -1,25 +0,0 @@-{-# LANGUAGE Trustworthy #-}---- |--- Module : Data.Hashable.Generic--- SPDX-License-Identifier : BSD-3-Clause--- Stability : provisional--- Portability : GHC >= 7.4------ Hashable support for GHC generics.------ @since 1.3.0.0-module Data.Hashable.Generic- (- -- * Implementation using Generics.- genericHashWithSalt- , genericLiftHashWithSalt- -- * Constraints- , GHashable (..)- , One- , Zero- , HashArgs (..)- ) where--import Data.Hashable.Generic.Instances ()-import Data.Hashable.Class
− Data/Hashable/Generic/Instances.hs
@@ -1,121 +0,0 @@-{-# LANGUAGE BangPatterns, FlexibleInstances, KindSignatures,- ScopedTypeVariables, TypeOperators,- MultiParamTypeClasses, GADTs, FlexibleContexts #-}-{-# OPTIONS_GHC -fno-warn-orphans #-}----------------------------------------------------------------------------- |--- Module : Data.Hashable.Generic.Instances--- Copyright : (c) Bryan O'Sullivan 2012--- SPDX-License-Identifier : BSD-3-Clause--- Maintainer : bos@serpentine.com--- Stability : provisional--- Portability : GHC >= 7.4------ Internal module defining orphan instances for "GHC.Generics"----module Data.Hashable.Generic.Instances () where--import Data.Hashable.Class-import GHC.Generics---- Type without constructors-instance GHashable arity V1 where- ghashWithSalt _ salt _ = hashWithSalt salt ()---- Constructor without arguments-instance GHashable arity U1 where- ghashWithSalt _ salt U1 = hashWithSalt salt ()--instance (GHashable arity a, GHashable arity b) => GHashable arity (a :*: b) where- ghashWithSalt toHash salt (x :*: y) =- (ghashWithSalt toHash (ghashWithSalt toHash salt x) y)---- Metadata (constructor name, etc)-instance GHashable arity a => GHashable arity (M1 i c a) where- ghashWithSalt targs salt = ghashWithSalt targs salt . unM1---- Constants, additional parameters, and rank-1 recursion-instance Hashable a => GHashable arity (K1 i a) where- ghashWithSalt _ = hashUsing unK1--instance GHashable One Par1 where- ghashWithSalt (HashArgs1 h) salt = h salt . unPar1--instance Hashable1 f => GHashable One (Rec1 f) where- ghashWithSalt (HashArgs1 h) salt = liftHashWithSalt h salt . unRec1--instance (Hashable1 f, GHashable One g) => GHashable One (f :.: g) where- ghashWithSalt targs salt = liftHashWithSalt (ghashWithSalt targs) salt . unComp1--class SumSize f => GSum arity f where- hashSum :: HashArgs arity a -> Int -> Int -> f a -> Int- -- hashSum args salt index value = ...---- [Note: Hashing a sum type]------ The tree structure is used in GHC.Generics to represent the sum (and--- product) part of the generic represention of the type, e.g.:------ (C0 ... :+: C1 ...) :+: (C2 ... :+: (C3 ... :+: C4 ...))------ The value constructed with C2 constructor is represented as (R1 (L1 ...)).--- Yet, if we think that this tree is a flat (heterogenous) list:------ [C0 ..., C1 ..., C2 ..., C3 ..., C4... ]------ then the value constructed with C2 is a (dependent) pair (2, ...), and--- hashing it is simple:------ salt `hashWithSalt` (2 :: Int) `hashWithSalt` ...------ This is what we do below. When drilling down the tree, we count how many--- leafs are to the left (`index` variable). At the leaf case C1, we'll have an--- actual index into the sum.------ This works well for balanced data. However for recursive types like:------ data Nat = Z | S Nat------ the `hashWithSalt salt (S (S (S Z)))` is------ salt `hashWithSalt` (1 :: Int) -- first S--- `hashWithSalt` (1 :: Int) -- second S--- `hashWithSalt` (1 :: Int) -- third S--- `hashWithSalt` (0 :: Int) -- Z--- `hashWithSalt` () -- U1------ For that type the manual implementation:------ instance Hashable Nat where--- hashWithSalt salt n = hashWithSalt salt (natToInteger n)------ would be better performing CPU and hash-quality wise (assuming that--- Integer's Hashable is of high quality).----instance (GSum arity a, GSum arity b) => GHashable arity (a :+: b) where- ghashWithSalt toHash salt = hashSum toHash salt 0--instance (GSum arity a, GSum arity b) => GSum arity (a :+: b) where- hashSum toHash !salt !index s = case s of- L1 x -> hashSum toHash salt index x- R1 x -> hashSum toHash salt (index + sizeL) x- where- sizeL = unTagged (sumSize :: Tagged a)- {-# INLINE hashSum #-}--instance GHashable arity a => GSum arity (C1 c a) where- hashSum toHash !salt !index (M1 x) = ghashWithSalt toHash (hashWithSalt salt index) 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/Lifted.hs
@@ -1,98 +0,0 @@-{-# LANGUAGE Trustworthy #-}----------------------------------------------------------------------------- |--- Module : Data.Hashable.Lifted--- Copyright : (c) Milan Straka 2010--- (c) Johan Tibell 2011--- (c) Bryan O'Sullivan 2011, 2012--- SPDX-License-Identifier : BSD-3-Clause--- Maintainer : johan.tibell@gmail.com--- Stability : provisional--- Portability : portable------ Lifting of the 'Hashable' class to unary and binary type constructors.--- These classes are needed to express the constraints on arguments of--- types that are parameterized by type constructors. Fixed-point data--- types and monad transformers are such types.--module Data.Hashable.Lifted- ( -- * Type Classes- Hashable1(..)- , Hashable2(..)- -- * Auxiliary Functions- , hashWithSalt1- , hashWithSalt2- , defaultLiftHashWithSalt- -- * Motivation- -- $motivation- ) where--import Data.Hashable.Class---- $motivation------ This type classes provided in this module are used to express constraints--- on type constructors in a Haskell98-compatible fashion. As an example, consider--- the following two types (Note that these instances are not actually provided--- because @hashable@ does not have @transformers@ or @free@ as a dependency):------ > newtype WriterT w m a = WriterT { runWriterT :: m (a, w) }--- > data Free f a = Pure a | Free (f (Free f a))------ The 'Hashable1' instances for @WriterT@ and @Free@ could be written as:------ > instance (Hashable w, Hashable1 m) => Hashable1 (WriterT w m) where--- > liftHashWithSalt h s (WriterT m) =--- > liftHashWithSalt (liftHashWithSalt2 h hashWithSalt) s m--- > instance Hashable1 f => Hashable1 (Free f) where--- > liftHashWithSalt h = go where--- > go s x = case x of--- > Pure a -> h s a--- > Free p -> liftHashWithSalt go s p------ The 'Hashable' instances for these types can be trivially recovered with--- 'hashWithSalt1':------ > instance (Hashable w, Hashable1 m, Hashable a) => Hashable (WriterT w m a) where--- > hashWithSalt = hashWithSalt1--- > instance (Hashable1 f, Hashable a) => Hashable (Free f a) where--- > hashWithSalt = hashWithSalt1------- $discussion------ Regardless of whether 'hashWithSalt1' is used to provide an implementation--- of 'hashWithSalt', they should produce the same hash when called with--- the same arguments. This is the only law that 'Hashable1' and 'Hashable2'--- are expected to follow.------ The typeclasses in this module only provide lifting for 'hashWithSalt', not--- for 'hash'. This is because such liftings cannot be defined in a way that--- would satisfy the @liftHash@ variant of the above law. As an illustration--- of the problem we run into, let us assume that 'Hashable1' were--- given a 'liftHash' method:------ > class Hashable1 t where--- > liftHash :: (a -> Int) -> t a -> Int--- > liftHashWithSalt :: (Int -> a -> Int) -> Int -> t a -> Int------ Even for a type as simple as 'Maybe', the problem manifests itself. The--- 'Hashable' instance for 'Maybe' is:------ > distinguisher :: Int--- > distinguisher = ...--- >--- > instance Hashable a => Hashable (Maybe a) where--- > hash Nothing = 0--- > hash (Just a) = distinguisher `hashWithSalt` a--- > hashWithSalt s Nothing = ...--- > hashWithSalt s (Just a) = ...------ The implementation of 'hash' calls 'hashWithSalt' on @a@. The hypothetical--- @liftHash@ defined earlier only accepts an argument that corresponds to--- the implementation of 'hash' for @a@. Consequently, this formulation of--- @liftHash@ would not provide a way to match the current behavior of 'hash'--- for 'Maybe'. This problem gets worse when 'Either' and @[]@ are considered.--- The solution adopted in this library is to omit @liftHash@ entirely.-
− Data/Hashable/RandomSource.hs
@@ -1,32 +0,0 @@-{-# LANGUAGE CPP, ForeignFunctionInterface #-}-#if defined(__GLASGOW_HASKELL__) && __GLASGOW_HASKELL__ >= 702-{-# LANGUAGE Trustworthy #-}-#endif--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
@@ -1,159 +0,0 @@-{-# 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
@@ -1,314 +0,0 @@-{-# LANGUAGE BangPatterns, CPP, ForeignFunctionInterface, MagicHash,- UnboxedTuples, DeriveGeneric #-}--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 GHC.Generics (Generic)-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).-main :: IO ()-main = do- -- We do not actually care about the contents of these pointers.- fp5 <- mallocForeignPtrBytes 5- 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-- let exP = P 22.0203 234.19 'x' 6424- exS = S3- exPS = PS3 'z' 7715-- -- We don't care about the contents of these either.- 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_SSE2- sse2SipHash (PS fp off len) =- inlinePerformIO . withForeignPtr fp $ \ptr ->- return $! sse2_siphash k0 k1 (ptr `plusPtr` off) (fromIntegral len)-#endif-#ifdef HAVE_SSE41- 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"- [ bench "5" $ whnfIO $ hashPtr p5 5- , bench "8" $ whnfIO $ hashPtr p8 8- , bench "11" $ whnfIO $ hashPtr p11 11- , bench "40" $ whnfIO $ hashPtr p40 40- , bench "128" $ whnfIO $ hashPtr p128 128- , bench "512" $ whnfIO $ hashPtr p512 512- , bench "2^20" $ whnfIO $ hashPtr p1Mb mb- ]- , bgroup "hashByteArray"- [ bench "5" $ whnf (hashByteArray ba5 0) 5- , 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_SSE2- , 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- ]-#endif-#ifdef HAVE_SSE41- , 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- ]- , bgroup "Generic"- [ bench "product" $ whnf hash exP- , bench "sum" $ whnf hash exS- , bench "product and sum" $ whnf hash exPS- ]- ]--data ByteArray = BA { unBA :: !ByteArray# }--new :: Int -> ByteArray#-new (I# n#) = unBA (runST $ ST $ \s1 ->- 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_SSE2-foreign import ccall unsafe "hashable_siphash24_sse2" sse2_siphash- :: Word64 -> Word64 -> Ptr Word8 -> CSize -> Word64-#endif-#ifdef HAVE_SSE41-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--data PS- = PS1 Int Char Bool- | PS2 String ()- | PS3 Char Int- deriving (Generic)--data P = P Double Float Char Int- deriving (Generic)--data S = S1 | S2 | S3 | S4 | S5- deriving (Generic)--instance Hashable PS-instance Hashable P-instance Hashable S-
− benchmarks/cbits/inthash.c
@@ -1,28 +0,0 @@-#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;-}
− benchmarks/cbits/siphash-sse2.c
@@ -1,129 +0,0 @@-/*- * The original code was developed by Samuel Neves, and has been- * only lightly modified.- *- * Used with permission.- */-#pragma GCC target("sse2")--#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;- const u8 *p;-- /* We used to use the _mm_seti_epi32 intrinsic to initialize- SSE2 registers. This compiles to a movdqa instruction,- which requires 16-byte alignment. On 32-bit Windows, it- looks like ghc's runtime linker doesn't align ".rdata"- sections as requested, so we got segfaults for our trouble.-- Now we use an intrinsic that cares less about alignment- (_mm_loadu_si128, aka movdqu) instead, and all seems- happy. */-- static const u32 const iv[6][4] = {- { 0x70736575, 0x736f6d65, 0, 0 },- { 0x6e646f6d, 0x646f7261, 0, 0 },- { 0x6e657261, 0x6c796765, 0, 0 },- { 0x79746573, 0x74656462, 0, 0 },- { -1, -1, 0, 0 },- { 255, 0, 0, 0 },- };-- k0 = _mm_loadl_epi64((__m128i*)(&ik0));- k1 = _mm_loadl_epi64((__m128i*)(&ik1));-- v0 = _mm_xor_si128(k0, _mm_loadu_si128((__m128i*) &iv[0]));- v1 = _mm_xor_si128(k1, _mm_loadu_si128((__m128i*) &iv[1]));- v2 = _mm_xor_si128(k0, _mm_loadu_si128((__m128i*) &iv[2]));- v3 = _mm_xor_si128(k1, _mm_loadu_si128((__m128i*) &iv[3]));--#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);- if (SIPHASH_ROUNDS == 2) {- COMPRESS(v0,v1,v2,v3); COMPRESS(v0,v1,v2,v3);- } else {- for (k = 0; k < SIPHASH_ROUNDS; ++k)- COMPRESS(v0,v1,v2,v3);- }- v0 = _mm_xor_si128(v0, mi);- }-- p = m + n;-- /* We must be careful to not trigger a segfault by reading an- unmapped page. So where is the end of our input? */-- if (((uintptr_t) p & 4095) == 0)- /* Exactly at a page boundary: do not read past the end. */- mi = _mm_setzero_si128();- else if (((uintptr_t) p & 4095) <= 4088)- /* Inside a page: safe to read past the end, as we'll- mask out any bits we shouldn't have looked at below. */- mi = _mm_loadl_epi64((__m128i*)(m + i));- else- /* Within 8 bytes of the end of a page: ensure that- our final read re-reads some bytes so that we do- not cross the page boundary, then shift our result- right so that the re-read bytes vanish. */- mi = _mm_srli_epi64(_mm_loadl_epi64((__m128i*)(((uintptr_t) m + i) & ~7)),- 8 * (((uintptr_t) m + i) % 8));-- len = _mm_set_epi32(0, 0, (n&0xff) << 24, 0);- mask = _mm_srli_epi64(_mm_loadu_si128((__m128i*) &iv[4]), 8*(8-n%8));- mi = _mm_xor_si128(_mm_and_si128(mi, mask), len);-- v3 = _mm_xor_si128(v3, mi);- if (SIPHASH_ROUNDS == 2) {- COMPRESS(v0,v1,v2,v3); COMPRESS(v0,v1,v2,v3);- } else {- for (k = 0; k < SIPHASH_ROUNDS; ++k)- COMPRESS(v0,v1,v2,v3);- }- v0 = _mm_xor_si128(v0, mi);-- v2 = _mm_xor_si128(v2, _mm_loadu_si128((__m128i*) &iv[5]));- if (SIPHASH_FINALROUNDS == 4) {- COMPRESS(v0,v1,v2,v3); COMPRESS(v0,v1,v2,v3);- COMPRESS(v0,v1,v2,v3); COMPRESS(v0,v1,v2,v3);- } else {- 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;-}
− benchmarks/cbits/siphash-sse41.c
@@ -1,86 +0,0 @@-/*- * The original code was developed by Samuel Neves, and has been- * only lightly modified.- *- * Used with permission.- */-#pragma GCC target("sse4.1")--#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;-}
− benchmarks/cbits/siphash.c
@@ -1,262 +0,0 @@-/* 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 = peek_u64le((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 defined(HAVE_SSE2)- if (edx & (1 << 26))- _siphash24 = hashable_siphash24_sse2;-#if defined(HAVE_SSE41)- else if (ecx & (1 << 19))- _siphash24 = hashable_siphash24_sse41;-#endif- else-#endif- _siphash24 = plain_siphash24;-}--#endif--/* ghci's linker fails to call static initializers. */-static inline void ensure_sse_init()-{-#if defined(__i386)- if (_siphash24 == NULL)- maybe_use_sse();-#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)-{- ensure_sse_init();- 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)-{- ensure_sse_init();- 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 = peek_u64le((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);-}
− benchmarks/cbits/wang.c
@@ -1,29 +0,0 @@-/*- * 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/fnv.c view
@@ -31,6 +31,14 @@ OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. */ +#include "MachDeps.h"++#if WORD_SIZE_IN_BITS == 64+#define FNV_PRIME 1099511628211+#else+#define FNV_PRIME 16777619+#endif+ /* FNV-1 hash * * The FNV-1 hash description: http://isthe.com/chongo/tech/comp/fnv/
− cbits/getRandomBytes.c
@@ -1,93 +0,0 @@-/*-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
hashable.cabal view
@@ -1,47 +1,32 @@ Cabal-version: 1.12 Name: hashable-Version: 1.3.0.0+Version: 1.3.1.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 exists for the benefit of hashing-based data structures. The package provides instances for basic types and a way to combine hash values.-Homepage: http://github.com/tibbe/hashable+Homepage: http://github.com/haskell-unordered-containers/hashable -- SPDX-License-Identifier : BSD-3-Clause License: BSD3 License-file: LICENSE Author: Milan Straka <fox@ucw.cz> Johan Tibell <johan.tibell@gmail.com>-Maintainer: johan.tibell@gmail.com-bug-reports: https://github.com/tibbe/hashable/issues+Maintainer: Oleg Grenrus <oleg.grenrus@iki.fi>+bug-reports: https://github.com/haskell-unordered-containers/hashable/issues Stability: Provisional Category: Data Build-type: Simple-tested-with: GHC==8.8.1, GHC==8.6.5, GHC==8.4.4, GHC==8.2.2, GHC==8.0.2, GHC==7.10.3, GHC==7.8.4, GHC==7.6.3, GHC==7.4.2+tested-with: GHC==8.10.3, GHC==8.8.3, GHC==8.6.5, GHC==8.4.4, GHC==8.2.2, GHC==8.0.2, GHC==7.10.3, GHC==7.8.4, GHC==7.6.3, GHC==7.4.2 Extra-source-files: CHANGES.md, README.md Flag integer-gmp- Description: Are we using @integer-gmp@ to provide fast Integer instances?+ Description: Are we using @integer-gmp@ to provide fast Integer instances? No effect on GHC-9.0 or later. Default: True -Flag sse2- Description: Do we want to assume that a target supports SSE 2?- Default: True- Manual: True--Flag sse41- Description: Do we want to assume that a target supports SSE 4.1?- Default: False- Manual: True--Flag examples- Description: Build example modules- Default: False- Manual: True- Library Exposed-modules: Data.Hashable Data.Hashable.Lifted@@ -50,18 +35,22 @@ Data.Hashable.Generic.Instances C-sources: cbits/fnv.c+ hs-source-dirs: src - Build-depends: base >= 4.5 && < 4.14- , bytestring >= 0.9 && < 0.11+ Build-depends: base >= 4.5 && < 4.16+ , bytestring >= 0.9 && < 0.12 , deepseq >= 1.3 && < 1.5 , text >= 0.12 && < 1.3 , ghc-prim - if flag(integer-gmp)- Build-depends: integer-gmp >= 0.4 && < 1.1+ if impl(ghc >= 9)+ Build-depends: ghc-bignum >= 1.0 && <1.1 else- -- this is needed for the automatic flag to be well-balanced- Build-depends: integer-simple+ if flag(integer-gmp)+ Build-depends: integer-gmp >= 0.4 && < 1.1+ else+ -- this is needed for the automatic flag to be well-balanced+ Build-depends: integer-simple Default-Language: Haskell2010 Other-Extensions: BangPatterns@@ -80,7 +69,7 @@ Ghc-options: -Wall -fwarn-tabs -Test-suite tests+Test-suite hashable-tests Type: exitcode-stdio-1.0 Hs-source-dirs: tests Main-is: Main.hs@@ -105,78 +94,13 @@ Ghc-options: -Wall -fno-warn-orphans Default-Language: Haskell2010 -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 >= 1.0,- 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-- if impl(ghc >= 7.2.1)- CPP-Options: -DGENERICS-- include-dirs:- benchmarks/cbits-- includes:- siphash.h-- c-sources:- benchmarks/cbits/inthash.c- benchmarks/cbits/siphash.c- benchmarks/cbits/wang.c- cbits/fnv.c-- if (arch(i386) || arch(x86_64)) && flag(sse2)- cpp-options: -DHAVE_SSE2- c-sources:- benchmarks/cbits/siphash-sse2.c-- if flag(sse41)- cpp-options: -DHAVE_SSE41- c-sources:- benchmarks/cbits/siphash-sse41.c-- Ghc-options: -Wall -O2- if impl(ghc >= 6.8)- Ghc-options: -fwarn-tabs- else- c-sources: cbits/getRandomBytes.c- other-modules: Data.Hashable.RandomSource- if os(windows)- extra-libraries: advapi32-- Default-Language: Haskell2010--Executable hashable-examples- if flag(examples)- build-depends: base, hashable- else- buildable: False+test-suite hashable-examples+ type: exitcode-stdio-1.0+ build-depends: base, hashable, ghc-prim hs-source-dirs: examples main-is: Main.hs Default-Language: Haskell2010 source-repository head type: git- location: https://github.com/tibbe/hashable.git+ location: https://github.com/haskell-unordered-containers/hashable.git
+ src/Data/Hashable.hs view
@@ -0,0 +1,211 @@+{-# LANGUAGE DeriveDataTypeable #-}+{-# LANGUAGE Trustworthy #-}++------------------------------------------------------------------------+-- |+-- Module : Data.Hashable+-- Copyright : (c) Milan Straka 2010+-- (c) Johan Tibell 2011+-- (c) Bryan O'Sullivan 2011, 2012+-- SPDX-License-Identifier : BSD-3-Clause+-- 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. Efficient instances for other types can be+-- generated automatically and effortlessly using the generics support+-- in GHC 7.4 and above.+--+-- The easiest way to get started is to use the 'hash' function. Here+-- is an example session with @ghci@.+--+-- > ghci> import Data.Hashable+-- > ghci> hash "foo"+-- > 60853164++module Data.Hashable+ (+ -- * Hashing and security+ -- $security++ -- * Computing hash values+ Hashable(..)++ -- * 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++ -- *** Hashing contructors with multiple fields+ -- $multiple-fields++ -- *** Hashing types with multiple constructors+ -- $multiple-ctors++ , hashUsing+ , hashPtr+ , hashPtrWithSalt+ , hashByteArray+ , hashByteArrayWithSalt++ -- * Caching hashes+ , Hashed+ , hashed+ , unhashed+ , mapHashed+ , traverseHashed+ ) where++import Data.Hashable.Class+import Data.Hashable.Generic ()++-- $security+-- #security#+--+-- Applications that use hash-based data structures to store input+-- from untrusted users can be susceptible to \"hash DoS\", a class of+-- denial-of-service attack that uses deliberately chosen colliding+-- inputs to force an application into unexpectedly behaving with+-- quadratic time complexity.+--+-- At this time, the string hashing functions used in this library are+-- susceptible to such attacks and users are recommended to either use+-- a 'Data.Map' to store keys derived from untrusted input or to use a+-- hash function (e.g. SipHash) that's resistant to such attacks. A+-- future version of this library might ship with such hash functions.++-- $generics+--+-- The recommended way to make instances of+-- 'Hashable' for most types is to use the compiler's support for+-- automatically generating default instances using "GHC.Generics".+--+-- > {-# 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.+--+-- The default implementations are provided by+-- 'genericHashWithSalt' and 'genericLiftHashWithSalt'; those together with+-- the generic type class 'GHashable' and auxiliary functions are exported+-- from the "Data.Hashable.Generic" module.++-- $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+-- '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+-- @bytestring@ package:+--+-- > import qualified Data.ByteString as B+-- > import qualified Data.ByteString.Internal as B+-- > import qualified Data.ByteString.Unsafe as B+-- > import Data.Hashable+-- > import Foreign.Ptr (castPtr)+-- >+-- > instance Hashable B.ByteString where+-- > hashWithSalt salt bs = B.inlinePerformIO $+-- > B.unsafeUseAsCStringLen bs $ \(p, len) ->+-- > hashPtrWithSalt p (fromIntegral len) salt++-- $multiple-fields+--+-- Hash constructors with multiple fields by chaining 'hashWithSalt':+--+-- > data Date = Date Int Int Int+-- >+-- > instance Hashable Date where+-- > hashWithSalt s (Date yr mo dy) =+-- > s `hashWithSalt`+-- > yr `hashWithSalt`+-- > mo `hashWithSalt` dy+--+-- If you need to chain hashes together, use 'hashWithSalt' and follow+-- this recipe:+--+-- > combineTwo h1 h2 = h1 `hashWithSalt` h2++-- $multiple-ctors+--+-- For a type with several value constructors, there are a few+-- possible approaches to writing a 'Hashable' instance.+--+-- If the type is an instance of 'Enum', the easiest path is to+-- convert it to an 'Int', and use the existing 'Hashable' instance+-- for 'Int'.+--+-- > data Color = Red | Green | Blue+-- > deriving Enum+-- >+-- > instance Hashable Color where+-- > hashWithSalt = hashUsing fromEnum+--+-- If the type's constructors accept parameters, it is important to+-- distinguish the constructors. To distinguish the constructors, add+-- a different integer to the hash computation of each constructor:+--+-- > data Time = Days Int+-- > | Weeks Int+-- > | Months Int+-- >+-- > 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
+ src/Data/Hashable/Class.hs view
@@ -0,0 +1,997 @@+{-# LANGUAGE BangPatterns, CPP, MagicHash,+ ScopedTypeVariables, UnliftedFFITypes, DeriveDataTypeable,+ DefaultSignatures, FlexibleContexts, TypeFamilies,+ MultiParamTypeClasses #-}++#if __GLASGOW_HASKELL__ >= 801+{-# LANGUAGE PolyKinds #-} -- For TypeRep instances+#endif++{-# OPTIONS_GHC -fno-warn-deprecations #-}++------------------------------------------------------------------------+-- |+-- Module : Data.Hashable.Class+-- Copyright : (c) Milan Straka 2010+-- (c) Johan Tibell 2011+-- (c) Bryan O'Sullivan 2011, 2012+-- SPDX-License-Identifier : BSD-3-Clause+-- 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(..)+ , Hashable1(..)+ , Hashable2(..)++ -- ** Support for generics+ , genericHashWithSalt+ , genericLiftHashWithSalt+ , GHashable(..)+ , HashArgs(..)+ , Zero+ , One++ -- * Creating new instances+ , hashUsing+ , hashPtr+ , hashPtrWithSalt+ , hashByteArray+ , hashByteArrayWithSalt+ , defaultHashWithSalt+ -- * Higher Rank Functions+ , hashWithSalt1+ , hashWithSalt2+ , defaultLiftHashWithSalt+ -- * Caching hashes+ , Hashed+ , hashed+ , unhashed+ , mapHashed+ , traverseHashed+ ) where++import Control.Applicative (Const(..))+import Control.Exception (assert)+import Control.DeepSeq (NFData(rnf))+import Data.Bits (shiftL, shiftR, xor)+import qualified Data.ByteString as B+import qualified Data.ByteString.Lazy as BL+import qualified Data.ByteString.Unsafe as B+import Data.Complex (Complex(..))+import Data.Int (Int8, Int16, Int32, Int64)+import Data.List (foldl')+import Data.Ratio (Ratio, denominator, numerator)+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 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)+import GHC.Base (ByteArray#)+import GHC.Conc (ThreadId(..))+import GHC.Prim (ThreadId#)+import System.IO.Unsafe (unsafeDupablePerformIO)+import System.Mem.StableName+import Data.Unique (Unique, hashUnique)++-- As we use qualified F.Foldable, we don't get warnings with newer base+import qualified Data.Foldable as F++#if MIN_VERSION_base(4,7,0)+import Data.Proxy (Proxy)+#endif++#if MIN_VERSION_base(4,7,0)+import Data.Fixed (Fixed(..))+#endif++#if MIN_VERSION_base(4,8,0)+import Data.Functor.Identity (Identity(..))+#endif++import GHC.Generics++#if MIN_VERSION_base(4,10,0)+import Type.Reflection (Typeable, TypeRep, SomeTypeRep(..))+import Type.Reflection.Unsafe (typeRepFingerprint)+import GHC.Fingerprint.Type(Fingerprint(..))+#elif MIN_VERSION_base(4,8,0)+import Data.Typeable (typeRepFingerprint, Typeable, TypeRep)+import GHC.Fingerprint.Type(Fingerprint(..))+#else+import Data.Typeable.Internal (Typeable, TypeRep (..))+import GHC.Fingerprint.Type(Fingerprint(..))+#endif++#if MIN_VERSION_base(4,5,0)+import Foreign.C (CLong(..))+import Foreign.C.Types (CInt(..))+#else+import Foreign.C (CLong)+import Foreign.C.Types (CInt)+#endif++#if !(MIN_VERSION_base(4,8,0))+import Data.Word (Word)+#endif++#if MIN_VERSION_base(4,7,0)+import Data.Bits (finiteBitSize)+#else+import Data.Bits (bitSize)+#endif++#if !(MIN_VERSION_bytestring(0,10,0))+import qualified Data.ByteString.Lazy.Internal as BL -- foldlChunks+#endif++#if MIN_VERSION_bytestring(0,10,4)+import qualified Data.ByteString.Short.Internal as BSI+#endif++#ifdef VERSION_ghc_bignum+import GHC.Num.BigNat (BigNat (..))+import GHC.Num.Integer (Integer (..))+import GHC.Num.Natural (Natural (..))+import GHC.Exts (Int (..), sizeofByteArray#)+#endif++#ifdef VERSION_integer_gmp++# if MIN_VERSION_integer_gmp(1,0,0)+# define MIN_VERSION_integer_gmp_1_0_0+# endif++import GHC.Exts (Int(..))+import GHC.Integer.GMP.Internals (Integer(..))+# if defined(MIN_VERSION_integer_gmp_1_0_0)+import GHC.Exts (sizeofByteArray#)+import GHC.Integer.GMP.Internals (BigNat(BN#))+# endif+#endif++#if MIN_VERSION_base(4,8,0)+import Data.Void (Void, absurd)+import GHC.Exts (Word(..))+#ifndef VERSION_ghc_bignum+import GHC.Natural (Natural(..))+#endif+#endif++#if MIN_VERSION_base(4,9,0)+import qualified Data.List.NonEmpty as NE+import Data.Semigroup+import Data.Functor.Classes (Eq1(..),Ord1(..),Show1(..),showsUnaryWith)++import Data.Functor.Compose (Compose(..))+import qualified Data.Functor.Product as FP+import qualified Data.Functor.Sum as FS+#endif++import Data.String (IsString(..))++#if MIN_VERSION_base(4,9,0)+import Data.Kind (Type)+#else+#define Type *+#endif++#include "MachDeps.h"++infixl 0 `hashWithSalt`++------------------------------------------------------------------------+-- * Computing hash values++-- | A default salt used in the implementation of 'hash'.+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'.+class Hashable a where+ -- | Return a hash value for the argument, using the given salt.+ --+ -- The general contract of 'hashWithSalt' is:+ --+ -- * 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. However, the programmer should be+ -- aware that producing distinct integer results for unequal+ -- values may 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++ -- | Like 'hashWithSalt', but no salt is used. The default+ -- implementation uses 'hashWithSalt' with some default salt.+ -- Instances might want to implement this method to provide a more+ -- efficient implementation than the default implementation.+ hash :: a -> Int+ hash = hashWithSalt defaultSalt++ default hashWithSalt :: (Generic a, GHashable Zero (Rep a)) => Int -> a -> Int+ hashWithSalt = genericHashWithSalt+ {-# INLINE hashWithSalt #-}++-- | Generic 'hashWithSalt'.+--+-- @since 1.3.0.0+genericHashWithSalt :: (Generic a, GHashable Zero (Rep a)) => Int -> a -> Int+genericHashWithSalt = \salt -> ghashWithSalt HashArgs0 salt . from+{-# INLINE genericHashWithSalt #-}++data Zero+data One++data family HashArgs arity a :: Type+data instance HashArgs Zero a = HashArgs0+newtype instance HashArgs One a = HashArgs1 (Int -> a -> Int)++-- | The class of types that can be generically hashed.+class GHashable arity f where+ ghashWithSalt :: HashArgs arity a -> Int -> f a -> Int++class Hashable1 t where+ -- | Lift a hashing function through the type constructor.+ liftHashWithSalt :: (Int -> a -> Int) -> Int -> t a -> Int++ default liftHashWithSalt :: (Generic1 t, GHashable One (Rep1 t)) => (Int -> a -> Int) -> Int -> t a -> Int+ liftHashWithSalt = genericLiftHashWithSalt+ {-# INLINE liftHashWithSalt #-}++-- | Generic 'liftHashWithSalt'.+--+-- @since 1.3.0.0+genericLiftHashWithSalt :: (Generic1 t, GHashable One (Rep1 t)) => (Int -> a -> Int) -> Int -> t a -> Int+genericLiftHashWithSalt = \h salt -> ghashWithSalt (HashArgs1 h) salt . from1+{-# INLINE genericLiftHashWithSalt #-}++class Hashable2 t where+ -- | Lift a hashing function through the binary type constructor.+ liftHashWithSalt2 :: (Int -> a -> Int) -> (Int -> b -> Int) -> Int -> t a b -> Int++-- | Lift the 'hashWithSalt' function through the type constructor.+--+-- > hashWithSalt1 = liftHashWithSalt hashWithSalt+hashWithSalt1 :: (Hashable1 f, Hashable a) => Int -> f a -> Int+hashWithSalt1 = liftHashWithSalt hashWithSalt++-- | Lift the 'hashWithSalt' function through the type constructor.+--+-- > hashWithSalt2 = liftHashWithSalt2 hashWithSalt hashWithSalt+hashWithSalt2 :: (Hashable2 f, Hashable a, Hashable b) => Int -> f a b -> Int+hashWithSalt2 = liftHashWithSalt2 hashWithSalt hashWithSalt++-- | Lift the 'hashWithSalt' function halfway through the type constructor.+-- This function makes a suitable default implementation of 'liftHashWithSalt',+-- given that the type constructor @t@ in question can unify with @f a@.+defaultLiftHashWithSalt :: (Hashable2 f, Hashable a) => (Int -> b -> Int) -> Int -> f a b -> Int+defaultLiftHashWithSalt h = liftHashWithSalt2 hashWithSalt h++-- | Since we support a generic implementation of 'hashWithSalt' we+-- cannot also provide a default implementation for that method for+-- the non-generic instance use case. Instead we provide+-- 'defaultHashWith'.+defaultHashWithSalt :: Hashable a => Int -> a -> Int+defaultHashWithSalt salt x = salt `combine` hash x++-- | 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+ hash = id+ hashWithSalt = defaultHashWithSalt++instance Hashable Int8 where+ hash = fromIntegral+ hashWithSalt = defaultHashWithSalt++instance Hashable Int16 where+ hash = fromIntegral+ hashWithSalt = defaultHashWithSalt++instance Hashable Int32 where+ hash = fromIntegral+ 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++instance Hashable Word where+ hash = fromIntegral+ hashWithSalt = defaultHashWithSalt++instance Hashable Word8 where+ hash = fromIntegral+ hashWithSalt = defaultHashWithSalt++instance Hashable Word16 where+ hash = fromIntegral+ hashWithSalt = defaultHashWithSalt++instance Hashable Word32 where+ hash = fromIntegral+ 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++instance Hashable () where+ hash = fromEnum+ hashWithSalt = defaultHashWithSalt++instance Hashable Bool where+ hash = fromEnum+ hashWithSalt = defaultHashWithSalt++instance Hashable Ordering where+ hash = fromEnum+ hashWithSalt = defaultHashWithSalt++instance Hashable Char where+ hash = fromEnum+ hashWithSalt = defaultHashWithSalt++#if defined(MIN_VERSION_integer_gmp_1_0_0) || defined(VERSION_ghc_bignum)+instance Hashable BigNat where+ hashWithSalt salt (BN# ba) = hashByteArrayWithSalt ba 0 numBytes salt+ `hashWithSalt` size+ where+ size = numBytes `quot` SIZEOF_HSWORD+ numBytes = I# (sizeofByteArray# ba)+#endif++#if MIN_VERSION_base(4,8,0)+instance Hashable Natural where+# if defined(VERSION_ghc_bignum)+ hash (NS n) = hash (W# n)+ hash (NB bn) = hash (BN# bn)++ hashWithSalt salt (NS n) = hashWithSalt salt (W# n)+ hashWithSalt salt (NB bn) = hashWithSalt salt (BN# bn)+# else+# if defined(MIN_VERSION_integer_gmp_1_0_0)+ hash (NatS# n) = hash (W# n)+ hash (NatJ# bn) = hash bn++ hashWithSalt salt (NatS# n) = hashWithSalt salt (W# n)+ hashWithSalt salt (NatJ# bn) = hashWithSalt salt bn+# else+ hash (Natural n) = hash n++ hashWithSalt salt (Natural n) = hashWithSalt salt n+# endif+# endif+#endif++instance Hashable Integer where+#if defined(VERSION_ghc_bignum)+ hash (IS n) = I# n+ hash (IP bn) = hash (BN# bn)+ hash (IN bn) = negate (hash (BN# bn))++ hashWithSalt salt (IS n) = hashWithSalt salt (I# n)+ hashWithSalt salt (IP bn) = hashWithSalt salt (BN# bn)+ hashWithSalt salt (IN bn) = negate (hashWithSalt salt (BN# bn))+#else+#if defined(VERSION_integer_gmp)+# if defined(MIN_VERSION_integer_gmp_1_0_0)+ hash (S# n) = (I# n)+ hash (Jp# bn) = hash bn+ hash (Jn# bn) = negate (hash bn)++ hashWithSalt salt (S# n) = hashWithSalt salt (I# n)+ hashWithSalt salt (Jp# bn) = hashWithSalt salt bn+ hashWithSalt salt (Jn# bn) = negate (hashWithSalt salt bn)+# else+ hash (S# int) = I# int+ hash n@(J# size# byteArray)+ | n >= minInt && n <= maxInt = fromInteger n :: Int+ | otherwise = let size = I# size#+ numBytes = SIZEOF_HSWORD * abs size+ in hashByteArrayWithSalt byteArray 0 numBytes defaultSalt+ `hashWithSalt` size+ where minInt = fromIntegral (minBound :: Int)+ maxInt = fromIntegral (maxBound :: Int)++ hashWithSalt salt (S# n) = hashWithSalt salt (I# n)+ hashWithSalt salt n@(J# size# byteArray)+ | n >= minInt && n <= maxInt = hashWithSalt salt (fromInteger n :: Int)+ | otherwise = let size = I# size#+ numBytes = SIZEOF_HSWORD * abs size+ in hashByteArrayWithSalt byteArray 0 numBytes salt+ `hashWithSalt` size+ where minInt = fromIntegral (minBound :: Int)+ maxInt = fromIntegral (maxBound :: Int)+# endif+#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+#endif++instance Hashable a => Hashable (Complex a) where+ {-# SPECIALIZE instance Hashable (Complex Double) #-}+ {-# SPECIALIZE instance Hashable (Complex Float) #-}+ hash (r :+ i) = hash r `hashWithSalt` i+ hashWithSalt = hashWithSalt1+instance Hashable1 Complex where+ liftHashWithSalt h s (r :+ i) = s `h` r `h` i++#if MIN_VERSION_base(4,9,0)+-- Starting with base-4.9, numerator/denominator don't need 'Integral' anymore+instance Hashable a => Hashable (Ratio a) where+#else+instance (Integral a, Hashable a) => Hashable (Ratio a) where+#endif+ {-# SPECIALIZE instance Hashable (Ratio Integer) #-}+ hash a = hash (numerator a) `hashWithSalt` denominator a+ hashWithSalt s a = s `hashWithSalt` numerator a `hashWithSalt` denominator a++-- | __Note__: prior to @hashable-1.3.0.0@, @hash 0.0 /= hash (-0.0)@+--+-- The 'hash' of NaN is not well defined.+--+-- @since 1.3.0.0+instance Hashable Float where+ hash x+ | x == -0.0 || x == 0.0 = 0 -- see note in 'Hashable Double'+ | isIEEE x =+ assert (sizeOf x >= sizeOf (0::Word32) &&+ alignment x >= alignment (0::Word32)) $+ hash ((unsafeDupablePerformIO $ with x $ peek . castPtr) :: Word32)+ | otherwise = hash (show x)+ hashWithSalt = defaultHashWithSalt++-- | __Note__: prior to @hashable-1.3.0.0@, @hash 0.0 /= hash (-0.0)@+--+-- The 'hash' of NaN is not well defined.+--+-- @since 1.3.0.0+instance Hashable Double where+ hash x+ | x == -0.0 || x == 0.0 = 0 -- s.t. @hash -0.0 == hash 0.0@ ; see #173+ | isIEEE x =+ assert (sizeOf x >= sizeOf (0::Word64) &&+ alignment x >= alignment (0::Word64)) $+ hash ((unsafeDupablePerformIO $ with x $ peek . castPtr) :: Word64)+ | otherwise = hash (show x)+ hashWithSalt = defaultHashWithSalt++-- | 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 = hashWithSalt1++instance Hashable1 Maybe where+ liftHashWithSalt _ s Nothing = s `combine` 0+ liftHashWithSalt h s (Just a) = s `combine` distinguisher `h` a++instance (Hashable a, Hashable b) => Hashable (Either a b) where+ hash (Left a) = 0 `hashWithSalt` a+ hash (Right b) = distinguisher `hashWithSalt` b+ hashWithSalt = hashWithSalt1++instance Hashable a => Hashable1 (Either a) where+ 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++instance (Hashable a1, Hashable a2) => Hashable (a1, a2) where+ hash (a1, a2) = hash a1 `hashWithSalt` a2+ hashWithSalt = hashWithSalt1++instance Hashable a1 => Hashable1 ((,) a1) where+ liftHashWithSalt = defaultLiftHashWithSalt++instance Hashable2 (,) where+ liftHashWithSalt2 h1 h2 s (a1, a2) = s `h1` a1 `h2` a2++instance (Hashable a1, Hashable a2, Hashable a3) => Hashable (a1, a2, a3) where+ hash (a1, a2, a3) = hash a1 `hashWithSalt` a2 `hashWithSalt` a3+ hashWithSalt = hashWithSalt1++instance (Hashable a1, Hashable a2) => Hashable1 ((,,) a1 a2) where+ liftHashWithSalt = defaultLiftHashWithSalt++instance Hashable a1 => Hashable2 ((,,) a1) where+ liftHashWithSalt2 h1 h2 s (a1, a2, a3) =+ (s `hashWithSalt` a1) `h1` a2 `h2` 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 = hashWithSalt1++instance (Hashable a1, Hashable a2, Hashable a3) => Hashable1 ((,,,) a1 a2 a3) where+ liftHashWithSalt = defaultLiftHashWithSalt++instance (Hashable a1, Hashable a2) => Hashable2 ((,,,) a1 a2) where+ liftHashWithSalt2 h1 h2 s (a1, a2, a3, a4) =+ (s `hashWithSalt` a1 `hashWithSalt` a2) `h1` a3 `h2` 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 = hashWithSalt1++instance (Hashable a1, Hashable a2, Hashable a3,+ Hashable a4) => Hashable1 ((,,,,) a1 a2 a3 a4) where+ liftHashWithSalt = defaultLiftHashWithSalt++instance (Hashable a1, Hashable a2, Hashable a3)+ => Hashable2 ((,,,,) a1 a2 a3) where+ liftHashWithSalt2 h1 h2 s (a1, a2, a3, a4, a5) =+ (s `hashWithSalt` a1 `hashWithSalt` a2+ `hashWithSalt` a3) `h1` a4 `h2` 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 = hashWithSalt1++instance (Hashable a1, Hashable a2, Hashable a3, Hashable a4,+ Hashable a5) => Hashable1 ((,,,,,) a1 a2 a3 a4 a5) where+ liftHashWithSalt = defaultLiftHashWithSalt++instance (Hashable a1, Hashable a2, Hashable a3,+ Hashable a4) => Hashable2 ((,,,,,) a1 a2 a3 a4) where+ liftHashWithSalt2 h1 h2 s (a1, a2, a3, a4, a5, a6) =+ (s `hashWithSalt` a1 `hashWithSalt` a2 `hashWithSalt` a3+ `hashWithSalt` a4) `h1` a5 `h2` 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++instance (Hashable a1, Hashable a2, Hashable a3, Hashable a4, Hashable a5, Hashable a6) => Hashable1 ((,,,,,,) a1 a2 a3 a4 a5 a6) where+ liftHashWithSalt = defaultLiftHashWithSalt++instance (Hashable a1, Hashable a2, Hashable a3, Hashable a4,+ Hashable a5) => Hashable2 ((,,,,,,) a1 a2 a3 a4 a5) where+ liftHashWithSalt2 h1 h2 s (a1, a2, a3, a4, a5, a6, a7) =+ (s `hashWithSalt` a1 `hashWithSalt` a2 `hashWithSalt` a3+ `hashWithSalt` a4 `hashWithSalt` a5) `h1` a6 `h2` a7++instance Hashable (StableName a) where+ hash = hashStableName+ hashWithSalt = defaultHashWithSalt++-- Auxillary type for Hashable [a] definition+data SPInt = SP !Int !Int++instance Hashable a => Hashable [a] where+ {-# SPECIALIZE instance Hashable [Char] #-}+ hashWithSalt = hashWithSalt1++instance Hashable1 [] where+ liftHashWithSalt h salt arr = finalise (foldl' step (SP salt 0) arr)+ where+ finalise (SP s l) = hashWithSalt s l+ step (SP s l) x = SP (h s x) (l + 1)++instance Hashable B.ByteString where+ hashWithSalt salt bs = unsafeDupablePerformIO $+ B.unsafeUseAsCStringLen bs $ \(p, len) ->+ hashPtrWithSalt p (fromIntegral len) salt++instance Hashable BL.ByteString where+ hashWithSalt = BL.foldlChunks hashWithSalt++#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+#endif++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 = TL.foldlChunks hashWithSalt++-- | Compute the hash of a ThreadId.+hashThreadId :: ThreadId -> Int+hashThreadId (ThreadId t) = hash (fromIntegral (getThreadId t) :: Int)++foreign import ccall unsafe "rts_getThreadId" getThreadId+ :: ThreadId# -> CInt++instance Hashable ThreadId where+ hash = hashThreadId+ hashWithSalt = defaultHashWithSalt++instance Hashable (Ptr a) where+ hashWithSalt salt p = hashWithSalt salt $ ptrToIntPtr p++instance Hashable (FunPtr a) where+ hashWithSalt salt p = hashWithSalt salt $ castFunPtrToPtr p++instance Hashable IntPtr where+ hash n = fromIntegral n+ hashWithSalt = defaultHashWithSalt++instance Hashable WordPtr where+ hash n = fromIntegral n+ hashWithSalt = defaultHashWithSalt++----------------------------------------------------------------------------+-- Fingerprint & TypeRep instances++-- | @since 1.3.0.0+instance Hashable Fingerprint where+ hash (Fingerprint x _) = fromIntegral x+ hashWithSalt = defaultHashWithSalt+ {-# INLINE hash #-}++#if MIN_VERSION_base(4,10,0)++hashTypeRep :: Type.Reflection.TypeRep a -> Int+hashTypeRep tr =+ let Fingerprint x _ = typeRepFingerprint tr in fromIntegral x++instance Hashable Type.Reflection.SomeTypeRep where+ hash (Type.Reflection.SomeTypeRep r) = hashTypeRep r+ hashWithSalt = defaultHashWithSalt+ {-# INLINE hash #-}++instance Hashable (Type.Reflection.TypeRep a) where+ hash = hashTypeRep+ hashWithSalt = defaultHashWithSalt+ {-# INLINE hash #-}++#else++-- | Compute the hash of a TypeRep, in various GHC versions we can do this quickly.+hashTypeRep :: TypeRep -> Int+{-# INLINE hashTypeRep #-}+#if MIN_VERSION_base(4,8,0)+-- Fingerprint is just the MD5, so taking any Int from it is fine+hashTypeRep tr = let Fingerprint x _ = typeRepFingerprint tr in fromIntegral x+#else+-- Fingerprint is just the MD5, so taking any Int from it is fine+hashTypeRep (TypeRep (Fingerprint x _) _ _) = fromIntegral x+#endif++instance Hashable TypeRep where+ hash = hashTypeRep+ hashWithSalt = defaultHashWithSalt+ {-# INLINE hash #-}++#endif++----------------------------------------------------------------------------++#if MIN_VERSION_base(4,8,0)+instance Hashable Void where+ hashWithSalt _ = absurd+#endif++-- | 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_hashCString (castPtr p) (fromIntegral len)+ (fromIntegral salt)++foreign import ccall unsafe "hashable_fnv_hash" c_hashCString+ :: CString -> CLong -> CLong -> IO CLong++-- | 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+ -> 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.+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)++foreign import ccall unsafe "hashable_fnv_hash_offset" c_hashByteArray+ :: ByteArray# -> CLong -> CLong -> CLong -> CLong++-- | 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++instance Hashable Version where+ hashWithSalt salt (Version branch tags) =+ salt `hashWithSalt` branch `hashWithSalt` tags++#if MIN_VERSION_base(4,7,0)+-- Using hashWithSalt1 would cause needless constraint+instance Hashable (Fixed a) where+ hashWithSalt salt (MkFixed i) = hashWithSalt salt i+instance Hashable1 Fixed where+ liftHashWithSalt _ salt (MkFixed i) = hashWithSalt salt i+#endif++#if MIN_VERSION_base(4,8,0)+instance Hashable a => Hashable (Identity a) where+ hashWithSalt = hashWithSalt1+instance Hashable1 Identity where+ liftHashWithSalt h salt (Identity x) = h salt x+#endif++-- Using hashWithSalt1 would cause needless constraint+instance Hashable a => Hashable (Const a b) where+ hashWithSalt salt (Const x) = hashWithSalt salt x++instance Hashable a => Hashable1 (Const a) where+ liftHashWithSalt = defaultLiftHashWithSalt++instance Hashable2 Const where+ liftHashWithSalt2 f _ salt (Const x) = f salt x++#if MIN_VERSION_base(4,7,0)+instance Hashable (Proxy a) where+ hash _ = 0+ hashWithSalt s _ = s++instance Hashable1 Proxy where+ liftHashWithSalt _ s _ = s+#endif++-- instances formerly provided by 'semigroups' package+#if MIN_VERSION_base(4,9,0)+instance Hashable a => Hashable (NE.NonEmpty a) where+ hashWithSalt p (a NE.:| as) = p `hashWithSalt` a `hashWithSalt` as++-- | @since 1.3.1.0+instance Hashable1 NE.NonEmpty where+ liftHashWithSalt h salt (a NE.:| as) = liftHashWithSalt h (h salt a) as++instance Hashable a => Hashable (Min a) where+ hashWithSalt p (Min a) = hashWithSalt p a++-- | @since 1.3.1.0+instance Hashable1 Min where liftHashWithSalt h salt (Min a) = h salt a++instance Hashable a => Hashable (Max a) where+ hashWithSalt p (Max a) = hashWithSalt p a++-- | @since 1.3.1.0+instance Hashable1 Max where liftHashWithSalt h salt (Max a) = h salt a++-- | __Note__: Prior to @hashable-1.3.0.0@ the hash computation included the second argument of 'Arg' which wasn't consistent with its 'Eq' instance.+--+-- @since 1.3.0.0+instance Hashable a => Hashable (Arg a b) where+ hashWithSalt p (Arg a _) = hashWithSalt p a++instance Hashable a => Hashable (First a) where+ hashWithSalt p (First a) = hashWithSalt p a++-- | @since 1.3.1.0+instance Hashable1 First where liftHashWithSalt h salt (First a) = h salt a++instance Hashable a => Hashable (Last a) where+ hashWithSalt p (Last a) = hashWithSalt p a++-- | @since 1.3.1.0+instance Hashable1 Last where liftHashWithSalt h salt (Last a) = h salt a++instance Hashable a => Hashable (WrappedMonoid a) where+ hashWithSalt p (WrapMonoid a) = hashWithSalt p a++-- | @since 1.3.1.0+instance Hashable1 WrappedMonoid where liftHashWithSalt h salt (WrapMonoid a) = h salt a++instance Hashable a => Hashable (Option a) where+ hashWithSalt p (Option a) = hashWithSalt p a++-- | @since 1.3.1.0+instance Hashable1 Option where liftHashWithSalt h salt (Option a) = liftHashWithSalt h salt a+#endif++-- instances for @Data.Functor.{Product,Sum,Compose}@, present+-- in base-4.9 and onward.+#if MIN_VERSION_base(4,9,0)+-- | In general, @hash (Compose x) ≠ hash x@. However, @hashWithSalt@ satisfies+-- its variant of this equivalence.+instance (Hashable1 f, Hashable1 g, Hashable a) => Hashable (Compose f g a) where+ hashWithSalt = hashWithSalt1++instance (Hashable1 f, Hashable1 g) => Hashable1 (Compose f g) where+ liftHashWithSalt h s = liftHashWithSalt (liftHashWithSalt h) s . getCompose++instance (Hashable1 f, Hashable1 g) => Hashable1 (FP.Product f g) where+ liftHashWithSalt h s (FP.Pair a b) = liftHashWithSalt h (liftHashWithSalt h s a) b++instance (Hashable1 f, Hashable1 g, Hashable a) => Hashable (FP.Product f g a) where+ 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++instance (Hashable1 f, Hashable1 g, Hashable a) => Hashable (FS.Sum f g a) where+ hashWithSalt = hashWithSalt1+#endif++-- | A hashable value along with the result of the 'hash' function.+data Hashed a = Hashed a {-# UNPACK #-} !Int+ deriving (Typeable)++-- | Wrap a hashable value, caching the 'hash' function result.+hashed :: Hashable a => a -> Hashed a+hashed a = Hashed a (hash a)++-- | Unwrap hashed value.+unhashed :: Hashed a -> a+unhashed (Hashed a _) = a++-- | Uses precomputed hash to detect inequality faster+instance Eq a => Eq (Hashed a) where+ Hashed a ha == Hashed b hb = ha == hb && a == b++instance Ord a => Ord (Hashed a) where+ Hashed a _ `compare` Hashed b _ = a `compare` b++instance Show a => Show (Hashed a) where+ showsPrec d (Hashed a _) = showParen (d > 10) $+ showString "hashed" . showChar ' ' . showsPrec 11 a++instance Hashable (Hashed a) where+ hashWithSalt = defaultHashWithSalt+ hash (Hashed _ h) = h++-- This instance is a little unsettling. It is unusal for+-- 'liftHashWithSalt' to ignore its first argument when a+-- value is actually available for it to work on.+instance Hashable1 Hashed where+ liftHashWithSalt _ s (Hashed _ h) = defaultHashWithSalt s h++instance (IsString a, Hashable a) => IsString (Hashed a) where+ fromString s = let r = fromString s in Hashed r (hash r)++instance F.Foldable Hashed where+ foldr f acc (Hashed a _) = f a acc++instance NFData a => NFData (Hashed a) where+ rnf = rnf . unhashed++-- | 'Hashed' cannot be 'Functor'+mapHashed :: Hashable b => (a -> b) -> Hashed a -> Hashed b+mapHashed f (Hashed a _) = hashed (f a)++-- | 'Hashed' cannot be 'Traversable'+traverseHashed :: (Hashable b, Functor f) => (a -> f b) -> Hashed a -> f (Hashed b)+traverseHashed f (Hashed a _) = fmap hashed (f a)++-- instances for @Data.Functor.Classes@ higher rank typeclasses+-- in base-4.9 and onward.+#if MIN_VERSION_base(4,9,0)+instance Eq1 Hashed where+ liftEq f (Hashed a ha) (Hashed b hb) = ha == hb && f a b++instance Ord1 Hashed where+ liftCompare f (Hashed a _) (Hashed b _) = f a b++instance Show1 Hashed where+ liftShowsPrec sp _ d (Hashed a _) = showsUnaryWith sp "hashed" d a+#endif
+ src/Data/Hashable/Generic.hs view
@@ -0,0 +1,25 @@+{-# LANGUAGE Trustworthy #-}++-- |+-- Module : Data.Hashable.Generic+-- SPDX-License-Identifier : BSD-3-Clause+-- Stability : provisional+-- Portability : GHC >= 7.4+--+-- Hashable support for GHC generics.+--+-- @since 1.3.0.0+module Data.Hashable.Generic+ (+ -- * Implementation using Generics.+ genericHashWithSalt+ , genericLiftHashWithSalt+ -- * Constraints+ , GHashable (..)+ , One+ , Zero+ , HashArgs (..)+ ) where++import Data.Hashable.Generic.Instances ()+import Data.Hashable.Class
+ src/Data/Hashable/Generic/Instances.hs view
@@ -0,0 +1,128 @@+{-# LANGUAGE BangPatterns, CPP, FlexibleInstances, KindSignatures,+ ScopedTypeVariables, TypeOperators,+ MultiParamTypeClasses, GADTs, FlexibleContexts #-}+{-# OPTIONS_GHC -fno-warn-orphans #-}++------------------------------------------------------------------------+-- |+-- Module : Data.Hashable.Generic.Instances+-- Copyright : (c) Bryan O'Sullivan 2012+-- SPDX-License-Identifier : BSD-3-Clause+-- Maintainer : bos@serpentine.com+-- Stability : provisional+-- Portability : GHC >= 7.4+--+-- Internal module defining orphan instances for "GHC.Generics"+--+module Data.Hashable.Generic.Instances () where++import Data.Hashable.Class+import GHC.Generics++#if MIN_VERSION_base(4,9,0)+import Data.Kind (Type)+#else+#define Type *+#endif+++-- Type without constructors+instance GHashable arity V1 where+ ghashWithSalt _ salt _ = hashWithSalt salt ()++-- Constructor without arguments+instance GHashable arity U1 where+ ghashWithSalt _ salt U1 = hashWithSalt salt ()++instance (GHashable arity a, GHashable arity b) => GHashable arity (a :*: b) where+ ghashWithSalt toHash salt (x :*: y) =+ (ghashWithSalt toHash (ghashWithSalt toHash salt x) y)++-- Metadata (constructor name, etc)+instance GHashable arity a => GHashable arity (M1 i c a) where+ ghashWithSalt targs salt = ghashWithSalt targs salt . unM1++-- Constants, additional parameters, and rank-1 recursion+instance Hashable a => GHashable arity (K1 i a) where+ ghashWithSalt _ = hashUsing unK1++instance GHashable One Par1 where+ ghashWithSalt (HashArgs1 h) salt = h salt . unPar1++instance Hashable1 f => GHashable One (Rec1 f) where+ ghashWithSalt (HashArgs1 h) salt = liftHashWithSalt h salt . unRec1++instance (Hashable1 f, GHashable One g) => GHashable One (f :.: g) where+ ghashWithSalt targs salt = liftHashWithSalt (ghashWithSalt targs) salt . unComp1++class SumSize f => GSum arity f where+ hashSum :: HashArgs arity a -> Int -> Int -> f a -> Int+ -- hashSum args salt index value = ...++-- [Note: Hashing a sum type]+--+-- The tree structure is used in GHC.Generics to represent the sum (and+-- product) part of the generic represention of the type, e.g.:+--+-- (C0 ... :+: C1 ...) :+: (C2 ... :+: (C3 ... :+: C4 ...))+--+-- The value constructed with C2 constructor is represented as (R1 (L1 ...)).+-- Yet, if we think that this tree is a flat (heterogenous) list:+--+-- [C0 ..., C1 ..., C2 ..., C3 ..., C4... ]+--+-- then the value constructed with C2 is a (dependent) pair (2, ...), and+-- hashing it is simple:+--+-- salt `hashWithSalt` (2 :: Int) `hashWithSalt` ...+--+-- This is what we do below. When drilling down the tree, we count how many+-- leafs are to the left (`index` variable). At the leaf case C1, we'll have an+-- actual index into the sum.+--+-- This works well for balanced data. However for recursive types like:+--+-- data Nat = Z | S Nat+--+-- the `hashWithSalt salt (S (S (S Z)))` is+--+-- salt `hashWithSalt` (1 :: Int) -- first S+-- `hashWithSalt` (1 :: Int) -- second S+-- `hashWithSalt` (1 :: Int) -- third S+-- `hashWithSalt` (0 :: Int) -- Z+-- `hashWithSalt` () -- U1+--+-- For that type the manual implementation:+--+-- instance Hashable Nat where+-- hashWithSalt salt n = hashWithSalt salt (natToInteger n)+--+-- would be better performing CPU and hash-quality wise (assuming that+-- Integer's Hashable is of high quality).+--+instance (GSum arity a, GSum arity b) => GHashable arity (a :+: b) where+ ghashWithSalt toHash salt = hashSum toHash salt 0++instance (GSum arity a, GSum arity b) => GSum arity (a :+: b) where+ hashSum toHash !salt !index s = case s of+ L1 x -> hashSum toHash salt index x+ R1 x -> hashSum toHash salt (index + sizeL) x+ where+ sizeL = unTagged (sumSize :: Tagged a)+ {-# INLINE hashSum #-}++instance GHashable arity a => GSum arity (C1 c a) where+ hashSum toHash !salt !index (M1 x) = ghashWithSalt toHash (hashWithSalt salt index) x+ {-# INLINE hashSum #-}++class SumSize f where+ sumSize :: Tagged f++newtype Tagged (s :: Type -> Type) = 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
+ src/Data/Hashable/Lifted.hs view
@@ -0,0 +1,98 @@+{-# LANGUAGE Trustworthy #-}++------------------------------------------------------------------------+-- |+-- Module : Data.Hashable.Lifted+-- Copyright : (c) Milan Straka 2010+-- (c) Johan Tibell 2011+-- (c) Bryan O'Sullivan 2011, 2012+-- SPDX-License-Identifier : BSD-3-Clause+-- Maintainer : johan.tibell@gmail.com+-- Stability : provisional+-- Portability : portable+--+-- Lifting of the 'Hashable' class to unary and binary type constructors.+-- These classes are needed to express the constraints on arguments of+-- types that are parameterized by type constructors. Fixed-point data+-- types and monad transformers are such types.++module Data.Hashable.Lifted+ ( -- * Type Classes+ Hashable1(..)+ , Hashable2(..)+ -- * Auxiliary Functions+ , hashWithSalt1+ , hashWithSalt2+ , defaultLiftHashWithSalt+ -- * Motivation+ -- $motivation+ ) where++import Data.Hashable.Class++-- $motivation+--+-- This type classes provided in this module are used to express constraints+-- on type constructors in a Haskell98-compatible fashion. As an example, consider+-- the following two types (Note that these instances are not actually provided+-- because @hashable@ does not have @transformers@ or @free@ as a dependency):+--+-- > newtype WriterT w m a = WriterT { runWriterT :: m (a, w) }+-- > data Free f a = Pure a | Free (f (Free f a))+--+-- The 'Hashable1' instances for @WriterT@ and @Free@ could be written as:+--+-- > instance (Hashable w, Hashable1 m) => Hashable1 (WriterT w m) where+-- > liftHashWithSalt h s (WriterT m) =+-- > liftHashWithSalt (liftHashWithSalt2 h hashWithSalt) s m+-- > instance Hashable1 f => Hashable1 (Free f) where+-- > liftHashWithSalt h = go where+-- > go s x = case x of+-- > Pure a -> h s a+-- > Free p -> liftHashWithSalt go s p+--+-- The 'Hashable' instances for these types can be trivially recovered with+-- 'hashWithSalt1':+--+-- > instance (Hashable w, Hashable1 m, Hashable a) => Hashable (WriterT w m a) where+-- > hashWithSalt = hashWithSalt1+-- > instance (Hashable1 f, Hashable a) => Hashable (Free f a) where+-- > hashWithSalt = hashWithSalt1++--+-- $discussion+--+-- Regardless of whether 'hashWithSalt1' is used to provide an implementation+-- of 'hashWithSalt', they should produce the same hash when called with+-- the same arguments. This is the only law that 'Hashable1' and 'Hashable2'+-- are expected to follow.+--+-- The typeclasses in this module only provide lifting for 'hashWithSalt', not+-- for 'hash'. This is because such liftings cannot be defined in a way that+-- would satisfy the @liftHash@ variant of the above law. As an illustration+-- of the problem we run into, let us assume that 'Hashable1' were+-- given a 'liftHash' method:+--+-- > class Hashable1 t where+-- > liftHash :: (a -> Int) -> t a -> Int+-- > liftHashWithSalt :: (Int -> a -> Int) -> Int -> t a -> Int+--+-- Even for a type as simple as 'Maybe', the problem manifests itself. The+-- 'Hashable' instance for 'Maybe' is:+--+-- > distinguisher :: Int+-- > distinguisher = ...+-- >+-- > instance Hashable a => Hashable (Maybe a) where+-- > hash Nothing = 0+-- > hash (Just a) = distinguisher `hashWithSalt` a+-- > hashWithSalt s Nothing = ...+-- > hashWithSalt s (Just a) = ...+--+-- The implementation of 'hash' calls 'hashWithSalt' on @a@. The hypothetical+-- @liftHash@ defined earlier only accepts an argument that corresponds to+-- the implementation of 'hash' for @a@. Consequently, this formulation of+-- @liftHash@ would not provide a way to match the current behavior of 'hash'+-- for 'Maybe'. This problem gets worse when 'Either' and @[]@ are considered.+-- The solution adopted in this library is to omit @liftHash@ entirely.+
tests/Properties.hs view
@@ -19,8 +19,8 @@ import Control.Monad (ap, liftM) import System.IO.Unsafe (unsafePerformIO) import Foreign.Marshal.Array (withArray)-import GHC.Base (ByteArray#, Int(..), newByteArray#, unsafeCoerce#,- writeWord8Array#)+import GHC.Base (ByteArray#, Int(..), newByteArray#, writeWord8Array#)+import GHC.Exts (unsafeCoerce#) import GHC.ST (ST(..), runST) import GHC.Word (Word8(..)) import Test.QuickCheck hiding ((.&.))