mirror/guile
mirror/guile
1
Fork 0
mirror of https://git.savannah.gnu.org/git/guile.git synced 2025-06-10 14:00:21 +02:00
Code Activity

remove uses of trampolines within guile itself

Browse source 
* libguile/eval.c (scm_map, scm_for_each)
* libguile/hashtab.c (scm_hash_for_each_handle)
* libguile/list.c (scm_filter, scm_filter_x)
* libguile/quicksort.i.c:
* libguile/sort.c (scm_restricted_vector_sort_x, scm_sorted_p)
  (scm_merge, scm_merge_list_x, scm_merge_x)
  (scm_merge_list_step, scm_sort_x, scm_sort, scm_merge_vector_x)
  (scm_merge_vector_step, scm_stable_sort_x, scm_sort_list_x)
  (scm_sort_list)nn
* libguile/srfi-13.c (scm_string_any, scm_string_every)
  (scm_string_tabulate, scm_string_trim, 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):
  Remove uses of trampolines.
This commit is contained in:
Andy Wingo 2009-11-27 18:13:59 +01:00
parent b3f04491ee
commit 6c9e8a5354
6 changed files with 101 additions and 126 deletions
Download patch file Download diff file Expand all files Collapse all files

23
libguile/eval.c
View file

@ -3268,11 +3268,10 @@ scm_map (SCM proc, SCM arg1, SCM args)
SCM_VALIDATE_REST_ARGUMENT (args);
if (scm_is_null (args))
{
scm_t_trampoline_1 call = scm_trampoline_1 (proc);
SCM_GASSERT2 (call, g_map, proc, arg1, SCM_ARG1, s_map);
SCM_GASSERT2 (scm_is_true (scm_procedure_p (proc)), g_map, proc, arg1, SCM_ARG1, s_map);
while (SCM_NIMP (arg1))
{
*pres = scm_list_1 (call (proc, SCM_CAR (arg1)));
*pres = scm_list_1 (scm_call_1 (proc, SCM_CAR (arg1)));
pres = SCM_CDRLOC (*pres);
arg1 = SCM_CDR (arg1);
}
@ -3282,16 +3281,15 @@ scm_map (SCM proc, SCM arg1, SCM args)
{
SCM arg2 = SCM_CAR (args);
int len2 = scm_ilength (arg2);
scm_t_trampoline_2 call = scm_trampoline_2 (proc);
SCM_GASSERTn (call,
g_map, scm_cons2 (proc, arg1, args), SCM_ARG1, s_map);
SCM_GASSERTn (scm_is_true (scm_procedure_p (proc)), g_map,
scm_cons2 (proc, arg1, args), SCM_ARG1, s_map);
SCM_GASSERTn (len2 >= 0,
g_map, scm_cons2 (proc, arg1, args), SCM_ARG3, s_map);
if (len2 != len)
SCM_OUT_OF_RANGE (3, arg2);
while (SCM_NIMP (arg1))
{
*pres = scm_list_1 (call (proc, SCM_CAR (arg1), SCM_CAR (arg2)));
*pres = scm_list_1 (scm_call_2 (proc, SCM_CAR (arg1), SCM_CAR (arg2)));
pres = SCM_CDRLOC (*pres);
arg1 = SCM_CDR (arg1);
arg2 = SCM_CDR (arg2);
@ -3332,11 +3330,11 @@ scm_for_each (SCM proc, SCM arg1, SCM args)
SCM_VALIDATE_REST_ARGUMENT (args);
if (scm_is_null (args))
{
scm_t_trampoline_1 call = scm_trampoline_1 (proc);
SCM_GASSERT2 (call, g_for_each, proc, arg1, SCM_ARG1, s_for_each);
SCM_GASSERT2 (scm_is_true (scm_procedure_p (proc)), g_for_each,
proc, arg1, SCM_ARG1, s_for_each);
while (SCM_NIMP (arg1))
{
call (proc, SCM_CAR (arg1));
scm_call_1 (proc, SCM_CAR (arg1));
arg1 = SCM_CDR (arg1);
}
return SCM_UNSPECIFIED;
@ -3345,8 +3343,7 @@ scm_for_each (SCM proc, SCM arg1, SCM args)
{
SCM arg2 = SCM_CAR (args);
int len2 = scm_ilength (arg2);
scm_t_trampoline_2 call = scm_trampoline_2 (proc);
SCM_GASSERTn (call, g_for_each,
SCM_GASSERTn (scm_is_true (scm_procedure_p (proc)), g_for_each,
scm_cons2 (proc, arg1, args), SCM_ARG1, s_for_each);
SCM_GASSERTn (len2 >= 0, g_for_each,
scm_cons2 (proc, arg1, args), SCM_ARG3, s_for_each);
@ -3354,7 +3351,7 @@ scm_for_each (SCM proc, SCM arg1, SCM args)
SCM_OUT_OF_RANGE (3, arg2);
while (SCM_NIMP (arg1))
{
call (proc, SCM_CAR (arg1), SCM_CAR (arg2));
scm_call_2 (proc, SCM_CAR (arg1), SCM_CAR (arg2));
arg1 = SCM_CDR (arg1);
arg2 = SCM_CDR (arg2);
}

5
libguile/hashtab.c
View file

@ -1220,12 +1220,11 @@ SCM_DEFINE (scm_hash_for_each_handle, "hash-for-each-handle", 2, 0, 0,
"Applies PROC successively on all hash table handles.")
#define FUNC_NAME s_scm_hash_for_each_handle
{
scm_t_trampoline_1 call = scm_trampoline_1 (proc);
SCM_ASSERT (call, proc, 1, FUNC_NAME);
SCM_ASSERT (scm_is_true (scm_procedure_p (proc)), proc, 1, FUNC_NAME);
if (!SCM_HASHTABLE_P (table))
SCM_VALIDATE_VECTOR (2, table);
scm_internal_hash_for_each_handle ((scm_t_hash_handle_fn) call,
scm_internal_hash_for_each_handle ((scm_t_hash_handle_fn) scm_call_1,
(void *) SCM_UNPACK (proc),
table);
return SCM_UNSPECIFIED;

12
libguile/list.c
View file

@ -1,4 +1,4 @@
/* Copyright (C) 1995,1996,1997,2000,2001,2003,2004,2008
/* Copyright (C) 1995,1996,1997,2000,2001,2003,2004,2008,2009
* Free Software Foundation, Inc.
*
* This library is free software; you can redistribute it and/or
@ -885,18 +885,17 @@ SCM_DEFINE (scm_filter, "filter", 2, 0, 0,
"@end lisp")
#define FUNC_NAME s_scm_filter
{
scm_t_trampoline_1 call = scm_trampoline_1 (pred);
SCM walk;
SCM *prev;
SCM res = SCM_EOL;
SCM_ASSERT (call, pred, 1, FUNC_NAME);
SCM_ASSERT (scm_is_true (scm_procedure_p (pred)), pred, 1, FUNC_NAME);
SCM_VALIDATE_LIST (2, list);
for (prev = &res, walk = list;
scm_is_pair (walk);
walk = SCM_CDR (walk))
{
if (scm_is_true (call (pred, SCM_CAR (walk))))
if (scm_is_true (scm_call_1 (pred, SCM_CAR (walk))))
{
*prev = scm_cons (SCM_CAR (walk), SCM_EOL);
prev = SCM_CDRLOC (*prev);
@ -912,17 +911,16 @@ SCM_DEFINE (scm_filter_x, "filter!", 2, 0, 0,
"Linear-update variant of @code{filter}.")
#define FUNC_NAME s_scm_filter_x
{
scm_t_trampoline_1 call = scm_trampoline_1 (pred);
SCM walk;
SCM *prev;
SCM_ASSERT (call, pred, 1, FUNC_NAME);
SCM_ASSERT (scm_is_true (scm_procedure_p (pred)), pred, 1, FUNC_NAME);
SCM_VALIDATE_LIST (2, list);
for (prev = &list, walk = list;
scm_is_pair (walk);
walk = SCM_CDR (walk))
{
if (scm_is_true (call (pred, SCM_CAR (walk))))
if (scm_is_true (scm_call_1 (pred, SCM_CAR (walk))))
prev = SCM_CDRLOC (walk);
else
*prev = SCM_CDR (walk);

16
libguile/quicksort.i.c
View file

@ -55,7 +55,7 @@
static void
NAME (SCM *const base_ptr, size_t nr_elems, INC_PARAM
scm_t_trampoline_2 cmp, SCM less)
SCM less)
{
/* Stack node declarations used to store unfulfilled partition obligations. */
typedef struct {
@ -93,13 +93,13 @@ NAME (SCM *const base_ptr, size_t nr_elems, INC_PARAM
SCM_TICK;
if (scm_is_true ((*cmp) (less, ELT(mid), ELT(lo))))
if (scm_is_true (scm_call_2 (less, ELT(mid), ELT(lo))))
SWAP (ELT(mid), ELT(lo));
if (scm_is_true ((*cmp) (less, ELT(hi), ELT(mid))))
if (scm_is_true (scm_call_2 (less, ELT(hi), ELT(mid))))
SWAP (ELT(mid), ELT(hi));
else
goto jump_over;
if (scm_is_true ((*cmp) (less, ELT(mid), ELT(lo))))
if (scm_is_true (scm_call_2 (less, ELT(mid), ELT(lo))))
SWAP (ELT(mid), ELT(lo));
jump_over:;
@ -112,7 +112,7 @@ NAME (SCM *const base_ptr, size_t nr_elems, INC_PARAM
that this algorithm runs much faster than others. */
do
{
while (scm_is_true ((*cmp) (less, ELT(left), pivot)))
while (scm_is_true (scm_call_2 (less, ELT(left), pivot)))
{
left += 1;
/* The comparison predicate may be buggy */
@ -120,7 +120,7 @@ NAME (SCM *const base_ptr, size_t nr_elems, INC_PARAM
scm_misc_error (NULL, s_buggy_less, SCM_EOL);
}
while (scm_is_true ((*cmp) (less, pivot, ELT(right))))
while (scm_is_true (scm_call_2 (less, pivot, ELT(right))))
{
right -= 1;
/* The comparison predicate may be buggy */
@ -192,7 +192,7 @@ NAME (SCM *const base_ptr, size_t nr_elems, INC_PARAM
and the operation speeds up insertion sort's inner loop. */
for (run = tmp + 1; run <= thresh; run += 1)
if (scm_is_true ((*cmp) (less, ELT(run), ELT(tmp))))
if (scm_is_true (scm_call_2 (less, ELT(run), ELT(tmp))))
tmp = run;
if (tmp != 0)
@ -206,7 +206,7 @@ NAME (SCM *const base_ptr, size_t nr_elems, INC_PARAM
SCM_TICK;
tmp = run - 1;
while (scm_is_true ((*cmp) (less, ELT(run), ELT(tmp))))
while (scm_is_true (scm_call_2 (less, ELT(run), ELT(tmp))))
{
/* The comparison predicate may be buggy */
if (tmp == 0)

66
libguile/sort.c
View file

@ -65,14 +65,6 @@
#define INC inc
#include "libguile/quicksort.i.c"
static scm_t_trampoline_2
compare_function (SCM less, unsigned int arg_nr, const char* fname)
{
const scm_t_trampoline_2 cmp = scm_trampoline_2 (less);
SCM_ASSERT_TYPE (cmp != NULL, less, arg_nr, fname, "less predicate");
return cmp;
}
SCM_DEFINE (scm_restricted_vector_sort_x, "restricted-vector-sort!", 4, 0, 0,
(SCM vec, SCM less, SCM startpos, SCM endpos),
@ -83,7 +75,6 @@ SCM_DEFINE (scm_restricted_vector_sort_x, "restricted-vector-sort!", 4, 0, 0,
"is not specified.")
#define FUNC_NAME s_scm_restricted_vector_sort_x
{
const scm_t_trampoline_2 cmp = compare_function (less, 2, FUNC_NAME);
size_t vlen, spos, len;
ssize_t vinc;
scm_t_array_handle handle;
@ -94,9 +85,9 @@ SCM_DEFINE (scm_restricted_vector_sort_x, "restricted-vector-sort!", 4, 0, 0,
len = scm_to_unsigned_integer (endpos, spos, vlen) - spos;
if (vinc == 1)
quicksort1 (velts + spos*vinc, len, cmp, less);
quicksort1 (velts + spos*vinc, len, less);
else
quicksort (velts + spos*vinc, len, vinc, cmp, less);
quicksort (velts + spos*vinc, len, vinc, less);
scm_array_handle_release (&handle);
@ -116,7 +107,6 @@ SCM_DEFINE (scm_sorted_p, "sorted?", 2, 0, 0,
"applied to all elements i - 1 and i")
#define FUNC_NAME s_scm_sorted_p
{
const scm_t_trampoline_2 cmp = compare_function (less, 2, FUNC_NAME);
long len, j; /* list/vector length, temp j */
SCM item, rest; /* rest of items loop variable */
@ -135,7 +125,7 @@ SCM_DEFINE (scm_sorted_p, "sorted?", 2, 0, 0,
j = len - 1;
while (j > 0)
{
if (scm_is_true ((*cmp) (less, SCM_CAR (rest), item)))
if (scm_is_true (scm_call_2 (less, SCM_CAR (rest), item)))
return SCM_BOOL_F;
else
{
@ -158,7 +148,7 @@ SCM_DEFINE (scm_sorted_p, "sorted?", 2, 0, 0,
for (i = 1; i < len; i++, elts += inc)
{
if (scm_is_true ((*cmp) (less, elts[inc], elts[0])))
if (scm_is_true (scm_call_2 (less, elts[inc], elts[0])))
{
result = SCM_BOOL_F;
break;
@ -199,13 +189,12 @@ SCM_DEFINE (scm_merge, "merge", 3, 0, 0,
return alist;
else
{
const scm_t_trampoline_2 cmp = compare_function (less, 3, FUNC_NAME);
long alen, blen; /* list lengths */
SCM last;
SCM_VALIDATE_NONEMPTYLIST_COPYLEN (1, alist, alen);
SCM_VALIDATE_NONEMPTYLIST_COPYLEN (2, blist, blen);
if (scm_is_true ((*cmp) (less, SCM_CAR (blist), SCM_CAR (alist))))
if (scm_is_true (scm_call_2 (less, SCM_CAR (blist), SCM_CAR (alist))))
{
build = scm_cons (SCM_CAR (blist), SCM_EOL);
blist = SCM_CDR (blist);
@ -221,7 +210,7 @@ SCM_DEFINE (scm_merge, "merge", 3, 0, 0,
while ((alen > 0) && (blen > 0))
{
SCM_TICK;
if (scm_is_true ((*cmp) (less, SCM_CAR (blist), SCM_CAR (alist))))
if (scm_is_true (scm_call_2 (less, SCM_CAR (blist), SCM_CAR (alist))))
{
SCM_SETCDR (last, scm_cons (SCM_CAR (blist), SCM_EOL));
blist = SCM_CDR (blist);
@ -248,7 +237,7 @@ SCM_DEFINE (scm_merge, "merge", 3, 0, 0,
static SCM
scm_merge_list_x (SCM alist, SCM blist,
long alen, long blen,
scm_t_trampoline_2 cmp, SCM less)
SCM less)
{
SCM build, last;
@ -258,7 +247,7 @@ scm_merge_list_x (SCM alist, SCM blist,
return alist;
else
{
if (scm_is_true ((*cmp) (less, SCM_CAR (blist), SCM_CAR (alist))))
if (scm_is_true (scm_call_2 (less, SCM_CAR (blist), SCM_CAR (alist))))
{
build = blist;
blist = SCM_CDR (blist);
@ -274,7 +263,7 @@ scm_merge_list_x (SCM alist, SCM blist,
while ((alen > 0) && (blen > 0))
{
SCM_TICK;
if (scm_is_true ((*cmp) (less, SCM_CAR (blist), SCM_CAR (alist))))
if (scm_is_true (scm_call_2 (less, SCM_CAR (blist), SCM_CAR (alist))))
{
SCM_SETCDR (last, blist);
blist = SCM_CDR (blist);
@ -314,11 +303,10 @@ SCM_DEFINE (scm_merge_x, "merge!", 3, 0, 0,
return alist;
else
{
const scm_t_trampoline_2 cmp = compare_function (less, 3, FUNC_NAME);
long alen, blen; /* list lengths */
SCM_VALIDATE_NONEMPTYLIST_COPYLEN (1, alist, alen);
SCM_VALIDATE_NONEMPTYLIST_COPYLEN (2, blist, blen);
return scm_merge_list_x (alist, blist, alen, blen, cmp, less);
return scm_merge_list_x (alist, blist, alen, blen, less);
}
}
#undef FUNC_NAME
@ -330,7 +318,7 @@ SCM_DEFINE (scm_merge_x, "merge!", 3, 0, 0,
though it claimed to be.
*/
static SCM
scm_merge_list_step (SCM * seq, scm_t_trampoline_2 cmp, SCM less, long n)
scm_merge_list_step (SCM * seq, SCM less, long n)
{
SCM a, b;
@ -338,9 +326,9 @@ scm_merge_list_step (SCM * seq, scm_t_trampoline_2 cmp, SCM less, long n)
{
long mid = n / 2;
SCM_TICK;
a = scm_merge_list_step (seq, cmp, less, mid);
b = scm_merge_list_step (seq, cmp, less, n - mid);
return scm_merge_list_x (a, b, mid, n - mid, cmp, less);
a = scm_merge_list_step (seq, less, mid);
b = scm_merge_list_step (seq, less, n - mid);
return scm_merge_list_x (a, b, mid, n - mid, less);
}
else if (n == 2)
{
@ -350,7 +338,7 @@ scm_merge_list_step (SCM * seq, scm_t_trampoline_2 cmp, SCM less, long n)
SCM y = SCM_CAR (SCM_CDR (*seq));
*seq = SCM_CDR (rest);
SCM_SETCDR (rest, SCM_EOL);
if (scm_is_true ((*cmp) (less, y, x)))
if (scm_is_true (scm_call_2 (less, y, x)))
{
SCM_SETCAR (p, y);
SCM_SETCAR (rest, x);
@ -384,9 +372,8 @@ SCM_DEFINE (scm_sort_x, "sort!", 2, 0, 0,
if (scm_is_pair (items))
{
const scm_t_trampoline_2 cmp = compare_function (less, 2, FUNC_NAME);
SCM_VALIDATE_LIST_COPYLEN (1, items, len);
return scm_merge_list_step (&items, cmp, less, len);
return scm_merge_list_step (&items, less, len);
}
else if (scm_is_vector (items))
{
@ -425,7 +412,6 @@ SCM_DEFINE (scm_sort, "sort", 2, 0, 0,
static void
scm_merge_vector_x (SCM *vec,
SCM *temp,
scm_t_trampoline_2 cmp,
SCM less,
size_t low,
size_t mid,
@ -441,7 +427,7 @@ scm_merge_vector_x (SCM *vec,
/* Copy while both segments contain more characters */
for (it = low; (i1 <= mid) && (i2 <= high); ++it)
{
if (scm_is_true ((*cmp) (less, VEC(i2), VEC(i1))))
if (scm_is_true (scm_call_2 (less, VEC(i2), VEC(i1))))
temp[it] = VEC(i2++);
else
temp[it] = VEC(i1++);
@ -466,7 +452,6 @@ scm_merge_vector_x (SCM *vec,
static void
scm_merge_vector_step (SCM *vec,
SCM *temp,
scm_t_trampoline_2 cmp,
SCM less,
size_t low,
size_t high,
@ -476,9 +461,9 @@ scm_merge_vector_step (SCM *vec,
{
size_t mid = (low + high) / 2;
SCM_TICK;
scm_merge_vector_step (vec, temp, cmp, less, low, mid, inc);
scm_merge_vector_step (vec, temp, cmp, less, mid+1, high, inc);
scm_merge_vector_x (vec, temp, cmp, less, low, mid, high, inc);
scm_merge_vector_step (vec, temp, less, low, mid, inc);
scm_merge_vector_step (vec, temp, less, mid+1, high, inc);
scm_merge_vector_x (vec, temp, less, low, mid, high, inc);
}
} /* scm_merge_vector_step */
@ -492,7 +477,6 @@ SCM_DEFINE (scm_stable_sort_x, "stable-sort!", 2, 0, 0,
"This is a stable sort.")
#define FUNC_NAME s_scm_stable_sort_x
{
const scm_t_trampoline_2 cmp = compare_function (less, 2, FUNC_NAME);
long len; /* list/vector length */
if (SCM_NULL_OR_NIL_P (items))
@ -501,7 +485,7 @@ SCM_DEFINE (scm_stable_sort_x, "stable-sort!", 2, 0, 0,
if (scm_is_pair (items))
{
SCM_VALIDATE_LIST_COPYLEN (1, items, len);
return scm_merge_list_step (&items, cmp, less, len);
return scm_merge_list_step (&items, less, len);
}
else if (scm_is_vector (items))
{
@ -516,7 +500,7 @@ SCM_DEFINE (scm_stable_sort_x, "stable-sort!", 2, 0, 0,
temp_elts = scm_vector_writable_elements (temp, &temp_handle,
NULL, NULL);
scm_merge_vector_step (vec_elts, temp_elts, cmp, less, 0, len-1, inc);
scm_merge_vector_step (vec_elts, temp_elts, less, 0, len-1, inc);
scm_array_handle_release (&temp_handle);
scm_array_handle_release (&vec_handle);
@ -557,11 +541,10 @@ SCM_DEFINE (scm_sort_list_x, "sort-list!", 2, 0, 0,
"This is a stable sort.")
#define FUNC_NAME s_scm_sort_list_x
{
const scm_t_trampoline_2 cmp = compare_function (less, 2, FUNC_NAME);
long len;
SCM_VALIDATE_LIST_COPYLEN (1, items, len);
return scm_merge_list_step (&items, cmp, less, len);
return scm_merge_list_step (&items, less, len);
}
#undef FUNC_NAME
@ -572,12 +555,11 @@ SCM_DEFINE (scm_sort_list, "sort-list", 2, 0, 0,
"list elements. This is a stable sort.")
#define FUNC_NAME s_scm_sort_list
{
const scm_t_trampoline_2 cmp = compare_function (less, 2, FUNC_NAME);
long len;
SCM_VALIDATE_LIST_COPYLEN (1, items, len);
items = scm_list_copy (items);
return scm_merge_list_step (&items, cmp, less, len);
return scm_merge_list_step (&items, less, len);
}
#undef FUNC_NAME

105
libguile/srfi-13.c
View file

@ -125,12 +125,12 @@ SCM_DEFINE (scm_string_any, "string-any-c-code", 2, 2, 0,
}
else
{
scm_t_trampoline_1 pred_tramp = scm_trampoline_1 (char_pred);
SCM_ASSERT (pred_tramp, char_pred, SCM_ARG1, FUNC_NAME);
SCM_ASSERT (scm_is_true (scm_procedure_p (char_pred)),
char_pred, SCM_ARG1, FUNC_NAME);
while (cstart < cend)
{
res = pred_tramp (char_pred,
res = scm_call_1 (char_pred,
SCM_MAKE_CHAR (scm_i_string_ref (s, cstart)));
if (scm_is_true (res))
break;
@ -192,12 +192,12 @@ SCM_DEFINE (scm_string_every, "string-every-c-code", 2, 2, 0,
}
else
{
scm_t_trampoline_1 pred_tramp = scm_trampoline_1 (char_pred);
SCM_ASSERT (pred_tramp, char_pred, SCM_ARG1, FUNC_NAME);
SCM_ASSERT (scm_is_true (scm_procedure_p (char_pred)),
char_pred, SCM_ARG1, FUNC_NAME);
while (cstart < cend)
{
res = pred_tramp (char_pred,
res = scm_call_1 (char_pred,
SCM_MAKE_CHAR (scm_i_string_ref (s, cstart)));
if (scm_is_false (res))
break;
@ -222,10 +222,9 @@ SCM_DEFINE (scm_string_tabulate, "string-tabulate", 2, 0, 0,
size_t clen, i;
SCM res;
SCM ch;
scm_t_trampoline_1 proc_tramp;
proc_tramp = scm_trampoline_1 (proc);
SCM_ASSERT (proc_tramp, proc, SCM_ARG1, FUNC_NAME);
SCM_ASSERT (scm_is_true (scm_procedure_p (proc)),
proc, SCM_ARG1, FUNC_NAME);
SCM_ASSERT_RANGE (2, len, scm_to_int (len) >= 0);
clen = scm_to_size_t (len);
@ -238,7 +237,7 @@ SCM_DEFINE (scm_string_tabulate, "string-tabulate", 2, 0, 0,
i = 0;
while (i < clen)
{
ch = proc_tramp (proc, scm_from_size_t (i));
ch = scm_call_1 (proc, scm_from_size_t (i));
if (!SCM_CHARP (ch))
{
SCM_MISC_ERROR ("procedure ~S returned non-char", scm_list_1 (proc));
@ -745,14 +744,14 @@ SCM_DEFINE (scm_string_trim, "string-trim", 1, 3, 0,
}
else
{
scm_t_trampoline_1 pred_tramp = scm_trampoline_1 (char_pred);
SCM_ASSERT (pred_tramp, char_pred, SCM_ARG2, FUNC_NAME);
SCM_ASSERT (scm_is_true (scm_procedure_p (char_pred)),
char_pred, SCM_ARG2, FUNC_NAME);
while (cstart < cend)
{
SCM res;
res = pred_tramp (char_pred, SCM_MAKE_CHAR (scm_i_string_ref (s, cstart)));
res = scm_call_1 (char_pred, SCM_MAKE_CHAR (scm_i_string_ref (s, cstart)));
if (scm_is_false (res))
break;
cstart++;
@ -820,14 +819,14 @@ SCM_DEFINE (scm_string_trim_right, "string-trim-right", 1, 3, 0,
}
else
{
scm_t_trampoline_1 pred_tramp = scm_trampoline_1 (char_pred);
SCM_ASSERT (pred_tramp, char_pred, SCM_ARG2, FUNC_NAME);
SCM_ASSERT (scm_is_true (scm_procedure_p (char_pred)),
char_pred, SCM_ARG2, FUNC_NAME);
while (cstart < cend)
{
SCM res;
res = pred_tramp (char_pred, SCM_MAKE_CHAR (scm_i_string_ref (s, cend - 1)));
res = scm_call_1 (char_pred, SCM_MAKE_CHAR (scm_i_string_ref (s, cend - 1)));
if (scm_is_false (res))
break;
cend--;
@ -913,14 +912,14 @@ SCM_DEFINE (scm_string_trim_both, "string-trim-both", 1, 3, 0,
}
else
{
scm_t_trampoline_1 pred_tramp = scm_trampoline_1 (char_pred);
SCM_ASSERT (pred_tramp, char_pred, SCM_ARG2, FUNC_NAME);
SCM_ASSERT (scm_is_true (scm_procedure_p (char_pred)),
char_pred, SCM_ARG2, FUNC_NAME);
while (cstart < cend)
{
SCM res;
res = pred_tramp (char_pred, SCM_MAKE_CHAR (scm_i_string_ref (s, cstart)));
res = scm_call_1 (char_pred, SCM_MAKE_CHAR (scm_i_string_ref (s, cstart)));
if (scm_is_false (res))
break;
cstart++;
@ -929,7 +928,7 @@ SCM_DEFINE (scm_string_trim_both, "string-trim-both", 1, 3, 0,
{
SCM res;
res = pred_tramp (char_pred, SCM_MAKE_CHAR (scm_i_string_ref (s, cend - 1)));
res = scm_call_1 (char_pred, SCM_MAKE_CHAR (scm_i_string_ref (s, cend - 1)));
if (scm_is_false (res))
break;
cend--;
@ -1656,13 +1655,13 @@ SCM_DEFINE (scm_string_index, "string-index", 2, 2, 0,
}
else
{
scm_t_trampoline_1 pred_tramp = scm_trampoline_1 (char_pred);
SCM_ASSERT (pred_tramp, char_pred, SCM_ARG2, FUNC_NAME);
SCM_ASSERT (scm_is_true (scm_procedure_p (char_pred)),
char_pred, SCM_ARG2, FUNC_NAME);
while (cstart < cend)
{
SCM res;
res = pred_tramp (char_pred, SCM_MAKE_CHAR (scm_i_string_ref (s, cstart)));
res = scm_call_1 (char_pred, SCM_MAKE_CHAR (scm_i_string_ref (s, cstart)));
if (scm_is_true (res))
goto found;
cstart++;
@ -1720,14 +1719,14 @@ SCM_DEFINE (scm_string_index_right, "string-index-right", 2, 2, 0,
}
else
{
scm_t_trampoline_1 pred_tramp = scm_trampoline_1 (char_pred);
SCM_ASSERT (pred_tramp, char_pred, SCM_ARG2, FUNC_NAME);
SCM_ASSERT (scm_is_true (scm_procedure_p (char_pred)),
char_pred, SCM_ARG2, FUNC_NAME);
while (cstart < cend)
{
SCM res;
cend--;
res = pred_tramp (char_pred, SCM_MAKE_CHAR (scm_i_string_ref (s, cend)));
res = scm_call_1 (char_pred, SCM_MAKE_CHAR (scm_i_string_ref (s, cend)));
if (scm_is_true (res))
goto found;
}
@ -1806,13 +1805,13 @@ SCM_DEFINE (scm_string_skip, "string-skip", 2, 2, 0,
}
else
{
scm_t_trampoline_1 pred_tramp = scm_trampoline_1 (char_pred);
SCM_ASSERT (pred_tramp, char_pred, SCM_ARG2, FUNC_NAME);
SCM_ASSERT (scm_is_true (scm_procedure_p (char_pred)),
char_pred, SCM_ARG2, FUNC_NAME);
while (cstart < cend)
{
SCM res;
res = pred_tramp (char_pred, SCM_MAKE_CHAR (scm_i_string_ref (s, cstart)));
res = scm_call_1 (char_pred, SCM_MAKE_CHAR (scm_i_string_ref (s, cstart)));
if (scm_is_false (res))
goto found;
cstart++;
@ -1872,14 +1871,14 @@ SCM_DEFINE (scm_string_skip_right, "string-skip-right", 2, 2, 0,
}
else
{
scm_t_trampoline_1 pred_tramp = scm_trampoline_1 (char_pred);
SCM_ASSERT (pred_tramp, char_pred, SCM_ARG2, FUNC_NAME);
SCM_ASSERT (scm_is_true (scm_procedure_p (char_pred)),
char_pred, SCM_ARG2, FUNC_NAME);
while (cstart < cend)
{
SCM res;
cend--;
res = pred_tramp (char_pred, SCM_MAKE_CHAR (scm_i_string_ref (s, cend)));
res = scm_call_1 (char_pred, SCM_MAKE_CHAR (scm_i_string_ref (s, cend)));
if (scm_is_false (res))
goto found;
}
@ -1939,13 +1938,13 @@ SCM_DEFINE (scm_string_count, "string-count", 2, 2, 0,
}
else
{
scm_t_trampoline_1 pred_tramp = scm_trampoline_1 (char_pred);
SCM_ASSERT (pred_tramp, char_pred, SCM_ARG2, FUNC_NAME);
SCM_ASSERT (scm_is_true (scm_procedure_p (char_pred)),
char_pred, SCM_ARG2, FUNC_NAME);
while (cstart < cend)
{
SCM res;
res = pred_tramp (char_pred, SCM_MAKE_CHAR (scm_i_string_ref (s, cstart)));
res = scm_call_1 (char_pred, SCM_MAKE_CHAR (scm_i_string_ref (s, cstart)));
if (scm_is_true (res))
count++;
cstart++;
@ -2452,9 +2451,9 @@ SCM_DEFINE (scm_string_map, "string-map", 2, 2, 0,
size_t p;
size_t cstart, cend;
SCM result;
scm_t_trampoline_1 proc_tramp = scm_trampoline_1 (proc);
SCM_ASSERT (proc_tramp, proc, SCM_ARG1, FUNC_NAME);
SCM_ASSERT (scm_is_true (scm_procedure_p (proc)),
proc, SCM_ARG1, FUNC_NAME);
MY_VALIDATE_SUBSTRING_SPEC (2, s,
3, start, cstart,
4, end, cend);
@ -2462,7 +2461,7 @@ SCM_DEFINE (scm_string_map, "string-map", 2, 2, 0,
p = 0;
while (cstart < cend)
{
SCM ch = proc_tramp (proc, scm_c_string_ref (s, cstart));
SCM ch = scm_call_1 (proc, scm_c_string_ref (s, cstart));
if (!SCM_CHARP (ch))
SCM_MISC_ERROR ("procedure ~S returned non-char", scm_list_1 (proc));
cstart++;
@ -2486,15 +2485,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_ASSERT (proc_tramp, proc, SCM_ARG1, FUNC_NAME);
SCM_ASSERT (scm_is_true (scm_procedure_p (proc)),
proc, SCM_ARG1, FUNC_NAME);
MY_VALIDATE_SUBSTRING_SPEC (2, s,
3, start, cstart,
4, end, cend);
while (cstart < cend)
{
SCM ch = proc_tramp (proc, scm_c_string_ref (s, cstart));
SCM ch = scm_call_1 (proc, scm_c_string_ref (s, cstart));
if (!SCM_CHARP (ch))
SCM_MISC_ERROR ("procedure ~S returned non-char", scm_list_1 (proc));
s = scm_i_string_start_writing (s);
@ -2702,15 +2701,15 @@ SCM_DEFINE (scm_string_for_each, "string-for-each", 2, 2, 0,
#define FUNC_NAME s_scm_string_for_each
{
size_t cstart, cend;
scm_t_trampoline_1 proc_tramp = scm_trampoline_1 (proc);
SCM_ASSERT (proc_tramp, proc, SCM_ARG1, FUNC_NAME);
SCM_ASSERT (scm_is_true (scm_procedure_p (proc)),
proc, SCM_ARG1, FUNC_NAME);
MY_VALIDATE_SUBSTRING_SPEC (2, s,
3, start, cstart,
4, end, cend);
while (cstart < cend)
{
proc_tramp (proc, SCM_MAKE_CHAR (scm_i_string_ref (s, cstart)));
scm_call_1 (proc, SCM_MAKE_CHAR (scm_i_string_ref (s, cstart)));
cstart++;
}
@ -2740,16 +2739,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_ASSERT (proc_tramp, proc, SCM_ARG1, FUNC_NAME);
SCM_ASSERT (scm_is_true (scm_procedure_p (proc)),
proc, SCM_ARG1, FUNC_NAME);
MY_VALIDATE_SUBSTRING_SPEC (2, s,
3, start, cstart,
4, end, cend);
while (cstart < cend)
{
proc_tramp (proc, scm_from_size_t (cstart));
scm_call_1 (proc, scm_from_size_t (cstart));
cstart++;
}
@ -3106,15 +3105,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_ASSERT (pred_tramp, char_pred, SCM_ARG2, FUNC_NAME);
SCM_ASSERT (scm_is_true (scm_procedure_p (char_pred)),
char_pred, SCM_ARG2, FUNC_NAME);
idx = cstart;
while (idx < cend)
{
SCM res, ch;
ch = SCM_MAKE_CHAR (scm_i_string_ref (s, idx));
res = pred_tramp (char_pred, ch);
res = scm_call_1 (char_pred, ch);
if (scm_is_true (res))
ls = scm_cons (ch, ls);
idx++;
@ -3242,14 +3241,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_ASSERT (scm_is_true (scm_procedure_p (char_pred)),
char_pred, SCM_ARG2, FUNC_NAME);
idx = cstart;
while (idx < cend)
{
SCM res, ch = SCM_MAKE_CHAR (scm_i_string_ref (s, idx));
res = pred_tramp (char_pred, ch);
res = scm_call_1 (char_pred, ch);
if (scm_is_false (res))
ls = scm_cons (ch, ls);
idx++;