regexp: fix match iteration with empty matches, and fix reverse regexes since they...

diff --git a/basis/regexp/regexp-tests.factor b/basis/regexp/regexp-tests.factor
index 2488f568dacb004a214d3fcb2764255c6b58d88a..609636c1d13c348bf6b17e6383797a8d97f71392 100644 (file)
--- a/basis/regexp/regexp-tests.factor
+++ b/basis/regexp/regexp-tests.factor
@@ -1,7 +1,5 @@
-! Copyright (C) 2008, 2009 Doug Coleman, Daniel Ehrenberg
-! See http://factorcode.org/license.txt for BSD license.
-USING: regexp tools.test kernel sequences regexp.parser regexp.private
-eval strings multiline accessors ;
+USING: arrays regexp tools.test kernel sequences regexp.parser
+regexp.private eval strings multiline accessors ;
 IN: regexp-tests
 
 [ f ] [ "b" "a*" <regexp> matches? ] unit-test
@@ -241,6 +239,9 @@ IN: regexp-tests
 [ t ] [ 3 "xabc" R/ abc/r match-index-from >boolean ] unit-test
 [ t ] [ 3 "xabc" R/ a[bB][cC]/r match-index-from >boolean ] unit-test
 
+[ 2 ] [ 0 "llamallol" R/ ll/ match-index-from ] unit-test
+[ 5 ] [ 8 "lolmallol" R/ lol/r match-index-from ] unit-test
+
 [ t ] [ "s@f" "[a-z.-]@[a-z]" <regexp> matches? ] unit-test
 [ f ] [ "a" "[a-z.-]@[a-z]" <regexp> matches? ] unit-test
 [ t ] [ ".o" "\\.[a-z]" <regexp> matches? ] unit-test
@@ -272,6 +273,10 @@ IN: regexp-tests
 
 [ "b" ] [ "aaaaaaaaaaaaaaaaaaaaaaab" "((a*)*b)*b" <regexp> first-match >string ] unit-test
 
+[ T{ slice { from 5 } { to 10 } { seq "hellohello" } } ]
+[ "hellohello" R/ hello/r first-match ]
+unit-test
+
 [ { "1" "2" "3" "4" } ]
 [ "1ABC2DEF3GHI4" R/ [A-Z]+/ re-split [ >string ] map ] unit-test
 
@@ -282,18 +287,52 @@ IN: regexp-tests
 
 [ { "a" "" } ] [ "a=" R/ =/ re-split [ >string ] map ] unit-test
 
+[ { "he" "o" } ] [ "hello" R/ l+/ re-split [ >string ] map ] unit-test
+
+[ { "h" "llo" } ] [ "hello" R/ e+/ re-split [ >string ] map ] unit-test
+
+[ { "" "h" "l" "l" "o" "" } ] [ "hello" R/ e*/ re-split [ >string ] map ] unit-test
+
+[ { { 0 5 "hellohello" } { 5 10 "hellohello" } } ]
+[ "hellohello" R/ hello/ [ 3array ] map-matches ]
+unit-test
+
+[ { { 5 10 "hellohello" } { 0 5 "hellohello" } } ]
+[ "hellohello" R/ hello/r [ 3array ] map-matches ]
+unit-test
+
 [ { "ABC" "DEF" "GHI" } ]
 [ "1ABC2DEF3GHI4" R/ [A-Z]+/ all-matching-subseqs ] unit-test
 
-[ 3 ]
-[ "1ABC2DEF3GHI4" R/ [A-Z]+/ count-matches ] unit-test
+[ { "ee" "e" } ] [ "heellohello" R/ e+/ all-matching-subseqs ] unit-test
+[ { "e" "ee" } ] [ "heellohello" R/ e+/r all-matching-subseqs ] unit-test
+
+[ 3 ] [ "1ABC2DEF3GHI4" R/ [A-Z]+/ count-matches ] unit-test
+
+[ 3 ] [ "1ABC2DEF3GHI4" R/ [A-Z]+/r count-matches ] unit-test
+
+[ 1 ] [ "" R/ / count-matches ] unit-test
+
+[ 1 ] [ "" R/ /r count-matches ] unit-test
+
+[ 0 ] [ "123" R/ [A-Z]+/ count-matches ] unit-test
+
+[ 0 ] [ "123" R/ [A-Z]+/r count-matches ] unit-test
+
+[ 6 ] [ "hello" R/ e*/ count-matches ] unit-test
+
+[ 6 ] [ "hello" R/ e*/r count-matches ] unit-test
+
+[ 11 ] [ "hello world" R/ l*/ count-matches ] unit-test
+
+[ 11 ] [ "hello world" R/ l*/r count-matches ] unit-test
+
+[ 1 ] [ "hello" R/ e+/ count-matches ] unit-test
 
-[ 0 ]
-[ "123" R/ [A-Z]+/ count-matches ] unit-test
+[ 2 ] [ "hello world" R/ l+/r count-matches ] unit-test
 
-[ "1.2.3.4." ]
-[ "1ABC2DEF3GHI4JK" R/ [A-Z]+/ "." re-replace ] unit-test
-  
+[ "1.2.3.4." ] [ "1ABC2DEF3GHI4JK" R/ [A-Z]+/ "." re-replace ] unit-test
+[ "XhXXlXlXoX XwXoXrXlXdX" ] [ "hello world" R/ e*/ "X" re-replace ] unit-test
 [ "-- title --" ] [ "== title ==" R/ =/ "-" re-replace ] unit-test
 
 [ "" ] [ "ab" "a(?!b)" <regexp> first-match >string ] unit-test

