1 /* Copyright (C) 1995,1996,1997,1998,1999,2000,2001,2002,2003,2004,2005,2006,2007,2008,2009,2010
2 * Free Software Foundation, Inc.
4 * This library is free software; you can redistribute it and/or
5 * modify it under the terms of the GNU Lesser General Public License
6 * as published by the Free Software Foundation; either version 3 of
7 * the License, or (at your option) any later version.
9 * This library is distributed in the hope that it will be useful, but
10 * WITHOUT ANY WARRANTY; without even the implied warranty of
11 * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
12 * Lesser General Public License for more details.
14 * You should have received a copy of the GNU Lesser General Public
15 * License along with this library; if not, write to the Free Software
16 * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
26 #include "libguile/__scm.h"
27 #include "libguile/_scm.h"
28 #include "libguile/continuations.h"
29 #include "libguile/eq.h"
30 #include "libguile/list.h"
31 #include "libguile/macros.h"
32 #include "libguile/expand.h"
33 #include "libguile/modules.h"
34 #include "libguile/srcprop.h"
35 #include "libguile/ports.h"
36 #include "libguile/print.h"
37 #include "libguile/strings.h"
38 #include "libguile/throw.h"
39 #include "libguile/validate.h"
45 SCM scm_exp_vtable_vtable
;
46 static SCM exp_vtables
[SCM_NUM_EXPANDED_TYPES
];
47 static size_t exp_nfields
[SCM_NUM_EXPANDED_TYPES
];
48 static const char* exp_names
[SCM_NUM_EXPANDED_TYPES
];
49 static const char** exp_field_names
[SCM_NUM_EXPANDED_TYPES
];
53 SCM_MAKE_EXPANDED_VOID(src)
54 #define CONST(src, exp) \
55 SCM_MAKE_EXPANDED_CONST(src, exp)
56 #define PRIMITIVE_REF_TYPE(src, name) \
57 SCM_MAKE_EXPANDED_PRIMITIVE_REF_TYPE(src, name)
58 #define LEXICAL_REF(src, name, gensym) \
59 SCM_MAKE_EXPANDED_LEXICAL_REF(src, name, gensym)
60 #define LEXICAL_SET(src, name, gensym, exp) \
61 SCM_MAKE_EXPANDED_LEXICAL_SET(src, name, gensym, exp)
62 #define MODULE_REF(src, mod, name, public) \
63 SCM_MAKE_EXPANDED_MODULE_REF(src, mod, name, public)
64 #define MODULE_SET(src, mod, name, public, exp) \
65 SCM_MAKE_EXPANDED_MODULE_SET(src, mod, name, public, exp)
66 #define TOPLEVEL_REF(src, name) \
67 SCM_MAKE_EXPANDED_TOPLEVEL_REF(src, name)
68 #define TOPLEVEL_SET(src, name, exp) \
69 SCM_MAKE_EXPANDED_TOPLEVEL_SET(src, name, exp)
70 #define TOPLEVEL_DEFINE(src, name, exp) \
71 SCM_MAKE_EXPANDED_TOPLEVEL_DEFINE(src, name, exp)
72 #define CONDITIONAL(src, test, consequent, alternate) \
73 SCM_MAKE_EXPANDED_CONDITIONAL(src, test, consequent, alternate)
74 #define APPLICATION(src, proc, exps) \
75 SCM_MAKE_EXPANDED_APPLICATION(src, proc, exps)
76 #define SEQUENCE(src, exps) \
77 SCM_MAKE_EXPANDED_SEQUENCE(src, exps)
78 #define LAMBDA(src, meta, body) \
79 SCM_MAKE_EXPANDED_LAMBDA(src, meta, body)
80 #define LAMBDA_CASE(src, req, opt, rest, kw, inits, gensyms, body, alternate) \
81 SCM_MAKE_EXPANDED_LAMBDA_CASE(src, req, opt, rest, kw, inits, gensyms, body, alternate)
82 #define LET(src, names, gensyms, vals, body) \
83 SCM_MAKE_EXPANDED_LET(src, names, gensyms, vals, body)
84 #define LETREC(src, names, gensyms, vals, body) \
85 SCM_MAKE_EXPANDED_LETREC(src, names, gensyms, vals, body)
86 #define DYNLET(src, fluids, vals, body) \
87 SCM_MAKE_EXPANDED_DYNLET(src, fluids, vals, body)
89 #define CAR(x) SCM_CAR(x)
90 #define CDR(x) SCM_CDR(x)
91 #define CAAR(x) SCM_CAAR(x)
92 #define CADR(x) SCM_CADR(x)
93 #define CDAR(x) SCM_CDAR(x)
94 #define CDDR(x) SCM_CDDR(x)
95 #define CADDR(x) SCM_CADDR(x)
96 #define CDDDR(x) SCM_CDDDR(x)
97 #define CADDDR(x) SCM_CADDDR(x)
100 static const char s_bad_expression
[] = "Bad expression";
101 static const char s_expression
[] = "Missing or extra expression in";
102 static const char s_missing_expression
[] = "Missing expression in";
103 static const char s_extra_expression
[] = "Extra expression in";
104 static const char s_empty_combination
[] = "Illegal empty combination";
105 static const char s_missing_body_expression
[] = "Missing body expression in";
106 static const char s_mixed_body_forms
[] = "Mixed definitions and expressions in";
107 static const char s_bad_define
[] = "Bad define placement";
108 static const char s_missing_clauses
[] = "Missing clauses";
109 static const char s_misplaced_else_clause
[] = "Misplaced else clause";
110 static const char s_bad_case_clause
[] = "Bad case clause";
111 static const char s_bad_case_labels
[] = "Bad case labels";
112 static const char s_duplicate_case_label
[] = "Duplicate case label";
113 static const char s_bad_cond_clause
[] = "Bad cond clause";
114 static const char s_missing_recipient
[] = "Missing recipient in";
115 static const char s_bad_variable
[] = "Bad variable";
116 static const char s_bad_bindings
[] = "Bad bindings";
117 static const char s_bad_binding
[] = "Bad binding";
118 static const char s_duplicate_binding
[] = "Duplicate binding";
119 static const char s_bad_exit_clause
[] = "Bad exit clause";
120 static const char s_bad_formals
[] = "Bad formals";
121 static const char s_bad_formal
[] = "Bad formal";
122 static const char s_duplicate_formal
[] = "Duplicate formal";
123 static const char s_splicing
[] = "Non-list result for unquote-splicing";
124 static const char s_bad_slot_number
[] = "Bad slot number";
126 static void syntax_error (const char* const, const SCM
, const SCM
) SCM_NORETURN
;
128 SCM_SYMBOL (syntax_error_key
, "syntax-error");
130 /* Shortcut macros to simplify syntax error handling. */
131 #define ASSERT_SYNTAX(cond, message, form) \
132 { if (SCM_UNLIKELY (!(cond))) \
133 syntax_error (message, form, SCM_UNDEFINED); }
134 #define ASSERT_SYNTAX_2(cond, message, form, expr) \
135 { if (SCM_UNLIKELY (!(cond))) \
136 syntax_error (message, form, expr); }
141 /* Primitive syntax. */
143 #define SCM_SYNTAX(STR, CFN) \
144 SCM_SNARF_HERE(static SCM CFN (SCM xorig, SCM env)) \
145 SCM_SNARF_INIT(scm_c_define (STR, scm_i_make_primitive_macro (STR, CFN)))
148 /* True primitive syntax */
149 SCM_SYNTAX ("@", expand_at
);
150 SCM_SYNTAX ("@@", expand_atat
);
151 SCM_SYNTAX ("begin", expand_begin
);
152 SCM_SYNTAX ("define", expand_define
);
153 SCM_SYNTAX ("with-fluids", expand_with_fluids
);
154 SCM_SYNTAX ("eval-when", expand_eval_when
);
155 SCM_SYNTAX ("if", expand_if
);
156 SCM_SYNTAX ("lambda", expand_lambda
);
157 SCM_SYNTAX ("let", expand_let
);
158 SCM_SYNTAX ("quote", expand_quote
);
159 SCM_SYNTAX ("set!", expand_set_x
);
161 /* Convenient syntax during boot, expands to primitive syntax. Replaced after
163 SCM_SYNTAX ("and", expand_and
);
164 SCM_SYNTAX ("cond", expand_cond
);
165 SCM_SYNTAX ("letrec", expand_letrec
);
166 SCM_SYNTAX ("let*", expand_letstar
);
167 SCM_SYNTAX ("or", expand_or
);
168 SCM_SYNTAX ("lambda*", expand_lambda_star
);
169 SCM_SYNTAX ("case-lambda", expand_case_lambda
);
170 SCM_SYNTAX ("case-lambda*", expand_case_lambda_star
);
173 SCM_GLOBAL_SYMBOL (scm_sym_apply
, "apply");
174 SCM_GLOBAL_SYMBOL (scm_sym_arrow
, "=>");
175 SCM_GLOBAL_SYMBOL (scm_sym_at
, "@");
176 SCM_GLOBAL_SYMBOL (scm_sym_atat
, "@@");
177 SCM_GLOBAL_SYMBOL (scm_sym_at_call_with_values
, "@call-with-values");
178 SCM_GLOBAL_SYMBOL (scm_sym_atapply
, "@apply");
179 SCM_GLOBAL_SYMBOL (scm_sym_atcall_cc
, "@call-with-current-continuation");
180 SCM_GLOBAL_SYMBOL (scm_sym_begin
, "begin");
181 SCM_GLOBAL_SYMBOL (scm_sym_case
, "case");
182 SCM_GLOBAL_SYMBOL (scm_sym_cond
, "cond");
183 SCM_GLOBAL_SYMBOL (scm_sym_define
, "define");
184 SCM_GLOBAL_SYMBOL (scm_sym_at_dynamic_wind
, "@dynamic-wind");
185 SCM_GLOBAL_SYMBOL (scm_sym_with_fluids
, "with-fluids");
186 SCM_GLOBAL_SYMBOL (scm_sym_else
, "else");
187 SCM_GLOBAL_SYMBOL (scm_sym_eval_when
, "eval-when");
188 SCM_GLOBAL_SYMBOL (scm_sym_if
, "if");
189 SCM_GLOBAL_SYMBOL (scm_sym_lambda
, "lambda");
190 SCM_GLOBAL_SYMBOL (scm_sym_let
, "let");
191 SCM_GLOBAL_SYMBOL (scm_sym_letrec
, "letrec");
192 SCM_GLOBAL_SYMBOL (scm_sym_letstar
, "let*");
193 SCM_GLOBAL_SYMBOL (scm_sym_or
, "or");
194 SCM_GLOBAL_SYMBOL (scm_sym_at_prompt
, "@prompt");
195 SCM_GLOBAL_SYMBOL (scm_sym_quote
, "quote");
196 SCM_GLOBAL_SYMBOL (scm_sym_set_x
, "set!");
197 SCM_SYMBOL (sym_lambda_star
, "lambda*");
198 SCM_SYMBOL (sym_eval
, "eval");
199 SCM_SYMBOL (sym_load
, "load");
201 SCM_GLOBAL_SYMBOL (scm_sym_unquote
, "unquote");
202 SCM_GLOBAL_SYMBOL (scm_sym_quasiquote
, "quasiquote");
203 SCM_GLOBAL_SYMBOL (scm_sym_uq_splicing
, "unquote-splicing");
205 SCM_KEYWORD (kw_allow_other_keys
, "allow-other-keys");
206 SCM_KEYWORD (kw_optional
, "optional");
207 SCM_KEYWORD (kw_key
, "key");
208 SCM_KEYWORD (kw_rest
, "rest");
214 /* Signal a syntax error. We distinguish between the form that caused the
215 * error and the enclosing expression. The error message will print out as
216 * shown in the following pattern. The file name and line number are only
217 * given when they can be determined from the erroneous form or from the
218 * enclosing expression.
220 * <filename>: In procedure memoization:
221 * <filename>: In file <name>, line <nr>: <error-message> in <expression>. */
224 syntax_error (const char* const msg
, const SCM form
, const SCM expr
)
226 SCM msg_string
= scm_from_locale_string (msg
);
227 SCM filename
= SCM_BOOL_F
;
228 SCM linenr
= SCM_BOOL_F
;
232 if (scm_is_pair (form
))
234 filename
= scm_source_property (form
, scm_sym_filename
);
235 linenr
= scm_source_property (form
, scm_sym_line
);
238 if (scm_is_false (filename
) && scm_is_false (linenr
) && scm_is_pair (expr
))
240 filename
= scm_source_property (expr
, scm_sym_filename
);
241 linenr
= scm_source_property (expr
, scm_sym_line
);
244 if (!SCM_UNBNDP (expr
))
246 if (scm_is_true (filename
))
248 format
= "In file ~S, line ~S: ~A ~S in expression ~S.";
249 args
= scm_list_5 (filename
, linenr
, msg_string
, form
, expr
);
251 else if (scm_is_true (linenr
))
253 format
= "In line ~S: ~A ~S in expression ~S.";
254 args
= scm_list_4 (linenr
, msg_string
, form
, expr
);
258 format
= "~A ~S in expression ~S.";
259 args
= scm_list_3 (msg_string
, form
, expr
);
264 if (scm_is_true (filename
))
266 format
= "In file ~S, line ~S: ~A ~S.";
267 args
= scm_list_4 (filename
, linenr
, msg_string
, form
);
269 else if (scm_is_true (linenr
))
271 format
= "In line ~S: ~A ~S.";
272 args
= scm_list_3 (linenr
, msg_string
, form
);
277 args
= scm_list_2 (msg_string
, form
);
281 scm_error (syntax_error_key
, "memoization", format
, args
, SCM_BOOL_F
);
289 expand_env_var_is_free (SCM env
, SCM x
)
291 for (; scm_is_pair (env
); env
= CDR (env
))
292 if (scm_is_eq (x
, CAAR (env
)))
293 return 0; /* bound */
298 expand_env_ref_macro (SCM env
, SCM x
)
301 if (!expand_env_var_is_free (env
, x
))
302 return SCM_BOOL_F
; /* lexical */
304 var
= scm_module_variable (scm_current_module (), x
);
305 if (scm_is_true (var
) && scm_is_true (scm_variable_bound_p (var
))
306 && scm_is_true (scm_macro_p (scm_variable_ref (var
))))
307 return scm_variable_ref (var
);
309 return SCM_BOOL_F
; /* anything else */
313 expand_env_lexical_gensym (SCM env
, SCM name
)
315 for (; scm_is_pair (env
); env
= CDR (env
))
316 if (scm_is_eq (name
, CAAR (env
)))
317 return CDAR (env
); /* bound */
318 return SCM_BOOL_F
; /* free */
322 expand_env_extend (SCM env
, SCM names
, SCM vars
)
324 while (scm_is_pair (names
))
326 env
= scm_acons (CAR (names
), CAR (vars
), env
);
334 expand (SCM exp
, SCM env
)
336 if (scm_is_pair (exp
))
339 scm_t_macro_primitive trans
= NULL
;
340 SCM macro
= SCM_BOOL_F
;
343 if (scm_is_symbol (car
))
344 macro
= expand_env_ref_macro (env
, car
);
346 if (scm_is_true (macro
))
347 trans
= scm_i_macro_primitive (macro
);
350 return trans (exp
, env
);
353 SCM arg_exps
= SCM_EOL
;
355 SCM proc
= CAR (exp
);
357 for (arg_exps
= CDR (exp
); scm_is_pair (arg_exps
);
358 arg_exps
= CDR (arg_exps
))
359 args
= scm_cons (expand (CAR (arg_exps
), env
), args
);
360 if (scm_is_null (arg_exps
))
361 return APPLICATION (scm_source_properties (exp
),
363 scm_reverse_x (args
, SCM_UNDEFINED
));
365 syntax_error ("expected a proper list", exp
, SCM_UNDEFINED
);
368 else if (scm_is_symbol (exp
))
370 SCM gensym
= expand_env_lexical_gensym (env
, exp
);
371 if (scm_is_true (gensym
))
372 return LEXICAL_REF (SCM_BOOL_F
, exp
, gensym
);
374 return TOPLEVEL_REF (SCM_BOOL_F
, exp
);
377 return CONST (SCM_BOOL_F
, exp
);
381 expand_exprs (SCM forms
, const SCM env
)
385 for (; !scm_is_null (forms
); forms
= CDR (forms
))
386 ret
= scm_cons (expand (CAR (forms
), env
), ret
);
387 return scm_reverse_x (ret
, SCM_UNDEFINED
);
391 expand_sequence (const SCM forms
, const SCM env
)
393 ASSERT_SYNTAX (scm_ilength (forms
) >= 1, s_bad_expression
,
394 scm_cons (scm_sym_begin
, forms
));
395 if (scm_is_null (CDR (forms
)))
396 return expand (CAR (forms
), env
);
398 return SEQUENCE (SCM_BOOL_F
, expand_exprs (forms
, env
));
406 expand_at (SCM expr
, SCM env SCM_UNUSED
)
408 ASSERT_SYNTAX (scm_ilength (expr
) == 3, s_bad_expression
, expr
);
409 ASSERT_SYNTAX (scm_ilength (CADR (expr
)) > 0, s_bad_expression
, expr
);
410 ASSERT_SYNTAX (scm_is_symbol (CADDR (expr
)), s_bad_expression
, expr
);
412 return MODULE_REF (scm_source_properties (expr
),
413 CADR (expr
), CADDR (expr
), SCM_BOOL_T
);
417 expand_atat (SCM expr
, SCM env SCM_UNUSED
)
419 ASSERT_SYNTAX (scm_ilength (expr
) == 3, s_bad_expression
, expr
);
420 ASSERT_SYNTAX (scm_ilength (CADR (expr
)) > 0, s_bad_expression
, expr
);
421 ASSERT_SYNTAX (scm_is_symbol (CADDR (expr
)), s_bad_expression
, expr
);
423 return MODULE_REF (scm_source_properties (expr
),
424 CADR (expr
), CADDR (expr
), SCM_BOOL_F
);
428 expand_and (SCM expr
, SCM env
)
430 const SCM cdr_expr
= CDR (expr
);
432 if (scm_is_null (cdr_expr
))
433 return CONST (SCM_BOOL_F
, SCM_BOOL_T
);
435 ASSERT_SYNTAX (scm_is_pair (cdr_expr
), s_bad_expression
, expr
);
437 if (scm_is_null (CDR (cdr_expr
)))
438 return expand (CAR (cdr_expr
), env
);
440 return CONDITIONAL (scm_source_properties (expr
),
441 expand (CAR (cdr_expr
), env
),
442 expand_and (cdr_expr
, env
),
443 CONST (SCM_BOOL_F
, SCM_BOOL_F
));
447 expand_begin (SCM expr
, SCM env
)
449 const SCM cdr_expr
= CDR (expr
);
450 ASSERT_SYNTAX (scm_ilength (cdr_expr
) >= 1, s_bad_expression
, expr
);
451 return expand_sequence (cdr_expr
, env
);
455 expand_cond_clauses (SCM clause
, SCM rest
, int elp
, int alp
, SCM env
)
458 const long length
= scm_ilength (clause
);
459 ASSERT_SYNTAX (length
>= 1, s_bad_cond_clause
, clause
);
462 if (scm_is_eq (test
, scm_sym_else
) && elp
)
464 const int last_clause_p
= scm_is_null (rest
);
465 ASSERT_SYNTAX (length
>= 2, s_bad_cond_clause
, clause
);
466 ASSERT_SYNTAX (last_clause_p
, s_misplaced_else_clause
, clause
);
467 return expand_sequence (CDR (clause
), env
);
470 if (scm_is_null (rest
))
471 rest
= VOID (SCM_BOOL_F
);
473 rest
= expand_cond_clauses (CAR (rest
), CDR (rest
), elp
, alp
, env
);
476 && scm_is_eq (CADR (clause
), scm_sym_arrow
)
479 SCM tmp
= scm_gensym (scm_from_locale_string ("cond "));
480 SCM new_env
= scm_acons (tmp
, tmp
, env
);
481 ASSERT_SYNTAX (length
> 2, s_missing_recipient
, clause
);
482 ASSERT_SYNTAX (length
== 3, s_extra_expression
, clause
);
483 return LET (SCM_BOOL_F
,
486 scm_list_1 (expand (test
, env
)),
487 CONDITIONAL (SCM_BOOL_F
,
488 LEXICAL_REF (SCM_BOOL_F
, tmp
, tmp
),
489 APPLICATION (SCM_BOOL_F
,
490 expand (CADDR (clause
), new_env
),
491 scm_list_1 (LEXICAL_REF (SCM_BOOL_F
,
495 /* FIXME length == 1 case */
497 return CONDITIONAL (SCM_BOOL_F
,
499 expand_sequence (CDR (clause
), env
),
504 expand_cond (SCM expr
, SCM env
)
506 const int else_literal_p
= expand_env_var_is_free (env
, scm_sym_else
);
507 const int arrow_literal_p
= expand_env_var_is_free (env
, scm_sym_arrow
);
508 const SCM clauses
= CDR (expr
);
510 ASSERT_SYNTAX (scm_ilength (clauses
) >= 0, s_bad_expression
, expr
);
511 ASSERT_SYNTAX (scm_ilength (clauses
) >= 1, s_missing_clauses
, expr
);
513 return expand_cond_clauses (CAR (clauses
), CDR (clauses
),
514 else_literal_p
, arrow_literal_p
, env
);
517 /* lone forward decl */
518 static SCM
expand_lambda (SCM expr
, SCM env
);
520 /* According to Section 5.2.1 of R5RS we first have to make sure that the
521 variable is bound, and then perform the `(set! variable expression)'
522 operation. However, EXPRESSION _can_ be evaluated before VARIABLE is
523 bound. This means that EXPRESSION won't necessarily be able to assign
524 values to VARIABLE as in `(define foo (begin (set! foo 1) (+ foo 1)))'. */
526 expand_define (SCM expr
, SCM env
)
528 const SCM cdr_expr
= CDR (expr
);
532 ASSERT_SYNTAX (scm_ilength (cdr_expr
) >= 0, s_bad_expression
, expr
);
533 ASSERT_SYNTAX (scm_ilength (cdr_expr
) >= 2, s_missing_expression
, expr
);
534 ASSERT_SYNTAX (!scm_is_pair (env
), s_bad_define
, expr
);
536 body
= CDR (cdr_expr
);
537 variable
= CAR (cdr_expr
);
539 if (scm_is_pair (variable
))
541 ASSERT_SYNTAX_2 (scm_is_symbol (CAR (variable
)), s_bad_variable
, variable
, expr
);
542 return TOPLEVEL_DEFINE
543 (scm_source_properties (expr
),
545 expand_lambda (scm_cons (scm_sym_lambda
, scm_cons (CDR (variable
), body
)),
548 ASSERT_SYNTAX_2 (scm_is_symbol (variable
), s_bad_variable
, variable
, expr
);
549 ASSERT_SYNTAX (scm_ilength (body
) == 1, s_expression
, expr
);
550 return TOPLEVEL_DEFINE (scm_source_properties (expr
), variable
,
551 expand (CAR (body
), env
));
555 expand_with_fluids (SCM expr
, SCM env
)
557 SCM binds
, fluids
, vals
;
558 ASSERT_SYNTAX (scm_ilength (expr
) >= 3, s_bad_expression
, expr
);
560 ASSERT_SYNTAX_2 (scm_ilength (binds
) >= 0, s_bad_bindings
, binds
, expr
);
561 for (fluids
= SCM_EOL
, vals
= SCM_EOL
;
565 SCM binding
= CAR (binds
);
566 ASSERT_SYNTAX_2 (scm_ilength (CAR (binds
)) == 2, s_bad_binding
,
568 fluids
= scm_cons (expand (CAR (binding
), env
), fluids
);
569 vals
= scm_cons (expand (CADR (binding
), env
), vals
);
572 return DYNLET (scm_source_properties (expr
),
573 scm_reverse_x (fluids
, SCM_UNDEFINED
),
574 scm_reverse_x (vals
, SCM_UNDEFINED
),
575 expand_sequence (CDDR (expr
), env
));
579 expand_eval_when (SCM expr
, SCM env
)
581 ASSERT_SYNTAX (scm_ilength (expr
) >= 3, s_bad_expression
, expr
);
582 ASSERT_SYNTAX (scm_ilength (CADR (expr
)) > 0, s_bad_expression
, expr
);
584 if (scm_is_true (scm_memq (sym_eval
, CADR (expr
)))
585 || scm_is_true (scm_memq (sym_load
, CADR (expr
))))
586 return expand_sequence (CDDR (expr
), env
);
588 return VOID (scm_source_properties (expr
));
592 expand_if (SCM expr
, SCM env SCM_UNUSED
)
594 const SCM cdr_expr
= CDR (expr
);
595 const long length
= scm_ilength (cdr_expr
);
596 ASSERT_SYNTAX (length
== 2 || length
== 3, s_expression
, expr
);
597 return CONDITIONAL (scm_source_properties (expr
),
598 expand (CADR (expr
), env
),
599 expand (CADDR (expr
), env
),
601 ? expand (CADDDR (expr
), env
)
602 : VOID (SCM_BOOL_F
)));
605 /* A helper function for expand_lambda to support checking for duplicate
606 * formal arguments: Return true if OBJ is `eq?' to one of the elements of
607 * LIST or to the CDR of the last cons. Therefore, LIST may have any of the
608 * forms that a formal argument can have:
609 * <rest>, (<arg1> ...), (<arg1> ... . <rest>) */
611 c_improper_memq (SCM obj
, SCM list
)
613 for (; scm_is_pair (list
); list
= CDR (list
))
615 if (scm_is_eq (CAR (list
), obj
))
618 return scm_is_eq (list
, obj
);
622 expand_lambda_case (SCM clause
, SCM alternate
, SCM env
)
631 ASSERT_SYNTAX (scm_is_pair (clause
) && scm_is_pair (CDR (clause
)),
632 s_bad_expression
, scm_cons (scm_sym_lambda
, clause
));
634 /* Before iterating the list of formal arguments, make sure the formals
635 * actually are given as either a symbol or a non-cyclic list. */
636 formals
= CAR (clause
);
637 if (scm_is_pair (formals
))
639 /* Dirk:FIXME:: We should check for a cyclic list of formals, and if
640 * detected, report a 'Bad formals' error. */
643 ASSERT_SYNTAX_2 (scm_is_symbol (formals
) || scm_is_null (formals
),
644 s_bad_formals
, formals
, scm_cons (scm_sym_lambda
, clause
));
646 /* Now iterate the list of formal arguments to check if all formals are
647 * symbols, and that there are no duplicates. */
648 while (scm_is_pair (formals
))
650 const SCM formal
= CAR (formals
);
651 formals
= CDR (formals
);
652 ASSERT_SYNTAX_2 (scm_is_symbol (formal
), s_bad_formal
, formal
,
653 scm_cons (scm_sym_lambda
, clause
));
654 ASSERT_SYNTAX_2 (!c_improper_memq (formal
, formals
), s_duplicate_formal
,
655 formal
, scm_cons (scm_sym_lambda
, clause
));
657 req
= scm_cons (formal
, req
);
658 vars
= scm_cons (scm_gensym (SCM_UNDEFINED
), vars
);
659 env
= scm_acons (formal
, CAR (vars
), env
);
662 ASSERT_SYNTAX_2 (scm_is_null (formals
) || scm_is_symbol (formals
),
663 s_bad_formal
, formals
, scm_cons (scm_sym_lambda
, clause
));
664 if (scm_is_symbol (formals
))
667 vars
= scm_cons (scm_gensym (SCM_UNDEFINED
), vars
);
668 env
= scm_acons (rest
, CAR (vars
), env
);
673 body
= expand_sequence (CDR (clause
), env
);
674 req
= scm_reverse_x (req
, SCM_UNDEFINED
);
675 vars
= scm_reverse_x (vars
, SCM_UNDEFINED
);
677 if (scm_is_true (alternate
) && !(SCM_EXPANDED_P (alternate
) && SCM_EXPANDED_TYPE (alternate
) == SCM_EXPANDED_LAMBDA_CASE
))
680 return LAMBDA_CASE (SCM_BOOL_F
, req
, SCM_BOOL_F
, rest
, SCM_BOOL_F
,
681 SCM_EOL
, vars
, body
, alternate
);
685 expand_lambda (SCM expr
, SCM env
)
687 return LAMBDA (scm_source_properties (expr
),
689 expand_lambda_case (CDR (expr
), SCM_BOOL_F
, env
));
693 expand_lambda_star_case (SCM clause
, SCM alternate
, SCM env
)
695 SCM req
, opt
, kw
, allow_other_keys
, rest
, formals
, vars
, body
, tmp
;
696 SCM inits
, kw_indices
;
699 const long length
= scm_ilength (clause
);
700 ASSERT_SYNTAX (length
>= 1, s_bad_expression
,
701 scm_cons (sym_lambda_star
, clause
));
702 ASSERT_SYNTAX (length
>= 2, s_missing_expression
,
703 scm_cons (sym_lambda_star
, clause
));
705 formals
= CAR (clause
);
709 req
= opt
= kw
= SCM_EOL
;
710 rest
= allow_other_keys
= SCM_BOOL_F
;
712 while (scm_is_pair (formals
) && scm_is_symbol (CAR (formals
)))
715 req
= scm_cons (CAR (formals
), req
);
716 formals
= scm_cdr (formals
);
719 if (scm_is_pair (formals
) && scm_is_eq (CAR (formals
), kw_optional
))
721 formals
= CDR (formals
);
722 while (scm_is_pair (formals
)
723 && (scm_is_symbol (CAR (formals
)) || scm_is_pair (CAR (formals
))))
726 opt
= scm_cons (CAR (formals
), opt
);
727 formals
= scm_cdr (formals
);
731 if (scm_is_pair (formals
) && scm_is_eq (CAR (formals
), kw_key
))
733 formals
= CDR (formals
);
734 while (scm_is_pair (formals
)
735 && (scm_is_symbol (CAR (formals
)) || scm_is_pair (CAR (formals
))))
737 kw
= scm_cons (CAR (formals
), kw
);
738 formals
= scm_cdr (formals
);
742 if (scm_is_pair (formals
) && scm_is_eq (CAR (formals
), kw_allow_other_keys
))
744 formals
= CDR (formals
);
745 allow_other_keys
= SCM_BOOL_T
;
748 if (scm_is_pair (formals
) && scm_is_eq (CAR (formals
), kw_rest
))
750 ASSERT_SYNTAX (scm_ilength (formals
) == 2, s_bad_formals
,
752 rest
= CADR (formals
);
754 else if (scm_is_symbol (formals
))
758 ASSERT_SYNTAX (scm_is_null (formals
), s_bad_formals
, CAR (clause
));
762 /* Now, iterate through them a second time, building up an expansion-time
763 environment, checking, expanding and canonicalizing the opt/kw init forms,
764 and eventually memoizing the body as well. Note that the rest argument, if
765 any, is expanded before keyword args, thus necessitating the second
768 Also note that the specific environment during expansion of init
769 expressions here needs to coincide with the environment when psyntax
770 expands. A lot of effort for something that is only used in the bootstrap
771 expandr, you say? Yes. Yes it is.
775 req
= scm_reverse_x (req
, SCM_EOL
);
776 for (tmp
= req
; scm_is_pair (tmp
); tmp
= scm_cdr (tmp
))
778 vars
= scm_cons (scm_gensym (SCM_UNDEFINED
), vars
);
779 env
= scm_acons (CAR (tmp
), CAR (vars
), env
);
782 /* Build up opt inits and env */
784 opt
= scm_reverse_x (opt
, SCM_EOL
);
785 for (tmp
= opt
; scm_is_pair (tmp
); tmp
= scm_cdr (tmp
))
788 vars
= scm_cons (scm_gensym (SCM_UNDEFINED
), vars
);
789 env
= scm_acons (x
, CAR (vars
), env
);
790 if (scm_is_symbol (x
))
791 inits
= scm_cons (CONST (SCM_BOOL_F
, SCM_BOOL_F
), inits
);
794 ASSERT_SYNTAX (scm_ilength (x
) == 2 && scm_is_symbol (CAR (x
)),
795 s_bad_formals
, CAR (clause
));
796 inits
= scm_cons (expand (CADR (x
), env
), inits
);
798 env
= scm_acons (scm_is_symbol (x
) ? x
: CAR (x
), CAR (vars
), env
);
800 if (scm_is_null (opt
))
803 /* Process rest before keyword args */
804 if (scm_is_true (rest
))
806 vars
= scm_cons (scm_gensym (SCM_UNDEFINED
), vars
);
807 env
= scm_acons (rest
, CAR (vars
), env
);
810 /* Build up kw inits, env, and kw-indices alist */
811 if (scm_is_null (kw
))
815 int idx
= nreq
+ nopt
+ (scm_is_true (rest
) ? 1 : 0);
817 kw_indices
= SCM_EOL
;
818 kw
= scm_reverse_x (kw
, SCM_UNDEFINED
);
819 for (tmp
= kw
; scm_is_pair (tmp
); tmp
= scm_cdr (tmp
))
823 if (scm_is_symbol (x
))
827 k
= scm_symbol_to_keyword (sym
);
829 else if (scm_ilength (x
) == 2 && scm_is_symbol (CAR (x
)))
833 k
= scm_symbol_to_keyword (sym
);
835 else if (scm_ilength (x
) == 3 && scm_is_symbol (CAR (x
))
836 && scm_is_keyword (CADDR (x
)))
843 syntax_error (s_bad_formals
, CAR (clause
), SCM_UNDEFINED
);
845 kw_indices
= scm_acons (k
, SCM_I_MAKINUM (idx
++), kw_indices
);
846 inits
= scm_cons (expand (init
, env
), inits
);
847 vars
= scm_cons (scm_gensym (SCM_UNDEFINED
), vars
);
848 env
= scm_acons (sym
, CAR (vars
), env
);
850 kw_indices
= scm_reverse_x (kw_indices
, SCM_UNDEFINED
);
851 kw
= scm_cons (allow_other_keys
, kw_indices
);
854 /* We should check for no duplicates, but given that psyntax does this
855 already, we can punt on it here... */
857 vars
= scm_reverse_x (vars
, SCM_UNDEFINED
);
858 inits
= scm_reverse_x (inits
, SCM_UNDEFINED
);
859 body
= expand_sequence (body
, env
);
861 return LAMBDA_CASE (SCM_BOOL_F
, req
, opt
, rest
, kw
, inits
, vars
, body
,
866 expand_lambda_star (SCM expr
, SCM env
)
868 return LAMBDA (scm_source_properties (expr
),
870 expand_lambda_star_case (CDR (expr
), SCM_BOOL_F
, env
));
874 expand_case_lambda_clauses (SCM expr
, SCM rest
, SCM env
)
878 if (scm_is_pair (rest
))
879 alt
= expand_case_lambda_clauses (CAR (rest
), CDR (rest
), env
);
883 return expand_lambda_case (expr
, alt
, env
);
887 expand_case_lambda (SCM expr
, SCM env
)
889 ASSERT_SYNTAX (scm_is_pair (CDR (expr
)), s_missing_expression
, expr
);
891 return LAMBDA (scm_source_properties (expr
),
893 expand_case_lambda_clauses (CADR (expr
), CDDR (expr
), env
));
897 expand_case_lambda_star_clauses (SCM expr
, SCM rest
, SCM env
)
901 if (scm_is_pair (rest
))
902 alt
= expand_case_lambda_star_clauses (CAR (rest
), CDR (rest
), env
);
906 return expand_lambda_star_case (expr
, alt
, env
);
910 expand_case_lambda_star (SCM expr
, SCM env
)
912 ASSERT_SYNTAX (scm_is_pair (CDR (expr
)), s_missing_expression
, expr
);
914 return LAMBDA (scm_source_properties (expr
),
916 expand_case_lambda_star_clauses (CADR (expr
), CDDR (expr
), env
));
919 /* Check if the format of the bindings is ((<symbol> <init-form>) ...). */
921 check_bindings (const SCM bindings
, const SCM expr
)
925 ASSERT_SYNTAX_2 (scm_ilength (bindings
) >= 0,
926 s_bad_bindings
, bindings
, expr
);
928 binding_idx
= bindings
;
929 for (; !scm_is_null (binding_idx
); binding_idx
= CDR (binding_idx
))
931 SCM name
; /* const */
933 const SCM binding
= CAR (binding_idx
);
934 ASSERT_SYNTAX_2 (scm_ilength (binding
) == 2,
935 s_bad_binding
, binding
, expr
);
937 name
= CAR (binding
);
938 ASSERT_SYNTAX_2 (scm_is_symbol (name
), s_bad_variable
, name
, expr
);
942 /* The bindings, which must have the format ((v1 i1) (v2 i2) ... (vn in)), are
943 * transformed to the lists (vn .. v2 v1) and (i1 i2 ... in). If a duplicate
944 * variable name is detected, an error is signalled. */
946 transform_bindings (const SCM bindings
, const SCM expr
,
947 SCM
*const names
, SCM
*const vars
, SCM
*const initptr
)
949 SCM rnames
= SCM_EOL
;
951 SCM rinits
= SCM_EOL
;
952 SCM binding_idx
= bindings
;
953 for (; !scm_is_null (binding_idx
); binding_idx
= CDR (binding_idx
))
955 const SCM binding
= CAR (binding_idx
);
956 const SCM CDR_binding
= CDR (binding
);
957 const SCM name
= CAR (binding
);
958 ASSERT_SYNTAX_2 (scm_is_false (scm_c_memq (name
, rnames
)),
959 s_duplicate_binding
, name
, expr
);
960 rnames
= scm_cons (name
, rnames
);
961 rvars
= scm_cons (scm_gensym (SCM_UNDEFINED
), rvars
);
962 rinits
= scm_cons (CAR (CDR_binding
), rinits
);
964 *names
= scm_reverse_x (rnames
, SCM_UNDEFINED
);
965 *vars
= scm_reverse_x (rvars
, SCM_UNDEFINED
);
966 *initptr
= scm_reverse_x (rinits
, SCM_UNDEFINED
);
969 /* FIXME: Remove named let in this boot expander. */
971 expand_named_let (const SCM expr
, SCM env
)
973 SCM var_names
, var_syms
, inits
;
977 const SCM cdr_expr
= CDR (expr
);
978 const SCM name
= CAR (cdr_expr
);
979 const SCM cddr_expr
= CDR (cdr_expr
);
980 const SCM bindings
= CAR (cddr_expr
);
981 check_bindings (bindings
, expr
);
983 transform_bindings (bindings
, expr
, &var_names
, &var_syms
, &inits
);
984 name_sym
= scm_gensym (SCM_UNDEFINED
);
985 inner_env
= scm_acons (name
, name_sym
, env
);
986 inner_env
= expand_env_extend (inner_env
, var_names
, var_syms
);
989 (scm_source_properties (expr
),
990 scm_list_1 (name
), scm_list_1 (name_sym
),
991 scm_list_1 (LAMBDA (SCM_BOOL_F
,
993 LAMBDA_CASE (SCM_BOOL_F
, var_names
, SCM_BOOL_F
, SCM_BOOL_F
,
994 SCM_BOOL_F
, SCM_BOOL_F
, var_syms
,
995 expand_sequence (CDDDR (expr
), inner_env
),
997 APPLICATION (SCM_BOOL_F
,
998 LEXICAL_REF (SCM_BOOL_F
, name
, name_sym
),
999 expand_exprs (inits
, env
)));
1003 expand_let (SCM expr
, SCM env
)
1007 const SCM cdr_expr
= CDR (expr
);
1008 const long length
= scm_ilength (cdr_expr
);
1009 ASSERT_SYNTAX (length
>= 0, s_bad_expression
, expr
);
1010 ASSERT_SYNTAX (length
>= 2, s_missing_expression
, expr
);
1012 bindings
= CAR (cdr_expr
);
1013 if (scm_is_symbol (bindings
))
1015 ASSERT_SYNTAX (length
>= 3, s_missing_expression
, expr
);
1016 return expand_named_let (expr
, env
);
1019 check_bindings (bindings
, expr
);
1020 if (scm_is_null (bindings
))
1021 return expand_sequence (CDDR (expr
), env
);
1024 SCM var_names
, var_syms
, inits
;
1025 transform_bindings (bindings
, expr
, &var_names
, &var_syms
, &inits
);
1026 return LET (SCM_BOOL_F
,
1027 var_names
, var_syms
, expand_exprs (inits
, env
),
1028 expand_sequence (CDDR (expr
),
1029 expand_env_extend (env
, var_names
,
1035 expand_letrec (SCM expr
, SCM env
)
1039 const SCM cdr_expr
= CDR (expr
);
1040 const long length
= scm_ilength (cdr_expr
);
1041 ASSERT_SYNTAX (length
>= 0, s_bad_expression
, expr
);
1042 ASSERT_SYNTAX (length
>= 2, s_missing_expression
, expr
);
1044 bindings
= CAR (cdr_expr
);
1045 check_bindings (bindings
, expr
);
1046 if (scm_is_null (bindings
))
1047 return expand_sequence (CDDR (expr
), env
);
1050 SCM var_names
, var_syms
, inits
;
1051 transform_bindings (bindings
, expr
, &var_names
, &var_syms
, &inits
);
1052 env
= expand_env_extend (env
, var_names
, var_syms
);
1053 return LETREC (SCM_BOOL_F
,
1054 var_names
, var_syms
, expand_exprs (inits
, env
),
1055 expand_sequence (CDDR (expr
), env
));
1060 expand_letstar_clause (SCM bindings
, SCM body
, SCM env SCM_UNUSED
)
1062 if (scm_is_null (bindings
))
1063 return expand_sequence (body
, env
);
1066 SCM bind
, name
, sym
, init
;
1068 ASSERT_SYNTAX (scm_is_pair (bindings
), s_bad_expression
, bindings
);
1069 bind
= CAR (bindings
);
1070 ASSERT_SYNTAX (scm_ilength (bind
) == 2, s_bad_binding
, bind
);
1072 sym
= scm_gensym (SCM_UNDEFINED
);
1075 return LET (SCM_BOOL_F
, scm_list_1 (name
), scm_list_1 (sym
),
1076 scm_list_1 (expand (init
, env
)),
1077 expand_letstar_clause (CDR (bindings
), body
,
1078 scm_acons (name
, sym
, env
)));
1083 expand_letstar (SCM expr
, SCM env SCM_UNUSED
)
1085 const SCM cdr_expr
= CDR (expr
);
1086 ASSERT_SYNTAX (scm_ilength (cdr_expr
) >= 0, s_bad_expression
, expr
);
1087 ASSERT_SYNTAX (scm_ilength (cdr_expr
) >= 2, s_missing_expression
, expr
);
1089 return expand_letstar_clause (CADR (expr
), CDDR (expr
), env
);
1093 expand_or (SCM expr
, SCM env SCM_UNUSED
)
1095 SCM tail
= CDR (expr
);
1096 const long length
= scm_ilength (tail
);
1098 ASSERT_SYNTAX (length
>= 0, s_bad_expression
, expr
);
1100 if (scm_is_null (CDR (expr
)))
1101 return CONST (SCM_BOOL_F
, SCM_BOOL_F
);
1104 SCM tmp
= scm_gensym (SCM_UNDEFINED
);
1105 return LET (SCM_BOOL_F
,
1106 scm_list_1 (tmp
), scm_list_1 (tmp
),
1107 scm_list_1 (expand (CADR (expr
), env
)),
1108 CONDITIONAL (SCM_BOOL_F
,
1109 LEXICAL_REF (SCM_BOOL_F
, tmp
, tmp
),
1110 LEXICAL_REF (SCM_BOOL_F
, tmp
, tmp
),
1111 expand_or (CDR (expr
),
1112 scm_acons (tmp
, tmp
, env
))));
1117 expand_quote (SCM expr
, SCM env SCM_UNUSED
)
1121 const SCM cdr_expr
= CDR (expr
);
1122 ASSERT_SYNTAX (scm_ilength (cdr_expr
) >= 0, s_bad_expression
, expr
);
1123 ASSERT_SYNTAX (scm_ilength (cdr_expr
) == 1, s_expression
, expr
);
1124 quotee
= CAR (cdr_expr
);
1125 return CONST (scm_source_properties (expr
), quotee
);
1129 expand_set_x (SCM expr
, SCM env
)
1134 const SCM cdr_expr
= CDR (expr
);
1135 ASSERT_SYNTAX (scm_ilength (cdr_expr
) >= 0, s_bad_expression
, expr
);
1136 ASSERT_SYNTAX (scm_ilength (cdr_expr
) == 2, s_expression
, expr
);
1137 variable
= CAR (cdr_expr
);
1138 vmem
= expand (variable
, env
);
1140 switch (SCM_EXPANDED_TYPE (vmem
))
1142 case SCM_EXPANDED_LEXICAL_REF
:
1143 return LEXICAL_SET (scm_source_properties (expr
),
1144 SCM_EXPANDED_REF (vmem
, LEXICAL_REF
, NAME
),
1145 SCM_EXPANDED_REF (vmem
, LEXICAL_REF
, GENSYM
),
1146 expand (CADDR (expr
), env
));
1147 case SCM_EXPANDED_TOPLEVEL_REF
:
1148 return TOPLEVEL_SET (scm_source_properties (expr
),
1149 SCM_EXPANDED_REF (vmem
, TOPLEVEL_REF
, NAME
),
1150 expand (CADDR (expr
), env
));
1151 case SCM_EXPANDED_MODULE_REF
:
1152 return MODULE_SET (scm_source_properties (expr
),
1153 SCM_EXPANDED_REF (vmem
, MODULE_REF
, MOD
),
1154 SCM_EXPANDED_REF (vmem
, MODULE_REF
, NAME
),
1155 SCM_EXPANDED_REF (vmem
, MODULE_REF
, PUBLIC
),
1156 expand (CADDR (expr
), env
));
1158 syntax_error (s_bad_variable
, variable
, expr
);
1165 /* This is the boot expander. It is later replaced with psyntax's sc-expand. */
1166 SCM_DEFINE (scm_macroexpand
, "macroexpand", 1, 0, 0,
1168 "Expand the expression @var{exp}.")
1169 #define FUNC_NAME s_scm_macroexpand
1171 return expand (exp
, scm_current_module ());
1175 SCM_DEFINE (scm_macroexpanded_p
, "macroexpanded?", 1, 0, 0,
1177 "Return @code{#t} if @var{exp} is an expanded expression.")
1178 #define FUNC_NAME s_scm_macroexpanded_p
1180 return scm_from_bool (SCM_EXPANDED_P (exp
));
1187 #define DEFINE_NAMES(type) \
1189 static const char *fields[] = SCM_EXPANDED_##type##_FIELD_NAMES; \
1190 exp_field_names[SCM_EXPANDED_##type] = fields; \
1191 exp_names[SCM_EXPANDED_##type] = SCM_EXPANDED_##type##_TYPE_NAME; \
1192 exp_nfields[SCM_EXPANDED_##type] = SCM_NUM_EXPANDED_##type##_FIELDS; \
1196 make_exp_vtable (size_t n
)
1198 SCM layout
, printer
, name
, code
, fields
;
1200 layout
= scm_string_to_symbol
1201 (scm_string_append (scm_make_list (scm_from_size_t (exp_nfields
[n
]),
1202 scm_from_locale_string ("pw"))));
1203 printer
= SCM_BOOL_F
;
1204 name
= scm_from_locale_symbol (exp_names
[n
]);
1205 code
= scm_from_size_t (n
);
1208 size_t m
= exp_nfields
[n
];
1210 fields
= scm_cons (scm_from_locale_symbol (exp_field_names
[n
][m
]), fields
);
1213 return scm_c_make_struct (scm_exp_vtable_vtable
, 0, 5,
1214 SCM_UNPACK (layout
), SCM_UNPACK (printer
), SCM_UNPACK (name
),
1215 SCM_UNPACK (code
), SCM_UNPACK (fields
));
1222 SCM exp_vtable_list
= SCM_EOL
;
1224 DEFINE_NAMES (VOID
);
1225 DEFINE_NAMES (CONST
);
1226 DEFINE_NAMES (PRIMITIVE_REF
);
1227 DEFINE_NAMES (LEXICAL_REF
);
1228 DEFINE_NAMES (LEXICAL_SET
);
1229 DEFINE_NAMES (MODULE_REF
);
1230 DEFINE_NAMES (MODULE_SET
);
1231 DEFINE_NAMES (TOPLEVEL_REF
);
1232 DEFINE_NAMES (TOPLEVEL_SET
);
1233 DEFINE_NAMES (TOPLEVEL_DEFINE
);
1234 DEFINE_NAMES (CONDITIONAL
);
1235 DEFINE_NAMES (APPLICATION
);
1236 DEFINE_NAMES (SEQUENCE
);
1237 DEFINE_NAMES (LAMBDA
);
1238 DEFINE_NAMES (LAMBDA_CASE
);
1240 DEFINE_NAMES (LETREC
);
1241 DEFINE_NAMES (DYNLET
);
1243 scm_exp_vtable_vtable
=
1244 scm_make_vtable (scm_from_locale_string (SCM_VTABLE_BASE_LAYOUT
"pwuwpw"),
1247 for (n
= 0; n
< SCM_NUM_EXPANDED_TYPES
; n
++)
1248 exp_vtables
[n
] = make_exp_vtable (n
);
1250 /* Now walk back down, consing in reverse. */
1252 exp_vtable_list
= scm_cons (exp_vtables
[n
], exp_vtable_list
);
1254 scm_c_define ("%expanded-vtables", scm_vector (exp_vtable_list
));
1256 #include "libguile/expand.x"