Optimise if/unless wrt OP_AND/OP_OR/OP_DOR. Also optimise OP_OR/OP_DOR chains.
authorMatthew Horsfall (alh) <wolfsage@gmail.com>
Thu, 19 Sep 2013 23:18:48 +0000 (19:18 -0400)
committerFather Chrysostomos <sprout@cpan.org>
Fri, 20 Sep 2013 19:44:40 +0000 (12:44 -0700)
An OP_AND/OP_OR/OP_DOR in void context provides a short circuit
through ->op_other that can be used if AND/OR/DOR 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

op.c
t/op/or.t

diff --git a/op.c b/op.c
index fccbd92..922fe61 100644 (file)
--- a/op.c
+++ b/op.c
@@ -10949,6 +10949,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_ORISH_OP(o) (o->op_type == OP_OR || o->op_type == OP_DOR)
+
 /* 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 */
@@ -11411,6 +11414,23 @@ 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;
+           /* OP_OR/OP_DOR behave the same wrt op_next */
+           if (IS_ORISH_OP(o)) {
+              while (o->op_next && ( IS_ORISH_OP(o->op_next)
+                                 ||  o->op_next->op_type == OP_NULL))
+                  o->op_next = o->op_next->op_next;
+           }
+           /* if we're an OR/DOR and our next is a AND in void context, we'll
+             follow it's op_other on short circuit, same for reverse */
+           if (o->op_next &&
+               (
+                   (IS_AND_OP(o) && IS_ORISH_OP(o->op_next))
+                || (IS_ORISH_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;
index 5260780..2a85ff5 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 => 8 );
+plan( tests => 10 );
 
 
 my ($a, $b, $c);
@@ -66,3 +66,20 @@ $c = $a || $b;
     local $TODO = 'Double FETCH';
     is($c, 1,   '   $tied || $var');
 }
+
+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");
+