From 08376ad8f67f8c268d78d4f25bd59ca8affe5585 Mon Sep 17 00:00:00 2001 From: Mark H Weaver Date: Sun, 29 Jan 2012 20:00:21 -0500 Subject: [PATCH] Implement scm_call_varargs and scm_call_{7,8,9} * libguile/eval.c (scm_call_7, scm_call_8, scm_call_9, scm_call_varargs): New functions. * libguile/eval.h: Add prototypes. * doc/ref/api-evaluation.texi: Add documentation. * test-suite/standalone/test-loose-ends.c: Add tests. * NEWS: Add news entry. --- NEWS | 1 + doc/ref/api-evaluation.texi | 15 ++++++++++ libguile/eval.c | 46 +++++++++++++++++++++++++++++++ libguile/eval.h | 7 +++++ test-suite/standalone/test-loose-ends.c | 17 +++++++++++ 5 files changed, 86 insertions(+), 0 deletions(-) diff --git a/NEWS b/NEWS index 02b824d..df5a4f8 100644 --- a/NEWS +++ b/NEWS @@ -136,6 +136,7 @@ Reflection", "Syntax Transformer Helpers", and "Local Inclusion". ** New print option: `escape-newlines', defaults to #t. ** (ice-9 ftw): `file-system-fold', `file-system-tree', `scandir' ** `scm_c_value_ref': access to multiple returned values from C +** scm_call_7, scm_call_8, scm_call_9, and scm_call_varargs ** Some new syntax helpers in (system syntax) Search the manual for these identifiers and modules, for more. diff --git a/doc/ref/api-evaluation.texi b/doc/ref/api-evaluation.texi index 90cae45..de54194 100644 --- a/doc/ref/api-evaluation.texi +++ b/doc/ref/api-evaluation.texi @@ -533,9 +533,24 @@ then there's no @var{arg1}@dots{}@var{argN} and @var{arg} is the @deffnx {C Function} scm_call_4 (proc, arg1, arg2, arg3, arg4) @deffnx {C Function} scm_call_5 (proc, arg1, arg2, arg3, arg4, arg5) @deffnx {C Function} scm_call_6 (proc, arg1, arg2, arg3, arg4, arg5, arg6) +@deffnx {C Function} scm_call_7 (proc, arg1, arg2, arg3, arg4, arg5, arg6, arg7) +@deffnx {C Function} scm_call_8 (proc, arg1, arg2, arg3, arg4, arg5, arg6, arg7, arg8) +@deffnx {C Function} scm_call_9 (proc, arg1, arg2, arg3, arg4, arg5, arg6, arg7, arg8, arg9) Call @var{proc} with the given arguments. @end deffn +@deffn {C Function} scm_call_varargs (proc, ...) +Call @var{proc} with any number of arguments. The argument list must be +terminated by @code{SCM_UNDEFINED}. For example: + +@example +scm_call_varargs (scm_c_public_ref ("guile", "+"), + scm_from_int (1), + scm_from_int (2), + SCM_UNDEFINED); +@end example +@end deffn + @deffn {C Function} scm_call_n (proc, argv, nargs) Call @var{proc} with the array of arguments @var{argv}, as a @code{SCM*}. The length of the arguments should be passed in diff --git a/libguile/eval.c b/libguile/eval.c index e008b3a..70e303a 100644 --- a/libguile/eval.c +++ b/libguile/eval.c @@ -24,6 +24,7 @@ #endif #include +#include #include "libguile/__scm.h" @@ -522,11 +523,56 @@ scm_call_6 (SCM proc, SCM arg1, SCM arg2, SCM arg3, SCM arg4, SCM arg5, } SCM +scm_call_7 (SCM proc, SCM arg1, SCM arg2, SCM arg3, SCM arg4, SCM arg5, + SCM arg6, SCM arg7) +{ + SCM args[] = { arg1, arg2, arg3, arg4, arg5, arg6, arg7 }; + return scm_c_vm_run (scm_the_vm (), proc, args, 7); +} + +SCM +scm_call_8 (SCM proc, SCM arg1, SCM arg2, SCM arg3, SCM arg4, SCM arg5, + SCM arg6, SCM arg7, SCM arg8) +{ + SCM args[] = { arg1, arg2, arg3, arg4, arg5, arg6, arg7, arg8 }; + return scm_c_vm_run (scm_the_vm (), proc, args, 8); +} + +SCM +scm_call_9 (SCM proc, SCM arg1, SCM arg2, SCM arg3, SCM arg4, SCM arg5, + SCM arg6, SCM arg7, SCM arg8, SCM arg9) +{ + SCM args[] = { arg1, arg2, arg3, arg4, arg5, arg6, arg7, arg8, arg9 }; + return scm_c_vm_run (scm_the_vm (), proc, args, 9); +} + +SCM scm_call_n (SCM proc, SCM *argv, size_t nargs) { return scm_c_vm_run (scm_the_vm (), proc, argv, nargs); } +SCM +scm_call_varargs (SCM proc, ...) +{ + va_list argp; + SCM *argv = NULL; + size_t i, nargs = 0; + + va_start (argp, proc); + while (!SCM_UNBNDP (va_arg (argp, SCM))) + nargs++; + va_end (argp); + + argv = alloca (nargs * sizeof (SCM)); + va_start (argp, proc); + for (i = 0; i < nargs; i++) + argv[i] = va_arg (argp, SCM); + va_end (argp); + + return scm_c_vm_run (scm_the_vm (), proc, argv, nargs); +} + /* Simple procedure applies */ diff --git a/libguile/eval.h b/libguile/eval.h index f193ad6..dca0b41 100644 --- a/libguile/eval.h +++ b/libguile/eval.h @@ -72,7 +72,14 @@ SCM_API SCM scm_call_5 (SCM proc, SCM arg1, SCM arg2, SCM arg3, SCM arg4, SCM arg5); SCM_API SCM scm_call_6 (SCM proc, SCM arg1, SCM arg2, SCM arg3, SCM arg4, SCM arg5, SCM arg6); +SCM_API SCM scm_call_7 (SCM proc, SCM arg1, SCM arg2, SCM arg3, SCM arg4, + SCM arg5, SCM arg6, SCM arg7); +SCM_API SCM scm_call_8 (SCM proc, SCM arg1, SCM arg2, SCM arg3, SCM arg4, + SCM arg5, SCM arg6, SCM arg7, SCM arg8); +SCM_API SCM scm_call_9 (SCM proc, SCM arg1, SCM arg2, SCM arg3, SCM arg4, + SCM arg5, SCM arg6, SCM arg7, SCM arg8, SCM arg9); SCM_API SCM scm_call_n (SCM proc, SCM *argv, size_t nargs); +SCM_API SCM scm_call_varargs (SCM proc, ...); SCM_API SCM scm_apply_0 (SCM proc, SCM args); SCM_API SCM scm_apply_1 (SCM proc, SCM arg1, SCM args); SCM_API SCM scm_apply_2 (SCM proc, SCM arg1, SCM arg2, SCM args); diff --git a/test-suite/standalone/test-loose-ends.c b/test-suite/standalone/test-loose-ends.c index d1d6831..253c9a6 100644 --- a/test-suite/standalone/test-loose-ends.c +++ b/test-suite/standalone/test-loose-ends.c @@ -59,10 +59,27 @@ test_scm_local_eval () } static void +test_scm_call_varargs () +{ + SCM result; + + result = scm_call_varargs (scm_c_public_ref ("guile", "+"), + scm_from_int (1), + scm_from_int (2), + SCM_UNDEFINED); + assert (scm_is_true (scm_equal_p (result, scm_from_int (3)))); + + result = scm_call_varargs (scm_c_public_ref ("guile", "list"), + SCM_UNDEFINED); + assert (scm_is_eq (result, SCM_EOL)); +} + +static void tests (void *data, int argc, char **argv) { test_scm_from_locale_keywordn (); test_scm_local_eval (); + test_scm_call_varargs (); } int -- 1.7.5.4