1-- |
2-- Module      : Data.Memory.Hash.FNV
3-- License     : BSD-style
4-- Maintainer  : Vincent Hanquez <vincent@snarc.org>
5-- Stability   : experimental
6-- Portability : good
7--
8-- Fowler Noll Vo Hash (1 and 1a / 32 / 64 bits versions)
9-- <http://en.wikipedia.org/wiki/Fowler%E2%80%93Noll%E2%80%93Vo_hash_function>
10--
11{-# LANGUAGE GeneralizedNewtypeDeriving #-}
12{-# LANGUAGE MagicHash                  #-}
13{-# LANGUAGE UnboxedTuples              #-}
14{-# LANGUAGE BangPatterns               #-}
15module Data.Memory.Hash.FNV
16    (
17    -- * types
18      FnvHash32(..)
19    , FnvHash64(..)
20    -- * methods
21    , fnv1
22    , fnv1a
23    , fnv1_64
24    , fnv1a_64
25    ) where
26
27import           Data.Memory.Internal.Compat ()
28import           Data.Memory.Internal.CompatPrim
29import           Data.Memory.Internal.CompatPrim64
30import           Data.Memory.Internal.Imports
31import           GHC.Word
32import           GHC.Prim hiding (Word64#, Int64#)
33import           GHC.Types
34import           GHC.Ptr
35
36-- | FNV1(a) hash (32 bit variants)
37newtype FnvHash32 = FnvHash32 Word32
38    deriving (Show,Eq,Ord,NFData)
39
40-- | FNV1(a) hash (64 bit variants)
41newtype FnvHash64 = FnvHash64 Word64
42    deriving (Show,Eq,Ord,NFData)
43
44-- | compute FNV1 (32 bit variant) of a raw piece of memory
45fnv1 :: Ptr Word8 -> Int -> IO FnvHash32
46fnv1 (Ptr addr) (I# n) = IO $ \s -> loop 0x811c9dc5## 0# s
47  where
48        loop :: Word# -> Int# -> State# s -> (# State# s, FnvHash32 #)
49        loop !acc i s
50            | booleanPrim (i ==# n) = (# s, FnvHash32 $ W32# (narrow32Word# acc) #)
51            | otherwise             =
52                case readWord8OffAddr# addr i s of
53                    (# s2, v #) ->
54                        let !nacc = (0x01000193## `timesWord#` acc) `xor#` v
55                         in loop nacc (i +# 1#) s2
56
57-- | compute FNV1a (32 bit variant) of a raw piece of memory
58fnv1a :: Ptr Word8 -> Int -> IO FnvHash32
59fnv1a (Ptr addr) (I# n) = IO $ \s -> loop 0x811c9dc5## 0# s
60  where
61        loop :: Word# -> Int# -> State# s -> (# State# s, FnvHash32 #)
62        loop !acc i s
63            | booleanPrim (i ==# n) = (# s, FnvHash32 $ W32# (narrow32Word# acc) #)
64            | otherwise             =
65                case readWord8OffAddr# addr i s of
66                    (# s2, v #) ->
67                        let !nacc = 0x01000193## `timesWord#` (acc `xor#` v)
68                         in loop nacc (i +# 1#) s2
69
70-- | compute FNV1 (64 bit variant) of a raw piece of memory
71fnv1_64 :: Ptr Word8 -> Int -> IO FnvHash64
72fnv1_64 (Ptr addr) (I# n) = IO $ \s -> loop fnv64Const 0# s
73  where
74        loop :: Word64# -> Int# -> State# s -> (# State# s, FnvHash64 #)
75        loop !acc i s
76            | booleanPrim (i ==# n) = (# s, FnvHash64 $ W64# acc #)
77            | otherwise             =
78                case readWord8OffAddr# addr i s of
79                    (# s2, v #) ->
80                        let !nacc = (fnv64Prime `timesWord64#` acc) `xor64#` (wordToWord64# v)
81                         in loop nacc (i +# 1#) s2
82
83        fnv64Const :: Word64#
84        !fnv64Const = w64# 0xcbf29ce484222325## 0xcbf29ce4## 0x84222325##
85
86        fnv64Prime :: Word64#
87        !fnv64Prime = w64# 0x100000001b3## 0x100## 0x000001b3##
88
89-- | compute FNV1a (64 bit variant) of a raw piece of memory
90fnv1a_64 :: Ptr Word8 -> Int -> IO FnvHash64
91fnv1a_64 (Ptr addr) (I# n) = IO $ \s -> loop fnv64Const 0# s
92  where
93        loop :: Word64# -> Int# -> State# s -> (# State# s, FnvHash64 #)
94        loop !acc i s
95            | booleanPrim (i ==# n) = (# s, FnvHash64 $ W64# acc #)
96            | otherwise             =
97                case readWord8OffAddr# addr i s of
98                    (# s2, v #) ->
99                        let !nacc = fnv64Prime `timesWord64#` (acc `xor64#` wordToWord64# v)
100                         in loop nacc (i +# 1#) s2
101
102        fnv64Const :: Word64#
103        !fnv64Const = w64# 0xcbf29ce484222325## 0xcbf29ce4## 0x84222325##
104
105        fnv64Prime :: Word64#
106        !fnv64Prime = w64# 0x100000001b3## 0x100## 0x000001b3##
107