Rebase on master, make test suite pass once more

haskell-unordered-containers · Oct 1, 2021 · 3a6f2b6 · 3a6f2b6
1 parent 432ac53
commit 3a6f2b6
Show file tree

Hide file tree

Showing 3 changed files with 90 additions and 109 deletions.
diff --git a/src/Data/Hashable/Class.hs b/src/Data/Hashable/Class.hs
@@ -94,8 +94,6 @@ import qualified Data.Sequence as Seq
 import qualified Data.Set as Set
 import qualified Data.Tree as Tree
 
-import qualified Data.Text.Internal.Lazy as TL
-
 #if __GLASGOW_HASKELL__ >= 703
 import Foreign.C (CSize(..))
 #else
@@ -670,13 +668,7 @@ instance Hashable B.ByteString where
                            hashPtrWithSalt p (fromIntegral len) (hashWithSalt salt len)
 
 instance Hashable BL.ByteString where
-    hashWithSalt salt = finalise . BL.foldlChunks step (SP salt 0)
-      where
-        finalise (SP s l) = hashWithSalt s l
-        step (SP s l) bs  = unsafeDupablePerformIO $
-                            B.unsafeUseAsCStringLen bs $ \(p, len) -> do
-                                s' <- hashPtrWithSalt p (fromIntegral len) s
-                                return (SP s' (l + len))
+    hashWithSalt = hashLazyByteStringWithSalt
 
 #if MIN_VERSION_bytestring(0,10,4)
 instance Hashable BSI.ShortByteString where
@@ -690,12 +682,7 @@ instance Hashable T.Text where
         (hashWithSalt salt len)
 
 instance Hashable TL.Text where
-    hashWithSalt salt = finalise . TL.foldlChunks step (SP salt 0)
-      where
-        finalise (SP s l) = hashWithSalt s l
-        step (SP s l) (T.Text arr off len) = SP
-            (hashByteArrayWithSalt (TA.aBA arr) (off `shiftL` 1) (len `shiftL` 1) s)
-            (l + len)
+    hashWithSalt = hashLazyTextWithSalt
 
 -- | Compute the hash of a ThreadId.
 hashThreadId :: ThreadId -> Int
@@ -781,20 +768,6 @@ hashPtr :: Ptr a      -- ^ pointer to the data to hash
         -> IO Int     -- ^ hash value
 hashPtr p len = hashPtrWithSalt p len defaultSalt
 
--- | Compute a hash value for the content of this pointer, using an
--- initial salt.
---
--- This function can for example be used to hash non-contiguous
--- segments of memory as if they were one contiguous segment, by using
--- the output of one hash as the salt for the next.
-hashPtrWithSalt :: Ptr a   -- ^ pointer to the data to hash
-                -> Int     -- ^ length, in bytes
-                -> Int     -- ^ salt
-                -> IO Int  -- ^ hash value
-hashPtrWithSalt p len salt =
-    fromIntegral `fmap` c_siphash24 k0 (fromSalt salt) (castPtr p)
-                        (fromIntegral len)
-
 -- | Compute a hash value for the content of this 'ByteArray#',
 -- beginning at the specified offset, using specified number of bytes.
 hashByteArray :: ByteArray#  -- ^ data to hash
@@ -804,37 +777,6 @@ hashByteArray :: ByteArray#  -- ^ data to hash
 hashByteArray ba0 off len = hashByteArrayWithSalt ba0 off len defaultSalt
 {-# INLINE hashByteArray #-}
 
--- | Compute a hash value for the content of this 'ByteArray#', using
--- an initial salt.
---
--- This function can for example be used to hash non-contiguous
--- segments of memory as if they were one contiguous segment, by using
--- the output of one hash as the salt for the next.
-hashByteArrayWithSalt
-    :: ByteArray#  -- ^ data to hash
-    -> Int         -- ^ offset, in bytes
-    -> Int         -- ^ length, in bytes
-    -> Int         -- ^ salt
-    -> Int         -- ^ hash value
-hashByteArrayWithSalt ba !off !len !h =
-    fromIntegral $
-    c_siphash24_offset k0 (fromSalt h) ba (fromIntegral off) (fromIntegral len)
-
-k0 :: Word64
-k0 = 0x56e2b8a0aee1721a
-{-# INLINE k0 #-}
-
-fromSalt :: Int -> Word64
-#if WORD_SIZE_IN_BITS == 64
-fromSalt = fromIntegral
-#else
-fromSalt v = fromIntegral v `xor` k1
-
-k1 :: Word64
-k1 = 0x7654954208bdfef9
-{-# INLINE k1 #-}
-#endif
-
 -- | Combine two given hash values.  'combine' has zero as a left
 -- identity.
 combine :: Int -> Int -> Int
@@ -1078,8 +1020,6 @@ instance Hashable IntSet.IntSet where
 instance Hashable1 Seq.Seq where
     liftHashWithSalt h s x = F.foldl' h (hashWithSalt s (Seq.length x)) x
 
-foreign import ccall unsafe "hashable_siphash24_offset" c_siphash24_offset
-    :: Word64 -> Word64 -> ByteArray# -> CSize -> CSize -> Word64
 
 -- | @since 1.3.4.0
 instance Hashable v => Hashable (Seq.Seq v) where
@@ -1092,44 +1032,3 @@ instance Hashable1 Tree.Tree where
 -- | @since 1.3.4.0
 instance Hashable v => Hashable (Tree.Tree v) where
     hashWithSalt = hashWithSalt1
-foreign import ccall unsafe "hashable_siphash24" c_siphash24
-    :: Word64 -> Word64 -> Ptr Word8 -> CSize -> IO Word64
-<<<<<<< variant A
->>>>>>> variant B
-
-hashLazyByteStringWithSalt :: Int -> BL.ByteString -> Int
-hashLazyByteStringWithSalt salt cs0 = unsafePerformIO . allocaArray 5 $ \v -> do
-  c_siphash_init k0 (fromSalt salt) v
-  let go !buffered !totallen (BL.Chunk c cs) =
-        B.unsafeUseAsCStringLen c $ \(ptr, len) -> do
-          let len' = fromIntegral len
-          buffered' <- c_siphash24_chunk buffered v (castPtr ptr) len' (-1)
-          go buffered' (totallen + len') cs
-      go buffered totallen _ = do
-        _ <- c_siphash24_chunk buffered v nullPtr 0 totallen
-        fromIntegral `fmap` peek (v `advancePtr` 4)
-  go 0 0 cs0
-
-foreign import ccall unsafe "hashable_siphash24_chunk" c_siphash24_chunk
-    :: CInt -> Ptr Word64 -> Ptr Word8 -> CSize -> CSize -> IO CInt
-
-foreign import ccall unsafe "hashable_siphash_init" c_siphash_init
-    :: Word64 -> Word64 -> Ptr Word64 -> IO ()
-
-hashLazyTextWithSalt :: Int -> TL.Text -> Int
-hashLazyTextWithSalt salt cs0 = unsafePerformIO . allocaArray 5 $ \v -> do
-  c_siphash_init k0 (fromSalt salt) v
-  let go !buffered !totallen (TL.Chunk (T.Text arr off len) cs) = do
-        let len' = fromIntegral (len `shiftL` 1)
-        buffered' <- c_siphash24_chunk_offset buffered v (TA.aBA arr)
-                     (fromIntegral (off `shiftL` 1)) len' (-1)
-        go buffered' (totallen + len') cs
-      go buffered totallen _ = do
-        _ <- c_siphash24_chunk buffered v nullPtr 0 totallen
-        fromIntegral `fmap` peek (v `advancePtr` 4)
-  go 0 0 cs0
-
-foreign import ccall unsafe "hashable_siphash24_chunk_offset"
-        c_siphash24_chunk_offset
-    :: CInt -> Ptr Word64 -> ByteArray# -> CSize -> CSize -> CSize -> IO CInt
-======= end
diff --git a/src/Data/Hashable/LowLevel.hs b/src/Data/Hashable/LowLevel.hs
@@ -9,16 +9,35 @@ module Data.Hashable.LowLevel (
     hashWord64,
     hashPtrWithSalt,
     hashByteArrayWithSalt,
+    hashLazyTextWithSalt,
+    hashLazyByteStringWithSalt
 ) where
 
 #include "MachDeps.h"
 
 import Data.Bits (xor)
 import Data.Int (Int64)
-import Data.Word (Word64)
+import Data.Word (Word64, Word8)
 import Foreign.C (CString)
 import Foreign.Ptr (Ptr, castPtr)
 import GHC.Base (ByteArray#)
+import Foreign.C.Types (CInt(..))
+import qualified Data.Text.Array as TA
+import qualified Data.Text.Internal as T
+import qualified Data.Text as T
+import qualified Data.Text.Lazy as TL
+import qualified Data.Text.Internal.Lazy as TL
+import qualified Data.ByteString as B
+import qualified Data.ByteString.Unsafe as B
+import qualified Data.ByteString.Lazy as BL
+import Foreign.Marshal.Array(advancePtr, allocaArray)
+import System.IO.Unsafe(unsafePerformIO)
+import Foreign.Storable (alignment, peek, sizeOf)
+import Foreign.Ptr(nullPtr)
+import Data.Bits (shiftL, shiftR, xor)
+#if (MIN_VERSION_bytestring(0,10,0))
+import qualified Data.ByteString.Lazy.Internal as BL  -- foldlChunks
+#endif
 
 #ifdef HASHABLE_RANDOM_SEED
 import System.IO.Unsafe (unsafePerformIO)
@@ -27,6 +46,11 @@ import System.IO.Unsafe (unsafePerformIO)
 #if WORD_SIZE_IN_BITS != 64
 import Data.Bits (shiftR)
 #endif
+#if __GLASGOW_HASKELL__ >= 703
+import Foreign.C (CSize(..))
+#else
+import Foreign.C (CSize)
+#endif
 
 -------------------------------------------------------------------------------
 -- Initial seed
@@ -96,8 +120,8 @@ hashPtrWithSalt :: Ptr a   -- ^ pointer to the data to hash
                 -> Salt    -- ^ salt
                 -> IO Salt -- ^ hash value
 hashPtrWithSalt p len salt =
-    fromIntegral `fmap` c_hashCString (castPtr p) (fromIntegral len)
-    (fromIntegral salt)
+    fromIntegral `fmap` c_siphash24 k0 (fromSalt salt) (castPtr p)
+                        (fromIntegral len)
 
 -- | Compute a hash value for the content of this 'ByteArray#', using
 -- an initial salt.
@@ -112,8 +136,23 @@ hashByteArrayWithSalt
     -> Salt        -- ^ salt
     -> Salt        -- ^ hash value
 hashByteArrayWithSalt ba !off !len !h =
-    fromIntegral $ c_hashByteArray ba (fromIntegral off) (fromIntegral len)
-    (fromIntegral h)
+    fromIntegral $
+    c_siphash24_offset k0 (fromSalt h) ba (fromIntegral off) (fromIntegral len)
+
+k0 :: Word64
+k0 = 0x56e2b8a0aee1721a
+{-# INLINE k0 #-}
+
+fromSalt :: Int -> Word64
+#if WORD_SIZE_IN_BITS == 64
+fromSalt = fromIntegral
+#else
+fromSalt v = fromIntegral v `xor` k1
+
+k1 :: Word64
+k1 = 0x7654954208bdfef9
+{-# INLINE k1 #-}
+#endif
 
 foreign import capi unsafe "HsHashable.h hashable_fnv_hash" c_hashCString
 #if WORD_SIZE_IN_BITS == 64
@@ -132,3 +171,46 @@ foreign import ccall unsafe "hashable_fnv_hash_offset" c_hashByteArray
 #else
     :: ByteArray# -> Int32 -> Int32 -> Int32 -> Word32
 #endif
+
+foreign import ccall unsafe "hashable_siphash24_offset" c_siphash24_offset
+    :: Word64 -> Word64 -> ByteArray# -> CSize -> CSize -> Word64
+
+foreign import ccall unsafe "hashable_siphash24" c_siphash24
+    :: Word64 -> Word64 -> Ptr Word8 -> CSize -> IO Word64
+
+
+hashLazyByteStringWithSalt :: Int -> BL.ByteString -> Int
+hashLazyByteStringWithSalt salt cs0 = unsafePerformIO . allocaArray 5 $ \v -> do
+  c_siphash_init k0 (fromSalt salt) v
+  let go !buffered !totallen (BL.Chunk c cs) =
+        B.unsafeUseAsCStringLen c $ \(ptr, len) -> do
+          let len' = fromIntegral len
+          buffered' <- c_siphash24_chunk buffered v (castPtr ptr) len' (-1)
+          go buffered' (totallen + len') cs
+      go buffered totallen _ = do
+        _ <- c_siphash24_chunk buffered v nullPtr 0 totallen
+        fromIntegral `fmap` peek (v `advancePtr` 4)
+  go 0 0 cs0
+
+foreign import ccall unsafe "hashable_siphash24_chunk" c_siphash24_chunk
+    :: CInt -> Ptr Word64 -> Ptr Word8 -> CSize -> CSize -> IO CInt
+
+foreign import ccall unsafe "hashable_siphash_init" c_siphash_init
+    :: Word64 -> Word64 -> Ptr Word64 -> IO ()
+
+hashLazyTextWithSalt :: Int -> TL.Text -> Int
+hashLazyTextWithSalt salt cs0 = unsafePerformIO . allocaArray 5 $ \v -> do
+  c_siphash_init k0 (fromSalt salt) v
+  let go !buffered !totallen (TL.Chunk (T.Text arr off len) cs) = do
+        let len' = fromIntegral (len `shiftL` 1)
+        buffered' <- c_siphash24_chunk_offset buffered v (TA.aBA arr)
+                     (fromIntegral (off `shiftL` 1)) len' (-1)
+        go buffered' (totallen + len') cs
+      go buffered totallen _ = do
+        _ <- c_siphash24_chunk buffered v nullPtr 0 totallen
+        fromIntegral `fmap` peek (v `advancePtr` 4)
+  go 0 0 cs0
+
+foreign import ccall unsafe "hashable_siphash24_chunk_offset"
+        c_siphash24_chunk_offset
+    :: CInt -> Ptr Word64 -> ByteArray# -> CSize -> CSize -> CSize -> IO CInt
diff --git a/tests/Regress.hs b/tests/Regress.hs
@@ -49,7 +49,7 @@ regressions = [] ++
 #if WORD_SIZE_IN_BITS == 64
     , testCase "64 bit Text" $ do
         hash ("hello world" :: Text) @=?
-          2930784640930823038 -- siphash
+          (-4389506060771033211) -- siphash
           -- -3875242662334356092 -- FNV
 #endif
     , F.testGroup "concatenation"