mirror/guile
mirror/guile
1
Fork 0
mirror of https://git.savannah.gnu.org/git/guile.git synced 2025-05-20 19:50:24 +02:00
Code Activity

(scm_string_any, scm_string_every, scm_string_tabulate,

Browse source 
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.
This commit is contained in:
Kevin Ryde 2005-08-06 01:44:30 +00:00
parent 514e4b24a9
commit 3540b91548
1 changed files with 62 additions and 35 deletions
Download patch file Download diff file Expand all files Collapse all files

97
libguile/srfi-13.c
View file

@ -120,11 +120,12 @@ SCM_DEFINE (scm_string_any, "string-any-c-code", 2, 2, 0,
} }
else 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) 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)) if (scm_is_true (res))
break; break;
cstr = scm_i_string_chars (s); cstr = scm_i_string_chars (s);
@ -188,11 +189,12 @@ SCM_DEFINE (scm_string_every, "string-every-c-code", 2, 2, 0,
} }
else 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) 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)) if (scm_is_false (res))
break; break;
cstr = scm_i_string_chars (s); cstr = scm_i_string_chars (s);
@ -218,8 +220,11 @@ SCM_DEFINE (scm_string_tabulate, "string-tabulate", 2, 0, 0,
SCM res; SCM res;
SCM ch; SCM ch;
char *p; 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); clen = scm_to_size_t (len);
SCM_ASSERT_RANGE (2, len, clen >= 0); 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 /* The RES string remains untouched since nobody knows about it
yet. No need to refetch P. 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)) if (!SCM_CHARP (ch))
SCM_MISC_ERROR ("procedure ~S returned non-char", scm_list_1 (proc)); SCM_MISC_ERROR ("procedure ~S returned non-char", scm_list_1 (proc));
*p++ = SCM_CHAR (ch); *p++ = SCM_CHAR (ch);
@ -728,12 +733,14 @@ SCM_DEFINE (scm_string_trim, "string-trim", 1, 3, 0,
} }
else 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) while (cstart < cend)
{ {
SCM res; 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)) if (scm_is_false (res))
break; break;
cstr = scm_i_string_chars (s); cstr = scm_i_string_chars (s);
@ -804,12 +811,14 @@ SCM_DEFINE (scm_string_trim_right, "string-trim-right", 1, 3, 0,
} }
else 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) while (cstart < cend)
{ {
SCM res; 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)) if (scm_is_false (res))
break; break;
cstr = scm_i_string_chars (s); cstr = scm_i_string_chars (s);
@ -898,12 +907,14 @@ SCM_DEFINE (scm_string_trim_both, "string-trim-both", 1, 3, 0,
} }
else 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) while (cstart < cend)
{ {
SCM res; 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)) if (scm_is_false (res))
break; break;
cstr = scm_i_string_chars (s); cstr = scm_i_string_chars (s);
@ -913,7 +924,7 @@ SCM_DEFINE (scm_string_trim_both, "string-trim-both", 1, 3, 0,
{ {
SCM res; 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)) if (scm_is_false (res))
break; break;
cstr = scm_i_string_chars (s); cstr = scm_i_string_chars (s);
@ -1931,11 +1942,13 @@ SCM_DEFINE (scm_string_index, "string-index", 2, 2, 0,
} }
else 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) while (cstart < cend)
{ {
SCM res; 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)) if (scm_is_true (res))
goto found; goto found;
cstr = scm_i_string_chars (s); cstr = scm_i_string_chars (s);
@ -1996,12 +2009,14 @@ SCM_DEFINE (scm_string_index_right, "string-index-right", 2, 2, 0,
} }
else 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) while (cstart < cend)
{ {
SCM res; SCM res;
cend--; 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)) if (scm_is_true (res))
goto found; goto found;
cstr = scm_i_string_chars (s); cstr = scm_i_string_chars (s);
@ -2083,11 +2098,13 @@ SCM_DEFINE (scm_string_skip, "string-skip", 2, 2, 0,
} }
else 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) while (cstart < cend)
{ {
SCM res; 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)) if (scm_is_false (res))
goto found; goto found;
cstr = scm_i_string_chars (s); cstr = scm_i_string_chars (s);
@ -2150,12 +2167,14 @@ SCM_DEFINE (scm_string_skip_right, "string-skip-right", 2, 2, 0,
} }
else 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) while (cstart < cend)
{ {
SCM res; SCM res;
cend--; 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)) if (scm_is_false (res))
goto found; goto found;
cstr = scm_i_string_chars (s); cstr = scm_i_string_chars (s);
@ -2218,11 +2237,13 @@ SCM_DEFINE (scm_string_count, "string-count", 2, 2, 0,
} }
else 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) while (cstart < cend)
{ {
SCM res; 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)) if (scm_is_true (res))
count++; count++;
cstr = scm_i_string_chars (s); cstr = scm_i_string_chars (s);
@ -2724,15 +2745,16 @@ SCM_DEFINE (scm_string_map, "string-map", 2, 2, 0,
char *p; char *p;
size_t cstart, cend; size_t cstart, cend;
SCM result; 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, MY_VALIDATE_SUBSTRING_SPEC (2, s,
3, start, cstart, 3, start, cstart,
4, end, cend); 4, end, cend);
result = scm_i_make_string (cend - cstart, &p); result = scm_i_make_string (cend - cstart, &p);
while (cstart < 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)) if (!SCM_CHARP (ch))
SCM_MISC_ERROR ("procedure ~S returned non-char", scm_list_1 (proc)); SCM_MISC_ERROR ("procedure ~S returned non-char", scm_list_1 (proc));
cstart++; cstart++;
@ -2752,14 +2774,15 @@ SCM_DEFINE (scm_string_map_x, "string-map!", 2, 2, 0,
#define FUNC_NAME s_scm_string_map_x #define FUNC_NAME s_scm_string_map_x
{ {
size_t cstart, cend; 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, MY_VALIDATE_SUBSTRING_SPEC (2, s,
3, start, cstart, 3, start, cstart,
4, end, cend); 4, end, cend);
while (cstart < 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)) if (!SCM_CHARP (ch))
SCM_MISC_ERROR ("procedure ~S returned non-char", scm_list_1 (proc)); SCM_MISC_ERROR ("procedure ~S returned non-char", scm_list_1 (proc));
scm_c_string_set_x (s, cstart, ch); 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; const char *cstr;
size_t cstart, cend; 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, MY_VALIDATE_SUBSTRING_SPEC_COPY (2, s, cstr,
3, start, cstart, 3, start, cstart,
4, end, cend); 4, end, cend);
while (cstart < cend) while (cstart < cend)
{ {
unsigned int c = (unsigned char) cstr[cstart]; 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); cstr = scm_i_string_chars (s);
cstart++; 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 #define FUNC_NAME s_scm_string_for_each_index
{ {
size_t cstart, cend; 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, MY_VALIDATE_SUBSTRING_SPEC (2, s,
3, start, cstart, 3, start, cstart,
4, end, cend); 4, end, cend);
while (cstart < cend) while (cstart < cend)
{ {
scm_call_1 (proc, scm_from_size_t (cstart)); proc_tramp (proc, scm_from_size_t (cstart));
cstart++; cstart++;
} }
@ -3349,14 +3374,15 @@ SCM_DEFINE (scm_string_filter, "string-filter", 2, 2, 0,
else else
{ {
SCM ls = SCM_EOL; 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; idx = cstart;
while (idx < cend) while (idx < cend)
{ {
SCM res, ch; SCM res, ch;
ch = SCM_MAKE_CHAR (cstr[idx]); ch = SCM_MAKE_CHAR (cstr[idx]);
res = scm_call_1 (char_pred, ch); res = pred_tramp (char_pred, ch);
if (scm_is_true (res)) if (scm_is_true (res))
ls = scm_cons (ch, ls); ls = scm_cons (ch, ls);
cstr = scm_i_string_chars (s); cstr = scm_i_string_chars (s);
@ -3485,13 +3511,14 @@ SCM_DEFINE (scm_string_delete, "string-delete", 2, 2, 0,
else else
{ {
SCM ls = SCM_EOL; 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; idx = cstart;
while (idx < cend) while (idx < cend)
{ {
SCM res, ch = SCM_MAKE_CHAR (cstr[idx]); 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)) if (scm_is_false (res))
ls = scm_cons (ch, ls); ls = scm_cons (ch, ls);
cstr = scm_i_string_chars (s); cstr = scm_i_string_chars (s);