Skip to content
New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

Sign up for GitHub

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

Jump to bottom

Support HASHABLE_INITIAL_SEED #219

Open
wants to merge 4 commits into
base: master
Choose a base branch
from
Open

Support HASHABLE_INITIAL_SEED #219

Changes from all commits
Commits
Show all changes
4 commits
Select commit Hold shift + click to select a range
64fa19f
Factor out getDefaultSalt
brandon-leapyear Sep 13, 2021
663195e
Move defaultSalt' into where-clause
brandon-leapyear Sep 13, 2021
902d077
Break out 'Default salt' section
brandon-leapyear Sep 13, 2021
870087f
Support HASHABLE_INITIAL_SEED
brandon-leapyear Sep 13, 2021
File filter

Filter by extension

Filter by extension
Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
56 changes: 31 additions & 25 deletions src/Data/Hashable/Class.hs
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -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)
Expand All @@ -85,9 +85,11 @@ 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.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
Expand Down Expand Up @@ -188,41 +190,45 @@ import Data.Kind (Type)
#define Type *
#endif

#ifdef HASHABLE_RANDOM_SEED
import System.IO.Unsafe (unsafePerformIO)
#endif

#include "MachDeps.h"

infixl 0 `hashWithSalt`

------------------------------------------------------------------------
-- * Computing hash values

-- * 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
initialSeed :: Word64
initialSeed = unsafePerformIO initialSeedC
{-# NOINLINE initialSeed #-}
getRandomInitialSeed = Just <$> initialSeedC

foreign import capi "HsHashable.h hs_hashable_init" initialSeedC :: IO Word64
#endif

-- | A default salt used in the implementation of 'hash'.
defaultSalt :: Int
#ifdef HASHABLE_RANDOM_SEED
defaultSalt = hashWithSalt defaultSalt' initialSeed
#else
defaultSalt = defaultSalt'
getRandomInitialSeed = pure Nothing
#endif
{-# INLINE defaultSalt #-}

defaultSalt' :: Int
getDefaultSalt :: IO Int
getDefaultSalt = maybe defaultSalt' (hashWithSalt defaultSalt') <$> getInitialSeed
where
defaultSalt' :: Int
#if WORD_SIZE_IN_BITS == 64
defaultSalt' = -3750763034362895579 -- 14695981039346656037 :: Int64
defaultSalt' = -3750763034362895579 -- 14695981039346656037 :: Int64
#else
defaultSalt' = -2128831035 -- 2166136261 :: Int32
defaultSalt' = -2128831035 -- 2166136261 :: Int32
#endif
{-# INLINE defaultSalt' #-}

-- | A default salt used in the implementation of 'hash'.
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.
--
Expand Down