1
Fork 0
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:
Andy Wingo 2013-11-21 15:41:27 +01:00
parent 3583665aa0
commit 6b4ba76d05
2 changed files with 34 additions and 26 deletions

View file

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

View file

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