This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
Add 3 methods for inversion lists
authorKarl Williamson <public@khwilliamson.com>
Mon, 30 May 2011 03:35:20 +0000 (21:35 -0600)
committerKarl Williamson <public@khwilliamson.com>
Sun, 3 Jul 2011 20:05:47 +0000 (14:05 -0600)
This adds inversion, cloning, and set subtraction

embed.fnc
embed.h
proto.h
regcomp.c

index 5d56194..4b78b0d 100644 (file)
--- a/embed.fnc
+++ b/embed.fnc
@@ -1318,6 +1318,9 @@ EiMR      |UV     |invlist_max    |NN SV* const invlist
 EiM    |void   |invlist_set_len        |NN SV* const invlist|const UV len
 EiM    |void   |invlist_trim   |NN SV* const invlist
 EsM    |void   |invlist_union  |NN SV* const a|NN SV* const b|NN SV** output
+EsM    |void   |invlist_subtract|NN SV* const a|NN SV* const b|NN SV** result
+EiM    |void   |invlist_invert |NN SV* const invlist
+EiMR   |SV*    |invlist_clone  |NN SV* const invlist
 EiMR   |UV*    |get_invlist_iter_addr  |NN SV* invlist
 EiM    |void   |invlist_iterinit|NN SV* invlist
 EsMR   |bool   |invlist_iternext|NN SV* invlist|NN UV* start|NN UV* end
diff --git a/embed.h b/embed.h
index 15da1bc..bc0532d 100644 (file)
--- a/embed.h
+++ b/embed.h
 #define get_invlist_len_addr(a)        S_get_invlist_len_addr(aTHX_ a)
 #define get_invlist_zero_addr(a)       S_get_invlist_zero_addr(aTHX_ a)
 #define invlist_array(a)       S_invlist_array(aTHX_ a)
+#define invlist_clone(a)       S_invlist_clone(aTHX_ a)
 #define invlist_extend(a,b)    S_invlist_extend(aTHX_ a,b)
 #define invlist_intersection(a,b,c)    S_invlist_intersection(aTHX_ a,b,c)
+#define invlist_invert(a)      S_invlist_invert(aTHX_ a)
 #define invlist_iterinit(a)    S_invlist_iterinit(aTHX_ a)
 #define invlist_iternext(a,b,c)        S_invlist_iternext(aTHX_ a,b,c)
 #define invlist_len(a)         S_invlist_len(aTHX_ a)
 #define invlist_max(a)         S_invlist_max(aTHX_ a)
 #define invlist_set_len(a,b)   S_invlist_set_len(aTHX_ a,b)
+#define invlist_subtract(a,b,c)        S_invlist_subtract(aTHX_ a,b,c)
 #define invlist_trim(a)                S_invlist_trim(aTHX_ a)
 #define invlist_union(a,b,c)   S_invlist_union(aTHX_ a,b,c)
 #define join_exact(a,b,c,d,e,f)        S_join_exact(aTHX_ a,b,c,d,e,f)
diff --git a/proto.h b/proto.h
index bfb0f83..be4dfb4 100644 (file)
--- a/proto.h
+++ b/proto.h
@@ -6071,6 +6071,12 @@ PERL_STATIC_INLINE UV*   S_invlist_array(pTHX_ SV* const invlist)
 #define PERL_ARGS_ASSERT_INVLIST_ARRAY \
        assert(invlist)
 
+PERL_STATIC_INLINE SV* S_invlist_clone(pTHX_ SV* const invlist)
+                       __attribute__warn_unused_result__
+                       __attribute__nonnull__(pTHX_1);
+#define PERL_ARGS_ASSERT_INVLIST_CLONE \
+       assert(invlist)
+
 STATIC void    S_invlist_extend(pTHX_ SV* const invlist, const UV len)
                        __attribute__nonnull__(pTHX_1);
 #define PERL_ARGS_ASSERT_INVLIST_EXTEND        \
@@ -6083,6 +6089,11 @@ STATIC void      S_invlist_intersection(pTHX_ SV* const a, SV* const b, SV** i)
 #define PERL_ARGS_ASSERT_INVLIST_INTERSECTION  \
        assert(a); assert(b); assert(i)
 
+PERL_STATIC_INLINE void        S_invlist_invert(pTHX_ SV* const invlist)
+                       __attribute__nonnull__(pTHX_1);
+#define PERL_ARGS_ASSERT_INVLIST_INVERT        \
+       assert(invlist)
+
 PERL_STATIC_INLINE void        S_invlist_iterinit(pTHX_ SV* invlist)
                        __attribute__nonnull__(pTHX_1);
 #define PERL_ARGS_ASSERT_INVLIST_ITERINIT      \
