{-# LANGUAGE BangPatterns, CPP, ForeignFunctionInterface,
    TypeOperators #-}

-- |
-- Module: Data.BloomFilter.Hash
-- Copyright: Bryan O'Sullivan
-- License: BSD3
--
-- Maintainer: Bryan O'Sullivan <bos@serpentine.com>
-- Stability: unstable
-- Portability: portable
--
-- Fast hashing of Haskell values.  The hash functions used are Bob
-- Jenkins's public domain functions, which combine high performance
-- with excellent mixing properties.  For more details, see
-- <http://burtleburtle.net/bob/hash/>.
--
-- In addition to the usual "one input, one output" hash functions,
-- this module provides multi-output hash functions, suitable for use
-- in applications that need multiple hashes, such as Bloom filtering.

module Data.BloomFilter.Hash
    (
    -- * Basic hash functionality
      Hashable(..)
    , hash32
    , hash64
    , hashSalt32
    , hashSalt64
    -- * Compute a family of hash values
    , hashes
    , cheapHashes
    -- * Hash functions for 'Storable' instances
    , hashOne32
    , hashOne64
    , hashList32
    , hashList64
    ) where

import Control.Monad (foldM)
import Data.Bits ((.&.), (.|.), unsafeShiftL, unsafeShiftR, xor)
import Data.List (unfoldr)
import Data.Int (Int8, Int16, Int32, Int64)
import Data.Word (Word8, Word16, Word32, Word64)
import Foreign.C.String (CString)
#if __GLASGOW_HASKELL__ >= 704
import Foreign.C.Types (CInt(..), CSize(..))
#else
import Foreign.C.Types (CInt, CSize)
#endif
import Foreign.ForeignPtr (withForeignPtr)
import Foreign.Marshal.Alloc (alloca)
import Foreign.Marshal.Array (allocaArray, withArrayLen)
import Foreign.Ptr (Ptr, castPtr, nullPtr, plusPtr)
import Foreign.Storable (Storable, peek, poke, sizeOf)
import System.IO.Unsafe (unsafePerformIO)
import Data.ByteString.Internal (ByteString(..))
import qualified Data.ByteString as SB
import qualified Data.ByteString.Lazy.Internal as LB
import qualified Data.ByteString.Lazy as LB

#include "HsBaseConfig.h"

-- Make sure we're not performing any expensive arithmetic operations.
-- import Prelude hiding ((/), (*), div, divMod, mod, rem)

foreign import ccall unsafe "lookup3.h _jenkins_hashword" hashWord
    :: Ptr Word32 -> CSize -> Word32 -> IO Word32

foreign import ccall unsafe "lookup3.h _jenkins_hashword2" hashWord2
    :: Ptr Word32 -> CSize -> Ptr Word32 -> Ptr Word32 -> IO ()

foreign import ccall unsafe "lookup3.h _jenkins_hashlittle" hashLittle
    :: Ptr a -> CSize -> Word32 -> IO Word32

foreign import ccall unsafe "lookup3.h _jenkins_hashlittle2" hashLittle2
    :: Ptr a -> CSize -> Ptr Word32 -> Ptr Word32 -> IO ()

class Hashable a where
    -- | Compute a 32-bit hash of a value.  The salt value perturbs
    -- the result.
    hashIO32 :: a               -- ^ value to hash
             -> Word32          -- ^ salt
             -> IO Word32

    -- | Compute a 64-bit hash of a value.  The first salt value
    -- perturbs the first element of the result, and the second salt
    -- perturbs the second.
    hashIO64 :: a               -- ^ value to hash
             -> Word64           -- ^ salt
             -> IO Word64
    hashIO64 a
v Word64
salt = do
                   let s1 :: Word32
s1 = forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word64
salt forall a. Bits a => a -> Int -> a
`unsafeShiftR` Int
32) forall a. Bits a => a -> a -> a
.&. forall a. Bounded a => a
maxBound
                       s2 :: Word32
s2 = forall a b. (Integral a, Num b) => a -> b
fromIntegral Word64
salt
                   Word32
h1 <- forall a. Hashable a => a -> Word32 -> IO Word32
hashIO32 a
v Word32
s1
                   Word32
h2 <- forall a. Hashable a => a -> Word32 -> IO Word32
hashIO32 a
v Word32
s2
                   forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ (forall a b. (Integral a, Num b) => a -> b
fromIntegral Word32
h1 forall a. Bits a => a -> Int -> a
`unsafeShiftL` Int
32) forall a. Bits a => a -> a -> a
.|. forall a b. (Integral a, Num b) => a -> b
fromIntegral Word32
h2

