Skip to content

Commit

Permalink
Browse files Browse the repository at this point in the history
Implement sub is export
  • Loading branch information
sorear committed Jul 24, 2010
1 parent 231d396 commit 1521ceb
Show file tree
Hide file tree
Showing 3 changed files with 44 additions and 16 deletions.
2 changes: 1 addition & 1 deletion Decl.pm
Expand Up @@ -161,7 +161,7 @@ use CgOp;
sub preinit_code {
my ($self, $body) = @_;

CgOp::bind($body->lookup_var($self->name, @{ $self->path }),
CgOp::bind(1, $body->lookup_var($self->name, @{ $self->path }),
CgOp::scopedlex($self->slot));
}

Expand Down
54 changes: 39 additions & 15 deletions Niecza/Actions.pm
Expand Up @@ -876,7 +876,21 @@ sub package_declarator__S_slang { my ($cl, $M) = @_;

sub package_declarator__S_also { my ($cl, $M) = @_;
$M->{_ast} = Op::StatementList->new(children =>
[ map { $_->{_ast}{mop} } @{ $M->{trait} }]);
$cl->process_package_traits($M, @{ $M->{trait} }));
}

sub process_package_traits { my ($cl, $M, @tr) = @_;
my @r;

for (@tr) {
if (exists $_->{_ast}{name}) {
push @r, Op::Super->new(name => $_->{_ast}{name});
} else {
$M->sorry("Non-superclass traits for packageoids NYI");
}
}

@r;
}

sub termish {}
Expand Down Expand Up @@ -982,7 +996,8 @@ sub package_def { my ($cl, $M) = @_;
my $stmts = $M->{statementlist} // $M->{blockoid};

$stmts = Op::StatementList->new(children =>
[ (map { $_->{_ast}{mop} } @{ $M->{trait} }), $stmts->{_ast} ]);
[ $cl->process_package_traits($M, @{ $M->{trait} }),
$stmts->{_ast} ]);

my $cbody = $cl->sl_to_block($blocktype, $stmts,
name => $name);
Expand All @@ -1002,18 +1017,22 @@ sub package_def { my ($cl, $M) = @_;
sub trait_mod {}
sub trait_mod__S_is { my ($cl, $M) = @_;
my $trait = $M->{longname}->Str;

if (!$M->is_name($trait)) {
$M->sorry('Non-superclass is traits NYI');
return;
my $noparm;

if ($M->is_name($trait)) {
$M->{_ast} = { name => $trait };
$noparm = 'Superclasses cannot have parameters';
} elsif ($trait eq 'export') {
$M->{_ast} = { export => [ 'DEFAULT', 'ALL' ] };
$noparm = 'Export tags NYI';
} else {
$M->sorry('Unhandled trait ' . $trait);
}

if ($M->{circumfix}[0]) {
$M->sorry('Superclasses cannot have parameters');
if ($noparm && $M->{circumfix}[0]) {
$M->sorry($noparm);
return;
}

$M->{_ast}{mop} = Op::Super->new(name => $trait);
}

sub trait { my ($cl, $M) = @_;
Expand Down Expand Up @@ -1064,7 +1083,7 @@ sub block_to_closure { my ($cl, $blk, %args) = @_;
my $outer_key = $args{outer_key} // $cl->gensym;

Op::SubDef->new(var => $outer_key, body => $blk,
method_too => $args{method_too});
method_too => $args{method_too}, exports => ($args{exports} // []));
}

# always a sub, though sometimes it's an implied sub after multi/proto/only
Expand All @@ -1078,9 +1097,13 @@ sub routine_def { my ($cl, $M) = @_;
$M->sorry("Multiple multisigs (what?) NYI");
return;
}
if ($M->{trait}[0]) {
$M->sorry("Sub traits NYI");
return;
my @export;
for my $t (@{ $M->{trait} }) {
if ($t->{_ast}{export}) {
push @export, @{ $t->{_ast}{export} };
} else {
$M->sorry('Non-export sub traits NYI');
}
}
my $scope = !$dln ? 'anon' : $::SCOPE || 'my';
if ($scope ne 'my' && $scope ne 'our' && $scope ne 'anon') {
Expand All @@ -1099,7 +1122,8 @@ sub routine_def { my ($cl, $M) = @_;
$M->{blockoid}{_ast},
subname => $m,
signature => ($M->{multisig}[0] ? $M->{multisig}[0]{_ast} : undef)),
outer_key => (($scope eq 'my') ? "&$m" : undef));
outer_key => (($scope eq 'my') ? "&$m" : undef),
exports => \@export);
}

sub method_def { my ($cl, $M) = @_;
Expand Down
4 changes: 4 additions & 0 deletions Op.pm
Expand Up @@ -536,13 +536,17 @@ use CgOp;
has var => (isa => 'Str', is => 'ro', required => 1);
has body => (isa => 'Body', is => 'ro', required => 1);
has method_too => (isa => 'Maybe[Str]', is => 'ro', required => 0);
has exports => (isa => 'ArrayRef[Str]', is => 'ro', default => sub { [] });

sub local_decls {
my ($self) = @_;
my @r;
push @r, Decl::Sub->new(var => $self->var, code => $self->body);
push @r, Decl::HasMethod->new(name => $self->method_too,
var => $self->var) if defined($self->method_too);
push @r, Decl::PackageAlias->new(slot => $self->var,
name => $self->var, path => [ 'OUR', 'EXPORT', $_ ])
for (@{ $self->exports });
@r;
}

Expand Down

0 comments on commit 1521ceb

Please sign in to comment.