Optimize subrules further for the non-backtrack case

~+30%
sorear · Sep 8, 2010 · 981e8db · 981e8db
1 parent b6871bc
commit 981e8db
Show file tree

Hide file tree

Showing 5 changed files with 42 additions and 13 deletions.
diff --git a/src/CgOp.pm b/src/CgOp.pm
@@ -105,7 +105,7 @@ use warnings;
         my ($self, $nv) = @_;
         my $zyg = $self->zyg;
         for (my $i = 0; $i < @$zyg; $i++) {
-            $zyg->[$i] = $zyg->[$i]->cps_convert($i == $#$zyg);
+            $zyg->[$i] = $zyg->[$i]->cps_convert($nv && $i == $#$zyg);
         }
         $self->cps_type(2);
         $self->cps_type($zyg->[-1]->cps_type) if @$zyg;

diff --git a/src/CodeGen.pm b/src/CodeGen.pm
@@ -289,6 +289,9 @@ use 5.010;
 
     sub set_result {
         my ($self) = @_;
+        if (!@{ $self->stacktype }) {
+            print for @{ $self->buffer };
+        }
         $self->resulttype($self->stacktype->[-1]);
         $self->_emit("th.resultSlot = " . ($self->_popn(1))[0]);
     }

diff --git a/src/Optimizer/RxSimple.pm b/src/Optimizer/RxSimple.pm
@@ -39,9 +39,27 @@ sub RxOp::Sequence::mayback { my ($self) = @_;
 }
 
 sub RxOp::Cut::rxsimp { my ($self, $cut) = @_;
-    return $self->zyg->[0]->rxsimp(0) if !$self->zyg->[0]->mayback;
+    my $kid = $self->zyg->[0]->rxsimp(1);
+    return $kid unless $kid->mayback;
 
-    return RxOp::Cut->new(zyg => [$self->zyg->[0]->rxsimp(1)]);
+    return RxOp::Cut->new(zyg => [$kid]);
+}
+
+sub RxOp::Subrule::rxsimp { my ($self, $cut) = @_;
+    if (my $true = $self->true) {
+        return $true->rxsimp($cut);
+    }
+    if ($cut) {
+        return RxOp::Subrule->new(%$self, selfcut => 1);
+    }
+    return $self;
+}
+
+sub RxOp::Subrule::mayback { my ($self) = @_;
+    if (my $true = $self->true) {
+        return $true->mayback;
+    }
+    return !$self->selfcut;
 }
 
 1;
diff --git a/src/RxOp.pm b/src/RxOp.pm
@@ -287,6 +287,7 @@ use CgOp;
     has name     => (isa => 'Str', is => 'ro', required => 1);
     has captures => (isa => 'ArrayRef[Maybe[Str]]', is => 'ro', default => sub { [] });
     has arglist  => (isa => 'Maybe[ArrayRef[Op]]', is => 'ro');
+    has selfcut  => (isa => 'Bool', is => 'ro', default => 0);
 
     sub true {
         my ($self) = @_;
@@ -314,14 +315,19 @@ use CgOp;
         my @code;
         push @code, CgOp::rawcall(CgOp::rxframe, "PushCursorList",
             CgOp::rawnewarr('String', map { CgOp::clr_string($_) } @{ $self->captures }),
-            CgOp::methodcall(CgOp::methodcall(CgOp::methodcall(
-                CgOp::newscalar(CgOp::rawcall(CgOp::rxframe, "MakeCursor")),
-                $self->name), "list"), "clone"));
-        push @code, CgOp::goto($sk);
-        push @code, CgOp::label($bt);
-        push @code, CgOp::methodcall(CgOp::rawcall(CgOp::rxframe,
-                "GetCursorList"), "shift");
-        push @code, CgOp::label($sk);
+            ($self->selfcut ?
+                CgOp::methodcall(CgOp::newscalar(CgOp::rawcall(
+                            CgOp::rxframe, "MakeCursor")), $self->name) :
+                CgOp::methodcall(CgOp::methodcall(CgOp::methodcall(
+                    CgOp::newscalar(CgOp::rawcall(CgOp::rxframe, "MakeCursor")),
+                    $self->name), "list"), "clone")));
+        unless ($self->selfcut) {
+            push @code, CgOp::goto($sk);
+            push @code, CgOp::label($bt);
+            push @code, CgOp::sink(CgOp::methodcall(CgOp::rawcall(CgOp::rxframe,
+                    "GetCursorList"), "shift"));
+            push @code, CgOp::label($sk);
+        }
         push @code, CgOp::letn(
             "k", CgOp::fetch(CgOp::rawsccall('Kernel.GetFirst:c,Variable',
                 CgOp::fetch(CgOp::rawcall(CgOp::rxframe, "GetCursorList")))),
@@ -330,7 +336,8 @@ use CgOp;
                     CgOp::getfield("pos", CgOp::cast("Cursor",
                             CgOp::letvar("k")))),
                 CgOp::rawccall(CgOp::rxframe, "Backtrack")));
-        push @code, CgOp::rxpushb("SUBRULE", $bt);
+        push @code, CgOp::rxpushb("SUBRULE", $bt)
+            unless $self->selfcut;
 
         @code;
     }

diff --git a/test2.pl b/test2.pl
@@ -1,6 +1,7 @@
 # vim: ft=perl6
 use Test;
 
-say Q:CgOp { (rawsccall Kernel.GetFirst:c,Variable (@ { flat(1,2,3) })) };
+# one CgOp bug manifested as a failure to compile this
+ok (/ <?before x>: <ws>: /).defined, "unnamed regression";
 
 done-testing;