diff --git a/basis/regexp/regexp.factor b/basis/regexp/regexp.factor
index bbfe44096749edda70412c5235c722e3997da19a..de0c1a03a7afdb867d2ea3d3fe145a184006c1ec 100644 (file)
--- a/basis/regexp/regexp.factor
+++ b/basis/regexp/regexp.factor
@@ -50,33 +50,49 @@ PRIVATE>
 
 <PRIVATE
 
-:: (next-match) ( i string regexp quot: ( i string regexp -- j ) reverse? -- i start end ? )
-    i string regexp quot call dup [| j |
-        j i j
-        reverse? [ swap [ 1 + ] bi@ ] when
-        string
-    ] [ drop f f f f ] if ; inline
-
 : search-range ( i string reverse? -- seq )
-    [ drop dup 1 + -1 ] [ length 1 ] if range boa ; inline
+    [ drop -1 ] [ length ] if [a,b] ; inline
+
+:: (next-match) ( i string regexp quot: ( i string regexp -- j ) reverse? -- start end ? )
+    i string regexp quot call dup
+    [| j | reverse? [ j i ] [ i j ] if string ] [ drop f f f ] if ; inline
 
-:: next-match ( i string regexp quot: ( i string regexp -- j ) reverse? -- i start end ? )
-    f f f f
+:: next-match ( i string regexp quot: ( i string regexp -- j ) reverse? -- start end ? )
+    f f f
     i string reverse? search-range
-    [ [ 2drop 2drop ] dip string regexp quot reverse? (next-match) dup ] find 2drop ; inline
+    [ [ 3drop ] dip string regexp quot reverse? (next-match) dup ] find 2drop ; inline
 
-: do-next-match ( i string regexp -- i start end ? )
+: do-next-match ( i string regexp -- start end ? )
     dup next-match>>
-    execute( i string regexp -- i start end ? ) ; 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
+    execute( i string regexp -- start end ? ) ; inline
+
+:: (each-match-forward) ( ... i string regexp quot: ( ... start end string -- ... ) -- ... )
+    i string length <= [
+        i string regexp do-next-match [| start end |
+            start end string quot call
+            start end eq? [ end 1 +  ] [ end ] if
+            string regexp quot (each-match-forward)
+        ] [ 2drop ] if
+    ] when ; inline recursive
+
+:: (each-match-backward) ( ... i string regexp quot: ( ... start end string -- ... ) -- ... )
+    i -1 >= [
+        i string regexp do-next-match [| start end |
+            start 1 + end 1 + string quot call
+            start end eq? [ start 1 - ] [ start ] if
+            string regexp quot (each-match-backward)
+        ] [ 2drop ] if
+    ] when ; inline recursive
+
+: (each-match) ( ... i string regexp quot: ( ... start end string -- ... ) -- ... )
+    over reverse-regexp? [ (each-match-backward) ] [ (each-match-forward) ] if ; inline
+
+GENERIC: match-iterator-start ( string regexp -- start )
+M: regexp match-iterator-start 2drop 0 ;
+M: reverse-regexp match-iterator-start drop length ;
 
 : prepare-match-iterator ( string regexp -- i string regexp )
-    [ check-string ] dip [ end/start nip ] 2keep ; inline
+    [ check-string ] dip [ match-iterator-start ] 2keep ; inline
 
 PRIVATE>
 
@@ -107,12 +123,14 @@ PRIVATE>
 
 PRIVATE>
 
-: first-match ( string regexp -- slice/f )
-    [ prepare-match-iterator do-next-match ] [ drop ] 2bi
-    '[ _ slice boa nip ] [ 3drop f ] if ;
+:: first-match ( string regexp -- slice/f )
+    string regexp prepare-match-iterator do-next-match [
+        regexp reverse-regexp? [ [ 1 + ] bi@ ] when
+        string slice boa
+    ] [ 2drop f ] if ;
 
 : re-contains? ( string regexp -- ? )
-    prepare-match-iterator do-next-match [ 3drop ] dip >boolean ;
+    prepare-match-iterator do-next-match [ 2drop ] dip >boolean ;
 
 : re-split ( string regexp -- seq )
     [ slice boa ] (re-split) ;
@@ -141,7 +159,7 @@ M: reverse-regexp compile-regexp ( regexp -- regexp )
 
 DEFER: compile-next-match
 
-: next-initial-word ( i string regexp -- i start end string )
+: next-initial-word ( i string regexp -- start end string )
     [ compile-next-match ] with-compilation-unit do-next-match ;
 
 : compile-next-match ( regexp -- regexp )
@@ -149,7 +167,7 @@ DEFER: compile-next-match
         dup \ next-initial-word = [
             drop _ [ compile-regexp dfa>> def>> ] [ reverse-regexp? ] bi
             '[ { array-capacity string regexp } declare _ _ next-match ]
-            (( i string regexp -- i start end string )) define-temp
+            (( i string regexp -- start end string )) define-temp
         ] when
     ] change-next-match ;