{-# LANGUAGE CPP           #-}
{-# LANGUAGE MagicHash     #-}
{-# LANGUAGE UnboxedTuples #-}
{-# OPTIONS_HADDOCK not-home #-}

-- | This module defines the 'Bloom' and 'MBloom' types and all the functions
-- that need direct knowledge of and access to the representation. This forms
-- the trusted base.
module Data.BloomFilter.Blocked.Internal (
    -- * Mutable Bloom filters
    MBloom,
    new,
    maxSizeBits,

    -- * Immutable Bloom filters
    Bloom,
    bloomInvariant,
    size,

    -- * Hash-based operations
    Hashes,
    hashes,
    insertHashes,
    prefetchInsert,
    elemHashes,
    prefetchElem,

    -- * Conversion
    freeze,
    unsafeFreeze,
    thaw,

    -- * (De)Serialisation
    formatVersion,
    serialise,
    deserialise,
  ) where

import           Control.DeepSeq (NFData (..))
import           Control.Exception (assert)
import           Control.Monad.Primitive (PrimMonad, PrimState)
import           Control.Monad.ST (ST)
import           Data.Bits
import           Data.Kind (Type)
import           Data.Primitive.ByteArray
import           Data.Primitive.PrimArray
import           Data.Primitive.Types (Prim (..))

import           Data.BloomFilter.Blocked.BitArray (BitArray, BitIx (..),
                     BlockIx (..), MBitArray, NumBlocks (..), bitsToBlocks,
                     blocksToBits)
import qualified Data.BloomFilter.Blocked.BitArray as BitArray
import           Data.BloomFilter.Classic.Calc
import           Data.BloomFilter.Hash

-- | The version of the format used by 'serialise' and 'deserialise'. The
-- format number will change when there is an incompatible change in the
-- library, such that deserialising and using the filter will not work.
-- This can include more than just changes to the serialised format, for
-- example changes to hash functions or how the hash is mapped to bits.
--
-- Note that the format produced does not include this version. Version
-- checking is the responsibility of the user of the library.
--
-- The library guarantes that the format version value for the classic
-- ("Data.BloomFilter.Classic") and blocked ("Data.BloomFilter.Blocked")
-- implementation will not overlap with each other or any previous value used
-- by either implementation. So switching between the two implementations will
-- always be detectable and unambigious.
--
-- History:
--
-- * Version 1000: original blocked implementation
--
formatVersion :: Int
formatVersion :: Int
formatVersion = Int
1000

-------------------------------------------------------------------------------
-- Mutable Bloom filters
--

type MBloom :: Type -> Type -> Type
-- | A mutable Bloom filter, for use within the 'ST' monad.
data MBloom s a = MBloom {
      forall s a. MBloom s a -> NumBlocks
mbNumBlocks :: {-# UNPACK #-} !NumBlocks  -- ^ non-zero
    , forall s a. MBloom s a -> Int
mbNumHashes :: {-# UNPACK #-} !Int
    , forall s a. MBloom s a -> MBitArray s
mbBitArray  :: {-# UNPACK #-} !(MBitArray s)
    }
type role MBloom nominal nominal

instance Show (MBloom s a) where
    show :: MBloom s a -> String
show MBloom s a
mb = String
"MBloom { " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show Int
numBits String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" bits } "
      where
        numBits :: Int
numBits = NumBlocks -> Int
blocksToBits (MBloom s a -> NumBlocks
forall s a. MBloom s a -> NumBlocks
mbNumBlocks MBloom s a
mb)

instance NFData (MBloom s a) where
    rnf :: MBloom s a -> ()
rnf !MBloom s a
_ = ()

-- | Create a new mutable Bloom filter.
--
-- The filter size is capped at 'maxSizeBits'.
--
new :: BloomSize -> ST s (MBloom s a)
new :: forall s a. BloomSize -> ST s (MBloom s a)
new BloomSize { Int
sizeBits :: Int
sizeBits :: BloomSize -> Int
sizeBits, Int
sizeHashes :: Int
sizeHashes :: BloomSize -> Int
sizeHashes } = do
    let numBlocks :: NumBlocks
numBlocks = Int -> NumBlocks
bitsToBlocks (Int -> Int -> Int
forall a. Ord a => a -> a -> a
max Int
1 (Int -> Int -> Int
forall a. Ord a => a -> a -> a
min Int
maxSizeBits Int
sizeBits))
    MBitArray s
mbBitArray <- NumBlocks -> ST s (MBitArray s)
forall s. NumBlocks -> ST s (MBitArray s)
BitArray.new NumBlocks
numBlocks
    MBloom s a -> ST s (MBloom s a)
forall a. a -> ST s a
forall (f :: * -> *) a. Applicative f => a -> f a
pure MBloom {
      mbNumBlocks :: NumBlocks
mbNumBlocks = NumBlocks
numBlocks,
      mbNumHashes :: Int
mbNumHashes = Int -> Int -> Int
forall a. Ord a => a -> a -> a
max Int
1 Int
sizeHashes,
      MBitArray s
mbBitArray :: MBitArray s
mbBitArray :: MBitArray s
mbBitArray
    }

-- The maximum size is $2^41$ bits (256 Gbytes). Tell us if you need bigger
-- bloom filters.
--
-- The reason for the current limit of $2^41$ bits is that this corresponds to
-- 2^32 blocks, each of size 64 bytes (512 bits). The reason for the current
-- limit of 2^32 blocks is that for efficiency we use a single 64bit hash per
-- element, and split that into a pair of 32bit hashes which are used for
-- probing the filter. To go bigger would need a pair of hashes.
--
maxSizeBits :: Int
maxSizeBits :: Int
maxSizeBits = Int
0x200_0000_0000

{-# NOINLINE insertHashes #-}
insertHashes :: forall s a. MBloom s a -> Hashes a -> ST s ()
insertHashes :: forall s a. MBloom s a -> Hashes a -> ST s ()
insertHashes MBloom { NumBlocks
mbNumBlocks :: forall s a. MBloom s a -> NumBlocks
mbNumBlocks :: NumBlocks
mbNumBlocks, Int
mbNumHashes :: forall s a. MBloom s a -> Int
mbNumHashes :: Int
mbNumHashes, MBitArray s
mbBitArray :: forall s a. MBloom s a -> MBitArray s
mbBitArray :: MBitArray s
mbBitArray } !Hashes a
h =
    BitIxGen -> Int -> ST s ()
go BitIxGen
g0 Int
mbNumHashes
  where
    blockIx :: BlockIx
    (!BlockIx
blockIx, !BitIxGen
g0) = Hashes a -> NumBlocks -> (BlockIx, BitIxGen)
forall {k} (a :: k). Hashes a -> NumBlocks -> (BlockIx, BitIxGen)
blockIxAndBitGen Hashes a
h NumBlocks
mbNumBlocks

    go :: BitIxGen -> Int -> ST s ()
    go :: BitIxGen -> Int -> ST s ()
go !BitIxGen
_ Int
0  = () -> ST s ()
forall a. a -> ST s a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
    go !BitIxGen
g !Int
i = do
      let blockBitIx :: BitIx
          (!BitIx
blockBitIx, !BitIxGen
g') = BitIxGen -> (BitIx, BitIxGen)
genBitIndex BitIxGen
g
      Bool -> ST s () -> ST s ()
forall a. (?callStack::CallStack) => Bool -> a -> a
assert (let BlockIx    Word
b = BlockIx
blockIx
                  NumBlocks Int
nb = NumBlocks
mbNumBlocks
               in Word
b Word -> Word -> Bool
forall a. Ord a => a -> a -> Bool
>= Word
0 Bool -> Bool -> Bool
&& Word
b Word -> Word -> Bool
forall a. Ord a => a -> a -> Bool
< Int -> Word
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
nb) (ST s () -> ST s ()) -> ST s () -> ST s ()
forall a b. (a -> b) -> a -> b
$
        MBitArray s -> BlockIx -> BitIx -> ST s ()
forall s. MBitArray s -> BlockIx -> BitIx -> ST s ()
BitArray.unsafeSet MBitArray s
mbBitArray BlockIx
blockIx BitIx
blockBitIx
      BitIxGen -> Int -> ST s ()
go BitIxGen
g' (Int
iInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1)

prefetchInsert :: MBloom s a -> Hashes a -> ST s ()
prefetchInsert :: forall s a. MBloom s a -> Hashes a -> ST s ()
prefetchInsert MBloom { NumBlocks
mbNumBlocks :: forall s a. MBloom s a -> NumBlocks
mbNumBlocks :: NumBlocks
mbNumBlocks, MBitArray s
mbBitArray :: forall s a. MBloom s a -> MBitArray s
mbBitArray :: MBitArray s
mbBitArray } !Hashes a
h =
    MBitArray s -> BlockIx -> ST s ()
forall s. MBitArray s -> BlockIx -> ST s ()
BitArray.prefetchSet MBitArray s
mbBitArray BlockIx
blockIx
  where
    blockIx :: BlockIx
    (!BlockIx
blockIx, BitIxGen
_) = Hashes a -> NumBlocks -> (BlockIx, BitIxGen)
forall {k} (a :: k). Hashes a -> NumBlocks -> (BlockIx, BitIxGen)
blockIxAndBitGen Hashes a
h NumBlocks
mbNumBlocks

{-# INLINE deserialise #-}
-- | Overwrite the filter's bit array. Use 'new' to create a filter of the
-- expected size and then use this function to fill in the bit data.
--
-- The callback is expected to write (exactly) the given number of bytes into
-- the given byte array buffer.
--
-- See also 'formatVersion' for compatibility advice.
--
deserialise :: PrimMonad m
            => MBloom (PrimState m) a
            -> (MutableByteArray (PrimState m) -> Int -> Int -> m ())
            -> m ()
deserialise :: forall (m :: * -> *) a.
PrimMonad m =>
MBloom (PrimState m) a
-> (MutableByteArray (PrimState m) -> Int -> Int -> m ()) -> m ()
deserialise MBloom {MBitArray (PrimState m)
mbBitArray :: forall s a. MBloom s a -> MBitArray s
mbBitArray :: MBitArray (PrimState m)
mbBitArray} MutableByteArray (PrimState m) -> Int -> Int -> m ()
fill =
    MBitArray (PrimState m)
-> (MutableByteArray (PrimState m) -> Int -> Int -> m ()) -> m ()
forall (m :: * -> *).
PrimMonad m =>
MBitArray (PrimState m)
-> (MutableByteArray (PrimState m) -> Int -> Int -> m ()) -> m ()
BitArray.deserialise MBitArray (PrimState m)
mbBitArray MutableByteArray (PrimState m) -> Int -> Int -> m ()
fill


-------------------------------------------------------------------------------
-- Immutable Bloom filters
--

type Bloom :: Type -> Type
-- | An immutable Bloom filter.
data Bloom a = Bloom {
      forall a. Bloom a -> NumBlocks
numBlocks :: {-# UNPACK #-} !NumBlocks  -- ^ non-zero
    , forall a. Bloom a -> Int
numHashes :: {-# UNPACK #-} !Int
    , forall a. Bloom a -> BitArray
bitArray  :: {-# UNPACK #-} !BitArray
    }
  deriving stock Bloom a -> Bloom a -> Bool
(Bloom a -> Bloom a -> Bool)
-> (Bloom a -> Bloom a -> Bool) -> Eq (Bloom a)
forall a. Bloom a -> Bloom a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: forall a. Bloom a -> Bloom a -> Bool
== :: Bloom a -> Bloom a -> Bool
$c/= :: forall a. Bloom a -> Bloom a -> Bool
/= :: Bloom a -> Bloom a -> Bool
Eq
type role Bloom nominal

bloomInvariant :: Bloom a -> Bool
bloomInvariant :: forall a. Bloom a -> Bool
bloomInvariant Bloom {
                 numBlocks :: forall a. Bloom a -> NumBlocks
numBlocks = NumBlocks Int
nb,
                 Int
numHashes :: forall a. Bloom a -> Int
numHashes :: Int
numHashes,
                 bitArray :: forall a. Bloom a -> BitArray
bitArray  = BitArray.BitArray PrimArray Word64
pa
               } =
    Int
nb Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
8 Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== PrimArray Word64 -> Int
forall a. Prim a => PrimArray a -> Int
sizeofPrimArray PrimArray Word64
pa
 Bool -> Bool -> Bool
&& Int
numHashes Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
0

instance Show (Bloom a) where
    show :: Bloom a -> String
show Bloom a
mb = String
"Bloom { " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show Int
numBits String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" bits } "
      where
        numBits :: Int
numBits = NumBlocks -> Int
blocksToBits (Bloom a -> NumBlocks
forall a. Bloom a -> NumBlocks
numBlocks Bloom a
mb)

instance NFData (Bloom a) where
    rnf :: Bloom a -> ()
rnf !Bloom a
_ = ()

-- | Return the size of the Bloom filter.
size :: Bloom a -> BloomSize
size :: forall a. Bloom a -> BloomSize
size Bloom { NumBlocks
numBlocks :: forall a. Bloom a -> NumBlocks
numBlocks :: NumBlocks
numBlocks, Int
numHashes :: forall a. Bloom a -> Int
numHashes :: Int
numHashes } =
    BloomSize {
      sizeBits :: Int
sizeBits   = NumBlocks -> Int
blocksToBits NumBlocks
numBlocks,
      sizeHashes :: Int
sizeHashes = Int
numHashes
    }

-- | Query an immutable Bloom filter for membership using already constructed
-- 'Hash' value.
elemHashes :: Bloom a -> Hashes a -> Bool
elemHashes :: forall a. Bloom a -> Hashes a -> Bool
elemHashes Bloom { NumBlocks
numBlocks :: forall a. Bloom a -> NumBlocks
numBlocks :: NumBlocks
numBlocks, Int
numHashes :: forall a. Bloom a -> Int
numHashes :: Int
numHashes, BitArray
bitArray :: forall a. Bloom a -> BitArray
bitArray :: BitArray
bitArray } !Hashes a
h =
    BitIxGen -> Int -> Bool
go BitIxGen
g0 Int
numHashes
  where
    blockIx :: BlockIx
    (!BlockIx
blockIx, !BitIxGen
g0) = Hashes a -> NumBlocks -> (BlockIx, BitIxGen)
forall {k} (a :: k). Hashes a -> NumBlocks -> (BlockIx, BitIxGen)
blockIxAndBitGen Hashes a
h NumBlocks
numBlocks

    go :: BitIxGen -> Int -> Bool
    go :: BitIxGen -> Int -> Bool
go !BitIxGen
_ Int
0 = Bool
True
    go !BitIxGen
g !Int
i
      | let blockBitIx :: BitIx
            (!BitIx
blockBitIx, !BitIxGen
g') = BitIxGen -> (BitIx, BitIxGen)
genBitIndex BitIxGen
g
      , Bool -> Bool -> Bool
forall a. (?callStack::CallStack) => Bool -> a -> a
assert (let BlockIx    Word
b = BlockIx
blockIx
                    NumBlocks Int
nb = NumBlocks
numBlocks
                 in Word
b Word -> Word -> Bool
forall a. Ord a => a -> a -> Bool
>= Word
0 Bool -> Bool -> Bool
&& Word
b Word -> Word -> Bool
forall a. Ord a => a -> a -> Bool
< Int -> Word
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
nb) (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$
        BitArray -> BlockIx -> BitIx -> Bool
BitArray.unsafeIndex BitArray
bitArray BlockIx
blockIx BitIx
blockBitIx
      = BitIxGen -> Int -> Bool
go BitIxGen
g' (Int
iInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1)

      | Bool
otherwise = Bool
False

prefetchElem :: Bloom a -> Hashes a -> ST s ()
prefetchElem :: forall a s. Bloom a -> Hashes a -> ST s ()
prefetchElem Bloom { NumBlocks
numBlocks :: forall a. Bloom a -> NumBlocks
numBlocks :: NumBlocks
numBlocks, BitArray
bitArray :: forall a. Bloom a -> BitArray
bitArray :: BitArray
bitArray } !Hashes a
h =
    BitArray -> BlockIx -> ST s ()
forall s. BitArray -> BlockIx -> ST s ()
BitArray.prefetchIndex BitArray
bitArray BlockIx
blockIx
  where
    blockIx :: BlockIx
    (!BlockIx
blockIx, BitIxGen
_) = Hashes a -> NumBlocks -> (BlockIx, BitIxGen)
forall {k} (a :: k). Hashes a -> NumBlocks -> (BlockIx, BitIxGen)
blockIxAndBitGen Hashes a
h NumBlocks
numBlocks

-- | Serialise the bloom filter to a 'BloomSize' (which is needed to
-- deserialise) and a 'ByteArray' along with the offset and length containing
-- the filter's bit data.
--
-- See also 'formatVersion' for compatibility advice.
--
serialise :: Bloom a -> (BloomSize, ByteArray, Int, Int)
serialise :: forall a. Bloom a -> (BloomSize, ByteArray, Int, Int)
serialise b :: Bloom a
b@Bloom{BitArray
bitArray :: forall a. Bloom a -> BitArray
bitArray :: BitArray
bitArray} =
    (Bloom a -> BloomSize
forall a. Bloom a -> BloomSize
size Bloom a
b, ByteArray
ba, Int
off, Int
len)
  where
    (ByteArray
ba, Int
off, Int
len) = BitArray -> (ByteArray, Int, Int)
BitArray.serialise BitArray
bitArray


-------------------------------------------------------------------------------
-- Conversions between mutable and immutable Bloom filters
--

-- | Create an immutable Bloom filter from a mutable one.  The mutable
-- filter may be modified afterwards.
freeze :: MBloom s a -> ST s (Bloom a)
freeze :: forall s a. MBloom s a -> ST s (Bloom a)
freeze MBloom { NumBlocks
mbNumBlocks :: forall s a. MBloom s a -> NumBlocks
mbNumBlocks :: NumBlocks
mbNumBlocks, Int
mbNumHashes :: forall s a. MBloom s a -> Int
mbNumHashes :: Int
mbNumHashes, MBitArray s
mbBitArray :: forall s a. MBloom s a -> MBitArray s
mbBitArray :: MBitArray s
mbBitArray } = do
    BitArray
bitArray <- MBitArray s -> ST s BitArray
forall s. MBitArray s -> ST s BitArray
BitArray.freeze MBitArray s
mbBitArray
    let !bf :: Bloom a
bf = Bloom {
                numBlocks :: NumBlocks
numBlocks = NumBlocks
mbNumBlocks,
                numHashes :: Int
numHashes = Int
mbNumHashes,
                BitArray
bitArray :: BitArray
bitArray :: BitArray
bitArray
              }
    Bool -> ST s (Bloom a) -> ST s (Bloom a)
forall a. (?callStack::CallStack) => Bool -> a -> a
assert (Bloom a -> Bool
forall a. Bloom a -> Bool
bloomInvariant Bloom a
bf) (ST s (Bloom a) -> ST s (Bloom a))
-> ST s (Bloom a) -> ST s (Bloom a)
forall a b. (a -> b) -> a -> b
$ Bloom a -> ST s (Bloom a)
forall a. a -> ST s a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Bloom a
bf

-- | Create an immutable Bloom filter from a mutable one without copying. The
-- mutable filter /must not/ be modified afterwards. For a safer creation
-- interface, use 'freeze' or 'create'.
unsafeFreeze :: MBloom s a -> ST s (Bloom a)
unsafeFreeze :: forall s a. MBloom s a -> ST s (Bloom a)
unsafeFreeze MBloom { NumBlocks
mbNumBlocks :: forall s a. MBloom s a -> NumBlocks
mbNumBlocks :: NumBlocks
mbNumBlocks, Int
mbNumHashes :: forall s a. MBloom s a -> Int
mbNumHashes :: Int
mbNumHashes, MBitArray s
mbBitArray :: forall s a. MBloom s a -> MBitArray s
mbBitArray :: MBitArray s
mbBitArray } = do
    BitArray
bitArray <- MBitArray s -> ST s BitArray
forall s. MBitArray s -> ST s BitArray
BitArray.unsafeFreeze MBitArray s
mbBitArray
    let !bf :: Bloom a
bf = Bloom {
                numBlocks :: NumBlocks
numBlocks = NumBlocks
mbNumBlocks,
                numHashes :: Int
numHashes = Int
mbNumHashes,
                BitArray
bitArray :: BitArray
bitArray :: BitArray
bitArray
              }
    Bool -> ST s (Bloom a) -> ST s (Bloom a)
forall a. (?callStack::CallStack) => Bool -> a -> a
assert (Bloom a -> Bool
forall a. Bloom a -> Bool
bloomInvariant Bloom a
bf) (ST s (Bloom a) -> ST s (Bloom a))
-> ST s (Bloom a) -> ST s (Bloom a)
forall a b. (a -> b) -> a -> b
$ Bloom a -> ST s (Bloom a)
forall a. a -> ST s a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Bloom a
bf

-- | Copy an immutable Bloom filter to create a mutable one.  There is
-- no non-copying equivalent.
thaw :: Bloom a -> ST s (MBloom s a)
thaw :: forall a s. Bloom a -> ST s (MBloom s a)
thaw Bloom { NumBlocks
numBlocks :: forall a. Bloom a -> NumBlocks
numBlocks :: NumBlocks
numBlocks, Int
numHashes :: forall a. Bloom a -> Int
numHashes :: Int
numHashes, BitArray
bitArray :: forall a. Bloom a -> BitArray
bitArray :: BitArray
bitArray } = do
    MBitArray s
mbBitArray <- BitArray -> ST s (MBitArray s)
forall s. BitArray -> ST s (MBitArray s)
BitArray.thaw BitArray
bitArray
    MBloom s a -> ST s (MBloom s a)
forall a. a -> ST s a
forall (f :: * -> *) a. Applicative f => a -> f a
pure MBloom {
      mbNumBlocks :: NumBlocks
mbNumBlocks = NumBlocks
numBlocks,
      mbNumHashes :: Int
mbNumHashes = Int
numHashes,
      MBitArray s
mbBitArray :: MBitArray s
mbBitArray :: MBitArray s
mbBitArray
    }


-------------------------------------------------------------------------------
-- Low level utils
--

{-# INLINE reduceRange32 #-}
-- | Given a word sampled uniformly from the full 'Word32' range, such as a
-- hash, reduce it fairly to a value in the range @[0,n)@.
--
-- See <https://lemire.me/blog/2016/06/27/a-fast-alternative-to-the-modulo-reduction/>
--
reduceRange32 :: Word -- ^ Sample from 0..2^32-1
              -> Word -- ^ upper bound of range [0,n)
              -> Word -- ^ result within range
reduceRange32 :: Word -> Word -> Word
reduceRange32 Word
x Word
n =
    Bool -> Word -> Word
forall a. (?callStack::CallStack) => Bool -> a -> a
assert (Word
n Word -> Word -> Bool
forall a. Ord a => a -> a -> Bool
> Word
0) (Word -> Word) -> Word -> Word
forall a b. (a -> b) -> a -> b
$
    let w :: Word
        w :: Word
w = Word
x Word -> Word -> Word
forall a. Num a => a -> a -> a
* Word
n
     in Word
w Word -> Int -> Word
forall a. Bits a => a -> Int -> a
`shiftR` Int
32

-------------------------------------------------------------------------------
-- Hashes
--

-- | A small family of hashes, for probing bits in a (blocked) bloom filter.
--
newtype Hashes a = Hashes Hash
  deriving stock Int -> Hashes a -> ShowS
[Hashes a] -> ShowS
Hashes a -> String
(Int -> Hashes a -> ShowS)
-> (Hashes a -> String) -> ([Hashes a] -> ShowS) -> Show (Hashes a)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall k (a :: k). Int -> Hashes a -> ShowS
forall k (a :: k). [Hashes a] -> ShowS
forall k (a :: k). Hashes a -> String
$cshowsPrec :: forall k (a :: k). Int -> Hashes a -> ShowS
showsPrec :: Int -> Hashes a -> ShowS
$cshow :: forall k (a :: k). Hashes a -> String
show :: Hashes a -> String
$cshowList :: forall k (a :: k). [Hashes a] -> ShowS
showList :: [Hashes a] -> ShowS
Show
  deriving newtype Addr# -> Int# -> Hashes a
ByteArray# -> Int# -> Hashes a
Proxy (Hashes a) -> Int#
Hashes a -> Int#
(Proxy (Hashes a) -> Int#)
-> (Hashes a -> Int#)
-> (Proxy (Hashes a) -> Int#)
-> (Hashes a -> Int#)
-> (ByteArray# -> Int# -> Hashes a)
-> (forall s.
    MutableByteArray# s
    -> Int# -> State# s -> (# State# s, Hashes a #))
-> (forall s.
    MutableByteArray# s -> Int# -> Hashes a -> State# s -> State# s)
-> (forall s.
    MutableByteArray# s
    -> Int# -> Int# -> Hashes a -> State# s -> State# s)
-> (Addr# -> Int# -> Hashes a)
-> (forall s.
    Addr# -> Int# -> State# s -> (# State# s, Hashes a #))
-> (forall s. Addr# -> Int# -> Hashes a -> State# s -> State# s)
-> (forall s.
    Addr# -> Int# -> Int# -> Hashes a -> State# s -> State# s)
-> Prim (Hashes a)
forall s. Addr# -> Int# -> Int# -> Hashes a -> State# s -> State# s
forall s. Addr# -> Int# -> State# s -> (# State# s, Hashes a #)
forall s. Addr# -> Int# -> Hashes a -> State# s -> State# s
forall s.
MutableByteArray# s
-> Int# -> Int# -> Hashes a -> State# s -> State# s
forall s.
MutableByteArray# s -> Int# -> State# s -> (# State# s, Hashes a #)
forall s.
MutableByteArray# s -> Int# -> Hashes a -> State# s -> State# s
forall a.
(Proxy a -> Int#)
-> (a -> Int#)
-> (Proxy a -> Int#)
-> (a -> Int#)
-> (ByteArray# -> Int# -> a)
-> (forall s.
    MutableByteArray# s -> Int# -> State# s -> (# State# s, a #))
-> (forall s.
    MutableByteArray# s -> Int# -> a -> State# s -> State# s)
-> (forall s.
    MutableByteArray# s -> Int# -> Int# -> a -> State# s -> State# s)
-> (Addr# -> Int# -> a)
-> (forall s. Addr# -> Int# -> State# s -> (# State# s, a #))
-> (forall s. Addr# -> Int# -> a -> State# s -> State# s)
-> (forall s. Addr# -> Int# -> Int# -> a -> State# s -> State# s)
-> Prim a
forall k (a :: k). Addr# -> Int# -> Hashes a
forall k (a :: k). ByteArray# -> Int# -> Hashes a
forall k (a :: k). Proxy (Hashes a) -> Int#
forall k (a :: k). Hashes a -> Int#
forall k (a :: k) s.
Addr# -> Int# -> Int# -> Hashes a -> State# s -> State# s
forall k (a :: k) s.
Addr# -> Int# -> State# s -> (# State# s, Hashes a #)
forall k (a :: k) s.
Addr# -> Int# -> Hashes a -> State# s -> State# s
forall k (a :: k) s.
MutableByteArray# s
-> Int# -> Int# -> Hashes a -> State# s -> State# s
forall k (a :: k) s.
MutableByteArray# s -> Int# -> State# s -> (# State# s, Hashes a #)
forall k (a :: k) s.
MutableByteArray# s -> Int# -> Hashes a -> State# s -> State# s
$csizeOfType# :: forall k (a :: k). Proxy (Hashes a) -> Int#
sizeOfType# :: Proxy (Hashes a) -> Int#
$csizeOf# :: forall k (a :: k). Hashes a -> Int#
sizeOf# :: Hashes a -> Int#
$calignmentOfType# :: forall k (a :: k). Proxy (Hashes a) -> Int#
alignmentOfType# :: Proxy (Hashes a) -> Int#
$calignment# :: forall k (a :: k). Hashes a -> Int#
alignment# :: Hashes a -> Int#
$cindexByteArray# :: forall k (a :: k). ByteArray# -> Int# -> Hashes a
indexByteArray# :: ByteArray# -> Int# -> Hashes a
$creadByteArray# :: forall k (a :: k) s.
MutableByteArray# s -> Int# -> State# s -> (# State# s, Hashes a #)
readByteArray# :: forall s.
MutableByteArray# s -> Int# -> State# s -> (# State# s, Hashes a #)
$cwriteByteArray# :: forall k (a :: k) s.
MutableByteArray# s -> Int# -> Hashes a -> State# s -> State# s
writeByteArray# :: forall s.
MutableByteArray# s -> Int# -> Hashes a -> State# s -> State# s
$csetByteArray# :: forall k (a :: k) s.
MutableByteArray# s
-> Int# -> Int# -> Hashes a -> State# s -> State# s
setByteArray# :: forall s.
MutableByteArray# s
-> Int# -> Int# -> Hashes a -> State# s -> State# s
$cindexOffAddr# :: forall k (a :: k). Addr# -> Int# -> Hashes a
indexOffAddr# :: Addr# -> Int# -> Hashes a
$creadOffAddr# :: forall k (a :: k) s.
Addr# -> Int# -> State# s -> (# State# s, Hashes a #)
readOffAddr# :: forall s. Addr# -> Int# -> State# s -> (# State# s, Hashes a #)
$cwriteOffAddr# :: forall k (a :: k) s.
Addr# -> Int# -> Hashes a -> State# s -> State# s
writeOffAddr# :: forall s. Addr# -> Int# -> Hashes a -> State# s -> State# s
$csetOffAddr# :: forall k (a :: k) s.
Addr# -> Int# -> Int# -> Hashes a -> State# s -> State# s
setOffAddr# :: forall s. Addr# -> Int# -> Int# -> Hashes a -> State# s -> State# s
Prim
type role Hashes nominal

{-# INLINE hashes #-}
hashes :: Hashable a => a -> Hashes a
hashes :: forall a. Hashable a => a -> Hashes a
hashes = Word64 -> Hashes a
forall {k} (a :: k). Word64 -> Hashes a
Hashes (Word64 -> Hashes a) -> (a -> Word64) -> a -> Hashes a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Word64
forall a. Hashable a => a -> Word64
hash64

{-# INLINE blockIxAndBitGen #-}
-- | The scheme for turning 'Hashes' into block and bit indexes is as follows:
-- the high 32bits of the 64bit hash select the block of bits, while the low
-- 32bits are used with a simpler PRNG to produce a sequence of probe points
-- within the selected 512bit block.
--
blockIxAndBitGen :: Hashes a -> NumBlocks -> (BlockIx, BitIxGen)
blockIxAndBitGen :: forall {k} (a :: k). Hashes a -> NumBlocks -> (BlockIx, BitIxGen)
blockIxAndBitGen (Hashes Word64
w64) (NumBlocks Int
numBlocks) =
    Bool -> (BlockIx, BitIxGen) -> (BlockIx, BitIxGen)
forall a. (?callStack::CallStack) => Bool -> a -> a
assert (Int
numBlocks Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
0) ((BlockIx, BitIxGen) -> (BlockIx, BitIxGen))
-> (BlockIx, BitIxGen) -> (BlockIx, BitIxGen)
forall a b. (a -> b) -> a -> b
$
    (BlockIx
blockIx, BitIxGen
bitGen)
  where
    blockIx :: BlockIx
blockIx = Word -> BlockIx
BlockIx (Word
high32 Word -> Word -> Word
`reduceRange32` Int -> Word
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
numBlocks)
    bitGen :: BitIxGen
bitGen  = Word -> BitIxGen
BitIxGen Word
low32

    high32, low32 :: Word
    high32 :: Word
high32 = Word64 -> Word
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word64
w64 Word64 -> Int -> Word64
forall a. Bits a => a -> Int -> a
`shiftR` Int
32)
    low32 :: Word
low32  = Word64 -> Word
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word64
w64 Word -> Word -> Word
forall a. Bits a => a -> a -> a
.&. Word
0xffff_ffff

newtype BitIxGen = BitIxGen Word

{-# INLINE genBitIndex #-}
-- | Generate the next in a short sequence of pseudo-random 9-bit values. This
-- is used for selecting the probe bit within the 512 bit block.
--
-- This simple generator works by multiplying a 32bit value by the golden ratio
-- (as a fraction of a 32bit value). This is only suitable for short sequences
-- using the top few bits each time.
genBitIndex :: BitIxGen -> (BitIx, BitIxGen)
genBitIndex :: BitIxGen -> (BitIx, BitIxGen)
genBitIndex (BitIxGen Word
h) =
    (Int -> BitIx
BitIx Int
i, Word -> BitIxGen
BitIxGen Word
h')
  where
    i  :: Int
    i :: Int
i  = Word -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word
h Word -> Int -> Word
forall a. Bits a => a -> Int -> a
`shiftR` (Int
32Int -> Int -> Int
forall a. Num a => a -> a -> a
-Int
9)) -- top 9 bits

    h' :: Word
    h' :: Word
h' = (Word
h Word -> Word -> Word
forall a. Num a => a -> a -> a
* Word
0x9e37_79b9) Word -> Word -> Word
forall a. Bits a => a -> a -> a
.&. Word
0xffff_ffff -- keep least significant 32 bits