* srfi-14.c (scm_char_set_diff_plus_intersection): wasn't correctly

	accounting for the (char-set-union cs2...) in the spec.  i.e.,
	(char-set-diff+intersection a) -> copy-of-a, empty-set
	and the following are equivalent:
	(char-set-diff+intersection a (char-set #\a) (char-set #\b))
	(char-set-diff+intersection a (char-set #\a #\b))

	(scm_char_set_xor_x): disabled the side-effecting code, since it
	gives inconsistent results to scm_char_set_xor for the case
	(char-set-xor! a a a).

	(scm_char_set_diff_plus_intersection_x): added cs2 argument, since
	two arguments are compulsory in final spec.  also similar changes
	as for scm_char_set_diff_plus_intersection.
	* srfi-14.h (scm_char_set_diff_plus_intersection_x): added cs2.

3 files changed, 63 insertions, 16 deletions

diff --git a/srfi/ChangeLog b/srfi/ChangeLog
index b287451b2..109ff9940 100644
--- a/srfi/ChangeLog
+++ b/srfi/ChangeLog
@@ -1,3 +1,21 @@
+2001-07-31  Gary Houston  <ghouston@arglist.com>
+
+	* srfi-14.c (scm_char_set_diff_plus_intersection): wasn't correctly
+	accounting for the (char-set-union cs2...) in the spec.  i.e.,
+	(char-set-diff+intersection a) -> copy-of-a, empty-set
+	and the following are equivalent:
+	(char-set-diff+intersection a (char-set #\a) (char-set #\b))
+	(char-set-diff+intersection a (char-set #\a #\b))
+
+	(scm_char_set_xor_x): disabled the side-effecting code, since it
+	gives inconsistent results to scm_char_set_xor for the case
+	(char-set-xor! a a a).
+	
+	(scm_char_set_diff_plus_intersection_x): added cs2 argument, since
+	two arguments are compulsory in final spec.  also similar changes
+	as for scm_char_set_diff_plus_intersection.
+	* srfi-14.h (scm_char_set_diff_plus_intersection_x): added cs2.
+
 2001-07-22  Gary Houston  <ghouston@arglist.com>
 
 	* srfi-14.c (scm_char_set_intersection, scm_char_set_xor): remove
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
 
diff --git a/srfi/srfi-14.h b/srfi/srfi-14.h
index 02e74f765..3989aadcc 100644
--- a/srfi/srfi-14.h
+++ b/srfi/srfi-14.h
@@ -111,6 +111,6 @@ SCM scm_char_set_union_x (SCM cs1, SCM rest);
 SCM scm_char_set_intersection_x (SCM cs1, SCM rest);
 SCM scm_char_set_difference_x (SCM cs1, SCM rest);
 SCM scm_char_set_xor_x (SCM cs1, SCM rest);
-SCM scm_char_set_diff_plus_intersection_x (SCM cs1, SCM rest);
+SCM scm_char_set_diff_plus_intersection_x (SCM cs1, SCM cs2, SCM rest);
 
 #endif /* SCM_SRFI_14_H */