Add subcaptures.

Raku · Jul 12, 2011 · 22b4fa8 · 22b4fa8
1 parent ec4c7a3
commit 22b4fa8
Show file tree

Hide file tree

Showing 2 changed files with 31 additions and 0 deletions.
diff --git a/src/QAST/Compiler.nqp b/src/QAST/Compiler.nqp
@@ -323,6 +323,28 @@ class QAST::Compiler is HLL::Compiler {
         $ops;
     }
 
+    method subcapture($node) {
+        my $ops := self.post_new('Ops', :result(%*REG<cur>));
+        my $prefix := self.unique('rxcap');
+        my $donelabel := self.post_new('Label', :result($prefix ~ '_done'));
+        my $faillabel := self.post_new('Label', :result($prefix ~ '_fail'));
+        my $name := $*PASTCOMPILER.as_post($node.name, :rtype<*>);
+        self.regex_mark($ops, $faillabel, %*REG<pos>, 0);
+        $ops.push(self.regex_post($node[0]));
+        self.regex_peek($ops, $faillabel, '$I11');
+        $ops.push($name);
+        $ops.push_pirop('repr_bind_attr_int', %*REG<cur>, %*REG<curclass>, '"$!pos"', '$I11');
+        $ops.push_pirop('callmethod', '"!cursor_start"', %*REG<cur>, :result<$P11>);
+        $ops.push_pirop('callmethod', '"!cursor_pass"', '$P11', %*REG<pos>);
+        $ops.push_pirop('callmethod', '"!cursor_capture"', %*REG<cur>, 
+                        '$P11', $name, :result(%*REG<caps>));
+        $ops.push_pirop('goto', $donelabel);
+        $ops.push($faillabel);
+        $ops.push_pirop('goto', %*REG<fail>);
+        $ops.push($donelabel);
+        $ops;
+    }
+
     method subrule($node) {
         my $ops := self.post_new('Ops', :result(%*REG<cur>));
         my $name := $*PASTCOMPILER.as_post($node.name, :rtype<*>);

diff --git a/src/QRegex/P6Regex/Actions.nqp b/src/QRegex/P6Regex/Actions.nqp
@@ -383,6 +383,15 @@ class QRegex::P6Regex::Actions is HLL::Actions {
                 %capnames{$_} := 1;
             }
         }
+        elsif $rxtype eq 'subcapture' {
+            for nqp::split(' ', $ast.name) {
+                if $_ eq '0' || $_ > 0 { $count := $_ + 1; }
+                %capnames{$_} := 1;
+            }
+            my %x := capnames($ast[0], $count);
+            for %x { %capnames{$_.key} := +%capnames{$_.key} + %x{$_.key} }
+            $count := %x{''};
+        }
         elsif $rxtype eq 'quant' {
             my %astcap := capnames($ast[0], $count);
             for %astcap { %capnames{$_} := 2 }