packages feed

bloomfilter (empty) → 1.0

raw patch · 12 files changed

+1904/−0 lines, 12 filesdep +arraydep +basedep +bytestringsetup-changed

Dependencies added: array, base, bytestring, containers

Files

+ Data/BloomFilter.hs view
@@ -0,0 +1,337 @@+{-# LANGUAGE Rank2Types, TypeOperators #-}++-- |+-- Module: Data.BloomFilter+-- Copyright: Bryan O'Sullivan+-- License: BSD3+--+-- Maintainer: Bryan O'Sullivan <bos@serpentine.com>+-- Stability: unstable+-- Portability: portable+--+-- A fast, space efficient Bloom filter implementation.  A Bloom+-- filter is a set-like data structure that provides a probabilistic+-- membership test.+--+-- * Queries do not give false negatives.  When an element is added to+--   a filter, a subsequent membership test will definitely return+--   'True'.+--+-- * False negatives /are/ possible.  If an element has not been added+--   to a filter, a membership test /may/ nevertheless indicate that+--   the element is present.+--+-- This module provides low-level control.  For an easier to use+-- interface, see the "Data.BloomFilter.Easy" module.++module Data.BloomFilter+    (+    -- * Overview+    -- $overview++    -- ** Ease of use+    -- $ease++    -- ** Performance+    -- $performance++    -- * Types+      Hash+    , Bloom+    , MBloom++    -- * Immutable Bloom filters+    -- ** Creation+    , unfoldB+    , fromListB+    , createB++    -- ** Accessors+    , lengthB+    , elemB++    -- * Mutable Bloom filters+    -- ** Creation+    , newMB+    , unsafeFreezeMB+    , thawMB++    -- ** Accessors+    , lengthMB+    , elemMB++    -- ** Mutation+    , insertMB++    -- * The underlying representation+    -- | If you serialize the raw bit arrays below to disk, do not+    -- expect them to be portable to systems with different+    -- conventions for endianness or word size.++    -- | The raw bit array used by the immutable 'Bloom' type.+    , bitArrayB++    -- | The raw bit array used by the immutable 'MBloom' type.+    , bitArrayMB+    ) where++import Control.Monad (liftM, forM_)+import Control.Monad.ST (ST, runST)+import Data.Array.Base (unsafeAt, unsafeRead, unsafeWrite)+import Data.Array.ST (STUArray, newArray, thaw, unsafeFreeze)+import Data.Array.Unboxed (UArray)+import Data.Bits ((.&.), (.|.))+import Data.BloomFilter.Util (FastShift(..), (:*)(..), nextPowerOfTwo)+import Data.Word (Word32)+import qualified Data.ByteString as SB+import qualified Data.ByteString.Lazy as LB++-- Make sure we're not performing any expensive arithmetic operations.+import Prelude hiding ((/), (*), div, divMod, mod, rem)++{-+import Debug.Trace+traceM :: (Show a, Monad m) => a -> m ()+traceM v = show v `trace` return ()+traces :: Show a => a -> b -> b+traces s = trace (show s)+-}++-- | A hash value is 32 bits wide.  This limits the maximum size of a+-- filter to about four billion elements, or 512 megabytes of memory.+type Hash = Word32++-- | A mutable Bloom filter, for use within the 'ST' monad.+data MBloom s a = MB {+      hashMB :: {-# UNPACK #-} !(a -> [Hash])+    , shiftMB :: {-# UNPACK #-} !Int+    , maskMB :: {-# UNPACK #-} !Int+    , bitArrayMB :: {-# UNPACK #-} !(STUArray s Int Hash)+    }++-- | An immutable Bloom filter, suitable for querying from pure code.+data Bloom a = B {+      hashB :: {-# UNPACK #-} !(a -> [Hash])+    , shiftB :: {-# UNPACK #-} !Int+    , maskB :: {-# UNPACK #-} !Int+    , bitArrayB :: {-# UNPACK #-} !(UArray Int Hash)+    }++instance Show (MBloom s a) where+    show mb = "MBloom { " ++ show (lengthMB mb) ++ " bits } "++instance Show (Bloom a) where+    show ub = "Bloom { " ++ show (lengthB ub) ++ " bits } "++-- | Create a new mutable Bloom filter.  For efficiency, the number of+-- bits used may be larger than the number requested.  It is always+-- rounded up to the nearest higher power of two.+--+-- For a safer creation interface, use 'createB'.  To convert a+-- mutable filter to an immutable filter for use in pure code, use+-- 'unsafeFreezeMB'.+newMB :: (a -> [Hash])          -- ^ family of hash functions to use+      -> Int                    -- ^ number of bits in filter+      -> ST s (MBloom s a)+newMB hash numBits = MB hash shift mask `liftM` newArray (0, numElems - 1) 0+  where twoBits | numBits < 1 = 1+                | isPowerOfTwo numBits = numBits+                | otherwise = nextPowerOfTwo numBits+        numElems = max 2 (twoBits `shiftR` logBitsInHash)+        trueBits = numElems `shiftL` logBitsInHash+        shift = logPower2 trueBits+        mask = trueBits - 1+        isPowerOfTwo n = n .&. (n - 1) == 0++logBitsInHash :: Int+logBitsInHash = 5 -- logPower2 bitsInHash++-- | Create an immutable Bloom filter, using the given setup function+-- which executes in the 'ST' monad.+--+-- Example:+--+-- @+--import "Data.BloomFilter.Hash" (cheapHashes)+--+--filter = createB (cheapHashes 3) 1024 $ \mf -> do+--           insertMB mf \"foo\"+--           insertMB mf \"bar\"+-- @+--+-- Note that the result of the setup function is not used.+createB :: (a -> [Hash])        -- ^ family of hash functions to use+        -> Int                  -- ^ number of bits in filter+        -> (forall s. (MBloom s a -> ST s z))  -- ^ setup function (result is discarded)+        -> Bloom a+{-# INLINE createB #-}+createB hash numBits body = runST $ do+  mb <- newMB hash numBits+  body mb+  unsafeFreezeMB mb++-- | Given a filter's mask and a hash value, compute an offset into+-- a word array and a bit offset within that word.+hashIdx :: Int -> Word32 -> (Int :* Int)+hashIdx mask x = (y `shiftR` logBitsInHash) :* (y .&. hashMask)+  where hashMask = 31 -- bitsInHash - 1+        y = fromIntegral x .&. mask++-- | Hash the given value, returning a list of (word offset, bit+-- offset) pairs, one per hash value.+hashesM :: MBloom s a -> a -> [Int :* Int]+hashesM mb elt = hashIdx (maskMB mb) `map` hashMB mb elt++-- | Hash the given value, returning a list of (word offset, bit+-- offset) pairs, one per hash value.+hashesU :: Bloom a -> a -> [Int :* Int]+hashesU ub elt = hashIdx (maskB ub) `map` hashB ub elt++-- | Insert a value into a mutable Bloom filter.  Afterwards, a+-- membership query for the same value is guaranteed to return @True@.+insertMB :: MBloom s a -> a -> ST s ()+{-# SPECIALIZE insertMB :: MBloom s SB.ByteString -> SB.ByteString -> ST s () #-}+{-# SPECIALIZE insertMB :: MBloom s LB.ByteString -> LB.ByteString -> ST s () #-}+{-# SPECIALIZE insertMB :: MBloom s String -> String -> ST s () #-}+insertMB mb elt = do+  let mu = bitArrayMB mb+  forM_ (hashesM mb elt) $ \(word :* bit) -> do+      old <- unsafeRead mu word+      unsafeWrite mu word (old .|. (1 `shiftL` bit))++-- | Query a mutable Bloom filter for membership.  If the value is+-- present, return @True@.  If the value is not present, there is+-- /still/ some possibility that @True@ will be returned.+elemMB :: a -> MBloom s a -> ST s Bool+elemMB elt mb = loop (hashesM mb elt)+  where mu = bitArrayMB mb+        loop ((word :* bit):wbs) = do+          i <- unsafeRead mu word+          if i .&. (1 `shiftL` bit) == 0+            then return False+            else loop wbs+        loop _ = return True++-- | Query an immutable Bloom filter for membership.  If the value is+-- present, return @True@.  If the value is not present, there is+-- /still/ some possibility that @True@ will be returned.+elemB :: a -> Bloom a -> Bool+elemB elt ub = all test (hashesU ub elt)+  where test (off :* bit) = (bitArrayB ub `unsafeAt` off) .&. (1 `shiftL` bit) /= 0+          +-- | Create an immutable Bloom filter from a mutable one.  The mutable+-- filter /must not/ be modified afterwards, or a runtime crash may+-- occur.  For a safer creation interface, use 'createB'.+unsafeFreezeMB :: MBloom s a -> ST s (Bloom a)+unsafeFreezeMB mb = B (hashMB mb) (shiftMB mb) (maskMB mb) `liftM`+                    unsafeFreeze (bitArrayMB mb)++-- | Copy an immutable Bloom filter to create a mutable one.  There is+-- no non-copying equivalent.+thawMB :: Bloom a -> ST s (MBloom s a)+thawMB ub = MB (hashB ub) (shiftB ub) (maskB ub) `liftM` thaw (bitArrayB ub)++-- bitsInHash :: Int+-- bitsInHash = sizeOf (undefined :: Hash) `shiftL` 3++-- | Return the size of a mutable Bloom filter, in bits.+lengthMB :: MBloom s a -> Int+lengthMB = shiftL 1 . shiftMB++-- | Return the size of an immutable Bloom filter, in bits.+lengthB :: Bloom a -> Int+lengthB = shiftL 1 . shiftB++-- | Build an immutable Bloom filter from a seed value.  The seeding+-- function populates the filter as follows.+--+--   * If it returns 'Nothing', it is finished producing values to+--     insert into the filter.+--+--   * If it returns @'Just' (a,b)@, @a@ is added to the filter and+--     @b@ is used as a new seed.+unfoldB :: (a -> [Hash])        -- ^ family of hash functions to use+        -> Int                  -- ^ number of bits in filter+        -> (b -> Maybe (a, b))  -- ^ seeding function+        -> b                    -- ^ initial seed+        -> Bloom a+{-# INLINE unfoldB #-}+unfoldB hashes numBits f k = createB hashes numBits (loop k)+  where loop j mb = case f j of+                      Just (a, j') -> insertMB mb a >> loop j' mb+                      _ -> return ()++-- | Create an immutable Bloom filter, populating it from a list of+-- values.+--+-- Here is an example that uses the @cheapHashes@ function from the+-- "Data.BloomFilter.Hash" module to create a hash function that+-- returns three hashes.+--+-- @+--import "Data.BloomFilter.Hash" (cheapHashes)+--+--filt = fromListB (cheapHashes 3) 1024 [\"foo\", \"bar\", \"quux\"]+-- @+fromListB :: (a -> [Hash])      -- ^ family of hash functions to use+          -> Int                -- ^ number of bits in filter+          -> [a]                -- ^ values to populate with+          -> Bloom a+{-# INLINE fromListB #-}+fromListB hashes numBits list = createB hashes numBits (loop list)+  where loop (x:xs) mb = insertMB mb x >> loop xs mb+        loop _ _       = return ()++{-+-- This is a simpler definition, but GHC doesn't inline the unfold+-- sensibly.++fromListB hashes numBits = unfoldB hashes numBits convert+  where convert (x:xs) = Just (x, xs)+        convert _      = Nothing+-}++-- | Slow, crummy way of computing the integer log of an integer known+-- to be a power of two.+logPower2 :: Int -> Int+logPower2 k = go 0 k+    where go j 1 = j+          go j n = go (j+1) (n `shiftR` 1)++-- $overview+--+-- Each of the functions for creating Bloom filters accepts two parameters:+--+-- * The number of bits that should be used for the filter.  Note that+--   a filter is fixed in size; it cannot be resized after creation.+--+-- * A function that accepts a value, and should return a fixed-size+--   list of hashes of that value.  To keep the false positive rate+--   low, the hashes computes should, as far as possible, be+--   independent.+--+-- By choosing these parameters with care, it is possible to tune for+-- a particular false positive rate.  The @suggestSizing@ function in+-- the "Data.BloomFilter.Easy" module calculates useful estimates for+-- these parameters.++-- $ease+--+-- This module provides both mutable and immutable interfaces for+-- creating and querying a Bloom filter.  It is most useful as a+-- low-level way to create a Bloom filter with a custom set of+-- characteristics, perhaps in combination with the hashing functions+-- in 'Data.BloomFilter.Hash'.+--+-- For a higher-level interface that is easy to use, see the+-- 'Data.BloomFilter.Easy' module.++-- $performance+--+-- The implementation has been carefully tuned for high performance+-- and low space consumption.+--+-- For efficiency, the number of bits requested when creating a Bloom+-- filter is rounded up to the nearest power of two.  This lets the+-- implementation use bitwise operations internally, instead of much+-- more expensive multiplication, division, and modulus operations.
+ Data/BloomFilter/Easy.hs view
@@ -0,0 +1,88 @@+{-# LANGUAGE PatternSignatures #-}++-- |+-- Module: Data.BloomFilter.Easy+-- Copyright: Bryan O'Sullivan+-- License: BSD3+--+-- Maintainer: Bryan O'Sullivan <bos@serpentine.com>+-- Stability: unstable+-- Portability: portable+--+-- An easy-to-use Bloom filter interface.++module Data.BloomFilter.Easy+    (+    -- * Easy creation and querying+      Bloom+    , easyList+    , elemB+    , lengthB++    -- ** Example: a spell checker+    -- $example++    -- * Useful defaults for creation+    , suggestSizing+    ) where++import Data.BloomFilter (Bloom, elemB, fromListB, lengthB)+import Data.BloomFilter.Hash (Hashable, cheapHashes)+import Data.BloomFilter.Util (nextPowerOfTwo)+import qualified Data.ByteString as SB+import qualified Data.ByteString.Lazy as LB++-- | Create a Bloom filter with the given false positive rate and+-- members.  The hash functions used are computed by the @cheapHashes@+-- function from the 'Data.BloomFilter.Hash' module.+easyList :: (Hashable a)+         => Double              -- ^ desired false positive rate (0 < /e/ < 1)+         -> [a]                 -- ^ values to populate with+         -> Bloom a+{-# SPECIALIZE easyList :: Double -> [String] -> Bloom String #-}+{-# SPECIALIZE easyList :: Double -> [LB.ByteString] -> Bloom LB.ByteString #-}+{-# SPECIALIZE easyList :: Double -> [SB.ByteString] -> Bloom SB.ByteString #-}+{-# INLINE easyList #-}+easyList errRate xs =+    let capacity = length xs+        (numBits, numHashes) = suggestSizing capacity errRate+    in fromListB (cheapHashes numHashes) numBits xs++-- | Suggest a good combination of filter size and number of hash+-- functions for a Bloom filter, based on its expected maximum+-- capacity and a desired false positive rate.+--+-- The false positive rate is the rate at which queries against the+-- filter should return @True@ when an element is not actually+-- present.  It should be a fraction between 0 and 1, so a 1% false+-- positive rate is represented by 0.01.+suggestSizing :: Int            -- ^ expected maximum capacity+              -> Double         -- ^ desired false positive rate (0 < /e/ < 1)+              -> (Int, Int)+suggestSizing capacity errRate+    | capacity <= 0                = fatal "invalid capacity"+    | errRate <= 0 || errRate >= 1 = fatal "invalid error rate"+    | otherwise =+    let cap = fromIntegral capacity+        (bits :: Double, hashes :: Double) =+            minimum [((-k) * cap / log (1 - (errRate ** (1 / k))), k)+                     | k <- [1..100]]+    in (nextPowerOfTwo (round bits), round hashes)+  where fatal = error . ("Data.BloomFilter.Util.suggestSizing: " ++)++-- $example+--+-- This example reads a dictionary file containing one word per line,+-- constructs a Bloom filter with a 1% false positive rate, and+-- spellchecks its standard input.  Like the Unix @spell@ command, it+-- prints each word that it does not recognize.+--+-- @+--import Data.BloomFilter.Easy (easyList, elemB)+--+--main = do+--  filt <- ('easyList' 0.01 . words) \`fmap\` readFile \"/usr/share/dict/words\"+--  let check word | 'elemB' word filt = \"\"+--                 | otherwise         = word ++ \"\\n\"+--  interact (concat . map check . lines)+-- @
+ Data/BloomFilter/Hash.hs view
@@ -0,0 +1,286 @@+{-# LANGUAGE CPP, ForeignFunctionInterface, TypeOperators #-}++-- |+-- Module: Data.BloomFilter.Hash+-- Copyright: Bryan O'Sullivan+-- License: BSD3+--+-- Maintainer: Bryan O'Sullivan <bos@serpentine.com>+-- Stability: unstable+-- Portability: portable+--+-- Fast hashing of Haskell values.  The hash functions used are Bob+-- Jenkins's public domain functions, which combine high performance+-- with excellent mixing properties.  For more details, see+-- <http://burtleburtle.net/bob/hash/>.+--+-- In addition to the usual "one input, one output" hash functions,+-- this module provides multi-output hash functions, suitable for use+-- in applications that need multiple hashes, such as Bloom filtering.++module Data.BloomFilter.Hash+    (+    -- * Basic hash functionality+      Hashable(..)+    , hash+    -- * Compute a family of hash values+    , hashes+    , cheapHashes+    -- * Hash functions for 'Storable' instances+    , hashOne+    , hashTwo+    , hashList+    , hashList2+    ) where++import Control.Monad (foldM, liftM2)+import Data.Bits ((.&.), xor)+import Data.BloomFilter.Util+import Data.List (unfoldr)+import Data.Int (Int8, Int16, Int32, Int64)+import Data.Word (Word8, Word16, Word32, Word64)+import Foreign.C.Types (CInt, CSize)+import Foreign.Marshal.Array (withArrayLen)+import Foreign.Marshal.Utils (with)+import Foreign.Ptr (Ptr, castPtr)+import Foreign.Storable (Storable, peek, sizeOf)+import System.IO.Unsafe (unsafePerformIO)+import qualified Data.ByteString as SB+import qualified Data.ByteString.Lazy as LB++#include "HsBaseConfig.h"++-- Make sure we're not performing any expensive arithmetic operations.+-- import Prelude hiding ((/), (*), div, divMod, mod, rem)++foreign import ccall unsafe "_jenkins_hashword" hashWord+    :: Ptr CInt -> CSize -> CInt -> IO CInt++foreign import ccall unsafe "_jenkins_hashword2" hashWord2+    :: Ptr CInt -> CSize -> Ptr CInt -> Ptr CInt -> IO ()++foreign import ccall unsafe "_jenkins_hashlittle" hashLittle+    :: Ptr a -> CSize -> CInt -> IO CInt++foreign import ccall unsafe "_jenkins_hashlittle2" hashLittle2+    :: Ptr a -> CSize -> Ptr CInt -> Ptr CInt -> IO ()++class Hashable a where+    -- | Compute a single hash of a value.  The salt value perturbs+    -- the result.+    hashIO :: a                 -- ^ value to hash+           -> CInt              -- ^ salt value+           -> IO CInt++    -- | Compute two hashes of a value.  The first salt value perturbs+    -- the first element of the result, and the second salt perturbs+    -- the second.+    hashIO2 :: a                -- ^ value to hash+            -> CInt             -- ^ first salt value+            -> CInt             -- ^ second salt value+            -> IO (CInt, CInt)+    hashIO2 v s1 s2 = liftM2 (,) (hashIO v s1) (hashIO v s2)+      +-- | Compute a hash.+hash :: Hashable a => a -> Word32+hash = hashS 0x106fc397cf62f64d3++hashS :: Hashable a => Word32 -> a -> Word32+hashS salt k =+    let !r = fromIntegral . unsafePerformIO $ hashIO k (fromIntegral salt)+    in r++hashS2 :: Hashable a => Word32 -> Word32 -> a -> (Word32 :* Word32)+{-# INLINE hashS2 #-}+hashS2 s1 s2 k =+    unsafePerformIO $ do+      (a, b) <- hashIO2 k (fromIntegral s1) (fromIntegral s2)+      return (fromIntegral a :* fromIntegral b)++-- | Compute a list of hashes.  The value to hash may be inspected as+-- many times as there are hashes requested.+hashes :: Hashable a => Int     -- ^ number of hashes to compute+       -> a                     -- ^ value to hash+       -> [Word32]+hashes n v = unfoldr go (n,0x3f56da2d3ddbb9f631)+    where go (k,s) | k <= 0    = Nothing+                   | otherwise = let s' = hashS s v+                                 in Just (s', (k-1,s'))++-- | Compute a list of hashes relatively cheaply.+-- The value to hash is inspected at most twice, regardless of the+-- number of hashes requested.+--+-- We use a variant of Kirsch and Mitzenmacher's technique from \"Less+-- Hashing, Same Performance: Building a Better Bloom Filter\",+-- <http://www.eecs.harvard.edu/~kirsch/pubs/bbbf/esa06.pdf>.+--+-- Where Kirsch and Mitzenmacher multiply the second hash by a+-- coefficient, we shift right by the coefficient.  This offers better+-- performance (as a shift is much cheaper than a multiply), and the+-- low order bits of the final hash stay well mixed.+cheapHashes :: Hashable a => Int -- ^ number of hashes to compute+            -> a                 -- ^ value to hash+            -> [Word32]+{-# SPECIALIZE cheapHashes :: Int -> SB.ByteString -> [Word32] #-}+{-# SPECIALIZE cheapHashes :: Int -> LB.ByteString -> [Word32] #-}+{-# SPECIALIZE cheapHashes :: Int -> String -> [Word32] #-}+cheapHashes k v = [h1 + (h2 `shiftR` i) | i <- [0..j]]+    where (h1 :* h2) = hashS2 0x3f56da2d3ddbb9f631 0xdc61ab0530200d7554 v+          j = fromIntegral k - 1++instance Hashable () where+    hashIO _ salt = return salt++instance Hashable Integer where+    hashIO k salt | k < 0 = hashIO (unfoldr go (-k))+                                   (salt `xor` 0x3ece731e9c1c64f8)+                  | otherwise = hashIO (unfoldr go k) salt+        where go 0 = Nothing+              go i = Just (fromIntegral i :: Word32, i `shiftR` 32)++instance Hashable Bool where+    hashIO = hashOne+    hashIO2 = hashTwo++instance Hashable Ordering where+    hashIO = hashIO . fromEnum+    hashIO2 = hashIO2 . fromEnum++instance Hashable Char where+    hashIO = hashOne+    hashIO2 = hashTwo++instance Hashable Int where+    hashIO = hashOne+    hashIO2 = hashTwo++instance Hashable Float where+    hashIO = hashOne+    hashIO2 = hashTwo++instance Hashable Double where+    hashIO = hashOne+    hashIO2 = hashTwo++instance Hashable Int8 where+    hashIO = hashOne+    hashIO2 = hashTwo++instance Hashable Int16 where+    hashIO = hashOne+    hashIO2 = hashTwo++instance Hashable Int32 where+    hashIO = hashOne+    hashIO2 = hashTwo++instance Hashable Int64 where+    hashIO = hashOne+    hashIO2 = hashTwo++instance Hashable Word8 where+    hashIO = hashOne+    hashIO2 = hashTwo++instance Hashable Word16 where+    hashIO = hashOne+    hashIO2 = hashTwo++instance Hashable Word32 where+    hashIO = hashOne+    hashIO2 = hashTwo++instance Hashable Word64 where+    hashIO = hashOne+    hashIO2 = hashTwo++-- | A fast unchecked shift.  Nasty, but otherwise GHC 6.8.2 does a+-- test and branch on every shift.+div4 :: CSize -> CSize+div4 k = fromIntegral ((fromIntegral k :: HTYPE_SIZE_T) `shiftR` 2)++alignedHash :: Ptr a -> CSize -> CInt -> IO CInt+alignedHash ptr bytes salt+    | bytes .&. 3 == 0 = hashWord (castPtr ptr) (div4 bytes) salt+    | otherwise        = hashLittle ptr bytes salt++alignedHash2 :: Ptr a -> CSize -> CInt -> CInt -> IO (CInt, CInt)+alignedHash2 ptr bytes s1 s2 =+    with s1 $ \p1 ->+        with s2 $ \p2 ->+            go p1 p2 >> liftM2 (,) (peek p1) (peek p2)+  where go p1 p2+          | bytes .&. 3 == 0 = hashWord2 (castPtr ptr) (div4 bytes) p1 p2+          | otherwise        = hashLittle2 ptr bytes p1 p2++instance Hashable SB.ByteString where+    hashIO bs salt = SB.useAsCStringLen bs $ \(ptr, len) -> do+                     alignedHash ptr (fromIntegral len) salt++    {-# INLINE hashIO2 #-}+    hashIO2 bs s1 s2 = SB.useAsCStringLen bs $ \(ptr, len) -> do+                       alignedHash2 ptr (fromIntegral len) s1 s2++instance Hashable LB.ByteString where+    hashIO bs salt = foldM (flip hashIO) salt (LB.toChunks bs)++    {-# INLINE hashIO2 #-}+    hashIO2 bs s1 s2 = foldM go (s1, s2) (LB.toChunks bs)+        where go (a, b) s = hashIO2 s a b++instance Hashable a => Hashable (Maybe a) where+    hashIO Nothing salt = return salt+    hashIO (Just k) salt = hashIO k salt+    hashIO2 Nothing s1 s2 = return (s1, s2)+    hashIO2 (Just k) s1 s2 = hashIO2 k s1 s2++instance (Hashable a, Hashable b) => Hashable (Either a b) where+    hashIO (Left a) salt = hashIO a salt+    hashIO (Right b) salt = hashIO b (salt + 1)+    hashIO2 (Left a) s1 s2 = hashIO2 a s1 s2+    hashIO2 (Right b) s1 s2 = hashIO2 b (s1 + 1) (s2 + 1)++instance (Hashable a, Hashable b) => Hashable (a, b) where+    hashIO (a,b) salt = hashIO a salt >>= hashIO b+    hashIO2 (a,b) s1 s2 = hashIO2 a s1 s2 >>= uncurry (hashIO2 b)++instance (Hashable a, Hashable b, Hashable c) => Hashable (a, b, c) where+    hashIO (a,b,c) salt = hashIO a salt >>= hashIO b >>= hashIO c++instance (Hashable a, Hashable b, Hashable c, Hashable d) =>+    Hashable (a, b, c, d) where+    hashIO (a,b,c,d) salt =+        hashIO a salt >>= hashIO b >>= hashIO c >>= hashIO d++instance (Hashable a, Hashable b, Hashable c, Hashable d, Hashable e) =>+    Hashable (a, b, c, d, e) where+    hashIO (a,b,c,d,e) salt =+        hashIO a salt >>= hashIO b >>= hashIO c >>= hashIO d >>= hashIO e++instance Storable a => Hashable [a] where+    hashIO = hashList++    {-# INLINE hashIO2 #-}+    hashIO2 = hashList2++-- | Compute a hash of a 'Storable' instance.+hashOne :: Storable a => a -> CInt -> IO CInt+hashOne k salt = with k $ \ptr ->+                 alignedHash ptr (fromIntegral (sizeOf k)) salt++-- | Compute two hashes of a 'Storable' instance.+hashTwo :: Storable a => a -> CInt -> CInt -> IO (CInt, CInt)+hashTwo k s1 s2 = with k $ \ptr ->+                  alignedHash2 ptr (fromIntegral (sizeOf k)) s1 s2++-- | Compute a hash of a list of 'Storable' instances.+hashList :: Storable a => [a] -> CInt -> IO CInt+hashList xs salt = withArrayLen xs $ \len ptr ->+                   alignedHash ptr (fromIntegral (len * sizeOf (head xs))) salt++-- | Compute two hashes of a list of 'Storable' instances.+hashList2 :: Storable a => [a] -> CInt -> CInt -> IO (CInt, CInt)+hashList2 xs s1 s2 =+    withArrayLen xs $ \len ptr ->+    alignedHash2 ptr (fromIntegral (len * sizeOf (head xs))) s1 s2
+ Data/BloomFilter/Util.hs view
@@ -0,0 +1,67 @@+{-# LANGUAGE MagicHash #-}++module Data.BloomFilter.Util+    (+      FastShift(..)+    , nextPowerOfTwo+    , (:*)(..)+    ) where++import Data.Bits ((.|.))+import qualified Data.Bits as Bits+import GHC.Base+import GHC.Word++-- | A strict pair type.+data a :* b = !a :* !b+            deriving (Eq, Ord, Show)++-- | Compute the nearest power of two greater to or equal than the+-- given number.+nextPowerOfTwo :: Int -> Int+{-# INLINE nextPowerOfTwo #-}+nextPowerOfTwo n =+    let a = n - 1+        b = a .|. (a `shiftR` 1)+        c = b .|. (b `shiftR` 2)+        d = c .|. (c `shiftR` 4)+        e = d .|. (d `shiftR` 8)+        f = e .|. (e `shiftR` 16)+        g = f .|. (f `shiftR` 32)  -- in case we're on a 64-bit host+        !h = g + 1+    in h++-- | This is a workaround for poor optimisation in GHC 6.8.2.  It+-- fails to notice constant-width shifts, and adds a test and branch+-- to every shift.  This imposes about a 10% performance hit.+class FastShift a where+    shiftL :: a -> Int -> a+    shiftR :: a -> Int -> a++instance FastShift Word32 where+    {-# INLINE shiftL #-}+    shiftL (W32# x#) (I# i#) = W32# (x# `uncheckedShiftL#` i#)++    {-# INLINE shiftR #-}+    shiftR (W32# x#) (I# i#) = W32# (x# `uncheckedShiftRL#` i#)++instance FastShift Word64 where+    {-# INLINE shiftL #-}+    shiftL (W64# x#) (I# i#) = W64# (x# `uncheckedShiftL64#` i#)++    {-# INLINE shiftR #-}+    shiftR (W64# x#) (I# i#) = W64# (x# `uncheckedShiftRL64#` i#)++instance FastShift Int where+    {-# INLINE shiftL #-}+    shiftL (I# x#) (I# i#) = I# (x# `iShiftL#` i#)++    {-# INLINE shiftR #-}+    shiftR (I# x#) (I# i#) = I# (x# `iShiftRA#` i#)++instance FastShift Integer where+    {-# INLINE shiftL #-}+    shiftL = Bits.shiftL++    {-# INLINE shiftR #-}+    shiftR = Bits.shiftR
+ LICENSE view
@@ -0,0 +1,29 @@+Copyright 2008 Bryan O'Sullivan <bos@serpentine.com>.+All rights reserved.++Redistribution and use in source and binary forms, with or without+modification, are permitted provided that the following conditions+are met:++1. Redistributions of source code must retain the above copyright+   notice, this list of conditions and the following disclaimer.++2. Redistributions in binary form must reproduce the above copyright+   notice, this list of conditions and the following disclaimer in the+   documentation and/or other materials provided with the distribution.++3. Neither the name of the author nor the names of his contributors+   may be used to endorse or promote products derived from this software+   without specific prior written permission.++THIS SOFTWARE IS PROVIDED BY THE CONTRIBUTORS ``AS IS'' AND ANY EXPRESS+OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED+WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE+DISCLAIMED.  IN NO EVENT SHALL THE AUTHORS OR CONTRIBUTORS BE LIABLE FOR+ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL+DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS+OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION)+HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT,+STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN+ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE+POSSIBILITY OF SUCH DAMAGE.
+ README view
@@ -0,0 +1,21 @@+A fast, space efficient Bloom filter implementation+---------------------------------------------------++Copyright 2008 Bryan O'Sullivan <bos@serpentine.com>.++This package provides both mutable and immutable Bloom filter data+types, along with a family of hash function and an easy-to-use+interface.++To build:++    runhaskell Setup.lhs configure+    runhaskell Setup.lhs build+    runhaskell Setup.lhs install++For examples of usage, see the Haddock documentation and the files in+the examples directory.++To get the latest sources:++    darcs get http://darcs.serpentine.com/bloomfilter
+ Setup.lhs view
@@ -0,0 +1,3 @@+#!/usr/bin/env runhaskell+> import Distribution.Simple+> main = defaultMain
+ bloomfilter.cabal view
@@ -0,0 +1,42 @@+name:            bloomfilter+version:         1.0+license:         BSD3+license-file:    LICENSE+author:          Bryan O'Sullivan <bos@serpentine.com>+maintainer:      Bryan O'Sullivan <bos@serpentine.com>+homepage:        http://www.serpentine.com/software/bloomfilter+description:     Pure and impure Bloom Filter implementations.+synopsis:        Pure and impure Bloom Filter implementations.+category:        Data+stability:       provisional+build-type:      Simple+cabal-version:   >= 1.2+tested-with:     GHC ==6.8.2+extra-source-files: README cbits/lookup3.c+                 examples/Makefile examples/SpellChecker.hs examples/Words.hs++flag bytestring-in-base+flag split-base++library+  if flag(bytestring-in-base)+    -- bytestring was in base-2.0 and 2.1.1+    build-depends: base >= 2.0 && < 2.2+    cpp-options: -DBYTESTRING_IN_BASE+  else+    -- in base 1.0 and 3.0 bytestring is a separate package+    build-depends: base < 2.0 || >= 3, bytestring >= 0.9++  if flag(split-base)+    build-depends:   base >= 3.0, containers, array+  else+    build-depends:   base < 3.0++  exposed-modules: Data.BloomFilter+                   Data.BloomFilter.Easy+                   Data.BloomFilter.Hash+  other-modules:   Data.BloomFilter.Util+  c-sources:       cbits/lookup3.c+  ghc-options:     -O2 -Wall -fliberate-case-threshold=1000++  cc-options:      -O3
+ cbits/lookup3.c view
@@ -0,0 +1,982 @@+/*+-------------------------------------------------------------------------------+lookup3.c, by Bob Jenkins, May 2006, Public Domain.++These are functions for producing 32-bit hashes for hash table lookup.+hashword(), hashlittle(), hashlittle2(), hashbig(), mix(), and final() +are externally useful functions.  Routines to test the hash are included +if SELF_TEST is defined.  You can use this free for any purpose.  It's in+the public domain.  It has no warranty.++You probably want to use hashlittle().  hashlittle() and hashbig()+hash byte arrays.  hashlittle() is is faster than hashbig() on+little-endian machines.  Intel and AMD are little-endian machines.+On second thought, you probably want hashlittle2(), which is identical to+hashlittle() except it returns two 32-bit hashes for the price of one.  +You could implement hashbig2() if you wanted but I haven't bothered here.++If you want to find a hash of, say, exactly 7 integers, do+  a = i1;  b = i2;  c = i3;+  mix(a,b,c);+  a += i4; b += i5; c += i6;+  mix(a,b,c);+  a += i7;+  final(a,b,c);+then use c as the hash value.  If you have a variable length array of+4-byte integers to hash, use hashword().  If you have a byte array (like+a character string), use hashlittle().  If you have several byte arrays, or+a mix of things, see the comments above hashlittle().  ++Why is this so big?  I read 12 bytes at a time into 3 4-byte integers, +then mix those integers.  This is fast (you can do a lot more thorough+mixing with 12*3 instructions on 3 integers than you can with 3 instructions+on 1 byte), but shoehorning those bytes into integers efficiently is messy.+-------------------------------------------------------------------------------+*/+/* #define SELF_TEST 1 */++#define hashword _jenkins_hashword+#define hashword2 _jenkins_hashword2+#define hashlittle _jenkins_hashlittle+#define hashlittle2 _jenkins_hashlittle2+#define hashbig _jenkins_hashbig++#include <stdio.h>      /* defines printf for tests */+#include <time.h>       /* defines time_t for timings in the test */+#include <stdint.h>     /* defines uint32_t etc */+#include <sys/param.h>  /* attempt to define endianness */+#ifdef linux+# include <endian.h>    /* attempt to define endianness */+#endif++/*+ * My best guess at if you are big-endian or little-endian.  This may+ * need adjustment.+ */+#if (defined(__BYTE_ORDER) && defined(__LITTLE_ENDIAN) && \+     __BYTE_ORDER == __LITTLE_ENDIAN) || \+    (defined(i386) || defined(__i386__) || defined(__i486__) || \+     defined(__i586__) || defined(__i686__) || defined(vax) || defined(MIPSEL))+# define HASH_LITTLE_ENDIAN 1+# define HASH_BIG_ENDIAN 0+#elif (defined(__BYTE_ORDER) && defined(__BIG_ENDIAN) && \+       __BYTE_ORDER == __BIG_ENDIAN) || \+      (defined(sparc) || defined(POWERPC) || defined(mc68000) || defined(sel))+# define HASH_LITTLE_ENDIAN 0+# define HASH_BIG_ENDIAN 1+#else+# define HASH_LITTLE_ENDIAN 0+# define HASH_BIG_ENDIAN 0+#endif++#define hashsize(n) ((uint32_t)1<<(n))+#define hashmask(n) (hashsize(n)-1)+#define rot(x,k) (((x)<<(k)) | ((x)>>(32-(k))))++/*+-------------------------------------------------------------------------------+mix -- mix 3 32-bit values reversibly.++This is reversible, so any information in (a,b,c) before mix() is+still in (a,b,c) after mix().++If four pairs of (a,b,c) inputs are run through mix(), or through+mix() in reverse, there are at least 32 bits of the output that+are sometimes the same for one pair and different for another pair.+This was tested for:+* pairs that differed by one bit, by two bits, in any combination+  of top bits of (a,b,c), or in any combination of bottom bits of+  (a,b,c).+* "differ" is defined as +, -, ^, or ~^.  For + and -, I transformed+  the output delta to a Gray code (a^(a>>1)) so a string of 1's (as+  is commonly produced by subtraction) look like a single 1-bit+  difference.+* the base values were pseudorandom, all zero but one bit set, or +  all zero plus a counter that starts at zero.++Some k values for my "a-=c; a^=rot(c,k); c+=b;" arrangement that+satisfy this are+    4  6  8 16 19  4+    9 15  3 18 27 15+   14  9  3  7 17  3+Well, "9 15 3 18 27 15" didn't quite get 32 bits diffing+for "differ" defined as + with a one-bit base and a two-bit delta.  I+used http://burtleburtle.net/bob/hash/avalanche.html to choose +the operations, constants, and arrangements of the variables.++This does not achieve avalanche.  There are input bits of (a,b,c)+that fail to affect some output bits of (a,b,c), especially of a.  The+most thoroughly mixed value is c, but it doesn't really even achieve+avalanche in c.++This allows some parallelism.  Read-after-writes are good at doubling+the number of bits affected, so the goal of mixing pulls in the opposite+direction as the goal of parallelism.  I did what I could.  Rotates+seem to cost as much as shifts on every machine I could lay my hands+on, and rotates are much kinder to the top and bottom bits, so I used+rotates.+-------------------------------------------------------------------------------+*/+#define mix(a,b,c) \+{ \+  a -= c;  a ^= rot(c, 4);  c += b; \+  b -= a;  b ^= rot(a, 6);  a += c; \+  c -= b;  c ^= rot(b, 8);  b += a; \+  a -= c;  a ^= rot(c,16);  c += b; \+  b -= a;  b ^= rot(a,19);  a += c; \+  c -= b;  c ^= rot(b, 4);  b += a; \+}++/*+-------------------------------------------------------------------------------+final -- final mixing of 3 32-bit values (a,b,c) into c++Pairs of (a,b,c) values differing in only a few bits will usually+produce values of c that look totally different.  This was tested for+* pairs that differed by one bit, by two bits, in any combination+  of top bits of (a,b,c), or in any combination of bottom bits of+  (a,b,c).+* "differ" is defined as +, -, ^, or ~^.  For + and -, I transformed+  the output delta to a Gray code (a^(a>>1)) so a string of 1's (as+  is commonly produced by subtraction) look like a single 1-bit+  difference.+* the base values were pseudorandom, all zero but one bit set, or +  all zero plus a counter that starts at zero.++These constants passed:+ 14 11 25 16 4 14 24+ 12 14 25 16 4 14 24+and these came close:+  4  8 15 26 3 22 24+ 10  8 15 26 3 22 24+ 11  8 15 26 3 22 24+-------------------------------------------------------------------------------+*/+#define final(a,b,c) \+{ \+  c ^= b; c -= rot(b,14); \+  a ^= c; a -= rot(c,11); \+  b ^= a; b -= rot(a,25); \+  c ^= b; c -= rot(b,16); \+  a ^= c; a -= rot(c,4);  \+  b ^= a; b -= rot(a,14); \+  c ^= b; c -= rot(b,24); \+}++/*+--------------------------------------------------------------------+ This works on all machines.  To be useful, it requires+ -- that the key be an array of uint32_t's, and+ -- that the length be the number of uint32_t's in the key++ The function hashword() is identical to hashlittle() on little-endian+ machines, and identical to hashbig() on big-endian machines,+ except that the length has to be measured in uint32_ts rather than in+ bytes.  hashlittle() is more complicated than hashword() only because+ hashlittle() has to dance around fitting the key bytes into registers.+--------------------------------------------------------------------+*/+uint32_t hashword(+const uint32_t *k,                   /* the key, an array of uint32_t values */+size_t          length,               /* the length of the key, in uint32_ts */+uint32_t        initval)         /* the previous hash, or an arbitrary value */+{+  uint32_t a,b,c;++  /* Set up the internal state */+  a = b = c = 0xdeadbeef + (((uint32_t)length)<<2) + initval;++  /*------------------------------------------------- handle most of the key */+  while (length > 3)+  {+    a += k[0];+    b += k[1];+    c += k[2];+    mix(a,b,c);+    length -= 3;+    k += 3;+  }++  /*------------------------------------------- handle the last 3 uint32_t's */+  switch(length)                     /* all the case statements fall through */+  { +  case 3 : c+=k[2];+  case 2 : b+=k[1];+  case 1 : a+=k[0];+    final(a,b,c);+  case 0:     /* case 0: nothing left to add */+    break;+  }+  /*------------------------------------------------------ report the result */+  return c;+}+++/*+--------------------------------------------------------------------+hashword2() -- same as hashword(), but take two seeds and return two+32-bit values.  pc and pb must both be nonnull, and *pc and *pb must+both be initialized with seeds.  If you pass in (*pb)==0, the output +(*pc) will be the same as the return value from hashword().+--------------------------------------------------------------------+*/+void hashword2 (+const uint32_t *k,                   /* the key, an array of uint32_t values */+size_t          length,               /* the length of the key, in uint32_ts */+uint32_t       *pc,                      /* IN: seed OUT: primary hash value */+uint32_t       *pb)               /* IN: more seed OUT: secondary hash value */+{+  uint32_t a,b,c;++  /* Set up the internal state */+  a = b = c = 0xdeadbeef + ((uint32_t)(length<<2)) + *pc;+  c += *pb;++  /*------------------------------------------------- handle most of the key */+  while (length > 3)+  {+    a += k[0];+    b += k[1];+    c += k[2];+    mix(a,b,c);+    length -= 3;+    k += 3;+  }++  /*------------------------------------------- handle the last 3 uint32_t's */+  switch(length)                     /* all the case statements fall through */+  { +  case 3 : c+=k[2];+  case 2 : b+=k[1];+  case 1 : a+=k[0];+    final(a,b,c);+  case 0:     /* case 0: nothing left to add */+    break;+  }+  /*------------------------------------------------------ report the result */+  *pc=c; *pb=b;+}+++/*+-------------------------------------------------------------------------------+hashlittle() -- hash a variable-length key into a 32-bit value+  k       : the key (the unaligned variable-length array of bytes)+  length  : the length of the key, counting by bytes+  initval : can be any 4-byte value+Returns a 32-bit value.  Every bit of the key affects every bit of+the return value.  Two keys differing by one or two bits will have+totally different hash values.++The best hash table sizes are powers of 2.  There is no need to do+mod a prime (mod is sooo slow!).  If you need less than 32 bits,+use a bitmask.  For example, if you need only 10 bits, do+  h = (h & hashmask(10));+In which case, the hash table should have hashsize(10) elements.++If you are hashing n strings (uint8_t **)k, do it like this:+  for (i=0, h=0; i<n; ++i) h = hashlittle( k[i], len[i], h);++By Bob Jenkins, 2006.  bob_jenkins@burtleburtle.net.  You may use this+code any way you wish, private, educational, or commercial.  It's free.++Use for hash table lookup, or anything where one collision in 2^^32 is+acceptable.  Do NOT use for cryptographic purposes.+-------------------------------------------------------------------------------+*/++uint32_t hashlittle( const void *key, size_t length, uint32_t initval)+{+  uint32_t a,b,c;                                          /* internal state */+  union { const void *ptr; size_t i; } u;     /* needed for Mac Powerbook G4 */++  /* Set up the internal state */+  a = b = c = 0xdeadbeef + ((uint32_t)length) + initval;++  u.ptr = key;+  if (HASH_LITTLE_ENDIAN && ((u.i & 0x3) == 0)) {+    const uint32_t *k = (const uint32_t *)key;         /* read 32-bit chunks */++    /*------ all but last block: aligned reads and affect 32 bits of (a,b,c) */+    while (length > 12)+    {+      a += k[0];+      b += k[1];+      c += k[2];+      mix(a,b,c);+      length -= 12;+      k += 3;+    }++    /*----------------------------- handle the last (probably partial) block */+    /* +     * "k[2]&0xffffff" actually reads beyond the end of the string, but+     * then masks off the part it's not allowed to read.  Because the+     * string is aligned, the masked-off tail is in the same word as the+     * rest of the string.  Every machine with memory protection I've seen+     * does it on word boundaries, so is OK with this.  But VALGRIND will+     * still catch it and complain.  The masking trick does make the hash+     * noticably faster for short strings (like English words).+     */+#ifndef VALGRIND++    switch(length)+    {+    case 12: c+=k[2]; b+=k[1]; a+=k[0]; break;+    case 11: c+=k[2]&0xffffff; b+=k[1]; a+=k[0]; break;+    case 10: c+=k[2]&0xffff; b+=k[1]; a+=k[0]; break;+    case 9 : c+=k[2]&0xff; b+=k[1]; a+=k[0]; break;+    case 8 : b+=k[1]; a+=k[0]; break;+    case 7 : b+=k[1]&0xffffff; a+=k[0]; break;+    case 6 : b+=k[1]&0xffff; a+=k[0]; break;+    case 5 : b+=k[1]&0xff; a+=k[0]; break;+    case 4 : a+=k[0]; break;+    case 3 : a+=k[0]&0xffffff; break;+    case 2 : a+=k[0]&0xffff; break;+    case 1 : a+=k[0]&0xff; break;+    case 0 : return c;              /* zero length strings require no mixing */+    }++#else /* make valgrind happy */++    k8 = (const uint8_t *)k;+    switch(length)+    {+    case 12: c+=k[2]; b+=k[1]; a+=k[0]; break;+    case 11: c+=((uint32_t)k8[10])<<16;  /* fall through */+    case 10: c+=((uint32_t)k8[9])<<8;    /* fall through */+    case 9 : c+=k8[8];                   /* fall through */+    case 8 : b+=k[1]; a+=k[0]; break;+    case 7 : b+=((uint32_t)k8[6])<<16;   /* fall through */+    case 6 : b+=((uint32_t)k8[5])<<8;    /* fall through */+    case 5 : b+=k8[4];                   /* fall through */+    case 4 : a+=k[0]; break;+    case 3 : a+=((uint32_t)k8[2])<<16;   /* fall through */+    case 2 : a+=((uint32_t)k8[1])<<8;    /* fall through */+    case 1 : a+=k8[0]; break;+    case 0 : return c;+    }++#endif /* !valgrind */++  } else if (HASH_LITTLE_ENDIAN && ((u.i & 0x1) == 0)) {+    const uint16_t *k = (const uint16_t *)key;         /* read 16-bit chunks */+    const uint8_t  *k8;++    /*--------------- all but last block: aligned reads and different mixing */+    while (length > 12)+    {+      a += k[0] + (((uint32_t)k[1])<<16);+      b += k[2] + (((uint32_t)k[3])<<16);+      c += k[4] + (((uint32_t)k[5])<<16);+      mix(a,b,c);+      length -= 12;+      k += 6;+    }++    /*----------------------------- handle the last (probably partial) block */+    k8 = (const uint8_t *)k;+    switch(length)+    {+    case 12: c+=k[4]+(((uint32_t)k[5])<<16);+             b+=k[2]+(((uint32_t)k[3])<<16);+             a+=k[0]+(((uint32_t)k[1])<<16);+             break;+    case 11: c+=((uint32_t)k8[10])<<16;     /* fall through */+    case 10: c+=k[4];+             b+=k[2]+(((uint32_t)k[3])<<16);+             a+=k[0]+(((uint32_t)k[1])<<16);+             break;+    case 9 : c+=k8[8];                      /* fall through */+    case 8 : b+=k[2]+(((uint32_t)k[3])<<16);+             a+=k[0]+(((uint32_t)k[1])<<16);+             break;+    case 7 : b+=((uint32_t)k8[6])<<16;      /* fall through */+    case 6 : b+=k[2];+             a+=k[0]+(((uint32_t)k[1])<<16);+             break;+    case 5 : b+=k8[4];                      /* fall through */+    case 4 : a+=k[0]+(((uint32_t)k[1])<<16);+             break;+    case 3 : a+=((uint32_t)k8[2])<<16;      /* fall through */+    case 2 : a+=k[0];+             break;+    case 1 : a+=k8[0];+             break;+    case 0 : return c;                     /* zero length requires no mixing */+    }++  } else {                        /* need to read the key one byte at a time */+    const uint8_t *k = (const uint8_t *)key;++    /*--------------- all but the last block: affect some 32 bits of (a,b,c) */+    while (length > 12)+    {+      a += k[0];+      a += ((uint32_t)k[1])<<8;+      a += ((uint32_t)k[2])<<16;+      a += ((uint32_t)k[3])<<24;+      b += k[4];+      b += ((uint32_t)k[5])<<8;+      b += ((uint32_t)k[6])<<16;+      b += ((uint32_t)k[7])<<24;+      c += k[8];+      c += ((uint32_t)k[9])<<8;+      c += ((uint32_t)k[10])<<16;+      c += ((uint32_t)k[11])<<24;+      mix(a,b,c);+      length -= 12;+      k += 12;+    }++    /*-------------------------------- last block: affect all 32 bits of (c) */+    switch(length)                   /* all the case statements fall through */+    {+    case 12: c+=((uint32_t)k[11])<<24;+    case 11: c+=((uint32_t)k[10])<<16;+    case 10: c+=((uint32_t)k[9])<<8;+    case 9 : c+=k[8];+    case 8 : b+=((uint32_t)k[7])<<24;+    case 7 : b+=((uint32_t)k[6])<<16;+    case 6 : b+=((uint32_t)k[5])<<8;+    case 5 : b+=k[4];+    case 4 : a+=((uint32_t)k[3])<<24;+    case 3 : a+=((uint32_t)k[2])<<16;+    case 2 : a+=((uint32_t)k[1])<<8;+    case 1 : a+=k[0];+             break;+    case 0 : return c;+    }+  }++  final(a,b,c);+  return c;+}+++/*+ * hashlittle2: return 2 32-bit hash values+ *+ * This is identical to hashlittle(), except it returns two 32-bit hash+ * values instead of just one.  This is good enough for hash table+ * lookup with 2^^64 buckets, or if you want a second hash if you're not+ * happy with the first, or if you want a probably-unique 64-bit ID for+ * the key.  *pc is better mixed than *pb, so use *pc first.  If you want+ * a 64-bit value do something like "*pc + (((uint64_t)*pb)<<32)".+ */+void hashlittle2( +  const void *key,       /* the key to hash */+  size_t      length,    /* length of the key */+  uint32_t   *pc,        /* IN: primary initval, OUT: primary hash */+  uint32_t   *pb)        /* IN: secondary initval, OUT: secondary hash */+{+  uint32_t a,b,c;                                          /* internal state */+  union { const void *ptr; size_t i; } u;     /* needed for Mac Powerbook G4 */++  /* Set up the internal state */+  a = b = c = 0xdeadbeef + ((uint32_t)length) + *pc;+  c += *pb;++  u.ptr = key;+  if (HASH_LITTLE_ENDIAN && ((u.i & 0x3) == 0)) {+    const uint32_t *k = (const uint32_t *)key;         /* read 32-bit chunks */++    /*------ all but last block: aligned reads and affect 32 bits of (a,b,c) */+    while (length > 12)+    {+      a += k[0];+      b += k[1];+      c += k[2];+      mix(a,b,c);+      length -= 12;+      k += 3;+    }++    /*----------------------------- handle the last (probably partial) block */+    /* +     * "k[2]&0xffffff" actually reads beyond the end of the string, but+     * then masks off the part it's not allowed to read.  Because the+     * string is aligned, the masked-off tail is in the same word as the+     * rest of the string.  Every machine with memory protection I've seen+     * does it on word boundaries, so is OK with this.  But VALGRIND will+     * still catch it and complain.  The masking trick does make the hash+     * noticably faster for short strings (like English words).+     */+#ifndef VALGRIND++    switch(length)+    {+    case 12: c+=k[2]; b+=k[1]; a+=k[0]; break;+    case 11: c+=k[2]&0xffffff; b+=k[1]; a+=k[0]; break;+    case 10: c+=k[2]&0xffff; b+=k[1]; a+=k[0]; break;+    case 9 : c+=k[2]&0xff; b+=k[1]; a+=k[0]; break;+    case 8 : b+=k[1]; a+=k[0]; break;+    case 7 : b+=k[1]&0xffffff; a+=k[0]; break;+    case 6 : b+=k[1]&0xffff; a+=k[0]; break;+    case 5 : b+=k[1]&0xff; a+=k[0]; break;+    case 4 : a+=k[0]; break;+    case 3 : a+=k[0]&0xffffff; break;+    case 2 : a+=k[0]&0xffff; break;+    case 1 : a+=k[0]&0xff; break;+    case 0 : *pc=c; *pb=b; return;  /* zero length strings require no mixing */+    }++#else /* make valgrind happy */++    k8 = (const uint8_t *)k;+    switch(length)+    {+    case 12: c+=k[2]; b+=k[1]; a+=k[0]; break;+    case 11: c+=((uint32_t)k8[10])<<16;  /* fall through */+    case 10: c+=((uint32_t)k8[9])<<8;    /* fall through */+    case 9 : c+=k8[8];                   /* fall through */+    case 8 : b+=k[1]; a+=k[0]; break;+    case 7 : b+=((uint32_t)k8[6])<<16;   /* fall through */+    case 6 : b+=((uint32_t)k8[5])<<8;    /* fall through */+    case 5 : b+=k8[4];                   /* fall through */+    case 4 : a+=k[0]; break;+    case 3 : a+=((uint32_t)k8[2])<<16;   /* fall through */+    case 2 : a+=((uint32_t)k8[1])<<8;    /* fall through */+    case 1 : a+=k8[0]; break;+    case 0 : *pc=c; *pb=b; return;  /* zero length strings require no mixing */+    }++#endif /* !valgrind */++  } else if (HASH_LITTLE_ENDIAN && ((u.i & 0x1) == 0)) {+    const uint16_t *k = (const uint16_t *)key;         /* read 16-bit chunks */+    const uint8_t  *k8;++    /*--------------- all but last block: aligned reads and different mixing */+    while (length > 12)+    {+      a += k[0] + (((uint32_t)k[1])<<16);+      b += k[2] + (((uint32_t)k[3])<<16);+      c += k[4] + (((uint32_t)k[5])<<16);+      mix(a,b,c);+      length -= 12;+      k += 6;+    }++    /*----------------------------- handle the last (probably partial) block */+    k8 = (const uint8_t *)k;+    switch(length)+    {+    case 12: c+=k[4]+(((uint32_t)k[5])<<16);+             b+=k[2]+(((uint32_t)k[3])<<16);+             a+=k[0]+(((uint32_t)k[1])<<16);+             break;+    case 11: c+=((uint32_t)k8[10])<<16;     /* fall through */+    case 10: c+=k[4];+             b+=k[2]+(((uint32_t)k[3])<<16);+             a+=k[0]+(((uint32_t)k[1])<<16);+             break;+    case 9 : c+=k8[8];                      /* fall through */+    case 8 : b+=k[2]+(((uint32_t)k[3])<<16);+             a+=k[0]+(((uint32_t)k[1])<<16);+             break;+    case 7 : b+=((uint32_t)k8[6])<<16;      /* fall through */+    case 6 : b+=k[2];+             a+=k[0]+(((uint32_t)k[1])<<16);+             break;+    case 5 : b+=k8[4];                      /* fall through */+    case 4 : a+=k[0]+(((uint32_t)k[1])<<16);+             break;+    case 3 : a+=((uint32_t)k8[2])<<16;      /* fall through */+    case 2 : a+=k[0];+             break;+    case 1 : a+=k8[0];+             break;+    case 0 : *pc=c; *pb=b; return;  /* zero length strings require no mixing */+    }++  } else {                        /* need to read the key one byte at a time */+    const uint8_t *k = (const uint8_t *)key;++    /*--------------- all but the last block: affect some 32 bits of (a,b,c) */+    while (length > 12)+    {+      a += k[0];+      a += ((uint32_t)k[1])<<8;+      a += ((uint32_t)k[2])<<16;+      a += ((uint32_t)k[3])<<24;+      b += k[4];+      b += ((uint32_t)k[5])<<8;+      b += ((uint32_t)k[6])<<16;+      b += ((uint32_t)k[7])<<24;+      c += k[8];+      c += ((uint32_t)k[9])<<8;+      c += ((uint32_t)k[10])<<16;+      c += ((uint32_t)k[11])<<24;+      mix(a,b,c);+      length -= 12;+      k += 12;+    }++    /*-------------------------------- last block: affect all 32 bits of (c) */+    switch(length)                   /* all the case statements fall through */+    {+    case 12: c+=((uint32_t)k[11])<<24;+    case 11: c+=((uint32_t)k[10])<<16;+    case 10: c+=((uint32_t)k[9])<<8;+    case 9 : c+=k[8];+    case 8 : b+=((uint32_t)k[7])<<24;+    case 7 : b+=((uint32_t)k[6])<<16;+    case 6 : b+=((uint32_t)k[5])<<8;+    case 5 : b+=k[4];+    case 4 : a+=((uint32_t)k[3])<<24;+    case 3 : a+=((uint32_t)k[2])<<16;+    case 2 : a+=((uint32_t)k[1])<<8;+    case 1 : a+=k[0];+             break;+    case 0 : *pc=c; *pb=b; return;  /* zero length strings require no mixing */+    }+  }++  final(a,b,c);+  *pc=c; *pb=b;+}++++/*+ * hashbig():+ * This is the same as hashword() on big-endian machines.  It is different+ * from hashlittle() on all machines.  hashbig() takes advantage of+ * big-endian byte ordering. + */+uint32_t hashbig( const void *key, size_t length, uint32_t initval)+{+  uint32_t a,b,c;+  union { const void *ptr; size_t i; } u; /* to cast key to (size_t) happily */++  /* Set up the internal state */+  a = b = c = 0xdeadbeef + ((uint32_t)length) + initval;++  u.ptr = key;+  if (HASH_BIG_ENDIAN && ((u.i & 0x3) == 0)) {+    const uint32_t *k = (const uint32_t *)key;         /* read 32-bit chunks */++    /*------ all but last block: aligned reads and affect 32 bits of (a,b,c) */+    while (length > 12)+    {+      a += k[0];+      b += k[1];+      c += k[2];+      mix(a,b,c);+      length -= 12;+      k += 3;+    }++    /*----------------------------- handle the last (probably partial) block */+    /* +     * "k[2]<<8" actually reads beyond the end of the string, but+     * then shifts out the part it's not allowed to read.  Because the+     * string is aligned, the illegal read is in the same word as the+     * rest of the string.  Every machine with memory protection I've seen+     * does it on word boundaries, so is OK with this.  But VALGRIND will+     * still catch it and complain.  The masking trick does make the hash+     * noticably faster for short strings (like English words).+     */+#ifndef VALGRIND++    switch(length)+    {+    case 12: c+=k[2]; b+=k[1]; a+=k[0]; break;+    case 11: c+=k[2]&0xffffff00; b+=k[1]; a+=k[0]; break;+    case 10: c+=k[2]&0xffff0000; b+=k[1]; a+=k[0]; break;+    case 9 : c+=k[2]&0xff000000; b+=k[1]; a+=k[0]; break;+    case 8 : b+=k[1]; a+=k[0]; break;+    case 7 : b+=k[1]&0xffffff00; a+=k[0]; break;+    case 6 : b+=k[1]&0xffff0000; a+=k[0]; break;+    case 5 : b+=k[1]&0xff000000; a+=k[0]; break;+    case 4 : a+=k[0]; break;+    case 3 : a+=k[0]&0xffffff00; break;+    case 2 : a+=k[0]&0xffff0000; break;+    case 1 : a+=k[0]&0xff000000; break;+    case 0 : return c;              /* zero length strings require no mixing */+    }++#else  /* make valgrind happy */++    k8 = (const uint8_t *)k;+    switch(length)                   /* all the case statements fall through */+    {+    case 12: c+=k[2]; b+=k[1]; a+=k[0]; break;+    case 11: c+=((uint32_t)k8[10])<<8;  /* fall through */+    case 10: c+=((uint32_t)k8[9])<<16;  /* fall through */+    case 9 : c+=((uint32_t)k8[8])<<24;  /* fall through */+    case 8 : b+=k[1]; a+=k[0]; break;+    case 7 : b+=((uint32_t)k8[6])<<8;   /* fall through */+    case 6 : b+=((uint32_t)k8[5])<<16;  /* fall through */+    case 5 : b+=((uint32_t)k8[4])<<24;  /* fall through */+    case 4 : a+=k[0]; break;+    case 3 : a+=((uint32_t)k8[2])<<8;   /* fall through */+    case 2 : a+=((uint32_t)k8[1])<<16;  /* fall through */+    case 1 : a+=((uint32_t)k8[0])<<24; break;+    case 0 : return c;+    }++#endif /* !VALGRIND */++  } else {                        /* need to read the key one byte at a time */+    const uint8_t *k = (const uint8_t *)key;++    /*--------------- all but the last block: affect some 32 bits of (a,b,c) */+    while (length > 12)+    {+      a += ((uint32_t)k[0])<<24;+      a += ((uint32_t)k[1])<<16;+      a += ((uint32_t)k[2])<<8;+      a += ((uint32_t)k[3]);+      b += ((uint32_t)k[4])<<24;+      b += ((uint32_t)k[5])<<16;+      b += ((uint32_t)k[6])<<8;+      b += ((uint32_t)k[7]);+      c += ((uint32_t)k[8])<<24;+      c += ((uint32_t)k[9])<<16;+      c += ((uint32_t)k[10])<<8;+      c += ((uint32_t)k[11]);+      mix(a,b,c);+      length -= 12;+      k += 12;+    }++    /*-------------------------------- last block: affect all 32 bits of (c) */+    switch(length)                   /* all the case statements fall through */+    {+    case 12: c+=k[11];+    case 11: c+=((uint32_t)k[10])<<8;+    case 10: c+=((uint32_t)k[9])<<16;+    case 9 : c+=((uint32_t)k[8])<<24;+    case 8 : b+=k[7];+    case 7 : b+=((uint32_t)k[6])<<8;+    case 6 : b+=((uint32_t)k[5])<<16;+    case 5 : b+=((uint32_t)k[4])<<24;+    case 4 : a+=k[3];+    case 3 : a+=((uint32_t)k[2])<<8;+    case 2 : a+=((uint32_t)k[1])<<16;+    case 1 : a+=((uint32_t)k[0])<<24;+             break;+    case 0 : return c;+    }+  }++  final(a,b,c);+  return c;+}+++#ifdef SELF_TEST++/* used for timings */+void driver1()+{+  uint8_t buf[256];+  uint32_t i;+  uint32_t h=0;+  time_t a,z;++  time(&a);+  for (i=0; i<256; ++i) buf[i] = 'x';+  for (i=0; i<1; ++i) +  {+    h = hashlittle(&buf[0],1,h);+  }+  time(&z);+  if (z-a > 0) printf("time %ld %.8x\n", (long) z-a, h);+}++/* check that every input bit changes every output bit half the time */+#define HASHSTATE 1+#define HASHLEN   1+#define MAXPAIR 60+#define MAXLEN  70+void driver2()+{+  uint8_t qa[MAXLEN+1], qb[MAXLEN+2], *a = &qa[0], *b = &qb[1];+  uint32_t c[HASHSTATE], d[HASHSTATE], i=0, j=0, k, l, m=0, z;+  uint32_t e[HASHSTATE],f[HASHSTATE],g[HASHSTATE],h[HASHSTATE];+  uint32_t x[HASHSTATE],y[HASHSTATE];+  uint32_t hlen;++  printf("No more than %d trials should ever be needed \n",MAXPAIR/2);+  for (hlen=0; hlen < MAXLEN; ++hlen)+  {+    z=0;+    for (i=0; i<hlen; ++i)  /*----------------------- for each input byte, */+    {+      for (j=0; j<8; ++j)   /*------------------------ for each input bit, */+      {+	for (m=1; m<8; ++m) /*------------ for serveral possible initvals, */+	{+	  for (l=0; l<HASHSTATE; ++l)+	    e[l]=f[l]=g[l]=h[l]=x[l]=y[l]=~((uint32_t)0);++      	  /*---- check that every output bit is affected by that input bit */+	  for (k=0; k<MAXPAIR; k+=2)+	  { +	    uint32_t finished=1;+	    /* keys have one bit different */+	    for (l=0; l<hlen+1; ++l) {a[l] = b[l] = (uint8_t)0;}+	    /* have a and b be two keys differing in only one bit */+	    a[i] ^= (k<<j);+	    a[i] ^= (k>>(8-j));+	     c[0] = hashlittle(a, hlen, m);+	    b[i] ^= ((k+1)<<j);+	    b[i] ^= ((k+1)>>(8-j));+	     d[0] = hashlittle(b, hlen, m);+	    /* check every bit is 1, 0, set, and not set at least once */+	    for (l=0; l<HASHSTATE; ++l)+	    {+	      e[l] &= (c[l]^d[l]);+	      f[l] &= ~(c[l]^d[l]);+	      g[l] &= c[l];+	      h[l] &= ~c[l];+	      x[l] &= d[l];+	      y[l] &= ~d[l];+	      if (e[l]|f[l]|g[l]|h[l]|x[l]|y[l]) finished=0;+	    }+	    if (finished) break;+	  }+	  if (k>z) z=k;+	  if (k==MAXPAIR) +	  {+	     printf("Some bit didn't change: ");+	     printf("%.8x %.8x %.8x %.8x %.8x %.8x  ",+	            e[0],f[0],g[0],h[0],x[0],y[0]);+	     printf("i %d j %d m %d len %d\n", i, j, m, hlen);+	  }+	  if (z==MAXPAIR) goto done;+	}+      }+    }+   done:+    if (z < MAXPAIR)+    {+      printf("Mix success  %2d bytes  %2d initvals  ",i,m);+      printf("required  %d  trials\n", z/2);+    }+  }+  printf("\n");+}++/* Check for reading beyond the end of the buffer and alignment problems */+void driver3()+{+  uint8_t buf[MAXLEN+20], *b;+  uint32_t len;+  uint8_t q[] = "This is the time for all good men to come to the aid of their country...";+  uint32_t h;+  uint8_t qq[] = "xThis is the time for all good men to come to the aid of their country...";+  uint32_t i;+  uint8_t qqq[] = "xxThis is the time for all good men to come to the aid of their country...";+  uint32_t j;+  uint8_t qqqq[] = "xxxThis is the time for all good men to come to the aid of their country...";+  uint32_t ref,x,y;+  uint8_t *p;++  printf("Endianness.  These lines should all be the same (for values filled in):\n");+  printf("%.8x                            %.8x                            %.8x\n",+         hashword((const uint32_t *)q, (sizeof(q)-1)/4, 13),+         hashword((const uint32_t *)q, (sizeof(q)-5)/4, 13),+         hashword((const uint32_t *)q, (sizeof(q)-9)/4, 13));+  p = q;+  printf("%.8x %.8x %.8x %.8x %.8x %.8x %.8x %.8x %.8x %.8x %.8x %.8x\n",+         hashlittle(p, sizeof(q)-1, 13), hashlittle(p, sizeof(q)-2, 13),+         hashlittle(p, sizeof(q)-3, 13), hashlittle(p, sizeof(q)-4, 13),+         hashlittle(p, sizeof(q)-5, 13), hashlittle(p, sizeof(q)-6, 13),+         hashlittle(p, sizeof(q)-7, 13), hashlittle(p, sizeof(q)-8, 13),+         hashlittle(p, sizeof(q)-9, 13), hashlittle(p, sizeof(q)-10, 13),+         hashlittle(p, sizeof(q)-11, 13), hashlittle(p, sizeof(q)-12, 13));+  p = &qq[1];+  printf("%.8x %.8x %.8x %.8x %.8x %.8x %.8x %.8x %.8x %.8x %.8x %.8x\n",+         hashlittle(p, sizeof(q)-1, 13), hashlittle(p, sizeof(q)-2, 13),+         hashlittle(p, sizeof(q)-3, 13), hashlittle(p, sizeof(q)-4, 13),+         hashlittle(p, sizeof(q)-5, 13), hashlittle(p, sizeof(q)-6, 13),+         hashlittle(p, sizeof(q)-7, 13), hashlittle(p, sizeof(q)-8, 13),+         hashlittle(p, sizeof(q)-9, 13), hashlittle(p, sizeof(q)-10, 13),+         hashlittle(p, sizeof(q)-11, 13), hashlittle(p, sizeof(q)-12, 13));+  p = &qqq[2];+  printf("%.8x %.8x %.8x %.8x %.8x %.8x %.8x %.8x %.8x %.8x %.8x %.8x\n",+         hashlittle(p, sizeof(q)-1, 13), hashlittle(p, sizeof(q)-2, 13),+         hashlittle(p, sizeof(q)-3, 13), hashlittle(p, sizeof(q)-4, 13),+         hashlittle(p, sizeof(q)-5, 13), hashlittle(p, sizeof(q)-6, 13),+         hashlittle(p, sizeof(q)-7, 13), hashlittle(p, sizeof(q)-8, 13),+         hashlittle(p, sizeof(q)-9, 13), hashlittle(p, sizeof(q)-10, 13),+         hashlittle(p, sizeof(q)-11, 13), hashlittle(p, sizeof(q)-12, 13));+  p = &qqqq[3];+  printf("%.8x %.8x %.8x %.8x %.8x %.8x %.8x %.8x %.8x %.8x %.8x %.8x\n",+         hashlittle(p, sizeof(q)-1, 13), hashlittle(p, sizeof(q)-2, 13),+         hashlittle(p, sizeof(q)-3, 13), hashlittle(p, sizeof(q)-4, 13),+         hashlittle(p, sizeof(q)-5, 13), hashlittle(p, sizeof(q)-6, 13),+         hashlittle(p, sizeof(q)-7, 13), hashlittle(p, sizeof(q)-8, 13),+         hashlittle(p, sizeof(q)-9, 13), hashlittle(p, sizeof(q)-10, 13),+         hashlittle(p, sizeof(q)-11, 13), hashlittle(p, sizeof(q)-12, 13));+  printf("\n");++  /* check that hashlittle2 and hashlittle produce the same results */+  i=47; j=0;+  hashlittle2(q, sizeof(q), &i, &j);+  if (hashlittle(q, sizeof(q), 47) != i)+    printf("hashlittle2 and hashlittle mismatch\n");++  /* check that hashword2 and hashword produce the same results */+  len = 0xdeadbeef;+  i=47, j=0;+  hashword2(&len, 1, &i, &j);+  if (hashword(&len, 1, 47) != i)+    printf("hashword2 and hashword mismatch %x %x\n", +	   i, hashword(&len, 1, 47));++  /* check hashlittle doesn't read before or after the ends of the string */+  for (h=0, b=buf+1; h<8; ++h, ++b)+  {+    for (i=0; i<MAXLEN; ++i)+    {+      len = i;+      for (j=0; j<i; ++j) *(b+j)=0;++      /* these should all be equal */+      ref = hashlittle(b, len, (uint32_t)1);+      *(b+i)=(uint8_t)~0;+      *(b-1)=(uint8_t)~0;+      x = hashlittle(b, len, (uint32_t)1);+      y = hashlittle(b, len, (uint32_t)1);+      if ((ref != x) || (ref != y)) +      {+	printf("alignment error: %.8x %.8x %.8x %d %d\n",ref,x,y,+               h, i);+      }+    }+  }+}++/* check for problems with nulls */+ void driver4()+{+  uint8_t buf[1];+  uint32_t h,i,state[HASHSTATE];+++  buf[0] = ~0;+  for (i=0; i<HASHSTATE; ++i) state[i] = 1;+  printf("These should all be different\n");+  for (i=0, h=0; i<8; ++i)+  {+    h = hashlittle(buf, 0, h);+    printf("%2d  0-byte strings, hash is  %.8x\n", i, h);+  }+}+++int main()+{+  driver1();   /* test that the key is hashed: used for timings */+  driver2();   /* test that whole key is hashed thoroughly */+  driver3();   /* test that nothing but the key is hashed */+  driver4();   /* test hashing multiple buffers (all buffers are null) */+  return 1;+}++#endif  /* SELF_TEST */
+ examples/Makefile view
@@ -0,0 +1,15 @@+hc := ghc+hcflags := --make -O2++examples := words spellchecker++all: $(examples)++words: Words.hs+	$(hc) $(hcflags) -o $@ $^++spellchecker: SpellChecker.hs+	$(hc) $(hcflags) -o $@ $^++clean:+	-rm -f *.hi *.o $(examples)
+ examples/SpellChecker.hs view
@@ -0,0 +1,7 @@+import Data.BloomFilter.Easy (easyList, elemB)++main = do+  filt <- (easyList 0.01 . words) `fmap` readFile "/usr/share/dict/words"+  let check word | word `elemB` filt = ""+                 | otherwise         = word ++ "\n"+  interact (concat . map check . lines)
+ examples/Words.hs view
@@ -0,0 +1,27 @@+-- This program is intended for performance analysis.  It simply+-- builds a Bloom filter from a list of words, one per line, and+-- queries it exhaustively.++import Control.Monad (forM_, mapM_)+import Data.BloomFilter.Easy (easyList, elemB, lengthB)+import qualified Data.ByteString.Char8 as B+import Data.Time.Clock (diffUTCTime, getCurrentTime)+import System.Environment (getArgs)++main = do+  args <- getArgs+  let files | null args = ["/usr/share/dict/words"]+            | otherwise = args+  forM_ files $ \file -> do+    a <- getCurrentTime+    words <- B.lines `fmap` B.readFile file+    putStrLn $ {-# SCC "words/length" #-} show (length words) ++ " words"+    b <- getCurrentTime+    putStrLn $ show (diffUTCTime b a) ++ "s to count words"+    let filt = {-# SCC "construct" #-} easyList 0.01 words+    print filt+    c <- getCurrentTime+    putStrLn $ show (diffUTCTime c b) ++ "s to construct filter"+    {-# SCC "query" #-} mapM_ print $ filter (not . (`elemB` filt)) words+    d <- getCurrentTime+    putStrLn $ show (diffUTCTime d c) ++ "s to query every element"