Skip to content

Commit

Permalink
Lift lift_decls into a separate compiler pass
Browse files Browse the repository at this point in the history
  • Loading branch information
@sorear
sorear committed Jul 26, 2010
1 parent e55a205 commit 75dc053
Show file tree
Hide file tree
Showing 5 changed files with 41 additions and 41 deletions.
35 changes: 13 additions & 22 deletions Body.pm
View file
Expand Up @@ -10,8 +10,6 @@ use CgOp ();

has name => (isa => 'Str', is => 'rw', default => "anon");
has do => (isa => 'Op', is => 'rw');
has enter => (isa => 'ArrayRef[Op]', is => 'ro',
default => sub { [] });
has outer => (isa => 'Body', is => 'rw', init_arg => undef);
has setting => (is => 'rw');
has decls => (isa => 'ArrayRef', is => 'ro', default => sub { [] });
Expand All @@ -24,16 +22,10 @@ use CgOp ();
# also '' for incorrectly contextualized {p,x,}block, blast
has type => (isa => 'Str', is => 'rw');

has lexical => (isa => 'HashRef[Str]', is => 'ro', lazy_build => 1);
has lexical => (isa => 'HashRef[Str]', is => 'rw');
# my $x inside, floats out; mostly for blasts; set by context so must be rw
has transparent => (isa => 'Bool', is => 'rw', default => 0);

sub _build_lexical {
my ($self) = @_;

+{ map { $_->used_slots } @{ $self->_alldecls } };
}

sub is_mainline {
my $self = shift;

Expand All @@ -52,28 +44,28 @@ use CgOp ();
}
}

sub floated_decls {
my ($self) = @_;
my @r;
push @r, $self->do->local_decls if $self->transparent;
push @r, map { $_->outer_decls } @{ $self->_alldecls }
if $self->type ne 'mainline';
@r;
}
has _alldecls => (isa => 'ArrayRef[Decl]', is => 'rw');