-- | Compute a 32-bit hash.
hash32 :: Hashable a => a -> Word32
hash32 :: forall a. Hashable a => a -> Word32
hash32 = forall a. Hashable a => Word32 -> a -> Word32
hashSalt32 Word32
0x16fc397c

hash64 :: Hashable a => a -> Word64
hash64 :: forall a. Hashable a => a -> Word64
hash64 = forall a. Hashable a => Word64 -> a -> Word64
hashSalt64 Word64
0x16fc397cf62f64d3

-- | Compute a salted 32-bit hash.
hashSalt32 :: Hashable a => Word32  -- ^ salt
           -> a                 -- ^ value to hash
           -> Word32
{-# INLINE hashSalt32 #-}
hashSalt32 :: forall a. Hashable a => Word32 -> a -> Word32
hashSalt32 Word32
salt a
k = forall a. IO a -> a
unsafePerformIO forall a b. (a -> b) -> a -> b
$ forall a. Hashable a => a -> Word32 -> IO Word32
hashIO32 a
k Word32
salt

-- | Compute a salted 64-bit hash.
hashSalt64 :: Hashable a => Word64  -- ^ salt
           -> a                 -- ^ value to hash
           -> Word64
{-# INLINE hashSalt64 #-}
hashSalt64 :: forall a. Hashable a => Word64 -> a -> Word64
hashSalt64 Word64
salt a
k = forall a. IO a -> a
unsafePerformIO forall a b. (a -> b) -> a -> b
$ forall a. Hashable a => a -> Word64 -> IO Word64
hashIO64 a
k Word64
salt

-- | Compute a list of 32-bit hashes.  The value to hash may be
-- inspected as many times as there are hashes requested.
hashes :: Hashable a => Int     -- ^ number of hashes to compute
       -> a                     -- ^ value to hash
       -> [Word32]
hashes :: forall a. Hashable a => Int -> a -> [Word32]
hashes Int
n a
v = forall b a. (b -> Maybe (a, b)) -> b -> [a]
unfoldr forall {a}.
(Ord a, Num a) =>
(a, Word32) -> Maybe (Word32, (a, Word32))
go (Int
n,Word32
0x3f56da2d)
    where go :: (a, Word32) -> Maybe (Word32, (a, Word32))
go (a
k,Word32
s) | a
k forall a. Ord a => a -> a -> Bool
<= a
0    = forall a. Maybe a
Nothing
                   | Bool
otherwise = let s' :: Word32
s' = forall a. Hashable a => Word32 -> a -> Word32
hashSalt32 Word32
s a
v
                                 in forall a. a -> Maybe a
Just (Word32
s', (a
kforall a. Num a => a -> a -> a
-a
1,Word32
s'))

-- | Compute a list of 32-bit hashes relatively cheaply.  The value to
-- hash is inspected at most twice, regardless of the number of hashes
-- requested.
--
-- We use a variant of Kirsch and Mitzenmacher's technique from \"Less
-- Hashing, Same Performance: Building a Better Bloom Filter\",
-- <http://www.eecs.harvard.edu/~kirsch/pubs/bbbf/esa06.pdf>.
--
-- Where Kirsch and Mitzenmacher multiply the second hash by a
-- coefficient, we shift right by the coefficient.  This offers better
-- performance (as a shift is much cheaper than a multiply), and the
-- low order bits of the final hash stay well mixed.
cheapHashes :: Hashable a => Int -- ^ number of hashes to compute
            -> a                 -- ^ value to hash
            -> [Word32]
{-# SPECIALIZE cheapHashes :: Int -> SB.ByteString -> [Word32] #-}
{-# SPECIALIZE cheapHashes :: Int -> LB.ByteString -> [Word32] #-}
{-# SPECIALIZE cheapHashes :: Int -> String -> [Word32] #-}
cheapHashes :: forall a. Hashable a => Int -> a -> [Word32]
cheapHashes Int
k a
v = Int -> [Word32]
go Int
0
    where go :: Int -> [Word32]
go Int
i | Int
i forall a. Eq a => a -> a -> Bool
== Int
j = []
               | Bool
otherwise = Word32
hash forall a. a -> [a] -> [a]
: Int -> [Word32]
go (Int
i forall a. Num a => a -> a -> a
+ Int
1)
               where !hash :: Word32
hash = Word32
h1 forall a. Num a => a -> a -> a
+ (Word32
h2 forall a. Bits a => a -> Int -> a
`unsafeShiftR` Int
i)
          h1 :: Word32
h1 = forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word64
h forall a. Bits a => a -> Int -> a
`unsafeShiftR` Int
32)
          h2 :: Word32
h2 = forall a b. (Integral a, Num b) => a -> b
fromIntegral Word64
h
          h :: Word64
h = forall a. Hashable a => Word64 -> a -> Word64
hashSalt64 Word64
0x9150a946c4a8966e a
v
          j :: Int
j = forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
k

instance Hashable () where
    hashIO32 :: () -> Word32 -> IO Word32
hashIO32 ()
_ Word32
salt = forall (m :: * -> *) a. Monad m => a -> m a
return Word32
salt

instance Hashable Integer where
    hashIO32 :: Integer -> Word32 -> IO Word32
hashIO32 Integer
k Word32
salt | Integer
k forall a. Ord a => a -> a -> Bool
< Integer
0 = forall a. Hashable a => a -> Word32 -> IO Word32
hashIO32 (forall b a. (b -> Maybe (a, b)) -> b -> [a]
unfoldr forall {b}. (Integral b, Bits b) => b -> Maybe (Word32, b)
go (-Integer
k))
                                   (Word32
salt forall a. Bits a => a -> a -> a
`xor` Word32
0x3ece731e)
                  | Bool
otherwise = forall a. Hashable a => a -> Word32 -> IO Word32
hashIO32 (forall b a. (b -> Maybe (a, b)) -> b -> [a]
unfoldr forall {b}. (Integral b, Bits b) => b -> Maybe (Word32, b)
go Integer
k) Word32
salt
        where go :: b -> Maybe (Word32, b)
go b
0 = forall a. Maybe a
Nothing
              go b
i = forall a. a -> Maybe a
Just (forall a b. (Integral a, Num b) => a -> b
fromIntegral b
i :: Word32, b
i forall a. Bits a => a -> Int -> a
`unsafeShiftR` Int
32)

instance Hashable Bool where
    hashIO32 :: Bool -> Word32 -> IO Word32
hashIO32 = forall a. Storable a => a -> Word32 -> IO Word32
hashOne32
    hashIO64 :: Bool -> Word64 -> IO Word64
hashIO64 = forall a. Storable a => a -> Word64 -> IO Word64
hashOne64

instance Hashable Ordering where
    hashIO32 :: Ordering -> Word32 -> IO Word32
hashIO32 = forall a. Hashable a => a -> Word32 -> IO Word32
hashIO32 forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Enum a => a -> Int
fromEnum
    hashIO64 :: Ordering -> Word64 -> IO Word64
hashIO64 = forall a. Hashable a => a -> Word64 -> IO Word64
hashIO64 forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Enum a => a -> Int
fromEnum

instance Hashable Char where
    hashIO32 :: Char -> Word32 -> IO Word32
hashIO32 = forall a. Storable a => a -> Word32 -> IO Word32
hashOne32
    hashIO64 :: Char -> Word64 -> IO Word64
hashIO64 = forall a. Storable a => a -> Word64 -> IO Word64
hashOne64

instance Hashable Int where
    hashIO32 :: Int -> Word32 -> IO Word32
hashIO32 = forall a. Storable a => a -> Word32 -> IO Word32
hashOne32
    hashIO64 :: Int -> Word64 -> IO Word64
hashIO64 = forall a. Storable a => a -> Word64 -> IO Word64
hashOne64

instance Hashable Float where
    hashIO32 :: Float -> Word32 -> IO Word32
hashIO32 = forall a. Storable a => a -> Word32 -> IO Word32
hashOne32
    hashIO64 :: Float -> Word64 -> IO Word64
hashIO64 = forall a. Storable a => a -> Word64 -> IO Word64
hashOne64

instance Hashable Double where
    hashIO32 :: Double -> Word32 -> IO Word32
hashIO32 = forall a. Storable a => a -> Word32 -> IO Word32
hashOne32
    hashIO64 :: Double -> Word64 -> IO Word64
hashIO64 = forall a. Storable a => a -> Word64 -> IO Word64
hashOne64

instance Hashable Int8 where
    hashIO32 :: Int8 -> Word32 -> IO Word32
hashIO32 = forall a. Storable a => a -> Word32 -> IO Word32
hashOne32
    hashIO64 :: Int8 -> Word64 -> IO Word64
hashIO64 = forall a. Storable a => a -> Word64 -> IO Word64
hashOne64

instance Hashable Int16 where
    hashIO32 :: Int16 -> Word32 -> IO Word32
hashIO32 = forall a. Storable a => a -> Word32 -> IO Word32
hashOne32
    hashIO64 :: Int16 -> Word64 -> IO Word64
hashIO64 = forall a. Storable a => a -> Word64 -> IO Word64
hashOne64

instance Hashable Int32 where
    hashIO32 :: Int32 -> Word32 -> IO Word32
hashIO32 = forall a. Storable a => a -> Word32 -> IO Word32
hashOne32
    hashIO64 :: Int32 -> Word64 -> IO Word64
hashIO64 = forall a. Storable a => a -> Word64 -> IO Word64
hashOne64

instance Hashable Int64 where
    hashIO32 :: Int64 -> Word32 -> IO Word32
hashIO32 = forall a. Storable a => a -> Word32 -> IO Word32
hashOne32
    hashIO64 :: Int64 -> Word64 -> IO Word64
hashIO64 = forall a. Storable a => a -> Word64 -> IO Word64
hashOne64

instance Hashable Word8 where
    hashIO32 :: Word8 -> Word32 -> IO Word32
hashIO32 = forall a. Storable a => a -> Word32 -> IO Word32
hashOne32
    hashIO64 :: Word8 -> Word64 -> IO Word64
hashIO64 = forall a. Storable a => a -> Word64 -> IO Word64
hashOne64

instance Hashable Word16 where
    hashIO32 :: Word16 -> Word32 -> IO Word32
hashIO32 = forall a. Storable a => a -> Word32 -> IO Word32
hashOne32
    hashIO64 :: Word16 -> Word64 -> IO Word64
hashIO64 = forall a. Storable a => a -> Word64 -> IO Word64
hashOne64

instance Hashable Word32 where
    hashIO32 :: Word32 -> Word32 -> IO Word32
hashIO32 = forall a. Storable a => a -> Word32 -> IO Word32
hashOne32
    hashIO64 :: Word32 -> Word64 -> IO Word64
hashIO64 = forall a. Storable a => a -> Word64 -> IO Word64
hashOne64

instance Hashable Word64 where
    hashIO32 :: Word64 -> Word32 -> IO Word32
hashIO32 = forall a. Storable a => a -> Word32 -> IO Word32
hashOne32
    hashIO64 :: Word64 -> Word64 -> IO Word64
hashIO64 = forall a. Storable a => a -> Word64 -> IO Word64
hashOne64

-- | A fast unchecked shift.  Nasty, but otherwise GHC 6.8.2 does a
-- test and branch on every shift.
div4 :: CSize -> CSize
div4 :: CSize -> CSize
div4 CSize
k = forall a b. (Integral a, Num b) => a -> b
fromIntegral ((forall a b. (Integral a, Num b) => a -> b
fromIntegral CSize
k :: HTYPE_SIZE_T) `unsafeShiftR` 2)

alignedHash :: Ptr a -> CSize -> Word32 -> IO Word32
alignedHash :: forall a. Ptr a -> CSize -> Word32 -> IO Word32
alignedHash Ptr a
ptr CSize
bytes Word32
salt
    | CSize
bytes forall a. Bits a => a -> a -> a
.&. CSize
3 forall a. Eq a => a -> a -> Bool
== CSize
0 = Ptr Word32 -> CSize -> Word32 -> IO Word32
hashWord (forall a b. Ptr a -> Ptr b
castPtr Ptr a
ptr) (CSize -> CSize
div4 CSize
bytes) Word32
salt'
    | Bool
otherwise        = forall a. Ptr a -> CSize -> Word32 -> IO Word32
hashLittle Ptr a
ptr CSize
bytes Word32
salt'
  where salt' :: Word32
salt' = forall a b. (Integral a, Num b) => a -> b
fromIntegral Word32
salt

-- Inlined from Foreign.Marshal.Utils, for performance reasons.
with :: Storable a => a -> (Ptr a -> IO b) -> IO b
with :: forall a b. Storable a => a -> (Ptr a -> IO b) -> IO b
with a
val Ptr a -> IO b
f  =
  forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr a
ptr -> do
    forall a. Storable a => Ptr a -> a -> IO ()
poke Ptr a
ptr a
val
    Ptr a -> IO b
f Ptr a
ptr

alignedHash2 :: Ptr a -> CSize -> Word64 -> IO Word64
alignedHash2 :: forall a. Ptr a -> CSize -> Word64 -> IO Word64
alignedHash2 Ptr a
ptr CSize
bytes Word64
salt =
    forall a b. Storable a => a -> (Ptr a -> IO b) -> IO b
with (forall a b. (Integral a, Num b) => a -> b
fromIntegral Word64
salt) forall a b. (a -> b) -> a -> b
$ \Ptr Word64
sp -> do
      let p1 :: Ptr b
p1 = forall a b. Ptr a -> Ptr b
castPtr Ptr Word64
sp
          p2 :: Ptr b
p2 = forall a b. Ptr a -> Ptr b
castPtr Ptr Word64
sp forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
4
      forall a. Ptr a -> CSize -> Ptr Word32 -> Ptr Word32 -> IO ()
doubleHash Ptr a
ptr CSize
bytes forall {b}. Ptr b
p1 forall {b}. Ptr b
p2
      forall a. Storable a => Ptr a -> IO a
peek Ptr Word64
sp

doubleHash :: Ptr a -> CSize -> Ptr Word32 -> Ptr Word32 -> IO ()
doubleHash :: forall a. Ptr a -> CSize -> Ptr Word32 -> Ptr Word32 -> IO ()
doubleHash Ptr a
ptr CSize
bytes Ptr Word32
p1 Ptr Word32
p2
          | CSize
bytes forall a. Bits a => a -> a -> a
.&. CSize
3 forall a. Eq a => a -> a -> Bool
== CSize
0 = Ptr Word32 -> CSize -> Ptr Word32 -> Ptr Word32 -> IO ()
hashWord2 (forall a b. Ptr a -> Ptr b
castPtr Ptr a
ptr) (CSize -> CSize
div4 CSize
bytes) Ptr Word32
p1 Ptr Word32
p2
          | Bool
otherwise        = forall a. Ptr a -> CSize -> Ptr Word32 -> Ptr Word32 -> IO ()
hashLittle2 Ptr a
ptr CSize
bytes Ptr Word32
p1 Ptr Word32
p2

instance Hashable SB.ByteString where
    hashIO32 :: ByteString -> Word32 -> IO Word32
hashIO32 ByteString
bs Word32
salt = forall a. ByteString -> (CString -> Int -> IO a) -> IO a
unsafeUseAsCStringLen ByteString
bs forall a b. (a -> b) -> a -> b
$ \CString
ptr Int
len ->
                       forall a. Ptr a -> CSize -> Word32 -> IO Word32
alignedHash CString
ptr (forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
len) Word32
salt

    {-# INLINE hashIO64 #-}
    hashIO64 :: ByteString -> Word64 -> IO Word64
hashIO64 ByteString
bs Word64
salt = forall a. ByteString -> (CString -> Int -> IO a) -> IO a
unsafeUseAsCStringLen ByteString
bs forall a b. (a -> b) -> a -> b
$ \CString
ptr Int
len ->
                       forall a. Ptr a -> CSize -> Word64 -> IO Word64
alignedHash2 CString
ptr (forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
len) Word64
salt

rechunk :: LB.ByteString -> [SB.ByteString]
rechunk :: ByteString -> [ByteString]
rechunk ByteString
s | ByteString -> Bool
LB.null ByteString
s = []
          | Bool
otherwise = let (ByteString
pre,ByteString
suf) = Int64 -> ByteString -> (ByteString, ByteString)
LB.splitAt Int64
chunkSize ByteString
s
                        in  ByteString -> ByteString
repack ByteString
pre forall a. a -> [a] -> [a]
: ByteString -> [ByteString]
rechunk ByteString
suf
    where repack :: ByteString -> ByteString
repack    = [ByteString] -> ByteString
SB.concat forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> [ByteString]
LB.toChunks
          chunkSize :: Int64
chunkSize = forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
LB.defaultChunkSize

instance Hashable LB.ByteString where
    hashIO32 :: ByteString -> Word32 -> IO Word32
hashIO32 ByteString
bs Word32
salt = forall (t :: * -> *) (m :: * -> *) b a.
(Foldable t, Monad m) =>
(b -> a -> m b) -> b -> t a -> m b
foldM (forall a b c. (a -> b -> c) -> b -> a -> c
flip forall a. Hashable a => a -> Word32 -> IO Word32
hashIO32) Word32
salt (ByteString -> [ByteString]
rechunk ByteString
bs)

    {-# INLINE hashIO64 #-}
    hashIO64 :: ByteString -> Word64 -> IO Word64
hashIO64 = ByteString -> Word64 -> IO Word64
hashChunks

instance Hashable a => Hashable (Maybe a) where
    hashIO32 :: Maybe a -> Word32 -> IO Word32
hashIO32 Maybe a
Nothing Word32
salt = forall (m :: * -> *) a. Monad m => a -> m a
return Word32
salt
    hashIO32 (Just a
k) Word32
salt = forall a. Hashable a => a -> Word32 -> IO Word32
hashIO32 a
k Word32
salt
    hashIO64 :: Maybe a -> Word64 -> IO Word64
hashIO64 Maybe a
Nothing Word64
salt = forall (m :: * -> *) a. Monad m => a -> m a
return Word64
salt
    hashIO64 (Just a
k) Word64
salt = forall a. Hashable a => a -> Word64 -> IO Word64
hashIO64 a
k Word64
salt

instance (Hashable a, Hashable b) => Hashable (Either a b) where
    hashIO32 :: Either a b -> Word32 -> IO Word32
hashIO32 (Left a
a) Word32
salt = forall a. Hashable a => a -> Word32 -> IO Word32
hashIO32 a
a Word32
salt
    hashIO32 (Right b
b) Word32
salt = forall a. Hashable a => a -> Word32 -> IO Word32
hashIO32 b
b (Word32
salt forall a. Num a => a -> a -> a
+ Word32
1)
    hashIO64 :: Either a b -> Word64 -> IO Word64
hashIO64 (Left a
a) Word64
salt = forall a. Hashable a => a -> Word64 -> IO Word64
hashIO64 a
a Word64
salt
    hashIO64 (Right b
b) Word64
salt = forall a. Hashable a => a -> Word64 -> IO Word64
hashIO64 b
b (Word64
salt forall a. Num a => a -> a -> a
+ Word64
1)

instance (Hashable a, Hashable b) => Hashable (a, b) where
    hashIO32 :: (a, b) -> Word32 -> IO Word32
hashIO32 (a
a,b
b) Word32
salt = forall a. Hashable a => a -> Word32 -> IO Word32
hashIO32 a
a Word32
salt forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall a. Hashable a => a -> Word32 -> IO Word32
hashIO32 b
b
    hashIO64 :: (a, b) -> Word64 -> IO Word64
hashIO64 (a
a,b
b) Word64
salt = forall a. Hashable a => a -> Word64 -> IO Word64
hashIO64 a
a Word64
salt forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall a. Hashable a => a -> Word64 -> IO Word64
hashIO64 b
b

instance (Hashable a, Hashable b, Hashable c) => Hashable (a, b, c) where
    hashIO32 :: (a, b, c) -> Word32 -> IO Word32
hashIO32 (a
a,b
b,c
c) Word32
salt = forall a. Hashable a => a -> Word32 -> IO Word32
hashIO32 a
a Word32
salt forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall a. Hashable a => a -> Word32 -> IO Word32
hashIO32 b
b forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall a. Hashable a => a -> Word32 -> IO Word32
hashIO32 c
c

instance (Hashable a, Hashable b, Hashable c, Hashable d) =>
    Hashable (a, b, c, d) where
    hashIO32 :: (a, b, c, d) -> Word32 -> IO Word32
hashIO32 (a
a,b
b,c
c,d
d) Word32
salt =
        forall a. Hashable a => a -> Word32 -> IO Word32
hashIO32 a
a Word32
salt forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall a. Hashable a => a -> Word32 -> IO Word32
hashIO32 b
b forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall a. Hashable a => a -> Word32 -> IO Word32
hashIO32 c
c forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall a. Hashable a => a -> Word32 -> IO Word32
hashIO32 d
d

instance (Hashable a, Hashable b, Hashable c, Hashable d, Hashable e) =>
    Hashable (a, b, c, d, e) where
    hashIO32 :: (a, b, c, d, e) -> Word32 -> IO Word32
hashIO32 (a
a,b
b,c
c,d
d,e
e) Word32
salt =
        forall a. Hashable a => a -> Word32 -> IO Word32
hashIO32 a
a Word32
salt forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall a. Hashable a => a -> Word32 -> IO Word32
hashIO32 b
b forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall a. Hashable a => a -> Word32 -> IO Word32
hashIO32 c
c forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall a. Hashable a => a -> Word32 -> IO Word32
hashIO32 d
d forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall a. Hashable a => a -> Word32 -> IO Word32
hashIO32 e
e

instance Storable a => Hashable [a] where
    hashIO32 :: [a] -> Word32 -> IO Word32
hashIO32 = forall a. Storable a => [a] -> Word32 -> IO Word32
hashList32

    {-# INLINE hashIO64 #-}
    hashIO64 :: [a] -> Word64 -> IO Word64
hashIO64 = forall a. Storable a => [a] -> Word64 -> IO Word64
hashList64

-- | Compute a 32-bit hash of a 'Storable' instance.
hashOne32 :: Storable a => a -> Word32 -> IO Word32
hashOne32 :: forall a. Storable a => a -> Word32 -> IO Word32
hashOne32 a
k Word32
salt = forall a b. Storable a => a -> (Ptr a -> IO b) -> IO b
with a
k forall a b. (a -> b) -> a -> b
$ \Ptr a
ptr ->
                 forall a. Ptr a -> CSize -> Word32 -> IO Word32
alignedHash Ptr a
ptr (forall a b. (Integral a, Num b) => a -> b
fromIntegral (forall a. Storable a => a -> Int
sizeOf a
k)) Word32
salt

-- | Compute a 64-bit hash of a 'Storable' instance.
hashOne64 :: Storable a => a -> Word64 -> IO Word64
hashOne64 :: forall a. Storable a => a -> Word64 -> IO Word64
hashOne64 a
k Word64
salt = forall a b. Storable a => a -> (Ptr a -> IO b) -> IO b
with a
k forall a b. (a -> b) -> a -> b
$ \Ptr a
ptr ->
                   forall a. Ptr a -> CSize -> Word64 -> IO Word64
alignedHash2 Ptr a
ptr (forall a b. (Integral a, Num b) => a -> b
fromIntegral (forall a. Storable a => a -> Int
sizeOf a
k)) Word64
salt

-- | Compute a 32-bit hash of a list of 'Storable' instances.
hashList32 :: Storable a => [a] -> Word32 -> IO Word32
hashList32 :: forall a. Storable a => [a] -> Word32 -> IO Word32
hashList32 [a]
xs Word32
salt =
    forall a b. Storable a => [a] -> (Int -> Ptr a -> IO b) -> IO b
withArrayLen [a]
xs forall a b. (a -> b) -> a -> b
$ \Int
len Ptr a
ptr ->
        forall a. Ptr a -> CSize -> Word32 -> IO Word32
alignedHash Ptr a
ptr (forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int
len forall a. Num a => a -> a -> a
* forall a. Storable a => a -> Int
sizeOf (forall a. [a] -> a
head [a]
xs))) Word32
salt

-- | Compute a 64-bit hash of a list of 'Storable' instances.
hashList64 :: Storable a => [a] -> Word64 -> IO Word64
hashList64 :: forall a. Storable a => [a] -> Word64 -> IO Word64
hashList64 [a]
xs Word64
salt =
    forall a b. Storable a => [a] -> (Int -> Ptr a -> IO b) -> IO b
withArrayLen [a]
xs forall a b. (a -> b) -> a -> b
$ \Int
len Ptr a
ptr ->
        forall a. Ptr a -> CSize -> Word64 -> IO Word64
alignedHash2 Ptr a
ptr (forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int
len forall a. Num a => a -> a -> a
* forall a. Storable a => a -> Int
sizeOf (forall a. [a] -> a
head [a]
xs))) Word64
salt

unsafeUseAsCStringLen :: SB.ByteString -> (CString -> Int -> IO a) -> IO a
unsafeUseAsCStringLen :: forall a. ByteString -> (CString -> Int -> IO a) -> IO a
unsafeUseAsCStringLen (PS ForeignPtr Word8
fp Int
o Int
l) CString -> Int -> IO a
action =
    forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr Word8
fp forall a b. (a -> b) -> a -> b
$ \Ptr Word8
p -> CString -> Int -> IO a
action (Ptr Word8
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
o) Int
l

type HashState = Ptr Word32

foreign import ccall unsafe "lookup3.h _jenkins_little2_begin" c_begin
    :: Ptr Word32 -> Ptr Word32 -> HashState -> IO ()

foreign import ccall unsafe "lookup3.h _jenkins_little2_frag" c_frag
    :: Ptr a -> CSize -> HashState -> CSize -> IO CSize

foreign import ccall unsafe "lookup3.h _jenkins_little2_step" c_step
    :: Ptr a -> CSize -> HashState -> IO CSize

foreign import ccall unsafe "lookup3.h _jenkins_little2_end" c_end
    :: CInt -> Ptr Word32 -> Ptr Word32 -> HashState -> IO ()

unsafeAdjustCStringLen :: SB.ByteString -> Int -> (CString -> Int -> IO a)
                       -> IO a
unsafeAdjustCStringLen :: forall a. ByteString -> Int -> (CString -> Int -> IO a) -> IO a
unsafeAdjustCStringLen (PS ForeignPtr Word8
fp Int
o Int
l) Int
d CString -> Int -> IO a
action
  | Int
d forall a. Ord a => a -> a -> Bool
> Int
l     = CString -> Int -> IO a
action forall {b}. Ptr b
nullPtr Int
0
  | Bool
otherwise = forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr Word8
fp forall a b. (a -> b) -> a -> b
$ \Ptr Word8
p -> CString -> Int -> IO a
action (Ptr Word8
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` (Int
o forall a. Num a => a -> a -> a
+ Int
d)) (Int
l forall a. Num a => a -> a -> a
- Int
d)

hashChunks :: LB.ByteString -> Word64 -> IO Word64
hashChunks :: ByteString -> Word64 -> IO Word64
hashChunks ByteString
s Word64
salt = do
    forall a b. Storable a => a -> (Ptr a -> IO b) -> IO b
with (forall a b. (Integral a, Num b) => a -> b
fromIntegral Word64
salt) forall a b. (a -> b) -> a -> b
$ \Ptr Word64
sp -> do
      let p1 :: Ptr b
p1 = forall a b. Ptr a -> Ptr b
castPtr Ptr Word64
sp
          p2 :: Ptr b
p2 = forall a b. Ptr a -> Ptr b
castPtr Ptr Word64
sp forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
4
      forall a b. Storable a => Int -> (Ptr a -> IO b) -> IO b
allocaArray Int
3 forall a b. (a -> b) -> a -> b
$ \Ptr Word32
st -> do
        let step :: LB.ByteString -> Int -> IO Int
            step :: ByteString -> Int -> IO Int
step (LB.Chunk ByteString
x ByteString
xs) Int
off = do
              CSize
unread <- forall a. ByteString -> Int -> (CString -> Int -> IO a) -> IO a
unsafeAdjustCStringLen ByteString
x Int
off forall a b. (a -> b) -> a -> b
$ \CString
ptr Int
len ->
                        forall a. Ptr a -> CSize -> Ptr Word32 -> IO CSize
c_step CString
ptr (forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
len) Ptr Word32
st
              if CSize
unread forall a. Ord a => a -> a -> Bool
> CSize
0
                then ByteString -> CSize -> IO Int
frag ByteString
xs CSize
unread
                else ByteString -> Int -> IO Int
step ByteString
xs Int
0
            step ByteString
_ Int
_ = forall (m :: * -> *) a. Monad m => a -> m a
return Int
0

            frag :: LB.ByteString -> CSize -> IO Int
            frag :: ByteString -> CSize -> IO Int
frag c :: ByteString
c@(LB.Chunk ByteString
x ByteString
xs) CSize
stoff = do
              CSize
nstoff <- forall a. ByteString -> (CString -> Int -> IO a) -> IO a
unsafeUseAsCStringLen ByteString
x forall a b. (a -> b) -> a -> b
$ \CString
ptr Int
len -> do
                forall a. Ptr a -> CSize -> Ptr Word32 -> CSize -> IO CSize
c_frag CString
ptr (forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
len) Ptr Word32
st CSize
stoff
              if CSize
nstoff forall a. Eq a => a -> a -> Bool
== CSize
12
                then ByteString -> Int -> IO Int
step ByteString
c (forall a b. (Integral a, Num b) => a -> b
fromIntegral (CSize
nstoff forall a. Num a => a -> a -> a
- CSize
stoff))
                else ByteString -> CSize -> IO Int
frag ByteString
xs CSize
nstoff
            frag ByteString
LB.Empty CSize
stoff = forall (m :: * -> *) a. Monad m => a -> m a
return (forall a b. (Integral a, Num b) => a -> b
fromIntegral (CSize
12 forall a. Num a => a -> a -> a
- CSize
stoff))
        Ptr Word32 -> Ptr Word32 -> Ptr Word32 -> IO ()
c_begin forall {b}. Ptr b
p1 forall {b}. Ptr b
p2 Ptr Word32
st
        Int
unread <- ByteString -> Int -> IO Int
step ByteString
s Int
0
        CInt -> Ptr Word32 -> Ptr Word32 -> Ptr Word32 -> IO ()
c_end (forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
unread) forall {b}. Ptr b
p1 forall {b}. Ptr b
p2 Ptr Word32
st
      forall a. Storable a => Ptr a -> IO a
peek Ptr Word64
sp