Initial version of backtracking. Adds Cursor.next and helper methods …

…to restart match from a given Cursor.

src/PAST/Compiler-Regex.pir

@@ -63,13 +63,15 @@ Return the POST representation of the regex AST rooted by C<node>.
     goto iter_loop
   iter_done:
 
-    .local pmc startlabel, donelabel, faillabel
+    .local pmc startlabel, donelabel, faillabel, restartlabel
     $S0 = concat prefix, 'start'
     startlabel = self.'post_new'('Label', 'result'=>$S0)
     $S0 = concat prefix, 'done'
     donelabel = self.'post_new'('Label', 'result'=>$S0)
     $S0 = concat prefix, 'fail'
     faillabel = self.'post_new'('Label', 'result'=>$S0)
+    $S0 = concat prefix, 'restart'
+    restartlabel = self.'post_new'('Label', 'result'=>$S0)
     reghash['fail'] = faillabel
 
     # If capnames is available, it's a hash where each key is the
@@ -119,7 +121,7 @@ Return the POST representation of the regex AST rooted by C<node>.
     concat $S0, pos
     concat $S0, ', '
     concat $S0, tgt
-    concat $S0, ')'
+    concat $S0, ', $I10)'
     ops.'push_pirop'('callmethod', '"!cursor_start"', 'self', 'result'=>$S0)
     unless caparray goto caparray_skip
     self.'!cursorop'(ops, '!cursor_caparray', 0, caparray :flat)
@@ -146,10 +148,13 @@ Return the POST representation of the regex AST rooted by C<node>.
     ops.'push_pirop'('sub', off, pos, 1, 'result'=>off)
     ops.'push_pirop'('substr', tgt, tgt, off, 'result'=>tgt)
     ops.'push'(startlabel)
+    ops.'push_pirop'('eq', '$I10', 1, restartlabel)
     self.'!cursorop'(ops, '!cursor_debug', 0, '"START "', regexname_esc)
 
     $P0 = self.'post_regex'(node)
     ops.'push'($P0)
+    ops.'push'(restartlabel)
+    self.'!cursorop'(ops, '!cursor_debug', 0, '"NEXT "', regexname_esc)
     ops.'push'(faillabel)
     self.'!cursorop'(ops, '!mark_fail', 4, rep, pos, '$I10', '$P10', 0)
     ops.'push_pirop'('lt', pos, CURSOR_FAIL, donelabel)

src/Regex/Cursor.pir

@@ -212,6 +212,26 @@ If C<regex> is omitted, then use the C<TOP> rule for the grammar.
 .end
 
 
+=item next()
+
+Return the next match from a successful Cursor.
+
+=cut
+
+.sub 'next' :method
+    .local pmc regex, cur, match
+    regex = getattribute self, '&!regex'
+    if null regex goto cur_fail
+    cur = self.regex()
+    goto cur_done
+  cur_fail:
+    cur = self.'!cursor_start'()
+  cur_done:
+    match = cur.'MATCH'()
+    .return (match)
+.end
+
+
 =item pos()
 
 Return the cursor's current position.
@@ -299,6 +319,10 @@ provided, then the new cursor has the same type as lang.
     parrotclass = getattribute $P0, 'parrotclass'
     cur = new parrotclass
 
+    .local pmc regex
+    regex = getattribute self, '&!regex'
+    unless null regex goto cursor_restart
+
     .local pmc from, target, debug
 
     from = getattribute self, '$!pos'
@@ -310,7 +334,28 @@ provided, then the new cursor has the same type as lang.
     debug = getattribute self, '$!debug'
     setattribute cur, '$!debug', debug
 
-    .return (cur, from, target)
+    .return (cur, from, target, 0)
+
+  cursor_restart:
+    .local pmc cstack, bstack
+    from   = getattribute self, '$!from'
+    target = getattribute self, '$!target'
+    debug  = getattribute self, '$!debug'
+    cstack = getattribute self, '@!cstack'
+    bstack = getattribute self, '@!bstack'
+
+    setattribute cur, '$!from', from
+    setattribute cur, '$!target', target
+    setattribute cur, '$!debug', debug
+    if null cstack goto cstack_done
+    cstack = clone cstack
+    setattribute cur, '@!cstack', cstack
+  cstack_done:
+    if null bstack goto bstack_done
+    bstack = clone bstack
+    setattribute cur, '@!bstack', bstack
+  bstack_done:
+    .return (cur, from, target, 1)
 .end