1{-# LANGUAGE BangPatterns, CPP, MagicHash, 2 ScopedTypeVariables, UnliftedFFITypes, DeriveDataTypeable, 3 DefaultSignatures, FlexibleContexts, TypeFamilies, 4 MultiParamTypeClasses #-} 5 6#if __GLASGOW_HASKELL__ >= 801 7{-# LANGUAGE PolyKinds #-} -- For TypeRep instances 8#endif 9 10------------------------------------------------------------------------ 11-- | 12-- Module : Data.Hashable.Class 13-- Copyright : (c) Milan Straka 2010 14-- (c) Johan Tibell 2011 15-- (c) Bryan O'Sullivan 2011, 2012 16-- SPDX-License-Identifier : BSD-3-Clause 17-- Maintainer : johan.tibell@gmail.com 18-- Stability : provisional 19-- Portability : portable 20-- 21-- This module defines a class, 'Hashable', for types that can be 22-- converted to a hash value. This class exists for the benefit of 23-- hashing-based data structures. The module provides instances for 24-- most standard types. 25 26module Data.Hashable.Class 27 ( 28 -- * Computing hash values 29 Hashable(..) 30 , Hashable1(..) 31 , Hashable2(..) 32 33 -- ** Support for generics 34 , genericHashWithSalt 35 , genericLiftHashWithSalt 36 , GHashable(..) 37 , HashArgs(..) 38 , Zero 39 , One 40 41 -- * Creating new instances 42 , hashUsing 43 , hashPtr 44 , hashPtrWithSalt 45 , hashByteArray 46 , hashByteArrayWithSalt 47 , defaultHashWithSalt 48 -- * Higher Rank Functions 49 , hashWithSalt1 50 , hashWithSalt2 51 , defaultLiftHashWithSalt 52 -- * Caching hashes 53 , Hashed 54 , hashed 55 , unhashed 56 , mapHashed 57 , traverseHashed 58 ) where 59 60import Control.Applicative (Const(..)) 61import Control.Exception (assert) 62import Control.DeepSeq (NFData(rnf)) 63import Data.Bits (shiftL, shiftR, xor) 64import qualified Data.ByteString as B 65import qualified Data.ByteString.Lazy as BL 66import qualified Data.ByteString.Unsafe as B 67import Data.Complex (Complex(..)) 68import Data.Int (Int8, Int16, Int32, Int64) 69import Data.List (foldl') 70import Data.Ratio (Ratio, denominator, numerator) 71import qualified Data.Text as T 72import qualified Data.Text.Array as TA 73import qualified Data.Text.Internal as T 74import qualified Data.Text.Lazy as TL 75import Data.Version (Version(..)) 76import Data.Word (Word8, Word16, Word32, Word64) 77import Foreign.C (CString) 78import Foreign.Marshal.Utils (with) 79import Foreign.Ptr (Ptr, FunPtr, IntPtr, WordPtr, castPtr, castFunPtrToPtr, ptrToIntPtr) 80import Foreign.Storable (alignment, peek, sizeOf) 81import GHC.Base (ByteArray#) 82import GHC.Conc (ThreadId(..)) 83import GHC.Prim (ThreadId#) 84import System.IO.Unsafe (unsafeDupablePerformIO) 85import System.Mem.StableName 86import Data.Unique (Unique, hashUnique) 87 88-- As we use qualified F.Foldable, we don't get warnings with newer base 89import qualified Data.Foldable as F 90 91#if MIN_VERSION_base(4,7,0) 92import Data.Proxy (Proxy) 93#endif 94 95#if MIN_VERSION_base(4,7,0) 96import Data.Fixed (Fixed(..)) 97#endif 98 99#if MIN_VERSION_base(4,8,0) 100import Data.Functor.Identity (Identity(..)) 101#endif 102 103import GHC.Generics 104 105#if MIN_VERSION_base(4,10,0) 106import Type.Reflection (Typeable, TypeRep, SomeTypeRep(..)) 107import Type.Reflection.Unsafe (typeRepFingerprint) 108import GHC.Fingerprint.Type(Fingerprint(..)) 109#elif MIN_VERSION_base(4,8,0) 110import Data.Typeable (typeRepFingerprint, Typeable, TypeRep) 111import GHC.Fingerprint.Type(Fingerprint(..)) 112#else 113import Data.Typeable.Internal (Typeable, TypeRep (..)) 114import GHC.Fingerprint.Type(Fingerprint(..)) 115#endif 116 117#if MIN_VERSION_base(4,5,0) 118import Foreign.C (CLong(..)) 119import Foreign.C.Types (CInt(..)) 120#else 121import Foreign.C (CLong) 122import Foreign.C.Types (CInt) 123#endif 124 125#if !(MIN_VERSION_base(4,8,0)) 126import Data.Word (Word) 127#endif 128 129#if MIN_VERSION_base(4,7,0) 130import Data.Bits (finiteBitSize) 131#else 132import Data.Bits (bitSize) 133#endif 134 135#if !(MIN_VERSION_bytestring(0,10,0)) 136import qualified Data.ByteString.Lazy.Internal as BL -- foldlChunks 137#endif 138 139#if MIN_VERSION_bytestring(0,10,4) 140import qualified Data.ByteString.Short.Internal as BSI 141#endif 142 143#ifdef VERSION_integer_gmp 144 145# if MIN_VERSION_integer_gmp(1,0,0) 146# define MIN_VERSION_integer_gmp_1_0_0 147# endif 148 149import GHC.Exts (Int(..)) 150import GHC.Integer.GMP.Internals (Integer(..)) 151# if defined(MIN_VERSION_integer_gmp_1_0_0) 152import GHC.Exts (sizeofByteArray#) 153import GHC.Integer.GMP.Internals (BigNat(BN#)) 154# endif 155#endif 156 157#if MIN_VERSION_base(4,8,0) 158import Data.Void (Void, absurd) 159import GHC.Natural (Natural(..)) 160import GHC.Exts (Word(..)) 161#endif 162 163#if MIN_VERSION_base(4,9,0) 164import qualified Data.List.NonEmpty as NE 165import Data.Semigroup 166import Data.Functor.Classes (Eq1(..),Ord1(..),Show1(..),showsUnaryWith) 167 168import Data.Functor.Compose (Compose(..)) 169import qualified Data.Functor.Product as FP 170import qualified Data.Functor.Sum as FS 171#endif 172 173import Data.String (IsString(..)) 174 175#include "MachDeps.h" 176 177infixl 0 `hashWithSalt` 178 179------------------------------------------------------------------------ 180-- * Computing hash values 181 182-- | A default salt used in the implementation of 'hash'. 183defaultSalt :: Int 184#if WORD_SIZE_IN_BITS == 64 185defaultSalt = -2578643520546668380 -- 0xdc36d1615b7400a4 186#else 187defaultSalt = 0x087fc72c 188#endif 189{-# INLINE defaultSalt #-} 190 191-- | The class of types that can be converted to a hash value. 192-- 193-- Minimal implementation: 'hashWithSalt'. 194class Hashable a where 195 -- | Return a hash value for the argument, using the given salt. 196 -- 197 -- The general contract of 'hashWithSalt' is: 198 -- 199 -- * If two values are equal according to the '==' method, then 200 -- applying the 'hashWithSalt' method on each of the two values 201 -- /must/ produce the same integer result if the same salt is 202 -- used in each case. 203 -- 204 -- * It is /not/ required that if two values are unequal 205 -- according to the '==' method, then applying the 206 -- 'hashWithSalt' method on each of the two values must produce 207 -- distinct integer results. However, the programmer should be 208 -- aware that producing distinct integer results for unequal 209 -- values may improve the performance of hashing-based data 210 -- structures. 211 -- 212 -- * This method can be used to compute different hash values for 213 -- the same input by providing a different salt in each 214 -- application of the method. This implies that any instance 215 -- that defines 'hashWithSalt' /must/ make use of the salt in 216 -- its implementation. 217 hashWithSalt :: Int -> a -> Int 218 219 -- | Like 'hashWithSalt', but no salt is used. The default 220 -- implementation uses 'hashWithSalt' with some default salt. 221 -- Instances might want to implement this method to provide a more 222 -- efficient implementation than the default implementation. 223 hash :: a -> Int 224 hash = hashWithSalt defaultSalt 225 226 default hashWithSalt :: (Generic a, GHashable Zero (Rep a)) => Int -> a -> Int 227 hashWithSalt = genericHashWithSalt 228 {-# INLINE hashWithSalt #-} 229 230-- | Generic 'hashWithSalt'. 231-- 232-- @since 1.3.0.0 233genericHashWithSalt :: (Generic a, GHashable Zero (Rep a)) => Int -> a -> Int 234genericHashWithSalt = \salt -> ghashWithSalt HashArgs0 salt . from 235{-# INLINE genericHashWithSalt #-} 236 237data Zero 238data One 239 240data family HashArgs arity a :: * 241data instance HashArgs Zero a = HashArgs0 242newtype instance HashArgs One a = HashArgs1 (Int -> a -> Int) 243 244-- | The class of types that can be generically hashed. 245class GHashable arity f where 246 ghashWithSalt :: HashArgs arity a -> Int -> f a -> Int 247 248class Hashable1 t where 249 -- | Lift a hashing function through the type constructor. 250 liftHashWithSalt :: (Int -> a -> Int) -> Int -> t a -> Int 251 252 default liftHashWithSalt :: (Generic1 t, GHashable One (Rep1 t)) => (Int -> a -> Int) -> Int -> t a -> Int 253 liftHashWithSalt = genericLiftHashWithSalt 254 {-# INLINE liftHashWithSalt #-} 255 256-- | Generic 'liftHashWithSalt'. 257-- 258-- @since 1.3.0.0 259genericLiftHashWithSalt :: (Generic1 t, GHashable One (Rep1 t)) => (Int -> a -> Int) -> Int -> t a -> Int 260genericLiftHashWithSalt = \h salt -> ghashWithSalt (HashArgs1 h) salt . from1 261{-# INLINE genericLiftHashWithSalt #-} 262 263class Hashable2 t where 264 -- | Lift a hashing function through the binary type constructor. 265 liftHashWithSalt2 :: (Int -> a -> Int) -> (Int -> b -> Int) -> Int -> t a b -> Int 266 267-- | Lift the 'hashWithSalt' function through the type constructor. 268-- 269-- > hashWithSalt1 = liftHashWithSalt hashWithSalt 270hashWithSalt1 :: (Hashable1 f, Hashable a) => Int -> f a -> Int 271hashWithSalt1 = liftHashWithSalt hashWithSalt 272 273-- | Lift the 'hashWithSalt' function through the type constructor. 274-- 275-- > hashWithSalt2 = liftHashWithSalt2 hashWithSalt hashWithSalt 276hashWithSalt2 :: (Hashable2 f, Hashable a, Hashable b) => Int -> f a b -> Int 277hashWithSalt2 = liftHashWithSalt2 hashWithSalt hashWithSalt 278 279-- | Lift the 'hashWithSalt' function halfway through the type constructor. 280-- This function makes a suitable default implementation of 'liftHashWithSalt', 281-- given that the type constructor @t@ in question can unify with @f a@. 282defaultLiftHashWithSalt :: (Hashable2 f, Hashable a) => (Int -> b -> Int) -> Int -> f a b -> Int 283defaultLiftHashWithSalt h = liftHashWithSalt2 hashWithSalt h 284 285-- | Since we support a generic implementation of 'hashWithSalt' we 286-- cannot also provide a default implementation for that method for 287-- the non-generic instance use case. Instead we provide 288-- 'defaultHashWith'. 289defaultHashWithSalt :: Hashable a => Int -> a -> Int 290defaultHashWithSalt salt x = salt `combine` hash x 291 292-- | Transform a value into a 'Hashable' value, then hash the 293-- transformed value using the given salt. 294-- 295-- This is a useful shorthand in cases where a type can easily be 296-- mapped to another type that is already an instance of 'Hashable'. 297-- Example: 298-- 299-- > data Foo = Foo | Bar 300-- > deriving (Enum) 301-- > 302-- > instance Hashable Foo where 303-- > hashWithSalt = hashUsing fromEnum 304hashUsing :: (Hashable b) => 305 (a -> b) -- ^ Transformation function. 306 -> Int -- ^ Salt. 307 -> a -- ^ Value to transform. 308 -> Int 309hashUsing f salt x = hashWithSalt salt (f x) 310{-# INLINE hashUsing #-} 311 312instance Hashable Int where 313 hash = id 314 hashWithSalt = defaultHashWithSalt 315 316instance Hashable Int8 where 317 hash = fromIntegral 318 hashWithSalt = defaultHashWithSalt 319 320instance Hashable Int16 where 321 hash = fromIntegral 322 hashWithSalt = defaultHashWithSalt 323 324instance Hashable Int32 where 325 hash = fromIntegral 326 hashWithSalt = defaultHashWithSalt 327 328instance Hashable Int64 where 329 hash n 330#if MIN_VERSION_base(4,7,0) 331 | finiteBitSize (undefined :: Int) == 64 = fromIntegral n 332#else 333 | bitSize (undefined :: Int) == 64 = fromIntegral n 334#endif 335 | otherwise = fromIntegral (fromIntegral n `xor` 336 (fromIntegral n `shiftR` 32 :: Word64)) 337 hashWithSalt = defaultHashWithSalt 338 339instance Hashable Word where 340 hash = fromIntegral 341 hashWithSalt = defaultHashWithSalt 342 343instance Hashable Word8 where 344 hash = fromIntegral 345 hashWithSalt = defaultHashWithSalt 346 347instance Hashable Word16 where 348 hash = fromIntegral 349 hashWithSalt = defaultHashWithSalt 350 351instance Hashable Word32 where 352 hash = fromIntegral 353 hashWithSalt = defaultHashWithSalt 354 355instance Hashable Word64 where 356 hash n 357#if MIN_VERSION_base(4,7,0) 358 | finiteBitSize (undefined :: Int) == 64 = fromIntegral n 359#else 360 | bitSize (undefined :: Int) == 64 = fromIntegral n 361#endif 362 | otherwise = fromIntegral (n `xor` (n `shiftR` 32)) 363 hashWithSalt = defaultHashWithSalt 364 365instance Hashable () where 366 hash = fromEnum 367 hashWithSalt = defaultHashWithSalt 368 369instance Hashable Bool where 370 hash = fromEnum 371 hashWithSalt = defaultHashWithSalt 372 373instance Hashable Ordering where 374 hash = fromEnum 375 hashWithSalt = defaultHashWithSalt 376 377instance Hashable Char where 378 hash = fromEnum 379 hashWithSalt = defaultHashWithSalt 380 381#if defined(MIN_VERSION_integer_gmp_1_0_0) 382instance Hashable BigNat where 383 hashWithSalt salt (BN# ba) = hashByteArrayWithSalt ba 0 numBytes salt 384 `hashWithSalt` size 385 where 386 size = numBytes `quot` SIZEOF_HSWORD 387 numBytes = I# (sizeofByteArray# ba) 388#endif 389 390#if MIN_VERSION_base(4,8,0) 391instance Hashable Natural where 392# if defined(MIN_VERSION_integer_gmp_1_0_0) 393 hash (NatS# n) = hash (W# n) 394 hash (NatJ# bn) = hash bn 395 396 hashWithSalt salt (NatS# n) = hashWithSalt salt (W# n) 397 hashWithSalt salt (NatJ# bn) = hashWithSalt salt bn 398# else 399 hash (Natural n) = hash n 400 401 hashWithSalt salt (Natural n) = hashWithSalt salt n 402# endif 403#endif 404 405instance Hashable Integer where 406#if defined(VERSION_integer_gmp) 407# if defined(MIN_VERSION_integer_gmp_1_0_0) 408 hash (S# n) = (I# n) 409 hash (Jp# bn) = hash bn 410 hash (Jn# bn) = negate (hash bn) 411 412 hashWithSalt salt (S# n) = hashWithSalt salt (I# n) 413 hashWithSalt salt (Jp# bn) = hashWithSalt salt bn 414 hashWithSalt salt (Jn# bn) = negate (hashWithSalt salt bn) 415# else 416 hash (S# int) = I# int 417 hash n@(J# size# byteArray) 418 | n >= minInt && n <= maxInt = fromInteger n :: Int 419 | otherwise = let size = I# size# 420 numBytes = SIZEOF_HSWORD * abs size 421 in hashByteArrayWithSalt byteArray 0 numBytes defaultSalt 422 `hashWithSalt` size 423 where minInt = fromIntegral (minBound :: Int) 424 maxInt = fromIntegral (maxBound :: Int) 425 426 hashWithSalt salt (S# n) = hashWithSalt salt (I# n) 427 hashWithSalt salt n@(J# size# byteArray) 428 | n >= minInt && n <= maxInt = hashWithSalt salt (fromInteger n :: Int) 429 | otherwise = let size = I# size# 430 numBytes = SIZEOF_HSWORD * abs size 431 in hashByteArrayWithSalt byteArray 0 numBytes salt 432 `hashWithSalt` size 433 where minInt = fromIntegral (minBound :: Int) 434 maxInt = fromIntegral (maxBound :: Int) 435# endif 436#else 437 hashWithSalt salt = foldl' hashWithSalt salt . go 438 where 439 go n | inBounds n = [fromIntegral n :: Int] 440 | otherwise = fromIntegral n : go (n `shiftR` WORD_SIZE_IN_BITS) 441 maxInt = fromIntegral (maxBound :: Int) 442 inBounds x = x >= fromIntegral (minBound :: Int) && x <= maxInt 443#endif 444 445instance Hashable a => Hashable (Complex a) where 446 {-# SPECIALIZE instance Hashable (Complex Double) #-} 447 {-# SPECIALIZE instance Hashable (Complex Float) #-} 448 hash (r :+ i) = hash r `hashWithSalt` i 449 hashWithSalt = hashWithSalt1 450instance Hashable1 Complex where 451 liftHashWithSalt h s (r :+ i) = s `h` r `h` i 452 453#if MIN_VERSION_base(4,9,0) 454-- Starting with base-4.9, numerator/denominator don't need 'Integral' anymore 455instance Hashable a => Hashable (Ratio a) where 456#else 457instance (Integral a, Hashable a) => Hashable (Ratio a) where 458#endif 459 {-# SPECIALIZE instance Hashable (Ratio Integer) #-} 460 hash a = hash (numerator a) `hashWithSalt` denominator a 461 hashWithSalt s a = s `hashWithSalt` numerator a `hashWithSalt` denominator a 462 463-- | __Note__: prior to @hashable-1.3.0.0@, @hash 0.0 /= hash (-0.0)@ 464-- 465-- The 'hash' of NaN is not well defined. 466-- 467-- @since 1.3.0.0 468instance Hashable Float where 469 hash x 470 | x == -0.0 || x == 0.0 = 0 -- see note in 'Hashable Double' 471 | isIEEE x = 472 assert (sizeOf x >= sizeOf (0::Word32) && 473 alignment x >= alignment (0::Word32)) $ 474 hash ((unsafeDupablePerformIO $ with x $ peek . castPtr) :: Word32) 475 | otherwise = hash (show x) 476 hashWithSalt = defaultHashWithSalt 477 478-- | __Note__: prior to @hashable-1.3.0.0@, @hash 0.0 /= hash (-0.0)@ 479-- 480-- The 'hash' of NaN is not well defined. 481-- 482-- @since 1.3.0.0 483instance Hashable Double where 484 hash x 485 | x == -0.0 || x == 0.0 = 0 -- s.t. @hash -0.0 == hash 0.0@ ; see #173 486 | isIEEE x = 487 assert (sizeOf x >= sizeOf (0::Word64) && 488 alignment x >= alignment (0::Word64)) $ 489 hash ((unsafeDupablePerformIO $ with x $ peek . castPtr) :: Word64) 490 | otherwise = hash (show x) 491 hashWithSalt = defaultHashWithSalt 492 493-- | A value with bit pattern (01)* (or 5* in hexa), for any size of Int. 494-- It is used as data constructor distinguisher. GHC computes its value during 495-- compilation. 496distinguisher :: Int 497distinguisher = fromIntegral $ (maxBound :: Word) `quot` 3 498{-# INLINE distinguisher #-} 499 500instance Hashable a => Hashable (Maybe a) where 501 hash Nothing = 0 502 hash (Just a) = distinguisher `hashWithSalt` a 503 hashWithSalt = hashWithSalt1 504 505instance Hashable1 Maybe where 506 liftHashWithSalt _ s Nothing = s `combine` 0 507 liftHashWithSalt h s (Just a) = s `combine` distinguisher `h` a 508 509instance (Hashable a, Hashable b) => Hashable (Either a b) where 510 hash (Left a) = 0 `hashWithSalt` a 511 hash (Right b) = distinguisher `hashWithSalt` b 512 hashWithSalt = hashWithSalt1 513 514instance Hashable a => Hashable1 (Either a) where 515 liftHashWithSalt = defaultLiftHashWithSalt 516 517instance Hashable2 Either where 518 liftHashWithSalt2 h _ s (Left a) = s `combine` 0 `h` a 519 liftHashWithSalt2 _ h s (Right b) = s `combine` distinguisher `h` b 520 521instance (Hashable a1, Hashable a2) => Hashable (a1, a2) where 522 hash (a1, a2) = hash a1 `hashWithSalt` a2 523 hashWithSalt = hashWithSalt1 524 525instance Hashable a1 => Hashable1 ((,) a1) where 526 liftHashWithSalt = defaultLiftHashWithSalt 527 528instance Hashable2 (,) where 529 liftHashWithSalt2 h1 h2 s (a1, a2) = s `h1` a1 `h2` a2 530 531instance (Hashable a1, Hashable a2, Hashable a3) => Hashable (a1, a2, a3) where 532 hash (a1, a2, a3) = hash a1 `hashWithSalt` a2 `hashWithSalt` a3 533 hashWithSalt = hashWithSalt1 534 535instance (Hashable a1, Hashable a2) => Hashable1 ((,,) a1 a2) where 536 liftHashWithSalt = defaultLiftHashWithSalt 537 538instance Hashable a1 => Hashable2 ((,,) a1) where 539 liftHashWithSalt2 h1 h2 s (a1, a2, a3) = 540 (s `hashWithSalt` a1) `h1` a2 `h2` a3 541 542instance (Hashable a1, Hashable a2, Hashable a3, Hashable a4) => 543 Hashable (a1, a2, a3, a4) where 544 hash (a1, a2, a3, a4) = hash a1 `hashWithSalt` a2 545 `hashWithSalt` a3 `hashWithSalt` a4 546 hashWithSalt = hashWithSalt1 547 548instance (Hashable a1, Hashable a2, Hashable a3) => Hashable1 ((,,,) a1 a2 a3) where 549 liftHashWithSalt = defaultLiftHashWithSalt 550 551instance (Hashable a1, Hashable a2) => Hashable2 ((,,,) a1 a2) where 552 liftHashWithSalt2 h1 h2 s (a1, a2, a3, a4) = 553 (s `hashWithSalt` a1 `hashWithSalt` a2) `h1` a3 `h2` a4 554 555instance (Hashable a1, Hashable a2, Hashable a3, Hashable a4, Hashable a5) 556 => Hashable (a1, a2, a3, a4, a5) where 557 hash (a1, a2, a3, a4, a5) = 558 hash a1 `hashWithSalt` a2 `hashWithSalt` a3 559 `hashWithSalt` a4 `hashWithSalt` a5 560 hashWithSalt = hashWithSalt1 561 562instance (Hashable a1, Hashable a2, Hashable a3, 563 Hashable a4) => Hashable1 ((,,,,) a1 a2 a3 a4) where 564 liftHashWithSalt = defaultLiftHashWithSalt 565 566instance (Hashable a1, Hashable a2, Hashable a3) 567 => Hashable2 ((,,,,) a1 a2 a3) where 568 liftHashWithSalt2 h1 h2 s (a1, a2, a3, a4, a5) = 569 (s `hashWithSalt` a1 `hashWithSalt` a2 570 `hashWithSalt` a3) `h1` a4 `h2` a5 571 572 573instance (Hashable a1, Hashable a2, Hashable a3, Hashable a4, Hashable a5, 574 Hashable a6) => Hashable (a1, a2, a3, a4, a5, a6) where 575 hash (a1, a2, a3, a4, a5, a6) = 576 hash a1 `hashWithSalt` a2 `hashWithSalt` a3 577 `hashWithSalt` a4 `hashWithSalt` a5 `hashWithSalt` a6 578 hashWithSalt = hashWithSalt1 579 580instance (Hashable a1, Hashable a2, Hashable a3, Hashable a4, 581 Hashable a5) => Hashable1 ((,,,,,) a1 a2 a3 a4 a5) where 582 liftHashWithSalt = defaultLiftHashWithSalt 583 584instance (Hashable a1, Hashable a2, Hashable a3, 585 Hashable a4) => Hashable2 ((,,,,,) a1 a2 a3 a4) where 586 liftHashWithSalt2 h1 h2 s (a1, a2, a3, a4, a5, a6) = 587 (s `hashWithSalt` a1 `hashWithSalt` a2 `hashWithSalt` a3 588 `hashWithSalt` a4) `h1` a5 `h2` a6 589 590 591instance (Hashable a1, Hashable a2, Hashable a3, Hashable a4, Hashable a5, 592 Hashable a6, Hashable a7) => 593 Hashable (a1, a2, a3, a4, a5, a6, a7) where 594 hash (a1, a2, a3, a4, a5, a6, a7) = 595 hash a1 `hashWithSalt` a2 `hashWithSalt` a3 596 `hashWithSalt` a4 `hashWithSalt` a5 `hashWithSalt` a6 `hashWithSalt` a7 597 hashWithSalt s (a1, a2, a3, a4, a5, a6, a7) = 598 s `hashWithSalt` a1 `hashWithSalt` a2 `hashWithSalt` a3 599 `hashWithSalt` a4 `hashWithSalt` a5 `hashWithSalt` a6 `hashWithSalt` a7 600 601instance (Hashable a1, Hashable a2, Hashable a3, Hashable a4, Hashable a5, Hashable a6) => Hashable1 ((,,,,,,) a1 a2 a3 a4 a5 a6) where 602 liftHashWithSalt = defaultLiftHashWithSalt 603 604instance (Hashable a1, Hashable a2, Hashable a3, Hashable a4, 605 Hashable a5) => Hashable2 ((,,,,,,) a1 a2 a3 a4 a5) where 606 liftHashWithSalt2 h1 h2 s (a1, a2, a3, a4, a5, a6, a7) = 607 (s `hashWithSalt` a1 `hashWithSalt` a2 `hashWithSalt` a3 608 `hashWithSalt` a4 `hashWithSalt` a5) `h1` a6 `h2` a7 609 610instance Hashable (StableName a) where 611 hash = hashStableName 612 hashWithSalt = defaultHashWithSalt 613 614-- Auxillary type for Hashable [a] definition 615data SPInt = SP !Int !Int 616 617instance Hashable a => Hashable [a] where 618 {-# SPECIALIZE instance Hashable [Char] #-} 619 hashWithSalt = hashWithSalt1 620 621instance Hashable1 [] where 622 liftHashWithSalt h salt arr = finalise (foldl' step (SP salt 0) arr) 623 where 624 finalise (SP s l) = hashWithSalt s l 625 step (SP s l) x = SP (h s x) (l + 1) 626 627instance Hashable B.ByteString where 628 hashWithSalt salt bs = unsafeDupablePerformIO $ 629 B.unsafeUseAsCStringLen bs $ \(p, len) -> 630 hashPtrWithSalt p (fromIntegral len) salt 631 632instance Hashable BL.ByteString where 633 hashWithSalt = BL.foldlChunks hashWithSalt 634 635#if MIN_VERSION_bytestring(0,10,4) 636instance Hashable BSI.ShortByteString where 637 hashWithSalt salt sbs@(BSI.SBS ba) = 638 hashByteArrayWithSalt ba 0 (BSI.length sbs) salt 639#endif 640 641instance Hashable T.Text where 642 hashWithSalt salt (T.Text arr off len) = 643 hashByteArrayWithSalt (TA.aBA arr) (off `shiftL` 1) (len `shiftL` 1) 644 salt 645 646instance Hashable TL.Text where 647 hashWithSalt = TL.foldlChunks hashWithSalt 648 649-- | Compute the hash of a ThreadId. 650hashThreadId :: ThreadId -> Int 651hashThreadId (ThreadId t) = hash (fromIntegral (getThreadId t) :: Int) 652 653foreign import ccall unsafe "rts_getThreadId" getThreadId 654 :: ThreadId# -> CInt 655 656instance Hashable ThreadId where 657 hash = hashThreadId 658 hashWithSalt = defaultHashWithSalt 659 660instance Hashable (Ptr a) where 661 hashWithSalt salt p = hashWithSalt salt $ ptrToIntPtr p 662 663instance Hashable (FunPtr a) where 664 hashWithSalt salt p = hashWithSalt salt $ castFunPtrToPtr p 665 666instance Hashable IntPtr where 667 hash n = fromIntegral n 668 hashWithSalt = defaultHashWithSalt 669 670instance Hashable WordPtr where 671 hash n = fromIntegral n 672 hashWithSalt = defaultHashWithSalt 673 674---------------------------------------------------------------------------- 675-- Fingerprint & TypeRep instances 676 677-- | @since 1.3.0.0 678instance Hashable Fingerprint where 679 hash (Fingerprint x _) = fromIntegral x 680 hashWithSalt = defaultHashWithSalt 681 {-# INLINE hash #-} 682 683#if MIN_VERSION_base(4,10,0) 684 685hashTypeRep :: Type.Reflection.TypeRep a -> Int 686hashTypeRep tr = 687 let Fingerprint x _ = typeRepFingerprint tr in fromIntegral x 688 689instance Hashable Type.Reflection.SomeTypeRep where 690 hash (Type.Reflection.SomeTypeRep r) = hashTypeRep r 691 hashWithSalt = defaultHashWithSalt 692 {-# INLINE hash #-} 693 694instance Hashable (Type.Reflection.TypeRep a) where 695 hash = hashTypeRep 696 hashWithSalt = defaultHashWithSalt 697 {-# INLINE hash #-} 698 699#else 700 701-- | Compute the hash of a TypeRep, in various GHC versions we can do this quickly. 702hashTypeRep :: TypeRep -> Int 703{-# INLINE hashTypeRep #-} 704#if MIN_VERSION_base(4,8,0) 705-- Fingerprint is just the MD5, so taking any Int from it is fine 706hashTypeRep tr = let Fingerprint x _ = typeRepFingerprint tr in fromIntegral x 707#else 708-- Fingerprint is just the MD5, so taking any Int from it is fine 709hashTypeRep (TypeRep (Fingerprint x _) _ _) = fromIntegral x 710#endif 711 712instance Hashable TypeRep where 713 hash = hashTypeRep 714 hashWithSalt = defaultHashWithSalt 715 {-# INLINE hash #-} 716 717#endif 718 719---------------------------------------------------------------------------- 720 721#if MIN_VERSION_base(4,8,0) 722instance Hashable Void where 723 hashWithSalt _ = absurd 724#endif 725 726-- | Compute a hash value for the content of this pointer. 727hashPtr :: Ptr a -- ^ pointer to the data to hash 728 -> Int -- ^ length, in bytes 729 -> IO Int -- ^ hash value 730hashPtr p len = hashPtrWithSalt p len defaultSalt 731 732-- | Compute a hash value for the content of this pointer, using an 733-- initial salt. 734-- 735-- This function can for example be used to hash non-contiguous 736-- segments of memory as if they were one contiguous segment, by using 737-- the output of one hash as the salt for the next. 738hashPtrWithSalt :: Ptr a -- ^ pointer to the data to hash 739 -> Int -- ^ length, in bytes 740 -> Int -- ^ salt 741 -> IO Int -- ^ hash value 742hashPtrWithSalt p len salt = 743 fromIntegral `fmap` c_hashCString (castPtr p) (fromIntegral len) 744 (fromIntegral salt) 745 746foreign import ccall unsafe "hashable_fnv_hash" c_hashCString 747 :: CString -> CLong -> CLong -> IO CLong 748 749-- | Compute a hash value for the content of this 'ByteArray#', 750-- beginning at the specified offset, using specified number of bytes. 751hashByteArray :: ByteArray# -- ^ data to hash 752 -> Int -- ^ offset, in bytes 753 -> Int -- ^ length, in bytes 754 -> Int -- ^ hash value 755hashByteArray ba0 off len = hashByteArrayWithSalt ba0 off len defaultSalt 756{-# INLINE hashByteArray #-} 757 758-- | Compute a hash value for the content of this 'ByteArray#', using 759-- an initial salt. 760-- 761-- This function can for example be used to hash non-contiguous 762-- segments of memory as if they were one contiguous segment, by using 763-- the output of one hash as the salt for the next. 764hashByteArrayWithSalt 765 :: ByteArray# -- ^ data to hash 766 -> Int -- ^ offset, in bytes 767 -> Int -- ^ length, in bytes 768 -> Int -- ^ salt 769 -> Int -- ^ hash value 770hashByteArrayWithSalt ba !off !len !h = 771 fromIntegral $ c_hashByteArray ba (fromIntegral off) (fromIntegral len) 772 (fromIntegral h) 773 774foreign import ccall unsafe "hashable_fnv_hash_offset" c_hashByteArray 775 :: ByteArray# -> CLong -> CLong -> CLong -> CLong 776 777-- | Combine two given hash values. 'combine' has zero as a left 778-- identity. 779combine :: Int -> Int -> Int 780combine h1 h2 = (h1 * 16777619) `xor` h2 781 782instance Hashable Unique where 783 hash = hashUnique 784 hashWithSalt = defaultHashWithSalt 785 786instance Hashable Version where 787 hashWithSalt salt (Version branch tags) = 788 salt `hashWithSalt` branch `hashWithSalt` tags 789 790#if MIN_VERSION_base(4,7,0) 791-- Using hashWithSalt1 would cause needless constraint 792instance Hashable (Fixed a) where 793 hashWithSalt salt (MkFixed i) = hashWithSalt salt i 794instance Hashable1 Fixed where 795 liftHashWithSalt _ salt (MkFixed i) = hashWithSalt salt i 796#endif 797 798#if MIN_VERSION_base(4,8,0) 799instance Hashable a => Hashable (Identity a) where 800 hashWithSalt = hashWithSalt1 801instance Hashable1 Identity where 802 liftHashWithSalt h salt (Identity x) = h salt x 803#endif 804 805-- Using hashWithSalt1 would cause needless constraint 806instance Hashable a => Hashable (Const a b) where 807 hashWithSalt salt (Const x) = hashWithSalt salt x 808 809instance Hashable a => Hashable1 (Const a) where 810 liftHashWithSalt = defaultLiftHashWithSalt 811 812instance Hashable2 Const where 813 liftHashWithSalt2 f _ salt (Const x) = f salt x 814 815#if MIN_VERSION_base(4,7,0) 816instance Hashable (Proxy a) where 817 hash _ = 0 818 hashWithSalt s _ = s 819 820instance Hashable1 Proxy where 821 liftHashWithSalt _ s _ = s 822#endif 823 824-- instances formerly provided by 'semigroups' package 825#if MIN_VERSION_base(4,9,0) 826instance Hashable a => Hashable (NE.NonEmpty a) where 827 hashWithSalt p (a NE.:| as) = p `hashWithSalt` a `hashWithSalt` as 828 829instance Hashable a => Hashable (Min a) where 830 hashWithSalt p (Min a) = hashWithSalt p a 831 832instance Hashable a => Hashable (Max a) where 833 hashWithSalt p (Max a) = hashWithSalt p a 834 835-- | __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. 836-- 837-- @since 1.3.0.0 838instance Hashable a => Hashable (Arg a b) where 839 hashWithSalt p (Arg a _) = hashWithSalt p a 840 841instance Hashable a => Hashable (First a) where 842 hashWithSalt p (First a) = hashWithSalt p a 843 844instance Hashable a => Hashable (Last a) where 845 hashWithSalt p (Last a) = hashWithSalt p a 846 847instance Hashable a => Hashable (WrappedMonoid a) where 848 hashWithSalt p (WrapMonoid a) = hashWithSalt p a 849 850instance Hashable a => Hashable (Option a) where 851 hashWithSalt p (Option a) = hashWithSalt p a 852#endif 853 854-- instances for @Data.Functor.{Product,Sum,Compose}@, present 855-- in base-4.9 and onward. 856#if MIN_VERSION_base(4,9,0) 857-- | In general, @hash (Compose x) ≠ hash x@. However, @hashWithSalt@ satisfies 858-- its variant of this equivalence. 859instance (Hashable1 f, Hashable1 g, Hashable a) => Hashable (Compose f g a) where 860 hashWithSalt = hashWithSalt1 861 862instance (Hashable1 f, Hashable1 g) => Hashable1 (Compose f g) where 863 liftHashWithSalt h s = liftHashWithSalt (liftHashWithSalt h) s . getCompose 864 865instance (Hashable1 f, Hashable1 g) => Hashable1 (FP.Product f g) where 866 liftHashWithSalt h s (FP.Pair a b) = liftHashWithSalt h (liftHashWithSalt h s a) b 867 868instance (Hashable1 f, Hashable1 g, Hashable a) => Hashable (FP.Product f g a) where 869 hashWithSalt = hashWithSalt1 870 871instance (Hashable1 f, Hashable1 g) => Hashable1 (FS.Sum f g) where 872 liftHashWithSalt h s (FS.InL a) = liftHashWithSalt h (s `combine` 0) a 873 liftHashWithSalt h s (FS.InR a) = liftHashWithSalt h (s `combine` distinguisher) a 874 875instance (Hashable1 f, Hashable1 g, Hashable a) => Hashable (FS.Sum f g a) where 876 hashWithSalt = hashWithSalt1 877#endif 878 879-- | A hashable value along with the result of the 'hash' function. 880data Hashed a = Hashed a {-# UNPACK #-} !Int 881 deriving (Typeable) 882 883-- | Wrap a hashable value, caching the 'hash' function result. 884hashed :: Hashable a => a -> Hashed a 885hashed a = Hashed a (hash a) 886 887-- | Unwrap hashed value. 888unhashed :: Hashed a -> a 889unhashed (Hashed a _) = a 890 891-- | Uses precomputed hash to detect inequality faster 892instance Eq a => Eq (Hashed a) where 893 Hashed a ha == Hashed b hb = ha == hb && a == b 894 895instance Ord a => Ord (Hashed a) where 896 Hashed a _ `compare` Hashed b _ = a `compare` b 897 898instance Show a => Show (Hashed a) where 899 showsPrec d (Hashed a _) = showParen (d > 10) $ 900 showString "hashed" . showChar ' ' . showsPrec 11 a 901 902instance Hashable (Hashed a) where 903 hashWithSalt = defaultHashWithSalt 904 hash (Hashed _ h) = h 905 906-- This instance is a little unsettling. It is unusal for 907-- 'liftHashWithSalt' to ignore its first argument when a 908-- value is actually available for it to work on. 909instance Hashable1 Hashed where 910 liftHashWithSalt _ s (Hashed _ h) = defaultHashWithSalt s h 911 912instance (IsString a, Hashable a) => IsString (Hashed a) where 913 fromString s = let r = fromString s in Hashed r (hash r) 914 915instance F.Foldable Hashed where 916 foldr f acc (Hashed a _) = f a acc 917 918instance NFData a => NFData (Hashed a) where 919 rnf = rnf . unhashed 920 921-- | 'Hashed' cannot be 'Functor' 922mapHashed :: Hashable b => (a -> b) -> Hashed a -> Hashed b 923mapHashed f (Hashed a _) = hashed (f a) 924 925-- | 'Hashed' cannot be 'Traversable' 926traverseHashed :: (Hashable b, Functor f) => (a -> f b) -> Hashed a -> f (Hashed b) 927traverseHashed f (Hashed a _) = fmap hashed (f a) 928 929-- instances for @Data.Functor.Classes@ higher rank typeclasses 930-- in base-4.9 and onward. 931#if MIN_VERSION_base(4,9,0) 932instance Eq1 Hashed where 933 liftEq f (Hashed a ha) (Hashed b hb) = ha == hb && f a b 934 935instance Ord1 Hashed where 936 liftCompare f (Hashed a _) (Hashed b _) = f a b 937 938instance Show1 Hashed where 939 liftShowsPrec sp _ d (Hashed a _) = showsUnaryWith sp "hashed" d a 940#endif 941