├── hashable-bench ├── cbits ├── src ├── include ├── xxHash-0.8.3 ├── cabal.project ├── LICENSE ├── hashable-bench.cabal └── benchmarks │ └── Benchmarks.hs ├── .gitattributes ├── Setup.hs ├── .git-blame-ignore-revs ├── cabal.bench.project ├── include ├── HsHashable.h └── HsXXHash.h ├── .hgignore ├── .gitignore ├── gen-ci.sh ├── README.md ├── tests ├── Main.hs ├── Regress │ └── Mmap.hsc ├── xxhash-tests.hs ├── Regress.hs └── Properties.hs ├── cabal.haskell-ci ├── src └── Data │ ├── Hashable │ ├── Imports.hs │ ├── Generic.hs │ ├── Mix.hs │ ├── FFI.hs │ ├── LowLevel.hs │ ├── Lifted.hs │ ├── Generic │ │ └── Instances.hs │ ├── XXH3.hs │ └── Class.hs │ └── Hashable.hs ├── .stylish-haskell.yaml ├── cabal.project ├── cbits-win └── init.c ├── cbits-unix └── init.c ├── src-randombytes ├── RandomSource.hs └── getRandomBytes.c ├── xxHash-0.8.3 └── LICENSE ├── examples └── Main.hs ├── LICENSE ├── .github └── workflows │ ├── simple.yml │ ├── haskell-ci-bench.yml │ └── haskell-ci.yml ├── hashable.cabal └── CHANGES.md /hashable-bench/cbits: -------------------------------------------------------------------------------- 1 | ../cbits -------------------------------------------------------------------------------- /hashable-bench/src: -------------------------------------------------------------------------------- 1 | ../src -------------------------------------------------------------------------------- /hashable-bench/include: -------------------------------------------------------------------------------- 1 | ../include -------------------------------------------------------------------------------- /hashable-bench/xxHash-0.8.3: -------------------------------------------------------------------------------- 1 | ../xxHash-0.8.3 -------------------------------------------------------------------------------- /.gitattributes: -------------------------------------------------------------------------------- 1 | xxHash-0.8.2/* linguist-detectable=false 2 | -------------------------------------------------------------------------------- /Setup.hs: -------------------------------------------------------------------------------- 1 | #!/usr/bin/env runhaskell 2 | import Distribution.Simple 3 | main = defaultMain 4 | -------------------------------------------------------------------------------- /.git-blame-ignore-revs: -------------------------------------------------------------------------------- 1 | # Move code into subdirectories 2 | c2b8b4fc450c6e530370c0118d5a4fec89e77074 3 | -------------------------------------------------------------------------------- /hashable-bench/cabal.project: -------------------------------------------------------------------------------- 1 | -- this project files is here, so you could work just in 2 | -- the haskell-bench directory 3 | packages: . 4 | -------------------------------------------------------------------------------- /cabal.bench.project: -------------------------------------------------------------------------------- 1 | -- separate package for benchmarks 2 | -- this way we can build criterion 3 | packages: hashable-bench 4 | benchmarks: True 5 | -------------------------------------------------------------------------------- /include/HsHashable.h: -------------------------------------------------------------------------------- 1 | #ifndef HS_HASHABLE_H 2 | #define HS_HASHABLE_H 3 | 4 | #include 5 | 6 | uint64_t hs_hashable_init(); 7 | 8 | #endif 9 | -------------------------------------------------------------------------------- /.hgignore: -------------------------------------------------------------------------------- 1 | ^(?:dist|benchmarks/dist)$ 2 | ^tests/benchmarks/.*\.txt$ 3 | ^tests/(?:\.hpc|bm|qc|qc-hpc|stdio-hpc|text/test)$ 4 | \.(?:aux|eventlog|h[ip]|log|[oa]|orig|prof|ps|rej|swp)$ 5 | ~$ 6 | syntax: glob 7 | .\#* 8 | -------------------------------------------------------------------------------- /.gitignore: -------------------------------------------------------------------------------- 1 | /.cabal-sandbox/ 2 | /cabal.project.local 3 | /cabal.sandbox.config 4 | /dist 5 | /dist-newstyle/ 6 | *.o 7 | *.hi 8 | /.ghc.environment.* 9 | 10 | # Executables 11 | benchmarks/bench 12 | cabal-dev 13 | -------------------------------------------------------------------------------- /gen-ci.sh: -------------------------------------------------------------------------------- 1 | #!/bin/sh 2 | 3 | # haskell-ci doesn't know how to regenerate multiple GHA workflows 4 | haskell-ci github cabal.project 5 | haskell-ci github --project cabal.bench.project -o .github/workflows/haskell-ci-bench.yml --github-action-name Benchmarks 6 | -------------------------------------------------------------------------------- /README.md: -------------------------------------------------------------------------------- 1 | The hashable package 2 | ==================== 3 | 4 | This package defines a class, `Hashable`, for types that can be 5 | converted to a hash value. This class exists for the benefit of 6 | hashing-based data structures. The package provides instances for 7 | basic types and a way to combine hash values. 8 | -------------------------------------------------------------------------------- /tests/Main.hs: -------------------------------------------------------------------------------- 1 | -- | Tests for the 'Data.Hashable' module. We test functions by 2 | -- comparing the C and Haskell implementations. 3 | 4 | module Main (main) where 5 | 6 | import Properties (properties) 7 | import Regress (regressions) 8 | import Test.Tasty (defaultMain, testGroup) 9 | 10 | main :: IO () 11 | main = defaultMain $ testGroup "hashable" 12 | [ testGroup "properties" properties 13 | , testGroup "regressions" regressions 14 | ] 15 | -------------------------------------------------------------------------------- /cabal.haskell-ci: -------------------------------------------------------------------------------- 1 | distribution: jammy 2 | branches: master 3 | benchmarks: False 4 | head-hackage: False 5 | 6 | constraint-set random-initial-seed 7 | constraints: hashable +random-initial-seed 8 | 9 | constraint-set filepath-1.4.100.0 10 | ghc: <9.10 11 | constraints: filepath ^>=1.4.100.0 12 | tests: True 13 | run-tests: True 14 | 15 | constraint-set filepath-1.5 16 | ghc: >=9.2 17 | constraints: filepath ^>=1.5.2.0 18 | tests: True 19 | run-tests: True 20 | -------------------------------------------------------------------------------- /src/Data/Hashable/Imports.hs: -------------------------------------------------------------------------------- 1 | -- | This module exists to avoid conditional imports 2 | -- and unused import warnings. 3 | {-# LANGUAGE Safe #-} 4 | module Data.Hashable.Imports ( 5 | Int64, Int32, 6 | Word64, Word32, 7 | xor, shiftR, shiftL, unsafeShiftL, unsafeShiftR, 8 | (.&.), 9 | ) where 10 | 11 | import Data.Bits (shiftL, shiftR, unsafeShiftL, unsafeShiftR, xor, (.&.)) 12 | import Data.Int (Int32, Int64) 13 | import Data.Word (Word32, Word64) 14 | import Prelude () 15 | -------------------------------------------------------------------------------- /.stylish-haskell.yaml: -------------------------------------------------------------------------------- 1 | steps: 2 | - imports: 3 | align: group 4 | list_align: after_alias 5 | long_list_align: new_line 6 | empty_list_align: right_after 7 | list_padding: module_name 8 | - language_pragmas: 9 | style: vertical 10 | remove_redundant: true 11 | - trailing_whitespace: {} 12 | columns: 140 13 | language_extensions: 14 | - DataKinds 15 | - EmptyCase 16 | - ExplicitForAll 17 | - FlexibleContexts 18 | - MultiParamTypeClasses 19 | -------------------------------------------------------------------------------- /cabal.project: -------------------------------------------------------------------------------- 1 | packages: . 2 | tests: True 3 | 4 | allow-newer: splitmix-0.1.0.5:base 5 | 6 | -- 7 | -- allow-newer: base 8 | -- allow-newer: bytestring 9 | -- 10 | -- repository head.hackage 11 | -- url: https://ghc.gitlab.haskell.org/head.hackage/ 12 | -- secure: True 13 | -- root-keys: 7541f32a4ccca4f97aea3b22f5e593ba2c0267546016b992dfadcd2fe944e55d 14 | -- 26021a13b401500c8eb2761ca95c61f2d625bfef951b939a8124ed12ecf07329 15 | -- f76d08be13e9a61a377a85e2fb63f4c5435d40f8feb3e12eb05905edb8cdea89 16 | -- key-threshold: 3 17 | -- 18 | -- active-repositories: hackage.haskell.org, head.hackage:override 19 | -------------------------------------------------------------------------------- /src/Data/Hashable/Generic.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE Safe #-} 2 | 3 | -- | 4 | -- Module : Data.Hashable.Generic 5 | -- SPDX-License-Identifier : BSD-3-Clause 6 | -- Stability : provisional 7 | -- Portability : GHC >= 7.4 8 | -- 9 | -- Hashable support for GHC generics. 10 | -- 11 | -- @since 1.3.0.0 12 | module Data.Hashable.Generic 13 | ( 14 | -- * Implementation using Generics. 15 | genericHashWithSalt 16 | , genericLiftHashWithSalt 17 | -- * Constraints 18 | , GHashable (..) 19 | , One 20 | , Zero 21 | , HashArgs (..) 22 | ) where 23 | 24 | import Data.Hashable.Generic.Instances () 25 | import Data.Hashable.Class 26 | -------------------------------------------------------------------------------- /cbits-win/init.c: -------------------------------------------------------------------------------- 1 | #include 2 | 3 | #include 4 | 5 | uint64_t hs_hashable_init() { 6 | /* Handy list at https://stackoverflow.com/a/3487338/1308058 */ 7 | 8 | uint64_t a = GetCurrentProcessId(); /* DWORD */ 9 | uint64_t b = GetCurrentThreadId(); /* DWORD */ 10 | uint64_t c = GetTickCount(); /* DWORD */ 11 | 12 | SYSTEMTIME t = {0,0,0,0,0,0,0,0}; 13 | GetSystemTime(&t); 14 | 15 | LARGE_INTEGER i; 16 | QueryPerformanceCounter(&i); 17 | 18 | return a ^ (b << 32) ^ (c << 16) 19 | ^ ((uint64_t) t.wYear << 56) 20 | ^ ((uint64_t) t.wMonth << 48) 21 | ^ ((uint64_t) t.wDayOfWeek << 40) 22 | ^ ((uint64_t) t.wDay << 32) 23 | ^ ((uint64_t) t.wHour << 24) 24 | ^ ((uint64_t) t.wMinute << 16) 25 | ^ ((uint64_t) t.wSecond << 8) 26 | ^ ((uint64_t) t.wMilliseconds << 0) 27 | ^ ((uint64_t) i.QuadPart); 28 | } 29 | -------------------------------------------------------------------------------- /cbits-unix/init.c: -------------------------------------------------------------------------------- 1 | #include 2 | #include 3 | #include 4 | #include 5 | #include 6 | #include 7 | 8 | uint64_t hs_hashable_init() { 9 | 10 | /* if there is /dev/urandom, read from it */ 11 | FILE *urandom = fopen("/dev/urandom", "r"); 12 | if (urandom) { 13 | uint64_t result = 0; 14 | size_t r = fread(&result, sizeof(uint64_t), 1, urandom); 15 | fclose(urandom); 16 | 17 | if (r == 1) { 18 | return result; 19 | } else { 20 | return 0xfeed1000; 21 | } 22 | 23 | } else { 24 | /* time of day */ 25 | struct timeval tp = {0, 0}; 26 | gettimeofday(&tp, NULL); 27 | 28 | /* cputime */ 29 | clock_t c = clock(); 30 | 31 | /* process id */ 32 | pid_t p = getpid(); 33 | 34 | return ((uint64_t) tp.tv_sec) 35 | ^ ((uint64_t) tp.tv_usec) 36 | ^ ((uint64_t) c << 16) 37 | ^ ((uint64_t) p << 32); 38 | } 39 | } 40 | -------------------------------------------------------------------------------- /src-randombytes/RandomSource.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE CPP, ForeignFunctionInterface #-} 2 | #if defined(__GLASGOW_HASKELL__) && __GLASGOW_HASKELL__ >= 702 3 | {-# LANGUAGE Trustworthy #-} 4 | #endif 5 | 6 | module Data.Hashable.RandomSource 7 | ( 8 | getRandomBytes 9 | , getRandomBytes_ 10 | ) where 11 | 12 | import Data.ByteString as B 13 | import Data.ByteString.Internal (create) 14 | import Foreign.C.Error (throwErrnoIfMinus1_) 15 | #if MIN_VERSION_base(4,5,0) 16 | import Foreign.C.Types (CInt(CInt)) 17 | #else 18 | import Foreign.C.Types (CInt) 19 | #endif 20 | import Foreign.Ptr (Ptr) 21 | 22 | getRandomBytes :: Int -> IO ByteString 23 | getRandomBytes nbytes 24 | | nbytes <= 0 = return B.empty 25 | | otherwise = create nbytes $ flip (getRandomBytes_ "getRandomBytes") nbytes 26 | 27 | getRandomBytes_ :: String -> Ptr a -> Int -> IO () 28 | getRandomBytes_ what ptr nbytes = do 29 | throwErrnoIfMinus1_ what $ c_getRandomBytes ptr (fromIntegral nbytes) 30 | 31 | foreign import ccall unsafe "hashable_getRandomBytes" c_getRandomBytes 32 | :: Ptr a -> CInt -> IO CInt 33 | -------------------------------------------------------------------------------- /include/HsXXHash.h: -------------------------------------------------------------------------------- 1 | #ifndef HS_XXHASH_H 2 | #define HS_XXHASH_H 3 | 4 | #include 5 | 6 | #define XXH_INLINE_ALL 7 | #include "xxhash.h" 8 | 9 | #define hs_XXH3_sizeof_state_s sizeof(struct XXH3_state_s) 10 | 11 | static inline uint64_t hs_XXH3_64bits_withSeed_offset(const uint8_t *ptr, size_t off, size_t len, uint64_t seed) { 12 | return XXH3_64bits_withSeed(ptr + off, len, seed); 13 | } 14 | 15 | static inline uint64_t hs_XXH3_64bits_withSeed_u64(uint64_t val, uint64_t seed) { 16 | return XXH3_64bits_withSeed(&val, sizeof(val), seed); 17 | } 18 | 19 | static inline uint64_t hs_XXH3_64bits_withSeed_u32(uint32_t val, uint64_t seed) { 20 | return XXH3_64bits_withSeed(&val, sizeof(val), seed); 21 | } 22 | 23 | static inline void hs_XXH3_64bits_update_offset(XXH3_state_t *statePtr, const uint8_t *ptr, size_t off, size_t len) { 24 | XXH3_64bits_update(statePtr, ptr + off, len); 25 | } 26 | 27 | static inline void hs_XXH3_64bits_update_u64(XXH3_state_t *statePtr, uint64_t val) { 28 | XXH3_64bits_update(statePtr, &val, sizeof(val)); 29 | } 30 | 31 | static inline void hs_XXH3_64bits_update_u32(XXH3_state_t *statePtr, uint32_t val) { 32 | XXH3_64bits_update(statePtr, &val, sizeof(val)); 33 | } 34 | 35 | #endif /* HS_XXHASH_H */ 36 | -------------------------------------------------------------------------------- /src/Data/Hashable/Mix.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE CPP #-} 2 | {-# LANGUAGE MagicHash #-} 3 | {-# LANGUAGE Trustworthy #-} 4 | {-# LANGUAGE UnboxedTuples #-} 5 | module Data.Hashable.Mix ( 6 | Salt, 7 | mixHash, 8 | ) where 9 | 10 | #include "MachDeps.h" 11 | 12 | import Data.Bits (unsafeShiftR, xor) 13 | import GHC.Exts (Word (..), byteSwap#, timesWord2#, xor#) 14 | 15 | type Salt = Int 16 | 17 | mulFold :: Word -> Word -> Word 18 | mulFold (W# x) (W# y) = case timesWord2# x y of 19 | (# hi, lo #) -> W# (xor# hi lo) 20 | 21 | byteSwap :: Word -> Word 22 | byteSwap (W# w) = W# (byteSwap# w) 23 | 24 | avalanche :: Word -> Word 25 | avalanche z0 = 26 | #if WORD_SIZE_IN_BITS == 64 27 | -- MurmurHash3Mixer 28 | let z1 = shiftXorMultiply 33 0xff51afd7ed558ccd z0 29 | z2 = shiftXorMultiply 33 0xc4ceb9fe1a85ec53 z1 30 | z3 = shiftXor 33 z2 31 | in z3 32 | #else 33 | -- MurmurHash3Mixer 32bit 34 | let z1 = shiftXorMultiply 16 0x85ebca6b z0 35 | z2 = shiftXorMultiply 13 0xc2b2ae35 z1 36 | z3 = shiftXor 16 z2 37 | in z3 38 | #endif 39 | 40 | shiftXor :: Int -> Word -> Word 41 | shiftXor n w = w `xor` (w `unsafeShiftR` n) 42 | 43 | shiftXorMultiply :: Int -> Word -> Word -> Word 44 | shiftXorMultiply n k w = shiftXor n w * k 45 | 46 | -- | Mix hash is inspired by how xxh3 works on small (<=16byte) inputs. 47 | mixHash :: Word -> Word -> Word 48 | mixHash hi lo = avalanche (byteSwap lo + hi + mulFold hi lo) 49 | -------------------------------------------------------------------------------- /xxHash-0.8.3/LICENSE: -------------------------------------------------------------------------------- 1 | xxHash Library 2 | Copyright (c) 2012-2021 Yann Collet 3 | All rights reserved. 4 | 5 | BSD 2-Clause License (https://www.opensource.org/licenses/bsd-license.php) 6 | 7 | Redistribution and use in source and binary forms, with or without modification, 8 | are permitted provided that the following conditions are met: 9 | 10 | * Redistributions of source code must retain the above copyright notice, this 11 | list of conditions and the following disclaimer. 12 | 13 | * Redistributions in binary form must reproduce the above copyright notice, this 14 | list of conditions and the following disclaimer in the documentation and/or 15 | other materials provided with the distribution. 16 | 17 | THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" AND 18 | ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED 19 | WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE 20 | DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDER OR CONTRIBUTORS BE LIABLE FOR 21 | ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES 22 | (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; 23 | LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON 24 | ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT 25 | (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS 26 | SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. 27 | -------------------------------------------------------------------------------- /examples/Main.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE DeriveGeneric #-} 2 | import Data.Hashable 3 | import Data.Hashable.Lifted 4 | import GHC.Generics (Generic) 5 | 6 | data Foo 7 | = Foo1 Int Char Bool 8 | | Foo2 String () 9 | deriving (Eq, Generic) 10 | 11 | instance Hashable Foo 12 | 13 | data Bar = Bar Double Float 14 | deriving (Eq, Generic) 15 | 16 | instance Hashable Bar 17 | 18 | -- printHash :: (Hashable a, Show a) => a -> IO () 19 | -- printHash = print . hash 20 | 21 | main :: IO () 22 | main = do 23 | putStrLn "Hashing Foo1" 24 | print . hash $ Foo1 22 'y' True 25 | putStrLn "Hashing Foo2" 26 | print . hash $ Foo2 "hello" () 27 | putStrLn "Hashing Bar" 28 | print . hash $ Bar 55.50 9.125 29 | 30 | ----------------------------------- 31 | -- Higher Rank Hashable Examples -- 32 | ----------------------------------- 33 | 34 | {- TODO: 35 | 36 | newtype WriterT w m a = WriterT { runWriterT :: m (a, w) } 37 | data Free f a = Pure a | Free (f (Free f a)) 38 | 39 | instance (Hashable w, Hashable1 m) => Hashable1 (WriterT w m) where 40 | liftHashWithSalt h s (WriterT m) = 41 | liftHashWithSalt (liftHashWithSalt2 h hashWithSalt) s m 42 | instance Hashable1 f => Hashable1 (Free f) where 43 | liftHashWithSalt h = go where 44 | go s x = case x of 45 | Pure a -> h s a 46 | Free p -> liftHashWithSalt go s p 47 | 48 | instance (Hashable w, Hashable1 m, Hashable a) => Hashable (WriterT w m a) where 49 | hashWithSalt = hashWithSalt1 50 | instance (Hashable1 f, Hashable a) => Hashable (Free f a) where 51 | hashWithSalt = hashWithSalt1 52 | -} 53 | -------------------------------------------------------------------------------- /LICENSE: -------------------------------------------------------------------------------- 1 | Copyright Milan Straka 2010 2 | 3 | All rights reserved. 4 | 5 | Redistribution and use in source and binary forms, with or without 6 | modification, are permitted provided that the following conditions are met: 7 | 8 | * Redistributions of source code must retain the above copyright 9 | notice, this list of conditions and the following disclaimer. 10 | 11 | * Redistributions in binary form must reproduce the above 12 | copyright notice, this list of conditions and the following 13 | disclaimer in the documentation and/or other materials provided 14 | with the distribution. 15 | 16 | * Neither the name of Milan Straka nor the names of other 17 | contributors may be used to endorse or promote products derived 18 | from this software without specific prior written permission. 19 | 20 | THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS 21 | "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT 22 | LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR 23 | A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT 24 | OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, 25 | SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT 26 | LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, 27 | DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY 28 | THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT 29 | (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE 30 | OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. 31 | -------------------------------------------------------------------------------- /hashable-bench/LICENSE: -------------------------------------------------------------------------------- 1 | Copyright Milan Straka 2010 2 | 3 | All rights reserved. 4 | 5 | Redistribution and use in source and binary forms, with or without 6 | modification, are permitted provided that the following conditions are met: 7 | 8 | * Redistributions of source code must retain the above copyright 9 | notice, this list of conditions and the following disclaimer. 10 | 11 | * Redistributions in binary form must reproduce the above 12 | copyright notice, this list of conditions and the following 13 | disclaimer in the documentation and/or other materials provided 14 | with the distribution. 15 | 16 | * Neither the name of Milan Straka nor the names of other 17 | contributors may be used to endorse or promote products derived 18 | from this software without specific prior written permission. 19 | 20 | THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS 21 | "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT 22 | LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR 23 | A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT 24 | OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, 25 | SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT 26 | LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, 27 | DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY 28 | THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT 29 | (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE 30 | OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. 31 | -------------------------------------------------------------------------------- /tests/Regress/Mmap.hsc: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE CApiFFI #-} 2 | 3 | module Regress.Mmap (regressions) where 4 | 5 | #include 6 | 7 | import Control.Exception (bracket, evaluate) 8 | import Control.Monad (forM_) 9 | import Data.Bits ((.|.)) 10 | import Data.ByteString.Internal (ByteString(..)) 11 | import Data.Hashable (hash) 12 | import Foreign.C.Error (throwErrnoIf, throwErrnoIfMinus1, throwErrnoIfMinus1_) 13 | import Foreign.C.Types (CInt(..), CSize(..)) 14 | import Foreign.Ptr (Ptr, intPtrToPtr, nullPtr, plusPtr) 15 | import GHC.ForeignPtr (newForeignPtr_) 16 | import System.Posix.Types (COff(..)) 17 | import Test.Tasty (TestTree) 18 | import Test.Tasty.HUnit (testCase) 19 | import qualified Data.ByteString as B 20 | 21 | withMapping :: (Ptr a -> Int -> IO ()) -> IO () 22 | withMapping go = do 23 | pageSize <- fromIntegral `fmap` getPageSize 24 | let mappingSize = pageSize * 2 25 | bracket (mmap 26 | nullPtr 27 | mappingSize 28 | ((#const PROT_READ) .|. (#const PROT_WRITE)) 29 | ((#const MAP_ANON) .|. (#const MAP_PRIVATE)) 30 | (-1) 31 | 0) 32 | (flip munmap mappingSize) $ \mappingPtr -> do 33 | go mappingPtr (fromIntegral pageSize) 34 | mprotect (mappingPtr `plusPtr` fromIntegral pageSize) 35 | pageSize (#const PROT_NONE) 36 | 37 | hashNearPageBoundary :: IO () 38 | hashNearPageBoundary = 39 | withMapping $ \ptr pageSize -> do 40 | let initialSize = 16 41 | fp <- newForeignPtr_ (ptr `plusPtr` (pageSize - initialSize)) 42 | let bs0 = PS fp 0 initialSize 43 | forM_ (B.tails bs0) $ \bs -> do 44 | evaluate (hash bs) 45 | 46 | regressions :: [TestTree] 47 | regressions = [ 48 | testCase "hashNearPageBoundary" hashNearPageBoundary 49 | ] 50 | 51 | mmap :: Ptr a -> CSize -> CInt -> CInt -> CInt -> COff -> IO (Ptr a) 52 | mmap addr len prot flags fd offset = 53 | throwErrnoIf (== intPtrToPtr (#const MAP_FAILED)) "mmap" $ 54 | c_mmap addr len prot flags fd offset 55 | 56 | munmap :: Ptr a -> CSize -> IO CInt 57 | munmap addr len = throwErrnoIfMinus1 "munmap" $ c_munmap addr len 58 | 59 | mprotect :: Ptr a -> CSize -> CInt -> IO () 60 | mprotect addr len prot = 61 | throwErrnoIfMinus1_ "mprotect" $ c_mprotect addr len prot 62 | 63 | foreign import capi unsafe "sys/mman.h mmap" 64 | c_mmap :: Ptr a -> CSize -> CInt -> CInt -> CInt -> COff -> IO (Ptr a) 65 | 66 | foreign import capi unsafe "sys/mman.h munmap" 67 | c_munmap :: Ptr a -> CSize -> IO CInt 68 | 69 | foreign import capi unsafe "sys/mman.h mprotect" 70 | c_mprotect :: Ptr a -> CSize -> CInt -> IO CInt 71 | 72 | foreign import capi unsafe "unistd.h getpagesize" 73 | getPageSize :: IO CInt 74 | -------------------------------------------------------------------------------- /tests/xxhash-tests.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE NumericUnderscores #-} 2 | module Main (main) where 3 | 4 | import Control.Monad.ST (runST) 5 | import qualified Data.ByteString as BS 6 | import qualified Data.Primitive as P 7 | import Data.Word (Word32, Word64) 8 | import Test.Tasty (defaultMain, testGroup) 9 | import Test.Tasty.HUnit (testCase, (@=?)) 10 | import Test.Tasty.QuickCheck (testProperty, (===)) 11 | 12 | import Data.Hashable.XXH3 13 | 14 | main :: IO () 15 | main = defaultMain $ testGroup "xxhash" 16 | [ testGroup "oneshot" 17 | [ testProperty "w64-ref" $ \w salt -> 18 | xxh3_64bit_withSeed_w64 w salt === xxh3_64bit_withSeed_w64_ref w salt 19 | , testCase "w64-examples" $ do 20 | xxh3_64bit_withSeed_w64 0 0 @=? 0xc77b_3abb_6f87_acd9 21 | xxh3_64bit_withSeed_w64 0x12 1 @=? 0xbba4_8522_c425_46b2 22 | xxh3_64bit_withSeed_w64 0x2100_0000_0000_0000 0 @=? 0xb7cb_e42a_e127_8055 23 | xxh3_64bit_withSeed_w64 0x1eb6e9 0 @=? 0x8e_adc3_1b56 24 | 25 | , testProperty "w32-ref" $ \w salt -> 26 | xxh3_64bit_withSeed_w32 w salt === xxh3_64bit_withSeed_w32_ref w salt 27 | 28 | , testCase "w32-examples" $ do 29 | xxh3_64bit_withSeed_w32 0 0 @=? 0x48b2_c926_16fc_193d 30 | xxh3_64bit_withSeed_w32 0x12 1 @=? 0x2870_1df3_2a21_6ad3 31 | 32 | ] 33 | 34 | , testGroup "incremental" 35 | [ testProperty "empty" $ \seed -> do 36 | let expected = xxh3_64bit_withSeed_bs BS.empty seed 37 | let actual = runST $ do 38 | s <- xxh3_64bit_createState 39 | xxh3_64bit_reset_withSeed s seed 40 | xxh3_64bit_digest s 41 | 42 | actual === expected 43 | 44 | , testProperty "bs" $ \w8s seed -> do 45 | let bs = BS.pack w8s 46 | let expected = xxh3_64bit_withSeed_bs bs seed 47 | let actual = runST $ do 48 | s <- xxh3_64bit_createState 49 | xxh3_64bit_reset_withSeed s seed 50 | xxh3_64bit_update_bs s bs 51 | xxh3_64bit_digest s 52 | 53 | actual === expected 54 | ] 55 | ] 56 | 57 | xxh3_64bit_withSeed_w64_ref :: Word64 -> Word64 -> Word64 58 | xxh3_64bit_withSeed_w64_ref w salt = case P.primArrayFromList [w] of 59 | P.PrimArray ba -> xxh3_64bit_withSeed_ba (P.ByteArray ba) 0 8 salt 60 | 61 | xxh3_64bit_withSeed_w32_ref :: Word32 -> Word64 -> Word64 62 | xxh3_64bit_withSeed_w32_ref w salt = case P.primArrayFromList [w] of 63 | P.PrimArray ba -> xxh3_64bit_withSeed_ba (P.ByteArray ba) 0 4 salt 64 | -------------------------------------------------------------------------------- /src-randombytes/getRandomBytes.c: -------------------------------------------------------------------------------- 1 | /* 2 | Copyright Bryan O'Sullivan 2012 3 | 4 | All rights reserved. 5 | 6 | Redistribution and use in source and binary forms, with or without 7 | modification, are permitted provided that the following conditions are met: 8 | 9 | * Redistributions of source code must retain the above copyright 10 | notice, this list of conditions and the following disclaimer. 11 | 12 | * Redistributions in binary form must reproduce the above 13 | copyright notice, this list of conditions and the following 14 | disclaimer in the documentation and/or other materials provided 15 | with the distribution. 16 | 17 | * Neither the name of Johan Tibell nor the names of other 18 | contributors may be used to endorse or promote products derived 19 | from this software without specific prior written permission. 20 | 21 | THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS 22 | "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT 23 | LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR 24 | A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT 25 | OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, 26 | SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT 27 | LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, 28 | DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY 29 | THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT 30 | (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE 31 | OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. 32 | */ 33 | 34 | #include "MachDeps.h" 35 | 36 | int hashable_getRandomBytes(unsigned char *dest, int nbytes); 37 | 38 | #if defined(mingw32_HOST_OS) || defined(__MINGW32__) 39 | 40 | #include 41 | #include 42 | 43 | int hashable_getRandomBytes(unsigned char *dest, int nbytes) 44 | { 45 | HCRYPTPROV hCryptProv; 46 | int ret; 47 | 48 | if (!CryptAcquireContextA(&hCryptProv, NULL, NULL, PROV_RSA_FULL, 49 | CRYPT_VERIFYCONTEXT)) 50 | return -1; 51 | 52 | ret = CryptGenRandom(hCryptProv, (DWORD) nbytes, (BYTE *) dest) ? nbytes : -1; 53 | 54 | CryptReleaseContext(hCryptProv, 0); 55 | 56 | bail: 57 | return ret; 58 | } 59 | 60 | #else 61 | 62 | #include 63 | #include 64 | #include 65 | 66 | /* Assumptions: /dev/urandom exists and does something sane, and does 67 | not block. */ 68 | 69 | int hashable_getRandomBytes(unsigned char *dest, int nbytes) 70 | { 71 | ssize_t off, nread; 72 | int fd; 73 | 74 | fd = open("/dev/urandom", O_RDONLY); 75 | if (fd == -1) 76 | return -1; 77 | 78 | for (off = 0; nbytes > 0; nbytes -= nread) { 79 | nread = read(fd, dest + off, nbytes); 80 | off += nread; 81 | if (nread == -1) { 82 | off = -1; 83 | break; 84 | } 85 | } 86 | 87 | bail: 88 | close(fd); 89 | 90 | return off; 91 | } 92 | 93 | #endif 94 | -------------------------------------------------------------------------------- /src/Data/Hashable/FFI.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE CApiFFI #-} 2 | {-# LANGUAGE MagicHash #-} 3 | {-# LANGUAGE Trustworthy #-} 4 | {-# LANGUAGE UnliftedFFITypes #-} 5 | module Data.Hashable.FFI ( 6 | -- * One shot 7 | unsafe_xxh3_64bit_withSeed_ptr, 8 | unsafe_xxh3_64bit_withSeed_ba, 9 | unsafe_xxh3_64bit_withSeed_u64, 10 | unsafe_xxh3_64bit_withSeed_u32, 11 | -- * Incremental 12 | unsafe_xxh3_sizeof_state, 13 | unsafe_xxh3_initState, 14 | unsafe_xxh3_64bit_reset_withSeed, 15 | unsafe_xxh3_64bit_digest, 16 | unsafe_xxh3_64bit_update_ptr, 17 | unsafe_xxh3_64bit_update_ba, 18 | unsafe_xxh3_64bit_update_u64, 19 | unsafe_xxh3_64bit_update_u32, 20 | ) where 21 | 22 | import Data.Word (Word32, Word64, Word8) 23 | import Foreign.C.Types (CSize (..)) 24 | import Foreign.Ptr (Ptr) 25 | import GHC.Exts (ByteArray#, MutableByteArray#) 26 | 27 | -- Note: we use unsafe FFI calls, as we expect our use case to be hashing only small data (<1kb, at most 4k). 28 | 29 | ------------------------------------------------------------------------------- 30 | -- OneShot 31 | ------------------------------------------------------------------------------- 32 | 33 | foreign import capi unsafe "HsXXHash.h XXH3_64bits_withSeed" 34 | unsafe_xxh3_64bit_withSeed_ptr :: Ptr Word8 -> CSize -> Word64 -> IO Word64 35 | 36 | foreign import capi unsafe "HsXXHash.h hs_XXH3_64bits_withSeed_offset" 37 | unsafe_xxh3_64bit_withSeed_ba :: ByteArray# -> CSize -> CSize -> Word64 -> Word64 38 | 39 | foreign import capi unsafe "HsXXHash.h hs_XXH3_64bits_withSeed_u64" 40 | unsafe_xxh3_64bit_withSeed_u64 :: Word64 -> Word64 -> Word64 41 | 42 | foreign import capi unsafe "HsXXHash.h hs_XXH3_64bits_withSeed_u32" 43 | unsafe_xxh3_64bit_withSeed_u32 :: Word32 -> Word64 -> Word64 44 | 45 | ------------------------------------------------------------------------------- 46 | -- Incremental 47 | ------------------------------------------------------------------------------- 48 | 49 | -- reset and update functions return OK/Error 50 | -- we ignore that: 51 | -- * reset errors only on NULL state 52 | -- * update cannot even error 53 | 54 | foreign import capi unsafe "HsXXHash.h value hs_XXH3_sizeof_state_s" 55 | unsafe_xxh3_sizeof_state :: Int 56 | 57 | foreign import capi unsafe "HsXXHash.h XXH3_INITSTATE" 58 | unsafe_xxh3_initState :: MutableByteArray# s -> IO () 59 | 60 | foreign import capi unsafe "HsXXHash.h XXH3_64bits_reset_withSeed" 61 | unsafe_xxh3_64bit_reset_withSeed :: MutableByteArray# s -> Word64 -> IO () 62 | 63 | foreign import capi unsafe "HsXXHash.h XXH3_64bits_digest" 64 | unsafe_xxh3_64bit_digest :: MutableByteArray# s -> IO Word64 65 | 66 | foreign import capi unsafe "HsXXHash.h XXH3_64bits_update" 67 | unsafe_xxh3_64bit_update_ptr :: MutableByteArray# s -> Ptr Word8 -> CSize -> IO () 68 | 69 | foreign import capi unsafe "HsXXHash.h hs_XXH3_64bits_update_offset" 70 | unsafe_xxh3_64bit_update_ba :: MutableByteArray# s -> ByteArray# -> CSize -> CSize -> IO () 71 | 72 | foreign import capi unsafe "HsXXHash.h hs_XXH3_64bits_update_u64" 73 | unsafe_xxh3_64bit_update_u64 :: MutableByteArray# s -> Word64 -> IO () 74 | 75 | foreign import capi unsafe "HsXXHash.h hs_XXH3_64bits_update_u32" 76 | unsafe_xxh3_64bit_update_u32 :: MutableByteArray# s -> Word32 -> IO () 77 | -------------------------------------------------------------------------------- /.github/workflows/simple.yml: -------------------------------------------------------------------------------- 1 | name: Simple 2 | on: 3 | push: 4 | branches: 5 | - master 6 | pull_request: 7 | branches: 8 | - master 9 | 10 | jobs: 11 | native: 12 | name: "Simple: GHC ${{ matrix.ghc }} on ${{ matrix.os }}" 13 | runs-on: ${{ matrix.os }} 14 | strategy: 15 | matrix: 16 | os: [macos-latest, windows-latest] 17 | ghc: ['9.6.5','9.8.2'] 18 | fail-fast: false 19 | steps: 20 | - name: Set git to use LF 21 | run: | 22 | git config --global core.autocrlf false 23 | git config --global core.eol lf 24 | 25 | - name: Checkout 26 | uses: actions/checkout@v4 27 | 28 | - name: Set up Haskell 29 | id: setup-haskell 30 | uses: haskell-actions/setup@v2 31 | with: 32 | ghc-version: ${{ matrix.ghc }} 33 | cabal-version: '3.10.3.0' 34 | 35 | - name: Cache 36 | uses: actions/cache@v4 37 | with: 38 | path: ${{ steps.setup-haskell.outputs.cabal-store }} 39 | key: ${{ runner.os }}-${{ matrix.ghc }}-${{ github.sha }} 40 | restore-keys: ${{ runner.os }}-${{ matrix.ghc }}- 41 | 42 | - name: Build 43 | run: cabal build all --enable-tests 44 | 45 | - name: Test 46 | run: cabal test all --enable-tests --test-show-details=direct 47 | 48 | alpine-32bit: 49 | name: Alpine Linux, musl, 32-bit 50 | runs-on: ubuntu-latest 51 | env: 52 | CC: "gcc" 53 | strategy: 54 | matrix: 55 | ghc: ['9.6.5'] 56 | steps: 57 | - name: Checkout 58 | uses: actions/checkout@v4 59 | 60 | - name: "Setup Alpine Linux" 61 | uses: jirutka/setup-alpine@v1 62 | with: 63 | arch: x86 64 | branch: v3.17 65 | packages: > 66 | binutils-gold 67 | curl 68 | gcc 69 | g++ 70 | git 71 | gmp-dev 72 | libc-dev 73 | libffi-dev 74 | make 75 | musl-dev 76 | ncurses-dev 77 | openssh-client 78 | perl 79 | tar 80 | zlib-dev 81 | zlib-static 82 | 83 | - name: "Setup" 84 | shell: alpine.sh {0} 85 | run: | 86 | gcc --version 87 | make --version 88 | curl https://downloads.haskell.org/ghcup/0.1.22.0/i386-linux-ghcup-0.1.22.0 > ghcup 89 | chmod a+x ghcup 90 | whoami 91 | echo $HOME 92 | GHCUP_INSTALL_BASE_PREFIX=$HOME ./ghcup install cabal 3.10.3.0 --set 93 | GHCUP_INSTALL_BASE_PREFIX=$HOME ./ghcup install ghc ${{matrix.ghc }} --set 94 | 95 | - name: Update 96 | shell: alpine.sh {0} 97 | run: | 98 | export PATH=$HOME/.ghcup/bin:$PATH 99 | cabal update 100 | 101 | - name: Build 102 | shell: alpine.sh {0} 103 | run: | 104 | export PATH=$HOME/.ghcup/bin:$PATH 105 | cabal build all --enable-tests 106 | 107 | - name: Test 108 | shell: alpine.sh {0} 109 | run: | 110 | export PATH=$HOME/.ghcup/bin:$PATH 111 | cabal test all --enable-tests --test-show-details=direct 112 | -------------------------------------------------------------------------------- /hashable-bench/hashable-bench.cabal: -------------------------------------------------------------------------------- 1 | cabal-version: 1.12 2 | name: hashable-bench 3 | version: 0 4 | synopsis: hashable benchmarks 5 | description: hashable benchmarks. 6 | homepage: http://github.com/haskell-unordered-containers/hashable 7 | 8 | -- SPDX-License-Identifier : BSD-3-Clause 9 | license: BSD3 10 | license-file: LICENSE 11 | author: 12 | Milan Straka 13 | Johan Tibell 14 | 15 | maintainer: Oleg Grenrus 16 | bug-reports: 17 | https://github.com/haskell-unordered-containers/hashable/issues 18 | 19 | stability: Provisional 20 | category: Data 21 | build-type: Simple 22 | tested-with: 23 | GHC ==9.6.5 24 | || ==9.8.2 25 | || ==9.10.1 26 | 27 | extra-source-files: 28 | include/HsHashable.h 29 | include/HsXXHash.h 30 | xxHash-0.8.3/xxhash.h 31 | 32 | library 33 | exposed-modules: 34 | Data.Hashable 35 | Data.Hashable.Generic 36 | Data.Hashable.Lifted 37 | 38 | other-modules: 39 | Data.Hashable.Class 40 | Data.Hashable.FFI 41 | Data.Hashable.Generic.Instances 42 | Data.Hashable.Imports 43 | Data.Hashable.LowLevel 44 | Data.Hashable.Mix 45 | Data.Hashable.XXH3 46 | 47 | include-dirs: include xxHash-0.8.3/ 48 | includes: 49 | HsHashable.h 50 | HsXXHash.h 51 | xxhash.h 52 | 53 | hs-source-dirs: src 54 | build-depends: 55 | base >=4.10.1.0 && <4.21 56 | , bytestring >=0.10.8.2 && <0.13 57 | , containers >=0.5.10.2 && <0.8 58 | , deepseq >=1.4.3.0 && <1.6 59 | , ghc-prim 60 | , text >=1.2.3.0 && <1.3 || >=2.0 && <2.2 61 | 62 | -- depend on os-string on newer GHCs only. 63 | -- os-string has tight lower bound on bytestring, which prevents 64 | -- using bundled version on older GHCs. 65 | build-depends: os-string >=2.0.2 66 | 67 | -- we also ensure that we can get filepath-1.5 only with GHC-9.2 68 | -- therefore there is else-branch with stricter upper bound. 69 | build-depends: filepath >=1.4.200.1 && <1.6 70 | 71 | -- Integer internals 72 | build-depends: ghc-bignum >=1.3 && <1.4 73 | 74 | default-language: Haskell2010 75 | other-extensions: 76 | BangPatterns 77 | CPP 78 | DeriveDataTypeable 79 | FlexibleContexts 80 | FlexibleInstances 81 | GADTs 82 | KindSignatures 83 | MagicHash 84 | MultiParamTypeClasses 85 | ScopedTypeVariables 86 | Trustworthy 87 | TypeOperators 88 | UnliftedFFITypes 89 | 90 | ghc-options: -Wall -fwarn-tabs 91 | ghc-options: -optc=-march=native -optc-mtune=native 92 | 93 | benchmark hashable-benchmark 94 | -- We cannot depend on the hashable library directly as that creates 95 | -- a dependency cycle. 96 | hs-source-dirs: benchmarks 97 | main-is: Benchmarks.hs 98 | type: exitcode-stdio-1.0 99 | build-depends: 100 | base 101 | , bytestring 102 | , criterion >=1.0 103 | , ghc-prim 104 | , hashable-bench 105 | , siphash 106 | , text 107 | 108 | if impl(ghc) 109 | build-depends: 110 | ghc-prim 111 | , text >=0.11.0.5 112 | 113 | ghc-options: -Wall 114 | default-language: Haskell2010 115 | 116 | source-repository head 117 | type: git 118 | location: 119 | https://github.com/haskell-unordered-containers/hashable.git 120 | -------------------------------------------------------------------------------- /src/Data/Hashable/LowLevel.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE CPP, BangPatterns, MagicHash, CApiFFI, UnliftedFFITypes #-} 2 | {-# LANGUAGE Trustworthy #-} 3 | -- | A module containing low-level hash primitives. 4 | module Data.Hashable.LowLevel ( 5 | Salt, 6 | defaultSalt, 7 | hashInt, 8 | hashInt64, 9 | hashWord64, 10 | hashPtrWithSalt, 11 | hashByteArrayWithSalt, 12 | ) where 13 | 14 | #include "MachDeps.h" 15 | 16 | import Data.Array.Byte (ByteArray (..)) 17 | import Foreign.Ptr (Ptr, castPtr) 18 | import GHC.Base (ByteArray#) 19 | 20 | #ifdef HASHABLE_RANDOM_SEED 21 | import System.IO.Unsafe (unsafePerformIO) 22 | #endif 23 | 24 | import Data.Hashable.Imports 25 | import Data.Hashable.Mix 26 | import Data.Hashable.XXH3 27 | 28 | ------------------------------------------------------------------------------- 29 | -- Initial seed 30 | ------------------------------------------------------------------------------- 31 | 32 | #ifdef HASHABLE_RANDOM_SEED 33 | initialSeed :: Word64 34 | initialSeed = unsafePerformIO initialSeedC 35 | {-# NOINLINE initialSeed #-} 36 | 37 | foreign import capi "HsHashable.h hs_hashable_init" initialSeedC :: IO Word64 38 | #endif 39 | 40 | -- | A default salt used in the implementation of 'hash'. 41 | defaultSalt :: Salt 42 | #ifdef HASHABLE_RANDOM_SEED 43 | defaultSalt = hashInt defaultSalt' (fromIntegral initialSeed) 44 | #else 45 | defaultSalt = defaultSalt' 46 | #endif 47 | {-# INLINE defaultSalt #-} 48 | 49 | defaultSalt' :: Salt 50 | #if WORD_SIZE_IN_BITS == 64 51 | defaultSalt' = -3750763034362895579 -- 14695981039346656037 :: Int64 52 | #else 53 | defaultSalt' = -2128831035 -- 2166136261 :: Int32 54 | #endif 55 | {-# INLINE defaultSalt' #-} 56 | 57 | ------------------------------------------------------------------------------- 58 | -- Hash primitives 59 | ------------------------------------------------------------------------------- 60 | 61 | -- | Hash 'Int'. First argument is a salt, second argument is an 'Int'. 62 | -- The result is new salt / hash value. 63 | hashInt :: Salt -> Int -> Salt 64 | hashInt !s !x = fromIntegral (mixHash (fromIntegral s) (fromIntegral x)) 65 | 66 | hashInt64 :: Salt -> Int64 -> Salt 67 | hashWord64 :: Salt -> Word64 -> Salt 68 | 69 | #if WORD_SIZE_IN_BITS == 64 70 | hashInt64 !s !x = hashInt s (fromIntegral x) 71 | hashWord64 !s !x = hashInt s (fromIntegral x) 72 | #else 73 | hashInt64 !s !x = hashInt (hashInt s (fromIntegral x)) (fromIntegral (x `unsafeShiftR` 32)) 74 | hashWord64 !s !x = hashInt (hashInt s (fromIntegral x)) (fromIntegral (x `unsafeShiftR` 32)) 75 | #endif 76 | 77 | -- | Compute a hash value for the content of this pointer, using an 78 | -- initial salt. 79 | -- 80 | -- This function can for example be used to hash non-contiguous 81 | -- segments of memory as if they were one contiguous segment, by using 82 | -- the output of one hash as the salt for the next. 83 | hashPtrWithSalt :: Ptr a -- ^ pointer to the data to hash 84 | -> Int -- ^ length, in bytes 85 | -> Salt -- ^ salt 86 | -> IO Salt -- ^ hash value 87 | hashPtrWithSalt ptr len salt = 88 | fromIntegral `fmap` xxh3_64bit_withSeed_ptr (castPtr ptr) len (fromIntegral salt) 89 | 90 | -- | Compute a hash value for the content of this 'ByteArray#', using 91 | -- an initial salt. 92 | -- 93 | -- This function can for example be used to hash non-contiguous 94 | -- segments of memory as if they were one contiguous segment, by using 95 | -- the output of one hash as the salt for the next. 96 | hashByteArrayWithSalt 97 | :: ByteArray# -- ^ data to hash 98 | -> Int -- ^ offset, in bytes 99 | -> Int -- ^ length, in bytes 100 | -> Salt -- ^ salt 101 | -> Salt -- ^ hash value 102 | hashByteArrayWithSalt ba !off !len !salt = 103 | fromIntegral (xxh3_64bit_withSeed_ba (ByteArray ba) off len (fromIntegral salt)) 104 | -------------------------------------------------------------------------------- /src/Data/Hashable/Lifted.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE Safe #-} 2 | 3 | ------------------------------------------------------------------------ 4 | -- | 5 | -- Module : Data.Hashable.Lifted 6 | -- Copyright : (c) Milan Straka 2010 7 | -- (c) Johan Tibell 2011 8 | -- (c) Bryan O'Sullivan 2011, 2012 9 | -- SPDX-License-Identifier : BSD-3-Clause 10 | -- Maintainer : johan.tibell@gmail.com 11 | -- Stability : provisional 12 | -- Portability : portable 13 | -- 14 | -- Lifting of the 'Hashable' class to unary and binary type constructors. 15 | -- These classes are needed to express the constraints on arguments of 16 | -- types that are parameterized by type constructors. Fixed-point data 17 | -- types and monad transformers are such types. 18 | 19 | module Data.Hashable.Lifted 20 | ( -- * Type Classes 21 | Hashable1(..) 22 | , Hashable2(..) 23 | -- * Auxiliary Functions 24 | , hashWithSalt1 25 | , hashWithSalt2 26 | , defaultLiftHashWithSalt 27 | -- * Motivation 28 | -- $motivation 29 | ) where 30 | 31 | import Data.Hashable.Class 32 | 33 | -- $motivation 34 | -- 35 | -- This type classes provided in this module are used to express constraints 36 | -- on type constructors in a Haskell98-compatible fashion. As an example, consider 37 | -- the following two types (Note that these instances are not actually provided 38 | -- because @hashable@ does not have @transformers@ or @free@ as a dependency): 39 | -- 40 | -- > newtype WriterT w m a = WriterT { runWriterT :: m (a, w) } 41 | -- > data Free f a = Pure a | Free (f (Free f a)) 42 | -- 43 | -- The 'Hashable1' instances for @WriterT@ and @Free@ could be written as: 44 | -- 45 | -- > instance (Hashable w, Hashable1 m) => Hashable1 (WriterT w m) where 46 | -- > liftHashWithSalt h s (WriterT m) = 47 | -- > liftHashWithSalt (liftHashWithSalt2 h hashWithSalt) s m 48 | -- > instance Hashable1 f => Hashable1 (Free f) where 49 | -- > liftHashWithSalt h = go where 50 | -- > go s x = case x of 51 | -- > Pure a -> h s a 52 | -- > Free p -> liftHashWithSalt go s p 53 | -- 54 | -- The 'Hashable' instances for these types can be trivially recovered with 55 | -- 'hashWithSalt1': 56 | -- 57 | -- > instance (Hashable w, Hashable1 m, Hashable a) => Hashable (WriterT w m a) where 58 | -- > hashWithSalt = hashWithSalt1 59 | -- > instance (Hashable1 f, Hashable a) => Hashable (Free f a) where 60 | -- > hashWithSalt = hashWithSalt1 61 | 62 | -- 63 | -- $discussion 64 | -- 65 | -- Regardless of whether 'hashWithSalt1' is used to provide an implementation 66 | -- of 'hashWithSalt', they should produce the same hash when called with 67 | -- the same arguments. This is the only law that 'Hashable1' and 'Hashable2' 68 | -- are expected to follow. 69 | -- 70 | -- The typeclasses in this module only provide lifting for 'hashWithSalt', not 71 | -- for 'hash'. This is because such liftings cannot be defined in a way that 72 | -- would satisfy the @liftHash@ variant of the above law. As an illustration 73 | -- of the problem we run into, let us assume that 'Hashable1' were 74 | -- given a 'liftHash' method: 75 | -- 76 | -- > class Hashable1 t where 77 | -- > liftHash :: (a -> Int) -> t a -> Int 78 | -- > liftHashWithSalt :: (Int -> a -> Int) -> Int -> t a -> Int 79 | -- 80 | -- Even for a type as simple as 'Maybe', the problem manifests itself. The 81 | -- 'Hashable' instance for 'Maybe' is: 82 | -- 83 | -- > distinguisher :: Int 84 | -- > distinguisher = ... 85 | -- > 86 | -- > instance Hashable a => Hashable (Maybe a) where 87 | -- > hash Nothing = 0 88 | -- > hash (Just a) = distinguisher `hashWithSalt` a 89 | -- > hashWithSalt s Nothing = ... 90 | -- > hashWithSalt s (Just a) = ... 91 | -- 92 | -- The implementation of 'hash' calls 'hashWithSalt' on @a@. The hypothetical 93 | -- @liftHash@ defined earlier only accepts an argument that corresponds to 94 | -- the implementation of 'hash' for @a@. Consequently, this formulation of 95 | -- @liftHash@ would not provide a way to match the current behavior of 'hash' 96 | -- for 'Maybe'. This problem gets worse when 'Either' and @[]@ are considered. 97 | -- The solution adopted in this library is to omit @liftHash@ entirely. 98 | 99 | -------------------------------------------------------------------------------- /tests/Regress.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE CPP #-} 2 | {-# LANGUAGE DeriveGeneric #-} 3 | {-# LANGUAGE OverloadedStrings #-} 4 | 5 | module Regress (regressions) where 6 | 7 | import Test.Tasty (TestTree, testGroup) 8 | import Control.Monad (when) 9 | import Test.Tasty.HUnit (testCase, Assertion, assertFailure, (@?=)) 10 | import Test.Tasty.QuickCheck (testProperty) 11 | import GHC.Generics (Generic) 12 | import Data.List (nub) 13 | import Data.Fixed (Pico) 14 | import Data.Text (Text) 15 | import Data.ByteString (ByteString) 16 | 17 | import qualified Data.Text.Lazy as TL 18 | import qualified Data.ByteString.Char8 as BS8 19 | import qualified Data.ByteString.Lazy as BSL 20 | import qualified Data.ByteString.Lazy.Char8 as BSL8 21 | 22 | #ifdef HAVE_MMAP 23 | import qualified Regress.Mmap as Mmap 24 | #endif 25 | 26 | import Data.Hashable 27 | 28 | #include "MachDeps.h" 29 | 30 | assertInequal :: Eq a => String -> a -> a -> Assertion 31 | assertInequal msg x y 32 | | x == y = assertFailure msg 33 | | otherwise = return () 34 | 35 | regressions :: [TestTree] 36 | regressions = [] ++ 37 | #ifdef HAVE_MMAP 38 | Mmap.regressions ++ 39 | [ testCase "Fixed" $ do 40 | (hash (1 :: Pico) == hash (2 :: Pico)) @?= False 41 | ] ++ 42 | #endif 43 | [ testGroup "Generic: sum of nullary constructors" 44 | [ testCase "0" $ nullaryCase 0 S0 45 | , testCase "1" $ nullaryCase 1 S1 46 | , testCase "2" $ nullaryCase 2 S2 47 | , testCase "3" $ nullaryCase 3 S3 48 | , testCase "4" $ nullaryCase 4 S4 49 | ] 50 | 51 | , testCase "Zero tuples: issue 271" $ do 52 | assertInequal "Hash of (0,0) != 0" (hash (0 :: Int, 0 :: Int)) 0 53 | assertInequal "Hash of (0,0,0) != 0" (hash (0 :: Int, 0 :: Int, 0 :: Int)) 0 54 | 55 | , testProperty "odd, odd: issue 271" $ \x' y' -> 56 | let x = if odd x' then x' else x' + 1 :: Int 57 | y = if odd y' then y' else y' + 1 :: Int 58 | in hash (x, y) /= hash (negate x, negate y) 59 | 60 | , testCase "Generic: Peano https://github.com/tibbe/hashable/issues/135" $ do 61 | let ns = take 20 $ iterate S Z 62 | let hs = map hash ns 63 | hs @?= nub hs 64 | #if WORD_SIZE_IN_BITS == 64 65 | , testCase "64 bit Text" $ do 66 | let expected = 67 | #if MIN_VERSION_text(2,0,0) 68 | -3150353794653054837 69 | #else 70 | 660667291861873677 71 | #endif 72 | hash ("hello world" :: Text) @?= expected 73 | #endif 74 | , testGroup "concatenation" 75 | [ testCase "String" $ do 76 | let lhs, rhs :: (String, String) 77 | lhs = ("foo", "bar") 78 | rhs = ("foobar", "") 79 | 80 | when (hash lhs == hash rhs) $ do 81 | assertFailure "Should have different hashes" 82 | 83 | , testCase "Text" $ do 84 | let lhs, rhs :: (Text, Text) 85 | lhs = ("foo", "bar") 86 | rhs = ("foobar", "") 87 | 88 | when (hash lhs == hash rhs) $ do 89 | assertFailure "Should have different hashes" 90 | 91 | , testCase "Lazy Text" $ do 92 | let lhs, rhs :: (TL.Text, TL.Text) 93 | lhs = ("foo", "bar") 94 | rhs = ("foobar", "") 95 | 96 | when (hash lhs == hash rhs) $ do 97 | assertFailure "Should have different hashes" 98 | 99 | , testCase "ByteString" $ do 100 | let lhs, rhs :: (ByteString, ByteString) 101 | lhs = (BS8.pack "foo", BS8.pack "bar") 102 | rhs = (BS8.pack "foobar", BS8.empty) 103 | 104 | when (hash lhs == hash rhs) $ do 105 | assertFailure "Should have different hashes" 106 | 107 | , testCase "Lazy ByteString" $ do 108 | let lhs, rhs :: (BSL.ByteString, BSL.ByteString) 109 | lhs = (BSL8.pack "foo", BSL8.pack "bar") 110 | rhs = (BSL8.pack "foobar", BSL.empty) 111 | 112 | when (hash lhs == hash rhs) $ do 113 | assertFailure "Should have different hashes" 114 | ] 115 | ] 116 | where 117 | nullaryCase :: Int -> SumOfNullary -> IO () 118 | nullaryCase n s = do 119 | let salt = 42 120 | let expected = salt `hashWithSalt` n `hashWithSalt` () 121 | let actual = hashWithSalt salt s 122 | actual @?= expected 123 | 124 | data SumOfNullary = S0 | S1 | S2 | S3 | S4 deriving (Eq, Generic) 125 | instance Hashable SumOfNullary 126 | 127 | data Nat = Z | S Nat deriving (Eq, Generic) 128 | instance Hashable Nat 129 | -------------------------------------------------------------------------------- /src/Data/Hashable/Generic/Instances.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE BangPatterns, FlexibleInstances, KindSignatures, 2 | ScopedTypeVariables, TypeOperators, 3 | MultiParamTypeClasses, GADTs, FlexibleContexts #-} 4 | {-# OPTIONS_GHC -fno-warn-orphans #-} 5 | {-# LANGUAGE Trustworthy #-} 6 | 7 | ------------------------------------------------------------------------ 8 | -- | 9 | -- Module : Data.Hashable.Generic.Instances 10 | -- Copyright : (c) Bryan O'Sullivan 2012 11 | -- SPDX-License-Identifier : BSD-3-Clause 12 | -- Maintainer : bos@serpentine.com 13 | -- Stability : provisional 14 | -- Portability : GHC >= 7.4 15 | -- 16 | -- Internal module defining orphan instances for "GHC.Generics" 17 | -- 18 | module Data.Hashable.Generic.Instances () where 19 | 20 | import Data.Hashable.Class 21 | import GHC.Generics 22 | import Data.Kind (Type) 23 | 24 | 25 | -- Type without constructors 26 | instance GHashable arity V1 where 27 | ghashWithSalt _ salt _ = hashWithSalt salt () 28 | 29 | -- Constructor without arguments 30 | instance GHashable arity U1 where 31 | ghashWithSalt _ salt U1 = hashWithSalt salt () 32 | 33 | instance (GHashable arity a, GHashable arity b) => GHashable arity (a :*: b) where 34 | ghashWithSalt toHash salt (x :*: y) = 35 | (ghashWithSalt toHash (ghashWithSalt toHash salt x) y) 36 | 37 | -- Metadata (constructor name, etc) 38 | instance GHashable arity a => GHashable arity (M1 i c a) where 39 | ghashWithSalt targs salt = ghashWithSalt targs salt . unM1 40 | 41 | -- Constants, additional parameters, and rank-1 recursion 42 | instance Hashable a => GHashable arity (K1 i a) where 43 | ghashWithSalt _ = hashUsing unK1 44 | 45 | instance GHashable One Par1 where 46 | ghashWithSalt (HashArgs1 h) salt = h salt . unPar1 47 | 48 | instance Hashable1 f => GHashable One (Rec1 f) where 49 | ghashWithSalt (HashArgs1 h) salt = liftHashWithSalt h salt . unRec1 50 | 51 | instance (Hashable1 f, GHashable One g) => GHashable One (f :.: g) where 52 | ghashWithSalt targs salt = liftHashWithSalt (ghashWithSalt targs) salt . unComp1 53 | 54 | class SumSize f => GSum arity f where 55 | hashSum :: HashArgs arity a -> Int -> Int -> f a -> Int 56 | -- hashSum args salt index value = ... 57 | 58 | -- [Note: Hashing a sum type] 59 | -- 60 | -- The tree structure is used in GHC.Generics to represent the sum (and 61 | -- product) part of the generic representation of the type, e.g.: 62 | -- 63 | -- (C0 ... :+: C1 ...) :+: (C2 ... :+: (C3 ... :+: C4 ...)) 64 | -- 65 | -- The value constructed with C2 constructor is represented as (R1 (L1 ...)). 66 | -- Yet, if we think that this tree is a flat (heterogeneous) list: 67 | -- 68 | -- [C0 ..., C1 ..., C2 ..., C3 ..., C4... ] 69 | -- 70 | -- then the value constructed with C2 is a (dependent) pair (2, ...), and 71 | -- hashing it is simple: 72 | -- 73 | -- salt `hashWithSalt` (2 :: Int) `hashWithSalt` ... 74 | -- 75 | -- This is what we do below. When drilling down the tree, we count how many 76 | -- leafs are to the left (`index` variable). At the leaf case C1, we'll have an 77 | -- actual index into the sum. 78 | -- 79 | -- This works well for balanced data. However for recursive types like: 80 | -- 81 | -- data Nat = Z | S Nat 82 | -- 83 | -- the `hashWithSalt salt (S (S (S Z)))` is 84 | -- 85 | -- salt `hashWithSalt` (1 :: Int) -- first S 86 | -- `hashWithSalt` (1 :: Int) -- second S 87 | -- `hashWithSalt` (1 :: Int) -- third S 88 | -- `hashWithSalt` (0 :: Int) -- Z 89 | -- `hashWithSalt` () -- U1 90 | -- 91 | -- For that type the manual implementation: 92 | -- 93 | -- instance Hashable Nat where 94 | -- hashWithSalt salt n = hashWithSalt salt (natToInteger n) 95 | -- 96 | -- would be better performing CPU and hash-quality wise (assuming that 97 | -- Integer's Hashable is of high quality). 98 | -- 99 | instance (GSum arity a, GSum arity b) => GHashable arity (a :+: b) where 100 | ghashWithSalt toHash salt = hashSum toHash salt 0 101 | 102 | instance (GSum arity a, GSum arity b) => GSum arity (a :+: b) where 103 | hashSum toHash !salt !index s = case s of 104 | L1 x -> hashSum toHash salt index x 105 | R1 x -> hashSum toHash salt (index + sizeL) x 106 | where 107 | sizeL = unTagged (sumSize :: Tagged a) 108 | {-# INLINE hashSum #-} 109 | 110 | instance GHashable arity a => GSum arity (C1 c a) where 111 | hashSum toHash !salt !index (M1 x) = ghashWithSalt toHash (hashWithSalt salt index) x 112 | {-# INLINE hashSum #-} 113 | 114 | class SumSize f where 115 | sumSize :: Tagged f 116 | 117 | newtype Tagged (s :: Type -> Type) = Tagged {unTagged :: Int} 118 | 119 | instance (SumSize a, SumSize b) => SumSize (a :+: b) where 120 | sumSize = Tagged $ unTagged (sumSize :: Tagged a) + 121 | unTagged (sumSize :: Tagged b) 122 | 123 | instance SumSize (C1 c a) where 124 | sumSize = Tagged 1 125 | -------------------------------------------------------------------------------- /src/Data/Hashable/XXH3.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE BangPatterns #-} 2 | {-# LANGUAGE CPP #-} 3 | {-# LANGUAGE MagicHash #-} 4 | {-# LANGUAGE PatternSynonyms #-} 5 | {-# LANGUAGE ScopedTypeVariables #-} 6 | {-# LANGUAGE Trustworthy #-} 7 | {-# LANGUAGE UnboxedTuples #-} 8 | module Data.Hashable.XXH3 ( 9 | -- * One shot 10 | xxh3_64bit_withSeed_ptr, 11 | xxh3_64bit_withSeed_bs, 12 | xxh3_64bit_withSeed_ba, 13 | xxh3_64bit_withSeed_w64, 14 | xxh3_64bit_withSeed_w32, 15 | -- * Incremental 16 | XXH3_State, 17 | xxh3_64bit_createState, 18 | xxh3_64bit_reset_withSeed, 19 | xxh3_64bit_digest, 20 | xxh3_64bit_update_bs, 21 | xxh3_64bit_update_ba, 22 | xxh3_64bit_update_w64, 23 | xxh3_64bit_update_w32, 24 | ) where 25 | 26 | import Control.Monad.ST.Unsafe (unsafeIOToST) 27 | import Data.Array.Byte (ByteArray (..), MutableByteArray (..)) 28 | import Data.ByteString.Internal (ByteString (..), accursedUnutterablePerformIO) 29 | import Data.Word (Word32, Word64, Word8) 30 | import Foreign (Ptr) 31 | import GHC.Exts (Int (..), MutableByteArray#, newAlignedPinnedByteArray#) 32 | import GHC.ForeignPtr (unsafeWithForeignPtr) 33 | import GHC.ST (ST (..)) 34 | 35 | import Data.Hashable.FFI 36 | 37 | ------------------------------------------------------------------------------- 38 | -- OneShot 39 | ------------------------------------------------------------------------------- 40 | 41 | -- | Hash 'Ptr' 42 | xxh3_64bit_withSeed_ptr :: Ptr Word8 -> Int -> Word64 -> IO Word64 43 | xxh3_64bit_withSeed_ptr !ptr !len !salt = 44 | unsafe_xxh3_64bit_withSeed_ptr ptr (fromIntegral len) salt 45 | 46 | -- | Hash 'ByteString'. 47 | xxh3_64bit_withSeed_bs :: ByteString -> Word64 -> Word64 48 | xxh3_64bit_withSeed_bs (BS fptr len) !salt = accursedUnutterablePerformIO $ 49 | unsafeWithForeignPtr fptr $ \ptr -> 50 | unsafe_xxh3_64bit_withSeed_ptr ptr (fromIntegral len) salt 51 | 52 | -- | Hash (part of) 'ByteArray'. 53 | xxh3_64bit_withSeed_ba :: ByteArray -> Int -> Int -> Word64 -> Word64 54 | xxh3_64bit_withSeed_ba (ByteArray ba) !off !len !salt = 55 | unsafe_xxh3_64bit_withSeed_ba ba (fromIntegral off) (fromIntegral len) salt 56 | 57 | -- | Hash 'Word64'. 58 | xxh3_64bit_withSeed_w64 :: Word64 -> Word64 -> Word64 59 | xxh3_64bit_withSeed_w64 !x !salt = 60 | unsafe_xxh3_64bit_withSeed_u64 x salt 61 | 62 | -- | Hash 'Word32'. 63 | xxh3_64bit_withSeed_w32 :: Word32 -> Word64 -> Word64 64 | xxh3_64bit_withSeed_w32 !x !salt = 65 | unsafe_xxh3_64bit_withSeed_u32 x salt 66 | 67 | ------------------------------------------------------------------------------- 68 | -- Incremental 69 | ------------------------------------------------------------------------------- 70 | 71 | -- | Mutable XXH3 state. 72 | data XXH3_State s = XXH3 (MutableByteArray# s) 73 | 74 | -- | Create 'XXH3_State'. 75 | xxh3_64bit_createState :: forall s. ST s (XXH3_State s) 76 | xxh3_64bit_createState = do 77 | -- aligned alloc, otherwise we get segfaults. 78 | -- see XXH3_createState implementation 79 | MutableByteArray ba <- newAlignedPinnedByteArray unsafe_xxh3_sizeof_state 64 80 | unsafeIOToST (unsafe_xxh3_initState ba) 81 | return (XXH3 ba) 82 | 83 | -- | Reset 'XXH3_State' with a seed. 84 | xxh3_64bit_reset_withSeed :: XXH3_State s -> Word64 -> ST s () 85 | xxh3_64bit_reset_withSeed (XXH3 s) seed = do 86 | unsafeIOToST (unsafe_xxh3_64bit_reset_withSeed s seed) 87 | 88 | -- | Return a hash value from a 'XXH3_State'. 89 | -- 90 | -- Doesn't mutate given state, so you can update, digest and update again. 91 | xxh3_64bit_digest :: XXH3_State s -> ST s Word64 92 | xxh3_64bit_digest (XXH3 s) = 93 | unsafeIOToST (unsafe_xxh3_64bit_digest s) 94 | 95 | -- | Update 'XXH3_State' with 'ByteString'. 96 | xxh3_64bit_update_bs :: XXH3_State s -> ByteString -> ST s () 97 | xxh3_64bit_update_bs (XXH3 s) (BS fptr len) = unsafeIOToST $ 98 | unsafeWithForeignPtr fptr $ \ptr -> 99 | unsafe_xxh3_64bit_update_ptr s ptr (fromIntegral len) 100 | 101 | -- | Update 'XXH3_State' with (part of) 'ByteArray' 102 | xxh3_64bit_update_ba :: XXH3_State s -> ByteArray -> Int -> Int -> ST s () 103 | xxh3_64bit_update_ba (XXH3 s) (ByteArray ba) !off !len = unsafeIOToST $ 104 | unsafe_xxh3_64bit_update_ba s ba (fromIntegral off) (fromIntegral len) 105 | 106 | -- | Update 'XXH3_State' with 'Word64'. 107 | xxh3_64bit_update_w64 :: XXH3_State s -> Word64 -> ST s () 108 | xxh3_64bit_update_w64 (XXH3 s) w64 = unsafeIOToST $ 109 | unsafe_xxh3_64bit_update_u64 s w64 110 | 111 | -- | Update 'XXH3_State' with 'Word32'. 112 | xxh3_64bit_update_w32 :: XXH3_State s -> Word32 -> ST s () 113 | xxh3_64bit_update_w32 (XXH3 s) w32 = unsafeIOToST $ 114 | unsafe_xxh3_64bit_update_u32 s w32 115 | 116 | ------------------------------------------------------------------------------- 117 | -- mini-primitive 118 | ------------------------------------------------------------------------------- 119 | 120 | newAlignedPinnedByteArray 121 | :: Int -- ^ size 122 | -> Int -- ^ alignment 123 | -> ST s (MutableByteArray s) 124 | {-# INLINE newAlignedPinnedByteArray #-} 125 | newAlignedPinnedByteArray (I# n) (I# k) = 126 | ST (\s -> case newAlignedPinnedByteArray# n k s of (# s', arr #) -> (# s', MutableByteArray arr #)) 127 | -------------------------------------------------------------------------------- /hashable.cabal: -------------------------------------------------------------------------------- 1 | cabal-version: 2.2 2 | name: hashable 3 | version: 1.5.1.0 4 | synopsis: A class for types that can be converted to a hash value 5 | description: 6 | This package defines a class, 'Hashable', for types that can be converted to a hash value. 7 | This class exists for the benefit of hashing-based data structures. 8 | The package provides instances for basic types and a way to combine hash values. 9 | . 10 | 'Hashable' is intended exclusively for use in in-memory data structures. 11 | . 12 | 'Hashable' does /not/ have a fixed standard. 13 | This allows it to improve over time. 14 | . 15 | Because it does not have a fixed standard, different computers or computers on different versions of the code will observe different hash values. 16 | As such, 'hashable' is not recommended for use other than in-memory datastructures. 17 | Specifically, 'hashable' is not intended for network use or in applications which persist hashed values. 18 | For stable hashing use named hashes: sha256, crc32, xxhash etc. 19 | 20 | homepage: http://github.com/haskell-unordered-containers/hashable 21 | license: BSD-3-Clause 22 | license-file: LICENSE 23 | author: 24 | Milan Straka 25 | Johan Tibell 26 | 27 | maintainer: Oleg Grenrus 28 | bug-reports: 29 | https://github.com/haskell-unordered-containers/hashable/issues 30 | 31 | stability: Provisional 32 | category: Data 33 | build-type: Simple 34 | tested-with: 35 | GHC ==9.6.5 || ==9.8.2 || ==9.8.3 || ==9.10.1 || ==9.12.1 36 | 37 | extra-source-files: 38 | CHANGES.md 39 | include/HsHashable.h 40 | include/HsXXHash.h 41 | README.md 42 | xxHash-0.8.3/xxhash.h 43 | 44 | flag arch-native 45 | description: 46 | Use @-march=native@ when compiling C sources. 47 | Portable implementation is 15-50% slower. 48 | Consider enabling this flag if hashing performance is important. 49 | 50 | manual: True 51 | default: False 52 | 53 | flag random-initial-seed 54 | description: 55 | Randomly initialize the initial seed on each final executable invocation 56 | This is useful for catching cases when you rely on (non-existent) 57 | stability of hashable's hash functions. 58 | This is not a security feature. 59 | 60 | manual: True 61 | default: False 62 | 63 | library 64 | exposed-modules: 65 | Data.Hashable 66 | Data.Hashable.Generic 67 | Data.Hashable.Lifted 68 | 69 | other-modules: 70 | Data.Hashable.Class 71 | Data.Hashable.FFI 72 | Data.Hashable.Generic.Instances 73 | Data.Hashable.Imports 74 | Data.Hashable.LowLevel 75 | Data.Hashable.Mix 76 | Data.Hashable.XXH3 77 | 78 | include-dirs: include xxHash-0.8.3 79 | includes: 80 | HsHashable.h 81 | HsXXHash.h 82 | xxhash.h 83 | 84 | hs-source-dirs: src 85 | build-depends: 86 | , base >=4.18.0.0 && <4.22 87 | , bytestring >=0.11.5.3 && <0.13 88 | , containers >=0.6.7 && <0.8 89 | , deepseq >=1.4.8.1 && <1.6 90 | , ghc-prim 91 | , text >=2.0.2 && <2.2 92 | 93 | -- depend on os-string on newer GHCs only. 94 | -- os-string has tight lower bound on bytestring, which prevents 95 | -- using bundled version on older GHCs. 96 | build-depends: os-string >=2.0.2 && <2.1 97 | 98 | -- we also ensure that we can get filepath-1.5 only with GHC-9.2 99 | -- therefore there is else-branch with stricter upper bound. 100 | build-depends: filepath >=1.4.200.1 && <1.6 101 | 102 | -- Integer internals 103 | build-depends: ghc-bignum >=1.3 && <1.4 104 | 105 | if (flag(random-initial-seed) && impl(ghc)) 106 | cpp-options: -DHASHABLE_RANDOM_SEED=1 107 | 108 | if os(windows) 109 | c-sources: cbits-win/init.c 110 | 111 | else 112 | c-sources: cbits-unix/init.c 113 | 114 | default-language: Haskell2010 115 | other-extensions: 116 | BangPatterns 117 | CPP 118 | DeriveDataTypeable 119 | FlexibleContexts 120 | FlexibleInstances 121 | GADTs 122 | KindSignatures 123 | MagicHash 124 | MultiParamTypeClasses 125 | QuantifiedConstraints 126 | ScopedTypeVariables 127 | Trustworthy 128 | TypeOperators 129 | UnliftedFFITypes 130 | 131 | ghc-options: -Wall 132 | 133 | if flag(arch-native) 134 | -- Cabal doesn't pass cc-options to "ordinary" Haskell source compilation 135 | -- https://github.com/haskell/cabal/issues/9801 136 | ghc-options: -optc=-march=native -optc-mtune=native 137 | 138 | if impl(ghc >=9.0) 139 | -- these flags may abort compilation with GHC-8.10 140 | -- https://gitlab.haskell.org/ghc/ghc/-/merge_requests/3295 141 | ghc-options: -Winferred-safe-imports -Wmissing-safe-haskell-mode 142 | 143 | test-suite hashable-tests 144 | type: exitcode-stdio-1.0 145 | hs-source-dirs: tests 146 | main-is: Main.hs 147 | other-modules: 148 | Properties 149 | Regress 150 | 151 | build-depends: 152 | , base 153 | , bytestring 154 | , filepath 155 | , ghc-prim 156 | , hashable 157 | , HUnit 158 | , QuickCheck >=2.15 159 | , random >=1.0 && <1.3 160 | , tasty ^>=1.5 161 | , tasty-hunit ^>=0.10.1 162 | , tasty-quickcheck ^>=0.10.3 || ^>=0.11 163 | , text >=0.11.0.5 164 | 165 | if impl(ghc >=9.2) 166 | build-depends: os-string 167 | 168 | if !os(windows) 169 | build-depends: unix 170 | cpp-options: -DHAVE_MMAP 171 | other-modules: Regress.Mmap 172 | other-extensions: CApiFFI 173 | 174 | ghc-options: -Wall -fno-warn-orphans 175 | default-language: Haskell2010 176 | 177 | test-suite xxhash-tests 178 | type: exitcode-stdio-1.0 179 | hs-source-dirs: tests src 180 | main-is: xxhash-tests.hs 181 | other-modules: 182 | Data.Hashable.FFI 183 | Data.Hashable.XXH3 184 | 185 | default-language: Haskell2010 186 | build-depends: 187 | , base <5 188 | , bytestring 189 | , primitive ^>=0.9.0.0 190 | , tasty ^>=1.5 191 | , tasty-hunit ^>=0.10.1 192 | , tasty-quickcheck ^>=0.10.3 || ^>=0.11 193 | 194 | include-dirs: include xxHash-0.8.3 195 | includes: 196 | HsXXHash.h 197 | xxhash.h 198 | 199 | if !impl(ghc >=9.4) 200 | build-depends: data-array-byte >=0.1.0.1 && <0.2 201 | 202 | test-suite hashable-examples 203 | type: exitcode-stdio-1.0 204 | build-depends: 205 | , base 206 | , ghc-prim 207 | , hashable 208 | 209 | hs-source-dirs: examples 210 | main-is: Main.hs 211 | default-language: Haskell2010 212 | 213 | source-repository head 214 | type: git 215 | location: 216 | https://github.com/haskell-unordered-containers/hashable.git 217 | -------------------------------------------------------------------------------- /src/Data/Hashable.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE DeriveDataTypeable #-} 2 | {-# LANGUAGE Safe #-} 3 | 4 | ------------------------------------------------------------------------ 5 | -- | 6 | -- Module : Data.Hashable 7 | -- Copyright : (c) Milan Straka 2010 8 | -- (c) Johan Tibell 2011 9 | -- (c) Bryan O'Sullivan 2011, 2012 10 | -- SPDX-License-Identifier : BSD-3-Clause 11 | -- Maintainer : johan.tibell@gmail.com 12 | -- Stability : provisional 13 | -- Portability : portable 14 | -- 15 | -- This module defines a class, 'Hashable', for types that can be 16 | -- converted to a hash value. This class exists for the benefit of 17 | -- hashing-based data structures. The module provides instances for 18 | -- most standard types. Efficient instances for other types can be 19 | -- generated automatically and effortlessly using the generics support 20 | -- in GHC 7.4 and above. 21 | -- 22 | -- The easiest way to get started is to use the 'hash' function. Here 23 | -- is an example session with @ghci@. 24 | -- 25 | -- > ghci> import Data.Hashable 26 | -- > ghci> hash "foo" 27 | -- > 60853164 28 | 29 | module Data.Hashable 30 | ( 31 | -- * Hashing and security 32 | -- $security 33 | 34 | -- * Computing hash values 35 | Hashable(..) 36 | 37 | -- * Creating new instances 38 | -- | There are two ways to create new instances: by deriving 39 | -- instances automatically using GHC's generic programming 40 | -- support or by writing instances manually. 41 | 42 | -- ** Generic instances 43 | -- $generics 44 | 45 | -- *** Understanding a compiler error 46 | -- $generic_err 47 | 48 | -- ** Writing instances by hand 49 | -- $blocks 50 | 51 | -- *** Hashing contructors with multiple fields 52 | -- $multiple-fields 53 | 54 | -- *** Hashing types with multiple constructors 55 | -- $multiple-ctors 56 | 57 | , hashUsing 58 | , hashPtr 59 | , hashPtrWithSalt 60 | , hashByteArray 61 | , hashByteArrayWithSalt 62 | 63 | , defaultHashWithSalt 64 | , defaultHash 65 | 66 | -- * Caching hashes 67 | , Hashed 68 | , hashed 69 | , hashedHash 70 | , unhashed 71 | , mapHashed 72 | , traverseHashed 73 | ) where 74 | 75 | import Data.Hashable.Class 76 | import Data.Hashable.Generic () 77 | 78 | -- $security 79 | -- #security# 80 | -- 81 | -- Applications that use hash-based data structures to store input 82 | -- from untrusted users can be susceptible to \"hash DoS\", a class of 83 | -- denial-of-service attack that uses deliberately chosen colliding 84 | -- inputs to force an application into unexpectedly behaving with 85 | -- quadratic time complexity. 86 | -- 87 | -- At this time, the string hashing functions used in this library are 88 | -- susceptible to such attacks and users are recommended to either use 89 | -- a 'Data.Map' to store keys derived from untrusted input or to use a 90 | -- hash function (e.g. SipHash) that's resistant to such attacks. A 91 | -- future version of this library might ship with such hash functions. 92 | 93 | -- $generics 94 | -- 95 | -- The recommended way to make instances of 96 | -- 'Hashable' for most types is to use the compiler's support for 97 | -- automatically generating default instances using "GHC.Generics". 98 | -- 99 | -- > {-# LANGUAGE DeriveGeneric #-} 100 | -- > 101 | -- > import GHC.Generics (Generic) 102 | -- > import Data.Hashable 103 | -- > 104 | -- > data Foo a = Foo a String 105 | -- > deriving (Eq, Generic) 106 | -- > 107 | -- > instance Hashable a => Hashable (Foo a) 108 | -- > 109 | -- > data Colour = Red | Green | Blue 110 | -- > deriving Generic 111 | -- > 112 | -- > instance Hashable Colour 113 | -- 114 | -- If you omit a body for the instance declaration, GHC will generate 115 | -- a default instance that correctly and efficiently hashes every 116 | -- constructor and parameter. 117 | -- 118 | -- The default implementations are provided by 119 | -- 'genericHashWithSalt' and 'genericLiftHashWithSalt'; those together with 120 | -- the generic type class 'GHashable' and auxiliary functions are exported 121 | -- from the "Data.Hashable.Generic" module. 122 | 123 | -- $generic_err 124 | -- 125 | -- Suppose you intend to use the generic machinery to automatically 126 | -- generate a 'Hashable' instance. 127 | -- 128 | -- > data Oops = Oops 129 | -- > -- forgot to add "deriving Generic" here! 130 | -- > 131 | -- > instance Hashable Oops 132 | -- 133 | -- And imagine that, as in the example above, you forget to add a 134 | -- \"@deriving 'Generic'@\" clause to your data type. At compile time, 135 | -- you will get an error message from GHC that begins roughly as 136 | -- follows: 137 | -- 138 | -- > No instance for (GHashable (Rep Oops)) 139 | -- 140 | -- This error can be confusing, as 'GHashable' is not exported (it is 141 | -- an internal typeclass used by this library's generics machinery). 142 | -- The correct fix is simply to add the missing \"@deriving 143 | -- 'Generic'@\". 144 | 145 | -- $blocks 146 | -- 147 | -- To maintain high quality hashes, new 'Hashable' instances should be 148 | -- built using existing 'Hashable' instances, combinators, and hash 149 | -- functions. 150 | -- 151 | -- The functions below can be used when creating new instances of 152 | -- 'Hashable'. For example, for many string-like types the 153 | -- 'hashWithSalt' method can be defined in terms of either 154 | -- 'hashPtrWithSalt' or 'hashByteArrayWithSalt'. Here's how you could 155 | -- implement an instance for the 'B.ByteString' data type, from the 156 | -- @bytestring@ package: 157 | -- 158 | -- > import qualified Data.ByteString as B 159 | -- > import qualified Data.ByteString.Internal as B 160 | -- > import qualified Data.ByteString.Unsafe as B 161 | -- > import Data.Hashable 162 | -- > import Foreign.Ptr (castPtr) 163 | -- > 164 | -- > instance Hashable B.ByteString where 165 | -- > hashWithSalt salt bs = B.inlinePerformIO $ 166 | -- > B.unsafeUseAsCStringLen bs $ \(p, len) -> 167 | -- > hashPtrWithSalt p (fromIntegral len) salt 168 | 169 | -- $multiple-fields 170 | -- 171 | -- Hash constructors with multiple fields by chaining 'hashWithSalt': 172 | -- 173 | -- > data Date = Date Int Int Int 174 | -- > 175 | -- > instance Hashable Date where 176 | -- > hashWithSalt s (Date yr mo dy) = 177 | -- > s `hashWithSalt` 178 | -- > yr `hashWithSalt` 179 | -- > mo `hashWithSalt` dy 180 | -- 181 | -- If you need to chain hashes together, use 'hashWithSalt' and follow 182 | -- this recipe: 183 | -- 184 | -- > combineTwo h1 h2 = h1 `hashWithSalt` h2 185 | 186 | -- $multiple-ctors 187 | -- 188 | -- For a type with several value constructors, there are a few 189 | -- possible approaches to writing a 'Hashable' instance. 190 | -- 191 | -- If the type is an instance of 'Enum', the easiest path is to 192 | -- convert it to an 'Int', and use the existing 'Hashable' instance 193 | -- for 'Int'. 194 | -- 195 | -- > data Color = Red | Green | Blue 196 | -- > deriving Enum 197 | -- > 198 | -- > instance Hashable Color where 199 | -- > hashWithSalt = hashUsing fromEnum 200 | -- 201 | -- If the type's constructors accept parameters, it is important to 202 | -- distinguish the constructors. To distinguish the constructors, add 203 | -- a different integer to the hash computation of each constructor: 204 | -- 205 | -- > data Time = Days Int 206 | -- > | Weeks Int 207 | -- > | Months Int 208 | -- > 209 | -- > instance Hashable Time where 210 | -- > hashWithSalt s (Days n) = s `hashWithSalt` 211 | -- > (0::Int) `hashWithSalt` n 212 | -- > hashWithSalt s (Weeks n) = s `hashWithSalt` 213 | -- > (1::Int) `hashWithSalt` n 214 | -- > hashWithSalt s (Months n) = s `hashWithSalt` 215 | -- > (2::Int) `hashWithSalt` n 216 | -------------------------------------------------------------------------------- /hashable-bench/benchmarks/Benchmarks.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE BangPatterns, CPP, ForeignFunctionInterface, MagicHash, 2 | UnboxedTuples, DeriveGeneric #-} 3 | 4 | module Main (main) where 5 | 6 | import Control.Monad.ST 7 | import Criterion.Main 8 | import Data.Hashable 9 | import Data.Int 10 | import Foreign.ForeignPtr 11 | import GHC.Exts 12 | import GHC.ST (ST(..)) 13 | import Data.ByteString.Internal 14 | import GHC.Generics (Generic) 15 | import qualified Data.ByteString.Lazy as BL 16 | import qualified Data.Text as T 17 | import qualified Data.Text.Lazy as TL 18 | import qualified Crypto.MAC.SipHash as HS 19 | import qualified Data.ByteString.Char8 as B8 20 | 21 | -- Benchmark English words (5 and 8), base64 encoded integers (11), 22 | -- SHA1 hashes as hex (40), and large blobs (1 Mb). 23 | main :: IO () 24 | main = do 25 | -- We do not actually care about the contents of these pointers. 26 | fp5 <- mallocForeignPtrBytes 5 27 | fp8 <- mallocForeignPtrBytes 8 28 | fp11 <- mallocForeignPtrBytes 11 29 | fp40 <- mallocForeignPtrBytes 40 30 | fp128 <- mallocForeignPtrBytes 128 31 | fp512 <- mallocForeignPtrBytes 512 32 | let !mb = 2^(20 :: Int) -- 1 Mb 33 | fp1Mb <- mallocForeignPtrBytes mb 34 | 35 | let exP = P 22.0203 234.19 'x' 6424 36 | exS = S3 37 | exPS = PS3 'z' 7715 38 | 39 | -- We don't care about the contents of these either. 40 | let !ba5 = new 5; !ba8 = new 8; !ba11 = new 11; !ba40 = new 40 41 | !ba128 = new 128; !ba512 = new 512; !ba1Mb = new mb 42 | 43 | s5 = ['\0'..'\4']; s8 = ['\0'..'\7']; s11 = ['\0'..'\10'] 44 | s40 = ['\0'..'\39']; s128 = ['\0'..'\127']; s512 = ['\0'..'\511'] 45 | s1Mb = ['\0'..'\999999'] 46 | 47 | !bs5 = B8.pack s5; !bs8 = B8.pack s8; !bs11 = B8.pack s11 48 | !bs40 = B8.pack s40; !bs128 = B8.pack s128; !bs512 = B8.pack s512 49 | !bs1Mb = B8.pack s1Mb 50 | 51 | blmeg = BL.take (fromIntegral mb) . BL.fromChunks . repeat 52 | bl5 = BL.fromChunks [bs5]; bl8 = BL.fromChunks [bs8] 53 | bl11 = BL.fromChunks [bs11]; bl40 = BL.fromChunks [bs40] 54 | bl128 = BL.fromChunks [bs128]; bl512 = BL.fromChunks [bs512] 55 | bl1Mb_40 = blmeg bs40; bl1Mb_128 = blmeg bs128 56 | bl1Mb_64k = blmeg (B8.take 65536 bs1Mb) 57 | 58 | !t5 = T.pack s5; !t8 = T.pack s8; !t11 = T.pack s11 59 | !t40 = T.pack s40; !t128 = T.pack s128; !t512 = T.pack s512 60 | !t1Mb = T.pack s1Mb 61 | 62 | tlmeg = TL.take (fromIntegral mb) . TL.fromChunks . repeat 63 | tl5 = TL.fromStrict t5; tl8 = TL.fromStrict t8 64 | tl11 = TL.fromStrict t11; tl40 = TL.fromStrict t40 65 | tl128 = TL.fromStrict t128; tl512 = TL.fromChunks (replicate 4 t128) 66 | tl1Mb_40 = tlmeg t40; tl1Mb_128 = tlmeg t128 67 | tl1Mb_64k = tlmeg (T.take 65536 t1Mb) 68 | 69 | let k0 = 0x4a7330fae70f52e8 70 | k1 = 0x919ea5953a9a1ec9 71 | 72 | hsSipHash :: ByteString -> HS.SipHash 73 | hsSipHash = HS.hash (HS.SipKey k0 k1) 74 | 75 | withForeignPtr fp5 $ \ p5 -> 76 | withForeignPtr fp8 $ \ p8 -> 77 | withForeignPtr fp11 $ \ p11 -> 78 | withForeignPtr fp40 $ \ p40 -> 79 | withForeignPtr fp128 $ \ p128 -> 80 | withForeignPtr fp512 $ \ p512 -> 81 | withForeignPtr fp1Mb $ \ p1Mb -> 82 | defaultMain 83 | [ bgroup "hashPtr" 84 | [ bench "5" $ whnfIO $ hashPtr p5 5 85 | , bench "8" $ whnfIO $ hashPtr p8 8 86 | , bench "11" $ whnfIO $ hashPtr p11 11 87 | , bench "40" $ whnfIO $ hashPtr p40 40 88 | , bench "128" $ whnfIO $ hashPtr p128 128 89 | , bench "512" $ whnfIO $ hashPtr p512 512 90 | , bench "2^20" $ whnfIO $ hashPtr p1Mb mb 91 | ] 92 | , bgroup "hashByteArray" 93 | [ bench "5" $ whnf (hashByteArray ba5 0) 5 94 | , bench "8" $ whnf (hashByteArray ba8 0) 8 95 | , bench "11" $ whnf (hashByteArray ba11 0) 11 96 | , bench "40" $ whnf (hashByteArray ba40 0) 40 97 | , bench "128" $ whnf (hashByteArray ba128 0) 128 98 | , bench "512" $ whnf (hashByteArray ba512 0) 512 99 | , bench "2^20" $ whnf (hashByteArray ba1Mb 0) mb 100 | ] 101 | , bgroup "hash" 102 | [ bgroup "ByteString" 103 | [ bgroup "strict" 104 | [ bench "5" $ whnf hash bs5 105 | , bench "8" $ whnf hash bs8 106 | , bench "11" $ whnf hash bs11 107 | , bench "40" $ whnf hash bs40 108 | , bench "128" $ whnf hash bs128 109 | , bench "512" $ whnf hash bs512 110 | , bench "2^20" $ whnf hash bs1Mb 111 | ] 112 | , bgroup "lazy" 113 | [ bench "5" $ whnf hash bl5 114 | , bench "8" $ whnf hash bl8 115 | , bench "11" $ whnf hash bl11 116 | , bench "40" $ whnf hash bl40 117 | , bench "128" $ whnf hash bl128 118 | , bench "512" $ whnf hash bl512 119 | , bench "2^20_40" $ whnf hash bl1Mb_40 120 | , bench "2^20_128" $ whnf hash bl1Mb_128 121 | , bench "2^20_64k" $ whnf hash bl1Mb_64k 122 | ] 123 | ] 124 | , bgroup "String" 125 | [ bench "5" $ whnf hash s5 126 | , bench "8" $ whnf hash s8 127 | , bench "11" $ whnf hash s11 128 | , bench "40" $ whnf hash s40 129 | , bench "128" $ whnf hash s128 130 | , bench "512" $ whnf hash s512 131 | , bench "2^20" $ whnf hash s1Mb 132 | ] 133 | , bgroup "Text" 134 | [ bgroup "strict" 135 | [ bench "5" $ whnf hash t5 136 | , bench "8" $ whnf hash t8 137 | , bench "11" $ whnf hash t11 138 | , bench "40" $ whnf hash t40 139 | , bench "128" $ whnf hash t128 140 | , bench "512" $ whnf hash t512 141 | , bench "2^20" $ whnf hash t1Mb 142 | ] 143 | , bgroup "lazy" 144 | [ bench "5" $ whnf hash tl5 145 | , bench "8" $ whnf hash tl8 146 | , bench "11" $ whnf hash tl11 147 | , bench "40" $ whnf hash tl40 148 | , bench "128" $ whnf hash tl128 149 | , bench "512" $ whnf hash tl512 150 | , bench "2^20_40" $ whnf hash tl1Mb_40 151 | , bench "2^20_128" $ whnf hash tl1Mb_128 152 | , bench "2^20_64k" $ whnf hash tl1Mb_64k 153 | ] 154 | ] 155 | , bench "Int8" $ whnf hash (0xef :: Int8) 156 | , bench "Int16" $ whnf hash (0x7eef :: Int16) 157 | , bench "Int32" $ whnf hash (0x7eadbeef :: Int32) 158 | , bench "Int" $ whnf hash (0x7eadbeefdeadbeef :: Int) 159 | , bench "Int64" $ whnf hash (0x7eadbeefdeadbeef :: Int64) 160 | , bench "Double" $ whnf hash (0.3780675796601578 :: Double) 161 | ] 162 | , bgroup "pkgSipHash" 163 | [ bench "5" $ whnf hsSipHash bs5 164 | , bench "8" $ whnf hsSipHash bs8 165 | , bench "11" $ whnf hsSipHash bs11 166 | , bench "40" $ whnf hsSipHash bs40 167 | , bench "128" $ whnf hsSipHash bs128 168 | , bench "512" $ whnf hsSipHash bs512 169 | , bench "2^20" $ whnf hsSipHash bs1Mb 170 | ] 171 | , bgroup "Int" 172 | [ bench "id32" $ whnf id (0x7eadbeef :: Int32) 173 | , bench "id64" $ whnf id (0x7eadbeefdeadbeef :: Int64) 174 | ] 175 | , bgroup "Generic" 176 | [ bench "product" $ whnf hash exP 177 | , bench "sum" $ whnf hash exS 178 | , bench "product and sum" $ whnf hash exPS 179 | ] 180 | ] 181 | 182 | data ByteArray = BA { unBA :: !ByteArray# } 183 | 184 | new :: Int -> ByteArray# 185 | new (I# n#) = unBA (runST $ ST $ \s1 -> 186 | case newByteArray# n# s1 of 187 | (# s2, ary #) -> case unsafeFreezeByteArray# ary s2 of 188 | (# s3, ba #) -> (# s3, BA ba #)) 189 | 190 | data PS 191 | = PS1 Int Char Bool 192 | | PS2 String () 193 | | PS3 Char Int 194 | deriving (Eq, Generic) 195 | 196 | data P = P Double Float Char Int 197 | deriving (Eq, Generic) 198 | 199 | data S = S1 | S2 | S3 | S4 | S5 200 | deriving (Eq, Generic) 201 | 202 | instance Hashable PS 203 | instance Hashable P 204 | instance Hashable S 205 | -------------------------------------------------------------------------------- /.github/workflows/haskell-ci-bench.yml: -------------------------------------------------------------------------------- 1 | # This GitHub workflow config has been generated by a script via 2 | # 3 | # haskell-ci 'github' '--project' 'cabal.bench.project' '-o' '.github/workflows/haskell-ci-bench.yml' '--github-action-name' 'Benchmarks' 4 | # 5 | # To regenerate the script (for example after adjusting tested-with) run 6 | # 7 | # haskell-ci regenerate 8 | # 9 | # For more information, see https://github.com/haskell-CI/haskell-ci 10 | # 11 | # version: 0.19.20241109 12 | # 13 | # REGENDATA ("0.19.20241109",["github","--project","cabal.bench.project","-o",".github/workflows/haskell-ci-bench.yml","--github-action-name","Benchmarks"]) 14 | # 15 | name: Benchmarks 16 | on: 17 | push: 18 | branches: 19 | - master 20 | pull_request: 21 | branches: 22 | - master 23 | jobs: 24 | linux: 25 | name: Benchmarks - Linux - ${{ matrix.compiler }} 26 | runs-on: ubuntu-20.04 27 | timeout-minutes: 28 | 60 29 | container: 30 | image: buildpack-deps:jammy 31 | continue-on-error: ${{ matrix.allow-failure }} 32 | strategy: 33 | matrix: 34 | include: 35 | - compiler: ghc-9.10.1 36 | compilerKind: ghc 37 | compilerVersion: 9.10.1 38 | setup-method: ghcup 39 | allow-failure: false 40 | - compiler: ghc-9.8.2 41 | compilerKind: ghc 42 | compilerVersion: 9.8.2 43 | setup-method: ghcup 44 | allow-failure: false 45 | - compiler: ghc-9.6.5 46 | compilerKind: ghc 47 | compilerVersion: 9.6.5 48 | setup-method: ghcup 49 | allow-failure: false 50 | fail-fast: false 51 | steps: 52 | - name: apt 53 | run: | 54 | apt-get update 55 | apt-get install -y --no-install-recommends gnupg ca-certificates dirmngr curl git software-properties-common libtinfo5 56 | mkdir -p "$HOME/.ghcup/bin" 57 | curl -sL https://downloads.haskell.org/ghcup/0.1.30.0/x86_64-linux-ghcup-0.1.30.0 > "$HOME/.ghcup/bin/ghcup" 58 | chmod a+x "$HOME/.ghcup/bin/ghcup" 59 | "$HOME/.ghcup/bin/ghcup" config add-release-channel https://raw.githubusercontent.com/haskell/ghcup-metadata/master/ghcup-prereleases-0.0.8.yaml; 60 | "$HOME/.ghcup/bin/ghcup" install ghc "$HCVER" || (cat "$HOME"/.ghcup/logs/*.* && false) 61 | "$HOME/.ghcup/bin/ghcup" install cabal 3.12.1.0 || (cat "$HOME"/.ghcup/logs/*.* && false) 62 | env: 63 | HCKIND: ${{ matrix.compilerKind }} 64 | HCNAME: ${{ matrix.compiler }} 65 | HCVER: ${{ matrix.compilerVersion }} 66 | - name: Set PATH and environment variables 67 | run: | 68 | echo "$HOME/.cabal/bin" >> $GITHUB_PATH 69 | echo "LANG=C.UTF-8" >> "$GITHUB_ENV" 70 | echo "CABAL_DIR=$HOME/.cabal" >> "$GITHUB_ENV" 71 | echo "CABAL_CONFIG=$HOME/.cabal/config" >> "$GITHUB_ENV" 72 | HCDIR=/opt/$HCKIND/$HCVER 73 | HC=$("$HOME/.ghcup/bin/ghcup" whereis ghc "$HCVER") 74 | HCPKG=$(echo "$HC" | sed 's#ghc$#ghc-pkg#') 75 | HADDOCK=$(echo "$HC" | sed 's#ghc$#haddock#') 76 | echo "HC=$HC" >> "$GITHUB_ENV" 77 | echo "HCPKG=$HCPKG" >> "$GITHUB_ENV" 78 | echo "HADDOCK=$HADDOCK" >> "$GITHUB_ENV" 79 | echo "CABAL=$HOME/.ghcup/bin/cabal-3.12.1.0 -vnormal+nowrap" >> "$GITHUB_ENV" 80 | HCNUMVER=$(${HC} --numeric-version|perl -ne '/^(\d+)\.(\d+)\.(\d+)(\.(\d+))?$/; print(10000 * $1 + 100 * $2 + ($3 == 0 ? $5 != 1 : $3))') 81 | echo "HCNUMVER=$HCNUMVER" >> "$GITHUB_ENV" 82 | echo "ARG_TESTS=--enable-tests" >> "$GITHUB_ENV" 83 | echo "ARG_BENCH=--disable-benchmarks" >> "$GITHUB_ENV" 84 | echo "HEADHACKAGE=false" >> "$GITHUB_ENV" 85 | echo "ARG_COMPILER=--$HCKIND --with-compiler=$HC" >> "$GITHUB_ENV" 86 | echo "GHCJSARITH=0" >> "$GITHUB_ENV" 87 | env: 88 | HCKIND: ${{ matrix.compilerKind }} 89 | HCNAME: ${{ matrix.compiler }} 90 | HCVER: ${{ matrix.compilerVersion }} 91 | - name: env 92 | run: | 93 | env 94 | - name: write cabal config 95 | run: | 96 | mkdir -p $CABAL_DIR 97 | cat >> $CABAL_CONFIG <> $CABAL_CONFIG < cabal-plan.xz 130 | echo 'f62ccb2971567a5f638f2005ad3173dba14693a45154c1508645c52289714cb2 cabal-plan.xz' | sha256sum -c - 131 | xz -d < cabal-plan.xz > $HOME/.cabal/bin/cabal-plan 132 | rm -f cabal-plan.xz 133 | chmod a+x $HOME/.cabal/bin/cabal-plan 134 | cabal-plan --version 135 | - name: checkout 136 | uses: actions/checkout@v4 137 | with: 138 | path: source 139 | - name: initial cabal.project for sdist 140 | run: | 141 | touch cabal.project 142 | echo "packages: $GITHUB_WORKSPACE/source/hashable-bench" >> cabal.project 143 | cat cabal.project 144 | - name: sdist 145 | run: | 146 | mkdir -p sdist 147 | $CABAL sdist all --output-dir $GITHUB_WORKSPACE/sdist 148 | - name: unpack 149 | run: | 150 | mkdir -p unpacked 151 | find sdist -maxdepth 1 -type f -name '*.tar.gz' -exec tar -C $GITHUB_WORKSPACE/unpacked -xzvf {} \; 152 | - name: generate cabal.project 153 | run: | 154 | PKGDIR_hashable_bench="$(find "$GITHUB_WORKSPACE/unpacked" -maxdepth 1 -type d -regex '.*/hashable-bench-[0-9.]*')" 155 | echo "PKGDIR_hashable_bench=${PKGDIR_hashable_bench}" >> "$GITHUB_ENV" 156 | rm -f cabal.project cabal.project.local 157 | touch cabal.project 158 | touch cabal.project.local 159 | echo "packages: ${PKGDIR_hashable_bench}" >> cabal.project 160 | echo "package hashable-bench" >> cabal.project 161 | echo " ghc-options: -Werror=missing-methods" >> cabal.project 162 | cat >> cabal.project <> cabal.project.local 165 | cat cabal.project 166 | cat cabal.project.local 167 | - name: dump install plan 168 | run: | 169 | $CABAL v2-build $ARG_COMPILER $ARG_TESTS $ARG_BENCH --dry-run all 170 | cabal-plan 171 | - name: restore cache 172 | uses: actions/cache/restore@v4 173 | with: 174 | key: ${{ runner.os }}-${{ matrix.compiler }}-${{ github.sha }} 175 | path: ~/.cabal/store 176 | restore-keys: ${{ runner.os }}-${{ matrix.compiler }}- 177 | - name: install dependencies 178 | run: | 179 | $CABAL v2-build $ARG_COMPILER --disable-tests --disable-benchmarks --dependencies-only -j2 all 180 | $CABAL v2-build $ARG_COMPILER $ARG_TESTS $ARG_BENCH --dependencies-only -j2 all 181 | - name: build w/o tests 182 | run: | 183 | $CABAL v2-build $ARG_COMPILER --disable-tests --disable-benchmarks all 184 | - name: build 185 | run: | 186 | $CABAL v2-build $ARG_COMPILER $ARG_TESTS $ARG_BENCH all --write-ghc-environment-files=always 187 | - name: cabal check 188 | run: | 189 | cd ${PKGDIR_hashable_bench} || false 190 | ${CABAL} -vnormal check 191 | - name: haddock 192 | run: | 193 | $CABAL v2-haddock --disable-documentation --haddock-all $ARG_COMPILER --with-haddock $HADDOCK $ARG_TESTS $ARG_BENCH all 194 | - name: unconstrained build 195 | run: | 196 | rm -f cabal.project.local 197 | $CABAL v2-build $ARG_COMPILER --disable-tests --disable-benchmarks all 198 | - name: prepare for constraint sets 199 | run: | 200 | rm -f cabal.project.local 201 | - name: constraint set filepath-1.5 202 | run: | 203 | $CABAL v2-build $ARG_COMPILER --enable-tests --disable-benchmarks --constraint='filepath ^>=1.5.2.0' all --dry-run 204 | cabal-plan topo | sort 205 | $CABAL v2-build $ARG_COMPILER --enable-tests --disable-benchmarks --constraint='filepath ^>=1.5.2.0' --dependencies-only -j2 all 206 | $CABAL v2-build $ARG_COMPILER --enable-tests --disable-benchmarks --constraint='filepath ^>=1.5.2.0' all 207 | - name: constraint set filepath-1.4.100.0 208 | run: | 209 | if [ $((HCNUMVER < 91000)) -ne 0 ] ; then $CABAL v2-build $ARG_COMPILER --enable-tests --disable-benchmarks --constraint='filepath ^>=1.4.100.0' all --dry-run ; fi 210 | if [ $((HCNUMVER < 91000)) -ne 0 ] ; then cabal-plan topo | sort ; fi 211 | if [ $((HCNUMVER < 91000)) -ne 0 ] ; then $CABAL v2-build $ARG_COMPILER --enable-tests --disable-benchmarks --constraint='filepath ^>=1.4.100.0' --dependencies-only -j2 all ; fi 212 | if [ $((HCNUMVER < 91000)) -ne 0 ] ; then $CABAL v2-build $ARG_COMPILER --enable-tests --disable-benchmarks --constraint='filepath ^>=1.4.100.0' all ; fi 213 | - name: constraint set random-initial-seed 214 | run: | 215 | $CABAL v2-build $ARG_COMPILER --disable-tests --disable-benchmarks --constraint='hashable +random-initial-seed' all --dry-run 216 | cabal-plan topo | sort 217 | $CABAL v2-build $ARG_COMPILER --disable-tests --disable-benchmarks --constraint='hashable +random-initial-seed' --dependencies-only -j2 all 218 | $CABAL v2-build $ARG_COMPILER --disable-tests --disable-benchmarks --constraint='hashable +random-initial-seed' all 219 | - name: save cache 220 | uses: actions/cache/save@v4 221 | if: always() 222 | with: 223 | key: ${{ runner.os }}-${{ matrix.compiler }}-${{ github.sha }} 224 | path: ~/.cabal/store 225 | -------------------------------------------------------------------------------- /CHANGES.md: -------------------------------------------------------------------------------- 1 | See also https://pvp.haskell.org/faq 2 | 3 | ## Version 1.5.1.0 4 | 5 | * Update xxHash to version 0.8.3 6 | 7 | ## Version 1.5.0.0 8 | 9 | * Add `QuantifiedConstraints` superclasses to `Hashable1/2`: 10 | 11 | ```haskell 12 | class (Eq1 t, forall a. Hashable a => Hashable (t a)) => Hashable1 t where 13 | class (Eq2 t, forall a. Hashable a => Hashable1 (t a)) => Hashable2 t where 14 | ``` 15 | 16 | * Change contexts of `Compose`, `Product` and `Sum` instances. 17 | This and above is the similar change as [CLC proposal #10](https://github.com/haskell/core-libraries-committee/issues/10) 18 | 19 | * The above changes require `base-4.18.0.0`, so we drop support for GHC prior GHC-9.6.5 20 | (The `hashable-1.4` branch will be maintained for time being for older GHC users). 21 | 22 | * Make `Arg a b` instance behave as `Hashable a` instance. 23 | 24 | ## Version 1.4.7.0 25 | 26 | * Make `arch-native` disabled by default. 27 | 28 | ## Version 1.4.6.0 29 | 30 | * Use GND&DerivingVia to derive `newtype` intances (`Data.Semigroup`, `Data.Monoid`, `Identity` etc). 31 | 32 | ## Version 1.4.5.0 33 | 34 | * Drop support for GHCs prior 8.6.5 35 | * Use xxhash for hashing bytestrings and bytearrays. 36 | Note: when compiling binaries for distribution, you may need to disable 37 | `arch-native` flag. 38 | 39 | ## Version 1.4.4.0 40 | 41 | * Depend on `os-string-2` for GHC-9.2+ 42 | * Support `filepath-1.5` 43 | 44 | ## Version 1.4.3.0 45 | 46 | * Export `defaultHashWithSalt` and `defaultHash`. 47 | * Fix issue of tuples with 0 first component causing all-zero state. 48 | * Change `hashInt` to mix bits more. 49 | 50 | ## Version 1.4.2.0 51 | 52 | * Fix the foreign signature of `getThreadId` 53 | https://github.com/haskell-unordered-containers/hashable/pull/263 54 | * Drop support for GHCs prior GHC-8.2 55 | The recent `unordered-containers` releases support only GHC-8.2+ 56 | * Add instance for `OsString`, `PosixString`, `WindowsString` from `filepath-1.4.100.1` 57 | * Add `Hashable ByteArray` instance using `data-array-byte` compat package 58 | 59 | ## Version 1.4.1.0 60 | 61 | * Add instance for `Data.Array.Byte.ByteArray`. 62 | 63 | ## Version 1.4.0.2 64 | 65 | * Restore older GHC support 66 | * Support GHC-9.0.2 67 | 68 | ## Version 1.4.0.1 69 | 70 | * `text-2.0` compatibility 71 | 72 | ## Version 1.4.0.0 73 | 74 | * `Eq` is now a superclass of `Hashable`. 75 | Also `Eq1` is a superclass of `Hashable1` and `Eq2` is a superclass of `Hashable2` 76 | when exists. 77 | 78 | * Remove `Hashable1 Fixed` instance 79 | * Remove `Hashable1 Semi.Min/Max/...` instances as they don't have `Eq1` instance. 80 | 81 | ## Version 1.3.5.0 82 | 83 | * Add `Solo` instance (base-4.15+, GHC-9+) 84 | 85 | ## Version 1.3.4.1 86 | 87 | * Fix compilation on 32 bit platforms 88 | * Fix `Tree` instance 89 | 90 | ## Version 1.3.4.0 91 | * `Text` and `ByteString` hashes include length. 92 | This fixes a variant of https://github.com/haskell-unordered-containers/hashable/issues/74 93 | for texts and bytestrings. 94 | https://github.com/haskell-unordered-containers/hashable/pull/223 95 | * Use correct prime in `combine`. 96 | This should improve the hash quality of compound structures on 64bit systems. 97 | https://github.com/haskell-unordered-containers/hashable/pull/224 98 | * Add instance for types in `containers` package 99 | https://github.com/haskell-unordered-containers/hashable/pull/226 100 | * Change `Int`, `Int64` and `Word64` `hashWithSalt` slightly. 101 | https://github.com/haskell-unordered-containers/hashable/pull/227 102 | 103 | ## Version 1.3.3.0 104 | 105 | * `Text` hashing uses 64-bit FNV prime 106 | * Don't truncate Text hashvalues on 64bit Windows: 107 | https://github.com/haskell-unordered-containers/hashable/pull/211 108 | 109 | ## Version 1.3.2.0 110 | 111 | * Add `Hashable (Fixed a)` for `base <4.7` versions. 112 | * Add documentation: 113 | - `hashable` is not a stable hash 114 | - `hashWithSalt` may return negative values 115 | - there is `time-compat` with `Hashable` instances for `time` types. 116 | * Add `random-initial-seed` flag causing the initial seed 117 | to be randomized on each start of an executable using `hashable`. 118 | 119 | ## Version 1.3.1.0 120 | 121 | * Add `Hashable1` instances to `semigroups` types. 122 | 123 | * Use `ghc-bignum` with GHC-9.0 124 | 125 | * Use FNV-1 constants. 126 | 127 | * Make `hashable-examples` a test-suite 128 | 129 | ## Version 1.3.0.0 130 | 131 | * Semantic change of `Hashable Arg` instance to *not* hash the second 132 | argument of `Arg` in order to be consistent with `Eq Arg` (#171) 133 | 134 | * Semantic change of `Hashable Float` and `Hashable Double` instances 135 | to hash `-0.0` and `0.0` to the same value (#173) 136 | 137 | * Add `Hashable` instance for `Fingerprint` (#156) 138 | 139 | * Add new `Data.Hashable.Generic` module providing the default 140 | implementations `genericHashWithSalt` and `genericLiftHashWithSalt` 141 | together with other Generics support helpers (#148, #178) 142 | 143 | * Bump minimum version requirement of `base` to `base-4.5` (i.e. GHC >= 7.4) 144 | 145 | ---- 146 | 147 | ## Version 1.2.7.0 148 | 149 | * Add `Hashable` and `Hashable1` instances for `Complex` 150 | 151 | * Fix undefined behavior in `hashable_fn_hash()` implementation 152 | due to signed integer overflow (#152) 153 | 154 | * Mark `Data.Hashable.Lifted` as `Trustworthy` (re SafeHaskell) 155 | 156 | * Support GHC 8.4 157 | 158 | ## Version 1.2.6.1 159 | 160 | * Use typeRepFingerprint from Type.Reflection.Unsafe 161 | 162 | * Bump minimum version of base to 4.4. 163 | 164 | ## Version 1.2.6.0 165 | 166 | * Add support for type-indexed `Typeable`. 167 | 168 | * Rework the `Generic` hashable for sums. 169 | 170 | ## Version 1.2.5.0 171 | 172 | * Add `Hashable1` and `Hashable2` 173 | 174 | * Add instances for: `Eq1`, `Ord1`, `Show1`, `Ptr`, `FunPtr`, `IntPtr`, `WordPtr` 175 | 176 | * Add `Hashed` type for caching the `hash` function result. 177 | 178 | ## Version 1.2.4.0 179 | 180 | * Add instances for: Unique, Version, Fixed, NonEmpty, Min, Max, Arg, 181 | First, Last, WrappedMonoid, Option 182 | 183 | * Support GHC 8.0 184 | 185 | ## Version 1.2.3.3 186 | 187 | * Support integer-simple. 188 | 189 | ## Version 1.2.3.2 190 | 191 | * Add support for GHC 7.10 typeRepFingerprint 192 | 193 | ## Version 1.2.3.1 194 | 195 | * Added support for random 1.1.*. 196 | 197 | ## Version 1.2.3.0 198 | 199 | * Silence integer literal overflow warning 200 | 201 | * Add support for GHC 7.10 `integer-gmp2` & `Natural` 202 | 203 | * Add instance for Data.Void 204 | 205 | * Make the SSE .cabal flags manual 206 | 207 | * Add an upper bound on bytestring 208 | 209 | ## Version 1.2.2.0 210 | 211 | * Add instances for `Data.ByteString.Short` 212 | 213 | * Use a 32-bit default salt on 32-bit archs. 214 | 215 | ## Version 1.2.1.0 216 | 217 | * Revert instances to their 1.1 implementations to regain the 218 | performance we had then. 219 | 220 | * Remove use of random salt altogether. Without using SipHash the 221 | benefit is unclear (i.e. collision attacks still work) and the 222 | complexity is no longer worth it. 223 | 224 | * Documentation improvements. 225 | 226 | ## Version 1.2.0.10 227 | 228 | * Fix for GHC 7.0. 229 | 230 | ## Version 1.2.0.9 231 | 232 | * Stop using SipHash. The current implementation still has segfault 233 | causing bugs that we won't be able to fix soon. 234 | 235 | * Stop using Wang hash. It degrades performance of fixed-size integer 236 | hashing too much. 237 | 238 | ## Version 1.2.0.8 239 | 240 | * Fix linking issue when SSE was disabled. 241 | 242 | * Hash small signed Integers correctly. 243 | 244 | ## Version 1.2.0.7 245 | 246 | * Add flags to control usage of SSE. 247 | 248 | ## Version 1.2.0.6 249 | 250 | * Fix another segfault caused by SSE2 code. 251 | 252 | ## Version 1.2.0.5 253 | 254 | * More portability fixes. 255 | 256 | * Force stack alignment to 16 bytes everywhere. Fixes a segfault. 257 | 258 | * Fix bug where code relied on rewrite rules firing for correctness. 259 | 260 | ## Version 1.2.0.4 261 | 262 | * Update docs to match code. 263 | 264 | * Work around bug in GHCi runtime linker, which never call static 265 | initializers. 266 | 267 | ## Version 1.2.0.3 268 | 269 | * Make building of SSE 4.1 code conditional, as it doesn't work on all 270 | platforms. 271 | 272 | * Use a fixed salt, but allow random salting. Random salting by 273 | default broke people's code. 274 | 275 | ## Version 1.2.0.2 276 | 277 | * Work around ghci linker bug on Windows. 278 | 279 | ## Version 1.2.0.1 280 | 281 | * Fix performance bug in SSE implementation of SipHash. 282 | 283 | * Fix segfault due to incorrect stack alignment on Windows. 284 | 285 | ## Version 1.2.0.0 286 | 287 | * Switch string hashing from FNV-1 to SipHash, in an effort to 288 | prevent collision attacks. 289 | 290 | * Switch fixed-size integer hashing to Wang hash. 291 | 292 | * The default salt now switched on every program run, in an effort to 293 | prevent collision attacks. 294 | 295 | * Move hash method out of Hashable type class. 296 | 297 | * Add support for generic instance deriving. 298 | 299 | * Add instance for Ordering. 300 | 301 | ---- 302 | 303 | ## Version 1.1.2.5 304 | 305 | * Bug fix for bytestring < 0.10.0. 306 | 307 | ## Version 1.1.2.4 308 | 309 | * Switch string hashing from Bernstein to FNV-1 310 | 311 | * Faster instance for Integer. 312 | 313 | * Update dependency on base, ghc-prim 314 | 315 | * Now works with GHC 7.6. 316 | 317 | ## Version 1.1.2.3 318 | 319 | * Add instance for TypeRep. 320 | 321 | * Update dependency on test-framework. 322 | 323 | ## Version 1.1.2.2 324 | 325 | * Bug fix for GHC 7.4 326 | 327 | ## Version 1.1.2.1 328 | 329 | * Update dependency on test-framework. 330 | 331 | * Improve documentation of combine. 332 | 333 | ## Version 1.1.2.0 334 | 335 | * Fix hash collision issues for lists and tuples when using a 336 | user-specified salt. 337 | 338 | * Add instances for `Integer`, `Ratio`, `Float`, `Double`, and `StableName`. 339 | 340 | * Improved instances for tuples and lists. 341 | 342 | ## Version 1.1.1.0 343 | 344 | * Add `hashWithSalt`, which allows the user to create different hash 345 | values for the same input by providing different seeds. This is 346 | useful for application like Cuckoo hashing which need a family of 347 | hash functions. 348 | 349 | * Fix a bug in the `Hashable` instance for `Int64`/`Word64` on 32-bit 350 | platforms. 351 | 352 | * Improved resilience to leading zero in the input being hashed. 353 | 354 | ## Version 1.1.0.0 355 | 356 | * Add instance for: strict and lazy Texts, ThreadId 357 | 358 | * Add hashPtrWithSalt and hashByteArrayWithSalt. 359 | 360 | * Faster ByteArray# hashing. 361 | 362 | * Fix a signedness bug that affected ByteString. 363 | 364 | * Fix ByteString hashing to work correctly on both 32 and 64-bit 365 | platforms. 366 | 367 | ## Version 1.0.1.1 368 | 369 | * Fix bug in Hashable instance for lazy ByteStrings where differences 370 | in the internal structure of the ByteString could cause different 371 | hash values for ByteStrings that are equal according to ==. 372 | 373 | ## Version 1.0.1.0 374 | 375 | * Add two helpers for creating Hashable instances: hashPtr and 376 | hashByteArray. 377 | 378 | ---- 379 | 380 | ## Version 1.0.0 381 | 382 | * Separate Hashable class to its own package from hashmap 1.0.0.3. 383 | -------------------------------------------------------------------------------- /tests/Properties.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE BangPatterns, CPP, GeneralizedNewtypeDeriving, MagicHash, 2 | Rank2Types, UnboxedTuples #-} 3 | {-# LANGUAGE DeriveGeneric, ScopedTypeVariables, PackageImports #-} 4 | 5 | -- | QuickCheck tests for the 'Data.Hashable' module. We test 6 | -- functions by comparing the C and Haskell implementations. 7 | 8 | module Properties (properties) where 9 | 10 | import Data.Hashable (Hashable, hash, hashByteArray, hashPtr, 11 | Hashed, hashed, unhashed, hashWithSalt) 12 | import Data.Hashable.Generic (genericHashWithSalt) 13 | import Data.Hashable.Lifted (hashWithSalt1) 14 | import qualified Data.ByteString as B 15 | import qualified Data.ByteString.Lazy as BL 16 | import qualified Data.Text as T 17 | import qualified Data.Text.Lazy as TL 18 | import Data.List (nub) 19 | import Control.Monad (ap, liftM) 20 | import System.IO.Unsafe (unsafePerformIO) 21 | import Foreign.Marshal.Array (withArray) 22 | import GHC.Base (ByteArray#, Int(..), newByteArray#, writeWord8Array#) 23 | import GHC.Exts (unsafeCoerce#) 24 | import GHC.ST (ST(..), runST) 25 | import GHC.Word (Word8(..)) 26 | import Test.QuickCheck hiding ((.&.)) 27 | import Test.Tasty (TestTree, testGroup) 28 | import Test.Tasty.QuickCheck (testProperty) 29 | import GHC.Generics 30 | 31 | import qualified Data.ByteString.Short as BS 32 | 33 | #if MIN_VERSION_filepath(1,4,100) && !(MIN_VERSION_filepath(1,5,0)) 34 | import qualified "filepath" System.OsString.Internal.Types as FP 35 | #endif 36 | 37 | #ifdef MIN_VERSION_os_string 38 | import qualified "os-string" System.OsString.Internal.Types as OS 39 | #endif 40 | 41 | ------------------------------------------------------------------------ 42 | -- * Properties 43 | 44 | instance Arbitrary T.Text where 45 | arbitrary = T.pack `fmap` arbitrary 46 | 47 | instance Arbitrary TL.Text where 48 | arbitrary = TL.pack `fmap` arbitrary 49 | 50 | instance Arbitrary B.ByteString where 51 | arbitrary = B.pack `fmap` arbitrary 52 | 53 | instance Arbitrary BL.ByteString where 54 | arbitrary = sized $ \n -> resize (round (sqrt (toEnum n :: Double))) 55 | ((BL.fromChunks . map (B.pack . nonEmpty)) `fmap` arbitrary) 56 | where nonEmpty (NonEmpty a) = a 57 | 58 | instance Arbitrary BS.ShortByteString where 59 | arbitrary = BS.pack `fmap` arbitrary 60 | 61 | -- | Validate the implementation by comparing the C and Haskell 62 | -- versions. 63 | pHash :: [Word8] -> Bool 64 | pHash xs = unsafePerformIO $ withArray xs $ \ p -> 65 | (hashByteArray (fromList xs) 0 len ==) `fmap` hashPtr p len 66 | where len = length xs 67 | 68 | -- | Content equality implies hash equality. 69 | pText :: T.Text -> T.Text -> Bool 70 | pText a b = if (a == b) then (hash a == hash b) else True 71 | 72 | -- | Content equality implies hash equality. 73 | pTextLazy :: TL.Text -> TL.Text -> Bool 74 | pTextLazy a b = if (a == b) then (hash a == hash b) else True 75 | 76 | -- | A small positive integer. 77 | newtype ChunkSize = ChunkSize { unCS :: Int } 78 | deriving (Eq, Ord, Num, Integral, Real, Enum) 79 | 80 | instance Show ChunkSize where show = show . unCS 81 | 82 | instance Arbitrary ChunkSize where 83 | arbitrary = (ChunkSize . (`mod` maxChunkSize)) `fmap` 84 | (arbitrary `suchThat` ((/=0) . (`mod` maxChunkSize))) 85 | where maxChunkSize = 16 86 | 87 | -- | Ensure that the rechunk function causes a rechunked string to 88 | -- still match its original form. 89 | pTextRechunk :: T.Text -> NonEmptyList ChunkSize -> Property 90 | pTextRechunk t cs = TL.fromStrict t === rechunkText t cs 91 | 92 | -- | Lazy strings must hash to the same value no matter how they are 93 | -- chunked. 94 | pTextLazyRechunked :: T.Text -> NonEmptyList ChunkSize -> NonEmptyList ChunkSize -> Property 95 | pTextLazyRechunked t cs0 cs1 = hash (rechunkText t cs0) === hash (rechunkText t cs1) 96 | 97 | pTextLazyRechunked' :: T.Text -> Int -> NonEmptyList ChunkSize -> NonEmptyList ChunkSize -> Property 98 | pTextLazyRechunked' t salt cs0 cs1 = hashWithSalt salt (rechunkText t cs0) === hashWithSalt salt (rechunkText t cs1) 99 | 100 | -- | Break up a string into chunks of different sizes. 101 | rechunkText :: T.Text -> NonEmptyList ChunkSize -> TL.Text 102 | rechunkText t0 (NonEmpty cs0) = TL.fromChunks . go t0 . cycle $ cs0 103 | where 104 | go t _ | T.null t = [] 105 | go t (c:cs) = a : go b cs 106 | where (a,b) = T.splitAt (unCS c) t 107 | go _ [] = error "Properties.rechunk - The 'impossible' happened!" 108 | 109 | -- | Content equality implies hash equality. 110 | pBSShort :: BS.ShortByteString -> BS.ShortByteString -> Bool 111 | pBSShort a b = if (a == b) then (hash a == hash b) else True 112 | 113 | -- | Content equality implies hash equality. 114 | pBS :: B.ByteString -> B.ByteString -> Bool 115 | pBS a b = if (a == b) then (hash a == hash b) else True 116 | 117 | -- | Content equality implies hash equality. 118 | pBSLazy :: BL.ByteString -> BL.ByteString -> Bool 119 | pBSLazy a b = if (a == b) then (hash a == hash b) else True 120 | 121 | -- | Break up a string into chunks of different sizes. 122 | rechunkBS :: B.ByteString -> NonEmptyList ChunkSize -> BL.ByteString 123 | rechunkBS t0 (NonEmpty cs0) = BL.fromChunks . go t0 . cycle $ cs0 124 | where 125 | go t _ | B.null t = [] 126 | go t (c:cs) = a : go b cs 127 | where (a,b) = B.splitAt (unCS c) t 128 | go _ [] = error "Properties.rechunkBS - The 'impossible' happened!" 129 | 130 | -- | Ensure that the rechunk function causes a rechunked string to 131 | -- still match its original form. 132 | pBSRechunk :: B.ByteString -> NonEmptyList ChunkSize -> Bool 133 | pBSRechunk t cs = fromStrict t == rechunkBS t cs 134 | 135 | -- | Lazy bytestrings must hash to the same value no matter how they 136 | -- are chunked. 137 | pBSLazyRechunked :: B.ByteString -> NonEmptyList ChunkSize -> NonEmptyList ChunkSize -> Property 138 | pBSLazyRechunked t cs1 cs2 = hash (rechunkBS t cs1) === hash (rechunkBS t cs2) 139 | 140 | pBSLazyRechunked' :: B.ByteString -> Int -> NonEmptyList ChunkSize -> NonEmptyList ChunkSize -> Property 141 | pBSLazyRechunked' t salt cs1 cs2 = hashWithSalt salt (rechunkBS t cs1) === hashWithSalt salt (rechunkBS t cs2) 142 | 143 | -- This wrapper is required by 'runST'. 144 | data ByteArray = BA { unBA :: ByteArray# } 145 | 146 | -- | Create a 'ByteArray#' from a list of 'Word8' values. 147 | fromList :: [Word8] -> ByteArray# 148 | fromList xs0 = unBA (runST $ ST $ \ s1# -> 149 | case newByteArray# len# s1# of 150 | (# s2#, marr# #) -> case go s2# 0 marr# xs0 of 151 | s3# -> (# s3#, BA (unsafeCoerce# marr#) #)) 152 | where 153 | !(I# len#) = length xs0 154 | go s# _ _ [] = s# 155 | go s# i@(I# i#) marr# ((W8# x):xs) = 156 | case writeWord8Array# marr# i# x s# of 157 | s2# -> go s2# (i + 1) marr# xs 158 | 159 | -- Generics 160 | 161 | data Product2 a b = Product2 a b 162 | deriving (Eq, Generic) 163 | 164 | instance (Arbitrary a, Arbitrary b) => Arbitrary (Product2 a b) where 165 | arbitrary = Product2 `liftM` arbitrary `ap` arbitrary 166 | 167 | instance (Hashable a, Hashable b) => Hashable (Product2 a b) 168 | 169 | data Product3 a b c = Product3 a b c 170 | deriving (Eq, Generic) 171 | 172 | instance (Arbitrary a, Arbitrary b, Arbitrary c) => 173 | Arbitrary (Product3 a b c) where 174 | arbitrary = Product3 `liftM` arbitrary `ap` arbitrary `ap` arbitrary 175 | 176 | instance (Hashable a, Hashable b, Hashable c) => Hashable (Product3 a b c) 177 | 178 | -- Hashes of all product types of the same shapes should be the same. 179 | 180 | pProduct2 :: Int -> String -> Bool 181 | pProduct2 x y = hash (x, y) == hash (Product2 x y) 182 | 183 | pProduct3 :: Double -> Maybe Bool -> (Int, String) -> Bool 184 | pProduct3 x y z = hash (x, y, z) == hash (Product3 x y z) 185 | 186 | data Sum2 a b = S2a a | S2b b 187 | deriving (Eq, Ord, Show, Generic) 188 | 189 | instance (Hashable a, Hashable b) => Hashable (Sum2 a b) 190 | 191 | data Sum3 a b c = S3a a | S3b b | S3c c 192 | deriving (Eq, Ord, Show, Generic) 193 | 194 | instance (Arbitrary a, Arbitrary b, Arbitrary c) => Arbitrary (Sum3 a b c) where 195 | arbitrary = oneof 196 | [ fmap S3a arbitrary 197 | , fmap S3b arbitrary 198 | , fmap S3c arbitrary 199 | ] 200 | 201 | instance (Hashable a, Hashable b, Hashable c) => Hashable (Sum3 a b c) 202 | 203 | -- Hashes of the same parameter, but with different sum constructors, 204 | -- should differ. (They might legitimately collide, but that's 205 | -- vanishingly unlikely.) 206 | 207 | pSum2_differ :: Int -> Bool 208 | pSum2_differ x = nub hs == hs 209 | where hs = [ hash (S2a x :: Sum2 Int Int) 210 | , hash (S2b x :: Sum2 Int Int) ] 211 | 212 | pSum3_differ :: Int -> Bool 213 | pSum3_differ x = nub hs == hs 214 | where hs = [ hash (S3a x :: Sum3 Int Int Int) 215 | , hash (S3b x :: Sum3 Int Int Int) 216 | , hash (S3c x :: Sum3 Int Int Int) ] 217 | 218 | pGeneric :: Sum3 Int Bool String -> Int -> Bool 219 | pGeneric x salt = hashWithSalt salt x == genericHashWithSalt salt x 220 | 221 | instance (Arbitrary a, Hashable a) => Arbitrary (Hashed a) where 222 | arbitrary = fmap hashed arbitrary 223 | shrink xs = map hashed $ shrink $ unhashed xs 224 | 225 | pLiftedHashed :: Int -> Hashed (Either Int String) -> Bool 226 | pLiftedHashed s h = hashWithSalt s h == hashWithSalt1 s h 227 | 228 | properties :: [TestTree] 229 | properties = 230 | [ testProperty "bernstein" pHash 231 | , testGroup "text" 232 | [ testProperty "text/strict" pText 233 | , testProperty "text/lazy" pTextLazy 234 | , testProperty "text/rechunk" pTextRechunk 235 | , testProperty "text/rechunked" pTextLazyRechunked 236 | , testProperty "text/rechunked-salt" pTextLazyRechunked' 237 | ] 238 | , testGroup "bytestring" 239 | [ testProperty "bytestring/strict" pBS 240 | , testProperty "bytestring/lazy" pBSLazy 241 | , testProperty "bytestring/short" pBSShort 242 | , testProperty "bytestring/rechunk" pBSRechunk 243 | , testProperty "bytestring/rechunked" pBSLazyRechunked 244 | , testProperty "bytestring/rechunked-salt" pBSLazyRechunked' 245 | ] 246 | , testGroup "generics" 247 | [ 248 | -- Note: "product2" and "product3" have been temporarily 249 | -- disabled until we have added a 'hash' method to the GHashable 250 | -- class. Until then (a,b) hashes to a different value than (a 251 | -- :*: b). While this is not incorrect, it would be nicer if 252 | -- they didn't. testProperty "product2" pProduct2 , testProperty 253 | -- "product3" pProduct3 254 | testProperty "sum2_differ" pSum2_differ 255 | , testProperty "sum3_differ" pSum3_differ 256 | , testProperty "genericHashWithSalt" pGeneric 257 | ] 258 | , testGroup "lifted law" 259 | [ testProperty "Hashed" pLiftedHashed 260 | ] 261 | ] 262 | 263 | ------------------------------------------------------------------------ 264 | -- Utilities 265 | 266 | fromStrict :: B.ByteString -> BL.ByteString 267 | fromStrict = BL.fromStrict 268 | 269 | ------------------------------------------------------------------------ 270 | -- test that instances exist 271 | 272 | instanceExists :: Hashable a => a -> () 273 | instanceExists _ = () 274 | 275 | #if MIN_VERSION_filepath(1,4,100) && !(MIN_VERSION_filepath(1,5,0)) 276 | _fp1, _fp2, _fp3 :: () 277 | _fp1 = instanceExists (undefined :: FP.OsString) 278 | _fp2 = instanceExists (undefined :: FP.WindowsString) 279 | _fp3 = instanceExists (undefined :: FP.PosixString) 280 | #endif 281 | 282 | #ifdef MIN_VERSION_os_string 283 | _os1, _os2, _os3 :: () 284 | _os1 = instanceExists (undefined :: OS.OsString) 285 | _os2 = instanceExists (undefined :: OS.WindowsString) 286 | _os3 = instanceExists (undefined :: OS.PosixString) 287 | #endif 288 | -------------------------------------------------------------------------------- /.github/workflows/haskell-ci.yml: -------------------------------------------------------------------------------- 1 | # This GitHub workflow config has been generated by a script via 2 | # 3 | # haskell-ci 'github' 'cabal.project' 4 | # 5 | # To regenerate the script (for example after adjusting tested-with) run 6 | # 7 | # haskell-ci regenerate 8 | # 9 | # For more information, see https://github.com/haskell-CI/haskell-ci 10 | # 11 | # version: 0.19.20241219 12 | # 13 | # REGENDATA ("0.19.20241219",["github","cabal.project"]) 14 | # 15 | name: Haskell-CI 16 | on: 17 | push: 18 | branches: 19 | - master 20 | pull_request: 21 | branches: 22 | - master 23 | jobs: 24 | linux: 25 | name: Haskell-CI - Linux - ${{ matrix.compiler }} 26 | runs-on: ubuntu-20.04 27 | timeout-minutes: 28 | 60 29 | container: 30 | image: buildpack-deps:jammy 31 | continue-on-error: ${{ matrix.allow-failure }} 32 | strategy: 33 | matrix: 34 | include: 35 | - compiler: ghc-9.12.1 36 | compilerKind: ghc 37 | compilerVersion: 9.12.1 38 | setup-method: ghcup 39 | allow-failure: false 40 | - compiler: ghc-9.10.1 41 | compilerKind: ghc 42 | compilerVersion: 9.10.1 43 | setup-method: ghcup 44 | allow-failure: false 45 | - compiler: ghc-9.8.3 46 | compilerKind: ghc 47 | compilerVersion: 9.8.3 48 | setup-method: ghcup-vanilla 49 | allow-failure: false 50 | - compiler: ghc-9.8.2 51 | compilerKind: ghc 52 | compilerVersion: 9.8.2 53 | setup-method: ghcup 54 | allow-failure: false 55 | - compiler: ghc-9.6.5 56 | compilerKind: ghc 57 | compilerVersion: 9.6.5 58 | setup-method: ghcup 59 | allow-failure: false 60 | fail-fast: false 61 | steps: 62 | - name: apt-get install 63 | run: | 64 | apt-get update 65 | apt-get install -y --no-install-recommends gnupg ca-certificates dirmngr curl git software-properties-common libtinfo5 66 | - name: Install GHCup 67 | run: | 68 | mkdir -p "$HOME/.ghcup/bin" 69 | curl -sL https://downloads.haskell.org/ghcup/0.1.30.0/x86_64-linux-ghcup-0.1.30.0 > "$HOME/.ghcup/bin/ghcup" 70 | chmod a+x "$HOME/.ghcup/bin/ghcup" 71 | - name: Install cabal-install (prerelease) 72 | run: | 73 | "$HOME/.ghcup/bin/ghcup" config add-release-channel https://raw.githubusercontent.com/haskell/ghcup-metadata/master/ghcup-prereleases-0.0.8.yaml; 74 | "$HOME/.ghcup/bin/ghcup" install cabal 3.15.0.0.2024.10.3 || (cat "$HOME"/.ghcup/logs/*.* && false) 75 | echo "CABAL=$HOME/.ghcup/bin/cabal-3.15.0.0.2024.10.3 -vnormal+nowrap" >> "$GITHUB_ENV" 76 | - name: Install GHC (GHCup) 77 | if: matrix.setup-method == 'ghcup' 78 | run: | 79 | "$HOME/.ghcup/bin/ghcup" install ghc "$HCVER" || (cat "$HOME"/.ghcup/logs/*.* && false) 80 | HC=$("$HOME/.ghcup/bin/ghcup" whereis ghc "$HCVER") 81 | HCPKG=$(echo "$HC" | sed 's#ghc$#ghc-pkg#') 82 | HADDOCK=$(echo "$HC" | sed 's#ghc$#haddock#') 83 | echo "HC=$HC" >> "$GITHUB_ENV" 84 | echo "HCPKG=$HCPKG" >> "$GITHUB_ENV" 85 | echo "HADDOCK=$HADDOCK" >> "$GITHUB_ENV" 86 | env: 87 | HCKIND: ${{ matrix.compilerKind }} 88 | HCNAME: ${{ matrix.compiler }} 89 | HCVER: ${{ matrix.compilerVersion }} 90 | - name: Install GHC (GHCup vanilla) 91 | if: matrix.setup-method == 'ghcup-vanilla' 92 | run: | 93 | "$HOME/.ghcup/bin/ghcup" -s https://raw.githubusercontent.com/haskell/ghcup-metadata/master/ghcup-vanilla-0.0.8.yaml install ghc "$HCVER" || (cat "$HOME"/.ghcup/logs/*.* && false) 94 | HC=$("$HOME/.ghcup/bin/ghcup" whereis ghc "$HCVER") 95 | HCPKG=$(echo "$HC" | sed 's#ghc$#ghc-pkg#') 96 | HADDOCK=$(echo "$HC" | sed 's#ghc$#haddock#') 97 | echo "HC=$HC" >> "$GITHUB_ENV" 98 | echo "HCPKG=$HCPKG" >> "$GITHUB_ENV" 99 | echo "HADDOCK=$HADDOCK" >> "$GITHUB_ENV" 100 | env: 101 | HCKIND: ${{ matrix.compilerKind }} 102 | HCNAME: ${{ matrix.compiler }} 103 | HCVER: ${{ matrix.compilerVersion }} 104 | - name: Set PATH and environment variables 105 | run: | 106 | echo "$HOME/.cabal/bin" >> $GITHUB_PATH 107 | echo "LANG=C.UTF-8" >> "$GITHUB_ENV" 108 | echo "CABAL_DIR=$HOME/.cabal" >> "$GITHUB_ENV" 109 | echo "CABAL_CONFIG=$HOME/.cabal/config" >> "$GITHUB_ENV" 110 | HCNUMVER=$(${HC} --numeric-version|perl -ne '/^(\d+)\.(\d+)\.(\d+)(\.(\d+))?$/; print(10000 * $1 + 100 * $2 + ($3 == 0 ? $5 != 1 : $3))') 111 | echo "HCNUMVER=$HCNUMVER" >> "$GITHUB_ENV" 112 | echo "ARG_TESTS=--enable-tests" >> "$GITHUB_ENV" 113 | echo "ARG_BENCH=--disable-benchmarks" >> "$GITHUB_ENV" 114 | echo "HEADHACKAGE=false" >> "$GITHUB_ENV" 115 | echo "ARG_COMPILER=--$HCKIND --with-compiler=$HC" >> "$GITHUB_ENV" 116 | env: 117 | HCKIND: ${{ matrix.compilerKind }} 118 | HCNAME: ${{ matrix.compiler }} 119 | HCVER: ${{ matrix.compilerVersion }} 120 | - name: env 121 | run: | 122 | env 123 | - name: write cabal config 124 | run: | 125 | mkdir -p $CABAL_DIR 126 | cat >> $CABAL_CONFIG <> $CABAL_CONFIG < cabal-plan.xz 159 | echo 'f62ccb2971567a5f638f2005ad3173dba14693a45154c1508645c52289714cb2 cabal-plan.xz' | sha256sum -c - 160 | xz -d < cabal-plan.xz > $HOME/.cabal/bin/cabal-plan 161 | rm -f cabal-plan.xz 162 | chmod a+x $HOME/.cabal/bin/cabal-plan 163 | cabal-plan --version 164 | - name: checkout 165 | uses: actions/checkout@v4 166 | with: 167 | path: source 168 | - name: initial cabal.project for sdist 169 | run: | 170 | touch cabal.project 171 | echo "packages: $GITHUB_WORKSPACE/source/." >> cabal.project 172 | cat cabal.project 173 | - name: sdist 174 | run: | 175 | mkdir -p sdist 176 | $CABAL sdist all --output-dir $GITHUB_WORKSPACE/sdist 177 | - name: unpack 178 | run: | 179 | mkdir -p unpacked 180 | find sdist -maxdepth 1 -type f -name '*.tar.gz' -exec tar -C $GITHUB_WORKSPACE/unpacked -xzvf {} \; 181 | - name: generate cabal.project 182 | run: | 183 | PKGDIR_hashable="$(find "$GITHUB_WORKSPACE/unpacked" -maxdepth 1 -type d -regex '.*/hashable-[0-9.]*')" 184 | echo "PKGDIR_hashable=${PKGDIR_hashable}" >> "$GITHUB_ENV" 185 | rm -f cabal.project cabal.project.local 186 | touch cabal.project 187 | touch cabal.project.local 188 | echo "packages: ${PKGDIR_hashable}" >> cabal.project 189 | echo "package hashable" >> cabal.project 190 | echo " ghc-options: -Werror=missing-methods" >> cabal.project 191 | cat >> cabal.project <> cabal.project.local 195 | cat cabal.project 196 | cat cabal.project.local 197 | - name: dump install plan 198 | run: | 199 | $CABAL v2-build $ARG_COMPILER $ARG_TESTS $ARG_BENCH --dry-run all 200 | cabal-plan 201 | - name: restore cache 202 | uses: actions/cache/restore@v4 203 | with: 204 | key: ${{ runner.os }}-${{ matrix.compiler }}-${{ github.sha }} 205 | path: ~/.cabal/store 206 | restore-keys: ${{ runner.os }}-${{ matrix.compiler }}- 207 | - name: install dependencies 208 | run: | 209 | $CABAL v2-build $ARG_COMPILER --disable-tests --disable-benchmarks --dependencies-only -j2 all 210 | $CABAL v2-build $ARG_COMPILER $ARG_TESTS $ARG_BENCH --dependencies-only -j2 all 211 | - name: build w/o tests 212 | run: | 213 | $CABAL v2-build $ARG_COMPILER --disable-tests --disable-benchmarks all 214 | - name: build 215 | run: | 216 | $CABAL v2-build $ARG_COMPILER $ARG_TESTS $ARG_BENCH all --write-ghc-environment-files=always 217 | - name: tests 218 | run: | 219 | $CABAL v2-test $ARG_COMPILER $ARG_TESTS $ARG_BENCH all --test-show-details=direct 220 | - name: cabal check 221 | run: | 222 | cd ${PKGDIR_hashable} || false 223 | ${CABAL} -vnormal check 224 | - name: haddock 225 | run: | 226 | $CABAL v2-haddock --disable-documentation --haddock-all $ARG_COMPILER --with-haddock $HADDOCK $ARG_TESTS $ARG_BENCH all 227 | - name: unconstrained build 228 | run: | 229 | rm -f cabal.project.local 230 | $CABAL v2-build $ARG_COMPILER --disable-tests --disable-benchmarks all 231 | - name: prepare for constraint sets 232 | run: | 233 | rm -f cabal.project.local 234 | - name: constraint set filepath-1.5 235 | run: | 236 | $CABAL v2-build $ARG_COMPILER --enable-tests --disable-benchmarks --constraint='filepath ^>=1.5.2.0' all --dry-run 237 | cabal-plan topo | sort 238 | $CABAL v2-build $ARG_COMPILER --enable-tests --disable-benchmarks --constraint='filepath ^>=1.5.2.0' --dependencies-only -j2 all 239 | $CABAL v2-build $ARG_COMPILER --enable-tests --disable-benchmarks --constraint='filepath ^>=1.5.2.0' all 240 | $CABAL v2-test $ARG_COMPILER --enable-tests --disable-benchmarks --constraint='filepath ^>=1.5.2.0' all 241 | - name: constraint set filepath-1.4.100.0 242 | run: | 243 | if [ $((HCNUMVER < 91000)) -ne 0 ] ; then $CABAL v2-build $ARG_COMPILER --enable-tests --disable-benchmarks --constraint='filepath ^>=1.4.100.0' all --dry-run ; fi 244 | if [ $((HCNUMVER < 91000)) -ne 0 ] ; then cabal-plan topo | sort ; fi 245 | if [ $((HCNUMVER < 91000)) -ne 0 ] ; then $CABAL v2-build $ARG_COMPILER --enable-tests --disable-benchmarks --constraint='filepath ^>=1.4.100.0' --dependencies-only -j2 all ; fi 246 | if [ $((HCNUMVER < 91000)) -ne 0 ] ; then $CABAL v2-build $ARG_COMPILER --enable-tests --disable-benchmarks --constraint='filepath ^>=1.4.100.0' all ; fi 247 | if [ $((HCNUMVER < 91000)) -ne 0 ] ; then $CABAL v2-test $ARG_COMPILER --enable-tests --disable-benchmarks --constraint='filepath ^>=1.4.100.0' all ; fi 248 | - name: constraint set random-initial-seed 249 | run: | 250 | $CABAL v2-build $ARG_COMPILER --disable-tests --disable-benchmarks --constraint='hashable +random-initial-seed' all --dry-run 251 | cabal-plan topo | sort 252 | $CABAL v2-build $ARG_COMPILER --disable-tests --disable-benchmarks --constraint='hashable +random-initial-seed' --dependencies-only -j2 all 253 | $CABAL v2-build $ARG_COMPILER --disable-tests --disable-benchmarks --constraint='hashable +random-initial-seed' all 254 | - name: save cache 255 | if: always() 256 | uses: actions/cache/save@v4 257 | with: 258 | key: ${{ runner.os }}-${{ matrix.compiler }}-${{ github.sha }} 259 | path: ~/.cabal/store 260 | -------------------------------------------------------------------------------- /src/Data/Hashable/Class.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE BangPatterns #-} 2 | {-# LANGUAGE CApiFFI #-} 3 | {-# LANGUAGE CPP #-} 4 | {-# LANGUAGE DefaultSignatures #-} 5 | {-# LANGUAGE DerivingStrategies #-} 6 | {-# LANGUAGE FlexibleContexts #-} 7 | {-# LANGUAGE GeneralizedNewtypeDeriving #-} 8 | {-# LANGUAGE MagicHash #-} 9 | {-# LANGUAGE MultiParamTypeClasses #-} 10 | {-# LANGUAGE PackageImports #-} 11 | {-# LANGUAGE PolyKinds #-} 12 | {-# LANGUAGE QuantifiedConstraints #-} 13 | {-# LANGUAGE ScopedTypeVariables #-} 14 | {-# LANGUAGE StandaloneDeriving #-} 15 | {-# LANGUAGE Trustworthy #-} 16 | {-# LANGUAGE TypeFamilies #-} 17 | {-# LANGUAGE UnliftedFFITypes #-} 18 | {-# OPTIONS_GHC -fno-warn-deprecations #-} 19 | 20 | ------------------------------------------------------------------------ 21 | -- | 22 | -- Module : Data.Hashable.Class 23 | -- Copyright : (c) Milan Straka 2010 24 | -- (c) Johan Tibell 2011 25 | -- (c) Bryan O'Sullivan 2011, 2012 26 | -- SPDX-License-Identifier : BSD-3-Clause 27 | -- Maintainer : johan.tibell@gmail.com 28 | -- Stability : provisional 29 | -- Portability : portable 30 | -- 31 | -- This module defines a class, 'Hashable', for types that can be 32 | -- converted to a hash value. This class exists for the benefit of 33 | -- hashing-based data structures. The module provides instances for 34 | -- most standard types. 35 | 36 | module Data.Hashable.Class 37 | ( 38 | -- * Computing hash values 39 | Hashable(..) 40 | , Hashable1(..) 41 | , Hashable2(..) 42 | 43 | -- ** Support for generics 44 | , genericHashWithSalt 45 | , genericLiftHashWithSalt 46 | , GHashable(..) 47 | , HashArgs(..) 48 | , Zero 49 | , One 50 | 51 | -- * Creating new instances 52 | , hashUsing 53 | , hashPtr 54 | , hashPtrWithSalt 55 | , hashByteArray 56 | , hashByteArrayWithSalt 57 | , defaultHashWithSalt 58 | , defaultHash 59 | -- * Higher Rank Functions 60 | , hashWithSalt1 61 | , hashWithSalt2 62 | , defaultLiftHashWithSalt 63 | -- * Caching hashes 64 | , Hashed 65 | , hashed 66 | , hashedHash 67 | , unhashed 68 | , mapHashed 69 | , traverseHashed 70 | ) where 71 | 72 | import Control.Applicative (Const (..)) 73 | import Control.DeepSeq (NFData (rnf)) 74 | import Control.Exception (assert) 75 | import Control.Monad.ST (runST) 76 | import Data.Array.Byte (ByteArray (..)) 77 | import Data.Complex (Complex (..)) 78 | import Data.Fixed (Fixed (..)) 79 | import Data.Functor.Classes (Eq1 (..), Eq2 (..), Ord1 (..), Show1 (..)) 80 | import Data.Functor.Compose (Compose (..)) 81 | import Data.Functor.Identity (Identity (..)) 82 | import Data.Int (Int16, Int8) 83 | import Data.Kind (Type) 84 | import Data.List (foldl') 85 | import Data.Proxy (Proxy) 86 | import Data.Ratio (Ratio, denominator, numerator) 87 | import Data.String (IsString (..)) 88 | import Data.Tuple (Solo (..)) 89 | import Data.Unique (Unique, hashUnique) 90 | import Data.Version (Version (..)) 91 | import Data.Void (Void, absurd) 92 | import Data.Word (Word16, Word8) 93 | import Foreign.Ptr (FunPtr, IntPtr, Ptr, WordPtr, castFunPtrToPtr, ptrToIntPtr) 94 | import Foreign.Storable (alignment, sizeOf) 95 | import GHC.Base (ByteArray#) 96 | import GHC.Conc (ThreadId (..)) 97 | import GHC.Fingerprint.Type (Fingerprint (..)) 98 | import GHC.Word (Word (..)) 99 | import System.Mem.StableName (StableName, hashStableName) 100 | import Type.Reflection (SomeTypeRep (..), TypeRep) 101 | import Type.Reflection.Unsafe (typeRepFingerprint) 102 | 103 | import qualified Data.Array.Byte as AB 104 | import qualified Data.ByteString as B 105 | import qualified Data.ByteString.Lazy as BL 106 | import qualified Data.ByteString.Short.Internal as BSI 107 | import qualified Data.Functor.Product as FP 108 | import qualified Data.Functor.Sum as FS 109 | import qualified Data.IntMap as IntMap 110 | import qualified Data.IntSet as IntSet 111 | import qualified Data.List.NonEmpty as NE 112 | import qualified Data.Map as Map 113 | import qualified Data.Semigroup as Semi 114 | import qualified Data.Sequence as Seq 115 | import qualified Data.Set as Set 116 | import qualified Data.Text as T 117 | import qualified Data.Text.Array as TA 118 | import qualified Data.Text.Internal as T 119 | import qualified Data.Text.Lazy as TL 120 | import qualified Data.Tree as Tree 121 | 122 | import GHC.Generics 123 | 124 | #if MIN_VERSION_base(4,19,0) 125 | import GHC.Conc.Sync (fromThreadId) 126 | #else 127 | import GHC.Prim (ThreadId#) 128 | #if __GLASGOW_HASKELL__ >= 904 129 | import Foreign.C.Types (CULLong (..)) 130 | #elif __GLASGOW_HASKELL__ >= 900 131 | import Foreign.C.Types (CLong (..)) 132 | #else 133 | import Foreign.C.Types (CInt (..)) 134 | #endif 135 | #endif 136 | 137 | import GHC.Exts (Int (..), sizeofByteArray#) 138 | import GHC.Num.BigNat (BigNat (..)) 139 | import GHC.Num.Integer (Integer (..)) 140 | import GHC.Num.Natural (Natural (..)) 141 | 142 | 143 | import GHC.Float (castDoubleToWord64, castFloatToWord32) 144 | 145 | -- filepath >=1.4.100 && <1.5 has System.OsString.Internal.Types module 146 | #if MIN_VERSION_filepath(1,4,100) && !(MIN_VERSION_filepath(1,5,0)) 147 | #define HAS_OS_STRING_filepath 1 148 | #else 149 | #define HAS_OS_STRING_filepath 0 150 | #endif 151 | 152 | -- if we depend on os_string module, then it has System.OsString.Internal.Types 153 | -- module as well 154 | #ifdef MIN_VERSION_os_string 155 | #define HAS_OS_STRING_os_string 1 156 | #else 157 | #define HAS_OS_STRING_os_string 0 158 | #endif 159 | 160 | #if HAS_OS_STRING_filepath && HAS_OS_STRING_os_string 161 | import "os-string" System.OsString.Internal.Types (OsString (..), PosixString (..), WindowsString (..)) 162 | import qualified "filepath" System.OsString.Internal.Types as FP (OsString (..), PosixString (..), WindowsString (..)) 163 | #elif HAS_OS_STRING_filepath || HAS_OS_STRING_os_string 164 | import System.OsString.Internal.Types (OsString (..), PosixString (..), WindowsString (..)) 165 | #endif 166 | 167 | import Data.Hashable.Imports 168 | import Data.Hashable.LowLevel 169 | import Data.Hashable.XXH3 170 | 171 | #include "MachDeps.h" 172 | 173 | infixl 0 `hashWithSalt` 174 | 175 | ------------------------------------------------------------------------ 176 | -- * Computing hash values 177 | 178 | -- | The class of types that can be converted to a hash value. 179 | -- 180 | -- Minimal implementation: 'hashWithSalt'. 181 | -- 182 | -- 'Hashable' is intended exclusively for use in in-memory data structures. 183 | -- . 184 | -- 'Hashable' does /not/ have a fixed standard. 185 | -- This allows it to improve over time. 186 | -- . 187 | -- Because it does not have a fixed standard, different computers or computers on different versions of the code will observe different hash values. 188 | -- As such, 'Hashable' is not recommended for use other than in-memory datastructures. 189 | -- Specifically, 'Hashable' is not intended for network use or in applications which persist hashed values. 190 | -- For stable hashing use named hashes: sha256, crc32, xxhash etc. 191 | -- 192 | -- If you are looking for 'Hashable' instance in @time@ package, 193 | -- check [time-compat](https://hackage.haskell.org/package/time-compat) 194 | -- 195 | class Eq a => Hashable a where 196 | -- | Return a hash value for the argument, using the given salt. 197 | -- 198 | -- The general contract of 'hashWithSalt' is: 199 | -- 200 | -- * If two values are equal according to the '==' method, then 201 | -- applying the 'hashWithSalt' method on each of the two values 202 | -- /must/ produce the same integer result if the same salt is 203 | -- used in each case. 204 | -- 205 | -- * It is /not/ required that if two values are unequal 206 | -- according to the '==' method, then applying the 207 | -- 'hashWithSalt' method on each of the two values must produce 208 | -- distinct integer results. However, the programmer should be 209 | -- aware that producing distinct integer results for unequal 210 | -- values may improve the performance of hashing-based data 211 | -- structures. 212 | -- 213 | -- * This method can be used to compute different hash values for 214 | -- the same input by providing a different salt in each 215 | -- application of the method. This implies that any instance 216 | -- that defines 'hashWithSalt' /must/ make use of the salt in 217 | -- its implementation. 218 | -- 219 | -- * 'hashWithSalt' may return negative 'Int' values. 220 | -- 221 | hashWithSalt :: Int -> a -> Int 222 | 223 | -- | Like 'hashWithSalt', but no salt is used. The default 224 | -- implementation uses 'hashWithSalt' with some default salt. 225 | -- Instances might want to implement this method to provide a more 226 | -- efficient implementation than the default implementation. 227 | hash :: a -> Int 228 | hash = defaultHash 229 | 230 | default hashWithSalt :: (Generic a, GHashable Zero (Rep a)) => Int -> a -> Int 231 | hashWithSalt = genericHashWithSalt 232 | {-# INLINE hashWithSalt #-} 233 | 234 | -- | Generic 'hashWithSalt'. 235 | -- 236 | -- @since 1.3.0.0 237 | genericHashWithSalt :: (Generic a, GHashable Zero (Rep a)) => Int -> a -> Int 238 | genericHashWithSalt = \salt -> ghashWithSalt HashArgs0 salt . from 239 | {-# INLINE genericHashWithSalt #-} 240 | 241 | data Zero 242 | data One 243 | 244 | data family HashArgs arity a :: Type 245 | data instance HashArgs Zero a = HashArgs0 246 | newtype instance HashArgs One a = HashArgs1 (Int -> a -> Int) 247 | 248 | -- | The class of types that can be generically hashed. 249 | class GHashable arity f where 250 | ghashWithSalt :: HashArgs arity a -> Int -> f a -> Int 251 | 252 | class (Eq1 t, forall a. Hashable a => Hashable (t a)) => Hashable1 t where 253 | -- | Lift a hashing function through the type constructor. 254 | liftHashWithSalt :: (Int -> a -> Int) -> Int -> t a -> Int 255 | 256 | default liftHashWithSalt :: (Generic1 t, GHashable One (Rep1 t)) => (Int -> a -> Int) -> Int -> t a -> Int 257 | liftHashWithSalt = genericLiftHashWithSalt 258 | {-# INLINE liftHashWithSalt #-} 259 | 260 | -- | Generic 'liftHashWithSalt'. 261 | -- 262 | -- @since 1.3.0.0 263 | genericLiftHashWithSalt :: (Generic1 t, GHashable One (Rep1 t)) => (Int -> a -> Int) -> Int -> t a -> Int 264 | genericLiftHashWithSalt = \h salt -> ghashWithSalt (HashArgs1 h) salt . from1 265 | {-# INLINE genericLiftHashWithSalt #-} 266 | 267 | class (Eq2 t, forall a. Hashable a => Hashable1 (t a)) => Hashable2 t where 268 | -- | Lift a hashing function through the binary type constructor. 269 | liftHashWithSalt2 :: (Int -> a -> Int) -> (Int -> b -> Int) -> Int -> t a b -> Int 270 | 271 | -- | Lift the 'hashWithSalt' function through the type constructor. 272 | -- 273 | -- > hashWithSalt1 = liftHashWithSalt hashWithSalt 274 | hashWithSalt1 :: (Hashable1 f, Hashable a) => Int -> f a -> Int 275 | hashWithSalt1 = liftHashWithSalt hashWithSalt 276 | 277 | -- | Lift the 'hashWithSalt' function through the type constructor. 278 | -- 279 | -- > hashWithSalt2 = liftHashWithSalt2 hashWithSalt hashWithSalt 280 | hashWithSalt2 :: (Hashable2 f, Hashable a, Hashable b) => Int -> f a b -> Int 281 | hashWithSalt2 = liftHashWithSalt2 hashWithSalt hashWithSalt 282 | 283 | -- | Lift the 'hashWithSalt' function halfway through the type constructor. 284 | -- This function makes a suitable default implementation of 'liftHashWithSalt', 285 | -- given that the type constructor @t@ in question can unify with @f a@. 286 | defaultLiftHashWithSalt :: (Hashable2 f, Hashable a) => (Int -> b -> Int) -> Int -> f a b -> Int 287 | defaultLiftHashWithSalt h = liftHashWithSalt2 hashWithSalt h 288 | 289 | -- | Since we support a generic implementation of 'hashWithSalt' we 290 | -- cannot also provide a default implementation for that method for 291 | -- the non-generic instance use case. Instead we provide 292 | -- 'defaultHashWith'. 293 | -- 294 | -- @since 1.4.3.0 295 | -- 296 | defaultHashWithSalt :: Hashable a => Int -> a -> Int 297 | defaultHashWithSalt salt x = salt `hashInt` hash x 298 | 299 | -- | Default implementation of 'hash' based on 'hashWithSalt'. 300 | -- 301 | -- @since 1.4.3.0 302 | -- 303 | defaultHash :: Hashable a => a -> Int 304 | defaultHash = hashWithSalt defaultSalt 305 | 306 | -- | Transform a value into a 'Hashable' value, then hash the 307 | -- transformed value using the given salt. 308 | -- 309 | -- This is a useful shorthand in cases where a type can easily be 310 | -- mapped to another type that is already an instance of 'Hashable'. 311 | -- Example: 312 | -- 313 | -- > data Foo = Foo | Bar 314 | -- > deriving (Enum) 315 | -- > 316 | -- > instance Hashable Foo where 317 | -- > hashWithSalt = hashUsing fromEnum 318 | -- 319 | -- @since 1.2.0.0 320 | hashUsing :: (Hashable b) => 321 | (a -> b) -- ^ Transformation function. 322 | -> Int -- ^ Salt. 323 | -> a -- ^ Value to transform. 324 | -> Int 325 | hashUsing f salt x = hashWithSalt salt (f x) 326 | {-# INLINE hashUsing #-} 327 | 328 | instance Hashable Int where 329 | hash = id 330 | hashWithSalt = hashInt 331 | 332 | instance Hashable Int8 where 333 | hash = fromIntegral 334 | hashWithSalt = defaultHashWithSalt 335 | 336 | instance Hashable Int16 where 337 | hash = fromIntegral 338 | hashWithSalt = defaultHashWithSalt 339 | 340 | instance Hashable Int32 where 341 | hash = fromIntegral 342 | hashWithSalt = defaultHashWithSalt 343 | 344 | instance Hashable Int64 where 345 | hash = fromIntegral 346 | hashWithSalt = hashInt64 347 | 348 | instance Hashable Word where 349 | hash = fromIntegral 350 | hashWithSalt = defaultHashWithSalt 351 | 352 | instance Hashable Word8 where 353 | hash = fromIntegral 354 | hashWithSalt = defaultHashWithSalt 355 | 356 | instance Hashable Word16 where 357 | hash = fromIntegral 358 | hashWithSalt = defaultHashWithSalt 359 | 360 | instance Hashable Word32 where 361 | hash = fromIntegral 362 | hashWithSalt = defaultHashWithSalt 363 | 364 | instance Hashable Word64 where 365 | hash = fromIntegral 366 | hashWithSalt = hashWord64 367 | 368 | instance Hashable () where 369 | hash = fromEnum 370 | hashWithSalt = defaultHashWithSalt 371 | 372 | instance Hashable Bool where 373 | hash = fromEnum 374 | hashWithSalt = defaultHashWithSalt 375 | 376 | instance Hashable Ordering where 377 | hash = fromEnum 378 | hashWithSalt = defaultHashWithSalt 379 | 380 | instance Hashable Char where 381 | hash = fromEnum 382 | hashWithSalt = defaultHashWithSalt 383 | 384 | instance Hashable BigNat where 385 | hashWithSalt salt (BN# ba) = hashWithSalt salt (ByteArray ba) 386 | 387 | instance Hashable Natural where 388 | hash (NS n) = hash (W# n) 389 | hash (NB bn) = hash (BN# bn) 390 | 391 | hashWithSalt salt (NS n) = hashWithSalt salt (W# n) 392 | hashWithSalt salt (NB bn) = hashWithSalt salt (BN# bn) 393 | 394 | instance Hashable Integer where 395 | hash (IS n) = I# n 396 | hash (IP bn) = hash (BN# bn) 397 | hash (IN bn) = negate (hash (BN# bn)) 398 | 399 | hashWithSalt salt (IS n) = hashWithSalt salt (I# n) 400 | hashWithSalt salt (IP bn) = hashWithSalt salt (BN# bn) 401 | hashWithSalt salt (IN bn) = negate (hashWithSalt salt (BN# bn)) 402 | 403 | instance Hashable a => Hashable (Complex a) where 404 | {-# SPECIALIZE instance Hashable (Complex Double) #-} 405 | {-# SPECIALIZE instance Hashable (Complex Float) #-} 406 | hash (r :+ i) = hash r `hashWithSalt` i 407 | hashWithSalt = hashWithSalt1 408 | instance Hashable1 Complex where 409 | liftHashWithSalt h s (r :+ i) = s `h` r `h` i 410 | 411 | instance Hashable a => Hashable (Ratio a) where 412 | {-# SPECIALIZE instance Hashable (Ratio Integer) #-} 413 | hash a = hash (numerator a) `hashWithSalt` denominator a 414 | hashWithSalt s a = s `hashWithSalt` numerator a `hashWithSalt` denominator a 415 | 416 | -- | __Note__: prior to @hashable-1.3.0.0@, @hash 0.0 /= hash (-0.0)@ 417 | -- 418 | -- The 'hash' of NaN is not well defined. 419 | -- 420 | -- @since 1.3.0.0 421 | instance Hashable Float where 422 | hash x 423 | | x == -0.0 || x == 0.0 = 0 -- see note in 'Hashable Double' 424 | | isIEEE x = 425 | assert (sizeOf x >= sizeOf (0::Word32) && 426 | alignment x >= alignment (0::Word32)) $ 427 | hash (castFloatToWord32 x) 428 | | otherwise = hash (show x) 429 | hashWithSalt = defaultHashWithSalt 430 | 431 | -- | __Note__: prior to @hashable-1.3.0.0@, @hash 0.0 /= hash (-0.0)@ 432 | -- 433 | -- The 'hash' of NaN is not well defined. 434 | -- 435 | -- @since 1.3.0.0 436 | instance Hashable Double where 437 | hash x 438 | | x == -0.0 || x == 0.0 = 0 -- s.t. @hash -0.0 == hash 0.0@ ; see #173 439 | | isIEEE x = 440 | assert (sizeOf x >= sizeOf (0::Word64) && 441 | alignment x >= alignment (0::Word64)) $ 442 | hash (castDoubleToWord64 x) 443 | | otherwise = hash (show x) 444 | hashWithSalt = defaultHashWithSalt 445 | 446 | -- | A value with bit pattern (01)* (or 5* in hexa), for any size of Int. 447 | -- It is used as data constructor distinguisher. GHC computes its value during 448 | -- compilation. 449 | distinguisher :: Int 450 | distinguisher = fromIntegral $ (maxBound :: Word) `quot` 3 451 | {-# INLINE distinguisher #-} 452 | 453 | instance Hashable a => Hashable (Maybe a) where 454 | hash Nothing = 0 455 | hash (Just a) = distinguisher `hashWithSalt` a 456 | hashWithSalt = hashWithSalt1 457 | 458 | instance Hashable1 Maybe where 459 | liftHashWithSalt _ s Nothing = s `hashInt` 0 460 | liftHashWithSalt h s (Just a) = s `hashInt` distinguisher `h` a 461 | 462 | instance (Hashable a, Hashable b) => Hashable (Either a b) where 463 | hash (Left a) = 0 `hashWithSalt` a 464 | hash (Right b) = distinguisher `hashWithSalt` b 465 | hashWithSalt = hashWithSalt1 466 | 467 | instance Hashable a => Hashable1 (Either a) where 468 | liftHashWithSalt = defaultLiftHashWithSalt 469 | 470 | instance Hashable2 Either where 471 | liftHashWithSalt2 h _ s (Left a) = s `hashInt` 0 `h` a 472 | liftHashWithSalt2 _ h s (Right b) = s `hashInt` distinguisher `h` b 473 | 474 | instance (Hashable a1, Hashable a2) => Hashable (a1, a2) where 475 | hashWithSalt = hashWithSalt1 476 | 477 | instance Hashable a1 => Hashable1 ((,) a1) where 478 | liftHashWithSalt = defaultLiftHashWithSalt 479 | 480 | instance Hashable2 (,) where 481 | liftHashWithSalt2 h1 h2 s (a1, a2) = s `h1` a1 `h2` a2 482 | 483 | instance (Hashable a1, Hashable a2, Hashable a3) => Hashable (a1, a2, a3) where 484 | hashWithSalt = hashWithSalt1 485 | 486 | instance (Hashable a1, Hashable a2) => Hashable1 ((,,) a1 a2) where 487 | liftHashWithSalt = defaultLiftHashWithSalt 488 | 489 | instance Hashable a1 => Hashable2 ((,,) a1) where 490 | liftHashWithSalt2 h1 h2 s (a1, a2, a3) = 491 | (s `hashWithSalt` a1) `h1` a2 `h2` a3 492 | 493 | instance (Hashable a1, Hashable a2, Hashable a3, Hashable a4) => 494 | Hashable (a1, a2, a3, a4) where 495 | hashWithSalt = hashWithSalt1 496 | 497 | instance (Hashable a1, Hashable a2, Hashable a3) => Hashable1 ((,,,) a1 a2 a3) where 498 | liftHashWithSalt = defaultLiftHashWithSalt 499 | 500 | instance (Hashable a1, Hashable a2) => Hashable2 ((,,,) a1 a2) where 501 | liftHashWithSalt2 h1 h2 s (a1, a2, a3, a4) = 502 | (s `hashWithSalt` a1 `hashWithSalt` a2) `h1` a3 `h2` a4 503 | 504 | instance (Hashable a1, Hashable a2, Hashable a3, Hashable a4, Hashable a5) 505 | => Hashable (a1, a2, a3, a4, a5) where 506 | hashWithSalt s (a1, a2, a3, a4, a5) = 507 | s `hashWithSalt` a1 `hashWithSalt` a2 `hashWithSalt` a3 508 | `hashWithSalt` a4 `hashWithSalt` a5 509 | 510 | {- 511 | instance (Hashable a1, Hashable a2, Hashable a3, 512 | Hashable a4) => Hashable1 ((,,,,) a1 a2 a3 a4) where 513 | liftHashWithSalt = defaultLiftHashWithSalt 514 | 515 | instance (Hashable a1, Hashable a2, Hashable a3) 516 | => Hashable2 ((,,,,) a1 a2 a3) where 517 | liftHashWithSalt2 h1 h2 s (a1, a2, a3, a4, a5) = 518 | (s `hashWithSalt` a1 `hashWithSalt` a2 519 | `hashWithSalt` a3) `h1` a4 `h2` a5 520 | -} 521 | 522 | instance (Hashable a1, Hashable a2, Hashable a3, Hashable a4, Hashable a5, 523 | Hashable a6) => Hashable (a1, a2, a3, a4, a5, a6) where 524 | hashWithSalt s (a1, a2, a3, a4, a5, a6) = 525 | s `hashWithSalt` a1 `hashWithSalt` a2 `hashWithSalt` a3 526 | `hashWithSalt` a4 `hashWithSalt` a5 `hashWithSalt` a6 527 | 528 | {- 529 | instance (Hashable a1, Hashable a2, Hashable a3, Hashable a4, 530 | Hashable a5) => Hashable1 ((,,,,,) a1 a2 a3 a4 a5) where 531 | liftHashWithSalt = defaultLiftHashWithSalt 532 | 533 | instance (Hashable a1, Hashable a2, Hashable a3, 534 | Hashable a4) => Hashable2 ((,,,,,) a1 a2 a3 a4) where 535 | liftHashWithSalt2 h1 h2 s (a1, a2, a3, a4, a5, a6) = 536 | (s `hashWithSalt` a1 `hashWithSalt` a2 `hashWithSalt` a3 537 | `hashWithSalt` a4) `h1` a5 `h2` a6 538 | -} 539 | 540 | instance (Hashable a1, Hashable a2, Hashable a3, Hashable a4, Hashable a5, 541 | Hashable a6, Hashable a7) => 542 | Hashable (a1, a2, a3, a4, a5, a6, a7) where 543 | hashWithSalt s (a1, a2, a3, a4, a5, a6, a7) = 544 | s `hashWithSalt` a1 `hashWithSalt` a2 `hashWithSalt` a3 545 | `hashWithSalt` a4 `hashWithSalt` a5 `hashWithSalt` a6 `hashWithSalt` a7 546 | 547 | {- 548 | instance (Hashable a1, Hashable a2, Hashable a3, Hashable a4, Hashable a5, Hashable a6) => Hashable1 ((,,,,,,) a1 a2 a3 a4 a5 a6) where 549 | liftHashWithSalt = defaultLiftHashWithSalt 550 | 551 | instance (Hashable a1, Hashable a2, Hashable a3, Hashable a4, 552 | Hashable a5) => Hashable2 ((,,,,,,) a1 a2 a3 a4 a5) where 553 | liftHashWithSalt2 h1 h2 s (a1, a2, a3, a4, a5, a6, a7) = 554 | (s `hashWithSalt` a1 `hashWithSalt` a2 `hashWithSalt` a3 555 | `hashWithSalt` a4 `hashWithSalt` a5) `h1` a6 `h2` a7 556 | -} 557 | 558 | instance Hashable (StableName a) where 559 | hash = hashStableName 560 | hashWithSalt = defaultHashWithSalt 561 | 562 | -- Auxiliary type for Hashable [a] definition 563 | data SPInt = SP !Int !Int 564 | 565 | instance Hashable a => Hashable [a] where 566 | {-# SPECIALIZE instance Hashable [Char] #-} 567 | hashWithSalt = hashWithSalt1 568 | 569 | instance Hashable1 [] where 570 | liftHashWithSalt h salt arr = finalise (foldl' step (SP salt 0) arr) 571 | where 572 | finalise (SP s l) = hashWithSalt s l 573 | step (SP s l) x = SP (h s x) (l + 1) 574 | 575 | instance Hashable B.ByteString where 576 | hash bs = fromIntegral (xxh3_64bit_withSeed_bs bs 0) 577 | 578 | hashWithSalt salt bs = 579 | fromIntegral (xxh3_64bit_withSeed_bs bs (fromIntegral (hashWithSalt salt len))) 580 | where 581 | len = B.length bs 582 | 583 | instance Hashable BL.ByteString where 584 | hashWithSalt salt lbs = runST $ do 585 | s <- xxh3_64bit_createState 586 | xxh3_64bit_reset_withSeed s (fromIntegral salt) 587 | len <- BL.foldrChunks (step s) return lbs 0 588 | xxh3_64bit_update_w64 s len 589 | digest <- xxh3_64bit_digest s 590 | return (fromIntegral digest) 591 | where 592 | step s bs next !acc = do 593 | xxh3_64bit_update_bs s bs 594 | next (acc + fromIntegral (B.length bs)) 595 | 596 | instance Hashable BSI.ShortByteString where 597 | hash (BSI.SBS ba) = hash (ByteArray ba) 598 | hashWithSalt salt (BSI.SBS ba) = hashWithSalt salt (ByteArray ba) 599 | 600 | #if HAS_OS_STRING_filepath || HAS_OS_STRING_os_string 601 | -- | @since 1.4.2.0 602 | deriving newtype instance Hashable PosixString 603 | 604 | -- | @since 1.4.2.0 605 | deriving newtype instance Hashable WindowsString 606 | 607 | -- | @since 1.4.2.0 608 | deriving newtype instance Hashable OsString 609 | #endif 610 | 611 | #if HAS_OS_STRING_filepath && HAS_OS_STRING_os_string 612 | deriving newtype instance Hashable FP.PosixString 613 | deriving newtype instance Hashable FP.WindowsString 614 | deriving newtype instance Hashable FP.OsString 615 | #endif 616 | 617 | #if MIN_VERSION_text(2,0,0) 618 | 619 | instance Hashable T.Text where 620 | hash (T.Text (TA.ByteArray arr) off len) = 621 | fromIntegral (xxh3_64bit_withSeed_ba (ByteArray arr) off len 0) 622 | hashWithSalt salt (T.Text (TA.ByteArray arr) off len) = 623 | fromIntegral (xxh3_64bit_withSeed_ba (ByteArray arr) off len (fromIntegral (hashWithSalt salt len))) 624 | 625 | instance Hashable TL.Text where 626 | hashWithSalt salt lt = runST $ do 627 | s <- xxh3_64bit_createState 628 | xxh3_64bit_reset_withSeed s (fromIntegral salt) 629 | len <- TL.foldrChunks (step s) return lt 0 630 | xxh3_64bit_update_w64 s len 631 | digest <- xxh3_64bit_digest s 632 | return (fromIntegral digest) 633 | where 634 | step s (T.Text (TA.ByteArray arr) off len) next !acc = do 635 | xxh3_64bit_update_ba s (ByteArray arr) off len 636 | next (acc + fromIntegral len) 637 | 638 | #else 639 | 640 | instance Hashable T.Text where 641 | hash (T.Text arr off len) = 642 | fromIntegral (xxh3_64bit_withSeed_ba (ByteArray (TA.aBA arr)) (unsafeShiftL off 1) (unsafeShiftL len 1) 0) 643 | hashWithSalt salt (T.Text arr off len) = 644 | fromIntegral (xxh3_64bit_withSeed_ba (ByteArray (TA.aBA arr)) (unsafeShiftL off 1) (unsafeShiftL len 1) (fromIntegral (hashWithSalt salt len))) 645 | 646 | instance Hashable TL.Text where 647 | hashWithSalt salt lt = runST $ do 648 | s <- xxh3_64bit_createState 649 | xxh3_64bit_reset_withSeed s (fromIntegral salt) 650 | len <- TL.foldrChunks (step s) return lt 0 651 | xxh3_64bit_update_w64 s len 652 | digest <- xxh3_64bit_digest s 653 | return (fromIntegral digest) 654 | where 655 | step s (T.Text arr off len) next !acc = do 656 | xxh3_64bit_update_ba s (ByteArray (TA.aBA arr)) (unsafeShiftL off 1) (unsafeShiftL len 1) 657 | next (acc + fromIntegral len) 658 | 659 | #endif 660 | 661 | #if !MIN_VERSION_base(4,19,0) 662 | fromThreadId :: ThreadId -> Word64 663 | fromThreadId (ThreadId t) = fromIntegral (getThreadId t) 664 | 665 | -- this cannot be capi, as GHC panics. 666 | foreign import ccall unsafe "rts_getThreadId" getThreadId 667 | #if __GLASGOW_HASKELL__ >= 904 668 | -- https://gitlab.haskell.org/ghc/ghc/-/merge_requests/6163 669 | :: ThreadId# -> CULLong 670 | #elif __GLASGOW_HASKELL__ >= 900 671 | -- https://gitlab.haskell.org/ghc/ghc/-/merge_requests/1254 672 | :: ThreadId# -> CLong 673 | #else 674 | :: ThreadId# -> CInt 675 | #endif 676 | #endif 677 | 678 | instance Hashable ThreadId where 679 | hash = hash . fromThreadId 680 | hashWithSalt = defaultHashWithSalt 681 | 682 | instance Hashable (Ptr a) where 683 | hashWithSalt salt p = hashWithSalt salt $ ptrToIntPtr p 684 | 685 | instance Hashable (FunPtr a) where 686 | hashWithSalt salt p = hashWithSalt salt $ castFunPtrToPtr p 687 | 688 | instance Hashable IntPtr where 689 | hash n = fromIntegral n 690 | hashWithSalt = defaultHashWithSalt 691 | 692 | instance Hashable WordPtr where 693 | hash n = fromIntegral n 694 | hashWithSalt = defaultHashWithSalt 695 | 696 | ---------------------------------------------------------------------------- 697 | -- Fingerprint & TypeRep instances 698 | 699 | -- | @since 1.3.0.0 700 | instance Hashable Fingerprint where 701 | hash (Fingerprint x _) = fromIntegral x 702 | hashWithSalt = defaultHashWithSalt 703 | {-# INLINE hash #-} 704 | 705 | hashTypeRep :: Type.Reflection.TypeRep a -> Int 706 | hashTypeRep tr = 707 | let Fingerprint x _ = typeRepFingerprint tr in fromIntegral x 708 | 709 | instance Hashable Type.Reflection.SomeTypeRep where 710 | hash (Type.Reflection.SomeTypeRep r) = hashTypeRep r 711 | hashWithSalt = defaultHashWithSalt 712 | {-# INLINE hash #-} 713 | 714 | instance Hashable (Type.Reflection.TypeRep a) where 715 | hash = hashTypeRep 716 | hashWithSalt = defaultHashWithSalt 717 | {-# INLINE hash #-} 718 | 719 | ---------------------------------------------------------------------------- 720 | 721 | instance Hashable Void where 722 | hashWithSalt _ = absurd 723 | 724 | -- | Compute a hash value for the content of this pointer. 725 | hashPtr :: Ptr a -- ^ pointer to the data to hash 726 | -> Int -- ^ length, in bytes 727 | -> IO Int -- ^ hash value 728 | hashPtr p len = hashPtrWithSalt p len defaultSalt 729 | 730 | -- | Compute a hash value for the content of this 'ByteArray#', 731 | -- beginning at the specified offset, using specified number of bytes. 732 | hashByteArray :: ByteArray# -- ^ data to hash 733 | -> Int -- ^ offset, in bytes 734 | -> Int -- ^ length, in bytes 735 | -> Int -- ^ hash value 736 | hashByteArray ba0 off len = hashByteArrayWithSalt ba0 off len defaultSalt 737 | {-# INLINE hashByteArray #-} 738 | 739 | instance Hashable Unique where 740 | hash = hashUnique 741 | hashWithSalt = defaultHashWithSalt 742 | 743 | instance Hashable Version where 744 | hashWithSalt salt (Version branch tags) = 745 | salt `hashWithSalt` branch `hashWithSalt` tags 746 | 747 | deriving newtype instance Hashable (Fixed a) 748 | 749 | deriving newtype instance Hashable a => Hashable (Identity a) 750 | instance Hashable1 Identity where 751 | liftHashWithSalt h salt (Identity x) = h salt x 752 | 753 | -- Using hashWithSalt1 would cause needless constraint 754 | deriving newtype instance Hashable a => Hashable (Const a b) 755 | 756 | instance Hashable a => Hashable1 (Const a) where 757 | liftHashWithSalt = defaultLiftHashWithSalt 758 | 759 | instance Hashable2 Const where 760 | liftHashWithSalt2 f _ salt (Const x) = f salt x 761 | 762 | instance Hashable (Proxy a) where 763 | hash _ = 0 764 | hashWithSalt s _ = s 765 | 766 | instance Hashable1 Proxy where 767 | liftHashWithSalt _ s _ = s 768 | 769 | instance Hashable a => Hashable (NE.NonEmpty a) where 770 | hashWithSalt p (a NE.:| as) = p `hashWithSalt` a `hashWithSalt` as 771 | 772 | -- | @since 1.3.1.0 773 | instance Hashable1 NE.NonEmpty where 774 | liftHashWithSalt h salt (a NE.:| as) = liftHashWithSalt h (h salt a) as 775 | 776 | deriving newtype instance Hashable a => Hashable (Semi.Min a) 777 | deriving newtype instance Hashable a => Hashable (Semi.Max a) 778 | 779 | -- | __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. 780 | -- 781 | -- Since @hashable-1.5.0.0@, @hash (Semi.arg a _) = hash a@ 782 | -- 783 | -- @since 1.3.0.0 784 | instance Hashable a => Hashable (Semi.Arg a b) where 785 | hash (Semi.Arg a _) = hash a 786 | hashWithSalt p (Semi.Arg a _) = hashWithSalt p a 787 | 788 | deriving newtype instance Hashable a => Hashable (Semi.First a) 789 | deriving newtype instance Hashable a => Hashable (Semi.Last a) 790 | deriving newtype instance Hashable a => Hashable (Semi.WrappedMonoid a) 791 | 792 | #if !MIN_VERSION_base(4,16,0) 793 | deriving newtype instance Hashable a => Hashable (Semi.Option a) 794 | #endif 795 | 796 | -- TODO: this instance is removed as there isn't Eq1 Min/Max, ... 797 | 798 | #if 0 799 | -- | @since 1.3.1.0 800 | -- instance Hashable1 Min where liftHashWithSalt h salt (Min a) = h salt a 801 | 802 | -- | @since 1.3.1.0 803 | -- instance Hashable1 Max where liftHashWithSalt h salt (Max a) = h salt a 804 | 805 | -- | @since 1.3.1.0 806 | -- instance Hashable1 First where liftHashWithSalt h salt (First a) = h salt a 807 | 808 | -- | @since 1.3.1.0 809 | -- instance Hashable1 Last where liftHashWithSalt h salt (Last a) = h salt a 810 | 811 | 812 | -- | @since 1.3.1.0 813 | -- instance Hashable1 WrappedMonoid where liftHashWithSalt h salt (WrapMonoid a) = h salt a 814 | 815 | -- | @since 1.3.1.0 816 | -- instance Hashable1 Option where liftHashWithSalt h salt (Option a) = liftHashWithSalt h salt a 817 | #endif 818 | 819 | instance (Hashable (f (g a))) => Hashable (Compose f g a) where 820 | hash (Compose x) = hash x 821 | hashWithSalt p (Compose x) = hashWithSalt p x 822 | 823 | instance (Hashable1 f, Hashable1 g) => Hashable1 (Compose f g) where 824 | liftHashWithSalt h s = liftHashWithSalt (liftHashWithSalt h) s . getCompose 825 | 826 | instance (Hashable1 f, Hashable1 g) => Hashable1 (FP.Product f g) where 827 | liftHashWithSalt h s (FP.Pair a b) = liftHashWithSalt h (liftHashWithSalt h s a) b 828 | 829 | instance (Hashable (f a), Hashable (g a)) => Hashable (FP.Product f g a) where 830 | hashWithSalt s (FP.Pair a b) = s `hashWithSalt` a `hashWithSalt` b 831 | 832 | instance (Hashable1 f, Hashable1 g) => Hashable1 (FS.Sum f g) where 833 | liftHashWithSalt h s (FS.InL a) = liftHashWithSalt h (s `hashInt` 0) a 834 | liftHashWithSalt h s (FS.InR a) = liftHashWithSalt h (s `hashInt` distinguisher) a 835 | 836 | instance (Hashable (f a), Hashable (g a)) => Hashable (FS.Sum f g a) where 837 | hashWithSalt s (FS.InL a) = hashWithSalt (s `hashInt` 0) a 838 | hashWithSalt s (FS.InR a) = hashWithSalt (s `hashInt` distinguisher) a 839 | 840 | -- | This instance was available since 1.4.1.0 only for GHC-9.4+ 841 | -- 842 | -- @since 1.4.2.0 843 | -- 844 | instance Hashable AB.ByteArray where 845 | hash ba@(AB.ByteArray ba') = 846 | fromIntegral (xxh3_64bit_withSeed_ba ba 0 len 0) 847 | where 848 | !len = I# (sizeofByteArray# ba') 849 | 850 | hashWithSalt salt ba@(AB.ByteArray ba') = 851 | fromIntegral (xxh3_64bit_withSeed_ba ba 0 len (fromIntegral (hashWithSalt salt len))) 852 | where 853 | !len = I# (sizeofByteArray# ba') 854 | 855 | ------------------------------------------------------------------------------- 856 | -- Hashed 857 | ------------------------------------------------------------------------------- 858 | 859 | -- | A hashable value along with the result of the 'hash' function. 860 | data Hashed a = Hashed a {-# UNPACK #-} !Int 861 | 862 | -- | Wrap a hashable value, caching the 'hash' function result. 863 | hashed :: Hashable a => a -> Hashed a 864 | hashed a = Hashed a (hash a) 865 | 866 | -- | Unwrap hashed value. 867 | unhashed :: Hashed a -> a 868 | unhashed (Hashed a _) = a 869 | 870 | -- | 'hash' has 'Eq' requirement. 871 | -- 872 | -- @since 1.4.0.0 873 | hashedHash :: Hashed a -> Int 874 | hashedHash (Hashed _ h) = h 875 | 876 | -- | Uses precomputed hash to detect inequality faster 877 | instance Eq a => Eq (Hashed a) where 878 | Hashed a ha == Hashed b hb = ha == hb && a == b 879 | 880 | instance Ord a => Ord (Hashed a) where 881 | Hashed a _ `compare` Hashed b _ = a `compare` b 882 | 883 | instance Show a => Show (Hashed a) where 884 | showsPrec d (Hashed a _) = showParen (d > 10) $ 885 | showString "hashed" . showChar ' ' . showsPrec 11 a 886 | 887 | instance Eq a => Hashable (Hashed a) where 888 | hashWithSalt = defaultHashWithSalt 889 | hash = hashedHash 890 | 891 | 892 | -- This instance is a little unsettling. It is unusal for 893 | -- 'liftHashWithSalt' to ignore its first argument when a 894 | -- value is actually available for it to work on. 895 | instance Hashable1 Hashed where 896 | liftHashWithSalt _ s (Hashed _ h) = defaultHashWithSalt s h 897 | 898 | instance (IsString a, Hashable a) => IsString (Hashed a) where 899 | fromString s = let r = fromString s in Hashed r (hash r) 900 | 901 | instance Foldable Hashed where 902 | foldMap f (Hashed a _) = f a 903 | foldr f acc (Hashed a _) = f a acc 904 | 905 | instance NFData a => NFData (Hashed a) where 906 | rnf = rnf . unhashed 907 | 908 | -- | 'Hashed' cannot be 'Functor' 909 | mapHashed :: Hashable b => (a -> b) -> Hashed a -> Hashed b 910 | mapHashed f (Hashed a _) = hashed (f a) 911 | 912 | -- | 'Hashed' cannot be 'Traversable' 913 | traverseHashed :: (Hashable b, Functor f) => (a -> f b) -> Hashed a -> f (Hashed b) 914 | traverseHashed f (Hashed a _) = fmap hashed (f a) 915 | 916 | -- instances for @Data.Functor.Classes@ higher rank typeclasses 917 | -- in base-4.9 and onward. 918 | instance Eq1 Hashed where 919 | liftEq f (Hashed a ha) (Hashed b hb) = ha == hb && f a b 920 | 921 | instance Ord1 Hashed where 922 | liftCompare f (Hashed a _) (Hashed b _) = f a b 923 | 924 | instance Show1 Hashed where 925 | liftShowsPrec sp _ d (Hashed a _) = showParen (d > 10) $ 926 | showString "hashed " . sp 11 a 927 | 928 | ------------------------------------------------------------------------------- 929 | -- containers 930 | ------------------------------------------------------------------------------- 931 | 932 | -- | @since 1.3.4.0 933 | instance Hashable2 Map.Map where 934 | liftHashWithSalt2 hk hv s m = Map.foldlWithKey' 935 | (\s' k v -> hv (hk s' k) v) 936 | (hashWithSalt s (Map.size m)) 937 | m 938 | 939 | -- | @since 1.3.4.0 940 | instance Hashable k => Hashable1 (Map.Map k) where 941 | liftHashWithSalt h s m = Map.foldlWithKey' 942 | (\s' k v -> h (hashWithSalt s' k) v) 943 | (hashWithSalt s (Map.size m)) 944 | m 945 | 946 | -- | @since 1.3.4.0 947 | instance (Hashable k, Hashable v) => Hashable (Map.Map k v) where 948 | hashWithSalt = hashWithSalt2 949 | 950 | -- | @since 1.3.4.0 951 | instance Hashable1 IntMap.IntMap where 952 | liftHashWithSalt h s m = IntMap.foldlWithKey' 953 | (\s' k v -> h (hashWithSalt s' k) v) 954 | (hashWithSalt s (IntMap.size m)) 955 | m 956 | 957 | -- | @since 1.3.4.0 958 | instance Hashable v => Hashable (IntMap.IntMap v) where 959 | hashWithSalt = hashWithSalt1 960 | 961 | -- | @since 1.3.4.0 962 | instance Hashable1 Set.Set where 963 | liftHashWithSalt h s x = Set.foldl' h (hashWithSalt s (Set.size x)) x 964 | 965 | -- | @since 1.3.4.0 966 | instance Hashable v => Hashable (Set.Set v) where 967 | hashWithSalt = hashWithSalt1 968 | 969 | -- | @since 1.3.4.0 970 | instance Hashable IntSet.IntSet where 971 | hashWithSalt salt x = IntSet.foldl' hashWithSalt 972 | (hashWithSalt salt (IntSet.size x)) 973 | x 974 | 975 | -- | @since 1.3.4.0 976 | instance Hashable1 Seq.Seq where 977 | liftHashWithSalt h s x = foldl' h (hashWithSalt s (Seq.length x)) x 978 | 979 | -- | @since 1.3.4.0 980 | instance Hashable v => Hashable (Seq.Seq v) where 981 | hashWithSalt = hashWithSalt1 982 | 983 | -- | @since 1.3.4.0 984 | instance Hashable1 Tree.Tree where 985 | liftHashWithSalt h = go where 986 | go s (Tree.Node x xs) = liftHashWithSalt go (h s x) xs 987 | 988 | -- | @since 1.3.4.0 989 | instance Hashable v => Hashable (Tree.Tree v) where 990 | hashWithSalt = hashWithSalt1 991 | 992 | ------------------------------------------------------------------------------- 993 | -- Solo 994 | ------------------------------------------------------------------------------- 995 | 996 | instance Hashable a => Hashable (Solo a) where 997 | hashWithSalt = hashWithSalt1 998 | instance Hashable1 Solo where 999 | liftHashWithSalt h salt (Solo x) = h salt x 1000 | --------------------------------------------------------------------------------