regcomp.c: Add ability to take intersection of complement

It turns out that it is a common paradigm to want to take the
intersection of an inversion list with the complement of another
inversion list.  In fact, this is the how to subtract the second
inversion list from the first, as what remains in the first after the
subtraction is everything in it that is not in the second.

It also turns out that it adds very few cycles to an intersection to
complement one (or both, should we choose to) of the operands.  By
adding this capability, we don't have to create a copy of the inverted
operand beforehand, just to throw it away.

diff --git a/embed.fnc b/embed.fnc
index 68e5ecd..43aa54e 100644 (file)
--- a/embed.fnc
+++ b/embed.fnc
@@ -1376,7 +1376,8 @@ EsMR      |bool   |invlist_iternext|NN SV* invlist|NN UV* start|NN UV* end
 EsMR   |IV     |invlist_search |NN SV* const invlist|const UV cp
 #endif
 #if defined(PERL_IN_REGCOMP_C) || defined(PERL_IN_UTF8_C)
-EXpM   |void   |_invlist_intersection  |NN SV* const a|NN SV* const b|NN SV** i
+EXmM   |void   |_invlist_intersection  |NN SV* const a|NN SV* const b|NN SV** i
+EXpM   |void   |_invlist_intersection_maybe_complement_2nd|NULLOK SV* const a|NN SV* const b|bool complement_b|NN SV** i
 EXpM   |void   |_invlist_union |NULLOK SV* const a|NN SV* const b|NN SV** output
 EXpM   |void   |_invlist_subtract|NN SV* const a|NN SV* const b|NN SV** result
 EXpM   |void   |_invlist_invert|NN SV* const invlist

diff --git a/embed.h b/embed.h
index 5190062..66dfe9a 100644 (file)
--- a/embed.h
+++ b/embed.h
@@ -949,7 +949,7 @@
 #  endif
 #  if defined(PERL_IN_REGCOMP_C) || defined(PERL_IN_UTF8_C)
 #define _append_range_to_invlist(a,b,c)        Perl__append_range_to_invlist(aTHX_ a,b,c)
-#define _invlist_intersection(a,b,c)   Perl__invlist_intersection(aTHX_ a,b,c)
+#define _invlist_intersection_maybe_complement_2nd(a,b,c,d)    Perl__invlist_intersection_maybe_complement_2nd(aTHX_ a,b,c,d)
 #define _invlist_invert(a)     Perl__invlist_invert(aTHX_ a)
 #define _invlist_invert_prop(a)        Perl__invlist_invert_prop(aTHX_ a)
 #define _invlist_populate_swatch(a,b,c,d)      Perl__invlist_populate_swatch(aTHX_ a,b,c,d)

diff --git a/proto.h b/proto.h
index 6135af8..9e114c2 100644 (file)
--- a/proto.h
+++ b/proto.h
@@ -6550,12 +6550,16 @@ PERL_CALLCONV void      Perl__append_range_to_invlist(pTHX_ SV* const invlist, const
 #define PERL_ARGS_ASSERT__APPEND_RANGE_TO_INVLIST      \
        assert(invlist)
 
-PERL_CALLCONV void     Perl__invlist_intersection(pTHX_ SV* const a, SV* const b, SV** i)
+/* PERL_CALLCONV void  _invlist_intersection(pTHX_ SV* const a, SV* const b, SV** i)
                        __attribute__nonnull__(pTHX_1)
                        __attribute__nonnull__(pTHX_2)
-                       __attribute__nonnull__(pTHX_3);
-#define PERL_ARGS_ASSERT__INVLIST_INTERSECTION \
-       assert(a); assert(b); assert(i)
+                       __attribute__nonnull__(pTHX_3); */
+
+PERL_CALLCONV void     Perl__invlist_intersection_maybe_complement_2nd(pTHX_ SV* const a, SV* const b, bool complement_b, SV** i)
+                       __attribute__nonnull__(pTHX_2)
+                       __attribute__nonnull__(pTHX_4);
+#define PERL_ARGS_ASSERT__INVLIST_INTERSECTION_MAYBE_COMPLEMENT_2ND    \
+       assert(b); assert(i)
 
 PERL_CALLCONV void     Perl__invlist_invert(pTHX_ SV* const invlist)
                        __attribute__nonnull__(pTHX_1);

diff --git a/regcomp.c b/regcomp.c
index 27309ff..3ae58bb 100644 (file)
--- a/regcomp.c
+++ b/regcomp.c
@@ -6730,11 +6730,14 @@ Perl__invlist_union(pTHX_ SV* const a, SV* const b, SV** output)
 }
 
 void
