Skip to content

Commit

Permalink
Allow regex embedded blocks to be inlined
Browse files Browse the repository at this point in the history
  • Loading branch information
@sorear
sorear committed Oct 25, 2010
1 parent 71c2d1e commit 08e051c
Show file tree
Hide file tree
Showing 5 changed files with 70 additions and 39 deletions.
25 changes: 14 additions & 11 deletions src/Metamodel.pm
View file
Expand Up @@ -519,6 +519,16 @@ our %units;
return ($self->outer ? $self->outer->find_lex($name) : undef);
}

sub delete_lex { my ($self, $name) = @_;
my $l = $self->lexicals->{$name};
if ($l) {
if ($l->isa('Metamodel::Lexical::Alias')) { $self->delete_lex($l->to) }
else { delete $self->lexicals->{$name} }
} else {
$self->outer && $self->outer->delete_lex($name);
}
}

sub add_my_name { my ($self, $slot, @ops) = @_;
$self->lexicals->{$slot} = Metamodel::Lexical::Simple->new(@ops);
}
Expand Down Expand Up @@ -806,21 +816,14 @@ sub Body::begin {
$metabody->signature($self->signature);
}

if ($self->type && $self->type eq 'regex') {
$metabody->add_my_name('$*/');
}

pop @opensubs if $self->transparent;

my $do = $self->do;

if ($self->signature && @{ $self->signature->params } >= 1 &&
$self->signature->params->[0]->slot eq '$¢') {
$metabody->add_my_name('$*/');
$do = Op::StatementList->new(children => [
Op::CallSub->new(
invocant => Op::Lexical->new(name => '&infix:<=>'),
args => [ Op::Lexical->new(name => '$*/'),
Op::Lexical->new(name => '$¢') ]),
$do]);
}

$do->begin;
$metabody->code($do);

Expand Down
32 changes: 25 additions & 7 deletions src/Niecza/Actions.pm
View file
Expand Up @@ -306,6 +306,20 @@ sub transparent { my ($cl, $M, $op, %args) = @_;
do => $op))
}

sub rxembed { my ($cl, $M, $op, $trans) = @_;
Op::CallSub->new(node($M),
positionals => [ Op::MakeCursor->new(node($M)) ],
invocant => Op::SubDef->new(node($M),
var => $cl->gensym,
once => 1,
body => Body->new(
transparent => $trans,
class => 'rxembedded',
type => 'Sub',
signature => Sig->simple('$¢'),
do => $op)));
}

sub op_for_regex { my ($cl, $M, $rxop) = @_;
my @lift = $rxop->oplift;
{
Expand Down Expand Up @@ -334,6 +348,7 @@ sub encapsulate_regex { my ($cl, $M, $rxop, %args) = @_;
pre => \@lift, passcut => $args{passcut}, passcap => $args{passcap},
rxop => $nrxop), ltm => $lad, class => 'Regex', type => 'regex',
sig => Sig->simple->for_method);
$subop = Op::CallSub->new(node($M), invocant => $subop, positionals => [ Op::MakeCursor->new(node($M)) ]);
return RxOp::Subrule->new(regex => $subop, passcap => $args{passcap},
_passcapzyg => $nrxop, _passcapltm => $lad);
}
Expand Down Expand Up @@ -566,6 +581,8 @@ sub metachar__S_Cur_Ly { my ($cl, $M) = @_;
my $inv = $M->{embeddedblock}{_ast}->invocant;
$inv->body->type('rxembedded');
$inv->body->signature(Sig->simple('$¢'));
$inv->once(1);
$inv = Op::CallSub->new(node($M), invocant => $inv, positionals => [ Op::MakeCursor->new(node($M)) ]);
$M->{_ast} = RxOp::VoidBlock->new(block => $inv);
}

