From mboxrd@z Thu Jan 1 00:00:00 1970 Path: news.gmane.org!not-for-mail From: Mark H Weaver Newsgroups: gmane.lisp.guile.devel Subject: [PATCH] Implement 'scm_c_bind_kwargs' to handle keyword arguments from C Date: Sat, 06 Apr 2013 15:31:42 -0400 Message-ID: <87vc7ztq01.fsf@tines.lan> NNTP-Posting-Host: plane.gmane.org Mime-Version: 1.0 Content-Type: multipart/mixed; boundary="=-=-=" X-Trace: ger.gmane.org 1365278400 26615 80.91.229.3 (6 Apr 2013 20:00:00 GMT) X-Complaints-To: usenet@ger.gmane.org NNTP-Posting-Date: Sat, 6 Apr 2013 20:00:00 +0000 (UTC) To: guile-devel@gnu.org Original-X-From: guile-devel-bounces+guile-devel=m.gmane.org@gnu.org Sat Apr 06 21:59:59 2013 Return-path: Envelope-to: guile-devel@m.gmane.org Original-Received: from lists.gnu.org ([208.118.235.17]) by plane.gmane.org with esmtp (Exim 4.69) (envelope-from ) id 1UOZH7-0007UX-KY for guile-devel@m.gmane.org; Sat, 06 Apr 2013 21:59:45 +0200 Original-Received: from localhost ([::1]:46071 helo=lists.gnu.org) by lists.gnu.org with esmtp (Exim 4.71) (envelope-from ) id 1UOYqV-0000iE-E6 for guile-devel@m.gmane.org; Sat, 06 Apr 2013 15:32:15 -0400 Original-Received: from eggs.gnu.org ([208.118.235.92]:46235) by lists.gnu.org with esmtp (Exim 4.71) (envelope-from ) id 1UOYqL-0000Ws-6C for guile-devel@gnu.org; Sat, 06 Apr 2013 15:32:11 -0400 Original-Received: from Debian-exim by eggs.gnu.org with spam-scanned (Exim 4.71) (envelope-from ) id 1UOYqI-0004dI-Dk for guile-devel@gnu.org; Sat, 06 Apr 2013 15:32:05 -0400 Original-Received: from world.peace.net ([96.39.62.75]:34715) by eggs.gnu.org with esmtp (Exim 4.71) (envelope-from ) id 1UOYqI-0004dB-7j for guile-devel@gnu.org; Sat, 06 Apr 2013 15:32:02 -0400 Original-Received: from 209-6-91-212.c3-0.smr-ubr1.sbo-smr.ma.cable.rcn.com ([209.6.91.212] helo=tines.lan) by world.peace.net with esmtpsa (TLS1.0:DHE_RSA_AES_128_CBC_SHA1:16) (Exim 4.72) (envelope-from ) id 1UOYq5-0005nc-T0; Sat, 06 Apr 2013 15:31:50 -0400 X-detected-operating-system: by eggs.gnu.org: GNU/Linux 2.6.x X-Received-From: 96.39.62.75 X-BeenThere: guile-devel@gnu.org X-Mailman-Version: 2.1.14 Precedence: list List-Id: "Developers list for Guile, the GNU extensibility library" List-Unsubscribe: , List-Archive: List-Post: List-Help: List-Subscribe: , Errors-To: guile-devel-bounces+guile-devel=m.gmane.org@gnu.org Original-Sender: guile-devel-bounces+guile-devel=m.gmane.org@gnu.org Xref: news.gmane.org gmane.lisp.guile.devel:16151 Archived-At: --=-=-= Content-Type: text/plain This patch speaks for itself. Comments and suggestions solicited. Mark --=-=-= Content-Type: text/x-diff Content-Disposition: inline; filename=0001-Implement-scm_c_bind_kwargs-to-handle-keyword-argume.patch Content-Description: [PATCH] Implement 'scm_c_bind_kwargs' to handle keyword arguments from C >From a53f6505de29c8408a09127b96c8be6ad3d712a6 Mon Sep 17 00:00:00 2001 From: Mark H Weaver Date: Sat, 6 Apr 2013 13:36:24 -0400 Subject: [PATCH] Implement 'scm_c_bind_kwargs' to handle keyword arguments from C. * libguile/keywords.c (scm_keyword_argument_error): New variable. (scm_c_bind_kwargs): New API function. * libguile/keywords.h (SCM_KWARGS_ALLOW_OTHER_KEYS, SCM_KWARGS_ALLOW_REST): New API preprocessor macros. (scm_c_bind_kwargs): New prototype. * doc/ref/api-data.texi (Coding With Keywords, Keyword Procedures): Add documentation. * test-suite/standalone/test-scm-c-bind-kwargs.c: New file. * test-suite/standalone/Makefile.am: Add test-scm-c-bind-kwargs test. --- doc/ref/api-data.texi | 64 ++++++++ libguile/keywords.c | 67 ++++++++ libguile/keywords.h | 5 + test-suite/standalone/Makefile.am | 7 + test-suite/standalone/test-scm-c-bind-kwargs.c | 203 ++++++++++++++++++++++++ 5 files changed, 346 insertions(+) create mode 100644 test-suite/standalone/test-scm-c-bind-kwargs.c diff --git a/doc/ref/api-data.texi b/doc/ref/api-data.texi index dc1b761..cbbd63a 100644 --- a/doc/ref/api-data.texi +++ b/doc/ref/api-data.texi @@ -5779,6 +5779,8 @@ For further details on @code{let-keywords}, @code{define*} and other facilities provided by the @code{(ice-9 optargs)} module, see @ref{Optional Arguments}. +To handle keyword arguments from procedures implemented in C, +use @code{scm_c_bind_kwargs} (@pxref{Keyword Procedures}). @node Keyword Read Syntax @subsubsection Keyword Read Syntax @@ -5881,6 +5883,68 @@ Equivalent to @code{scm_symbol_to_keyword (scm_from_latin1_symbol (@var{name}))}, respectively. @end deftypefn +@deftypefn {C Function} void scm_c_bind_kwargs (const char *subr, SCM rest, int flags, @ + SCM keyword1, SCM *argp1, @ + @dots{}, @ + SCM keywordN, SCM *argpN, @ + @nicode{SCM_UNDEFINED}) + +Extract the specified keyword arguments from @var{rest}, which is not +modified. If the keyword argument @var{keyword1} is present in +@var{rest} with an associated value, that value is stored in the +variable pointed to by @var{argp1}, otherwise the variable is left +unchanged. Similarly for the other keywords and argument pointers up to +@var{keywordN} and @var{argpN}. The argument list to +@code{scm_c_bind_kwargs} must be terminated by @code{SCM_UNDEFINED}. + +Note that since the variables pointed to by @var{argp1} through +@var{argpN} are left unchanged if the associated keyword argument is not +present, they should be initialized to their default values before +calling @code{scm_c_bind_kwargs}. Alternatively, you can initialize +them to @code{SCM_UNDEFINED} before the call, and then use +@code{SCM_UNBNDP} after the call to see which ones were provided. + +If an unrecognized keyword argument is present in @var{rest} and +@var{flags} does not contain @code{SCM_KWARGS_ALLOW_OTHER_KEYS}, or if +non-keyword arguments are present and @var{flags} does not contain +@code{SCM_KWARGS_ALLOW_REST}, an exception is raised. @var{subr} should +be the name of the procedure receiving the keyword arguments, for +purposes of error reporting. + +For example: + +@example +SCM k_delimiter; +SCM k_grammar; +SCM sym_infix; + +SCM my_string_join (SCM strings, SCM rest) +@{ + SCM delimiter = SCM_UNDEFINED; + SCM grammar = sym_infix; + + scm_c_bind_kwargs ("my_string_join", rest, 0, + k_delimiter, &delimiter, + k_grammar, &grammar, + SCM_UNDEFINED); + + if (SCM_UNBNDP (delimiter)) + delimiter = scm_from_utf8_string (" "); + + return scm_string_join (strings, delimiter, grammar); +@} + +void my_init () +@{ + k_delimiter = scm_from_utf8_keyword ("delimiter"); + k_grammar = scm_from_utf8_keyword ("grammar"); + sym_infix = scm_from_utf8_symbol ("infix"); + scm_c_define_gsubr ("my-string-join", 1, 0, 1, my_string_join); +@} +@end example +@end deftypefn + + @node Other Types @subsection ``Functionality-Centric'' Data Types diff --git a/libguile/keywords.c b/libguile/keywords.c index 3b9a922..5025542 100644 --- a/libguile/keywords.c +++ b/libguile/keywords.c @@ -23,6 +23,7 @@ #endif #include +#include #include "libguile/_scm.h" #include "libguile/async.h" @@ -124,6 +125,72 @@ scm_from_utf8_keyword (const char *name) return scm_symbol_to_keyword (scm_from_utf8_symbol (name)); } +SCM_SYMBOL (scm_keyword_argument_error, "keyword-argument-error"); + +void +scm_c_bind_kwargs (const char *subr, SCM rest, int flags, ...) +{ + int allow_other_keys = flags & SCM_KWARGS_ALLOW_OTHER_KEYS; + int allow_rest = flags & SCM_KWARGS_ALLOW_REST; + va_list va; + + if (SCM_UNLIKELY (!allow_rest && scm_ilength (rest) % 2 != 0)) + scm_error (scm_keyword_argument_error, + subr, "Odd length of keyword argument list", + SCM_EOL, SCM_BOOL_F); + + while (scm_is_pair (rest)) + { + SCM kw_or_arg = SCM_CAR (rest); + SCM tail = SCM_CDR (rest); + + if (scm_is_keyword (kw_or_arg) && scm_is_pair (tail)) + { + SCM kw; + SCM *arg_p; + + va_start (va, allow_other_keys); + for (;;) + { + kw = va_arg (va, SCM); + if (SCM_UNBNDP (kw)) + { + /* KW_OR_ARG is not in the list of expected keywords. */ + if (!allow_other_keys) + scm_error (scm_keyword_argument_error, + subr, "Unrecognized keyword", + SCM_EOL, SCM_BOOL_F); + break; + } + arg_p = va_arg (va, SCM *); + if (scm_is_eq (kw_or_arg, kw)) + { + /* We found the matching keyword. Store the + associated value and break out of the loop. */ + *arg_p = SCM_CAR (tail); + break; + } + } + va_end (va); + + /* Advance REST. */ + rest = SCM_CDR (tail); + } + else + { + /* The next argument is not a keyword, or is a singleton + keyword at the end of REST. */ + if (!allow_rest) + scm_error (scm_keyword_argument_error, + subr, "Invalid keyword", + SCM_EOL, SCM_BOOL_F); + + /* Advance REST. */ + rest = tail; + } + } +} + /* njrev: critical sections reviewed so far up to here */ void scm_init_keywords () diff --git a/libguile/keywords.h b/libguile/keywords.h index c9e6af1..734f784 100644 --- a/libguile/keywords.h +++ b/libguile/keywords.h @@ -41,6 +41,11 @@ SCM_API SCM scm_from_locale_keywordn (const char *name, size_t len); SCM_API SCM scm_from_latin1_keyword (const char *name); SCM_API SCM scm_from_utf8_keyword (const char *name); +#define SCM_KWARGS_ALLOW_OTHER_KEYS 1 +#define SCM_KWARGS_ALLOW_REST 2 + +SCM_API void scm_c_bind_kwargs (const char *subr, SCM rest, int flags, ...); + SCM_INTERNAL void scm_init_keywords (void); #endif /* SCM_KEYWORDS_H */ diff --git a/test-suite/standalone/Makefile.am b/test-suite/standalone/Makefile.am index ffeafa8..c6d9e4e 100644 --- a/test-suite/standalone/Makefile.am +++ b/test-suite/standalone/Makefile.am @@ -204,6 +204,13 @@ test_scm_values_LDADD = $(LIBGUILE_LDADD) check_PROGRAMS += test-scm-values TESTS += test-scm-values +# test-scm-c-bind-kwargs +test_scm_c_bind_kwargs_SOURCES = test-scm-c-bind-kwargs.c +test_scm_c_bind_kwargs_CFLAGS = ${test_cflags} +test_scm_c_bind_kwargs_LDADD = $(LIBGUILE_LDADD) +check_PROGRAMS += test-scm-c-bind-kwargs +TESTS += test-scm-c-bind-kwargs + if HAVE_SHARED_LIBRARIES # test-extensions diff --git a/test-suite/standalone/test-scm-c-bind-kwargs.c b/test-suite/standalone/test-scm-c-bind-kwargs.c new file mode 100644 index 0000000..25e44e4 --- /dev/null +++ b/test-suite/standalone/test-scm-c-bind-kwargs.c @@ -0,0 +1,203 @@ +/* test-scm-c-bind-kwargs.c */ + +/* Copyright (C) 2013 Free Software Foundation, Inc. + * + * This library is free software; you can redistribute it and/or + * modify it under the terms of the GNU Lesser General Public License + * as published by the Free Software Foundation; either version 3 of + * the License, or (at your option) any later version. + * + * This library is distributed in the hope that it will be useful, but + * WITHOUT ANY WARRANTY; without even the implied warranty of + * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU + * Lesser General Public License for more details. + * + * You should have received a copy of the GNU Lesser General Public + * License along with this library; if not, write to the Free Software + * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA + * 02110-1301 USA + */ + +#if HAVE_CONFIG_H +# include +#endif + +#include + +#include + +static SCM +error_handler (void *data, SCM key, SCM args) +{ + SCM expected_args = scm_list_n (scm_from_latin1_string ("test"), + scm_from_latin1_string ((char *) data), + SCM_EOL, SCM_BOOL_F, + SCM_UNDEFINED); + + assert (scm_is_eq (key, scm_from_latin1_symbol ("keyword-argument-error"))); + assert (scm_is_true (scm_equal_p (args, expected_args))); + + return SCM_BOOL_T; +} + +static SCM +test_unrecognized_keyword (void *data) +{ + SCM k_foo = scm_from_latin1_keyword ("foo"); + SCM k_bar = scm_from_latin1_keyword ("bar"); + SCM k_baz = scm_from_latin1_keyword ("baz"); + SCM arg_foo, arg_bar; + + scm_c_bind_kwargs ("test", + scm_list_n (k_foo, SCM_EOL, + k_baz, SCM_BOOL_T, + SCM_UNDEFINED), + SCM_KWARGS_ALLOW_REST, + k_foo, &arg_foo, + k_bar, &arg_bar, + SCM_UNDEFINED); + assert (0); +} + +static SCM +test_invalid_keyword (void *data) +{ + SCM k_foo = scm_from_latin1_keyword ("foo"); + SCM k_bar = scm_from_latin1_keyword ("bar"); + SCM arg_foo, arg_bar; + + scm_c_bind_kwargs ("test", + scm_list_n (k_foo, SCM_EOL, + SCM_INUM0, SCM_INUM1, + SCM_UNDEFINED), + SCM_KWARGS_ALLOW_OTHER_KEYS, + k_foo, &arg_foo, + k_bar, &arg_bar, + SCM_UNDEFINED); + assert (0); +} + +static SCM +test_odd_length (void *data) +{ + SCM k_foo = scm_from_latin1_keyword ("foo"); + SCM k_bar = scm_from_latin1_keyword ("bar"); + SCM arg_foo, arg_bar; + + scm_c_bind_kwargs ("test", + scm_list_n (k_foo, SCM_EOL, + SCM_INUM0, + SCM_UNDEFINED), + SCM_KWARGS_ALLOW_OTHER_KEYS, + k_foo, &arg_foo, + k_bar, &arg_bar, + SCM_UNDEFINED); + assert (0); +} + +static void +test_scm_c_bind_kwargs () +{ + SCM k_foo = scm_from_latin1_keyword ("foo"); + SCM k_bar = scm_from_latin1_keyword ("bar"); + SCM k_baz = scm_from_latin1_keyword ("baz"); + SCM arg_foo, arg_bar; + + /* All kwargs provided. */ + arg_foo = SCM_INUM0; + arg_bar = SCM_INUM1; + scm_c_bind_kwargs ("test", + scm_list_n (k_bar, SCM_EOL, + k_foo, SCM_BOOL_T, + SCM_UNDEFINED), + 0, + k_foo, &arg_foo, + k_bar, &arg_bar, + SCM_UNDEFINED); + assert (scm_is_eq (arg_foo, SCM_BOOL_T)); + assert (scm_is_eq (arg_bar, SCM_EOL)); + + /* Some kwargs provided. */ + arg_foo = SCM_INUM0; + arg_bar = SCM_INUM1; + scm_c_bind_kwargs ("test", + scm_list_n (k_bar, SCM_EOL, + SCM_UNDEFINED), + 0, + k_foo, &arg_foo, + k_bar, &arg_bar, + SCM_UNDEFINED); + assert (scm_is_eq (arg_foo, SCM_INUM0)); + assert (scm_is_eq (arg_bar, SCM_EOL)); + + /* No kwargs provided. */ + arg_foo = SCM_INUM0; + arg_bar = SCM_INUM1; + scm_c_bind_kwargs ("test", + SCM_EOL, + 0, + k_foo, &arg_foo, + k_bar, &arg_bar, + SCM_UNDEFINED); + assert (scm_is_eq (arg_foo, SCM_INUM0)); + assert (scm_is_eq (arg_bar, SCM_INUM1)); + + /* Other kwargs provided, when allowed. */ + arg_foo = SCM_INUM0; + arg_bar = SCM_INUM1; + scm_c_bind_kwargs ("test", + scm_list_n (k_foo, SCM_EOL, + k_baz, SCM_BOOL_T, + SCM_UNDEFINED), + SCM_KWARGS_ALLOW_OTHER_KEYS, + k_foo, &arg_foo, + k_bar, &arg_bar, + SCM_UNDEFINED); + assert (scm_is_eq (arg_foo, SCM_EOL)); + assert (scm_is_eq (arg_bar, SCM_INUM1)); + + /* Other non-kwargs provided, when allowed. */ + arg_foo = SCM_INUM0; + arg_bar = SCM_INUM1; + scm_c_bind_kwargs ("test", + scm_list_n (SCM_BOOL_F, + k_foo, SCM_EOL, + SCM_INUM0, + k_bar, SCM_BOOL_T, + SCM_INUM1, + SCM_UNDEFINED), + SCM_KWARGS_ALLOW_REST, + k_foo, &arg_foo, + k_bar, &arg_bar, + SCM_UNDEFINED); + assert (scm_is_eq (arg_foo, SCM_EOL)); + assert (scm_is_eq (arg_bar, SCM_BOOL_T)); + + /* Test unrecognized keyword error. */ + scm_internal_catch (SCM_BOOL_T, + test_unrecognized_keyword, NULL, + error_handler, "Unrecognized keyword"); + + /* Test invalid keyword error. */ + scm_internal_catch (SCM_BOOL_T, + test_invalid_keyword, NULL, + error_handler, "Invalid keyword"); + + /* Test odd length error. */ + scm_internal_catch (SCM_BOOL_T, + test_odd_length, NULL, + error_handler, "Odd length of keyword argument list"); +} + +static void +tests (void *data, int argc, char **argv) +{ + test_scm_c_bind_kwargs (); +} + +int +main (int argc, char *argv[]) +{ + scm_boot_guile (argc, argv, tests, NULL); + return 0; +} -- 1.7.10.4 --=-=-=--