never executed always true always false

    1 {-# OPTIONS_HADDOCK not-home #-}
    2 -- | This module exports 'Bloom'' definition.
    3 module Data.BloomFilter.Internal (
    4     Bloom'(..),
    5     bloomInvariant,
    6 ) where
    7 
    8 import           Control.DeepSeq (NFData (..))
    9 import           Data.Bits
   10 import qualified Data.BloomFilter.BitVec64 as V
   11 import           Data.Kind (Type)
   12 import           Data.Primitive.ByteArray (sizeofByteArray)
   13 import qualified Data.Vector.Primitive as P
   14 import           Data.Word (Word64)
   15 
   16 type Bloom' :: (Type -> Type) -> Type -> Type
   17 data Bloom' h a = Bloom {
   18       hashesN  :: {-# UNPACK #-} !Int
   19     , size     :: {-# UNPACK #-} !Word64 -- ^ size is non-zero
   20     , bitArray :: {-# UNPACK #-} !V.BitVec64
   21     }
   22 type role Bloom' nominal nominal
   23 
   24 bloomInvariant :: Bloom' h a -> Bool
   25 bloomInvariant (Bloom _ s (V.BV64 (P.Vector off len ba))) =
   26        s > 0
   27     && s <= 2^(48 :: Int)
   28     && off >= 0
   29     && ceilDiv64 s == fromIntegral len
   30     && (off + len) * 8 <= sizeofByteArray ba
   31   where
   32     ceilDiv64 x = unsafeShiftR (x + 63) 6
   33 
   34 instance Eq (Bloom' h a) where
   35     -- We support arbitrary sized bitvectors,
   36     -- therefore an equality is a bit involved:
   37     -- we need to be careful when comparing the last bits of bitArray.
   38     Bloom k n (V.BV64 v) == Bloom k' n' (V.BV64 v') =
   39         k == k' &&
   40         n == n' &&
   41         P.take w v == P.take w v' && -- compare full words
   42         if l == 0 then True else unsafeShiftL x s == unsafeShiftL x' s -- compare last words
   43       where
   44         !w = fromIntegral (unsafeShiftR n 6) :: Int  -- n `div` 64
   45         !l = fromIntegral (n .&. 63) :: Int          -- n `mod` 64
   46         !s = 64 - l
   47 
   48         -- last words
   49         x = P.unsafeIndex v w
   50         x' = P.unsafeIndex v' w
   51 
   52 instance Show (Bloom' h a) where
   53     show mb = "Bloom { " ++ show (size mb) ++ " bits } "
   54 
   55 instance NFData (Bloom' h a) where
   56     rnf !_ = ()