[nrx] Reimplement simple cuts

lib/Cursor.cs

@@ -23,7 +23,8 @@ public struct State {
 
         public XAct xact;
     }
-    // invariant: xact of top state is NEVER committed/pruned
+    // the current State doesn't really have an xact; bt.obj.xact is used to
+    // hold the parent of what will become bt.next.obj.xact
 
     public PSN<State> bt;
 
@@ -37,13 +38,13 @@ public struct State {
     // cache of orig.Length
     public int end;
 
-    public RxFrame(Cursor csr) {
+    public RxFrame(string name, Cursor csr) {
         orig = csr.backing_ca;
         orig_s = csr.backing;
         end = orig.Length;
         bt = new PSN<State>(default(State), null);
         bt.obj.klasses = new PSN<DynMetaObject>(csr.klass, null);
-        bt.obj.xact = new XAct("MATCH", csr.xact);
+        bt.obj.xact = new XAct("RULE " + name, csr.xact);
         bt.obj.pos = csr.pos;
     }
 
@@ -68,15 +69,16 @@ public struct State {
 
             return th.caller;
         } else {
+            bt.obj.xact = bt.obj.xact.next;
             th.ip = bt.obj.ip;
             return th;
         }
     }
 
     public void PushBacktrack(string name, int ip) {
         bt.obj.ip = ip;
-        bt = new PSN<State>(bt.obj, bt);
         bt.obj.xact = new XAct(name, bt.obj.xact);
+        bt = new PSN<State>(bt.obj, bt);
     }
 
     public void CommitAll() {
@@ -92,19 +94,34 @@ public struct State {
         name = "RULE " + name;
         while (x != null) {
             x.committed = true;
-            x = x.next;
             if (x.tag.Equals(name))
                 break;
+            x = x.next;
         }
     }
 
     public void CommitRule() {
         XAct x = bt.next.obj.xact;
         while (x != null) {
             x.committed = true;
-            x = x.next;
             if (x.tag.StartsWith("RULE "))
                 break;
+            x = x.next;
+        }
+    }
+
+    public void CommitGroup(string open, string close) {
+        XAct x = bt.next.obj.xact;
+        int level = 1;
+        while (x != null) {
+            x.committed = true;
+            if (x.tag == open)
+                level--;
+            else if (x.tag == close)
+                level++;
+            x = x.next;
+            if (level == 0)
+                break;
         }
     }
 

src/CodeGen.pm

@@ -65,6 +65,7 @@ use 5.010;
               GetQuant     => [m => 'Int32'],
               OpenQuant    => [m => 'Void'],
               CloseQuant   => [m => 'Int32'],
+              CommitGroup  => [m => 'Void'],
               Backtrack    => [c => 'Void'],
               End          => [c => 'Void'] },
         'Niecza.FatalException' =>

src/Niecza/Actions.pm

@@ -379,7 +379,7 @@ sub regex_def { my ($cl, $M) = @_;
             class => 'Regex',
             type  => 'regex',
             signature => $sig->for_regex,
-            do => Op::RegexBody->new(rxop => $ast)));
+            do => Op::RegexBody->new(name => ($name // ''), rxop => $ast)));
 }
 
 sub regex_declarator { my ($cl, $M) = @_;

src/Op.pm

@@ -1014,6 +1014,7 @@ use CgOp;
     extends 'Op';
 
     has rxop => (isa => 'RxOp', is => 'ro', required => 1);
+    has name => (isa => 'Str', is => 'ro', default => '');
 
     sub zyg { $_[0]->rxop->opzyg }
 
@@ -1022,8 +1023,8 @@ use CgOp;
 
         CgOp::prog(
             CgOp::setfield('rx', CgOp::callframe,
-                CgOp::rawnew('RxFrame', CgOp::cast('Cursor',
-                        CgOp::fetch(CgOp::scopedlex('$¢'))))),
+                CgOp::rawnew('RxFrame', CgOp::clr_string($self->name),
+                    CgOp::cast('Cursor', CgOp::fetch(CgOp::scopedlex('$¢'))))),
             $self->rxop->code($body),
             CgOp::rawccall(CgOp::getfield('rx', CgOp::callframe), 'End'),
             CgOp::rawccall(CgOp::getfield('rx', CgOp::callframe), 'Backtrack'),

src/RxOp.pm

@@ -188,16 +188,17 @@ use CgOp;
     use Moose;
     extends 'RxOp';
 
-    sub op {
-        my ($self, $cn, $cont) = @_;
+    sub code {
+        my ($self, $body) = @_;
 
-        my $icn = Niecza::Actions->gensym;
-        $icn, Op::CallSub->new(
-            invocant => Op::Lexical->new(name => '&_rxcut'),
-            positionals => [
-                Op::Lexical->new(name => $icn),
-                $self->_close_op($self->zyg->[0]),
-                $self->_close_k($cn, $cont)]);
+        my @code;
+        push @code, CgOp::rxpushb("CUTGRP");
+        push @code, $self->zyg->[0]->code($body);
+        push @code, CgOp::rawcall(CgOp::rxframe, 'CommitGroup',
+            CgOp::clr_string("CUTGRP"), CgOp::clr_string("ENDCUTGRP"));
+        push @code, CgOp::rxpushb("ENDCUTGRP");
+
+        @code;
     }
 
     sub lad {

test2.pl

@@ -70,14 +70,14 @@
 #     ok !G3.parse("y"), "capturing subrules work (negative)";
 # }
 # 
-# {
-#     ok ("aab" ~~ /a* ab/), "a*ab backtracks";
-#     ok !("aab" ~~ /a*: ab/), "a*: ab doesn't";
-#     ok ("aab" ~~ /a*! ab/), "a*! ab backtracks";
-#     ok !("aab" ~~ /:r a* ab/), "ratcheting a* ab does not";
-#     ok !("aab" ~~ /:r a*: ab/), "ratcheting a*: ab does not";
-#     ok ("aab" ~~ /:r a*! ab/), "ratcheting a*! ab does";
-#     ok !("aab" ~~ token { a* ab }), "a* ab in a token does not";
+{
+    ok ("aab" ~~ /a* ab/), "a*ab backtracks";
+    ok !("aab" ~~ /a*: ab/), "a*: ab doesn't";
+    ok ("aab" ~~ /a*! ab/), "a*! ab backtracks";
+    ok !("aab" ~~ /:r a* ab/), "ratcheting a* ab does not";
+    ok !("aab" ~~ /:r a*: ab/), "ratcheting a*: ab does not";
+    ok ("aab" ~~ /:r a*! ab/), "ratcheting a*! ab does";
+    ok !("aab" ~~ token { a* ab }), "a* ab in a token does not";
 # 
 #     ok ("ab ab" ~~ / ab <.ws> ab /), "ws matches a space";
 #     ok (q:to/end/ ~~ / ab <.ws> ab /), "ws matches a newline";
@@ -87,7 +87,7 @@
 #     ok ("ab   ab" ~~ / ab <.ws> ab /), "ws matches several spaces";
 #     ok !("abab" ~~ / ab <.ws> ab /), "ws does not match nothing";
 #     ok ("ab   ab" ~~ rule { ab ab }), "rule gives space";
-# }
+}
 # 
 # {
 #     # doing a more reasonable test will probably require embedded blocks