diff --git a/CHANGES.md b/CHANGES.md --- a/CHANGES.md +++ b/CHANGES.md @@ -1,5 +1,15 @@ See also https://pvp.haskell.org/faq +## Version 1.3.2.0 + + * Add `Hashable (Fixed a)` for `base <4.7` versions. + * Add documentation: + - `hashable` is not a stable hash + - `hashWithSalt` may return negative values + - there is `time-compat` with `Hashable` instances for `time` types. + * Add `random-initial-seed` flag causing the initial seed + to be randomized on each start of an executable using `hashable`. + ## Version 1.3.1.0 * Add `Hashable1` instances to `semigroups` types. diff --git a/cbits-unix/init.c b/cbits-unix/init.c new file mode 100644 --- /dev/null +++ b/cbits-unix/init.c @@ -0,0 +1,39 @@ +#include +#include +#include +#include +#include +#include + +uint64_t hs_hashable_init() { + + /* if there is /dev/urandom, read from it */ + FILE *urandom = fopen("/dev/urandom", "r"); + if (urandom) { + uint64_t result = 0; + size_t r = fread(&result, sizeof(uint64_t), 1, urandom); + fclose(urandom); + + if (r == 1) { + return result; + } else { + return 0xfeed1000; + } + + } else { + /* time of day */ + struct timeval tp = {0, 0}; + gettimeofday(&tp, NULL); + + /* cputime */ + clock_t c = clock(); + + /* process id */ + pid_t p = getpid(); + + return ((uint64_t) tp.tv_sec) + ^ ((uint64_t) tp.tv_usec) + ^ ((uint64_t) c << 16) + ^ ((uint64_t) p << 32); + } +} diff --git a/cbits-win/init.c b/cbits-win/init.c new file mode 100644 --- /dev/null +++ b/cbits-win/init.c @@ -0,0 +1,28 @@ +#include + +#include + +uint64_t hs_hashable_init() { + /* Handy list at https://stackoverflow.com/a/3487338/1308058 */ + + uint64_t a = GetCurrentProcessId(); /* DWORD */ + uint64_t b = GetCurrentThreadId(); /* DWORD */ + uint64_t c = GetTickCount(); /* DWORD */ + + SYSTEMTIME t = {0,0,0,0,0,0,0,0}; + GetSystemTime(&t); + + LARGE_INTEGER i; + QueryPerformanceCounter(&i); + + return a ^ (b << 32) ^ (c << 16) + ^ ((uint64_t) t.wYear << 56) + ^ ((uint64_t) t.wMonth << 48) + ^ ((uint64_t) t.wDayOfWeek << 40) + ^ ((uint64_t) t.wDay << 32) + ^ ((uint64_t) t.wHour << 24) + ^ ((uint64_t) t.wMinute << 16) + ^ ((uint64_t) t.wSecond << 8) + ^ ((uint64_t) t.wMilliseconds << 0) + ^ ((uint64_t) i.QuadPart); +} diff --git a/hashable.cabal b/hashable.cabal --- a/hashable.cabal +++ b/hashable.cabal @@ -1,106 +1,167 @@ -Cabal-version: 1.12 -Name: hashable -Version: 1.3.1.0 -Synopsis: A class for types that can be converted to a hash value -Description: This package defines a class, 'Hashable', for types that - can be converted to a hash value. This class - exists for the benefit of hashing-based data - structures. The package provides instances for - basic types and a way to combine hash values. -Homepage: http://github.com/haskell-unordered-containers/hashable +cabal-version: 1.12 +name: hashable +version: 1.3.2.0 +synopsis: A class for types that can be converted to a hash value +description: + This package defines a class, 'Hashable', for types that + can be converted to a hash value. This class + exists for the benefit of hashing-based data + structures. The package provides instances for + basic types and a way to combine hash values. + +homepage: http://github.com/haskell-unordered-containers/hashable + -- SPDX-License-Identifier : BSD-3-Clause -License: BSD3 -License-file: LICENSE -Author: Milan Straka - Johan Tibell -Maintainer: Oleg Grenrus -bug-reports: https://github.com/haskell-unordered-containers/hashable/issues -Stability: Provisional -Category: Data -Build-type: Simple -tested-with: GHC==8.10.3, GHC==8.8.3, GHC==8.6.5, GHC==8.4.4, GHC==8.2.2, GHC==8.0.2, GHC==7.10.3, GHC==7.8.4, GHC==7.6.3, GHC==7.4.2 +license: BSD3 +license-file: LICENSE +author: + Milan Straka + Johan Tibell -Extra-source-files: - CHANGES.md, README.md +maintainer: Oleg Grenrus +bug-reports: + https://github.com/haskell-unordered-containers/hashable/issues -Flag integer-gmp - Description: Are we using @integer-gmp@ to provide fast Integer instances? No effect on GHC-9.0 or later. - Default: True +stability: Provisional +category: Data +build-type: Simple +tested-with: + GHC ==7.4.2 + || ==7.6.3 + || ==7.8.4 + || ==7.10.3 + || ==8.0.2 + || ==8.2.2 + || ==8.4.4 + || ==8.6.5 + || ==8.8.3 + || ==8.10.4 + || ==9.0.1 -Library - Exposed-modules: Data.Hashable - Data.Hashable.Lifted - Data.Hashable.Generic - Other-modules: Data.Hashable.Class - Data.Hashable.Generic.Instances +extra-source-files: + CHANGES.md + README.md - C-sources: cbits/fnv.c - hs-source-dirs: src +flag integer-gmp + description: + Are we using @integer-gmp@ to provide fast Integer instances? No effect on GHC-9.0 or later. - Build-depends: base >= 4.5 && < 4.16 - , bytestring >= 0.9 && < 0.12 - , deepseq >= 1.3 && < 1.5 - , text >= 0.12 && < 1.3 - , ghc-prim + manual: False + default: True - if impl(ghc >= 9) - Build-depends: ghc-bignum >= 1.0 && <1.1 +flag random-initial-seed + description: + Randomly initialize the initial seed on each final executable invocation + This is useful for catching cases when you rely on (non-existent) + stability of hashable's hash functions. + + manual: True + default: False + +library + exposed-modules: + Data.Hashable + Data.Hashable.Generic + Data.Hashable.Lifted + + other-modules: + Data.Hashable.Class + Data.Hashable.Generic.Instances + + c-sources: cbits/fnv.c + hs-source-dirs: src + build-depends: + base >=4.5 && <4.16 + , bytestring >=0.9 && <0.12 + , deepseq >=1.3 && <1.5 + , ghc-prim + , text >=0.12 && <1.3 + + if impl(ghc >=9) + build-depends: ghc-bignum ==1.0.* + else if flag(integer-gmp) - Build-depends: integer-gmp >= 0.4 && < 1.1 + build-depends: integer-gmp >=0.4 && <1.1 + else -- this is needed for the automatic flag to be well-balanced - Build-depends: integer-simple + build-depends: integer-simple - Default-Language: Haskell2010 - Other-Extensions: BangPatterns - CPP - DeriveDataTypeable - FlexibleContexts - FlexibleInstances - GADTs - KindSignatures - MagicHash - MultiParamTypeClasses - ScopedTypeVariables - Trustworthy - TypeOperators - UnliftedFFITypes + if (flag(random-initial-seed) && impl(ghc)) + cpp-options: -DHASHABLE_RANDOM_SEED=1 - Ghc-options: -Wall -fwarn-tabs + if os(windows) + c-sources: cbits-win/init.c -Test-suite hashable-tests - Type: exitcode-stdio-1.0 - Hs-source-dirs: tests - Main-is: Main.hs - Other-modules: Properties Regress - Build-depends: base, - bytestring, - ghc-prim, - hashable, - test-framework >= 0.3.3, - test-framework-hunit, - test-framework-quickcheck2 >= 0.2.9, - HUnit, - QuickCheck >= 2.4.0.1, - random >= 1.0 && < 1.2, - text >= 0.11.0.5 + else + c-sources: cbits-unix/init.c + + default-language: Haskell2010 + other-extensions: + BangPatterns + CPP + DeriveDataTypeable + FlexibleContexts + FlexibleInstances + GADTs + KindSignatures + MagicHash + MultiParamTypeClasses + ScopedTypeVariables + Trustworthy + TypeOperators + UnliftedFFITypes + + ghc-options: -Wall -fwarn-tabs + + if impl(ghc >=9.0) + -- these flags may abort compilation with GHC-8.10 + -- https://gitlab.haskell.org/ghc/ghc/-/merge_requests/3295 + ghc-options: -Winferred-safe-imports -Wmissing-safe-haskell-mode + +test-suite hashable-tests + type: exitcode-stdio-1.0 + hs-source-dirs: tests + main-is: Main.hs + other-modules: + Properties + Regress + + build-depends: + base + , bytestring + , ghc-prim + , hashable + , HUnit + , QuickCheck >=2.4.0.1 + , random >=1.0 && <1.3 + , test-framework >=0.3.3 + , test-framework-hunit + , test-framework-quickcheck2 >=0.2.9 + , text >=0.11.0.5 + if !os(windows) - Build-depends: unix - CPP-options: -DHAVE_MMAP - Other-modules: Regress.Mmap - Other-Extensions: CApiFFI + build-depends: unix + cpp-options: -DHAVE_MMAP + other-modules: Regress.Mmap + other-extensions: CApiFFI - Ghc-options: -Wall -fno-warn-orphans - Default-Language: Haskell2010 + ghc-options: -Wall -fno-warn-orphans + default-language: Haskell2010 test-suite hashable-examples - type: exitcode-stdio-1.0 - build-depends: base, hashable, ghc-prim - hs-source-dirs: examples - main-is: Main.hs - Default-Language: Haskell2010 + type: exitcode-stdio-1.0 + build-depends: + base + , ghc-prim + , hashable + hs-source-dirs: examples + main-is: Main.hs + default-language: Haskell2010 + source-repository head type: git - location: https://github.com/haskell-unordered-containers/hashable.git + location: + https://github.com/haskell-unordered-containers/hashable.git diff --git a/src/Data/Hashable.hs b/src/Data/Hashable.hs --- a/src/Data/Hashable.hs +++ b/src/Data/Hashable.hs @@ -1,5 +1,5 @@ {-# LANGUAGE DeriveDataTypeable #-} -{-# LANGUAGE Trustworthy #-} +{-# LANGUAGE Safe #-} ------------------------------------------------------------------------ -- | diff --git a/src/Data/Hashable/Class.hs b/src/Data/Hashable/Class.hs --- a/src/Data/Hashable/Class.hs +++ b/src/Data/Hashable/Class.hs @@ -3,6 +3,8 @@ DefaultSignatures, FlexibleContexts, TypeFamilies, MultiParamTypeClasses #-} +{-# LANGUAGE Trustworthy #-} + #if __GLASGOW_HASKELL__ >= 801 {-# LANGUAGE PolyKinds #-} -- For TypeRep instances #endif @@ -96,6 +98,9 @@ #if MIN_VERSION_base(4,7,0) import Data.Fixed (Fixed(..)) +#else +import Data.Fixed (Fixed) +import Unsafe.Coerce (unsafeCoerce) #endif #if MIN_VERSION_base(4,8,0) @@ -189,6 +194,10 @@ #define Type * #endif +#ifdef HASHABLE_RANDOM_SEED +import System.IO.Unsafe (unsafePerformIO) +#endif + #include "MachDeps.h" infixl 0 `hashWithSalt` @@ -196,18 +205,42 @@ ------------------------------------------------------------------------ -- * Computing hash values +#ifdef HASHABLE_RANDOM_SEED +initialSeed :: Word64 +initialSeed = unsafePerformIO initialSeedC +{-# NOINLINE initialSeed #-} + +foreign import ccall "hs_hashable_init" initialSeedC :: IO Word64 +#endif + -- | A default salt used in the implementation of 'hash'. defaultSalt :: Int -#if WORD_SIZE_IN_BITS == 64 -defaultSalt = -3750763034362895579 -- 14695981039346656037 :: Int64 +#ifdef HASHABLE_RANDOM_SEED +defaultSalt = hashWithSalt defaultSalt' initialSeed #else -defaultSalt = -2128831035 -- 2166136261 :: Int32 +defaultSalt = defaultSalt' #endif {-# INLINE defaultSalt #-} +defaultSalt' :: Int +#if WORD_SIZE_IN_BITS == 64 +defaultSalt' = -3750763034362895579 -- 14695981039346656037 :: Int64 +#else +defaultSalt' = -2128831035 -- 2166136261 :: Int32 +#endif +{-# INLINE defaultSalt' #-} + -- | The class of types that can be converted to a hash value. -- -- Minimal implementation: 'hashWithSalt'. +-- +-- /Note:/ the hash is not guaranteed to be stable across +-- library versions, operating systems or architectures. +-- For stable hashing use named hashes: SHA256, CRC32 etc. +-- +-- If you are looking for 'Hashable' instance in @time@ package, +-- check [time-compat](https://hackage.haskell.org/package/time-compat) +-- class Hashable a where -- | Return a hash value for the argument, using the given salt. -- @@ -231,6 +264,9 @@ -- application of the method. This implies that any instance -- that defines 'hashWithSalt' /must/ make use of the salt in -- its implementation. + -- + -- * 'hashWithSalt' may return negative 'Int' values. + -- hashWithSalt :: Int -> a -> Int -- | Like 'hashWithSalt', but no salt is used. The default @@ -823,11 +859,14 @@ salt `hashWithSalt` branch `hashWithSalt` tags #if MIN_VERSION_base(4,7,0) --- Using hashWithSalt1 would cause needless constraint instance Hashable (Fixed a) where hashWithSalt salt (MkFixed i) = hashWithSalt salt i +-- Using hashWithSalt1 would cause needless constraint instance Hashable1 Fixed where liftHashWithSalt _ salt (MkFixed i) = hashWithSalt salt i +#else +instance Hashable (Fixed a) where + hashWithSalt salt x = hashWithSalt salt (unsafeCoerce x :: Integer) #endif #if MIN_VERSION_base(4,8,0) @@ -901,11 +940,13 @@ -- | @since 1.3.1.0 instance Hashable1 WrappedMonoid where liftHashWithSalt h salt (WrapMonoid a) = h salt a +#if !MIN_VERSION_base(4,16,0) instance Hashable a => Hashable (Option a) where hashWithSalt p (Option a) = hashWithSalt p a -- | @since 1.3.1.0 instance Hashable1 Option where liftHashWithSalt h salt (Option a) = liftHashWithSalt h salt a +#endif #endif -- instances for @Data.Functor.{Product,Sum,Compose}@, present diff --git a/src/Data/Hashable/Generic.hs b/src/Data/Hashable/Generic.hs --- a/src/Data/Hashable/Generic.hs +++ b/src/Data/Hashable/Generic.hs @@ -1,4 +1,4 @@ -{-# LANGUAGE Trustworthy #-} +{-# LANGUAGE Safe #-} -- | -- Module : Data.Hashable.Generic diff --git a/src/Data/Hashable/Generic/Instances.hs b/src/Data/Hashable/Generic/Instances.hs --- a/src/Data/Hashable/Generic/Instances.hs +++ b/src/Data/Hashable/Generic/Instances.hs @@ -2,6 +2,7 @@ ScopedTypeVariables, TypeOperators, MultiParamTypeClasses, GADTs, FlexibleContexts #-} {-# OPTIONS_GHC -fno-warn-orphans #-} +{-# LANGUAGE Trustworthy #-} ------------------------------------------------------------------------ -- | diff --git a/src/Data/Hashable/Lifted.hs b/src/Data/Hashable/Lifted.hs --- a/src/Data/Hashable/Lifted.hs +++ b/src/Data/Hashable/Lifted.hs @@ -1,4 +1,4 @@ -{-# LANGUAGE Trustworthy #-} +{-# LANGUAGE Safe #-} ------------------------------------------------------------------------ -- | diff --git a/tests/Regress.hs b/tests/Regress.hs --- a/tests/Regress.hs +++ b/tests/Regress.hs @@ -8,6 +8,7 @@ import Test.HUnit ((@=?)) import GHC.Generics (Generic) import Data.List (nub) +import Data.Fixed (Pico) #ifdef HAVE_MMAP import qualified Regress.Mmap as Mmap @@ -19,6 +20,9 @@ regressions = [] ++ #ifdef HAVE_MMAP Mmap.regressions ++ + [ testCase "Fixed" $ do + (hash (1 :: Pico) == hash (2 :: Pico)) @=? False + ] ++ #endif [ F.testGroup "Generic: sum of nullary constructors" [ testCase "0" $ nullaryCase 0 S0