re-implement boolean context detection
authorDavid Mitchell <davem@iabyn.com>
Wed, 4 Jan 2017 20:27:55 +0000 (20:27 +0000)
committerDavid Mitchell <davem@iabyn.com>
Fri, 6 Jan 2017 16:28:27 +0000 (16:28 +0000)
When certain ops are used in a boolean context (currently just PADHV and
RV2SV, implementing '%hash'), one of the private flags OPpTRUEBOOL or
OPpMAYBE_TRUEBOOL is set on the op to indicate this; at
runtime, the pp function can then just return a boolean value rather than
 a full scalar value (in the case of %hash, an element count).

However, the code which sets these flags has had a complex history, and is
a bit messy. It also sets the flags incorrectly (but safely) in many
cases: principally indicating boolean context when it's in fact void, or
scalar context when it's in fact boolean. Both these permutations make the
code potentially slower (but still correct).

[ As a side-note: in 5.25, a bare %hash in scalar context changed from
returning a bucket count etc, to just returning a key count, which is
quicker to calculate. So the boolean optimisation for %hash is not nearly
as important now: it's now just the overhead of creating a temp to return
a count verses returning &PL_sv_yes, rather than counting keys. However
the improved and generalised boolean context detection added by this
commit will be useful in future to apply boolean context to other ops. ]

In particular, this wasn't being optimised (i.e. a 'not' of a hash within
an if):

    if (!%hash) { ...}

This commit fixes all these cases (and uncomments a load of failing tests
in t/perf/optree.t which were added in the previous commit.)

It makes the code below nearly 3 times faster:

    my $c; my %h = 1..10;
    for my $i (1..10_000_000) { if (!%h) { $c++ }; }

It restructures the relevant code in rpeep() so that rather than switching
on logops like OP_OR, then seeing if that op is preceded by PADHV/RV2HV,
it instead switches on PADHV/RV2HV then sees if succeeding ops impose
boolean context on that op - that is to say, in all possible execution
paths after the PADHV/RV2HV pushes a scalar onto the stack, will that
scalar only ever be used for a boolean test? (*).

The scanning of succeeding ops is extracted out into a static function.
This will make it very easy in future to apply boolean context to other
ops too, or to expand the definition of boolean context (e.g. adding
'xor').

(*) Although in theory an expression like (A && B) can return A if A is
false, if A happens to be %hash, and as long as pp_padhv() etc return
a boolean false value that is also usable in scalar context (so it returns
0 rather than PL_sv_no), then we can pretend that OP_AND's LH arg is
never used as a scalar.

op.c
pp.c
pp_hot.c
t/perf/optree.t

diff --git a/op.c b/op.c
index 339a9ce..7aa56f7 100644 (file)
--- a/op.c
+++ b/op.c
@@ -13383,6 +13383,68 @@ S_maybe_multideref(pTHX_ OP *start, OP *orig_o, UV orig_action, U8 hints)
     } /* for (pass = ...) */
 }
 
+/* See if the ops following o are such that o will always be executed in
+ * boolean context: that is, the SV which o pushes onto the stack will
+ * only ever be used by later ops with SvTRUE(sv) or similar.
+ * If so, set a suitable private flag on o. Normally this will be
+ * bool_flag; but if it's only possible to determine booleaness at run
+ * time (e.g. sub f { ....; (%h || $y) }), then set maybe_flag instead.
+ */
+
+static void
+S_check_for_bool_cxt(pTHX_ OP*o, U8 bool_flag, U8 maybe_flag)
+{
+    OP *lop;
+
+    assert((o->op_flags & OPf_WANT) == OPf_WANT_SCALAR);
+
+    lop = o->op_next;
+
+    while (lop) {
+        switch (lop->op_type) {
+        case OP_NULL:
+        case OP_SCALAR:
+            break;
+
+        /* these two never leave the original value on the stack */
+        case OP_NOT:
+        case OP_COND_EXPR:
+        /* 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.
+         */
+        case OP_AND:
+            o->op_private |= bool_flag;
+            lop = NULL;
+            break;
+
+        /* OR and DOR leave the original arg on the stack when following
+         * the op_next route. If not in void context, we need to ensure
+         * that whatever follows consumes the arg only in boolean context
+         * too.
+         */
+        case OP_OR:
+        case OP_DOR:
+            if ((lop->op_flags & OPf_WANT) == OPf_WANT_VOID) {
+                o->op_private |= bool_flag;
+                lop = NULL;
+            }
+            else if (!(lop->op_flags & OPf_WANT)) {
+                /* unknown context - decide at runtime */
+                o->op_private |= maybe_flag;
+                lop = NULL;
+            }
+            break;
+
+        default:
+            lop = NULL;
+        }
+
+        if (lop)
+            lop = lop->op_next;
+    }
+}
+
 
 
 /* mechanism for deferring recursion in rpeep() */
