traversal flags machinery in place, lookahead works but shouldnt create capturing...

diff --git a/unfinished/regexp/dfa/dfa.factor b/unfinished/regexp/dfa/dfa.factor
index 6200a1b3c0408e4eea17261edd8fa5e450909f7b..cd6dab6a064172819591b2bc18a4cbb48fbfb438 100644 (file)
--- a/unfinished/regexp/dfa/dfa.factor
+++ b/unfinished/regexp/dfa/dfa.factor
@@ -68,12 +68,16 @@ IN: regexp.dfa
     1vector >>new-states drop ;
 
 : set-traversal-flags ( regexp -- )
-    [ dfa-table>> transitions>> keys ]
+    dup
     [ nfa-traversal-flags>> ]
-    bi 2drop ;
+    [ dfa-table>> transitions>> keys ] bi
+    [ tuck [ swap at ] with map concat ] with H{ } map>assoc
+    >>dfa-traversal-flags drop ;
 
 : construct-dfa ( regexp -- )
-    [ set-initial-state ]
-    [ new-transitions ]
-    [ set-final-states ] tri ;
-    ! [ set-traversal-flags ] quad ;
+    {
+        [ set-initial-state ]
+        [ new-transitions ]
+        [ set-final-states ]
+        [ set-traversal-flags ]
+    } cleave ;

diff --git a/unfinished/regexp/regexp-tests.factor b/unfinished/regexp/regexp-tests.factor
index 78098952d3d3c18624d3949b3f11199026d2874c..ab3bca9eadf7c34e516df7c119ad1ef398d5cbb4 100644 (file)
--- a/unfinished/regexp/regexp-tests.factor
+++ b/unfinished/regexp/regexp-tests.factor
@@ -251,8 +251,8 @@ IN: regexp-tests
 ! [ t ] [ "fxxbar" "(?!foo).{3}bar" <regexp> matches? ] unit-test
 ! [ f ] [ "foobar" "(?!foo).{3}bar" <regexp> matches? ] unit-test
 
-! [ 3 ] [ "foobar" "foo(?=bar)" <regexp> match-head ] unit-test
-! [ f ] [ "foobxr" "foo(?=bar)" <regexp> match-head ] unit-test
+[ 3 ] [ "foobar" "foo(?=bar)" <regexp> match-head ] unit-test
+[ f ] [ "foobxr" "foo(?=bar)" <regexp> match-head ] unit-test
 
 ! [ f ] [ "foobxr" "foo\\z" <regexp> match-head ] unit-test
 ! [ 3 ] [ "foo" "foo\\z" <regexp> match-head ] unit-test

diff --git a/unfinished/regexp/traversal/traversal.factor b/unfinished/regexp/traversal/traversal.factor
index cfc97aff292455a412af90b1d65a0e68e2c6511f..6f41b16d950b627a8407af0803225e855ae4f443 100644 (file)
--- a/unfinished/regexp/traversal/traversal.factor
+++ b/unfinished/regexp/traversal/traversal.factor
@@ -1,8 +1,8 @@
 ! Copyright (C) 2008 Doug Coleman.
 ! See http://factorcode.org/license.txt for BSD license.
 USING: accessors assocs combinators kernel math math.ranges
-quotations sequences regexp.parser regexp.classes
-combinators.short-circuit regexp.utils ;
+quotations sequences regexp.parser regexp.classes fry
+combinators.short-circuit regexp.utils prettyprint regexp.nfa ;
 IN: regexp.traversal
 
 TUPLE: dfa-traverser
@@ -10,7 +10,7 @@ TUPLE: dfa-traverser
     traversal-flags
     capture-groups
     { capture-group-index integer }
-    { lookahead-counter integer }
+    lookahead-counters
     last-state current-state
     text
     start-index current-index
@@ -26,7 +26,8 @@ TUPLE: dfa-traverser
         0 >>start-index
         0 >>current-index
         V{ } clone >>matches
-        V{ } clone >>capture-groups ;
+        V{ } clone >>capture-groups
+        V{ } clone >>lookahead-counters ;
 
 : final-state? ( dfa-traverser -- ? )
     [ current-state>> ] [ dfa-table>> final-states>> ] bi
@@ -43,9 +44,21 @@ TUPLE: dfa-traverser
         dup save-final-state
     ] when text-finished? ;
 
-: print-flags ( dfa-traverser -- dfa-traverser )
+GENERIC: flag-action ( dfa-traverser flag -- )
+
+M: lookahead-on flag-action ( dfa-traverser flag -- )
+    drop
+    lookahead-counters>> 0 swap push ;
+
+M: lookahead-off flag-action ( dfa-traverser flag -- )
+    drop
+    dup lookahead-counters>> pop
+    '[ _ - ] change-current-index drop ;
+
+: process-flags ( dfa-traverser -- )
+    [ [ 1+ ] map ] change-lookahead-counters
     dup [ current-state>> ] [ traversal-flags>> ] bi
-    ;
+    at [ dup . flag-action ] with each ;
 
 : increment-state ( dfa-traverser state -- dfa-traverser )
     [
@@ -79,6 +92,7 @@ TUPLE: dfa-traverser
     [ nth ] 2dip ;
 
 : do-match ( dfa-traverser -- dfa-traverser )
+    dup process-flags
     dup match-done? [
         dup setup-match match-transition
         [ increment-state do-match ] when*