mirror of
https://git.savannah.gnu.org/git/guile.git
synced 2025-06-10 14:00:21 +02:00
* 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.
This commit is contained in:
Martin Grabmüller
parent
df1ad0d146
commit
2c4df45186
4 changed files with 137 additions and 88 deletions
|
|
@ -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.
|
||||
|
|
|
|||
119
srfi/srfi-13.c
119
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. */
|
||||
|
|
|
|||
|
|
@ -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. */
|
||||
|
|
|
|||
|
|
@ -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. */
|
||||
|
|
|
|||
Loading…
Add table
Add a link
Reference in a new issue