@@ -13418,8 +13480,6 @@ Perl_rpeep(pTHX_ OP *o)
     OP** defer_queue[MAX_DEFERRED]; /* small queue of deferred branches */
     int defer_base = 0;
     int defer_ix = -1;
-    OP *fop;
-    OP *sop;
 
     if (!o || o->op_opt)
        return;
@@ -14114,9 +14174,16 @@ Perl_rpeep(pTHX_ OP *o)
             break;
         }
 
+       case OP_RV2HV:
+       case OP_PADHV:
+            /* see if %h is used in boolean context */
+            if ((o->op_flags & OPf_WANT) == OPf_WANT_SCALAR)
+                S_check_for_bool_cxt(aTHX_ o, OPpTRUEBOOL, OPpMAYBE_TRUEBOOL);
+            if (o->op_type != OP_PADHV)
+                break;
+            /* FALLTHROUGH */
        case OP_PADAV:
        case OP_PADSV:
-       case OP_PADHV:
        /* Skip over state($x) in void context.  */
        if (oldop && o->op_private == (OPpPAD_STATE|OPpLVAL_INTRO)
         && (o->op_flags & OPf_WANT) == OPf_WANT_VOID)
@@ -14206,25 +14273,12 @@ Perl_rpeep(pTHX_ OP *o)
 
            break;
         
-#define HV_OR_SCALARHV(op)                                   \
-    (  (op)->op_type == OP_PADHV || (op)->op_type == OP_RV2HV \
-       ? (op)                                                  \
-       : (op)->op_type == OP_SCALAR && (op)->op_flags & OPf_KIDS \
-       && (  cUNOPx(op)->op_first->op_type == OP_PADHV          \
-          || cUNOPx(op)->op_first->op_type == OP_RV2HV)          \
-         ? cUNOPx(op)->op_first                                   \
-         : NULL)
-
         case OP_NOT:
-            if ((fop = HV_OR_SCALARHV(cUNOP->op_first)))
-                fop->op_private |= OPpTRUEBOOL;
             break;
 
         case OP_AND:
        case OP_OR:
        case OP_DOR:
