Merge pull request #213 from haskell-unordered-containers/no-long

No long in C-FFI

CHANGES.md

@@ -1,5 +1,11 @@
 See also https://pvp.haskell.org/faq
 
+## Version 1.3.3.0
+
+ * `Text` hashing uses 64-bit FNV prime
+ * Don't truncate Text hashvalues on 64bit Windows:
+   https://github.com/haskell-unordered-containers/hashable/pull/211
+
 ## Version 1.3.2.0
 
  * Add `Hashable (Fixed a)` for `base <4.7` versions.

cbits/fnv.c

@@ -31,24 +31,18 @@ THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT
 OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
 */
 
-#include "MachDeps.h"
-
-#if WORD_SIZE_IN_BITS == 64
-#define FNV_PRIME 1099511628211
-#else
-#define FNV_PRIME 16777619
-#endif
+#include "HsHashable.h"
 
 /* FNV-1 hash
  *
  * The FNV-1 hash description: http://isthe.com/chongo/tech/comp/fnv/
  * The FNV-1 hash is public domain: http://isthe.com/chongo/tech/comp/fnv/#public_domain
  */
-long hashable_fnv_hash(const unsigned char* str, long len, long salt) {
+FNV_UNSIGNED hashable_fnv_hash(const unsigned char* str, FNV_SIGNED len, FNV_UNSIGNED salt) {
 
-  unsigned long hash = salt;
+  FNV_UNSIGNED hash = salt;
   while (len--) {
-    hash = (hash * 16777619) ^ *str++;
+    hash = (hash * FNV_PRIME) ^ *str++;
   }
 
   return hash;
@@ -57,6 +51,6 @@ long hashable_fnv_hash(const unsigned char* str, long len, long salt) {
 /* Used for ByteArray#s. We can't treat them like pointers in
    native Haskell, but we can in unsafe FFI calls.
  */
-long hashable_fnv_hash_offset(const unsigned char* str, long offset, long len, long salt) {
+FNV_UNSIGNED hashable_fnv_hash_offset(const unsigned char* str, FNV_SIGNED offset, FNV_SIGNED len, FNV_UNSIGNED salt) {
   return hashable_fnv_hash(str + offset, len, salt);
 }

hashable-bench/hashable-bench.cabal

@@ -32,7 +32,9 @@ tested-with:
    || ==8.10.4
    || ==9.0.1
 
-extra-source-files: benchmarks/cbits/*.h
+extra-source-files:
+  benchmarks/cbits/*.h
+  include/HsHashable.h
 
 flag integer-gmp
   description:
@@ -61,6 +63,7 @@ library
     Data.Hashable.Generic.Instances
 
   c-sources:        cbits/fnv.c
+  include-dirs:     include
   hs-source-dirs:   src
   build-depends:
       base        >=4.5  && <4.16
@@ -113,12 +116,12 @@ benchmark hashable-benchmark
     , siphash
     , text
 
-  if impl(ghc -any)
+  if impl(ghc)
     build-depends:
         ghc-prim
       , text      >=0.11.0.5
 
-  if (impl(ghc -any) && flag(integer-gmp))
+  if (impl(ghc) && flag(integer-gmp))
     build-depends: integer-gmp >=0.2
 
   if impl(ghc >=7.2.1)

hashable-bench/include

@@ -0,0 +1 @@
+../include

hashable.cabal

@@ -1,7 +1,6 @@
 cabal-version:      1.12
 name:               hashable
-version:            1.3.2.0
-x-revision:         1
+version:            1.3.3.0
 synopsis:           A class for types that can be converted to a hash value
 description:
   This package defines a class, 'Hashable', for types that
@@ -43,6 +42,7 @@ tested-with:
 extra-source-files:
   CHANGES.md
   README.md
+  include/HsHashable.h
 
 flag integer-gmp
   description:
@@ -71,6 +71,7 @@ library
     Data.Hashable.Generic.Instances
 
   c-sources:        cbits/fnv.c
+  include-dirs:     include
   hs-source-dirs:   src
   build-depends:
       base        >=4.5  && <4.17

include/HsHashable.h

@@ -0,0 +1,22 @@
+#ifndef HS_HASHABLE_H
+#define HS_HASHABLE_H
+
+#include "MachDeps.h"
+#include <stdint.h>
+
+#if WORD_SIZE_IN_BITS == 64
+#define FNV_PRIME 1099511628211
+#define FNV_SIGNED int64_t
+#define FNV_UNSIGNED uint64_t
+#else
+#define FNV_PRIME 16777619
+#define FNV_SIGNED int32_t
+#define FNV_UNSIGNED uint32_t
+#endif
+
+uint64_t hs_hashable_init();
+
+FNV_UNSIGNED hashable_fnv_hash(const unsigned char* str, FNV_SIGNED len, FNV_UNSIGNED salt);
+FNV_UNSIGNED hashable_fnv_hash_offset(const unsigned char* str, FNV_SIGNED offset, FNV_SIGNED len, FNV_UNSIGNED salt);
+
+#endif

src/Data/Hashable/Class.hs

@@ -1,7 +1,7 @@
 {-# LANGUAGE BangPatterns, CPP, MagicHash,
              ScopedTypeVariables, UnliftedFFITypes, DeriveDataTypeable,
              DefaultSignatures, FlexibleContexts, TypeFamilies,
-             MultiParamTypeClasses #-}
+             MultiParamTypeClasses, CApiFFI #-}
 
 {-# LANGUAGE Trustworthy #-}
 
@@ -121,13 +121,7 @@ import Data.Typeable.Internal (Typeable, TypeRep (..))
 import GHC.Fingerprint.Type(Fingerprint(..))
 #endif
 
-#if MIN_VERSION_base(4,5,0)
-import Foreign.C (CLong(..))
 import Foreign.C.Types (CInt(..))
-#else
-import Foreign.C (CLong)
-import Foreign.C.Types (CInt)
-#endif
 
 #if !(MIN_VERSION_base(4,8,0))
 import Data.Word (Word)
@@ -210,7 +204,7 @@ initialSeed :: Word64
 initialSeed = unsafePerformIO initialSeedC
 {-# NOINLINE initialSeed #-}
 
-foreign import ccall "hs_hashable_init" initialSeedC :: IO Word64
+foreign import capi "HsHashable.h hs_hashable_init" initialSeedC :: IO Word64
 #endif
 
 -- | A default salt used in the implementation of 'hash'.
@@ -723,6 +717,7 @@ instance Hashable TL.Text where
 hashThreadId :: ThreadId -> Int
 hashThreadId (ThreadId t) = hash (fromIntegral (getThreadId t) :: Int)
 
+-- this cannot be capi, as GHC panics.
 foreign import ccall unsafe "rts_getThreadId" getThreadId
     :: ThreadId# -> CInt
 
@@ -816,8 +811,12 @@ hashPtrWithSalt p len salt =
     fromIntegral `fmap` c_hashCString (castPtr p) (fromIntegral len)
     (fromIntegral salt)
 
-foreign import ccall unsafe "hashable_fnv_hash" c_hashCString
-    :: CString -> CLong -> CLong -> IO CLong
+foreign import capi unsafe "HsHashable.h hashable_fnv_hash" c_hashCString
+#if WORD_SIZE_IN_BITS == 64
+    :: CString -> Int64 -> Int64 -> IO Word64
+#else
+    :: CString -> Int32 -> Int32 -> IO Word32
+#endif
 
 -- | Compute a hash value for the content of this 'ByteArray#',
 -- beginning at the specified offset, using specified number of bytes.
@@ -844,8 +843,16 @@ hashByteArrayWithSalt ba !off !len !h =
     fromIntegral $ c_hashByteArray ba (fromIntegral off) (fromIntegral len)
     (fromIntegral h)
 
+#if __GLASGOW_HASKELL__ >= 802
+foreign import capi unsafe "HsHashable.h hashable_fnv_hash_offset" c_hashByteArray
+#else
 foreign import ccall unsafe "hashable_fnv_hash_offset" c_hashByteArray
-    :: ByteArray# -> CLong -> CLong -> CLong -> CLong
+#endif
+#if WORD_SIZE_IN_BITS == 64
+    :: ByteArray# -> Int64 -> Int64 -> Int64 -> Word64
+#else
+    :: ByteArray# -> Int32 -> Int32 -> Int32 -> Word32
+#endif
 
 -- | Combine two given hash values.  'combine' has zero as a left
 -- identity.

tests/Regress.hs

@@ -1,5 +1,6 @@
 {-# LANGUAGE CPP #-}
 {-# LANGUAGE DeriveGeneric #-}
+{-# LANGUAGE OverloadedStrings #-}
 
 module Regress (regressions) where
 
@@ -9,13 +10,16 @@ import Test.HUnit ((@=?))
 import GHC.Generics (Generic)
 import Data.List (nub)
 import Data.Fixed (Pico)
+import Data.Text (Text)
 
 #ifdef HAVE_MMAP
 import qualified Regress.Mmap as Mmap
 #endif
 
 import Data.Hashable
 
+#include "MachDeps.h"
+
 regressions :: [F.Test]
 regressions = [] ++
 #ifdef HAVE_MMAP
@@ -35,6 +39,10 @@ regressions = [] ++
         let ns = take 20 $ iterate S Z
         let hs = map hash ns
         hs @=? nub hs
+#if WORD_SIZE_IN_BITS == 64
+    , testCase "64 bit Text" $ do
+        hash ("hello world" :: Text) @=? 2668910425102664189
+#endif
     ]
   where
     nullaryCase :: Int -> SumOfNullary -> IO ()