summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorMatthew Horsfall (alh) <wolfsage@gmail.com>2013-10-08 12:56:08 -0400
committerTony Cook <tony@develop-help.com>2013-11-19 15:35:32 +1100
commite45d8982aeb58420180a04c6079471d707058965 (patch)
treeaabdb7bb894da028248ce14d1828af50c4720f69
parentd320cf40013cb3d9e9458bacdc38048ffba35a6c (diff)
downloadperl-e45d8982aeb58420180a04c6079471d707058965.tar.gz
Optimise 'if ($a || $b)' and 'unless ($a && $b)' early exit
An OP_AND/OP_OR in void context provides a short circuit through ->op_other that can be used if AND/OR ops contained within it jump out early. Use that short circuit. Previously: $ ./perl -Ilib -MO=Concise -e 'if ($aa || $bb) {}' 8 <@> leave[1 ref] vKP/REFC ->(end) 1 <0> enter ->2 2 <;> nextstate(main 3 -e:1) v:{ ->3 - <1> null vK/1 ->8 6 <|> and(other->7) vK/1 ->8 - <1> null sK/1 ->6 4 <|> or(other->5) sK/1 ->6 <-- Not optimised - <1> ex-rv2sv sK/1 ->4 3 <$> gvsv(*aa) s ->4 - <1> ex-rv2sv sK/1 ->- 5 <$> gvsv(*bb) s ->6 - <@> scope vK ->- 7 <0> stub v ->8 Now: $ ./perl -Ilib -MO=Concise -e 'if ($aa || $bb) {}' 8 <@> leave[1 ref] vKP/REFC ->(end) 1 <0> enter ->2 2 <;> nextstate(main 3 -e:1) v:{ ->3 - <1> null vK/1 ->8 6 <|> and(other->7) vK/1 ->8 - <1> null sK/1 ->6 4 <|> or(other->5) sK/1 ->7 <-- Short circuited - <1> ex-rv2sv sK/1 ->4 3 <$> gvsv(*aa) s ->4 - <1> ex-rv2sv sK/1 ->- 5 <$> gvsv(*bb) s ->6 - <@> scope vK ->- 7 <0> stub v ->8
-rw-r--r--op.c18
-rw-r--r--t/op/dor.t26
-rw-r--r--t/op/or.t18
3 files changed, 60 insertions, 2 deletions
diff --git a/op.c b/op.c
index 236a6e0aa4..fe6d89e9ec 100644
--- a/op.c
+++ b/op.c
@@ -11062,6 +11062,9 @@ S_inplace_aassign(pTHX_ OP *o) {
defer_queue[(defer_base + ++defer_ix) % MAX_DEFERRED] = o; \
} STMT_END
+#define IS_AND_OP(o) (o->op_type == OP_AND)
+#define IS_OR_OP(o) (o->op_type == OP_OR)
+
/* A peephole optimizer. We visit the ops in the order they're to execute.
* See the comments at the top of this file for more details about when
* peep() is called */
@@ -11529,6 +11532,21 @@ Perl_rpeep(pTHX_ OP *o)
while (o->op_next && ( o->op_type == o->op_next->op_type
|| o->op_next->op_type == OP_NULL))
o->op_next = o->op_next->op_next;
+
+ /* if we're an OR and our next is a AND in void context, we'll
+ follow it's op_other on short circuit, same for reverse.
+ We can't do this with OP_DOR since if it's true, its return
+ value is the underlying value which must be evaluated
+ by the next op */
+ if (o->op_next &&
+ (
+ (IS_AND_OP(o) && IS_OR_OP(o->op_next))
+ || (IS_OR_OP(o) && IS_AND_OP(o->op_next))
+ )
+ && (o->op_next->op_flags & OPf_WANT) == OPf_WANT_VOID
+ ) {
+ o->op_next = ((LOGOP*)o->op_next)->op_other;
+ }
DEFER(cLOGOP->op_other);
o->op_opt = 1;
diff --git a/t/op/dor.t b/t/op/dor.t
index e2385f1a7b..a0b98f189e 100644
--- a/t/op/dor.t
+++ b/t/op/dor.t
@@ -10,7 +10,7 @@ BEGIN {
package main;
require './test.pl';
-plan( tests => 31 );
+plan( tests => 34 );
my($x);
@@ -74,3 +74,27 @@ like( $@, qr/^Search pattern not terminated/,
is(0 // 2, 0, ' // : left-hand operand not optimized away');
is('' // 2, '', ' // : left-hand operand not optimized away');
is(undef // 2, 2, ' // : left-hand operand optimized away');
+
+# Test that OP_DORs other branch isn't run when arg is defined
+# // returns the value if its defined, and we must test its
+# truthness after
+my $x = 0;
+my $y = 0;
+
+$x // 1 and $y = 1;
+is($y, 0, 'y is still 0 after "$x // 1 and $y = 1"');
+
+$y = 0;
+# $x is defined, so its value 0 is returned to the if block
+# and the block is skipped
+if ($x // 1) {
+ $y = 1;
+}
+is($y, 0, 'if ($x // 1) exited out early since $x is defined and 0');
+
+# This is actually (($x // $z) || 'cat'), so 0 from first dor
+# evaluates false, we should see 'cat'.
+$y = undef;
+
+$y = $x // $z || 'cat';
+is($y, 'cat', 'chained or/dor behaves correctly');
diff --git a/t/op/or.t b/t/op/or.t
index 7a4997b184..056989f48a 100644
--- a/t/op/or.t
+++ b/t/op/or.t
@@ -25,7 +25,7 @@ sub FETCH {
package main;
require './test.pl';
-plan( tests => 9 );
+plan( tests => 11 );
my ($a, $b, $c);
@@ -72,3 +72,19 @@ for (pos $x || pos $y) {
eval { $_++ };
}
is(pos($y) || $@, 1, "|| propagates lvaluish context");
+
+my $aa, $bb, $cc;
+$bb = 1;
+
+my $res = 0;
+# Well, really testing OP_DOR I guess
+unless ($aa || $bb // $cc) {
+ $res = 1;
+}
+is($res, 0, "res is 0 after mixed OR/DOR");
+
+$res = 0;
+unless ($aa // $bb || $cc) {
+ $res = 1;
+}
+is($res, 0, "res is 0 after mixed DOR/OR");