optimise (index() == -1)
authorDavid Mitchell <davem@iabyn.com>
Fri, 14 Jul 2017 16:29:43 +0000 (17:29 +0100)
committerDavid Mitchell <davem@iabyn.com>
Thu, 27 Jul 2017 10:30:23 +0000 (11:30 +0100)
Unusually, index() and rindex() return -1 on failure.

So it's reasonably common to see code like

    if (index(...) != -1) { ... }

and variants.

For such code, this commit optimises away to OP_EQ and OP_CONST,
and sets a couple of private flags on the index op instead, indicating:

    OPpTRUEBOOL        return a boolean which is a comparison of
                       what the return would have been, against -1

    OPpINDEX_BOOLNEG   negate the boolean result

Its also supports OPpTRUEBOOL in conjunction with the existing
OPpTARGET_MY flag, so for example in

    $lexical = (index(...) == -1)

the padmy, sassign, eq and const ops are all optimised away.

13 files changed:
embed.h
lib/B/Deparse.pm
lib/B/Deparse.t
lib/B/Op_private.pm
op.c
opcode.h
pp.c
proto.h
regen/op_private
regen/opcodes
t/op/index.t
t/perf/benchmarks
t/perf/opcount.t

diff --git a/embed.h b/embed.h
index 0cdf036..15d63bd 100644 (file)
--- a/embed.h
+++ b/embed.h
 #define ck_delete(a)           Perl_ck_delete(aTHX_ a)
 #define ck_each(a)             Perl_ck_each(aTHX_ a)
 #define ck_eof(a)              Perl_ck_eof(aTHX_ a)
+#define ck_eq(a)               Perl_ck_eq(aTHX_ a)
 #define ck_eval(a)             Perl_ck_eval(aTHX_ a)
 #define ck_exec(a)             Perl_ck_exec(aTHX_ a)
 #define ck_exists(a)           Perl_ck_exists(aTHX_ a)
index 4a8c55f..f214081 100644 (file)
@@ -19,6 +19,7 @@ use B qw(class main_root main_start main_cv svref_2object opnumber perlstring
         OPpSORT_REVERSE OPpMULTIDEREF_EXISTS OPpMULTIDEREF_DELETE
          OPpSPLIT_ASSIGN OPpSPLIT_LEX
          OPpPADHV_ISKEYS OPpRV2HV_ISKEYS
+         OPpTRUEBOOL OPpINDEX_BOOLNEG
         SVf_IOK SVf_NOK SVf_ROK SVf_POK SVpad_OUR SVf_FAKE SVs_RMG SVs_SMG
         SVs_PADTMP SVpad_TYPED
          CVf_METHOD CVf_LVALUE
@@ -3318,9 +3319,35 @@ sub pp_substr {
     }
     maybe_local(@_, listop(@_, "substr"))
 }
+
+sub pp_index {
+    # Also handles pp_rindex.
+    #
+    # The body of this function includes an unrolled maybe_targmy(),
+    # since the two parts of that sub's actions need to have have the
+    # '== -1' bit in between
+
+    my($self, $op, $cx) = @_;
+
+    my $lex  = ($op->private & OPpTARGET_MY);
+    my $bool = ($op->private & OPpTRUEBOOL);
+
+    my $val = $self->listop($op, ($bool ? 14 : $lex ? 7 : $cx), $op->name);
+
+    # (index() == -1) has op_eq and op_const optimised away
+    if ($bool) {
+        $val .= ($op->private & OPpINDEX_BOOLNEG) ? " == -1" : " != -1";
+        $val = "($val)" if ($op->flags & OPf_PARENS);
+    }
+    if ($lex) {
+       my $var = $self->padname($op->targ);
+       $val = $self->maybe_parens("$var = $val", $cx, 7);
+    }
+    $val;
+}
+
+sub pp_rindex { pp_index(@_); }
 sub pp_vec { maybe_targmy(@_, \&maybe_local, listop(@_, "vec")) }
-sub pp_index { maybe_targmy(@_, \&listop, "index") }
-sub pp_rindex { maybe_targmy(@_, \&listop, "rindex") }
 sub pp_sprintf { maybe_targmy(@_, \&listop, "sprintf") }
 sub pp_formline { listop(@_, "formline") } # see also deparse_format
 sub pp_crypt { maybe_targmy(@_, \&listop, "crypt") }
index c73a467..0ee9e9e 100644 (file)
@@ -2675,3 +2675,31 @@ $x = keys %h1;
 keys %h2;
 $x = %h2;
 $x = keys %h2;
