mirror of
https://git.savannah.gnu.org/git/guile.git
synced 2025-05-09 23:40:29 +02:00
Change eval.c to use scm_c_vm_run instead of scm_call_with_vm.
* libguile/eval.c (scm_apply_0, scm_apply_1, scm_apply_2, scm_apply_3) (scm_map, scm_for_each, scm_apply): Change to prefer scm_apply_0, and to have it call vm_run instead of call_with_vm. (eval): Use scm_apply_0 and scm_call_0. * libguile/srfi-1.c (scm_srfi1_count): Use scm_apply_0.
This commit is contained in:
parent
3583665aa0
commit
6b4ba76d05
2 changed files with 34 additions and 26 deletions
|
@ -312,7 +312,7 @@ eval (SCM x, SCM env)
|
||||||
goto loop;
|
goto loop;
|
||||||
}
|
}
|
||||||
else
|
else
|
||||||
return scm_call_with_vm (scm_the_vm (), proc, args);
|
return scm_apply_0 (proc, args);
|
||||||
|
|
||||||
case SCM_M_CALL:
|
case SCM_M_CALL:
|
||||||
/* Evaluate the procedure to be applied. */
|
/* Evaluate the procedure to be applied. */
|
||||||
|
@ -348,7 +348,7 @@ eval (SCM x, SCM env)
|
||||||
producer = EVAL1 (CAR (mx), env);
|
producer = EVAL1 (CAR (mx), env);
|
||||||
/* `proc' is the consumer. */
|
/* `proc' is the consumer. */
|
||||||
proc = EVAL1 (CDR (mx), env);
|
proc = EVAL1 (CDR (mx), env);
|
||||||
v = scm_call_with_vm (scm_the_vm (), producer, SCM_EOL);
|
v = scm_call_0 (producer);
|
||||||
if (SCM_VALUESP (v))
|
if (SCM_VALUESP (v))
|
||||||
args = scm_struct_ref (v, SCM_INUM0);
|
args = scm_struct_ref (v, SCM_INUM0);
|
||||||
else
|
else
|
||||||
|
@ -586,26 +586,40 @@ scm_call (SCM proc, ...)
|
||||||
SCM
|
SCM
|
||||||
scm_apply_0 (SCM proc, SCM args)
|
scm_apply_0 (SCM proc, SCM args)
|
||||||
{
|
{
|
||||||
return scm_apply (proc, args, SCM_EOL);
|
SCM *argv;
|
||||||
|
int i, nargs;
|
||||||
|
|
||||||
|
nargs = scm_ilength (args);
|
||||||
|
if (SCM_UNLIKELY (nargs < 0))
|
||||||
|
scm_wrong_type_arg_msg ("apply", 2, args, "list");
|
||||||
|
|
||||||
|
/* FIXME: Use vm_builtin_apply instead of alloca. */
|
||||||
|
argv = alloca (nargs * sizeof(SCM));
|
||||||
|
for (i = 0; i < nargs; i++)
|
||||||
|
{
|
||||||
|
argv[i] = SCM_CAR (args);
|
||||||
|
args = SCM_CDR (args);
|
||||||
|
}
|
||||||
|
|
||||||
|
return scm_c_vm_run (scm_the_vm (), proc, argv, nargs);
|
||||||
}
|
}
|
||||||
|
|
||||||
SCM
|
SCM
|
||||||
scm_apply_1 (SCM proc, SCM arg1, SCM args)
|
scm_apply_1 (SCM proc, SCM arg1, SCM args)
|
||||||
{
|
{
|
||||||
return scm_apply (proc, scm_cons (arg1, args), SCM_EOL);
|
return scm_apply_0 (proc, scm_cons (arg1, args));
|
||||||
}
|
}
|
||||||
|
|
||||||
SCM
|
SCM
|
||||||
scm_apply_2 (SCM proc, SCM arg1, SCM arg2, SCM args)
|
scm_apply_2 (SCM proc, SCM arg1, SCM arg2, SCM args)
|
||||||
{
|
{
|
||||||
return scm_apply (proc, scm_cons2 (arg1, arg2, args), SCM_EOL);
|
return scm_apply_0 (proc, scm_cons2 (arg1, arg2, args));
|
||||||
}
|
}
|
||||||
|
|
||||||
SCM
|
SCM
|
||||||
scm_apply_3 (SCM proc, SCM arg1, SCM arg2, SCM arg3, SCM args)
|
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)),
|
return scm_apply_0 (proc, scm_cons (arg1, scm_cons2 (arg2, arg3, args)));
|
||||||
SCM_EOL);
|
|
||||||
}
|
}
|
||||||
|
|
||||||
|
|
||||||
|
@ -618,8 +632,8 @@ scm_map (SCM proc, SCM arg1, SCM args)
|
||||||
var = scm_private_variable (scm_the_root_module (),
|
var = scm_private_variable (scm_the_root_module (),
|
||||||
scm_from_latin1_symbol ("map"));
|
scm_from_latin1_symbol ("map"));
|
||||||
|
|
||||||
return scm_apply (scm_variable_ref (var),
|
return scm_apply_0 (scm_variable_ref (var),
|
||||||
scm_cons (proc, scm_cons (arg1, args)), SCM_EOL);
|
scm_cons (proc, scm_cons (arg1, args)));
|
||||||
}
|
}
|
||||||
|
|
||||||
SCM
|
SCM
|
||||||
|
@ -631,8 +645,8 @@ scm_for_each (SCM proc, SCM arg1, SCM args)
|
||||||
var = scm_private_variable (scm_the_root_module (),
|
var = scm_private_variable (scm_the_root_module (),
|
||||||
scm_from_latin1_symbol ("for-each"));
|
scm_from_latin1_symbol ("for-each"));
|
||||||
|
|
||||||
return scm_apply (scm_variable_ref (var),
|
return scm_apply_0 (scm_variable_ref (var),
|
||||||
scm_cons (proc, scm_cons (arg1, args)), SCM_EOL);
|
scm_cons (proc, scm_cons (arg1, args)));
|
||||||
}
|
}
|
||||||
|
|
||||||
|
|
||||||
|
@ -694,24 +708,18 @@ static SCM f_apply;
|
||||||
|
|
||||||
/* Apply a function to a list of arguments.
|
/* Apply a function to a list of arguments.
|
||||||
|
|
||||||
This function is exported to the Scheme level as taking two
|
This function's interface is a bit wonly. It takes two required
|
||||||
required arguments and a tail argument, as if it were:
|
arguments and a tail argument, as if it were:
|
||||||
|
|
||||||
(lambda (proc arg1 . args) ...)
|
(lambda (proc arg1 . args) ...)
|
||||||
Thus, if you just have a list of arguments to pass to a procedure,
|
|
||||||
pass the list as ARG1, and '() for ARGS. If you have some fixed
|
Usually you want to use scm_apply_0 or one of its cousins. */
|
||||||
args, pass the first as ARG1, then cons any remaining fixed args
|
|
||||||
onto the front of your argument list, and pass that as ARGS. */
|
|
||||||
|
|
||||||
SCM
|
SCM
|
||||||
scm_apply (SCM proc, SCM arg1, SCM args)
|
scm_apply (SCM proc, SCM arg1, SCM args)
|
||||||
{
|
{
|
||||||
/* Fix things up so that args contains all args. */
|
return scm_apply_0 (proc,
|
||||||
if (scm_is_null (args))
|
scm_is_null (args) ? arg1 : scm_cons_star (arg1, args));
|
||||||
args = arg1;
|
|
||||||
else
|
|
||||||
args = scm_cons_star (arg1, args);
|
|
||||||
|
|
||||||
return scm_call_with_vm (scm_the_vm (), proc, args);
|
|
||||||
}
|
}
|
||||||
|
|
||||||
static void
|
static void
|
||||||
|
|
|
@ -1,7 +1,7 @@
|
||||||
/* srfi-1.c --- SRFI-1 procedures for Guile
|
/* srfi-1.c --- SRFI-1 procedures for Guile
|
||||||
*
|
*
|
||||||
* Copyright (C) 1995, 1996, 1997, 2000, 2001, 2002, 2003, 2005, 2006,
|
* Copyright (C) 1995, 1996, 1997, 2000, 2001, 2002, 2003, 2005, 2006,
|
||||||
* 2008, 2009, 2010, 2011 Free Software Foundation, Inc.
|
* 2008, 2009, 2010, 2011, 2013 Free Software Foundation, Inc.
|
||||||
*
|
*
|
||||||
* This library is free software; you can redistribute it and/or
|
* This library is free software; you can redistribute it and/or
|
||||||
* modify it under the terms of the GNU Lesser General Public License
|
* modify it under the terms of the GNU Lesser General Public License
|
||||||
|
@ -258,7 +258,7 @@ SCM_DEFINE (scm_srfi1_count, "count", 2, 0, 1,
|
||||||
SCM_SIMPLE_VECTOR_SET (vec, i, SCM_CDR (lst)); /* rest of lst */
|
SCM_SIMPLE_VECTOR_SET (vec, i, SCM_CDR (lst)); /* rest of lst */
|
||||||
}
|
}
|
||||||
|
|
||||||
count += scm_is_true (scm_apply (pred, args, SCM_EOL));
|
count += scm_is_true (scm_apply_0 (pred, args));
|
||||||
}
|
}
|
||||||
}
|
}
|
||||||
|
|
||||||
|
|
Loading…
Add table
Add a link
Reference in a new issue