diff --git a/Data/PerfectHash.lhs b/Data/PerfectHash.lhs new file mode 100644 --- /dev/null +++ b/Data/PerfectHash.lhs @@ -0,0 +1,91 @@ +> {-# LANGUAGE ForeignFunctionInterface, ScopedTypeVariables, EmptyDataDecls, BangPatterns #-} +> module Data.PerfectHash ( PerfectHash, fromList, lookup, lookupByIndex ) where + +> import Array +> import Data.Array.IO +> import Foreign +> import Foreign.C.String +> import Foreign.C.Types +> import Foreign.Marshal.Array +> import Prelude hiding (lookup) +> import System.IO.Unsafe +> import qualified Data.ByteString.Char8 as S +> import qualified Data.ByteString.Unsafe as Unsafe +> import Data.Array.Storable +> import Data.Digest.CRC32 (crc32) +> import Data.Digest.Adler32 (adler32) +> import Control.Monad(guard) + +Arguably the FFI stuff should be in a separate file, but let's keep it simple for the moment. + +> foreign import ccall unsafe "cmph.h cmph_search" c_cmph_search :: Ptr ForeignHash -> CString -> CInt -> CULong +> foreign import ccall unsafe "stub.h build_hash" c_build_hash :: Ptr CString -> CInt -> IO (Ptr ForeignHash) +> foreign import ccall unsafe "string.h strdup" c_strdup :: CString -> IO CString +> foreign import ccall unsafe "string.h strncmp" c_strncmp :: CString -> CString -> CInt -> IO CInt + +standard idiom for an opaque type + +> data ForeignHash + +> data PerfectHash a = PerfectHash { store :: !(Array.Array Word32 (a,CString)), +> hashFunc :: !(S.ByteString -> Word32) } + +pretty certain this could be improved + +> use_hash a str = {-# SCC "use_hash" #-} unsafePerformIO $ Unsafe.unsafeUseAsCStringLen str +> (\(cstr,i) -> return (fromIntegral $ c_cmph_search a cstr (fromIntegral i))) + +> raw_hashfunc hash cstr len = fromIntegral $ c_cmph_search hash cstr len + +This could do with being broken up a little, probably + +> fromList :: Show a => [(S.ByteString, a)] -> PerfectHash a +> fromList ls = unsafePerformIO $ do +> let len = length ls +> arr <- newArray_ (0, len-1) +> -- we make one pass over ls, then throw it away +> cstr_ptrs <- mapM (\(i,(bs, val)) -> +> S.useAsCStringLen bs $ \(cstr,len) -> do +> newPtr <- c_strdup cstr +> writeArray arr i newPtr +> return (newPtr,fromIntegral len,val)) +> (zip [0..] ls) +> cmph <- withStorableArray arr $ \ptr -> c_build_hash ptr (fromIntegral len) +> let bounds :: (Word32, Word32) = (fromIntegral 0, fromIntegral len - 1) +> arr <- newArray_ bounds :: IO (IOArray Word32 a) +> checksums <- newArray_ bounds :: IO (IOArray Word32 Word32) +> let hashFunc = use_hash cmph +> mapM_ (\(cstr,len,val) -> do +> let index = raw_hashfunc cmph cstr len +> writeArray arr index (val,cstr)) $ cstr_ptrs +> i_arr <- freeze arr +> return PerfectHash { store = i_arr, +> hashFunc = use_hash cmph } + +> + +-- > crc = crc32 + +-- > crc = adler32 + +> lookup :: PerfectHash a -> S.ByteString -> Maybe a +> lookup !hash !bs +> | check = Just e +> | otherwise = Nothing +> where index = {-# SCC "hash_only" #-} hashFunc hash bs +> (!low, !high) = Array.bounds arr +> !arr = store hash +> (e, str) = arr ! index +> !check = {-# SCC "check" #-} low <= index && high >= index && +> {-# SCC "bs_check" #-} unsafePerformIO $ Unsafe.unsafeUseAsCStringLen bs (\(cstr,len) -> +> c_strncmp str cstr (fromIntegral len) >>= \res -> return (res == 0)) + +sometimes it's convenient to have direct access, but this should probably be seen as a +slightly devious use case. + +> lookupByIndex :: PerfectHash a -> Word32 -> Maybe S.ByteString +> lookupByIndex hash index = do +> guard $ low <= index && high >= index +> return $ unsafePerformIO $ S.packCString $ snd $ arr ! index +> where (!low, !high) = bounds arr +> arr = store hash diff --git a/HackedMicrobench.hs b/HackedMicrobench.hs new file mode 100644 --- /dev/null +++ b/HackedMicrobench.hs @@ -0,0 +1,105 @@ +{-# LANGUAGE OverlappingInstances, FlexibleInstances #-} +-- microbench, a tiny microbenchmarking library for Haskell. +-- Copyright (C) 2008 Evan Martin +-- hacked ever so slightly by mwotton@gmail.com in the interests +-- of not spinning forever on very fast operations + +-- |Microbenchmarking can be used to compare the speed of different +-- approaches to the same operation. Since most code is very fast, to +-- get accurate timing information you must run the operation many times +-- and then divide to get the time per operation. +-- +-- This library manages the microbenchmarking process: it finds how many +-- iterations of a function are needed to get a good timing estimate per +-- iteration and prints out a human-readable \"Your code takes /n/ +-- nanoseconds to run, and can run /n/ times per second\". +-- +-- The only function 'microbench' takes a function that expects an +-- integer parameter (which is the quantity you're trying to measure), +-- and probes the function with increasing parameters until enough time +-- has elapsed to get a good measurement. +-- +-- This may be better understood by some example code: +-- +-- > sum1 n = sum [1..n] +-- > sum2 n = foldl (+) 0 [1..n] +-- > main = do +-- > microbench "Sum using sum" sum1 +-- > microbench "Sum using foldl" sum2 +-- +-- When run, @sum1@ and @sum2@ are called with varying values of @n@. +-- The output, then, is an estimate of how many integers these +-- approaches could sum per second. +-- +-- 'microbench' also accepts a parameter of type @IO ()@ for +-- benchmarking. It does the same probing process, but manages running +-- the operation in a loop. +module HackedMicrobench ( + microbench, + Microbenchable +) where + +import Control.Exception +import Debug.Trace +import Data.IORef +import Data.List +import Data.Time.Clock +import Data.Typeable +import Control.Concurrent +import System.IO +import Numeric + +-- Want to handle: +-- Int -> a => ok +-- Int -> IO a => ok +-- IO () => loop the action +-- TODO: +-- IO a => loop the action, forcing each result? +-- a => is it possible? I tried for a while but couldn't make it work. +-- +-- TODO 2: +-- factor out "setup time" by comparing different outputs for different inputs +-- and a linear model. + +-- |Microbenchmarkable computations. Be very wary of adding your own +-- instances of this class, as it's difficult to force GHC to +-- re-evaluate code in a way that makes benchmarking easy. +class Microbenchable a where + run :: a -> Integer -> IO () + +instance Microbenchable (Integer -> IO ()) where + run f n = f n +instance Microbenchable (Integer -> a) where + run f n = do x <- evaluate (f n); return () +instance Microbenchable (IO ()) where + run f n = mapM_ (const f) [1..n] + +-- This was chosen totally arbitrarily. Perhaps it would be better to make it +-- a parameter, or use some sort of real statistical test. +microbenchTime = 5.0 + +-- |@microbench description target@ probes target with different parameters +-- until it's ran enough iterations to have a good estimate at the rate per +-- second of the operation. @description@ is a textual description of the +-- thing being benchmarked. Outputs to stdout. +microbench :: Microbenchable a => String -> a -> IO () +microbench desc f = do + hSetBuffering stdout NoBuffering + putStr $ "* " ++ desc ++ ": " + start <- getCurrentTime + time <- probe 1 + putStrLn "" + putStrLn $ " " ++ showFFloat (Just 3) (time*1000*1000) "ns per iteration / " + ++ showGFloat (Just 2) (1 / time) " per second." + where + probe repeats = do + -- putStr "." + start <- getCurrentTime + run f repeats + end <- getCurrentTime + let delta = end `diffUTCTime` start + -- print (delta, repeats) + if delta > microbenchTime + then do return (realToFrac delta / realToFrac repeats) + else probe (repeats * 2) + diff --git a/LICENSE b/LICENSE new file mode 100644 --- /dev/null +++ b/LICENSE @@ -0,0 +1,29 @@ +Copyright (c) 2009 Mark Wotton +(Microbench copyright Evan Martin ) + +All rights reserved. + +Redistribution and use in source and binary forms, with or without +modification, are permitted provided that the following conditions are +met: +* Redistributions of source code must retain the above copyright notice, + this list of conditions and the following disclaimer. +* 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. +* Neither the name of the author nor the names of contributors may be + used to endorse or promote products derived from this software without + specific prior written permission. + +THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND 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 COPYRIGHT OWNER +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. + diff --git a/PerfectHash.cabal b/PerfectHash.cabal new file mode 100644 --- /dev/null +++ b/PerfectHash.cabal @@ -0,0 +1,52 @@ +Name: PerfectHash +Version: 0.1 +Cabal-Version: >= 1.2 +License: BSD3 +License-File: LICENSE +Build-Type: Simple +Author: Mark Wotton +Maintainer: Mark Wotton +Category: Data, Data Structures +Stability: Experimental +extra-source-files: stub.h, README, TODO +bug-reports: mailto:mwotton@gmail.com +Synopsis: A perfect hashing library for mapping bytestrings to values. +Description: A perfect hashing library for mapping bytestrings to values. + Insertion is not supported (by design): this is just a binding + to the C-based CMPH library (http://cmph.sf.net). Only fromList + and lookup operations are supported, but in many circumstances + this is all that's required. +Library + Exposed-Modules: Data.PerfectHash, HackedMicrobench + ghc-options: -auto-all -funbox-strict-fields -fvia-C -optc-O2 + c-sources: stub.c + includes: stub.h + extra-lib-dirs: /usr/local/lib/ + extra-libraries: cmph + build-depends: base, haskell98, containers, bytestring, digest,array, time + +Executable benchmark + Executable: benchmark + Main-Is: benchmark.hs + extra-lib-dirs: /usr/local/lib/ + extra-libraries: cmph + c-sources: stub.c + includes: stub.h + +Executable benchmark_trie + Executable: benchmark_trie + Main-Is: benchmark_trie.hs + extra-lib-dirs: /usr/local/lib/ + extra-libraries: cmph + c-sources: stub.c + includes: stub.h + build-depends: bytestring-trie + +Executable test + Executable: test + Main-Is: t/00_correctness.hs + extra-lib-dirs: /usr/local/lib/ + extra-libraries: cmph + c-sources: stub.c + includes: stub.h + build-depends: QuickCheck, HUnit diff --git a/README b/README new file mode 100644 --- /dev/null +++ b/README @@ -0,0 +1,20 @@ +This is a thin haskell wrapper around the CMPH library, obtainable at http://cmph.sf.net. +I assume you have it installed in /usr/local/lib. + +The motivation is mostly speed, and wren thornton's bytestring-trie seems to be the main competition: + +% ./dist/build/benchmark_trie/benchmark_trie +* trie lookup: 1.136ns per iteration / 880403.98 per second. + +% ./dist/build/benchmark/benchmark +* perfect lookup: 0.687ns per iteration / 1456455.69 per second. + +it also uses less space in the haskell heap, building once and doing the same number of lookups: + +PerfectHash: + total alloc = 2,525,223,964 bytes (excludes profiling overheads) + +Trie: + total alloc = 9,806,202,096 bytes (excludes profiling overheads) + +although this is not an entirely fair comparison given how much PerfectHash stores on the C side. diff --git a/Setup.hs b/Setup.hs new file mode 100644 --- /dev/null +++ b/Setup.hs @@ -0,0 +1,4 @@ +#!/usr/bin/env runhaskell +import Distribution.Simple + +main = defaultMain diff --git a/TODO b/TODO new file mode 100644 --- /dev/null +++ b/TODO @@ -0,0 +1,2 @@ +- some sensible way of changing the hashing algorithm +- finalisers for C memory allocation - it probably leaks like crazy right now. diff --git a/benchmark.hs b/benchmark.hs new file mode 100644 --- /dev/null +++ b/benchmark.hs @@ -0,0 +1,22 @@ + +{-# LANGUAGE ScopedTypeVariables #-} + +import Random +import HackedMicrobench -- small bugfix - use Integer rather than Int. original author unavailable for reports +import Control.Exception +import Data.List as List +import Data.PerfectHash as PerfectHash +import Maybe +import qualified Data.ByteString.Char8 as S + + +perfect_lookup :: PerfectHash Integer -> [S.ByteString] -> Integer -> Integer +perfect_lookup m words size = sum $ mapMaybe (PerfectHash.lookup m) targets + where targets :: [S.ByteString] = genericTake size $ cycle words + +main = do + str <- S.readFile "/usr/share/dict/words" + words <- evaluate $ S.lines str + source :: [(S.ByteString, Integer)] <- evaluate $ zip words [1..] + perfect <- evaluate $ PerfectHash.fromList source + {-# SCC "mb_lookup" #-} microbench "perfect lookup" (perfect_lookup perfect words) diff --git a/benchmark_trie.hs b/benchmark_trie.hs new file mode 100644 --- /dev/null +++ b/benchmark_trie.hs @@ -0,0 +1,24 @@ + +{-# LANGUAGE ScopedTypeVariables #-} + +import Random +import HackedMicrobench -- small bugfix - use Integer rather than Int. original author unavailable for reports +import Control.Exception +import Data.List as List +import Data.Trie as Trie +import Maybe +import qualified Data.ByteString.Char8 as S + + +trie_lookup :: Trie.Trie Integer -> [S.ByteString] -> Integer -> Integer +trie_lookup m words size = sum $ mapMaybe (tl m) targets + where targets :: [S.ByteString] = genericTake size $ cycle words + +tl string trie = {-# SCC "trie" #-} Trie.lookup trie string + +main = do + str <- S.readFile "/usr/share/dict/words" + words <- evaluate $ S.lines str + source :: [(S.ByteString, Integer)] <- evaluate $ zip words [1..] + trie <- evaluate $ Trie.fromList source + {-# SCC "mb_lookup" #-} microbench "trie lookup" (trie_lookup trie words) diff --git a/stub.c b/stub.c new file mode 100644 --- /dev/null +++ b/stub.c @@ -0,0 +1,34 @@ +#include "stub.h" +#include +#include +#include + +// #define __MONKEY_DEBUG__ + +void monkey_debug(char ** vector, int nkeys) { + int i = 0; + int blah=0; + for(i=0; i< nkeys; i++) { + fprintf(stderr, "read:%5d: %s\n", i, vector[i]); + } +} + +cmph_t * build_hash(char ** vector, int nkeys) { +#ifdef __MONKEY_DEBUG__ + monkey_debug(vector, nkeys); +#endif + // fprintf(stderr, "building hash with %d keys, first is %s, last is %s\n", nkeys, *vector, vector[nkeys-1]); + cmph_io_adapter_t *source = cmph_io_vector_adapter(vector, nkeys); + //fprintf(stderr, "building adapter is %p\n", source); + cmph_config_t *config = cmph_config_new(source); + // fprintf(stderr, "building config is %p\n", config); + cmph_config_set_algo(config, CMPH_BDZ); + cmph_t *hash = cmph_new(config); + // cmph_config_destroy(config); + // fprintf(stderr, "building hash is %p\n", hash); + // monkey_debug(vector, nkeys); + if(!hash) { fprintf(stderr, "Dying horribly, hash is null"); exit(1); } + return hash; +} + + diff --git a/stub.h b/stub.h new file mode 100644 --- /dev/null +++ b/stub.h @@ -0,0 +1,8 @@ +#ifndef __HASH_STUB_H__ +#define __HASH_STUB_H__ + +#include + +unsigned long stub_hash(cmph_t* hash, char * word); +cmph_t * build_hash(char ** vector, int nkeys); +#endif diff --git a/t/00_correctness.hs b/t/00_correctness.hs new file mode 100644 --- /dev/null +++ b/t/00_correctness.hs @@ -0,0 +1,49 @@ +{-# LANGUAGE ScopedTypeVariables, FlexibleInstances, IncoherentInstances, OverlappingInstances #-} + +import qualified Data.ByteString.Char8 as S +import qualified Data.Map as Map +import qualified Data.PerfectHash as PerfectHash +import Debug.Trace +import Test.HUnit +import List +import Maybe +import Test.QuickCheck + + +newtype Blub = Blub ([S.ByteString],[S.ByteString]) + deriving (Show, Read) + +newtype Bar = Bar [S.ByteString] + deriving (Show, Read) + + +-- would be nice to have a reasonable way of generating random strings, then i could +-- move this to quickcheck and get rid of the dependence on /usr/share/dict/words + +halves :: [a] -> ([a], [a]) +halves ls = List.splitAt ((length ls) `div` 2) ls + +big_test ws = TestList [TestLabel "Successful lookup" $ TestList successTests, + TestLabel "Faithful report of absence" $ TestList absenceTests] + where hash = PerfectHash.fromList al + datamap = Map.fromList al + al = zip source [0..] + (source, orphans) = halves $ sortedNub ws + absenceTests = map (\w -> TestCase $ + assertEqual "shouldn't find it" + (PerfectHash.lookup hash w) + Nothing + ) orphans + successTests = map (\w -> TestCase $ + assertEqual "should find it: same result as Data.Map" + (Map.lookup w datamap ) + (PerfectHash.lookup hash w) + + ) source + +sortedNub xs = map head $ group $ sort xs + +main = do + l <- S.readFile "/usr/share/dict/words"; + runTestTT (big_test $ take 10000 $ S.lines l) +