fix index(...) == -1 type optimisations

[perl5.git] / op.c

diff --git a/op.c b/op.c
index ff78e95..99c4db8 100644 (file)
--- a/op.c
+++ b/op.c
@@ -9681,11 +9681,27 @@ is_dollar_bracket(pTHX_ const OP * const o)
        && strEQ(GvNAME(cGVOPx_gv(kid)), "[");
 }
 
+/* for lt, gt, le, ge, eq, ne and their i_ variants */
+
 OP *
 Perl_ck_cmp(pTHX_ OP *o)
 {
+    bool is_eq;
+    bool neg;
+    bool reverse;
+    bool iv0;
+    OP *indexop, *constop, *start;
+    SV *sv;
+    IV iv;
+
     PERL_ARGS_ASSERT_CK_CMP;
-    if (ckWARN(WARN_SYNTAX)) {
+
+    is_eq = (   o->op_type == OP_EQ
+             || o->op_type == OP_NE
+             || o->op_type == OP_I_EQ
+             || o->op_type == OP_I_NE);
+
+    if (!is_eq && ckWARN(WARN_SYNTAX)) {
        const OP *kid = cUNOPo->op_first;
        if (kid &&
             (
@@ -9700,9 +9716,87 @@ Perl_ck_cmp(pTHX_ OP *o)
            Perl_warner(aTHX_ packWARN(WARN_SYNTAX),
                        "$[ used in %s (did you mean $] ?)", OP_DESC(o));
     }
-    return o;
+
+    /* convert (index(...) == -1) and variations into
+     *   (r)index/BOOL(,NEG)
+     */
+
+    reverse = FALSE;
+
+    indexop = cUNOPo->op_first;
+    constop = OpSIBLING(indexop);
+    start = NULL;
+    if (indexop->op_type == OP_CONST) {
+        constop = indexop;
+        indexop = OpSIBLING(constop);
+        start = constop;
+        reverse = TRUE;
+    }
+
+    if (indexop->op_type != OP_INDEX && indexop->op_type != OP_RINDEX)
+        return o;
+
+    /* ($lex = index(....)) == -1 */
+    if (indexop->op_private & OPpTARGET_MY)
+        return o;
+
+    if (constop->op_type != OP_CONST)
+        return o;
+
+    sv = cSVOPx_sv(constop);
+    if (!(sv && SvIOK_notUV(sv)))
+        return o;
+
+    iv = SvIVX(sv);
+    if (iv != -1 && iv != 0)
+        return o;
+    iv0 = (iv == 0);
+
+    if (o->op_type == OP_LT || o->op_type == OP_I_LT) {
+        if (!(iv0 ^ reverse))
+            return o;
+        neg = iv0;
+    }
+    else if (o->op_type == OP_LE || o->op_type == OP_I_LE) {
+        if (iv0 ^ reverse)
+            return o;
+        neg = !iv0;
+    }
+    else if (o->op_type == OP_GE || o->op_type == OP_I_GE) {
+        if (!(iv0 ^ reverse))
+            return o;
+        neg = !iv0;
+    }
+    else if (o->op_type == OP_GT || o->op_type == OP_I_GT) {
+        if (iv0 ^ reverse)
+            return o;
+        neg = iv0;
+    }
+    else if (o->op_type == OP_EQ || o->op_type == OP_I_EQ) {
+        if (iv0)
+            return o;
+        neg = TRUE;
+    }
+    else {
+        assert(o->op_type == OP_NE || o->op_type == OP_I_NE);
+        if (iv0)
+            return o;
+        neg = FALSE;
+    }
+
+    indexop->op_flags &= ~OPf_PARENS;
+    indexop->op_flags |= (o->op_flags & OPf_PARENS);
+    indexop->op_private |= OPpTRUEBOOL;
+    if (neg)
+        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_concat(pTHX_ OP *o)
 {
@@ -9816,52 +9910,6 @@ Perl_ck_eof(pTHX_ OP *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)
 {