Use inline code expansions for quantifiers

Suprisingly, even without lexical let working, this is -20K to test bytecode.
sorear · Aug 15, 2010 · 4f89f0b · 4f89f0b
1 parent 14138d4
commit 4f89f0b
Show file tree

Hide file tree

Showing 2 changed files with 48 additions and 23 deletions.
diff --git a/RxOp.pm b/RxOp.pm
@@ -99,16 +99,55 @@ use CgOp;
     # zyg * 1
 
     my %qf = ( '+', 'plus', '*', 'star', '?', 'opt' );
-    sub op {
+    sub op { goto &{ $_[0]->can('op_' . $qf{$_[0]->type}) }; }
+
+    sub op_opt {
         my ($self, $cn, $cont) = @_;
-        my $icn = Niecza::Actions->gensym;
-        $icn, Op::CallSub->new(
-            invocant => Op::Lexical->new(name => '&_rx' . $qf{$self->type} .
-                ($self->minimal ? 'g' : '')),
-            positionals => [
-                Op::Lexical->new(name => $icn),
-                $self->_close_op($self->zyg->[0]),
-                $self->_close_k($cn, $cont)]);
+        my $kcl = $self->_close_k($cn, $cont);
+        my $zzcn = Niecza::Actions->gensym;
+        my ($zcn, $zcont) = $self->zyg->[0]->op($zzcn,
+            Op::CallSub->new(invocant => Op::Lexical->new(name => $kcl->var),
+                positionals => [Op::Lexical->new(name => $zzcn)]));
+        $zcn, Op::StatementList->new(children => [
+                $kcl, $zcont, Op::CallSub->new(
+                    invocant => Op::Lexical->new(name => $kcl->var),
+                    positionals => [Op::Lexical->new(name => $zcn)])]);
+    }
+
+    # (sub loop($C) { zyg($C, &loop); cont($C) })($C)
+    sub op_star {
+        my ($self, $cn, $cont) = @_;
+        my $lpn =  Niecza::Actions->gensym;
+        my $zzcn = Niecza::Actions->gensym;
+        my ($zcn, $zcont) = $self->zyg->[0]->op($zzcn, Op::CallSub->new(
+                invocant => Op::Lexical->new(name => $lpn),
+                positionals => [Op::Lexical->new(name => $zzcn)]));
+        $cn, Op::CallSub->new(
+            invocant => Op::SubDef->new(var => $lpn, class => 'Sub', body =>
+                Body->new(type => 'sub', signature => Sig->simple($zcn), do =>
+                    Op::StatementList->new(children => [ $zcont,
+                            Op::CallSub->new(
+                                invocant => $self->_close_k($cn, $cont),
+                                positionals => [Op::Lexical->new(name => $zcn)])]))),
+            positionals => [Op::Lexical->new(name => $cn)]);
+    }
+
+    # (sub loop($C) { zyg($C, -> $nC { loop($nC); cont($nC) }) })($C)
+    sub op_plus {
+        my ($self, $cn, $cont) = @_;
+        my $lpn =  Niecza::Actions->gensym;
+        my ($zcn, $zcont) = $self->zyg->[0]->op($cn, Op::StatementList->new(
+                children => [
+                    Op::CallSub->new(
+                        invocant => Op::Lexical->new(name => $lpn),
+                        positionals => [Op::Lexical->new(name => $cn)]),
+                    $cont
+                ]));
+        $cn, Op::CallSub->new(
+            invocant => Op::SubDef->new(var => $lpn, class => 'Sub', body =>
+                Body->new(type => 'sub', signature => Sig->simple($zcn), do =>
+                    $zcont)),
+            positionals => [Op::Lexical->new(name => $cn)]);
     }
 
     sub lad {

diff --git a/SAFE.setting b/SAFE.setting
@@ -893,20 +893,6 @@ my class Cursor {
     }
 }
 
-sub _rxstar($C, $f, $k) {
-    $f($C, -> $nC { _rxstar($nC, $f, $k) });
-    $k($C);
-}
-
-sub _rxopt($C, $f, $k) {
-    $f($C, $k);
-    $k($C);
-}
-
-sub _rxplus($C, $f, $k) {
-    $f($C, -> $nC { _rxstar($nC, $f, $k) });
-}
-
 sub _rxstr($C, $str, $k) {
     #say "_rxstr : " ~ ($C.str ~ (" @ " ~ ($C.from ~ (" ? " ~ $str))));
     Q:CgOp {