summaryrefslogtreecommitdiff
path: root/srfi/srfi-14.c
diff options
context:
space:
mode:
Diffstat (limited to 'srfi/srfi-14.c')
-rw-r--r--srfi/srfi-14.c59
1 files changed, 44 insertions, 15 deletions
diff --git a/srfi/srfi-14.c b/srfi/srfi-14.c
index 8a7a7321a..52d9419e3 100644
--- a/srfi/srfi-14.c
+++ b/srfi/srfi-14.c
@@ -1194,22 +1194,25 @@ SCM_DEFINE (scm_char_set_diff_plus_intersection, "char-set-diff+intersection", 1
SCM_VALIDATE_REST_ARGUMENT (rest);
res1 = scm_char_set_copy (cs1);
- res2 = scm_char_set_copy (cs1);
+ res2 = make_char_set (FUNC_NAME);
p = (long *) SCM_SMOB_DATA (res1);
q = (long *) SCM_SMOB_DATA (res2);
while (!SCM_NULLP (rest))
{
int k;
SCM cs = SCM_CAR (rest);
+ long *r;
+
SCM_VALIDATE_SMOB (c, cs, charset);
c++;
- rest = SCM_CDR (rest);
+ r = (long *) SCM_SMOB_DATA (cs);
for (k = 0; k < LONGS_PER_CHARSET; k++)
{
- p[k] &= ~((long *) SCM_SMOB_DATA (cs))[k];
- q[k] &= ((long *) SCM_SMOB_DATA (cs))[k];
+ q[k] |= p[k] & r[k];
+ p[k] &= ~r[k];
}
+ rest = SCM_CDR (rest);
}
return scm_values (scm_list_2 (res1, res2));
}
@@ -1322,6 +1325,15 @@ SCM_DEFINE (scm_char_set_xor_x, "char-set-xor!", 1, 0, 1,
"Return the exclusive-or of all argument character sets.")
#define FUNC_NAME s_scm_char_set_xor_x
{
+ /* a side-effecting variant should presumably give consistent results:
+ (define a (char-set #\a))
+ (char-set-xor a a a) -> char set #\a
+ (char-set-xor! a a a) -> char set #\a
+ */
+ return scm_char_set_xor (scm_cons (cs1, rest));
+
+#if 0
+ /* this would give (char-set-xor! a a a) -> empty char set. */
int c = 2;
long * p;
@@ -1341,41 +1353,58 @@ SCM_DEFINE (scm_char_set_xor_x, "char-set-xor!", 1, 0, 1,
p[k] ^= ((long *) SCM_SMOB_DATA (cs))[k];
}
return cs1;
+#endif
}
#undef FUNC_NAME
-SCM_DEFINE (scm_char_set_diff_plus_intersection_x, "char-set-diff+intersection!", 1, 0, 1,
- (SCM cs1, SCM rest),
+SCM_DEFINE (scm_char_set_diff_plus_intersection_x, "char-set-diff+intersection!", 2, 0, 1,
+ (SCM cs1, SCM cs2, SCM rest),
"Return the difference and the intersection of all argument\n"
"character sets.")
#define FUNC_NAME s_scm_char_set_diff_plus_intersection_x
{
- int c = 2;
- SCM res2;
+ int c = 3;
long * p, * q;
+ int k;
SCM_VALIDATE_SMOB (1, cs1, charset);
+ SCM_VALIDATE_SMOB (2, cs2, charset);
SCM_VALIDATE_REST_ARGUMENT (rest);
- res2 = scm_char_set_copy (cs1);
p = (long *) SCM_SMOB_DATA (cs1);
- q = (long *) SCM_SMOB_DATA (res2);
+ q = (long *) SCM_SMOB_DATA (cs2);
+ if (p == q)
+ {
+ /* (char-set-diff+intersection! a a ...): can't share storage,
+ but we know the answer without checking for further
+ arguments. */
+ return scm_values (scm_list_2 (make_char_set (FUNC_NAME), cs1));
+ }
+ for (k = 0; k < LONGS_PER_CHARSET; k++)
+ {
+ long t = p[k];
+
+ p[k] &= ~q[k];
+ q[k] = t & q[k];
+ }
while (!SCM_NULLP (rest))
{
- int k;
SCM cs = SCM_CAR (rest);
+ long *r;
+
SCM_VALIDATE_SMOB (c, cs, charset);
c++;
- rest = SCM_CDR (rest);
+ r = (long *) SCM_SMOB_DATA (cs);
for (k = 0; k < LONGS_PER_CHARSET; k++)
{
- p[k] &= ~((long *) SCM_SMOB_DATA (cs))[k];
- q[k] &= ((long *) SCM_SMOB_DATA (cs))[k];
+ q[k] |= p[k] & r[k];
+ p[k] &= ~r[k];
}
+ rest = SCM_CDR (rest);
}
- return scm_values (scm_list_2 (cs1, res2));
+ return scm_values (scm_list_2 (cs1, cs2));
}
#undef FUNC_NAME