summaryrefslogtreecommitdiff
path: root/libguile/srfi-13.c
diff options
context:
space:
mode:
authorKevin Ryde <user42@zip.com.au>2005-08-06 01:44:30 +0000
committerKevin Ryde <user42@zip.com.au>2005-08-06 01:44:30 +0000
commit3540b91548dea3e58d2597a2c7d9429f35866abc (patch)
tree8d1391f4a7741b5cb7580f2ea5c691d88bbee275 /libguile/srfi-13.c
parent514e4b24a9b28b9f0769b3e6ddc7fa839f80ba15 (diff)
downloadguile-3540b91548dea3e58d2597a2c7d9429f35866abc.tar.gz
(scm_string_any, scm_string_every, scm_string_tabulate,
scm_string_trim, scm_string_trim_right, scm_string_trim_both, scm_string_index, scm_string_index_right, scm_string_skip, scm_string_skip_right, scm_string_count, scm_string_map, scm_string_map_x, scm_string_for_each, scm_string_for_each_index, scm_string_filter, scm_string_delete): Use scm_t_trampoline_1 for procedures called in loops.
Diffstat (limited to 'libguile/srfi-13.c')
-rw-r--r--libguile/srfi-13.c97
1 files changed, 62 insertions, 35 deletions
diff --git a/libguile/srfi-13.c b/libguile/srfi-13.c
index d4bd53b73..ee4a09a09 100644
--- a/libguile/srfi-13.c
+++ b/libguile/srfi-13.c
@@ -120,11 +120,12 @@ SCM_DEFINE (scm_string_any, "string-any-c-code", 2, 2, 0,
}
else
{
- SCM_VALIDATE_PROC (1, char_pred);
+ scm_t_trampoline_1 pred_tramp = scm_trampoline_1 (char_pred);
+ SCM_ASSERT (pred_tramp, char_pred, SCM_ARG1, FUNC_NAME);
while (cstart < cend)
{
- res = scm_call_1 (char_pred, SCM_MAKE_CHAR (cstr[cstart]));
+ res = pred_tramp (char_pred, SCM_MAKE_CHAR (cstr[cstart]));
if (scm_is_true (res))
break;
cstr = scm_i_string_chars (s);
@@ -188,11 +189,12 @@ SCM_DEFINE (scm_string_every, "string-every-c-code", 2, 2, 0,
}
else
{
- SCM_VALIDATE_PROC (1, char_pred);
+ scm_t_trampoline_1 pred_tramp = scm_trampoline_1 (char_pred);
+ SCM_ASSERT (pred_tramp, char_pred, SCM_ARG1, FUNC_NAME);
while (cstart < cend)
{
- res = scm_call_1 (char_pred, SCM_MAKE_CHAR (cstr[cstart]));
+ res = pred_tramp (char_pred, SCM_MAKE_CHAR (cstr[cstart]));
if (scm_is_false (res))
break;
cstr = scm_i_string_chars (s);
@@ -218,8 +220,11 @@ SCM_DEFINE (scm_string_tabulate, "string-tabulate", 2, 0, 0,
SCM res;
SCM ch;
char *p;
+ scm_t_trampoline_1 proc_tramp;
+
+ proc_tramp = scm_trampoline_1 (proc);
+ SCM_ASSERT (proc_tramp, proc, SCM_ARG1, FUNC_NAME);
- SCM_VALIDATE_PROC (1, proc);
clen = scm_to_size_t (len);
SCM_ASSERT_RANGE (2, len, clen >= 0);
@@ -230,7 +235,7 @@ SCM_DEFINE (scm_string_tabulate, "string-tabulate", 2, 0, 0,
/* The RES string remains untouched since nobody knows about it
yet. No need to refetch P.
*/
- ch = scm_call_1 (proc, scm_from_size_t (i));
+ ch = proc_tramp (proc, scm_from_size_t (i));
if (!SCM_CHARP (ch))
SCM_MISC_ERROR ("procedure ~S returned non-char", scm_list_1 (proc));
*p++ = SCM_CHAR (ch);
@@ -728,12 +733,14 @@ SCM_DEFINE (scm_string_trim, "string-trim", 1, 3, 0,
}
else
{
- SCM_VALIDATE_PROC (2, char_pred);
+ scm_t_trampoline_1 pred_tramp = scm_trampoline_1 (char_pred);
+ SCM_ASSERT (pred_tramp, char_pred, SCM_ARG2, FUNC_NAME);
+
while (cstart < cend)
{
SCM res;
- res = scm_call_1 (char_pred, SCM_MAKE_CHAR (cstr[cstart]));
+ res = pred_tramp (char_pred, SCM_MAKE_CHAR (cstr[cstart]));
if (scm_is_false (res))
break;
cstr = scm_i_string_chars (s);
@@ -804,12 +811,14 @@ SCM_DEFINE (scm_string_trim_right, "string-trim-right", 1, 3, 0,
}
else
{
- SCM_VALIDATE_PROC (2, char_pred);
+ scm_t_trampoline_1 pred_tramp = scm_trampoline_1 (char_pred);
+ SCM_ASSERT (pred_tramp, char_pred, SCM_ARG2, FUNC_NAME);
+
while (cstart < cend)
{
SCM res;
- res = scm_call_1 (char_pred, SCM_MAKE_CHAR (cstr[cend - 1]));
+ res = pred_tramp (char_pred, SCM_MAKE_CHAR (cstr[cend - 1]));
if (scm_is_false (res))
break;
cstr = scm_i_string_chars (s);
@@ -898,12 +907,14 @@ SCM_DEFINE (scm_string_trim_both, "string-trim-both", 1, 3, 0,
}
else
{
- SCM_VALIDATE_PROC (2, char_pred);
+ scm_t_trampoline_1 pred_tramp = scm_trampoline_1 (char_pred);
+ SCM_ASSERT (pred_tramp, char_pred, SCM_ARG2, FUNC_NAME);
+
while (cstart < cend)
{
SCM res;
- res = scm_call_1 (char_pred, SCM_MAKE_CHAR (cstr[cstart]));
+ res = pred_tramp (char_pred, SCM_MAKE_CHAR (cstr[cstart]));
if (scm_is_false (res))
break;
cstr = scm_i_string_chars (s);
@@ -913,7 +924,7 @@ SCM_DEFINE (scm_string_trim_both, "string-trim-both", 1, 3, 0,
{
SCM res;
- res = scm_call_1 (char_pred, SCM_MAKE_CHAR (cstr[cend - 1]));
+ res = pred_tramp (char_pred, SCM_MAKE_CHAR (cstr[cend - 1]));
if (scm_is_false (res))
break;
cstr = scm_i_string_chars (s);
@@ -1931,11 +1942,13 @@ SCM_DEFINE (scm_string_index, "string-index", 2, 2, 0,
}
else
{
- SCM_VALIDATE_PROC (2, char_pred);
+ scm_t_trampoline_1 pred_tramp = scm_trampoline_1 (char_pred);
+ SCM_ASSERT (pred_tramp, char_pred, SCM_ARG2, FUNC_NAME);
+
while (cstart < cend)
{
SCM res;
- res = scm_call_1 (char_pred, SCM_MAKE_CHAR (cstr[cstart]));
+ res = pred_tramp (char_pred, SCM_MAKE_CHAR (cstr[cstart]));
if (scm_is_true (res))
goto found;
cstr = scm_i_string_chars (s);
@@ -1996,12 +2009,14 @@ SCM_DEFINE (scm_string_index_right, "string-index-right", 2, 2, 0,
}
else
{
- SCM_VALIDATE_PROC (2, char_pred);
+ scm_t_trampoline_1 pred_tramp = scm_trampoline_1 (char_pred);
+ SCM_ASSERT (pred_tramp, char_pred, SCM_ARG2, FUNC_NAME);
+
while (cstart < cend)
{
SCM res;
cend--;
- res = scm_call_1 (char_pred, SCM_MAKE_CHAR (cstr[cend]));
+ res = pred_tramp (char_pred, SCM_MAKE_CHAR (cstr[cend]));
if (scm_is_true (res))
goto found;
cstr = scm_i_string_chars (s);
@@ -2083,11 +2098,13 @@ SCM_DEFINE (scm_string_skip, "string-skip", 2, 2, 0,
}
else
{
- SCM_VALIDATE_PROC (2, char_pred);
+ scm_t_trampoline_1 pred_tramp = scm_trampoline_1 (char_pred);
+ SCM_ASSERT (pred_tramp, char_pred, SCM_ARG2, FUNC_NAME);
+
while (cstart < cend)
{
SCM res;
- res = scm_call_1 (char_pred, SCM_MAKE_CHAR (cstr[cstart]));
+ res = pred_tramp (char_pred, SCM_MAKE_CHAR (cstr[cstart]));
if (scm_is_false (res))
goto found;
cstr = scm_i_string_chars (s);
@@ -2150,12 +2167,14 @@ SCM_DEFINE (scm_string_skip_right, "string-skip-right", 2, 2, 0,
}
else
{
- SCM_VALIDATE_PROC (2, char_pred);
+ scm_t_trampoline_1 pred_tramp = scm_trampoline_1 (char_pred);
+ SCM_ASSERT (pred_tramp, char_pred, SCM_ARG2, FUNC_NAME);
+
while (cstart < cend)
{
SCM res;
cend--;
- res = scm_call_1 (char_pred, SCM_MAKE_CHAR (cstr[cend]));
+ res = pred_tramp (char_pred, SCM_MAKE_CHAR (cstr[cend]));
if (scm_is_false (res))
goto found;
cstr = scm_i_string_chars (s);
@@ -2218,11 +2237,13 @@ SCM_DEFINE (scm_string_count, "string-count", 2, 2, 0,
}
else
{
- SCM_VALIDATE_PROC (2, char_pred);
+ scm_t_trampoline_1 pred_tramp = scm_trampoline_1 (char_pred);
+ SCM_ASSERT (pred_tramp, char_pred, SCM_ARG2, FUNC_NAME);
+
while (cstart < cend)
{
SCM res;
- res = scm_call_1 (char_pred, SCM_MAKE_CHAR (cstr[cstart]));
+ res = pred_tramp (char_pred, SCM_MAKE_CHAR (cstr[cstart]));
if (scm_is_true (res))
count++;
cstr = scm_i_string_chars (s);
@@ -2724,15 +2745,16 @@ SCM_DEFINE (scm_string_map, "string-map", 2, 2, 0,
char *p;
size_t cstart, cend;
SCM result;
+ scm_t_trampoline_1 proc_tramp = scm_trampoline_1 (proc);
- SCM_VALIDATE_PROC (1, proc);
+ SCM_ASSERT (proc_tramp, proc, SCM_ARG1, FUNC_NAME);
MY_VALIDATE_SUBSTRING_SPEC (2, s,
3, start, cstart,
4, end, cend);
result = scm_i_make_string (cend - cstart, &p);
while (cstart < cend)
{
- SCM ch = scm_call_1 (proc, scm_c_string_ref (s, cstart));
+ SCM ch = proc_tramp (proc, scm_c_string_ref (s, cstart));
if (!SCM_CHARP (ch))
SCM_MISC_ERROR ("procedure ~S returned non-char", scm_list_1 (proc));
cstart++;
@@ -2752,14 +2774,15 @@ SCM_DEFINE (scm_string_map_x, "string-map!", 2, 2, 0,
#define FUNC_NAME s_scm_string_map_x
{
size_t cstart, cend;
+ scm_t_trampoline_1 proc_tramp = scm_trampoline_1 (proc);
- SCM_VALIDATE_PROC (1, proc);
+ SCM_ASSERT (proc_tramp, proc, SCM_ARG1, FUNC_NAME);
MY_VALIDATE_SUBSTRING_SPEC (2, s,
3, start, cstart,
4, end, cend);
while (cstart < cend)
{
- SCM ch = scm_call_1 (proc, scm_c_string_ref (s, cstart));
+ SCM ch = proc_tramp (proc, scm_c_string_ref (s, cstart));
if (!SCM_CHARP (ch))
SCM_MISC_ERROR ("procedure ~S returned non-char", scm_list_1 (proc));
scm_c_string_set_x (s, cstart, ch);
@@ -2966,15 +2989,16 @@ SCM_DEFINE (scm_string_for_each, "string-for-each", 2, 2, 0,
{
const char *cstr;
size_t cstart, cend;
+ scm_t_trampoline_1 proc_tramp = scm_trampoline_1 (proc);
- SCM_VALIDATE_PROC (1, proc);
+ SCM_ASSERT (proc_tramp, proc, SCM_ARG1, FUNC_NAME);
MY_VALIDATE_SUBSTRING_SPEC_COPY (2, s, cstr,
3, start, cstart,
4, end, cend);
while (cstart < cend)
{
unsigned int c = (unsigned char) cstr[cstart];
- scm_call_1 (proc, SCM_MAKE_CHAR (c));
+ proc_tramp (proc, SCM_MAKE_CHAR (c));
cstr = scm_i_string_chars (s);
cstart++;
}
@@ -2991,15 +3015,16 @@ SCM_DEFINE (scm_string_for_each_index, "string-for-each-index", 2, 2, 0,
#define FUNC_NAME s_scm_string_for_each_index
{
size_t cstart, cend;
+ scm_t_trampoline_1 proc_tramp = scm_trampoline_1 (proc);
- SCM_VALIDATE_PROC (1, proc);
+ SCM_ASSERT (proc_tramp, proc, SCM_ARG1, FUNC_NAME);
MY_VALIDATE_SUBSTRING_SPEC (2, s,
3, start, cstart,
4, end, cend);
while (cstart < cend)
{
- scm_call_1 (proc, scm_from_size_t (cstart));
+ proc_tramp (proc, scm_from_size_t (cstart));
cstart++;
}
@@ -3349,14 +3374,15 @@ SCM_DEFINE (scm_string_filter, "string-filter", 2, 2, 0,
else
{
SCM ls = SCM_EOL;
+ scm_t_trampoline_1 pred_tramp = scm_trampoline_1 (char_pred);
- SCM_VALIDATE_PROC (2, char_pred);
+ SCM_ASSERT (pred_tramp, char_pred, SCM_ARG2, FUNC_NAME);
idx = cstart;
while (idx < cend)
{
SCM res, ch;
ch = SCM_MAKE_CHAR (cstr[idx]);
- res = scm_call_1 (char_pred, ch);
+ res = pred_tramp (char_pred, ch);
if (scm_is_true (res))
ls = scm_cons (ch, ls);
cstr = scm_i_string_chars (s);
@@ -3485,13 +3511,14 @@ SCM_DEFINE (scm_string_delete, "string-delete", 2, 2, 0,
else
{
SCM ls = SCM_EOL;
+ scm_t_trampoline_1 pred_tramp = scm_trampoline_1 (char_pred);
+ SCM_ASSERT (pred_tramp, char_pred, SCM_ARG2, FUNC_NAME);
- SCM_VALIDATE_PROC (2, char_pred);
idx = cstart;
while (idx < cend)
{
SCM res, ch = SCM_MAKE_CHAR (cstr[idx]);
- res = scm_call_1 (char_pred, ch);
+ res = pred_tramp (char_pred, ch);
if (scm_is_false (res))
ls = scm_cons (ch, ls);
cstr = scm_i_string_chars (s);