diff options
author | Keisuke Nishida <kxn30@po.cwru.edu> | 2001-06-26 15:46:40 +0000 |
---|---|---|
committer | Keisuke Nishida <kxn30@po.cwru.edu> | 2001-06-26 15:46:40 +0000 |
commit | fdc2839563bd8c821221a4869f27255ae77f757b (patch) | |
tree | 63bc043598fe6d9c2cac3d3c7251898cc306f5cd | |
parent | 36284627919a6968174b5f17369349187a2b4b1b (diff) | |
download | guile-fdc2839563bd8c821221a4869f27255ae77f757b.tar.gz |
* eval.c (scm_call_0, scm_call_1, scm_call_2, scm_call_3,
scm_apply_0, scm_apply_1, scm_apply_2, scm_apply_3): New functions.
-rw-r--r-- | libguile/ChangeLog | 29 | ||||
-rw-r--r-- | libguile/async.c | 2 | ||||
-rw-r--r-- | libguile/coop-threads.c | 6 | ||||
-rw-r--r-- | libguile/debug.c | 2 | ||||
-rw-r--r-- | libguile/dynwind.c | 10 | ||||
-rw-r--r-- | libguile/environments.c | 2 | ||||
-rw-r--r-- | libguile/eval.c | 64 | ||||
-rw-r--r-- | libguile/eval.h | 8 | ||||
-rw-r--r-- | libguile/fluids.c | 2 | ||||
-rw-r--r-- | libguile/goops.c | 16 | ||||
-rw-r--r-- | libguile/hashtab.c | 15 | ||||
-rw-r--r-- | libguile/hooks.c | 2 | ||||
-rw-r--r-- | libguile/load.c | 2 | ||||
-rw-r--r-- | libguile/modules.c | 43 | ||||
-rw-r--r-- | libguile/ports.c | 2 | ||||
-rw-r--r-- | libguile/print.c | 2 | ||||
-rw-r--r-- | libguile/properties.c | 2 | ||||
-rw-r--r-- | libguile/ramap.c | 19 | ||||
-rw-r--r-- | libguile/read.c | 4 | ||||
-rw-r--r-- | libguile/scmsigs.c | 5 | ||||
-rw-r--r-- | libguile/sort.c | 6 | ||||
-rw-r--r-- | libguile/strports.c | 6 | ||||
-rw-r--r-- | libguile/throw.c | 6 | ||||
-rw-r--r-- | libguile/unif.c | 4 | ||||
-rw-r--r-- | libguile/vports.c | 13 |
25 files changed, 167 insertions, 105 deletions
diff --git a/libguile/ChangeLog b/libguile/ChangeLog index ddffe6faf..cdf0344f2 100644 --- a/libguile/ChangeLog +++ b/libguile/ChangeLog @@ -1,3 +1,32 @@ +2001-06-27 Keisuke Nishida <kxn30@po.cwru.edu> + + * eval.c (scm_call_0, scm_call_1, scm_call_2, scm_call_3, + scm_apply_0, scm_apply_1, scm_apply_2, scm_apply_3): New functions. + * eval.h (scm_call_0, scm_call_1, scm_call_2, scm_call_3, + scm_apply_0, scm_apply_1, scm_apply_2, scm_apply_3): Declared. + * async.c (scm_run_asyncs), coop-threads.c (scheme_body_bootstrip, + scheme_handler_bootstrip), debug.c (with_traps_inner), dynwind.c + (scm_dynamic_wind, scm_dowinds), environments.c + (import_environment_conflict), eval.c (scm_macroexp, scm_force, + scm_primitive_eval_x, scm_primitive_eval), fluids.c (apply_thunk), + goops.c (GETVAR, purgatory, make_class_from_template, + scm_ensure_accessor), hashtab.c (scm_ihashx, scm_sloppy_assx, + scm_delx_x, fold_proc), hooks.c (scm_c_run_hook), load.c + (scm_primitive_load), modules.c (scm_resolve_module, + scm_c_define_module, scm_c_use_module, scm_c_export, + module_variable, scm_eval_closure_lookup, scm_sym2var, + scm_make_module, scm_ensure_user_module, scm_load_scheme_module), + ports.c (scm_port_for_each), print.c (scm_printer_apply), + properties.c (scm_primitive_property_ref), ramap.c (ramap, + ramap_cxr, rafe, scm_array_index_map_x, read.c (scm_lreadr), + scmsigs.c (sys_deliver_signals), sort.c (applyless), strports.c + (scm_object_to_string, scm_call_with_output_string, + scm_call_with_input_string), throw.c (scm_body_thunk, + scm_handle_by_proc, hbpca_body), unif.c (scm_make_shared_array, + scm_make_shared_array), vports.c (sf_flush, sf_write, + sf_fill_input, sf_close): Use one of the above functions. + * goops.c, hashtab.c, scmsigs.c, sort.c: #include "libguile/root.h". + 2001-06-26 Dirk Herrmann <D.Herrmann@tu-bs.de> * filesys.c (scm_close), ports.c (scm_close_port, diff --git a/libguile/async.c b/libguile/async.c index d93ce7d1a..e5946393c 100644 --- a/libguile/async.c +++ b/libguile/async.c @@ -363,7 +363,7 @@ SCM_DEFINE (scm_run_asyncs, "run-asyncs", 1, 0, 0, if (ASYNC_GOT_IT (a)) { SET_ASYNC_GOT_IT (a, 0); - scm_apply (ASYNC_THUNK (a), SCM_EOL, SCM_EOL); + scm_call_0 (ASYNC_THUNK (a)); } scm_mask_ints = 0; list_of_a = SCM_CDR (list_of_a); diff --git a/libguile/coop-threads.c b/libguile/coop-threads.c index 0c9feb287..fda74aa6d 100644 --- a/libguile/coop-threads.c +++ b/libguile/coop-threads.c @@ -180,21 +180,19 @@ typedef struct scheme_launch_data { SCM handler; } scheme_launch_data; -extern SCM scm_apply (SCM, SCM, SCM); - static SCM scheme_body_bootstrip (scheme_launch_data* data) { /* First save the new root continuation */ data->rootcont = scm_root->rootcont; - return scm_apply (data->body, SCM_EOL, SCM_EOL); + return scm_call_0 (data->body); } static SCM scheme_handler_bootstrip (scheme_launch_data* data, SCM tag, SCM throw_args) { scm_root->rootcont = data->rootcont; - return scm_apply (data->handler, scm_cons (tag, throw_args), SCM_EOL); + return scm_apply_1 (data->handler, tag, throw_args); } static void diff --git a/libguile/debug.c b/libguile/debug.c index 29d259d60..c4c738009 100644 --- a/libguile/debug.c +++ b/libguile/debug.c @@ -120,7 +120,7 @@ static SCM with_traps_inner (void *data) { SCM thunk = SCM_PACK (data); - return scm_apply (thunk, SCM_EOL, SCM_EOL); + return scm_call_0 (thunk); } SCM_DEFINE (scm_with_traps, "with-traps", 1, 0, 0, diff --git a/libguile/dynwind.c b/libguile/dynwind.c index f0777ab92..9c6ab1069 100644 --- a/libguile/dynwind.c +++ b/libguile/dynwind.c @@ -125,11 +125,11 @@ SCM_DEFINE (scm_dynamic_wind, "dynamic-wind", 3, 0, 0, SCM_ASSERT (SCM_NFALSEP (scm_thunk_p (out_guard)), out_guard, SCM_ARG3, FUNC_NAME); - scm_apply (in_guard, SCM_EOL, SCM_EOL); + scm_call_0 (in_guard); scm_dynwinds = scm_acons (in_guard, out_guard, scm_dynwinds); - ans = scm_apply (thunk, SCM_EOL, SCM_EOL); + ans = scm_call_0 (thunk); scm_dynwinds = SCM_CDR (scm_dynwinds); - scm_apply (out_guard, SCM_EOL, SCM_EOL); + scm_call_0 (out_guard); return ans; } #undef FUNC_NAME @@ -231,7 +231,7 @@ scm_dowinds (SCM to, long delta) else if (SCM_GUARDSP (wind_key)) SCM_BEFORE_GUARD (wind_key) (SCM_GUARD_DATA (wind_key)); else if (SCM_TYP3 (wind_key) == scm_tc3_closure) - scm_apply (wind_key, SCM_EOL, SCM_EOL); + scm_call_0 (wind_key); } } scm_dynwinds = to; @@ -263,7 +263,7 @@ scm_dowinds (SCM to, long delta) else if (SCM_GUARDSP (wind_key)) SCM_AFTER_GUARD (wind_key) (SCM_GUARD_DATA (wind_key)); else if (SCM_TYP3 (wind_key) == scm_tc3_closure) - scm_apply (from, SCM_EOL, SCM_EOL); + scm_call_0 (from); } } delta--; diff --git a/libguile/environments.c b/libguile/environments.c index ea6230ba9..58a4cff8b 100644 --- a/libguile/environments.c +++ b/libguile/environments.c @@ -1613,7 +1613,7 @@ import_environment_conflict (SCM env, SCM sym, SCM imports) SCM conflict_proc = IMPORT_ENVIRONMENT (env)->conflict_proc; SCM args = scm_cons2 (env, sym, scm_cons (imports, SCM_EOL)); - return scm_apply (conflict_proc, args, SCM_EOL); + return scm_apply_0 (conflict_proc, args); } diff --git a/libguile/eval.c b/libguile/eval.c index 53177f6ae..5d07e2434 100644 --- a/libguile/eval.c +++ b/libguile/eval.c @@ -1246,7 +1246,7 @@ scm_macroexp (SCM x, SCM env) return x; SCM_SETCAR (x, orig_sym); /* Undo memoizing effect of lookupcar */ - res = scm_apply (SCM_MACRO_CODE (proc), x, scm_cons (env, scm_listofnull)); + res = scm_call_2 (SCM_MACRO_CODE (proc), x, env); if (scm_ilength (res) <= 0) res = scm_cons2 (SCM_IM_BEGIN, res, SCM_EOL); @@ -3245,6 +3245,62 @@ ret: #ifndef DEVAL + +/* Simple procedure calls + */ + +SCM +scm_call_0 (SCM proc) +{ + return scm_apply (proc, SCM_EOL, SCM_EOL); +} + +SCM +scm_call_1 (SCM proc, SCM arg1) +{ + return scm_apply (proc, arg1, scm_listofnull); +} + +SCM +scm_call_2 (SCM proc, SCM arg1, SCM arg2) +{ + return scm_apply (proc, arg1, scm_cons (arg2, scm_listofnull)); +} + +SCM +scm_call_3 (SCM proc, SCM arg1, SCM arg2, SCM arg3) +{ + return scm_apply (proc, arg1, scm_cons2 (arg2, arg3, scm_listofnull)); +} + +/* Simple procedure applies + */ + +SCM +scm_apply_0 (SCM proc, SCM args) +{ + return scm_apply (proc, args, SCM_EOL); +} + +SCM +scm_apply_1 (SCM proc, SCM arg1, SCM args) +{ + return scm_apply (proc, scm_cons (arg1, args), SCM_EOL); +} + +SCM +scm_apply_2 (SCM proc, SCM arg1, SCM arg2, SCM args) +{ + return scm_apply (proc, scm_cons2 (arg1, arg2, args), SCM_EOL); +} + +SCM +scm_apply_3 (SCM proc, SCM arg1, SCM arg2, SCM arg3, SCM args) +{ + return scm_apply (proc, scm_cons (arg1, scm_cons2 (arg2, arg3, args)), + SCM_EOL); +} + /* This code processes the arguments to apply: (apply PROC ARG1 ... ARGS) @@ -3812,7 +3868,7 @@ SCM_DEFINE (scm_force, "force", 1, 0, 0, SCM_VALIDATE_SMOB (1, x, promise); if (!((1L << 16) & SCM_CELL_WORD_0 (x))) { - SCM ans = scm_apply (SCM_CELL_OBJECT_1 (x), SCM_EOL, SCM_EOL); + SCM ans = scm_call_0 (SCM_CELL_OBJECT_1 (x)); if (!((1L << 16) & SCM_CELL_WORD_0 (x))) { SCM_DEFER_INTS; @@ -3948,7 +4004,7 @@ scm_primitive_eval_x (SCM exp) SCM env; SCM transformer = scm_current_module_transformer (); if (SCM_NIMP (transformer)) - exp = scm_apply (transformer, exp, scm_listofnull); + exp = scm_call_1 (transformer, exp); env = scm_top_level_env (scm_current_module_lookup_closure ()); return scm_i_eval_x (exp, env); } @@ -3962,7 +4018,7 @@ SCM_DEFINE (scm_primitive_eval, "primitive-eval", 1, 0, 0, SCM env; SCM transformer = scm_current_module_transformer (); if (SCM_NIMP (transformer)) - exp = scm_apply (transformer, exp, scm_listofnull); + exp = scm_call_1 (transformer, exp); env = scm_top_level_env (scm_current_module_lookup_closure ()); return scm_i_eval (exp, env); } diff --git a/libguile/eval.h b/libguile/eval.h index 133d8b4c2..35de8a6b2 100644 --- a/libguile/eval.h +++ b/libguile/eval.h @@ -231,6 +231,14 @@ extern SCM scm_m_at_call_with_values (SCM xorig, SCM env); extern int scm_badargsp (SCM formals, SCM args); extern SCM scm_ceval (SCM x, SCM env); extern SCM scm_deval (SCM x, SCM env); +extern SCM scm_call_0 (SCM proc); +extern SCM scm_call_1 (SCM proc, SCM arg1); +extern SCM scm_call_2 (SCM proc, SCM arg1, SCM arg2); +extern SCM scm_call_3 (SCM proc, SCM arg1, SCM arg2, SCM arg3); +extern SCM scm_apply_0 (SCM proc, SCM args); +extern SCM scm_apply_1 (SCM proc, SCM arg1, SCM args); +extern SCM scm_apply_2 (SCM proc, SCM arg1, SCM arg2, SCM args); +extern SCM scm_apply_3 (SCM proc, SCM arg1, SCM arg2, SCM arg3, SCM args); extern SCM scm_nconc2last (SCM lst); extern SCM scm_apply (SCM proc, SCM arg1, SCM args); extern SCM scm_dapply (SCM proc, SCM arg1, SCM args); diff --git a/libguile/fluids.c b/libguile/fluids.c index 9aba42bf5..206808ab1 100644 --- a/libguile/fluids.c +++ b/libguile/fluids.c @@ -213,7 +213,7 @@ scm_swap_fluids_reverse (SCM fluids, SCM vals) static SCM apply_thunk (void *thunk) { - return scm_apply (SCM_PACK (thunk), SCM_EOL, SCM_EOL); + return scm_call_0 (SCM_PACK (thunk)); } SCM_DEFINE (scm_with_fluids, "with-fluids*", 3, 0, 0, diff --git a/libguile/goops.c b/libguile/goops.c index 176cddec5..3ae186e75 100644 --- a/libguile/goops.c +++ b/libguile/goops.c @@ -63,6 +63,7 @@ #include "libguile/ports.h" #include "libguile/procprop.h" #include "libguile/random.h" +#include "libguile/root.h" #include "libguile/smob.h" #include "libguile/strings.h" #include "libguile/strports.h" @@ -79,9 +80,8 @@ scm_module_goops); } /* Temporary hack until we get the new module system */ /*fixme* Should optimize by keeping track of the variable object itself */ -#define GETVAR(v) (SCM_VARIABLE_REF (scm_apply (scm_goops_lookup_closure, \ - SCM_LIST2 ((v), SCM_BOOL_F), \ - SCM_EOL))) +#define GETVAR(v) (SCM_VARIABLE_REF (scm_call_2 (scm_goops_lookup_closure, \ + (v), SCM_BOOL_F))) /* Fixme: Should use already interned symbols */ #define CALL_GF1(name,a) (scm_apply (GETVAR (scm_str2symbol (name)), \ @@ -1513,7 +1513,7 @@ go_to_heaven (void *o) static SCM purgatory (void *args) { - return scm_apply (GETVAR (scm_str2symbol ("change-class")), (SCM) args, SCM_EOL); + return scm_apply_0 (GETVAR (scm_str2symbol ("change-class")), (SCM) args); } void @@ -2339,9 +2339,7 @@ make_class_from_template (char *template, char *type_name, SCM supers) /* Only define name if doesn't already exist. */ if (!SCM_GOOPS_UNBOUNDP (name) - && SCM_FALSEP (scm_apply (scm_goops_lookup_closure, - SCM_LIST2 (name, SCM_BOOL_F), - SCM_EOL))) + && SCM_FALSEP (scm_call_2 (scm_goops_lookup_closure, name, SCM_BOOL_F))) DEFVAR (name, class); return class; } @@ -2588,9 +2586,7 @@ scm_wrap_component (SCM class, SCM container, void *data) SCM scm_ensure_accessor (SCM name) { - SCM gf = scm_apply (SCM_TOP_LEVEL_LOOKUP_CLOSURE, - SCM_LIST2 (name, SCM_BOOL_F), - SCM_EOL); + SCM gf = scm_call_2 (SCM_TOP_LEVEL_LOOKUP_CLOSURE, name, SCM_BOOL_F); if (!SCM_IS_A_P (gf, scm_class_generic_with_setter)) { gf = scm_make (SCM_LIST3 (scm_class_generic, k_name, name)); diff --git a/libguile/hashtab.c b/libguile/hashtab.c index 442bfd644..fa2840bb8 100644 --- a/libguile/hashtab.c +++ b/libguile/hashtab.c @@ -48,6 +48,7 @@ #include "libguile/alist.h" #include "libguile/hash.h" #include "libguile/eval.h" +#include "libguile/root.h" #include "libguile/vectors.h" #include "libguile/validate.h" @@ -380,9 +381,7 @@ scm_ihashx (SCM obj, unsigned long n, scm_t_ihashx_closure *closure) { SCM answer; SCM_DEFER_INTS; - answer = scm_apply (closure->hash, - SCM_LIST2 (obj, scm_ulong2num ((unsigned long)n)), - SCM_EOL); + answer = scm_call_2 (closure->hash, obj, scm_ulong2num ((unsigned long) n)); SCM_ALLOW_INTS; return SCM_INUM (answer); } @@ -394,9 +393,7 @@ scm_sloppy_assx (SCM obj, SCM alist, scm_t_ihashx_closure *closure) { SCM answer; SCM_DEFER_INTS; - answer = scm_apply (closure->assoc, - SCM_LIST2 (obj, alist), - SCM_EOL); + answer = scm_call_2 (closure->assoc, obj, alist); SCM_ALLOW_INTS; return answer; } @@ -409,9 +406,7 @@ scm_delx_x (SCM obj, SCM alist, scm_t_ihashx_closure *closure) { SCM answer; SCM_DEFER_INTS; - answer = scm_apply (closure->delete, - SCM_LIST2 (obj, alist), - SCM_EOL); + answer = scm_call_2 (closure->delete, obj, alist); SCM_ALLOW_INTS; return answer; } @@ -519,7 +514,7 @@ scm_hashx_remove_x (SCM hash, SCM assoc, SCM delete, SCM table, SCM obj) static SCM fold_proc (void *proc, SCM key, SCM data, SCM value) { - return scm_apply (SCM_PACK (proc), SCM_LIST3 (key, data, value), SCM_EOL); + return scm_call_3 (SCM_PACK (proc), key, data, value); } SCM_DEFINE (scm_hash_fold, "hash-fold", 3, 0, 0, diff --git a/libguile/hooks.c b/libguile/hooks.c index f0713f5eb..120ef1287 100644 --- a/libguile/hooks.c +++ b/libguile/hooks.c @@ -307,7 +307,7 @@ scm_c_run_hook (SCM hook, SCM args) SCM procs = SCM_HOOK_PROCEDURES (hook); while (SCM_NIMP (procs)) { - scm_apply (SCM_CAR (procs), args, SCM_EOL); + scm_apply_0 (SCM_CAR (procs), args); procs = SCM_CDR (procs); } } diff --git a/libguile/load.c b/libguile/load.c index 3f6fff049..8cb726a04 100644 --- a/libguile/load.c +++ b/libguile/load.c @@ -119,7 +119,7 @@ SCM_DEFINE (scm_primitive_load, "primitive-load", 1, 0, 0, SCM_EOL); if (! SCM_FALSEP (hook)) - scm_apply (hook, SCM_LIST1 (filename), SCM_EOL); + scm_call_1 (hook, filename); { /* scope */ SCM port, save_port; diff --git a/libguile/modules.c b/libguile/modules.c index 0e9fd0b4a..dd912cf2d 100644 --- a/libguile/modules.c +++ b/libguile/modules.c @@ -162,17 +162,15 @@ scm_c_resolve_module (const char *name) SCM scm_resolve_module (SCM name) { - return scm_apply (SCM_VARIABLE_REF (resolve_module_var), - SCM_LIST1 (name), SCM_EOL); + return scm_call_1 (SCM_VARIABLE_REF (resolve_module_var), name); } SCM scm_c_define_module (const char *name, void (*init)(void *), void *data) { - SCM module = scm_apply (SCM_VARIABLE_REF (process_define_module_var), - SCM_LIST1 (SCM_LIST1 (convert_module_name (name))), - SCM_EOL); + SCM module = scm_call_1 (SCM_VARIABLE_REF (process_define_module_var), + SCM_LIST1 (convert_module_name (name))); if (init) scm_c_call_with_current_module (module, (SCM (*)(void*))init, data); return module; @@ -181,9 +179,8 @@ scm_c_define_module (const char *name, void scm_c_use_module (const char *name) { - scm_apply (SCM_VARIABLE_REF (process_use_modules_var), - SCM_LIST1 (SCM_LIST1 (convert_module_name (name))), - SCM_EOL); + scm_call_1 (SCM_VARIABLE_REF (process_use_modules_var), + SCM_LIST1 (convert_module_name (name))); } static SCM module_export_x_var; @@ -203,10 +200,8 @@ scm_c_export (const char *name, ...) *tail = scm_cons (scm_str2symbol (n), SCM_EOL); tail = SCM_CDRLOC (*tail); } - scm_apply (SCM_VARIABLE_REF (module_export_x_var), - SCM_LIST2 (scm_current_module (), - names), - SCM_EOL); + scm_call_2 (SCM_VARIABLE_REF (module_export_x_var), + scm_current_module (), names); } /* Environments */ @@ -292,9 +287,7 @@ module_variable (SCM module, SCM sym) if (SCM_NFALSEP (binder)) /* 2. Custom binder */ { - b = scm_apply (binder, - SCM_LIST3 (module, sym, SCM_BOOL_F), - SCM_EOL); + b = scm_call_3 (binder, module, sym, SCM_BOOL_F); if (SCM_NFALSEP (b)) return b; } @@ -329,9 +322,8 @@ scm_eval_closure_lookup (SCM eclo, SCM sym, SCM definep) { if (SCM_EVAL_CLOSURE_INTERFACE_P (eclo)) return SCM_BOOL_F; - return scm_apply (SCM_VARIABLE_REF (module_make_local_var_x_var), - SCM_LIST2 (module, sym), - SCM_EOL); + return scm_call_2 (SCM_VARIABLE_REF (module_make_local_var_x_var), + module, sym); } else return module_variable (module, sym); @@ -423,7 +415,7 @@ scm_sym2var (SCM sym, SCM proc, SCM definep) var = scm_eval_closure_lookup (proc, sym, definep); } else - var = scm_apply (proc, sym, scm_cons (definep, scm_listofnull)); + var = scm_call_2 (proc, sym, definep); } else { @@ -686,10 +678,9 @@ scm_make_module (SCM name) scm_c_issue_deprecation_warning ("`scm_make_module' is deprecated. " "Use `scm_c_define_module instead."); - return scm_apply (SCM_VARIABLE_REF (make_modules_in_var), - SCM_LIST2 (scm_the_root_module (), - scm_module_full_name (name)), - SCM_EOL); + return scm_call_2 (SCM_VARIABLE_REF (make_modules_in_var), + scm_the_root_module (), + scm_module_full_name (name)); } SCM @@ -698,8 +689,7 @@ scm_ensure_user_module (SCM module) scm_c_issue_deprecation_warning ("`scm_ensure_user_module' is deprecated. " "Use `scm_c_define_module instead."); - scm_apply (SCM_VARIABLE_REF (beautify_user_module_x_var), - SCM_LIST1 (module), SCM_EOL); + scm_call_1 (SCM_VARIABLE_REF (beautify_user_module_x_var), module); return SCM_UNSPECIFIED; } @@ -709,8 +699,7 @@ scm_load_scheme_module (SCM name) scm_c_issue_deprecation_warning ("`scm_load_scheme_module' is deprecated. " "Use `scm_c_resolve_module instead."); - return scm_apply (SCM_VARIABLE_REF (try_module_autoload_var), - SCM_LIST1 (name), SCM_EOL); + return scm_call_1 (SCM_VARIABLE_REF (try_module_autoload_var), name); } #endif diff --git a/libguile/ports.c b/libguile/ports.c index 49902d7e2..0dddda802 100644 --- a/libguile/ports.c +++ b/libguile/ports.c @@ -732,7 +732,7 @@ SCM_DEFINE (scm_port_for_each, "port-for-each", 1, 0, 0, while (ports != SCM_EOL) { - scm_apply (proc, scm_cons (SCM_CAR (ports), SCM_EOL), SCM_EOL); + scm_call_1 (proc, SCM_CAR (ports)); ports = SCM_CDR (ports); } diff --git a/libguile/print.c b/libguile/print.c index 6583b3f42..9159f996b 100644 --- a/libguile/print.c +++ b/libguile/print.c @@ -1068,7 +1068,7 @@ scm_printer_apply (SCM proc, SCM exp, SCM port, scm_print_state *pstate) SCM pair = scm_cons (port, pstate->handle); SCM_NEWSMOB (pwps, scm_tc16_port_with_ps, SCM_UNPACK (pair)); pstate->revealed = 1; - return scm_apply (proc, exp, scm_cons (pwps, scm_listofnull)); + return scm_call_2 (proc, exp, pwps); } SCM_DEFINE (scm_port_with_print_state, "port-with-print-state", 2, 0, 0, diff --git a/libguile/properties.c b/libguile/properties.c index 6d9d8031b..b95c5d3da 100644 --- a/libguile/properties.c +++ b/libguile/properties.c @@ -100,7 +100,7 @@ SCM_DEFINE (scm_primitive_property_ref, "primitive-property-ref", 2, 0, 0, return SCM_BOOL_F; else { - SCM val = scm_apply (SCM_CAR (prop), SCM_LIST2 (prop, obj), SCM_EOL); + SCM val = scm_call_2 (SCM_CAR (prop), prop, obj); if (SCM_FALSEP (h)) h = scm_hashq_create_handle_x (scm_properties_whash, obj, SCM_EOL); SCM_SETCDR (h, scm_acons (prop, val, SCM_CDR (h))); diff --git a/libguile/ramap.c b/libguile/ramap.c index 7d49cdbd9..e21d7b8b3 100644 --- a/libguile/ramap.c +++ b/libguile/ramap.c @@ -1241,7 +1241,7 @@ ramap (SCM ra0,SCM proc,SCM ras) ra0 = SCM_ARRAY_V (ra0); if (SCM_NULLP (ras)) for (; i <= n; i++) - scm_array_set_x (ra0, scm_apply (proc, SCM_EOL, SCM_EOL), SCM_MAKINUM (i * inc + base)); + scm_array_set_x (ra0, scm_call_0 (proc), SCM_MAKINUM (i * inc + base)); else { SCM ra1 = SCM_CAR (ras); @@ -1263,7 +1263,7 @@ ramap (SCM ra0,SCM proc,SCM ras) for (k = SCM_INUM (scm_uniform_vector_length (ras)); k--;) args = scm_cons (scm_uniform_vector_ref (ve[k], SCM_MAKINUM (i)), args); args = scm_cons (scm_cvref (ra1, i1, SCM_UNDEFINED), args); - scm_array_set_x (ra0, scm_apply (proc, args, SCM_EOL), SCM_MAKINUM (i * inc + base)); + scm_array_set_x (ra0, scm_apply_0 (proc, args), SCM_MAKINUM (i * inc + base)); } } return 1; @@ -1285,7 +1285,7 @@ ramap_cxr (SCM ra0,SCM proc,SCM ras) default: gencase: for (; n-- > 0; i0 += inc0, i1 += inc1) - scm_array_set_x (ra0, scm_apply (proc, RVREF (ra1, i1, e1), scm_listofnull), SCM_MAKINUM (i0)); + scm_array_set_x (ra0, scm_call_1 (proc, RVREF (ra1, i1, e1)), SCM_MAKINUM (i0)); break; case scm_tc7_fvect: { @@ -1635,7 +1635,7 @@ rafe (SCM ra0,SCM proc,SCM ras) ra0 = SCM_ARRAY_V (ra0); if (SCM_NULLP (ras)) for (; i <= n; i++, i0 += inc0) - scm_apply (proc, scm_cvref (ra0, i0, SCM_UNDEFINED), scm_listofnull); + scm_call_1 (proc, scm_cvref (ra0, i0, SCM_UNDEFINED)); else { SCM ra1 = SCM_CAR (ras); @@ -1657,7 +1657,7 @@ rafe (SCM ra0,SCM proc,SCM ras) for (k = SCM_INUM (scm_uniform_vector_length (ras)); k--;) args = scm_cons (scm_uniform_vector_ref (ve[k], SCM_MAKINUM (i)), args); args = scm_cons2 (scm_cvref (ra0, i0, SCM_UNDEFINED), scm_cvref (ra1, i1, SCM_UNDEFINED), args); - scm_apply (proc, args, SCM_EOL); + scm_apply_0 (proc, args); } } return 1; @@ -1710,7 +1710,7 @@ SCM_DEFINE (scm_array_index_map_x, "array-index-map!", 2, 0, 0, { SCM *ve = SCM_VELTS (ra); for (i = 0; i < SCM_VECTOR_LENGTH (ra); i++) - ve[i] = scm_apply (proc, SCM_MAKINUM (i), scm_listofnull); + ve[i] = scm_call_1 (proc, SCM_MAKINUM (i)); return SCM_UNSPECIFIED; } case scm_tc7_string: @@ -1728,7 +1728,7 @@ SCM_DEFINE (scm_array_index_map_x, "array-index-map!", 2, 0, 0, { unsigned long int length = SCM_INUM (scm_uniform_vector_length (ra)); for (i = 0; i < length; i++) - scm_array_set_x (ra, scm_apply (proc, SCM_MAKINUM (i), scm_listofnull), + scm_array_set_x (ra, scm_call_1 (proc, SCM_MAKINUM (i)), SCM_MAKINUM (i)); return SCM_UNSPECIFIED; } @@ -1740,8 +1740,7 @@ SCM_DEFINE (scm_array_index_map_x, "array-index-map!", 2, 0, 0, long *vinds = (long *) SCM_VELTS (inds); int j, k, kmax = SCM_ARRAY_NDIM (ra) - 1; if (kmax < 0) - return scm_array_set_x (ra, scm_apply(proc, SCM_EOL, SCM_EOL), - SCM_EOL); + return scm_array_set_x (ra, scm_call_0 (proc), SCM_EOL); for (k = 0; k <= kmax; k++) vinds[k] = SCM_ARRAY_DIMS (ra)[k].lbnd; k = kmax; @@ -1756,7 +1755,7 @@ SCM_DEFINE (scm_array_index_map_x, "array-index-map!", 2, 0, 0, for (j = kmax + 1, args = SCM_EOL; j--;) args = scm_cons (SCM_MAKINUM (vinds[j]), args); scm_array_set_x (SCM_ARRAY_V (ra), - scm_apply (proc, args, SCM_EOL), + scm_apply_0 (proc, args), SCM_MAKINUM (i)); i += SCM_ARRAY_DIMS (ra)[k].inc; } diff --git a/libguile/read.c b/libguile/read.c index 4dd745d67..214118473 100644 --- a/libguile/read.c +++ b/libguile/read.c @@ -424,9 +424,7 @@ tryagain_no_flush_ws: int column = SCM_COL (port) - 2; SCM got; - got = scm_apply (sharp, - SCM_MAKE_CHAR (c), - scm_acons (port, SCM_EOL, SCM_EOL)); + got = scm_call_2 (sharp, SCM_MAKE_CHAR (c), port); if (SCM_EQ_P (got, SCM_UNSPECIFIED)) goto unkshrp; if (SCM_RECORD_POSITIONS_P) diff --git a/libguile/scmsigs.c b/libguile/scmsigs.c index c36c83d98..bdbf525e7 100644 --- a/libguile/scmsigs.c +++ b/libguile/scmsigs.c @@ -51,6 +51,7 @@ #include "libguile/async.h" #include "libguile/eval.h" +#include "libguile/root.h" #include "libguile/vectors.h" #include "libguile/validate.h" @@ -166,9 +167,7 @@ sys_deliver_signals (void) #ifndef HAVE_SIGACTION signal (i, take_signal); #endif - scm_apply (SCM_VELTS (*signal_handlers)[i], - SCM_LIST1 (SCM_MAKINUM (i)), - SCM_EOL); + scm_call_1 (SCM_VELTS (*signal_handlers)[i], SCM_MAKINUM (i)); } } return SCM_UNSPECIFIED; diff --git a/libguile/sort.c b/libguile/sort.c index 76867843a..f2edb5a17 100644 --- a/libguile/sort.c +++ b/libguile/sort.c @@ -86,6 +86,7 @@ char *alloca (); #include "libguile/ramap.h" #include "libguile/alist.h" #include "libguile/feature.h" +#include "libguile/root.h" #include "libguile/vectors.h" #include "libguile/validate.h" @@ -385,10 +386,7 @@ closureless (SCM code, const void *a, const void *b) static int applyless (SCM less, const void *a, const void *b) { - return SCM_NFALSEP (scm_apply (less, - scm_cons (*(SCM *) a, - scm_cons (*(SCM *) b, SCM_EOL)), - SCM_EOL)); + return SCM_NFALSEP (scm_call_2 (less, *(SCM *) a, *(SCM *) b)); } /* applyless */ static cmp_fun_t diff --git a/libguile/strports.c b/libguile/strports.c index 2ce941b76..f968c46ee 100644 --- a/libguile/strports.c +++ b/libguile/strports.c @@ -333,7 +333,7 @@ SCM_DEFINE (scm_object_to_string, "object->string", 1, 1, 0, if (SCM_UNBNDP (printer)) scm_write (obj, port); else - scm_apply (printer, SCM_LIST2 (obj, port), SCM_EOL); + scm_call_2 (printer, obj, port); return scm_strport_to_string (port); } @@ -362,7 +362,7 @@ SCM_DEFINE (scm_call_with_output_string, "call-with-output-string", 1, 0, 0, scm_make_string (SCM_INUM0, SCM_UNDEFINED), SCM_OPN | SCM_WRTNG, FUNC_NAME); - scm_apply (proc, p, scm_listofnull); + scm_call_1 (proc, p); return scm_strport_to_string (p); } @@ -376,7 +376,7 @@ SCM_DEFINE (scm_call_with_input_string, "call-with-input-string", 2, 0, 0, #define FUNC_NAME s_scm_call_with_input_string { SCM p = scm_mkstrport(SCM_INUM0, string, SCM_OPN | SCM_RDNG, FUNC_NAME); - return scm_apply (proc, p, scm_listofnull); + return scm_call_1 (proc, p); } #undef FUNC_NAME diff --git a/libguile/throw.c b/libguile/throw.c index 9d4f0aeca..62468437b 100644 --- a/libguile/throw.c +++ b/libguile/throw.c @@ -348,7 +348,7 @@ scm_body_thunk (void *body_data) { struct scm_body_thunk_data *c = (struct scm_body_thunk_data *) body_data; - return scm_apply (c->body_proc, SCM_EOL, SCM_EOL); + return scm_call_0 (c->body_proc); } @@ -367,7 +367,7 @@ scm_handle_by_proc (void *handler_data, SCM tag, SCM throw_args) { SCM *handler_proc_p = (SCM *) handler_data; - return scm_apply (*handler_proc_p, scm_cons (tag, throw_args), SCM_EOL); + return scm_apply_1 (*handler_proc_p, tag, throw_args); } /* SCM_HANDLE_BY_PROC_CATCHING_ALL is like SCM_HANDLE_BY_PROC but @@ -383,7 +383,7 @@ static SCM hbpca_body (void *body_data) { struct hbpca_data *data = (struct hbpca_data *)body_data; - return scm_apply (data->proc, data->args, SCM_EOL); + return scm_apply_0 (data->proc, data->args); } SCM diff --git a/libguile/unif.c b/libguile/unif.c index 17aad0774..0e7319b7a 100644 --- a/libguile/unif.c +++ b/libguile/unif.c @@ -721,7 +721,7 @@ SCM_DEFINE (scm_make_shared_array, "make-shared-array", 2, 0, 1, return ra; } } - imap = scm_apply (mapfunc, scm_reverse (inds), SCM_EOL); + imap = scm_apply_0 (mapfunc, scm_reverse (inds)); if (SCM_ARRAYP (oldra)) i = (size_t) scm_aind (oldra, imap, FUNC_NAME); else @@ -743,7 +743,7 @@ SCM_DEFINE (scm_make_shared_array, "make-shared-array", 2, 0, 1, if (s[k].ubnd > s[k].lbnd) { SCM_SETCAR (indptr, SCM_MAKINUM (SCM_INUM (SCM_CAR (indptr)) + 1)); - imap = scm_apply (mapfunc, scm_reverse (inds), SCM_EOL); + imap = scm_apply_0 (mapfunc, scm_reverse (inds)); if (SCM_ARRAYP (oldra)) s[k].inc = scm_aind (oldra, imap, FUNC_NAME) - i; diff --git a/libguile/vports.c b/libguile/vports.c index 33ae23520..50c3b76fb 100644 --- a/libguile/vports.c +++ b/libguile/vports.c @@ -81,8 +81,7 @@ sf_flush (SCM port) if (pt->write_pos > pt->write_buf) { /* write the byte. */ - scm_apply (SCM_VELTS (stream)[0], SCM_MAKE_CHAR (*pt->write_buf), - scm_listofnull); + scm_call_1 (SCM_VELTS (stream)[0], SCM_MAKE_CHAR (*pt->write_buf)); pt->write_pos = pt->write_buf; /* flush the output. */ @@ -90,7 +89,7 @@ sf_flush (SCM port) SCM f = SCM_VELTS (stream)[2]; if (!SCM_FALSEP (f)) - scm_apply (f, SCM_EOL, SCM_EOL); + scm_call_0 (f); } } } @@ -100,9 +99,7 @@ sf_write (SCM port, const void *data, size_t size) { SCM p = SCM_PACK (SCM_STREAM (port)); - scm_apply (SCM_VELTS (p)[1], - scm_cons (scm_mem2string ((char *) data, size), SCM_EOL), - SCM_EOL); + scm_call_1 (SCM_VELTS (p)[1], scm_mem2string ((char *) data, size)); } /* calling the flush proc (element 2) is in case old code needs it, @@ -116,7 +113,7 @@ sf_fill_input (SCM port) SCM p = SCM_PACK (SCM_STREAM (port)); SCM ans; - ans = scm_apply (SCM_VELTS (p)[3], SCM_EOL, SCM_EOL); /* get char. */ + ans = scm_call_0 (SCM_VELTS (p)[3]); /* get char. */ if (SCM_FALSEP (ans) || SCM_EOF_OBJECT_P (ans)) return EOF; SCM_ASSERT (SCM_CHARP (ans), ans, SCM_ARG1, "sf_fill_input"); @@ -138,7 +135,7 @@ sf_close (SCM port) SCM f = SCM_VELTS (p)[4]; if (SCM_FALSEP (f)) return 0; - f = scm_apply (f, SCM_EOL, SCM_EOL); + f = scm_call_0 (f); errno = 0; return SCM_FALSEP (f) ? EOF : 0; } |