Merge branch 'highexpect'

Raku · Dec 10, 2012 · 80fed8e · 80fed8e
2 parents 03aa465 + 45ecaf8
commit 80fed8e
Show file tree

Hide file tree

Showing 4 changed files with 57 additions and 30 deletions.
diff --git a/src/QAST/Compiler.nqp b/src/QAST/Compiler.nqp
@@ -1239,6 +1239,12 @@ class QAST::Compiler is HLL::Compiler {
 
         $ops;
     }
+
+    method dba($node) {
+        my $ops := self.post_new('Ops', :result(%*REG<cur>));
+        $ops.push_pirop('callmethod', '"!dba"', %*REG<cur>, %*REG<pos>, self.escape($node.name));
+        $ops
+    }
 
     my %cclass_code;
     INIT {

diff --git a/src/QRegex/Cursor.nqp b/src/QRegex/Cursor.nqp
@@ -3,6 +3,7 @@ my class ParseShared {
     has $!orig;
     has str $!target;
     has int $!highwater;
+    has @!highexpect;
 }
 
 role NQPCursorRole is export {
@@ -79,6 +80,7 @@ role NQPCursorRole is export {
             nqp::bindattr_s($shared, ParseShared, '$!target',
                 pir::trans_encoding__Ssi($orig, pir::find_encoding__Is('ucs4')));
             nqp::bindattr_i($shared, ParseShared, '$!highwater', 0);
+            nqp::bindattr($shared, ParseShared, '@!highexpect', nqp::list());
         }
         nqp::bindattr($new, $?CLASS, '$!shared', $shared);
         if nqp::defined($c) {
@@ -308,11 +310,41 @@ role NQPCursorRole is export {
         }
     }
 
+    method !dba(int $pos, str $dba) {
+        my $shared := $!shared;
+        my int $highwater := nqp::getattr_i($shared, ParseShared, '$!highwater');
+        my $highexpect;
+        if $pos >= $highwater {
+            $highexpect := nqp::getattr($shared, ParseShared, '@!highexpect');
+            if $pos > $highwater {
+                pir::assign__0Pi($highexpect, 0);
+                nqp::bindattr_i($shared, ParseShared, '$!highwater', $pos);
+            }
+            nqp::push_s($highexpect, $dba);
+        }
+    }
+
     method !highwater() {
         nqp::getattr_i($!shared, ParseShared, '$!highwater')
     }
 
+    method !highexpect() {
+        nqp::getattr($!shared, ParseShared, '@!highexpect')
+    }
+
+    method !fresh_highexpect() {
+        my @old := nqp::getattr($!shared, ParseShared, '@!highexpect');
+        nqp::bindattr($!shared, ParseShared, '@!highexpect', []);
+        @old
+    }
+
+    method !set_highexpect(@highexpect) {
+        nqp::bindattr($!shared, ParseShared, '@!highexpect', @highexpect)
+    }
+
     method !clear_highwater() {
+        my $highexpect := nqp::getattr($!shared, ParseShared, '@!highexpect');
+        pir::assign__0Pi($highexpect, 0);
         nqp::bindattr_i($!shared, ParseShared, '$!highwater', -1)
     }
 
@@ -351,19 +383,24 @@ role NQPCursorRole is export {
 
     method before($regex) {
         my int $orig_highwater := nqp::getattr_i($!shared, ParseShared, '$!highwater');
+        my $orig_highexpect := nqp::getattr($!shared, ParseShared, '@!highexpect');
+        nqp::bindattr($!shared, ParseShared, '@!highexpect', []);
         my $cur := self."!cursor_start"();
         nqp::bindattr_i($cur, $?CLASS, '$!pos', $!pos);
         nqp::getattr_i($regex($cur), $?CLASS, '$!pos') >= 0 ??
             $cur."!cursor_pass"($!pos, 'before') !!
             nqp::bindattr_i($cur, $?CLASS, '$!pos', -3);
         nqp::bindattr_i($!shared, ParseShared, '$!highwater', $orig_highwater);
+        nqp::bindattr($!shared, ParseShared, '@!highexpect', $orig_highexpect);
         $cur;
     }
 
     # Expects to get a regex whose syntax tree was flipped during the
     # compile.
     method after($regex) {
         my int $orig_highwater := nqp::getattr_i($!shared, ParseShared, '$!highwater');
+        my $orig_highexpect := nqp::getattr($!shared, ParseShared, '@!highexpect');
+        nqp::bindattr($!shared, ParseShared, '@!highexpect', []);
         my $cur := self."!cursor_start"();
         my str $target := nqp::getattr_s($!shared, ParseShared, '$!target');
         my $shared := pir::repr_clone__PP($!shared);
@@ -375,6 +412,7 @@ role NQPCursorRole is export {
             $cur."!cursor_pass"($!pos, 'after') !!
             nqp::bindattr_i($cur, $?CLASS, '$!pos', -3);
         nqp::bindattr_i($!shared, ParseShared, '$!highwater', $orig_highwater);
+        nqp::bindattr($!shared, ParseShared, '@!highexpect', $orig_highexpect);
         $cur;
     }
 

diff --git a/src/QRegex/NFA.nqp b/src/QRegex/NFA.nqp
@@ -74,6 +74,10 @@ class QRegex::NFA {
     method anchor($node, int $from, int $to) { 
         self.addedge($from, $to, $EDGE_EPSILON, 0);
     }
+
+    method dba($node, int $from, int $to) { 
+        self.addedge($from, $to, $EDGE_EPSILON, 0);
+    }
 
     my %cclass_code;
     INIT {
@@ -274,34 +278,6 @@ class QRegex::NFA {
         $!states
     }
 
-    method qast(:$non_empty) {
-        unless $!edges {
-            return 0 unless $non_empty;
-            self.addedge(1, 0, $EDGE_FATE, 0, :newedge(1)) 
-        }
-        my $past := QAST::Op.new(:op<list>);
-        for $!states -> @values {
-            my $list := QAST::Op.new(:op<list>);
-            for @values {
-                if nqp::islist($_) {
-                    my $arglist := QAST::Op.new( :op('list_i') );
-                    for $_ -> $i {
-                        $arglist.push(QAST::IVal.new( :value($i) ));
-                    }
-                    $list.push($arglist);
-                }
-                elsif +$_ eq $_ {
-                    $list.push(QAST::IVal.new( :value($_) ));
-                }
-                else {
-                    $list.push(QAST::SVal.new( :value($_) ));
-                }
-            }
-            $past.push($list);
-        }
-        $past;
-    }
-
     method mergesubrule(int $start, int $to, $fate, $cursor, str $name, %caller_seen?) {
         #nqp::say("adding $name");
         my %seen := nqp::clone(%caller_seen);

diff --git a/src/QRegex/P6Regex/Actions.nqp b/src/QRegex/P6Regex/Actions.nqp
@@ -259,6 +259,8 @@ class QRegex::P6Regex::Actions is HLL::Actions {
             :rxtype<concat>
         );
     }
+
+    method metachar:sym<mod>($/) { make $<mod_internal>.ast; }
 
     method backslash:sym<s>($/) {
         make QAST::Regex.new(:rxtype<cclass>, '.CCLASS_WHITESPACE', 
@@ -524,7 +526,12 @@ class QRegex::P6Regex::Actions is HLL::Actions {
     method mod_internal($/) {
         if $<quote_EXPR> {
             if $<quote_EXPR>[0].ast ~~ QAST::SVal {
-                %*RX{ ~$<mod_ident><sym> } := $<quote_EXPR>[0].ast.value;
+                my $key := ~$<mod_ident><sym>;
+                my $val := $<quote_EXPR>[0].ast.value;
+                %*RX{$key} := $val;
+                make $key eq 'dba'
+                    ?? QAST::Regex.new( :rxtype('dba'), :name($val) )
+                    !! 0;
             }
             else {
                 $/.CURSOR.panic("Internal modifier strings must be literals");
@@ -533,8 +540,8 @@ class QRegex::P6Regex::Actions is HLL::Actions {
         else {
             my $n := $<n>[0] gt '' ?? +$<n>[0] !! 1;
             %*RX{ ~$<mod_ident><sym> } := $n;
+            make 0;
         }
-        make 0;
     }
 
     sub backmod($ast, $backmod) {