Bryan O'Sullivan avatar Bryan O'Sullivan committed 98e61f1

Write a new version of replace that is 2.2x faster

Comments (0)

Files changed (3)

     , transpose
     , reverse
     , replace
+    , replace2
 
     -- ** Case conversion
     -- $case
 replace s d = intercalate d . splitOn s
 {-# INLINE replace #-}
 
+replace2 :: Text -> Text -> Text -> Text
+replace2 needle@(Text _      _      neeLen)
+              r@(Text repArr repOff repLen)
+       haystack@(Text hayArr hayOff hayLen)
+  | neeLen == 0 = emptyError "replace2"
+  | len < 0     = overflowError "replace2"
+  | len == 0    = empty
+  | L.null ixs  = haystack
+  | otherwise   = Text (A.run x) 0 len
+  where
+    ixs = indices needle haystack
+    cnt = L.length ixs
+    len = hayLen - (neeLen - repLen) * cnt
+    x = do
+      marr <- A.new len
+      let loop is0@(i:is) o d = do
+            let d0 = d + i - o
+                d1 = d0 + repLen
+            A.copyI marr d  hayArr (hayOff+o) d0
+            A.copyI marr d0 repArr repOff d1
+            loop is (i + neeLen) d1
+          loop []     o d = A.copyI marr d hayArr (hayOff+o) len
+      loop ixs 0 0
+      return marr
+
 -- ----------------------------------------------------------------------------
 -- ** Case conversions (folds)
 

benchmarks/haskell/Benchmarks/Replace.hs

         !b = T.encodeUtf8 t
     return $ bgroup "Replace" [
           bench "Text"           $ nf (T.length . T.replace tpat tsub) t
+        , bench "Text2"          $ nf (T.length . T.replace2 tpat tsub) t
         , bench "ByteString"     $ nf (BL.length . B.replace bpat bsub) b
         , bench "LazyText"       $ nf (TL.length . TL.replace tlpat tlsub) tl
         , bench "LazyByteString" $ nf (BL.length . BL.replace blpat blsub) bl

tests/Tests/Properties.hs

 
 t_replace s d     = (L.intercalate d . splitOn s) `eqP`
                     (unpackS . T.replace (T.pack s) (T.pack d))
+t_replace2 (NotEmpty s0) (NotEmpty d0) (NotEmpty w0) =
+    T.replace s d w =^= T.replace2 s d w
+  where s = f s0; d = f d0; w = f w0
+        f = T.tail . T.pack
 tl_replace s d     = (L.intercalate d . splitOn s) `eqP`
                      (unpackS . TL.replace (TL.pack s) (TL.pack d))
 
 splitOn :: (Eq a) => [a] -> [a] -> [[a]]
 splitOn pat src0
-    | l == 0    = error "empty"
+    | l == 0    = error "splitOn: empty"
     | otherwise = go src0
   where
     l           = length pat
       testProperty "tl_reverse" tl_reverse,
       testProperty "t_reverse_short" t_reverse_short,
       testProperty "t_replace" t_replace,
+      testProperty "t_replace2" t_replace2,
       testProperty "tl_replace" tl_replace,
 
       testGroup "case conversion" [
Tip: Filter by directory path e.g. /media app.js to search for public/media/app.js.
Tip: Use camelCasing e.g. ProjME to search for ProjectModifiedEvent.java.
Tip: Filter by extension type e.g. /repo .js to search for all .js files in the /repo directory.
Tip: Separate your search with spaces e.g. /ssh pom.xml to search for src/ssh/pom.xml.
Tip: Use ↑ and ↓ arrow keys to navigate and return to view the file.
Tip: You can also navigate files with Ctrl+j (next) and Ctrl+k (previous) and view the file with Ctrl+o.
Tip: You can also navigate files with Alt+j (next) and Alt+k (previous) and view the file with Alt+o.