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

diff --git a/op.c b/op.c
index 236a6e0..fe6d89e 100644 (file)
--- 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 e2385f1..a0b98f1 100644 (file)
--- 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 7a4997b..056989f 100644 (file)
--- 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");