Skip to content

Comparing changes

Choose two branches to see what’s changed or to start a new pull request. If you need to, you can also .

Open a pull request

Create a new pull request by comparing changes across two branches. If you need to, you can also .
...
  • 4 commits
  • 2 files changed
  • 0 commit comments
  • 1 contributor
Showing with 30 additions and 17 deletions.
  1. +12 −10 src/Perl6/Grammar.pm
  2. +18 −7 src/Perl6/World.pm
View
22 src/Perl6/Grammar.pm
@@ -1211,9 +1211,11 @@ grammar Perl6::Grammar is HLL::Grammar {
# Locate any existing symbol. Note that it's only a match
# with "my" if we already have a declaration in this scope.
my $exists := 0;
- if $longname && $*SCOPE ne 'anon' {
- my @name := $longname.type_name_parts('package name', :decl(1));
- if $*W.already_declared($*SCOPE, $*OUTERPACKAGE, $outer, @name) {
+ my @name := $longname ??
+ $longname.type_name_parts('package name', :decl(1)) !!
+ [];
+ if @name && $*SCOPE ne 'anon' {
+ if @name && $*W.already_declared($*SCOPE, $*OUTERPACKAGE, $outer, @name) {
$*PACKAGE := $*W.find_symbol(@name);
$exists := 1;
}
@@ -1232,10 +1234,10 @@ grammar Perl6::Grammar is HLL::Grammar {
# If it's not a role, or it is a role but one with no name,
# then just needs meta-object construction and installation.
- elsif $*PKGDECL ne 'role' || !$longname {
+ elsif $*PKGDECL ne 'role' || !@name {
# Construct meta-object for this package.
my %args;
- if $longname {
+ if @name {
%args<name> := $longname.name();
}
if $*REPR ne '' {
@@ -1244,8 +1246,7 @@ grammar Perl6::Grammar is HLL::Grammar {
$*PACKAGE := $*W.pkg_create_mo($/, %*HOW{$*PKGDECL}, |%args);
# Install it in the symbol table if needed.
- if $longname {
- my @name := $longname.type_name_parts('package name', :decl(1));
+ if @name {
$*W.install_package($/, @name, $*SCOPE, $*PKGDECL, $*OUTERPACKAGE, $outer, $*PACKAGE);
}
}
@@ -1260,7 +1261,6 @@ grammar Perl6::Grammar is HLL::Grammar {
$group := $*PACKAGE;
}
else {
- my @name := $longname.type_name_parts('package name', :decl(1));
$group := $*W.pkg_create_mo($/, %*HOW{'role-group'}, :name($longname.name()));
$*W.install_package($/, @name, $*SCOPE, $*PKGDECL, $*OUTERPACKAGE, $outer, $group);
}
@@ -1272,19 +1272,21 @@ grammar Perl6::Grammar is HLL::Grammar {
}
else {
# Augment. Ensure we can.
+ my @name := $longname ??
+ $longname.type_name_parts('package name', :decl(1)) !!
+ [];
unless $*MONKEY_TYPING {
$/.CURSOR.typed_panic('X::Syntax::Augment::WithoutMonkeyTyping');
}
if $*PKGDECL eq 'role' {
$/.CURSOR.typed_panic('X::Syntax::Augment::Role');
}
- unless $longname {
+ unless @name {
$*W.throw($/, 'X::Anon::Augment', package-type => $*PKGDECL);
}
# Locate type.
my $found;
- my @name := $longname.type_name_parts('package name', :decl(1));
try { $*PACKAGE := $*W.find_symbol(@name); $found := 1 }
unless $found {
$*W.throw($/, 'X::Augment::NoSuchType',
View
25 src/Perl6/World.pm
@@ -1334,6 +1334,9 @@ class Perl6::World is HLL::World {
method type_name_parts($dba, :$decl) {
my @name;
my $beyond_pp;
+ if $decl && $!get_who {
+ pir::die("Name $!text ends with '::' and cannot be used as a $dba");
+ }
for @!components {
if pir::can($_, 'isa') && $_.isa(PAST::Node) {
pir::die("Name $!text is not compile-time known, and can not serve as a $dba");
@@ -1347,6 +1350,12 @@ class Perl6::World is HLL::World {
if $_ ne 'GLOBAL' {
pir::die("Cannot use pseudo-package $_ in a $dba");
}
+ elsif +@!components == 1 {
+ pir::die("Cannot declare pseudo-package GLOBAL");
+ }
+ }
+ else {
+ nqp::push(@name, $_);
}
}
}
@@ -1358,7 +1367,7 @@ class Perl6::World is HLL::World {
$comp eq 'CORE' || $comp eq 'SETTING' || $comp eq 'UNIT' ||
$comp eq 'OUTER' || $comp eq 'MY' || $comp eq 'OUR' ||
$comp eq 'PROCESS' || $comp eq 'GLOBAL' || $comp eq 'CALLER' ||
- $comp eq 'DYNAMIC' || $comp eq 'COMPILING'
+ $comp eq 'DYNAMIC' || $comp eq 'COMPILING' || $comp eq 'PARENT'
}
}
@@ -1379,7 +1388,7 @@ class Perl6::World is HLL::World {
if $_<identifier> {
@components.push(~$_<identifier>[0]);
}
- else {
+ elsif $_<EXPR> {
my $EXPR := $_<EXPR>[0].ast;
if $EXPR<has_compile_time_value> {
@components.push(~$EXPR<compile_time_value>);
@@ -1388,17 +1397,19 @@ class Perl6::World is HLL::World {
@components.push($EXPR);
}
}
+ else {
+ # Either it's :: as a name entirely, in which case it's anon,
+ # or we're ending in ::, in which case it implies .WHO.
+ if +@components {
+ nqp::bindattr_i($result, LongName, '$!get_who', 1);
+ }
+ }
}
nqp::bindattr($result, LongName, '@!components', @components);
# Stash colon pairs.
nqp::bindattr($result, LongName, '@!colonpairs', $name<colonpair>);
- # Is it a name that ends in ::?
- if $name && $name<morename> && ~$name<morename>[+$name<morename> - 1] eq '::' {
- nqp::bindattr_i($result, LongName, '$!get_who', 1);
- }
-
$result
}

No commit comments for this range

Something went wrong with that request. Please try again.