]> gitweb.factorcode.org Git - factor.git/commitdiff
Remove match iterators for a performance boost
authorSlava Pestov <slava@slava-pestovs-macbook-pro.local>
Wed, 11 Mar 2009 21:21:29 +0000 (16:21 -0500)
committerSlava Pestov <slava@slava-pestovs-macbook-pro.local>
Wed, 11 Mar 2009 21:21:29 +0000 (16:21 -0500)
basis/regexp/regexp-docs.factor
basis/regexp/regexp-tests.factor
basis/regexp/regexp.factor

index d31b185b2f5b508eb14a18ce1ffa6da9e780050a..adbeb341bb37272de2245f13d57e7247adb89d2f 100644 (file)
@@ -42,8 +42,8 @@ ARTICLE: { "regexp" "operations" } "Matching operations with regular expressions
 { $subsection matches? }
 { $subsection re-contains? }
 { $subsection first-match }
-{ $subsection all-matches }
-{ $subsection re-split1 }
+{ $subsection all-matching-slices }
+{ $subsection all-matching-subseqs }
 { $subsection re-split }
 { $subsection re-replace }
 { $subsection count-matches } ;
@@ -67,25 +67,21 @@ HELP: matches?
 { $values { "string" string } { "regexp" regexp } { "?" "a boolean" } }
 { $description "Tests if the string as a whole matches the given regular expression." } ;
 
-HELP: re-split1
-{ $values { "string" string } { "regexp" regexp } { "before" string } { "after/f" string } }
-{ $description "Searches the string for a substring which matches the pattern. If found, the input string is split on the leftmost and longest occurence of the match, and the two halves are given as output. If no match is found, then the input string and " { $link f } " are output." } ;
-
-HELP: all-matches
+HELP: all-matching-slices
 { $values { "string" string } { "regexp" regexp } { "seq" "a sequence of slices of the input" } }
 { $description "Finds a sequence of disjoint substrings which each match the pattern. It chooses this by finding the leftmost longest match, and then the leftmost longest match which starts after the end of the previous match, and so on." } ;
 
 HELP: count-matches
 { $values { "string" string } { "regexp" regexp } { "n" integer } }
-{ $description "Counts how many disjoint matches the regexp has in the string, as made unambiguous by " { $link all-matches } "." } ;
+{ $description "Counts how many disjoint matches the regexp has in the string, as made unambiguous by " { $link all-matching-slices } "." } ;
 
 HELP: re-split
 { $values { "string" string } { "regexp" regexp } { "seq" "a sequence of slices of the input" } }
-{ $description "Splits the input string into chunks separated by the regular expression. Each chunk contains no match of the regexp. The chunks are chosen by the strategy of " { $link all-matches } "." } ;
+{ $description "Splits the input string into chunks separated by the regular expression. Each chunk contains no match of the regexp. The chunks are chosen by the strategy of " { $link all-matching-slices } "." } ;
 
 HELP: re-replace
 { $values { "string" string } { "regexp" regexp } { "replacement" string } { "result" string } }
-{ $description "Replaces substrings which match the input regexp with the given replacement text. The boundaries of the substring are chosen by the strategy used by " { $link all-matches } "." } ;
+{ $description "Replaces substrings which match the input regexp with the given replacement text. The boundaries of the substring are chosen by the strategy used by " { $link all-matching-slices } "." } ;
 
 HELP: first-match
 { $values { "string" string } { "regexp" regexp } { "slice/f" "the match, if one exists" } }
index e01241552dbbd957b9900ded1e2559861c1ebfc3..c6d1487d5ac2fc284e14400be93213fdb0a8c55a 100644 (file)
@@ -287,7 +287,7 @@ IN: regexp-tests
 [ { "a" "" } ] [ "a=" R/ =/ re-split [ >string ] map ] unit-test
 
 [ { "ABC" "DEF" "GHI" } ]
-[ "1ABC2DEF3GHI4" R/ [A-Z]+/ all-matches [ >string ] map ] unit-test
+[ "1ABC2DEF3GHI4" R/ [A-Z]+/ all-matching-subseqs ] unit-test
 
 [ 3 ]
 [ "1ABC2DEF3GHI4" R/ [A-Z]+/ count-matches ] unit-test
@@ -431,7 +431,7 @@ IN: regexp-tests
 [ f ] [ "a bar b" R/ foo/ re-contains? ] unit-test
 [ t ] [ "foo" R/ foo/ re-contains? ] unit-test
 
-[ { "foo" "fxx" "fab" } ] [ "fab fxx foo" R/ f../r all-matches [ >string ] map ] unit-test
+[ { "foo" "fxx" "fab" } ] [ "fab fxx foo" R/ f../r all-matching-subseqs ] unit-test
 
 ! [ t ] [ "foo" "\\bfoo\\b" <regexp> matches? ] unit-test
 ! [ t ] [ "afoob" "\\Bfoo\\B" <regexp> matches? ] unit-test
index 7f27a13104a011f67505e454273f5dcbbdc9536a..e385c515ef51591c8c1acca3d0cf7815a8849d79 100644 (file)
@@ -49,93 +49,90 @@ M: reverse-regexp end/start drop length 1- -1 swap ;
 PRIVATE>
 
 : matches? ( string regexp -- ? )
-    [ end/start ] 2keep
     [ check-string ] dip
