summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorKeisuke Nishida <kxn30@po.cwru.edu>2001-06-26 15:46:40 +0000
committerKeisuke Nishida <kxn30@po.cwru.edu>2001-06-26 15:46:40 +0000
commitfdc2839563bd8c821221a4869f27255ae77f757b (patch)
tree63bc043598fe6d9c2cac3d3c7251898cc306f5cd
parent36284627919a6968174b5f17369349187a2b4b1b (diff)
downloadguile-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/ChangeLog29
-rw-r--r--libguile/async.c2
-rw-r--r--libguile/coop-threads.c6
-rw-r--r--libguile/debug.c2
-rw-r--r--libguile/dynwind.c10
-rw-r--r--libguile/environments.c2
-rw-r--r--libguile/eval.c64
-rw-r--r--libguile/eval.h8
-rw-r--r--libguile/fluids.c2
-rw-r--r--libguile/goops.c16
-rw-r--r--libguile/hashtab.c15
-rw-r--r--libguile/hooks.c2
-rw-r--r--libguile/load.c2
-rw-r--r--libguile/modules.c43
-rw-r--r--libguile/ports.c2
-rw-r--r--libguile/print.c2
-rw-r--r--libguile/properties.c2
-rw-r--r--libguile/ramap.c19
-rw-r--r--libguile/read.c4
-rw-r--r--libguile/scmsigs.c5
-rw-r--r--libguile/sort.c6
-rw-r--r--libguile/strports.c6
-rw-r--r--libguile/throw.c6
-rw-r--r--libguile/unif.c4
-rw-r--r--libguile/vports.c13
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;
}