refactor(bloomfilter): abstract over hashes with Hasher type class

Author: wenkokke

bloomfilter/src/Data/BloomFilter/Blocked.hs

@@ -65,7 +65,7 @@ module Data.BloomFilter.Blocked (
 
     -- * Low level variants
     Hashes,
-    hashes,
+    Hasher(hashes),
     insertHashes,
     elemHashes,
     -- ** Prefetching
@@ -114,14 +114,14 @@ create bloomsalt bloomsize body =
 -- | Insert a value into a mutable Bloom filter.  Afterwards, a
 -- membership query for the same value is guaranteed to return @True@.
 insert :: Hashable a => MBloom s a -> a -> ST s ()
-insert = \ !mb !x -> insertHashes mb (hashes (mbHashSalt mb) x)
+insert = \ !mb !x -> insertHashes mb (hashes mb x)
 
 {-# INLINE elem #-}
 -- | Query an immutable Bloom filter for membership.  If the value is
 -- present, return @True@.  If the value is not present, there is
 -- /still/ some possibility that @True@ will be returned.
 elem :: Hashable a => a -> Bloom a -> Bool
-elem = \ !x !b -> elemHashes b (hashes (hashSalt b) x)
+elem = \ !x !b -> elemHashes b (hashes b x)
 
 -- | Same as 'elem' but with the opposite argument order:
 --
@@ -241,7 +241,7 @@ insertMany bloom key n =
         prepareProbes !i !i_w
           | i_w < 0x0f && i < n = do
               k <- key i
-              let !kh = hashes (mbHashSalt bloom) k
+              let !kh = hashes bloom k
               prefetchInsert bloom kh
               P.writePrimArray buf i_w kh
               prepareProbes (i+1) (i_w+1)
@@ -264,7 +264,7 @@ insertMany bloom key n =
           -- (from the read end of the buffer).
           | i < n = do
               k <- key i
-              let !kh = hashes (mbHashSalt bloom) k
+              let !kh = hashes bloom k
               prefetchInsert bloom kh
               P.writePrimArray buf i_w kh
               insertProbe

bloomfilter/src/Data/BloomFilter/Blocked/Internal.hs

@@ -9,7 +9,6 @@
 module Data.BloomFilter.Blocked.Internal (
     -- * Mutable Bloom filters
     MBloom,
-    mbHashSalt,
     new,
     maxSizeBits,
 
@@ -22,7 +21,7 @@ module Data.BloomFilter.Blocked.Internal (
     -- * Hash-based operations
     Hashes,
     Salt (Salt),
-    hashes,
+    Hasher (hashes),
     insertHashes,
     prefetchInsert,
     elemHashes,
@@ -44,7 +43,7 @@ import           Control.Exception (assert)
 import           Control.Monad.Primitive (PrimMonad, PrimState)
 import           Control.Monad.ST (ST)
 import           Data.Bits
-import           Data.Kind (Type)
+import           Data.Kind (Constraint, Type)
 import           Data.Primitive.ByteArray
 import           Data.Primitive.PrimArray
 import           Data.Primitive.Types (Prim (..))
@@ -331,9 +330,23 @@ type role Hashes nominal
 newtype Salt = Salt Word64
   deriving stock (Eq, Show)
 
-{-# INLINE hashes #-}
-hashes :: (Hashable a) => Salt -> a -> Hashes a
-hashes = \ (Salt !salt) !x -> Hashes (hashSalt64 salt x)
+type Hasher :: (Type -> Type) -> Constraint
+class Hasher b where
+  hashes :: (Hashable a) => b a -> a -> Hashes a
+
+instance Hasher (MBloom s) where
+  hashes :: (Hashable a) => MBloom s a -> a -> Hashes a
+  hashes = \ !mb !x -> hashesWithSalt (mbHashSalt mb) x
+  {-# INLINE hashes #-}
+
+instance Hasher Bloom where
+  hashes :: (Hashable a) => Bloom a -> a -> Hashes a
+  hashes = \ !b !x -> hashesWithSalt (hashSalt b) x
+  {-# INLINE hashes #-}
+
+{-# INLINE hashesWithSalt #-}
+hashesWithSalt :: (Hashable a) => Salt -> a -> Hashes a
+hashesWithSalt = \ (Salt !salt) !x -> Hashes (hashSalt64 salt x)
 
 {-# INLINE blockIxAndBitGen #-}
 -- | The scheme for turning 'Hashes' into block and bit indexes is as follows:

bloomfilter/src/Data/BloomFilter/Classic.hs

@@ -115,13 +115,13 @@ create bloomsalt bloomsize body =
 -- | Insert a value into a mutable Bloom filter.  Afterwards, a
 -- membership query for the same value is guaranteed to return @True@.
 insert :: Hashable a => MBloom s a -> a -> ST s ()
-insert !mb !x = insertHashes mb (hashes (mbHashSalt mb) x)
+insert !mb !x = insertHashes mb (hashes mb x)
 
 -- | Query an immutable Bloom filter for membership.  If the value is
 -- present, return @True@.  If the value is not present, there is
 -- /still/ some possibility that @True@ will be returned.
 elem :: Hashable a => a -> Bloom a -> Bool
-elem = \ !x !b -> elemHashes b (hashes (hashSalt b) x)
+elem = \ !x !b -> elemHashes b (hashes b x)
 
 -- | Same as 'elem' but with the opposite argument order:
 --
@@ -144,7 +144,7 @@ notElem = \ x b -> not (x `elem` b)
 -- present, return @True@.  If the value is not present, there is
 -- /still/ some possibility that @True@ will be returned.
 read :: Hashable a => MBloom s a -> a -> ST s Bool
-read !mb !x = readHashes mb (hashes (mbHashSalt mb) x)
+read !mb !x = readHashes mb (hashes mb x)
 
 -- | Build an immutable Bloom filter from a seed value.  The seeding
 -- function populates the filter as follows.

bloomfilter/src/Data/BloomFilter/Classic/Internal.hs

@@ -21,7 +21,7 @@ module Data.BloomFilter.Classic.Internal (
     -- * Hash-based operations
     Hashes,
     Salt (Salt),
-    hashes,
+    Hasher (hashes),
     insertHashes,
     elemHashes,
     readHashes,
@@ -42,7 +42,7 @@ import           Control.Exception (assert)
 import           Control.Monad.Primitive (PrimMonad, PrimState)
 import           Control.Monad.ST (ST)
 import           Data.Bits
-import           Data.Kind (Type)
+import           Data.Kind (Constraint, Type)
 import           Data.Primitive.ByteArray
 import           Data.Primitive.PrimArray
 import           Data.Primitive.Types (Prim (..))
@@ -439,9 +439,23 @@ https://github.com/facebook/rocksdb/blob/096fb9b67d19a9a180e7c906b4a0cdb2b2d0c1f
 evalHashes :: Hashes a -> Int -> Hash
 evalHashes (Hashes h1 h2) i = h1 + (h2 `unsafeShiftR` i)
 
+type Hasher :: (Type -> Type) -> Constraint
+class Hasher b where
+  hashes :: (Hashable a) => b a -> a -> Hashes a
+
+instance Hasher (MBloom s) where
+  hashes :: (Hashable a) => MBloom s a -> a -> Hashes a
+  hashes = \ !mb !x -> hashesWithSalt (mbHashSalt mb) x
+  {-# INLINE hashes #-}
+
+instance Hasher Bloom where
+  hashes :: (Hashable a) => Bloom a -> a -> Hashes a
+  hashes = \ !b !x -> hashesWithSalt (hashSalt b) x
+  {-# INLINE hashes #-}
+
 -- | Create 'Hashes' structure.
 --
 -- It's simply hashes the value twice using seed 0 and 1.
-hashes :: Hashable a => Salt -> a -> Hashes a
-hashes (Salt salt) v = Hashes (hashSalt64 salt v) (hashSalt64 (salt + 1) v)
-{-# INLINE hashes #-}
+hashesWithSalt :: Hashable a => Salt -> a -> Hashes a
+hashesWithSalt (Salt salt) v = Hashes (hashSalt64 salt v) (hashSalt64 (salt + 1) v)
+{-# INLINE hashesWithSalt #-}