Skip to content

Commit

Permalink
Merge branch 'master' into handle-6.d
Browse files Browse the repository at this point in the history
  • Loading branch information
@zoffixznet
zoffixznet committed Jul 11, 2018
2 parents 03d7997 + 86846ac commit 44ae378
Show file tree
Hide file tree
Showing 36 changed files with 1,224 additions and 1,138 deletions.
402 changes: 355 additions & 47 deletions src/Perl6/Actions.nqp
View file

Large diffs are not rendered by default.

352 changes: 331 additions & 21 deletions src/Perl6/Metamodel/BOOTSTRAP.nqp
View file

Large diffs are not rendered by default.

37 changes: 0 additions & 37 deletions src/Perl6/Metamodel/ContainerDescriptor.nqp
View file

This file was deleted.

50 changes: 36 additions & 14 deletions src/Perl6/Optimizer.nqp
View file
Expand Up @@ -628,7 +628,7 @@ my class BlockVarOptimizer {
next unless $scope eq 'lexical';

# Also ensure not dynamic.
my $dynamic := try nqp::getattr($qast.value, nqp::p6var($qast.value).WHAT, '$!descriptor').dynamic;
my $dynamic := try nqp::getattr($qast.value, nqp::what_nd($qast.value), '$!descriptor').dynamic;
next if $dynamic;

# Consider name. Can't lower if it's used by any nested blocks.
Expand Down Expand Up @@ -1132,7 +1132,7 @@ class Perl6::Optimizer {

# Let's see if we can catch a type mismatch in assignment at compile-time.
# Especially with Num, Rat, and Int there's often surprises at run-time.
if ($optype eq 'assign' || $optype eq 'assign_n' || $optype eq 'assign_i')
if ($optype eq 'p6assign' || $optype eq 'assign_n' || $optype eq 'assign_i')
&& nqp::istype($op[0], QAST::Var)
&& ($op[0].scope eq 'lexical' || $op[0].scope eq 'lexicalref') {
if nqp::istype($op[1], QAST::Want) {
Expand Down Expand Up @@ -1914,7 +1914,7 @@ class Perl6::Optimizer {
$is-always-definite := 1;
}
elsif $sigil eq '$' {
$assignop := 'assign';
$assignop := 'p6assign';
}
elsif $sigil eq '@' || $sigil eq '%' {
$assignop := 'p6store';
Expand Down Expand Up @@ -1979,7 +1979,7 @@ class Perl6::Optimizer {

$op.annotate_self: 'METAOP_opt_result', 1;
$op.returns: $assignee.returns
if $assignop ne 'assign'
if $assignop ne 'p6assign'
&& nqp::objprimspec($assignee.returns);

my $*NO-COMPILE-TIME-THROWAGE := 1;
Expand Down Expand Up @@ -2236,24 +2236,46 @@ class Perl6::Optimizer {

# Any literal in void context deserves a warning.
if $!void_context && +@($want) == 3 && $want.node
&& ! $want.ann('sink-quietly') {

&& !$want.ann('sink-quietly') {
my str $warning;
my $no-sink;

if $want[1] eq 'Ss' && nqp::istype($want[2], QAST::SVal) {
$warning := qq[Useless use of constant string "]
~ nqp::escape($want[2].node // $want[2].value)
~ qq[" in sink context];
$warning := 'constant string "'
~ nqp::escape($want[2].node // $want[2].value)
~ '"'
}
elsif $want[1] eq 'Ii' && nqp::istype($want[2], QAST::IVal) {
$warning := qq[Useless use of constant integer ]
~ ($want[2].node // $want[2].value)
~ qq[ in sink context];
$warning := 'constant integer '
~ ($want[2].node // $want[2].value);
}
elsif $want[1] eq 'Nn' && nqp::istype($want[2], QAST::NVal) {
$warning := qq[Useless use of constant floating-point number ]
~ ($want[2].node // $want[2].value) ~ qq[ in sink context];
$warning := 'constant floating-point number '
~ ($want[2].node // $want[2].value);
}
elsif $want[1] eq 'v' && nqp::istype($want[2], QAST::Op) {
# R#2040
# - QAST::Op(p6capturelex)
# - QAST::Op(callmethod clone)
# - QAST::WVal(Sub...)
if $want[0].op eq 'p6capturelex' {
my $op := $want[0][0];
if $op.op eq 'callmethod' && $op.name eq 'clone' {
$op := $op[0];
if nqp::istype($op, QAST::WVal) && nqp::istype(
$op.value,
$!symbols.find_in_setting("Sub")
) && !$op.value.name {
$warning := qq[anonymous sub, did you forget to provide a name?];
$no-sink := 1;
}
}
}
}

if $warning {
$warning := "Useless use of " ~ $warning;
$warning := $warning ~ qq[ in sink context] unless $no-sink;
$warning := $warning ~ ' (use Nil instead to suppress this warning)' if $want.okifnil;
note($warning) if $!debug;
$!problems.add_worry($want, $warning);
Expand Down
34 changes: 18 additions & 16 deletions src/Perl6/World.nqp
View file
Expand Up @@ -1266,7 +1266,8 @@ class Perl6::World is HLL::World {
:auth-matcher(%opts<auth> // $true),
:api-matcher(%opts<api> // $true),
:version-matcher(%opts<ver> // $true),
:source-line-number($line)
:source-line-number($line),
:source-file-name(self.current_file)
);
self.add_object($spec);
my $registry := self.find_symbol(['CompUnit', 'RepositoryRegistry'], :setting-only);
Expand Down Expand Up @@ -1568,9 +1569,9 @@ class Perl6::World is HLL::World {
}

# Creates a new container descriptor and adds it to the SC.
method create_container_descriptor($of, $rw, $name, $default = $of, $dynamic = nqp::chars($name) > 2 && nqp::eqat($name, '*', 1)) {
method create_container_descriptor($of, $name, $default = $of, $dynamic = nqp::chars($name) > 2 && nqp::eqat($name, '*', 1)) {
my $cd_type := self.find_symbol(['ContainerDescriptor'], :setting-only);
my $cd := $cd_type.new( :$of, :$rw, :$name, :$default, :$dynamic );
my $cd := $cd_type.new( :$of, :$name, :$default, :$dynamic );
self.add_object($cd);
$cd
}
Expand Down Expand Up @@ -1796,7 +1797,7 @@ class Perl6::World is HLL::World {
'scalar_value', $WHAT,
);
my $desc :=
self.create_container_descriptor($Mu, 1, $name, $WHAT, 1);
self.create_container_descriptor($Mu, $name, $WHAT, 1);

my $cont := self.build_container_and_add_to_sc(%info, $desc);

Expand Down Expand Up @@ -1869,7 +1870,7 @@ class Perl6::World is HLL::World {
my %cont_info := self.container_type_info(NQPMu, $var<sigil>,
$*OFTYPE ?? [$*OFTYPE.ast] !! [], []);
%cont_info<value_type> := self.find_symbol(['Any'], :setting-only);
my $descriptor := self.create_container_descriptor(%cont_info<value_type>, 1, $name);
my $descriptor := self.create_container_descriptor(%cont_info<value_type>, $name);

nqp::die("auto_declare_var") unless nqp::objectid($*PACKAGE) == nqp::objectid($*LEAF.package);
self.install_lexical_container($BLOCK, $name, %cont_info, $descriptor,
Expand Down Expand Up @@ -2059,6 +2060,7 @@ class Perl6::World is HLL::World {

# Walk parameters, setting up parameter objects.
my $default_type := self.find_symbol([$default_type_name]);
my $param_type := self.find_symbol(['Parameter'], :setting-only);
my @param_objs;
my %seen_names;
for @params {
Expand Down Expand Up @@ -2096,26 +2098,26 @@ class Perl6::World is HLL::World {
$_<sub_signature_params>, $lexpad, $default_type_name);
}

# Create parameter object and apply any traits.
my $param_obj := self.create_parameter($/, $_);
self.apply_traits($_<traits>, $param_obj) if $_<traits>;

# Add variable as needed.
my int $flags := nqp::getattr_i($param_obj, $param_type, '$!flags');
my $varname := $_<variable_name>;
if $varname {
if $varname && ($flags +& $SIG_ELEM_IS_RW || $flags +& $SIG_ELEM_IS_COPY) {
my %sym := $lexpad.symbol($varname);
if +%sym && !nqp::existskey(%sym, 'descriptor') {
$_<container_descriptor> := self.create_container_descriptor(
$_<nominal_type>, $_<is_rw> ?? 1 !! 0, $varname);
$lexpad.symbol($varname, :descriptor($_<container_descriptor>));
my $desc := self.create_container_descriptor($_<nominal_type>, $varname);
$_<container_descriptor> := $desc;
nqp::bindattr($param_obj, $param_type, '$!container_descriptor', $desc);
$lexpad.symbol($varname, :descriptor($desc));
}
}

# Create parameter object and apply any traits.
my $param_obj := self.create_parameter($/, $_);
self.apply_traits($_<traits>, $param_obj) if $_<traits>;

# If it's natively typed and we got "is rw" set, need to mark the
# container as being a lexical ref.
if $varname && nqp::objprimspec($_<nominal_type>) {
my $param_type := self.find_symbol(['Parameter'], :setting-only);
my int $flags := nqp::getattr_i($param_obj, $param_type, '$!flags');
if $flags +& $SIG_ELEM_IS_RW {
for @($lexpad[0]) {
if nqp::istype($_, QAST::Var) && $_.name eq $varname {
Expand Down Expand Up @@ -3911,7 +3913,7 @@ class Perl6::World is HLL::World {
%info<bind_constraint> := self.find_symbol(['Associative'], :setting-only);
%info<value_type> := $mu;
self.install_lexical_container($*UNIT, '!INIT_VALUES', %info,
self.create_container_descriptor($mu, 1, '!INIT_VALUES'));
self.create_container_descriptor($mu, '!INIT_VALUES'));
}
$*UNIT[0].push(QAST::Op.new(
:op('callmethod'), :name('BIND-KEY'),
Expand Down
40 changes: 3 additions & 37 deletions src/core/Any.pm6
View file
Expand Up @@ -251,30 +251,10 @@ my class Any { # declared in BOOTSTRAP

proto method AT-POS(|) is nodal {*}
multi method AT-POS(Any:U \SELF: int \pos) is raw {
nqp::p6bindattrinvres(
my $scalar,
Scalar,
'$!whence',
-> { nqp::if(
nqp::isconcrete(SELF),
SELF,
(SELF = Array.new)
).BIND-POS(pos, $scalar)
}
)
nqp::p6scalarfromdesc(ContainerDescriptor::VivifyArray.new(SELF, pos))
}
multi method AT-POS(Any:U \SELF: Int:D \pos) is raw {
nqp::p6bindattrinvres(
my $scalar,
Scalar,
'$!whence',
-> { nqp::if(
nqp::isconcrete(SELF),
SELF,
(SELF = Array.new)
).BIND-POS(pos, $scalar)
}
)
nqp::p6scalarfromdesc(ContainerDescriptor::VivifyArray.new(SELF, pos))
}
multi method AT-POS(Any:U: Num:D \pos) is raw {
nqp::isnanorinf(pos)
Expand Down Expand Up @@ -405,21 +385,7 @@ my class Any { # declared in BOOTSTRAP
)
}
multi method AT-KEY(Any:U \SELF: \key) is raw {
nqp::p6bindattrinvres(
my $scalar,
Scalar,
'$!whence',
# NOTE: even though the signature indicates a non-concrete SELF,
# by the time the below code is executed, it *may* have become
# concrete: and then we don't want the execution to reset it to
# an empty Hash.
-> { nqp::if(
nqp::isconcrete(SELF),
SELF,
(SELF = nqp::create(Hash))
).BIND-KEY(key, $scalar)
}
)
nqp::p6scalarfromdesc(ContainerDescriptor::VivifyHash.new(SELF, key))
}

proto method BIND-KEY(|) is nodal {*}
Expand Down

0 comments on commit 44ae378

Please sign in to comment.