1 /* Copyright (C) 1995,1996,1997,1998,1999,2000,2001,2002,2003,2004,2005,2006,2007,2008,2009,2010,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 APPLICATION(src, proc, exps) \
78 SCM_MAKE_EXPANDED_APPLICATION(src, proc, exps)
79 #define SEQUENCE(src, exps) \
80 SCM_MAKE_EXPANDED_SEQUENCE(src, exps)
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 APPLICATION (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 SEQUENCE (SCM_BOOL_F
, expand_exprs (forms
, env
));
410 expand_at (SCM expr
, SCM env SCM_UNUSED
)
412 ASSERT_SYNTAX (scm_ilength (expr
) == 3, s_bad_expression
, expr
);
413 ASSERT_SYNTAX (scm_ilength (CADR (expr
)) > 0, s_bad_expression
, expr
);
414 ASSERT_SYNTAX (scm_is_symbol (CADDR (expr
)), s_bad_expression
, expr
);
416 return MODULE_REF (scm_source_properties (expr
),
417 CADR (expr
), CADDR (expr
), SCM_BOOL_T
);
421 expand_atat (SCM expr
, SCM env SCM_UNUSED
)
423 ASSERT_SYNTAX (scm_ilength (expr
) == 3, s_bad_expression
, expr
);
424 ASSERT_SYNTAX (scm_ilength (CADR (expr
)) > 0, s_bad_expression
, expr
);
425 ASSERT_SYNTAX (scm_is_symbol (CADDR (expr
)), s_bad_expression
, expr
);
427 return MODULE_REF (scm_source_properties (expr
),
428 CADR (expr
), CADDR (expr
), SCM_BOOL_F
);
432 expand_and (SCM expr
, SCM env
)
434 const SCM cdr_expr
= CDR (expr
);
436 if (scm_is_null (cdr_expr
))
437 return CONST_ (SCM_BOOL_F
, SCM_BOOL_T
);
439 ASSERT_SYNTAX (scm_is_pair (cdr_expr
), s_bad_expression
, expr
);
441 if (scm_is_null (CDR (cdr_expr
)))
442 return expand (CAR (cdr_expr
), env
);
444 return CONDITIONAL (scm_source_properties (expr
),
445 expand (CAR (cdr_expr
), env
),
446 expand_and (cdr_expr
, env
),
447 CONST_ (SCM_BOOL_F
, SCM_BOOL_F
));
451 expand_begin (SCM expr
, SCM env
)
453 const SCM cdr_expr
= CDR (expr
);
454 ASSERT_SYNTAX (scm_ilength (cdr_expr
) >= 1, s_bad_expression
, expr
);
455 return expand_sequence (cdr_expr
, env
);
459 expand_cond_clauses (SCM clause
, SCM rest
, int elp
, int alp
, SCM env
)
462 const long length
= scm_ilength (clause
);
463 ASSERT_SYNTAX (length
>= 1, s_bad_cond_clause
, clause
);
466 if (scm_is_eq (test
, scm_sym_else
) && elp
)
468 const int last_clause_p
= scm_is_null (rest
);
469 ASSERT_SYNTAX (length
>= 2, s_bad_cond_clause
, clause
);
470 ASSERT_SYNTAX (last_clause_p
, s_misplaced_else_clause
, clause
);
471 return expand_sequence (CDR (clause
), env
);
474 if (scm_is_null (rest
))
475 rest
= VOID_ (SCM_BOOL_F
);
477 rest
= expand_cond_clauses (CAR (rest
), CDR (rest
), elp
, alp
, env
);
480 && scm_is_eq (CADR (clause
), scm_sym_arrow
)
483 SCM tmp
= scm_gensym (scm_from_locale_string ("cond "));
484 SCM new_env
= scm_acons (tmp
, tmp
, env
);
485 ASSERT_SYNTAX (length
> 2, s_missing_recipient
, clause
);
486 ASSERT_SYNTAX (length
== 3, s_extra_expression
, clause
);
487 return LET (SCM_BOOL_F
,
490 scm_list_1 (expand (test
, env
)),
491 CONDITIONAL (SCM_BOOL_F
,
492 LEXICAL_REF (SCM_BOOL_F
, tmp
, tmp
),
493 APPLICATION (SCM_BOOL_F
,
494 expand (CADDR (clause
), new_env
),
495 scm_list_1 (LEXICAL_REF (SCM_BOOL_F
,
499 /* FIXME length == 1 case */
501 return CONDITIONAL (SCM_BOOL_F
,
503 expand_sequence (CDR (clause
), env
),
508 expand_cond (SCM expr
, SCM env
)
510 const int else_literal_p
= expand_env_var_is_free (env
, scm_sym_else
);
511 const int arrow_literal_p
= expand_env_var_is_free (env
, scm_sym_arrow
);
512 const SCM clauses
= CDR (expr
);
514 ASSERT_SYNTAX (scm_ilength (clauses
) >= 0, s_bad_expression
, expr
);
515 ASSERT_SYNTAX (scm_ilength (clauses
) >= 1, s_missing_clauses
, expr
);
517 return expand_cond_clauses (CAR (clauses
), CDR (clauses
),
518 else_literal_p
, arrow_literal_p
, env
);
521 /* lone forward decl */
522 static SCM
expand_lambda (SCM expr
, SCM env
);
524 /* According to Section 5.2.1 of R5RS we first have to make sure that the
525 variable is bound, and then perform the `(set! variable expression)'
526 operation. However, EXPRESSION _can_ be evaluated before VARIABLE is
527 bound. This means that EXPRESSION won't necessarily be able to assign
528 values to VARIABLE as in `(define foo (begin (set! foo 1) (+ foo 1)))'. */
530 expand_define (SCM expr
, SCM env
)
532 const SCM cdr_expr
= CDR (expr
);
536 ASSERT_SYNTAX (scm_ilength (cdr_expr
) >= 0, s_bad_expression
, expr
);
537 ASSERT_SYNTAX (scm_ilength (cdr_expr
) >= 2, s_missing_expression
, expr
);
538 ASSERT_SYNTAX (!scm_is_pair (env
), s_bad_define
, expr
);
540 body
= CDR (cdr_expr
);
541 variable
= CAR (cdr_expr
);
543 if (scm_is_pair (variable
))
545 ASSERT_SYNTAX_2 (scm_is_symbol (CAR (variable
)), s_bad_variable
, variable
, expr
);
546 return TOPLEVEL_DEFINE
547 (scm_source_properties (expr
),
549 expand_lambda (scm_cons (scm_sym_lambda
, scm_cons (CDR (variable
), body
)),
552 ASSERT_SYNTAX_2 (scm_is_symbol (variable
), s_bad_variable
, variable
, expr
);
553 ASSERT_SYNTAX (scm_ilength (body
) == 1, s_expression
, expr
);
554 return TOPLEVEL_DEFINE (scm_source_properties (expr
), variable
,
555 expand (CAR (body
), env
));
559 expand_with_fluids (SCM expr
, SCM env
)
561 SCM binds
, fluids
, vals
;
562 ASSERT_SYNTAX (scm_ilength (expr
) >= 3, s_bad_expression
, expr
);
564 ASSERT_SYNTAX_2 (scm_ilength (binds
) >= 0, s_bad_bindings
, binds
, expr
);
565 for (fluids
= SCM_EOL
, vals
= SCM_EOL
;
569 SCM binding
= CAR (binds
);
570 ASSERT_SYNTAX_2 (scm_ilength (CAR (binds
)) == 2, s_bad_binding
,
572 fluids
= scm_cons (expand (CAR (binding
), env
), fluids
);
573 vals
= scm_cons (expand (CADR (binding
), env
), vals
);
576 return DYNLET (scm_source_properties (expr
),
577 scm_reverse_x (fluids
, SCM_UNDEFINED
),
578 scm_reverse_x (vals
, SCM_UNDEFINED
),
579 expand_sequence (CDDR (expr
), env
));
583 expand_eval_when (SCM expr
, SCM env
)
585 ASSERT_SYNTAX (scm_ilength (expr
) >= 3, s_bad_expression
, expr
);
586 ASSERT_SYNTAX (scm_ilength (CADR (expr
)) > 0, s_bad_expression
, expr
);
588 if (scm_is_true (scm_memq (sym_eval
, CADR (expr
)))
589 || scm_is_true (scm_memq (sym_load
, CADR (expr
))))
590 return expand_sequence (CDDR (expr
), env
);
592 return VOID_ (scm_source_properties (expr
));
596 expand_if (SCM expr
, SCM env SCM_UNUSED
)
598 const SCM cdr_expr
= CDR (expr
);
599 const long length
= scm_ilength (cdr_expr
);
600 ASSERT_SYNTAX (length
== 2 || length
== 3, s_expression
, expr
);
601 return CONDITIONAL (scm_source_properties (expr
),
602 expand (CADR (expr
), env
),
603 expand (CADDR (expr
), env
),
605 ? expand (CADDDR (expr
), env
)
606 : VOID_ (SCM_BOOL_F
)));
609 /* A helper function for expand_lambda to support checking for duplicate
610 * formal arguments: Return true if OBJ is `eq?' to one of the elements of
611 * LIST or to the CDR of the last cons. Therefore, LIST may have any of the
612 * forms that a formal argument can have:
613 * <rest>, (<arg1> ...), (<arg1> ... . <rest>) */
615 c_improper_memq (SCM obj
, SCM list
)
617 for (; scm_is_pair (list
); list
= CDR (list
))
619 if (scm_is_eq (CAR (list
), obj
))
622 return scm_is_eq (list
, obj
);
626 expand_lambda_case (SCM clause
, SCM alternate
, SCM env
)
635 ASSERT_SYNTAX (scm_is_pair (clause
) && scm_is_pair (CDR (clause
)),
636 s_bad_expression
, scm_cons (scm_sym_lambda
, clause
));
638 /* Before iterating the list of formal arguments, make sure the formals
639 * actually are given as either a symbol or a non-cyclic list. */
640 formals
= CAR (clause
);
641 if (scm_is_pair (formals
))
643 /* Dirk:FIXME:: We should check for a cyclic list of formals, and if
644 * detected, report a 'Bad formals' error. */
647 ASSERT_SYNTAX_2 (scm_is_symbol (formals
) || scm_is_null (formals
),
648 s_bad_formals
, formals
, scm_cons (scm_sym_lambda
, clause
));
650 /* Now iterate the list of formal arguments to check if all formals are
651 * symbols, and that there are no duplicates. */
652 while (scm_is_pair (formals
))
654 const SCM formal
= CAR (formals
);
655 formals
= CDR (formals
);
656 ASSERT_SYNTAX_2 (scm_is_symbol (formal
), s_bad_formal
, formal
,
657 scm_cons (scm_sym_lambda
, clause
));
658 ASSERT_SYNTAX_2 (!c_improper_memq (formal
, formals
), s_duplicate_formal
,
659 formal
, scm_cons (scm_sym_lambda
, clause
));
661 req
= scm_cons (formal
, req
);
662 vars
= scm_cons (scm_gensym (SCM_UNDEFINED
), vars
);
663 env
= scm_acons (formal
, CAR (vars
), env
);
666 ASSERT_SYNTAX_2 (scm_is_null (formals
) || scm_is_symbol (formals
),
667 s_bad_formal
, formals
, scm_cons (scm_sym_lambda
, clause
));
668 if (scm_is_symbol (formals
))
671 vars
= scm_cons (scm_gensym (SCM_UNDEFINED
), vars
);
672 env
= scm_acons (rest
, CAR (vars
), env
);
677 body
= expand_sequence (CDR (clause
), env
);
678 req
= scm_reverse_x (req
, SCM_UNDEFINED
);
679 vars
= scm_reverse_x (vars
, SCM_UNDEFINED
);
681 if (scm_is_true (alternate
) && !(SCM_EXPANDED_P (alternate
) && SCM_EXPANDED_TYPE (alternate
) == SCM_EXPANDED_LAMBDA_CASE
))
684 return LAMBDA_CASE (SCM_BOOL_F
, req
, SCM_BOOL_F
, rest
, SCM_BOOL_F
,
685 SCM_EOL
, vars
, body
, alternate
);
689 expand_lambda (SCM expr
, SCM env
)
691 return LAMBDA (scm_source_properties (expr
),
693 expand_lambda_case (CDR (expr
), SCM_BOOL_F
, env
));
697 expand_lambda_star_case (SCM clause
, SCM alternate
, SCM env
)
699 SCM req
, opt
, kw
, allow_other_keys
, rest
, formals
, vars
, body
, tmp
;
703 const long length
= scm_ilength (clause
);
704 ASSERT_SYNTAX (length
>= 1, s_bad_expression
,
705 scm_cons (sym_lambda_star
, clause
));
706 ASSERT_SYNTAX (length
>= 2, s_missing_expression
,
707 scm_cons (sym_lambda_star
, clause
));
709 formals
= CAR (clause
);
713 req
= opt
= kw
= SCM_EOL
;
714 rest
= allow_other_keys
= SCM_BOOL_F
;
716 while (scm_is_pair (formals
) && scm_is_symbol (CAR (formals
)))
719 req
= scm_cons (CAR (formals
), req
);
720 formals
= scm_cdr (formals
);
723 if (scm_is_pair (formals
) && scm_is_eq (CAR (formals
), kw_optional
))
725 formals
= CDR (formals
);
726 while (scm_is_pair (formals
)
727 && (scm_is_symbol (CAR (formals
)) || scm_is_pair (CAR (formals
))))
730 opt
= scm_cons (CAR (formals
), opt
);
731 formals
= scm_cdr (formals
);
735 if (scm_is_pair (formals
) && scm_is_eq (CAR (formals
), kw_key
))
737 formals
= CDR (formals
);
738 while (scm_is_pair (formals
)
739 && (scm_is_symbol (CAR (formals
)) || scm_is_pair (CAR (formals
))))
741 kw
= scm_cons (CAR (formals
), kw
);
742 formals
= scm_cdr (formals
);
746 if (scm_is_pair (formals
) && scm_is_eq (CAR (formals
), kw_allow_other_keys
))
748 formals
= CDR (formals
);
749 allow_other_keys
= SCM_BOOL_T
;
752 if (scm_is_pair (formals
) && scm_is_eq (CAR (formals
), kw_rest
))
754 ASSERT_SYNTAX (scm_ilength (formals
) == 2, s_bad_formals
,
756 rest
= CADR (formals
);
758 else if (scm_is_symbol (formals
))
762 ASSERT_SYNTAX (scm_is_null (formals
), s_bad_formals
, CAR (clause
));
766 /* Now, iterate through them a second time, building up an expansion-time
767 environment, checking, expanding and canonicalizing the opt/kw init forms,
768 and eventually memoizing the body as well. Note that the rest argument, if
769 any, is expanded before keyword args, thus necessitating the second
772 Also note that the specific environment during expansion of init
773 expressions here needs to coincide with the environment when psyntax
774 expands. A lot of effort for something that is only used in the bootstrap
775 expandr, you say? Yes. Yes it is.
779 req
= scm_reverse_x (req
, SCM_EOL
);
780 for (tmp
= req
; scm_is_pair (tmp
); tmp
= scm_cdr (tmp
))
782 vars
= scm_cons (scm_gensym (SCM_UNDEFINED
), vars
);
783 env
= scm_acons (CAR (tmp
), CAR (vars
), env
);
786 /* Build up opt inits and env */
788 opt
= scm_reverse_x (opt
, SCM_EOL
);
789 for (tmp
= opt
; scm_is_pair (tmp
); tmp
= scm_cdr (tmp
))
792 vars
= scm_cons (scm_gensym (SCM_UNDEFINED
), vars
);
793 env
= scm_acons (x
, CAR (vars
), env
);
794 if (scm_is_symbol (x
))
795 inits
= scm_cons (CONST_ (SCM_BOOL_F
, SCM_BOOL_F
), inits
);
798 ASSERT_SYNTAX (scm_ilength (x
) == 2 && scm_is_symbol (CAR (x
)),
799 s_bad_formals
, CAR (clause
));
800 inits
= scm_cons (expand (CADR (x
), env
), inits
);
802 env
= scm_acons (scm_is_symbol (x
) ? x
: CAR (x
), CAR (vars
), env
);
804 if (scm_is_null (opt
))
807 /* Process rest before keyword args */
808 if (scm_is_true (rest
))
810 vars
= scm_cons (scm_gensym (SCM_UNDEFINED
), vars
);
811 env
= scm_acons (rest
, CAR (vars
), env
);
814 /* Build up kw inits, env, and kw-canon list */
815 if (scm_is_null (kw
))
819 SCM kw_canon
= SCM_EOL
;
820 kw
= scm_reverse_x (kw
, SCM_UNDEFINED
);
821 for (tmp
= kw
; scm_is_pair (tmp
); tmp
= scm_cdr (tmp
))
825 if (scm_is_symbol (x
))
829 k
= scm_symbol_to_keyword (sym
);
831 else if (scm_ilength (x
) == 2 && scm_is_symbol (CAR (x
)))
835 k
= scm_symbol_to_keyword (sym
);
837 else if (scm_ilength (x
) == 3 && scm_is_symbol (CAR (x
))
838 && scm_is_keyword (CADDR (x
)))
845 syntax_error (s_bad_formals
, CAR (clause
), SCM_UNDEFINED
);
847 inits
= scm_cons (expand (init
, env
), inits
);
848 vars
= scm_cons (scm_gensym (SCM_UNDEFINED
), vars
);
849 kw_canon
= scm_cons (scm_list_3 (k
, sym
, CAR (vars
)), kw_canon
);
850 env
= scm_acons (sym
, CAR (vars
), env
);
852 kw_canon
= scm_reverse_x (kw_canon
, SCM_UNDEFINED
);
853 kw
= scm_cons (allow_other_keys
, kw_canon
);
856 /* We should check for no duplicates, but given that psyntax does this
857 already, we can punt on it here... */
859 vars
= scm_reverse_x (vars
, SCM_UNDEFINED
);
860 inits
= scm_reverse_x (inits
, SCM_UNDEFINED
);
861 body
= expand_sequence (body
, env
);
863 return LAMBDA_CASE (SCM_BOOL_F
, req
, opt
, rest
, kw
, inits
, vars
, body
,
868 expand_lambda_star (SCM expr
, SCM env
)
870 return LAMBDA (scm_source_properties (expr
),
872 expand_lambda_star_case (CDR (expr
), SCM_BOOL_F
, env
));
876 expand_case_lambda_clauses (SCM expr
, SCM rest
, SCM env
)
880 if (scm_is_pair (rest
))
881 alt
= expand_case_lambda_clauses (CAR (rest
), CDR (rest
), env
);
885 return expand_lambda_case (expr
, alt
, env
);
889 expand_case_lambda (SCM expr
, SCM env
)
891 ASSERT_SYNTAX (scm_is_pair (CDR (expr
)), s_missing_expression
, expr
);
893 return LAMBDA (scm_source_properties (expr
),
895 expand_case_lambda_clauses (CADR (expr
), CDDR (expr
), env
));
899 expand_case_lambda_star_clauses (SCM expr
, SCM rest
, SCM env
)
903 if (scm_is_pair (rest
))
904 alt
= expand_case_lambda_star_clauses (CAR (rest
), CDR (rest
), env
);
908 return expand_lambda_star_case (expr
, alt
, env
);
912 expand_case_lambda_star (SCM expr
, SCM env
)
914 ASSERT_SYNTAX (scm_is_pair (CDR (expr
)), s_missing_expression
, expr
);
916 return LAMBDA (scm_source_properties (expr
),
918 expand_case_lambda_star_clauses (CADR (expr
), CDDR (expr
), env
));
921 /* Check if the format of the bindings is ((<symbol> <init-form>) ...). */
923 check_bindings (const SCM bindings
, const SCM expr
)
927 ASSERT_SYNTAX_2 (scm_ilength (bindings
) >= 0,
928 s_bad_bindings
, bindings
, expr
);
930 binding_idx
= bindings
;
931 for (; !scm_is_null (binding_idx
); binding_idx
= CDR (binding_idx
))
933 SCM name
; /* const */
935 const SCM binding
= CAR (binding_idx
);
936 ASSERT_SYNTAX_2 (scm_ilength (binding
) == 2,
937 s_bad_binding
, binding
, expr
);
939 name
= CAR (binding
);
940 ASSERT_SYNTAX_2 (scm_is_symbol (name
), s_bad_variable
, name
, expr
);
944 /* The bindings, which must have the format ((v1 i1) (v2 i2) ... (vn in)), are
945 * transformed to the lists (vn .. v2 v1) and (i1 i2 ... in). If a duplicate
946 * variable name is detected, an error is signalled. */
948 transform_bindings (const SCM bindings
, const SCM expr
,
949 SCM
*const names
, SCM
*const vars
, SCM
*const initptr
)
951 SCM rnames
= SCM_EOL
;
953 SCM rinits
= SCM_EOL
;
954 SCM binding_idx
= bindings
;
955 for (; !scm_is_null (binding_idx
); binding_idx
= CDR (binding_idx
))
957 const SCM binding
= CAR (binding_idx
);
958 const SCM CDR_binding
= CDR (binding
);
959 const SCM name
= CAR (binding
);
960 ASSERT_SYNTAX_2 (scm_is_false (scm_c_memq (name
, rnames
)),
961 s_duplicate_binding
, name
, expr
);
962 rnames
= scm_cons (name
, rnames
);
963 rvars
= scm_cons (scm_gensym (SCM_UNDEFINED
), rvars
);
964 rinits
= scm_cons (CAR (CDR_binding
), rinits
);
966 *names
= scm_reverse_x (rnames
, SCM_UNDEFINED
);
967 *vars
= scm_reverse_x (rvars
, SCM_UNDEFINED
);
968 *initptr
= scm_reverse_x (rinits
, SCM_UNDEFINED
);
971 /* FIXME: Remove named let in this boot expander. */
973 expand_named_let (const SCM expr
, SCM env
)
975 SCM var_names
, var_syms
, inits
;
979 const SCM cdr_expr
= CDR (expr
);
980 const SCM name
= CAR (cdr_expr
);
981 const SCM cddr_expr
= CDR (cdr_expr
);
982 const SCM bindings
= CAR (cddr_expr
);
983 check_bindings (bindings
, expr
);
985 transform_bindings (bindings
, expr
, &var_names
, &var_syms
, &inits
);
986 name_sym
= scm_gensym (SCM_UNDEFINED
);
987 inner_env
= scm_acons (name
, name_sym
, env
);
988 inner_env
= expand_env_extend (inner_env
, var_names
, var_syms
);
991 (scm_source_properties (expr
), SCM_BOOL_F
,
992 scm_list_1 (name
), scm_list_1 (name_sym
),
993 scm_list_1 (LAMBDA (SCM_BOOL_F
,
995 LAMBDA_CASE (SCM_BOOL_F
, var_names
, SCM_BOOL_F
, SCM_BOOL_F
,
996 SCM_BOOL_F
, SCM_BOOL_F
, var_syms
,
997 expand_sequence (CDDDR (expr
), inner_env
),
999 APPLICATION (SCM_BOOL_F
,
1000 LEXICAL_REF (SCM_BOOL_F
, name
, name_sym
),
1001 expand_exprs (inits
, env
)));
1005 expand_let (SCM expr
, SCM env
)
1009 const SCM cdr_expr
= CDR (expr
);
1010 const long length
= scm_ilength (cdr_expr
);
1011 ASSERT_SYNTAX (length
>= 0, s_bad_expression
, expr
);
1012 ASSERT_SYNTAX (length
>= 2, s_missing_expression
, expr
);
1014 bindings
= CAR (cdr_expr
);
1015 if (scm_is_symbol (bindings
))
1017 ASSERT_SYNTAX (length
>= 3, s_missing_expression
, expr
);
1018 return expand_named_let (expr
, env
);
1021 check_bindings (bindings
, expr
);
1022 if (scm_is_null (bindings
))
1023 return expand_sequence (CDDR (expr
), env
);
1026 SCM var_names
, var_syms
, inits
;
1027 transform_bindings (bindings
, expr
, &var_names
, &var_syms
, &inits
);
1028 return LET (SCM_BOOL_F
,
1029 var_names
, var_syms
, expand_exprs (inits
, env
),
1030 expand_sequence (CDDR (expr
),
1031 expand_env_extend (env
, var_names
,
1037 expand_letrec_helper (SCM expr
, SCM env
, SCM in_order_p
)
1041 const SCM cdr_expr
= CDR (expr
);
1042 const long length
= scm_ilength (cdr_expr
);
1043 ASSERT_SYNTAX (length
>= 0, s_bad_expression
, expr
);
1044 ASSERT_SYNTAX (length
>= 2, s_missing_expression
, expr
);
1046 bindings
= CAR (cdr_expr
);
1047 check_bindings (bindings
, expr
);
1048 if (scm_is_null (bindings
))
1049 return expand_sequence (CDDR (expr
), env
);
1052 SCM var_names
, var_syms
, inits
;
1053 transform_bindings (bindings
, expr
, &var_names
, &var_syms
, &inits
);
1054 env
= expand_env_extend (env
, var_names
, var_syms
);
1055 return LETREC (SCM_BOOL_F
, in_order_p
,
1056 var_names
, var_syms
, expand_exprs (inits
, env
),
1057 expand_sequence (CDDR (expr
), env
));
1062 expand_letrec (SCM expr
, SCM env
)
1064 return expand_letrec_helper (expr
, env
, SCM_BOOL_F
);
1068 expand_letrec_star (SCM expr
, SCM env
)
1070 return expand_letrec_helper (expr
, env
, SCM_BOOL_T
);
1074 expand_letstar_clause (SCM bindings
, SCM body
, SCM env SCM_UNUSED
)
1076 if (scm_is_null (bindings
))
1077 return expand_sequence (body
, env
);
1080 SCM bind
, name
, sym
, init
;
1082 ASSERT_SYNTAX (scm_is_pair (bindings
), s_bad_expression
, bindings
);
1083 bind
= CAR (bindings
);
1084 ASSERT_SYNTAX (scm_ilength (bind
) == 2, s_bad_binding
, bind
);
1086 sym
= scm_gensym (SCM_UNDEFINED
);
1089 return LET (SCM_BOOL_F
, scm_list_1 (name
), scm_list_1 (sym
),
1090 scm_list_1 (expand (init
, env
)),
1091 expand_letstar_clause (CDR (bindings
), body
,
1092 scm_acons (name
, sym
, env
)));
1097 expand_letstar (SCM expr
, SCM env SCM_UNUSED
)
1099 const SCM cdr_expr
= CDR (expr
);
1100 ASSERT_SYNTAX (scm_ilength (cdr_expr
) >= 0, s_bad_expression
, expr
);
1101 ASSERT_SYNTAX (scm_ilength (cdr_expr
) >= 2, s_missing_expression
, expr
);
1103 return expand_letstar_clause (CADR (expr
), CDDR (expr
), env
);
1107 expand_or (SCM expr
, SCM env SCM_UNUSED
)
1109 SCM tail
= CDR (expr
);
1110 const long length
= scm_ilength (tail
);
1112 ASSERT_SYNTAX (length
>= 0, s_bad_expression
, expr
);
1114 if (scm_is_null (CDR (expr
)))
1115 return CONST_ (SCM_BOOL_F
, SCM_BOOL_F
);
1118 SCM tmp
= scm_gensym (SCM_UNDEFINED
);
1119 return LET (SCM_BOOL_F
,
1120 scm_list_1 (tmp
), scm_list_1 (tmp
),
1121 scm_list_1 (expand (CADR (expr
), env
)),
1122 CONDITIONAL (SCM_BOOL_F
,
1123 LEXICAL_REF (SCM_BOOL_F
, tmp
, tmp
),
1124 LEXICAL_REF (SCM_BOOL_F
, tmp
, tmp
),
1125 expand_or (CDR (expr
),
1126 scm_acons (tmp
, tmp
, env
))));
1131 expand_quote (SCM expr
, SCM env SCM_UNUSED
)
1135 const SCM cdr_expr
= CDR (expr
);
1136 ASSERT_SYNTAX (scm_ilength (cdr_expr
) >= 0, s_bad_expression
, expr
);
1137 ASSERT_SYNTAX (scm_ilength (cdr_expr
) == 1, s_expression
, expr
);
1138 quotee
= CAR (cdr_expr
);
1139 return CONST_ (scm_source_properties (expr
), quotee
);
1143 expand_set_x (SCM expr
, SCM env
)
1148 const SCM cdr_expr
= CDR (expr
);
1149 ASSERT_SYNTAX (scm_ilength (cdr_expr
) >= 0, s_bad_expression
, expr
);
1150 ASSERT_SYNTAX (scm_ilength (cdr_expr
) == 2, s_expression
, expr
);
1151 variable
= CAR (cdr_expr
);
1152 vmem
= expand (variable
, env
);
1154 switch (SCM_EXPANDED_TYPE (vmem
))
1156 case SCM_EXPANDED_LEXICAL_REF
:
1157 return LEXICAL_SET (scm_source_properties (expr
),
1158 SCM_EXPANDED_REF (vmem
, LEXICAL_REF
, NAME
),
1159 SCM_EXPANDED_REF (vmem
, LEXICAL_REF
, GENSYM
),
1160 expand (CADDR (expr
), env
));
1161 case SCM_EXPANDED_TOPLEVEL_REF
:
1162 return TOPLEVEL_SET (scm_source_properties (expr
),
1163 SCM_EXPANDED_REF (vmem
, TOPLEVEL_REF
, NAME
),
1164 expand (CADDR (expr
), env
));
1165 case SCM_EXPANDED_MODULE_REF
:
1166 return MODULE_SET (scm_source_properties (expr
),
1167 SCM_EXPANDED_REF (vmem
, MODULE_REF
, MOD
),
1168 SCM_EXPANDED_REF (vmem
, MODULE_REF
, NAME
),
1169 SCM_EXPANDED_REF (vmem
, MODULE_REF
, PUBLIC
),
1170 expand (CADDR (expr
), env
));
1172 syntax_error (s_bad_variable
, variable
, expr
);
1179 /* This is the boot expander. It is later replaced with psyntax's sc-expand. */
1180 SCM_DEFINE (scm_macroexpand
, "macroexpand", 1, 0, 0,
1182 "Expand the expression @var{exp}.")
1183 #define FUNC_NAME s_scm_macroexpand
1185 return expand (exp
, scm_current_module ());
1189 SCM_DEFINE (scm_macroexpanded_p
, "macroexpanded?", 1, 0, 0,
1191 "Return @code{#t} if @var{exp} is an expanded expression.")
1192 #define FUNC_NAME s_scm_macroexpanded_p
1194 return scm_from_bool (SCM_EXPANDED_P (exp
));
1201 #define DEFINE_NAMES(type) \
1203 static const char *fields[] = SCM_EXPANDED_##type##_FIELD_NAMES; \
1204 exp_field_names[SCM_EXPANDED_##type] = fields; \
1205 exp_names[SCM_EXPANDED_##type] = SCM_EXPANDED_##type##_TYPE_NAME; \
1206 exp_nfields[SCM_EXPANDED_##type] = SCM_NUM_EXPANDED_##type##_FIELDS; \
1210 make_exp_vtable (size_t n
)
1212 SCM layout
, printer
, name
, code
, fields
;
1214 layout
= scm_string_to_symbol
1215 (scm_string_append (scm_make_list (scm_from_size_t (exp_nfields
[n
]),
1216 scm_from_locale_string ("pw"))));
1217 printer
= SCM_BOOL_F
;
1218 name
= scm_from_locale_symbol (exp_names
[n
]);
1219 code
= scm_from_size_t (n
);
1222 size_t m
= exp_nfields
[n
];
1224 fields
= scm_cons (scm_from_locale_symbol (exp_field_names
[n
][m
]), fields
);
1227 return scm_c_make_struct (scm_exp_vtable_vtable
, 0, 5,
1228 SCM_UNPACK (layout
), SCM_UNPACK (printer
), SCM_UNPACK (name
),
1229 SCM_UNPACK (code
), SCM_UNPACK (fields
));
1236 SCM exp_vtable_list
= SCM_EOL
;
1238 DEFINE_NAMES (VOID
);
1239 DEFINE_NAMES (CONST
);
1240 DEFINE_NAMES (PRIMITIVE_REF
);
1241 DEFINE_NAMES (LEXICAL_REF
);
1242 DEFINE_NAMES (LEXICAL_SET
);
1243 DEFINE_NAMES (MODULE_REF
);
1244 DEFINE_NAMES (MODULE_SET
);
1245 DEFINE_NAMES (TOPLEVEL_REF
);
1246 DEFINE_NAMES (TOPLEVEL_SET
);
1247 DEFINE_NAMES (TOPLEVEL_DEFINE
);
1248 DEFINE_NAMES (CONDITIONAL
);
1249 DEFINE_NAMES (APPLICATION
);
1250 DEFINE_NAMES (SEQUENCE
);
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"