Implement <( and )>.

rakudo · May 12, 2012 · 04b1809 · 04b1809
1 parent cc71885
commit 04b1809
Show file tree

Hide file tree

Showing 3 changed files with 37 additions and 0 deletions.
diff --git a/src/Perl6/Actions.pm b/src/Perl6/Actions.pm
@@ -5212,6 +5212,16 @@ class Perl6::RegexActions is QRegex::P6Regex::Actions {
         }
         make $qast;
     }
+
+    method metachar:sym<from>($/) {
+        make QAST::Regex.new( :rxtype<subrule>, :subtype<method>,
+            PAST::Node.new('MARK_FROM'), :node($/) );
+    }
+
+    method metachar:sym<to>($/) {
+        make QAST::Regex.new( :rxtype<subrule>, :subtype<method>,
+            PAST::Node.new('MARK_TO'), :node($/) );
+    }
 
     method metachar:sym<rakvar>($/) {
         make QAST::Regex.new( PAST::Node.new('INTERPOLATE', $<var>.ast,

diff --git a/src/Perl6/Grammar.pm b/src/Perl6/Grammar.pm
@@ -2863,6 +2863,9 @@ grammar Perl6::RegexGrammar is QRegex::P6Regex::Grammar {
         <quote_EXPR: ':q', ':w'>
     }
 
+    token metachar:sym<from> { '<(' }
+    token metachar:sym<to> { ')>' }
+
     token assertion:sym<{ }> {
         <?[{]> <codeblock>
     }

diff --git a/src/core/Cursor.pm b/src/core/Cursor.pm
@@ -5,6 +5,24 @@ my class Cursor does NQPCursorRole {
     trusts Regex;
     my $last_match;
     method !set_last_match($m) { $last_match = $m }
+
+    # For <( and )>
+    has $!explicit_from;
+    has $!explicit_to;
+    method MARK_FROM() {
+        my int $pos = nqp::getattr_i(self, Cursor, '$!pos');
+        $!explicit_from = $pos;
+        my $cur := self.'!cursor_start'();
+        $cur.'!cursor_pass'($pos);
+        $cur
+    }
+    method MARK_TO() {
+        my int $pos = nqp::getattr_i(self, Cursor, '$!pos');
+        $!explicit_to = $pos;
+        my $cur := self.'!cursor_start'();
+        $cur.'!cursor_pass'($pos);
+        $cur
+    }
 
     method MATCH() {
         my $match := nqp::getattr(self, Cursor, '$!match');
@@ -30,6 +48,12 @@ my class Cursor does NQPCursorRole {
                   ?? nqp::bindpos($list, $key, $value)
                   !! nqp::bindkey($hash, $key, $value);
             }
+            if $!explicit_from.DEFINITE {
+                nqp::bindattr($match, Match, '$!from', $!explicit_from);
+            }
+            if $!explicit_to.DEFINITE {
+                nqp::bindattr($match, Match, '$!to',  $!explicit_to);
+            }
         }
         nqp::bindattr($match, Capture, '$!list', $list);
         nqp::bindattr($match, Capture, '$!hash', $hash);