packages feed

xxhash-ffi 0.1.0.1 → 0.2.0.0

raw patch · 3 files changed

+168/−130 lines, 3 files

Files

src/Data/Digest/XXHash/FFI.hs view
@@ -1,10 +1,12 @@-{-# LANGUAGE ForeignFunctionInterface #-}+{-# LANGUAGE MagicHash     #-}+{-# LANGUAGE UnboxedTuples #-} -- |--- Module:     Data.Digest.XXHash.FFI--- Copyright:  (c) 2017 Henri Verroken--- Licence:    BSD3--- Maintainer: Henri Verroken <henriverroken@gmail.com--- Stability:  stable+-- Module:      Data.Digest.XXHash.FFI+-- Copyright:   (c) 2017 Henri Verroken+-- Licence:     BSD3+-- Maintainer:  Henri Verroken <henriverroken@gmail.com+-- Stability:   stable+-- Portability: GHC -- -- This module provides bindings to the xxHash64 and the xxHash32 algorithm. --@@ -12,112 +14,27 @@ module Data.Digest.XXHash.FFI (   -- * Interface   XXHash(..)--  -- * C Interface-  -- ** Direct Calculation-, c_xxh64-, c_xxh32--  -- ** 32-bit state functions-, XXH32State-, c_xxh32_createState-, c_xxh32_freeState-, c_xxh32_copyState-, c_xxh32_reset-, c_xxh32_update-, c_xxh32_digest--  -- ** 64-bit state functions-, XXH64State-, c_xxh64_createState-, c_xxh64_freeState-, c_xxh64_copyState-, c_xxh64_reset-, c_xxh64_update-, c_xxh64_digest ) where -import Control.Exception (bracket)+import Data.Digest.XXHash.FFI.C -import Data.ByteString.Unsafe (unsafeUseAsCString)+import Data.ByteString.Unsafe (unsafeUseAsCStringLen) import Data.Word (Word32, Word64) import qualified Data.ByteString as BS import qualified Data.ByteString.Lazy as BL  import Foreign.C-import Foreign.Ptr-+import GHC.Exts         (realWorld#)+import GHC.IO           (IO(IO)) import System.IO.Unsafe (unsafePerformIO) -foreign import ccall unsafe "XXH64" c_xxh64 ::-    Ptr a   -- ^ 'Ptr' to the input buffer- -> CSize   -- ^ Buffer length- -> CULLong -- ^ Seed- -> CULLong -- ^ Resulting hash--foreign import ccall unsafe "XXH32" c_xxh32 ::-    Ptr a -- ^ 'Ptr' to the input buffer- -> CSize -- ^ Buffer length- -> CUInt -- ^ Seed- -> CUInt -- ^ Resulting hash--data XXH32State--foreign import ccall unsafe "XXH32_createState" c_xxh32_createState ::-    IO (Ptr XXH32State) -- ^ Pointer to a newly allocated state--foreign import ccall unsafe "XXH32_freeState" c_xxh32_freeState ::-    Ptr XXH32State- -> IO () -- ^ Free pointer allocated by 'c_xxh32_createState'--foreign import ccall unsafe "XXH32_copyState" c_xxh32_copyState ::-    Ptr XXH32State -- ^ Destination- -> Ptr XXH32State -- ^ Source- -> IO ()--foreign import ccall unsafe "XXH32_reset" c_xxh32_reset ::-    Ptr XXH32State -- ^ The state to reset- -> CUInt          -- ^ The initial seed- -> IO ()--foreign import ccall unsafe "XXH32_update" c_xxh32_update ::-    Ptr XXH32State -- ^ The state to update- -> Ptr a          -- ^ 'Ptr' to the input buffer- -> CSize          -- ^ Buffer length- -> IO ()--foreign import ccall unsafe "XXH32_digest" c_xxh32_digest ::-    Ptr XXH32State -- ^ The state to digest- -> IO CUInt       -- ^ Resulting hash--data XXH64State--foreign import ccall unsafe "XXH64_createState" c_xxh64_createState ::-    IO (Ptr XXH64State) -- ^ Pointer to a newly allocated state--foreign import ccall unsafe "XXH64_freeState" c_xxh64_freeState ::-    Ptr XXH64State- -> IO () -- ^ Free pointer allocated by 'c_xxh64_createState'--foreign import ccall unsafe "XXH64_copyState" c_xxh64_copyState ::-    Ptr XXH64State -- ^ Destination- -> Ptr XXH64State -- ^ Source- -> IO ()--foreign import ccall unsafe "XXH64_reset" c_xxh64_reset ::-    Ptr XXH64State -- ^ The state to reset- -> CULLong        -- ^ The initial seed- -> IO ()--foreign import ccall unsafe "XXH64_update" c_xxh64_update ::-    Ptr XXH64State -- ^ The state to update- -> Ptr a          -- ^ 'Ptr' to the input buffer- -> CSize          -- ^ Buffer length- -> IO ()+{-# INLINE inlinePerformIO #-}+inlinePerformIO :: IO a -> a+inlinePerformIO (IO m) = case m realWorld# of (# _, r #) -> r -foreign import ccall unsafe "XXH64_digest" c_xxh64_digest ::-    Ptr XXH64State -- ^ The state to digest- -> IO CULLong     -- ^ Resulting hash+{-# INLINE use #-}+use :: BS.ByteString -> (CString -> CSize -> IO a) -> IO a+use bs k = unsafeUseAsCStringLen bs $ \(ptr,len) -> k ptr (fromIntegral len)  -- | Class for hashable data types. --@@ -136,45 +53,31 @@   instance XXHash BS.ByteString where-    xxh32 bs seed = unsafePerformIO $-        unsafeUseAsCString bs $ \ptr ->-            return . fromIntegral $ c_xxh32 (castPtr ptr) len (fromIntegral seed)-      where-        len = fromIntegral $ BS.length bs+    xxh32 bs seed = fromIntegral . inlinePerformIO . use bs $+        \ptr len -> c_xxh32 ptr len (fromIntegral seed) -    xxh64 bs seed = unsafePerformIO $-        unsafeUseAsCString bs $ \ptr ->-            return . fromIntegral $ c_xxh64 (castPtr ptr) len (fromIntegral seed)-      where-        len = fromIntegral $ BS.length bs+    xxh64 bs seed = fromIntegral . inlinePerformIO . use bs $+        \ptr len -> c_xxh64 ptr len (fromIntegral seed)  {-# SPECIALIZE xxh32 :: BS.ByteString -> Word32 -> Word32 #-} {-# SPECIALIZE xxh64 :: BS.ByteString -> Word64 -> Word64 #-}  instance XXHash BL.ByteString where     xxh32 bs seed = fromIntegral . unsafePerformIO $-        bracket c_xxh32_createState-                c_xxh32_freeState $ \state -> do-                    c_xxh32_reset state (fromIntegral seed)-                    mapM_ (update state) (BL.toChunks bs)-                    c_xxh32_digest state+        allocaXXH32State $ \state -> do+            c_xxh32_reset state (fromIntegral seed)+            mapM_ (update state) (BL.toChunks bs)+            c_xxh32_digest state       where-        update state bs' =-            let len = fromIntegral (BS.length bs') in-            unsafeUseAsCString bs' $ \ ptr ->-                c_xxh32_update state ptr len+        update state bs' = use bs' $ c_xxh32_update state      xxh64 bs seed = fromIntegral . unsafePerformIO $-        bracket c_xxh64_createState-                c_xxh64_freeState $ \state -> do-                    c_xxh64_reset state (fromIntegral seed)-                    mapM_ (update state) (BL.toChunks bs)-                    c_xxh64_digest state+        allocaXXH64State $ \state -> do+            c_xxh64_reset state (fromIntegral seed)+            mapM_ (update state) (BL.toChunks bs)+            c_xxh64_digest state       where-        update state bs' =-            let len = fromIntegral (BS.length bs') in-            unsafeUseAsCString bs' $ \ ptr ->-                c_xxh64_update state ptr len+        update state bs' = use bs' $ c_xxh64_update state  {-# SPECIALIZE xxh32 :: BL.ByteString -> Word32 -> Word32 #-} {-# SPECIALIZE xxh64 :: BL.ByteString -> Word64 -> Word64 #-}
+ src/Data/Digest/XXHash/FFI/C.hsc view
@@ -0,0 +1,134 @@+{-# LANGUAGE ForeignFunctionInterface #-}+{-# LANGUAGE MagicHash                #-}+{-# LANGUAGE UnboxedTuples            #-}+{-# LANGUAGE UnliftedFFITypes         #-}+-- |+-- Module:      Data.Digest.XXHash.FFI.C+-- Copyright:   (c) 2017 Henri Verroken+-- Licence:     BSD3+-- Maintainer:  Henri Verroken <henriverroken@gmail.com+-- Stability:   stable+-- Portability: GHC+--+-- This module provides FFI imports to the C reference library at+-- <https://github.com/Cyan4973/xxHash>.+--+-- This binding keeps the intermediate state for stream processing in an+-- 'MutableByteArray#' on the managed GHC heap. All foreign imports use unsafe+-- call semantics. Therefore, it is possible to use either unpinned or pinned+-- 'MutableByteArray#' since GHC's garbage collector doesn't move the either+-- kind during an unsafe foreign call. However GHCi <8.4 may replace unsafe+-- foreign calls with safe foreign calls in the bytecode+-- interpreter. Consequently, unpinned 'MutableByteArray#s' may be moved by the+-- garbage collector during foreign calls which obviously breaks this code. So+-- extra care should be taken when loading this code into the bytecode+-- interpreter.+module Data.Digest.XXHash.FFI.C (+  -- * C Interface+  -- ** Direct Calculation+  c_xxh64+, c_xxh32++  -- ** 32-bit state functions+, XXH32State+, allocaXXH32State+, c_xxh32_copyState+, c_xxh32_reset+, c_xxh32_update+, c_xxh32_digest++  -- ** 64-bit state functions+, XXH64State+, allocaXXH64State+, c_xxh64_copyState+, c_xxh64_reset+, c_xxh64_update+, c_xxh64_digest+) where++-- Define XXH_STATIC_LINKING_ONLY to expose the definition of the state structs.+-- We can then get the size of them and allocate them on the managed GHC heap.+#define XXH_STATIC_LINKING_ONLY+#include "xxhash.h"++import Foreign.C.Types+import Foreign.Ptr       (Ptr)+import GHC.Exts          (Int(..), RealWorld,+                          MutableByteArray##, newByteArray##)+import GHC.IO            (IO(IO))++foreign import ccall unsafe "XXH64" c_xxh64 ::+    Ptr a      -- ^ 'Ptr' to the input buffer+ -> CSize      -- ^ Buffer length+ -> CULLong    -- ^ Seed+ -> IO CULLong -- ^ Resulting hash++foreign import ccall unsafe "XXH32" c_xxh32 ::+    Ptr a      -- ^ 'Ptr' to the input buffer+ -> CSize      -- ^ Buffer length+ -> CUInt      -- ^ Seed+ -> IO CUInt   -- ^ Resulting hash++-- | Intermediate state for computing a XXH32 using segmentation or streams.+type XXH32State = MutableByteArray## RealWorld++foreign import ccall unsafe "XXH32_copyState" c_xxh32_copyState ::+    XXH32State     -- ^ Destination+ -> XXH32State     -- ^ Source+ -> IO ()++foreign import ccall unsafe "XXH32_reset" c_xxh32_reset ::+    XXH32State     -- ^ The state to reset+ -> CUInt          -- ^ The initial seed+ -> IO ()++foreign import ccall unsafe "XXH32_update" c_xxh32_update ::+    XXH32State     -- ^ The state to update+ -> Ptr a          -- ^ 'Ptr' to the input buffer+ -> CSize          -- ^ Buffer length+ -> IO ()++foreign import ccall unsafe "XXH32_digest" c_xxh32_digest ::+    XXH32State     -- ^ The state to digest+ -> IO CUInt       -- ^ Resulting hash++-- | Intermediate state for computing a XXH64 using segmentation or streams.+type XXH64State = MutableByteArray## RealWorld++foreign import ccall unsafe "XXH64_copyState" c_xxh64_copyState ::+    XXH64State     -- ^ Destination+ -> XXH64State     -- ^ Source+ -> IO ()++foreign import ccall unsafe "XXH64_reset" c_xxh64_reset ::+    XXH64State     -- ^ The state to reset+ -> CULLong        -- ^ The initial seed+ -> IO ()++foreign import ccall unsafe "XXH64_update" c_xxh64_update ::+    XXH64State     -- ^ The state to update+ -> Ptr a          -- ^ 'Ptr' to the input buffer+ -> CSize          -- ^ Buffer length+ -> IO ()++foreign import ccall unsafe "XXH64_digest" c_xxh64_digest ::+    XXH64State     -- ^ The state to digest+ -> IO CULLong     -- ^ Resulting hash++{-# INLINE allocaMutableByteArray #-}+allocaMutableByteArray :: Int -> (MutableByteArray## RealWorld -> IO b) -> IO b+allocaMutableByteArray (I## len) f = IO $ \s0 ->+    case newByteArray## len s0 of { (## s1, mba ##) ->+    case f mba                 of { IO m -> m s1 }}++{-# INLINE allocaXXH32State #-}+-- | 'allocaXXH32State f' temporarily allocates a 'XXH32State' and passes it+--   to the function 'f'.+allocaXXH32State :: (XXH32State -> IO a) -> IO a+allocaXXH32State = allocaMutableByteArray #{size XXH32_state_t}++{-# INLINE allocaXXH64State #-}+-- | 'allocaXXH64State f' temporarily allocates a 'XXH64State' and passes it+--   to the function 'f'.+allocaXXH64State :: (XXH64State -> IO a) -> IO a+allocaXXH64State = allocaMutableByteArray #{size XXH64_state_t}
xxhash-ffi.cabal view
@@ -1,5 +1,5 @@ name:                xxhash-ffi-version:             0.1.0.1+version:             0.2.0.0 synopsis:            Bindings to the C implementation the xxHash algorithm description:         Bindings to the C implementation the xxHash algorithm. xxHash provides 32-bit and 64-bit extremely fast non-cryptographic hash functions. homepage:            https://github.com/haskell-haskey/xxhash-ffi#readme@@ -16,6 +16,7 @@ library   hs-source-dirs:      src   exposed-modules:     Data.Digest.XXHash.FFI+                       Data.Digest.XXHash.FFI.C   build-depends:       base >= 4.7 && < 5                      , bytestring   ghc-options:         -Wall