summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
-rw-r--r--libguile/eval.c23
-rw-r--r--libguile/hashtab.c5
-rw-r--r--libguile/list.c12
-rw-r--r--libguile/quicksort.i.c16
-rw-r--r--libguile/sort.c66
-rw-r--r--libguile/srfi-13.c105
6 files changed, 101 insertions, 126 deletions
diff --git a/libguile/eval.c b/libguile/eval.c
index f38512a99..79aa04d37 100644
--- a/libguile/eval.c
+++ b/libguile/eval.c
@@ -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);
}
diff --git a/libguile/hashtab.c b/libguile/hashtab.c
index b76d3af79..f3b35485a 100644
--- a/libguile/hashtab.c
+++ b/libguile/hashtab.c
@@ -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;
diff --git a/libguile/list.c b/libguile/list.c
index 70f527755..ba4b249eb 100644
--- a/libguile/list.c
+++ b/libguile/list.c
@@ -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);
diff --git a/libguile/quicksort.i.c b/libguile/quicksort.i.c
index 91801c19a..4e39f827a 100644
--- a/libguile/quicksort.i.c
+++ b/libguile/quicksort.i.c
@@ -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)
diff --git a/libguile/sort.c b/libguile/sort.c
index a9e4dda8c..763978f52 100644
--- a/libguile/sort.c
+++ b/libguile/sort.c
@@ -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
diff --git a/libguile/srfi-13.c b/libguile/srfi-13.c
index f76093188..cf2abfc70 100644
--- a/libguile/srfi-13.c
+++ b/libguile/srfi-13.c
@@ -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++;