FNV64.hs

-- | 64-bit FNV-1a (Fowler-Noll-Vo) hash

{-# LANGUAGE CPP #-}
module Data.Generics.Fixplate.Hash.FNV.FNV64 
  ( FNV64(..) 
  , unFNV64
  ) 
  where

--------------------------------------------------------------------------------

import Data.Char
import Data.Word
import Data.Bits
-- import Data.Int
-- import Data.List

import Data.Generics.Fixplate.Hash.Class

--------------------------------------------------------------------------------

instance Hashable FNV64 where 
  hashDigest (FNV64 w) = hashDigest w

instance HashValue FNV64 where
  emptyHash = FNV64 fnv64_offset 
  hashHash (FNV64 w) = hashWord64 w
  showHex  (FNV64 w) = showHex64 w
  hashWord8  x (FNV64 w) = FNV64 (fnv64_octet  x w)
  hashWord16 x (FNV64 w) = FNV64 (fnv64_word16 x w)
  hashWord32 x (FNV64 w) = FNV64 (fnv64_word32 x w)
  hashWord64 x (FNV64 w) = FNV64 (fnv64_word64 x w)
  
--------------------------------------------------------------------------------

newtype FNV64 = FNV64 Word64 deriving (Eq,Ord,Show)

unFNV64 :: FNV64 -> Word64
unFNV64 (FNV64 x) = x

--------------------------------------------------------------------------------

showHex64 :: Word64 -> String
showHex64 h = reverse $ worker 16 h where
  worker :: Int -> Word64 -> String
  worker 0 0 = []
  worker 0 _ = error "Hash/FNV64/showHex: shouldn't happen"
  worker i w = hexdigit (w .&. 15) : worker (i-1) (shiftR w 4) 
  hexdigit :: Word64 -> Char
  hexdigit n
    | k>=0 && k<=9   = chr (k+48)
    | otherwise      = chr (k+55)
    where k = fromIntegral n

--------------------------------------------------------------------------------
-- FNV-1a hash

fnv64_prime, fnv64_offset :: Word64

fnv64_prime  = 1099511628211        
fnv64_offset = 14695981039346656037 

fnv64_octet :: Word8 -> Word64 -> Word64
fnv64_octet octet old = fnv64_prime * (old `xor` fromIntegral octet)

--------------------------------------------------------------------------------
-- 64 bit

fnv64_word32 :: Word32 -> Word64 -> Word64
fnv64_word32 w = fnv64_octet a . fnv64_octet b . fnv64_octet c . fnv64_octet d where
  a = fromIntegral (255 .&. (       w   ))
  b = fromIntegral (255 .&. (shiftR w  8))
  c = fromIntegral (255 .&. (shiftR w 16))
  d = fromIntegral (255 .&. (shiftR w 24))

{-
fnv64_word24 :: Word32 -> Word64 -> Word64
fnv64_word24 w = fnv64_octet a . fnv64_octet b . fnv64_octet c where
  a = fromIntegral (255 .&. (       w   ))
  b = fromIntegral (255 .&. (shiftR w  8))
  c = fromIntegral (255 .&. (shiftR w 16))
-}
 
fnv64_word16 :: Word16 -> Word64 -> Word64
fnv64_word16 w = fnv64_octet a . fnv64_octet b where
  a = fromIntegral (255 .&. (       w   ))
  b = fromIntegral (255 .&. (shiftR w  8))

fnv64_word64 :: Word64 -> Word64 -> Word64
fnv64_word64 w = fnv64_word32 a . fnv64_word32 b where
  a = fromIntegral (0xffffffff .&. (       w   ))
  b = fromIntegral (0xffffffff .&. (shiftR w 32))

--------------------------------------------------------------------------------