-            fop = cLOGOP->op_first;
-            sop = OpSIBLING(fop);
            while (cLOGOP->op_other->op_type == OP_NULL)
                cLOGOP->op_other = cLOGOP->op_other->op_next;
            while (o->op_next && (   o->op_type == o->op_next->op_type
@@ -14246,53 +14300,10 @@ Perl_rpeep(pTHX_ OP *o)
                o->op_next = ((LOGOP*)o->op_next)->op_other;
            }
            DEFER(cLOGOP->op_other);
-          
            o->op_opt = 1;
-            fop = HV_OR_SCALARHV(fop);
-            if (sop) sop = HV_OR_SCALARHV(sop);
-            if (fop || sop
-            ){ 
-                OP * nop = o;
-                OP * lop = o;
-                if (!((nop->op_flags & OPf_WANT) == OPf_WANT_VOID)) {
-                    while (nop && nop->op_next) {
-                        switch (nop->op_next->op_type) {
-                            case OP_NOT:
-                            case OP_AND:
-                            case OP_OR:
-                            case OP_DOR:
-                                lop = nop = nop->op_next;
-                                break;
-                            case OP_NULL:
-                                nop = nop->op_next;
-                                break;
-                            default:
-                                nop = NULL;
-                                break;
-                        }
-                    }            
-                }
-                if (fop) {
-                    if (  (lop->op_flags & OPf_WANT) == OPf_WANT_VOID
-                      || o->op_type == OP_AND  )
-                        fop->op_private |= OPpTRUEBOOL;
-                    else if (!(lop->op_flags & OPf_WANT))
-                        fop->op_private |= OPpMAYBE_TRUEBOOL;
-                }
-                if (  (lop->op_flags & OPf_WANT) == OPf_WANT_VOID
-                   && sop)
-                    sop->op_private |= OPpTRUEBOOL;
-            }                  
-            
-           
            break;
        
        case OP_COND_EXPR:
-           if ((fop = HV_OR_SCALARHV(cLOGOP->op_first)))
-               fop->op_private |= OPpTRUEBOOL;
-#undef HV_OR_SCALARHV
-           /* GERONIMO! */ /* FALLTHROUGH */
-
        case OP_MAPWHILE:
        case OP_GREPWHILE:
        case OP_ANDASSIGN:
diff --git a/pp.c b/pp.c
index c015bfe..56dcf5d 100644 (file)
--- a/pp.c
+++ b/pp.c
@@ -150,6 +150,8 @@ PP(pp_padhv)
             && block_gimme() == G_VOID  ))
          && (!SvRMAGICAL(TARG) || !mg_find(TARG, PERL_MAGIC_tied))
     )
+        /* use newSViv(0) rather than PL_sv_no - see OP_AND comment in
+         * S_check_for_bool_cxt() */
        SETs(HvUSEDKEYS(TARG) ? &PL_sv_yes : sv_2mortal(newSViv(0)));
     else if (gimme == G_SCALAR) {
        SV* const sv = Perl_hv_scalar(aTHX_ MUTABLE_HV(TARG));
index ec3afe4..cc93999 100644 (file)
--- a/pp_hot.c
+++ b/pp_hot.c
@@ -1039,6 +1039,8 @@ PP(pp_rv2av)
              || (  PL_op->op_private & OPpMAYBE_TRUEBOOL
                 && block_gimme() == G_VOID  ))
              && (!SvRMAGICAL(sv) || !mg_find(sv, PERL_MAGIC_tied)))
