guile/guile-core/srfi ChangeLog srfi-14.c srfi-...

[Gary Houston]

CVSROOT:        /cvs
Module name:    guile
Branch:         branch_release-1-6
Changes by:     Gary Houston <address@hidden>   01/07/31 14:50:30

Modified files:
        guile-core/srfi: ChangeLog srfi-14.c srfi-14.h 

Log message:
        * 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.

CVSWeb URLs:
http://savannah.gnu.org/cgi-bin/viewcvs/guile/guile-core/srfi/ChangeLog.diff?cvsroot=OldCVS&only_with_tag=branch_release-1-6&tr1=1.44.2.15&tr2=1.44.2.16&r1=text&r2=text
http://savannah.gnu.org/cgi-bin/viewcvs/guile/guile-core/srfi/srfi-14.c.diff?cvsroot=OldCVS&only_with_tag=branch_release-1-6&tr1=1.9.2.12&tr2=1.9.2.13&r1=text&r2=text
http://savannah.gnu.org/cgi-bin/viewcvs/guile/guile-core/srfi/srfi-14.h.diff?cvsroot=OldCVS&only_with_tag=branch_release-1-6&tr1=1.3.2.4&tr2=1.3.2.5&r1=text&r2=text

Patches:
Index: guile/guile-core/srfi/ChangeLog
diff -u guile/guile-core/srfi/ChangeLog:1.59 
guile/guile-core/srfi/ChangeLog:1.60
--- guile/guile-core/srfi/ChangeLog:1.59        Sun Jul 22 16:21:03 2001
+++ guile/guile-core/srfi/ChangeLog     Tue Jul 31 14:42:24 2001
@@ -1,3 +1,21 @@
+2001-07-31  Gary Houston  <address@hidden>
+
+       * 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  <address@hidden>
 
        * srfi-14.c (scm_char_set_intersection, scm_char_set_xor): remove
Index: guile/guile-core/srfi/srfi-14.c
diff -u guile/guile-core/srfi/srfi-14.c:1.21 
guile/guile-core/srfi/srfi-14.c:1.22
--- guile/guile-core/srfi/srfi-14.c:1.21        Sun Jul 22 16:21:03 2001
+++ guile/guile-core/srfi/srfi-14.c     Tue Jul 31 14:42:24 2001
@@ -1194,22 +1194,25 @@
   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 @@
            "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 @@
        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
 
Index: guile/guile-core/srfi/srfi-14.h
diff -u guile/guile-core/srfi/srfi-14.h:1.7 guile/guile-core/srfi/srfi-14.h:1.8
--- guile/guile-core/srfi/srfi-14.h:1.7 Sun Jul 22 13:17:28 2001
+++ guile/guile-core/srfi/srfi-14.h     Tue Jul 31 14:42:24 2001
@@ -111,6 +111,6 @@
 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 */