diff options
-rw-r--r-- | libguile/eval.c | 23 | ||||
-rw-r--r-- | libguile/hashtab.c | 5 | ||||
-rw-r--r-- | libguile/list.c | 12 | ||||
-rw-r--r-- | libguile/quicksort.i.c | 16 | ||||
-rw-r--r-- | libguile/sort.c | 66 | ||||
-rw-r--r-- | libguile/srfi-13.c | 105 |
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++; |