6 /* Copyright (C) 2010, 2011, 2013
7 * Free Software Foundation, Inc.
9 * This library is free software; you can redistribute it and/or
10 * modify it under the terms of the GNU Lesser General Public License
11 * as published by the Free Software Foundation; either version 3 of
12 * the License, or (at your option) any later version.
14 * This library is distributed in the hope that it will be useful, but
15 * WITHOUT ANY WARRANTY; without even the implied warranty of
16 * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
17 * Lesser General Public License for more details.
19 * You should have received a copy of the GNU Lesser General Public
20 * License along with this library; if not, write to the Free Software
21 * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
27 #include "libguile/__scm.h"
32 #ifdef BUILDING_LIBGUILE
34 /* All private for now. Ask if you want to use this. Surely this should be
35 auto-generated by something; for now I wrangle it with keyboard macros. */
41 SCM_EXPANDED_PRIMITIVE_REF
,
42 SCM_EXPANDED_LEXICAL_REF
,
43 SCM_EXPANDED_LEXICAL_SET
,
44 SCM_EXPANDED_MODULE_REF
,
45 SCM_EXPANDED_MODULE_SET
,
46 SCM_EXPANDED_TOPLEVEL_REF
,
47 SCM_EXPANDED_TOPLEVEL_SET
,
48 SCM_EXPANDED_TOPLEVEL_DEFINE
,
49 SCM_EXPANDED_CONDITIONAL
,
51 SCM_EXPANDED_PRIMCALL
,
54 SCM_EXPANDED_LAMBDA_CASE
,
57 SCM_NUM_EXPANDED_TYPES
,
58 } scm_t_expanded_type
;
67 SCM_INTERNAL SCM scm_exp_vtable_vtable
;
71 SCM_EXPANDED_TYPE_NAME
= scm_vtable_offset_user
,
72 SCM_EXPANDED_TYPE_CODE
,
73 SCM_EXPANDED_TYPE_FIELDS
,
76 #define SCM_EXPANDED_P(x) \
78 && (scm_is_eq (SCM_STRUCT_VTABLE (SCM_STRUCT_VTABLE (x)), scm_exp_vtable_vtable)))
79 #define SCM_EXPANDED_REF(x,type,field) \
80 (scm_struct_ref (x, SCM_I_MAKINUM (SCM_EXPANDED_##type##_##field)))
81 #define SCM_EXPANDED_TYPE(x) \
82 SCM_STRUCT_DATA_REF (SCM_STRUCT_VTABLE (x), SCM_EXPANDED_TYPE_CODE)
88 #define SCM_EXPANDED_VOID_TYPE_NAME "void"
89 #define SCM_EXPANDED_VOID_FIELD_NAMES \
93 SCM_EXPANDED_VOID_SRC
,
94 SCM_NUM_EXPANDED_VOID_FIELDS
,
96 #define SCM_MAKE_EXPANDED_VOID(src) \
97 scm_c_make_struct (exp_vtables[SCM_EXPANDED_VOID], 0, SCM_NUM_EXPANDED_VOID_FIELDS, SCM_UNPACK (src))
99 #define SCM_EXPANDED_CONST_TYPE_NAME "const"
100 #define SCM_EXPANDED_CONST_FIELD_NAMES \
104 SCM_EXPANDED_CONST_SRC
,
105 SCM_EXPANDED_CONST_EXP
,
106 SCM_NUM_EXPANDED_CONST_FIELDS
,
108 #define SCM_MAKE_EXPANDED_CONST(src, exp) \
109 scm_c_make_struct (exp_vtables[SCM_EXPANDED_CONST], 0, SCM_NUM_EXPANDED_CONST_FIELDS, SCM_UNPACK (src), SCM_UNPACK (exp))
111 #define SCM_EXPANDED_PRIMITIVE_REF_TYPE_NAME "primitive-ref"
112 #define SCM_EXPANDED_PRIMITIVE_REF_FIELD_NAMES \
116 SCM_EXPANDED_PRIMITIVE_REF_SRC
,
117 SCM_EXPANDED_PRIMITIVE_REF_NAME
,
118 SCM_NUM_EXPANDED_PRIMITIVE_REF_FIELDS
,
120 #define SCM_MAKE_EXPANDED_PRIMITIVE_REF(src, name) \
121 scm_c_make_struct (exp_vtables[SCM_EXPANDED_PRIMITIVE_REF], 0, SCM_NUM_EXPANDED_PRIMITIVE_REF_FIELDS, SCM_UNPACK (src), SCM_UNPACK (name))
123 #define SCM_EXPANDED_LEXICAL_REF_TYPE_NAME "lexical-ref"
124 #define SCM_EXPANDED_LEXICAL_REF_FIELD_NAMES \
125 { "src", "name", "gensym", }
128 SCM_EXPANDED_LEXICAL_REF_SRC
,
129 SCM_EXPANDED_LEXICAL_REF_NAME
,
130 SCM_EXPANDED_LEXICAL_REF_GENSYM
,
131 SCM_NUM_EXPANDED_LEXICAL_REF_FIELDS
,
133 #define SCM_MAKE_EXPANDED_LEXICAL_REF(src, name, gensym) \
134 scm_c_make_struct (exp_vtables[SCM_EXPANDED_LEXICAL_REF], 0, SCM_NUM_EXPANDED_LEXICAL_REF_FIELDS, SCM_UNPACK (src), SCM_UNPACK (name), SCM_UNPACK (gensym))
136 #define SCM_EXPANDED_LEXICAL_SET_TYPE_NAME "lexical-set"
137 #define SCM_EXPANDED_LEXICAL_SET_FIELD_NAMES \
138 { "src", "name", "gensym", "exp", }
141 SCM_EXPANDED_LEXICAL_SET_SRC
,
142 SCM_EXPANDED_LEXICAL_SET_NAME
,
143 SCM_EXPANDED_LEXICAL_SET_GENSYM
,
144 SCM_EXPANDED_LEXICAL_SET_EXP
,
145 SCM_NUM_EXPANDED_LEXICAL_SET_FIELDS
,
147 #define SCM_MAKE_EXPANDED_LEXICAL_SET(src, name, gensym, exp) \
148 scm_c_make_struct (exp_vtables[SCM_EXPANDED_LEXICAL_SET], 0, SCM_NUM_EXPANDED_LEXICAL_SET_FIELDS, SCM_UNPACK (src), SCM_UNPACK (name), SCM_UNPACK (gensym), SCM_UNPACK (exp))
150 #define SCM_EXPANDED_MODULE_REF_TYPE_NAME "module-ref"
151 #define SCM_EXPANDED_MODULE_REF_FIELD_NAMES \
152 { "src", "mod", "name", "public?", }
155 SCM_EXPANDED_MODULE_REF_SRC
,
156 SCM_EXPANDED_MODULE_REF_MOD
,
157 SCM_EXPANDED_MODULE_REF_NAME
,
158 SCM_EXPANDED_MODULE_REF_PUBLIC
,
159 SCM_NUM_EXPANDED_MODULE_REF_FIELDS
,
161 #define SCM_MAKE_EXPANDED_MODULE_REF(src, mod, name, public) \
162 scm_c_make_struct (exp_vtables[SCM_EXPANDED_MODULE_REF], 0, SCM_NUM_EXPANDED_MODULE_REF_FIELDS, SCM_UNPACK (src), SCM_UNPACK (mod), SCM_UNPACK (name), SCM_UNPACK (public))
164 #define SCM_EXPANDED_MODULE_SET_TYPE_NAME "module-set"
165 #define SCM_EXPANDED_MODULE_SET_FIELD_NAMES \
166 { "src", "mod", "name", "public?", "exp", }
169 SCM_EXPANDED_MODULE_SET_SRC
,
170 SCM_EXPANDED_MODULE_SET_MOD
,
171 SCM_EXPANDED_MODULE_SET_NAME
,
172 SCM_EXPANDED_MODULE_SET_PUBLIC
,
173 SCM_EXPANDED_MODULE_SET_EXP
,
174 SCM_NUM_EXPANDED_MODULE_SET_FIELDS
,
176 #define SCM_MAKE_EXPANDED_MODULE_SET(src, mod, name, public, exp) \
177 scm_c_make_struct (exp_vtables[SCM_EXPANDED_MODULE_SET], 0, SCM_NUM_EXPANDED_MODULE_SET_FIELDS, SCM_UNPACK (src), SCM_UNPACK (mod), SCM_UNPACK (name), SCM_UNPACK (public), SCM_UNPACK (exp))
179 #define SCM_EXPANDED_TOPLEVEL_REF_TYPE_NAME "toplevel-ref"
180 #define SCM_EXPANDED_TOPLEVEL_REF_FIELD_NAMES \
184 SCM_EXPANDED_TOPLEVEL_REF_SRC
,
185 SCM_EXPANDED_TOPLEVEL_REF_NAME
,
186 SCM_NUM_EXPANDED_TOPLEVEL_REF_FIELDS
,
188 #define SCM_MAKE_EXPANDED_TOPLEVEL_REF(src, name) \
189 scm_c_make_struct (exp_vtables[SCM_EXPANDED_TOPLEVEL_REF], 0, SCM_NUM_EXPANDED_TOPLEVEL_REF_FIELDS, SCM_UNPACK (src), SCM_UNPACK (name))
191 #define SCM_EXPANDED_TOPLEVEL_SET_TYPE_NAME "toplevel-set"
192 #define SCM_EXPANDED_TOPLEVEL_SET_FIELD_NAMES \
193 { "src", "name", "exp", }
196 SCM_EXPANDED_TOPLEVEL_SET_SRC
,
197 SCM_EXPANDED_TOPLEVEL_SET_NAME
,
198 SCM_EXPANDED_TOPLEVEL_SET_EXP
,
199 SCM_NUM_EXPANDED_TOPLEVEL_SET_FIELDS
,
201 #define SCM_MAKE_EXPANDED_TOPLEVEL_SET(src, name, exp) \
202 scm_c_make_struct (exp_vtables[SCM_EXPANDED_TOPLEVEL_SET], 0, SCM_NUM_EXPANDED_TOPLEVEL_SET_FIELDS, SCM_UNPACK (src), SCM_UNPACK (name), SCM_UNPACK (exp))
204 #define SCM_EXPANDED_TOPLEVEL_DEFINE_TYPE_NAME "toplevel-define"
205 #define SCM_EXPANDED_TOPLEVEL_DEFINE_FIELD_NAMES \
206 { "src", "name", "exp", }
209 SCM_EXPANDED_TOPLEVEL_DEFINE_SRC
,
210 SCM_EXPANDED_TOPLEVEL_DEFINE_NAME
,
211 SCM_EXPANDED_TOPLEVEL_DEFINE_EXP
,
212 SCM_NUM_EXPANDED_TOPLEVEL_DEFINE_FIELDS
,
214 #define SCM_MAKE_EXPANDED_TOPLEVEL_DEFINE(src, name, exp) \
215 scm_c_make_struct (exp_vtables[SCM_EXPANDED_TOPLEVEL_DEFINE], 0, SCM_NUM_EXPANDED_TOPLEVEL_DEFINE_FIELDS, SCM_UNPACK (src), SCM_UNPACK (name), SCM_UNPACK (exp))
217 #define SCM_EXPANDED_CONDITIONAL_TYPE_NAME "conditional"
218 #define SCM_EXPANDED_CONDITIONAL_FIELD_NAMES \
219 { "src", "test", "consequent", "alternate", }
222 SCM_EXPANDED_CONDITIONAL_SRC
,
223 SCM_EXPANDED_CONDITIONAL_TEST
,
224 SCM_EXPANDED_CONDITIONAL_CONSEQUENT
,
225 SCM_EXPANDED_CONDITIONAL_ALTERNATE
,
226 SCM_NUM_EXPANDED_CONDITIONAL_FIELDS
,
228 #define SCM_MAKE_EXPANDED_CONDITIONAL(src, test, consequent, alternate) \
229 scm_c_make_struct (exp_vtables[SCM_EXPANDED_CONDITIONAL], 0, SCM_NUM_EXPANDED_CONDITIONAL_FIELDS, SCM_UNPACK (src), SCM_UNPACK (test), SCM_UNPACK (consequent), SCM_UNPACK (alternate))
231 #define SCM_EXPANDED_CALL_TYPE_NAME "call"
232 #define SCM_EXPANDED_CALL_FIELD_NAMES \
233 { "src", "proc", "args", }
236 SCM_EXPANDED_CALL_SRC
,
237 SCM_EXPANDED_CALL_PROC
,
238 SCM_EXPANDED_CALL_ARGS
,
239 SCM_NUM_EXPANDED_CALL_FIELDS
,
241 #define SCM_MAKE_EXPANDED_CALL(src, proc, args) \
242 scm_c_make_struct (exp_vtables[SCM_EXPANDED_CALL], 0, SCM_NUM_EXPANDED_CALL_FIELDS, SCM_UNPACK (src), SCM_UNPACK (proc), SCM_UNPACK (args))
244 #define SCM_EXPANDED_PRIMCALL_TYPE_NAME "primcall"
245 #define SCM_EXPANDED_PRIMCALL_FIELD_NAMES \
246 { "src", "name", "args", }
249 SCM_EXPANDED_PRIMCALL_SRC
,
250 SCM_EXPANDED_PRIMCALL_NAME
,
251 SCM_EXPANDED_PRIMCALL_ARGS
,
252 SCM_NUM_EXPANDED_PRIMCALL_FIELDS
,
254 #define SCM_MAKE_EXPANDED_PRIMCALL(src, name, args) \
255 scm_c_make_struct (exp_vtables[SCM_EXPANDED_PRIMCALL], 0, SCM_NUM_EXPANDED_PRIMCALL_FIELDS, SCM_UNPACK (src), SCM_UNPACK (name), SCM_UNPACK (args))
257 #define SCM_EXPANDED_SEQ_TYPE_NAME "seq"
258 #define SCM_EXPANDED_SEQ_FIELD_NAMES \
259 { "src", "head", "tail", }
262 SCM_EXPANDED_SEQ_SRC
,
263 SCM_EXPANDED_SEQ_HEAD
,
264 SCM_EXPANDED_SEQ_TAIL
,
265 SCM_NUM_EXPANDED_SEQ_FIELDS
,
267 #define SCM_MAKE_EXPANDED_SEQ(src, head, tail) \
268 scm_c_make_struct (exp_vtables[SCM_EXPANDED_SEQ], 0, SCM_NUM_EXPANDED_SEQ_FIELDS, SCM_UNPACK (src), SCM_UNPACK (head), SCM_UNPACK (tail))
270 #define SCM_EXPANDED_LAMBDA_TYPE_NAME "lambda"
271 #define SCM_EXPANDED_LAMBDA_FIELD_NAMES \
272 { "src", "meta", "body", }
275 SCM_EXPANDED_LAMBDA_SRC
,
276 SCM_EXPANDED_LAMBDA_META
,
277 SCM_EXPANDED_LAMBDA_BODY
,
278 SCM_NUM_EXPANDED_LAMBDA_FIELDS
,
280 #define SCM_MAKE_EXPANDED_LAMBDA(src, meta, body) \
281 scm_c_make_struct (exp_vtables[SCM_EXPANDED_LAMBDA], 0, SCM_NUM_EXPANDED_LAMBDA_FIELDS, SCM_UNPACK (src), SCM_UNPACK (meta), SCM_UNPACK (body))
283 #define SCM_EXPANDED_LAMBDA_CASE_TYPE_NAME "lambda-case"
284 #define SCM_EXPANDED_LAMBDA_CASE_FIELD_NAMES \
285 { "src", "req", "opt", "rest", "kw", "inits", "gensyms", "body", "alternate", }
288 SCM_EXPANDED_LAMBDA_CASE_SRC
,
289 SCM_EXPANDED_LAMBDA_CASE_REQ
,
290 SCM_EXPANDED_LAMBDA_CASE_OPT
,
291 SCM_EXPANDED_LAMBDA_CASE_REST
,
292 SCM_EXPANDED_LAMBDA_CASE_KW
,
293 SCM_EXPANDED_LAMBDA_CASE_INITS
,
294 SCM_EXPANDED_LAMBDA_CASE_GENSYMS
,
295 SCM_EXPANDED_LAMBDA_CASE_BODY
,
296 SCM_EXPANDED_LAMBDA_CASE_ALTERNATE
,
297 SCM_NUM_EXPANDED_LAMBDA_CASE_FIELDS
,
299 #define SCM_MAKE_EXPANDED_LAMBDA_CASE(src, req, opt, rest, kw, inits, gensyms, body, alternate) \
300 scm_c_make_struct (exp_vtables[SCM_EXPANDED_LAMBDA_CASE], 0, SCM_NUM_EXPANDED_LAMBDA_CASE_FIELDS, SCM_UNPACK (src), SCM_UNPACK (req), SCM_UNPACK (opt), SCM_UNPACK (rest), SCM_UNPACK (kw), SCM_UNPACK (inits), SCM_UNPACK (gensyms), SCM_UNPACK (body), SCM_UNPACK (alternate))
302 #define SCM_EXPANDED_LET_TYPE_NAME "let"
303 #define SCM_EXPANDED_LET_FIELD_NAMES \
304 { "src", "names", "gensyms", "vals", "body", }
307 SCM_EXPANDED_LET_SRC
,
308 SCM_EXPANDED_LET_NAMES
,
309 SCM_EXPANDED_LET_GENSYMS
,
310 SCM_EXPANDED_LET_VALS
,
311 SCM_EXPANDED_LET_BODY
,
312 SCM_NUM_EXPANDED_LET_FIELDS
,
314 #define SCM_MAKE_EXPANDED_LET(src, names, gensyms, vals, body) \
315 scm_c_make_struct (exp_vtables[SCM_EXPANDED_LET], 0, SCM_NUM_EXPANDED_LET_FIELDS, SCM_UNPACK (src), SCM_UNPACK (names), SCM_UNPACK (gensyms), SCM_UNPACK (vals), SCM_UNPACK (body))
317 #define SCM_EXPANDED_LETREC_TYPE_NAME "letrec"
318 #define SCM_EXPANDED_LETREC_FIELD_NAMES \
319 { "src", "in-order?", "names", "gensyms", "vals", "body", }
322 SCM_EXPANDED_LETREC_SRC
,
323 SCM_EXPANDED_LETREC_IN_ORDER_P
,
324 SCM_EXPANDED_LETREC_NAMES
,
325 SCM_EXPANDED_LETREC_GENSYMS
,
326 SCM_EXPANDED_LETREC_VALS
,
327 SCM_EXPANDED_LETREC_BODY
,
328 SCM_NUM_EXPANDED_LETREC_FIELDS
,
330 #define SCM_MAKE_EXPANDED_LETREC(src, in_order_p, names, gensyms, vals, body) \
331 scm_c_make_struct (exp_vtables[SCM_EXPANDED_LETREC], 0, SCM_NUM_EXPANDED_LETREC_FIELDS, SCM_UNPACK (src), SCM_UNPACK (in_order_p), SCM_UNPACK (names), SCM_UNPACK (gensyms), SCM_UNPACK (vals), SCM_UNPACK (body))
333 #endif /* BUILDING_LIBGUILE */
337 SCM_INTERNAL SCM
scm_macroexpand (SCM exp
);
338 SCM_INTERNAL SCM
scm_macroexpanded_p (SCM exp
);
340 SCM_INTERNAL
void scm_init_expand (void);
343 #endif /* SCM_EXPAND_H */