1 /* Copyright (C) 1995,1996,1997,1998,1999,2000,2001,2002,2003,2004,2005,2006,2007,2008,2009,2010,2011
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 CALL(src, proc, exps) \
75 SCM_MAKE_EXPANDED_CALL(src, proc, exps)
76 #define SEQ(src, head, tail) \
77 SCM_MAKE_EXPANDED_SEQ(src, head, tail)
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, in_order_p, names, gensyms, vals, body) \
85 SCM_MAKE_EXPANDED_LETREC(src, in_order_p, 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 ("letrec*", expand_letrec_star
);
167 SCM_SYNTAX ("let*", expand_letstar
);
168 SCM_SYNTAX ("or", expand_or
);
169 SCM_SYNTAX ("lambda*", expand_lambda_star
);
170 SCM_SYNTAX ("case-lambda", expand_case_lambda
);
171 SCM_SYNTAX ("case-lambda*", expand_case_lambda_star
);
174 SCM_GLOBAL_SYMBOL (scm_sym_apply
, "apply");
175 SCM_GLOBAL_SYMBOL (scm_sym_arrow
, "=>");
176 SCM_GLOBAL_SYMBOL (scm_sym_at
, "@");
177 SCM_GLOBAL_SYMBOL (scm_sym_atat
, "@@");
178 SCM_GLOBAL_SYMBOL (scm_sym_at_call_with_values
, "@call-with-values");
179 SCM_GLOBAL_SYMBOL (scm_sym_atapply
, "@apply");
180 SCM_GLOBAL_SYMBOL (scm_sym_atcall_cc
, "@call-with-current-continuation");
181 SCM_GLOBAL_SYMBOL (scm_sym_begin
, "begin");
182 SCM_GLOBAL_SYMBOL (scm_sym_case
, "case");
183 SCM_GLOBAL_SYMBOL (scm_sym_cond
, "cond");
184 SCM_GLOBAL_SYMBOL (scm_sym_define
, "define");
185 SCM_GLOBAL_SYMBOL (scm_sym_at_dynamic_wind
, "@dynamic-wind");
186 SCM_GLOBAL_SYMBOL (scm_sym_with_fluids
, "with-fluids");
187 SCM_GLOBAL_SYMBOL (scm_sym_else
, "else");
188 SCM_GLOBAL_SYMBOL (scm_sym_eval_when
, "eval-when");
189 SCM_GLOBAL_SYMBOL (scm_sym_if
, "if");
190 SCM_GLOBAL_SYMBOL (scm_sym_lambda
, "lambda");
191 SCM_GLOBAL_SYMBOL (scm_sym_let
, "let");
192 SCM_GLOBAL_SYMBOL (scm_sym_letrec
, "letrec");
193 SCM_GLOBAL_SYMBOL (scm_sym_letstar
, "let*");
194 SCM_GLOBAL_SYMBOL (scm_sym_or
, "or");
195 SCM_GLOBAL_SYMBOL (scm_sym_at_prompt
, "@prompt");
196 SCM_GLOBAL_SYMBOL (scm_sym_quote
, "quote");
197 SCM_GLOBAL_SYMBOL (scm_sym_set_x
, "set!");
198 SCM_SYMBOL (sym_lambda_star
, "lambda*");
199 SCM_SYMBOL (sym_eval
, "eval");
200 SCM_SYMBOL (sym_load
, "load");
202 SCM_GLOBAL_SYMBOL (scm_sym_unquote
, "unquote");
203 SCM_GLOBAL_SYMBOL (scm_sym_quasiquote
, "quasiquote");
204 SCM_GLOBAL_SYMBOL (scm_sym_uq_splicing
, "unquote-splicing");
206 SCM_KEYWORD (kw_allow_other_keys
, "allow-other-keys");
207 SCM_KEYWORD (kw_optional
, "optional");
208 SCM_KEYWORD (kw_key
, "key");
209 SCM_KEYWORD (kw_rest
, "rest");
215 /* Signal a syntax error. We distinguish between the form that caused the
216 * error and the enclosing expression. The error message will print out as
217 * shown in the following pattern. The file name and line number are only
218 * given when they can be determined from the erroneous form or from the
219 * enclosing expression.
221 * <filename>: In procedure memoization:
222 * <filename>: In file <name>, line <nr>: <error-message> in <expression>. */
225 syntax_error (const char* const msg
, const SCM form
, const SCM expr
)
227 SCM msg_string
= scm_from_locale_string (msg
);
228 SCM filename
= SCM_BOOL_F
;
229 SCM linenr
= SCM_BOOL_F
;
233 if (scm_is_pair (form
))
235 filename
= scm_source_property (form
, scm_sym_filename
);
236 linenr
= scm_source_property (form
, scm_sym_line
);
239 if (scm_is_false (filename
) && scm_is_false (linenr
) && scm_is_pair (expr
))
241 filename
= scm_source_property (expr
, scm_sym_filename
);
242 linenr
= scm_source_property (expr
, scm_sym_line
);
245 if (!SCM_UNBNDP (expr
))
247 if (scm_is_true (filename
))
249 format
= "In file ~S, line ~S: ~A ~S in expression ~S.";
250 args
= scm_list_5 (filename
, linenr
, msg_string
, form
, expr
);
252 else if (scm_is_true (linenr
))
254 format
= "In line ~S: ~A ~S in expression ~S.";
255 args
= scm_list_4 (linenr
, msg_string
, form
, expr
);
259 format
= "~A ~S in expression ~S.";
260 args
= scm_list_3 (msg_string
, form
, expr
);
265 if (scm_is_true (filename
))
267 format
= "In file ~S, line ~S: ~A ~S.";
268 args
= scm_list_4 (filename
, linenr
, msg_string
, form
);
270 else if (scm_is_true (linenr
))
272 format
= "In line ~S: ~A ~S.";
273 args
= scm_list_3 (linenr
, msg_string
, form
);
278 args
= scm_list_2 (msg_string
, form
);
282 scm_error (syntax_error_key
, "memoization", format
, args
, SCM_BOOL_F
);
290 expand_env_var_is_free (SCM env
, SCM x
)
292 for (; scm_is_pair (env
); env
= CDR (env
))
293 if (scm_is_eq (x
, CAAR (env
)))
294 return 0; /* bound */
299 expand_env_ref_macro (SCM env
, SCM x
)
302 if (!expand_env_var_is_free (env
, x
))
303 return SCM_BOOL_F
; /* lexical */
305 var
= scm_module_variable (scm_current_module (), x
);
306 if (scm_is_true (var
) && scm_is_true (scm_variable_bound_p (var
))
307 && scm_is_true (scm_macro_p (scm_variable_ref (var
))))
308 return scm_variable_ref (var
);
310 return SCM_BOOL_F
; /* anything else */
314 expand_env_lexical_gensym (SCM env
, SCM name
)
316 for (; scm_is_pair (env
); env
= CDR (env
))
317 if (scm_is_eq (name
, CAAR (env
)))
318 return CDAR (env
); /* bound */
319 return SCM_BOOL_F
; /* free */
323 expand_env_extend (SCM env
, SCM names
, SCM vars
)
325 while (scm_is_pair (names
))
327 env
= scm_acons (CAR (names
), CAR (vars
), env
);
335 expand (SCM exp
, SCM env
)
337 if (scm_is_pair (exp
))
340 scm_t_macro_primitive trans
= NULL
;
341 SCM macro
= SCM_BOOL_F
;
344 if (scm_is_symbol (car
))
345 macro
= expand_env_ref_macro (env
, car
);
347 if (scm_is_true (macro
))
348 trans
= scm_i_macro_primitive (macro
);
351 return trans (exp
, env
);
354 SCM arg_exps
= SCM_EOL
;
356 SCM proc
= CAR (exp
);
358 for (arg_exps
= CDR (exp
); scm_is_pair (arg_exps
);
359 arg_exps
= CDR (arg_exps
))
360 args
= scm_cons (expand (CAR (arg_exps
), env
), args
);
361 if (scm_is_null (arg_exps
))
362 return CALL (scm_source_properties (exp
),
364 scm_reverse_x (args
, SCM_UNDEFINED
));
366 syntax_error ("expected a proper list", exp
, SCM_UNDEFINED
);
369 else if (scm_is_symbol (exp
))
371 SCM gensym
= expand_env_lexical_gensym (env
, exp
);
372 if (scm_is_true (gensym
))
373 return LEXICAL_REF (SCM_BOOL_F
, exp
, gensym
);
375 return TOPLEVEL_REF (SCM_BOOL_F
, exp
);
378 return CONST (SCM_BOOL_F
, exp
);
382 expand_exprs (SCM forms
, const SCM env
)
386 for (; !scm_is_null (forms
); forms
= CDR (forms
))
387 ret
= scm_cons (expand (CAR (forms
), env
), ret
);
388 return scm_reverse_x (ret
, SCM_UNDEFINED
);
392 expand_sequence (const SCM forms
, const SCM env
)
394 ASSERT_SYNTAX (scm_ilength (forms
) >= 1, s_bad_expression
,
395 scm_cons (scm_sym_begin
, forms
));
396 if (scm_is_null (CDR (forms
)))
397 return expand (CAR (forms
), env
);
399 return SEQ (scm_source_properties (forms
),
400 expand (CAR (forms
), env
),
401 expand_sequence (CDR (forms
), env
));
409 expand_at (SCM expr
, SCM env SCM_UNUSED
)
411 ASSERT_SYNTAX (scm_ilength (expr
) == 3, s_bad_expression
, expr
);
412 ASSERT_SYNTAX (scm_ilength (CADR (expr
)) > 0, s_bad_expression
, expr
);
413 ASSERT_SYNTAX (scm_is_symbol (CADDR (expr
)), s_bad_expression
, expr
);
415 return MODULE_REF (scm_source_properties (expr
),
416 CADR (expr
), CADDR (expr
), SCM_BOOL_T
);
420 expand_atat (SCM expr
, SCM env SCM_UNUSED
)
422 ASSERT_SYNTAX (scm_ilength (expr
) == 3, s_bad_expression
, expr
);
423 ASSERT_SYNTAX (scm_ilength (CADR (expr
)) > 0, s_bad_expression
, expr
);
424 ASSERT_SYNTAX (scm_is_symbol (CADDR (expr
)), s_bad_expression
, expr
);
426 return MODULE_REF (scm_source_properties (expr
),
427 CADR (expr
), CADDR (expr
), SCM_BOOL_F
);
431 expand_and (SCM expr
, SCM env
)
433 const SCM cdr_expr
= CDR (expr
);
435 if (scm_is_null (cdr_expr
))
436 return CONST (SCM_BOOL_F
, SCM_BOOL_T
);
438 ASSERT_SYNTAX (scm_is_pair (cdr_expr
), s_bad_expression
, expr
);
440 if (scm_is_null (CDR (cdr_expr
)))
441 return expand (CAR (cdr_expr
), env
);
443 return CONDITIONAL (scm_source_properties (expr
),
444 expand (CAR (cdr_expr
), env
),
445 expand_and (cdr_expr
, env
),
446 CONST (SCM_BOOL_F
, SCM_BOOL_F
));
450 expand_begin (SCM expr
, SCM env
)
452 const SCM cdr_expr
= CDR (expr
);
453 ASSERT_SYNTAX (scm_ilength (cdr_expr
) >= 1, s_bad_expression
, expr
);
454 return expand_sequence (cdr_expr
, env
);
458 expand_cond_clauses (SCM clause
, SCM rest
, int elp
, int alp
, SCM env
)
461 const long length
= scm_ilength (clause
);
462 ASSERT_SYNTAX (length
>= 1, s_bad_cond_clause
, clause
);
465 if (scm_is_eq (test
, scm_sym_else
) && elp
)
467 const int last_clause_p
= scm_is_null (rest
);
468 ASSERT_SYNTAX (length
>= 2, s_bad_cond_clause
, clause
);
469 ASSERT_SYNTAX (last_clause_p
, s_misplaced_else_clause
, clause
);
470 return expand_sequence (CDR (clause
), env
);
473 if (scm_is_null (rest
))
474 rest
= VOID (SCM_BOOL_F
);
476 rest
= expand_cond_clauses (CAR (rest
), CDR (rest
), elp
, alp
, env
);
479 && scm_is_eq (CADR (clause
), scm_sym_arrow
)
482 SCM tmp
= scm_gensym (scm_from_locale_string ("cond "));
483 SCM new_env
= scm_acons (tmp
, tmp
, env
);
484 ASSERT_SYNTAX (length
> 2, s_missing_recipient
, clause
);
485 ASSERT_SYNTAX (length
== 3, s_extra_expression
, clause
);
486 return LET (SCM_BOOL_F
,
489 scm_list_1 (expand (test
, env
)),
490 CONDITIONAL (SCM_BOOL_F
,
491 LEXICAL_REF (SCM_BOOL_F
, tmp
, tmp
),
493 expand (CADDR (clause
), new_env
),
494 scm_list_1 (LEXICAL_REF (SCM_BOOL_F
,
498 /* FIXME length == 1 case */
500 return CONDITIONAL (SCM_BOOL_F
,
502 expand_sequence (CDR (clause
), env
),
507 expand_cond (SCM expr
, SCM env
)
509 const int else_literal_p
= expand_env_var_is_free (env
, scm_sym_else
);
510 const int arrow_literal_p
= expand_env_var_is_free (env
, scm_sym_arrow
);
511 const SCM clauses
= CDR (expr
);
513 ASSERT_SYNTAX (scm_ilength (clauses
) >= 0, s_bad_expression
, expr
);
514 ASSERT_SYNTAX (scm_ilength (clauses
) >= 1, s_missing_clauses
, expr
);
516 return expand_cond_clauses (CAR (clauses
), CDR (clauses
),
517 else_literal_p
, arrow_literal_p
, env
);
520 /* lone forward decl */
521 static SCM
expand_lambda (SCM expr
, SCM env
);
523 /* According to Section 5.2.1 of R5RS we first have to make sure that the
524 variable is bound, and then perform the `(set! variable expression)'
525 operation. However, EXPRESSION _can_ be evaluated before VARIABLE is
526 bound. This means that EXPRESSION won't necessarily be able to assign
527 values to VARIABLE as in `(define foo (begin (set! foo 1) (+ foo 1)))'. */
529 expand_define (SCM expr
, SCM env
)
531 const SCM cdr_expr
= CDR (expr
);
535 ASSERT_SYNTAX (scm_ilength (cdr_expr
) >= 0, s_bad_expression
, expr
);
536 ASSERT_SYNTAX (scm_ilength (cdr_expr
) >= 2, s_missing_expression
, expr
);
537 ASSERT_SYNTAX (!scm_is_pair (env
), s_bad_define
, expr
);
539 body
= CDR (cdr_expr
);
540 variable
= CAR (cdr_expr
);
542 if (scm_is_pair (variable
))
544 ASSERT_SYNTAX_2 (scm_is_symbol (CAR (variable
)), s_bad_variable
, variable
, expr
);
545 return TOPLEVEL_DEFINE
546 (scm_source_properties (expr
),
548 expand_lambda (scm_cons (scm_sym_lambda
, scm_cons (CDR (variable
), body
)),
551 ASSERT_SYNTAX_2 (scm_is_symbol (variable
), s_bad_variable
, variable
, expr
);
552 ASSERT_SYNTAX (scm_ilength (body
) == 1, s_expression
, expr
);
553 return TOPLEVEL_DEFINE (scm_source_properties (expr
), variable
,
554 expand (CAR (body
), env
));
558 expand_with_fluids (SCM expr
, SCM env
)
560 SCM binds
, fluids
, vals
;
561 ASSERT_SYNTAX (scm_ilength (expr
) >= 3, s_bad_expression
, expr
);
563 ASSERT_SYNTAX_2 (scm_ilength (binds
) >= 0, s_bad_bindings
, binds
, expr
);
564 for (fluids
= SCM_EOL
, vals
= SCM_EOL
;
568 SCM binding
= CAR (binds
);
569 ASSERT_SYNTAX_2 (scm_ilength (CAR (binds
)) == 2, s_bad_binding
,
571 fluids
= scm_cons (expand (CAR (binding
), env
), fluids
);
572 vals
= scm_cons (expand (CADR (binding
), env
), vals
);
575 return DYNLET (scm_source_properties (expr
),
576 scm_reverse_x (fluids
, SCM_UNDEFINED
),
577 scm_reverse_x (vals
, SCM_UNDEFINED
),
578 expand_sequence (CDDR (expr
), env
));
582 expand_eval_when (SCM expr
, SCM env
)
584 ASSERT_SYNTAX (scm_ilength (expr
) >= 3, s_bad_expression
, expr
);
585 ASSERT_SYNTAX (scm_ilength (CADR (expr
)) > 0, s_bad_expression
, expr
);
587 if (scm_is_true (scm_memq (sym_eval
, CADR (expr
)))
588 || scm_is_true (scm_memq (sym_load
, CADR (expr
))))
589 return expand_sequence (CDDR (expr
), env
);
591 return VOID (scm_source_properties (expr
));
595 expand_if (SCM expr
, SCM env SCM_UNUSED
)
597 const SCM cdr_expr
= CDR (expr
);
598 const long length
= scm_ilength (cdr_expr
);
599 ASSERT_SYNTAX (length
== 2 || length
== 3, s_expression
, expr
);
600 return CONDITIONAL (scm_source_properties (expr
),
601 expand (CADR (expr
), env
),
602 expand (CADDR (expr
), env
),
604 ? expand (CADDDR (expr
), env
)
605 : VOID (SCM_BOOL_F
)));
608 /* A helper function for expand_lambda to support checking for duplicate
609 * formal arguments: Return true if OBJ is `eq?' to one of the elements of
610 * LIST or to the CDR of the last cons. Therefore, LIST may have any of the
611 * forms that a formal argument can have:
612 * <rest>, (<arg1> ...), (<arg1> ... . <rest>) */
614 c_improper_memq (SCM obj
, SCM list
)
616 for (; scm_is_pair (list
); list
= CDR (list
))
618 if (scm_is_eq (CAR (list
), obj
))
621 return scm_is_eq (list
, obj
);
625 expand_lambda_case (SCM clause
, SCM alternate
, SCM env
)
634 ASSERT_SYNTAX (scm_is_pair (clause
) && scm_is_pair (CDR (clause
)),
635 s_bad_expression
, scm_cons (scm_sym_lambda
, clause
));
637 /* Before iterating the list of formal arguments, make sure the formals
638 * actually are given as either a symbol or a non-cyclic list. */
639 formals
= CAR (clause
);
640 if (scm_is_pair (formals
))
642 /* Dirk:FIXME:: We should check for a cyclic list of formals, and if
643 * detected, report a 'Bad formals' error. */
646 ASSERT_SYNTAX_2 (scm_is_symbol (formals
) || scm_is_null (formals
),
647 s_bad_formals
, formals
, scm_cons (scm_sym_lambda
, clause
));
649 /* Now iterate the list of formal arguments to check if all formals are
650 * symbols, and that there are no duplicates. */
651 while (scm_is_pair (formals
))
653 const SCM formal
= CAR (formals
);
654 formals
= CDR (formals
);
655 ASSERT_SYNTAX_2 (scm_is_symbol (formal
), s_bad_formal
, formal
,
656 scm_cons (scm_sym_lambda
, clause
));
657 ASSERT_SYNTAX_2 (!c_improper_memq (formal
, formals
), s_duplicate_formal
,
658 formal
, scm_cons (scm_sym_lambda
, clause
));
660 req
= scm_cons (formal
, req
);
661 vars
= scm_cons (scm_gensym (SCM_UNDEFINED
), vars
);
662 env
= scm_acons (formal
, CAR (vars
), env
);
665 ASSERT_SYNTAX_2 (scm_is_null (formals
) || scm_is_symbol (formals
),
666 s_bad_formal
, formals
, scm_cons (scm_sym_lambda
, clause
));
667 if (scm_is_symbol (formals
))
670 vars
= scm_cons (scm_gensym (SCM_UNDEFINED
), vars
);
671 env
= scm_acons (rest
, CAR (vars
), env
);
676 body
= expand_sequence (CDR (clause
), env
);
677 req
= scm_reverse_x (req
, SCM_UNDEFINED
);
678 vars
= scm_reverse_x (vars
, SCM_UNDEFINED
);
680 if (scm_is_true (alternate
) && !(SCM_EXPANDED_P (alternate
) && SCM_EXPANDED_TYPE (alternate
) == SCM_EXPANDED_LAMBDA_CASE
))
683 return LAMBDA_CASE (SCM_BOOL_F
, req
, SCM_BOOL_F
, rest
, SCM_BOOL_F
,
684 SCM_EOL
, vars
, body
, alternate
);
688 expand_lambda (SCM expr
, SCM env
)
690 return LAMBDA (scm_source_properties (expr
),
692 expand_lambda_case (CDR (expr
), SCM_BOOL_F
, env
));
696 expand_lambda_star_case (SCM clause
, SCM alternate
, SCM env
)
698 SCM req
, opt
, kw
, allow_other_keys
, rest
, formals
, vars
, body
, tmp
;
702 const long length
= scm_ilength (clause
);
703 ASSERT_SYNTAX (length
>= 1, s_bad_expression
,
704 scm_cons (sym_lambda_star
, clause
));
705 ASSERT_SYNTAX (length
>= 2, s_missing_expression
,
706 scm_cons (sym_lambda_star
, clause
));
708 formals
= CAR (clause
);
712 req
= opt
= kw
= SCM_EOL
;
713 rest
= allow_other_keys
= SCM_BOOL_F
;
715 while (scm_is_pair (formals
) && scm_is_symbol (CAR (formals
)))
718 req
= scm_cons (CAR (formals
), req
);
719 formals
= scm_cdr (formals
);
722 if (scm_is_pair (formals
) && scm_is_eq (CAR (formals
), kw_optional
))
724 formals
= CDR (formals
);
725 while (scm_is_pair (formals
)
726 && (scm_is_symbol (CAR (formals
)) || scm_is_pair (CAR (formals
))))
729 opt
= scm_cons (CAR (formals
), opt
);
730 formals
= scm_cdr (formals
);
734 if (scm_is_pair (formals
) && scm_is_eq (CAR (formals
), kw_key
))
736 formals
= CDR (formals
);
737 while (scm_is_pair (formals
)
738 && (scm_is_symbol (CAR (formals
)) || scm_is_pair (CAR (formals
))))
740 kw
= scm_cons (CAR (formals
), kw
);
741 formals
= scm_cdr (formals
);
745 if (scm_is_pair (formals
) && scm_is_eq (CAR (formals
), kw_allow_other_keys
))
747 formals
= CDR (formals
);
748 allow_other_keys
= SCM_BOOL_T
;
751 if (scm_is_pair (formals
) && scm_is_eq (CAR (formals
), kw_rest
))
753 ASSERT_SYNTAX (scm_ilength (formals
) == 2, s_bad_formals
,
755 rest
= CADR (formals
);
757 else if (scm_is_symbol (formals
))
761 ASSERT_SYNTAX (scm_is_null (formals
), s_bad_formals
, CAR (clause
));
765 /* Now, iterate through them a second time, building up an expansion-time
766 environment, checking, expanding and canonicalizing the opt/kw init forms,
767 and eventually memoizing the body as well. Note that the rest argument, if
768 any, is expanded before keyword args, thus necessitating the second
771 Also note that the specific environment during expansion of init
772 expressions here needs to coincide with the environment when psyntax
773 expands. A lot of effort for something that is only used in the bootstrap
774 expandr, you say? Yes. Yes it is.
778 req
= scm_reverse_x (req
, SCM_EOL
);
779 for (tmp
= req
; scm_is_pair (tmp
); tmp
= scm_cdr (tmp
))
781 vars
= scm_cons (scm_gensym (SCM_UNDEFINED
), vars
);
782 env
= scm_acons (CAR (tmp
), CAR (vars
), env
);
785 /* Build up opt inits and env */
787 opt
= scm_reverse_x (opt
, SCM_EOL
);
788 for (tmp
= opt
; scm_is_pair (tmp
); tmp
= scm_cdr (tmp
))
791 vars
= scm_cons (scm_gensym (SCM_UNDEFINED
), vars
);
792 env
= scm_acons (x
, CAR (vars
), env
);
793 if (scm_is_symbol (x
))
794 inits
= scm_cons (CONST (SCM_BOOL_F
, SCM_BOOL_F
), inits
);
797 ASSERT_SYNTAX (scm_ilength (x
) == 2 && scm_is_symbol (CAR (x
)),
798 s_bad_formals
, CAR (clause
));
799 inits
= scm_cons (expand (CADR (x
), env
), inits
);
801 env
= scm_acons (scm_is_symbol (x
) ? x
: CAR (x
), CAR (vars
), env
);
803 if (scm_is_null (opt
))
806 /* Process rest before keyword args */
807 if (scm_is_true (rest
))
809 vars
= scm_cons (scm_gensym (SCM_UNDEFINED
), vars
);
810 env
= scm_acons (rest
, CAR (vars
), env
);
813 /* Build up kw inits, env, and kw-canon list */
814 if (scm_is_null (kw
))
818 SCM kw_canon
= SCM_EOL
;
819 kw
= scm_reverse_x (kw
, SCM_UNDEFINED
);
820 for (tmp
= kw
; scm_is_pair (tmp
); tmp
= scm_cdr (tmp
))
824 if (scm_is_symbol (x
))
828 k
= scm_symbol_to_keyword (sym
);
830 else if (scm_ilength (x
) == 2 && scm_is_symbol (CAR (x
)))
834 k
= scm_symbol_to_keyword (sym
);
836 else if (scm_ilength (x
) == 3 && scm_is_symbol (CAR (x
))
837 && scm_is_keyword (CADDR (x
)))
844 syntax_error (s_bad_formals
, CAR (clause
), SCM_UNDEFINED
);
846 inits
= scm_cons (expand (init
, env
), inits
);
847 vars
= scm_cons (scm_gensym (SCM_UNDEFINED
), vars
);
848 kw_canon
= scm_cons (scm_list_3 (k
, sym
, CAR (vars
)), kw_canon
);
849 env
= scm_acons (sym
, CAR (vars
), env
);
851 kw_canon
= scm_reverse_x (kw_canon
, SCM_UNDEFINED
);
852 kw
= scm_cons (allow_other_keys
, kw_canon
);
855 /* We should check for no duplicates, but given that psyntax does this
856 already, we can punt on it here... */
858 vars
= scm_reverse_x (vars
, SCM_UNDEFINED
);
859 inits
= scm_reverse_x (inits
, SCM_UNDEFINED
);
860 body
= expand_sequence (body
, env
);
862 return LAMBDA_CASE (SCM_BOOL_F
, req
, opt
, rest
, kw
, inits
, vars
, body
,
867 expand_lambda_star (SCM expr
, SCM env
)
869 return LAMBDA (scm_source_properties (expr
),
871 expand_lambda_star_case (CDR (expr
), SCM_BOOL_F
, env
));
875 expand_case_lambda_clauses (SCM expr
, SCM rest
, SCM env
)
879 if (scm_is_pair (rest
))
880 alt
= expand_case_lambda_clauses (CAR (rest
), CDR (rest
), env
);
884 return expand_lambda_case (expr
, alt
, env
);
888 expand_case_lambda (SCM expr
, SCM env
)
890 ASSERT_SYNTAX (scm_is_pair (CDR (expr
)), s_missing_expression
, expr
);
892 return LAMBDA (scm_source_properties (expr
),
894 expand_case_lambda_clauses (CADR (expr
), CDDR (expr
), env
));
898 expand_case_lambda_star_clauses (SCM expr
, SCM rest
, SCM env
)
902 if (scm_is_pair (rest
))
903 alt
= expand_case_lambda_star_clauses (CAR (rest
), CDR (rest
), env
);
907 return expand_lambda_star_case (expr
, alt
, env
);
911 expand_case_lambda_star (SCM expr
, SCM env
)
913 ASSERT_SYNTAX (scm_is_pair (CDR (expr
)), s_missing_expression
, expr
);
915 return LAMBDA (scm_source_properties (expr
),
917 expand_case_lambda_star_clauses (CADR (expr
), CDDR (expr
), env
));
920 /* Check if the format of the bindings is ((<symbol> <init-form>) ...). */
922 check_bindings (const SCM bindings
, const SCM expr
)
926 ASSERT_SYNTAX_2 (scm_ilength (bindings
) >= 0,
927 s_bad_bindings
, bindings
, expr
);
929 binding_idx
= bindings
;
930 for (; !scm_is_null (binding_idx
); binding_idx
= CDR (binding_idx
))
932 SCM name
; /* const */
934 const SCM binding
= CAR (binding_idx
);
935 ASSERT_SYNTAX_2 (scm_ilength (binding
) == 2,
936 s_bad_binding
, binding
, expr
);
938 name
= CAR (binding
);
939 ASSERT_SYNTAX_2 (scm_is_symbol (name
), s_bad_variable
, name
, expr
);
943 /* The bindings, which must have the format ((v1 i1) (v2 i2) ... (vn in)), are
944 * transformed to the lists (vn .. v2 v1) and (i1 i2 ... in). If a duplicate
945 * variable name is detected, an error is signalled. */
947 transform_bindings (const SCM bindings
, const SCM expr
,
948 SCM
*const names
, SCM
*const vars
, SCM
*const initptr
)
950 SCM rnames
= SCM_EOL
;
952 SCM rinits
= SCM_EOL
;
953 SCM binding_idx
= bindings
;
954 for (; !scm_is_null (binding_idx
); binding_idx
= CDR (binding_idx
))
956 const SCM binding
= CAR (binding_idx
);
957 const SCM CDR_binding
= CDR (binding
);
958 const SCM name
= CAR (binding
);
959 ASSERT_SYNTAX_2 (scm_is_false (scm_c_memq (name
, rnames
)),
960 s_duplicate_binding
, name
, expr
);
961 rnames
= scm_cons (name
, rnames
);
962 rvars
= scm_cons (scm_gensym (SCM_UNDEFINED
), rvars
);
963 rinits
= scm_cons (CAR (CDR_binding
), rinits
);
965 *names
= scm_reverse_x (rnames
, SCM_UNDEFINED
);
966 *vars
= scm_reverse_x (rvars
, SCM_UNDEFINED
);
967 *initptr
= scm_reverse_x (rinits
, SCM_UNDEFINED
);
970 /* FIXME: Remove named let in this boot expander. */
972 expand_named_let (const SCM expr
, SCM env
)
974 SCM var_names
, var_syms
, inits
;
978 const SCM cdr_expr
= CDR (expr
);
979 const SCM name
= CAR (cdr_expr
);
980 const SCM cddr_expr
= CDR (cdr_expr
);
981 const SCM bindings
= CAR (cddr_expr
);
982 check_bindings (bindings
, expr
);
984 transform_bindings (bindings
, expr
, &var_names
, &var_syms
, &inits
);
985 name_sym
= scm_gensym (SCM_UNDEFINED
);
986 inner_env
= scm_acons (name
, name_sym
, env
);
987 inner_env
= expand_env_extend (inner_env
, var_names
, var_syms
);
990 (scm_source_properties (expr
), SCM_BOOL_F
,
991 scm_list_1 (name
), scm_list_1 (name_sym
),
992 scm_list_1 (LAMBDA (SCM_BOOL_F
,
994 LAMBDA_CASE (SCM_BOOL_F
, var_names
, SCM_BOOL_F
, SCM_BOOL_F
,
995 SCM_BOOL_F
, SCM_BOOL_F
, var_syms
,
996 expand_sequence (CDDDR (expr
), inner_env
),
999 LEXICAL_REF (SCM_BOOL_F
, name
, name_sym
),
1000 expand_exprs (inits
, env
)));
1004 expand_let (SCM expr
, SCM env
)
1008 const SCM cdr_expr
= CDR (expr
);
1009 const long length
= scm_ilength (cdr_expr
);
1010 ASSERT_SYNTAX (length
>= 0, s_bad_expression
, expr
);
1011 ASSERT_SYNTAX (length
>= 2, s_missing_expression
, expr
);
1013 bindings
= CAR (cdr_expr
);
1014 if (scm_is_symbol (bindings
))
1016 ASSERT_SYNTAX (length
>= 3, s_missing_expression
, expr
);
1017 return expand_named_let (expr
, env
);
1020 check_bindings (bindings
, expr
);
1021 if (scm_is_null (bindings
))
1022 return expand_sequence (CDDR (expr
), env
);
1025 SCM var_names
, var_syms
, inits
;
1026 transform_bindings (bindings
, expr
, &var_names
, &var_syms
, &inits
);
1027 return LET (SCM_BOOL_F
,
1028 var_names
, var_syms
, expand_exprs (inits
, env
),
1029 expand_sequence (CDDR (expr
),
1030 expand_env_extend (env
, var_names
,
1036 expand_letrec_helper (SCM expr
, SCM env
, SCM in_order_p
)
1040 const SCM cdr_expr
= CDR (expr
);
1041 const long length
= scm_ilength (cdr_expr
);
1042 ASSERT_SYNTAX (length
>= 0, s_bad_expression
, expr
);
1043 ASSERT_SYNTAX (length
>= 2, s_missing_expression
, expr
);
1045 bindings
= CAR (cdr_expr
);
1046 check_bindings (bindings
, expr
);
1047 if (scm_is_null (bindings
))
1048 return expand_sequence (CDDR (expr
), env
);
1051 SCM var_names
, var_syms
, inits
;
1052 transform_bindings (bindings
, expr
, &var_names
, &var_syms
, &inits
);
1053 env
= expand_env_extend (env
, var_names
, var_syms
);
1054 return LETREC (SCM_BOOL_F
, in_order_p
,
1055 var_names
, var_syms
, expand_exprs (inits
, env
),
1056 expand_sequence (CDDR (expr
), env
));
1061 expand_letrec (SCM expr
, SCM env
)
1063 return expand_letrec_helper (expr
, env
, SCM_BOOL_F
);
1067 expand_letrec_star (SCM expr
, SCM env
)
1069 return expand_letrec_helper (expr
, env
, SCM_BOOL_T
);
1073 expand_letstar_clause (SCM bindings
, SCM body
, SCM env SCM_UNUSED
)
1075 if (scm_is_null (bindings
))
1076 return expand_sequence (body
, env
);
1079 SCM bind
, name
, sym
, init
;
1081 ASSERT_SYNTAX (scm_is_pair (bindings
), s_bad_expression
, bindings
);
1082 bind
= CAR (bindings
);
1083 ASSERT_SYNTAX (scm_ilength (bind
) == 2, s_bad_binding
, bind
);
1085 sym
= scm_gensym (SCM_UNDEFINED
);
1088 return LET (SCM_BOOL_F
, scm_list_1 (name
), scm_list_1 (sym
),
1089 scm_list_1 (expand (init
, env
)),
1090 expand_letstar_clause (CDR (bindings
), body
,
1091 scm_acons (name
, sym
, env
)));
1096 expand_letstar (SCM expr
, SCM env SCM_UNUSED
)
1098 const SCM cdr_expr
= CDR (expr
);
1099 ASSERT_SYNTAX (scm_ilength (cdr_expr
) >= 0, s_bad_expression
, expr
);
1100 ASSERT_SYNTAX (scm_ilength (cdr_expr
) >= 2, s_missing_expression
, expr
);
1102 return expand_letstar_clause (CADR (expr
), CDDR (expr
), env
);
1106 expand_or (SCM expr
, SCM env SCM_UNUSED
)
1108 SCM tail
= CDR (expr
);
1109 const long length
= scm_ilength (tail
);
1111 ASSERT_SYNTAX (length
>= 0, s_bad_expression
, expr
);
1113 if (scm_is_null (CDR (expr
)))
1114 return CONST (SCM_BOOL_F
, SCM_BOOL_F
);
1117 SCM tmp
= scm_gensym (SCM_UNDEFINED
);
1118 return LET (SCM_BOOL_F
,
1119 scm_list_1 (tmp
), scm_list_1 (tmp
),
1120 scm_list_1 (expand (CADR (expr
), env
)),
1121 CONDITIONAL (SCM_BOOL_F
,
1122 LEXICAL_REF (SCM_BOOL_F
, tmp
, tmp
),
1123 LEXICAL_REF (SCM_BOOL_F
, tmp
, tmp
),
1124 expand_or (CDR (expr
),
1125 scm_acons (tmp
, tmp
, env
))));
1130 expand_quote (SCM expr
, SCM env SCM_UNUSED
)
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
) == 1, s_expression
, expr
);
1137 quotee
= CAR (cdr_expr
);
1138 return CONST (scm_source_properties (expr
), quotee
);
1142 expand_set_x (SCM expr
, SCM env
)
1147 const SCM cdr_expr
= CDR (expr
);
1148 ASSERT_SYNTAX (scm_ilength (cdr_expr
) >= 0, s_bad_expression
, expr
);
1149 ASSERT_SYNTAX (scm_ilength (cdr_expr
) == 2, s_expression
, expr
);
1150 variable
= CAR (cdr_expr
);
1151 vmem
= expand (variable
, env
);
1153 switch (SCM_EXPANDED_TYPE (vmem
))
1155 case SCM_EXPANDED_LEXICAL_REF
:
1156 return LEXICAL_SET (scm_source_properties (expr
),
1157 SCM_EXPANDED_REF (vmem
, LEXICAL_REF
, NAME
),
1158 SCM_EXPANDED_REF (vmem
, LEXICAL_REF
, GENSYM
),
1159 expand (CADDR (expr
), env
));
1160 case SCM_EXPANDED_TOPLEVEL_REF
:
1161 return TOPLEVEL_SET (scm_source_properties (expr
),
1162 SCM_EXPANDED_REF (vmem
, TOPLEVEL_REF
, NAME
),
1163 expand (CADDR (expr
), env
));
1164 case SCM_EXPANDED_MODULE_REF
:
1165 return MODULE_SET (scm_source_properties (expr
),
1166 SCM_EXPANDED_REF (vmem
, MODULE_REF
, MOD
),
1167 SCM_EXPANDED_REF (vmem
, MODULE_REF
, NAME
),
1168 SCM_EXPANDED_REF (vmem
, MODULE_REF
, PUBLIC
),
1169 expand (CADDR (expr
), env
));
1171 syntax_error (s_bad_variable
, variable
, expr
);
1178 /* This is the boot expander. It is later replaced with psyntax's sc-expand. */
1179 SCM_DEFINE (scm_macroexpand
, "macroexpand", 1, 0, 0,
1181 "Expand the expression @var{exp}.")
1182 #define FUNC_NAME s_scm_macroexpand
1184 return expand (exp
, scm_current_module ());
1188 SCM_DEFINE (scm_macroexpanded_p
, "macroexpanded?", 1, 0, 0,
1190 "Return @code{#t} if @var{exp} is an expanded expression.")
1191 #define FUNC_NAME s_scm_macroexpanded_p
1193 return scm_from_bool (SCM_EXPANDED_P (exp
));
1200 #define DEFINE_NAMES(type) \
1202 static const char *fields[] = SCM_EXPANDED_##type##_FIELD_NAMES; \
1203 exp_field_names[SCM_EXPANDED_##type] = fields; \
1204 exp_names[SCM_EXPANDED_##type] = SCM_EXPANDED_##type##_TYPE_NAME; \
1205 exp_nfields[SCM_EXPANDED_##type] = SCM_NUM_EXPANDED_##type##_FIELDS; \
1209 make_exp_vtable (size_t n
)
1211 SCM layout
, printer
, name
, code
, fields
;
1213 layout
= scm_string_to_symbol
1214 (scm_string_append (scm_make_list (scm_from_size_t (exp_nfields
[n
]),
1215 scm_from_locale_string ("pw"))));
1216 printer
= SCM_BOOL_F
;
1217 name
= scm_from_utf8_symbol (exp_names
[n
]);
1218 code
= scm_from_size_t (n
);
1221 size_t m
= exp_nfields
[n
];
1223 fields
= scm_cons (scm_from_utf8_symbol (exp_field_names
[n
][m
]), fields
);
1226 return scm_c_make_struct (scm_exp_vtable_vtable
, 0, 5,
1227 SCM_UNPACK (layout
), SCM_UNPACK (printer
), SCM_UNPACK (name
),
1228 SCM_UNPACK (code
), SCM_UNPACK (fields
));
1235 SCM exp_vtable_list
= SCM_EOL
;
1237 DEFINE_NAMES (VOID
);
1238 DEFINE_NAMES (CONST
);
1239 DEFINE_NAMES (PRIMITIVE_REF
);
1240 DEFINE_NAMES (LEXICAL_REF
);
1241 DEFINE_NAMES (LEXICAL_SET
);
1242 DEFINE_NAMES (MODULE_REF
);
1243 DEFINE_NAMES (MODULE_SET
);
1244 DEFINE_NAMES (TOPLEVEL_REF
);
1245 DEFINE_NAMES (TOPLEVEL_SET
);
1246 DEFINE_NAMES (TOPLEVEL_DEFINE
);
1247 DEFINE_NAMES (CONDITIONAL
);
1248 DEFINE_NAMES (CALL
);
1249 DEFINE_NAMES (PRIMCALL
);
1251 DEFINE_NAMES (LAMBDA
);
1252 DEFINE_NAMES (LAMBDA_CASE
);
1254 DEFINE_NAMES (LETREC
);
1255 DEFINE_NAMES (DYNLET
);
1257 scm_exp_vtable_vtable
=
1258 scm_make_vtable (scm_from_locale_string (SCM_VTABLE_BASE_LAYOUT
"pwuwpw"),
1261 for (n
= 0; n
< SCM_NUM_EXPANDED_TYPES
; n
++)
1262 exp_vtables
[n
] = make_exp_vtable (n
);
1264 /* Now walk back down, consing in reverse. */
1266 exp_vtable_list
= scm_cons (exp_vtables
[n
], exp_vtable_list
);
1268 scm_c_define ("%expanded-vtables", scm_vector (exp_vtable_list
));
1270 #include "libguile/expand.x"