@@ -6113,6 +6124,13 @@ PERL_STATIC_INLINE void  S_invlist_set_len(pTHX_ SV* const invlist, const UV len)
 #define PERL_ARGS_ASSERT_INVLIST_SET_LEN       \
        assert(invlist)
 
+STATIC void    S_invlist_subtract(pTHX_ SV* const a, SV* const b, SV** result)
+                       __attribute__nonnull__(pTHX_1)
+                       __attribute__nonnull__(pTHX_2)
+                       __attribute__nonnull__(pTHX_3);
+#define PERL_ARGS_ASSERT_INVLIST_SUBTRACT      \
+       assert(a); assert(b); assert(result)
+
 PERL_STATIC_INLINE void        S_invlist_trim(pTHX_ SV* const invlist)
                        __attribute__nonnull__(pTHX_1);
 #define PERL_ARGS_ASSERT_INVLIST_TRIM  \
index d658169..a23134c 100644 (file)
--- a/regcomp.c
+++ b/regcomp.c
@@ -5966,7 +5966,9 @@ S_invlist_set_len(pTHX_ SV* const invlist, const UV len)
      * But, this is only valid if len is not 0.  The consequences of not doing
      * this is that the memory allocation code may think that the 1 more UV
      * is being used than actually is, and so might do an unnecessary grow.
-     * That seems worth not bothering to make this the precise amount */
+     * That seems worth not bothering to make this the precise amount.
+     *
+     * Note that when inverting, SvCUR shouldn't change */
 }
 
 PERL_STATIC_INLINE UV
@@ -6535,6 +6537,80 @@ S_add_cp_to_invlist(pTHX_ SV* invlist, const UV cp) {
     return add_range_to_invlist(invlist, cp, cp);
 }
 
+PERL_STATIC_INLINE void
+S_invlist_invert(pTHX_ SV* const invlist)
+{
+    /* Complement the input inversion list.  This adds a 0 if the list didn't
+     * have a zero; removes it otherwise.  As described above, the data
+     * structure is set up so that this is very efficient */
+
+    UV* len_pos = get_invlist_len_addr(invlist);
+
+    PERL_ARGS_ASSERT_INVLIST_INVERT;
+
+    /* The inverse of matching nothing is matching everything */
+    if (*len_pos == 0) {
+       _append_range_to_invlist(invlist, 0, UV_MAX);
+       return;
+    }
+
+    /* The exclusive or complents 0 to 1; and 1 to 0.  If the result is 1, the
+     * zero element was a 0, so it is being removed, so the length decrements
+     * by 1; and vice-versa.  SvCUR is unaffected */
+    if (*get_invlist_zero_addr(invlist) ^= 1) {
+       (*len_pos)--;
+    }
+    else {
+       (*len_pos)++;
+    }
+}
+
+PERL_STATIC_INLINE SV*
+S_invlist_clone(pTHX_ SV* const invlist)
+{
+
+    /* Return a new inversion list that is a copy of the input one, which is
+     * unchanged */
+
+    SV* new_invlist = _new_invlist(SvCUR(invlist));
+
+    PERL_ARGS_ASSERT_INVLIST_CLONE;
+
+    Copy(SvPVX(invlist), SvPVX(new_invlist), SvCUR(invlist), char);
+    return new_invlist;
+}
+
+STATIC void
+S_invlist_subtract(pTHX_ SV* const a, SV* const b, SV** result)
+{
+    /* Point result to an inversion list which consists of all elements in 'a'
+     * that aren't also in 'b' */
+
+    PERL_ARGS_ASSERT_INVLIST_SUBTRACT;
+
+    /* Subtracting nothing retains the original */
+    if (invlist_len(b) == 0) {
+
+       /* If the result is not to be the same variable as the original, create
+        * a copy */
+       if (result != &a) {
+           *result = invlist_clone(a);
+       }
+    } else {
+       SV *b_copy = invlist_clone(b);
+       invlist_invert(b_copy); /* Everything not in 'b' */
+       invlist_intersection(a, b_copy, result);    /* Everything in 'a' not in
+                                                      'b' */
+       SvREFCNT_dec(b_copy);
+    }
+
+    if (result == &b) {
+       SvREFCNT_dec(b);
+    }
+
+    return;
+}
+
 PERL_STATIC_INLINE UV*
 S_get_invlist_iter_addr(pTHX_ SV* invlist)
 {