From c591230f6b9026f9764d7392939607a6eb943b65 Mon Sep 17 00:00:00 2001 From: M Farkas-Dyck Date: Fri, 4 May 2018 14:20:28 -0800 Subject: [PATCH 1/2] findIndexEnd --- Changelog.md | 3 ++- Data/ByteString.hs | 28 +++++++++++++++++----------- Data/ByteString/Lazy.hs | 22 +++++++++++++++------- tests/Properties.hs | 23 +++++++++++++++++++++++ 4 files changed, 57 insertions(+), 19 deletions(-) diff --git a/Changelog.md b/Changelog.md index c4cc2f52a..b23b015cd 100644 --- a/Changelog.md +++ b/Changelog.md @@ -1,4 +1,4 @@ -0.10.10.1 May 2020 +0.10.X.X May 2020 * Fix off-by-one infinite loop in primMapByteStringBounded. * Document inadvertent 0.10.6.0 behaviour change in findSubstrings @@ -8,6 +8,7 @@ * Fix benchmark builds * Add GHC 8.10 to the CI matrix * Improve the performance of `sconcat` for lazy and strict bytestrings + * Define `findIndexEnd` 0.10.10.0 July 2019 July 2019 diff --git a/Data/ByteString.hs b/Data/ByteString.hs index 6564e961f..d82b4b7a8 100644 --- a/Data/ByteString.hs +++ b/Data/ByteString.hs @@ -157,6 +157,7 @@ module Data.ByteString ( elemIndexEnd, -- :: Word8 -> ByteString -> Maybe Int findIndex, -- :: (Word8 -> Bool) -> ByteString -> Maybe Int findIndices, -- :: (Word8 -> Bool) -> ByteString -> [Int] + findIndexEnd, -- :: (Word8 -> Bool) -> ByteString -> Maybe Int count, -- :: Word8 -> ByteString -> Int -- * Zipping and unzipping ByteStrings @@ -1098,15 +1099,7 @@ elemIndex c (PS x s l) = accursedUnutterablePerformIO $ withForeignPtr x $ \p -> -- > (-) (length xs - 1) `fmap` elemIndex c (reverse xs) -- elemIndexEnd :: Word8 -> ByteString -> Maybe Int -elemIndexEnd ch (PS x s l) = accursedUnutterablePerformIO $ withForeignPtr x $ \p -> - go (p `plusPtr` s) (l-1) - where - go !p !i | i < 0 = return Nothing - | otherwise = do ch' <- peekByteOff p i - if ch == ch' - then return $ Just i - else go p (i-1) -{-# INLINE elemIndexEnd #-} +elemIndexEnd = findIndexEnd . (==) -- | /O(n)/ The 'elemIndices' function extends 'elemIndex', by returning -- the indices of all elements equal to the query element, in ascending order. @@ -1134,7 +1127,7 @@ count w (PS x s m) = accursedUnutterablePerformIO $ withForeignPtr x $ \p -> fmap fromIntegral $ c_count (p `plusPtr` s) (fromIntegral m) w {-# INLINE count #-} --- | The 'findIndex' function takes a predicate and a 'ByteString' and +-- | /O(n)/ The 'findIndex' function takes a predicate and a 'ByteString' and -- returns the index of the first element in the ByteString -- satisfying the predicate. findIndex :: (Word8 -> Bool) -> ByteString -> Maybe Int @@ -1147,7 +1140,20 @@ findIndex k (PS x s l) = accursedUnutterablePerformIO $ withForeignPtr x $ \f -> else go (ptr `plusPtr` 1) (n+1) {-# INLINE findIndex #-} --- | The 'findIndices' function extends 'findIndex', by returning the +-- | /O(n)/ The 'findIndexEnd' function takes a predicate and a 'ByteString' and +-- returns the index of the last element in the ByteString +-- satisfying the predicate. +findIndexEnd :: (Word8 -> Bool) -> ByteString -> Maybe Int +findIndexEnd k (PS x s l) = accursedUnutterablePerformIO $ withForeignPtr x $ \ f -> go (f `plusPtr` s) (l-1) + where + go !ptr !n | n < 0 = return Nothing + | otherwise = do w <- peekByteOff ptr n + if k w + then return (Just n) + else go ptr (n-1) +{-# INLINE findIndexEnd #-} + +-- | /O(n)/ The 'findIndices' function extends 'findIndex', by returning the -- indices of all elements satisfying the predicate, in ascending order. findIndices :: (Word8 -> Bool) -> ByteString -> [Int] findIndices p ps = loop 0 ps diff --git a/Data/ByteString/Lazy.hs b/Data/ByteString/Lazy.hs index 9157826f2..d18e3340e 100644 --- a/Data/ByteString/Lazy.hs +++ b/Data/ByteString/Lazy.hs @@ -171,6 +171,7 @@ module Data.ByteString.Lazy ( elemIndexEnd, -- :: Word8 -> ByteString -> Maybe Int64 elemIndices, -- :: Word8 -> ByteString -> [Int64] findIndex, -- :: (Word8 -> Bool) -> ByteString -> Maybe Int64 + findIndexEnd, -- :: (Word8 -> Bool) -> ByteString -> Maybe Int64 findIndices, -- :: (Word8 -> Bool) -> ByteString -> [Int64] count, -- :: Word8 -> ByteString -> Int64 @@ -916,13 +917,7 @@ elemIndex w cs0 = elemIndex' 0 cs0 -- -- @since 0.10.6.0 elemIndexEnd :: Word8 -> ByteString -> Maybe Int64 -elemIndexEnd w = elemIndexEnd' 0 - where - elemIndexEnd' _ Empty = Nothing - elemIndexEnd' n (Chunk c cs) = - let !n' = n + S.length c - !i = fmap (fromIntegral . (n +)) $ S.elemIndexEnd w c - in elemIndexEnd' n' cs `mplus` i +elemIndexEnd = findIndexEnd . (==) -- | /O(n)/ The 'elemIndices' function extends 'elemIndex', by returning -- the indices of all elements equal to the query element, in ascending order. @@ -953,6 +948,19 @@ findIndex k cs0 = findIndex' 0 cs0 Just i -> Just (n + fromIntegral i) {-# INLINE findIndex #-} +-- | The 'findIndexEnd' function takes a predicate and a 'ByteString' and +-- returns the index of the last element in the ByteString +-- satisfying the predicate. +findIndexEnd :: (Word8 -> Bool) -> ByteString -> Maybe Int64 +findIndexEnd k = findIndexEnd' 0 + where + findIndexEnd' _ Empty = Nothing + findIndexEnd' n (Chunk c cs) = + let !n' = n + S.length c + !i = fmap (fromIntegral . (n +)) $ S.findIndexEnd k c + in findIndexEnd' n' cs `mplus` i +{-# INLINE findIndexEnd #-} + -- | /O(n)/ The 'find' function takes a predicate and a ByteString, -- and returns the first element in matching the predicate, or 'Nothing' -- if there is no such element. diff --git a/tests/Properties.hs b/tests/Properties.hs index 8dcde9f1b..15b69d40a 100644 --- a/tests/Properties.hs +++ b/tests/Properties.hs @@ -177,6 +177,7 @@ prop_dropWhileBP = L.dropWhile `eq2` P.dropWhile prop_filterBP = L.filter `eq2` P.filter prop_findBP = L.find `eq2` P.find prop_findIndexBP = L.findIndex `eq2` ((fmap toInt64 .) . P.findIndex) +prop_findIndexEndBP = L.findIndexEnd `eq2` ((fmap toInt64 .) . P.findIndexEnd) prop_findIndicesBP = L.findIndices `eq2` ((fmap toInt64 .) . P.findIndices) prop_isPrefixOfBP = L.isPrefixOf `eq2` P.isPrefixOf prop_stripPrefixBP = L.stripPrefix `eq2` P.stripPrefix @@ -194,6 +195,7 @@ prop_takeWhileBP = L.takeWhile `eq2` P.takeWhile prop_elemBP = L.elem `eq2` P.elem prop_notElemBP = L.notElem `eq2` P.notElem prop_elemIndexBP = L.elemIndex `eq2` ((fmap toInt64 .) . P.elemIndex) +prop_elemIndexEndBP = L.elemIndexEnd `eq2` ((fmap toInt64 .) . P.elemIndexEnd) prop_elemIndicesBP = L.elemIndices `eq2` ((fmap toInt64 .) . P.elemIndices) prop_intersperseBP = L.intersperse `eq2` P.intersperse prop_lengthBP = L.length `eq1` (toInt64 . P.length) @@ -364,6 +366,7 @@ prop_filterBL = L.filter `eq2` (filter :: (W -> Bool ) - prop_findBL = L.find `eq2` (find :: (W -> Bool) -> [W] -> Maybe W) prop_findIndicesBL = L.findIndices `eq2` ((fmap toInt64 .) . findIndices:: (W -> Bool) -> [W] -> [Int64]) prop_findIndexBL = L.findIndex `eq2` ((fmap toInt64 .) . findIndex :: (W -> Bool) -> [W] -> Maybe Int64) +prop_findIndexEndBL = L.findIndexEnd `eq2` ((fmap toInt64 .) . findIndexEnd :: (W -> Bool) -> [W] -> Maybe Int64) prop_isPrefixOfBL = L.isPrefixOf `eq2` (isPrefixOf:: [W] -> [W] -> Bool) prop_stripPrefixBL = L.stripPrefix `eq2` (stripPrefix:: [W] -> [W] -> Maybe [W]) prop_isSuffixOfBL = L.isSuffixOf `eq2` (isSuffixOf:: [W] -> [W] -> Bool) @@ -379,6 +382,7 @@ prop_takeWhileBL = L.takeWhile `eq2` (takeWhile :: (W -> Bool) -> prop_elemBL = L.elem `eq2` (elem :: W -> [W] -> Bool) prop_notElemBL = L.notElem `eq2` (notElem :: W -> [W] -> Bool) prop_elemIndexBL = L.elemIndex `eq2` ((fmap toInt64 .) . elemIndex :: W -> [W] -> Maybe Int64) +prop_elemIndexEndBL = L.elemIndexEnd `eq2` ((fmap toInt64 .) . elemIndexEnd:: W -> [W] -> Maybe Int64) prop_elemIndicesBL = L.elemIndices `eq2` ((fmap toInt64 .) . elemIndices :: W -> [W] -> [Int64]) prop_linesBL = D.lines `eq1` (lines :: String -> [String]) @@ -472,6 +476,7 @@ prop_partitionPL = P.partition `eq2` (partition :: (W -> Bool ) -> [W] -> ([ prop_partitionLL = L.partition `eq2` (partition :: (W -> Bool ) -> [W] -> ([W],[W])) prop_findPL = P.find `eq2` (find :: (W -> Bool) -> [W] -> Maybe W) prop_findIndexPL = P.findIndex `eq2` (findIndex :: (W -> Bool) -> [W] -> Maybe Int) +prop_findIndexEndPL = P.findIndexEnd `eq2` (findIndexEnd :: (W -> Bool) -> [W] -> Maybe Int) prop_isPrefixOfPL = P.isPrefixOf`eq2` (isPrefixOf:: [W] -> [W] -> Bool) prop_isSuffixOfPL = P.isSuffixOf`eq2` (isSuffixOf:: [W] -> [W] -> Bool) prop_isInfixOfPL = P.isInfixOf `eq2` (isInfixOf:: [W] -> [W] -> Bool) @@ -792,6 +797,7 @@ prop_elemIndices xs c = elemIndices c xs == map fromIntegral (L.elemIndices c (p prop_count c xs = length (L.elemIndices c xs) == fromIntegral (L.count c xs) prop_findIndex xs f = (findIndex f xs) == fmap fromIntegral (L.findIndex f (pack xs)) +prop_findIndexEnd xs f = (findIndexEnd f xs) == fmap fromIntegral (L.findIndexEnd f (pack xs)) prop_findIndicies xs f = (findIndices f xs) == map fromIntegral (L.findIndices f (pack xs)) prop_elem xs c = (c `elem` xs) == (c `L.elem` (pack xs)) @@ -1161,6 +1167,8 @@ prop_elemIndicesBB xs c = elemIndices c xs == P.elemIndices c (P.pack xs) prop_findIndexBB xs a = (findIndex (==a) xs) == (P.findIndex (==a) (P.pack xs)) +prop_findIndexEndBB xs a = (findIndexEnd (==a) xs) == (P.findIndexEnd (==a) (P.pack xs)) + prop_findIndiciesBB xs c = (findIndices (==c) xs) == (P.findIndices (==c) (P.pack xs)) -- example properties from QuickCheck.Batch @@ -1827,6 +1835,7 @@ bl_tests = , testProperty "filter" prop_filterBL , testProperty "find" prop_findBL , testProperty "findIndex" prop_findIndexBL + , testProperty "findIndexEnd"prop_findIndexEndBL , testProperty "findIndices" prop_findIndicesBL , testProperty "foldl" prop_foldlBL , testProperty "foldl'" prop_foldlBL' @@ -1878,6 +1887,7 @@ bl_tests = , testProperty "notElem" prop_notElemBL , testProperty "lines" prop_linesBL , testProperty "elemIndex" prop_elemIndexBL + , testProperty "elemIndexEnd"prop_elemIndexEndBL , testProperty "elemIndices" prop_elemIndicesBL , testProperty "concatMap" prop_concatMapBL ] @@ -1963,6 +1973,7 @@ bp_tests = , testProperty "filter" prop_filterBP , testProperty "find" prop_findBP , testProperty "findIndex" prop_findIndexBP + , testProperty "findIndexEnd"prop_findIndexEndBP , testProperty "findIndices" prop_findIndicesBP , testProperty "foldl" prop_foldlBP , testProperty "foldl'" prop_foldlBP' @@ -2014,6 +2025,7 @@ bp_tests = , testProperty "elem" prop_elemBP , testProperty "notElem" prop_notElemBP , testProperty "elemIndex" prop_elemIndexBP + , testProperty "elemIndexEnd"prop_elemIndexEndBP , testProperty "elemIndices" prop_elemIndicesBP , testProperty "intersperse" prop_intersperseBP , testProperty "concatMap" prop_concatMapBP @@ -2037,6 +2049,7 @@ pl_tests = , testProperty "partition" prop_partitionLL , testProperty "find" prop_findPL , testProperty "findIndex" prop_findIndexPL + , testProperty "findIndexEnd"prop_findIndexEndPL , testProperty "findIndices" prop_findIndicesPL , testProperty "foldl" prop_foldlPL , testProperty "foldl'" prop_foldlPL' @@ -2217,6 +2230,7 @@ bb_tests = , testProperty "elemIndex 1" prop_elemIndex1BB , testProperty "elemIndex 2" prop_elemIndex2BB , testProperty "findIndex" prop_findIndexBB + , testProperty "findIndexEnd" prop_findIndexEndBB , testProperty "findIndicies" prop_findIndiciesBB , testProperty "elemIndices" prop_elemIndicesBB , testProperty "find" prop_findBB @@ -2422,6 +2436,7 @@ ll_tests = , testProperty "elemIndices" prop_elemIndices , testProperty "count/elemIndices" prop_count , testProperty "findIndex" prop_findIndex + , testProperty "findIndexEnd" prop_findIndexEnd , testProperty "findIndices" prop_findIndicies , testProperty "find" prop_find , testProperty "find/findIndex" prop_find_findIndex @@ -2440,4 +2455,12 @@ ll_tests = , testProperty "isSpace" prop_isSpaceWord8 ] +findIndexEnd :: (a -> Bool) -> [a] -> Maybe Int +findIndexEnd p = go . findIndices p + where + go [] = Nothing + go (k:[]) = Just k + go (k:ks) = go ks +elemIndexEnd :: Eq a => a -> [a] -> Maybe Int +elemIndexEnd = findIndexEnd . (==) From ba15fbb61613c2096812fb13df0c08e1d6f8c0dc Mon Sep 17 00:00:00 2001 From: M Farkas-Dyck Date: Mon, 6 Jul 2020 13:02:02 -0800 Subject: [PATCH 2/2] INLINE elemIndexEnd --- Data/ByteString.hs | 1 + Data/ByteString/Lazy.hs | 1 + 2 files changed, 2 insertions(+) diff --git a/Data/ByteString.hs b/Data/ByteString.hs index b02c7a03e..44bd9d99d 100644 --- a/Data/ByteString.hs +++ b/Data/ByteString.hs @@ -1114,6 +1114,7 @@ elemIndex c (PS x s l) = accursedUnutterablePerformIO $ withForeignPtr x $ \p -> -- elemIndexEnd :: Word8 -> ByteString -> Maybe Int elemIndexEnd = findIndexEnd . (==) +{-# INLINE elemIndexEnd #-} -- | /O(n)/ The 'elemIndices' function extends 'elemIndex', by returning -- the indices of all elements equal to the query element, in ascending order. diff --git a/Data/ByteString/Lazy.hs b/Data/ByteString/Lazy.hs index d18e3340e..5b0a5f9b4 100644 --- a/Data/ByteString/Lazy.hs +++ b/Data/ByteString/Lazy.hs @@ -918,6 +918,7 @@ elemIndex w cs0 = elemIndex' 0 cs0 -- @since 0.10.6.0 elemIndexEnd :: Word8 -> ByteString -> Maybe Int64 elemIndexEnd = findIndexEnd . (==) +{-# INLINE elemIndexEnd #-} -- | /O(n)/ The 'elemIndices' function extends 'elemIndex', by returning -- the indices of all elements equal to the query element, in ascending order.