mirror/perl
1
0
Fork 0
mirror of https://github.com/Perl/perl5.git synced 2026-01-26 16:39:36 +00:00
Code Issues Packages Projects Releases Wiki Activity

op.h/op.c/peep.c - Optimise away empty if{} blocks

Browse Source 
This commit optimises away the OP_STUB associated with an empty `true`
branch of an `OP_COND_EXPR`.

The `OPf_SPECIAL` flag has been brought into use on the `OP_COND_EXPR`
to indicate that it is the `else`, not the `if`, block that has been
optimised away. This is purely for the benefit of B::Deparse.
This commit is contained in:
Richard Leach 2024-12-20 21:08:41 +00:00
parent 75a310dd6d
commit e7778069bc
5 changed files with 147 additions and 12 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

40
lib/B/Deparse.pm
View File

@ -4034,12 +4034,23 @@ sub pp_cond_expr {
my $true = $cond->sibling;
my $false = $true->sibling;
my $cuddle = $self->{'cuddle'};
my $no_true = 0;
if (class($false) eq "NULL") { # Empty else {} block was optimised away
unless ($cx < 1 and (is_scope($true) and $true->name ne "null")) {
$cond = $self->deparse($cond, 8);
$true = $self->deparse($true, 6);
return $self->maybe_parens("$cond ? $true : ()", $cx, 8);
if (class($false) eq "NULL") { # Empty true or false block was optimised away
if (!($op->flags & OPf_SPECIAL)) { # It was an empty true block
my $temp = $false; $false = $true; $true = $temp;
$no_true = 1;
unless ($cx < 1 and (is_scope($false) and $false->name ne "null")) {
$cond = $self->deparse($cond, 8);
$false = $self->deparse($false, 6);
return $self->maybe_parens("$cond ? () : $false", $cx, 8);
}
} else { # Must have been an empty false block
unless ($cx < 1 and (is_scope($true) and $true->name ne "null")) {
$cond = $self->deparse($cond, 8);
$true = $self->deparse($true, 6);
return $self->maybe_parens("$cond ? $true : ()", $cx, 8);
}
}
} else { # Both true and false branches are present
unless ($cx < 1 and (is_scope($true) and $true->name ne "null")
@ -4053,8 +4064,10 @@ sub pp_cond_expr {
}
$cond = $self->deparse($cond, 1);
$true = $self->deparse($true, 0);
my $head = $self->keyword("if") . " ($cond) {\n\t$true\n\b}";
$true = ($no_true) ? "\b" : $self->deparse($true, 0);
my $head = ($no_true)
? $self->keyword("if") . " ($cond) {\n\t();\n\b}"
: $self->keyword("if") . " ($cond) {\n\t$true\n\b}";
my @elsifs;
my $elsif;
while (!null($false) and is_ifelse_cont($false)) {
@ -4069,13 +4082,24 @@ sub pp_cond_expr {
$newcond = $newcond->first->sibling;
}
$newcond = $self->deparse($newcond, 1);
$newtrue = $self->deparse($newtrue, 0);
if (null($false) && ! ($newop->flags & OPf_SPECIAL)) {
# An empty elsif "true" block has been optimised away
my $temp = $false; $false = $newtrue; $newtrue = $temp;
$newtrue = "();";
} else {
$newtrue = $self->deparse($newtrue, 0);
}
$elsif ||= $self->keyword("elsif");
push @elsifs, "$elsif ($newcond) {\n\t$newtrue\n\b}";
}
if (!null($false)) {
$false = $cuddle . $self->keyword("else") . " {\n\t" .
$self->deparse($false, 0) . "\n\b}\cK";
} elsif ($op->flags & OPf_SPECIAL) {
$false = $cuddle . $self->keyword("else") . " {\n\t" .
"();\n\b}\cK";
} else {
$false = "\cK";
}

81
lib/B/Deparse.t
View File

@ -3456,6 +3456,85 @@ my($x, $y, $z);
$z = 1 + ($x ^^ $y);
$z = ($x ^^= $y);
####
# Else block of a ternary is optimised away
# Empty ? branch of a ternary is optimised away
my $x;
my(@y) = $x ? () : [1, 2];
####
# Empty : branch of a ternary is optimised away
my $x;
my(@y) = $x ? [1, 2] : ();
####
# Empty if {} block is optimised away
my($x, $y);
if ($x) {
();
}
else {
$y = 1;
}
####
# Empty else {} block is optimised away
my($x, $y);
if ($x) {
$y = 1;
}
else {
();
}
####
# Empty else {} preceded by an valid elsif
my($x, $y);
if ($x) {
$y = 1;
}
elsif ($y) {
$y = 2;
}
else {
();
}
####
# Empty elsif {} with valid else
my($x, $y);
if ($x) {
$y = 1;
}
elsif ($y) {
();
} else {
$y = 2;
}
####
# Deparse of empty elsif sandwich (filling)
my($x, $y);
if ($x) {
$y = 1;
}
elsif ($y) {
$y = 3;
}
elsif ($y) {
();
}
elsif ($y) {
$y = 4;
} else {
$y = 2;
}
####
# Deparse of empty elsif sandwich (bread)
my($x, $y);
if ($x) {
$y = 1;
}
elsif ($y) {
();
}
elsif ($y) {
$y = 3;
}
elsif ($y) {
();
} else {
$y = 2;
}

2
op.h
View File

@ -164,6 +164,8 @@ Deprecated. Use C<GIMME_V> instead.
/* On OP_RETURN, module_true is in effect */
/* On OP_NEXT/OP_LAST/OP_REDO, there is no
* loop label */
/* On OP_COND_EXPR, indicates that an empty
* "else" condition was optimized away. */
/* There is no room in op_flags for this one, so it has its own bit-
field member (op_folded) instead. The flag is only used to tell
op_convert_list to set op_folded. */

30
peep.c
View File

@ -3589,14 +3589,38 @@ Perl_rpeep(pTHX_ OP *o)
/* FALLTHROUGH */
case OP_COND_EXPR:
if (o->op_type == OP_COND_EXPR) {
OP *stub = cLOGOP->op_other;
/* Is there an empty "if" block or ternary true branch?
If so, optimise away the OP_STUB if safe to do so. */
if (stub->op_type == OP_STUB &&
((stub->op_flags & OPf_WANT) != OPf_WANT_SCALAR)
) {
OP *trueop = OpSIBLING( cLOGOP->op_first );
assert((stub == trueop ) || (OP_TYPE_IS(trueop, OP_SCOPE) &&
((stub == cUNOPx(trueop)->op_first)) && !OpSIBLING(stub))
);
assert(!(stub->op_flags & OPf_KIDS));
cLOGOP->op_other = (stub->op_next == trueop) ?
stub->op_next->op_next :
stub->op_next;
op_sibling_splice(o, cLOGOP->op_first, 1, NULL);
if (stub != trueop) op_free(stub);
op_free(trueop);
} else
/* Is there an empty "else" block or ternary false branch?
If so, optimise away the OP_STUB if safe to do so. */
if (o->op_next->op_type == OP_STUB &&
((o->op_next->op_flags & OPf_WANT) != OPf_WANT_SCALAR)
stub = o->op_next;
if (stub->op_type == OP_STUB &&
((stub->op_flags & OPf_WANT) != OPf_WANT_SCALAR)
) {
OP *stub = o->op_next;
assert(stub == OpSIBLING(OpSIBLING( cLOGOP->op_first )));
assert(!(stub->op_flags & OPf_KIDS));
o->op_flags |= OPf_SPECIAL; /* For B::Deparse */
o->op_next = stub->op_next;
op_sibling_splice(o, OpSIBLING(cLOGOP->op_first), 1, NULL);
op_free(stub);

6
t/perf/opcount.t
View File

@ -1233,6 +1233,12 @@ test_opcount(0, "defined(ABC) gets constant folded",
defined => 0,
});
test_opcount(0, "Empty if{} blocks are optimised away",
sub { my $x; ($x) ? () : 1 },
{
stub => 0
});
test_opcount(0, "Empty else{} blocks are optimised away",
sub { my $x; ($x) ? 1 : () },
{