diff options
author | Martin Grabmüller <mgrabmue@cs.tu-berlin.de> | 2001-06-28 16:39:00 +0000 |
---|---|---|
committer | Martin Grabmüller <mgrabmue@cs.tu-berlin.de> | 2001-06-28 16:39:00 +0000 |
commit | 2c4df451863763567ee9813093e6f81b30244d53 (patch) | |
tree | 01d6585d7c104855a5cd3ddc48bfed2cc74048d8 | |
parent | df1ad0d146b78a4eeefaf0e0eb33de7cbf0354ff (diff) | |
download | guile-2c4df451863763567ee9813093e6f81b30244d53.tar.gz |
* srfi-4.c: Minor cleanups.
* srfi-14.c (scm_char_set_fold, scm_char_set_unfold)
(scm_char_set_unfold_x, scm_char_set_for_each)
(scm_char_set_map, scm_char_set_filter)
(scm_char_set_filter_x, scm_char_set_count)
(scm_char_set_every, scm_char_set_any): Replace calls to
scm_apply() with the corresponding scm_call_N() functions.
* srfi-14.c (scm_char_set_ref, scm_char_set_cursor_next)
(scm_char_set_unfold, scm_char_set_unfold_x)
(scm_char_set_map, scm_char_set_diff_plus_intersection)
(scm_char_set_diff_plus_intersection_x): Replace deprecated macros
SCM_LISTN with calls to scm_list_N().
* srfi-13.c (scm_string_tabulate, scm_string_map)
(scm_string_map_x, scm_string_unfold)
(scm_string_unfold_right): Replace deprecated macros SCM_LISTN
with calls to scm_list_N().
* srfi-13.c (scm_string_any, scm_string_every),
(scm_string_tabulate, scm_string_trim),
(scm_string_trim_right, scm_string_trim_both),
(scm_string_compare, scm_string_compare_ci),
(scm_string_indexS, scm_string_index_right),
(scm_string_skip, scm_string_skip_right, scm_string_count),
(scm_string_map, scm_string_map_x, scm_string_fold),
(scm_string_fold_right, scm_string_unfold),
(scm_string_unfold_right, scm_string_for_each),
(scm_string_filter, scm_string_delete): Replace calls to
scm_apply() with the corresponding scm_call_N() functions.
-rw-r--r-- | srfi/ChangeLog | 34 | ||||
-rw-r--r-- | srfi/srfi-13.c | 119 | ||||
-rw-r--r-- | srfi/srfi-14.c | 67 | ||||
-rw-r--r-- | srfi/srfi-4.c | 5 |
4 files changed, 137 insertions, 88 deletions
diff --git a/srfi/ChangeLog b/srfi/ChangeLog index 0984f87bb..4f56cc6dd 100644 --- a/srfi/ChangeLog +++ b/srfi/ChangeLog @@ -1,3 +1,37 @@ +2001-06-28 Martin Grabmueller <mgrabmue@cs.tu-berlin.de> + + * srfi-4.c: Minor cleanups. + + * srfi-14.c (scm_char_set_fold, scm_char_set_unfold) + (scm_char_set_unfold_x, scm_char_set_for_each) + (scm_char_set_map, scm_char_set_filter) + (scm_char_set_filter_x, scm_char_set_count) + (scm_char_set_every, scm_char_set_any): Replace calls to + scm_apply() with the corresponding scm_call_N() functions. + + * srfi-14.c (scm_char_set_ref, scm_char_set_cursor_next) + (scm_char_set_unfold, scm_char_set_unfold_x) + (scm_char_set_map, scm_char_set_diff_plus_intersection) + (scm_char_set_diff_plus_intersection_x): Replace deprecated macros + SCM_LISTN with calls to scm_list_N(). + + * srfi-13.c (scm_string_tabulate, scm_string_map) + (scm_string_map_x, scm_string_unfold) + (scm_string_unfold_right): Replace deprecated macros SCM_LISTN + with calls to scm_list_N(). + + * srfi-13.c (scm_string_any, scm_string_every), + (scm_string_tabulate, scm_string_trim), + (scm_string_trim_right, scm_string_trim_both), + (scm_string_compare, scm_string_compare_ci), + (scm_string_indexS, scm_string_index_right), + (scm_string_skip, scm_string_skip_right, scm_string_count), + (scm_string_map, scm_string_map_x, scm_string_fold), + (scm_string_fold_right, scm_string_unfold), + (scm_string_unfold_right, scm_string_for_each), + (scm_string_filter, scm_string_delete): Replace calls to + scm_apply() with the corresponding scm_call_N() functions. + 2001-06-27 Martin Grabmueller <mgrabmue@cs.tu-berlin.de> * Makefile.am: Added SRFI-4 files in various places. diff --git a/srfi/srfi-13.c b/srfi/srfi-13.c index af34b03e2..acd043b9c 100644 --- a/srfi/srfi-13.c +++ b/srfi/srfi-13.c @@ -72,7 +72,7 @@ SCM_DEFINE (scm_string_any, "string-any", 2, 2, 0, cstr += cstart; while (cstart < cend) { - res = scm_apply (pred, SCM_MAKE_CHAR (*cstr), scm_listofnull); + res = scm_call_1 (pred, SCM_MAKE_CHAR (*cstr)); if (!SCM_FALSEP (res)) return res; cstr++; @@ -104,7 +104,7 @@ SCM_DEFINE (scm_string_every, "string-every", 2, 2, 0, cstr += cstart; while (cstart < cend) { - res = scm_apply (pred, SCM_MAKE_CHAR (*cstr), scm_listofnull); + res = scm_call_1 (pred, SCM_MAKE_CHAR (*cstr)); if (SCM_FALSEP (res)) return res; cstr++; @@ -137,9 +137,9 @@ SCM_DEFINE (scm_string_tabulate, "string-tabulate", 2, 0, 0, i = 0; while (i < clen) { - ch = scm_apply (proc, SCM_MAKINUM (i), scm_listofnull); + ch = scm_call_1 (proc, SCM_MAKINUM (i)); if (!SCM_CHARP (ch)) - SCM_MISC_ERROR ("procedure ~S returned non-char", SCM_LIST1 (proc)); + SCM_MISC_ERROR ("procedure ~S returned non-char", scm_list_1 (proc)); *p++ = SCM_CHAR (ch); i++; } @@ -650,8 +650,7 @@ SCM_DEFINE (scm_string_trim, "string-trim", 1, 3, 0, { SCM res; - res = scm_apply (char_pred, SCM_MAKE_CHAR (cstr[cstart]), - scm_listofnull); + res = scm_call_1 (char_pred, SCM_MAKE_CHAR (cstr[cstart])); if (SCM_FALSEP (res)) break; cstart++; @@ -726,8 +725,7 @@ SCM_DEFINE (scm_string_trim_right, "string-trim-right", 1, 3, 0, { SCM res; - res = scm_apply (char_pred, SCM_MAKE_CHAR (cstr[cend - 1]), - scm_listofnull); + res = scm_call_1 (char_pred, SCM_MAKE_CHAR (cstr[cend - 1])); if (SCM_FALSEP (res)) break; cend--; @@ -820,8 +818,7 @@ SCM_DEFINE (scm_string_trim_both, "string-trim-both", 1, 3, 0, { SCM res; - res = scm_apply (char_pred, SCM_MAKE_CHAR (cstr[cstart]), - scm_listofnull); + res = scm_call_1 (char_pred, SCM_MAKE_CHAR (cstr[cstart])); if (SCM_FALSEP (res)) break; cstart++; @@ -830,8 +827,7 @@ SCM_DEFINE (scm_string_trim_both, "string-trim-both", 1, 3, 0, { SCM res; - res = scm_apply (char_pred, SCM_MAKE_CHAR (cstr[cend - 1]), - scm_listofnull); + res = scm_call_1 (char_pred, SCM_MAKE_CHAR (cstr[cend - 1])); if (SCM_FALSEP (res)) break; cend--; @@ -890,18 +886,18 @@ SCM_DEFINE (scm_string_compare, "string-compare", 5, 4, 0, while (cstart1 < cend1 && cstart2 < cend2) { if (cstr1[cstart1] < cstr2[cstart2]) - return scm_apply (proc_lt, SCM_MAKINUM (cstart1), scm_listofnull); + return scm_call_1 (proc_lt, SCM_MAKINUM (cstart1)); else if (cstr1[cstart1] > cstr2[cstart2]) - return scm_apply (proc_gt, SCM_MAKINUM (cstart1), scm_listofnull); + return scm_call_1 (proc_gt, SCM_MAKINUM (cstart1)); cstart1++; cstart2++; } if (cstart1 < cend1) - return scm_apply (proc_gt, SCM_MAKINUM (cstart1), scm_listofnull); + return scm_call_1 (proc_gt, SCM_MAKINUM (cstart1)); else if (cstart2 < cend2) - return scm_apply (proc_lt, SCM_MAKINUM (cstart1), scm_listofnull); + return scm_call_1 (proc_lt, SCM_MAKINUM (cstart1)); else - return scm_apply (proc_eq, SCM_MAKINUM (cstart1), scm_listofnull); + return scm_call_1 (proc_eq, SCM_MAKINUM (cstart1)); } #undef FUNC_NAME @@ -933,18 +929,18 @@ SCM_DEFINE (scm_string_compare_ci, "string-compare-ci", 5, 4, 0, while (cstart1 < cend1 && cstart2 < cend2) { if (scm_downcase (cstr1[cstart1]) < scm_downcase (cstr2[cstart2])) - return scm_apply (proc_lt, SCM_MAKINUM (cstart1), scm_listofnull); + return scm_call_1 (proc_lt, SCM_MAKINUM (cstart1)); else if (scm_downcase (cstr1[cstart1]) > scm_downcase (cstr2[cstart2])) - return scm_apply (proc_gt, SCM_MAKINUM (cstart1), scm_listofnull); + return scm_call_1 (proc_gt, SCM_MAKINUM (cstart1)); cstart1++; cstart2++; } if (cstart1 < cend1) - return scm_apply (proc_gt, SCM_MAKINUM (cstart1), scm_listofnull); + return scm_call_1 (proc_gt, SCM_MAKINUM (cstart1)); else if (cstart2 < cend2) - return scm_apply (proc_lt, SCM_MAKINUM (cstart1), scm_listofnull); + return scm_call_1 (proc_lt, SCM_MAKINUM (cstart1)); else - return scm_apply (proc_eq, SCM_MAKINUM (cstart1), scm_listofnull); + return scm_call_1 (proc_eq, SCM_MAKINUM (cstart1)); } #undef FUNC_NAME @@ -1657,8 +1653,7 @@ SCM_DEFINE (scm_string_indexS, "string-index", 2, 2, 0, while (cstart < cend) { SCM res; - res = scm_apply (char_pred, SCM_MAKE_CHAR (cstr[cstart]), - scm_listofnull); + res = scm_call_1 (char_pred, SCM_MAKE_CHAR (cstr[cstart])); if (!SCM_FALSEP (res)) return SCM_MAKINUM (cstart); cstart++; @@ -1718,8 +1713,7 @@ SCM_DEFINE (scm_string_index_right, "string-index-right", 2, 2, 0, { SCM res; cend--; - res = scm_apply (char_pred, SCM_MAKE_CHAR (cstr[cend]), - scm_listofnull); + res = scm_call_1 (char_pred, SCM_MAKE_CHAR (cstr[cend])); if (!SCM_FALSEP (res)) return SCM_MAKINUM (cend); } @@ -1778,8 +1772,7 @@ SCM_DEFINE (scm_string_skip, "string-skip", 2, 2, 0, while (cstart < cend) { SCM res; - res = scm_apply (char_pred, SCM_MAKE_CHAR (cstr[cstart]), - scm_listofnull); + res = scm_call_1 (char_pred, SCM_MAKE_CHAR (cstr[cstart])); if (SCM_FALSEP (res)) return SCM_MAKINUM (cstart); cstart++; @@ -1840,8 +1833,7 @@ SCM_DEFINE (scm_string_skip_right, "string-skip-right", 2, 2, 0, { SCM res; cend--; - res = scm_apply (char_pred, SCM_MAKE_CHAR (cstr[cend]), - scm_listofnull); + res = scm_call_1 (char_pred, SCM_MAKE_CHAR (cstr[cend])); if (SCM_FALSEP (res)) return SCM_MAKINUM (cend); } @@ -1900,8 +1892,7 @@ SCM_DEFINE (scm_string_count, "string-count", 2, 2, 0, while (cstart < cend) { SCM res; - res = scm_apply (char_pred, SCM_MAKE_CHAR (cstr[cstart]), - scm_listofnull); + res = scm_call_1 (char_pred, SCM_MAKE_CHAR (cstr[cstart])); if (!SCM_FALSEP (res)) count++; cstart++; @@ -2427,10 +2418,9 @@ SCM_DEFINE (scm_string_map, "string-map", 2, 2, 0, p = SCM_STRING_CHARS (result); while (cstart < cend) { - SCM ch = scm_apply (proc, SCM_MAKE_CHAR (cstr[cstart]), - scm_listofnull); + SCM ch = scm_call_1 (proc, SCM_MAKE_CHAR (cstr[cstart])); if (!SCM_CHARP (ch)) - SCM_MISC_ERROR ("procedure ~S returned non-char", SCM_LIST1 (proc)); + SCM_MISC_ERROR ("procedure ~S returned non-char", scm_list_1 (proc)); cstart++; *p++ = SCM_CHAR (ch); } @@ -2457,10 +2447,9 @@ SCM_DEFINE (scm_string_map_x, "string-map!", 2, 2, 0, p = SCM_STRING_CHARS (s) + cstart; while (cstart < cend) { - SCM ch = scm_apply (proc, SCM_MAKE_CHAR (cstr[cstart]), - scm_listofnull); + SCM ch = scm_call_1 (proc, SCM_MAKE_CHAR (cstr[cstart])); if (!SCM_CHARP (ch)) - SCM_MISC_ERROR ("procedure ~S returned non-char", SCM_LIST1 (proc)); + SCM_MISC_ERROR ("procedure ~S returned non-char", scm_list_1 (proc)); cstart++; *p++ = SCM_CHAR (ch); } @@ -2488,8 +2477,7 @@ SCM_DEFINE (scm_string_fold, "string-fold", 3, 2, 0, result = knil; while (cstart < cend) { - result = scm_apply (kons, SCM_LIST2 (SCM_MAKE_CHAR (cstr[cstart]), - result), SCM_EOL); + result = scm_call_2 (kons, SCM_MAKE_CHAR (cstr[cstart]), result); cstart++; } return result; @@ -2516,8 +2504,7 @@ SCM_DEFINE (scm_string_fold_right, "string-fold-right", 3, 2, 0, result = knil; while (cstart < cend) { - result = scm_apply (kons, SCM_LIST2 (SCM_MAKE_CHAR (cstr[cend - 1]), - result), SCM_EOL); + result = scm_call_2 (kons, SCM_MAKE_CHAR (cstr[cend - 1]), result); cend--; } return result; @@ -2562,24 +2549,24 @@ SCM_DEFINE (scm_string_unfold, "string-unfold", 4, 2, 0, if (!SCM_UNBNDP (make_final)) SCM_VALIDATE_PROC (6, make_final); - res = scm_apply (p, seed, scm_listofnull); + res = scm_call_1 (p, seed); while (SCM_FALSEP (res)) { SCM str; - SCM ch = scm_apply (f, seed, scm_listofnull); + SCM ch = scm_call_1 (f, seed); if (!SCM_CHARP (ch)) - SCM_MISC_ERROR ("procedure ~S returned non-char", SCM_LIST1 (f)); + SCM_MISC_ERROR ("procedure ~S returned non-char", scm_list_1 (f)); str = scm_allocate_string (1); *SCM_STRING_CHARS (str) = SCM_CHAR (ch); - ans = scm_string_append (SCM_LIST2 (ans, str)); - seed = scm_apply (g, seed, scm_listofnull); - res = scm_apply (p, seed, scm_listofnull); + ans = scm_string_append (scm_list_2 (ans, str)); + seed = scm_call_1 (g, seed); + res = scm_call_1 (p, seed); } if (!SCM_UNBNDP (make_final)) { - res = scm_apply (make_final, seed, scm_listofnull); - return scm_string_append (SCM_LIST2 (ans, res)); + res = scm_call_1 (make_final, seed); + return scm_string_append (scm_list_2 (ans, res)); } else return ans; @@ -2624,24 +2611,24 @@ SCM_DEFINE (scm_string_unfold_right, "string-unfold-right", 4, 2, 0, if (!SCM_UNBNDP (make_final)) SCM_VALIDATE_PROC (6, make_final); - res = scm_apply (p, seed, scm_listofnull); + res = scm_call_1 (p, seed); while (SCM_FALSEP (res)) { SCM str; - SCM ch = scm_apply (f, seed, scm_listofnull); + SCM ch = scm_call_1 (f, seed); if (!SCM_CHARP (ch)) - SCM_MISC_ERROR ("procedure ~S returned non-char", SCM_LIST1 (f)); + SCM_MISC_ERROR ("procedure ~S returned non-char", scm_list_1 (f)); str = scm_allocate_string (1); *SCM_STRING_CHARS (str) = SCM_CHAR (ch); - ans = scm_string_append (SCM_LIST2 (str, ans)); - seed = scm_apply (g, seed, scm_listofnull); - res = scm_apply (p, seed, scm_listofnull); + ans = scm_string_append (scm_list_2 (str, ans)); + seed = scm_call_1 (g, seed); + res = scm_call_1 (p, seed); } if (!SCM_UNBNDP (make_final)) { - res = scm_apply (make_final, seed, scm_listofnull); - return scm_string_append (SCM_LIST2 (res, ans)); + res = scm_call_1 (make_final, seed); + return scm_string_append (scm_list_2 (res, ans)); } else return ans; @@ -2664,7 +2651,7 @@ SCM_DEFINE (scm_string_for_each, "string-for-each", 2, 2, 0, SCM_VALIDATE_PROC (2, proc); while (cstart < cend) { - scm_apply (proc, SCM_MAKE_CHAR (cstr[cstart]), scm_listofnull); + scm_call_1 (proc, SCM_MAKE_CHAR (cstr[cstart])); cstart++; } return SCM_UNSPECIFIED; @@ -2940,8 +2927,7 @@ SCM_DEFINE (scm_string_filter, "string-filter", 2, 2, 0, while (idx < cend) { SCM res; - res = scm_apply (char_pred, SCM_MAKE_CHAR (cstr[idx]), - scm_listofnull); + res = scm_call_1 (char_pred, SCM_MAKE_CHAR (cstr[idx])); if (!SCM_FALSEP (res)) ls = scm_cons (SCM_MAKE_CHAR (cstr[idx]), ls); idx++; @@ -3007,8 +2993,7 @@ SCM_DEFINE (scm_string_delete, "string-delete", 2, 2, 0, while (idx < cend) { SCM res; - res = scm_apply (char_pred, SCM_MAKE_CHAR (cstr[idx]), - scm_listofnull); + res = scm_call_1 (char_pred, SCM_MAKE_CHAR (cstr[idx])); if (SCM_FALSEP (res)) ls = scm_cons (SCM_MAKE_CHAR (cstr[idx]), ls); idx++; @@ -3020,11 +3005,19 @@ SCM_DEFINE (scm_string_delete, "string-delete", 2, 2, 0, #undef FUNC_NAME +/* Initialize the SRFI-13 module. This function will be called by the + loading Scheme module. */ void scm_init_srfi_13 (void) { + /* We initialize the SRFI-14 module here, because the string + primitives need the charset smob type created by that module. */ scm_c_init_srfi_14 (); + + /* Install the string primitives. */ #ifndef SCM_MAGIC_SNARFER #include "srfi/srfi-13.x" #endif } + +/* End of srfi-13.c. */ diff --git a/srfi/srfi-14.c b/srfi/srfi-14.c index de9713bd9..3ee4ea8a2 100644 --- a/srfi/srfi-14.c +++ b/srfi/srfi-14.c @@ -237,7 +237,7 @@ SCM_DEFINE (scm_char_set_ref, "char-set-ref", 2, 0, 0, SCM_VALIDATE_INUM_COPY (2, cursor, ccursor); if (ccursor >= SCM_CHARSET_SIZE || !SCM_CHARSET_GET (cs, ccursor)) - SCM_MISC_ERROR ("invalid character set cursor: ~A", SCM_LIST1 (cursor)); + SCM_MISC_ERROR ("invalid character set cursor: ~A", scm_list_1 (cursor)); return SCM_MAKE_CHAR (ccursor); } #undef FUNC_NAME @@ -256,7 +256,7 @@ SCM_DEFINE (scm_char_set_cursor_next, "char-set-cursor-next", 2, 0, 0, SCM_VALIDATE_INUM_COPY (2, cursor, ccursor); if (ccursor >= SCM_CHARSET_SIZE || !SCM_CHARSET_GET (cs, ccursor)) - SCM_MISC_ERROR ("invalid character set cursor: ~A", SCM_LIST1 (cursor)); + SCM_MISC_ERROR ("invalid character set cursor: ~A", scm_list_1 (cursor)); for (ccursor++; ccursor < SCM_CHARSET_SIZE; ccursor++) { if (SCM_CHARSET_GET (cs, ccursor)) @@ -295,13 +295,13 @@ SCM_DEFINE (scm_char_set_fold, "char-set-fold", 3, 0, 0, for (k = 0; k < SCM_CHARSET_SIZE; k++) if (SCM_CHARSET_GET (cs, k)) { - knil = scm_apply (kons, SCM_LIST2 (SCM_MAKE_CHAR (k), (knil)), - SCM_EOL); + knil = scm_call_2 (kons, SCM_MAKE_CHAR (k), knil); } return knil; } #undef FUNC_NAME + SCM_DEFINE (scm_char_set_unfold, "char-set-unfold", 4, 1, 0, (SCM p, SCM f, SCM g, SCM seed, SCM base_cs), "This is a fundamental constructor for character sets.\n" @@ -330,16 +330,16 @@ SCM_DEFINE (scm_char_set_unfold, "char-set-unfold", 4, 1, 0, else result = make_char_set (FUNC_NAME); - tmp = scm_apply (p, seed, scm_listofnull); + tmp = scm_call_1 (p, seed); while (SCM_FALSEP (tmp)) { - SCM ch = scm_apply (f, seed, scm_listofnull); + SCM ch = scm_call_1 (f, seed); if (!SCM_CHARP (ch)) - SCM_MISC_ERROR ("procedure ~S returned non-char", SCM_LIST1 (f)); + SCM_MISC_ERROR ("procedure ~S returned non-char", scm_list_1 (f)); SCM_CHARSET_SET (result, SCM_CHAR (ch)); - seed = scm_apply (g, seed, scm_listofnull); - tmp = scm_apply (p, seed, scm_listofnull); + seed = scm_call_1 (g, seed); + tmp = scm_call_1 (p, seed); } return result; } @@ -368,16 +368,16 @@ SCM_DEFINE (scm_char_set_unfold_x, "char-set-unfold!", 5, 0, 0, SCM_VALIDATE_PROC (3, g); SCM_VALIDATE_SMOB (5, base_cs, charset); - tmp = scm_apply (p, seed, scm_listofnull); + tmp = scm_call_1 (p, seed); while (SCM_FALSEP (tmp)) { - SCM ch = scm_apply (f, seed, scm_listofnull); + SCM ch = scm_call_1 (f, seed); if (!SCM_CHARP (ch)) - SCM_MISC_ERROR ("procedure ~S returned non-char", SCM_LIST1 (f)); + SCM_MISC_ERROR ("procedure ~S returned non-char", scm_list_1 (f)); SCM_CHARSET_SET (base_cs, SCM_CHAR (ch)); - seed = scm_apply (g, seed, scm_listofnull); - tmp = scm_apply (p, seed, scm_listofnull); + seed = scm_call_1 (g, seed); + tmp = scm_call_1 (p, seed); } return base_cs; } @@ -397,7 +397,7 @@ SCM_DEFINE (scm_char_set_for_each, "char-set-for-each", 2, 0, 0, for (k = 0; k < SCM_CHARSET_SIZE; k++) if (SCM_CHARSET_GET (cs, k)) - scm_apply (proc, SCM_MAKE_CHAR (k), scm_listofnull); + scm_call_1 (proc, SCM_MAKE_CHAR (k)); return SCM_UNSPECIFIED; } #undef FUNC_NAME @@ -419,9 +419,9 @@ SCM_DEFINE (scm_char_set_map, "char-set-map", 2, 0, 0, for (k = 0; k < SCM_CHARSET_SIZE; k++) if (SCM_CHARSET_GET (cs, k)) { - SCM ch = scm_apply (proc, SCM_MAKE_CHAR (k), scm_listofnull); + SCM ch = scm_call_1 (proc, SCM_MAKE_CHAR (k)); if (!SCM_CHARP (ch)) - SCM_MISC_ERROR ("procedure ~S returned non-char", SCM_LIST1 (proc)); + SCM_MISC_ERROR ("procedure ~S returned non-char", scm_list_1 (proc)); SCM_CHARSET_SET (cs, SCM_CHAR (ch)); } return result; @@ -620,7 +620,7 @@ SCM_DEFINE (scm_char_set_filter, "char-set-filter", 2, 1, 0, { if (SCM_CHARSET_GET (cs, k)) { - SCM res = scm_apply (pred, SCM_MAKE_CHAR (k), scm_listofnull); + SCM res = scm_call_1 (pred, SCM_MAKE_CHAR (k)); if (!SCM_FALSEP (res)) p[k / sizeof (long)] |= 1 << (k % sizeof (long)); @@ -649,7 +649,7 @@ SCM_DEFINE (scm_char_set_filter_x, "char-set-filter!", 3, 0, 0, { if (SCM_CHARSET_GET (cs, k)) { - SCM res = scm_apply (pred, SCM_MAKE_CHAR (k), scm_listofnull); + SCM res = scm_call_1 (pred, SCM_MAKE_CHAR (k)); if (!SCM_FALSEP (res)) p[k / sizeof (long)] |= 1 << (k % sizeof (long)); @@ -787,7 +787,7 @@ SCM_DEFINE (scm_char_set_count, "char-set-count", 2, 0, 0, for (k = 0; k < SCM_CHARSET_SIZE; k++) if (SCM_CHARSET_GET (cs, k)) { - SCM res = scm_apply (pred, SCM_MAKE_CHAR (k), scm_listofnull); + SCM res = scm_call_1 (pred, SCM_MAKE_CHAR (k)); if (!SCM_FALSEP (res)) count++; } @@ -869,7 +869,7 @@ SCM_DEFINE (scm_char_set_every, "char-set-every", 2, 0, 0, for (k = 0; k < SCM_CHARSET_SIZE; k++) if (SCM_CHARSET_GET (cs, k)) { - res = scm_apply (pred, SCM_MAKE_CHAR (k), scm_listofnull); + res = scm_call_1 (pred, SCM_MAKE_CHAR (k)); if (SCM_FALSEP (res)) return res; } @@ -892,7 +892,7 @@ SCM_DEFINE (scm_char_set_any, "char-set-any", 2, 0, 0, for (k = 0; k < SCM_CHARSET_SIZE; k++) if (SCM_CHARSET_GET (cs, k)) { - SCM res = scm_apply (pred, SCM_MAKE_CHAR (k), scm_listofnull); + SCM res = scm_call_1 (pred, SCM_MAKE_CHAR (k)); if (!SCM_FALSEP (res)) return res; } @@ -928,6 +928,7 @@ SCM_DEFINE (scm_char_set_adjoin, "char-set-adjoin", 1, 0, 1, } #undef FUNC_NAME + SCM_DEFINE (scm_char_set_delete, "char-set-delete", 1, 0, 1, (SCM cs, SCM rest), "Delete all character arguments from the first argument, which\n" @@ -955,6 +956,7 @@ SCM_DEFINE (scm_char_set_delete, "char-set-delete", 1, 0, 1, } #undef FUNC_NAME + SCM_DEFINE (scm_char_set_adjoin_x, "char-set-adjoin!", 1, 0, 1, (SCM cs, SCM rest), "Add all character arguments to the first argument, which must\n" @@ -981,6 +983,7 @@ SCM_DEFINE (scm_char_set_adjoin_x, "char-set-adjoin!", 1, 0, 1, } #undef FUNC_NAME + SCM_DEFINE (scm_char_set_delete_x, "char-set-delete!", 1, 0, 1, (SCM cs, SCM rest), "Delete all character arguments from the first argument, which\n" @@ -1179,7 +1182,7 @@ SCM_DEFINE (scm_char_set_diff_plus_intersection, "char-set-diff+intersection", 1 q[k] &= ((long *) SCM_SMOB_DATA (cs))[k]; } } - return scm_values (SCM_LIST2 (res1, res2)); + return scm_values (scm_list_2 (res1, res2)); } #undef FUNC_NAME @@ -1315,7 +1318,8 @@ SCM_DEFINE (scm_char_set_xor_x, "char-set-xor!", 1, 0, 1, SCM_DEFINE (scm_char_set_diff_plus_intersection_x, "char-set-diff+intersection!", 1, 0, 1, (SCM cs1, SCM rest), - "Return the difference and the intersection of all argument character sets.") + "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; @@ -1342,14 +1346,19 @@ SCM_DEFINE (scm_char_set_diff_plus_intersection_x, "char-set-diff+intersection!" q[k] &= ((long *) SCM_SMOB_DATA (cs))[k]; } } - return scm_values (SCM_LIST2 (cs1, res2)); + return scm_values (scm_list_2 (cs1, res2)); } #undef FUNC_NAME +/* Create the charset smob type. */ void scm_c_init_srfi_14 (void) { + /* Charset smob creation is protected by this variable because this + function can be both called from the SRFI-13 and SRFI-14 + initialization functions. This is because the SRFI-13 procedures + access the charset smob type code. */ static int initialized = 0; if (!initialized) @@ -1362,11 +1371,19 @@ scm_c_init_srfi_14 (void) } } + +/* Initialize the SRFI-14 module. This function will be called by the + loading Scheme module. */ void scm_init_srfi_14 (void) { + /* Do the smob type initialization. */ scm_c_init_srfi_14 (); + + /* Install the charset primitives. */ #ifndef SCM_MAGIC_SNARFER #include "srfi/srfi-14.x" #endif } + +/* End of srfi-14.c. */ diff --git a/srfi/srfi-4.c b/srfi/srfi-4.c index da3025e1d..c90b36675 100644 --- a/srfi/srfi-4.c +++ b/srfi/srfi-4.c @@ -68,6 +68,7 @@ typedef signed long long int_s64; typedef float float_f32; typedef double float_f64; + /* Smob type code for homogeneous numeric vectors. */ int scm_tc16_uvec = 0; @@ -2138,6 +2139,8 @@ SCM_DEFINE (scm_list_to_f64vector, "list->f64vector", 1, 0, 0, #undef FUNC_NAME +/* Create the smob type for homogeneous numeric vectors and install + the primitives. */ void scm_init_srfi_4 (void) { @@ -2148,3 +2151,5 @@ scm_init_srfi_4 (void) #include "srfi/srfi-4.x" #endif } + +/* End of srfi-4.c. */ |