mirror/guile
mirror/guile
1
Fork 0
mirror of https://git.savannah.gnu.org/git/guile.git synced 2025-06-03 18:50:19 +02:00
Code Activity

* eval.c (scm_call_0, scm_call_1, scm_call_2, scm_call_3,

Browse source 
scm_apply_0, scm_apply_1, scm_apply_2, scm_apply_3): New functions.
This commit is contained in:
Keisuke Nishida 2001-06-26 15:46:40 +00:00
parent 3628462791
commit fdc2839563
25 changed files with 167 additions and 105 deletions
Download patch file Download diff file Expand all files Collapse all files

29
libguile/ChangeLog
View file

@ -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,

2
libguile/async.c
View file

@ -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);

6
libguile/coop-threads.c
View file

@ -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

2
libguile/debug.c
View file

@ -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,

10
libguile/dynwind.c
View file

@ -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--;

2
libguile/environments.c
View file

@ -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);
}

64
libguile/eval.c
View file

@ -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);
}

8
libguile/eval.h
View file

@ -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);

2
libguile/fluids.c
View file

@ -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,

16
libguile/goops.c
View file

@ -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));

15
libguile/hashtab.c
View file

@ -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,

2
libguile/hooks.c
View file

@ -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);
}
}

2
libguile/load.c
View file

@ -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;

43
libguile/modules.c
View file

@ -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

2
libguile/ports.c
View file

@ -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);
}

2
libguile/print.c
View file

@ -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,

2
libguile/properties.c
View file

@ -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)));

19
libguile/ramap.c
View file

@ -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;
}

4
libguile/read.c
View file

@ -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)

5
libguile/scmsigs.c
View file

@ -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;

6
libguile/sort.c
View file

@ -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

6
libguile/strports.c
View file

@ -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

6
libguile/throw.c
View file

@ -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

4
libguile/unif.c
View file

@ -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;

13
libguile/vports.c
View file

@ -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;
}