mirror/guile
mirror/guile
1
Fork 0
mirror of https://git.savannah.gnu.org/git/guile.git synced 2025-06-11 22:31:12 +02:00
Code Activity

Implement 'scm_c_bind_keyword_arguments'.

Browse source 
* libguile/keywords.c (scm_keyword_argument_error): New variable.
  (scm_c_bind_keyword_arguments): New API function.

* libguile/keywords.h (enum scm_keyword_arguments_flags): New enum.
  (scm_t_keyword_arguments_flags): New typedef.
  (scm_c_bind_keyword_arguments): New prototype.

* doc/ref/api-data.texi (Coding With Keywords, Keyword Procedures): Add
  documentation.

* test-suite/standalone/test-scm-c-bind-keyword-arguments.c: New file.

* test-suite/standalone/Makefile.am: Add
  test-scm-c-bind-keyword-arguments test.
This commit is contained in:
Mark H Weaver 2013-04-06 13:36:24 -04:00
parent c608e1aafa
commit a16d4e82e9
5 changed files with 353 additions and 0 deletions
Download patch file Download diff file Expand all files Collapse all files

66
doc/ref/api-data.texi
View file

@ -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_keyword_arguments} (@pxref{Keyword Procedures}).
@node Keyword Read Syntax
@subsubsection Keyword Read Syntax
@ -5881,6 +5883,70 @@ Equivalent to @code{scm_symbol_to_keyword (scm_from_latin1_symbol
(@var{name}))}, respectively.
@end deftypefn
@deftypefn {C Function} void scm_c_bind_keyword_arguments (const char *subr, @
SCM rest, scm_t_keyword_arguments_flags 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_keyword_arguments} 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_keyword_arguments}. 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_ALLOW_OTHER_KEYS}, or if
non-keyword arguments are present and @var{flags} does not contain
@code{SCM_ALLOW_NON_KEYWORD_ARGUMENTS}, 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_keyword_arguments ("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

67
libguile/keywords.c
View file

@ -23,6 +23,7 @@
#endif
#include <string.h>
#include <stdarg.h>
#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_keyword_arguments (const char *subr, SCM rest,
scm_t_keyword_arguments_flags flags, ...)
{
va_list va;
if (SCM_UNLIKELY (!(flags & SCM_ALLOW_NON_KEYWORD_ARGUMENTS)
&& 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, flags);
for (;;)
{
kw = va_arg (va, SCM);
if (SCM_UNBNDP (kw))
{
/* KW_OR_ARG is not in the list of expected keywords. */
if (!(flags & SCM_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 (!(flags & SCM_ALLOW_NON_KEYWORD_ARGUMENTS))
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 ()

12
libguile/keywords.h
View file

@ -41,6 +41,18 @@ 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);
enum scm_keyword_arguments_flags
{
SCM_ALLOW_OTHER_KEYS = (1U << 0),
SCM_ALLOW_NON_KEYWORD_ARGUMENTS = (1U << 1)
};
typedef enum scm_keyword_arguments_flags scm_t_keyword_arguments_flags;
SCM_API void
scm_c_bind_keyword_arguments (const char *subr, SCM rest,
scm_t_keyword_arguments_flags flags, ...);
SCM_INTERNAL void scm_init_keywords (void);
#endif /* SCM_KEYWORDS_H */

7
test-suite/standalone/Makefile.am
View file

@ -204,6 +204,13 @@ test_scm_values_LDADD = $(LIBGUILE_LDADD)
check_PROGRAMS += test-scm-values
TESTS += test-scm-values
# test-scm-c-bind-keyword-arguments
test_scm_c_bind_keyword_arguments_SOURCES = test-scm-c-bind-keyword-arguments.c
test_scm_c_bind_keyword_arguments_CFLAGS = ${test_cflags}
test_scm_c_bind_keyword_arguments_LDADD = $(LIBGUILE_LDADD)
check_PROGRAMS += test-scm-c-bind-keyword-arguments
TESTS += test-scm-c-bind-keyword-arguments
if HAVE_SHARED_LIBRARIES
# test-extensions

201
test-suite/standalone/test-scm-c-bind-keyword-arguments.c Normal file
View file

@ -0,0 +1,201 @@
/* 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 <config.h>
#endif
#include <libguile.h>
#include <assert.h>
static SCM
error_handler (void *data, SCM key, SCM args)
{
SCM expected_args = scm_list_n (scm_from_utf8_string ("test"),
scm_from_utf8_string ((char *) data),
SCM_EOL, SCM_BOOL_F,
SCM_UNDEFINED);
assert (scm_is_eq (key, scm_from_utf8_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_utf8_keyword ("foo");
SCM k_bar = scm_from_utf8_keyword ("bar");
SCM k_baz = scm_from_utf8_keyword ("baz");
SCM arg_foo, arg_bar;
scm_c_bind_keyword_arguments ("test",
scm_list_n (k_foo, SCM_EOL,
k_baz, SCM_BOOL_T,
SCM_UNDEFINED),
SCM_ALLOW_NON_KEYWORD_ARGUMENTS,
k_foo, &arg_foo,
k_bar, &arg_bar,
SCM_UNDEFINED);
assert (0);
}
static SCM
test_invalid_keyword (void *data)
{
SCM k_foo = scm_from_utf8_keyword ("foo");
SCM k_bar = scm_from_utf8_keyword ("bar");
SCM arg_foo, arg_bar;
scm_c_bind_keyword_arguments ("test",
scm_list_n (k_foo, SCM_EOL,
SCM_INUM0, SCM_INUM1,
SCM_UNDEFINED),
SCM_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_utf8_keyword ("foo");
SCM k_bar = scm_from_utf8_keyword ("bar");
SCM arg_foo, arg_bar;
scm_c_bind_keyword_arguments ("test",
scm_list_n (k_foo, SCM_EOL,
SCM_INUM0,
SCM_UNDEFINED),
SCM_ALLOW_OTHER_KEYS,
k_foo, &arg_foo,
k_bar, &arg_bar,
SCM_UNDEFINED);
assert (0);
}
static void
test_scm_c_bind_keyword_arguments ()
{
SCM k_foo = scm_from_utf8_keyword ("foo");
SCM k_bar = scm_from_utf8_keyword ("bar");
SCM k_baz = scm_from_utf8_keyword ("baz");
SCM arg_foo, arg_bar;
/* All kwargs provided. */
arg_foo = SCM_INUM0;
arg_bar = SCM_INUM1;
scm_c_bind_keyword_arguments ("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_keyword_arguments ("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_keyword_arguments ("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_keyword_arguments ("test",
scm_list_n (k_foo, SCM_EOL,
k_baz, SCM_BOOL_T,
SCM_UNDEFINED),
SCM_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_keyword_arguments ("test",
scm_list_n (SCM_BOOL_F,
k_foo, SCM_EOL,
SCM_INUM0,
k_bar, SCM_BOOL_T,
SCM_INUM1,
SCM_UNDEFINED),
SCM_ALLOW_NON_KEYWORD_ARGUMENTS,
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_keyword_arguments ();
}
int
main (int argc, char *argv[])
{
scm_boot_guile (argc, argv, tests, NULL);
return 0;
}