This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
In A && B, stop special-casing boolean-ness of A
authorDavid Mitchell <davem@iabyn.com>
Fri, 6 Jan 2017 11:35:11 +0000 (11:35 +0000)
committerDavid Mitchell <davem@iabyn.com>
Fri, 6 Jan 2017 16:28:27 +0000 (16:28 +0000)
Some ops, (currently PADHV and RV2HV) can be flagged as being in boolean
context, and if so, may return a simple truth value which may be more
efficient to calculate than a full scalar value. (This was originally
motivated by code like if (%h) {...}, where the scalar context %h returned a
bucket ratio string, which involved counting how many HvARRAY buckets were
non-empty, which was slow in large hashes. It's been made less important
since %h in scalar context now just returns a key count, which is quick to
calculate.)

There is an issue with the A argument of  A||B, A//B and A&&B, in that,
although A checked by the logop in boolean context, depending on its
truth value the original A may be passed through to the next op. So in
something like $x = (%h || -1), it's not sufficient for %h to return a
truth value; it must return a full scalar value which may get assigned to
$x.

So in general, we only mark the A op as being in boolean context if the
logop is in void context, or if the returned A would only be consumed in
boolean context; so !(A||B) would be ok for example.

However, && is a special case of this, since it will return the original A
only if A was false. Before this commit, && was special-cased to mark A as
being in boolean context regardless of the context of (A&&B). The downside
of this is that the A op can't just return &PL_sv_no as a false value;
it has to return something that is usable in scalar context too. For
example with %h, it returns sv_2mortal(newSViv(0))), which stringifies to
"0" while &PL_sv_no stringifies to "".

This commit removes that special case and makes && behave like || and //
again.

The upside is that some ops in boolean context will be able to more
cheaply return a false value (e.g. just &PL_sv_no verses
sv_2mortal(newSViv(0))).

The main downside is that && in unknown context (typically an
'if (%h} {...}' as the last statement in a sub) will have to check at
runtime whether the caller context is slower.  It will also have to return
a scalar value for something like $y = (%h && $x), but that's a relatively
uncommon occurrence, and now that %h in scalar context doesn't have to
count used buckets, the extra cost in these rare cases is minor.

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

diff --git a/op.c b/op.c
index 1636993..919e8ed 100644 (file)
--- a/op.c
+++ b/op.c
@@ -13422,22 +13422,19 @@ S_check_for_bool_cxt(pTHX_ OP*o, U8 bool_flag, U8 maybe_flag)
         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.
-         */
-        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
+        /* OR DOR and AND evaluate their arg as a boolean, but then may
+         * leave the original scalar value 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:
+        case OP_AND:
             if ((lop->op_flags & OPf_WANT) == OPf_WANT_VOID) {
                 o->op_private |= bool_flag;
                 lop = NULL;
diff --git a/pp.c b/pp.c
index 56dcf5d..adda6c9 100644 (file)
--- a/pp.c
+++ b/pp.c
@@ -150,9 +150,7 @@ 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)));
+       SETs(HvUSEDKEYS(TARG) ? &PL_sv_yes : &PL_sv_no);
     else if (gimme == G_SCALAR) {
        SV* const sv = Perl_hv_scalar(aTHX_ MUTABLE_HV(TARG));
        SETs(sv);
index cc93999..aeaecfc 100644 (file)
--- a/pp_hot.c
+++ b/pp_hot.c
@@ -1039,9 +1039,7 @@ 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)));
+           SETs(HvUSEDKEYS(sv) ? &PL_sv_yes : &PL_sv_no);
        else if (gimme == G_SCALAR) {
            dTARG;
            TARG = Perl_hv_scalar(aTHX_ MUTABLE_HV(sv));
index 4aebb9e..61eefd1 100644 (file)
@@ -13,7 +13,7 @@ BEGIN {
     @INC = '../lib';
 }
 
-plan 711;
+plan 695;
 
 use v5.10; # state
 use B qw(svref_2object
@@ -237,7 +237,7 @@ for my $ops (
         # INNER PLAIN
 
         [ [0,0,0], [],        '%s'                               ],
-        [ [1,9,1], [0,0],     'if (%s) {$x}'                     ],
+        [ [1,9,2], [0,0],     'if (%s) {$x}'                     ],
         [ [1,9,1], [0,0],     'if (%s) {$x} else {$y}'           ],
         [ [1,9,2], [0,0],     'unless (%s) {$x}'                 ],
 
@@ -261,7 +261,7 @@ for my $ops (
         [ [1,0,2], [0,0],     '%s || $x'                         ],
         [ [1,1,1], [0,0,0],   '!(%s || $x)'                      ],
         [ [1,0,2], [0,1,0,0], '$y && (%s || $x)'                 ],
-        [ [1,9,1], [0,0,0,0], 'if (%s || $x) {$x}'               ],
+        [ [1,9,2], [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}'           ],
 
@@ -270,7 +270,7 @@ for my $ops (
         [ [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,2], [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}'           ],
 
@@ -279,9 +279,7 @@ for my $ops (
         [ [1,0,2], [0,0],     '%s // $x'                         ],
         [ [1,1,1], [0,0,0],   '!(%s // $x)'                      ],
         [ [1,0,2], [0,1,0,0], '$y && (%s // $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,2], [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}'           ],
 
@@ -290,25 +288,25 @@ for my $ops (
         [ [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,2], [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
 
-        [ [1,1,1], [0,0],     '%s && $x'                         ],
+        [ [1,0,2], [0,0],     '%s && $x'                         ],
         [ [1,1,1], [0,0,0],   '!(%s && $x)'                      ],
-        [ [1,1,1], [0,1,0,0], '$y || (%s && $x)'                 ],
-        [ [1,9,1], [0,0,0,0], 'if (%s && $x) {$x}'               ],
+        [ [1,0,2], [0,1,0,0], '$y || (%s && $x)'                 ],
+        [ [1,9,2], [0,0,0,0], 'if (%s && $x) {$x}'               ],
         [ [1,9,1], [0,0,0,0], 'if (%s && $x) {$x} else {$y}'     ],
-        [ [1,9,1], [0,0,0,0], 'unless (%s && $x) {$x}'           ],
+        [ [1,9,2], [0,0,0,0], 'unless (%s && $x) {$x}'           ],
 
         # INNER AND RHS
 
         [ [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,2], [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}'           ],