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

[factor.git] / basis / regexp / regexp.factor

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 ;