{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE DefaultSignatures #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE KindSignatures #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE PackageImports #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeApplications #-}

-- |
-- Module: Data.Cuckoo
-- Copyright: Copyright © 2019-2021 Lars Kuhtz <lakuhtz@gmail.com>
-- License: BSD3
-- Maintainer: Lars Kuhtz <lakuhtz@gmail.com>
-- Stability: experimental
--
-- Haskell implementation of Cuckoo filters as described in
--
-- <https://www.cs.cmu.edu/~dga/papers/cuckoo-conext2014.pdf B. Fan, D.G. Anderson, M. Kaminsky, M.D. Mitzenmacher. Cuckoo Filter: Practically Better Than Bloom. In Proc. CoNEXT, 2014.>
--
-- Cuckoo filters are a data structure for probabilistic set membership. They
-- support insertion, deletion, and membership queries for set elements.
--
-- Membership queries may return false positive results. But queries don't
-- return false negative results.
--
-- Unlike Bloom filters, Cuckoo filters maintain an upper bound on the false
-- positive rate that is independent of the load of the filter. However,
-- insertion of new elements in the filter can fail. For typical
-- configurations this probability is very small for load factors smaller than
-- 90 percent.
--
-- = Example
--
-- > {-# LANGUAGE DataKinds #-}
-- > {-# LANGUAGE TypeApplications #-}
-- > {-# LANGUAGE TypeFamilies #-}
-- > {-# OPTIONS_GHC -fno-warn-orphans #-}
-- >
-- > import Control.Monad (filterM)
-- > import Data.Cuckoo
-- > import Data.List ((\\))
-- >
-- > -- Define CuckooFilterHash instance (this uses the default implementation)
-- > instance CuckooFilterHash Int
-- >
-- > main :: IO ()
-- > main = do
-- >     -- Create Filter for a minimum of 500000 entries
-- >     f <- newCuckooFilter @4 @8 @Int 0 500000
-- >
-- >     -- Insert 450000 items
-- >     failed <- filterM (fmap not . insert f) [0..500000-1]
-- >
-- >     -- Query inserted items
-- >     missing <- filterM (fmap not . member f) [0..500000-1]
-- >
-- >     -- Test for false positives
-- >     false <- filterM (member f) [500000..1000000 - 1]
-- >
-- >     -- Report results
-- >     putStrLn $ "failed inserts: " <> show (length failed)
-- >     putStrLn $ "false positives: " <> show (length false)
-- >     putStrLn $ "false positive rate (%): " <> show @Double (fromIntegral (length false) * 100 / 500000)
-- >     putStrLn $ "missing (must be 0): " <> show (length $ missing \\ failed)
-- >
-- >     -- Filter properties
-- >     putStrLn $ "capacity: " <> show (capacityInItems f)
-- >     putStrLn $ "size in allocated bytes: " <> show (sizeInAllocatedBytes f)
-- >
-- >     -- computing the following is a bit slow
-- >     c <- itemCount f
-- >     putStrLn $ "item count: " <> show c
-- >     lf <- loadFactor f
-- >     putStrLn $ "load factor (%): " <> show lf
-- >     putStrLn $ "bits per item: " <> show @Double (fromIntegral (sizeInAllocatedBytes f) * 8 / fromIntegral c)
--
module Data.Cuckoo
(
-- * Hash Functions
  Salt(..)
, CuckooFilterHash(..)

-- ** Hash functions
, saltedSipHashStorable
, saltedSipHashByteString
, saltedSipHashPtr
, saltedFnv1aStorable
, saltedFnv1aByteString
, saltedFnv1aPtr

-- * Cuckoo Filter
, CuckooFilter
, CuckooFilterIO
, newCuckooFilter

-- * Cuckoo Filter Operations
, insert
, member
, delete

-- * Utils
, sizeInAllocatedBytes
, capacityInItems
, itemCount
, loadFactor

-- * Debugging Utils
, showFilter
, itemHashes
) where

import Control.Applicative
import Control.Monad
import Control.Monad.Primitive

import Data.Bits
import Data.Bool
import Data.Kind
import Data.Maybe
import Data.Primitive.ByteArray

import Foreign

import GHC.TypeLits

import Numeric.Natural

import Prelude hiding (null)

import "cuckoo" System.Random.Internal

import Text.Printf

-- internal modules

import Data.Cuckoo.Internal
import Data.Cuckoo.Internal.HashFunctions

-- $setup
-- >>> :set -XTypeApplications -XDataKinds -XTypeFamilies
-- >>> :{
-- instance CuckooFilterHash Int where
--     -- can't use default implementation with doctest because of a bug in GHC-9
--     cuckooHash (Salt s) a = saltedFnv1aStorable s a
--     cuckooFingerprint (Salt s) a = saltedSipHashStorable s a
--     {-# INLINE cuckooHash #-}
--     {-# INLINE cuckooFingerprint #-}
-- :}

-- -------------------------------------------------------------------------- --
-- Hash Functions

-- The hashable package is a bit of a kitchen sink. Instances for different data
-- types use hash functions with very different properites and of varying
-- quality. Neither of this is documented.
--
-- Primitive base types, including all number types use fast instances that
-- provided very little uniformity in the output with respect to input data and
-- salt. Don't use these!
--
-- ByteString uses a pure Haskell implementation of Sip hash.
--
-- The helper functions for low-level ptrs (Ptr, ByteArray) use a C
-- implementation of fnv.
--
-- Because of the variying quality and properties of the functions, absence of
-- any control over which function is used, and no guarantees with respect to
-- stability accross versions, we don't use that package altogether.
--

-- | Salt for hash computations.
--
newtype Salt = Salt Int
    deriving (Int -> Salt -> ShowS
[Salt] -> ShowS
Salt -> String
(Int -> Salt -> ShowS)
-> (Salt -> String) -> ([Salt] -> ShowS) -> Show Salt
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Salt] -> ShowS
$cshowList :: [Salt] -> ShowS
show :: Salt -> String
$cshow :: Salt -> String
showsPrec :: Int -> Salt -> ShowS
$cshowsPrec :: Int -> Salt -> ShowS
Show, Salt -> Salt -> Bool
(Salt -> Salt -> Bool) -> (Salt -> Salt -> Bool) -> Eq Salt
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Salt -> Salt -> Bool
$c/= :: Salt -> Salt -> Bool
== :: Salt -> Salt -> Bool
$c== :: Salt -> Salt -> Bool
Eq, Eq Salt
Eq Salt
-> (Salt -> Salt -> Ordering)
-> (Salt -> Salt -> Bool)
-> (Salt -> Salt -> Bool)
-> (Salt -> Salt -> Bool)
-> (Salt -> Salt -> Bool)
-> (Salt -> Salt -> Salt)
-> (Salt -> Salt -> Salt)
-> Ord Salt
Salt -> Salt -> Bool
Salt -> Salt -> Ordering
Salt -> Salt -> Salt
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 :: Salt -> Salt -> Salt
$cmin :: Salt -> Salt -> Salt
max :: Salt -> Salt -> Salt
$cmax :: Salt -> Salt -> Salt
>= :: Salt -> Salt -> Bool
$c>= :: Salt -> Salt -> Bool
> :: Salt -> Salt -> Bool
$c> :: Salt -> Salt -> Bool
<= :: Salt -> Salt -> Bool
$c<= :: Salt -> Salt -> Bool
< :: Salt -> Salt -> Bool
$c< :: Salt -> Salt -> Bool
compare :: Salt -> Salt -> Ordering
$ccompare :: Salt -> Salt -> Ordering
$cp1Ord :: Eq Salt
Ord, Int -> Salt
Salt -> Int
Salt -> [Salt]
Salt -> Salt
Salt -> Salt -> [Salt]
Salt -> Salt -> Salt -> [Salt]
(Salt -> Salt)
-> (Salt -> Salt)
-> (Int -> Salt)
-> (Salt -> Int)
-> (Salt -> [Salt])
-> (Salt -> Salt -> [Salt])
-> (Salt -> Salt -> [Salt])
-> (Salt -> Salt -> Salt -> [Salt])
-> Enum Salt
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
enumFromThenTo :: Salt -> Salt -> Salt -> [Salt]
$cenumFromThenTo :: Salt -> Salt -> Salt -> [Salt]
enumFromTo :: Salt -> Salt -> [Salt]
$cenumFromTo :: Salt -> Salt -> [Salt]
enumFromThen :: Salt -> Salt -> [Salt]
$cenumFromThen :: Salt -> Salt -> [Salt]
enumFrom :: Salt -> [Salt]
$cenumFrom :: Salt -> [Salt]
fromEnum :: Salt -> Int
$cfromEnum :: Salt -> Int
toEnum :: Int -> Salt
$ctoEnum :: Int -> Salt
pred :: Salt -> Salt
$cpred :: Salt -> Salt
succ :: Salt -> Salt
$csucc :: Salt -> Salt
Enum, Enum Salt
Real Salt
Real Salt
-> Enum Salt
-> (Salt -> Salt -> Salt)
-> (Salt -> Salt -> Salt)
-> (Salt -> Salt -> Salt)
-> (Salt -> Salt -> Salt)
-> (Salt -> Salt -> (Salt, Salt))
-> (Salt -> Salt -> (Salt, Salt))
-> (Salt -> Integer)
-> Integral Salt
Salt -> Integer
Salt -> Salt -> (Salt, Salt)
Salt -> Salt -> Salt
forall a.
Real a
-> Enum a
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> (a, a))
-> (a -> a -> (a, a))
-> (a -> Integer)
-> Integral a
toInteger :: Salt -> Integer
$ctoInteger :: Salt -> Integer
divMod :: Salt -> Salt -> (Salt, Salt)
$cdivMod :: Salt -> Salt -> (Salt, Salt)
quotRem :: Salt -> Salt -> (Salt, Salt)
$cquotRem :: Salt -> Salt -> (Salt, Salt)
mod :: Salt -> Salt -> Salt
$cmod :: Salt -> Salt -> Salt
div :: Salt -> Salt -> Salt
$cdiv :: Salt -> Salt -> Salt
rem :: Salt -> Salt -> Salt
$crem :: Salt -> Salt -> Salt
quot :: Salt -> Salt -> Salt
$cquot :: Salt -> Salt -> Salt
$cp2Integral :: Enum Salt
$cp1Integral :: Real Salt
Integral, Num Salt
Ord Salt
Num Salt -> Ord Salt -> (Salt -> Rational) -> Real Salt
Salt -> Rational
forall a. Num a -> Ord a -> (a -> Rational) -> Real a
toRational :: Salt -> Rational
$ctoRational :: Salt -> Rational
$cp2Real :: Ord Salt
$cp1Real :: Num Salt
Real, Integer -> Salt
Salt -> Salt
Salt -> Salt -> Salt
(Salt -> Salt -> Salt)
-> (Salt -> Salt -> Salt)
-> (Salt -> Salt -> Salt)
-> (Salt -> Salt)
-> (Salt -> Salt)
-> (Salt -> Salt)
-> (Integer -> Salt)
-> Num Salt
forall a.
(a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a)
-> (a -> a)
-> (a -> a)
-> (Integer -> a)
-> Num a
fromInteger :: Integer -> Salt
$cfromInteger :: Integer -> Salt
signum :: Salt -> Salt
$csignum :: Salt -> Salt
abs :: Salt -> Salt
$cabs :: Salt -> Salt
negate :: Salt -> Salt
$cnegate :: Salt -> Salt
* :: Salt -> Salt -> Salt
$c* :: Salt -> Salt -> Salt
- :: Salt -> Salt -> Salt
$c- :: Salt -> Salt -> Salt
+ :: Salt -> Salt -> Salt
$c+ :: Salt -> Salt -> Salt
Num)

-- | Choosing good hash functions is imperative for a good performance of a
-- cuckoo filter. The hash functions must be
--
-- * independent and
-- * provide good uniformity on the lower bits of the output.
--
-- The default implementations use sip hash for 'cuckooHash' and 'fnv1a' (64
-- bit) for 'cuckooFingerprint' and require an instance of 'Storable'.
--
-- >>> :{
-- instance CuckooFilterHash Int where
--     -- can't use default implementation with doctest because of a bug in GHC-9
--     cuckooHash (Salt s) a = saltedFnv1aStorable s a
--     cuckooFingerprint (Salt s) a = saltedSipHashStorable s a
--     {-# INLINE cuckooHash #-}
--     {-# INLINE cuckooFingerprint #-}
-- :}
--
-- The following example uses the hash functions that are provided in this
-- module to define an instance for 'B.ByteString':
--
-- >>> import qualified Data.ByteString as B
-- >>> :{
-- instance CuckooFilterHash B.ByteString where
--     cuckooHash (Salt s) a = saltedFnv1aByteString s a
--     cuckooFingerprint (Salt s) a = saltedSipHashByteString s a
--     {-# INLINE cuckooHash #-}
--     {-# INLINE cuckooFingerprint #-}
-- :}
--
class CuckooFilterHash a where

    -- | This function must provide good entropy on the lower
    -- \(2^b - 1\) bits of the result, where \(b\) is the number of buckets.
    --
    cuckooHash :: Salt -> a -> Word64

    -- | This function must provide good entropy on the lower
    -- bits of the size of a fingerprint.
    --
    cuckooFingerprint :: Salt -> a -> Word64

    -- | Default implementation of 'cuckooHash' for types that are an instance
    -- of 'Storable'.
    --
    default cuckooHash :: Storable a => Salt -> a -> Word64
    cuckooHash (Salt Int
s) = Int -> a -> Word64
forall a. Storable a => Int -> a -> Word64
saltedSipHashStorable Int
s
    {-# INLINE cuckooHash #-}

    -- | Default implementation of 'cuckooFingerprint' for types that are an
    -- instance of 'Storable'.
    --
    default cuckooFingerprint :: Storable a => Salt -> a -> Word64
    cuckooFingerprint (Salt Int
s) = Int -> a -> Word64
forall a. Storable a => Int -> a -> Word64
saltedFnv1aStorable Int
s
    {-# INLINE cuckooFingerprint #-}

-- -------------------------------------------------------------------------- --
-- Cuckoo Filter

-- | Cuckoo Filter with
--
-- * State token @s :: Type@,
-- * bucket size @b :: Nat@,
-- * fingerprint size @f :: Nat@, and
-- * content type @a :: Type@.
--
-- The following constraints apply
--
-- * \(0 < f \leq 32\)
-- * \(0 < b\)
--
-- The implementation is not thread safe. For concurrent use the filter must be
-- wrapped in a read-write lock.
--
data CuckooFilter s (b :: Nat) (f :: Nat) (a :: Type)
    = CuckooFilter
        { CuckooFilter s b f a -> Int
_cfBucketCount :: {-# UNPACK #-} !Int
        , CuckooFilter s b f a -> Salt
_cfSalt :: {-# UNPACK #-} !Salt
        , CuckooFilter s b f a -> Gen s
_cfRng :: {-# UNPACK #-} !(Gen s)
        , CuckooFilter s b f a -> MutableByteArray s
_cfData :: {-# UNPACK #-} !(MutableByteArray s)
        }

-- | Cuckoo filter that can be used in the `IO` monad.
--
type CuckooFilterIO b f a = CuckooFilter RealWorld b f a

-- | Create a new Cuckoo filter that has at least the given capacity.
--
-- Enabling the @TypeApplications@ language extension provides a convenient way
-- for passing the type parameters to the function.
--
-- >>> :set -XTypeApplications -XDataKinds -XTypeFamilies
-- >>> newCuckooFilter @4 @10 @Int 0 1000
--
-- The type parameters are
--
-- * bucket size @b :: Nat@,
-- * fingerprint size @f :: Nat@,
-- * content type @a :: Type@, and
-- * Monad @m :: Type -> Type@,
--
-- The following constraints apply:
--
-- * \(0 < f \leq 32\),
-- * \(0 < b\), and
-- * \(64 \leq n\), where \(n\) is the requested size.
--
-- The false positive rate depends mostly on the value of @f@. It is bounded
-- from above by \(\frac{2b}{2^f}\). In most cases @4@ is a good choice for @b@.
--
-- Actual performance depends on the choice of good hash functions that provide
-- high uniformity on the lower bits.
--
-- The actual capacity may be much larger than what is requested, because the
-- actual bucket count is a power of two.
--
-- >>> f <- newCuckooFilter @4 @10 @Int 0 600
-- >>> capacityInItems f
-- 1024
-- >>> sizeInAllocatedBytes f
-- 1284
--
newCuckooFilter
    :: forall b f a m
    . KnownNat b
    => KnownNat f
    => PrimMonad m
    => Salt
        -- ^ Salt for the hash functions.
    -> Natural
        -- ^ Size. Must be at least 64.
    -> m (CuckooFilter (PrimState m) b f a)
newCuckooFilter :: Salt -> Natural -> m (CuckooFilter (PrimState m) b f a)
newCuckooFilter Salt
salt Natural
n = do
    m ()
check
    MutableByteArray (PrimState m)
arr <- Int -> m (MutableByteArray (PrimState m))
forall (m :: * -> *).
PrimMonad m =>
Int -> m (MutableByteArray (PrimState m))
newByteArray Int
bytes
    MutableByteArray (PrimState m) -> Int -> Int -> Word8 -> m ()
forall (m :: * -> *).
PrimMonad m =>
MutableByteArray (PrimState m) -> Int -> Int -> Word8 -> m ()
fillByteArray MutableByteArray (PrimState m)
arr Int
0 Int
bytes Word8
0
    Int
-> Salt
-> Gen (PrimState m)
-> MutableByteArray (PrimState m)
-> CuckooFilter (PrimState m) b f a
forall s (b :: Nat) (f :: Nat) a.
Int -> Salt -> Gen s -> MutableByteArray s -> CuckooFilter s b f a
CuckooFilter Int
buckets Salt
salt
        (Gen (PrimState m)
 -> MutableByteArray (PrimState m)
 -> CuckooFilter (PrimState m) b f a)
-> m (Gen (PrimState m))
-> m (MutableByteArray (PrimState m)
      -> CuckooFilter (PrimState m) b f a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Int -> m (Gen (PrimState m))
forall (m :: * -> *). PrimMonad m => Int -> m (Gen (PrimState m))
initialize (Salt -> Int
forall a b. (Integral a, Num b) => a -> b
int Salt
salt)
        m (MutableByteArray (PrimState m)
   -> CuckooFilter (PrimState m) b f a)
-> m (MutableByteArray (PrimState m))
-> m (CuckooFilter (PrimState m) b f a)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> MutableByteArray (PrimState m)
-> m (MutableByteArray (PrimState m))
forall (f :: * -> *) a. Applicative f => a -> f a
pure MutableByteArray (PrimState m)
arr
  where
    minBuckets :: Natural
minBuckets = Natural -> Int -> Natural
forall a b. (Integral a, Integral b) => a -> b -> a
intFit Natural
n (KnownNat b => Int
forall (n :: Nat). KnownNat n => Int
w @b) -- minimum number of buckets match requested capacity
    buckets :: Int
buckets = Int -> Int
intNextPowerOfTwo (Natural -> Int
forall a b. (Integral a, Num b) => a -> b
int Natural
minBuckets) -- actual number of buckets
    items :: Int
items = KnownNat b => Int
forall (n :: Nat). KnownNat n => Int
w @b Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
buckets -- actual capacity (in number of items)
    bytes :: Int
bytes = Int -> Int -> Int
forall a b. (Integral a, Integral b) => a -> b -> a
intFit @_ @Int (KnownNat f => Int
forall (n :: Nat). KnownNat n => Int
w @f Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
items) Int
8 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
4 -- total number of allocated bytes

        -- we add 4 extra bytes to avoid having to deal with corner cases when
        -- reading and writing fingerprints that are not aligned to Word32 at
        -- the end of the filter.

    check :: m ()
check
        | Bool -> Bool
not (Int
0 Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< KnownNat f => Int
forall (n :: Nat). KnownNat n => Int
w @f) = String -> m ()
forall a. HasCallStack => String -> a
error String
"Fingerprint size must be positive"
        | Bool -> Bool
not (KnownNat f => Int
forall (n :: Nat). KnownNat n => Int
w @f Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
32) = String -> m ()
forall a. HasCallStack => String -> a
error String
"Fingerprint size must not be larger than 32"
        | Bool -> Bool
not (Int
0 Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< KnownNat b => Int
forall (n :: Nat). KnownNat n => Int
w @b) = String -> m ()
forall a. HasCallStack => String -> a
error String
"Bucket size (items per bucket) must be positive"
        | Bool -> Bool
not (Natural
0 Natural -> Natural -> Bool
forall a. Ord a => a -> a -> Bool
< Natural
n) = String -> m ()
forall a. HasCallStack => String -> a
error String
"The size (number of items) of the filter must be positive"
        | Bool -> Bool
not (Natural
64 Natural -> Natural -> Bool
forall a. Ord a => a -> a -> Bool
<= Natural
n) = String -> m ()
forall a. HasCallStack => String -> a
error String
"Seriously? Are you kidding me? If you need to represent such a tiny set, you'll have to pick another data structure for that"
        | Bool
otherwise = () -> m ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

-- -------------------------------------------------------------------------- --
-- Insert

-- TODO: reduce number of reads, in checkBucket and don't re-read value
-- during setFingerprint. Similarly, don't recompute hashes.
--
-- TODO: is the RNG really important here (for security or performance) or is
-- the hash function sufficient? (For preventing attacks, is the salt
-- sufficient). Could we also compute the relocation slot from the hash?

-- | Insert an item into the filter and return whether the operation was
-- successful. If insertion fails, the filter is unchanged. An item can be
-- inserted more than once. The return value indicates whether insertion was
-- successful. The operation can fail when the filter doesn't have enough space
-- for the item.
--
-- This function is not thread safe. No concurrent writes or reads should occur
-- while this function is executed. If this is needed a lock must be used.
--
-- This function is not exception safe. The filter must not be used any more
-- after an asynchronous exception has been thrown during the computation of this
-- function. If this function is used in the presence of asynchronous exceptions
-- it should be apprioriately masked.
--
-- >>> f <- newCuckooFilter @4 @10 @Int 0 1000
-- >>> insert f 0
-- True
-- >>> insert f 0
-- True
-- >>> itemCount f
-- 2
--
insert
    :: forall b f a m
    . KnownNat f
    => KnownNat b
    => PrimMonad m
    => CuckooFilterHash a
    => CuckooFilter (PrimState m) b f a
    -> a
    -> m Bool
insert :: CuckooFilter (PrimState m) b f a -> a -> m Bool
insert CuckooFilter (PrimState m) b f a
f a
a = do
  (Bucket
b1, Bucket
b2, Fingerprint f
fp) <- CuckooFilter (PrimState m) b f a
-> a -> m (Bucket, Bucket, Fingerprint f)
forall a (m :: * -> *) (f :: Nat) (b :: Nat).
(CuckooFilterHash a, PrimMonad m, KnownNat f, KnownNat b) =>
CuckooFilter (PrimState m) b f a
-> a -> m (Bucket, Bucket, Fingerprint f)
getBucketsRandom CuckooFilter (PrimState m) b f a
f a
a
  CuckooFilter (PrimState m) b f a
-> Bucket -> Fingerprint f -> m (Maybe Slot)
forall (b :: Nat) (f :: Nat) a (m :: * -> *).
(PrimMonad m, KnownNat f, KnownNat b) =>
CuckooFilter (PrimState m) b f a
-> Bucket -> Fingerprint f -> m (Maybe Slot)
checkBucket CuckooFilter (PrimState m) b f a
f Bucket
b1 Fingerprint f
forall (f :: Nat). Fingerprint f
null m (Maybe Slot) -> (Maybe Slot -> m Bool) -> m Bool
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
      Just Slot
i -> Bool
True Bool -> m () -> m Bool
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ CuckooFilter (PrimState m) b f a
-> Bucket -> Slot -> Fingerprint f -> m ()
forall (b :: Nat) (f :: Nat) a (m :: * -> *).
(KnownNat f, KnownNat b, PrimMonad m) =>
CuckooFilter (PrimState m) b f a
-> Bucket -> Slot -> Fingerprint f -> m ()
setFingerprint CuckooFilter (PrimState m) b f a
f Bucket
b1 Slot
i Fingerprint f
fp
      Maybe Slot
Nothing -> Int -> Bucket -> Fingerprint f -> m Bool
kick Int
500 Bucket
b2 Fingerprint f
fp
  where

    -- TODO make this exception safe? Do we need that?
    --
    kick :: Int -> Bucket -> Fingerprint f -> m Bool
kick Int
0 Bucket
_ Fingerprint f
_ = Bool -> m Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
False
    kick Int
c Bucket
b Fingerprint f
k = CuckooFilter (PrimState m) b f a
-> Bucket -> Fingerprint f -> m (Maybe Slot)
forall (b :: Nat) (f :: Nat) a (m :: * -> *).
(PrimMonad m, KnownNat f, KnownNat b) =>
CuckooFilter (PrimState m) b f a
-> Bucket -> Fingerprint f -> m (Maybe Slot)
checkBucket CuckooFilter (PrimState m) b f a
f Bucket
b Fingerprint f
forall (f :: Nat). Fingerprint f
null m (Maybe Slot) -> (Maybe Slot -> m Bool) -> m Bool
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
        Just Slot
i -> Bool
True Bool -> m () -> m Bool
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ CuckooFilter (PrimState m) b f a
-> Bucket -> Slot -> Fingerprint f -> m ()
forall (b :: Nat) (f :: Nat) a (m :: * -> *).
(KnownNat f, KnownNat b, PrimMonad m) =>
CuckooFilter (PrimState m) b f a
-> Bucket -> Slot -> Fingerprint f -> m ()
setFingerprint CuckooFilter (PrimState m) b f a
f Bucket
b Slot
i Fingerprint f
k
        Maybe Slot
Nothing -> do
            Slot
i <- m Slot
randomSlot
            Fingerprint f
k' <- Bucket -> Slot -> Fingerprint f -> m (Fingerprint f)
swapFingerprint Bucket
b Slot
i Fingerprint f
k
            Int -> Bucket -> Fingerprint f -> m Bool
kick (Int -> Int
forall a. Enum a => a -> a
pred @Int Int
c) (CuckooFilter (PrimState m) b f a
-> Bucket -> Fingerprint f -> Bucket
forall s (b :: Nat) (f :: Nat) a.
CuckooFilter s b f a -> Bucket -> Fingerprint f -> Bucket
otherBucket CuckooFilter (PrimState m) b f a
f Bucket
b Fingerprint f
k') Fingerprint f
k' m Bool -> (Bool -> m Bool) -> m Bool
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
                Bool
False -> Bool
False Bool -> m () -> m Bool
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ CuckooFilter (PrimState m) b f a
-> Bucket -> Slot -> Fingerprint f -> m ()
forall (b :: Nat) (f :: Nat) a (m :: * -> *).
(KnownNat f, KnownNat b, PrimMonad m) =>
CuckooFilter (PrimState m) b f a
-> Bucket -> Slot -> Fingerprint f -> m ()
setFingerprint CuckooFilter (PrimState m) b f a
f Bucket
b Slot
i Fingerprint f
k'
                Bool
x -> Bool -> m Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
x
    {-# INLINE kick #-}

    randomSlot :: m Slot
randomSlot = Int -> Slot
Slot (Int -> Slot) -> m Int -> m Slot
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Int, Int) -> Gen (PrimState m) -> m Int
forall b (m :: * -> *).
(Variate b, PrimMonad m) =>
(b, b) -> Gen (PrimState m) -> m b
uniformR (Int
0, KnownNat b => Int
forall (n :: Nat). KnownNat n => Int
w @b Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1) (CuckooFilter (PrimState m) b f a -> Gen (PrimState m)
forall s (b :: Nat) (f :: Nat) a. CuckooFilter s b f a -> Gen s
_cfRng CuckooFilter (PrimState m) b f a
f)
    {-# INLINE randomSlot #-}

    swapFingerprint :: Bucket -> Slot -> Fingerprint f -> m (Fingerprint f)
swapFingerprint Bucket
b Slot
i Fingerprint f
k = do
        Fingerprint f
k' <- CuckooFilter (PrimState m) b f a
-> Bucket -> Slot -> m (Fingerprint f)
forall (b :: Nat) (f :: Nat) a (m :: * -> *).
(KnownNat f, KnownNat b, PrimMonad m) =>
CuckooFilter (PrimState m) b f a
-> Bucket -> Slot -> m (Fingerprint f)
readFingerprint CuckooFilter (PrimState m) b f a
f Bucket
b Slot
i
        CuckooFilter (PrimState m) b f a
-> Bucket -> Slot -> Fingerprint f -> m ()
forall (b :: Nat) (f :: Nat) a (m :: * -> *).
(KnownNat f, KnownNat b, PrimMonad m) =>
CuckooFilter (PrimState m) b f a
-> Bucket -> Slot -> Fingerprint f -> m ()
setFingerprint CuckooFilter (PrimState m) b f a
f Bucket
b Slot
i Fingerprint f
k
        Fingerprint f -> m (Fingerprint f)
forall (m :: * -> *) a. Monad m => a -> m a
return Fingerprint f
k'
    {-# INLINE swapFingerprint #-}

-- -------------------------------------------------------------------------- --
-- Member Test

-- | Test whether an item is in the set that is represented by the Cuckoo
-- filter.
--
-- A negative result means that the item is definitively not in the set. A
-- positive result means that the item is most likely in the set. The rate of
-- false positives is bounded from above by \(\frac{2b}{2^f}\) where @b@ is the number
-- of items per bucket and @f@ is the size of a fingerprint in bits.
--
-- >>> f <- newCuckooFilter @4 @10 @Int 0 1000
-- >>> insert f 0
-- True
-- >>> member f 0
-- True
-- >>> member f 1
-- False
--
member
    :: CuckooFilterHash a
    => PrimMonad m
    => KnownNat f
    => KnownNat b
    => CuckooFilter (PrimState m) b f a
    -> a
    -> m Bool
member :: CuckooFilter (PrimState m) b f a -> a -> m Bool
member CuckooFilter (PrimState m) b f a
f a
a = CuckooFilter (PrimState m) b f a
-> Bucket -> Fingerprint f -> m (Maybe Slot)
forall (b :: Nat) (f :: Nat) a (m :: * -> *).
(PrimMonad m, KnownNat f, KnownNat b) =>
CuckooFilter (PrimState m) b f a
-> Bucket -> Fingerprint f -> m (Maybe Slot)
checkBucket CuckooFilter (PrimState m) b f a
f Bucket
b1 Fingerprint f
fp m (Maybe Slot) -> (Maybe Slot -> m Bool) -> m Bool
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
    Just Slot
_ -> Bool -> m Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
True
    Maybe Slot
Nothing -> CuckooFilter (PrimState m) b f a
-> Bucket -> Fingerprint f -> m (Maybe Slot)
forall (b :: Nat) (f :: Nat) a (m :: * -> *).
(PrimMonad m, KnownNat f, KnownNat b) =>
CuckooFilter (PrimState m) b f a
-> Bucket -> Fingerprint f -> m (Maybe Slot)
checkBucket CuckooFilter (PrimState m) b f a
f Bucket
b2 Fingerprint f
fp m (Maybe Slot) -> (Maybe Slot -> m Bool) -> m Bool
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
        Just Slot
_ -> Bool -> m Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
True
        Maybe Slot
Nothing -> Bool -> m Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
False
  where
    salt :: Salt
salt = CuckooFilter (PrimState m) b f a -> Salt
forall s (b :: Nat) (f :: Nat) a. CuckooFilter s b f a -> Salt
_cfSalt CuckooFilter (PrimState m) b f a
f
    b1 :: Bucket
b1 = CuckooFilter (PrimState m) b f a -> a -> Bucket
forall a s (b :: Nat) (f :: Nat).
CuckooFilterHash a =>
CuckooFilter s b f a -> a -> Bucket
bucket1 CuckooFilter (PrimState m) b f a
f a
a
    b2 :: Bucket
b2 = CuckooFilter (PrimState m) b f a
-> Bucket -> Fingerprint f -> Bucket
forall s (b :: Nat) (f :: Nat) a.
CuckooFilter s b f a -> Bucket -> Fingerprint f -> Bucket
otherBucket CuckooFilter (PrimState m) b f a
f Bucket
b1 Fingerprint f
fp
    fp :: Fingerprint f
fp = Salt -> a -> Fingerprint f
forall (f :: Nat) a.
(KnownNat f, CuckooFilterHash a) =>
Salt -> a -> Fingerprint f
mkFingerprint Salt
salt a
a
{-# INLINE member #-}

-- -------------------------------------------------------------------------- --
-- Delete

-- | Delete an items from the filter. An item that was inserted more than once
-- can also be deleted more than once.
--
-- /IMPORTANT/ An item must only be deleted if it was successfully added to the
-- filter before (and hasn't been deleted since then).
--
-- Deleting an item that isn't in the filter can result in the filter returning
-- false negative results.
--
-- This function is not thread safe. No concurrent writes must occur while this
-- function is executed. If this is needed a lock must be used. Concurrent reads
-- are fine.
--
-- >>> f <- newCuckooFilter @4 @10 @Int 0 1000
-- >>> insert f 0
-- True
-- >>> insert f 0
-- True
-- >>> itemCount f
-- 2
-- >>> delete f 0
-- True
-- >>> itemCount f
-- 1
-- >>> member f 0
-- True
-- >>> delete f 0
-- True
-- >>> itemCount f
-- 0
-- >>> member f 0
-- False
--
delete
    :: CuckooFilterHash a
    => PrimMonad m
    => KnownNat f
    => KnownNat b
    => CuckooFilter (PrimState m) b f a
    -> a
    -> m Bool
delete :: CuckooFilter (PrimState m) b f a -> a -> m Bool
delete CuckooFilter (PrimState m) b f a
f a
a = do
    (Bucket
b1, Bucket
b2, Fingerprint f
fp) <- CuckooFilter (PrimState m) b f a
-> a -> m (Bucket, Bucket, Fingerprint f)
forall a (m :: * -> *) (f :: Nat) (b :: Nat).
(CuckooFilterHash a, PrimMonad m, KnownNat f, KnownNat b) =>
CuckooFilter (PrimState m) b f a
-> a -> m (Bucket, Bucket, Fingerprint f)
getBucketsRandom CuckooFilter (PrimState m) b f a
f a
a
    CuckooFilter (PrimState m) b f a
-> Bucket -> Fingerprint f -> m (Maybe Slot)
forall (b :: Nat) (f :: Nat) a (m :: * -> *).
(PrimMonad m, KnownNat f, KnownNat b) =>
CuckooFilter (PrimState m) b f a
-> Bucket -> Fingerprint f -> m (Maybe Slot)
checkBucket CuckooFilter (PrimState m) b f a
f Bucket
b1 Fingerprint f
fp m (Maybe Slot) -> (Maybe Slot -> m Bool) -> m Bool
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
        Just Slot
i -> Bool
True Bool -> m () -> m Bool
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ CuckooFilter (PrimState m) b f a
-> Bucket -> Slot -> Fingerprint f -> m ()
forall (b :: Nat) (f :: Nat) a (m :: * -> *).
(KnownNat f, KnownNat b, PrimMonad m) =>
CuckooFilter (PrimState m) b f a
-> Bucket -> Slot -> Fingerprint f -> m ()
setFingerprint CuckooFilter (PrimState m) b f a
f Bucket
b1 Slot
i Fingerprint f
forall (f :: Nat). Fingerprint f
null
        Maybe Slot
Nothing -> CuckooFilter (PrimState m) b f a
-> Bucket -> Fingerprint f -> m (Maybe Slot)
forall (b :: Nat) (f :: Nat) a (m :: * -> *).
(PrimMonad m, KnownNat f, KnownNat b) =>
CuckooFilter (PrimState m) b f a
-> Bucket -> Fingerprint f -> m (Maybe Slot)
checkBucket CuckooFilter (PrimState m) b f a
f Bucket
b2 Fingerprint f
fp m (Maybe Slot) -> (Maybe Slot -> m Bool) -> m Bool
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
            Just Slot
i -> Bool
True Bool -> m () -> m Bool
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ CuckooFilter (PrimState m) b f a
-> Bucket -> Slot -> Fingerprint f -> m ()
forall (b :: Nat) (f :: Nat) a (m :: * -> *).
(KnownNat f, KnownNat b, PrimMonad m) =>
CuckooFilter (PrimState m) b f a
-> Bucket -> Slot -> Fingerprint f -> m ()
setFingerprint CuckooFilter (PrimState m) b f a
f Bucket
b2 Slot
i Fingerprint f
forall (f :: Nat). Fingerprint f
null
            Maybe Slot
Nothing -> Bool -> m Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
False

-- -------------------------------------------------------------------------- --
-- Internal
-- -------------------------------------------------------------------------- --

newtype Fingerprint (f :: Nat) = Fingerprint Word64
    deriving (Int -> Fingerprint f -> ShowS
[Fingerprint f] -> ShowS
Fingerprint f -> String
(Int -> Fingerprint f -> ShowS)
-> (Fingerprint f -> String)
-> ([Fingerprint f] -> ShowS)
-> Show (Fingerprint f)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall (f :: Nat). Int -> Fingerprint f -> ShowS
forall (f :: Nat). [Fingerprint f] -> ShowS
forall (f :: Nat). Fingerprint f -> String
showList :: [Fingerprint f] -> ShowS
$cshowList :: forall (f :: Nat). [Fingerprint f] -> ShowS
show :: Fingerprint f -> String
$cshow :: forall (f :: Nat). Fingerprint f -> String
showsPrec :: Int -> Fingerprint f -> ShowS
$cshowsPrec :: forall (f :: Nat). Int -> Fingerprint f -> ShowS
Show, Fingerprint f -> Fingerprint f -> Bool
(Fingerprint f -> Fingerprint f -> Bool)
-> (Fingerprint f -> Fingerprint f -> Bool) -> Eq (Fingerprint f)
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
forall (f :: Nat). Fingerprint f -> Fingerprint f -> Bool
/= :: Fingerprint f -> Fingerprint f -> Bool
$c/= :: forall (f :: Nat). Fingerprint f -> Fingerprint f -> Bool
== :: Fingerprint f -> Fingerprint f -> Bool
$c== :: forall (f :: Nat). Fingerprint f -> Fingerprint f -> Bool
Eq, Eq (Fingerprint f)
Eq (Fingerprint f)
-> (Fingerprint f -> Fingerprint f -> Ordering)
-> (Fingerprint f -> Fingerprint f -> Bool)
-> (Fingerprint f -> Fingerprint f -> Bool)
-> (Fingerprint f -> Fingerprint f -> Bool)
-> (Fingerprint f -> Fingerprint f -> Bool)
-> (Fingerprint f -> Fingerprint f -> Fingerprint f)
-> (Fingerprint f -> Fingerprint f -> Fingerprint f)
-> Ord (Fingerprint f)
Fingerprint f -> Fingerprint f -> Bool
Fingerprint f -> Fingerprint f -> Ordering
Fingerprint f -> Fingerprint f -> Fingerprint f
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
forall (f :: Nat). Eq (Fingerprint f)
forall (f :: Nat). Fingerprint f -> Fingerprint f -> Bool
forall (f :: Nat). Fingerprint f -> Fingerprint f -> Ordering
forall (f :: Nat). Fingerprint f -> Fingerprint f -> Fingerprint f
min :: Fingerprint f -> Fingerprint f -> Fingerprint f
$cmin :: forall (f :: Nat). Fingerprint f -> Fingerprint f -> Fingerprint f
max :: Fingerprint f -> Fingerprint f -> Fingerprint f
$cmax :: forall (f :: Nat). Fingerprint f -> Fingerprint f -> Fingerprint f
>= :: Fingerprint f -> Fingerprint f -> Bool
$c>= :: forall (f :: Nat). Fingerprint f -> Fingerprint f -> Bool
> :: Fingerprint f -> Fingerprint f -> Bool
$c> :: forall (f :: Nat). Fingerprint f -> Fingerprint f -> Bool
<= :: Fingerprint f -> Fingerprint f -> Bool
$c<= :: forall (f :: Nat). Fingerprint f -> Fingerprint f -> Bool
< :: Fingerprint f -> Fingerprint f -> Bool
$c< :: forall (f :: Nat). Fingerprint f -> Fingerprint f -> Bool
compare :: Fingerprint f -> Fingerprint f -> Ordering
$ccompare :: forall (f :: Nat). Fingerprint f -> Fingerprint f -> Ordering
$cp1Ord :: forall (f :: Nat). Eq (Fingerprint f)
Ord)

newtype Bucket = Bucket Int
    deriving (Int -> Bucket -> ShowS
[Bucket] -> ShowS
Bucket -> String
(Int -> Bucket -> ShowS)
-> (Bucket -> String) -> ([Bucket] -> ShowS) -> Show Bucket
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Bucket] -> ShowS
$cshowList :: [Bucket] -> ShowS
show :: Bucket -> String
$cshow :: Bucket -> String
showsPrec :: Int -> Bucket -> ShowS
$cshowsPrec :: Int -> Bucket -> ShowS
Show, Bucket -> Bucket -> Bool
(Bucket -> Bucket -> Bool)
-> (Bucket -> Bucket -> Bool) -> Eq Bucket
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Bucket -> Bucket -> Bool
$c/= :: Bucket -> Bucket -> Bool
== :: Bucket -> Bucket -> Bool
$c== :: Bucket -> Bucket -> Bool
Eq, Eq Bucket
Eq Bucket
-> (Bucket -> Bucket -> Ordering)
-> (Bucket -> Bucket -> Bool)
-> (Bucket -> Bucket -> Bool)
-> (Bucket -> Bucket -> Bool)
-> (Bucket -> Bucket -> Bool)
-> (Bucket -> Bucket -> Bucket)
-> (Bucket -> Bucket -> Bucket)
-> Ord Bucket
Bucket -> Bucket -> Bool
Bucket -> Bucket -> Ordering
Bucket -> Bucket -> Bucket
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 :: Bucket -> Bucket -> Bucket
$cmin :: Bucket -> Bucket -> Bucket
max :: Bucket -> Bucket -> Bucket
$cmax :: Bucket -> Bucket -> Bucket
>= :: Bucket -> Bucket -> Bool
$c>= :: Bucket -> Bucket -> Bool
> :: Bucket -> Bucket -> Bool
$c> :: Bucket -> Bucket -> Bool
<= :: Bucket -> Bucket -> Bool
$c<= :: Bucket -> Bucket -> Bool
< :: Bucket -> Bucket -> Bool
$c< :: Bucket -> Bucket -> Bool
compare :: Bucket -> Bucket -> Ordering
$ccompare :: Bucket -> Bucket -> Ordering
$cp1Ord :: Eq Bucket
Ord, Int -> Bucket
Bucket -> Int
Bucket -> [Bucket]
Bucket -> Bucket
Bucket -> Bucket -> [Bucket]
Bucket -> Bucket -> Bucket -> [Bucket]
(Bucket -> Bucket)
-> (Bucket -> Bucket)
-> (Int -> Bucket)
-> (Bucket -> Int)
-> (Bucket -> [Bucket])
-> (Bucket -> Bucket -> [Bucket])
-> (Bucket -> Bucket -> [Bucket])
-> (Bucket -> Bucket -> Bucket -> [Bucket])
-> Enum Bucket
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
enumFromThenTo :: Bucket -> Bucket -> Bucket -> [Bucket]
$cenumFromThenTo :: Bucket -> Bucket -> Bucket -> [Bucket]
enumFromTo :: Bucket -> Bucket -> [Bucket]
$cenumFromTo :: Bucket -> Bucket -> [Bucket]
enumFromThen :: Bucket -> Bucket -> [Bucket]
$cenumFromThen :: Bucket -> Bucket -> [Bucket]
enumFrom :: Bucket -> [Bucket]
$cenumFrom :: Bucket -> [Bucket]
fromEnum :: Bucket -> Int
$cfromEnum :: Bucket -> Int
toEnum :: Int -> Bucket
$ctoEnum :: Int -> Bucket
pred :: Bucket -> Bucket
$cpred :: Bucket -> Bucket
succ :: Bucket -> Bucket
$csucc :: Bucket -> Bucket
Enum, Enum Bucket
Real Bucket
Real Bucket
-> Enum Bucket
-> (Bucket -> Bucket -> Bucket)
-> (Bucket -> Bucket -> Bucket)
-> (Bucket -> Bucket -> Bucket)
-> (Bucket -> Bucket -> Bucket)
-> (Bucket -> Bucket -> (Bucket, Bucket))
-> (Bucket -> Bucket -> (Bucket, Bucket))
-> (Bucket -> Integer)
-> Integral Bucket
Bucket -> Integer
Bucket -> Bucket -> (Bucket, Bucket)
Bucket -> Bucket -> Bucket
forall a.
Real a
-> Enum a
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> (a, a))
-> (a -> a -> (a, a))
-> (a -> Integer)
-> Integral a
toInteger :: Bucket -> Integer
$ctoInteger :: Bucket -> Integer
divMod :: Bucket -> Bucket -> (Bucket, Bucket)
$cdivMod :: Bucket -> Bucket -> (Bucket, Bucket)
quotRem :: Bucket -> Bucket -> (Bucket, Bucket)
$cquotRem :: Bucket -> Bucket -> (Bucket, Bucket)
mod :: Bucket -> Bucket -> Bucket
$cmod :: Bucket -> Bucket -> Bucket
div :: Bucket -> Bucket -> Bucket
$cdiv :: Bucket -> Bucket -> Bucket
rem :: Bucket -> Bucket -> Bucket
$crem :: Bucket -> Bucket -> Bucket
quot :: Bucket -> Bucket -> Bucket
$cquot :: Bucket -> Bucket -> Bucket
$cp2Integral :: Enum Bucket
$cp1Integral :: Real Bucket
Integral, Num Bucket
Ord Bucket
Num Bucket -> Ord Bucket -> (Bucket -> Rational) -> Real Bucket
Bucket -> Rational
forall a. Num a -> Ord a -> (a -> Rational) -> Real a
toRational :: Bucket -> Rational
$ctoRational :: Bucket -> Rational
$cp2Real :: Ord Bucket
$cp1Real :: Num Bucket
Real, Integer -> Bucket
Bucket -> Bucket
Bucket -> Bucket -> Bucket
(Bucket -> Bucket -> Bucket)
-> (Bucket -> Bucket -> Bucket)
-> (Bucket -> Bucket -> Bucket)
-> (Bucket -> Bucket)
-> (Bucket -> Bucket)
-> (Bucket -> Bucket)
-> (Integer -> Bucket)
-> Num Bucket
forall a.
(a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a)
-> (a -> a)
-> (a -> a)
-> (Integer -> a)
-> Num a
fromInteger :: Integer -> Bucket
$cfromInteger :: Integer -> Bucket
signum :: Bucket -> Bucket
$csignum :: Bucket -> Bucket
abs :: Bucket -> Bucket
$cabs :: Bucket -> Bucket
negate :: Bucket -> Bucket
$cnegate :: Bucket -> Bucket
* :: Bucket -> Bucket -> Bucket
$c* :: Bucket -> Bucket -> Bucket
- :: Bucket -> Bucket -> Bucket
$c- :: Bucket -> Bucket -> Bucket
+ :: Bucket -> Bucket -> Bucket
$c+ :: Bucket -> Bucket -> Bucket
Num)

newtype Slot = Slot Int
    deriving (Int -> Slot -> ShowS
[Slot] -> ShowS
Slot -> String
(Int -> Slot -> ShowS)
-> (Slot -> String) -> ([Slot] -> ShowS) -> Show Slot
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Slot] -> ShowS
$cshowList :: [Slot] -> ShowS
show :: Slot -> String
$cshow :: Slot -> String
showsPrec :: Int -> Slot -> ShowS
$cshowsPrec :: Int -> Slot -> ShowS
Show, Slot -> Slot -> Bool
(Slot -> Slot -> Bool) -> (Slot -> Slot -> Bool) -> Eq Slot
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Slot -> Slot -> Bool
$c/= :: Slot -> Slot -> Bool
== :: Slot -> Slot -> Bool
$c== :: Slot -> Slot -> Bool
Eq, Eq Slot
Eq Slot
-> (Slot -> Slot -> Ordering)
-> (Slot -> Slot -> Bool)
-> (Slot -> Slot -> Bool)
-> (Slot -> Slot -> Bool)
-> (Slot -> Slot -> Bool)
-> (Slot -> Slot -> Slot)
-> (Slot -> Slot -> Slot)
-> Ord Slot
Slot -> Slot -> Bool
Slot -> Slot -> Ordering
Slot -> Slot -> Slot
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 :: Slot -> Slot -> Slot
$cmin :: Slot -> Slot -> Slot
max :: Slot -> Slot -> Slot
$cmax :: Slot -> Slot -> Slot
>= :: Slot -> Slot -> Bool
$c>= :: Slot -> Slot -> Bool
> :: Slot -> Slot -> Bool
$c> :: Slot -> Slot -> Bool
<= :: Slot -> Slot -> Bool
$c<= :: Slot -> Slot -> Bool
< :: Slot -> Slot -> Bool
$c< :: Slot -> Slot -> Bool
compare :: Slot -> Slot -> Ordering
$ccompare :: Slot -> Slot -> Ordering
$cp1Ord :: Eq Slot
Ord, Int -> Slot
Slot -> Int
Slot -> [Slot]
Slot -> Slot
Slot -> Slot -> [Slot]
Slot -> Slot -> Slot -> [Slot]
(Slot -> Slot)
-> (Slot -> Slot)
-> (Int -> Slot)
-> (Slot -> Int)
-> (Slot -> [Slot])
-> (Slot -> Slot -> [Slot])
-> (Slot -> Slot -> [Slot])
-> (Slot -> Slot -> Slot -> [Slot])
-> Enum Slot
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
enumFromThenTo :: Slot -> Slot -> Slot -> [Slot]
$cenumFromThenTo :: Slot -> Slot -> Slot -> [Slot]
enumFromTo :: Slot -> Slot -> [Slot]
$cenumFromTo :: Slot -> Slot -> [Slot]
enumFromThen :: Slot -> Slot -> [Slot]
$cenumFromThen :: Slot -> Slot -> [Slot]
enumFrom :: Slot -> [Slot]
$cenumFrom :: Slot -> [Slot]
fromEnum :: Slot -> Int
$cfromEnum :: Slot -> Int
toEnum :: Int -> Slot
$ctoEnum :: Int -> Slot
pred :: Slot -> Slot
$cpred :: Slot -> Slot
succ :: Slot -> Slot
$csucc :: Slot -> Slot
Enum, Enum Slot
Real Slot
Real Slot
-> Enum Slot
-> (Slot -> Slot -> Slot)
-> (Slot -> Slot -> Slot)
-> (Slot -> Slot -> Slot)
-> (Slot -> Slot -> Slot)
-> (Slot -> Slot -> (Slot, Slot))
-> (Slot -> Slot -> (Slot, Slot))
-> (Slot -> Integer)
-> Integral Slot
Slot -> Integer
Slot -> Slot -> (Slot, Slot)
Slot -> Slot -> Slot
forall a.
Real a
-> Enum a
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> (a, a))
-> (a -> a -> (a, a))
-> (a -> Integer)
-> Integral a
toInteger :: Slot -> Integer
$ctoInteger :: Slot -> Integer
divMod :: Slot -> Slot -> (Slot, Slot)
$cdivMod :: Slot -> Slot -> (Slot, Slot)
quotRem :: Slot -> Slot -> (Slot, Slot)
$cquotRem :: Slot -> Slot -> (Slot, Slot)
mod :: Slot -> Slot -> Slot
$cmod :: Slot -> Slot -> Slot
div :: Slot -> Slot -> Slot
$cdiv :: Slot -> Slot -> Slot
rem :: Slot -> Slot -> Slot
$crem :: Slot -> Slot -> Slot
quot :: Slot -> Slot -> Slot
$cquot :: Slot -> Slot -> Slot
$cp2Integral :: Enum Slot
$cp1Integral :: Real Slot
Integral, Num Slot
Ord Slot
Num Slot -> Ord Slot -> (Slot -> Rational) -> Real Slot
Slot -> Rational
forall a. Num a -> Ord a -> (a -> Rational) -> Real a
toRational :: Slot -> Rational
$ctoRational :: Slot -> Rational
$cp2Real :: Ord Slot
$cp1Real :: Num Slot
Real, Integer -> Slot
Slot -> Slot
Slot -> Slot -> Slot
(Slot -> Slot -> Slot)
-> (Slot -> Slot -> Slot)
-> (Slot -> Slot -> Slot)
-> (Slot -> Slot)
-> (Slot -> Slot)
-> (Slot -> Slot)
-> (Integer -> Slot)
-> Num Slot
forall a.
(a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a)
-> (a -> a)
-> (a -> a)
-> (Integer -> a)
-> Num a
fromInteger :: Integer -> Slot
$cfromInteger :: Integer -> Slot
signum :: Slot -> Slot
$csignum :: Slot -> Slot
abs :: Slot -> Slot
$cabs :: Slot -> Slot
negate :: Slot -> Slot
$cnegate :: Slot -> Slot
* :: Slot -> Slot -> Slot
$c* :: Slot -> Slot -> Slot
- :: Slot -> Slot -> Slot
$c- :: Slot -> Slot -> Slot
+ :: Slot -> Slot -> Slot
$c+ :: Slot -> Slot -> Slot
Num)

-- TODO: Should we expose this function, too, in 'CuckooFilterHash'? By hiding
-- it here there is some chance that a user accidentally picks a function that
-- isn't independent from this one.
--
hashFingerprint :: Salt -> Fingerprint f -> Int
hashFingerprint :: Salt -> Fingerprint f -> Int
hashFingerprint (Salt Int
s) (Fingerprint Word64
a) = Word64 -> Int
forall a b. (Integral a, Num b) => a -> b
int (Word64 -> Int) -> Word64 -> Int
forall a b. (a -> b) -> a -> b
$! Int -> Word64 -> Word64
forall a. Storable a => Int -> a -> Word64
sipHashInternal Int
s Word64
a
{-# INLINE hashFingerprint #-}

mkFingerprint
    :: forall f a
    . KnownNat f
    => CuckooFilterHash a
    => Salt
    -> a
    -> Fingerprint f
mkFingerprint :: Salt -> a -> Fingerprint f
mkFingerprint Salt
salt a
a = Word64 -> Fingerprint f
forall (f :: Nat). Word64 -> Fingerprint f
Fingerprint (Word64 -> Fingerprint f) -> Word64 -> Fingerprint f
forall a b. (a -> b) -> a -> b
$! Word64 -> Word64 -> Word64
forall a. Ord a => a -> a -> a
max Word64
1 (Word64 -> Word64) -> Word64 -> Word64
forall a b. (a -> b) -> a -> b
$!
    Salt -> a -> Word64
forall a. CuckooFilterHash a => Salt -> a -> Word64
cuckooFingerprint Salt
salt a
a Word64 -> Word64 -> Word64
forall a. Bits a => a -> a -> a
.&. (Word64
2 Word64 -> Int -> Word64
forall a b. (Num a, Integral b) => a -> b -> a
^ KnownNat f => Int
forall (n :: Nat). KnownNat n => Int
w @f Word64 -> Word64 -> Word64
forall a. Num a => a -> a -> a
- Word64
1)
{-# INLINE mkFingerprint #-}

bucket1 :: CuckooFilterHash a => CuckooFilter s b f a -> a -> Bucket
bucket1 :: CuckooFilter s b f a -> a -> Bucket
bucket1 CuckooFilter s b f a
f a
a = Int -> Bucket
Bucket (Int -> Bucket) -> Int -> Bucket
forall a b. (a -> b) -> a -> b
$! Word64 -> Int
forall a b. (Integral a, Num b) => a -> b
int (Word64 -> Int) -> Word64 -> Int
forall a b. (a -> b) -> a -> b
$! Salt -> a -> Word64
forall a. CuckooFilterHash a => Salt -> a -> Word64
cuckooHash (CuckooFilter s b f a -> Salt
forall s (b :: Nat) (f :: Nat) a. CuckooFilter s b f a -> Salt
_cfSalt CuckooFilter s b f a
f) a
a Word64 -> Word64 -> Word64
forall a. Bits a => a -> a -> a
.&. Int -> Word64
forall a b. (Integral a, Num b) => a -> b
int (CuckooFilter s b f a -> Int
forall s (b :: Nat) (f :: Nat) a. CuckooFilter s b f a -> Int
_cfBucketCount CuckooFilter s b f a
f Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1)
{-# INLINE bucket1 #-}

otherBucket :: CuckooFilter s b f a -> Bucket -> Fingerprint f -> Bucket
otherBucket :: CuckooFilter s b f a -> Bucket -> Fingerprint f -> Bucket
otherBucket CuckooFilter s b f a
f (Bucket Int
b) Fingerprint f
fp = Int -> Bucket
Bucket (Int -> Bucket) -> Int -> Bucket
forall a b. (a -> b) -> a -> b
$!
    (Int
b Int -> Int -> Int
forall a. Bits a => a -> a -> a
`xor` Salt -> Fingerprint f -> Int
forall (f :: Nat). Salt -> Fingerprint f -> Int
hashFingerprint (CuckooFilter s b f a -> Salt
forall s (b :: Nat) (f :: Nat) a. CuckooFilter s b f a -> Salt
_cfSalt CuckooFilter s b f a
f) Fingerprint f
fp) Int -> Int -> Int
forall a. Bits a => a -> a -> a
.&. Int -> Int
forall a b. (Integral a, Num b) => a -> b
int (CuckooFilter s b f a -> Int
forall s (b :: Nat) (f :: Nat) a. CuckooFilter s b f a -> Int
_cfBucketCount CuckooFilter s b f a
f Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1)
{-# INLINE otherBucket #-}

ix :: Bucket -> Int
ix :: Bucket -> Int
ix (Bucket Int
i) = Int
i
{-# INLINE ix #-}

-- | Fingerprints must be of at most 32 bits. Yet we represent them as Word64,
-- this is compromise to work with an reasonably efficient 32bit alignment,
-- while guaranteeing that the for each fingerprint there is an alignment such
-- that the fingerprint fits into the returned value with respect to the
-- alignment.
--
readFingerprint
    :: forall b f a m
    . KnownNat f
    => KnownNat b
    => PrimMonad m
    => CuckooFilter (PrimState m) b f a
        -- ^ Filter
    -> Bucket
        -- ^ bucket number
    -> Slot
        -- ^ slot number
    -> m (Fingerprint f)
readFingerprint :: CuckooFilter (PrimState m) b f a
-> Bucket -> Slot -> m (Fingerprint f)
readFingerprint CuckooFilter (PrimState m) b f a
f Bucket
n (Slot Int
i) = do
    Word64
v <- MutableByteArray (PrimState m) -> Int -> m Word64
forall (m :: * -> *).
PrimMonad m =>
MutableByteArray (PrimState m) -> Int -> m Word64
get MutableByteArray (PrimState m)
dat Int
pos
    Fingerprint f -> m (Fingerprint f)
forall (m :: * -> *) a. Monad m => a -> m a
return (Fingerprint f -> m (Fingerprint f))
-> Fingerprint f -> m (Fingerprint f)
forall a b. (a -> b) -> a -> b
$ Word64 -> Fingerprint f
forall (f :: Nat). Word64 -> Fingerprint f
Fingerprint (Word64 -> Fingerprint f) -> Word64 -> Fingerprint f
forall a b. (a -> b) -> a -> b
$! (Word64
v Word64 -> Int -> Word64
forall a. Bits a => a -> Int -> a
`shiftR` Int
off) Word64 -> Word64 -> Word64
forall a. Bits a => a -> a -> a
.&. Word64
mask
  where
    dat :: MutableByteArray (PrimState m)
dat = CuckooFilter (PrimState m) b f a -> MutableByteArray (PrimState m)
forall s (b :: Nat) (f :: Nat) a.
CuckooFilter s b f a -> MutableByteArray s
_cfData CuckooFilter (PrimState m) b f a
f
    mask :: Word64
mask = (Word64
2 Word64 -> Int -> Word64
forall a b. (Num a, Integral b) => a -> b -> a
^ (KnownNat f => Int
forall (n :: Nat). KnownNat n => Int
w @f)) Word64 -> Word64 -> Word64
forall a. Num a => a -> a -> a
- Word64
1
    (Int
pos, Int
off) = (KnownNat b => Int
forall (n :: Nat). KnownNat n => Int
w @b Int -> Int -> Int
forall a. Num a => a -> a -> a
* KnownNat f => Int
forall (n :: Nat). KnownNat n => Int
w @f Int -> Int -> Int
forall a. Num a => a -> a -> a
* Bucket -> Int
ix Bucket
n Int -> Int -> Int
forall a. Num a => a -> a -> a
+ KnownNat f => Int
forall (n :: Nat). KnownNat n => Int
w @f Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
i) Int -> Int -> (Int, Int)
forall a. Integral a => a -> a -> (a, a)
`divMod` Int
32
{-# INLINE readFingerprint #-}

setFingerprint
    :: forall b f a m
    . KnownNat f
    => KnownNat b
    => PrimMonad m
    => CuckooFilter (PrimState m) b f a
        -- ^ Filter
    -> Bucket
        -- ^ bucket number
    -> Slot
        -- ^ slot number
    -> Fingerprint f
    -> m ()
setFingerprint :: CuckooFilter (PrimState m) b f a
-> Bucket -> Slot -> Fingerprint f -> m ()
setFingerprint CuckooFilter (PrimState m) b f a
f Bucket
n (Slot Int
i) (Fingerprint Word64
fp) = do
    Word64
v <- MutableByteArray (PrimState m) -> Int -> m Word64
forall (m :: * -> *).
PrimMonad m =>
MutableByteArray (PrimState m) -> Int -> m Word64
get MutableByteArray (PrimState m)
dat Int
pos
    MutableByteArray (PrimState m) -> Int -> Word64 -> m ()
forall (m :: * -> *).
PrimMonad m =>
MutableByteArray (PrimState m) -> Int -> Word64 -> m ()
set MutableByteArray (PrimState m)
dat Int
pos (Word64 -> m ()) -> Word64 -> m ()
forall a b. (a -> b) -> a -> b
$ (Word64
fp Word64 -> Int -> Word64
forall a. Bits a => a -> Int -> a
`shiftL` Int
off) Word64 -> Word64 -> Word64
forall a. Bits a => a -> a -> a
.|. (Word64
v Word64 -> Word64 -> Word64
forall a. Bits a => a -> a -> a
.&. Word64 -> Word64
forall a. Bits a => a -> a
complement Word64
mask)
  where
    dat :: MutableByteArray (PrimState m)
dat = CuckooFilter (PrimState m) b f a -> MutableByteArray (PrimState m)
forall s (b :: Nat) (f :: Nat) a.
CuckooFilter s b f a -> MutableByteArray s
_cfData CuckooFilter (PrimState m) b f a
f
    mask :: Word64
mask = (Word64
2 Word64 -> Int -> Word64
forall a b. (Num a, Integral b) => a -> b -> a
^ (KnownNat f => Int
forall (n :: Nat). KnownNat n => Int
w @f) Word64 -> Word64 -> Word64
forall a. Num a => a -> a -> a
- Word64
1) Word64 -> Int -> Word64
forall a. Bits a => a -> Int -> a
`shiftL` Int
off
    (Int
pos, Int
off) = (KnownNat b => Int
forall (n :: Nat). KnownNat n => Int
w @b Int -> Int -> Int
forall a. Num a => a -> a -> a
* KnownNat f => Int
forall (n :: Nat). KnownNat n => Int
w @f Int -> Int -> Int
forall a. Num a => a -> a -> a
* Bucket -> Int
ix Bucket
n Int -> Int -> Int
forall a. Num a => a -> a -> a
+ KnownNat f => Int
forall (n :: Nat). KnownNat n => Int
w @f Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
i) Int -> Int -> (Int, Int)
forall a. Integral a => a -> a -> (a, a)
`divMod` Int
32
{-# INLINE setFingerprint #-}

-- -------------------------------------------------------------------------- --
-- Utils

null :: Fingerprint f
null :: Fingerprint f
null = Word64 -> Fingerprint f
forall (f :: Nat). Word64 -> Fingerprint f
Fingerprint Word64
0
{-# INLINE null #-}

getBucketsRandom
    :: CuckooFilterHash a
    => PrimMonad m
    => KnownNat f
    => KnownNat b
    => CuckooFilter (PrimState m) b f a
    -> a
    -> m (Bucket, Bucket, Fingerprint f)
getBucketsRandom :: CuckooFilter (PrimState m) b f a
-> a -> m (Bucket, Bucket, Fingerprint f)
getBucketsRandom CuckooFilter (PrimState m) b f a
f a
a = (Bucket, Bucket, Fingerprint f)
-> (Bucket, Bucket, Fingerprint f)
-> Bool
-> (Bucket, Bucket, Fingerprint f)
forall a. a -> a -> Bool -> a
bool (Bucket
b1, Bucket
b2, Fingerprint f
fp) (Bucket
b2, Bucket
b1, Fingerprint f
fp) (Bool -> (Bucket, Bucket, Fingerprint f))
-> m Bool -> m (Bucket, Bucket, Fingerprint f)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen (PrimState m) -> m Bool
forall b (m :: * -> *).
(Variate b, PrimMonad m) =>
Gen (PrimState m) -> m b
uniform Gen (PrimState m)
rng
  where
    salt :: Salt
salt = CuckooFilter (PrimState m) b f a -> Salt
forall s (b :: Nat) (f :: Nat) a. CuckooFilter s b f a -> Salt
_cfSalt CuckooFilter (PrimState m) b f a
f
    rng :: Gen (PrimState m)
rng = CuckooFilter (PrimState m) b f a -> Gen (PrimState m)
forall s (b :: Nat) (f :: Nat) a. CuckooFilter s b f a -> Gen s
_cfRng CuckooFilter (PrimState m) b f a
f
    b1 :: Bucket
b1 = CuckooFilter (PrimState m) b f a -> a -> Bucket
forall a s (b :: Nat) (f :: Nat).
CuckooFilterHash a =>
CuckooFilter s b f a -> a -> Bucket
bucket1 CuckooFilter (PrimState m) b f a
f a
a
    b2 :: Bucket
b2 = CuckooFilter (PrimState m) b f a
-> Bucket -> Fingerprint f -> Bucket
forall s (b :: Nat) (f :: Nat) a.
CuckooFilter s b f a -> Bucket -> Fingerprint f -> Bucket
otherBucket CuckooFilter (PrimState m) b f a
f Bucket
b1 Fingerprint f
fp
    fp :: Fingerprint f
fp = Salt -> a -> Fingerprint f
forall (f :: Nat) a.
(KnownNat f, CuckooFilterHash a) =>
Salt -> a -> Fingerprint f
mkFingerprint Salt
salt a
a
{-# INLINE getBucketsRandom #-}

checkBucket
    :: forall b f a m
    . PrimMonad m
    => KnownNat f
    => KnownNat b
    => CuckooFilter (PrimState m) b f a
    -> Bucket
    -> Fingerprint f
    -> m (Maybe Slot)
checkBucket :: CuckooFilter (PrimState m) b f a
-> Bucket -> Fingerprint f -> m (Maybe Slot)
checkBucket CuckooFilter (PrimState m) b f a
f Bucket
b Fingerprint f
fp = Int -> m (Maybe Slot)
go (KnownNat b => Int
forall (n :: Nat). KnownNat n => Int
w @b Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1)
  where
    go :: Int -> m (Maybe Slot)
    go :: Int -> m (Maybe Slot)
go (-1) = Maybe Slot -> m (Maybe Slot)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe Slot
forall a. Maybe a
Nothing
    go Int
i = CuckooFilter (PrimState m) b f a
-> Bucket -> Slot -> m (Fingerprint f)
forall (b :: Nat) (f :: Nat) a (m :: * -> *).
(KnownNat f, KnownNat b, PrimMonad m) =>
CuckooFilter (PrimState m) b f a
-> Bucket -> Slot -> m (Fingerprint f)
readFingerprint CuckooFilter (PrimState m) b f a
f Bucket
b (Int -> Slot
Slot Int
i) m (Fingerprint f)
-> (Fingerprint f -> m (Maybe Slot)) -> m (Maybe Slot)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \Fingerprint f
x -> if Fingerprint f
x Fingerprint f -> Fingerprint f -> Bool
forall a. Eq a => a -> a -> Bool
== Fingerprint f
fp
        then Maybe Slot -> m (Maybe Slot)
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe Slot -> m (Maybe Slot)) -> Maybe Slot -> m (Maybe Slot)
forall a b. (a -> b) -> a -> b
$ Slot -> Maybe Slot
forall a. a -> Maybe a
Just (Int -> Slot
Slot Int
i)
        else Int -> m (Maybe Slot)
go (Int -> Int
forall a. Enum a => a -> a
pred Int
i)
    -- TODO: can we teach GHC to unroll this loop statically without
    -- defining a class. Maybe GHC does already unroll it?

-- | Total number of items that the filter can hold. In practice a load factor
-- of ~95% of this number can be reached.
--
capacityInItems :: forall b f a s . KnownNat b => CuckooFilter s b f a -> Int
capacityInItems :: CuckooFilter s b f a -> Int
capacityInItems CuckooFilter s b f a
f = CuckooFilter s b f a -> Int
forall s (b :: Nat) (f :: Nat) a. CuckooFilter s b f a -> Int
_cfBucketCount CuckooFilter s b f a
f Int -> Int -> Int
forall a. Num a => a -> a -> a
* KnownNat b => Int
forall (n :: Nat). KnownNat n => Int
w @b
{-# INLINE capacityInItems #-}

-- | The total number of bytes allocated for storing items in the filter.
--
sizeInAllocatedBytes :: forall b f a s . KnownNat f => KnownNat b => CuckooFilter s b f a -> Int
sizeInAllocatedBytes :: CuckooFilter s b f a -> Int
sizeInAllocatedBytes CuckooFilter s b f a
f = Int -> Int -> Int
forall a b. (Integral a, Integral b) => a -> b -> a
intFit @_ @Int (CuckooFilter s b f a -> Int
forall (b :: Nat) (f :: Nat) a s.
KnownNat b =>
CuckooFilter s b f a -> Int
capacityInItems CuckooFilter s b f a
f Int -> Int -> Int
forall a. Num a => a -> a -> a
* KnownNat f => Int
forall (n :: Nat). KnownNat n => Int
w @f) Int
8 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
4
{-# INLINE sizeInAllocatedBytes #-}

-- | Number of items currently stored in the filter.
--
-- /Note/ that computing this number is expensive \(\mathcal{O}(n)\).
--
itemCount
    :: forall b f a m
    . PrimMonad m
    => KnownNat b
    => KnownNat f
    => CuckooFilter (PrimState m) b f a
    -> m Int
itemCount :: CuckooFilter (PrimState m) b f a -> m Int
itemCount CuckooFilter (PrimState m) b f a
f = (Int -> Int -> m Int) -> Int -> [Int] -> m Int
forall (t :: * -> *) (m :: * -> *) b a.
(Foldable t, Monad m) =>
(b -> a -> m b) -> b -> t a -> m b
foldM (\Int
x Int
i -> (Int -> Int -> m Int) -> Int -> [Int] -> m Int
forall (t :: * -> *) (m :: * -> *) b a.
(Foldable t, Monad m) =>
(b -> a -> m b) -> b -> t a -> m b
foldM (\Int
x' Int
j -> Int -> Bucket -> Slot -> m Int
forall a. Enum a => a -> Bucket -> Slot -> m a
go Int
x' (Int -> Bucket
Bucket Int
i) (Int -> Slot
Slot Int
j)) Int
x [Int
0.. KnownNat b => Int
forall (n :: Nat). KnownNat n => Int
w @b Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1]) Int
0 [Int
0..CuckooFilter (PrimState m) b f a -> Int
forall s (b :: Nat) (f :: Nat) a. CuckooFilter s b f a -> Int
_cfBucketCount CuckooFilter (PrimState m) b f a
f Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1]
  where
    go :: a -> Bucket -> Slot -> m a
go a
x Bucket
b Slot
s = CuckooFilter (PrimState m) b f a
-> Bucket -> Slot -> m (Fingerprint f)
forall (b :: Nat) (f :: Nat) a (m :: * -> *).
(KnownNat f, KnownNat b, PrimMonad m) =>
CuckooFilter (PrimState m) b f a
-> Bucket -> Slot -> m (Fingerprint f)
readFingerprint CuckooFilter (PrimState m) b f a
f Bucket
b Slot
s m (Fingerprint f) -> (Fingerprint f -> m a) -> m a
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \Fingerprint f
fp -> case Fingerprint f
fp Fingerprint f -> Fingerprint f -> Bool
forall a. Eq a => a -> a -> Bool
== Word64 -> Fingerprint f
forall (f :: Nat). Word64 -> Fingerprint f
Fingerprint Word64
0 of
        Bool
True -> a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return a
x
        Bool
False -> a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (a -> a
forall a. Enum a => a -> a
succ a
x)

-- | The current load factor of the filter in percent.
--
-- @
-- loadFactor f = 100 * itemCount f / capacityInItems
-- @
--
-- /Note/ that computing this number is expensive \(\mathcal{O}(n)\).
--
loadFactor
    :: forall b f a m
    . PrimMonad m
    => KnownNat b
    => KnownNat f
    => CuckooFilter (PrimState m) b f a
    -> m Double
loadFactor :: CuckooFilter (PrimState m) b f a -> m Double
loadFactor CuckooFilter (PrimState m) b f a
f = do
    Int
i <- CuckooFilter (PrimState m) b f a -> m Int
forall (b :: Nat) (f :: Nat) a (m :: * -> *).
(PrimMonad m, KnownNat b, KnownNat f) =>
CuckooFilter (PrimState m) b f a -> m Int
itemCount CuckooFilter (PrimState m) b f a
f
    Double -> m Double
forall (m :: * -> *) a. Monad m => a -> m a
return (Double -> m Double) -> Double -> m Double
forall a b. (a -> b) -> a -> b
$! Double
100 Double -> Double -> Double
forall a. Num a => a -> a -> a
* Int -> Double
forall a b. (Integral a, Num b) => a -> b
int Int
i Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ Int -> Double
forall a b. (Integral a, Num b) => a -> b
int (CuckooFilter (PrimState m) b f a -> Int
forall (b :: Nat) (f :: Nat) a s.
KnownNat b =>
CuckooFilter s b f a -> Int
capacityInItems CuckooFilter (PrimState m) b f a
f)

-- -------------------------------------------------------------------------- --
-- Debugging Tools

-- | Show the contents of the filter as a list of buckets with values show in
-- hex. Used for debugging purposes.
--
showFilter
    :: forall b f a
    . KnownNat f
    => KnownNat b
    => CuckooFilter RealWorld b f a
    -> IO [[String]]
showFilter :: CuckooFilter RealWorld b f a -> IO [[String]]
showFilter CuckooFilter RealWorld b f a
f = [Int] -> (Int -> IO [String]) -> IO [[String]]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
t a -> (a -> m b) -> m (t b)
forM [Int
0.. CuckooFilter RealWorld b f a -> Int
forall s (b :: Nat) (f :: Nat) a. CuckooFilter s b f a -> Int
_cfBucketCount CuckooFilter RealWorld b f a
f Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1] ((Int -> IO [String]) -> IO [[String]])
-> (Int -> IO [String]) -> IO [[String]]
forall a b. (a -> b) -> a -> b
$ \(Int
i :: Int) -> do
        [Int] -> (Int -> IO String) -> IO [String]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
t a -> (a -> m b) -> m (t b)
forM [Int
0 .. KnownNat b => Int
forall (n :: Nat). KnownNat n => Int
w @b Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1] ((Int -> IO String) -> IO [String])
-> (Int -> IO String) -> IO [String]
forall a b. (a -> b) -> a -> b
$ \(Int
j :: Int) -> do
            Fingerprint Word64
fp <- CuckooFilter (PrimState IO) b f a
-> Bucket -> Slot -> IO (Fingerprint f)
forall (b :: Nat) (f :: Nat) a (m :: * -> *).
(KnownNat f, KnownNat b, PrimMonad m) =>
CuckooFilter (PrimState m) b f a
-> Bucket -> Slot -> m (Fingerprint f)
readFingerprint CuckooFilter RealWorld b f a
CuckooFilter (PrimState IO) b f a
f (Int -> Bucket
Bucket Int
i) (Int -> Slot
Slot Int
j)
            String -> IO String
forall (m :: * -> *) a. Monad m => a -> m a
return (String -> IO String) -> String -> IO String
forall a b. (a -> b) -> a -> b
$ String -> Word64 -> String
forall r. PrintfType r => String -> r
printf (String
"%0" String -> ShowS
forall a. Semigroup a => a -> a -> a
<> Int -> String
forall a. Show a => a -> String
show (Int -> Int -> Int
forall a b. (Integral a, Integral b) => a -> b -> a
intFit @_ @Int (KnownNat f => Int
forall (n :: Nat). KnownNat n => Int
w @f) Int
8) String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
"x") Word64
fp

-- | Returns the different hashes that are associated with an item in the
-- filter. Used for debugging purposes.
--
itemHashes
    :: forall b f a s
    . KnownNat f
    => CuckooFilterHash a
    => CuckooFilter s b f a
    -> a
    -> (Int, Int, Word64)
itemHashes :: CuckooFilter s b f a -> a -> (Int, Int, Word64)
itemHashes CuckooFilter s b f a
f a
a = (Int
b1_, Int
b2_, Word64
fp_)
  where
    fp :: Fingerprint f
fp@(Fingerprint Word64
fp_) = Salt -> a -> Fingerprint f
forall (f :: Nat) a.
(KnownNat f, CuckooFilterHash a) =>
Salt -> a -> Fingerprint f
mkFingerprint @f (CuckooFilter s b f a -> Salt
forall s (b :: Nat) (f :: Nat) a. CuckooFilter s b f a -> Salt
_cfSalt CuckooFilter s b f a
f) a
a
    b1 :: Bucket
b1@(Bucket Int
b1_) = CuckooFilter s b f a -> a -> Bucket
forall a s (b :: Nat) (f :: Nat).
CuckooFilterHash a =>
CuckooFilter s b f a -> a -> Bucket
bucket1 CuckooFilter s b f a
f a
a
    Bucket Int
b2_ = CuckooFilter s b f a -> Bucket -> Fingerprint f -> Bucket
forall s (b :: Nat) (f :: Nat) a.
CuckooFilter s b f a -> Bucket -> Fingerprint f -> Bucket
otherBucket CuckooFilter s b f a
f Bucket
b1 Fingerprint f
fp