Use memcpy over byte-byte comparision in RingArray

Author: adithyaov

core/src/Streamly/Internal/Data/MutArray/Lib.c

@@ -13,3 +13,8 @@ size_t memchr_index(const void *dst, size_t off, int c, size_t len) {
         return len;
     }
 }
+
+int memcmp_index(const void *p1, size_t p1_off, const void *p2, size_t p2_off, size_t len) {
+    int cmp = memcmp((char *)p1 + p1_off, (char *)p2 + p2_off, len);
+    return cmp;
+}

core/src/Streamly/Internal/Data/MutArray/Type.hs

@@ -295,6 +295,9 @@ module Streamly.Internal.Data.MutArray.Type
     , isPower2
     , roundUpToPower2
 
+    -- * Foreign APIs
+    , c_memcmp_index
+
     -- * Deprecated
     , realloc
     , createOfWith
@@ -368,7 +371,7 @@ import Data.Char (ord)
 import Data.Functor.Identity (Identity(..))
 import Data.Proxy (Proxy(..))
 import Data.Word (Word8, Word16)
-import Foreign.C.Types (CSize(..))
+import Foreign.C.Types (CSize(..), CInt(..))
 import Foreign.Ptr (plusPtr)
 import Streamly.Internal.Data.MutByteArray.Type
     ( MutByteArray(..)
@@ -427,6 +430,11 @@ foreign import ccall unsafe "memchr_index" c_memchr_index
 foreign import ccall unsafe "string.h strlen" c_strlen
     :: Ptr Word8 -> IO CSize
 
+foreign import ccall unsafe "memcmp_index" c_memcmp_index
+    :: MutableByteArray# RealWorld -> CSize
+    -> MutableByteArray# RealWorld -> CSize
+    -> CSize -> IO CInt
+
 -- | Given an 'Unboxed' type (unused first arg) and a number of bytes, return
 -- how many elements of that type will completely fit in those bytes.
 --

core/src/Streamly/Internal/Data/RingArray.hs

@@ -639,31 +639,24 @@ cast ring =
 eqArrayN :: RingArray a -> Array a -> Int -> IO Bool
 eqArrayN RingArray{..} Array.Array{..} nBytes
     | nBytes < 0 = error "eqArrayN: n should be >= 0"
-    | arrLen < nBytes = error "eqArrayN: array is shorter than n"
+    | arrEnd - arrStart < nBytes = error "eqArrayN: array is shorter than n"
     | ringSize < nBytes = error "eqArrayN: ring is shorter than n"
     | nBytes == 0 = return True
-    | otherwise = check ringHead 0
-
+    | nBytesC <= p1Len = do
+          part1 <- MutArray.c_memcmp_index arr# 0 ring# p1Off nBytesC
+          pure $ part1 == 0
+    | otherwise = do
+          part1 <- MutArray.c_memcmp_index arr# 0 ring# p1Off p1Len
+          part2 <- MutArray.c_memcmp_index arr# p1Len ring# p2Off p2Len
+          pure $ part1 == 0 && part2 == 0
     where
-
-    arrLen = arrEnd - arrStart
-
-    -- XXX compare Word64 at a time
-    check ringIndex arrayIndex = do
-        (relem :: Word8) <- peekAt ringIndex ringContents
-        aelem <- peekAt arrayIndex arrContents
-        if relem == aelem
-        then go (ringIndex + 1) (arrayIndex + 1)
-        else return False
-
-    go ringIndex arrayIndex
-        -- Checking ringIndex == rh is enough
-        --  | arrayIndex == nBytes = return True
-        | ringIndex == ringSize = go 0 arrayIndex
-        | ringIndex == ringHead = return True
-        | otherwise = check ringIndex arrayIndex
-
--- XXX We can use memcmp over two segments.
+    nBytesC = fromIntegral nBytes
+    arr# = MutByteArray.getMutByteArray# arrContents
+    ring# = MutByteArray.getMutByteArray# ringContents
+    p1Off = fromIntegral ringHead
+    p1Len = fromIntegral $ ringSize - ringHead
+    p2Off = 0
+    p2Len = nBytesC - p1Len
 
 -- | Byte compare the entire length of ringBuffer with the given array,
 -- starting at the supplied ring head index.  Returns true if the Array and
@@ -674,25 +667,18 @@ eqArrayN RingArray{..} Array.Array{..} nBytes
 {-# INLINE eqArray #-}
 eqArray :: RingArray a -> Array a -> IO Bool
 eqArray RingArray{..} Array.Array{..}
-    | arrLen < ringSize = error "eqArrayN: array is shorter than ring"
-    | otherwise = check ringHead 0
-
+    | arrEnd - arrStart < ringSize = error "eqArrayN: array is shorter than ring"
+    | otherwise = do
+          part1 <- MutArray.c_memcmp_index arr# 0 ring# p1Off p1Len
+          part2 <- MutArray.c_memcmp_index arr# p1Len ring# p2Off p2Len
+          pure $ part1 == 0 && part2 == 0
     where
-
-    arrLen = arrEnd - arrStart
-
-    -- XXX compare Word64 at a time
-    check ringIndex arrayIndex = do
-        (relem :: Word8) <- peekAt ringIndex ringContents
-        aelem <- peekAt arrayIndex arrContents
-        if relem == aelem
-        then go (ringIndex + 1) (arrayIndex + 1)
-        else return False
-
-    go ringIndex arrayIndex
-        | ringIndex == ringSize = go 0 arrayIndex
-        | ringIndex == ringHead = return True
-        | otherwise = check ringIndex arrayIndex
+    arr# = MutByteArray.getMutByteArray# arrContents
+    ring# = MutByteArray.getMutByteArray# ringContents
+    p1Off = fromIntegral ringHead
+    p1Len = fromIntegral $ ringSize - ringHead
+    p2Off = 0
+    p2Len = fromIntegral $ ringHead
 
 -------------------------------------------------------------------------------
 -- Folding

test/Streamly/Test/Data/Array.hs

@@ -20,6 +20,7 @@ import Streamly.Internal.Data.MutByteArray (Unbox, sizeOf)
 import Streamly.Internal.Data.MutArray (MutArray)
 import Test.QuickCheck (chooseInt, listOf)
 import System.Mem (performMajorGC)
+import Streamly.Test.Common (performGCSweep)
 
 import qualified Streamly.Internal.Data.Array as A
 import qualified Streamly.Internal.Data.MutArray as MA
@@ -223,12 +224,6 @@ testUnsafeAsForeignPtr = do
     where
     getIntList1 fp blen = withForeignPtr fp $ \p -> getIntList p blen
 
-performGCSweep :: Int -> Int -> IO ()
-performGCSweep i j = do
-  mapM_ id $ replicate i $ do
-      performMajorGC
-      void $ MA.fromList ([0 .. j] :: [Int])
-
 testForeignPtrConversionId :: IO ()
 testForeignPtrConversionId = do
     arr0 <- MA.unsafeGetSlice 10 50 <$> MA.fromList ([0 .. 99] :: [Word8])

test/Streamly/Test/Data/RingArray.hs

@@ -8,29 +8,34 @@
 
 module Streamly.Test.Data.RingArray (main) where
 
+import Streamly.Test.Common (performGCSweep)
+
 import qualified Streamly.Internal.Data.MutArray as MutArray
 import qualified Streamly.Internal.Data.Array as Array
 import qualified Streamly.Internal.Data.RingArray as RingArray
 
 import Prelude as P
-
 import Test.Hspec as H
 
 eqArrayN :: [Int] -> [Int] -> Int -> Int -> Bool -> IO ()
-eqArrayN lstArr lstRing startR nelem expected = do
+eqArrayN lstArr lstRing startR nBytes expected = do
     let arr = Array.fromList lstArr
     marr <- MutArray.fromList lstRing
     let ring =
             maybe (error "cast failed") id $ RingArray.castMutArrayWith startR marr
-    RingArray.eqArrayN ring arr nelem `shouldReturn` expected
+    performGCSweep 4 100000
+    res <- RingArray.eqArrayN ring arr nBytes
+    res `shouldBe` expected
 
 eqArray :: [Int] -> [Int] -> Int -> Bool -> IO ()
 eqArray lstArr lstRing startR expected = do
     let arr = Array.fromList lstArr
     marr <- MutArray.fromList lstRing
     let ring =
             maybe (error "cast failed") id $ RingArray.castMutArrayWith startR marr
-    RingArray.eqArray ring arr `shouldReturn` expected
+    performGCSweep 4 100000
+    res <- RingArray.eqArray ring arr
+    res `shouldBe` expected
 
 moduleName :: String
 moduleName = "Data.RingArray"

test/lib/Streamly/Test/Common.hs

@@ -13,14 +13,18 @@ module Streamly.Test.Common
     , checkListEqual
     , chooseInt
     , chooseDouble
+    , performGCSweep
     ) where
 
-import Control.Monad (when)
+import Control.Monad (when, void)
 import Control.Monad.IO.Class (MonadIO(..))
 import Data.List ((\\))
+import System.Mem (performMajorGC)
 import Test.QuickCheck (Property, Gen, choose, counterexample)
 import Test.QuickCheck.Monadic (PropertyM, assert, monitor, monadicIO)
 
+import qualified Streamly.Internal.Data.MutArray as MA
+
 equals
     :: (Show a, Monad m)
     => (a -> a -> Bool) -> a -> a -> PropertyM m ()
@@ -64,3 +68,10 @@ chooseInt = choose
 
 chooseDouble :: (Double, Double) -> Gen Double
 chooseDouble = choose
+
+-- XXX Move this to Streamly.Test.Array.Common?
+performGCSweep :: Int -> Int -> IO ()
+performGCSweep i j = do
+  mapM_ id $ replicate i $ do
+      performMajorGC
+      void $ MA.fromList ([0 .. j] :: [Int])