Allow PAST::Regex subrule nodes to have arguments to pass to the subr…

…ule. Implement simple backreferences.
perl6 · Oct 13, 2009 · 568cc9b · 568cc9b
1 parent 4481429
commit 568cc9b
Show file tree

Hide file tree

Showing 3 changed files with 57 additions and 6 deletions.
diff --git a/src/PAST/Compiler-Regex.pir b/src/PAST/Compiler-Regex.pir
@@ -810,9 +810,9 @@ Perform a subrule call.
     name = self.'as_post'($P0, 'rtype'=>'*')
     ops.'push'(name)
 
-    .local pmc subpast, subpost
-    subpast = node[0]
-    subpost = self.'as_post'(subpast, 'rtype'=>'*')
+    .local pmc cpost, posargs, namedargs, subpost
+    (cpost, posargs, namedargs) = self.'post_children'(node, 'signature'=>'v:')
+    subpost = shift posargs
 
     .local pmc negate
     .local string testop
@@ -822,11 +822,11 @@ Perform a subrule call.
     .local pmc subtype
     subtype = node.'subtype'()
 
-    ops.'push_pirop'('inline', name, subtype, negate, 'inline'=>"  # rx subrule %0 subtype=%1 negate=%2")
+    ops.'push_pirop'('inline', subpost, subtype, negate, 'inline'=>"  # rx subrule %0 subtype=%1 negate=%2")
 
     self.'!cursorop'(ops, '!cursor_pos', 0, pos)
-    ops.'push'(subpost)
-    ops.'push_pirop'('callmethod', subpost, cur, 'result'=>'$P10')
+    ops.'push'(cpost)
+    ops.'push_pirop'('callmethod', subpost, cur, posargs :flat, namedargs :flat, 'result'=>'$P10')
     ops.'push_pirop'(testop, '$P10', fail)
     if subtype == 'zerowidth' goto done
     ops.'push_pirop'('callmethod', '"pos"', '$P10', 'result'=>pos)

diff --git a/src/Regex/Cursor.pir b/src/Regex/Cursor.pir
@@ -721,6 +721,53 @@ Perform any action associated with the current regex match.
 .end
 
 
+=item !BACKREF(name)
+
+Match the backreference given by C<name>.
+
+=cut
+
+.sub '!BACKREF' :method
+    .param string name
+    .local pmc cur
+    .local int pos, eos
+    .local string tgt
+    (cur, pos, tgt) = self.'!cursor_start'()
+
+    # search the cursor cstack for the latest occurrence of C<name>
+    .local pmc cstack
+    cstack = getattribute self, '@!cstack'
+    if null cstack goto pass
+    .local int cstack_it
+    cstack_it = elements cstack
+  cstack_loop:
+    dec cstack_it
+    unless cstack_it >= 0 goto pass
+    .local pmc subcur
+    subcur = cstack[cstack_it]
+    $P0 = getattribute subcur, '$!names'
+    if null $P0 goto cstack_loop
+    $S0 = $P0
+    if name != $S0 goto cstack_loop
+    # we found a matching subcursor, get the literal it matched
+  cstack_done:
+    .local int litlen
+    .local string litstr
+    $I1 = subcur.'pos'()
+    $I0 = subcur.'from'()
+    litlen = $I1 - $I0
+    litstr = substr tgt, $I0, litlen
+    # now test the literal against our target
+    $S0 = substr tgt, pos, litlen
+    unless $S0 == litstr goto fail
+    pos += litlen
+  pass:
+    cur.'!cursor_pass'(pos, '')
+  fail:
+    .return (cur)
+.end
+
+
 =back
 
 =head2 Vtable functions

diff --git a/src/Regex/P6Regex/Actions.pm b/src/Regex/P6Regex/Actions.pm
@@ -178,6 +178,10 @@ method metachar:sym<var>($/) {
             $past.name($name); 
         }
     }
+    else {
+        $past := PAST::Regex.new( '!BACKREF', $name, :pasttype('subrule'),
+                                  :subtype('method') );
+    }
     make $past;
 }