module Data.BloomFilter.Hash
(
Hashable(..)
, hash32
, hash64
, hashSalt32
, hashSalt64
, hashes
, cheapHashes
, hashOne32
, hashOne64
, hashList32
, hashList64
) where
import Control.Monad (foldM)
import Data.Bits ((.&.), (.|.), xor)
import Data.BloomFilter.Util (FastShift(..))
import Data.List (unfoldr)
import Data.Int (Int8, Int16, Int32, Int64)
import Data.Word (Word8, Word16, Word32, Word64)
import Foreign.C.Types (CInt, CSize)
import Foreign.Marshal.Array (withArrayLen)
import Foreign.Marshal.Utils (with)
import Foreign.Ptr (Ptr, castPtr, plusPtr)
import Foreign.Storable (Storable, peek, sizeOf)
import System.IO.Unsafe (unsafePerformIO)
import qualified Data.ByteString as SB
import qualified Data.ByteString.Lazy as LB
#include "HsBaseConfig.h"
foreign import ccall unsafe "_jenkins_hashword" hashWord
:: Ptr CInt -> CSize -> CInt -> IO CInt
foreign import ccall unsafe "_jenkins_hashword2" hashWord2
:: Ptr CInt -> CSize -> Ptr CInt -> Ptr CInt -> IO ()
foreign import ccall unsafe "_jenkins_hashlittle" hashLittle
:: Ptr a -> CSize -> CInt -> IO CInt
foreign import ccall unsafe "_jenkins_hashlittle2" hashLittle2
:: Ptr a -> CSize -> Ptr CInt -> Ptr CInt -> IO ()
class Hashable a where
hashIO32 :: a
-> Word32
-> IO Word32
hashIO64 :: a
-> Word64
-> IO Word64
hashIO64 v salt = do
let s1 = fromIntegral (salt `shiftR` 32) .&. maxBound
s2 = fromIntegral salt
h1 <- hashIO32 v s1
h2 <- hashIO32 v s2
return $ (fromIntegral h1 `shiftL` 32) .|. fromIntegral h2
hash32 :: Hashable a => a -> Word32
hash32 = hashSalt32 0x106fc397
hash64 :: Hashable a => a -> Word64
hash64 = hashSalt64 0x106fc397cf62f64d3
hashSalt32 :: Hashable a => Word32
-> a
-> Word32
hashSalt32 salt k =
let !r = unsafePerformIO $ hashIO32 k salt
in r
hashSalt64 :: Hashable a => Word64
-> a
-> Word64
hashSalt64 salt k =
let !r = unsafePerformIO $ hashIO64 k salt
in r
hashes :: Hashable a => Int
-> a
-> [Word32]
hashes n v = unfoldr go (n,0x3f56da2d3ddbb9f6)
where go (k,s) | k <= 0 = Nothing
| otherwise = let s' = hashSalt32 s v
in Just (s', (k1,s'))
cheapHashes :: Hashable a => Int
-> a
-> [Word32]
cheapHashes k v = [h1 + (h2 `shiftR` i) | i <- [0..j]]
where h = hashSalt64 0x9150a946c4a8966e v
h1 = fromIntegral (h `shiftR` 32) .&. maxBound
h2 = fromIntegral h
j = fromIntegral k 1
instance Hashable () where
hashIO32 _ salt = return salt
instance Hashable Integer where
hashIO32 k salt | k < 0 = hashIO32 (unfoldr go (k))
(salt `xor` 0x3ece731e9c1c64f8)
| otherwise = hashIO32 (unfoldr go k) salt
where go 0 = Nothing
go i = Just (fromIntegral i :: Word32, i `shiftR` 32)
instance Hashable Bool where
hashIO32 = hashOne32
hashIO64 = hashOne64
instance Hashable Ordering where
hashIO32 = hashIO32 . fromEnum
hashIO64 = hashIO64 . fromEnum
instance Hashable Char where
hashIO32 = hashOne32
hashIO64 = hashOne64
instance Hashable Int where
hashIO32 = hashOne32
hashIO64 = hashOne64
instance Hashable Float where
hashIO32 = hashOne32
hashIO64 = hashOne64
instance Hashable Double where
hashIO32 = hashOne32
hashIO64 = hashOne64
instance Hashable Int8 where
hashIO32 = hashOne32
hashIO64 = hashOne64
instance Hashable Int16 where
hashIO32 = hashOne32
hashIO64 = hashOne64
instance Hashable Int32 where
hashIO32 = hashOne32
hashIO64 = hashOne64
instance Hashable Int64 where
hashIO32 = hashOne32
hashIO64 = hashOne64
instance Hashable Word8 where
hashIO32 = hashOne32
hashIO64 = hashOne64
instance Hashable Word16 where
hashIO32 = hashOne32
hashIO64 = hashOne64
instance Hashable Word32 where
hashIO32 = hashOne32
hashIO64 = hashOne64
instance Hashable Word64 where
hashIO32 = hashOne32
hashIO64 = hashOne64
div4 :: CSize -> CSize
div4 k = fromIntegral ((fromIntegral k :: HTYPE_SIZE_T) `shiftR` 2)
alignedHash :: Ptr a -> CSize -> Word32 -> IO Word32
alignedHash ptr bytes salt
| bytes .&. 3 == 0 = hashWord (castPtr ptr) (div4 bytes) salt' >>= cast32
| otherwise = hashLittle ptr bytes salt' >>= cast32
where salt' = fromIntegral salt
cast32 :: CInt -> IO Word32
cast32 = return . fromIntegral
alignedHash2 :: Ptr a -> CSize -> Word64 -> IO Word64
alignedHash2 ptr bytes salt =
with (fromIntegral salt) $ \sp -> do
let p1 = castPtr sp
p2 = castPtr sp `plusPtr` 4
go p1 p2
peek sp
where go p1 p2
| bytes .&. 3 == 0 = hashWord2 (castPtr ptr) (div4 bytes) p1 p2
| otherwise = hashLittle2 ptr bytes p1 p2
instance Hashable SB.ByteString where
hashIO32 bs salt = SB.useAsCStringLen bs $ \(ptr, len) -> do
alignedHash ptr (fromIntegral len) salt
hashIO64 bs salt = SB.useAsCStringLen bs $ \(ptr, len) -> do
alignedHash2 ptr (fromIntegral len) salt
instance Hashable LB.ByteString where
hashIO32 bs salt = foldM (flip hashIO32) salt (LB.toChunks bs)
hashIO64 bs salt = foldM go salt (LB.toChunks bs)
where go a s = hashIO64 s a
instance Hashable a => Hashable (Maybe a) where
hashIO32 Nothing salt = return salt
hashIO32 (Just k) salt = hashIO32 k salt
hashIO64 Nothing salt = return salt
hashIO64 (Just k) salt = hashIO64 k salt
instance (Hashable a, Hashable b) => Hashable (Either a b) where
hashIO32 (Left a) salt = hashIO32 a salt
hashIO32 (Right b) salt = hashIO32 b (salt + 1)
hashIO64 (Left a) salt = hashIO64 a salt
hashIO64 (Right b) salt = hashIO64 b (salt + 1)
instance (Hashable a, Hashable b) => Hashable (a, b) where
hashIO32 (a,b) salt = hashIO32 a salt >>= hashIO32 b
hashIO64 (a,b) salt = hashIO64 a salt >>= hashIO64 b
instance (Hashable a, Hashable b, Hashable c) => Hashable (a, b, c) where
hashIO32 (a,b,c) salt = hashIO32 a salt >>= hashIO32 b >>= hashIO32 c
instance (Hashable a, Hashable b, Hashable c, Hashable d) =>
Hashable (a, b, c, d) where
hashIO32 (a,b,c,d) salt =
hashIO32 a salt >>= hashIO32 b >>= hashIO32 c >>= hashIO32 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) salt =
hashIO32 a salt >>= hashIO32 b >>= hashIO32 c >>= hashIO32 d >>= hashIO32 e
instance Storable a => Hashable [a] where
hashIO32 = hashList32
hashIO64 = hashList64
hashOne32 :: Storable a => a -> Word32 -> IO Word32
hashOne32 k salt = with k $ \ptr ->
alignedHash ptr (fromIntegral (sizeOf k)) salt
hashOne64 :: Storable a => a -> Word64 -> IO Word64
hashOne64 k salt = with k $ \ptr ->
alignedHash2 ptr (fromIntegral (sizeOf k)) salt
hashList32 :: Storable a => [a] -> Word32 -> IO Word32
hashList32 xs salt =
withArrayLen xs $ \len ptr ->
alignedHash ptr (fromIntegral (len * sizeOf (head xs))) salt
hashList64 :: Storable a => [a] -> Word64 -> IO Word64
hashList64 xs salt =
withArrayLen xs $ \len ptr ->
alignedHash2 ptr (fromIntegral (len * sizeOf (head xs))) salt