diff --git a/Data/CMPH.hs b/Data/CMPH.hs new file mode 100644 --- /dev/null +++ b/Data/CMPH.hs @@ -0,0 +1,88 @@ +{-# LANGUAGE EmptyDataDecls #-} +{-# LANGUAGE FlexibleContexts #-} +{-# LANGUAGE ForeignFunctionInterface #-} +{-# LANGUAGE OverloadedStrings #-} + + +module Data.CMPH ( CMPH, hash, buildHash, size ) where +import Control.Exception (bracket) +import Control.Monad (guard, liftM) +import Data.Array +import Data.Array.IO (IOArray, newArray, newArray_, + writeArray) +import Data.Array.Storable (StorableArray, withStorableArray) +import Data.Array.Unsafe (unsafeFreeze) +import qualified Data.ByteString as BS +import qualified Data.ByteString.Char8 as S +import qualified Data.ByteString.Unsafe as Unsafe +import Data.Monoid +import qualified Data.Set as Set +import Data.Word +import Foreign (Ptr) +import Foreign.C.String (CString) +import Foreign.C.Types +import Foreign.Marshal.Array () +import GHC.Arr (unsafeAt) +import Prelude hiding (lookup) +import System.IO.Unsafe (unsafePerformIO) + +data ForeignHash + +foreign import ccall unsafe "stub.h cmph_search" c_cmph_search + :: Ptr ForeignHash -> CString -> CUInt -> IO CULong +foreign import ccall unsafe "stub.h build_hash" c_build_hash + :: Ptr CString -> CUInt -> IO (Ptr ForeignHash) +foreign import ccall unsafe "stub.h free_ptrs" c_free_ptrs + :: CUInt -> Ptr CString -> IO () +foreign import ccall unsafe "string.h strdup" c_strdup + :: CString -> IO CString + +data CMPH = CMPH { rawHash :: Ptr ForeignHash + , size :: Word32 + } + +-- we pull a few dumb tricks to get around some partiality in libcmph. +-- +-- no empty strings allowed +-- so prepend 'a' to all strings +-- can't hash an empty list +-- so add an element to empty lists. +-- no repeats +-- strip them out before passing to the c lib +-- can't have embedded nulls in the inserted strings +-- return Nothing. Too hard. + +buildHash :: [BS.ByteString] -> IO (Maybe CMPH) +buildHash input' + | all noNull input' = do + let input = uniqued ("":"b":input') + let len = fromIntegral $ length input + raw <- + bracket (buildCPtrs (map ("a"<>) input)) + (freeCPtrs len) + (\a -> withStorableArray a (`c_build_hash` (CUInt len))) + return $ Just $ CMPH raw len + | otherwise = return Nothing + +uniqued :: Ord a => [a] -> [a] +uniqued = Set.toList . Set.fromList + +noNull :: BS.ByteString -> Bool +noNull = (==Nothing) . S.find (=='\NUL') + +hash :: CMPH-> BS.ByteString -> IO Word64 +hash cmph bs = do + (CULong w) <- S.useAsCStringLen ("a"<>bs) $ \(cstr,len) -> c_cmph_search (rawHash cmph) cstr (CUInt $ fromIntegral len) + return w + +freeCPtrs :: Word32 + -> StorableArray Int CString + -> IO () +freeCPtrs len arr = withStorableArray arr $ c_free_ptrs (CUInt len) + +buildCPtrs bs = do + buffer <- newArray_ (0,length bs-1) + (`mapM_` (zip [0..] bs)) $ \(i,bs) -> + S.useAsCStringLen bs $ \(cstr,len) -> do + writeArray buffer i =<< c_strdup cstr + return buffer 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/README b/README new file mode 100644 --- /dev/null +++ b/README @@ -0,0 +1,1 @@ +This is a thin haskell wrapper around the CMPH library, obtainable at http://cmph.sf.net. diff --git a/Setup.hs b/Setup.hs new file mode 100644 --- /dev/null +++ b/Setup.hs @@ -0,0 +1,2 @@ +import Distribution.Simple +main = defaultMain diff --git a/cmph.cabal b/cmph.cabal new file mode 100644 --- /dev/null +++ b/cmph.cabal @@ -0,0 +1,39 @@ +Name: cmph +Version: 0.0.1 +Cabal-Version: >= 1.10 +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 +bug-reports: mailto:mwotton@gmail.com +Synopsis: low level interface to CMPH +Description: a binding to the C-based CMPH library (http://cmph.sf.net). + +library + Exposed-Modules: Data.CMPH + default-language: Haskell2010 + ghc-options: -funbox-strict-fields + c-sources: stub.c + includes: stub.h + extra-libraries: cmph + build-depends: base >=4.5 && <5.2 + , bytestring + , containers + , array + +test-suite cmph-test + default-language: Haskell2010 + type: exitcode-stdio-1.0 + hs-source-dirs: test + main-is: Main.hs + other-modules: Data.CMPHSpec + build-depends: cmph, base, hspec, QuickCheck, containers, bytestring, semigroups, text + extra-libraries: cmph + +source-repository head + type: git + location: http://github.com/mwotton/hscmph.git diff --git a/stub.c b/stub.c new file mode 100644 --- /dev/null +++ b/stub.c @@ -0,0 +1,47 @@ +#include "stub.h" +#include +#include +#include + +/* alas, BDZ is not defined in 0.7, so we need a fallback */ +// #ifdef CMPH_BDZ +// #define CMPH_ALGO CMPH_BDZ +// #else +// +// #define CMPH_ALGO CMPH_BMZ +// #endif + +#define CMPH_ALGO CMPH_CHD + +/* void monkey_debug(char ** v, unsigned int nkeys) { */ +/* for (int i=0; i< nkeys; i++) { */ +/* fprintf(stderr, "monkey %d: %s\n", i, v[i]); */ +/* } */ +/* } */ + +/* unsigned long cmph_search_mark(cmph_t * hash, char * str, unsigned long len) { */ +/* unsigned long i = cmph_search(hash,str,len); */ +/* fprintf(stderr,"search got %lu for %s, length %lu\n", i, str,len); */ +/* return i; */ +/* } */ + +cmph_t * build_hash(char ** vector, unsigned int nkeys) { + // 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_ALGO); + 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\n"); exit(1); } + return hash; +} + +void free_ptrs(unsigned int nkeys, char ** strings) { + for (unsigned int i = 0; i + +unsigned long stub_hash(cmph_t* hash, char * word); +cmph_t * build_hash(char ** vector, unsigned int nkeys); +#endif diff --git a/test/Data/CMPHSpec.hs b/test/Data/CMPHSpec.hs new file mode 100644 --- /dev/null +++ b/test/Data/CMPHSpec.hs @@ -0,0 +1,51 @@ +{-# LANGUAGE OverloadedStrings #-} +module Data.CMPHSpec where + +import Control.Monad (guard) +import qualified Data.ByteString as BS +import qualified Data.ByteString.Char8 as BS8 +import Data.Char +import qualified Data.CMPH as CMPH +import qualified Data.List as DL +import qualified Data.List.NonEmpty as NEL +import Data.Maybe (isNothing) +import Data.Monoid ((<>)) +import Data.Ord (comparing) +import Data.Set (Set) +import qualified Data.Set as Set +import Data.Text (Text) +import Data.Text.Encoding (decodeUtf8) +import Data.Word +import Test.Hspec +import Test.Hspec.QuickCheck (modifyMaxSuccess) +import Test.QuickCheck + +main = hspec spec + +letterGen = arbitrary `suchThat` (\c -> c /= '\NUL') +stringGen = BS8.pack <$> listOf letterGen +stringListGen = listOf stringGen + +unique s = Set.size (Set.fromList s) == length s + +spec = modifyMaxSuccess (const 1000) $ describe "cmph" $ do + it "gives up early if there's a NUL in there" $ do + property + $ forAll (stringListGen `suchThat` (not . null)) $ \strings' -> do + let strings = map (\a -> a <> "\NUL" <> a) strings' + ph <- CMPH.buildHash strings + fmap (const "cmph") ph `shouldSatisfy` isNothing + + it "does not generate dupes if the input contains no nulls " $ do + property +-- $ (const 500) + + $ forAll stringListGen $ \strings -> do + -- print ("strings", strings) + Just ph <- CMPH.buildHash strings + -- print ("builtstrings", strings) + -- we unique them here: it's ok to pass in dupes, but for + -- correctness purposes, it's the uniqued size we care about + results <- mapM (CMPH.hash ph) (Set.toList $ Set.fromList strings) + -- print ("results", DL.sortBy (comparing snd) $ zip strings results) + DL.sort results `shouldSatisfy` unique diff --git a/test/Main.hs b/test/Main.hs new file mode 100644 --- /dev/null +++ b/test/Main.hs @@ -0,0 +1,1 @@ +{-# OPTIONS_GHC -F -pgmF hspec-discover #-}