Expand Down Expand Up @@ -669,9 +686,8 @@ sub metachar__S_Single_Single { my ($cl, $M) = @_;

sub metachar__S_Double_Double { my ($cl, $M) = @_;
if (! $M->{quote}{_ast}->isa('Op::StringLiteral')) {
$M->{_ast} = RxOp::VarString->new(thunk =>
$cl->transparent($M, $M->{quote}{_ast}, once => 1, sig =>
Sig->simple('$¢'), type => 'rxembedded'));
$M->{_ast} = RxOp::VarString->new(ops =>
$cl->rxembed($M, $M->{quote}{_ast}, 1));
return;
}
$M->{_ast} = RxOp::String->new(text => $M->{quote}{_ast}->text,
Expand All @@ -698,8 +714,8 @@ sub metachar__S_var { my ($cl, $M) = @_;
$M->{_ast} = $cl->rxcapturize($M, $cid, $a);
return;
}
$M->{_ast} = RxOp::VarString->new(thunk =>
$cl->transparent($M, $cl->do_variable_reference($M, $M->{variable}{_ast}), once => 1, sig => Sig->simple('$¢'), type => 'rxembedded'));
$M->{_ast} = RxOp::VarString->new(ops => $cl->rxembed($M,
$cl->do_variable_reference($M, $M->{variable}{_ast}, 1)));
}

sub rxcapturize { my ($cl, $M, $name, $rxop) = @_;
Expand Down Expand Up @@ -782,7 +798,7 @@ sub assertion__S_name { my ($cl, $M) = @_;
name => $name,
args => $args);

my $regex = $cl->transparent($M, $callop, sig => Sig->simple('$¢'));
my $regex = $cl->rxembed($M, $callop, 1);

$M->{_ast} = RxOp::Subrule->new(regex => $regex);
}
Expand Down Expand Up @@ -817,6 +833,8 @@ sub assertion__S_Cur_Ly { my ($cl, $M) = @_;
my $inv = $M->{embeddedblock}{_ast}->invocant;
$inv->body->type('rxembedded');
$inv->body->signature(Sig->simple('$¢'));
$inv->once(1);
$inv = Op::CallSub->new(node($M), invocant => $inv, positionals => [ Op::MakeCursor->new(node($M)) ]);
$M->{_ast} = RxOp::CheckBlock->new(block => $inv);
}

Expand Down Expand Up @@ -858,7 +876,7 @@ sub mod_internal__S_p6adv { my ($cl, $M) = @_;
$v = $v->[0]{_ast};

if ($k eq 'lang') {
$M->{_ast} = RxOp::SetLang->new(expr => $cl->transparent($M, $v, sig => Sig->simple('$¢')));
$M->{_ast} = RxOp::SetLang->new(expr => $cl->rxembed($M, $v, 1));
} elsif ($k eq 'dba') {
UNWRAP: {
$v->isa('Op::Paren') && ($v = $v->inside, redo UNWRAP);
Expand Down
20 changes: 19 additions & 1 deletion src/Op.pm
View file
Expand Up @@ -829,7 +829,7 @@ use CgOp;
has exports => (isa => 'ArrayRef[Str]', is => 'ro', default => sub { [] });
# Is candidate for beta-optimization. Not compatible with method_too,
# proto_too, exports, ltm
has once => (isa => 'Bool', is => 'ro', default => 0);
has once => (isa => 'Bool', is => 'rw', default => 0);

sub code {
my ($self, $body) = @_;
Expand Down Expand Up @@ -1005,6 +1005,24 @@ use CgOp;
no Moose;
}

# the existance of these two complicates cross-sub inlining a bit
{
package Op::MakeCursor;
use Moose;
extends 'Op';

sub code {
my ($self, $body) = @_;

CgOp::prog(
CgOp::scopedlex('$*/', CgOp::newscalar(CgOp::rxcall('MakeCursor'))),
CgOp::scopedlex('$*/'));
}

__PACKAGE__->meta->make_immutable;
no Moose;
}

{
package Op::RegexBody;
use Moose;
Expand Down
4 changes: 2 additions & 2 deletions src/Optimizer/Beta.pm
View file
Expand Up @@ -28,7 +28,7 @@ sub run_optree {
return unless $op->isa('Op::CallSub') && no_named_params($op);
my $inv = $op->invocant;
return unless $inv->isa('Op::SubDef') && $inv->once;
my $cbody = $body->lexicals->{$inv->var} or return;
my $cbody = $body->find_lex($inv->var) or return;
$cbody = $cbody->body;
return unless is_removable_body($cbody);

Expand Down Expand Up @@ -93,7 +93,7 @@ sub beta_optimize {
# the function
my @args = map { [ $_, Niecza::Actions->gensym ] } @{ $op->positionals };

delete $body->lexicals->{$inv->var};
$body->delete_lex($inv->var);
$unit->xref->[$cbody->xref->[1]] = undef;

my @pos = (map { Op::Lexical->new(name => $_->[1]) } @args);
Expand Down
28 changes: 10 additions & 18 deletions src/RxOp.pm
View file
Expand Up @@ -133,12 +133,12 @@ use CgOp;
use Moose;
extends 'RxOp';

has thunk => (isa => 'Op', is => 'ro', required => 1);
sub opzyg { $_[0]->thunk }
has ops => (isa => 'Op', is => 'ro', required => 1);
sub opzyg { $_[0]->ops }

sub code {
my ($self, $body) = @_;
CgOp::rxbprim('Exact', CgOp::unbox('str', CgOp::fetch(CgOp::methodcall(CgOp::subcall(CgOp::fetch($self->thunk->cgop($body)), CgOp::newscalar(CgOp::rxcall('MakeCursor'))), "Str"))));
CgOp::rxbprim('Exact', CgOp::unbox('str', CgOp::fetch(CgOp::methodcall($self->ops->cgop($body), "Str"))));
}

sub lad { ['Imp'] }
Expand Down Expand Up @@ -553,10 +553,9 @@ use CgOp;
has passcap => (isa => 'Bool', is => 'ro', default => 0);
has _passcapzyg => (isa => 'Maybe[RxOp]', is => 'rw');
has _passcapltm => (is => 'rw');
has arglist => (isa => 'Maybe[ArrayRef[Op]]', is => 'ro');
has selfcut => (isa => 'Bool', is => 'ro', default => 0);

sub opzyg { ($_[0]->regex ? ($_[0]->regex) : ()), @{ $_[0]->arglist // [] } }
sub opzyg { ($_[0]->regex ? ($_[0]->regex) : ()) }

sub used_caps {
my ($self) = @_;
Expand All @@ -582,13 +581,10 @@ use CgOp;
my $bt = $self->label;
my $sk = $self->label;

my @args = Op::CallLike::parsearglist($body, @{ $self->arglist // [] });

my $callf = $self->regex ?
CgOp::subcall(CgOp::fetch($self->regex->cgop($body)),
CgOp::newscalar(CgOp::rxcall("MakeCursor")), @args) :
$self->regex->cgop($body) :
CgOp::methodcall(CgOp::newscalar(
CgOp::rxcall("MakeCursor")), $self->method, @args);
CgOp::rxcall("MakeCursor")), $self->method);
my @pushcapf = (@{ $self->captures } == 0) ? () : ($self->passcap ?
(CgOp::rxsetcapsfrom(CgOp::cast("cursor",
CgOp::letvar("k"))),
Expand Down Expand Up @@ -710,7 +706,7 @@ use CgOp;
sub code {
my ($self, $body) = @_;
CgOp::rxsetclass(CgOp::obj_llhow(CgOp::fetch(
CgOp::subcall(CgOp::fetch($self->expr->cgop($body)), CgOp::newscalar(CgOp::rxcall('MakeCursor'))))));
$self->expr->cgop($body))));
}

sub lad {
Expand Down Expand Up @@ -797,8 +793,7 @@ use CgOp;
sub code {
my ($self, $body) = @_;
CgOp::ncgoto('backtrack', CgOp::unbox('bool', CgOp::fetch(
CgOp::methodcall(CgOp::subcall(CgOp::fetch($self->block->cgop($body)),
CgOp::newscalar(CgOp::rxcall("MakeCursor"))), "Bool"))));
CgOp::methodcall($self->block->cgop($body), "Bool"))));
}

sub lad {
Expand Down Expand Up @@ -826,9 +821,7 @@ use CgOp;

sub code {
my ($self, $body) = @_;
CgOp::rxpushcapture(CgOp::subcall(
CgOp::fetch($self->block->cgop($body)),
CgOp::newscalar(CgOp::rxcall("MakeCursor"))), $self->capid);
CgOp::rxpushcapture($self->block->cgop($body), $self->capid);
}

sub lad {
Expand All @@ -850,8 +843,7 @@ use CgOp;

sub code {
my ($self, $body) = @_;
CgOp::sink(CgOp::subcall(CgOp::fetch($self->block->cgop($body)),
CgOp::newscalar(CgOp::rxcall("MakeCursor"))));
CgOp::sink($self->block->cgop($body));
}

sub lad {
Expand Down

0 comments on commit 08e051c

Please sign in to comment.