{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE CPP #-}
{-# LANGUAGE MagicHash #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE UnboxedTuples #-}

-- |
-- Module: Data.Hash.FNV1
-- Copyright: Copyright © 2021 Lars Kuhtz <lakuhtz@gmail.com>
-- License: MIT
-- Maintainer: Lars Kuhtz <lakuhtz@gmail.com>
-- Stability: experimental
--
-- The primitive versions are usually not more efficient than the version with
-- explicit word sizes for the respective host architecture.
--
module Data.Hash.FNV1
(
-- * IO API (64 bit)

  fnv1_64
, fnv1_64_
, fnv1a_64
, fnv1a_64_

-- * 32 bit versions
, fnv1_32
, fnv1_32_
, fnv1a_32
, fnv1a_32_

-- * Primitive (host word size)
, fnv1
, fnv1_
, fnv1Primitive
, fnv1Primitive_

, fnv1a
, fnv1a_
, fnv1aPrimitive
, fnv1aPrimitive_

-- * Utils
, module Data.Hash.Utils

-- * Constants
, fnvPrime
, fnvPrime32
, fnvPrime64

, fnvOffsetBasis
, fnvOffsetBasis32
, fnvOffsetBasis64

) where

import Data.Bits
import Data.Word

import Foreign.Ptr
import Foreign.Storable

import GHC.Exts

import GHC.IO

-- internal modules

import Data.Hash.Utils

-- -------------------------------------------------------------------------- --
-- Constants

fnvPrime32 :: Word32
fnvPrime32 :: Word32
fnvPrime32 = Word32
0x01000193

fnvPrime64 :: Word64
fnvPrime64 :: Word64
fnvPrime64 = Word64
0x100000001b3

fnvOffsetBasis32 :: Word32
fnvOffsetBasis32 :: Word32
fnvOffsetBasis32 = Word32
0x811c9dc5

fnvOffsetBasis64 :: Word64
fnvOffsetBasis64 :: Word64
fnvOffsetBasis64 = Word64
0xcbf29ce484222325

fnvPrime :: Word
#if defined(x86_64_HOST_ARCH)
fnvPrime :: Word
fnvPrime = Word64 -> Word
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word64
fnvPrime64
#elif defined(i386_HOST_ARCH)
fnvPrime = fromIntegral fvnPrime32
#else
fnvPrime = error "fnvPrime: unsupported hardware platform"
#endif

fnvOffsetBasis :: Word
#if defined(x86_64_HOST_ARCH)
fnvOffsetBasis :: Word
fnvOffsetBasis = Word64 -> Word
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word64
fnvOffsetBasis64
#elif defined(i386_HOST_ARCH)
fnvOffsetBasis = fromIntegral fnvOffsetBasis32
#else
fnvOffsetBasis = error "fnvOffsetBasis: unsupported hardware platform"
#endif

-- -------------------------------------------------------------------------- --
-- FNV1 64 bit

fnv1_64 :: Ptr Word8 -> Int -> IO Word64
fnv1_64 :: Ptr Word8 -> Int -> IO Word64
fnv1_64 !Ptr Word8
ptr !Int
n = Ptr Word8 -> Int -> Word64 -> IO Word64
fnv1_64_ Ptr Word8
ptr Int
n Word64
fnvOffsetBasis64
{-# INLINE fnv1_64 #-}

fnv1_64_ :: Ptr Word8 -> Int -> Word64 -> IO Word64
fnv1_64_ :: Ptr Word8 -> Int -> Word64 -> IO Word64
fnv1_64_ !Ptr Word8
ptr !Int
n !Word64
a = Word64 -> Int -> IO Word64
loop Word64
a Int
0
  where
    loop :: Word64 -> Int -> IO Word64
loop !Word64
acc !Int
i
        | Int
i Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
n = Word64 -> IO Word64
forall (m :: * -> *) a. Monad m => a -> m a
return Word64
acc
        | Bool
otherwise = do
            !Word8
x <- Ptr Word8 -> Int -> IO Word8
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff @Word8 Ptr Word8
ptr Int
i
            Word64 -> Int -> IO Word64
loop ((Word64
fnvPrime64 Word64 -> Word64 -> Word64
forall a. Num a => a -> a -> a
* Word64
acc) Word64 -> Word64 -> Word64
forall a. Bits a => a -> a -> a
`xor` Word8 -> Word64
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word8
x) (Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1)
{-# INLINE fnv1_64_ #-}

-- -------------------------------------------------------------------------- --
-- FNV1a 64 bit

fnv1a_64 :: Ptr Word8 -> Int -> IO Word64
fnv1a_64 :: Ptr Word8 -> Int -> IO Word64
fnv1a_64 !Ptr Word8
ptr !Int
n = Ptr Word8 -> Int -> Word64 -> IO Word64
fnv1a_64_ Ptr Word8
ptr Int
n Word64
fnvOffsetBasis64
{-# INLINE fnv1a_64 #-}

fnv1a_64_ :: Ptr Word8 -> Int -> Word64 -> IO Word64
fnv1a_64_ :: Ptr Word8 -> Int -> Word64 -> IO Word64
fnv1a_64_ !Ptr Word8
ptr !Int
n !Word64
a = Word64 -> Int -> IO Word64
loop Word64
a Int
0
  where
    loop :: Word64 -> Int -> IO Word64
loop !Word64
acc !Int
i
        | Int
i Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
n = Word64 -> IO Word64
forall (m :: * -> *) a. Monad m => a -> m a
return Word64
acc
        | Bool
otherwise = do
            !Word8
x <- Ptr Word8 -> Int -> IO Word8
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff @Word8 Ptr Word8
ptr Int
i
            Word64 -> Int -> IO Word64
loop (Word64
fnvPrime64 Word64 -> Word64 -> Word64
forall a. Num a => a -> a -> a
* (Word64
acc Word64 -> Word64 -> Word64
forall a. Bits a => a -> a -> a
`xor` Word8 -> Word64
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word8
x)) (Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1)
{-# INLINE fnv1a_64_ #-}

-- -------------------------------------------------------------------------- --
-- FNV1 32 bit

fnv1_32 :: Ptr Word8 -> Int -> IO Word32
fnv1_32 :: Ptr Word8 -> Int -> IO Word32
fnv1_32 !Ptr Word8
ptr !Int
n = Ptr Word8 -> Int -> Word32 -> IO Word32
fnv1_32_ Ptr Word8
ptr Int
n Word32
fnvOffsetBasis32
{-# INLINE fnv1_32 #-}

fnv1_32_ :: Ptr Word8 -> Int -> Word32 -> IO Word32
fnv1_32_ :: Ptr Word8 -> Int -> Word32 -> IO Word32
fnv1_32_ !Ptr Word8
ptr !Int
n !Word32
a = Word32 -> Int -> IO Word32
loop Word32
a Int
0
  where
    loop :: Word32 -> Int -> IO Word32
loop !Word32
acc !Int
i
        | Int
i Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
n = Word32 -> IO Word32
forall (m :: * -> *) a. Monad m => a -> m a
return Word32
acc
        | Bool
otherwise = do
            !Word8
x <- Ptr Word8 -> Int -> IO Word8
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff @Word8 Ptr Word8
ptr Int
i
            Word32 -> Int -> IO Word32
loop ((Word32
fnvPrime32 Word32 -> Word32 -> Word32
forall a. Num a => a -> a -> a
* Word32
acc) Word32 -> Word32 -> Word32
forall a. Bits a => a -> a -> a
`xor` Word8 -> Word32
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word8
x) (Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1)
{-# INLINE fnv1_32_ #-}

-- FNV1a 32 bit

fnv1a_32 :: Ptr Word8 -> Int -> IO Word32
fnv1a_32 :: Ptr Word8 -> Int -> IO Word32
fnv1a_32 !Ptr Word8
ptr !Int
n = Ptr Word8 -> Int -> Word32 -> IO Word32
fnv1a_32_ Ptr Word8
ptr Int
n Word32
fnvOffsetBasis32
{-# INLINE fnv1a_32 #-}

fnv1a_32_ :: Ptr Word8 -> Int -> Word32 -> IO Word32
fnv1a_32_ :: Ptr Word8 -> Int -> Word32 -> IO Word32
fnv1a_32_ !Ptr Word8
ptr !Int
n Word32
a = Word32 -> Int -> IO Word32
loop Word32
a Int
0
  where
    loop :: Word32 -> Int -> IO Word32
loop !Word32
acc !Int
i
        | Int
i Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
n = Word32 -> IO Word32
forall (m :: * -> *) a. Monad m => a -> m a
return Word32
acc
        | Bool
otherwise = do
            !Word8
x <- Ptr Word8 -> Int -> IO Word8
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff @Word8 Ptr Word8
ptr Int
i
            Word32 -> Int -> IO Word32
loop (Word32
fnvPrime32 Word32 -> Word32 -> Word32
forall a. Num a => a -> a -> a
* (Word32
acc Word32 -> Word32 -> Word32
forall a. Bits a => a -> a -> a
`xor` Word8 -> Word32
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word8
x)) (Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1)
{-# INLINE fnv1a_32_ #-}

-- -------------------------------------------------------------------------- --
-- Primitive (host architecture words)

-- FNV1

fnv1 :: Addr# -> Int -> IO Word
fnv1 :: Addr# -> Int -> IO Word
fnv1 Addr#
addr (I# Int#
n) = (State# RealWorld -> (# State# RealWorld, Word #)) -> IO Word
forall a. (State# RealWorld -> (# State# RealWorld, a #)) -> IO a
IO ((State# RealWorld -> (# State# RealWorld, Word #)) -> IO Word)
-> (State# RealWorld -> (# State# RealWorld, Word #)) -> IO Word
forall a b. (a -> b) -> a -> b
$ \State# RealWorld
s -> case Addr# -> Int# -> State# RealWorld -> (# State# RealWorld, Word# #)
forall tok. Addr# -> Int# -> State# tok -> (# State# tok, Word# #)
fnv1Primitive Addr#
addr Int#
n State# RealWorld
s of
    (# State# RealWorld
s1, Word#
w #) -> (# State# RealWorld
s1, Word# -> Word
W# Word#
w #)
{-# INlINE fnv1 #-}

fnv1_ :: Addr# -> Int -> Word -> IO Word
fnv1_ :: Addr# -> Int -> Word -> IO Word
fnv1_ Addr#
addr (I# Int#
n) (W# Word#
a) = (State# RealWorld -> (# State# RealWorld, Word #)) -> IO Word
forall a. (State# RealWorld -> (# State# RealWorld, a #)) -> IO a
IO ((State# RealWorld -> (# State# RealWorld, Word #)) -> IO Word)
-> (State# RealWorld -> (# State# RealWorld, Word #)) -> IO Word
forall a b. (a -> b) -> a -> b
$ \State# RealWorld
s -> case Addr#
-> Int#
-> Word#
-> State# RealWorld
-> (# State# RealWorld, Word# #)
forall tok.
Addr# -> Int# -> Word# -> State# tok -> (# State# tok, Word# #)
fnv1Primitive_ Addr#
addr Int#
n Word#
a State# RealWorld
s of
    (# State# RealWorld
s1, Word#
w #) -> (# State# RealWorld
s1, Word# -> Word
W# Word#
w #)
{-# INlINE fnv1_ #-}

fnv1Primitive :: Addr# -> Int# -> State# tok -> (# State# tok, Word# #)
fnv1Primitive :: Addr# -> Int# -> State# tok -> (# State# tok, Word# #)
fnv1Primitive !Addr#
addr !Int#
n !State# tok
tok = Addr# -> Int# -> Word# -> State# tok -> (# State# tok, Word# #)
forall tok.
Addr# -> Int# -> Word# -> State# tok -> (# State# tok, Word# #)
fnv1Primitive_ Addr#
addr Int#
n Word#
o State# tok
tok
  where
    !(W# Word#
o) = Word
fnvOffsetBasis
{-# INLINE fnv1Primitive #-}

fnv1Primitive_ :: Addr# -> Int# -> Word# -> State# tok -> (# State# tok, Word# #)
fnv1Primitive_ :: Addr# -> Int# -> Word# -> State# tok -> (# State# tok, Word# #)
fnv1Primitive_ !Addr#
addr !Int#
n !Word#
a State# tok
tok = case Word# -> Int# -> State# tok -> (# State# tok, Word# #)
forall d. Word# -> Int# -> State# d -> (# State# d, Word# #)
loop Word#
a Int#
0# State# tok
tok of
    (# State# tok
tok1, Word#
w #) -> (# State# tok
tok1, Word#
w #)
  where
    loop :: Word# -> Int# -> State# d -> (# State# d, Word# #)
loop !Word#
acc !Int#
i !State# d
s = case Int#
i Int# -> Int# -> Int#
==# Int#
n of
        Int#
1# -> (# State# d
s, Word#
acc #)
        Int#
_ -> case Addr# -> Int# -> State# d -> (# State# d, Word# #)
forall tok. Addr# -> Int# -> State# tok -> (# State# tok, Word# #)
readWord8OffAddr# Addr#
addr Int#
i State# d
s of
            (# State# d
s1, Word#
w #) -> Word# -> Int# -> State# d -> (# State# d, Word# #)
loop
                ((Word#
p Word# -> Word# -> Word#
`timesWord#` Word#
acc) Word# -> Word# -> Word#
`xor#` Word# -> Word#
word8ToWord# Word#
w)
                (Int#
i Int# -> Int# -> Int#
+# Int#
1#)
                State# d
s1

    !(W# Word#
p) = Word
fnvPrime
{-# INLINE fnv1Primitive_ #-}

-- FNV1a

fnv1a :: Addr# -> Int -> IO Word
fnv1a :: Addr# -> Int -> IO Word
fnv1a Addr#
addr (I# Int#
n) = (State# RealWorld -> (# State# RealWorld, Word #)) -> IO Word
forall a. (State# RealWorld -> (# State# RealWorld, a #)) -> IO a
IO ((State# RealWorld -> (# State# RealWorld, Word #)) -> IO Word)
-> (State# RealWorld -> (# State# RealWorld, Word #)) -> IO Word
forall a b. (a -> b) -> a -> b
$ \State# RealWorld
s -> case Addr# -> Int# -> State# RealWorld -> (# State# RealWorld, Word# #)
forall tok. Addr# -> Int# -> State# tok -> (# State# tok, Word# #)
fnv1aPrimitive Addr#
addr Int#
n State# RealWorld
s of
    (# State# RealWorld
s1, Word#
w #) -> (# State# RealWorld
s1, Word# -> Word
W# Word#
w #)
{-# INlINE fnv1a #-}

fnv1a_ :: Addr# -> Int -> Word -> IO Word
fnv1a_ :: Addr# -> Int -> Word -> IO Word
fnv1a_ Addr#
addr (I# Int#
n) (W# Word#
a) = (State# RealWorld -> (# State# RealWorld, Word #)) -> IO Word
forall a. (State# RealWorld -> (# State# RealWorld, a #)) -> IO a
IO ((State# RealWorld -> (# State# RealWorld, Word #)) -> IO Word)
-> (State# RealWorld -> (# State# RealWorld, Word #)) -> IO Word
forall a b. (a -> b) -> a -> b
$ \State# RealWorld
s -> case Addr#
-> Int#
-> Word#
-> State# RealWorld
-> (# State# RealWorld, Word# #)
forall tok.
Addr# -> Int# -> Word# -> State# tok -> (# State# tok, Word# #)
fnv1aPrimitive_ Addr#
addr Int#
n Word#
a State# RealWorld
s of
    (# State# RealWorld
s1, Word#
w #) -> (# State# RealWorld
s1, Word# -> Word
W# Word#
w #)
{-# INlINE fnv1a_ #-}

fnv1aPrimitive :: Addr# -> Int# -> State# tok -> (# State# tok, Word# #)
fnv1aPrimitive :: Addr# -> Int# -> State# tok -> (# State# tok, Word# #)
fnv1aPrimitive !Addr#
addr !Int#
n !State# tok
tok = Addr# -> Int# -> Word# -> State# tok -> (# State# tok, Word# #)
forall tok.
Addr# -> Int# -> Word# -> State# tok -> (# State# tok, Word# #)
fnv1aPrimitive_ Addr#
addr Int#
n Word#
o State# tok
tok
  where
    !(W# Word#
o) = Word
fnvOffsetBasis
{-# INLINE fnv1aPrimitive #-}

fnv1aPrimitive_ :: Addr# -> Int# -> Word# -> State# tok -> (# State# tok, Word# #)
fnv1aPrimitive_ :: Addr# -> Int# -> Word# -> State# tok -> (# State# tok, Word# #)
fnv1aPrimitive_ !Addr#
addr !Int#
n !Word#
a State# tok
tok = case Word# -> Int# -> State# tok -> (# State# tok, Word# #)
forall d. Word# -> Int# -> State# d -> (# State# d, Word# #)
loop Word#
a Int#
0# State# tok
tok of
    (# State# tok
tok1, Word#
w #) -> (# State# tok
tok1, Word#
w #)
  where
    loop :: Word# -> Int# -> State# d -> (# State# d, Word# #)
loop !Word#
acc !Int#
i !State# d
s = case Int#
i Int# -> Int# -> Int#
==# Int#
n of
        Int#
1# -> (# State# d
s, Word#
acc #)
        Int#
_ -> case Addr# -> Int# -> State# d -> (# State# d, Word# #)
forall tok. Addr# -> Int# -> State# tok -> (# State# tok, Word# #)
readWord8OffAddr# Addr#
addr Int#
i State# d
s of
            (# State# d
s1, Word#
w #) -> Word# -> Int# -> State# d -> (# State# d, Word# #)
loop
                (Word#
p Word# -> Word# -> Word#
`timesWord#` (Word#
acc Word# -> Word# -> Word#
`xor#` Word# -> Word#
word8ToWord# Word#
w))
                (Int#
i Int# -> Int# -> Int#
+# Int#
1#)
                State# d
s1

    !(W# Word#
p) = Word
fnvPrime
{-# INLINE fnv1aPrimitive_ #-}

-- -------------------------------------------------------------------------- --
-- Backward compatibility

#if !MIN_VERSION_base(4,16,0)
-- | 'readWord8OffAddr#' returns 'Word#' for base < 4.16.0. So, there's no
-- need to convert it to 'Word#' down the road.
--
word8ToWord# :: Word# -> Word#
word8ToWord# :: Word# -> Word#
word8ToWord# Word#
a = Word#
a
#endif