-- |
-- Module      : Data.Memory.Hash.FNV
-- License     : BSD-style
-- Maintainer  : Vincent Hanquez <vincent@snarc.org>
-- Stability   : experimental
-- Portability : good
--
-- Fowler Noll Vo Hash (1 and 1a / 32 / 64 bits versions)
-- <http://en.wikipedia.org/wiki/Fowler%E2%80%93Noll%E2%80%93Vo_hash_function>
--
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE MagicHash                  #-}
{-# LANGUAGE UnboxedTuples              #-}
{-# LANGUAGE BangPatterns               #-}
module Data.Memory.Hash.FNV
    (
    -- * types
      FnvHash32(..)
    , FnvHash64(..)
    -- * methods
    , fnv1
    , fnv1a
    , fnv1_64
    , fnv1a_64
    ) where

import           Data.Memory.Internal.Compat ()
import           Data.Memory.Internal.CompatPrim
import           Data.Memory.Internal.CompatPrim64
import           Data.Memory.Internal.Imports
import           GHC.Word
import           GHC.Prim hiding (Word64#, Int64#)
import           GHC.Types
import           GHC.Ptr

-- | FNV1(a) hash (32 bit variants)
newtype FnvHash32 = FnvHash32 Word32
    deriving (Int -> FnvHash32 -> ShowS
[FnvHash32] -> ShowS
FnvHash32 -> String
(Int -> FnvHash32 -> ShowS)
-> (FnvHash32 -> String)
-> ([FnvHash32] -> ShowS)
-> Show FnvHash32
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [FnvHash32] -> ShowS
$cshowList :: [FnvHash32] -> ShowS
show :: FnvHash32 -> String
$cshow :: FnvHash32 -> String
showsPrec :: Int -> FnvHash32 -> ShowS
$cshowsPrec :: Int -> FnvHash32 -> ShowS
Show,FnvHash32 -> FnvHash32 -> Bool
(FnvHash32 -> FnvHash32 -> Bool)
-> (FnvHash32 -> FnvHash32 -> Bool) -> Eq FnvHash32
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: FnvHash32 -> FnvHash32 -> Bool
$c/= :: FnvHash32 -> FnvHash32 -> Bool
== :: FnvHash32 -> FnvHash32 -> Bool
$c== :: FnvHash32 -> FnvHash32 -> Bool
Eq,Eq FnvHash32
Eq FnvHash32
-> (FnvHash32 -> FnvHash32 -> Ordering)
-> (FnvHash32 -> FnvHash32 -> Bool)
-> (FnvHash32 -> FnvHash32 -> Bool)
-> (FnvHash32 -> FnvHash32 -> Bool)
-> (FnvHash32 -> FnvHash32 -> Bool)
-> (FnvHash32 -> FnvHash32 -> FnvHash32)
-> (FnvHash32 -> FnvHash32 -> FnvHash32)
-> Ord FnvHash32
FnvHash32 -> FnvHash32 -> Bool
FnvHash32 -> FnvHash32 -> Ordering
FnvHash32 -> FnvHash32 -> FnvHash32
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: FnvHash32 -> FnvHash32 -> FnvHash32
$cmin :: FnvHash32 -> FnvHash32 -> FnvHash32
max :: FnvHash32 -> FnvHash32 -> FnvHash32
$cmax :: FnvHash32 -> FnvHash32 -> FnvHash32
>= :: FnvHash32 -> FnvHash32 -> Bool
$c>= :: FnvHash32 -> FnvHash32 -> Bool
> :: FnvHash32 -> FnvHash32 -> Bool
$c> :: FnvHash32 -> FnvHash32 -> Bool
<= :: FnvHash32 -> FnvHash32 -> Bool
$c<= :: FnvHash32 -> FnvHash32 -> Bool
< :: FnvHash32 -> FnvHash32 -> Bool
$c< :: FnvHash32 -> FnvHash32 -> Bool
compare :: FnvHash32 -> FnvHash32 -> Ordering
$ccompare :: FnvHash32 -> FnvHash32 -> Ordering
$cp1Ord :: Eq FnvHash32
Ord,FnvHash32 -> ()
(FnvHash32 -> ()) -> NFData FnvHash32
forall a. (a -> ()) -> NFData a
rnf :: FnvHash32 -> ()
$crnf :: FnvHash32 -> ()
NFData)

-- | FNV1(a) hash (64 bit variants)
newtype FnvHash64 = FnvHash64 Word64
    deriving (Int -> FnvHash64 -> ShowS
[FnvHash64] -> ShowS
FnvHash64 -> String
(Int -> FnvHash64 -> ShowS)
-> (FnvHash64 -> String)
-> ([FnvHash64] -> ShowS)
-> Show FnvHash64
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [FnvHash64] -> ShowS
$cshowList :: [FnvHash64] -> ShowS
show :: FnvHash64 -> String
$cshow :: FnvHash64 -> String
showsPrec :: Int -> FnvHash64 -> ShowS
$cshowsPrec :: Int -> FnvHash64 -> ShowS
Show,FnvHash64 -> FnvHash64 -> Bool
(FnvHash64 -> FnvHash64 -> Bool)
-> (FnvHash64 -> FnvHash64 -> Bool) -> Eq FnvHash64
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: FnvHash64 -> FnvHash64 -> Bool
$c/= :: FnvHash64 -> FnvHash64 -> Bool
== :: FnvHash64 -> FnvHash64 -> Bool
$c== :: FnvHash64 -> FnvHash64 -> Bool
Eq,Eq FnvHash64
Eq FnvHash64
-> (FnvHash64 -> FnvHash64 -> Ordering)
-> (FnvHash64 -> FnvHash64 -> Bool)
-> (FnvHash64 -> FnvHash64 -> Bool)
-> (FnvHash64 -> FnvHash64 -> Bool)
-> (FnvHash64 -> FnvHash64 -> Bool)
-> (FnvHash64 -> FnvHash64 -> FnvHash64)
-> (FnvHash64 -> FnvHash64 -> FnvHash64)
-> Ord FnvHash64
FnvHash64 -> FnvHash64 -> Bool
FnvHash64 -> FnvHash64 -> Ordering
FnvHash64 -> FnvHash64 -> FnvHash64
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: FnvHash64 -> FnvHash64 -> FnvHash64
$cmin :: FnvHash64 -> FnvHash64 -> FnvHash64
max :: FnvHash64 -> FnvHash64 -> FnvHash64
$cmax :: FnvHash64 -> FnvHash64 -> FnvHash64
>= :: FnvHash64 -> FnvHash64 -> Bool
$c>= :: FnvHash64 -> FnvHash64 -> Bool
> :: FnvHash64 -> FnvHash64 -> Bool
$c> :: FnvHash64 -> FnvHash64 -> Bool
<= :: FnvHash64 -> FnvHash64 -> Bool
$c<= :: FnvHash64 -> FnvHash64 -> Bool
< :: FnvHash64 -> FnvHash64 -> Bool
$c< :: FnvHash64 -> FnvHash64 -> Bool
compare :: FnvHash64 -> FnvHash64 -> Ordering
$ccompare :: FnvHash64 -> FnvHash64 -> Ordering
$cp1Ord :: Eq FnvHash64
Ord,FnvHash64 -> ()
(FnvHash64 -> ()) -> NFData FnvHash64
forall a. (a -> ()) -> NFData a
rnf :: FnvHash64 -> ()
$crnf :: FnvHash64 -> ()
NFData)

-- | compute FNV1 (32 bit variant) of a raw piece of memory
fnv1 :: Ptr Word8 -> Int -> IO FnvHash32
fnv1 :: Ptr Word8 -> Int -> IO FnvHash32
fnv1 (Ptr Addr#
addr) (I# Int#
n) = (State# RealWorld -> (# State# RealWorld, FnvHash32 #))
-> IO FnvHash32
forall a. (State# RealWorld -> (# State# RealWorld, a #)) -> IO a
IO ((State# RealWorld -> (# State# RealWorld, FnvHash32 #))
 -> IO FnvHash32)
-> (State# RealWorld -> (# State# RealWorld, FnvHash32 #))
-> IO FnvHash32
forall a b. (a -> b) -> a -> b
$ \State# RealWorld
s -> Word#
-> Int# -> State# RealWorld -> (# State# RealWorld, FnvHash32 #)
forall s. Word# -> Int# -> State# s -> (# State# s, FnvHash32 #)
loop Word#
0x811c9dc5## Int#
0# State# RealWorld
s
  where 
        loop :: Word# -> Int# -> State# s -> (# State# s, FnvHash32 #)
        loop :: Word# -> Int# -> State# s -> (# State# s, FnvHash32 #)
loop !Word#
acc Int#
i State# s
s
            | Int# -> Bool
booleanPrim (Int#
i Int# -> Int# -> Int#
==# Int#
n) = (# State# s
s, Word32 -> FnvHash32
FnvHash32 (Word32 -> FnvHash32) -> Word32 -> FnvHash32
forall a b. (a -> b) -> a -> b
$ Word# -> Word32
W32# (Word# -> Word#
narrow32Word# Word#
acc) #)
            | Bool
otherwise             =
                case Addr# -> Int# -> State# s -> (# State# s, Word# #)
forall d. Addr# -> Int# -> State# d -> (# State# d, Word# #)
readWord8OffAddr# Addr#
addr Int#
i State# s
s of
                    (# State# s
s2, Word#
v #) ->
                        let !nacc :: Word#
nacc = (Word#
0x01000193## Word# -> Word# -> Word#
`timesWord#` Word#
acc) Word# -> Word# -> Word#
`xor#` Word#
v
                         in Word# -> Int# -> State# s -> (# State# s, FnvHash32 #)
forall s. Word# -> Int# -> State# s -> (# State# s, FnvHash32 #)
loop Word#
nacc (Int#
i Int# -> Int# -> Int#
+# Int#
1#) State# s
s2

-- | compute FNV1a (32 bit variant) of a raw piece of memory
fnv1a :: Ptr Word8 -> Int -> IO FnvHash32
fnv1a :: Ptr Word8 -> Int -> IO FnvHash32
fnv1a (Ptr Addr#
addr) (I# Int#
n) = (State# RealWorld -> (# State# RealWorld, FnvHash32 #))
-> IO FnvHash32
forall a. (State# RealWorld -> (# State# RealWorld, a #)) -> IO a
IO ((State# RealWorld -> (# State# RealWorld, FnvHash32 #))
 -> IO FnvHash32)
-> (State# RealWorld -> (# State# RealWorld, FnvHash32 #))
-> IO FnvHash32
forall a b. (a -> b) -> a -> b
$ \State# RealWorld
s -> Word#
-> Int# -> State# RealWorld -> (# State# RealWorld, FnvHash32 #)
forall s. Word# -> Int# -> State# s -> (# State# s, FnvHash32 #)
loop Word#
0x811c9dc5## Int#
0# State# RealWorld
s
  where 
        loop :: Word# -> Int# -> State# s -> (# State# s, FnvHash32 #)
        loop :: Word# -> Int# -> State# s -> (# State# s, FnvHash32 #)
loop !Word#
acc Int#
i State# s
s
            | Int# -> Bool
booleanPrim (Int#
i Int# -> Int# -> Int#
==# Int#
n) = (# State# s
s, Word32 -> FnvHash32
FnvHash32 (Word32 -> FnvHash32) -> Word32 -> FnvHash32
forall a b. (a -> b) -> a -> b
$ Word# -> Word32
W32# (Word# -> Word#
narrow32Word# Word#
acc) #)
            | Bool
otherwise             =
                case Addr# -> Int# -> State# s -> (# State# s, Word# #)
forall d. Addr# -> Int# -> State# d -> (# State# d, Word# #)
readWord8OffAddr# Addr#
addr Int#
i State# s
s of
                    (# State# s
s2, Word#
v #) ->
                        let !nacc :: Word#
nacc = Word#
0x01000193## Word# -> Word# -> Word#
`timesWord#` (Word#
acc Word# -> Word# -> Word#
`xor#` Word#
v)
                         in Word# -> Int# -> State# s -> (# State# s, FnvHash32 #)
forall s. Word# -> Int# -> State# s -> (# State# s, FnvHash32 #)
loop Word#
nacc (Int#
i Int# -> Int# -> Int#
+# Int#
1#) State# s
s2

-- | compute FNV1 (64 bit variant) of a raw piece of memory
fnv1_64 :: Ptr Word8 -> Int -> IO FnvHash64
fnv1_64 :: Ptr Word8 -> Int -> IO FnvHash64
fnv1_64 (Ptr Addr#
addr) (I# Int#
n) = (State# RealWorld -> (# State# RealWorld, FnvHash64 #))
-> IO FnvHash64
forall a. (State# RealWorld -> (# State# RealWorld, a #)) -> IO a
IO ((State# RealWorld -> (# State# RealWorld, FnvHash64 #))
 -> IO FnvHash64)
-> (State# RealWorld -> (# State# RealWorld, FnvHash64 #))
-> IO FnvHash64
forall a b. (a -> b) -> a -> b
$ \State# RealWorld
s -> Word#
-> Int# -> State# RealWorld -> (# State# RealWorld, FnvHash64 #)
forall s. Word# -> Int# -> State# s -> (# State# s, FnvHash64 #)
loop Word#
fnv64Const Int#
0# State# RealWorld
s
  where 
        loop :: Word64# -> Int# -> State# s -> (# State# s, FnvHash64 #)
        loop :: Word# -> Int# -> State# s -> (# State# s, FnvHash64 #)
loop !Word#
acc Int#
i State# s
s
            | Int# -> Bool
booleanPrim (Int#
i Int# -> Int# -> Int#
==# Int#
n) = (# State# s
s, Word64 -> FnvHash64
FnvHash64 (Word64 -> FnvHash64) -> Word64 -> FnvHash64
forall a b. (a -> b) -> a -> b
$ Word# -> Word64
W64# Word#
acc #)
            | Bool
otherwise             =
                case Addr# -> Int# -> State# s -> (# State# s, Word# #)
forall d. Addr# -> Int# -> State# d -> (# State# d, Word# #)
readWord8OffAddr# Addr#
addr Int#
i State# s
s of
                    (# State# s
s2, Word#
v #) ->
                        let !nacc :: Word#
nacc = (Word#
fnv64Prime Word# -> Word# -> Word#
`timesWord64#` Word#
acc) Word# -> Word# -> Word#
`xor64#` (Word# -> Word#
wordToWord64# Word#
v)
                         in Word# -> Int# -> State# s -> (# State# s, FnvHash64 #)
forall s. Word# -> Int# -> State# s -> (# State# s, FnvHash64 #)
loop Word#
nacc (Int#
i Int# -> Int# -> Int#
+# Int#
1#) State# s
s2

        fnv64Const :: Word64#
        !fnv64Const :: Word#
fnv64Const = Word# -> Word# -> Word# -> Word#
w64# Word#
0xcbf29ce484222325## Word#
0xcbf29ce4## Word#
0x84222325##

        fnv64Prime :: Word64#
        !fnv64Prime :: Word#
fnv64Prime = Word# -> Word# -> Word# -> Word#
w64# Word#
0x100000001b3## Word#
0x100## Word#
0x000001b3##

-- | compute FNV1a (64 bit variant) of a raw piece of memory
fnv1a_64 :: Ptr Word8 -> Int -> IO FnvHash64
fnv1a_64 :: Ptr Word8 -> Int -> IO FnvHash64
fnv1a_64 (Ptr Addr#
addr) (I# Int#
n) = (State# RealWorld -> (# State# RealWorld, FnvHash64 #))
-> IO FnvHash64
forall a. (State# RealWorld -> (# State# RealWorld, a #)) -> IO a
IO ((State# RealWorld -> (# State# RealWorld, FnvHash64 #))
 -> IO FnvHash64)
-> (State# RealWorld -> (# State# RealWorld, FnvHash64 #))
-> IO FnvHash64
forall a b. (a -> b) -> a -> b
$ \State# RealWorld
s -> Word#
-> Int# -> State# RealWorld -> (# State# RealWorld, FnvHash64 #)
forall s. Word# -> Int# -> State# s -> (# State# s, FnvHash64 #)
loop Word#
fnv64Const Int#
0# State# RealWorld
s
  where 
        loop :: Word64# -> Int# -> State# s -> (# State# s, FnvHash64 #)
        loop :: Word# -> Int# -> State# s -> (# State# s, FnvHash64 #)
loop !Word#
acc Int#
i State# s
s
            | Int# -> Bool
booleanPrim (Int#
i Int# -> Int# -> Int#
==# Int#
n) = (# State# s
s, Word64 -> FnvHash64
FnvHash64 (Word64 -> FnvHash64) -> Word64 -> FnvHash64
forall a b. (a -> b) -> a -> b
$ Word# -> Word64
W64# Word#
acc #)
            | Bool
otherwise             =
                case Addr# -> Int# -> State# s -> (# State# s, Word# #)
forall d. Addr# -> Int# -> State# d -> (# State# d, Word# #)
readWord8OffAddr# Addr#
addr Int#
i State# s
s of
                    (# State# s
s2, Word#
v #) ->
                        let !nacc :: Word#
nacc = Word#
fnv64Prime Word# -> Word# -> Word#
`timesWord64#` (Word#
acc Word# -> Word# -> Word#
`xor64#` Word# -> Word#
wordToWord64# Word#
v)
                         in Word# -> Int# -> State# s -> (# State# s, FnvHash64 #)
forall s. Word# -> Int# -> State# s -> (# State# s, FnvHash64 #)
loop Word#
nacc (Int#
i Int# -> Int# -> Int#
+# Int#
1#) State# s
s2

        fnv64Const :: Word64#
        !fnv64Const :: Word#
fnv64Const = Word# -> Word# -> Word# -> Word#
w64# Word#
0xcbf29ce484222325## Word#
0xcbf29ce4## Word#
0x84222325##

        fnv64Prime :: Word64#
        !fnv64Prime :: Word#
fnv64Prime = Word# -> Word# -> Word# -> Word#
w64# Word#
0x100000001b3## Word#
0x100## Word#
0x000001b3##