-Perl__invlist_intersection(pTHX_ SV* const a, SV* const b, SV** i)
+Perl__invlist_intersection_maybe_complement_2nd(pTHX_ SV* const a, SV* const b, bool complement_b, SV** i)
 {
     /* Take the intersection of two inversion lists and point <i> to it.  *i
      * should be defined upon input, and if it points to one of the two lists,
      * the reference count to that list will be decremented.
+     * If <complement_b> is TRUE, the result will be the intersection of <a>
+     * and the complement (or inversion) of <b> instead of <b> directly.
+     *
      * The basis for this comes from "Unicode Demystified" Chapter 13 by
      * Richard Gillam, published by Addison-Wesley, and explained at some
      * length there.  The preface says to incorporate its examples into your
@@ -6765,22 +6768,38 @@ Perl__invlist_intersection(pTHX_ SV* const a, SV* const b, SV** i)
      */
     UV count = 0;
 
-    PERL_ARGS_ASSERT__INVLIST_INTERSECTION;
+    PERL_ARGS_ASSERT__INVLIST_INTERSECTION_MAYBE_COMPLEMENT_2ND;
     assert(a != b);
 
-    /* If either one is empty, the intersection is null */
+    /* Special case if either one is empty */
     len_a = invlist_len(a);
     if ((len_a == 0) || ((len_b = invlist_len(b)) == 0)) {
 
-       /* If the result is the same as one of the inputs, the input is being
-        * overwritten */
+        if (len_a != 0 && complement_b) {
+
+            /* Here, 'a' is not empty, therefore from the above 'if', 'b' must
+             * be empty.  Here, also we are using 'b's complement, which hence
+             * must be every possible code point.  Thus the intersection is
+             * simply 'a'. */
+            if (*i != a) {
+                *i = invlist_clone(a);
+
+                if (*i == b) {
+                    SvREFCNT_dec(b);
+                }
+            }
+            /* else *i is already 'a' */
+            return;
+        }
+
+        /* Here, 'a' or 'b' is empty and not using the complement of 'b'.  The
+         * intersection must be empty */
        if (*i == a) {
            SvREFCNT_dec(a);
        }
        else if (*i == b) {
            SvREFCNT_dec(b);
        }
-
        *i = _new_invlist(0);
        return;
     }
@@ -6789,6 +6808,31 @@ Perl__invlist_intersection(pTHX_ SV* const a, SV* const b, SV** i)
     array_a = invlist_array(a);
     array_b = invlist_array(b);
 
+    /* If are to take the intersection of 'a' with the complement of b, set it
+     * up so are looking at b's complement. */
+    if (complement_b) {
+
+       /* To complement, we invert: if the first element is 0, remove it.  To
+        * do this, we just pretend the array starts one later, and clear the
+        * flag as we don't have to do anything else later */
+        if (array_b[0] == 0) {
+            array_b++;
+            len_b--;
+            complement_b = FALSE;
+        }
+        else {
+
+            /* But if the first element is not zero, we unshift a 0 before the
+             * array.  The data structure reserves a space for that 0 (which
+             * should be a '1' right now), so physical shifting is unneeded,
+             * but temporarily change that element to 0.  Before exiting the
+             * routine, we must restore the element to '1' */
+            array_b--;
+            len_b++;
+            array_b[0] = 0;
+        }
+    }
+
     /* Size the intersection for the worst case: that the intersection ends up
      * fragmenting everything to be completely disjoint */
     r= _new_invlist(len_a + len_b);
@@ -6897,6 +6941,11 @@ Perl__invlist_intersection(pTHX_ SV* const a, SV* const b, SV** i)
        SvREFCNT_dec(*i);
     }
 
+    /* If we've changed b, restore it */
+    if (complement_b) {
+        array_b[0] = 1;
+    }
+
     *i = r;
     return;
 }

diff --git a/regexp.h b/regexp.h
index b24a639..aefdac8 100644 (file)
--- a/regexp.h
+++ b/regexp.h
@@ -55,6 +55,10 @@ typedef struct regexp_paren_pair {
     I32 end;
 } regexp_paren_pair;
 
+#if defined(PERL_IN_REGCOMP_C) || defined(PERL_IN_UTF8_C)
+#define _invlist_intersection(a, b, output) _invlist_intersection_maybe_complement_2nd(a, b, FALSE, output)
+#endif
+
 /*
   The regexp/REGEXP struct, see L<perlreapi> for further documentation
   on the individual fields. The struct is ordered so that the most