Skip to content

Commit

Permalink
Browse files Browse the repository at this point in the history
Implement named arguments
  • Loading branch information
@sorear
sorear committed Aug 18, 2010
1 parent 055d9ad commit 5eb127a
Show file tree
Hide file tree
Showing 4 changed files with 79 additions and 26 deletions.
13 changes: 6 additions & 7 deletions Niecza/Actions.pm
View file
Expand Up @@ -874,20 +874,20 @@ sub POSTFIX { my ($cl, $M) = @_;
$M->{_ast} = Op::CallMetaMethod->new(node($M),
receiver => $arg,
name => $op->{metamethod},
positionals => $op->{args} // []);
args => $op->{args} // []);
} elsif ($op->{name}) {
$M->{_ast} = Op::CallMethod->new(node($M),
receiver => $arg,
name => ($op->{private} ? '!' . $op->{name} : $op->{name}),
positionals => $op->{args} // []);
args => $op->{args} // []);
} elsif ($op->{postcall}) {
if (@{ $op->{postcall} } > 1) {
$M->sorry("Slicels NYI");
return;
}
$M->{_ast} = Op::CallSub->new(node($M),
invocant => $arg,
positionals => ($op->{postcall}[0] // []));
args => ($op->{postcall}[0] // []));
} else {
$M->sorry("Unhandled postop type");
}
Expand Down Expand Up @@ -1017,16 +1017,15 @@ sub colonpair { my ($cl, $M) = @_;
} elsif (defined $M->{v}{qpvalue}) {
$n = ":" . $M->{k} . $M->{v}{qpvalue};
}
my $tk = Op::StringLiteral->new(text => $M->{k});
my $tv = ref($M->{v}) ? $M->{v}{_ast} :
Op::Lexical->new(name => $M->{v} ? 'True' : 'False');
$M->{_ast} = { ext => $n, term => Op::SimplePair->new(
key => $tk, value => $tv) };
key => $M->{k}, value => $tv) };
}

sub fatarrow { my ($cl, $M) = @_;
$M->{_ast} = Op::SimplePair->new(
key => Op::StringLiteral->new(text => $M->{key}->Str),
key => $M->{key}->Str,
value => $M->{val}{_ast});
}

Expand Down Expand Up @@ -1098,7 +1097,7 @@ sub term__S_identifier { my ($cl, $M) = @_;

$M->{_ast} = Op::CallSub->new(node($M),
invocant => Op::Lexical->new(name => '&' . $id),
positionals => $args);
args => $args);
}

sub term__S_self { my ($cl, $M) = @_;
Expand Down
59 changes: 41 additions & 18 deletions Op.pm
View file
Expand Up @@ -92,19 +92,47 @@ use CgOp;
}

{
package Op::CallSub;
package Op::CallLike;
use Moose;
extends 'Op';

has invocant => (isa => 'Op', is => 'ro', required => 1);
has positionals => (isa => 'ArrayRef[Op]', is => 'ro',
default => sub { [] });
sub zyg { $_[0]->invocant, @{ $_[0]->positionals } }
has args => (isa => 'ArrayRef[Op]', is => 'ro');
sub zyg { @{ $_[0]->args // $_[0]->positionals } }

sub argblock {
my ($self, $body) = @_;
if (! $self->args) {
return map { $_->cgop($body) } @{ $self->positionals };
}
my @out;
for my $a (@{ $self->args }) {
if ($a->isa('Op::SimplePair')) {
push @out, ":" . $a->key, $a->value->cgop($body);
} else {
push @out, $a->cgop($body);
}
}
@out;
}

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

{
package Op::CallSub;
use Moose;
extends 'Op::CallLike';

has invocant => (isa => 'Op', is => 'ro', required => 1);
sub zyg { $_[0]->invocant, $_[0]->SUPER::zyg }

sub code {
my ($self, $body) = @_;
CgOp::subcall(CgOp::fetch($self->invocant->cgop($body)),
map { $_->cgop($body) } @{ $self->positionals });
$self->argblock($body));
}

__PACKAGE__->meta->make_immutable;
Expand Down Expand Up @@ -137,18 +165,16 @@ use CgOp;
{
package Op::CallMethod;
use Moose;
extends 'Op';
extends 'Op::CallLike';

has receiver => (isa => 'Op', is => 'ro', required => 1);
has positionals => (isa => 'ArrayRef[Op]', is => 'ro',
default => sub { [] });
has name => (isa => 'Str', is => 'ro', required => 1);
sub zyg { $_[0]->receiver, @{ $_[0]->positionals } }
sub zyg { $_[0]->receiver, $_[0]->SUPER::zyg }

sub code {
my ($self, $body) = @_;
CgOp::methodcall($self->receiver->cgop($body),
$self->name, map { $_->cgop($body) } @{ $self->positionals });
$self->name, $self->argblock($body));
}

__PACKAGE__->meta->make_immutable;
Expand Down Expand Up @@ -177,20 +203,17 @@ use CgOp;
{
package Op::CallMetaMethod;
use Moose;
extends 'Op';
extends 'Op::CallLike';

has receiver => (isa => 'Op', is => 'ro', required => 1);
has positionals => (isa => 'ArrayRef[Op]', is => 'ro',
default => sub { [] });
has name => (isa => 'Str', is => 'ro', required => 1);
sub zyg { $_[0]->receiver, @{ $_[0]->positionals } }
sub zyg { $_[0]->receiver, $_[0]->SUPER::zyg }

sub code {
my ($self, $body) = @_;
CgOp::let($self->receiver->cgop($body), sub {
CgOp::methodcall(CgOp::newscalar(CgOp::how(CgOp::fetch($_[0]))),
$self->name, $_[0], map { $_->cgop($body) }
@{ $self->positionals })});
$self->name, $_[0], $self->argblock($body))});
}

__PACKAGE__->meta->make_immutable;
Expand Down Expand Up @@ -219,14 +242,14 @@ use CgOp;
use Moose;
extends 'Op';

has key => (isa => 'Op', is => 'ro', required => 1);
has key => (isa => 'Str', is => 'ro', required => 1);
has value => (isa => 'Op', is => 'ro', required => 1);
sub zyg { $_[0]->key, $_[0]->value }
sub zyg { $_[0]->value }

sub code {
my ($self, $body) = @_;
CgOp::subcall(CgOp::fetch(CgOp::scopedlex('&infix:<=>>')),
$self->key->cgop($body), $self->value->cgop($body));
CgOp::string_var($self->key), $self->value->cgop($body));
}

__PACKAGE__->meta->make_immutable;
Expand Down
14 changes: 14 additions & 0 deletions Optimizer/Beta.pm
View file
Expand Up @@ -27,6 +27,7 @@ sub run_optree {
my ($body, $op) = @_;

if ($op->isa('Op::CallSub') && $op->invocant->isa('Op::SubDef')
&& no_named_params($op)
&& $op->invocant->once && is_removable_body($op->invocant->body)) {
beta_optimize($body, $op);
} else {
Expand All @@ -36,6 +37,19 @@ sub run_optree {
}
}

sub no_named_params {
my $op = shift;

if ($op->args) {
for (@{ $op->args }) {
if ($_->isa('Op::SimplePair') || $_->isa('Op::Flatten')) {
return 0;
}
}
}
return 1;
}

sub deb {
#say @_;
}
Expand Down
19 changes: 18 additions & 1 deletion test.pl
View file
Expand Up @@ -2,7 +2,7 @@

use Test;

plan 322;
plan 333;

ok 1, "one is true";
ok 2, "two is also true";
Expand Down Expand Up @@ -827,3 +827,20 @@
ok G7.parse('+'), "can parse :sym<> symbols";
ok G7.parse('foo'), "can parse : symbols";
}
{
sub t1(*@k, :$x, :y($)) { $x } #OK
sub t2(*@k, :y($x), :x($)) { $x } #OK
sub t3(*@k, :y(:$x)) { $x } #OK
ok !t1.defined, "no arg, no value";
ok !t1(12).defined, "positional is not enough";
ok t1(x => 5) == 5, "can pass argument (fatarrow)";
ok !t1("x" => 5), "quoted fatarrow doesn't work";
ok !t1((x => 5)), "parenned fatarrow doesn't work";
ok t1(:x(6)) == 6, "colonpair works";
ok !t1(:y(7)).defined, "wrong name, no cigar";
ok t2(y => 9) == 9, ":y(\$x) syntax picks out y as name";
ok !t2(x => 10).defined, "x is NOT a usable name";
ok t3(:x(11)) == 11, ":y(:\$x) works for both (1)";
ok t3(:y(11)) == 11, ":y(:\$x) works for both (2)";
}

0 comments on commit 5eb127a

Please sign in to comment.