+            /* use newSViv(0) rather than PL_sv_no - see OP_AND comment in
+             * S_check_for_bool_cxt() */
            SETs(HvUSEDKEYS(sv) ? &PL_sv_yes : sv_2mortal(newSViv(0)));
        else if (gimme == G_SCALAR) {
            dTARG;
index 75586ef..189cee0 100644 (file)
@@ -13,7 +13,7 @@ BEGIN {
     @INC = '../lib';
 }
 
-plan 267;
+plan 543;
 
 use v5.10; # state
 use B qw(svref_2object
@@ -227,13 +227,12 @@ for my $ops (
         #                1: expect bool flag
         #                2: expect maybe bool flag
         #                9: skip test
-        #  2nd column: if true, code can be put in scalar context 
-        #  3rd column: path though the op subtree to the flagged op:
-        #                0 is first sibling, 1 is second sibling etc.
+        #  2nd column: path though the op subtree to the flagged op:
+        #                0 is first child, 1 is second child etc.
         #                Will have @$post_op_path from above appended.
-        #  4rd column: code to execute: %s holds the code for the op
+        #  3rd column: code to execute: %s holds the code for the op
         #
-        # [V S U]  PATH   CODE
+        # [V S U]  PATH        CODE
 
         # INNER PLAIN
 
@@ -245,11 +244,9 @@ for my $ops (
         # INNER NOT
 
         [ [1,1,1], [0],       '!%s'                              ],
-        #XXX should be bool, gives void
-        #XXX[ [1,9,1], [0,0,0],   'if (!%s) {$x}'                ],
+        [ [1,9,1], [0,0,0],   'if (!%s) {$x}'                    ],
         [ [1,9,1], [0,0,0],   'if (!%s) {$x} else {$y}'          ],
-        #XXX should be bool, gives void
-        #XXX[ [1,9,1], [0,0,0],   'unless (!%s) {$x}'            ],
+        [ [1,9,1], [0,0,0],   'unless (!%s) {$x}'                ],
 
         # INNER COND
 
@@ -262,61 +259,40 @@ for my $ops (
         # INNER OR LHS
 
         [ [1,0,2], [0,0],     '%s || $x'                         ],
-        #XXX the not should always force bool cxt
-        #XXX[ [1,1,1], [0,0,0],   '!(%s || $x)'                  ],
+        [ [1,1,1], [0,0,0],   '!(%s || $x)'                      ],
         [ [1,0,2], [0,1,0,0], '$y && (%s || $x)'                 ],
-        #XXX should be bool, gives void/maybe
-        #XXX[ [1,9,1], [0,0,0,0], 'if (%s || $x) {$x}'           ],
-        #XXX should be bool, gives void/maybe
-        #XXX[ [1,9,1], [0,0,0,0], 'if (%s || $x) {$x} else {$y}' ],
-        #XXX should be bool/maybe, gives void
-        #XXX[ [1,9,2], [0,0,0,0], 'unless (%s || $x) {$x}'       ],
+        [ [1,9,1], [0,0,0,0], 'if (%s || $x) {$x}'               ],
+        [ [1,9,1], [0,0,0,0], 'if (%s || $x) {$x} else {$y}'     ],
+        [ [1,9,2], [0,0,0,0], 'unless (%s || $x) {$x}'           ],
 
         # INNER OR RHS
 
-        #XXX RHS of && is in void cxt, not bool cxt
-        #XXX [ [0,0,0], [0,1], '$x || %s'                        ],
-        #XXX the not should always force bool cxt
-        #XXX[ [1,1,1], [0,0,1],   '!($x || %s)'                  ],
-        #XXX RHS of && is in void cxt, not bool cxt
-        #XXX [ [0,0,0], [0,1,0,1], '$y && ($x || %s)'            ],
-        #XXX should be bool, gives void
-        #XXX[ [1,9,1], [0,0,0,1], 'if ($x || %s) {$x}'           ],
-        #XXX should be bool, gives void
-        #XXX[ [1,9,1], [0,0,0,1], 'if ($x || %s) {$x} else {$y}' ],
-        #XXX should be bool/maybe, gives void
-        #XXX[ [1,9,2], [0,0,0,1], 'unless ($x || %s) {$x}'       ],
+        [ [0,0,0], [0,1],     '$x || %s'                         ],
+        [ [1,1,1], [0,0,1],   '!($x || %s)'                      ],
+        [ [0,0,0], [0,1,0,1], '$y && ($x || %s)'                 ],
+        [ [1,9,1], [0,0,0,1], 'if ($x || %s) {$x}'               ],
+        [ [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 DOR LHS
 
         [ [1,0,2], [0,0],     '%s // $x'                         ],
-        #XXX the not should always force bool cxt
-        #XXX[ [1,1,1], [0,0,0],   '!(%s // $x)'                  ],
+        [ [1,1,1], [0,0,0],   '!(%s // $x)'                      ],
         [ [1,0,2], [0,1,0,0], '$y && (%s // $x)'                 ],
-        #XXX should be bool, gives maybe
-        #XXX[ [1,9,1], [0,0,0,0], 'if (%s // $x) {$x}'           ],
+        [ [1,9,1], [0,0,0,0], 'if (%s // $x) {$x}'               ],
+        [ [1,9,2], [0,0,0,0], 'unless (%s // $x) {$x}'           ],
+        [ [1,9,1], [0,0,0,0], 'if (%s // $x) {$x}'               ],
+        [ [1,9,1], [0,0,0,0], 'if (%s // $x) {$x} else {$y}'     ],
         [ [1,9,2], [0,0,0,0], 'unless (%s // $x) {$x}'           ],
-        #XXX should be bool, gives maybe
-        #XXX[ [1,9,1], [0,0,0,0], 'if (%s // $x) {$x}'           ],
-        #XXX should be bool, gives void
-        #XXX[ [1,9,1], [0,0,0,0], 'if (%s // $x) {$x} else {$y}' ],
-        #XXX should be bool/maybe, gives void
-        #XXX[ [1,9,2], [0,0,0,0], 'unless (%s // $x) {$x}'       ],
 
         # INNER DOR RHS
 
-        #XXX RHS of && is in void cxt, not bool cxt
-        #XXX [ [0,0,0], [0,1], '$x // %s'                        ],
-        #XXX the not should always force bool cxt
-        #XXX[ [1,1,1], [0,0,1],   '!($x // %s)'                  ],
-        #XXX RHS of && is in void cxt, not bool cxt
-        #XXX [ [0,0,0], [0,1,0,1], '$y && ($x // %s)'            ],
-        #XXX should be bool, gives void
-        #XXX[ [1,9,1], [0,0,0,1], 'if ($x // %s) {$x}'           ],
-        #XXX should be bool, gives void
-        #XXX[ [1,9,1], [0,0,0,1], 'if ($x // %s) {$x} else {$y}' ],
-        #XXX should be bool/maybe, gives void
-        #XXX[ [1,9,2], [0,0,0,1], 'unless ($x // %s) {$x}'       ],
+        [ [0,0,0], [0,1],     '$x // %s'                         ],
+        [ [1,1,1], [0,0,1],   '!($x // %s)'                      ],
+        [ [0,0,0], [0,1,0,1], '$y && ($x // %s)'                 ],
+        [ [1,9,1], [0,0,0,1], 'if ($x // %s) {$x}'               ],
+        [ [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 AND LHS
 
@@ -329,22 +305,12 @@ for my $ops (
 
         # INNER AND RHS
 
-        #XXX RHS of && is in void cxt, not bool cxt
-        #XXX [ [0,0,0], [0,1], '$x && %s'                        ],
-        #XXX the not should always force bool cxt
-        #XXX[ [1,1,1], [0,0,1],   '!($x && %s)'                  ],
-        #XXX RHS of || is in void cxt, not bool cxt
-        #XXX [ [0,0,0], [0,1,0,1], '$y || ($x && %s)'            ],
-        #XXX should be bool, gives void
-        #XXX[ [1,9,1], [0,0,0,1], 'if ($x && %s) {$x}'           ],
-        #XXX should be bool, gives void
-        #XXX[ [1,9,1], [0,0,0,1], 'if ($x && %s) {$x} else {$y}' ],
-        #XXX should be bool/maybe, gives void
-        #XXX[ [1,9,2], [0,0,0,1], 'unless ($x && %s) {$x}'       ],
-
-
-
-
+        [ [0,0,0], [0,1],     '$x && %s'                         ],
+        [ [1,1,1], [0,0,1],   '!($x && %s)'                      ],
+        [ [0,0,0], [0,1,0,1], '$y || ($x && %s)'                 ],
+        [ [1,9,1], [0,0,0,1], 'if ($x && %s) {$x}'               ],
+        [ [1,9,1], [0,0,0,1], 'if ($x && %s) {$x} else {$y}'     ],
+        [ [1,9,2], [0,0,0,1], 'unless ($x && %s) {$x}'           ],
 
     ) {
         my ($expects, $op_path, $code_fmt) = @$test;