mirror/guile
mirror/guile
1
Fork 0
mirror of https://git.savannah.gnu.org/git/guile.git synced 2025-04-30 03:40:34 +02:00
Code Activity

formally deprecate trampolines

Browse source 
* libguile/eval.c:
* libguile/deprecated.h:
* libguile/deprecated.c (scm_trampoline_0, scm_trampoline_1)
  (scm_trampoline_2): Actually deprecate trampolines.

* srfi/srfi-1.c: Fix all trampoline uses in srfi-1.c.
This commit is contained in:
Andy Wingo 2009-11-27 20:36:09 +01:00
parent 6c9e8a5354
commit a3e923770e
4 changed files with 120 additions and 156 deletions
Download patch file Download diff file Expand all files Collapse all files

39
libguile/deprecated.c
View file

@ -1572,6 +1572,45 @@ scm_gc_set_debug_check_freelist_x (SCM flag)
} }
#endif #endif
/* Trampolines
*
* Trampolines were an intent to speed up calling the same Scheme procedure many
* times from C.
*
* However, this was the wrong thing to optimize; if you really know what you're
* calling, call its function directly, otherwise you're in Scheme-land, and we
* have many better tricks there (inlining, for example, which can remove the
* need for closures and free variables).
*
* Also, in the normal debugging case, trampolines were being computed but not
* used. Silliness.
*/
scm_t_trampoline_0
scm_trampoline_0 (SCM proc)
{
scm_c_issue_deprecation_warning
("`scm_trampoline_0' is deprecated. Just use `scm_call_0' instead.");
return scm_call_0;
}
scm_t_trampoline_1
scm_trampoline_1 (SCM proc)
{
scm_c_issue_deprecation_warning
("`scm_trampoline_1' is deprecated. Just use `scm_call_1' instead.");
return scm_call_1;
}
scm_t_trampoline_2
scm_trampoline_2 (SCM proc)
{
scm_c_issue_deprecation_warning
("`scm_trampoline_2' is deprecated. Just use `scm_call_2' instead.");
return scm_call_2;
}
void void
scm_i_init_deprecated () scm_i_init_deprecated ()

7
libguile/deprecated.h
View file

@ -26,6 +26,7 @@
#include "libguile/__scm.h" #include "libguile/__scm.h"
#include "libguile/arrays.h" #include "libguile/arrays.h"
#include "libguile/strings.h" #include "libguile/strings.h"
#include "libguile/eval.h"
#if (SCM_ENABLE_DEPRECATED == 1) #if (SCM_ENABLE_DEPRECATED == 1)
@ -587,6 +588,12 @@ SCM_DEPRECATED SCM scm_map_free_list (void);
SCM_DEPRECATED SCM scm_gc_set_debug_check_freelist_x (SCM flag); SCM_DEPRECATED SCM scm_gc_set_debug_check_freelist_x (SCM flag);
#endif #endif
/* Deprecated 2009-11-27, scm_call_N is sufficient */
SCM_DEPRECATED scm_t_trampoline_0 scm_trampoline_0 (SCM proc);
SCM_DEPRECATED scm_t_trampoline_1 scm_trampoline_1 (SCM proc);
SCM_DEPRECATED scm_t_trampoline_2 scm_trampoline_2 (SCM proc);
void scm_i_init_deprecated (void); void scm_i_init_deprecated (void);

32
libguile/eval.c
View file

