enable non-capturing groups and named captures

Raku · Aug 19, 2013 · 210cd15 · 210cd15
1 parent 8733f0e
commit 210cd15
Show file tree

Hide file tree

Showing 2 changed files with 23 additions and 4 deletions.
diff --git a/src/QRegex/P5Regex/Actions.nqp b/src/QRegex/P5Regex/Actions.nqp
@@ -99,8 +99,20 @@ class QRegex::P5Regex::Actions is HLL::Actions {
         );
     }
 
-    method p5metachar:sym<(? )>($/) {
-        make $<assertion>.ast;
+    method p5metachar:sym<(? )>($/) { # like P6's $<name>=[ ... ]
+        my $qast;
+        if $<nibbler> {
+            $qast := QAST::Regex.new( :rxtype<subcapture>, :name(~$<name>),
+                $<nibbler>.ast, :node($/) );
+        }
+        else {
+            $qast := $<assertion>.ast;
+        }
+        make $qast;
+    }
+
+    method p5metachar:sym<(?: )>($/) {
+        make $<nibbler>.ast;
     }
 
     method p5metachar:sym<( )>($/) {

diff --git a/src/QRegex/P5Regex/Grammar.nqp b/src/QRegex/P5Regex/Grammar.nqp
@@ -86,6 +86,7 @@ grammar QRegex::P5Regex::Grammar is HLL::Grammar {
     proto token p5metachar { <...> }
 
     token p5metachar:sym<quant> {
+        <![(?]>
         <quantifier=p5quantifier>
         <.panic: "quantifier quantifies nothing">
     }
@@ -96,9 +97,15 @@ grammar QRegex::P5Regex::Grammar is HLL::Grammar {
         '$' <?before \W | $>
     }
     token p5metachar:sym<(? )> {
-        '(?' {} <assertion=p5assertion>
-        [ ')' || <.panic: "Perl 5 regex assertion not terminated by parenthesis"> ]
+        '(?' <![?]>
+            [
+            | <?[<]> '<' $<name>=[<-[>]>+] '>' {} <nibbler>
+            | <?[']> "'" $<name>=[<-[']>+] "'" {} <nibbler>
+            | <assertion=p5assertion>
+            ]
+        [ ')' || <.panic: "Perl 5 named capture group not terminated by parenthesis"> ]
     }
+    token p5metachar:sym<(?: )> { '(?:' {} <nibbler> ')' }
     token p5metachar:sym<( )> { '(' {} <nibbler> ')' }
     token p5metachar:sym<[ ]> { <?before '['> <cclass> }