This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
add xor, grep, flip, flop to boolean cxt detection
authorDavid Mitchell <davem@iabyn.com>
Wed, 4 Jan 2017 23:50:14 +0000 (23:50 +0000)
committerDavid Mitchell <davem@iabyn.com>
Fri, 6 Jan 2017 16:28:27 +0000 (16:28 +0000)
The code that detects whether certain ops (currently just PADHV and RV2HV)
are called in boolean context only recognises a few ops as providing
boolean context: NOT, OR, DOR, AND, COND_EXPR.

This commit expands this by adding GREPWHILE, FLIP, FLOP, XOR too (in the
case of XOR it only applies to the RHS arg - the LHS is not simple to
detect).

This means that in something like

    @AofH_nonempty = grep %$_, @AofH

the test for each hash being non-empty will now be done in boolean rather
than full scalar context, so may be faster.

Similarly (although less excitingly) these hash key counts are also
boolean now:

    %hash .. $other;
    $other .. %hash;
    $other xor %hash;

(I basically did a grep for 'SvTRUE' in pp*.c to see what other ops might
be imposing boolean context.)

Since this has been added to the general boolean context detection
mechanism, it will also apply for any future ops with are 'booleanised'.

op.c
t/perf/optree.t

diff --git a/op.c b/op.c
index 5966d53..1636993 100644 (file)
--- a/op.c
+++ b/op.c
@@ -13406,9 +13406,22 @@ S_check_for_bool_cxt(pTHX_ OP*o, U8 bool_flag, U8 maybe_flag)
         case OP_SCALAR:
             break;
 
-        /* these two never leave the original value on the stack */
+        /* these two consume the stack argument in the scalar case,
+         * and treat it as a boolean in the non linenumber case */
+        case OP_FLIP:
+        case OP_FLOP:
+            if (   ((lop->op_flags & OPf_WANT) == OPf_WANT_LIST)
+                || (lop->op_private & OPpFLIP_LINENUM))
+            {
+                lop = NULL;
+                break;
+            }
+            /* FALLTHROUGH */
+        /* these never leave the original value on the stack */
         case OP_NOT:
+        case OP_XOR:
         case OP_COND_EXPR:
+        case OP_GREPWHILE:
         /* AND may leave its original arg on the stack, but only if it's
          * false. As long as o returns a value which is both false
          * and usable in scalar context, it's safe.
@@ -13438,6 +13451,7 @@ S_check_for_bool_cxt(pTHX_ OP*o, U8 bool_flag, U8 maybe_flag)
 
         default:
             lop = NULL;
+            break;
         }
 
         if (lop)
index 189cee0..4aebb9e 100644 (file)
@@ -13,7 +13,7 @@ BEGIN {
     @INC = '../lib';
 }
 
-plan 543;
+plan 711;
 
 use v5.10; # state
 use B qw(svref_2object
@@ -312,6 +312,38 @@ for my $ops (
         [ [1,9,1], [0,0,0,1], 'if ($x && %s) {$x} else {$y}'     ],
         [ [1,9,2], [0,0,0,1], 'unless ($x && %s) {$x}'           ],
 
+        # INNER XOR LHS
+
+            # LHS of XOR is currently too hard to detect as
+            # being in boolean context
+
+        # INNER XOR RHS
+
+        [ [1,1,1], [1],       '($x xor %s)'                      ],
+        [ [1,1,1], [0,1],     '!($x xor %s)'                     ],
+        [ [1,1,1], [0,1,1],   '$y || ($x xor %s)'                ],
+        [ [1,9,1], [0,0,1],   'if ($x xor %s) {$x}'              ],
+        [ [1,9,1], [0,0,1],   'if ($x xor %s) {$x} else {$y}'    ],
+        [ [1,9,1], [0,0,1],   'unless ($x xor %s) {$x}'          ],
+
+        # GREP
+
+        [ [1,1,1], [0,1,0],    'grep %s,1,2'                     ],
+        [ [1,1,1], [0,1,0,0],  'grep !%s,1,2'                    ],
+        [ [1,1,1], [0,1,0,0,1],'grep  $y || %s,1,2'              ],
+
+        # FLIP
+
+        [ [1,1,1], [0,0,0,0],      '%s..$x'                      ],
+        [ [1,1,1], [0,0,0,0,0],    '!%s..$x'                     ],
+        [ [1,1,1], [0,0,0,0,0,1],  '($y || %s)..$x'              ],
+
+        # FLOP
+
+        [ [1,1,1], [0,0,0,1],      '$x..%s'                      ],
+        [ [1,1,1], [0,0,0,1,0],    '$x..!%s'                     ],
+        [ [1,1,1], [0,0,0,1,0,1],  '$x..($y || %s)'              ],
+
     ) {
         my ($expects, $op_path, $code_fmt) = @$test;