Enable regexes to use beta-opt

sorear · Aug 17, 2010 · aae0b1f · aae0b1f
1 parent d059983
commit aae0b1f
Show file tree

Hide file tree

Showing 3 changed files with 11 additions and 7 deletions.
diff --git a/Op.pm b/Op.pm
@@ -985,6 +985,8 @@ use CgOp;
     extends 'Op';
 
     has signature   => (isa => 'Sig', is => 'ro', required => 1);
+    # positionals *really* should be a bunch of gensym Lexical's, or else
+    # you risk shadowing hell.  this needs to be handled at a different level
     has positionals => (isa => 'ArrayRef[Op]', is => 'ro', required => 1);
 
     sub zyg { @{ $_[0]->positionals } }
@@ -998,7 +1000,8 @@ use CgOp;
         my ($self, $body) = @_;
 
         CgOp::prog(
-            $self->signature->bind_inline($body, @{ $self->positionals }),
+            $self->signature->bind_inline($body,
+                map { $_->cgop($body) } @{ $self->positionals }),
             CgOp::null('Variable'));
     }
 

diff --git a/Optimizer/Beta.pm b/Optimizer/Beta.pm
@@ -87,7 +87,7 @@ sub beta_optimize {
     @{ $body->decls } = grep { !$_->isa('Decl::Sub') ||
         $_->code != $ib } @{ $body->decls };
 
-    my @pos = (map { Op::Lexical->new(name => $_->[0]) } @args);
+    my @pos = (map { Op::Lexical->new(name => $_->[1]) } @args);
 
     my $nop = Op::StatementList->new(children => [
         Op::SigBind->new(signature => $ib->signature,

diff --git a/RxOp.pm b/RxOp.pm
@@ -18,7 +18,7 @@ use CgOp;
     sub _close {
         my ($self, $type, $parms, $op) = @_;
         Op::SubDef->new(var => Niecza::Actions->gensym, class => ucfirst($type),
-            body => Body->new(
+            once => 1, body => Body->new(
                 type        => $type,
                 signature   => Sig->simple(@$parms),
                 do          => $op));
@@ -123,7 +123,8 @@ use CgOp;
                 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 =>
+            invocant => Op::SubDef->new(var => $lpn, class => 'Sub',
+                once => 1, body =>
                 Body->new(type => 'sub', signature => Sig->simple($zcn), do =>
                     Op::StatementList->new(children => [ $zcont,
                             Op::CallSub->new(
@@ -144,9 +145,9 @@ use CgOp;
                     $cont
                 ]));
         $cn, Op::CallSub->new(
-            invocant => Op::SubDef->new(var => $lpn, class => 'Sub', body =>
-                Body->new(type => 'sub', signature => Sig->simple($zcn), do =>
-                    $zcont)),
+            invocant => Op::SubDef->new(var => $lpn, class => 'Sub', once => 1,
+                body => Body->new(type => 'sub', signature =>
+                    Sig->simple($zcn), do => $zcont)),
             positionals => [Op::Lexical->new(name => $cn)]);
     }