+####
+# eq,const optimised away for (index() == -1)
+my($a, $b);
+our $c;
+$c = index($a, $b) == 2;
+$c = rindex($a, $b) == 2;
+$c = index($a, $b) == -1;
+$c = rindex($a, $b) == -1;
+$c = index($a, $b) != -1;
+$c = rindex($a, $b) != -1;
+$c = (index($a, $b) == -1);
+$c = (rindex($a, $b) == -1);
+$c = (index($a, $b) != -1);
+$c = (rindex($a, $b) != -1);
+####
+# eq,const,sassign,madmy optimised away for (index() == -1)
+my($a, $b);
+my $c;
+$c = index($a, $b) == 2;
+$c = rindex($a, $b) == 2;
+$c = index($a, $b) == -1;
+$c = rindex($a, $b) == -1;
+$c = index($a, $b) != -1;
+$c = rindex($a, $b) != -1;
+$c = (index($a, $b) == -1);
+$c = (rindex($a, $b) == -1);
+$c = (index($a, $b) != -1);
+$c = (rindex($a, $b) != -1);
index ff5671a..fbac993 100644 (file)
@@ -130,6 +130,7 @@ $bits{$_}{2} = 'OPpFT_STACKED' for qw(ftatime ftbinary ftblk ftchr ftctime ftdir
 $bits{$_}{3} = 'OPpFT_STACKING' for qw(ftatime ftbinary ftblk ftchr ftctime ftdir fteexec fteowned fteread ftewrite ftfile ftis ftlink ftmtime ftpipe ftrexec ftrowned ftrread ftrwrite ftsgid ftsize ftsock ftsuid ftsvtx fttext fttty ftzero);
 $bits{$_}{1} = 'OPpHINT_STRICT_REFS' for qw(entersub multideref rv2av rv2cv rv2gv rv2hv rv2sv);
 $bits{$_}{5} = 'OPpHUSH_VMSISH' for qw(dbstate nextstate);
+$bits{$_}{6} = 'OPpINDEX_BOOLNEG' for qw(index rindex);
 $bits{$_}{1} = 'OPpITER_REVERSED' for qw(enteriter iter);
 $bits{$_}{7} = 'OPpLVALUE' for qw(leave leaveloop);
 $bits{$_}{6} = 'OPpLVAL_DEFER' for qw(aelem helem multideref);
@@ -156,7 +157,7 @@ $bits{$_}{6} = 'OPpTRANS_GROWS' for qw(trans transr);
 $bits{$_}{2} = 'OPpTRANS_IDENTICAL' for qw(trans transr);
 $bits{$_}{3} = 'OPpTRANS_SQUASH' for qw(trans transr);
 $bits{$_}{1} = 'OPpTRANS_TO_UTF' for qw(trans transr);
-$bits{$_}{5} = 'OPpTRUEBOOL' for qw(grepwhile length padav padhv pos ref rv2av rv2hv subst);
+$bits{$_}{5} = 'OPpTRUEBOOL' for qw(grepwhile index length padav padhv pos ref rindex rv2av rv2hv subst);
 
 my @bf = (
     {
@@ -631,6 +632,7 @@ our %defines = (
     OPpFT_STACKING           =>   8,
     OPpHINT_STRICT_REFS      =>   2,
     OPpHUSH_VMSISH           =>  32,
+    OPpINDEX_BOOLNEG         =>  64,
     OPpITER_DEF              =>   8,
     OPpITER_REVERSED         =>   2,
     OPpKVSLICE               =>  32,
@@ -732,6 +734,7 @@ our %labels = (
     OPpFT_STACKING           => 'FTSTACKING',
     OPpHINT_STRICT_REFS      => 'STRICT',
     OPpHUSH_VMSISH           => 'HUSH',
+    OPpINDEX_BOOLNEG         => 'NEG',
     OPpITER_DEF              => 'DEF',
     OPpITER_REVERSED         => 'REVERSED',
     OPpKVSLICE               => 'KVSLICE',
@@ -805,6 +808,7 @@ our %ops_using = (
     OPpFT_AFTER_t            => [qw(ftatime ftbinary ftblk ftchr ftctime ftdir fteexec fteowned fteread ftewrite ftfile ftis ftlink ftmtime ftpipe ftrexec ftrowned ftrread ftrwrite ftsgid ftsize ftsock ftsuid ftsvtx fttext fttty ftzero)],
     OPpHINT_STRICT_REFS      => [qw(entersub multideref rv2av rv2cv rv2gv rv2hv rv2sv)],
     OPpHUSH_VMSISH           => [qw(dbstate nextstate)],
+    OPpINDEX_BOOLNEG         => [qw(index rindex)],
     OPpITER_DEF              => [qw(enteriter)],
     OPpITER_REVERSED         => [qw(enteriter iter)],
     OPpKVSLICE               => [qw(delete)],
@@ -832,7 +836,7 @@ our %ops_using = (
     OPpSUBSTR_REPL_FIRST     => [qw(substr)],
     OPpTARGET_MY             => [qw(abs add atan2 chdir chmod chomp chown chr chroot concat cos crypt divide exec exp flock getpgrp getppid getpriority hex i_add i_divide i_modulo i_multiply i_subtract index int kill left_shift length link log mkdir modulo multiply nbit_and nbit_or nbit_xor ncomplement oct ord pow push rand rename right_shift rindex rmdir schomp scomplement setpgrp setpriority sin sleep sqrt srand stringify subtract symlink system time unlink unshift utime wait waitpid)],
     OPpTRANS_COMPLEMENT      => [qw(trans transr)],
-    OPpTRUEBOOL              => [qw(grepwhile length padav padhv pos ref rv2av rv2hv subst)],
+    OPpTRUEBOOL              => [qw(grepwhile index length padav padhv pos ref rindex rv2av rv2hv subst)],
 );
 
 $ops_using{OPpASSIGN_COMMON_RC1} = $ops_using{OPpASSIGN_COMMON_AGG};
diff --git a/op.c b/op.c
index b371f06..3be0e56 100644 (file)
--- a/op.c
+++ b/op.c
@@ -9815,6 +9815,53 @@ Perl_ck_eof(pTHX_ OP *o)
     return o;
 }
 
+
+/* for OP_EQ, OP_NE, OP_I_EQ, OP_I_NE */
+
+OP *
+Perl_ck_eq(pTHX_ OP *o)
+{
+    OP *indexop, *constop, *start;
+    SV *sv;
+    PERL_ARGS_ASSERT_CK_EQ;
+
+    /* convert (index(...) == -1) and variations into
+     *   (r)index/BOOL(,NEG)
+     */
+
+    indexop = cUNOPo->op_first;
+    constop = OpSIBLING(indexop);
+    start = NULL;
+    if (indexop->op_type == OP_CONST) {
+        constop = indexop;
+        indexop = OpSIBLING(constop);
+        start = constop;
+    }
+
+    if (indexop->op_type != OP_INDEX && indexop->op_type != OP_RINDEX)
+        return o;
+
+    if (constop->op_type != OP_CONST)
+        return o;
+
+    sv = cSVOPx_sv(constop);
+    if (!(sv && SvIOK_notUV(sv) && SvIVX(sv) == -1))
+        return o;
+
+    assert(!(indexop->op_private & OPpTARGET_MY));
+    indexop->op_flags &= ~OPf_PARENS;
+    indexop->op_flags |= (o->op_flags & OPf_PARENS);
+    indexop->op_private |= OPpTRUEBOOL;
+    if (o->op_type == OP_EQ || o->op_type == OP_I_EQ)
+        indexop->op_private |= OPpINDEX_BOOLNEG;
+    /* cut out the index op and free the eq,const ops */
+    (void)op_sibling_splice(o, start, 1, NULL);
+    op_free(o);
+
+    return indexop;
+}
+
+
 OP *
 Perl_ck_eval(pTHX_ OP *o)
 {
index fb8c1be..77e61e7 100644 (file)
--- a/opcode.h
+++ b/opcode.h
@@ -1460,10 +1460,10 @@ EXT Perl_check_t PL_check[] /* or perlvars.h */
        Perl_ck_cmp,            /* i_le */
        Perl_ck_cmp,            /* ge */
        Perl_ck_cmp,            /* i_ge */
-       Perl_ck_null,           /* eq */
-       Perl_ck_null,           /* i_eq */
-       Perl_ck_null,           /* ne */
-       Perl_ck_null,           /* i_ne */
+       Perl_ck_eq,             /* eq */
+       Perl_ck_eq,             /* i_eq */
+       Perl_ck_eq,             /* ne */
+       Perl_ck_eq,             /* i_ne */
        Perl_ck_null,           /* ncmp */
        Perl_ck_null,           /* i_ncmp */
        Perl_ck_null,           /* slt */
@@ -2279,6 +2279,7 @@ END_EXTERN_C
 #define OPpENTERSUB_DB          0x40
 #define OPpEXISTS_SUB           0x40
 #define OPpFLIP_LINENUM         0x40
+#define OPpINDEX_BOOLNEG        0x40
 #define OPpLIST_GUESSED         0x40
 #define OPpLVAL_DEFER           0x40
 #define OPpOPEN_OUT_RAW         0x40
@@ -2385,6 +2386,7 @@ EXTCONST char PL_op_private_labels[] = {
     'L','V','I','N','T','R','O','\0',
     'L','V','S','U','B','\0',
     'M','A','R','K','\0',
+    'N','E','G','\0',
     'N','O','(',')','\0',
     'N','O','I','N','I','T','\0',
     'N','O','V','E','R','\0',
@@ -2432,14 +2434,14 @@ EXTCONST char PL_op_private_labels[] = {
 EXTCONST I16 PL_op_private_bitfields[] = {
     0, 8, -1,
     0, 8, -1,
-    0, 552, -1,
+    0, 556, -1,
     0, 8, -1,
     0, 8, -1,
-    0, 559, -1,
-    0, 548, -1,
-    1, -1, 0, 525, 1, 33, 2, 283, -1,
+    0, 563, -1,
+    0, 552, -1,
+    1, -1, 0, 529, 1, 33, 2, 283, -1,
     4, -1, 1, 164, 2, 171, 3, 178, -1,
-    4, -1, 0, 525, 1, 33, 2, 283, 3, 110, -1,
+    4, -1, 0, 529, 1, 33, 2, 283, 3, 110, -1,
 
 };
 
@@ -2570,8 +2572,8 @@ EXTCONST I16  PL_op_private_bitdef_ix[] = {
       86, /* length */
       89, /* substr */
       92, /* vec */
-      84, /* index */
-      84, /* rindex */
+      94, /* index */
+      94, /* rindex */
       52, /* sprintf */
       52, /* formline */
       75, /* ord */
@@ -2582,30 +2584,30 @@ EXTCONST I16  PL_op_private_bitdef_ix[] = {
        0, /* uc */
        0, /* lc */
        0, /* quotemeta */
-      94, /* rv2av */
-     101, /* aelemfast */
-     101, /* aelemfast_lex */
-     102, /* aelem */
-     107, /* aslice */
-     110, /* kvaslice */
+      98, /* rv2av */
+     105, /* aelemfast */
+     105, /* aelemfast_lex */
+     106, /* aelem */
+     111, /* aslice */
+     114, /* kvaslice */
        0, /* aeach */
        0, /* avalues */
       40, /* akeys */
        0, /* each */
       40, /* values */
       40, /* keys */
-     111, /* delete */
-     115, /* exists */
-     117, /* rv2hv */
-     102, /* helem */
-     107, /* hslice */
-     110, /* kvhslice */
-     125, /* multideref */
+     115, /* delete */
+     119, /* exists */
+     121, /* rv2hv */
+     106, /* helem */
+     111, /* hslice */
+     114, /* kvhslice */
+     129, /* multideref */
       52, /* unpack */
       52, /* pack */
-     132, /* split */
+     136, /* split */
       52, /* join */
-     137, /* list */
+     141, /* list */
       12, /* lslice */
       52, /* anonlist */
       52, /* anonhash */
@@ -2614,50 +2616,50 @@ EXTCONST I16  PL_op_private_bitdef_ix[] = {
        0, /* pop */
        0, /* shift */
       84, /* unshift */
-     139, /* sort */
-     146, /* reverse */
+     143, /* sort */
+     150, /* reverse */
        0, /* grepstart */
-     148, /* grepwhile */
+     152, /* grepwhile */
        0, /* mapstart */
        0, /* mapwhile */
        0, /* range */
-     150, /* flip */
-     150, /* flop */
+     154, /* flip */
+     154, /* flop */
        0, /* and */
        0, /* or */
       12, /* xor */
        0, /* dor */
-     152, /* cond_expr */
+     156, /* cond_expr */
        0, /* andassign */
        0, /* orassign */
        0, /* dorassign */
-     154, /* entersub */
-     161, /* leavesub */
-     161, /* leavesublv */
+     158, /* entersub */
+     165, /* leavesub */
+     165, /* leavesublv */
        0, /* argcheck */
-     163, /* argelem */
+     167, /* argelem */
        0, /* argdefelem */
-     165, /* caller */
+     169, /* caller */
       52, /* warn */
       52, /* die */
       52, /* reset */
       -1, /* lineseq */
-     167, /* nextstate */
-     167, /* dbstate */
+     171, /* nextstate */
+     171, /* dbstate */
       -1, /* unstack */
       -1, /* enter */
-     168, /* leave */
+     172, /* leave */
       -1, /* scope */
-     170, /* enteriter */
-     174, /* iter */
+     174, /* enteriter */
+     178, /* iter */
       -1, /* enterloop */
-     175, /* leaveloop */
+     179, /* leaveloop */
       -1, /* return */
-     177, /* last */
-     177, /* next */
-     177, /* redo */
-     177, /* dump */
-     177, /* goto */
+     181, /* last */
+     181, /* next */
+     181, /* redo */
+     181, /* dump */
+     181, /* goto */
       52, /* exit */
        0, /* method */
        0, /* method_named */
@@ -2670,7 +2672,7 @@ EXTCONST I16  PL_op_private_bitdef_ix[] = {
        0, /* leavewhen */
       -1, /* break */
       -1, /* continue */
-     179, /* open */
+     183, /* open */
       52, /* close */
       52, /* pipe_op */
       52, /* fileno */
@@ -2686,7 +2688,7 @@ EXTCONST I16  PL_op_private_bitdef_ix[] = {
       52, /* getc */
       52, /* read */
       52, /* enterwrite */
-     161, /* leavewrite */
+     165, /* leavewrite */
       -1, /* prtf */
       -1, /* print */
       -1, /* say */
@@ -2716,33 +2718,33 @@ EXTCONST I16  PL_op_private_bitdef_ix[] = {
        0, /* getpeername */
        0, /* lstat */
        0, /* stat */
-     184, /* ftrread */
-     184, /* ftrwrite */
-     184, /* ftrexec */
-     184, /* fteread */
-     184, /* ftewrite */
-     184, /* fteexec */
-     189, /* ftis */
-     189, /* ftsize */
-     189, /* ftmtime */
-     189, /* ftatime */
-     189, /* ftctime */
-     189, /* ftrowned */
-     189, /* fteowned */
-     189, /* ftzero */
-     189, /* ftsock */
-     189, /* ftchr */
-     189, /* ftblk */
-     189, /* ftfile */
-     189, /* ftdir */
-     189, /* ftpipe */
-     189, /* ftsuid */
-     189, /* ftsgid */
-     189, /* ftsvtx */
-     189, /* ftlink */
-     189, /* fttty */
-     189, /* fttext */
-     189, /* ftbinary */
+     188, /* ftrread */
+     188, /* ftrwrite */
+     188, /* ftrexec */
+     188, /* fteread */
+     188, /* ftewrite */
+     188, /* fteexec */
+     193, /* ftis */
+     193, /* ftsize */
+     193, /* ftmtime */
+     193, /* ftatime */
+     193, /* ftctime */
+     193, /* ftrowned */
+     193, /* fteowned */
+     193, /* ftzero */
+     193, /* ftsock */
+     193, /* ftchr */
+     193, /* ftblk */
+     193, /* ftfile */
+     193, /* ftdir */
+     193, /* ftpipe */
+     193, /* ftsuid */
+     193, /* ftsgid */
+     193, /* ftsvtx */
+     193, /* ftlink */
+     193, /* fttty */
+     193, /* fttext */
+     193, /* ftbinary */
       84, /* chdir */
       84, /* chown */
       75, /* chroot */
@@ -2762,17 +2764,17 @@ EXTCONST I16  PL_op_private_bitdef_ix[] = {
        0, /* rewinddir */
        0, /* closedir */
       -1, /* fork */
-     193, /* wait */
+     197, /* wait */
       84, /* waitpid */
       84, /* system */
       84, /* exec */
       84, /* kill */
-     193, /* getppid */
+     197, /* getppid */
       84, /* getpgrp */
       84, /* setpgrp */
       84, /* getpriority */
       84, /* setpriority */
-     193, /* time */
+     197, /* time */
       -1, /* tms */
        0, /* localtime */
       52, /* gmtime */
@@ -2792,8 +2794,8 @@ EXTCONST I16  PL_op_private_bitdef_ix[] = {
        0, /* require */
        0, /* dofile */
       -1, /* hintseval */
-     194, /* entereval */
-     161, /* leaveeval */
+     198, /* entereval */
+     165, /* leaveeval */
        0, /* entertry */
       -1, /* leavetry */
        0, /* ghbyname */
@@ -2831,18 +2833,18 @@ EXTCONST I16  PL_op_private_bitdef_ix[] = {
        0, /* lock */
        0, /* once */
       -1, /* custom */
-     200, /* coreargs */
-     204, /* avhvswitch */
+     204, /* coreargs */
+     208, /* avhvswitch */
        3, /* runcv */
        0, /* fc */
       -1, /* padcv */
       -1, /* introcv */
       -1, /* clonecv */
-     206, /* padrange */
-     208, /* refassign */
-     214, /* lvref */
-     220, /* lvrefslice */
-     221, /* lvavref */
+     210, /* padrange */
+     212, /* refassign */
+     218, /* lvref */
+     224, /* lvrefslice */
+     225, /* lvavref */
        0, /* anonconst */
 
 };
@@ -2863,72 +2865,73 @@ EXTCONST I16  PL_op_private_bitdef_ix[] = {
 
 EXTCONST U16  PL_op_private_bitdefs[] = {
     0x0003, /* scalar, prototype, refgen, srefgen, readline, regcmaybe, regcreset, regcomp, substcont, chop, schop, defined, undef, study, preinc, i_preinc, predec, i_predec, postinc, i_postinc, postdec, i_postdec, negate, i_negate, not, complement, ucfirst, lcfirst, uc, lc, quotemeta, aeach, avalues, each, pop, shift, grepstart, mapstart, mapwhile, range, and, or, dor, andassign, orassign, dorassign, argcheck, argdefelem, method, method_named, method_super, method_redir, method_redir_super, entergiven, leavegiven, enterwhen, leavewhen, untie, tied, dbmclose, getsockname, getpeername, lstat, stat, readlink, readdir, telldir, rewinddir, closedir, localtime, alarm, require, dofile, entertry, ghbyname, gnbyname, gpbyname, shostent, snetent, sprotoent, sservent, gpwnam, gpwuid, ggrnam, ggrgid, lock, once, fc, anonconst */
-    0x2e5c, 0x3f99, /* pushmark */
+    0x2e5c, 0x4019, /* pushmark */
     0x00bd, /* wantarray, runcv */
-    0x0498, 0x18d0, 0x404c, 0x3b08, 0x3225, /* const */
-    0x2e5c, 0x3379, /* gvsv */
+    0x0498, 0x18d0, 0x40cc, 0x3b88, 0x32a5, /* const */
+    0x2e5c, 0x33f9, /* gvsv */
     0x1735, /* gv */
     0x0067, /* gelem, lt, i_lt, gt, i_gt, le, i_le, ge, i_ge, eq, i_eq, ne, i_ne, ncmp, i_ncmp, slt, sgt, sle, sge, seq, sne, scmp, bit_and, bit_xor, bit_or, sbit_and, sbit_xor, sbit_or, smartmatch, lslice, xor */
-    0x2e5c, 0x3f98, 0x03d7, /* padsv */
-    0x2e5c, 0x3f98, 0x0614, 0x2f4c, 0x3c89, /* padav */
-    0x2e5c, 0x3f98, 0x0614, 0x06b0, 0x2f4c, 0x3c88, 0x29c1, /* padhv */
-    0x2e5c, 0x1ab8, 0x03d6, 0x2f4c, 0x3148, 0x4044, 0x0003, /* rv2gv */
-    0x2e5c, 0x3378, 0x03d6, 0x4044, 0x0003, /* rv2sv */
+    0x2e5c, 0x4018, 0x03d7, /* padsv */
+    0x2e5c, 0x4018, 0x0614, 0x2f4c, 0x3d09, /* padav */
+    0x2e5c, 0x4018, 0x0614, 0x06b0, 0x2f4c, 0x3d08, 0x29c1, /* padhv */
+    0x2e5c, 0x1ab8, 0x03d6, 0x2f4c, 0x31c8, 0x40c4, 0x0003, /* rv2gv */
+    0x2e5c, 0x33f8, 0x03d6, 0x40c4, 0x0003, /* rv2sv */
     0x2f4c, 0x0003, /* av2arylen, akeys, values, keys */
-    0x30bc, 0x0ef8, 0x0c54, 0x028c, 0x4208, 0x4044, 0x0003, /* rv2cv */
+    0x313c, 0x0ef8, 0x0c54, 0x028c, 0x4288, 0x40c4, 0x0003, /* rv2cv */
     0x0614, 0x06b0, 0x0003, /* ref */
     0x018f, /* bless, glob, sprintf, formline, unpack, pack, join, anonlist, anonhash, splice, warn, die, reset, exit, close, pipe_op, fileno, umask, binmode, tie, dbmopen, sselect, select, getc, read, enterwrite, sysopen, sysseek, sysread, syswrite, eof, tell, seek, truncate, fcntl, ioctl, send, recv, socket, sockpair, bind, connect, listen, accept, shutdown, gsockopt, ssockopt, open_dir, seekdir, gmtime, shmget, shmctl, shmread, shmwrite, msgget, msgctl, msgsnd, msgrcv, semop, semget, semctl, ghbyaddr, gnbyaddr, gpbynumber, gsbyname, gsbyport, syscall */
-    0x355c, 0x3478, 0x2714, 0x2650, 0x0003, /* backtick */
+    0x35dc, 0x34f8, 0x2714, 0x2650, 0x0003, /* backtick */
     0x0615, /* subst */
-    0x0ffc, 0x2038, 0x0834, 0x3dcc, 0x23c8, 0x01e4, 0x0141, /* trans, transr */
+    0x0ffc, 0x2038, 0x0834, 0x3e4c, 0x23c8, 0x01e4, 0x0141, /* trans, transr */
     0x0e3c, 0x0538, 0x0067, /* sassign */
     0x0af8, 0x09f4, 0x08f0, 0x2f4c, 0x0608, 0x0067, /* aassign */
-    0x42b0, 0x0003, /* chomp, schomp, ncomplement, scomplement, sin, cos, exp, log, sqrt, int, hex, oct, abs, ord, chr, chroot, rmdir */
+    0x4330, 0x0003, /* chomp, schomp, ncomplement, scomplement, sin, cos, exp, log, sqrt, int, hex, oct, abs, ord, chr, chroot, rmdir */
     0x0614, 0x2f4c, 0x0003, /* pos */
-    0x42b0, 0x0067, /* pow, multiply, i_multiply, divide, i_divide, modulo, i_modulo, add, i_add, subtract, i_subtract, concat, left_shift, right_shift, nbit_and, nbit_xor, nbit_or */
+    0x4330, 0x0067, /* pow, multiply, i_multiply, divide, i_divide, modulo, i_modulo, add, i_add, subtract, i_subtract, concat, left_shift, right_shift, nbit_and, nbit_xor, nbit_or */
     0x13b8, 0x0067, /* repeat */
-    0x42b0, 0x018f, /* stringify, atan2, rand, srand, index, rindex, crypt, push, unshift, flock, chdir, chown, unlink, chmod, utime, rename, link, symlink, mkdir, waitpid, system, exec, kill, getpgrp, setpgrp, getpriority, setpriority, sleep */
-    0x0614, 0x42b0, 0x0003, /* length */
-    0x3870, 0x2f4c, 0x012b, /* substr */
+    0x4330, 0x018f, /* stringify, atan2, rand, srand, crypt, push, unshift, flock, chdir, chown, unlink, chmod, utime, rename, link, symlink, mkdir, waitpid, system, exec, kill, getpgrp, setpgrp, getpriority, setpriority, sleep */
+    0x0614, 0x4330, 0x0003, /* length */
+    0x38f0, 0x2f4c, 0x012b, /* substr */
     0x2f4c, 0x0067, /* vec */
-    0x2e5c, 0x3378, 0x0614, 0x2f4c, 0x3c88, 0x4044, 0x0003, /* rv2av */
+    0x30b8, 0x0614, 0x4330, 0x018f, /* index, rindex */
+    0x2e5c, 0x33f8, 0x0614, 0x2f4c, 0x3d08, 0x40c4, 0x0003, /* rv2av */
     0x025f, /* aelemfast, aelemfast_lex */
     0x2e5c, 0x2d58, 0x03d6, 0x2f4c, 0x0067, /* aelem, helem */
-    0x2e5c, 0x2f4c, 0x3c89, /* aslice, hslice */
+    0x2e5c, 0x2f4c, 0x3d09, /* aslice, hslice */
     0x2f4d, /* kvaslice, kvhslice */
-    0x2e5c, 0x3bd8, 0x2a74, 0x0003, /* delete */
-    0x4138, 0x0003, /* exists */
-    0x2e5c, 0x3378, 0x0614, 0x06b0, 0x2f4c, 0x3c88, 0x4044, 0x29c1, /* rv2hv */
-    0x2e5c, 0x2d58, 0x1074, 0x19d0, 0x2f4c, 0x4044, 0x0003, /* multideref */
-    0x2e5c, 0x3378, 0x0350, 0x2b6c, 0x2489, /* split */
+    0x2e5c, 0x3c58, 0x2a74, 0x0003, /* delete */
+    0x41b8, 0x0003, /* exists */
+    0x2e5c, 0x33f8, 0x0614, 0x06b0, 0x2f4c, 0x3d08, 0x40c4, 0x29c1, /* rv2hv */
+    0x2e5c, 0x2d58, 0x1074, 0x19d0, 0x2f4c, 0x40c4, 0x0003, /* multideref */
+    0x2e5c, 0x33f8, 0x0350, 0x2b6c, 0x2489, /* split */
     0x2e5c, 0x20f9, /* list */
-    0x3eb8, 0x3614, 0x1310, 0x27ac, 0x3968, 0x28a4, 0x32e1, /* sort */
+    0x3f38, 0x3694, 0x1310, 0x27ac, 0x39e8, 0x28a4, 0x3361, /* sort */
     0x27ac, 0x0003, /* reverse */
     0x0614, 0x0003, /* grepwhile */
     0x2bf8, 0x0003, /* flip, flop */
     0x2e5c, 0x0003, /* cond_expr */
-    0x2e5c, 0x0ef8, 0x03d6, 0x028c, 0x4208, 0x4044, 0x2561, /* entersub */
-    0x36d8, 0x0003, /* leavesub, leavesublv, leavewrite, leaveeval */
+    0x2e5c, 0x0ef8, 0x03d6, 0x028c, 0x4288, 0x40c4, 0x2561, /* entersub */
+    0x3758, 0x0003, /* leavesub, leavesublv, leavewrite, leaveeval */
     0x02aa, 0x0003, /* argelem */
     0x00bc, 0x018f, /* caller */
     0x22d5, /* nextstate, dbstate */
-    0x2cfc, 0x36d9, /* leave */
-    0x2e5c, 0x3378, 0x0f6c, 0x39e5, /* enteriter */
-    0x39e5, /* iter */
+    0x2cfc, 0x3759, /* leave */
+    0x2e5c, 0x33f8, 0x0f6c, 0x3a65, /* enteriter */
+    0x3a65, /* iter */
     0x2cfc, 0x0067, /* leaveloop */
-    0x441c, 0x0003, /* last, next, redo, dump, goto */
-    0x355c, 0x3478, 0x2714, 0x2650, 0x018f, /* open */
+    0x449c, 0x0003, /* last, next, redo, dump, goto */
+    0x35dc, 0x34f8, 0x2714, 0x2650, 0x018f, /* open */
     0x1c70, 0x1ecc, 0x1d88, 0x1b44, 0x0003, /* ftrread, ftrwrite, ftrexec, fteread, ftewrite, fteexec */
     0x1c70, 0x1ecc, 0x1d88, 0x0003, /* ftis, ftsize, ftmtime, ftatime, ftctime, ftrowned, fteowned, ftzero, ftsock, ftchr, ftblk, ftfile, ftdir, ftpipe, ftsuid, ftsgid, ftsvtx, ftlink, fttty, fttext, ftbinary */
-    0x42b1, /* wait, getppid, time */
-    0x3774, 0x0d10, 0x076c, 0x4388, 0x21e4, 0x0003, /* entereval */
+    0x4331, /* wait, getppid, time */
+    0x37f4, 0x0d10, 0x076c, 0x4408, 0x21e4, 0x0003, /* entereval */
     0x301c, 0x0018, 0x1224, 0x1141, /* coreargs */
     0x2f4c, 0x00c7, /* avhvswitch */
     0x2e5c, 0x01fb, /* padrange */
-    0x2e5c, 0x3f98, 0x04f6, 0x292c, 0x1828, 0x0067, /* refassign */
-    0x2e5c, 0x3f98, 0x04f6, 0x292c, 0x1828, 0x0003, /* lvref */
+    0x2e5c, 0x4018, 0x04f6, 0x292c, 0x1828, 0x0067, /* refassign */
+    0x2e5c, 0x4018, 0x04f6, 0x292c, 0x1828, 0x0003, /* lvref */
     0x2e5d, /* lvrefslice */
-    0x2e5c, 0x3f98, 0x0003, /* lvavref */
+    0x2e5c, 0x4018, 0x0003, /* lvavref */
 
 };
 
@@ -3059,8 +3062,8 @@ EXTCONST U8 PL_op_private_valid[] = {
     /* LENGTH     */ (OPpARG1_MASK|OPpTARGET_MY|OPpTRUEBOOL),
     /* SUBSTR     */ (OPpARG3_MASK|OPpMAYBE_LVSUB|OPpSUBSTR_REPL_FIRST),
     /* VEC        */ (OPpARG2_MASK|OPpMAYBE_LVSUB),
-    /* INDEX      */ (OPpARG4_MASK|OPpTARGET_MY),
-    /* RINDEX     */ (OPpARG4_MASK|OPpTARGET_MY),
+    /* INDEX      */ (OPpARG4_MASK|OPpTARGET_MY|OPpTRUEBOOL|OPpINDEX_BOOLNEG),
+    /* RINDEX     */ (OPpARG4_MASK|OPpTARGET_MY|OPpTRUEBOOL|OPpINDEX_BOOLNEG),
     /* SPRINTF    */ (OPpARG4_MASK),
     /* FORMLINE   */ (OPpARG4_MASK),
     /* ORD        */ (OPpARG1_MASK|OPpTARGET_MY),
diff --git a/pp.c b/pp.c
index 20fd474..798c624 100644 (file)
--- a/pp.c
+++ b/pp.c
@@ -3604,7 +3604,7 @@ PP(pp_index)
                   convert the small string to ISO-8859-1, then there is no
                   way that it could be found anywhere by index.  */
                retval = -1;
-               goto fail;
+               goto push_result;
            }
 
            /* At this point, pv is a malloc()ed string. So donate it to temp
@@ -3667,8 +3667,18 @@ PP(pp_index)
            retval = sv_pos_b2u_flags(big, retval, SV_CONST_RETURN);
     }
     SvREFCNT_dec(temp);
- fail:
-    PUSHi(retval);
+
+  push_result:
+    /* OPpTRUEBOOL indicates an '== -1' has been optimised away */
+    if (PL_op->op_private & OPpTRUEBOOL) {
+        PUSHs( ((retval != -1) ^ cBOOL(PL_op->op_private & OPpINDEX_BOOLNEG))
+                    ? &PL_sv_yes : &PL_sv_no);
+        if (PL_op->op_private & OPpTARGET_MY)
+            /* $lex = (index() == -1) */
+            sv_setsv(TARG, TOPs);
+    }
+    else 
+        PUSHi(retval);
     RETURN;
 }
 
diff --git a/proto.h b/proto.h
index d6df7f4..3888d39 100644 (file)
--- a/proto.h
+++ b/proto.h
@@ -363,6 +363,11 @@ PERL_CALLCONV OP * Perl_ck_eof(pTHX_ OP *o)
 #define PERL_ARGS_ASSERT_CK_EOF        \
        assert(o)
 
+PERL_CALLCONV OP *     Perl_ck_eq(pTHX_ OP *o)
+                       __attribute__warn_unused_result__;
+#define PERL_ARGS_ASSERT_CK_EQ \
+       assert(o)
+
 PERL_CALLCONV OP *     Perl_ck_eval(pTHX_ OP *o)
                        __attribute__warn_unused_result__;
 #define PERL_ARGS_ASSERT_CK_EVAL       \
index 4ff7e9f..0122863 100644 (file)
@@ -447,7 +447,7 @@ for (qw(rv2hv padhv ref)) {
         5 => qw(OPpTRUEBOOL       BOOL),
     );
 }
-for (qw(grepwhile length padav pos rv2av subst)) {
+for (qw(grepwhile index length padav pos rindex rv2av subst)) {
     addbits($_,
         5 => qw(OPpTRUEBOOL       BOOL),  # if (@a) {...}
     );
@@ -801,6 +801,14 @@ addbits('rv2hv',
     0 => qw(OPpRV2HV_ISKEYS KEYS),
 );
 
+# In conjunction with OPpTRUEBOOL, indicates that the test should be
+# inverted. This allows both (index() == -1) and (index() != -1)
+# to optimise away the const and eq/ne
+
+for (qw(index rindex)) {
+    addbits($_, 6 => qw(OPpINDEX_BOOLNEG NEG));
+}
+
 
 
 1;
index f1e439d..58d08c3 100644 (file)
@@ -144,10 +144,10 @@ le                numeric le (<=)         ck_cmp          Iifs2   S S<
 i_le           integer le (<=)         ck_cmp          ifs2    S S<
 ge             numeric ge (>=)         ck_cmp          Iifs2   S S<
 i_ge           integer ge (>=)         ck_cmp          ifs2    S S<
-eq             numeric eq (==)         ck_null         Iifs2   S S<
-i_eq           integer eq (==)         ck_null         ifs2    S S<
-ne             numeric ne (!=)         ck_null         Iifs2   S S<
-i_ne           integer ne (!=)         ck_null         ifs2    S S<
+eq             numeric eq (==)         ck_eq           Iifs2   S S<
+i_eq           integer eq (==)         ck_eq           ifs2    S S<
+ne             numeric ne (!=)         ck_eq           Iifs2   S S<
+i_ne           integer ne (!=)         ck_eq           ifs2    S S<
 ncmp           numeric comparison (<=>)        ck_null         Iifst2  S S<
 i_ncmp         integer comparison (<=>)        ck_null         ifst2   S S<
 
index 5e95191..a28ca65 100644 (file)
@@ -8,7 +8,7 @@ BEGIN {
 }
 
 use strict;
-plan( tests => 122 );
+plan( tests => 170 );
 
 run_tests() unless caller;
 
@@ -256,3 +256,68 @@ is index('the main road', __PACKAGE__), 4,
 utf8::upgrade my $substr = "\x{a3}a";
 
 is index($substr, 'a'), 1, 'index reply reflects characters not octets';
+
+# op_eq, op_const optimised away in (index() == -1) and variants
+
+{
+    my $s = "ab";
+    ok(!(index($s,"a") == -1),  "index(a) == -1");
+    ok( (index($s,"a") != -1),  "index(a) != -1");
+    ok( (index($s,"c") == -1),  "index(c) == -1");
+    ok(!(index($s,"c") != -1),  "index(c) != -1");
+
+    ok(!(rindex($s,"a") == -1), "rindex(a) == -1");
+    ok( (rindex($s,"a") != -1), "rindex(a) != -1");
+    ok( (rindex($s,"c") == -1), "rindex(c) == -1");
+    ok(!(rindex($s,"c") != -1), "rindex(c) != -1");
+
+    ok(!(-1 == index($s,"a")),  "-1 == index(a)");
+    ok( (-1 != index($s,"a")),  "-1 != index(a)");
+    ok( (-1 == index($s,"c")),  "-1 == index(c)");
+    ok(!(-1 != index($s,"c")),  "-1 != index(c)");
+
+    ok(!(-1 == rindex($s,"a")), "-1 == rindex(a)");
+    ok( (-1 != rindex($s,"a")), "-1 != rindex(a)");
+    ok( (-1 == rindex($s,"c")), "-1 == rindex(c)");
+    ok(!(-1 != rindex($s,"c")), "-1 != rindex(c)");
+
+    # OPpTARGET_MY variant: the '$r = ' is optimised away too
+
+    my $r;
+
+    ok(!($r = index($s,"a") == -1),  "r = index(a) == -1");
+    ok(!$r,                          "r = index(a) == -1 - r value");
+    ok( ($r = index($s,"a") != -1),  "r = index(a) != -1");
+    ok( $r,                          "r = index(a) != -1 - r value");
+    ok( ($r = index($s,"c") == -1),  "r = index(c) == -1");
+    ok( $r,                          "r = index(c) == -1 - r value");
+    ok(!($r = index($s,"c") != -1),  "r = index(c) != -1");
+    ok(!$r,                          "r = index(c) != -1 - r value");
+
+    ok(!($r = rindex($s,"a") == -1), "r = rindex(a) == -1");
+    ok(!$r,                         "r = rindex(a) == -1 - r value");
+    ok( ($r = rindex($s,"a") != -1), "r = rindex(a) != -1");
+    ok( $r,                         "r = rindex(a) != -1 - r value");
+    ok( ($r = rindex($s,"c") == -1), "r = rindex(c) == -1");
+    ok( $r,                         "r = rindex(c) == -1 - r value");
+    ok(!($r = rindex($s,"c") != -1), "r = rindex(c) != -1");
+    ok(!$r,                         "r = rindex(c) != -1 - r value");
+
+    ok(!($r = -1 == index($s,"a")),  "r = -1 == index(a)");
+    ok(!$r,                          "r = -1 == index(a) - r value");
+    ok( ($r = -1 != index($s,"a")),  "r = -1 != index(a)");
+    ok( $r,                          "r = -1 != index(a) - r value");
+    ok( ($r = -1 == index($s,"c")),  "r = -1 == index(c)");
+    ok( $r,                          "r = -1 == index(c) - r value");
+    ok(!($r = -1 != index($s,"c")),  "r = -1 != index(c)");
+    ok(!$r,                          "r = -1 != index(c) - r value");
+
+    ok(!($r = -1 == rindex($s,"a")), "r = -1 == rindex(a)");
+    ok(!$r,                         "r = -1 == rindex(a) - r value");
+    ok( ($r = -1 != rindex($s,"a")), "r = -1 != rindex(a)");
+    ok( $r,                         "r = -1 != rindex(a) - r value");
+    ok( ($r = -1 == rindex($s,"c")), "r = -1 == rindex(c)");
+    ok( $r,                         "r = -1 == rindex(c) - r value");
+    ok(!($r = -1 != rindex($s,"c")), "r = -1 != rindex(c)");
+    ok(!$r,                         "r = -1 != rindex(c) - r value");
+}
index a144279..87f7704 100644 (file)
         code    => '$g = grep $_, @a;',
     },
 
+    # (index() == -1) and variants optimise away the op_const and op_eq
+    # and any assignment to a lexical var
+    'func::index::bool' => {
+        desc    => '(index() == -1) for match',
+        setup   => 'my $x = "aaaab"',
+        code    => 'index($x, "b") == -1',
+    },
+    'func::index::bool_fail' => {
+        desc    => '(index() == -1) for no match',
+        setup   => 'my $x = "aaaab"',
+        code    => 'index($x, "c") == -1',
+    },
+    'func::index::lex_bool' => {
+        desc    => '$lex = (index() == -1) for match',
+        setup   => 'my $r; my $x = "aaaab"',
+        code    => '$r = index($x, "b") == -1',
+    },
+    'func::index::lex_bool_fail' => {
+        desc    => '$lex = (index() == -1) for no match',
+        setup   => 'my $r; my $x = "aaaab"',
+        code    => '$r = index($x, "c") == -1',
+    },
+
     # using a const string as second arg to index triggers using FBM.
     # the FBM matcher special-cases 1,2-byte strings.
     #
index 1d02fae..b81892b 100644 (file)
@@ -20,7 +20,7 @@ BEGIN {
 use warnings;
 use strict;
 
-plan 2261;
+plan 2277;
 
 use B ();
 
@@ -350,3 +350,34 @@ test_opcount(0, 'barewords can be constant-folded',
                 });
     }
 }
+
+# index(...) == -1 and variants optimise away the EQ and CONST
+# and with $lex = (index(...) == -1), the assignment is optimised away
+# too
+
+{
+    local our @pkg;
+    my @lex;
+
+    my ($x, $y, $z);
+    for my $assign (0, 1) {
+        for my $op ('index($x,$y)', 'rindex($x,$y)') {
+            for my $eq ('==', '!=') {
+                for my $swap (0, 1) {
+                    my $expr = $swap ? "(-1 $eq $op)" : "($op $eq -1)";
+                    $expr = "\$z = ($expr)" if $assign;
+
+                    test_opcount(0, "optimise away qe,const in $expr",
+                            eval qq{sub { $expr }},
+                            {
+                                eq      => 0,
+                                ne      => 0,
+                                const   => 0,
+                                sassign => 0,
+                                padsv   => 2.
+                            });
+                }
+            }
+        }
+    }
+}