1 /* Copyright (C) 1995,1996,1997,1998,1999,2000,2001,2002,2003,2004,2005,2006,2007,2008,2009,2010,2011,2012
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
];
52 /* The trailing underscores on these first to are to avoid spurious
53 conflicts with macros defined on MinGW. */
56 SCM_MAKE_EXPANDED_VOID(src)
57 #define CONST_(src, exp) \
58 SCM_MAKE_EXPANDED_CONST(src, exp)
59 #define PRIMITIVE_REF_TYPE(src, name) \
60 SCM_MAKE_EXPANDED_PRIMITIVE_REF_TYPE(src, name)
61 #define LEXICAL_REF(src, name, gensym) \
62 SCM_MAKE_EXPANDED_LEXICAL_REF(src, name, gensym)
63 #define LEXICAL_SET(src, name, gensym, exp) \
64 SCM_MAKE_EXPANDED_LEXICAL_SET(src, name, gensym, exp)
65 #define MODULE_REF(src, mod, name, public) \
66 SCM_MAKE_EXPANDED_MODULE_REF(src, mod, name, public)
67 #define MODULE_SET(src, mod, name, public, exp) \
68 SCM_MAKE_EXPANDED_MODULE_SET(src, mod, name, public, exp)
69 #define TOPLEVEL_REF(src, name) \
70 SCM_MAKE_EXPANDED_TOPLEVEL_REF(src, name)
71 #define TOPLEVEL_SET(src, name, exp) \
72 SCM_MAKE_EXPANDED_TOPLEVEL_SET(src, name, exp)
73 #define TOPLEVEL_DEFINE(src, name, exp) \
74 SCM_MAKE_EXPANDED_TOPLEVEL_DEFINE(src, name, exp)
75 #define CONDITIONAL(src, test, consequent, alternate) \
76 SCM_MAKE_EXPANDED_CONDITIONAL(src, test, consequent, alternate)
77 #define CALL(src, proc, exps) \
78 SCM_MAKE_EXPANDED_CALL(src, proc, exps)
79 #define SEQ(src, head, tail) \
80 SCM_MAKE_EXPANDED_SEQ(src, head, tail)
81 #define LAMBDA(src, meta, body) \
82 SCM_MAKE_EXPANDED_LAMBDA(src, meta, body)
83 #define LAMBDA_CASE(src, req, opt, rest, kw, inits, gensyms, body, alternate) \
84 SCM_MAKE_EXPANDED_LAMBDA_CASE(src, req, opt, rest, kw, inits, gensyms, body, alternate)
85 #define LET(src, names, gensyms, vals, body) \
86 SCM_MAKE_EXPANDED_LET(src, names, gensyms, vals, body)
87 #define LETREC(src, in_order_p, names, gensyms, vals, body) \
88 SCM_MAKE_EXPANDED_LETREC(src, in_order_p, names, gensyms, vals, body)
89 #define DYNLET(src, fluids, vals, body) \
90 SCM_MAKE_EXPANDED_DYNLET(src, fluids, vals, body)
92 #define CAR(x) SCM_CAR(x)
93 #define CDR(x) SCM_CDR(x)
94 #define CAAR(x) SCM_CAAR(x)
95 #define CADR(x) SCM_CADR(x)
96 #define CDAR(x) SCM_CDAR(x)
97 #define CDDR(x) SCM_CDDR(x)
98 #define CADDR(x) SCM_CADDR(x)
99 #define CDDDR(x) SCM_CDDDR(x)
100 #define CADDDR(x) SCM_CADDDR(x)
103 static const char s_bad_expression
[] = "Bad expression";
104 static const char s_expression
[] = "Missing or extra expression in";
105 static const char s_missing_expression
[] = "Missing expression in";
106 static const char s_extra_expression
[] = "Extra expression in";
107 static const char s_empty_combination
[] = "Illegal empty combination";
108 static const char s_missing_body_expression
[] = "Missing body expression in";
109 static const char s_mixed_body_forms
[] = "Mixed definitions and expressions in";
110 static const char s_bad_define
[] = "Bad define placement";
111 static const char s_missing_clauses
[] = "Missing clauses";
112 static const char s_misplaced_else_clause
[] = "Misplaced else clause";
113 static const char s_bad_case_clause
[] = "Bad case clause";
114 static const char s_bad_case_labels
[] = "Bad case labels";
115 static const char s_duplicate_case_label
[] = "Duplicate case label";
116 static const char s_bad_cond_clause
[] = "Bad cond clause";
117 static const char s_missing_recipient
[] = "Missing recipient in";
118 static const char s_bad_variable
[] = "Bad variable";
119 static const char s_bad_bindings
[] = "Bad bindings";
120 static const char s_bad_binding
[] = "Bad binding";
121 static const char s_duplicate_binding
[] = "Duplicate binding";
122 static const char s_bad_exit_clause
[] = "Bad exit clause";
123 static const char s_bad_formals
[] = "Bad formals";
124 static const char s_bad_formal
[] = "Bad formal";
125 static const char s_duplicate_formal
[] = "Duplicate formal";
126 static const char s_splicing
[] = "Non-list result for unquote-splicing";
127 static const char s_bad_slot_number
[] = "Bad slot number";
129 static void syntax_error (const char* const, const SCM
, const SCM
) SCM_NORETURN
;
131 SCM_SYMBOL (syntax_error_key
, "syntax-error");
133 /* Shortcut macros to simplify syntax error handling. */
134 #define ASSERT_SYNTAX(cond, message, form) \
135 { if (SCM_UNLIKELY (!(cond))) \
136 syntax_error (message, form, SCM_UNDEFINED); }
137 #define ASSERT_SYNTAX_2(cond, message, form, expr) \
138 { if (SCM_UNLIKELY (!(cond))) \
139 syntax_error (message, form, expr); }
144 /* Primitive syntax. */
146 #define SCM_SYNTAX(STR, CFN) \
147 SCM_SNARF_HERE(static SCM CFN (SCM xorig, SCM env)) \
148 SCM_SNARF_INIT(scm_c_define (STR, scm_i_make_primitive_macro (STR, CFN)))
151 /* True primitive syntax */
152 SCM_SYNTAX ("@", expand_at
);
153 SCM_SYNTAX ("@@", expand_atat
);
154 SCM_SYNTAX ("begin", expand_begin
);
155 SCM_SYNTAX ("define", expand_define
);
156 SCM_SYNTAX ("with-fluids", expand_with_fluids
);
157 SCM_SYNTAX ("eval-when", expand_eval_when
);
158 SCM_SYNTAX ("if", expand_if
);
159 SCM_SYNTAX ("lambda", expand_lambda
);
160 SCM_SYNTAX ("let", expand_let
);
161 SCM_SYNTAX ("quote", expand_quote
);
162 SCM_SYNTAX ("set!", expand_set_x
);
164 /* Convenient syntax during boot, expands to primitive syntax. Replaced after
166 SCM_SYNTAX ("and", expand_and
);
167 SCM_SYNTAX ("cond", expand_cond
);
168 SCM_SYNTAX ("letrec", expand_letrec
);
169 SCM_SYNTAX ("letrec*", expand_letrec_star
);
170 SCM_SYNTAX ("let*", expand_letstar
);
171 SCM_SYNTAX ("or", expand_or
);
172 SCM_SYNTAX ("lambda*", expand_lambda_star
);
173 SCM_SYNTAX ("case-lambda", expand_case_lambda
);
174 SCM_SYNTAX ("case-lambda*", expand_case_lambda_star
);
177 SCM_GLOBAL_SYMBOL (scm_sym_apply
, "apply");
178 SCM_GLOBAL_SYMBOL (scm_sym_arrow
, "=>");
179 SCM_GLOBAL_SYMBOL (scm_sym_at
, "@");
180 SCM_GLOBAL_SYMBOL (scm_sym_atat
, "@@");
181 SCM_GLOBAL_SYMBOL (scm_sym_at_call_with_values
, "@call-with-values");
182 SCM_GLOBAL_SYMBOL (scm_sym_atapply
, "@apply");
183 SCM_GLOBAL_SYMBOL (scm_sym_atcall_cc
, "@call-with-current-continuation");
184 SCM_GLOBAL_SYMBOL (scm_sym_begin
, "begin");
185 SCM_GLOBAL_SYMBOL (scm_sym_case
, "case");
186 SCM_GLOBAL_SYMBOL (scm_sym_cond
, "cond");
187 SCM_GLOBAL_SYMBOL (scm_sym_define
, "define");
188 SCM_GLOBAL_SYMBOL (scm_sym_at_dynamic_wind
, "@dynamic-wind");
189 SCM_GLOBAL_SYMBOL (scm_sym_with_fluids
, "with-fluids");
190 SCM_GLOBAL_SYMBOL (scm_sym_else
, "else");
191 SCM_GLOBAL_SYMBOL (scm_sym_eval_when
, "eval-when");
192 SCM_GLOBAL_SYMBOL (scm_sym_if
, "if");
193 SCM_GLOBAL_SYMBOL (scm_sym_lambda
, "lambda");
194 SCM_GLOBAL_SYMBOL (scm_sym_let
, "let");
195 SCM_GLOBAL_SYMBOL (scm_sym_letrec
, "letrec");
196 SCM_GLOBAL_SYMBOL (scm_sym_letstar
, "let*");
197 SCM_GLOBAL_SYMBOL (scm_sym_or
, "or");
198 SCM_GLOBAL_SYMBOL (scm_sym_at_prompt
, "@prompt");
199 SCM_GLOBAL_SYMBOL (scm_sym_quote
, "quote");
200 SCM_GLOBAL_SYMBOL (scm_sym_set_x
, "set!");
201 SCM_SYMBOL (sym_lambda_star
, "lambda*");
202 SCM_SYMBOL (sym_eval
, "eval");
203 SCM_SYMBOL (sym_load
, "load");
205 SCM_GLOBAL_SYMBOL (scm_sym_unquote
, "unquote");
206 SCM_GLOBAL_SYMBOL (scm_sym_quasiquote
, "quasiquote");
207 SCM_GLOBAL_SYMBOL (scm_sym_uq_splicing
, "unquote-splicing");
209 SCM_KEYWORD (kw_allow_other_keys
, "allow-other-keys");
210 SCM_KEYWORD (kw_optional
, "optional");
211 SCM_KEYWORD (kw_key
, "key");
212 SCM_KEYWORD (kw_rest
, "rest");
218 /* Signal a syntax error. We distinguish between the form that caused the
219 * error and the enclosing expression. The error message will print out as
220 * shown in the following pattern. The file name and line number are only
221 * given when they can be determined from the erroneous form or from the
222 * enclosing expression.
224 * <filename>: In procedure memoization:
225 * <filename>: In file <name>, line <nr>: <error-message> in <expression>. */
228 syntax_error (const char* const msg
, const SCM form
, const SCM expr
)
230 SCM msg_string
= scm_from_locale_string (msg
);
231 SCM filename
= SCM_BOOL_F
;
232 SCM linenr
= SCM_BOOL_F
;
236 if (scm_is_pair (form
))
238 filename
= scm_source_property (form
, scm_sym_filename
);
239 linenr
= scm_source_property (form
, scm_sym_line
);
242 if (scm_is_false (filename
) && scm_is_false (linenr
) && scm_is_pair (expr
))
244 filename
= scm_source_property (expr
, scm_sym_filename
);
245 linenr
= scm_source_property (expr
, scm_sym_line
);
248 if (!SCM_UNBNDP (expr
))
250 if (scm_is_true (filename
))
252 format
= "In file ~S, line ~S: ~A ~S in expression ~S.";
253 args
= scm_list_5 (filename
, linenr
, msg_string
, form
, expr
);
255 else if (scm_is_true (linenr
))
257 format
= "In line ~S: ~A ~S in expression ~S.";
258 args
= scm_list_4 (linenr
, msg_string
, form
, expr
);
262 format
= "~A ~S in expression ~S.";
263 args
= scm_list_3 (msg_string
, form
, expr
);
268 if (scm_is_true (filename
))
270 format
= "In file ~S, line ~S: ~A ~S.";
271 args
= scm_list_4 (filename
, linenr
, msg_string
, form
);
273 else if (scm_is_true (linenr
))
275 format
= "In line ~S: ~A ~S.";
276 args
= scm_list_3 (linenr
, msg_string
, form
);
281 args
= scm_list_2 (msg_string
, form
);
285 scm_error (syntax_error_key
, "memoization", format
, args
, SCM_BOOL_F
);
293 expand_env_var_is_free (SCM env
, SCM x
)
295 for (; scm_is_pair (env
); env
= CDR (env
))
296 if (scm_is_eq (x
, CAAR (env
)))
297 return 0; /* bound */
302 expand_env_ref_macro (SCM env
, SCM x
)
305 if (!expand_env_var_is_free (env
, x
))
306 return SCM_BOOL_F
; /* lexical */
308 var
= scm_module_variable (scm_current_module (), x
);
309 if (scm_is_true (var
) && scm_is_true (scm_variable_bound_p (var
))
310 && scm_is_true (scm_macro_p (scm_variable_ref (var
))))
311 return scm_variable_ref (var
);
313 return SCM_BOOL_F
; /* anything else */
317 expand_env_lexical_gensym (SCM env
, SCM name
)
319 for (; scm_is_pair (env
); env
= CDR (env
))
320 if (scm_is_eq (name
, CAAR (env
)))
321 return CDAR (env
); /* bound */
322 return SCM_BOOL_F
; /* free */
326 expand_env_extend (SCM env
, SCM names
, SCM vars
)
328 while (scm_is_pair (names
))
330 env
= scm_acons (CAR (names
), CAR (vars
), env
);
338 expand (SCM exp
, SCM env
)
340 if (scm_is_pair (exp
))
343 scm_t_macro_primitive trans
= NULL
;
344 SCM macro
= SCM_BOOL_F
;
347 if (scm_is_symbol (car
))
348 macro
= expand_env_ref_macro (env
, car
);
350 if (scm_is_true (macro
))
351 trans
= scm_i_macro_primitive (macro
);
354 return trans (exp
, env
);
357 SCM arg_exps
= SCM_EOL
;
359 SCM proc
= CAR (exp
);
361 for (arg_exps
= CDR (exp
); scm_is_pair (arg_exps
);
362 arg_exps
= CDR (arg_exps
))
363 args
= scm_cons (expand (CAR (arg_exps
), env
), args
);
364 if (scm_is_null (arg_exps
))
365 return CALL (scm_source_properties (exp
),
367 scm_reverse_x (args
, SCM_UNDEFINED
));
369 syntax_error ("expected a proper list", exp
, SCM_UNDEFINED
);
372 else if (scm_is_symbol (exp
))
374 SCM gensym
= expand_env_lexical_gensym (env
, exp
);
375 if (scm_is_true (gensym
))
376 return LEXICAL_REF (SCM_BOOL_F
, exp
, gensym
);
378 return TOPLEVEL_REF (SCM_BOOL_F
, exp
);
381 return CONST_ (SCM_BOOL_F
, exp
);
385 expand_exprs (SCM forms
, const SCM env
)
389 for (; !scm_is_null (forms
); forms
= CDR (forms
))
390 ret
= scm_cons (expand (CAR (forms
), env
), ret
);
391 return scm_reverse_x (ret
, SCM_UNDEFINED
);
395 expand_sequence (const SCM forms
, const SCM env
)
397 ASSERT_SYNTAX (scm_ilength (forms
) >= 1, s_bad_expression
,
398 scm_cons (scm_sym_begin
, forms
));
399 if (scm_is_null (CDR (forms
)))
400 return expand (CAR (forms
), env
);
402 return SEQ (scm_source_properties (forms
),
403 expand (CAR (forms
), env
),
404 expand_sequence (CDR (forms
), env
));
412 expand_at (SCM expr
, SCM env SCM_UNUSED
)
414 ASSERT_SYNTAX (scm_ilength (expr
) == 3, s_bad_expression
, expr
);
415 ASSERT_SYNTAX (scm_ilength (CADR (expr
)) > 0, s_bad_expression
, expr
);
416 ASSERT_SYNTAX (scm_is_symbol (CADDR (expr
)), s_bad_expression
, expr
);
418 return MODULE_REF (scm_source_properties (expr
),
419 CADR (expr
), CADDR (expr
), SCM_BOOL_T
);
423 expand_atat (SCM expr
, SCM env SCM_UNUSED
)
425 ASSERT_SYNTAX (scm_ilength (expr
) == 3, s_bad_expression
, expr
);
426 ASSERT_SYNTAX (scm_ilength (CADR (expr
)) > 0, s_bad_expression
, expr
);
427 ASSERT_SYNTAX (scm_is_symbol (CADDR (expr
)), s_bad_expression
, expr
);
429 return MODULE_REF (scm_source_properties (expr
),
430 CADR (expr
), CADDR (expr
), SCM_BOOL_F
);
434 expand_and (SCM expr
, SCM env
)
436 const SCM cdr_expr
= CDR (expr
);
438 if (scm_is_null (cdr_expr
))
439 return CONST_ (SCM_BOOL_F
, SCM_BOOL_T
);
441 ASSERT_SYNTAX (scm_is_pair (cdr_expr
), s_bad_expression
, expr
);
443 if (scm_is_null (CDR (cdr_expr
)))
444 return expand (CAR (cdr_expr
), env
);
446 return CONDITIONAL (scm_source_properties (expr
),
447 expand (CAR (cdr_expr
), env
),
448 expand_and (cdr_expr
, env
),
449 CONST_ (SCM_BOOL_F
, SCM_BOOL_F
));
453 expand_begin (SCM expr
, SCM env
)
455 const SCM cdr_expr
= CDR (expr
);
456 ASSERT_SYNTAX (scm_ilength (cdr_expr
) >= 1, s_bad_expression
, expr
);
457 return expand_sequence (cdr_expr
, env
);
461 expand_cond_clauses (SCM clause
, SCM rest
, int elp
, int alp
, SCM env
)
464 const long length
= scm_ilength (clause
);
465 ASSERT_SYNTAX (length
>= 1, s_bad_cond_clause
, clause
);
468 if (scm_is_eq (test
, scm_sym_else
) && elp
)
470 const int last_clause_p
= scm_is_null (rest
);
471 ASSERT_SYNTAX (length
>= 2, s_bad_cond_clause
, clause
);
472 ASSERT_SYNTAX (last_clause_p
, s_misplaced_else_clause
, clause
);
473 return expand_sequence (CDR (clause
), env
);
476 if (scm_is_null (rest
))
477 rest
= VOID_ (SCM_BOOL_F
);
479 rest
= expand_cond_clauses (CAR (rest
), CDR (rest
), elp
, alp
, env
);
482 && scm_is_eq (CADR (clause
), scm_sym_arrow
)
485 SCM tmp
= scm_gensym (scm_from_locale_string ("cond "));
486 SCM new_env
= scm_acons (tmp
, tmp
, env
);
487 ASSERT_SYNTAX (length
> 2, s_missing_recipient
, clause
);
488 ASSERT_SYNTAX (length
== 3, s_extra_expression
, clause
);
489 return LET (SCM_BOOL_F
,
492 scm_list_1 (expand (test
, env
)),
493 CONDITIONAL (SCM_BOOL_F
,
494 LEXICAL_REF (SCM_BOOL_F
, tmp
, tmp
),
496 expand (CADDR (clause
), new_env
),
497 scm_list_1 (LEXICAL_REF (SCM_BOOL_F
,
501 /* FIXME length == 1 case */
503 return CONDITIONAL (SCM_BOOL_F
,
505 expand_sequence (CDR (clause
), env
),
510 expand_cond (SCM expr
, SCM env
)
512 const int else_literal_p
= expand_env_var_is_free (env
, scm_sym_else
);
513 const int arrow_literal_p
= expand_env_var_is_free (env
, scm_sym_arrow
);
514 const SCM clauses
= CDR (expr
);
516 ASSERT_SYNTAX (scm_ilength (clauses
) >= 0, s_bad_expression
, expr
);
517 ASSERT_SYNTAX (scm_ilength (clauses
) >= 1, s_missing_clauses
, expr
);
519 return expand_cond_clauses (CAR (clauses
), CDR (clauses
),
520 else_literal_p
, arrow_literal_p
, env
);
523 /* lone forward decl */
524 static SCM
expand_lambda (SCM expr
, SCM env
);
526 /* According to Section 5.2.1 of R5RS we first have to make sure that the
527 variable is bound, and then perform the `(set! variable expression)'
528 operation. However, EXPRESSION _can_ be evaluated before VARIABLE is
529 bound. This means that EXPRESSION won't necessarily be able to assign
530 values to VARIABLE as in `(define foo (begin (set! foo 1) (+ foo 1)))'. */
532 expand_define (SCM expr
, SCM env
)
534 const SCM cdr_expr
= CDR (expr
);
538 ASSERT_SYNTAX (scm_ilength (cdr_expr
) >= 0, s_bad_expression
, expr
);
539 ASSERT_SYNTAX (scm_ilength (cdr_expr
) >= 2, s_missing_expression
, expr
);
540 ASSERT_SYNTAX (!scm_is_pair (env
), s_bad_define
, expr
);
542 body
= CDR (cdr_expr
);
543 variable
= CAR (cdr_expr
);
545 if (scm_is_pair (variable
))
547 ASSERT_SYNTAX_2 (scm_is_symbol (CAR (variable
)), s_bad_variable
, variable
, expr
);
548 return TOPLEVEL_DEFINE
549 (scm_source_properties (expr
),
551 expand_lambda (scm_cons (scm_sym_lambda
, scm_cons (CDR (variable
), body
)),
554 ASSERT_SYNTAX_2 (scm_is_symbol (variable
), s_bad_variable
, variable
, expr
);
555 ASSERT_SYNTAX (scm_ilength (body
) == 1, s_expression
, expr
);
556 return TOPLEVEL_DEFINE (scm_source_properties (expr
), variable
,
557 expand (CAR (body
), env
));
561 expand_with_fluids (SCM expr
, SCM env
)
563 SCM binds
, fluids
, vals
;
564 ASSERT_SYNTAX (scm_ilength (expr
) >= 3, s_bad_expression
, expr
);
566 ASSERT_SYNTAX_2 (scm_ilength (binds
) >= 0, s_bad_bindings
, binds
, expr
);
567 for (fluids
= SCM_EOL
, vals
= SCM_EOL
;
571 SCM binding
= CAR (binds
);
572 ASSERT_SYNTAX_2 (scm_ilength (CAR (binds
)) == 2, s_bad_binding
,
574 fluids
= scm_cons (expand (CAR (binding
), env
), fluids
);
575 vals
= scm_cons (expand (CADR (binding
), env
), vals
);
578 return DYNLET (scm_source_properties (expr
),
579 scm_reverse_x (fluids
, SCM_UNDEFINED
),
580 scm_reverse_x (vals
, SCM_UNDEFINED
),
581 expand_sequence (CDDR (expr
), env
));
585 expand_eval_when (SCM expr
, SCM env
)
587 ASSERT_SYNTAX (scm_ilength (expr
) >= 3, s_bad_expression
, expr
);
588 ASSERT_SYNTAX (scm_ilength (CADR (expr
)) > 0, s_bad_expression
, expr
);
590 if (scm_is_true (scm_memq (sym_eval
, CADR (expr
)))
591 || scm_is_true (scm_memq (sym_load
, CADR (expr
))))
592 return expand_sequence (CDDR (expr
), env
);
594 return VOID_ (scm_source_properties (expr
));
598 expand_if (SCM expr
, SCM env SCM_UNUSED
)
600 const SCM cdr_expr
= CDR (expr
);
601 const long length
= scm_ilength (cdr_expr
);
602 ASSERT_SYNTAX (length
== 2 || length
== 3, s_expression
, expr
);
603 return CONDITIONAL (scm_source_properties (expr
),
604 expand (CADR (expr
), env
),
605 expand (CADDR (expr
), env
),
607 ? expand (CADDDR (expr
), env
)
608 : VOID_ (SCM_BOOL_F
)));
611 /* A helper function for expand_lambda to support checking for duplicate
612 * formal arguments: Return true if OBJ is `eq?' to one of the elements of
613 * LIST or to the CDR of the last cons. Therefore, LIST may have any of the
614 * forms that a formal argument can have:
615 * <rest>, (<arg1> ...), (<arg1> ... . <rest>) */
617 c_improper_memq (SCM obj
, SCM list
)
619 for (; scm_is_pair (list
); list
= CDR (list
))
621 if (scm_is_eq (CAR (list
), obj
))
624 return scm_is_eq (list
, obj
);
628 expand_lambda_case (SCM clause
, SCM alternate
, SCM env
)
637 ASSERT_SYNTAX (scm_is_pair (clause
) && scm_is_pair (CDR (clause
)),
638 s_bad_expression
, scm_cons (scm_sym_lambda
, clause
));
640 /* Before iterating the list of formal arguments, make sure the formals
641 * actually are given as either a symbol or a non-cyclic list. */
642 formals
= CAR (clause
);
643 if (scm_is_pair (formals
))
645 /* Dirk:FIXME:: We should check for a cyclic list of formals, and if
646 * detected, report a 'Bad formals' error. */
649 ASSERT_SYNTAX_2 (scm_is_symbol (formals
) || scm_is_null (formals
),
650 s_bad_formals
, formals
, scm_cons (scm_sym_lambda
, clause
));
652 /* Now iterate the list of formal arguments to check if all formals are
653 * symbols, and that there are no duplicates. */
654 while (scm_is_pair (formals
))
656 const SCM formal
= CAR (formals
);
657 formals
= CDR (formals
);
658 ASSERT_SYNTAX_2 (scm_is_symbol (formal
), s_bad_formal
, formal
,
659 scm_cons (scm_sym_lambda
, clause
));
660 ASSERT_SYNTAX_2 (!c_improper_memq (formal
, formals
), s_duplicate_formal
,
661 formal
, scm_cons (scm_sym_lambda
, clause
));
663 req
= scm_cons (formal
, req
);
664 vars
= scm_cons (scm_gensym (SCM_UNDEFINED
), vars
);
665 env
= scm_acons (formal
, CAR (vars
), env
);
668 ASSERT_SYNTAX_2 (scm_is_null (formals
) || scm_is_symbol (formals
),
669 s_bad_formal
, formals
, scm_cons (scm_sym_lambda
, clause
));
670 if (scm_is_symbol (formals
))
673 vars
= scm_cons (scm_gensym (SCM_UNDEFINED
), vars
);
674 env
= scm_acons (rest
, CAR (vars
), env
);
679 body
= expand_sequence (CDR (clause
), env
);
680 req
= scm_reverse_x (req
, SCM_UNDEFINED
);
681 vars
= scm_reverse_x (vars
, SCM_UNDEFINED
);
683 if (scm_is_true (alternate
) && !(SCM_EXPANDED_P (alternate
) && SCM_EXPANDED_TYPE (alternate
) == SCM_EXPANDED_LAMBDA_CASE
))
686 return LAMBDA_CASE (SCM_BOOL_F
, req
, SCM_BOOL_F
, rest
, SCM_BOOL_F
,
687 SCM_EOL
, vars
, body
, alternate
);
691 expand_lambda (SCM expr
, SCM env
)
693 return LAMBDA (scm_source_properties (expr
),
695 expand_lambda_case (CDR (expr
), SCM_BOOL_F
, env
));
699 expand_lambda_star_case (SCM clause
, SCM alternate
, SCM env
)
701 SCM req
, opt
, kw
, allow_other_keys
, rest
, formals
, vars
, body
, tmp
;
705 const long length
= scm_ilength (clause
);
706 ASSERT_SYNTAX (length
>= 1, s_bad_expression
,
707 scm_cons (sym_lambda_star
, clause
));
708 ASSERT_SYNTAX (length
>= 2, s_missing_expression
,
709 scm_cons (sym_lambda_star
, clause
));
711 formals
= CAR (clause
);
715 req
= opt
= kw
= SCM_EOL
;
716 rest
= allow_other_keys
= SCM_BOOL_F
;
718 while (scm_is_pair (formals
) && scm_is_symbol (CAR (formals
)))
721 req
= scm_cons (CAR (formals
), req
);
722 formals
= scm_cdr (formals
);
725 if (scm_is_pair (formals
) && scm_is_eq (CAR (formals
), kw_optional
))
727 formals
= CDR (formals
);
728 while (scm_is_pair (formals
)
729 && (scm_is_symbol (CAR (formals
)) || scm_is_pair (CAR (formals
))))
732 opt
= scm_cons (CAR (formals
), opt
);
733 formals
= scm_cdr (formals
);
737 if (scm_is_pair (formals
) && scm_is_eq (CAR (formals
), kw_key
))
739 formals
= CDR (formals
);
740 while (scm_is_pair (formals
)
741 && (scm_is_symbol (CAR (formals
)) || scm_is_pair (CAR (formals
))))
743 kw
= scm_cons (CAR (formals
), kw
);
744 formals
= scm_cdr (formals
);
748 if (scm_is_pair (formals
) && scm_is_eq (CAR (formals
), kw_allow_other_keys
))
750 formals
= CDR (formals
);
751 allow_other_keys
= SCM_BOOL_T
;
754 if (scm_is_pair (formals
) && scm_is_eq (CAR (formals
), kw_rest
))
756 ASSERT_SYNTAX (scm_ilength (formals
) == 2, s_bad_formals
,
758 rest
= CADR (formals
);
760 else if (scm_is_symbol (formals
))
764 ASSERT_SYNTAX (scm_is_null (formals
), s_bad_formals
, CAR (clause
));
768 /* Now, iterate through them a second time, building up an expansion-time
769 environment, checking, expanding and canonicalizing the opt/kw init forms,
770 and eventually memoizing the body as well. Note that the rest argument, if
771 any, is expanded before keyword args, thus necessitating the second
774 Also note that the specific environment during expansion of init
775 expressions here needs to coincide with the environment when psyntax
776 expands. A lot of effort for something that is only used in the bootstrap
777 expandr, you say? Yes. Yes it is.
781 req
= scm_reverse_x (req
, SCM_EOL
);
782 for (tmp
= req
; scm_is_pair (tmp
); tmp
= scm_cdr (tmp
))
784 vars
= scm_cons (scm_gensym (SCM_UNDEFINED
), vars
);
785 env
= scm_acons (CAR (tmp
), CAR (vars
), env
);
788 /* Build up opt inits and env */
790 opt
= scm_reverse_x (opt
, SCM_EOL
);
791 for (tmp
= opt
; scm_is_pair (tmp
); tmp
= scm_cdr (tmp
))
794 vars
= scm_cons (scm_gensym (SCM_UNDEFINED
), vars
);
795 env
= scm_acons (x
, CAR (vars
), env
);
796 if (scm_is_symbol (x
))
797 inits
= scm_cons (CONST_ (SCM_BOOL_F
, SCM_BOOL_F
), inits
);
800 ASSERT_SYNTAX (scm_ilength (x
) == 2 && scm_is_symbol (CAR (x
)),
801 s_bad_formals
, CAR (clause
));
802 inits
= scm_cons (expand (CADR (x
), env
), inits
);
804 env
= scm_acons (scm_is_symbol (x
) ? x
: CAR (x
), CAR (vars
), env
);
806 if (scm_is_null (opt
))
809 /* Process rest before keyword args */
810 if (scm_is_true (rest
))
812 vars
= scm_cons (scm_gensym (SCM_UNDEFINED
), vars
);
813 env
= scm_acons (rest
, CAR (vars
), env
);
816 /* Build up kw inits, env, and kw-canon list */
817 if (scm_is_null (kw
))
821 SCM kw_canon
= SCM_EOL
;
822 kw
= scm_reverse_x (kw
, SCM_UNDEFINED
);
823 for (tmp
= kw
; scm_is_pair (tmp
); tmp
= scm_cdr (tmp
))
827 if (scm_is_symbol (x
))
831 k
= scm_symbol_to_keyword (sym
);
833 else if (scm_ilength (x
) == 2 && scm_is_symbol (CAR (x
)))
837 k
= scm_symbol_to_keyword (sym
);
839 else if (scm_ilength (x
) == 3 && scm_is_symbol (CAR (x
))
840 && scm_is_keyword (CADDR (x
)))
847 syntax_error (s_bad_formals
, CAR (clause
), SCM_UNDEFINED
);
849 inits
= scm_cons (expand (init
, env
), inits
);
850 vars
= scm_cons (scm_gensym (SCM_UNDEFINED
), vars
);
851 kw_canon
= scm_cons (scm_list_3 (k
, sym
, CAR (vars
)), kw_canon
);
852 env
= scm_acons (sym
, CAR (vars
), env
);
854 kw_canon
= scm_reverse_x (kw_canon
, SCM_UNDEFINED
);
855 kw
= scm_cons (allow_other_keys
, kw_canon
);
858 /* We should check for no duplicates, but given that psyntax does this
859 already, we can punt on it here... */
861 vars
= scm_reverse_x (vars
, SCM_UNDEFINED
);
862 inits
= scm_reverse_x (inits
, SCM_UNDEFINED
);
863 body
= expand_sequence (body
, env
);
865 return LAMBDA_CASE (SCM_BOOL_F
, req
, opt
, rest
, kw
, inits
, vars
, body
,
870 expand_lambda_star (SCM expr
, SCM env
)
872 return LAMBDA (scm_source_properties (expr
),
874 expand_lambda_star_case (CDR (expr
), SCM_BOOL_F
, env
));
878 expand_case_lambda_clauses (SCM expr
, SCM rest
, SCM env
)
882 if (scm_is_pair (rest
))
883 alt
= expand_case_lambda_clauses (CAR (rest
), CDR (rest
), env
);
887 return expand_lambda_case (expr
, alt
, env
);
891 expand_case_lambda (SCM expr
, SCM env
)
893 ASSERT_SYNTAX (scm_is_pair (CDR (expr
)), s_missing_expression
, expr
);
895 return LAMBDA (scm_source_properties (expr
),
897 expand_case_lambda_clauses (CADR (expr
), CDDR (expr
), env
));
901 expand_case_lambda_star_clauses (SCM expr
, SCM rest
, SCM env
)
905 if (scm_is_pair (rest
))
906 alt
= expand_case_lambda_star_clauses (CAR (rest
), CDR (rest
), env
);
910 return expand_lambda_star_case (expr
, alt
, env
);
914 expand_case_lambda_star (SCM expr
, SCM env
)
916 ASSERT_SYNTAX (scm_is_pair (CDR (expr
)), s_missing_expression
, expr
);
918 return LAMBDA (scm_source_properties (expr
),
920 expand_case_lambda_star_clauses (CADR (expr
), CDDR (expr
), env
));
923 /* Check if the format of the bindings is ((<symbol> <init-form>) ...). */
925 check_bindings (const SCM bindings
, const SCM expr
)
929 ASSERT_SYNTAX_2 (scm_ilength (bindings
) >= 0,
930 s_bad_bindings
, bindings
, expr
);
932 binding_idx
= bindings
;
933 for (; !scm_is_null (binding_idx
); binding_idx
= CDR (binding_idx
))
935 SCM name
; /* const */
937 const SCM binding
= CAR (binding_idx
);
938 ASSERT_SYNTAX_2 (scm_ilength (binding
) == 2,
939 s_bad_binding
, binding
, expr
);
941 name
= CAR (binding
);
942 ASSERT_SYNTAX_2 (scm_is_symbol (name
), s_bad_variable
, name
, expr
);
946 /* The bindings, which must have the format ((v1 i1) (v2 i2) ... (vn in)), are
947 * transformed to the lists (vn .. v2 v1) and (i1 i2 ... in). If a duplicate
948 * variable name is detected, an error is signalled. */
950 transform_bindings (const SCM bindings
, const SCM expr
,
951 SCM
*const names
, SCM
*const vars
, SCM
*const initptr
)
953 SCM rnames
= SCM_EOL
;
955 SCM rinits
= SCM_EOL
;
956 SCM binding_idx
= bindings
;
957 for (; !scm_is_null (binding_idx
); binding_idx
= CDR (binding_idx
))
959 const SCM binding
= CAR (binding_idx
);
960 const SCM CDR_binding
= CDR (binding
);
961 const SCM name
= CAR (binding
);
962 ASSERT_SYNTAX_2 (scm_is_false (scm_c_memq (name
, rnames
)),
963 s_duplicate_binding
, name
, expr
);
964 rnames
= scm_cons (name
, rnames
);
965 rvars
= scm_cons (scm_gensym (SCM_UNDEFINED
), rvars
);
966 rinits
= scm_cons (CAR (CDR_binding
), rinits
);
968 *names
= scm_reverse_x (rnames
, SCM_UNDEFINED
);
969 *vars
= scm_reverse_x (rvars
, SCM_UNDEFINED
);
970 *initptr
= scm_reverse_x (rinits
, SCM_UNDEFINED
);
973 /* FIXME: Remove named let in this boot expander. */
975 expand_named_let (const SCM expr
, SCM env
)
977 SCM var_names
, var_syms
, inits
;
981 const SCM cdr_expr
= CDR (expr
);
982 const SCM name
= CAR (cdr_expr
);
983 const SCM cddr_expr
= CDR (cdr_expr
);
984 const SCM bindings
= CAR (cddr_expr
);
985 check_bindings (bindings
, expr
);
987 transform_bindings (bindings
, expr
, &var_names
, &var_syms
, &inits
);
988 name_sym
= scm_gensym (SCM_UNDEFINED
);
989 inner_env
= scm_acons (name
, name_sym
, env
);
990 inner_env
= expand_env_extend (inner_env
, var_names
, var_syms
);
993 (scm_source_properties (expr
), SCM_BOOL_F
,
994 scm_list_1 (name
), scm_list_1 (name_sym
),
995 scm_list_1 (LAMBDA (SCM_BOOL_F
,
997 LAMBDA_CASE (SCM_BOOL_F
, var_names
, SCM_BOOL_F
, SCM_BOOL_F
,
998 SCM_BOOL_F
, SCM_BOOL_F
, var_syms
,
999 expand_sequence (CDDDR (expr
), inner_env
),
1002 LEXICAL_REF (SCM_BOOL_F
, name
, name_sym
),
1003 expand_exprs (inits
, env
)));
1007 expand_let (SCM expr
, SCM env
)
1011 const SCM cdr_expr
= CDR (expr
);
1012 const long length
= scm_ilength (cdr_expr
);
1013 ASSERT_SYNTAX (length
>= 0, s_bad_expression
, expr
);
1014 ASSERT_SYNTAX (length
>= 2, s_missing_expression
, expr
);
1016 bindings
= CAR (cdr_expr
);
1017 if (scm_is_symbol (bindings
))
1019 ASSERT_SYNTAX (length
>= 3, s_missing_expression
, expr
);
1020 return expand_named_let (expr
, env
);
1023 check_bindings (bindings
, expr
);
1024 if (scm_is_null (bindings
))
1025 return expand_sequence (CDDR (expr
), env
);
1028 SCM var_names
, var_syms
, inits
;
1029 transform_bindings (bindings
, expr
, &var_names
, &var_syms
, &inits
);
1030 return LET (SCM_BOOL_F
,
1031 var_names
, var_syms
, expand_exprs (inits
, env
),
1032 expand_sequence (CDDR (expr
),
1033 expand_env_extend (env
, var_names
,
1039 expand_letrec_helper (SCM expr
, SCM env
, SCM in_order_p
)
1043 const SCM cdr_expr
= CDR (expr
);
1044 const long length
= scm_ilength (cdr_expr
);
1045 ASSERT_SYNTAX (length
>= 0, s_bad_expression
, expr
);
1046 ASSERT_SYNTAX (length
>= 2, s_missing_expression
, expr
);
1048 bindings
= CAR (cdr_expr
);
1049 check_bindings (bindings
, expr
);
1050 if (scm_is_null (bindings
))
1051 return expand_sequence (CDDR (expr
), env
);
1054 SCM var_names
, var_syms
, inits
;
1055 transform_bindings (bindings
, expr
, &var_names
, &var_syms
, &inits
);
1056 env
= expand_env_extend (env
, var_names
, var_syms
);
1057 return LETREC (SCM_BOOL_F
, in_order_p
,
1058 var_names
, var_syms
, expand_exprs (inits
, env
),
1059 expand_sequence (CDDR (expr
), env
));
1064 expand_letrec (SCM expr
, SCM env
)
1066 return expand_letrec_helper (expr
, env
, SCM_BOOL_F
);
1070 expand_letrec_star (SCM expr
, SCM env
)
1072 return expand_letrec_helper (expr
, env
, SCM_BOOL_T
);
1076 expand_letstar_clause (SCM bindings
, SCM body
, SCM env SCM_UNUSED
)
1078 if (scm_is_null (bindings
))
1079 return expand_sequence (body
, env
);
1082 SCM bind
, name
, sym
, init
;
1084 ASSERT_SYNTAX (scm_is_pair (bindings
), s_bad_expression
, bindings
);
1085 bind
= CAR (bindings
);
1086 ASSERT_SYNTAX (scm_ilength (bind
) == 2, s_bad_binding
, bind
);
1088 sym
= scm_gensym (SCM_UNDEFINED
);
1091 return LET (SCM_BOOL_F
, scm_list_1 (name
), scm_list_1 (sym
),
1092 scm_list_1 (expand (init
, env
)),
1093 expand_letstar_clause (CDR (bindings
), body
,
1094 scm_acons (name
, sym
, env
)));
1099 expand_letstar (SCM expr
, SCM env SCM_UNUSED
)
1101 const SCM cdr_expr
= CDR (expr
);
1102 ASSERT_SYNTAX (scm_ilength (cdr_expr
) >= 0, s_bad_expression
, expr
);
1103 ASSERT_SYNTAX (scm_ilength (cdr_expr
) >= 2, s_missing_expression
, expr
);
1105 return expand_letstar_clause (CADR (expr
), CDDR (expr
), env
);
1109 expand_or (SCM expr
, SCM env SCM_UNUSED
)
1111 SCM tail
= CDR (expr
);
1112 const long length
= scm_ilength (tail
);
1114 ASSERT_SYNTAX (length
>= 0, s_bad_expression
, expr
);
1116 if (scm_is_null (CDR (expr
)))
1117 return CONST_ (SCM_BOOL_F
, SCM_BOOL_F
);
1120 SCM tmp
= scm_gensym (SCM_UNDEFINED
);
1121 return LET (SCM_BOOL_F
,
1122 scm_list_1 (tmp
), scm_list_1 (tmp
),
1123 scm_list_1 (expand (CADR (expr
), env
)),
1124 CONDITIONAL (SCM_BOOL_F
,
1125 LEXICAL_REF (SCM_BOOL_F
, tmp
, tmp
),
1126 LEXICAL_REF (SCM_BOOL_F
, tmp
, tmp
),
1127 expand_or (CDR (expr
),
1128 scm_acons (tmp
, tmp
, env
))));
1133 expand_quote (SCM expr
, SCM env SCM_UNUSED
)
1137 const SCM cdr_expr
= CDR (expr
);
1138 ASSERT_SYNTAX (scm_ilength (cdr_expr
) >= 0, s_bad_expression
, expr
);
1139 ASSERT_SYNTAX (scm_ilength (cdr_expr
) == 1, s_expression
, expr
);
1140 quotee
= CAR (cdr_expr
);
1141 return CONST_ (scm_source_properties (expr
), quotee
);
1145 expand_set_x (SCM expr
, SCM env
)
1150 const SCM cdr_expr
= CDR (expr
);
1151 ASSERT_SYNTAX (scm_ilength (cdr_expr
) >= 0, s_bad_expression
, expr
);
1152 ASSERT_SYNTAX (scm_ilength (cdr_expr
) == 2, s_expression
, expr
);
1153 variable
= CAR (cdr_expr
);
1154 vmem
= expand (variable
, env
);
1156 switch (SCM_EXPANDED_TYPE (vmem
))
1158 case SCM_EXPANDED_LEXICAL_REF
:
1159 return LEXICAL_SET (scm_source_properties (expr
),
1160 SCM_EXPANDED_REF (vmem
, LEXICAL_REF
, NAME
),
1161 SCM_EXPANDED_REF (vmem
, LEXICAL_REF
, GENSYM
),
1162 expand (CADDR (expr
), env
));
1163 case SCM_EXPANDED_TOPLEVEL_REF
:
1164 return TOPLEVEL_SET (scm_source_properties (expr
),
1165 SCM_EXPANDED_REF (vmem
, TOPLEVEL_REF
, NAME
),
1166 expand (CADDR (expr
), env
));
1167 case SCM_EXPANDED_MODULE_REF
:
1168 return MODULE_SET (scm_source_properties (expr
),
1169 SCM_EXPANDED_REF (vmem
, MODULE_REF
, MOD
),
1170 SCM_EXPANDED_REF (vmem
, MODULE_REF
, NAME
),
1171 SCM_EXPANDED_REF (vmem
, MODULE_REF
, PUBLIC
),
1172 expand (CADDR (expr
), env
));
1174 syntax_error (s_bad_variable
, variable
, expr
);
1181 /* This is the boot expander. It is later replaced with psyntax's sc-expand. */
1182 SCM_DEFINE (scm_macroexpand
, "macroexpand", 1, 0, 0,
1184 "Expand the expression @var{exp}.")
1185 #define FUNC_NAME s_scm_macroexpand
1187 return expand (exp
, scm_current_module ());
1191 SCM_DEFINE (scm_macroexpanded_p
, "macroexpanded?", 1, 0, 0,
1193 "Return @code{#t} if @var{exp} is an expanded expression.")
1194 #define FUNC_NAME s_scm_macroexpanded_p
1196 return scm_from_bool (SCM_EXPANDED_P (exp
));
1203 #define DEFINE_NAMES(type) \
1205 static const char *fields[] = SCM_EXPANDED_##type##_FIELD_NAMES; \
1206 exp_field_names[SCM_EXPANDED_##type] = fields; \
1207 exp_names[SCM_EXPANDED_##type] = SCM_EXPANDED_##type##_TYPE_NAME; \
1208 exp_nfields[SCM_EXPANDED_##type] = SCM_NUM_EXPANDED_##type##_FIELDS; \
1212 make_exp_vtable (size_t n
)
1214 SCM layout
, printer
, name
, code
, fields
;
1216 layout
= scm_string_to_symbol
1217 (scm_string_append (scm_make_list (scm_from_size_t (exp_nfields
[n
]),
1218 scm_from_locale_string ("pw"))));
1219 printer
= SCM_BOOL_F
;
1220 name
= scm_from_utf8_symbol (exp_names
[n
]);
1221 code
= scm_from_size_t (n
);
1224 size_t m
= exp_nfields
[n
];
1226 fields
= scm_cons (scm_from_utf8_symbol (exp_field_names
[n
][m
]), fields
);
1229 return scm_c_make_struct (scm_exp_vtable_vtable
, 0, 5,
1230 SCM_UNPACK (layout
), SCM_UNPACK (printer
), SCM_UNPACK (name
),
1231 SCM_UNPACK (code
), SCM_UNPACK (fields
));
1238 SCM exp_vtable_list
= SCM_EOL
;
1240 DEFINE_NAMES (VOID
);
1241 DEFINE_NAMES (CONST
);
1242 DEFINE_NAMES (PRIMITIVE_REF
);
1243 DEFINE_NAMES (LEXICAL_REF
);
1244 DEFINE_NAMES (LEXICAL_SET
);
1245 DEFINE_NAMES (MODULE_REF
);
1246 DEFINE_NAMES (MODULE_SET
);
1247 DEFINE_NAMES (TOPLEVEL_REF
);
1248 DEFINE_NAMES (TOPLEVEL_SET
);
1249 DEFINE_NAMES (TOPLEVEL_DEFINE
);
1250 DEFINE_NAMES (CONDITIONAL
);
1251 DEFINE_NAMES (CALL
);
1252 DEFINE_NAMES (PRIMCALL
);
1254 DEFINE_NAMES (LAMBDA
);
1255 DEFINE_NAMES (LAMBDA_CASE
);
1257 DEFINE_NAMES (LETREC
);
1258 DEFINE_NAMES (DYNLET
);
1260 scm_exp_vtable_vtable
=
1261 scm_make_vtable (scm_from_locale_string (SCM_VTABLE_BASE_LAYOUT
"pwuwpw"),
1264 for (n
= 0; n
< SCM_NUM_EXPANDED_TYPES
; n
++)
1265 exp_vtables
[n
] = make_exp_vtable (n
);
1267 /* Now walk back down, consing in reverse. */
1269 exp_vtable_list
= scm_cons (exp_vtables
[n
], exp_vtable_list
);
1271 scm_c_define ("%expanded-vtables", scm_vector (exp_vtable_list
));
1273 #include "libguile/expand.x"