diff options
author | Ludovic Courtès <ludo@gnu.org> | 2009-03-08 16:36:14 +0100 |
---|---|---|
committer | Ludovic Courtès <ludo@gnu.org> | 2009-03-08 16:40:49 +0100 |
commit | 8321ed20f69b4c56cb680563160cd30ecac8f509 (patch) | |
tree | 29c7a0a9988b62826a2fcacd7747b51502d4fc57 /libguile/eval.i.c | |
parent | d18f4d805ed12cc477fa00b3608130785151f3d6 (diff) | |
download | guile-8321ed20f69b4c56cb680563160cd30ecac8f509.tar.gz |
Provide a C vararg interface to gsubr invocation.
* libguile/eval.i.c (CEVAL): Update calls to `scm_i_gsubr_apply ()' with
a fixed number of arguments. Use `scm_i_gsubr_apply_list ()' for
calls with a list of arguments of unknown length.
(SCM_APPLY): Use `scm_i_gsubr_apply_list ()' instead of
`scm_i_gsubr_apply ()'.
* libguile/gsubr.c (gsubr_apply_raw): New.
(scm_i_gsubr_apply): Change to take a C vararg list instead of a
Scheme list. Use `gsubr_apply_raw ()'.
(scm_i_gsubr_apply_list): Use `gsubr_apply_raw ()'.
* libguile/gsubr.h (scm_i_gsubr_apply): Update prototype.
(scm_i_gsubr_apply_list): New declaration.
Diffstat (limited to 'libguile/eval.i.c')
-rw-r--r-- | libguile/eval.i.c | 25 |
1 files changed, 15 insertions, 10 deletions
diff --git a/libguile/eval.i.c b/libguile/eval.i.c index de4851d4b..ae666d415 100644 --- a/libguile/eval.i.c +++ b/libguile/eval.i.c @@ -1129,7 +1129,7 @@ dispatch: debug.info->a.proc = proc; debug.info->a.args = SCM_EOL; #endif - RETURN (scm_i_gsubr_apply (proc, SCM_EOL)); + RETURN (scm_i_gsubr_apply (proc, SCM_UNDEFINED)); case scm_tc7_pws: proc = SCM_PROCEDURE (proc); #ifdef DEVAL @@ -1248,7 +1248,7 @@ dispatch: debug.info->a.args = scm_cons (arg1, debug.info->a.args); debug.info->a.proc = proc; #endif - RETURN (scm_i_gsubr_apply (proc, scm_list_1 (arg1))); + RETURN (scm_i_gsubr_apply (proc, arg1, SCM_UNDEFINED)); case scm_tc7_pws: proc = SCM_PROCEDURE (proc); #ifdef DEVAL @@ -1347,9 +1347,9 @@ dispatch: RETURN (SCM_SMOB_APPLY_2 (proc, arg1, arg2)); case scm_tc7_gsubr: #ifdef DEVAL - RETURN (scm_i_gsubr_apply (proc, debug.info->a.args)); + RETURN (scm_i_gsubr_apply_list (proc, debug.info->a.args)); #else - RETURN (scm_i_gsubr_apply (proc, scm_list_2 (arg1, arg2))); + RETURN (scm_i_gsubr_apply (proc, arg1, arg2, SCM_UNDEFINED)); #endif case scm_tcs_struct: if (SCM_OBJ_CLASS_FLAGS (proc) & SCM_CLASSF_PURE_GENERIC) @@ -1479,7 +1479,7 @@ dispatch: RETURN (SCM_SMOB_APPLY_3 (proc, arg1, arg2, SCM_CDDR (debug.info->a.args))); case scm_tc7_gsubr: - RETURN (scm_i_gsubr_apply (proc, debug.info->a.args)); + RETURN (scm_i_gsubr_apply_list (proc, debug.info->a.args)); case scm_tc7_pws: proc = SCM_PROCEDURE (proc); debug.info->a.proc = proc; @@ -1542,10 +1542,15 @@ dispatch: RETURN (SCM_SMOB_APPLY_3 (proc, arg1, arg2, scm_ceval_args (x, env, proc))); case scm_tc7_gsubr: - RETURN (scm_i_gsubr_apply (proc, - scm_cons2 (arg1, arg2, - scm_ceval_args (x, env, - proc)))); + if (scm_is_null (SCM_CDR (x))) + /* 3 arguments */ + RETURN (scm_i_gsubr_apply (proc, arg1, arg2, EVALCAR (x, env), + SCM_UNDEFINED)); + else + RETURN (scm_i_gsubr_apply_list (proc, + scm_cons2 (arg1, arg2, + scm_ceval_args (x, env, + proc)))); case scm_tc7_pws: proc = SCM_PROCEDURE (proc); if (!SCM_CLOSUREP (proc)) @@ -1864,7 +1869,7 @@ tail: #else args = (SCM_UNBNDP(arg1) ? SCM_EOL : scm_cons (arg1, args)); #endif - RETURN (scm_i_gsubr_apply (proc, args)); + RETURN (scm_i_gsubr_apply_list (proc, args)); case scm_tc7_pws: proc = SCM_PROCEDURE (proc); #ifdef DEVAL |