PerfectHash 0.1 → 0.1.1
raw patch · 2 files changed
+67/−35 lines, 2 filesdep +binaryPVP ok
version bump matches the API change (PVP)
Dependencies added: binary
API changes (from Hackage documentation)
Files
- Data/PerfectHash.lhs +65/−33
- PerfectHash.cabal +2/−2
Data/PerfectHash.lhs view
@@ -1,4 +1,4 @@-> {-# LANGUAGE ForeignFunctionInterface, ScopedTypeVariables, EmptyDataDecls, BangPatterns #-}+> {-# LANGUAGE ForeignFunctionInterface, ScopedTypeVariables, EmptyDataDecls, BangPatterns, TypeSynonymInstances, FlexibleInstances #-} > module Data.PerfectHash ( PerfectHash, fromList, lookup, lookupByIndex ) where > import Array@@ -12,9 +12,11 @@ > import qualified Data.ByteString.Char8 as S > import qualified Data.ByteString.Unsafe as Unsafe > import Data.Array.Storable+> import Data.Binary > import Data.Digest.CRC32 (crc32) > import Data.Digest.Adler32 (adler32)-> import Control.Monad(guard)+> import Control.Monad(guard, liftM)+> import GHC.Arr (unsafeAt) Arguably the FFI stuff should be in a separate file, but let's keep it simple for the moment. @@ -28,64 +30,94 @@ > data ForeignHash > data PerfectHash a = PerfectHash { store :: !(Array.Array Word32 (a,CString)),-> hashFunc :: !(S.ByteString -> Word32) }+> cmph :: Ptr ForeignHash +> } -pretty certain this could be improved+is this even a sane thing to do? -> use_hash a str = {-# SCC "use_hash" #-} unsafePerformIO $ Unsafe.unsafeUseAsCStringLen str-> (\(cstr,i) -> return (fromIntegral $ c_cmph_search a cstr (fromIntegral i)))+-- > instance Binary CString where+-- > get = undefined+-- > put (s :: CString) = undefined -> raw_hashfunc hash cstr len = fromIntegral $ c_cmph_search hash cstr len+-- > instance (Binary a) => Binary (PerfectHash a) where+-- > get = do+-- > size <- get+-- > arr <- newArray_ (0,size)+-- > forM_ [0 .. size] $ writeArray arr +-- > store <- get+-- > cmph <- undefined+-- > return $ PerfectHash { store = store, cmph = cmph }+-- > put p = do+-- > let arr = store p+-- > last = rangeSize (bounds arr) - 1+-- > put last+-- > mapM_ (\(a, str) -> put a >> put (unsafePerformIO $ S.packCString str))+-- > [ unsafeAt arr i | i <- [0 .. last] ] +-- > put (cmph p)++-- > instance Binary (Ptr ForeignHash) where+-- > get = undefined+-- > put f = undefined++> raw_hashfunc hash (cstr,len) = fromIntegral $ c_cmph_search hash cstr (fromIntegral 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)+> (fodder,cstr_ptrs) <- prepareCPtrs+> cmph <- withStorableArray fodder $ \ptr -> c_build_hash ptr (fromIntegral len)+> i_arr <- buildArray cmph cstr_ptrs+> return PerfectHash { store = i_arr, +> cmph = cmph }++> where prepareCPtrs = do +> fodder <- 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))+> writeArray fodder 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+> return (fodder, cstr_ptrs)+> +> buildArray cmph cstr_ptrs = do+> arr <- newArray_ (fromIntegral 0, fromIntegral len - 1) :: IO (IOArray Word32 a)+> mapM_ (\(cl@(cstr,len),val) -> writeArray arr (raw_hashfunc cmph cl) (val,cstr)) $ cstr_ptrs+> -- we created it, we can do what we like with it...+> unsafeFreeze arr+> +> len = length ls > lookup :: PerfectHash a -> S.ByteString -> Maybe a-> lookup !hash !bs-> | check = Just e-> | otherwise = Nothing-> where index = {-# SCC "hash_only" #-} hashFunc hash bs+> lookup !hash !bs = guard check >> return e+> where index = {-# SCC "hash_only" #-} use_hash (cmph hash) bs > (!low, !high) = Array.bounds arr > !arr = store hash > (e, str) = arr ! index++basic index checking stuff plus a check that we haven't just had a hash collision - tried crc checking here+and it turns out that strncmp is faster+ > !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)) +> use_hash a str = {-# SCC "use_hash" #-} unsafePerformIO $ Unsafe.unsafeUseAsCStringLen str+> (return . raw_hashfunc a)++++ 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+> return $ unsafePerformIO $ S.packCString $ snd $ unsafeAt arr (fromIntegral index) > where (!low, !high) = bounds arr > arr = store hash
PerfectHash.cabal view
@@ -1,5 +1,5 @@ Name: PerfectHash-Version: 0.1+Version: 0.1.1 Cabal-Version: >= 1.2 License: BSD3 License-File: LICENSE@@ -23,7 +23,7 @@ includes: stub.h extra-lib-dirs: /usr/local/lib/ extra-libraries: cmph- build-depends: base, haskell98, containers, bytestring, digest,array, time+ build-depends: base, haskell98, containers, bytestring, digest,array, time, binary Executable benchmark Executable: benchmark