diff options
author | Gary Houston <ghouston@arglist.com> | 2001-07-31 21:42:24 +0000 |
---|---|---|
committer | Gary Houston <ghouston@arglist.com> | 2001-07-31 21:42:24 +0000 |
commit | 9be745030e215de6a0ee5e14e0d1e5c0398c704f (patch) | |
tree | 122943645b05742abbeb914b03d069d00df7a7b7 /srfi/srfi-14.c | |
parent | 88c4ba2aefd9175068e479d87d6e69e83c9c08d5 (diff) | |
download | guile-9be745030e215de6a0ee5e14e0d1e5c0398c704f.tar.gz |
* 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.
Diffstat (limited to 'srfi/srfi-14.c')
-rw-r--r-- | srfi/srfi-14.c | 59 |
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 |