mirror/guile
mirror/guile
1
Fork 0
mirror of https://git.savannah.gnu.org/git/guile.git synced 2025-06-11 22:31:12 +02:00
Code Activity

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

Browse source 
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.
This commit is contained in:
Gary Houston 2001-07-31 21:50:30 +00:00
parent 50694746a3
commit aaf41af6d5
3 changed files with 63 additions and 16 deletions
Download patch file Download diff file Expand all files Collapse all files

18
srfi/ChangeLog
View file

@ -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

59
srfi/srfi-14.c
View file

@ -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

2
srfi/srfi-14.h
View file

@ -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 */