has _alldecls => (isa => 'ArrayRef[Decl]', is => 'ro', lazy_build => 1);
sub _build__alldecls {
sub lift_decls {
my ($self) = @_;
my @x = @{ $self->decls };
unshift @x, $self->do->local_decls if !$self->transparent;
my @y;
unshift @{ $self->transparent ? \@y : \@x },
$self->do->lift_decls;
unshift @x, $self->signature->local_decls if $self->signature;
@x = map { $_->extra_decls, $_ } @x;
@x = map { $_->outer_decls, $_ } @x if $self->type eq 'mainline';
unshift @x, Decl::PackageLink->new(name => '$?GLOBAL')
if $self->type eq 'mainline';
unshift @x, Decl::PackageLink->new(name => '$?CURPKG')
if $self->type =~ /mainline|class|package|grammar|module|role|slang|knowhow/;
\@x;
#print STDERR YAML::XS::Dump(\@x);
push @y, map { $_->outer_decls } @x
if $self->type ne 'mainline';
$self->_alldecls(\@x);
$self->lexical(+{ map { $_->used_slots } @{ $self->_alldecls } });

@y;
}

sub gen_code {
Expand All @@ -90,7 +82,6 @@ use CgOp ();
my @p;
push @p, map { $_->enter_code($self) } @{ $self->_alldecls };
push @p, $self->signature->binder if $self->signature;
push @p, map { CgOp::sink($_->code($self)) } @{ $self->enter };
CgOp::prog(@p);
}

Expand Down
2 changes: 2 additions & 0 deletions CompilerDriver.pm
View file
Expand Up @@ -55,6 +55,8 @@ sub compile {

$::SETTING_RESUME = undef;

$ast->lift_decls;

my $basename = $::UNITNAME;
$basename =~ s/::/\//g;
$basename ||= 'MAIN';
Expand Down
8 changes: 4 additions & 4 deletions Decl.pm
View file
Expand Up @@ -31,7 +31,7 @@ use CgOp;
has code => (isa => 'Body', is => 'ro', required => 1);
has shared => (isa => 'Bool', is => 'ro', default => 0);

sub extra_decls { $_[0]->code->floated_decls }
sub extra_decls { $_[0]->code->lift_decls }

sub used_slots {
my ($self) = @_;
Expand Down Expand Up @@ -70,7 +70,7 @@ use CgOp;
has var => (isa => 'Str', is => 'ro', required => 1);
has code => (isa => 'Body', is => 'ro', required => 1);

sub extra_decls { $_[0]->code->floated_decls }
sub extra_decls { $_[0]->code->lift_decls }

sub used_slots {
$_[0]->var, 'Variable';
Expand Down Expand Up @@ -277,7 +277,7 @@ use CgOp;
has stub => (is => 'ro', isa => 'Bool', default => 0);
has name => (is => 'ro', isa => 'Str', predicate => 'has_name');

sub extra_decls { $_[0]->body ? ($_[0]->body->floated_decls) : () }
sub extra_decls { $_[0]->body ? ($_[0]->body->lift_decls) : () }
sub stashvar { $_[0]->var . '::' }

sub used_slots {
Expand Down Expand Up @@ -361,7 +361,7 @@ use CgOp;
sub finish_obj {
my ($self) = @_;
my @r;
if (!grep { $_->isa('Decl::Super') } $self->body->do->local_decls) {
if (!grep { $_->isa('Decl::Super') } @{ $self->body->_alldecls }) {
push @r, CgOp::sink(CgOp::methodcall(CgOp::letvar("how"),
"add-super", CgOp::scopedlex($self->defsuper)));
}
Expand Down
33 changes: 18 additions & 15 deletions Op.pm
View file
Expand Up @@ -10,9 +10,9 @@ use CgOp;

sub zyg { }

sub local_decls {
sub lift_decls {
my ($self) = shift;
map { $_->local_decls } $self->zyg;
map { $_->lift_decls } $self->zyg;
}

sub splittable_parcel {
Expand Down Expand Up @@ -86,10 +86,13 @@ use CgOp;
use Moose;
extends 'Op';

has unitname => (isa => 'Str', is => 'ro', required => 1);
has unitname => (isa => 'Str', is => 'ro', clearer => 'drop_unitname');
has save_only => (isa => 'Bool', is => 'ro', default => 0);

sub local_decls { Decl::SaveEnv->new(unitname => $_[0]->unitname) }
sub lift_decls {
my $un = $_[0]->unitname; $_[0]->drop_unitname;
Decl::SaveEnv->new(unitname => $un)
}

sub code {
my ($self, $body) = @_;
Expand Down Expand Up @@ -395,10 +398,10 @@ use CgOp;
has body => (isa => 'Op', is => 'ro', required => 1);
sub zyg { $_[0]->body }

sub local_decls {
sub lift_decls {
my ($self) = @_;
Decl::StateVar->new(backing => $self->condvar),
$self->SUPER::local_decls(@_);
$self->SUPER::lift_decls(@_);
}

sub code {
Expand Down Expand Up @@ -471,7 +474,7 @@ use CgOp;
has exports => (is => 'ro', isa => 'ArrayRef[Str]', default => sub { [] });

sub decl_class { 'Decl::Package' }
sub local_decls {
sub lift_decls {
my ($self) = @_;
my @r = $self->decl_class->new(stub => $self->stub, var => $self->var,
($self->has_name ? (name => $self->name) : ()),
Expand Down Expand Up @@ -546,7 +549,7 @@ use CgOp;
has body => (isa => 'Body', is => 'ro', required => 1);
has shared => (isa => 'Bool', is => 'ro', default => 0);

sub local_decls {
sub lift_decls {
my ($self) = @_;
Decl::PreInit->new(var => $self->var, code => $self->body,
shared => $self->shared);
Expand All @@ -568,7 +571,7 @@ use CgOp;

has name => (isa => 'Str', is => 'ro');

sub local_decls {
sub lift_decls {
my ($self) = @_;
Decl::Super->new(name => $self->name);
}
Expand All @@ -590,7 +593,7 @@ use CgOp;
has name => (isa => 'Str', is => 'ro');
has accessor => (isa => 'Bool', is => 'ro');

sub local_decls {
sub lift_decls {
my ($self) = @_;
my @r;
push @r, Decl::Attribute->new(name => $self->name);
Expand Down Expand Up @@ -626,7 +629,7 @@ use CgOp;
has var => (isa => 'Str', is => 'ro', required => 1);
has body => (isa => 'Body', is => 'ro', required => 1);

sub local_decls {
sub lift_decls {
my ($self) = @_;
Decl::Sub->new(var => $self->var, code => $self->body);
}
Expand Down Expand Up @@ -654,7 +657,7 @@ use CgOp;
has method_too => (isa => 'Maybe[Str]', is => 'ro', required => 0);
has exports => (isa => 'ArrayRef[Str]', is => 'ro', default => sub { [] });

sub local_decls {
sub lift_decls {
my ($self) = @_;
my @r;
push @r, Decl::Sub->new(var => $self->var, code => $self->body);
Expand Down Expand Up @@ -688,7 +691,7 @@ use CgOp;

has state_backing => (isa => 'Str', is => 'ro');

sub local_decls {
sub lift_decls {
my ($self) = @_;
return () unless $self->declaring;

Expand Down Expand Up @@ -736,7 +739,7 @@ use CgOp;
has slot => (isa => 'Str', is => 'ro', required => 1);
has path => (isa => 'ArrayRef[Str]', is => 'ro', required => 1);

sub local_decls {
sub lift_decls {
my ($self) = @_;
# TODO Skip this part if the thing-being-bound references MY,
# CALLER, OUTER, etc
Expand All @@ -761,7 +764,7 @@ use CgOp;
has unit => (isa => 'Str', is => 'ro', required => 1);
has symbols => (isa => 'HashRef[ArrayRef[Str]]', is => 'ro', required => 1);

sub local_decls {
sub lift_decls {
my ($self) = @_;
Decl::Use->new(unit => $self->unit, symbols => $self->symbols);
}
Expand Down
4 changes: 4 additions & 0 deletions Unit.pm
View file
Expand Up @@ -19,6 +19,10 @@ use 5.010;
has is_setting => (isa => 'Bool', is => 'ro');
has setting_name => (isa => 'Str', is => 'ro');

sub lift_decls {
$_[0]->mainline->lift_decls;
}

sub gen_code {
my ($self) = @_;
$self->mainline->setting($self->setting) if $self->setting;
Expand Down

0 comments on commit 75dc053

Please sign in to comment.