@ -3179,38 +3179,6 @@ SCM_DEFINE (scm_nconc2last, "apply:nconc2last", 1, 0, 0,
/* Trampolines
*
* Trampolines were an intent to speed up calling the same Scheme procedure many
* times from C.
*
* However, this was the wrong thing to optimize; if you really know what you're
* calling, call its function directly, otherwise you're in Scheme-land, and we
* have many better tricks there (inlining, for example, which can remove the
* need for closures and free variables).
*
* Also, in the normal debugging case, trampolines were being computed but not
* used. Silliness.
*/
scm_t_trampoline_0
scm_trampoline_0 (SCM proc)
{
return scm_call_0;
}
scm_t_trampoline_1
scm_trampoline_1 (SCM proc)
{
return scm_call_1;
}
scm_t_trampoline_2
scm_trampoline_2 (SCM proc)
{
return scm_call_2;
}
/* Typechecking for multi-argument MAP and FOR-EACH. /* Typechecking for multi-argument MAP and FOR-EACH.
Verify that each element of the vector ARGV, except for the first, Verify that each element of the vector ARGV, except for the first,

198
srfi/srfi-1.c
View file

@ -200,18 +200,16 @@ SCM_DEFINE (scm_srfi1_break, "break", 2, 0, 0,
"make a new define under a different name.") "make a new define under a different name.")
#define FUNC_NAME s_scm_srfi1_break #define FUNC_NAME s_scm_srfi1_break
{ {
scm_t_trampoline_1 pred_tramp;
SCM ret, *p; SCM ret, *p;
pred_tramp = scm_trampoline_1 (pred); SCM_ASSERT (scm_is_true (scm_procedure_p (pred)), pred, SCM_ARG1, FUNC_NAME);
SCM_ASSERT (pred_tramp, pred, SCM_ARG1, FUNC_NAME);
ret = SCM_EOL; ret = SCM_EOL;
p = &ret; p = &ret;
for ( ; scm_is_pair (lst); lst = SCM_CDR (lst)) for ( ; scm_is_pair (lst); lst = SCM_CDR (lst))
{ {
SCM elem = SCM_CAR (lst); SCM elem = SCM_CAR (lst);
if (scm_is_true (pred_tramp (pred, elem))) if (scm_is_true (scm_call_1 (pred, elem)))
goto done; goto done;
/* want this elem, tack it onto the end of ret */ /* want this elem, tack it onto the end of ret */
@ -235,15 +233,13 @@ SCM_DEFINE (scm_srfi1_break_x, "break!", 2, 0, 0,
#define FUNC_NAME s_scm_srfi1_break_x #define FUNC_NAME s_scm_srfi1_break_x
{ {
SCM upto, *p; SCM upto, *p;
scm_t_trampoline_1 pred_tramp;
pred_tramp = scm_trampoline_1 (pred); SCM_ASSERT (scm_is_true (scm_procedure_p (pred)), pred, SCM_ARG1, FUNC_NAME);
SCM_ASSERT (pred_tramp, pred, SCM_ARG1, FUNC_NAME);
p = &lst; p = &lst;
for (upto = lst; scm_is_pair (upto); upto = SCM_CDR (upto)) for (upto = lst; scm_is_pair (upto); upto = SCM_CDR (upto))
{ {
if (scm_is_true (pred_tramp (pred, SCM_CAR (upto)))) if (scm_is_true (scm_call_1 (pred, SCM_CAR (upto))))
goto done; goto done;
/* want this element */ /* want this element */
@ -329,12 +325,10 @@ SCM_DEFINE (scm_srfi1_count, "count", 2, 0, 1,
if (scm_is_null (rest)) if (scm_is_null (rest))
{ {
/* one list */ /* one list */
scm_t_trampoline_1 pred_tramp; SCM_ASSERT (scm_is_true (scm_procedure_p (pred)), pred, SCM_ARG1, FUNC_NAME);
pred_tramp = scm_trampoline_1 (pred);
SCM_ASSERT (pred_tramp, pred, SCM_ARG1, FUNC_NAME);
for ( ; scm_is_pair (list1); list1 = SCM_CDR (list1)) for ( ; scm_is_pair (list1); list1 = SCM_CDR (list1))
count += scm_is_true (pred_tramp (pred, SCM_CAR (list1))); count += scm_is_true (scm_call_1 (pred, SCM_CAR (list1)));
/* check below that list1 is a proper list, and done */ /* check below that list1 is a proper list, and done */
end_list1: end_list1:
@ -344,11 +338,9 @@ SCM_DEFINE (scm_srfi1_count, "count", 2, 0, 1,
else if (scm_is_pair (rest) && scm_is_null (SCM_CDR (rest))) else if (scm_is_pair (rest) && scm_is_null (SCM_CDR (rest)))
{ {
/* two lists */ /* two lists */
scm_t_trampoline_2 pred_tramp;
SCM list2; SCM list2;
pred_tramp = scm_trampoline_2 (pred); SCM_ASSERT (scm_is_true (scm_procedure_p (pred)), pred, SCM_ARG1, FUNC_NAME);
SCM_ASSERT (pred_tramp, pred, SCM_ARG1, FUNC_NAME);
list2 = SCM_CAR (rest); list2 = SCM_CAR (rest);
for (;;) for (;;)
@ -361,7 +353,7 @@ SCM_DEFINE (scm_srfi1_count, "count", 2, 0, 1,
argnum = 3; argnum = 3;
break; break;
} }
count += scm_is_true (pred_tramp count += scm_is_true (scm_call_2
(pred, SCM_CAR (list1), SCM_CAR (list2))); (pred, SCM_CAR (list1), SCM_CAR (list2)));
list1 = SCM_CDR (list1); list1 = SCM_CDR (list1);
list2 = SCM_CDR (list2); list2 = SCM_CDR (list2);
@ -426,15 +418,13 @@ SCM_DEFINE (scm_srfi1_delete, "delete", 2, 1, 0,
"common tail with @var{lst}.") "common tail with @var{lst}.")
#define FUNC_NAME s_scm_srfi1_delete #define FUNC_NAME s_scm_srfi1_delete
{ {
scm_t_trampoline_2 equal_p;
SCM ret, *p, keeplst; SCM ret, *p, keeplst;
int count; int count;
if (SCM_UNBNDP (pred)) if (SCM_UNBNDP (pred))
return scm_delete (x, lst); return scm_delete (x, lst);
equal_p = scm_trampoline_2 (pred); SCM_ASSERT (scm_is_true (scm_procedure_p (pred)), pred, SCM_ARG3, FUNC_NAME);
SCM_ASSERT (equal_p, pred, SCM_ARG3, FUNC_NAME);
/* ret is the return list being constructed. p is where to append to it, /* ret is the return list being constructed. p is where to append to it,
initially &ret then SCM_CDRLOC of the last pair. lst progresses as initially &ret then SCM_CDRLOC of the last pair. lst progresses as
@ -452,7 +442,7 @@ SCM_DEFINE (scm_srfi1_delete, "delete", 2, 1, 0,
for ( ; scm_is_pair (lst); lst = SCM_CDR (lst)) for ( ; scm_is_pair (lst); lst = SCM_CDR (lst))
{ {
if (scm_is_true (equal_p (pred, x, SCM_CAR (lst)))) if (scm_is_true (scm_call_2 (pred, x, SCM_CAR (lst))))
{ {
/* delete this element, so copy those at keeplst */ /* delete this element, so copy those at keeplst */
p = list_copy_part (keeplst, count, p); p = list_copy_part (keeplst, count, p);
@ -495,21 +485,19 @@ SCM_DEFINE (scm_srfi1_delete_x, "delete!", 2, 1, 0,
"@var{lst} may be modified to construct the returned list.") "@var{lst} may be modified to construct the returned list.")
#define FUNC_NAME s_scm_srfi1_delete_x #define FUNC_NAME s_scm_srfi1_delete_x
{ {
scm_t_trampoline_2 equal_p;
SCM walk; SCM walk;
SCM *prev; SCM *prev;
if (SCM_UNBNDP (pred)) if (SCM_UNBNDP (pred))
return scm_delete_x (x, lst); return scm_delete_x (x, lst);
equal_p = scm_trampoline_2 (pred); SCM_ASSERT (scm_is_true (scm_procedure_p (pred)), pred, SCM_ARG3, FUNC_NAME);
SCM_ASSERT (equal_p, pred, SCM_ARG3, FUNC_NAME);
for (prev = &lst, walk = lst; for (prev = &lst, walk = lst;
scm_is_pair (walk); scm_is_pair (walk);
walk = SCM_CDR (walk)) walk = SCM_CDR (walk))
{ {
if (scm_is_true (equal_p (pred, x, SCM_CAR (walk)))) if (scm_is_true (scm_call_2 (pred, x, SCM_CAR (walk))))
*prev = SCM_CDR (walk); *prev = SCM_CDR (walk);
else else
prev = SCM_CDRLOC (walk); prev = SCM_CDRLOC (walk);
@ -576,8 +564,8 @@ SCM_DEFINE (scm_srfi1_delete_duplicates, "delete-duplicates", 1, 1, 0,
equal_p = equal_trampoline; equal_p = equal_trampoline;
else else
{ {
equal_p = scm_trampoline_2 (pred); SCM_VALIDATE_PROC (SCM_ARG2, pred);
SCM_ASSERT (equal_p, pred, SCM_ARG2, FUNC_NAME); equal_p = scm_call_2;
} }
keeplst = lst; keeplst = lst;
@ -666,8 +654,8 @@ SCM_DEFINE (scm_srfi1_delete_duplicates_x, "delete-duplicates!", 1, 1, 0,
equal_p = equal_trampoline; equal_p = equal_trampoline;
else else
{ {
equal_p = scm_trampoline_2 (pred); SCM_VALIDATE_PROC (SCM_ARG2, pred);
SCM_ASSERT (equal_p, pred, SCM_ARG2, FUNC_NAME); equal_p = scm_call_2;
} }
endret = ret; endret = ret;
@ -766,11 +754,10 @@ SCM_DEFINE (scm_srfi1_drop_while, "drop-while", 2, 0, 0,
"satisfy the predicate @var{pred}.") "satisfy the predicate @var{pred}.")
#define FUNC_NAME s_scm_srfi1_drop_while #define FUNC_NAME s_scm_srfi1_drop_while
{ {
scm_t_trampoline_1 pred_tramp = scm_trampoline_1 (pred); SCM_VALIDATE_PROC (SCM_ARG1, pred);
SCM_ASSERT (pred_tramp, pred, SCM_ARG1, FUNC_NAME);
for ( ; scm_is_pair (lst); lst = SCM_CDR (lst)) for ( ; scm_is_pair (lst); lst = SCM_CDR (lst))
if (scm_is_false (pred_tramp (pred, SCM_CAR (lst)))) if (scm_is_false (scm_call_1 (pred, SCM_CAR (lst))))
goto done; goto done;
SCM_ASSERT_TYPE (SCM_NULL_OR_NIL_P (lst), lst, SCM_ARG2, FUNC_NAME, "list"); SCM_ASSERT_TYPE (SCM_NULL_OR_NIL_P (lst), lst, SCM_ARG2, FUNC_NAME, "list");
@ -818,12 +805,11 @@ SCM_DEFINE (scm_srfi1_filter_map, "filter-map", 2, 0, 1,
if (scm_is_null (rest)) if (scm_is_null (rest))
{ {
/* one list */ /* one list */
scm_t_trampoline_1 proc_tramp = scm_trampoline_1 (proc); SCM_VALIDATE_PROC (SCM_ARG1, proc);
SCM_ASSERT (proc_tramp, proc, SCM_ARG1, FUNC_NAME);
for ( ; scm_is_pair (list1); list1 = SCM_CDR (list1)) for ( ; scm_is_pair (list1); list1 = SCM_CDR (list1))
{ {
elem = proc_tramp (proc, SCM_CAR (list1)); elem = scm_call_1 (proc, SCM_CAR (list1));
if (scm_is_true (elem)) if (scm_is_true (elem))
{ {
newcell = scm_cons (elem, SCM_EOL); newcell = scm_cons (elem, SCM_EOL);
@ -840,9 +826,8 @@ SCM_DEFINE (scm_srfi1_filter_map, "filter-map", 2, 0, 1,
else if (scm_is_null (SCM_CDR (rest))) else if (scm_is_null (SCM_CDR (rest)))
{ {
/* two lists */ /* two lists */
scm_t_trampoline_2 proc_tramp = scm_trampoline_2 (proc);
SCM list2 = SCM_CAR (rest); SCM list2 = SCM_CAR (rest);
SCM_ASSERT (proc_tramp, proc, SCM_ARG1, FUNC_NAME); SCM_VALIDATE_PROC (SCM_ARG1, proc);
for (;;) for (;;)
{ {
@ -854,7 +839,7 @@ SCM_DEFINE (scm_srfi1_filter_map, "filter-map", 2, 0, 1,
argnum = 3; argnum = 3;
goto check_lst_and_done; goto check_lst_and_done;
} }
elem = proc_tramp (proc, SCM_CAR (list1), SCM_CAR (list2)); elem = scm_call_2 (proc, SCM_CAR (list1), SCM_CAR (list2));
if (scm_is_true (elem)) if (scm_is_true (elem))
{ {
newcell = scm_cons (elem, SCM_EOL); newcell = scm_cons (elem, SCM_EOL);
@ -918,13 +903,12 @@ SCM_DEFINE (scm_srfi1_find, "find", 2, 0, 0,
"found.") "found.")
#define FUNC_NAME s_scm_srfi1_find #define FUNC_NAME s_scm_srfi1_find
{ {
scm_t_trampoline_1 pred_tramp = scm_trampoline_1 (pred); SCM_VALIDATE_PROC (SCM_ARG1, pred);
SCM_ASSERT (pred_tramp, pred, SCM_ARG1, FUNC_NAME);
for ( ; scm_is_pair (lst); lst = SCM_CDR (lst)) for ( ; scm_is_pair (lst); lst = SCM_CDR (lst))
{ {
SCM elem = SCM_CAR (lst); SCM elem = SCM_CAR (lst);
if (scm_is_true (pred_tramp (pred, elem))) if (scm_is_true (scm_call_1 (pred, elem)))
return elem; return elem;
} }
SCM_ASSERT_TYPE (SCM_NULL_OR_NIL_P (lst), lst, SCM_ARG2, FUNC_NAME, "list"); SCM_ASSERT_TYPE (SCM_NULL_OR_NIL_P (lst), lst, SCM_ARG2, FUNC_NAME, "list");
@ -941,11 +925,10 @@ SCM_DEFINE (scm_srfi1_find_tail, "find-tail", 2, 0, 0,
"found.") "found.")
#define FUNC_NAME s_scm_srfi1_find_tail #define FUNC_NAME s_scm_srfi1_find_tail
{ {
scm_t_trampoline_1 pred_tramp = scm_trampoline_1 (pred); SCM_VALIDATE_PROC (SCM_ARG1, pred);
SCM_ASSERT (pred_tramp, pred, SCM_ARG1, FUNC_NAME);
for ( ; scm_is_pair (lst); lst = SCM_CDR (lst)) for ( ; scm_is_pair (lst); lst = SCM_CDR (lst))
if (scm_is_true (pred_tramp (pred, SCM_CAR (lst)))) if (scm_is_true (scm_call_1 (pred, SCM_CAR (lst))))
return lst; return lst;
SCM_ASSERT_TYPE (SCM_NULL_OR_NIL_P (lst), lst, SCM_ARG2, FUNC_NAME, "list"); SCM_ASSERT_TYPE (SCM_NULL_OR_NIL_P (lst), lst, SCM_ARG2, FUNC_NAME, "list");
@ -1015,11 +998,10 @@ SCM_DEFINE (scm_srfi1_fold, "fold", 3, 0, 1,
if (scm_is_null (rest)) if (scm_is_null (rest))
{ {
/* one list */ /* one list */
scm_t_trampoline_2 proc_tramp = scm_trampoline_2 (proc); SCM_VALIDATE_PROC (SCM_ARG1, proc);
SCM_ASSERT (proc_tramp, proc, SCM_ARG1, FUNC_NAME);
for ( ; scm_is_pair (list1); list1 = SCM_CDR (list1)) for ( ; scm_is_pair (list1); list1 = SCM_CDR (list1))
init = proc_tramp (proc, SCM_CAR (list1), init); init = scm_call_2 (proc, SCM_CAR (list1), init);
/* check below that list1 is a proper list, and done */ /* check below that list1 is a proper list, and done */
lst = list1; lst = list1;
@ -1117,11 +1099,10 @@ SCM_DEFINE (scm_srfi1_list_index, "list-index", 2, 0, 1,
if (scm_is_null (rest)) if (scm_is_null (rest))
{ {
/* one list */ /* one list */
scm_t_trampoline_1 pred_tramp = scm_trampoline_1 (pred); SCM_VALIDATE_PROC (SCM_ARG1, pred);
SCM_ASSERT (pred_tramp, pred, SCM_ARG1, FUNC_NAME);
for ( ; scm_is_pair (list1); n++, list1 = SCM_CDR (list1)) for ( ; scm_is_pair (list1); n++, list1 = SCM_CDR (list1))
if (scm_is_true (pred_tramp (pred, SCM_CAR (list1)))) if (scm_is_true (scm_call_1 (pred, SCM_CAR (list1))))
return SCM_I_MAKINUM (n); return SCM_I_MAKINUM (n);
/* not found, check below that list1 is a proper list */ /* not found, check below that list1 is a proper list */
@ -1133,8 +1114,7 @@ SCM_DEFINE (scm_srfi1_list_index, "list-index", 2, 0, 1,
{ {
/* two lists */ /* two lists */
SCM list2 = SCM_CAR (rest); SCM list2 = SCM_CAR (rest);
scm_t_trampoline_2 pred_tramp = scm_trampoline_2 (pred); SCM_VALIDATE_PROC (SCM_ARG1, pred);
SCM_ASSERT (pred_tramp, pred, SCM_ARG1, FUNC_NAME);
for ( ; ; n++) for ( ; ; n++)
{ {
@ -1146,7 +1126,7 @@ SCM_DEFINE (scm_srfi1_list_index, "list-index", 2, 0, 1,
argnum = 3; argnum = 3;
break; break;
} }
if (scm_is_true (pred_tramp (pred, if (scm_is_true (scm_call_2 (pred,
SCM_CAR (list1), SCM_CAR (list2)))) SCM_CAR (list1), SCM_CAR (list2))))
return SCM_I_MAKINUM (n); return SCM_I_MAKINUM (n);
@ -1237,15 +1217,11 @@ SCM_DEFINE (scm_srfi1_list_tabulate, "list-tabulate", 2, 0, 0,
#define FUNC_NAME s_scm_srfi1_list_tabulate #define FUNC_NAME s_scm_srfi1_list_tabulate
{ {
long i, nn; long i, nn;
scm_t_trampoline_1 proc_tramp = scm_trampoline_1 (proc);
SCM ret = SCM_EOL; SCM ret = SCM_EOL;
nn = scm_to_signed_integer (n, 0, LONG_MAX); nn = scm_to_signed_integer (n, 0, LONG_MAX);
SCM_ASSERT (proc_tramp, proc, SCM_ARG2, FUNC_NAME); SCM_VALIDATE_PROC (SCM_ARG2, proc);
for (i = nn-1; i >= 0; i--) for (i = nn-1; i >= 0; i--)
ret = scm_cons (proc_tramp (proc, scm_from_long (i)), ret); ret = scm_cons (scm_call_1 (proc, scm_from_long (i)), ret);
return ret; return ret;
} }
#undef FUNC_NAME #undef FUNC_NAME
@ -1267,11 +1243,9 @@ SCM_DEFINE (scm_srfi1_lset_adjoin, "lset-adjoin", 2, 0, 1,
"@end example") "@end example")
#define FUNC_NAME s_scm_srfi1_lset_adjoin #define FUNC_NAME s_scm_srfi1_lset_adjoin
{ {
scm_t_trampoline_2 equal_tramp;
SCM l, elem; SCM l, elem;
equal_tramp = scm_trampoline_2 (equal); SCM_VALIDATE_PROC (SCM_ARG1, equal);
SCM_ASSERT (equal_tramp, equal, SCM_ARG1, FUNC_NAME);
SCM_VALIDATE_REST_ARGUMENT (rest); SCM_VALIDATE_REST_ARGUMENT (rest);
/* It's not clear if duplicates among the `rest' elements are meant to be /* It's not clear if duplicates among the `rest' elements are meant to be
@ -1286,7 +1260,7 @@ SCM_DEFINE (scm_srfi1_lset_adjoin, "lset-adjoin", 2, 0, 1,
elem = SCM_CAR (rest); elem = SCM_CAR (rest);
for (l = lst; scm_is_pair (l); l = SCM_CDR (l)) for (l = lst; scm_is_pair (l); l = SCM_CDR (l))
if (scm_is_true (equal_tramp (equal, SCM_CAR (l), elem))) if (scm_is_true (scm_call_2 (equal, SCM_CAR (l), elem)))
goto next_elem; /* elem already in lst, don't add */ goto next_elem; /* elem already in lst, don't add */
SCM_ASSERT_TYPE (SCM_NULL_OR_NIL_P(l), lst, SCM_ARG2, FUNC_NAME, "list"); SCM_ASSERT_TYPE (SCM_NULL_OR_NIL_P(l), lst, SCM_ARG2, FUNC_NAME, "list");
@ -1325,11 +1299,9 @@ SCM_DEFINE (scm_srfi1_lset_difference_x, "lset-difference!", 2, 0, 1,
"result.") "result.")
#define FUNC_NAME s_scm_srfi1_lset_difference_x #define FUNC_NAME s_scm_srfi1_lset_difference_x
{ {
scm_t_trampoline_2 equal_tramp = scm_trampoline_2 (equal);
SCM ret, *pos, elem, r, b; SCM ret, *pos, elem, r, b;
int argnum; int argnum;
SCM_ASSERT (equal_tramp, equal, SCM_ARG1, FUNC_NAME);
SCM_VALIDATE_PROC (SCM_ARG1, equal); SCM_VALIDATE_PROC (SCM_ARG1, equal);
SCM_VALIDATE_REST_ARGUMENT (rest); SCM_VALIDATE_REST_ARGUMENT (rest);
@ -1344,7 +1316,7 @@ SCM_DEFINE (scm_srfi1_lset_difference_x, "lset-difference!", 2, 0, 1,
r = SCM_CDR (r), argnum++) r = SCM_CDR (r), argnum++)
{ {
for (b = SCM_CAR (r); scm_is_pair (b); b = SCM_CDR (b)) for (b = SCM_CAR (r); scm_is_pair (b); b = SCM_CDR (b))
if (scm_is_true (equal_tramp (equal, elem, SCM_CAR (b)))) if (scm_is_true (scm_call_2 (equal, elem, SCM_CAR (b))))
goto next_elem; /* equal to elem, so drop that elem */ goto next_elem; /* equal to elem, so drop that elem */
SCM_ASSERT_TYPE (SCM_NULL_OR_NIL_P (b), b, argnum, FUNC_NAME,"list"); SCM_ASSERT_TYPE (SCM_NULL_OR_NIL_P (b), b, argnum, FUNC_NAME,"list");
@ -1437,12 +1409,12 @@ scm_srfi1_map (SCM proc, SCM arg1, SCM args)
SCM_VALIDATE_REST_ARGUMENT (args); SCM_VALIDATE_REST_ARGUMENT (args);
if (scm_is_null (args)) if (scm_is_null (args))
{ {
scm_t_trampoline_1 call = scm_trampoline_1 (proc); SCM_GASSERT2 (scm_is_true (scm_procedure_p (proc)), g_srfi1_map,
SCM_GASSERT2 (call, g_srfi1_map, proc, arg1, SCM_ARG1, s_srfi1_map); proc, arg1, SCM_ARG1, s_srfi1_map);
SCM_GASSERT2 (len >= 0, g_srfi1_map, proc, arg1, SCM_ARG2, s_srfi1_map); SCM_GASSERT2 (len >= 0, g_srfi1_map, proc, arg1, SCM_ARG2, s_srfi1_map);
while (SCM_NIMP (arg1)) 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); pres = SCM_CDRLOC (*pres);
arg1 = SCM_CDR (arg1); arg1 = SCM_CDR (arg1);
} }
@ -1452,8 +1424,7 @@ scm_srfi1_map (SCM proc, SCM arg1, SCM args)
{ {
SCM arg2 = SCM_CAR (args); SCM arg2 = SCM_CAR (args);
int len2 = srfi1_ilength (arg2); int len2 = srfi1_ilength (arg2);
scm_t_trampoline_2 call = scm_trampoline_2 (proc); SCM_GASSERTn (scm_is_true (scm_procedure_p (proc)), g_srfi1_map,
SCM_GASSERTn (call, g_srfi1_map,
scm_cons2 (proc, arg1, args), SCM_ARG1, s_srfi1_map); scm_cons2 (proc, arg1, args), SCM_ARG1, s_srfi1_map);
if (len < 0 || (len2 >= 0 && len2 < len)) if (len < 0 || (len2 >= 0 && len2 < len))
len = len2; len = len2;
@ -1465,7 +1436,7 @@ scm_srfi1_map (SCM proc, SCM arg1, SCM args)
s_srfi1_map); s_srfi1_map);
while (len > 0) while (len > 0)
{ {
*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); pres = SCM_CDRLOC (*pres);
arg1 = SCM_CDR (arg1); arg1 = SCM_CDR (arg1);
arg2 = SCM_CDR (arg2); arg2 = SCM_CDR (arg2);
@ -1508,14 +1479,13 @@ scm_srfi1_for_each (SCM proc, SCM arg1, SCM args)
SCM_VALIDATE_REST_ARGUMENT (args); SCM_VALIDATE_REST_ARGUMENT (args);
if (scm_is_null (args)) if (scm_is_null (args))
{ {
scm_t_trampoline_1 call = scm_trampoline_1 (proc); SCM_GASSERT2 (scm_is_true (scm_procedure_p (proc)), g_srfi1_for_each,
SCM_GASSERT2 (call, g_srfi1_for_each, proc, arg1, proc, arg1, SCM_ARG1, s_srfi1_for_each);
SCM_ARG1, s_srfi1_for_each);
SCM_GASSERT2 (len >= 0, g_srfi1_for_each, proc, arg1, SCM_GASSERT2 (len >= 0, g_srfi1_for_each, proc, arg1,
SCM_ARG2, s_srfi1_map); SCM_ARG2, s_srfi1_map);
while (SCM_NIMP (arg1)) while (SCM_NIMP (arg1))
{ {
call (proc, SCM_CAR (arg1)); scm_call_1 (proc, SCM_CAR (arg1));
arg1 = SCM_CDR (arg1); arg1 = SCM_CDR (arg1);
} }
return SCM_UNSPECIFIED; return SCM_UNSPECIFIED;
@ -1524,8 +1494,7 @@ scm_srfi1_for_each (SCM proc, SCM arg1, SCM args)
{ {
SCM arg2 = SCM_CAR (args); SCM arg2 = SCM_CAR (args);
int len2 = srfi1_ilength (arg2); int len2 = srfi1_ilength (arg2);
scm_t_trampoline_2 call = scm_trampoline_2 (proc); SCM_GASSERTn (scm_is_true (scm_procedure_p (proc)), g_srfi1_for_each,
SCM_GASSERTn (call, g_srfi1_for_each,
scm_cons2 (proc, arg1, args), SCM_ARG1, s_srfi1_for_each); scm_cons2 (proc, arg1, args), SCM_ARG1, s_srfi1_for_each);
if (len < 0 || (len2 >= 0 && len2 < len)) if (len < 0 || (len2 >= 0 && len2 < len))
len = len2; len = len2;
@ -1537,7 +1506,7 @@ scm_srfi1_for_each (SCM proc, SCM arg1, SCM args)
s_srfi1_for_each); s_srfi1_for_each);
while (len > 0) while (len > 0)
{ {
call (proc, SCM_CAR (arg1), SCM_CAR (arg2)); scm_call_2 (proc, SCM_CAR (arg1), SCM_CAR (arg2));
arg1 = SCM_CDR (arg1); arg1 = SCM_CDR (arg1);
arg2 = SCM_CDR (arg2); arg2 = SCM_CDR (arg2);
--len; --len;
@ -1589,8 +1558,8 @@ SCM_DEFINE (scm_srfi1_member, "member", 2, 1, 0,
equal_p = equal_trampoline; equal_p = equal_trampoline;
else else
{ {
equal_p = scm_trampoline_2 (pred); SCM_VALIDATE_PROC (SCM_ARG3, pred);
SCM_ASSERT (equal_p, pred, 3, FUNC_NAME); equal_p = scm_call_2;
} }
for (; !SCM_NULL_OR_NIL_P (lst); lst = SCM_CDR (lst)) for (; !SCM_NULL_OR_NIL_P (lst); lst = SCM_CDR (lst))
{ {
@ -1614,8 +1583,8 @@ SCM_DEFINE (scm_srfi1_assoc, "assoc", 2, 1, 0,
equal_p = equal_trampoline; equal_p = equal_trampoline;
else else
{ {
equal_p = scm_trampoline_2 (pred); SCM_VALIDATE_PROC (SCM_ARG3, pred);
SCM_ASSERT (equal_p, pred, 3, FUNC_NAME); equal_p = scm_call_2;
} }
for(; scm_is_pair (ls); ls = SCM_CDR (ls)) for(; scm_is_pair (ls); ls = SCM_CDR (ls))
{ {
@ -1668,14 +1637,13 @@ SCM_DEFINE (scm_srfi1_partition, "partition", 2, 0, 0,
{ {
/* In this implementation, the output lists don't share memory with /* In this implementation, the output lists don't share memory with
list, because it's probably not worth the effort. */ list, because it's probably not worth the effort. */
scm_t_trampoline_1 call = scm_trampoline_1(pred);
SCM orig_list = list; SCM orig_list = list;
SCM kept = scm_cons(SCM_EOL, SCM_EOL); SCM kept = scm_cons(SCM_EOL, SCM_EOL);
SCM kept_tail = kept; SCM kept_tail = kept;
SCM dropped = scm_cons(SCM_EOL, SCM_EOL); SCM dropped = scm_cons(SCM_EOL, SCM_EOL);
SCM dropped_tail = dropped; SCM dropped_tail = dropped;
SCM_ASSERT(call, pred, 2, FUNC_NAME); SCM_VALIDATE_PROC (SCM_ARG1, pred);
for (; !SCM_NULL_OR_NIL_P (list); list = SCM_CDR(list)) { for (; !SCM_NULL_OR_NIL_P (list); list = SCM_CDR(list)) {
SCM elt, new_tail; SCM elt, new_tail;
@ -1686,7 +1654,7 @@ SCM_DEFINE (scm_srfi1_partition, "partition", 2, 0, 0,
elt = SCM_CAR (list); elt = SCM_CAR (list);
new_tail = scm_cons (SCM_CAR (list), SCM_EOL); new_tail = scm_cons (SCM_CAR (list), SCM_EOL);
if (scm_is_true (call (pred, elt))) { if (scm_is_true (scm_call_1 (pred, elt))) {
SCM_SETCDR(kept_tail, new_tail); SCM_SETCDR(kept_tail, new_tail);
kept_tail = new_tail; kept_tail = new_tail;
} }
@ -1722,10 +1690,8 @@ SCM_DEFINE (scm_srfi1_partition_x, "partition!", 2, 0, 0,
#define FUNC_NAME s_scm_srfi1_partition_x #define FUNC_NAME s_scm_srfi1_partition_x
{ {
SCM tlst, flst, *tp, *fp; SCM tlst, flst, *tp, *fp;
scm_t_trampoline_1 pred_tramp;
pred_tramp = scm_trampoline_1 (pred); SCM_ASSERT (scm_is_true (scm_procedure_p (pred)), pred, SCM_ARG1, FUNC_NAME);
SCM_ASSERT (pred_tramp, pred, SCM_ARG1, FUNC_NAME);
/* tlst and flst are the lists of true and false elements. tp and fp are /* tlst and flst are the lists of true and false elements. tp and fp are
where to store to append to them, initially &tlst and &flst, then where to store to append to them, initially &tlst and &flst, then
@ -1738,7 +1704,7 @@ SCM_DEFINE (scm_srfi1_partition_x, "partition!", 2, 0, 0,
for ( ; scm_is_pair (lst); lst = SCM_CDR (lst)) for ( ; scm_is_pair (lst); lst = SCM_CDR (lst))
{ {
if (scm_is_true (pred_tramp (pred, SCM_CAR (lst)))) if (scm_is_true (scm_call_1 (pred, SCM_CAR (lst))))
{ {
*tp = lst; *tp = lst;
tp = SCM_CDRLOC (lst); tp = SCM_CDRLOC (lst);
@ -1798,18 +1764,15 @@ SCM_DEFINE (scm_srfi1_reduce, "reduce", 3, 0, 0,
"avoids that unnecessary call.") "avoids that unnecessary call.")
#define FUNC_NAME s_scm_srfi1_reduce #define FUNC_NAME s_scm_srfi1_reduce
{ {
scm_t_trampoline_2 proc_tramp = scm_trampoline_2 (proc); SCM ret;
SCM ret; SCM_VALIDATE_PROC (SCM_ARG1, proc);
SCM_ASSERT (proc_tramp, proc, SCM_ARG1, FUNC_NAME);
ret = def; /* if lst is empty */ ret = def; /* if lst is empty */
if (scm_is_pair (lst)) if (scm_is_pair (lst))
{ {
ret = SCM_CAR (lst); /* if lst has one element */ ret = SCM_CAR (lst); /* if lst has one element */
for (lst = SCM_CDR (lst); scm_is_pair (lst); lst = SCM_CDR (lst)) for (lst = SCM_CDR (lst); scm_is_pair (lst); lst = SCM_CDR (lst))
ret = proc_tramp (proc, SCM_CAR (lst), ret); ret = scm_call_2 (proc, SCM_CAR (lst), ret);
} }
SCM_ASSERT_TYPE (SCM_NULL_OR_NIL_P (lst), lst, SCM_ARG3, FUNC_NAME, "list"); SCM_ASSERT_TYPE (SCM_NULL_OR_NIL_P (lst), lst, SCM_ARG3, FUNC_NAME, "list");
@ -1866,12 +1829,9 @@ SCM_DEFINE (scm_srfi1_reduce_right, "reduce-right", 3, 0, 0,
is long. A vector is preferred over a reversed list since it's more is long. A vector is preferred over a reversed list since it's more
compact and is less work for the gc to collect. */ compact and is less work for the gc to collect. */
scm_t_trampoline_2 proc_tramp = scm_trampoline_2 (proc); SCM vec, ret;
SCM ret, vec; ssize_t len, i;
long len, i; SCM_VALIDATE_PROC (SCM_ARG1, proc);
SCM_ASSERT (proc_tramp, proc, SCM_ARG1, FUNC_NAME);
if (SCM_NULL_OR_NIL_P (lst)) if (SCM_NULL_OR_NIL_P (lst))
return def; return def;
@ -1880,7 +1840,7 @@ SCM_DEFINE (scm_srfi1_reduce_right, "reduce-right", 3, 0, 0,
ret = SCM_SIMPLE_VECTOR_REF (vec, len-1); ret = SCM_SIMPLE_VECTOR_REF (vec, len-1);
for (i = len-2; i >= 0; i--) for (i = len-2; i >= 0; i--)
ret = proc_tramp (proc, SCM_SIMPLE_VECTOR_REF (vec, i), ret); ret = scm_call_2 (proc, SCM_SIMPLE_VECTOR_REF (vec, i), ret);
return ret; return ret;
} }
@ -1896,18 +1856,17 @@ SCM_DEFINE (scm_srfi1_remove, "remove", 2, 0, 0,
"specified.") "specified.")
#define FUNC_NAME s_scm_srfi1_remove #define FUNC_NAME s_scm_srfi1_remove
{ {
scm_t_trampoline_1 call = scm_trampoline_1 (pred);
SCM walk; SCM walk;
SCM *prev; SCM *prev;
SCM res = SCM_EOL; SCM res = SCM_EOL;
SCM_ASSERT (call, pred, 1, FUNC_NAME); SCM_VALIDATE_PROC (SCM_ARG1, pred);
SCM_VALIDATE_LIST (2, list); SCM_VALIDATE_LIST (2, list);
for (prev = &res, walk = list; for (prev = &res, walk = list;
scm_is_pair (walk); scm_is_pair (walk);
walk = SCM_CDR (walk)) walk = SCM_CDR (walk))
{ {
if (scm_is_false (call (pred, SCM_CAR (walk)))) if (scm_is_false (scm_call_1 (pred, SCM_CAR (walk))))
{ {
*prev = scm_cons (SCM_CAR (walk), SCM_EOL); *prev = scm_cons (SCM_CAR (walk), SCM_EOL);
prev = SCM_CDRLOC (*prev); prev = SCM_CDRLOC (*prev);
@ -1929,17 +1888,16 @@ SCM_DEFINE (scm_srfi1_remove_x, "remove!", 2, 0, 0,
"list.") "list.")
#define FUNC_NAME s_scm_srfi1_remove_x #define FUNC_NAME s_scm_srfi1_remove_x
{ {
scm_t_trampoline_1 call = scm_trampoline_1 (pred);
SCM walk; SCM walk;
SCM *prev; SCM *prev;
SCM_ASSERT (call, pred, 1, FUNC_NAME); SCM_VALIDATE_PROC (SCM_ARG1, pred);
SCM_VALIDATE_LIST (2, list); SCM_VALIDATE_LIST (2, list);
for (prev = &list, walk = list; for (prev = &list, walk = list;
scm_is_pair (walk); scm_is_pair (walk);
walk = SCM_CDR (walk)) walk = SCM_CDR (walk))
{ {
if (scm_is_false (call (pred, SCM_CAR (walk)))) if (scm_is_false (scm_call_1 (pred, SCM_CAR (walk))))
prev = SCM_CDRLOC (walk); prev = SCM_CDRLOC (walk);
else else
*prev = SCM_CDR (walk); *prev = SCM_CDR (walk);
@ -1977,18 +1935,16 @@ SCM_DEFINE (scm_srfi1_span, "span", 2, 0, 0,
"remainder of @var{lst}.") "remainder of @var{lst}.")
#define FUNC_NAME s_scm_srfi1_span #define FUNC_NAME s_scm_srfi1_span
{ {
scm_t_trampoline_1 pred_tramp;
SCM ret, *p; SCM ret, *p;
pred_tramp = scm_trampoline_1 (pred); SCM_ASSERT (scm_is_true (scm_procedure_p (pred)), pred, SCM_ARG1, FUNC_NAME);
SCM_ASSERT (pred_tramp, pred, SCM_ARG1, FUNC_NAME);
ret = SCM_EOL; ret = SCM_EOL;
p = &ret; p = &ret;
for ( ; scm_is_pair (lst); lst = SCM_CDR (lst)) for ( ; scm_is_pair (lst); lst = SCM_CDR (lst))
{ {
SCM elem = SCM_CAR (lst); SCM elem = SCM_CAR (lst);
if (scm_is_false (pred_tramp (pred, elem))) if (scm_is_false (scm_call_1 (pred, elem)))
goto done; goto done;
/* want this elem, tack it onto the end of ret */ /* want this elem, tack it onto the end of ret */
@ -2012,15 +1968,13 @@ SCM_DEFINE (scm_srfi1_span_x, "span!", 2, 0, 0,
#define FUNC_NAME s_scm_srfi1_span_x #define FUNC_NAME s_scm_srfi1_span_x
{ {
SCM upto, *p; SCM upto, *p;
scm_t_trampoline_1 pred_tramp;
pred_tramp = scm_trampoline_1 (pred); SCM_ASSERT (scm_is_true (scm_procedure_p (pred)), pred, SCM_ARG1, FUNC_NAME);
SCM_ASSERT (pred_tramp, pred, SCM_ARG1, FUNC_NAME);
p = &lst; p = &lst;
for (upto = lst; scm_is_pair (upto); upto = SCM_CDR (upto)) for (upto = lst; scm_is_pair (upto); upto = SCM_CDR (upto))
{ {
if (scm_is_false (pred_tramp (pred, SCM_CAR (upto)))) if (scm_is_false (scm_call_1 (pred, SCM_CAR (upto))))
goto done; goto done;
/* want this element */ /* want this element */
@ -2137,18 +2091,16 @@ SCM_DEFINE (scm_srfi1_take_while, "take-while", 2, 0, 0,
"@var{lst} whose elements all satisfy the predicate @var{pred}.") "@var{lst} whose elements all satisfy the predicate @var{pred}.")
#define FUNC_NAME s_scm_srfi1_take_while #define FUNC_NAME s_scm_srfi1_take_while
{ {
scm_t_trampoline_1 pred_tramp;
SCM ret, *p; SCM ret, *p;
pred_tramp = scm_trampoline_1 (pred); SCM_ASSERT (scm_is_true (scm_procedure_p (pred)), pred, SCM_ARG1, FUNC_NAME);
SCM_ASSERT (pred_tramp, pred, SCM_ARG1, FUNC_NAME);
ret = SCM_EOL; ret = SCM_EOL;
p = &ret; p = &ret;
for ( ; scm_is_pair (lst); lst = SCM_CDR (lst)) for ( ; scm_is_pair (lst); lst = SCM_CDR (lst))
{ {
SCM elem = SCM_CAR (lst); SCM elem = SCM_CAR (lst);
if (scm_is_false (pred_tramp (pred, elem))) if (scm_is_false (scm_call_1 (pred, elem)))
goto done; goto done;
/* want this elem, tack it onto the end of ret */ /* want this elem, tack it onto the end of ret */
@ -2171,15 +2123,13 @@ SCM_DEFINE (scm_srfi1_take_while_x, "take-while!", 2, 0, 0,
#define FUNC_NAME s_scm_srfi1_take_while_x #define FUNC_NAME s_scm_srfi1_take_while_x
{ {
SCM upto, *p; SCM upto, *p;
scm_t_trampoline_1 pred_tramp;
pred_tramp = scm_trampoline_1 (pred); SCM_ASSERT (scm_is_true (scm_procedure_p (pred)), pred, SCM_ARG1, FUNC_NAME);
SCM_ASSERT (pred_tramp, pred, SCM_ARG1, FUNC_NAME);
p = &lst; p = &lst;
for (upto = lst; scm_is_pair (upto); upto = SCM_CDR (upto)) for (upto = lst; scm_is_pair (upto); upto = SCM_CDR (upto))
{ {
if (scm_is_false (pred_tramp (pred, SCM_CAR (upto)))) if (scm_is_false (scm_call_1 (pred, SCM_CAR (upto))))
goto done; goto done;
/* want this element */ /* want this element */