on master help sign in
Rewrite find to use indices. New test is broken, alas.
7537b75Bryan O'Sullivan
Data/Text.hs+11−13
@@ -1054,7 +1054,7 @@ filter :: (Char -> Bool) -> Text -> Text
1054filter p t = unstream (S.filter p (stream t))
1054filter p t = unstream (S.filter p (stream t))
1055{-# INLINE filter #-}
1055{-# INLINE filter #-}
1056
1056
1057−-- /O(n*m)/ Find all non-overlapping instances of @needle@ in
1057+-- /O(n+m)/ Find all non-overlapping instances of @needle@ in
1058-- @haystack@. The first element of the returned tuple is the prefix
1058-- @haystack@. The first element of the returned tuple is the prefix
1059-- of @haystack@ before any matches of @needle@. The second element
1059-- of @haystack@ before any matches of @needle@. The second element
1060-- of the tuple is a list of non-overlapping substrings from
1060-- of the tuple is a list of non-overlapping substrings from
@@ -1071,20 +1071,18 @@ filter p t = unstream (S.filter p (stream t))
1071--
1071--
1072-- > concat (prefix : matches) == haystack
1072-- > concat (prefix : matches) == haystack
1073-- > where (prefix, matches) = find needle haystack
1073-- > where (prefix, matches) = find needle haystack
1074+--
1075+-- In (unlikely) bad cases, this function's time complexity
1076+-- degenerates towards /O(n*m)/.
1074find :: Text -> Text -> (Text, [Text])
1077find :: Text -> Text -> (Text, [Text])
1075−find pat@(Text _ _ plen) src@(Text sarr soff slen)
1078+find pat src@(Text arr off len)
1076− | plen <= 0 = emptyError "find"
1079+ | null pat = emptyError "find"
1077− | otherwise = (h,t)
1080+ | otherwise = case indices pat src of
1081+ [] -> (src, [])
1082+ (x:xs) -> (textP arr off x, go x xs)
1078 where
1083 where
1079− (h:t) = go 0 (search 0)
1084+ go !s (x:xs) = textP arr (s+off) (x-s) : go x xs
1080− go k (x:xs) = Text sarr k (x-k) : go x xs
1085+ go s _ = [textP arr (s+off) (len-s)]
1081− go _ [] = []
1082− search i
1083− | i >= slen = [slen] -- not found
1084− | pat `isPrefixOf` s = i : search (i+plen)
1085− | otherwise = search (i+d)
1086− where d = iter_ src i
1087− s = Text sarr (soff+i) (slen-i)
1088{-# INLINE find #-}
1086{-# INLINE find #-}
1089
1087
1090-------------------------------------------------------------------------------
1088-------------------------------------------------------------------------------
tests/Properties.hs+10−5
@@ -2,7 +2,7 @@
2 TypeSynonymInstances #-}
2 TypeSynonymInstances #-}
3{-# OPTIONS_GHC -fno-enable-rewrite-rules #-}
3{-# OPTIONS_GHC -fno-enable-rewrite-rules #-}
4
4
5−import Test.QuickCheck
5+import Test.QuickCheck hiding (evaluate)
6import Text.Show.Functions ()
6import Text.Show.Functions ()
7
7
8import qualified Data.Bits as Bits (shiftL, shiftR)
8import qualified Data.Bits as Bits (shiftL, shiftR)
@@ -15,7 +15,7 @@ import Data.Word (Word8, Word16, Word32)
15import qualified Data.Text as T
15import qualified Data.Text as T
16import qualified Data.Text.Lazy as TL
16import qualified Data.Text.Lazy as TL
17import qualified Data.Text.Encoding as E
17import qualified Data.Text.Encoding as E
18−import Control.Exception (SomeException, try)
18+import Control.Exception (SomeException, evaluate, try)
19import qualified Data.Text.Fusion as S
19import qualified Data.Text.Fusion as S
20import qualified Data.Text.Fusion.Common as S
20import qualified Data.Text.Fusion.Common as S
21import Data.Text.Fusion.Size
21import Data.Text.Fusion.Size
@@ -38,8 +38,8 @@ import QuickCheckUtils (NotEmpty(..), small)
38(=^=) :: (Eq a, Show a) => a -> a -> Bool
38(=^=) :: (Eq a, Show a) => a -> a -> Bool
39{-# NOINLINE (=^=) #-}
39{-# NOINLINE (=^=) #-}
40i =^= j = unsafePerformIO $ do
40i =^= j = unsafePerformIO $ do
41− x <- try (return $! i)
41+ x <- try (evaluate i)
42− y <- try (return $! j)
42+ y <- try (evaluate j)
43 case (x,y) of
43 case (x,y) of
44 (Left (_ :: SomeException), Left (_ :: SomeException))
44 (Left (_ :: SomeException), Left (_ :: SomeException))
45 -> return True
45 -> return True
@@ -398,7 +398,11 @@ tl_inits = L.inits `eqP` (map unpackS . TL.inits)
398t_tails = L.tails `eqP` (map unpackS . T.tails)
398t_tails = L.tails `eqP` (map unpackS . T.tails)
399tl_tails = L.tails `eqP` (map unpackS . TL.tails)
399tl_tails = L.tails `eqP` (map unpackS . TL.tails)
400
400
401+findSplit s t = let (x,xs) = T.find s t
402+ in x : L.map (T.drop (T.length s)) xs
403+
404+t_findSplit s = T.split s `eq` findSplit s
401−t_split_split p = T.split p `eq` Slow.split p
405+t_split_split s = T.split s `eq` Slow.split s
402t_split_i (NotEmpty t) = id `eq` (T.intercalate t . T.split t)
406t_split_i (NotEmpty t) = id `eq` (T.intercalate t . T.split t)
403tl_split_i (NotEmpty t) = id `eq` (TL.intercalate t . TL.split t)
407tl_split_i (NotEmpty t) = id `eq` (TL.intercalate t . TL.split t)
404t_splitTimes_i k (NotEmpty t) = id `eq` (T.intercalate t . T.splitTimes k t)
408t_splitTimes_i k (NotEmpty t) = id `eq` (T.intercalate t . T.splitTimes k t)
@@ -802,6 +806,7 @@ tests = [
802 ],
806 ],
803
807
804 testGroup "breaking many" [
808 testGroup "breaking many" [
809+ testProperty "t_findSplit" t_findSplit,
805 testProperty "t_split_split" t_split_split,
810 testProperty "t_split_split" t_split_split,
806 testProperty "t_split_i" t_split_i,
811 testProperty "t_split_i" t_split_i,
807 testProperty "t_splitTimes_i" t_splitTimes_i,
812 testProperty "t_splitTimes_i" t_splitTimes_i,