{-# LANGUAGE BangPatterns #-}
module Data.Hash.Murmur (murmur3) where
import Control.Monad (replicateM )
import Data.Serialize.Get
( runGet
, getWord32le
)
import Data.Bits
( shiftR
, rotateL
, xor
)
import qualified Data.ByteString as BS
( ByteString
, length
, drop
, append
, replicate
)
import Data.List (foldl')
import Data.Word (Word32)
murmur3 :: Word32
-> BS.ByteString
-> Word32
murmur3 :: Word32 -> ByteString -> Word32
murmur3 nHashSeed :: Word32
nHashSeed bs :: ByteString
bs =
Word32
h8
where
!nBlocks :: Int
nBlocks = ByteString -> Int
BS.length ByteString
bs Int -> Int -> Int
forall a. Integral a => a -> a -> a
`quot` 4
!nTail :: Int
nTail = ByteString -> Int
BS.length ByteString
bs Int -> Int -> Int
forall a. Integral a => a -> a -> a
`rem` 4
Right blocks :: [Word32]
blocks = Get [Word32] -> ByteString -> Either String [Word32]
forall a. Get a -> ByteString -> Either String a
runGet (Int -> Get Word32 -> Get [Word32]
forall (m :: * -> *) a. Applicative m => Int -> m a -> m [a]
replicateM Int
nBlocks Get Word32
getWord32le) ByteString
bs
bsTail :: ByteString
bsTail = Int -> ByteString -> ByteString
BS.drop (Int
nBlocksInt -> Int -> Int
forall a. Num a => a -> a -> a
*4) ByteString
bs ByteString -> ByteString -> ByteString
`BS.append` Int -> Word8 -> ByteString
BS.replicate (4Int -> Int -> Int
forall a. Num a => a -> a -> a
-Int
nTail) 0
!h1 :: Word32
h1 = (Word32 -> Word32 -> Word32) -> Word32 -> [Word32] -> Word32
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' Word32 -> Word32 -> Word32
mix Word32
nHashSeed [Word32]
blocks
Right !Word32
t1 = Get Word32 -> ByteString -> Either String Word32
forall a. Get a -> ByteString -> Either String a
runGet Get Word32
getWord32le ByteString
bsTail
!t2 :: Word32
t2 = Word32
t1 Word32 -> Word32 -> Word32
forall a. Num a => a -> a -> a
* Word32
c1
!t3 :: Word32
t3 = Word32
t2 Word32 -> Int -> Word32
forall a. Bits a => a -> Int -> a
`rotateL` 15
!t4 :: Word32
t4 = Word32
t3 Word32 -> Word32 -> Word32
forall a. Num a => a -> a -> a
* Word32
c2
!h2 :: Word32
h2 = Word32
h1 Word32 -> Word32 -> Word32
forall a. Bits a => a -> a -> a
`xor` Word32
t4
!h3 :: Word32
h3 = Word32
h2 Word32 -> Word32 -> Word32
forall a. Bits a => a -> a -> a
`xor` Int -> Word32
forall a b. (Integral a, Num b) => a -> b
fromIntegral (ByteString -> Int
BS.length ByteString
bs)
!h4 :: Word32
h4 = Word32
h3 Word32 -> Word32 -> Word32
forall a. Bits a => a -> a -> a
`xor` (Word32
h3 Word32 -> Int -> Word32
forall a. Bits a => a -> Int -> a
`shiftR` 16)
!h5 :: Word32
h5 = Word32
h4 Word32 -> Word32 -> Word32
forall a. Num a => a -> a -> a
* 0x85ebca6b
!h6 :: Word32
h6 = Word32
h5 Word32 -> Word32 -> Word32
forall a. Bits a => a -> a -> a
`xor` (Word32
h5 Word32 -> Int -> Word32
forall a. Bits a => a -> Int -> a
`shiftR` 13)
!h7 :: Word32
h7 = Word32
h6 Word32 -> Word32 -> Word32
forall a. Num a => a -> a -> a
* 0xc2b2ae35
!h8 :: Word32
h8 = Word32
h7 Word32 -> Word32 -> Word32
forall a. Bits a => a -> a -> a
`xor` (Word32
h7 Word32 -> Int -> Word32
forall a. Bits a => a -> Int -> a
`shiftR` 16)
mix :: Word32 -> Word32 -> Word32
mix !Word32
r1 !Word32
k1 = Word32
r4
where
!k2 :: Word32
k2 = Word32
k1 Word32 -> Word32 -> Word32
forall a. Num a => a -> a -> a
* Word32
c1
!k3 :: Word32
k3 = Word32
k2 Word32 -> Int -> Word32
forall a. Bits a => a -> Int -> a
`rotateL` 15
!k4 :: Word32
k4 = Word32
k3 Word32 -> Word32 -> Word32
forall a. Num a => a -> a -> a
* Word32
c2
!r2 :: Word32
r2 = Word32
r1 Word32 -> Word32 -> Word32
forall a. Bits a => a -> a -> a
`xor` Word32
k4
!r3 :: Word32
r3 = Word32
r2 Word32 -> Int -> Word32
forall a. Bits a => a -> Int -> a
`rotateL` 13
!r4 :: Word32
r4 = Word32
r3Word32 -> Word32 -> Word32
forall a. Num a => a -> a -> a
*5 Word32 -> Word32 -> Word32
forall a. Num a => a -> a -> a
+ 0xe6546b64
c1 :: Word32
c1 = 0xcc9e2d51
c2 :: Word32
c2 = 0x1b873593