From 750e66a052c6bfce45c38200ecd9ff323b849e5d Mon Sep 17 00:00:00 2001 From: Stefan O'Rear Date: Thu, 15 Jul 2010 01:31:44 -0700 Subject: [PATCH] Remove premature and heavily code duplicating Op context optimization --- Body.pm | 7 +++- Op.pm | 116 ++++++++++++++------------------------------------------ 2 files changed, 33 insertions(+), 90 deletions(-) diff --git a/Body.pm b/Body.pm index e399e335..8ffd2571 100644 --- a/Body.pm +++ b/Body.pm @@ -23,7 +23,7 @@ use CodeGen (); $self->codegen(CodeGen->new(name => $self->name, body => $self)); my $cg = $self->codegen; $self->do_enter($cg); - $self->do->item_cg($cg, $self); + $self->do->cg($cg, $self); # TODO: Bind a return value here to catch non-ro sub use $cg->return(1) unless $cg->unreach; return $cg; @@ -34,7 +34,10 @@ use CodeGen (); $cg->lextypes($_, 'Variable') for keys %{ $self->lexical }; $_->do_enter($cg, $self) for @{ $self->decls }; $self->signature->gen_binder($cg) if $self->signature; - $_->void_cg($cg, $self) for @{ $self->enter }; + for (@{ $self->enter }) { + $_->cg($cg, $self); + $cg->drop; + } } sub write { diff --git a/Op.pm b/Op.pm index 9749f6dc..98adb5fb 100644 --- a/Op.pm +++ b/Op.pm @@ -8,12 +8,6 @@ use 5.010; sub paren { shift } - sub void_cg { - my ($self, $cg, $body) = @_; - $self->item_cg($cg, $body); - $cg->drop; - } - __PACKAGE__->meta->make_immutable; no Moose; } @@ -25,11 +19,11 @@ use 5.010; has code => (isa => 'ArrayRef', is => 'ro', required => 1); - sub item_cg { + sub cg { my ($self, $cg, $body) = @_; for my $insn (@{ $self->code }) { if (blessed $insn) { - $insn->item_cg($cg, $body); + $insn->cg($cg, $body); } else { my ($op, @args) = @$insn; $cg->$op(@args); @@ -37,12 +31,6 @@ use 5.010; } } - sub void_cg { - my ($self, $cg, $body) = @_; - $self->item_cg($cg, $body); - $cg->drop; - } - __PACKAGE__->meta->make_immutable; no Moose; } @@ -54,7 +42,7 @@ use 5.010; has children => (isa => 'ArrayRef[Op]', is => 'ro', required => 1); - sub item_cg { + sub cg { my ($self, $cg, $body) = @_; if (!@{ $self->children }) { # XXX should be Nil or something @@ -64,16 +52,10 @@ use 5.010; my @kids = @{ $self->children }; my $end = pop @kids; for (@kids) { - $_->void_cg($cg, $body); + $_->cg($cg, $body); + $cg->drop; } - $end->item_cg($cg, $body); - } - } - - sub void_cg { - my ($self, $cg, $body) = @_; - for (@{ $self->children }) { - $_->void_cg($cg, $body); + $end->cg($cg, $body); } } @@ -99,22 +81,14 @@ use 5.010; positionals => $self->positionals); } - sub item_cg { + sub cg { my ($self, $cg, $body) = @_; - $self->invocant->item_cg($cg, $body); + $self->invocant->cg($cg, $body); $cg->fetch; - $_->item_cg($cg, $body) for @{ $self->positionals }; + $_->cg($cg, $body) for @{ $self->positionals }; $cg->call_sub(1, scalar(@{ $self->positionals })); } - sub void_cg { - my ($self, $cg, $body) = @_; - $self->invocant->item_cg($cg, $body); - $cg->fetch; - $_->item_cg($cg, $body) for @{ $self->positionals }; - $cg->call_sub(0, scalar(@{ $self->positionals })); - } - __PACKAGE__->meta->make_immutable; no Moose; } @@ -129,22 +103,14 @@ use 5.010; default => sub { [] }); has name => (isa => 'Str', is => 'ro', required => 1); - sub item_cg { + sub cg { my ($self, $cg, $body) = @_; - $self->receiver->item_cg($cg, $body); + $self->receiver->cg($cg, $body); $cg->dup_fetch; - $_->item_cg($cg, $body) for @{ $self->positionals }; + $_->cg($cg, $body) for @{ $self->positionals }; $cg->call_method(1, $self->name, scalar(@{ $self->positionals })); } - sub void_cg { - my ($self, $cg, $body) = @_; - $self->receiver->item_cg($cg, $body); - $cg->dup_fetch; - $_->item_cg($cg, $body) for @{ $self->positionals }; - $cg->call_method(0, $self->name, scalar(@{ $self->positionals })); - } - __PACKAGE__->meta->make_immutable; no Moose; } @@ -157,9 +123,9 @@ use 5.010; has receiver => (isa => 'Op', is => 'ro', required => 1); has name => (isa => 'Str', is => 'ro', required => 1); - sub item_cg { + sub cg { my ($self, $cg, $body) = @_; - $self->receiver->item_cg($cg, $body); + $self->receiver->cg($cg, $body); $cg->fetch; given ($self->name) { when ("HOW") { @@ -196,7 +162,7 @@ use 5.010; has text => (isa => 'Str', is => 'ro', required => 1); - sub item_cg { + sub cg { my ($self, $cg, $body) = @_; $cg->string_var($self->text); } @@ -215,9 +181,9 @@ use 5.010; has false => (isa => 'Maybe[Op]', is => 'ro', required => 1); sub cg { - my ($self, $nv, $cg, $body) = @_; + my ($self, $cg, $body) = @_; - $self->check->item_cg($cg, $body); + $self->check->cg($cg, $body); $cg->dup_fetch; $cg->call_method(1, "Bool", 0); $cg->fetch; @@ -233,24 +199,13 @@ use 5.010; my $l1 = $cg->label; my $l2 = $cg->label; $cg->ncgoto($l1); - my $m = $nv ? 'item_cg' : 'void_cg'; - $t->$m($cg, $body); + $t->cg($cg, $body); $cg->goto($l2); $cg->labelhere($l1); - $f->$m($cg, $body); + $f->cg($cg, $body); $cg->labelhere($l2); } - sub item_cg { - my ($self, $cg, $body) = @_; - $self->cg(1, $cg, $body); - } - - sub void_cg { - my ($self, $cg, $body) = @_; - $self->cg(0, $cg, $body); - } - __PACKAGE__->meta->make_immutable; no Moose; } @@ -265,7 +220,7 @@ use 5.010; has once => (isa => 'Bool', is => 'ro', required => 1); has until => (isa => 'Bool', is => 'ro', required => 1); - sub void_cg { + sub cg { my ($self, $cg, $body) = @_; my $l1 = $cg->label; @@ -273,20 +228,16 @@ use 5.010; $cg->goto($l2) unless $self->once; $cg->labelhere($l1); - $self->body->void_cg($cg, $body); + $self->body->cg($cg, $body); + $cg->drop; $cg->labelhere($l2) unless $self->once; - $self->check->item_cg($cg, $body); + $self->check->cg($cg, $body); $cg->dup_fetch; $cg->call_method(1, "Bool", 0); $cg->fetch; $cg->unbox('Boolean'); my $m = $self->until ? 'ncgoto' : 'cgoto'; $cg->$m($l1); - } - - sub item_cg { - my ($self, $cg, $body) = @_; - $self->void_cg($cg, $body); $cg->push_null('Variable'); } @@ -301,7 +252,7 @@ use 5.010; has value => (isa => 'Num', is => 'ro', required => 1); - sub item_cg { + sub cg { my ($self, $cg, $body) = @_; $cg->clr_double($self->value); $cg->box('Num'); @@ -320,18 +271,11 @@ use 5.010; has rhs => (isa => 'Op', is => 'ro', required => 1); has readonly => (isa => 'Bool', is => 'ro', required => 1); - sub item_cg { + sub cg { my ($self, $cg, $body) = @_; - $self->lhs->item_cg($cg, $body); + $self->lhs->cg($cg, $body); $cg->dup; - $self->rhs->item_cg($cg, $body); - $cg->bind; - } - - sub void_cg { - my ($self, $cg, $body) = @_; - $self->lhs->item_cg($cg, $body); - $self->rhs->item_cg($cg, $body); + $self->rhs->cg($cg, $body); $cg->bind; } @@ -346,15 +290,11 @@ use 5.010; has name => (isa => 'Str', is => 'ro', required => 1); - sub item_cg { + sub cg { my ($self, $cg, $body) = @_; $cg->scopelexget($self->name, $body); } - sub void_cg { - my ($self, $cg, $body) = @_; - } - __PACKAGE__->meta->make_immutable; no Moose; }