Skip to content

Commit

Permalink
Implement $Foo::x referencing syntax
Browse files Browse the repository at this point in the history
  • Loading branch information
@sorear
sorear committed Jul 22, 2010
1 parent d4c0960 commit 260f408
Show file tree
Hide file tree
Showing 4 changed files with 76 additions and 22 deletions.
2 changes: 1 addition & 1 deletion CodeGen.pm
View file
Expand Up @@ -438,7 +438,7 @@ use 5.010;
my $ty = ($oty =~ /^Dictionary<.*,(.*)>$/) ? $1 :
($oty =~ /^(.*)\[\]$/) ? $1 :
($oty =~ /^List<(.*)>$/) ? $1 :
die "type inference needs more hacks";
die "type inference needs more hacks $oty";
my $obj = $self->_pop;
$self->_push($ty, "$obj" . "[$ix]");
}
Expand Down
57 changes: 40 additions & 17 deletions Niecza/Actions.pm
View file
Expand Up @@ -77,7 +77,8 @@ sub identifier { my ($cl, $M) = @_;

# Either String Op
sub morename { my ($cl, $M) = @_;
$M->{_ast} = $M->{identifier} ? $M->{identifier}{_ast} : $M->{EXPR}{_ast};
$M->{_ast} = $M->{identifier}[0] ? $M->{identifier}[0]{_ast} :
$M->{EXPR}[0]{_ast};
}

# { dc: Bool, names: [Either String Op] }
Expand All @@ -90,13 +91,19 @@ sub name { my ($cl, $M) = @_;
sub longname {} # look at the children yourself
sub deflongname {}

sub mangle_longname { my ($cl, $M) = @_;
if ($M->{name}{_ast}{dc} || @{ $M->{name}{_ast}{names} } > 1) {
$M->sorry("Multipart names not yet supported");
sub mangle_longname { my ($cl, $M, $single) = @_;
if ($M->{name}{_ast}{dc}) {
$M->sorry('Leading double colons not yet supported');
return "";
}

if ($single && @{ $M->{name}{_ast}{names} } > 1) {
$M->sorry("Multipart names not yet supported for $single");
return "";
}

my ($n) = @{ $M->{name}{_ast}{names} };
my @ns = @{ $M->{name}{_ast}{names} };
my $n = pop @ns;

for my $cp (@{ $M->{colonpair} }) {
my $k = $cp->{k};
Expand All @@ -113,7 +120,7 @@ sub mangle_longname { my ($cl, $M) = @_;
}
}

$n;
$single ? $n : ($n, @ns);
}

sub desigilname { my ($cl, $M) = @_;
Expand All @@ -122,7 +129,7 @@ sub desigilname { my ($cl, $M) = @_;
return;
}

$M->{_ast} = $cl->mangle_longname($M->{longname});
$M->{_ast} = [ $cl->mangle_longname($M->{longname}) ];
}

sub stopper { }
Expand Down Expand Up @@ -398,7 +405,7 @@ sub PRE { }

sub methodop { my ($cl, $M) = @_;
my %r;
$r{name} = $cl->mangle_longname($M->{longname}) if $M->{longname};
$r{name} = $cl->mangle_longname($M->{longname}, "method call") if $M->{longname};
$r{quote} = $M->{quote}{_ast} if $M->{quote};
$r{ref} = $M->{variable}{_ast}{term} if $M->{variable};

Expand Down Expand Up @@ -544,20 +551,36 @@ sub variable { my ($cl, $M) = @_;
return;
}

my $sl = $sigil . $twigil . $M->{desigilname}{_ast};
my ($name, @rest) = @{ $M->{desigilname}{_ast} };

my $sl = $sigil . $twigil . $name;

if ($twigil && @rest) {
$M->sorry("Cannot use a twigil on a qualified name");
return;
}

given ($twigil) {
when ('!') {
$M->{_ast} = {
term => Op::GetSlot->new(name => $M->{desigilname}{_ast},
term => Op::GetSlot->new(name => $name,
object => Op::Lexical->new(name => 'self')),
};
}
when ('') {
$M->{_ast} = {
term => Op::Lexical->new(name => $sl),
decl_slot => $sl,
};
if (@rest) {
my $lexpkg = $M->lex_can_find_name($::CURLEX, $rest[0] . "::",
{ truename => '???' });
$M->{_ast} = {
term => Op::PackageVar->new(lexical_pkg => $lexpkg,
path => [ map { $_ . "::" } @rest ], name => $sl),
};
} else {
$M->{_ast} = {
term => Op::Lexical->new(name => $sl),
decl_slot => $sl,
};
}
}
default {
$M->sorry("Unhandled twigil $twigil");
Expand Down Expand Up @@ -948,7 +971,7 @@ sub package_def { my ($cl, $M) = @_;
return;
}
my $name = $M->{longname}[0] ?
$cl->mangle_longname($M->{longname}[0]) : 'ANON';
$cl->mangle_longname($M->{longname}[0], "package definition") : 'ANON';
my $outervar = $::SCOPE eq 'my' ? $name : $cl->gensym;

my $optype = 'Op::' . ucfirst($::PKGDECL) . 'Def';
Expand Down Expand Up @@ -1069,7 +1092,7 @@ sub routine_def { my ($cl, $M) = @_;
return;
}

my $m = $dln ? $cl->mangle_longname($dln) : undef;
my $m = $dln ? $cl->mangle_longname($dln, "subroutine definition") : undef;

$M->{_ast} = $cl->block_to_closure(
$cl->sl_to_block('sub',
Expand All @@ -1082,7 +1105,7 @@ sub routine_def { my ($cl, $M) = @_;
sub method_def { my ($cl, $M) = @_;
my $scope = $::SCOPE // 'has';
$scope = 'anon' if !$M->{longname};
my $name = $M->{longname} ? $cl->mangle_longname($M->{longname}) : undef;
my $name = $M->{longname} ? $cl->mangle_longname($M->{longname}, "method definition") : undef;

if ($M->{trait}[0] || $M->{sigil}) {
$M->sorry("Method traits NYI");
Expand Down
32 changes: 29 additions & 3 deletions Op.pm
View file
Expand Up @@ -422,20 +422,20 @@ use CgOp;

sub local_decls {
my ($self) = @_;
Decl::Package->new(stub => $self->stub, var => $self->var,
Decl::Package->new(stub => $self->stub, var => $self->var . "::",
($self->stub ? () : (body => $self->body,
bodyvar => $self->bodyvar)));
}

sub code {
my ($self, $body) = @_;
if ($self->stub) {
CgOp::scopedlex($self->var);
CgOp::scopedlex($self->var . "::");
} else {
CgOp::prog(
CgOp::sink(CgOp::subcall(CgOp::fetch(
CgOp::scopedlex($self->bodyvar)))),
CgOp::scopedlex($self->var));
CgOp::scopedlex($self->var . "::"));
}
}

Expand Down Expand Up @@ -596,4 +596,30 @@ use CgOp;
no Moose;
}

{
package Op::PackageVar;
use Moose;
extends 'Op';

has name => (isa => 'Str', is => 'ro', required => 1);
has lexical_pkg => (isa => 'Bool', is => 'ro', required => 1);
has path => (isa => 'ArrayRef[Str]', is => 'ro', required => 1);

sub code {
my ($self, $body) = @_;
my @path = @{ $self->path };
my $p = $self->lexical_pkg ? CgOp::scopedlex(shift(@path)) :
CgOp::letvar('pkg');
for (@path) {
$p = CgOp::getindex($_, CgOp::unwrap('Dictionary<string,Variable>',
CgOp::fetch($p)));
}
CgOp::getindex($self->name, CgOp::unwrap('Dictionary<string,Variable>',
CgOp::fetch($p)));
}

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

1;
7 changes: 6 additions & 1 deletion test.pl
View file
Expand Up @@ -10,7 +10,7 @@ ($num)
say ("1.." ~ $num);
}

plan 94;
plan 95;

ok 1, "one is true";
ok 2, "two is also true";
Expand Down Expand Up @@ -302,3 +302,8 @@ ($num)
}
ok cat(1, (2, 3), ((4, 5), (Nil, 7))) eq "123457", "parcels flatten";
}

{
my package Foo { our $x = 42; }
ok $Foo::x == 42, "can access our vars";
}

0 comments on commit 260f408

Please sign in to comment.