From 64fa19f6190e3b626fefd2c3e1c5b2cb32a208c4 Mon Sep 17 00:00:00 2001 From: Brandon Chinn Date: Mon, 13 Sep 2021 12:24:28 -0700 Subject: [PATCH 1/4] Factor out getDefaultSalt --- src/Data/Hashable/Class.hs | 25 ++++++++++--------------- 1 file changed, 10 insertions(+), 15 deletions(-) diff --git a/src/Data/Hashable/Class.hs b/src/Data/Hashable/Class.hs index f164eb2..36ef3b2 100644 --- a/src/Data/Hashable/Class.hs +++ b/src/Data/Hashable/Class.hs @@ -85,7 +85,7 @@ import Foreign.Storable (alignment, peek, sizeOf) import GHC.Base (ByteArray#) import GHC.Conc (ThreadId(..)) import GHC.Prim (ThreadId#) -import System.IO.Unsafe (unsafeDupablePerformIO) +import System.IO.Unsafe (unsafeDupablePerformIO, unsafePerformIO) import System.Mem.StableName import Data.Unique (Unique, hashUnique) @@ -188,10 +188,6 @@ import Data.Kind (Type) #define Type * #endif -#ifdef HASHABLE_RANDOM_SEED -import System.IO.Unsafe (unsafePerformIO) -#endif - #include "MachDeps.h" infixl 0 `hashWithSalt` @@ -199,22 +195,21 @@ infixl 0 `hashWithSalt` ------------------------------------------------------------------------ -- * Computing hash values +getInitialSeed :: IO (Maybe Word64) #ifdef HASHABLE_RANDOM_SEED -initialSeed :: Word64 -initialSeed = unsafePerformIO initialSeedC -{-# NOINLINE initialSeed #-} - +getInitialSeed = Just <$> initialSeedC foreign import capi "HsHashable.h hs_hashable_init" initialSeedC :: IO Word64 +#else +getInitialSeed = pure Nothing #endif +getDefaultSalt :: IO Int +getDefaultSalt = maybe defaultSalt' (hashWithSalt defaultSalt') <$> getInitialSeed + -- | A default salt used in the implementation of 'hash'. defaultSalt :: Int -#ifdef HASHABLE_RANDOM_SEED -defaultSalt = hashWithSalt defaultSalt' initialSeed -#else -defaultSalt = defaultSalt' -#endif -{-# INLINE defaultSalt #-} +defaultSalt = unsafePerformIO getDefaultSalt +{-# NOINLINE defaultSalt #-} defaultSalt' :: Int #if WORD_SIZE_IN_BITS == 64 From 663195eb00eb49a15ade98d8a7dfbc54b5210855 Mon Sep 17 00:00:00 2001 From: Brandon Chinn Date: Mon, 13 Sep 2021 12:25:07 -0700 Subject: [PATCH 2/4] Move defaultSalt' into where-clause --- src/Data/Hashable/Class.hs | 15 +++++++-------- 1 file changed, 7 insertions(+), 8 deletions(-) diff --git a/src/Data/Hashable/Class.hs b/src/Data/Hashable/Class.hs index 36ef3b2..19ca4e7 100644 --- a/src/Data/Hashable/Class.hs +++ b/src/Data/Hashable/Class.hs @@ -205,20 +205,19 @@ getInitialSeed = pure Nothing getDefaultSalt :: IO Int getDefaultSalt = maybe defaultSalt' (hashWithSalt defaultSalt') <$> getInitialSeed + where + defaultSalt' :: Int +#if WORD_SIZE_IN_BITS == 64 + defaultSalt' = -3750763034362895579 -- 14695981039346656037 :: Int64 +#else + defaultSalt' = -2128831035 -- 2166136261 :: Int32 +#endif -- | A default salt used in the implementation of 'hash'. defaultSalt :: Int defaultSalt = unsafePerformIO getDefaultSalt {-# NOINLINE 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'. From 902d0776beee5d05a1a0d1f33c95184b1302e3b3 Mon Sep 17 00:00:00 2001 From: Brandon Chinn Date: Mon, 13 Sep 2021 12:28:07 -0700 Subject: [PATCH 3/4] Break out 'Default salt' section --- src/Data/Hashable/Class.hs | 9 ++++++--- 1 file changed, 6 insertions(+), 3 deletions(-) diff --git a/src/Data/Hashable/Class.hs b/src/Data/Hashable/Class.hs index 19ca4e7..d2ca33e 100644 --- a/src/Data/Hashable/Class.hs +++ b/src/Data/Hashable/Class.hs @@ -190,10 +190,8 @@ import Data.Kind (Type) #include "MachDeps.h" -infixl 0 `hashWithSalt` - ------------------------------------------------------------------------ --- * Computing hash values +-- * Default salt getInitialSeed :: IO (Maybe Word64) #ifdef HASHABLE_RANDOM_SEED @@ -218,6 +216,11 @@ defaultSalt :: Int defaultSalt = unsafePerformIO getDefaultSalt {-# NOINLINE defaultSalt #-} +------------------------------------------------------------------------ +-- * Computing hash values + +infixl 0 `hashWithSalt` + -- | The class of types that can be converted to a hash value. -- -- Minimal implementation: 'hashWithSalt'. From 870087f00bc4e34d66f231bdfa1e6c053b49a982 Mon Sep 17 00:00:00 2001 From: Brandon Chinn Date: Mon, 13 Sep 2021 12:39:32 -0700 Subject: [PATCH 4/4] Support HASHABLE_INITIAL_SEED --- src/Data/Hashable/Class.hs | 15 ++++++++++++--- 1 file changed, 12 insertions(+), 3 deletions(-) diff --git a/src/Data/Hashable/Class.hs b/src/Data/Hashable/Class.hs index d2ca33e..8d9d870 100644 --- a/src/Data/Hashable/Class.hs +++ b/src/Data/Hashable/Class.hs @@ -61,7 +61,7 @@ module Data.Hashable.Class , traverseHashed ) where -import Control.Applicative (Const(..)) +import Control.Applicative (Const(..), (<|>)) import Control.Exception (assert) import Control.DeepSeq (NFData(rnf)) import Data.Bits (shiftL, shiftR, xor) @@ -85,9 +85,11 @@ import Foreign.Storable (alignment, peek, sizeOf) import GHC.Base (ByteArray#) import GHC.Conc (ThreadId(..)) import GHC.Prim (ThreadId#) +import System.Environment (lookupEnv) import System.IO.Unsafe (unsafeDupablePerformIO, unsafePerformIO) import System.Mem.StableName import Data.Unique (Unique, hashUnique) +import Text.Read (readMaybe) -- As we use qualified F.Foldable, we don't get warnings with newer base import qualified Data.Foldable as F @@ -194,11 +196,18 @@ import Data.Kind (Type) -- * Default salt getInitialSeed :: IO (Maybe Word64) +getInitialSeed = do + initialSeedFromEnv' <- lookupEnv "HASHABLE_INITIAL_SEED" + let initialSeedFromEnv = initialSeedFromEnv' >>= readMaybe + initialSeedFromRandom <- getRandomInitialSeed + return $ initialSeedFromEnv <|> initialSeedFromRandom + where #ifdef HASHABLE_RANDOM_SEED -getInitialSeed = Just <$> initialSeedC + getRandomInitialSeed = Just <$> initialSeedC + foreign import capi "HsHashable.h hs_hashable_init" initialSeedC :: IO Word64 #else -getInitialSeed = pure Nothing + getRandomInitialSeed = pure Nothing #endif getDefaultSalt :: IO Int