static void
syntax_error (const char* const msg, const SCM form, const SCM expr)
{
SCM msg_string = scm_from_locale_string (msg);
SCM filename = SCM_BOOL_F;
SCM linenr = SCM_BOOL_F;
const char *format;
SCM args;
if (scm_is_pair (form))
{
filename = scm_source_property (form, scm_sym_filename);
linenr = scm_source_property (form, scm_sym_line);
}
if (scm_is_false (filename) && scm_is_false (linenr) && scm_is_pair (expr))
{
filename = scm_source_property (expr, scm_sym_filename);
linenr = scm_source_property (expr, scm_sym_line);
}
if (!SCM_UNBNDP (expr))
{
if (scm_is_true (filename))
{
format = "In file ~S, line ~S: ~A ~S in expression ~S.";
args = scm_list_5 (filename, linenr, msg_string, form, expr);
}
else if (scm_is_true (linenr))
{
format = "In line ~S: ~A ~S in expression ~S.";
args = scm_list_4 (linenr, msg_string, form, expr);
}
else
{
format = "~A ~S in expression ~S.";
args = scm_list_3 (msg_string, form, expr);
}
}
else
{
if (scm_is_true (filename))
{
format = "In file ~S, line ~S: ~A ~S.";
args = scm_list_4 (filename, linenr, msg_string, form);
}
else if (scm_is_true (linenr))
{
format = "In line ~S: ~A ~S.";
args = scm_list_3 (linenr, msg_string, form);
}
else
{
format = "~A ~S.";
args = scm_list_2 (msg_string, form);
}
}
scm_error (syntax_error_key, "memoization", format, args, SCM_BOOL_F);
}
/*! \brief Gets a Scheme hook object by name.
* \par Function Description
* Returns the contents of variable with the given name in the (gschem
* core hook). Used for looking up hook objects.
*
* \param name name of hook to lookup.
* \return value found in the (gschem core hook) module.
*/
static SCM
g_get_hook_by_name (const char *name)
{
SCM exp = scm_list_3 (at_sym,
scm_list_3 (gschem_sym, core_sym, hook_sym),
scm_from_utf8_symbol (name));
return g_scm_eval_protected (exp, SCM_UNDEFINED);
}
SWIGINTERN SCM
SWIG_Guile_NewPointerObj(void *ptr, swig_type_info *type, int owner)
{
if (ptr == NULL)
return SCM_EOL;
else {
SCM smob;
swig_guile_clientdata *cdata = (swig_guile_clientdata *) type->clientdata;
if (owner)
SCM_NEWSMOB2(smob, swig_collectable_tag, ptr, (void *) type);
else
SCM_NEWSMOB2(smob, swig_tag, ptr, (void *) type);
if (!cdata || SCM_NULLP(cdata->goops_class) || swig_make_func == SCM_EOL ) {
return smob;
} else {
/* the scm_make() C function only handles the creation of gf,
methods and classes (no instances) the (make ...) function is
later redefined in goops.scm. So we need to call that
Scheme function. */
return scm_apply(swig_make_func,
scm_list_3(cdata->goops_class,
swig_keyword,
smob),
SCM_EOL);
}
}
}
static SCM
dascm_make_insn (CORE_ADDR pc, const char *assembly, int insn_len)
{
return scm_list_3 (scm_cons (address_symbol,
gdbscm_scm_from_ulongest (pc)),
scm_cons (asm_symbol,
gdbscm_scm_from_c_string (assembly)),
scm_cons (length_symbol,
scm_from_int (insn_len)));
}
/*! \brief Runs a object hook with a single OBJECT.
* \par Function Description
* Runs a hook called \a name, which should expect a list of #OBJECT
* smobs as its argument, with a single-element list containing only \a obj.
*
* \see g_run_hook_object_list()
*
* \param name name of hook to run.
* \param obj #OBJECT argument for hook.
*/
void
g_run_hook_object (GschemToplevel *w_current, const char *name, OBJECT *obj)
{
scm_dynwind_begin (0);
g_dynwind_window (w_current);
SCM expr = scm_list_3 (run_hook_sym,
g_get_hook_by_name (name),
scm_list_2 (list_sym, edascm_from_object (obj)));
g_scm_eval_protected (expr, scm_interaction_environment ());
scm_dynwind_end ();
scm_remember_upto_here_1 (expr);
}
static void
test_scm_to_pointer ()
{
int (*add3) (int a, int b, int c);
SCM int_type = scm_c_public_ref ("system foreign", "int");
add3 = scm_to_pointer
(scm_procedure_to_pointer (int_type,
scm_c_public_ref ("guile", "+"),
scm_list_3 (int_type,
int_type,
int_type)));
assert ((*add3) (1000000, 1000, -1) == 1000999);
}
static void
test_scm_local_eval ()
{
SCM result;
scm_c_use_module ("ice-9 local-eval");
result = scm_local_eval
(scm_list_3 (scm_from_latin1_symbol ("+"),
scm_from_latin1_symbol ("x"),
scm_from_latin1_symbol ("y")),
scm_c_eval_string ("(let ((x 1) (y 2)) (the-environment))"));
assert (scm_is_true (scm_equal_p (result,
scm_from_signed_integer (3))));
}
/* Return a list of three elements containing the RGB of COLOR */
SCM
gucu_color_content (SCM s_color)
{
int ret;
short c_red, c_green, c_blue;
ret = color_content (scm_to_short (s_color), &c_red, &c_green, &c_blue);
if (ret == OK)
{
return scm_list_3 (scm_from_short (c_red),
scm_from_short (c_green), scm_from_short (c_blue));
}
else
return SCM_BOOL_F;
}
/*! \brief Runs a object hook for a list of objects.
* \par Function Description
* Runs a hook called \a name, which should expect a list of #OBJECT
* smobs as its argument, with \a obj_lst as the argument list.
*
* \see g_run_hook_object()
*
* \param name name of hook to run.
* \param obj_lst list of #OBJECT smobs as hook argument.
*/
void
g_run_hook_object_list (GschemToplevel *w_current, const char *name,
GList *obj_lst)
{
SCM lst = SCM_EOL;
GList *iter;
scm_dynwind_begin (0);
g_dynwind_window (w_current);
for (iter = obj_lst; iter != NULL; iter = g_list_next (iter)) {
lst = scm_cons (edascm_from_object ((OBJECT *) iter->data), lst);
}
SCM expr = scm_list_3 (run_hook_sym,
g_get_hook_by_name (name),
scm_cons (list_sym,
scm_reverse_x (lst, SCM_EOL)));
g_scm_eval_protected (expr, scm_interaction_environment ());
scm_dynwind_end ();
scm_remember_upto_here_1 (expr);
}
/* Multiple values truncation. */
static SCM
truncate_values (SCM x)
{
if (SCM_LIKELY (!SCM_VALUESP (x)))
return x;
else
{
SCM l = scm_struct_ref (x, SCM_INUM0);
if (SCM_LIKELY (scm_is_pair (l)))
return scm_car (l);
else
{
scm_ithrow (scm_from_latin1_symbol ("vm-run"),
scm_list_3 (scm_from_latin1_symbol ("vm-run"),
scm_from_locale_string
("Too few values returned to continuation"),
SCM_EOL),
1);
/* Not reached. */
return SCM_BOOL_F;
}
}
}
SCM tf_from_tensor(SCM scm_self)
{
struct tf_tensor_t *self = get_tf_tensor(scm_self);
int type = TF_TensorType(self->tensor);
int num_dims = TF_NumDims(self->tensor);
int count = 1;
SCM scm_shape = SCM_EOL;
for (int i=num_dims - 1; i>=0; i--) {
scm_shape = scm_cons(scm_from_int(TF_Dim(self->tensor, i)), scm_shape);
count = count * TF_Dim(self->tensor, i);
};
size_t size = TF_TensorByteSize(self->tensor);
void *data;
if (type == TF_STRING) {
int64_t *offsets = TF_TensorData(self->tensor);
void *pointer = offsets + count;
size_t str_len;
data = scm_gc_malloc(sizeof(SCM) * count, "from-tensor");
SCM *result = data;
for (int i=0; i<count; i++) {
const char *str;
size_t len;
TF_StringDecode(pointer + *offsets, size - *offsets, &str, &len, status());
if (TF_GetCode(_status) != TF_OK)
scm_misc_error("from-tensor", TF_Message(_status), SCM_EOL);
*result++ = scm_from_locale_stringn(str, len);
offsets++;
};
} else {
data = scm_gc_malloc_pointerless(size, "from-tensor");
memcpy(data, TF_TensorData(self->tensor), size);
};
return scm_list_3(scm_from_int(type),
scm_shape,
scm_from_pointer(data, NULL));
}
static void
shell_main (void *data, int argc, char **argv)
{
SCM setup_lst = SCM_EOL; /* We reverse! this before using it. */
SCM run_lst = SCM_EOL; /* We reverse! this before using it. */
int c;
int interactive = 1;
int inhibit_rc = 0;
int status;
TOPLEVEL *toplevel;
#include "shell.x"
/* Parse command-line arguments */
opterr = 0;
while ((c = getopt (argc, argv, GETOPT_OPTIONS)) != -1) {
switch (c) {
case 's':
/* Construct an application of LOAD to the script name */
run_lst = scm_cons (scm_list_2 (sym_load,
scm_from_locale_string (optarg)),
run_lst);
interactive = 0;
goto endoptloop;
case 'c':
/* We need to evaluate an expression */
run_lst = scm_cons (scm_list_2 (sym_eval_string,
scm_from_locale_string (optarg)),
run_lst);
interactive = 0;
goto endoptloop;
case 'L':
/* Add argument to %load-path */
setup_lst = scm_cons (scm_list_3 (sym_set_x,
sym_load_path,
scm_list_3 (sym_cons,
scm_from_locale_string (optarg),
sym_load_path)),
setup_lst);
break;
case 'l':
/* Same as -s, pretty much */
run_lst = scm_cons (scm_list_2 (sym_load,
scm_from_locale_string (optarg)),
run_lst);
break;
case 'q':
inhibit_rc = 1;
break;
case 'h':
usage (0);
case 'V':
version();
case '?':
if ((optopt != ':') && (strchr (GETOPT_OPTIONS, optopt) != NULL)) {
fprintf (stderr,
"ERROR: -%c option requires an argument.\n\n",
optopt);
usage (1);
} else if (isprint (optopt)) {
fprintf (stderr, "ERROR: Unknown option -%c\n\n", optopt);
usage (1);
} else {
fprintf (stderr,
"ERROR: Unknown option character `\\x%x'.\n\n",
optopt);
usage (1);
}
default:
g_assert_not_reached ();
}
}
endoptloop:
/* Set program arguments visible from Guile */
scm_set_program_arguments (argc - optind, argv + optind, "geda-shell");
/* If interactive mode, load readline and run top REPL. */
if (interactive) {
run_lst = scm_cons (scm_list_2 (sym_use_modules,
scm_list_2 (sym_ice_9, sym_readline)),
run_lst);
run_lst = scm_cons (scm_list_1 (sym_activate_readline), run_lst);
run_lst = scm_cons (scm_list_1 (sym_top_repl), run_lst);
/* Print GPL bumf if necessary */
if (isatty (1) && isatty (0)) {
printf (
"gEDA " PACKAGE_GIT_VERSION "\n"
"Copyright (C) 1998-2010 gEDA developers\n"
"This is free software, and you are welcome to redistribute it under\n"
"certain conditions. For details, see the file `COPYING', which is\n"
"included in the gEDA distribution.\n"
"There is NO WARRANTY, to the extent permitted by law.\n"
);
}
} else {
run_lst = scm_cons (scm_list_1 (sym_quit), run_lst);
}
/* Reverse lists */
setup_lst = scm_reverse_x (setup_lst, SCM_UNDEFINED);
run_lst = scm_reverse_x (run_lst, SCM_UNDEFINED);
/* Initialise libgeda */
libgeda_init ();
scm_dynwind_begin (0);
toplevel = s_toplevel_new ();
edascm_dynwind_toplevel (toplevel);
/* First run the setup list */
if (setup_lst != SCM_EOL) {
setup_lst = scm_cons (sym_begin, setup_lst);
scm_eval_x (setup_lst, scm_current_module ());
}
/* Now load rc files, if necessary */
if (!inhibit_rc)
g_rc_parse (toplevel, argv[0], NULL, NULL);
i_vars_libgeda_set (toplevel); /* Ugh */
/* Finally evaluate run list */
run_lst = scm_cons (sym_begin, run_lst);
status = scm_exit_status (scm_eval_x (run_lst, scm_current_module ()));
exit (status);
scm_dynwind_end ();
scm_remember_upto_here_2 (setup_lst, run_lst);
}
int main(int argc, char** argv)
{
if (!glfwInit())
return EXIT_FAILURE;
glfwWindowHint(GLFW_DEPTH_BITS, 24);
GLFWwindow* window = glfwCreateWindow(WIDTH, HEIGHT, "guihck-glhckElements", NULL, NULL);
if(!window)
{
return EXIT_FAILURE;
}
glfwMakeContextCurrent(window);
glfwSwapInterval(1);
glfwSetWindowCloseCallback(window, windowCloseCallback);
if(!glhckInit(argc, argv))
{
printf("GLHCK initialization error\n");
return EXIT_FAILURE;
}
glhckLogColor(0);
if(!glhckDisplayCreate(WIDTH, HEIGHT, 0))
{
printf("GLHCK display create error");
return EXIT_FAILURE;
}
glhckRenderClearColoru(128, 128, 128, 255);
guihckInit();
guihckContext* ctx = guihckContextNew();
guihckGlhckAddAllTypes(ctx);
guihckStackPushNewElement(ctx, "rectangle");
guihckStackElementProperty(ctx, "x", scm_from_double(200.0));
guihckStackElementProperty(ctx, "y", scm_from_double(100.0));
guihckStackElementProperty(ctx, "width", scm_from_double(50.0));
guihckStackElementProperty(ctx, "height", scm_from_double(75.0));
guihckStackElementProperty(ctx, "color", scm_list_3(scm_from_uint8(128), scm_from_uint8(52), scm_from_uint8(200)));
guihckStackPopElement(ctx);
guihckStackPushNewElement(ctx, "text");
guihckStackElementProperty(ctx, "x", scm_from_double(50.0));
guihckStackElementProperty(ctx, "y", scm_from_double(300.0));
guihckStackElementProperty(ctx, "text", scm_from_utf8_string("guihck rocks!"));
guihckStackElementProperty(ctx, "size", scm_from_double(100));
guihckStackElementProperty(ctx, "color", scm_list_3(scm_from_uint8(128), scm_from_uint8(52), scm_from_uint8(200)));
guihckStackPopElement(ctx);
while(RUNNING)
{
glfwPollEvents();
guihckContextUpdate(ctx);
glhckRenderClear(GLHCK_DEPTH_BUFFER_BIT | GLHCK_COLOR_BUFFER_BIT);
guihckContextRender(ctx);
glfwSwapBuffers(window);
}
guihckContextFree(ctx);
return EXIT_SUCCESS;
}
static int
pyscm_PySCM_setattr(pyscm_PySCMObject *self, char *name, PyObject *v)
{
/* Set attribute 'name' to value 'v'. v==NULL means delete */
if (pyguile_verbosity_test(PYGUILE_VERBOSE_PYSCM)) {
scm_simple_format(scm_current_output_port(),scm_makfrom0str("# pyscm_PySCM_setattr: trying to set attribute=~S from pobj=~S to value ~S\n"),scm_list_3(scm_makfrom0str(name),verbosity_repr((PyObject *)self),verbosity_repr(v)));
}
SCM sobj_keyword;
SCM sattr_vector = retrieve_sattr_vector(self,name,&sobj_keyword);
if (SCM_UNBNDP(sattr_vector)) {
// Attribute error exception was raised by retrieve_sattr_vector().
return(-1);
}
SCM ssetattr_func = GET_H_SETATTR_FUNC(sattr_vector);
if (SCM_EQ_P(SCM_EOL,ssetattr_func)) {
PyErr_SetString(PyExc_AttributeError, name);
return(-1);
}
if (NULL != v) {
SCM sval = p2g_apply(v,
GET_H_P2G_SETATTR_TEMPLATE(sattr_vector));
scm_append_x(scm_list_2(sobj_keyword,sval));
}
SCM sresult = scm_apply(ssetattr_func,sobj_keyword,SCM_EOL);
return(SCM_EQ_P(SCM_BOOL_F,sresult) ? (-1) : 0);
}
/*! \brief Parse gschem command-line options.
* \par Function Description
* Parse command line options, displaying usage message or version
* information as required.
*
* \param argc Number of command-line arguments.
* \param argv Array of command-line arguments.
* \return index into \a argv of first non-option argument.
*/
int
parse_commandline(int argc, char *argv[])
{
int ch;
SCM sym_cons = scm_from_utf8_symbol ("cons");
SCM sym_set_x = scm_from_utf8_symbol ("set!");
SCM sym_load_path = scm_from_utf8_symbol ("%load-path");
SCM sym_begin = scm_from_utf8_symbol ("begin");
SCM sym_load = scm_from_utf8_symbol ("load");
SCM sym_eval_string = scm_from_utf8_symbol ("eval-string");
#ifdef HAVE_GETOPT_LONG
while ((ch = getopt_long (argc, argv, GETOPT_OPTIONS, long_options, NULL)) != -1) {
#else
while ((ch = getopt (argc, argv, GETOPT_OPTIONS)) != -1) {
#endif
switch (ch) {
case 'v':
verbose_mode = TRUE;
break;
case 'q':
quiet_mode = TRUE;
break;
case 's':
/* Argument is filename of a Scheme script to be run on gschem
* load. Add the necessary expression to be evaluated after
* loading. */
s_post_load_expr =
scm_cons (scm_list_2 (sym_load,
scm_from_locale_string (optarg)),
s_post_load_expr);
break;
case 'c':
/* Argument is a Scheme expression to be evaluated on gschem
* load. Add the necessary expression to be evaluated after
* loading. */
s_post_load_expr =
scm_cons (scm_list_2 (sym_eval_string,
scm_from_locale_string (optarg)),
s_post_load_expr);
break;
case 'o':
output_filename_s = scm_from_locale_string (optarg);
break;
case 'p':
auto_place_mode = TRUE;
break;
case 'L':
/* Argument is a directory to add to the Scheme load path.
* Add the necessary expression to be evaluated before rc file
* loading. */
s_pre_load_expr =
scm_cons (scm_list_3 (sym_set_x,
sym_load_path,
scm_list_3 (sym_cons,
scm_from_locale_string (optarg),
sym_load_path)),
s_pre_load_expr);
break;
case 'h':
usage(argv[0]);
break;
case 'V':
version ();
break;
case '?':
#ifndef HAVE_GETOPT_LONG
if ((optopt != ':') && (strchr (GETOPT_OPTIONS, optopt) != NULL)) {
fprintf (stderr,
"ERROR: -%c option requires an argument.\n\n",
optopt);
} else if (isprint (optopt)) {
fprintf (stderr, "ERROR: Unknown option -%c.\n\n", optopt);
} else {
fprintf (stderr, "ERROR: Unknown option character `\\x%x'.\n\n",
optopt);
}
#endif
fprintf (stderr, "\nRun `%s --help' for more information.\n", argv[0]);
exit (1);
break;
default:
g_assert_not_reached ();
}
}
if (quiet_mode) {
verbose_mode = FALSE;
}
/* Make sure Scheme expressions can be passed straight to eval */
s_pre_load_expr = scm_cons (sym_begin,
scm_reverse_x (s_pre_load_expr, SCM_UNDEFINED));
scm_gc_protect_object (s_pre_load_expr);
s_post_load_expr = scm_cons (sym_begin,
scm_reverse_x (s_post_load_expr, SCM_UNDEFINED));
scm_gc_protect_object (s_post_load_expr);
return(optind);
}
static SCM
expand_lambda_star_case (SCM clause, SCM alternate, SCM env)
{
SCM req, opt, kw, allow_other_keys, rest, formals, vars, body, tmp;
SCM inits;
int nreq, nopt;
const long length = scm_ilength (clause);
ASSERT_SYNTAX (length >= 1, s_bad_expression,
scm_cons (sym_lambda_star, clause));
ASSERT_SYNTAX (length >= 2, s_missing_expression,
scm_cons (sym_lambda_star, clause));
formals = CAR (clause);
body = CDR (clause);
nreq = nopt = 0;
req = opt = kw = SCM_EOL;
rest = allow_other_keys = SCM_BOOL_F;
while (scm_is_pair (formals) && scm_is_symbol (CAR (formals)))
{
nreq++;
req = scm_cons (CAR (formals), req);
formals = scm_cdr (formals);
}
if (scm_is_pair (formals) && scm_is_eq (CAR (formals), kw_optional))
{
formals = CDR (formals);
while (scm_is_pair (formals)
&& (scm_is_symbol (CAR (formals)) || scm_is_pair (CAR (formals))))
{
nopt++;
opt = scm_cons (CAR (formals), opt);
formals = scm_cdr (formals);
}
}
if (scm_is_pair (formals) && scm_is_eq (CAR (formals), kw_key))
{
formals = CDR (formals);
while (scm_is_pair (formals)
&& (scm_is_symbol (CAR (formals)) || scm_is_pair (CAR (formals))))
{
kw = scm_cons (CAR (formals), kw);
formals = scm_cdr (formals);
}
}
if (scm_is_pair (formals) && scm_is_eq (CAR (formals), kw_allow_other_keys))
{
formals = CDR (formals);
allow_other_keys = SCM_BOOL_T;
}
if (scm_is_pair (formals) && scm_is_eq (CAR (formals), kw_rest))
{
ASSERT_SYNTAX (scm_ilength (formals) == 2, s_bad_formals,
CAR (clause));
rest = CADR (formals);
}
else if (scm_is_symbol (formals))
rest = formals;
else
{
ASSERT_SYNTAX (scm_is_null (formals), s_bad_formals, CAR (clause));
rest = SCM_BOOL_F;
}
/* Now, iterate through them a second time, building up an expansion-time
environment, checking, expanding and canonicalizing the opt/kw init forms,
and eventually memoizing the body as well. Note that the rest argument, if
any, is expanded before keyword args, thus necessitating the second
pass.
Also note that the specific environment during expansion of init
expressions here needs to coincide with the environment when psyntax
expands. A lot of effort for something that is only used in the bootstrap
expandr, you say? Yes. Yes it is.
*/
vars = SCM_EOL;
req = scm_reverse_x (req, SCM_EOL);
for (tmp = req; scm_is_pair (tmp); tmp = scm_cdr (tmp))
{
vars = scm_cons (scm_gensym (SCM_UNDEFINED), vars);
env = scm_acons (CAR (tmp), CAR (vars), env);
}
/* Build up opt inits and env */
inits = SCM_EOL;
opt = scm_reverse_x (opt, SCM_EOL);
for (tmp = opt; scm_is_pair (tmp); tmp = scm_cdr (tmp))
{
SCM x = CAR (tmp);
vars = scm_cons (scm_gensym (SCM_UNDEFINED), vars);
env = scm_acons (x, CAR (vars), env);
if (scm_is_symbol (x))
inits = scm_cons (CONST (SCM_BOOL_F, SCM_BOOL_F), inits);
else
{
ASSERT_SYNTAX (scm_ilength (x) == 2 && scm_is_symbol (CAR (x)),
s_bad_formals, CAR (clause));
inits = scm_cons (expand (CADR (x), env), inits);
}
env = scm_acons (scm_is_symbol (x) ? x : CAR (x), CAR (vars), env);
}
if (scm_is_null (opt))
opt = SCM_BOOL_F;
/* Process rest before keyword args */
if (scm_is_true (rest))
{
vars = scm_cons (scm_gensym (SCM_UNDEFINED), vars);
env = scm_acons (rest, CAR (vars), env);
}
/* Build up kw inits, env, and kw-canon list */
if (scm_is_null (kw))
kw = SCM_BOOL_F;
else
{
SCM kw_canon = SCM_EOL;
kw = scm_reverse_x (kw, SCM_UNDEFINED);
for (tmp = kw; scm_is_pair (tmp); tmp = scm_cdr (tmp))
{
SCM x, sym, k, init;
x = CAR (tmp);
if (scm_is_symbol (x))
{
sym = x;
init = SCM_BOOL_F;
k = scm_symbol_to_keyword (sym);
}
else if (scm_ilength (x) == 2 && scm_is_symbol (CAR (x)))
{
sym = CAR (x);
init = CADR (x);
k = scm_symbol_to_keyword (sym);
}
else if (scm_ilength (x) == 3 && scm_is_symbol (CAR (x))
&& scm_is_keyword (CADDR (x)))
{
sym = CAR (x);
init = CADR (x);
k = CADDR (x);
}
else
syntax_error (s_bad_formals, CAR (clause), SCM_UNDEFINED);
inits = scm_cons (expand (init, env), inits);
vars = scm_cons (scm_gensym (SCM_UNDEFINED), vars);
kw_canon = scm_cons (scm_list_3 (k, sym, CAR (vars)), kw_canon);
env = scm_acons (sym, CAR (vars), env);
}
kw_canon = scm_reverse_x (kw_canon, SCM_UNDEFINED);
kw = scm_cons (allow_other_keys, kw_canon);
}
/* We should check for no duplicates, but given that psyntax does this
already, we can punt on it here... */
vars = scm_reverse_x (vars, SCM_UNDEFINED);
inits = scm_reverse_x (inits, SCM_UNDEFINED);
body = expand_sequence (body, env);
return LAMBDA_CASE (SCM_BOOL_F, req, opt, rest, kw, inits, vars, body,
alternate);
}
