murmur-hash (empty) → 0.1
raw patch · 5 files changed
+442/−0 lines, 5 filesdep +basesetup-changed
Dependencies added: base
Files
- Data/Digest/Murmur32.hs +193/−0
- Data/Digest/Murmur64.hs +188/−0
- LICENSE +29/−0
- Setup.hs +4/−0
- murmur-hash.cabal +28/−0
+ Data/Digest/Murmur32.hs view
@@ -0,0 +1,193 @@+{-# LANGUAGE FlexibleInstances, BangPatterns #-}+{-|+Module : Data.Digest.Murmur32+Copyright : (c) Thomas Schilling 2010+License : BSD-style++Maintainer : nominolo@gmail.com+Stability : experimental+Portability : portable++Type class and primitives for constructing 32 bit hashes using the+MurmurHash2 algorithm. See <http://murmurhash.googlepages.com> for+details on MurmurHash2. +-}+module Data.Digest.Murmur32 + ( Hash32, asWord32,+ Hashable32(..),+ hash32AddWord32, hash32AddInt, hash32, hash32WithSeed+ )+where++import Data.Word+import Numeric ( showHex )+import Data.Bits+import Data.Char ( ord )+import Data.Foldable+import Data.List ( unfoldr )++-- | A 32 bit hash.+newtype Hash32 = Hash32 Word32+ deriving (Eq, Ord, Bounded)++instance Show Hash32 where+ showsPrec _ (Hash32 w) = showString "Hash32 0x" . showHex w++-- | Extract 32 bit word from hash.+asWord32 :: Hash32 -> Word32+asWord32 (Hash32 w) = w++-- | Instance for +class Hashable32 a where+ hash32Add :: a -> Hash32 -> Hash32++murmur_m :: Word32+murmur_m = 0x5bd1e995++murmur_r :: Int+murmur_r = 24++hash32AddWord32 :: Word32 -> Hash32 -> Hash32+hash32AddWord32 k (Hash32 h) =+ let k1 = k * murmur_m+ k2 = k1 `xor` (k1 `shiftR` murmur_r)+ k3 = k2 * murmur_m+ h1 = h * murmur_m+ h2 = h1 `xor` k3+ in Hash32 h2++hash32AddInt :: Int -> Hash32 -> Hash32+hash32AddInt !k0 + | bitSize (undefined :: Int) <= 32 -- Int is 32 bits+ = hash32AddWord32 (fromIntegral k0)+ | otherwise -- Int is 64 bits+ = hash32AddWord32 (fromIntegral k0) `combine`+ hash32AddWord32 (fromIntegral (k0 `shiftR` 32))++hash32AddFoldable :: (Hashable32 a, Foldable c) => c a -> Hash32 -> Hash32+hash32AddFoldable c !h0 = foldl' f h0 c+ where f h a = hash32Add a h++-- | Create a hash using a custom seed.+--+-- The seed should be non-zero, but other than that can be an+-- arbitrary number. Different seeds will give different hashes, and+-- thus (most likely) different hash collisions.+hash32WithSeed :: Hashable32 a => Word32 -> a -> Hash32+hash32WithSeed seed a = hash32End (hash32Add a (Hash32 seed))++-- | Create a hash using the default seed.+hash32 :: Hashable32 a => a -> Hash32+hash32 = hash32WithSeed defaultSeed++-- | Combine two hash generators. E.g.,+-- +-- @+-- hashFoo (Foo a) = hash32AddInt 1 `combine` hash32Add a+-- @+combine :: (Hash32 -> Hash32) -> (Hash32 -> Hash32) -> (Hash32 -> Hash32)+combine x y = y . x++hash32End :: Hash32 -> Hash32+hash32End (Hash32 h) =+ let h1 = h `xor` (h `shiftR` 13)+ h2 = h1 * murmur_m+ h3 = h2 `xor` (h2 `shiftR` 15)+ in Hash32 h3++defaultSeed :: Word32+defaultSeed = 0xdeadbeef -- not 0, otherwise hash32 [0] == hash32 []++{-++On a CPU with two multipliers and two ALUs, Murmur2 can process one+word in every two cycles + set up (2 cycles) and finish (3 cycles).++Here's the data flow graph:++@+ h k1 k2 k3 ...+ | | | |+ | * m | |+ | |\ | |+ | | >> r |+ | | / | |+ | xor * |+ | | |\ |+ * m * m | >> r+ \ / |/ |+ xor xor * m+ \ / |\+ * m * m | >> r+ \ / |/+ xor xor+ \ /+ * m * m+ \ /+ xor+ \+ ...+@+-}++-- -------------------------------------------------------------------+-- Instances++instance Hashable32 Char where+ hash32Add c = hash32AddInt (ord c) ++instance Hashable32 Int where+ hash32Add = hash32AddInt++instance Hashable32 Word32 where+ hash32Add = hash32AddWord32++instance Hashable32 a => Hashable32 [a] where+ hash32Add = hash32AddFoldable++instance Hashable32 Integer where+ -- Within Int range, make sure they hash to exactly the same value+ hash32Add i0+ | i0 >= fromIntegral (minBound :: Int) &&+ i0 <= fromIntegral (maxBound :: Int)+ = hash32AddInt (fromIntegral i0)+ | otherwise+ -- Prefix by sign, then hash the raw data words, starting with LSB+ = hash32Add (signum i0 > 0) `combine` + hash32AddFoldable (unfoldr f (abs i0) :: [Word32])+ where+ f i | i == 0 = Nothing+ f i = + let (i', a) = quotRem i maxWord in+ Just (fromIntegral a, i')+ maxWord = fromIntegral (maxBound :: Word32) + 1 :: Integer++instance Hashable32 Bool where+ hash32Add False = hash32AddWord32 1+ hash32Add True = hash32AddWord32 2++instance Hashable32 a => Hashable32 (Maybe a) where+ hash32Add Nothing = hash32AddWord32 3+ hash32Add (Just a) = hash32AddWord32 4 `combine` hash32Add a++instance (Hashable32 a, Hashable32 b) => Hashable32 (Either a b) where+ hash32Add (Left a) = hash32AddWord32 5 `combine` hash32Add a+ hash32Add (Right b) = hash32AddWord32 6 `combine` hash32Add b++instance Hashable32 () where+ hash32Add () = hash32AddWord32 7++instance (Hashable32 a, Hashable32 b) => Hashable32 (a, b) where+ hash32Add (a, b) = hash32Add a `combine` hash32Add b++instance (Hashable32 a, Hashable32 b, Hashable32 c)+ => Hashable32 (a, b, c) where+ hash32Add (a, b, c) =+ hash32Add a `combine` hash32Add b `combine` hash32Add c++instance (Hashable32 a, Hashable32 b, Hashable32 c, Hashable32 d)+ => Hashable32 (a, b, c, d) where+ hash32Add (a, b, c, d) =+ hash32Add a `combine` hash32Add b `combine`+ hash32Add c `combine` hash32Add d+
+ Data/Digest/Murmur64.hs view
@@ -0,0 +1,188 @@+{-# LANGUAGE FlexibleInstances, BangPatterns #-}+{-|+Module : Data.Digest.Murmur64+Copyright : (c) Thomas Schilling 2010+License : BSD-style++Maintainer : nominolo@gmail.com+Stability : experimental+Portability : portable++Type class and primitives for constructing 64 bit hashes using the+MurmurHash2 algorithm. See <http://murmurhash.googlepages.com> for+details on MurmurHash2. +-}+module Data.Digest.Murmur64 + ( Hash64, asWord64,+ Hashable64(..),+ hash64AddWord64, hash64AddInt, hash64, hash64WithSeed, combine,+ )+where++import Data.Word+import Numeric ( showHex )+import Data.Bits+import Data.Char ( ord )+import Data.Foldable+import Data.List ( unfoldr )++-- | A 64 bit hash.+newtype Hash64 = Hash64 Word64+ deriving (Eq, Ord, Bounded)++instance Show Hash64 where+ showsPrec _ (Hash64 w) = showString "Hash64 0x" . showHex w++-- | Extract 64 bit word from hash.+asWord64 :: Hash64 -> Word64+asWord64 (Hash64 w) = w++class Hashable64 a where+ hash64Add :: a -> Hash64 -> Hash64++murmur_m :: Word64+murmur_m = 0xc6a4a7935bd1e995++murmur_r :: Int+murmur_r = 47++-- | Add a 64 bit word to the hash.+hash64AddWord64 :: Word64 -> Hash64 -> Hash64+hash64AddWord64 k (Hash64 h) =+ let k1 = k * murmur_m+ k2 = k1 `xor` (k1 `shiftR` murmur_r)+ k3 = k2 * murmur_m+ h1 = h * murmur_m+ h2 = h1 `xor` k3+ in Hash64 h2++hash64AddInt :: Int -> Hash64 -> Hash64+hash64AddInt !k0 = hash64AddWord64 (fromIntegral k0)++hash64AddFoldable :: (Hashable64 a, Foldable c) => c a -> Hash64 -> Hash64+hash64AddFoldable c !h0 = foldl' f h0 c+ where f h a = hash64Add a h++-- | Create a hash using a custom seed.+--h+-- The seed should be non-zero, but other than that can be an+-- arbitrary number. Different seeds will give different hashes, and+-- thus (most likely) different hash collisions.+hash64WithSeed :: Hashable64 a => Word64 -> a -> Hash64+hash64WithSeed seed a = hash64End (hash64Add a (Hash64 seed))++-- | Create a hash using the default seed.+hash64 :: Hashable64 a => a -> Hash64+hash64 = hash64WithSeed defaultSeed++-- | Combine two hash generators. E.g.,+-- +-- @+-- hashFoo (Foo a) = hash64AddInt 1 `combine` hash64Add a+-- @+combine :: (Hash64 -> Hash64) -> (Hash64 -> Hash64) -> (Hash64 -> Hash64)+combine x y = y . x++hash64End :: Hash64 -> Hash64+hash64End (Hash64 h) =+ let h1 = h `xor` (h `shiftR` murmur_r)+ h2 = h1 * murmur_m+ h3 = h2 `xor` (h2 `shiftR` murmur_r)+ in Hash64 h3++defaultSeed :: Word64+defaultSeed = 0xdeadbeef -- not 0, otherwise hash64 [0] == hash64 []++{-++On a CPU with two multipliers and two ALUs, Murmur2 can process one+word in every two cycles + set up (2 cycles) and finish (3 cycles).++Here's the data flow graph:++@+ h k1 k2 k3 ...+ | | | |+ | * m | |+ | |\ | |+ | | >> r |+ | | / | |+ | xor * |+ | | |\ |+ * m * m | >> r+ \ / |/ |+ xor xor * m+ \ / |\+ * m * m | >> r+ \ / |/+ xor xor+ \ /+ * m * m+ \ /+ xor+ \+ ...+@+-}++-- -------------------------------------------------------------------+-- Instances++instance Hashable64 Char where+ hash64Add c = hash64AddInt (ord c) ++instance Hashable64 Int where+ hash64Add = hash64AddInt++instance Hashable64 Word64 where+ hash64Add = hash64AddWord64++instance Hashable64 a => Hashable64 [a] where+ hash64Add = hash64AddFoldable++instance Hashable64 Integer where+ -- Within Int range, make sure they hash to exactly the same value+ hash64Add i0+ | i0 >= fromIntegral (minBound :: Int) &&+ i0 <= fromIntegral (maxBound :: Int)+ = hash64AddInt (fromIntegral i0)+ | otherwise+ -- Prefix by sign, then hash the raw data words, starting with LSB+ = hash64Add (signum i0 > 0) `combine` + hash64AddFoldable (unfoldr f (abs i0) :: [Word64])+ where+ f i | i == 0 = Nothing+ f i = + let (i', a) = quotRem i maxWord in+ Just (fromIntegral a, i')+ maxWord = fromIntegral (maxBound :: Word64) + 1 :: Integer++instance Hashable64 Bool where+ hash64Add False = hash64AddWord64 1+ hash64Add True = hash64AddWord64 2++instance Hashable64 a => Hashable64 (Maybe a) where+ hash64Add Nothing = hash64AddWord64 3+ hash64Add (Just a) = hash64AddWord64 4 `combine` hash64Add a++instance (Hashable64 a, Hashable64 b) => Hashable64 (Either a b) where+ hash64Add (Left a) = hash64AddWord64 5 `combine` hash64Add a+ hash64Add (Right b) = hash64AddWord64 6 `combine` hash64Add b++instance Hashable64 () where+ hash64Add () = hash64AddWord64 7++instance (Hashable64 a, Hashable64 b) => Hashable64 (a, b) where+ hash64Add (a, b) = hash64Add a `combine` hash64Add b++instance (Hashable64 a, Hashable64 b, Hashable64 c)+ => Hashable64 (a, b, c) where+ hash64Add (a, b, c) =+ hash64Add a `combine` hash64Add b `combine` hash64Add c++instance (Hashable64 a, Hashable64 b, Hashable64 c, Hashable64 d)+ => Hashable64 (a, b, c, d) where+ hash64Add (a, b, c, d) =+ hash64Add a `combine` hash64Add b `combine`+ hash64Add c `combine` hash64Add d+
+ LICENSE view
@@ -0,0 +1,29 @@+Copyright (c) 2010, Thomas Schilling+All rights reserved.++Redistribution and use in source and binary forms, with or without+modification, are permitted provided that the following conditions are met:++- Redistributions of source code must retain the above copyright notice,+this list of conditions and the following disclaimer.+ +- Redistributions in binary form must reproduce the above copyright notice,+this list of conditions and the following disclaimer in the documentation+and/or other materials provided with the distribution.+ +- Neither name of the author nor the names of its contributors may be+used to endorse or promote products derived from this software without+specific prior written permission. ++THIS SOFTWARE IS PROVIDED BY THE AUTHOR(S) AND THE CONTRIBUTORS "AS+IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED+TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A+PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE UNIVERSITY+COURT OF THE UNIVERSITY OF GLASGOW OR THE CONTRIBUTORS BE LIABLE FOR+ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL+DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE+GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS+INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER+IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR+OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF+ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+ Setup.hs view
@@ -0,0 +1,4 @@+#!/usr/bin/env runhaskell+import Distribution.Simple+main :: IO ()+main = defaultMain
+ murmur-hash.cabal view
@@ -0,0 +1,28 @@+Name: murmur-hash+Version: 0.1+License: BSD3+License-File: LICENSE+Author: Thomas Schilling+Maintainer: Thomas Schilling <nominolo@googlemail.com>+Homepage: http://github.com/nominolo/murmur-hash+Synopsis: MurmurHash2 implementation for +Description:+ Implements MurmurHash2, a good, fast, general-purpose,+ non-cryptographic hashing function. See+ <http://murmurhash.googlepages.com/> for details.+ .+ This implementation is pure Haskell, so it might be a bit slower+ than a C FFI binding.+ +Category: Data, Digest+Stability: provisional+Build-Type: Simple+Cabal-Version: >= 1.6++Library+ Build-Depends:+ base >= 3.0 && < 4.3++ exposed-modules:+ Data.Digest.Murmur32+ Data.Digest.Murmur64