Refactoring next-match

diff --git a/basis/regexp/regexp.factor b/basis/regexp/regexp.factor
index d116bff73d1d5f137b58c818cf9aea4295c7370f..df253184c30894c1179eaeab34e8083a60edef06 100644 (file)
--- a/basis/regexp/regexp.factor
+++ b/basis/regexp/regexp.factor
@@ -56,23 +56,33 @@ PRIVATE>
 
 <PRIVATE
 
-: make-slice ( i j seq -- slice )
-    [ 2dup > [ swap [ 1+ ] bi@ ] when ] dip <slice> ; inline
+TUPLE: match { i read-only } { j read-only } { seq read-only } ;
 
-: match-slice ( i string quot -- slice/f )
+: match-slice ( i string quot -- match/f )
     [ 2dup ] dip call
-    [ swap make-slice ] [ 2drop f ] if* ; inline
+    [ swap match boa ] [ 2drop f ] if* ; inline
 
 : search-range ( i string reverse? -- seq )
     [ drop 0 [a,b] ] [ length [a,b) ] if ; inline
 
-:: next-match ( i string quot reverse? -- i slice/f )
+: 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
+
+:: next-match ( i string quot reverse? -- i start end string )
     i string reverse? search-range
     [ string quot match-slice ] map-find drop
-    [ dup [ reverse? [ from>> ] [ to>> ] if ] when ] keep ; inline
+    reverse? match>result ; inline
+
+: do-next-match ( i string regexp -- i start end string )
+    dup next-match>>
+    execute( i string regexp -- i start end string ) ;
 
-: do-next-match ( i string regexp -- i match/f )
-    dup next-match>> execute( i string regexp -- i match/f ) ; inline
+: next-slice ( i string regexp -- i/f slice/f )
+    do-next-match
+    [ slice boa ] [ drop ] if* ; inline
 
 PRIVATE>
 
@@ -84,7 +94,7 @@ TUPLE: match-iterator
 
 : iterate ( iterator -- iterator'/f )
     dup
-    [ i>> ] [ string>> ] [ regexp>> ] tri do-next-match
+    [ i>> ] [ string>> ] [ regexp>> ] tri next-slice
     [ [ [ string>> ] [ regexp>> ] bi ] 2dip match-iterator boa ]
     [ 2drop f ] if* ;
 
@@ -149,22 +159,20 @@ M: regexp compile-regexp ( regexp -- regexp )
 M: reverse-regexp compile-regexp ( regexp -- regexp )
     t backwards? [ do-compile-regexp ] with-variable ;
 
-GENERIC: compile-next-match ( regexp -- regexp )
+DEFER: compile-next-match
 
-: next-initial-word ( i string regexp -- i slice/f )
+: next-initial-word ( i string regexp -- i start end string )
     compile-next-match do-next-match ;
 
-M: regexp compile-next-match ( regexp -- regexp )
+: compile-next-match ( regexp -- regexp )
     dup '[
         dup \ next-initial-word = [
             drop _ [ compile-regexp dfa>> ] [ reverse-regexp? ] bi
             '[ _ '[ _ _ execute ] _ next-match ]
-            (( i string regexp -- i match/f )) simple-define-temp
+            (( i string regexp -- i start end string )) simple-define-temp
         ] when
     ] change-next-match ;
 
-! Write M: reverse-regexp compile-next-match
-
 PRIVATE>
 
 : new-regexp ( string ast options class -- regexp )