Skip to content
Permalink
Browse files

Don't lower $_ when in 6.c

Turns out the `is dynamic` markings alone are not quite enough, so
simply don't perform this optimization when we are in 6.c. Gets the
previous specs appendix test covering $CALLER::_ passing again.
  • Loading branch information...
jnthn committed Jan 4, 2019
1 parent eb3917c commit a4c994f544dc611f59221f8354de46a06da7850c
Showing with 15 additions and 4 deletions.
  1. +2 −0 src/Perl6/Actions.nqp
  2. +1 −0 src/Perl6/Grammar.nqp
  3. +10 −4 src/Perl6/Optimizer.nqp
  4. +2 −0 src/Perl6/World.nqp
@@ -1398,6 +1398,8 @@ class Perl6::Actions is HLL::Actions does STDActions {
$outer
).annotate_self( # Pass some extra bits along to the optimizer.
'UNIT', $unit
).annotate_self(
'CAN_LOWER_TOPIC', $*CAN_LOWER_TOPIC
).annotate_self('GLOBALish', $*GLOBALish).annotate_self('W', $*W)
}

@@ -788,6 +788,7 @@ grammar Perl6::Grammar is HLL::Grammar does STD {
# TODO XXX: see https://github.com/rakudo/rakudo/issues/2432
:my $*SET_DEFAULT_LANG_VER := 1;
:my %*SIG_INFO; # information about recent signature
:my $*CAN_LOWER_TOPIC := 1; # true if we optimize the $_ lexical away
# Various interesting scopes we'd like to keep to hand.
:my $*GLOBALish;
@@ -635,7 +635,7 @@ my class BlockVarOptimizer {
}
}

method lexical_vars_to_locals($block, $LoweredAwayLexical) {
method lexical_vars_to_locals($block, $LoweredAwayLexical, $can_lower_topic) {
return 0 if $!poisoned || $!uses_bindsig;
return 0 unless nqp::istype($block[0], QAST::Stmts);
for %!decls {
@@ -666,14 +666,15 @@ my class BlockVarOptimizer {
my str $name := $_.key;
unless nqp::existskey(%!usages_inner, $name) ||
nqp::existskey(%!used_in_handle_handler, $name) {
# Lowerable if it's a normal variable, including $_.
# Lowerable if it's a normal variable, including $_ if we're in a
# Perl 6 version that allows lowering that.
next if nqp::chars($name) < 1;
unless nqp::iscclass(nqp::const::CCLASS_ALPHABETIC, $name, 0) {
my str $sigil := nqp::substr($name, 0, 1);
next unless $sigil eq '$' || $sigil eq '@' || $sigil eq '%';
next unless nqp::chars($name) >= 2 &&
(nqp::iscclass(nqp::const::CCLASS_ALPHABETIC, $name, 1) ||
nqp::eqat($name, '_', 1));
$can_lower_topic && nqp::eqat($name, '_', 1));
}

# Also must not lexicalref it.
@@ -983,6 +984,10 @@ class Perl6::Optimizer {
# one shared QAST tree we'll put into every block we've eliminated
has $!eliminated_block_contents;

# Are we allowed to lower the topic ($_) to a local?
has $!can_lower_topic;

# Are we in debug mode?
has $!debug;

# Entry point for the optimization process.
@@ -995,6 +1000,7 @@ class Perl6::Optimizer {
$!chain_depth := 0;
$!in_declaration := 0;
$!void_context := 0;
$!can_lower_topic := $past.ann('CAN_LOWER_TOPIC');
$!debug := nqp::getenvhash<RAKUDO_OPTIMIZER_DEBUG>;
my $*DYNAMICALLY_COMPILED := 0;
my $*W := $past.ann('W');
@@ -1096,7 +1102,7 @@ class Perl6::Optimizer {

# Do any possible lexical => local lowering.
if $!level >= 2 {
$vars_info.lexical_vars_to_locals($block, $!symbols.LoweredAwayLexical);
$vars_info.lexical_vars_to_locals($block, $!symbols.LoweredAwayLexical, $!can_lower_topic);
}

# Incorporate this block's info into outer block's info.
@@ -529,6 +529,7 @@ class Perl6::World is HLL::World {
# fast-path the common cases
if $version eq 'v6.c' {
$comp.set_language_version: '6.c';
$*CAN_LOWER_TOPIC := 0;
# CORE.c is currently our lowest core, which we don't "load"
return;
}
@@ -549,6 +550,7 @@ class Perl6::World is HLL::World {

my $lang := $vCan.parts.AT-POS: 1;
$comp.set_language_version: '6.' ~ $lang;
$*CAN_LOWER_TOPIC := 0 if $lang eq 'c';

# CORE.c is currently our lowest core, which we don't "load"
self.load_setting: $ver-match, 'CORE.' ~ $lang

0 comments on commit a4c994f

Please sign in to comment.
You can’t perform that action at this time.