Murmur32.hs

{-# LANGUAGE MultiParamTypeClasses #-}

-- | An implementation of MurmurHash3_x86_32
module Mini.Hash.Murmur32 (
  -- * Type
  Murmur32,
) where

import Data.Bits (
  rotateL,
  shiftL,
  shiftR,
  xor,
  (.&.),
 )
import Data.Word (
  Word32,
  Word8,
 )
import Mini.Data.Recursion (
  bool,
 )
import Mini.Hash.Class (
  Hash,
  digest,
  hash,
  toBytes,
 )
import Numeric (
  showHex,
 )
import Prelude (
  Eq,
  Ord,
  Show,
  fromIntegral,
  showsPrec,
  ($),
  (*),
  (+),
  (.),
  (/=),
 )

-- Type

-- | Abstract representation of a 32-bit hash value
newtype Murmur32 = Murmur32 Word32
  deriving (Eq, Ord)

instance Show Murmur32 where
  showsPrec _ = showHex . digest

instance Hash Murmur32 Word32 Word32 where
  hash a s =
    let bs = toBytes a
        (len, h, k) = body s bs
     in Murmur32 . final len $ tail len h k
  digest (Murmur32 d) = d

-- Helpers

body :: Word32 -> [Word8] -> (Word32, Word32, Word32)
body h0 bs = go 0 h0 bs
 where
  go len h (a : b : c : d : rest) =
    let d' = fromIntegral d `shiftL` 24
        c' = fromIntegral c `shiftL` 16
        b' = fromIntegral b `shiftL` 8
        a' = fromIntegral a
        k = a' `xor` b' `xor` c' `xor` d'
     in go (len + 4) (murmur k h) rest
  go len h (a : b : c : _) =
    let c' = fromIntegral c `shiftL` 16
        b' = fromIntegral b `shiftL` 8
        a' = fromIntegral a
        k = a' `xor` b' `xor` c'
     in (len + 3, h, k)
  go len h (a : b : _) =
    let b' = fromIntegral b `shiftL` 8
        a' = fromIntegral a
        k = a' `xor` b'
     in (len + 2, h, k)
  go len h (a : _) = (len + 1, h, fromIntegral a)
  go len h _ = (len, h, 0)

tail :: Word32 -> Word32 -> Word32 -> Word32
tail len h0 k0 =
  let k1 = k0 * 0xcc9e2d51
      k2 = k1 `rotateL` 15
      k3 = k2 * 0x1b873593
      h1 = h0 `xor` k3
   in bool h0 h1 $ len .&. 3 /= 0

final :: Word32 -> Word32 -> Word32
final len h = mix $ h `xor` len

murmur :: Word32 -> Word32 -> Word32
murmur k1 h1 =
  let c1 = 0xcc9e2d51
      c2 = 0x1b873593
      c3 = 0xe6546b64
      k2 = k1 * c1
      k3 = k2 `rotateL` 15
      k4 = k3 * c2
      h2 = h1 `xor` k4
      h3 = h2 `rotateL` 13
      h4 = h3 * 5 + c3
   in h4

mix :: Word32 -> Word32
mix h1 =
  let h2 = h1 `xor` (h1 `shiftR` 16)
      h3 = h2 * 0x85ebca6b
      h4 = h3 `xor` (h3 `shiftR` 13)
      h5 = h4 * 0xc2b2ae35
      h6 = h5 `xor` (h5 `shiftR` 16)
   in h6