+    [ end/start ] 2keep
     match-index-from
-    [ swap = ] [ drop f ] if* ;
+    [ = ] [ drop f ] if* ;
 
 <PRIVATE
 
-TUPLE: match { i read-only } { j read-only } { seq read-only } ;
+TUPLE: match { i read-only } { start read-only } { end read-only } { string read-only } ;
 
-: match-slice ( i string quot -- match/f )
-    [ 2dup ] dip call
-    [ swap match boa ] [ 2drop f ] if* ; inline
+:: <match> ( i string quot: ( i string -- i seq j ) reverse? -- match/f )
+    i string quot call dup [| j |
+        j i j
+        reverse? [ swap [ 1+ ] bi@ ] when
+        string match boa
+    ] when ; inline
 
 : search-range ( i string reverse? -- seq )
     [ drop 0 [a,b] ] [ length [a,b) ] if ; inline
 
-: match>result ( match reverse? -- i start end string )
-    over [
-        [ [ i>> ] [ j>> tuck ] [ seq>> ] tri ] dip
-        [ [ swap [ 1+ ] bi@ ] dip ] when
-    ] [ 2drop f f f f ] if ; inline
+: match>result ( match -- i start end string )
+    dup
+    [ { [ i>> ] [ start>> ] [ end>> ] [ string>> ] } cleave ]
+    [ drop f f f f ]
+    if ; inline
 
-:: next-match ( i string quot reverse? -- i start end string )
+:: next-match ( i string quot reverse? -- i start end ? )
     i string reverse? search-range
-    [ string quot match-slice ] map-find drop
-    reverse? match>result ; inline
+    [ string quot reverse? <match> ] map-find drop
+    match>result ; inline
 
-: do-next-match ( i string regexp -- i start end string )
+: do-next-match ( i string regexp -- i start end ? )
     dup next-match>>
-    execute-unsafe( i string regexp -- i start end string ) ;
+    execute-unsafe( i string regexp -- i start end ? ) ; inline
 
-: next-slice ( i string regexp -- i/f slice/f )
-    do-next-match
-    [ slice boa ] [ drop ] if* ; inline
+:: (each-match) ( i string regexp quot: ( start end string -- ) -- )
+    i string regexp do-next-match [| i' start end |
+        start end string quot call
+        i' string regexp quot (each-match)
+    ] [ 3drop ] if ; inline recursive
 
 PRIVATE>
 
-TUPLE: match-iterator
-    { string read-only }
-    { regexp read-only }
-    { i read-only }
-    { value read-only } ;
+: prepare-match-iterator ( string regexp -- i string regexp )
+    [ check-string ] dip [ end/start nip ] 2keep ; inline
 
-: iterate ( iterator -- iterator'/f )
-    dup
-    [ i>> ] [ string>> ] [ regexp>> ] tri next-slice
-    [ [ [ string>> ] [ regexp>> ] bi ] 2dip match-iterator boa ]
-    [ 2drop f ] if* ;
+: each-match ( string regexp quot: ( start end string -- ) -- )
+    [ prepare-match-iterator ] dip (each-match) ; inline
 
-: value ( iterator/f -- value/f )
-    dup [ value>> ] when ;
+: map-matches ( string regexp quot: ( start end string -- obj ) -- seq )
+    accumulator [ each-match ] dip >array ; inline
 
-: <match-iterator> ( string regexp -- match-iterator )
-    [ check-string ] dip
-    2dup end/start nip f
-    match-iterator boa
-    iterate ; inline
+: all-matching-slices ( string regexp -- seq )
+    [ slice boa ] map-matches ;
 
-: all-matches ( string regexp -- seq )
-    <match-iterator> [ iterate ] follow [ value ] map ;
+: all-matching-subseqs ( string regexp -- seq )
+    [ subseq ] map-matches ;
 
 : count-matches ( string regexp -- n )
-    all-matches length ;
+    [ 0 ] 2dip [ 3drop 1+ ] each-match ;
 
 <PRIVATE
 
-:: split-slices ( string slices -- new-slices )
-    slices [ to>> ] map 0 prefix
-    slices [ from>> ] map string length suffix
-    [ string <slice> ] 2map ;
+:: (re-split) ( string regexp quot -- new-slices )
+    0 string regexp [| end start end' string |
+        end' ! leave it on the stack for the next iteration
+        end start string quot call
+    ] map-matches
+    ! Final chunk
+    swap string length string quot call suffix ; inline
 
 PRIVATE>
 
 : first-match ( string regexp -- slice/f )
-    <match-iterator> value ;
+    [ prepare-match-iterator do-next-match ] [ drop ] 2bi
+    '[ _ slice boa nip ] [ 3drop f ] if ;
 
 : re-contains? ( string regexp -- ? )
-    first-match >boolean ;
-
-: re-split1 ( string regexp -- before after/f )
-    dupd first-match [ 1array split-slices first2 ] [ f ] if* ;
+    prepare-match-iterator do-next-match [ 3drop ] dip >boolean ;
 
 : re-split ( string regexp -- seq )
-    dupd all-matches split-slices ;
+    [ slice boa ] (re-split) ;
 
 : re-replace ( string regexp replacement -- result )
-    [ re-split ] dip join ;
+    [ [ subseq ] (re-split) ] dip join ;
 
 <PRIVATE