1 /* pkl-ast.c - Abstract Syntax Tree for Poke. */
2
3 /* Copyright (C) 2019, 2020, 2021 Jose E. Marchesi */
4
5 /* This program is free software: you can redistribute it and/or modify
6 * it under the terms of the GNU General Public License as published by
7 * the Free Software Foundation, either version 3 of the License, or
8 * (at your option) any later version.
9 *
10 * This program is distributed in the hope that it will be useful,
11 * but WITHOUT ANY WARRANTY; without even the implied warranty of
12 * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
13 * GNU General Public License for more details.
14 *
15 * You should have received a copy of the GNU General Public License
16 * along with this program. If not, see <http://www.gnu.org/licenses/>.
17 */
18
19 #include <config.h>
20
21 #include <string.h>
22 #include <assert.h>
23 #include <stdlib.h>
24 #include <stdio.h>
25 #include <inttypes.h>
26 #include "string-buffer.h"
27 #include "xalloc.h"
28
29 #include "pvm.h"
30 #include "pvm-alloc.h" /* For pvm_alloc_{add/remove}_gc_roots */
31 #include "pk-utils.h"
32 #include "pkl-ast.h"
33
34 /* Allocate and return a new AST node, with the given CODE. The rest
35 of the node is initialized to zero. */
36
37 static pkl_ast_node
pkl_ast_make_node(pkl_ast ast,enum pkl_ast_code code)38 pkl_ast_make_node (pkl_ast ast,
39 enum pkl_ast_code code)
40 {
41 pkl_ast_node node;
42
43 node = xzalloc (sizeof (union pkl_ast_node));
44 PKL_AST_AST (node) = ast;
45 PKL_AST_CODE (node) = code;
46 PKL_AST_UID (node) = ast->uid++;
47
48 return node;
49 }
50
51 /* Chain AST2 at the end of the tree node chain in AST1. If AST1 is
52 null then it returns AST2. */
53
54 pkl_ast_node
pkl_ast_chainon(pkl_ast_node ast1,pkl_ast_node ast2)55 pkl_ast_chainon (pkl_ast_node ast1, pkl_ast_node ast2)
56 {
57 if (ast1)
58 {
59 pkl_ast_node tmp;
60
61 for (tmp = ast1; PKL_AST_CHAIN (tmp); tmp = PKL_AST_CHAIN (tmp))
62 if (tmp == ast2)
63 abort ();
64
65 PKL_AST_CHAIN (tmp) = ASTREF (ast2);
66 return ast1;
67 }
68
69 return ast2;
70 }
71
72 /* Return the number of elements chained by CHAIN starting at the
73 given AST node. */
74
75 size_t
pkl_ast_chain_length(pkl_ast_node ast)76 pkl_ast_chain_length (pkl_ast_node ast)
77 {
78 pkl_ast_node tmp;
79 size_t nelem = 0;
80
81 for (tmp = ast; tmp; tmp = PKL_AST_CHAIN (tmp))
82 nelem++;
83
84 return nelem;
85 }
86
87 /* Build and return an AST node for an integer constant. */
88
89 pkl_ast_node
pkl_ast_make_integer(pkl_ast ast,uint64_t value)90 pkl_ast_make_integer (pkl_ast ast,
91 uint64_t value)
92 {
93 pkl_ast_node new = pkl_ast_make_node (ast, PKL_AST_INTEGER);
94
95 PKL_AST_INTEGER_VALUE (new) = value;
96 PKL_AST_LITERAL_P (new) = 1;
97
98 return new;
99 }
100
101 /* Build and return an AST node for a string constant. */
102
103 pkl_ast_node
pkl_ast_make_string(pkl_ast ast,const char * str)104 pkl_ast_make_string (pkl_ast ast,
105 const char *str)
106 {
107 pkl_ast_node new = pkl_ast_make_node (ast, PKL_AST_STRING);
108
109 assert (str);
110
111 PKL_AST_STRING_POINTER (new) = xstrdup (str);
112 PKL_AST_STRING_LENGTH (new) = strlen (str);
113 PKL_AST_LITERAL_P (new) = 1;
114
115 return new;
116 }
117
118 /* Build and return an AST node for an identifier. */
119
120 pkl_ast_node
pkl_ast_make_identifier(pkl_ast ast,const char * str)121 pkl_ast_make_identifier (pkl_ast ast,
122 const char *str)
123 {
124 pkl_ast_node id = pkl_ast_make_node (ast, PKL_AST_IDENTIFIER);
125
126 PKL_AST_IDENTIFIER_POINTER (id) = xstrdup (str);
127 PKL_AST_IDENTIFIER_LENGTH (id) = strlen (str);
128
129 return id;
130 }
131
132 /* Build and return an AST node for an enumerator. */
133
134 pkl_ast_node
pkl_ast_make_enumerator(pkl_ast ast,pkl_ast_node identifier,pkl_ast_node value)135 pkl_ast_make_enumerator (pkl_ast ast,
136 pkl_ast_node identifier,
137 pkl_ast_node value)
138 {
139 pkl_ast_node enumerator
140 = pkl_ast_make_node (ast, PKL_AST_ENUMERATOR);
141
142 assert (identifier != NULL);
143
144 PKL_AST_ENUMERATOR_IDENTIFIER (enumerator) = ASTREF (identifier);
145 PKL_AST_ENUMERATOR_VALUE (enumerator) = ASTREF (value);
146
147 return enumerator;
148 }
149
150 /* Build and return an AST node for a conditional expression. */
151
152 pkl_ast_node
pkl_ast_make_cond_exp(pkl_ast ast,pkl_ast_node cond,pkl_ast_node thenexp,pkl_ast_node elseexp)153 pkl_ast_make_cond_exp (pkl_ast ast,
154 pkl_ast_node cond,
155 pkl_ast_node thenexp,
156 pkl_ast_node elseexp)
157 {
158 pkl_ast_node cond_exp
159 = pkl_ast_make_node (ast, PKL_AST_COND_EXP);
160
161 assert (cond && thenexp && elseexp);
162
163 PKL_AST_COND_EXP_COND (cond_exp) = ASTREF (cond);
164 PKL_AST_COND_EXP_THENEXP (cond_exp) = ASTREF (thenexp);
165 PKL_AST_COND_EXP_ELSEEXP (cond_exp) = ASTREF (elseexp);
166
167 PKL_AST_LITERAL_P (cond_exp)
168 = PKL_AST_LITERAL_P (thenexp) && PKL_AST_LITERAL_P (elseexp);
169
170 return cond_exp;
171 }
172
173 /* Build and return an AST node for a binary expression. */
174
175 pkl_ast_node
pkl_ast_make_binary_exp(pkl_ast ast,enum pkl_ast_op code,pkl_ast_node op1,pkl_ast_node op2)176 pkl_ast_make_binary_exp (pkl_ast ast,
177 enum pkl_ast_op code,
178 pkl_ast_node op1,
179 pkl_ast_node op2)
180 {
181 pkl_ast_node exp = pkl_ast_make_node (ast, PKL_AST_EXP);
182
183 assert (op1 && op2);
184
185 PKL_AST_EXP_CODE (exp) = code;
186 PKL_AST_EXP_ATTR (exp) = PKL_AST_ATTR_NONE;
187 PKL_AST_EXP_NUMOPS (exp) = 2;
188 PKL_AST_EXP_OPERAND (exp, 0) = ASTREF (op1);
189 PKL_AST_EXP_OPERAND (exp, 1) = ASTREF (op2);
190
191 PKL_AST_LITERAL_P (exp)
192 = PKL_AST_LITERAL_P (op1) && PKL_AST_LITERAL_P (op2);
193
194 return exp;
195 }
196
197 /* Return the written form of the given attribute code. This returns
198 NULL for PKL_AST_ATTR_NONE */
199
200 const char *
pkl_attr_name(enum pkl_ast_attr attr)201 pkl_attr_name (enum pkl_ast_attr attr)
202 {
203 #define PKL_DEF_ATTR(SYM, STRING) STRING,
204 static const char* attr_names[] =
205 {
206 #include "pkl-attrs.def"
207 NULL
208 };
209 #undef PKL_DEF_ATTR
210
211 return attr_names[attr];
212 }
213
214 /* Build and return an AST node for an unary expression. */
215
216 pkl_ast_node
pkl_ast_make_unary_exp(pkl_ast ast,enum pkl_ast_op code,pkl_ast_node op)217 pkl_ast_make_unary_exp (pkl_ast ast,
218 enum pkl_ast_op code,
219 pkl_ast_node op)
220 {
221 pkl_ast_node exp = pkl_ast_make_node (ast, PKL_AST_EXP);
222
223 PKL_AST_EXP_CODE (exp) = code;
224 PKL_AST_EXP_ATTR (exp) = PKL_AST_ATTR_NONE;
225 PKL_AST_EXP_NUMOPS (exp) = 1;
226 PKL_AST_EXP_OPERAND (exp, 0) = ASTREF (op);
227 PKL_AST_LITERAL_P (exp) = PKL_AST_LITERAL_P (op);
228
229 return exp;
230 }
231
232 /* Build and return an AST node for a function definition. */
233
234 pkl_ast_node
pkl_ast_make_func(pkl_ast ast,pkl_ast_node ret_type,pkl_ast_node args,pkl_ast_node body)235 pkl_ast_make_func (pkl_ast ast, pkl_ast_node ret_type,
236 pkl_ast_node args, pkl_ast_node body)
237 {
238 pkl_ast_node func = pkl_ast_make_node (ast, PKL_AST_FUNC);
239
240 assert (body);
241
242 if (ret_type)
243 PKL_AST_FUNC_RET_TYPE (func) = ASTREF (ret_type);
244 if (args)
245 PKL_AST_FUNC_ARGS (func) = ASTREF (args);
246 PKL_AST_FUNC_BODY (func) = ASTREF (body);
247
248 PKL_AST_FUNC_FIRST_OPT_ARG (func) = NULL;
249 PKL_AST_FUNC_PROGRAM (func) = NULL;
250
251 return func;
252 }
253
254 /* Build and return an AST node for a function definition formal
255 argument. */
256
257 pkl_ast_node
pkl_ast_make_func_arg(pkl_ast ast,pkl_ast_node type,pkl_ast_node identifier,pkl_ast_node initial)258 pkl_ast_make_func_arg (pkl_ast ast, pkl_ast_node type,
259 pkl_ast_node identifier,
260 pkl_ast_node initial)
261 {
262 pkl_ast_node func_arg = pkl_ast_make_node (ast, PKL_AST_FUNC_ARG);
263
264 assert (identifier);
265
266 PKL_AST_FUNC_ARG_TYPE (func_arg) = ASTREF (type);
267 PKL_AST_FUNC_ARG_IDENTIFIER (func_arg) = ASTREF (identifier);
268 if (initial)
269 PKL_AST_FUNC_ARG_INITIAL (func_arg) = ASTREF (initial);
270 PKL_AST_FUNC_ARG_VARARG (func_arg) = 0;
271
272 return func_arg;
273 }
274
275 /* Build and return an AST node for a trimmer. */
276
277 pkl_ast_node
pkl_ast_make_trimmer(pkl_ast ast,pkl_ast_node entity,pkl_ast_node from,pkl_ast_node to,pkl_ast_node addend)278 pkl_ast_make_trimmer (pkl_ast ast, pkl_ast_node entity,
279 pkl_ast_node from, pkl_ast_node to,
280 pkl_ast_node addend)
281 {
282 pkl_ast_node trimmer = pkl_ast_make_node (ast, PKL_AST_TRIMMER);
283
284 assert (!to || !addend);
285
286 PKL_AST_TRIMMER_ENTITY (trimmer) = ASTREF (entity);
287 if (from)
288 PKL_AST_TRIMMER_FROM (trimmer) = ASTREF (from);
289 if (to)
290 PKL_AST_TRIMMER_TO (trimmer) = ASTREF (to);
291 if (addend)
292 PKL_AST_TRIMMER_ADDEND (trimmer) = ASTREF (addend);
293
294 return trimmer;
295 }
296
297 /* Build and return an AST node for an indexer. */
298
299 pkl_ast_node
pkl_ast_make_indexer(pkl_ast ast,pkl_ast_node entity,pkl_ast_node index)300 pkl_ast_make_indexer (pkl_ast ast,
301 pkl_ast_node entity, pkl_ast_node index)
302 {
303 pkl_ast_node indexer = pkl_ast_make_node (ast, PKL_AST_INDEXER);
304
305 assert (entity && index);
306
307 PKL_AST_INDEXER_ENTITY (indexer) = ASTREF (entity);
308 PKL_AST_INDEXER_INDEX (indexer) = ASTREF (index);
309 PKL_AST_LITERAL_P (indexer) = 0;
310
311 return indexer;
312 }
313
314 /* Build and return an AST node for a struct reference. */
315
316 pkl_ast_node
pkl_ast_make_struct_ref(pkl_ast ast,pkl_ast_node sct,pkl_ast_node identifier)317 pkl_ast_make_struct_ref (pkl_ast ast,
318 pkl_ast_node sct, pkl_ast_node identifier)
319 {
320 pkl_ast_node sref = pkl_ast_make_node (ast, PKL_AST_STRUCT_REF);
321
322 assert (sct && identifier);
323
324 PKL_AST_STRUCT_REF_STRUCT (sref) = ASTREF (sct);
325 PKL_AST_STRUCT_REF_IDENTIFIER (sref) = ASTREF (identifier);
326
327 return sref;
328 }
329
330 /* Build and return type AST nodes. */
331
332 static pkl_ast_node
pkl_ast_make_type(pkl_ast ast)333 pkl_ast_make_type (pkl_ast ast)
334 {
335 pkl_ast_node type = pkl_ast_make_node (ast, PKL_AST_TYPE);
336
337 PKL_AST_TYPE_NAME (type) = NULL;
338 PKL_AST_TYPE_COMPLETE (type)
339 = PKL_AST_TYPE_COMPLETE_UNKNOWN;
340 return type;
341 }
342
343 pkl_ast_node
pkl_ast_make_named_type(pkl_ast ast,pkl_ast_node name)344 pkl_ast_make_named_type (pkl_ast ast, pkl_ast_node name)
345 {
346 pkl_ast_node type = pkl_ast_make_type (ast);
347
348 assert (name);
349
350 PKL_AST_TYPE_NAME (type) = ASTREF (name);
351 return type;
352 }
353
354 pkl_ast_node
pkl_ast_make_integral_type(pkl_ast ast,size_t size,int signed_p)355 pkl_ast_make_integral_type (pkl_ast ast, size_t size, int signed_p)
356 {
357 pkl_ast_node type = pkl_ast_make_type (ast);
358
359 assert (signed_p == 0 || signed_p == 1);
360
361 PKL_AST_TYPE_CODE (type) = PKL_TYPE_INTEGRAL;
362 PKL_AST_TYPE_COMPLETE (type)
363 = PKL_AST_TYPE_COMPLETE_YES;
364 PKL_AST_TYPE_I_SIGNED_P (type) = signed_p;
365 PKL_AST_TYPE_I_SIZE (type) = size;
366 return type;
367 }
368
369 pkl_ast_node
pkl_ast_make_array_type(pkl_ast ast,pkl_ast_node etype,pkl_ast_node bound)370 pkl_ast_make_array_type (pkl_ast ast, pkl_ast_node etype, pkl_ast_node bound)
371 {
372 pkl_ast_node type = pkl_ast_make_type (ast);
373
374 assert (etype);
375
376 PKL_AST_TYPE_CODE (type) = PKL_TYPE_ARRAY;
377 PKL_AST_TYPE_A_ETYPE (type) = ASTREF (etype);
378 if (bound)
379 PKL_AST_TYPE_A_BOUND (type) = ASTREF (bound);
380
381 PKL_AST_TYPE_A_MAPPER (type) = PVM_NULL;
382 PKL_AST_TYPE_A_WRITER (type) = PVM_NULL;
383 PKL_AST_TYPE_A_BOUNDER (type) = PVM_NULL;
384 PKL_AST_TYPE_A_CONSTRUCTOR (type) = PVM_NULL;
385 PKL_AST_TYPE_A_PRINTER (type) = PVM_NULL;
386
387 /* The closure slots are GC roots. */
388 pvm_alloc_add_gc_roots (&PKL_AST_TYPE_A_MAPPER (type), 1);
389 pvm_alloc_add_gc_roots (&PKL_AST_TYPE_A_WRITER (type), 1);
390 pvm_alloc_add_gc_roots (&PKL_AST_TYPE_A_BOUNDER (type), 1);
391 pvm_alloc_add_gc_roots (&PKL_AST_TYPE_A_CONSTRUCTOR (type), 1);
392 pvm_alloc_add_gc_roots (&PKL_AST_TYPE_A_PRINTER (type), 1);
393
394 return type;
395 }
396
397 pkl_ast_node
pkl_ast_make_string_type(pkl_ast ast)398 pkl_ast_make_string_type (pkl_ast ast)
399 {
400 pkl_ast_node type = pkl_ast_make_type (ast);
401
402 PKL_AST_TYPE_CODE (type) = PKL_TYPE_STRING;
403 PKL_AST_TYPE_COMPLETE (type)
404 = PKL_AST_TYPE_COMPLETE_NO;
405 return type;
406 }
407
408 pkl_ast_node
pkl_ast_make_void_type(pkl_ast ast)409 pkl_ast_make_void_type (pkl_ast ast)
410 {
411 pkl_ast_node type = pkl_ast_make_type (ast);
412
413 PKL_AST_TYPE_CODE (type) = PKL_TYPE_VOID;
414 PKL_AST_TYPE_COMPLETE (type)
415 = PKL_AST_TYPE_COMPLETE_NO;
416 return type;
417 }
418
419 pkl_ast_node
pkl_ast_make_offset_type(pkl_ast ast,pkl_ast_node base_type,pkl_ast_node unit)420 pkl_ast_make_offset_type (pkl_ast ast,
421 pkl_ast_node base_type,
422 pkl_ast_node unit)
423 {
424 pkl_ast_node type = pkl_ast_make_type (ast);
425
426 assert (base_type && unit);
427
428 PKL_AST_TYPE_CODE (type) = PKL_TYPE_OFFSET;
429 PKL_AST_TYPE_COMPLETE (type)
430 = PKL_AST_TYPE_COMPLETE_YES;
431 PKL_AST_TYPE_O_UNIT (type) = ASTREF (unit);
432 PKL_AST_TYPE_O_BASE_TYPE (type) = ASTREF (base_type);
433
434 return type;
435 }
436
437 pkl_ast_node
pkl_ast_make_struct_type(pkl_ast ast,size_t nelem,size_t nfield,size_t ndecl,pkl_ast_node itype,pkl_ast_node struct_type_elems,int pinned_p,int union_p)438 pkl_ast_make_struct_type (pkl_ast ast,
439 size_t nelem,
440 size_t nfield,
441 size_t ndecl,
442 pkl_ast_node itype,
443 pkl_ast_node struct_type_elems,
444 int pinned_p, int union_p)
445 {
446 pkl_ast_node type = pkl_ast_make_type (ast);
447
448 PKL_AST_TYPE_CODE (type) = PKL_TYPE_STRUCT;
449 PKL_AST_TYPE_S_NELEM (type) = nelem;
450 PKL_AST_TYPE_S_NFIELD (type) = nfield;
451 PKL_AST_TYPE_S_NDECL (type) = ndecl;
452 if (struct_type_elems)
453 PKL_AST_TYPE_S_ELEMS (type) = ASTREF (struct_type_elems);
454 if (itype)
455 PKL_AST_TYPE_S_ITYPE (type) = ASTREF (itype);
456 PKL_AST_TYPE_S_PINNED_P (type) = pinned_p;
457 PKL_AST_TYPE_S_UNION_P (type) = union_p;
458 PKL_AST_TYPE_S_MAPPER (type) = PVM_NULL;
459 PKL_AST_TYPE_S_WRITER (type) = PVM_NULL;
460 PKL_AST_TYPE_S_CONSTRUCTOR (type) = PVM_NULL;
461 PKL_AST_TYPE_S_COMPARATOR (type) = PVM_NULL;
462 PKL_AST_TYPE_S_INTEGRATOR (type) = PVM_NULL;
463 PKL_AST_TYPE_S_PRINTER (type) = PVM_NULL;
464
465 /* The closure slots are GC roots. */
466 pvm_alloc_add_gc_roots (&PKL_AST_TYPE_S_WRITER (type), 1);
467 pvm_alloc_add_gc_roots (&PKL_AST_TYPE_S_MAPPER (type), 1);
468 pvm_alloc_add_gc_roots (&PKL_AST_TYPE_S_CONSTRUCTOR (type), 1);
469 pvm_alloc_add_gc_roots (&PKL_AST_TYPE_S_COMPARATOR (type), 1);
470 pvm_alloc_add_gc_roots (&PKL_AST_TYPE_S_INTEGRATOR (type), 1);
471 pvm_alloc_add_gc_roots (&PKL_AST_TYPE_S_PRINTER (type), 1);
472
473 return type;
474 }
475
476 pkl_ast_node
pkl_ast_make_struct_type_field(pkl_ast ast,pkl_ast_node name,pkl_ast_node type,pkl_ast_node constraint,pkl_ast_node initializer,pkl_ast_node label,int endian,pkl_ast_node optcond)477 pkl_ast_make_struct_type_field (pkl_ast ast,
478 pkl_ast_node name,
479 pkl_ast_node type,
480 pkl_ast_node constraint,
481 pkl_ast_node initializer,
482 pkl_ast_node label,
483 int endian,
484 pkl_ast_node optcond)
485 {
486 pkl_ast_node struct_type_elem
487 = pkl_ast_make_node (ast, PKL_AST_STRUCT_TYPE_FIELD);
488
489 PKL_AST_STRUCT_TYPE_FIELD_NAME (struct_type_elem)
490 = ASTREF (name);
491 PKL_AST_STRUCT_TYPE_FIELD_TYPE (struct_type_elem)
492 = ASTREF (type);
493 if (constraint)
494 PKL_AST_STRUCT_TYPE_FIELD_CONSTRAINT (struct_type_elem)
495 = ASTREF (constraint);
496 if (label)
497 PKL_AST_STRUCT_TYPE_FIELD_LABEL (struct_type_elem)
498 = ASTREF (label);
499 if (optcond)
500 PKL_AST_STRUCT_TYPE_FIELD_OPTCOND (struct_type_elem)
501 = ASTREF (optcond);
502 if (initializer)
503 PKL_AST_STRUCT_TYPE_FIELD_INITIALIZER (struct_type_elem)
504 = ASTREF (initializer);
505
506 PKL_AST_STRUCT_TYPE_FIELD_ENDIAN (struct_type_elem)
507 = endian;
508
509 return struct_type_elem;
510 }
511
512 pkl_ast_node
pkl_ast_make_function_type(pkl_ast ast,pkl_ast_node rtype,size_t narg,pkl_ast_node args)513 pkl_ast_make_function_type (pkl_ast ast, pkl_ast_node rtype,
514 size_t narg, pkl_ast_node args)
515 {
516 pkl_ast_node type = pkl_ast_make_type (ast);
517
518 PKL_AST_TYPE_CODE (type) = PKL_TYPE_FUNCTION;
519 PKL_AST_TYPE_F_RTYPE (type) = ASTREF (rtype);
520 PKL_AST_TYPE_F_NARG (type) = narg;
521 PKL_AST_TYPE_F_ARGS (type) = ASTREF (args);
522 PKL_AST_TYPE_F_VARARG (type) = 0;
523 PKL_AST_TYPE_F_FIRST_OPT_ARG (type) = NULL;
524
525 return type;
526 }
527
528 pkl_ast_node
pkl_ast_make_any_type(pkl_ast ast)529 pkl_ast_make_any_type (pkl_ast ast)
530 {
531 pkl_ast_node type = pkl_ast_make_type (ast);
532 PKL_AST_TYPE_CODE (type) = PKL_TYPE_ANY;
533 return type;
534 }
535
536 pkl_ast_node
pkl_ast_make_func_type_arg(pkl_ast ast,pkl_ast_node type,pkl_ast_node name)537 pkl_ast_make_func_type_arg (pkl_ast ast, pkl_ast_node type,
538 pkl_ast_node name)
539 {
540 pkl_ast_node function_type_arg
541 = pkl_ast_make_node (ast, PKL_AST_FUNC_TYPE_ARG);
542
543 PKL_AST_FUNC_TYPE_ARG_TYPE (function_type_arg)
544 = ASTREF (type);
545 if (name)
546 PKL_AST_FUNC_TYPE_ARG_NAME (function_type_arg)
547 = ASTREF (name);
548 PKL_AST_FUNC_TYPE_ARG_OPTIONAL (function_type_arg) = 0;
549 PKL_AST_FUNC_TYPE_ARG_VARARG (function_type_arg) = 0;
550
551 return function_type_arg;
552 }
553
554 /* Allocate and return a duplicated type AST node. */
555
556 pkl_ast_node
pkl_ast_dup_type(pkl_ast_node type)557 pkl_ast_dup_type (pkl_ast_node type)
558 {
559 pkl_ast_node t, new = pkl_ast_make_type (PKL_AST_AST (type));
560
561 PKL_AST_TYPE_CODE (new) = PKL_AST_TYPE_CODE (type);
562 PKL_AST_TYPE_COMPLETE (new) = PKL_AST_TYPE_COMPLETE (type);
563
564 switch (PKL_AST_TYPE_CODE (type))
565 {
566 case PKL_TYPE_ANY:
567 break;
568 case PKL_TYPE_INTEGRAL:
569 PKL_AST_TYPE_I_SIZE (new) = PKL_AST_TYPE_I_SIZE (type);
570 PKL_AST_TYPE_I_SIGNED_P (new) = PKL_AST_TYPE_I_SIGNED_P (type);
571 break;
572 case PKL_TYPE_ARRAY:
573 {
574 pkl_ast_node etype
575 = pkl_ast_dup_type (PKL_AST_TYPE_A_ETYPE (type));
576 PKL_AST_TYPE_A_BOUND (new) = ASTREF (PKL_AST_TYPE_A_BOUND (type));
577 PKL_AST_TYPE_A_ETYPE (new) = ASTREF (etype);
578 }
579 break;
580 case PKL_TYPE_STRUCT:
581 PKL_AST_TYPE_S_NELEM (new) = PKL_AST_TYPE_S_NELEM (type);
582 PKL_AST_TYPE_S_NFIELD (new) = PKL_AST_TYPE_S_NFIELD (type);
583 PKL_AST_TYPE_S_NDECL (new) = PKL_AST_TYPE_S_NDECL (type);
584 for (t = PKL_AST_TYPE_S_ELEMS (type); t; t = PKL_AST_CHAIN (t))
585 {
586 pkl_ast_node struct_type_elem_name;
587 pkl_ast_node struct_type_elem_type;
588 pkl_ast_node struct_type_elem_constraint;
589 pkl_ast_node struct_type_elem_initializer;
590 pkl_ast_node struct_type_elem_label;
591 pkl_ast_node new_struct_type_elem_name;
592 pkl_ast_node struct_type_elem;
593 pkl_ast_node struct_type_elem_optcond;
594 int struct_type_elem_endian;
595
596 /* Process only struct type fields. XXX But what about
597 declarations? These should also be duplicated. */
598 if (PKL_AST_CODE (t) != PKL_AST_STRUCT_TYPE_FIELD)
599 break;
600
601 struct_type_elem_name = PKL_AST_STRUCT_TYPE_FIELD_NAME (t);
602 struct_type_elem_type = PKL_AST_STRUCT_TYPE_FIELD_TYPE (t);
603 struct_type_elem_constraint = PKL_AST_STRUCT_TYPE_FIELD_CONSTRAINT (t);
604 struct_type_elem_initializer = PKL_AST_STRUCT_TYPE_FIELD_INITIALIZER (t);
605 struct_type_elem_label = PKL_AST_STRUCT_TYPE_FIELD_LABEL (t);
606 struct_type_elem_endian = PKL_AST_STRUCT_TYPE_FIELD_ENDIAN (t);
607 struct_type_elem_optcond = PKL_AST_STRUCT_TYPE_FIELD_OPTCOND (t);
608
609 new_struct_type_elem_name
610 = (struct_type_elem_name
611 ? pkl_ast_make_identifier (PKL_AST_AST (new),
612 PKL_AST_IDENTIFIER_POINTER (struct_type_elem_name))
613 : NULL);
614 struct_type_elem
615 = pkl_ast_make_struct_type_field (PKL_AST_AST (new),
616 new_struct_type_elem_name,
617 pkl_ast_dup_type (struct_type_elem_type),
618 struct_type_elem_constraint,
619 struct_type_elem_initializer,
620 struct_type_elem_label,
621 struct_type_elem_endian,
622 struct_type_elem_optcond);
623
624 PKL_AST_TYPE_S_ELEMS (new)
625 = pkl_ast_chainon (PKL_AST_TYPE_S_ELEMS (new),
626 struct_type_elem);
627 PKL_AST_TYPE_S_ELEMS (new) = ASTREF (PKL_AST_TYPE_S_ELEMS (type));
628 PKL_AST_TYPE_S_PINNED_P (new) = PKL_AST_TYPE_S_PINNED_P (type);
629 PKL_AST_TYPE_S_UNION_P (new) = PKL_AST_TYPE_S_UNION_P (type);
630 }
631 break;
632 case PKL_TYPE_FUNCTION:
633 PKL_AST_TYPE_F_RTYPE (new)
634 = pkl_ast_dup_type (PKL_AST_TYPE_F_RTYPE (type));
635 PKL_AST_TYPE_F_NARG (new) = PKL_AST_TYPE_F_NARG (type);
636 for (t = PKL_AST_TYPE_F_ARGS (type); t; t = PKL_AST_CHAIN (t))
637 {
638 pkl_ast_node fun_type_arg_type
639 = PKL_AST_FUNC_TYPE_ARG_TYPE (t);
640 pkl_ast_node fun_type_arg_name
641 = PKL_AST_FUNC_TYPE_ARG_NAME (t);
642
643 pkl_ast_node function_type_arg
644 = pkl_ast_make_func_type_arg (PKL_AST_AST (new),
645 fun_type_arg_type,
646 fun_type_arg_name);
647 PKL_AST_FUNC_TYPE_ARG_OPTIONAL (function_type_arg)
648 = PKL_AST_FUNC_TYPE_ARG_OPTIONAL (t);
649 PKL_AST_FUNC_TYPE_ARG_VARARG (function_type_arg)
650 = PKL_AST_FUNC_TYPE_ARG_VARARG (t);
651 PKL_AST_TYPE_F_ARGS (new)
652 = pkl_ast_chainon (PKL_AST_TYPE_F_ARGS (new),
653 function_type_arg);
654 PKL_AST_TYPE_F_ARGS (new) = ASTREF (PKL_AST_TYPE_F_ARGS (t));
655 }
656 PKL_AST_TYPE_F_FIRST_OPT_ARG (new)
657 = ASTREF (PKL_AST_TYPE_F_FIRST_OPT_ARG (type));
658 PKL_AST_TYPE_F_VARARG (new)
659 = PKL_AST_TYPE_F_VARARG (type);
660 break;
661 case PKL_TYPE_OFFSET:
662 /* Fallthrough. */
663 case PKL_TYPE_STRING:
664 /* Fallthrough. */
665 default:
666 break;
667 }
668
669 return new;
670 }
671
672 /* Given a struct type node AST and a string in the form BB.CC.CC.xx,
673 check that the intermediate fields are valid struct references, and return
674 the pkl_ast_node corresponding to the type of the latest field CC. */
675
676 pkl_ast_node
pkl_struct_type_traverse(pkl_ast_node type,const char * path)677 pkl_struct_type_traverse (pkl_ast_node type, const char *path)
678 {
679 char *trunk, *sub, *base;
680
681 if (PKL_AST_TYPE_CODE (type) != PKL_TYPE_STRUCT)
682 return NULL;
683
684 trunk = strndup (path, strlen (path) - strlen (strrchr (path, '.')));
685 base = strtok (trunk, ".");
686
687 /* Node in the form XX. Check to silence the compiler about base not used */
688 if (base == NULL)
689 {
690 free (trunk);
691 return type;
692 }
693
694 while ((sub = strtok (NULL, ".")) != NULL)
695 {
696 pkl_ast_node ename;
697 pkl_ast_node etype, t;
698 char *field;
699
700 etype = NULL;
701
702 if (PKL_AST_TYPE_CODE (type) != PKL_TYPE_STRUCT)
703 goto out;
704
705 for (t = PKL_AST_TYPE_S_ELEMS (type); t;
706 t = PKL_AST_CHAIN (t))
707 {
708 if (PKL_AST_CODE (t) == PKL_AST_STRUCT_TYPE_FIELD)
709 {
710 ename = PKL_AST_STRUCT_TYPE_FIELD_NAME (t);
711 etype = PKL_AST_STRUCT_TYPE_FIELD_TYPE (t);
712
713 field = PKL_AST_IDENTIFIER_POINTER (ename);
714
715 if (STREQ (field, sub))
716 {
717 type = etype;
718 break;
719 }
720 }
721 }
722
723 if (type != etype)
724 goto out;
725 }
726
727 free (trunk);
728 return type;
729
730 out:
731 free (trunk);
732 return NULL;
733 }
734
735 /* Return whether the given type AST node corresponds to an exception
736 type. */
737
738 int
pkl_ast_type_is_exception(pkl_ast_node type)739 pkl_ast_type_is_exception (pkl_ast_node type)
740 {
741 pkl_ast_node type_name = PKL_AST_TYPE_NAME (type);
742
743 return (PKL_AST_TYPE_CODE (type) == PKL_TYPE_STRUCT
744 && type_name
745 && STREQ (PKL_AST_IDENTIFIER_POINTER (type_name), "Exception"));
746 }
747
748 /* Remove bounder closures from the given array type. This works
749 recursively for arrays of arrays. */
750
751 void
pkl_ast_array_type_remove_bounders(pkl_ast_node type)752 pkl_ast_array_type_remove_bounders (pkl_ast_node type)
753 {
754 pkl_ast_node etype;
755
756 assert (PKL_AST_TYPE_CODE (type) == PKL_TYPE_ARRAY);
757
758 PKL_AST_TYPE_A_BOUNDER (type) = PVM_NULL;
759
760 for (etype = PKL_AST_TYPE_A_ETYPE (type);
761 PKL_AST_TYPE_CODE (etype) == PKL_TYPE_ARRAY
762 && PKL_AST_TYPE_NAME (etype) == NULL;
763 etype = PKL_AST_TYPE_A_ETYPE (etype))
764 {
765 PKL_AST_TYPE_A_BOUNDER (etype) = PVM_NULL;
766 }
767 }
768
769 /* Return whether two given type AST nodes are equal, i.e. they denote
770 the same type. */
771
772 int
pkl_ast_type_equal_p(pkl_ast_node a,pkl_ast_node b)773 pkl_ast_type_equal_p (pkl_ast_node a, pkl_ast_node b)
774 {
775 if (PKL_AST_TYPE_CODE (a) != PKL_AST_TYPE_CODE (b))
776 return 0;
777
778 switch (PKL_AST_TYPE_CODE (a))
779 {
780 case PKL_TYPE_ANY:
781 return 1;
782 break;
783 case PKL_TYPE_INTEGRAL:
784 return (PKL_AST_TYPE_I_SIZE (a) == PKL_AST_TYPE_I_SIZE (b)
785 && PKL_AST_TYPE_I_SIGNED_P (a) == PKL_AST_TYPE_I_SIGNED_P (b));
786 break;
787 case PKL_TYPE_ARRAY:
788 {
789 /* If the array types denote static arrays, i.e. the array
790 types are bounded by a _constant_ number of elements then
791 we can actually do some control here. */
792 pkl_ast_node ba = PKL_AST_TYPE_A_BOUND (a);
793 pkl_ast_node bb = PKL_AST_TYPE_A_BOUND (b);
794
795 if (ba && bb)
796 {
797 pkl_ast_node tba = PKL_AST_TYPE (ba);
798 pkl_ast_node tbb = PKL_AST_TYPE (bb);
799
800 if (PKL_AST_TYPE_CODE (tba) == PKL_TYPE_INTEGRAL
801 && PKL_AST_CODE (ba) == PKL_AST_INTEGER
802 && PKL_AST_TYPE_CODE (tbb) == PKL_TYPE_INTEGRAL
803 && PKL_AST_CODE (bb) == PKL_AST_INTEGER)
804 {
805 if (PKL_AST_INTEGER_VALUE (ba)
806 != PKL_AST_INTEGER_VALUE (bb))
807 return 0;
808 }
809 }
810
811 return pkl_ast_type_equal_p (PKL_AST_TYPE_A_ETYPE (a),
812 PKL_AST_TYPE_A_ETYPE (b));
813 break;
814 }
815 case PKL_TYPE_STRUCT:
816 {
817 /* Anonymous structs are always unequal. */
818 if (PKL_AST_TYPE_NAME (a) == NULL || PKL_AST_TYPE_NAME (b) == NULL)
819 return 0;
820
821 /* Struct types are compared by name. */
822 return (STREQ (PKL_AST_IDENTIFIER_POINTER (PKL_AST_TYPE_NAME (a)),
823 PKL_AST_IDENTIFIER_POINTER (PKL_AST_TYPE_NAME (b))));
824 break;
825 }
826 case PKL_TYPE_FUNCTION:
827 {
828 pkl_ast_node fa, fb;
829
830 if (PKL_AST_TYPE_F_NARG (a) != PKL_AST_TYPE_F_NARG (b))
831 return 0;
832 for (fa = PKL_AST_TYPE_F_ARGS (a), fb = PKL_AST_TYPE_F_ARGS (b);
833 fa && fb;
834 fa = PKL_AST_CHAIN (fa), fb = PKL_AST_CHAIN (fb))
835 {
836 if (PKL_AST_FUNC_TYPE_ARG_OPTIONAL (fa)
837 != PKL_AST_FUNC_TYPE_ARG_OPTIONAL (fb))
838 return 0;
839
840 if (PKL_AST_FUNC_TYPE_ARG_VARARG (fa)
841 != PKL_AST_FUNC_TYPE_ARG_VARARG (fb))
842 return 0;
843
844 if (!pkl_ast_type_equal_p (PKL_AST_FUNC_TYPE_ARG_TYPE (fa),
845 PKL_AST_FUNC_TYPE_ARG_TYPE (fb)))
846 return 0;
847 }
848 break;
849 }
850 case PKL_TYPE_OFFSET:
851 {
852 pkl_ast_node a_unit = PKL_AST_TYPE_O_UNIT (a);
853 pkl_ast_node b_unit = PKL_AST_TYPE_O_UNIT (b);
854
855 /* If the units of the types are not known yet (because they
856 are identifiers, or whatever then we cannot guarantee the
857 types are the same. */
858 if (PKL_AST_CODE (a_unit) != PKL_AST_INTEGER
859 || PKL_AST_CODE (b_unit) != PKL_AST_INTEGER)
860 return 0;
861
862 return (PKL_AST_INTEGER_VALUE (a_unit) == PKL_AST_INTEGER_VALUE (b_unit)
863 && pkl_ast_type_equal_p (PKL_AST_TYPE_O_BASE_TYPE (a),
864 PKL_AST_TYPE_O_BASE_TYPE (b)));
865 }
866 break;
867 case PKL_TYPE_STRING:
868 /* Fallthrough. */
869 default:
870 break;
871 }
872
873 return 1;
874 }
875
876 /* Return whether the type FT is promoteable to type TT. Note that,
877 unlike pkl_ast_type_equal_p above, this operation is not
878 generally commutative. */
879
880 int
pkl_ast_type_promoteable_p(pkl_ast_node ft,pkl_ast_node tt,int promote_array_of_any)881 pkl_ast_type_promoteable_p (pkl_ast_node ft, pkl_ast_node tt,
882 int promote_array_of_any)
883 {
884 if (pkl_ast_type_equal_p (ft, tt))
885 return 1;
886
887 /* VOID can't be promoted to anything. */
888 if (PKL_AST_TYPE_CODE (ft) == PKL_TYPE_VOID)
889 return 0;
890
891 /* Any type is promoteable to ANY. */
892 if (PKL_AST_TYPE_CODE (tt) == PKL_TYPE_ANY)
893 return 1;
894
895 /* An integral type is promoteable to other integral types. */
896 if (PKL_AST_TYPE_CODE (tt) == PKL_TYPE_INTEGRAL
897 && PKL_AST_TYPE_CODE (ft) == PKL_TYPE_INTEGRAL)
898 return 1;
899
900 /* An offset type is promoteable to other offset types. */
901 if (PKL_AST_TYPE_CODE (tt) == PKL_TYPE_OFFSET
902 && PKL_AST_TYPE_CODE (ft) == PKL_TYPE_OFFSET)
903 return 1;
904
905 /* Any array[] type is promoteable to ANY[]. */
906 if (promote_array_of_any
907 && PKL_AST_TYPE_CODE (ft) == PKL_TYPE_ARRAY
908 && PKL_AST_TYPE_CODE (tt) == PKL_TYPE_ARRAY
909 && PKL_AST_TYPE_CODE (PKL_AST_TYPE_A_ETYPE (tt)) == PKL_TYPE_ANY)
910 return 1;
911
912 /* An array type is promoteable to other array type if the types of
913 the elements are equal. Only length may differ. */
914 if (PKL_AST_TYPE_CODE (ft) == PKL_TYPE_ARRAY
915 && PKL_AST_TYPE_CODE (tt) == PKL_TYPE_ARRAY)
916 {
917 pkl_ast_node ft_bound = PKL_AST_TYPE_A_BOUND (ft);
918 pkl_ast_node tt_bound = PKL_AST_TYPE_A_BOUND (tt);
919 pkl_ast_node ft_etype = PKL_AST_TYPE_A_ETYPE (ft);
920 pkl_ast_node tt_etype = PKL_AST_TYPE_A_ETYPE (tt);
921
922 if (!pkl_ast_type_equal_p (tt_etype, ft_etype))
923 return 0;
924
925 /* Static array types can be handled here. */
926 if (tt_bound && (PKL_AST_CODE (tt_bound) == PKL_AST_INTEGER))
927 {
928 if (!ft_bound || PKL_AST_CODE (ft_bound) != PKL_AST_INTEGER)
929 return 0;
930
931 if (PKL_AST_INTEGER_VALUE (ft_bound)
932 != PKL_AST_INTEGER_VALUE (tt_bound))
933 return 0;
934 }
935
936 return 1;
937 // return pkl_ast_type_promoteable_p (PKL_AST_TYPE_A_ETYPE (ft),
938 // PKL_AST_TYPE_A_ETYPE (tt),
939 // promote_array_of_any);
940 }
941
942 /* A struct type is promoteable to any integral type if the struct
943 itself is integral. */
944 if (PKL_AST_TYPE_CODE (ft) == PKL_TYPE_STRUCT
945 && PKL_AST_TYPE_S_ITYPE (ft)
946 && PKL_AST_TYPE_CODE (tt) == PKL_TYPE_INTEGRAL)
947 return 1;
948
949 return 0;
950 }
951
952 /* Build and return an expression that computes the size of TYPE in
953 bits, as an unsigned 64-bit value. */
954
955 pkl_ast_node
pkl_ast_sizeof_type(pkl_ast ast,pkl_ast_node type)956 pkl_ast_sizeof_type (pkl_ast ast, pkl_ast_node type)
957 {
958 pkl_ast_node res;
959 pkl_ast_node res_type
960 = pkl_ast_make_integral_type (ast, 64, 0);
961 PKL_AST_LOC (res_type) = PKL_AST_LOC (type);
962
963 /* This function should only be called on complete types. */
964 assert (PKL_AST_TYPE_COMPLETE (type)
965 == PKL_AST_TYPE_COMPLETE_YES);
966
967 switch (PKL_AST_TYPE_CODE (type))
968 {
969 case PKL_TYPE_INTEGRAL:
970 {
971 res = pkl_ast_make_integer (ast, PKL_AST_TYPE_I_SIZE (type));
972 PKL_AST_LOC (res) = PKL_AST_LOC (type);
973 PKL_AST_TYPE (res) = ASTREF (res_type);
974 break;
975 }
976 case PKL_TYPE_ARRAY:
977 {
978 pkl_ast_node sizeof_etype
979 = pkl_ast_sizeof_type (ast,
980 PKL_AST_TYPE_A_ETYPE (type));
981 res= pkl_ast_make_binary_exp (ast, PKL_AST_OP_MUL,
982 PKL_AST_TYPE_A_BOUND (type),
983 sizeof_etype);
984 PKL_AST_LOC (res) = PKL_AST_LOC (type);
985 PKL_AST_TYPE (res) = ASTREF (res_type);
986 break;
987 }
988 case PKL_TYPE_STRUCT:
989 {
990 pkl_ast_node t;
991
992 res = pkl_ast_make_integer (ast, 0);
993 PKL_AST_TYPE (res) = ASTREF (res_type);
994 PKL_AST_LOC (res) = PKL_AST_LOC (type);
995
996 for (t = PKL_AST_TYPE_S_ELEMS (type); t; t = PKL_AST_CHAIN (t))
997 {
998 if (PKL_AST_CODE (t) == PKL_AST_STRUCT_TYPE_FIELD)
999 {
1000 pkl_ast_node elem_type;
1001
1002 /* Struct fields with labels are not expected, as these
1003 cannot appear in complete struct types. Ditto for
1004 optional fields. */
1005 assert (PKL_AST_STRUCT_TYPE_FIELD_LABEL (t) == NULL);
1006 assert (PKL_AST_STRUCT_TYPE_FIELD_OPTCOND (t) == NULL);
1007
1008 elem_type = PKL_AST_STRUCT_TYPE_FIELD_TYPE (t);
1009 res = pkl_ast_make_binary_exp (ast, PKL_AST_OP_ADD,
1010 res,
1011 pkl_ast_sizeof_type (ast,
1012 elem_type));
1013 PKL_AST_TYPE (res) = ASTREF (res_type);
1014 PKL_AST_LOC (res) = PKL_AST_LOC (type);
1015 }
1016 }
1017
1018 break;
1019 }
1020 case PKL_TYPE_FUNCTION:
1021 {
1022 /* By convention functions have sizeof 0#b */
1023 res = pkl_ast_make_integer (ast, 0);
1024 PKL_AST_TYPE (res) = ASTREF (res_type);
1025 PKL_AST_LOC (res) = PKL_AST_LOC (type);
1026 break;
1027 }
1028 case PKL_TYPE_OFFSET:
1029 return pkl_ast_sizeof_type (ast, PKL_AST_TYPE_O_BASE_TYPE (type));
1030 break;
1031 case PKL_TYPE_STRING:
1032 default:
1033 assert (0);
1034 break;
1035 }
1036
1037 return res;
1038 }
1039
1040 /* Return 1 if the given TYPE can be mapped in IO. 0 otherwise. */
1041
1042 int
pkl_ast_type_mappable_p(pkl_ast_node type)1043 pkl_ast_type_mappable_p (pkl_ast_node type)
1044 {
1045 switch (PKL_AST_TYPE_CODE (type))
1046 {
1047 case PKL_TYPE_INTEGRAL:
1048 case PKL_TYPE_STRING:
1049 case PKL_TYPE_OFFSET:
1050 case PKL_TYPE_FUNCTION:
1051 return 1;
1052 case PKL_TYPE_ARRAY:
1053 return pkl_ast_type_mappable_p (PKL_AST_TYPE_A_ETYPE (type));
1054 break;
1055 case PKL_TYPE_STRUCT:
1056 {
1057 pkl_ast_node elem;
1058
1059 for (elem = PKL_AST_TYPE_S_ELEMS (type);
1060 elem;
1061 elem = PKL_AST_CHAIN (elem))
1062 {
1063 if (PKL_AST_CODE (elem) == PKL_AST_STRUCT_TYPE_FIELD
1064 && !pkl_ast_type_mappable_p (PKL_AST_STRUCT_TYPE_FIELD_TYPE (elem)))
1065 return 0;
1066 }
1067
1068 return 1;
1069 break;
1070 }
1071 default:
1072 break;
1073 }
1074
1075 return 0;
1076 }
1077
1078 /* Return PKL_AST_TYPE_COMPLETE_YES if the given TYPE is a complete
1079 type. Return PKL_AST_TYPE_COMPLETE_NO otherwise. This function
1080 assumes that the children of TYPE have correct completeness
1081 annotations. */
1082
1083 int
pkl_ast_type_is_complete(pkl_ast_node type)1084 pkl_ast_type_is_complete (pkl_ast_node type)
1085 {
1086 int complete = PKL_AST_TYPE_COMPLETE_UNKNOWN;
1087
1088 switch (PKL_AST_TYPE_CODE (type))
1089 {
1090 /* Integral, offset, function and struct types are always
1091 complete. */
1092 case PKL_TYPE_INTEGRAL:
1093 case PKL_TYPE_OFFSET:
1094 case PKL_TYPE_FUNCTION:
1095 complete = PKL_AST_TYPE_COMPLETE_YES;
1096 break;
1097 /* Other types are never complete. */
1098 case PKL_TYPE_ANY:
1099 case PKL_TYPE_VOID:
1100 case PKL_TYPE_STRING:
1101 complete = PKL_AST_TYPE_COMPLETE_NO;
1102 break;
1103 /* Struct types are complete if their fields are also of
1104 complete types and there are no labels nor optconds. */
1105 case PKL_TYPE_STRUCT:
1106 {
1107 pkl_ast_node elem;
1108
1109 complete = PKL_AST_TYPE_COMPLETE_YES;
1110 for (elem = PKL_AST_TYPE_S_ELEMS (type);
1111 elem;
1112 elem = PKL_AST_CHAIN (elem))
1113 {
1114 if (PKL_AST_CODE (elem) == PKL_AST_STRUCT_TYPE_FIELD
1115 && (PKL_AST_STRUCT_TYPE_FIELD_LABEL (elem)
1116 || PKL_AST_STRUCT_TYPE_FIELD_OPTCOND (elem)
1117 || (pkl_ast_type_is_complete (PKL_AST_STRUCT_TYPE_FIELD_TYPE (elem))
1118 == PKL_AST_TYPE_COMPLETE_NO)))
1119 {
1120 complete = PKL_AST_TYPE_COMPLETE_NO;
1121 break;
1122 }
1123 }
1124 break;
1125 }
1126 /* Array types are complete if the number of elements in the
1127 array are specified and it is a literal expression. */
1128 case PKL_TYPE_ARRAY:
1129 {
1130 pkl_ast_node bound = PKL_AST_TYPE_A_BOUND (type);
1131
1132 if (bound)
1133 {
1134 pkl_ast_node bound_type = PKL_AST_TYPE (bound);
1135
1136 /* The type of the bounding expression should have been
1137 calculated at this point. */
1138 assert (bound_type);
1139
1140 if (PKL_AST_TYPE_CODE (bound_type) == PKL_TYPE_INTEGRAL
1141 && PKL_AST_LITERAL_P (bound))
1142 complete = PKL_AST_TYPE_COMPLETE_YES;
1143 else
1144 complete = PKL_AST_TYPE_COMPLETE_NO;
1145 }
1146 else
1147 complete = PKL_AST_TYPE_COMPLETE_NO;
1148 }
1149 default:
1150 break;
1151 }
1152
1153 assert (complete != PKL_AST_TYPE_COMPLETE_UNKNOWN);
1154 return complete;
1155 }
1156
1157
1158 /* Append the textual description of TYPE to BUFFER. If TYPE is a
1159 named type then its given name is preferred if USE_GIVEN_NAME is
1160 1. */
1161 static void
pkl_type_append_to(pkl_ast_node type,int use_given_name,struct string_buffer * buffer)1162 pkl_type_append_to (pkl_ast_node type, int use_given_name,
1163 struct string_buffer *buffer)
1164 {
1165 assert (PKL_AST_CODE (type) == PKL_AST_TYPE);
1166
1167 /* Use the type's given name, if requested and this specific type
1168 instance is named. */
1169 if (use_given_name
1170 && PKL_AST_TYPE_NAME (type))
1171 {
1172 sb_append (buffer, PKL_AST_IDENTIFIER_POINTER (PKL_AST_TYPE_NAME (type)));
1173 return;
1174 }
1175
1176 /* Otherwise, print a description of the type, as terse as possible
1177 but complete. The descriptions should follow the same
1178 style/syntax/conventions used in both the language specification
1179 and the PVM. */
1180 switch (PKL_AST_TYPE_CODE (type))
1181 {
1182 case PKL_TYPE_ANY:
1183 sb_append (buffer, "any");
1184 break;
1185 case PKL_TYPE_INTEGRAL:
1186 if (!PKL_AST_TYPE_I_SIGNED_P (type))
1187 sb_append (buffer, "u");
1188 sb_appendf (buffer, "int<%zd>", PKL_AST_TYPE_I_SIZE (type));
1189 break;
1190 case PKL_TYPE_VOID:
1191 sb_append (buffer, "void");
1192 break;
1193 case PKL_TYPE_STRING:
1194 sb_append (buffer, "string");
1195 break;
1196 case PKL_TYPE_ARRAY:
1197 {
1198 pkl_ast_node bound = PKL_AST_TYPE_A_BOUND (type);
1199
1200 pkl_type_append_to (PKL_AST_TYPE_A_ETYPE (type), use_given_name,
1201 buffer);
1202 sb_append (buffer, "[");
1203 if (bound != NULL)
1204 {
1205 pkl_ast_node bound_type = PKL_AST_TYPE (bound);
1206
1207 if (bound_type
1208 && PKL_AST_TYPE_CODE (bound_type) == PKL_TYPE_INTEGRAL
1209 && PKL_AST_CODE (bound) == PKL_AST_INTEGER)
1210 {
1211 sb_appendf (buffer, "%" PRIu64, PKL_AST_INTEGER_VALUE (bound));
1212 }
1213 }
1214 sb_append (buffer, "]");
1215 break;
1216 }
1217 case PKL_TYPE_STRUCT:
1218 {
1219 pkl_ast_node t;
1220
1221 sb_append (buffer, "struct {");
1222
1223 for (t = PKL_AST_TYPE_S_ELEMS (type); t;
1224 t = PKL_AST_CHAIN (t))
1225 {
1226 if (PKL_AST_CODE (t) == PKL_AST_STRUCT_TYPE_FIELD)
1227 {
1228 pkl_ast_node ename = PKL_AST_STRUCT_TYPE_FIELD_NAME (t);
1229 pkl_ast_node etype = PKL_AST_STRUCT_TYPE_FIELD_TYPE (t);
1230
1231 pkl_type_append_to (etype, use_given_name, buffer);
1232 if (ename)
1233 {
1234 sb_append (buffer, " ");
1235 sb_append (buffer, PKL_AST_IDENTIFIER_POINTER (ename));
1236 }
1237 sb_append (buffer, ";");
1238 }
1239 }
1240 sb_append (buffer, "}");
1241 break;
1242 }
1243 case PKL_TYPE_FUNCTION:
1244 {
1245 pkl_ast_node t;
1246
1247 if (PKL_AST_TYPE_F_NARG (type) > 0)
1248 {
1249 sb_append (buffer, "(");
1250
1251 for (t = PKL_AST_TYPE_F_ARGS (type); t;
1252 t = PKL_AST_CHAIN (t))
1253 {
1254 pkl_ast_node atype
1255 = PKL_AST_FUNC_TYPE_ARG_TYPE (t);
1256
1257 if (PKL_AST_FUNC_TYPE_ARG_VARARG (t))
1258 sb_append (buffer, "...");
1259 else
1260 {
1261 if (t != PKL_AST_TYPE_F_ARGS (type))
1262 sb_append (buffer, ",");
1263 pkl_type_append_to (atype, use_given_name, buffer);
1264 if (PKL_AST_FUNC_TYPE_ARG_OPTIONAL (t))
1265 sb_append (buffer, "?");
1266 }
1267 }
1268
1269 sb_append (buffer, ")");
1270 }
1271
1272 pkl_type_append_to (PKL_AST_TYPE_F_RTYPE (type), use_given_name,
1273 buffer);
1274 sb_append (buffer, ":");
1275 break;
1276 }
1277 case PKL_TYPE_OFFSET:
1278 {
1279 pkl_ast_node unit = PKL_AST_TYPE_O_UNIT (type);
1280
1281 sb_append (buffer, "offset<");
1282 pkl_type_append_to (PKL_AST_TYPE_O_BASE_TYPE (type), use_given_name,
1283 buffer);
1284 sb_append (buffer, ",");
1285
1286 if (PKL_AST_CODE (unit) == PKL_AST_TYPE)
1287 pkl_type_append_to (unit, use_given_name, buffer);
1288 else if (PKL_AST_CODE (unit) == PKL_AST_IDENTIFIER)
1289 sb_append (buffer, PKL_AST_IDENTIFIER_POINTER (unit));
1290 else if (PKL_AST_CODE (unit) == PKL_AST_INTEGER)
1291 sb_appendf (buffer, "%" PRIu64, PKL_AST_INTEGER_VALUE (unit));
1292 else
1293 assert (0);
1294
1295 sb_append (buffer, ">");
1296 break;
1297 }
1298 case PKL_TYPE_NOTYPE:
1299 default:
1300 assert (0);
1301 break;
1302 }
1303 }
1304
1305 /* Return a string with a textual description of TYPE. If TYPE is a
1306 named type then its given name is preferred if USE_GIVEN_NAME is
1307 1. It is up to the caller to free the string memory. */
1308
1309 char *
pkl_type_str(pkl_ast_node type,int use_given_name)1310 pkl_type_str (pkl_ast_node type, int use_given_name)
1311 {
1312 struct string_buffer buffer;
1313 char *str;
1314
1315 sb_init (&buffer);
1316 pkl_type_append_to (type, use_given_name, &buffer);
1317 str = sb_dupfree (&buffer);
1318 if (str == NULL)
1319 /* The only possible error here is out-of-memory. */
1320 xalloc_die ();
1321 return str;
1322 }
1323
1324 /* Print a textual description of TYPE to the file OUT. If TYPE is a
1325 named type then its given name is preferred if USE_GIVEN_NAME is
1326 1. */
1327
1328 void
pkl_print_type(FILE * out,pkl_ast_node type,int use_given_name)1329 pkl_print_type (FILE *out, pkl_ast_node type, int use_given_name)
1330 {
1331 char *str = pkl_type_str (type, use_given_name);
1332 fputs (str, out);
1333 free (str);
1334 }
1335
1336 /* Return a boolean telling whether the given type function only have
1337 optional arguments, i.e. all arguments have an initializer. */
1338
1339 int
pkl_ast_func_all_optargs(pkl_ast_node type)1340 pkl_ast_func_all_optargs (pkl_ast_node type)
1341 {
1342 pkl_ast_node arg;
1343 int all_optargs = 1;
1344
1345 for (arg = PKL_AST_TYPE_F_ARGS (type); arg; arg = PKL_AST_CHAIN (arg))
1346 {
1347 if (!PKL_AST_FUNC_TYPE_ARG_OPTIONAL (arg))
1348 {
1349 all_optargs = 0;
1350 break;
1351 }
1352 }
1353
1354 return all_optargs;
1355 }
1356
1357 /* Build and return an AST node for an enum. */
1358
1359 pkl_ast_node
pkl_ast_make_enum(pkl_ast ast,pkl_ast_node tag,pkl_ast_node values)1360 pkl_ast_make_enum (pkl_ast ast,
1361 pkl_ast_node tag, pkl_ast_node values)
1362 {
1363 pkl_ast_node enumeration
1364 = pkl_ast_make_node (ast, PKL_AST_ENUM);
1365
1366 assert (tag && values);
1367
1368 PKL_AST_ENUM_TAG (enumeration) = ASTREF (tag);
1369 PKL_AST_ENUM_VALUES (enumeration) = ASTREF (values);
1370
1371 return enumeration;
1372 }
1373
1374 /* Build and return an AST node for an array. */
1375
1376 pkl_ast_node
pkl_ast_make_array(pkl_ast ast,size_t nelem,size_t ninitializer,pkl_ast_node initializers)1377 pkl_ast_make_array (pkl_ast ast,
1378 size_t nelem, size_t ninitializer,
1379 pkl_ast_node initializers)
1380 {
1381 pkl_ast_node array
1382 = pkl_ast_make_node (ast, PKL_AST_ARRAY);
1383
1384 PKL_AST_ARRAY_NELEM (array) = nelem;
1385 PKL_AST_ARRAY_NINITIALIZER (array) = ninitializer;
1386 PKL_AST_ARRAY_INITIALIZERS (array) = ASTREF (initializers);
1387
1388 return array;
1389 }
1390
1391 /* Build and return an AST node for an array element. */
1392
1393 pkl_ast_node
pkl_ast_make_array_initializer(pkl_ast ast,pkl_ast_node index,pkl_ast_node exp)1394 pkl_ast_make_array_initializer (pkl_ast ast,
1395 pkl_ast_node index, pkl_ast_node exp)
1396 {
1397 pkl_ast_node initializer
1398 = pkl_ast_make_node (ast, PKL_AST_ARRAY_INITIALIZER);
1399
1400 PKL_AST_ARRAY_INITIALIZER_INDEX (initializer) = ASTREF (index);
1401 PKL_AST_ARRAY_INITIALIZER_EXP (initializer) = ASTREF (exp);
1402
1403 return initializer;
1404 }
1405
1406 /* Build and return an AST node for a struct. */
1407
1408 pkl_ast_node
pkl_ast_make_struct(pkl_ast ast,size_t nelem,pkl_ast_node elems)1409 pkl_ast_make_struct (pkl_ast ast,
1410 size_t nelem,
1411 pkl_ast_node elems)
1412 {
1413 pkl_ast_node sct = pkl_ast_make_node (ast, PKL_AST_STRUCT);
1414
1415 PKL_AST_STRUCT_NELEM (sct) = nelem;
1416 PKL_AST_STRUCT_FIELDS (sct) = ASTREF (elems);
1417
1418 return sct;
1419 }
1420
1421 /* Build and return an AST node for a struct field. */
1422
1423 pkl_ast_node
pkl_ast_make_struct_field(pkl_ast ast,pkl_ast_node name,pkl_ast_node exp)1424 pkl_ast_make_struct_field (pkl_ast ast,
1425 pkl_ast_node name,
1426 pkl_ast_node exp)
1427 {
1428 pkl_ast_node elem = pkl_ast_make_node (ast, PKL_AST_STRUCT_FIELD);
1429
1430 if (name != NULL)
1431 PKL_AST_STRUCT_FIELD_NAME (elem) = ASTREF (name);
1432 PKL_AST_STRUCT_FIELD_EXP (elem) = ASTREF (exp);
1433
1434 return elem;
1435 }
1436
1437 /* Build and return an AST node for a declaration. */
1438
1439 pkl_ast_node
pkl_ast_make_decl(pkl_ast ast,int kind,pkl_ast_node name,pkl_ast_node initial,const char * source)1440 pkl_ast_make_decl (pkl_ast ast, int kind, pkl_ast_node name,
1441 pkl_ast_node initial, const char *source)
1442 {
1443 pkl_ast_node decl = pkl_ast_make_node (ast, PKL_AST_DECL);
1444
1445 assert (name);
1446
1447 PKL_AST_DECL_KIND (decl) = kind;
1448 PKL_AST_DECL_NAME (decl) = ASTREF (name);
1449 PKL_AST_DECL_INITIAL (decl) = ASTREF (initial);
1450 if (source)
1451 PKL_AST_DECL_SOURCE (decl) = xstrdup (source);
1452
1453 return decl;
1454 }
1455
1456 /* Build and return an AST node for an offset construct. */
1457
1458 pkl_ast_node
pkl_ast_make_offset(pkl_ast ast,pkl_ast_node magnitude,pkl_ast_node unit)1459 pkl_ast_make_offset (pkl_ast ast,
1460 pkl_ast_node magnitude, pkl_ast_node unit)
1461 {
1462 pkl_ast_node offset = pkl_ast_make_node (ast, PKL_AST_OFFSET);
1463
1464 assert (unit);
1465
1466 if (magnitude != NULL)
1467 PKL_AST_OFFSET_MAGNITUDE (offset) = ASTREF (magnitude);
1468 PKL_AST_OFFSET_UNIT (offset) = ASTREF (unit);
1469
1470 return offset;
1471 }
1472
1473 /* Build and return an AST node for a cast. */
1474
1475 pkl_ast_node
pkl_ast_make_cast(pkl_ast ast,pkl_ast_node type,pkl_ast_node exp)1476 pkl_ast_make_cast (pkl_ast ast,
1477 pkl_ast_node type, pkl_ast_node exp)
1478 {
1479 pkl_ast_node cast = pkl_ast_make_node (ast, PKL_AST_CAST);
1480
1481 assert (type && exp);
1482
1483 PKL_AST_CAST_TYPE (cast) = ASTREF (type);
1484 PKL_AST_CAST_EXP (cast) = ASTREF (exp);
1485
1486 return cast;
1487 }
1488
1489 /* Build and return an AST node for an `isa' operation. */
1490
1491 pkl_ast_node
pkl_ast_make_isa(pkl_ast ast,pkl_ast_node type,pkl_ast_node exp)1492 pkl_ast_make_isa (pkl_ast ast,
1493 pkl_ast_node type, pkl_ast_node exp)
1494 {
1495 pkl_ast_node isa = pkl_ast_make_node (ast, PKL_AST_ISA);
1496
1497 assert (type && exp);
1498
1499 PKL_AST_ISA_TYPE (isa) = ASTREF (type);
1500 PKL_AST_ISA_EXP (isa) = ASTREF (exp);
1501
1502 return isa;
1503 }
1504
1505 /* Build and return an AST node for a map. */
1506
1507 pkl_ast_node
pkl_ast_make_map(pkl_ast ast,int strict_p,pkl_ast_node type,pkl_ast_node ios,pkl_ast_node offset)1508 pkl_ast_make_map (pkl_ast ast,
1509 int strict_p,
1510 pkl_ast_node type,
1511 pkl_ast_node ios,
1512 pkl_ast_node offset)
1513 {
1514 pkl_ast_node map = pkl_ast_make_node (ast, PKL_AST_MAP);
1515
1516 assert (type && offset);
1517
1518 PKL_AST_MAP_STRICT_P (map) = strict_p;
1519 PKL_AST_MAP_TYPE (map) = ASTREF (type);
1520 PKL_AST_MAP_IOS (map) = ASTREF (ios);
1521 PKL_AST_MAP_OFFSET (map) = ASTREF (offset);
1522
1523 return map;
1524 }
1525
1526 /* Build and return an AST node for a value constructor. */
1527
1528 pkl_ast_node
pkl_ast_make_cons(pkl_ast ast,pkl_ast_node type,pkl_ast_node value)1529 pkl_ast_make_cons (pkl_ast ast,
1530 pkl_ast_node type, pkl_ast_node value)
1531 {
1532 pkl_ast_node cons = pkl_ast_make_node (ast, PKL_AST_CONS);
1533
1534 assert (type);
1535
1536 PKL_AST_CONS_KIND (cons) = PKL_AST_CONS_KIND_UNKNOWN;
1537 PKL_AST_CONS_TYPE (cons) = ASTREF (type);
1538 PKL_AST_CONS_VALUE (cons) = ASTREF (value);
1539 return cons;
1540 }
1541
1542 /* Build and return an AST node for a function call. */
1543
1544 pkl_ast_node
pkl_ast_make_funcall(pkl_ast ast,pkl_ast_node function,pkl_ast_node args)1545 pkl_ast_make_funcall (pkl_ast ast,
1546 pkl_ast_node function, pkl_ast_node args)
1547 {
1548 pkl_ast_node funcall = pkl_ast_make_node (ast,
1549 PKL_AST_FUNCALL);
1550
1551 assert (function);
1552
1553 PKL_AST_FUNCALL_FUNCTION (funcall) = ASTREF (function);
1554 if (args)
1555 PKL_AST_FUNCALL_ARGS (funcall) = ASTREF (args);
1556 return funcall;
1557 }
1558
1559 /* Build and return an AST node for an actual argument of a function
1560 call. */
1561
1562 pkl_ast_node
pkl_ast_make_funcall_arg(pkl_ast ast,pkl_ast_node exp,pkl_ast_node name)1563 pkl_ast_make_funcall_arg (pkl_ast ast, pkl_ast_node exp,
1564 pkl_ast_node name)
1565 {
1566 pkl_ast_node funcall_arg = pkl_ast_make_node (ast,
1567 PKL_AST_FUNCALL_ARG);
1568
1569 if (exp)
1570 PKL_AST_FUNCALL_ARG_EXP (funcall_arg) = ASTREF (exp);
1571 if (name)
1572 PKL_AST_FUNCALL_ARG_NAME (funcall_arg) = ASTREF (name);
1573 PKL_AST_FUNCALL_ARG_FIRST_VARARG (funcall_arg) = 0;
1574 return funcall_arg;
1575 }
1576
1577 /* Build and return an AST node for a variable reference. */
1578
1579 pkl_ast_node
pkl_ast_make_var(pkl_ast ast,pkl_ast_node name,pkl_ast_node decl,int back,int over)1580 pkl_ast_make_var (pkl_ast ast, pkl_ast_node name,
1581 pkl_ast_node decl, int back, int over)
1582 {
1583 pkl_ast_node var = pkl_ast_make_node (ast, PKL_AST_VAR);
1584
1585 assert (name && decl);
1586
1587 PKL_AST_VAR_NAME (var) = ASTREF (name);
1588 PKL_AST_VAR_DECL (var) = ASTREF (decl);
1589 PKL_AST_VAR_BACK (var) = back;
1590 PKL_AST_VAR_OVER (var) = over;
1591
1592 return var;
1593 }
1594
1595 /* Build and return an AST node for an incrdecr expression. */
1596
1597 pkl_ast_node
pkl_ast_make_incrdecr(pkl_ast ast,pkl_ast_node exp,int order,int sign)1598 pkl_ast_make_incrdecr (pkl_ast ast,
1599 pkl_ast_node exp, int order, int sign)
1600 {
1601 pkl_ast_node incrdecr = pkl_ast_make_node (ast,
1602 PKL_AST_INCRDECR);
1603
1604 assert (order == PKL_AST_ORDER_PRE || order == PKL_AST_ORDER_POST);
1605 assert (sign == PKL_AST_SIGN_INCR || sign == PKL_AST_SIGN_DECR);
1606 assert (exp);
1607
1608 PKL_AST_INCRDECR_EXP (incrdecr) = ASTREF (exp);
1609 PKL_AST_INCRDECR_ORDER (incrdecr) = order;
1610 PKL_AST_INCRDECR_SIGN (incrdecr) = sign;
1611
1612 return incrdecr;
1613 }
1614
1615 /* Build and return an AST node for a lambda expression. */
1616
1617 pkl_ast_node
pkl_ast_make_lambda(pkl_ast ast,pkl_ast_node function)1618 pkl_ast_make_lambda (pkl_ast ast, pkl_ast_node function)
1619 {
1620 pkl_ast_node lambda = pkl_ast_make_node (ast, PKL_AST_LAMBDA);
1621
1622 assert (function);
1623
1624 PKL_AST_LAMBDA_FUNCTION (lambda) = ASTREF (function);
1625 return lambda;
1626 }
1627
1628 /* Build and return an AST node for a compound statement. */
1629
1630 pkl_ast_node
pkl_ast_make_comp_stmt(pkl_ast ast,pkl_ast_node stmts)1631 pkl_ast_make_comp_stmt (pkl_ast ast, pkl_ast_node stmts)
1632 {
1633 pkl_ast_node comp_stmt = pkl_ast_make_node (ast,
1634 PKL_AST_COMP_STMT);
1635
1636 if (stmts)
1637 PKL_AST_COMP_STMT_STMTS (comp_stmt) = ASTREF (stmts);
1638 PKL_AST_COMP_STMT_BUILTIN (comp_stmt) = PKL_AST_BUILTIN_NONE;
1639 return comp_stmt;
1640 }
1641
1642 /* Build and return an AST node for a compiler builtin. */
1643
1644 pkl_ast_node
pkl_ast_make_builtin(pkl_ast ast,int builtin)1645 pkl_ast_make_builtin (pkl_ast ast, int builtin)
1646 {
1647 pkl_ast_node comp_stmt = pkl_ast_make_node (ast,
1648 PKL_AST_COMP_STMT);
1649
1650 PKL_AST_COMP_STMT_BUILTIN (comp_stmt) = builtin;
1651 return comp_stmt;
1652 }
1653
1654 /* Build and return an AST node for an assignment statement. */
1655
1656 pkl_ast_node
pkl_ast_make_ass_stmt(pkl_ast ast,pkl_ast_node lvalue,pkl_ast_node exp)1657 pkl_ast_make_ass_stmt (pkl_ast ast, pkl_ast_node lvalue,
1658 pkl_ast_node exp)
1659 {
1660 pkl_ast_node ass_stmt = pkl_ast_make_node (ast,
1661 PKL_AST_ASS_STMT);
1662
1663 assert (lvalue && exp);
1664
1665 PKL_AST_ASS_STMT_LVALUE (ass_stmt) = ASTREF (lvalue);
1666 PKL_AST_ASS_STMT_EXP (ass_stmt) = ASTREF (exp);
1667
1668 return ass_stmt;
1669 }
1670
1671 /* Build and return an AST node for a conditional statement. */
1672
1673 pkl_ast_node
pkl_ast_make_if_stmt(pkl_ast ast,pkl_ast_node exp,pkl_ast_node then_stmt,pkl_ast_node else_stmt)1674 pkl_ast_make_if_stmt (pkl_ast ast, pkl_ast_node exp,
1675 pkl_ast_node then_stmt, pkl_ast_node else_stmt)
1676 {
1677 pkl_ast_node if_stmt = pkl_ast_make_node (ast, PKL_AST_IF_STMT);
1678
1679 assert (exp && then_stmt);
1680
1681 PKL_AST_IF_STMT_EXP (if_stmt) = ASTREF (exp);
1682 PKL_AST_IF_STMT_THEN_STMT (if_stmt) = ASTREF (then_stmt);
1683 if (else_stmt)
1684 PKL_AST_IF_STMT_ELSE_STMT (if_stmt) = ASTREF (else_stmt);
1685
1686 return if_stmt;
1687 }
1688
1689 /* Build and return an AST node for a loop statement. */
1690
1691 pkl_ast_node
pkl_ast_make_loop_stmt(pkl_ast ast,int kind,pkl_ast_node iterator,pkl_ast_node condition,pkl_ast_node head,pkl_ast_node tail,pkl_ast_node body)1692 pkl_ast_make_loop_stmt (pkl_ast ast,
1693 int kind,
1694 pkl_ast_node iterator,
1695 pkl_ast_node condition,
1696 pkl_ast_node head, pkl_ast_node tail,
1697 pkl_ast_node body)
1698 {
1699 pkl_ast_node loop_stmt
1700 = pkl_ast_make_node (ast, PKL_AST_LOOP_STMT);
1701
1702 assert (body);
1703 assert (kind == PKL_AST_LOOP_STMT_KIND_WHILE
1704 || kind == PKL_AST_LOOP_STMT_KIND_FOR
1705 || kind == PKL_AST_LOOP_STMT_KIND_FOR_IN);
1706
1707 PKL_AST_LOOP_STMT_KIND (loop_stmt) = kind;
1708 if (iterator)
1709 PKL_AST_LOOP_STMT_ITERATOR (loop_stmt)
1710 = ASTREF (iterator);
1711 if (condition)
1712 PKL_AST_LOOP_STMT_CONDITION (loop_stmt)
1713 = ASTREF (condition);
1714 if (head)
1715 PKL_AST_LOOP_STMT_HEAD (loop_stmt) = ASTREF (head);
1716 if (tail)
1717 PKL_AST_LOOP_STMT_TAIL (loop_stmt) = ASTREF (tail);
1718 PKL_AST_LOOP_STMT_BODY (loop_stmt) = ASTREF (body);
1719
1720 return loop_stmt;
1721 }
1722
1723 /* Build and return an AST node for the iterator of a loop
1724 statement. */
1725
1726 pkl_ast_node
pkl_ast_make_loop_stmt_iterator(pkl_ast ast,pkl_ast_node decl,pkl_ast_node container)1727 pkl_ast_make_loop_stmt_iterator (pkl_ast ast, pkl_ast_node decl,
1728 pkl_ast_node container)
1729 {
1730 pkl_ast_node loop_stmt_iterator
1731 = pkl_ast_make_node (ast, PKL_AST_LOOP_STMT_ITERATOR);
1732
1733 assert (decl && container);
1734
1735 PKL_AST_LOOP_STMT_ITERATOR_DECL (loop_stmt_iterator)
1736 = ASTREF (decl);
1737 PKL_AST_LOOP_STMT_ITERATOR_CONTAINER (loop_stmt_iterator)
1738 = ASTREF (container);
1739
1740 return loop_stmt_iterator;
1741 }
1742
1743 /* Build and return an AST node for a return statement. */
1744
1745 pkl_ast_node
pkl_ast_make_return_stmt(pkl_ast ast,pkl_ast_node exp)1746 pkl_ast_make_return_stmt (pkl_ast ast, pkl_ast_node exp)
1747 {
1748 pkl_ast_node return_stmt = pkl_ast_make_node (ast,
1749 PKL_AST_RETURN_STMT);
1750
1751 PKL_AST_RETURN_STMT_EXP (return_stmt) = ASTREF (exp);
1752 return return_stmt;
1753 }
1754
1755 /* Build and return an AST node for a "null statement". */
1756
1757 pkl_ast_node
pkl_ast_make_null_stmt(pkl_ast ast)1758 pkl_ast_make_null_stmt (pkl_ast ast)
1759 {
1760 pkl_ast_node null_stmt = pkl_ast_make_node (ast,
1761 PKL_AST_NULL_STMT);
1762 return null_stmt;
1763 }
1764
1765 /* Build and return an AST node for an "expression statement". */
1766
1767 pkl_ast_node
pkl_ast_make_exp_stmt(pkl_ast ast,pkl_ast_node exp)1768 pkl_ast_make_exp_stmt (pkl_ast ast, pkl_ast_node exp)
1769 {
1770 pkl_ast_node exp_stmt = pkl_ast_make_node (ast,
1771 PKL_AST_EXP_STMT);
1772
1773 assert (exp);
1774
1775 PKL_AST_EXP_STMT_EXP (exp_stmt) = ASTREF (exp);
1776 return exp_stmt;
1777 }
1778
1779 /* Build and return an AST node for a try-until statement. */
1780
1781 pkl_ast_node
pkl_ast_make_try_until_stmt(pkl_ast ast,pkl_ast_node code,pkl_ast_node exp)1782 pkl_ast_make_try_until_stmt (pkl_ast ast, pkl_ast_node code,
1783 pkl_ast_node exp)
1784 {
1785 pkl_ast_node try_until_stmt = pkl_ast_make_node (ast,
1786 PKL_AST_TRY_UNTIL_STMT);
1787
1788 assert (code && exp);
1789
1790 PKL_AST_TRY_UNTIL_STMT_CODE (try_until_stmt) = ASTREF (code);
1791 PKL_AST_TRY_UNTIL_STMT_EXP (try_until_stmt) = ASTREF (exp);
1792
1793 return try_until_stmt;
1794 }
1795
1796 /* Build and return an AST node for a try-catch statement. */
1797
1798 pkl_ast_node
pkl_ast_make_try_catch_stmt(pkl_ast ast,pkl_ast_node code,pkl_ast_node handler,pkl_ast_node arg,pkl_ast_node exp)1799 pkl_ast_make_try_catch_stmt (pkl_ast ast, pkl_ast_node code,
1800 pkl_ast_node handler, pkl_ast_node arg,
1801 pkl_ast_node exp)
1802 {
1803 pkl_ast_node try_catch_stmt = pkl_ast_make_node (ast,
1804 PKL_AST_TRY_CATCH_STMT);
1805
1806 assert (code && handler);
1807 assert (!arg || !exp);
1808
1809 PKL_AST_TRY_CATCH_STMT_CODE (try_catch_stmt) = ASTREF (code);
1810 PKL_AST_TRY_CATCH_STMT_HANDLER (try_catch_stmt) = ASTREF (handler);
1811 if (arg)
1812 PKL_AST_TRY_CATCH_STMT_ARG (try_catch_stmt) = ASTREF (arg);
1813 if (exp)
1814 PKL_AST_TRY_CATCH_STMT_EXP (try_catch_stmt) = ASTREF (exp);
1815
1816 return try_catch_stmt;
1817 }
1818
1819 /* Build and return an AST node for a `print' statement. */
1820
1821 pkl_ast_node
pkl_ast_make_print_stmt(pkl_ast ast,pkl_ast_node fmt,pkl_ast_node args)1822 pkl_ast_make_print_stmt (pkl_ast ast,
1823 pkl_ast_node fmt, pkl_ast_node args)
1824 {
1825 pkl_ast_node print_stmt = pkl_ast_make_node (ast,
1826 PKL_AST_PRINT_STMT);
1827
1828 if (fmt)
1829 PKL_AST_PRINT_STMT_FMT (print_stmt) = ASTREF (fmt);
1830 if (args)
1831 PKL_AST_PRINT_STMT_ARGS (print_stmt) = ASTREF (args);
1832
1833 return print_stmt;
1834 }
1835
1836 /* Build and return an AST node for a `printf' argument. */
1837
1838 pkl_ast_node
pkl_ast_make_print_stmt_arg(pkl_ast ast,pkl_ast_node exp)1839 pkl_ast_make_print_stmt_arg (pkl_ast ast, pkl_ast_node exp)
1840 {
1841 pkl_ast_node print_stmt_arg = pkl_ast_make_node (ast,
1842 PKL_AST_PRINT_STMT_ARG);
1843
1844 if (exp)
1845 PKL_AST_PRINT_STMT_ARG_EXP (print_stmt_arg) = ASTREF (exp);
1846 return print_stmt_arg;
1847 }
1848
1849 /* Build and return an AST node for a `break' statement. */
1850
1851 pkl_ast_node
pkl_ast_make_break_stmt(pkl_ast ast)1852 pkl_ast_make_break_stmt (pkl_ast ast)
1853 {
1854 pkl_ast_node break_stmt = pkl_ast_make_node (ast,
1855 PKL_AST_BREAK_STMT);
1856 return break_stmt;
1857 }
1858
1859 /* Build and return an AST node for a `continue' statement. */
1860
1861 pkl_ast_node
pkl_ast_make_continue_stmt(pkl_ast ast)1862 pkl_ast_make_continue_stmt (pkl_ast ast)
1863 {
1864 pkl_ast_node continue_stmt = pkl_ast_make_node (ast,
1865 PKL_AST_CONTINUE_STMT);
1866 return continue_stmt;
1867 }
1868
1869 /* Build and return an AST node for a `raise' statement. */
1870
1871 pkl_ast_node
pkl_ast_make_raise_stmt(pkl_ast ast,pkl_ast_node exp)1872 pkl_ast_make_raise_stmt (pkl_ast ast, pkl_ast_node exp)
1873 {
1874 pkl_ast_node raise_stmt = pkl_ast_make_node (ast,
1875 PKL_AST_RAISE_STMT);
1876
1877 if (exp)
1878 PKL_AST_RAISE_STMT_EXP (raise_stmt) = ASTREF (exp);
1879 return raise_stmt;
1880 }
1881
1882 /* Build and return an AST node for a PKL program. */
1883
1884 pkl_ast_node
pkl_ast_make_program(pkl_ast ast,pkl_ast_node elems)1885 pkl_ast_make_program (pkl_ast ast, pkl_ast_node elems)
1886 {
1887 pkl_ast_node program
1888 = pkl_ast_make_node (ast, PKL_AST_PROGRAM);
1889
1890 PKL_AST_PROGRAM_ELEMS (program) = ASTREF (elems);
1891 return program;
1892 }
1893
1894 /* Build and return an AST node for a source file change. */
1895
1896 pkl_ast_node
pkl_ast_make_src(pkl_ast ast,const char * filename)1897 pkl_ast_make_src (pkl_ast ast, const char *filename)
1898 {
1899 pkl_ast_node src = pkl_ast_make_node (ast, PKL_AST_SRC);
1900
1901 PKL_AST_SRC_FILENAME (src) = filename ? xstrdup (filename) : NULL;
1902 return src;
1903 }
1904
1905 /* Free the AST nodes linked by PKL_AST_CHAIN. */
1906 void
pkl_ast_node_free_chain(pkl_ast_node ast)1907 pkl_ast_node_free_chain (pkl_ast_node ast)
1908 {
1909 pkl_ast_node n, next;
1910
1911 for (n = ast; n; n = next)
1912 {
1913 next = PKL_AST_CHAIN (n);
1914 pkl_ast_node_free (n);
1915 }
1916 }
1917
1918 /* Free all allocated resources used by AST. Note that nodes marked
1919 as "registered", as well as their children, are not disposed. */
1920
1921 void
pkl_ast_node_free(pkl_ast_node ast)1922 pkl_ast_node_free (pkl_ast_node ast)
1923 {
1924 pkl_ast_node t, n;
1925 size_t i;
1926
1927 if (ast == NULL)
1928 return;
1929
1930 assert (PKL_AST_REFCOUNT (ast) > 0);
1931
1932 if (PKL_AST_REFCOUNT (ast) > 1)
1933 {
1934 PKL_AST_REFCOUNT (ast) -= 1;
1935 return;
1936 }
1937
1938 switch (PKL_AST_CODE (ast))
1939 {
1940 case PKL_AST_PROGRAM:
1941 for (t = PKL_AST_PROGRAM_ELEMS (ast); t; t = n)
1942 {
1943 n = PKL_AST_CHAIN (t);
1944 pkl_ast_node_free (t);
1945 }
1946 break;
1947
1948 case PKL_AST_SRC:
1949 free (PKL_AST_SRC_FILENAME (ast));
1950 break;
1951
1952 case PKL_AST_EXP:
1953
1954 for (i = 0; i < PKL_AST_EXP_NUMOPS (ast); i++)
1955 pkl_ast_node_free (PKL_AST_EXP_OPERAND (ast, i));
1956
1957 break;
1958
1959 case PKL_AST_COND_EXP:
1960
1961 pkl_ast_node_free (PKL_AST_COND_EXP_COND (ast));
1962 pkl_ast_node_free (PKL_AST_COND_EXP_THENEXP (ast));
1963 pkl_ast_node_free (PKL_AST_COND_EXP_ELSEEXP (ast));
1964 break;
1965
1966 case PKL_AST_ENUM:
1967
1968 pkl_ast_node_free (PKL_AST_ENUM_TAG (ast));
1969
1970 for (t = PKL_AST_ENUM_VALUES (ast); t; t = n)
1971 {
1972 n = PKL_AST_CHAIN (t);
1973 pkl_ast_node_free (t);
1974 }
1975
1976 break;
1977
1978 case PKL_AST_ENUMERATOR:
1979
1980 pkl_ast_node_free (PKL_AST_ENUMERATOR_IDENTIFIER (ast));
1981 pkl_ast_node_free (PKL_AST_ENUMERATOR_VALUE (ast));
1982 break;
1983
1984 case PKL_AST_TYPE:
1985
1986 free (PKL_AST_TYPE_NAME (ast));
1987 switch (PKL_AST_TYPE_CODE (ast))
1988 {
1989 case PKL_TYPE_ARRAY:
1990 /* Remove GC roots. */
1991 pvm_alloc_remove_gc_roots (&PKL_AST_TYPE_A_MAPPER (ast), 1);
1992 pvm_alloc_remove_gc_roots (&PKL_AST_TYPE_A_WRITER (ast), 1);
1993 pvm_alloc_remove_gc_roots (&PKL_AST_TYPE_A_BOUNDER (ast), 1);
1994 pvm_alloc_remove_gc_roots (&PKL_AST_TYPE_A_CONSTRUCTOR (ast), 1);
1995 pvm_alloc_remove_gc_roots (&PKL_AST_TYPE_A_PRINTER (ast), 1);
1996
1997 pkl_ast_node_free (PKL_AST_TYPE_A_BOUND (ast));
1998 pkl_ast_node_free (PKL_AST_TYPE_A_ETYPE (ast));
1999 break;
2000 case PKL_TYPE_STRUCT:
2001 /* Remove GC roots. */
2002 pvm_alloc_remove_gc_roots (&PKL_AST_TYPE_S_WRITER (ast), 1);
2003 pvm_alloc_remove_gc_roots (&PKL_AST_TYPE_S_MAPPER (ast), 1);
2004 pvm_alloc_remove_gc_roots (&PKL_AST_TYPE_S_CONSTRUCTOR (ast), 1);
2005 pvm_alloc_remove_gc_roots (&PKL_AST_TYPE_S_COMPARATOR (ast), 1);
2006 pvm_alloc_remove_gc_roots (&PKL_AST_TYPE_S_INTEGRATOR (ast), 1);
2007 pvm_alloc_remove_gc_roots (&PKL_AST_TYPE_S_PRINTER (ast), 1);
2008
2009 for (t = PKL_AST_TYPE_S_ELEMS (ast); t; t = n)
2010 {
2011 n = PKL_AST_CHAIN (t);
2012 pkl_ast_node_free (t);
2013 }
2014 break;
2015 case PKL_TYPE_FUNCTION:
2016 pkl_ast_node_free (PKL_AST_TYPE_F_RTYPE (ast));
2017 pkl_ast_node_free (PKL_AST_TYPE_F_FIRST_OPT_ARG (ast));
2018 for (t = PKL_AST_TYPE_F_ARGS (ast); t; t = n)
2019 {
2020 n = PKL_AST_CHAIN (t);
2021 pkl_ast_node_free (t);
2022 }
2023 break;
2024 case PKL_TYPE_OFFSET:
2025 pkl_ast_node_free (PKL_AST_TYPE_O_UNIT (ast));
2026 pkl_ast_node_free (PKL_AST_TYPE_O_BASE_TYPE (ast));
2027 break;
2028 case PKL_TYPE_INTEGRAL:
2029 case PKL_TYPE_STRING:
2030 default:
2031 break;
2032 }
2033
2034 break;
2035
2036 case PKL_AST_STRUCT_TYPE_FIELD:
2037
2038 pkl_ast_node_free (PKL_AST_STRUCT_TYPE_FIELD_NAME (ast));
2039 pkl_ast_node_free (PKL_AST_STRUCT_TYPE_FIELD_TYPE (ast));
2040 pkl_ast_node_free (PKL_AST_STRUCT_TYPE_FIELD_CONSTRAINT (ast));
2041 pkl_ast_node_free (PKL_AST_STRUCT_TYPE_FIELD_INITIALIZER (ast));
2042 pkl_ast_node_free (PKL_AST_STRUCT_TYPE_FIELD_LABEL (ast));
2043 pkl_ast_node_free (PKL_AST_STRUCT_TYPE_FIELD_OPTCOND (ast));
2044 break;
2045
2046 case PKL_AST_FUNC_TYPE_ARG:
2047
2048 pkl_ast_node_free (PKL_AST_FUNC_TYPE_ARG_TYPE (ast));
2049 pkl_ast_node_free (PKL_AST_FUNC_TYPE_ARG_NAME (ast));
2050 break;
2051
2052 case PKL_AST_INDEXER:
2053
2054 pkl_ast_node_free (PKL_AST_INDEXER_ENTITY (ast));
2055 pkl_ast_node_free (PKL_AST_INDEXER_INDEX (ast));
2056 break;
2057
2058 case PKL_AST_TRIMMER:
2059
2060 pkl_ast_node_free (PKL_AST_TRIMMER_ENTITY (ast));
2061 pkl_ast_node_free (PKL_AST_TRIMMER_FROM (ast));
2062 pkl_ast_node_free (PKL_AST_TRIMMER_TO (ast));
2063 pkl_ast_node_free (PKL_AST_TRIMMER_ADDEND (ast));
2064 break;
2065
2066 case PKL_AST_FUNC:
2067
2068 free (PKL_AST_FUNC_NAME (ast));
2069 pkl_ast_node_free (PKL_AST_FUNC_RET_TYPE (ast));
2070 pkl_ast_node_free (PKL_AST_FUNC_BODY (ast));
2071 pkl_ast_node_free (PKL_AST_FUNC_FIRST_OPT_ARG (ast));
2072 for (t = PKL_AST_FUNC_ARGS (ast); t; t = n)
2073 {
2074 n = PKL_AST_CHAIN (t);
2075 pkl_ast_node_free (t);
2076 }
2077 break;
2078
2079 case PKL_AST_FUNC_ARG:
2080
2081 pkl_ast_node_free (PKL_AST_FUNC_ARG_TYPE (ast));
2082 pkl_ast_node_free (PKL_AST_FUNC_ARG_IDENTIFIER (ast));
2083 pkl_ast_node_free (PKL_AST_FUNC_ARG_INITIAL (ast));
2084 break;
2085
2086 case PKL_AST_STRING:
2087
2088 free (PKL_AST_STRING_POINTER (ast));
2089 break;
2090
2091 case PKL_AST_IDENTIFIER:
2092
2093 free (PKL_AST_IDENTIFIER_POINTER (ast));
2094 break;
2095
2096 case PKL_AST_STRUCT_REF:
2097
2098 pkl_ast_node_free (PKL_AST_STRUCT_REF_STRUCT (ast));
2099 pkl_ast_node_free (PKL_AST_STRUCT_REF_IDENTIFIER (ast));
2100 break;
2101
2102 case PKL_AST_STRUCT_FIELD:
2103
2104 pkl_ast_node_free (PKL_AST_STRUCT_FIELD_NAME (ast));
2105 pkl_ast_node_free (PKL_AST_STRUCT_FIELD_EXP (ast));
2106 break;
2107
2108 case PKL_AST_STRUCT:
2109
2110 for (t = PKL_AST_STRUCT_FIELDS (ast); t; t = n)
2111 {
2112 n = PKL_AST_CHAIN (t);
2113 pkl_ast_node_free (t);
2114 }
2115 break;
2116
2117 case PKL_AST_ARRAY_INITIALIZER:
2118
2119 pkl_ast_node_free (PKL_AST_ARRAY_INITIALIZER_INDEX (ast));
2120 pkl_ast_node_free (PKL_AST_ARRAY_INITIALIZER_EXP (ast));
2121 break;
2122
2123 case PKL_AST_ARRAY:
2124
2125 for (t = PKL_AST_ARRAY_INITIALIZERS (ast); t; t = n)
2126 {
2127 n = PKL_AST_CHAIN (t);
2128 pkl_ast_node_free (t);
2129 }
2130
2131 break;
2132
2133 case PKL_AST_DECL:
2134
2135 free (PKL_AST_DECL_SOURCE (ast));
2136 pkl_ast_node_free (PKL_AST_DECL_NAME (ast));
2137 pkl_ast_node_free (PKL_AST_DECL_INITIAL (ast));
2138 break;
2139
2140 case PKL_AST_OFFSET:
2141
2142 pkl_ast_node_free (PKL_AST_OFFSET_MAGNITUDE (ast));
2143 pkl_ast_node_free (PKL_AST_OFFSET_UNIT (ast));
2144 break;
2145
2146 case PKL_AST_CAST:
2147
2148 pkl_ast_node_free (PKL_AST_CAST_TYPE (ast));
2149 pkl_ast_node_free (PKL_AST_CAST_EXP (ast));
2150 break;
2151
2152 case PKL_AST_ISA:
2153
2154 pkl_ast_node_free (PKL_AST_ISA_TYPE (ast));
2155 pkl_ast_node_free (PKL_AST_ISA_EXP (ast));
2156 break;
2157
2158 case PKL_AST_MAP:
2159
2160 pkl_ast_node_free (PKL_AST_MAP_TYPE (ast));
2161 pkl_ast_node_free (PKL_AST_MAP_IOS (ast));
2162 pkl_ast_node_free (PKL_AST_MAP_OFFSET (ast));
2163 break;
2164
2165 case PKL_AST_CONS:
2166
2167 pkl_ast_node_free (PKL_AST_CONS_TYPE (ast));
2168 pkl_ast_node_free (PKL_AST_CONS_VALUE (ast));
2169 break;
2170
2171 case PKL_AST_FUNCALL:
2172
2173 pkl_ast_node_free (PKL_AST_FUNCALL_FUNCTION (ast));
2174 for (t = PKL_AST_FUNCALL_ARGS (ast); t; t = n)
2175 {
2176 n = PKL_AST_CHAIN (t);
2177 pkl_ast_node_free (t);
2178 }
2179
2180 break;
2181
2182 case PKL_AST_FUNCALL_ARG:
2183
2184 pkl_ast_node_free (PKL_AST_FUNCALL_ARG_EXP (ast));
2185 pkl_ast_node_free (PKL_AST_FUNCALL_ARG_NAME (ast));
2186 break;
2187
2188 case PKL_AST_VAR:
2189
2190 pkl_ast_node_free (PKL_AST_VAR_NAME (ast));
2191 if (!PKL_AST_VAR_IS_RECURSIVE (ast))
2192 pkl_ast_node_free (PKL_AST_VAR_DECL (ast));
2193 break;
2194
2195 case PKL_AST_INCRDECR:
2196
2197 pkl_ast_node_free (PKL_AST_INCRDECR_EXP (ast));
2198 break;
2199
2200 case PKL_AST_LAMBDA:
2201
2202 pkl_ast_node_free (PKL_AST_LAMBDA_FUNCTION (ast));
2203 break;
2204
2205 case PKL_AST_COMP_STMT:
2206
2207 for (t = PKL_AST_COMP_STMT_STMTS (ast); t; t = n)
2208 {
2209 n = PKL_AST_CHAIN (t);
2210 pkl_ast_node_free (t);
2211 }
2212
2213 break;
2214
2215 case PKL_AST_ASS_STMT:
2216
2217 pkl_ast_node_free (PKL_AST_ASS_STMT_LVALUE (ast));
2218 pkl_ast_node_free (PKL_AST_ASS_STMT_EXP (ast));
2219 break;
2220
2221 case PKL_AST_IF_STMT:
2222
2223 pkl_ast_node_free (PKL_AST_IF_STMT_EXP (ast));
2224 pkl_ast_node_free (PKL_AST_IF_STMT_THEN_STMT (ast));
2225 pkl_ast_node_free (PKL_AST_IF_STMT_ELSE_STMT (ast));
2226 break;
2227
2228 case PKL_AST_LOOP_STMT:
2229
2230 pkl_ast_node_free (PKL_AST_LOOP_STMT_ITERATOR (ast));
2231 pkl_ast_node_free (PKL_AST_LOOP_STMT_CONDITION (ast));
2232 pkl_ast_node_free (PKL_AST_LOOP_STMT_BODY (ast));
2233 pkl_ast_node_free (PKL_AST_LOOP_STMT_HEAD (ast));
2234 pkl_ast_node_free (PKL_AST_LOOP_STMT_TAIL (ast));
2235
2236 break;
2237
2238 case PKL_AST_LOOP_STMT_ITERATOR:
2239
2240 pkl_ast_node_free (PKL_AST_LOOP_STMT_ITERATOR_DECL (ast));
2241 pkl_ast_node_free (PKL_AST_LOOP_STMT_ITERATOR_CONTAINER (ast));
2242
2243 break;
2244
2245 case PKL_AST_RETURN_STMT:
2246
2247 pkl_ast_node_free (PKL_AST_RETURN_STMT_EXP (ast));
2248 break;
2249
2250 case PKL_AST_EXP_STMT:
2251
2252 pkl_ast_node_free (PKL_AST_EXP_STMT_EXP (ast));
2253 break;
2254
2255 case PKL_AST_TRY_CATCH_STMT:
2256
2257 pkl_ast_node_free (PKL_AST_TRY_CATCH_STMT_CODE (ast));
2258 pkl_ast_node_free (PKL_AST_TRY_CATCH_STMT_HANDLER (ast));
2259 pkl_ast_node_free (PKL_AST_TRY_CATCH_STMT_ARG (ast));
2260 pkl_ast_node_free (PKL_AST_TRY_CATCH_STMT_EXP (ast));
2261 break;
2262
2263 case PKL_AST_TRY_UNTIL_STMT:
2264
2265 pkl_ast_node_free (PKL_AST_TRY_UNTIL_STMT_CODE (ast));
2266 pkl_ast_node_free (PKL_AST_TRY_UNTIL_STMT_EXP (ast));
2267 break;
2268
2269 case PKL_AST_PRINT_STMT_ARG:
2270 free (PKL_AST_PRINT_STMT_ARG_SUFFIX (ast));
2271 free (PKL_AST_PRINT_STMT_ARG_BEGIN_SC (ast));
2272 free (PKL_AST_PRINT_STMT_ARG_END_SC (ast));
2273 pkl_ast_node_free (PKL_AST_PRINT_STMT_ARG_EXP (ast));
2274 break;
2275
2276 case PKL_AST_PRINT_STMT:
2277 {
2278 free (PKL_AST_PRINT_STMT_PREFIX (ast));
2279 for (t = PKL_AST_PRINT_STMT_ARGS (ast); t; t = n)
2280 {
2281 n = PKL_AST_CHAIN (t);
2282 pkl_ast_node_free (t);
2283 }
2284 for (t = PKL_AST_PRINT_STMT_TYPES (ast); t; t = n)
2285 {
2286 n = PKL_AST_CHAIN (t);
2287 pkl_ast_node_free (t);
2288 }
2289 pkl_ast_node_free (PKL_AST_PRINT_STMT_FMT (ast));
2290 break;
2291 }
2292
2293 case PKL_AST_BREAK_STMT:
2294 case PKL_AST_CONTINUE_STMT:
2295 break;
2296
2297
2298 case PKL_AST_RAISE_STMT:
2299 pkl_ast_node_free (PKL_AST_RAISE_STMT_EXP (ast));
2300 break;
2301
2302 case PKL_AST_NULL_STMT:
2303 break;
2304
2305 case PKL_AST_INTEGER:
2306 break;
2307
2308 default:
2309 assert (0);
2310 }
2311
2312 pkl_ast_node_free (PKL_AST_TYPE (ast));
2313 free (ast);
2314 }
2315
2316 /* Allocate and initialize a new AST and return it. */
2317
2318 pkl_ast
pkl_ast_init(void)2319 pkl_ast_init (void)
2320 {
2321 struct pkl_ast *ast;
2322
2323 /* Allocate a new AST and initialize it to 0. */
2324 ast = xzalloc (sizeof (struct pkl_ast));
2325
2326 return ast;
2327 }
2328
2329 /* Free all the memory allocated to store the nodes of an AST. */
2330
2331 void
pkl_ast_free(pkl_ast ast)2332 pkl_ast_free (pkl_ast ast)
2333 {
2334 if (ast == NULL)
2335 return;
2336
2337 pkl_ast_node_free (ast->ast);
2338 free (ast->buffer);
2339 free (ast->filename);
2340 free (ast);
2341 }
2342
2343 pkl_ast_node
pkl_ast_reverse(pkl_ast_node ast)2344 pkl_ast_reverse (pkl_ast_node ast)
2345 {
2346 pkl_ast_node prev = NULL, decl, next;
2347
2348 ast = ASTDEREF (ast);
2349 for (decl = ast; decl != NULL; decl = next)
2350 {
2351 next = PKL_AST_CHAIN (decl);
2352 next = ASTDEREF (next);
2353 PKL_AST_CHAIN (decl) = ASTREF (prev);
2354 prev = decl;
2355 }
2356
2357 return prev;
2358 }
2359
2360 /* Annotate the break and continue statements within a given entity
2361 (loop or switch or...) with a pointer to the entity and their
2362 lexical nest level within the entity. */
2363
2364 static void
pkl_ast_finish_breaks_1(pkl_ast_node entity,pkl_ast_node stmt,int * nframes)2365 pkl_ast_finish_breaks_1 (pkl_ast_node entity, pkl_ast_node stmt,
2366 int *nframes)
2367 {
2368 /* STMT can be a statement or a declaration. */
2369
2370 switch (PKL_AST_CODE (stmt))
2371 {
2372 case PKL_AST_BREAK_STMT:
2373 PKL_AST_BREAK_STMT_ENTITY (stmt) = entity; /* Note no ASTREF */
2374 PKL_AST_BREAK_STMT_NFRAMES (stmt) = *nframes;
2375 break;
2376 case PKL_AST_CONTINUE_STMT:
2377 PKL_AST_CONTINUE_STMT_ENTITY (stmt) = entity; /* Note no ASTREF */
2378 PKL_AST_CONTINUE_STMT_NFRAMES (stmt) = *nframes;
2379 break;
2380 case PKL_AST_COMP_STMT:
2381 {
2382 pkl_ast_node t;
2383
2384 *nframes += 1;
2385 for (t = PKL_AST_COMP_STMT_STMTS (stmt); t;
2386 t = PKL_AST_CHAIN (t))
2387 pkl_ast_finish_breaks_1 (entity, t, nframes);
2388
2389 /* Pop the frame of the compound itself. */
2390 *nframes -= 1;
2391 break;
2392 }
2393 case PKL_AST_IF_STMT:
2394 pkl_ast_finish_breaks_1 (entity,
2395 PKL_AST_IF_STMT_THEN_STMT (stmt),
2396 nframes);
2397 if (PKL_AST_IF_STMT_ELSE_STMT (stmt))
2398 pkl_ast_finish_breaks_1 (entity,
2399 PKL_AST_IF_STMT_ELSE_STMT (stmt),
2400 nframes);
2401 break;
2402 case PKL_AST_TRY_CATCH_STMT:
2403 pkl_ast_finish_breaks_1 (entity,
2404 PKL_AST_TRY_CATCH_STMT_CODE (stmt),
2405 nframes);
2406 if (PKL_AST_TRY_CATCH_STMT_ARG (stmt))
2407 *nframes += 1;
2408 pkl_ast_finish_breaks_1 (entity,
2409 PKL_AST_TRY_CATCH_STMT_HANDLER (stmt),
2410 nframes);
2411 if (PKL_AST_TRY_CATCH_STMT_ARG (stmt))
2412 *nframes -=1;
2413 break;
2414 case PKL_AST_TRY_UNTIL_STMT:
2415 pkl_ast_finish_breaks_1 (entity,
2416 PKL_AST_TRY_CATCH_STMT_CODE (stmt),
2417 nframes);
2418 break;
2419 case PKL_AST_DECL:
2420 case PKL_AST_RETURN_STMT:
2421 case PKL_AST_LOOP_STMT:
2422 case PKL_AST_LOOP_STMT_ITERATOR:
2423 case PKL_AST_EXP_STMT:
2424 case PKL_AST_ASS_STMT:
2425 case PKL_AST_PRINT_STMT:
2426 case PKL_AST_RAISE_STMT:
2427 case PKL_AST_NULL_STMT:
2428 break;
2429 default:
2430 assert (0);
2431 break;
2432 }
2433 }
2434
2435 void
pkl_ast_finish_breaks(pkl_ast_node entity,pkl_ast_node stmt)2436 pkl_ast_finish_breaks (pkl_ast_node entity, pkl_ast_node stmt)
2437 {
2438 int nframes = 0;
2439 pkl_ast_finish_breaks_1 (entity, stmt, &nframes);
2440 }
2441
2442 pkl_ast_node
pkl_ast_type_incr_step(pkl_ast ast,pkl_ast_node type)2443 pkl_ast_type_incr_step (pkl_ast ast, pkl_ast_node type)
2444 {
2445 pkl_ast_node step = NULL;
2446
2447 assert (PKL_AST_CODE (type) == PKL_AST_TYPE);
2448
2449 switch (PKL_AST_TYPE_CODE (type))
2450 {
2451 case PKL_TYPE_INTEGRAL:
2452 {
2453 /* The obvious step for integral types is 1, of the same
2454 type. */
2455 step = pkl_ast_make_integer (ast, 1);
2456 PKL_AST_TYPE (step) = ASTREF (type);
2457 break;
2458 }
2459 case PKL_TYPE_OFFSET:
2460 {
2461 /* The step for an offset type is one unit. */
2462 pkl_ast_node one = pkl_ast_make_integer (ast, 1);
2463
2464 PKL_AST_TYPE (one) = PKL_AST_TYPE_O_BASE_TYPE (type);
2465 step = pkl_ast_make_offset (ast, one,
2466 PKL_AST_TYPE_O_UNIT (type));
2467 PKL_AST_TYPE (step) = ASTREF (type);
2468 break;
2469 }
2470 default:
2471 break;
2472 }
2473
2474 return step;
2475 }
2476
2477 /* Annotate FUNCTIONs return statements with the function and their
2478 nest level within the function.
2479
2480 XXX: move to handlers in trans1. */
2481
2482 static void
pkl_ast_finish_returns_1(pkl_ast_node function,pkl_ast_node stmt,int * nframes,int * ndrops)2483 pkl_ast_finish_returns_1 (pkl_ast_node function, pkl_ast_node stmt,
2484 int *nframes, int *ndrops)
2485 {
2486 /* STMT can be a statement or a declaration. */
2487
2488 switch (PKL_AST_CODE (stmt))
2489 {
2490 case PKL_AST_RETURN_STMT:
2491 PKL_AST_RETURN_STMT_FUNCTION (stmt) = function; /* Note no ASTREF. */
2492 PKL_AST_RETURN_STMT_NFRAMES (stmt) = *nframes;
2493 PKL_AST_RETURN_STMT_NDROPS (stmt) = *ndrops;
2494 break;
2495 case PKL_AST_COMP_STMT:
2496 {
2497 pkl_ast_node t;
2498
2499 *nframes += 1;
2500 for (t = PKL_AST_COMP_STMT_STMTS (stmt); t;
2501 t = PKL_AST_CHAIN (t))
2502 pkl_ast_finish_returns_1 (function, t, nframes, ndrops);
2503
2504 /* Pop the frame of the compound itself. */
2505 *nframes -= 1;
2506 break;
2507 }
2508 case PKL_AST_IF_STMT:
2509 pkl_ast_finish_returns_1 (function,
2510 PKL_AST_IF_STMT_THEN_STMT (stmt),
2511 nframes, ndrops);
2512 if (PKL_AST_IF_STMT_ELSE_STMT (stmt))
2513 pkl_ast_finish_returns_1 (function,
2514 PKL_AST_IF_STMT_ELSE_STMT (stmt),
2515 nframes, ndrops);
2516 break;
2517 case PKL_AST_LOOP_STMT:
2518 {
2519 if (PKL_AST_LOOP_STMT_ITERATOR (stmt))
2520 *ndrops += 3;
2521 pkl_ast_finish_returns_1 (function,
2522 PKL_AST_LOOP_STMT_BODY (stmt),
2523 nframes, ndrops);
2524 if (PKL_AST_LOOP_STMT_ITERATOR (stmt))
2525 *ndrops -= 3;
2526 break;
2527 }
2528 case PKL_AST_TRY_CATCH_STMT:
2529 pkl_ast_finish_returns_1 (function,
2530 PKL_AST_TRY_CATCH_STMT_CODE (stmt),
2531 nframes, ndrops);
2532 pkl_ast_finish_returns_1 (function,
2533 PKL_AST_TRY_CATCH_STMT_HANDLER (stmt),
2534 nframes, ndrops);
2535 break;
2536 case PKL_AST_TRY_UNTIL_STMT:
2537 pkl_ast_finish_returns_1 (function,
2538 PKL_AST_TRY_UNTIL_STMT_CODE (stmt),
2539 nframes, ndrops);
2540 break;
2541 case PKL_AST_DECL:
2542 case PKL_AST_EXP_STMT:
2543 case PKL_AST_ASS_STMT:
2544 case PKL_AST_PRINT_STMT:
2545 case PKL_AST_BREAK_STMT:
2546 case PKL_AST_CONTINUE_STMT:
2547 case PKL_AST_RAISE_STMT:
2548 case PKL_AST_NULL_STMT:
2549 break;
2550 default:
2551 assert (0);
2552 break;
2553 }
2554 }
2555
2556 void
pkl_ast_finish_returns(pkl_ast_node function)2557 pkl_ast_finish_returns (pkl_ast_node function)
2558 {
2559 int nframes = 0;
2560 int ndrops = 0;
2561 pkl_ast_finish_returns_1 (function, PKL_AST_FUNC_BODY (function),
2562 &nframes, &ndrops);
2563 }
2564
2565 int
pkl_ast_lvalue_p(pkl_ast_node node)2566 pkl_ast_lvalue_p (pkl_ast_node node)
2567 {
2568 switch (PKL_AST_CODE (node))
2569 {
2570 case PKL_AST_VAR:
2571 case PKL_AST_MAP:
2572 /* Variable references and maps can always be used as
2573 l-values. */
2574 return 1;
2575 break;
2576 case PKL_AST_STRUCT_REF:
2577 /* A field reference can be used as a l-value if the referred
2578 struct is itself a l-value. */
2579 return pkl_ast_lvalue_p (PKL_AST_STRUCT_REF_STRUCT (node));
2580 break;
2581 case PKL_AST_INDEXER:
2582 /* An indexer can be used as a l-value if the referred entity is
2583 an array, and it is itself a l-value. */
2584 {
2585 pkl_ast_node entity = PKL_AST_INDEXER_ENTITY (node);
2586 pkl_ast_node entity_type = PKL_AST_TYPE (entity);
2587
2588 if (PKL_AST_TYPE_CODE (entity_type) == PKL_TYPE_ARRAY)
2589 return pkl_ast_lvalue_p (entity);
2590
2591 break;
2592 }
2593 case PKL_AST_EXP:
2594 if (PKL_AST_EXP_CODE (node) == PKL_AST_OP_BCONC)
2595 return (pkl_ast_lvalue_p (PKL_AST_EXP_OPERAND (node, 0))
2596 && pkl_ast_lvalue_p (PKL_AST_EXP_OPERAND (node, 1)));
2597 break;
2598 default:
2599 break;
2600 }
2601
2602 return 0;
2603 }
2604
2605 #ifdef PKL_DEBUG
2606
2607 /* The following macros are commodities to be used to keep the
2608 `pkl_ast_print' function as readable and easy to update as
2609 possible. Do not use them anywhere else. */
2610
2611 #define IPRINTF(...) \
2612 do \
2613 { \
2614 int i; \
2615 for (i = 0; i < indent; i++) \
2616 if (indent >= 2 && i % 2 == 0) \
2617 fprintf (fp, "|"); \
2618 else \
2619 fprintf (fp, " "); \
2620 fprintf (fp, __VA_ARGS__); \
2621 } while (0)
2622
2623 #define PRINT_AST_IMM(NAME,MACRO,FMT) \
2624 do \
2625 { \
2626 IPRINTF (#NAME ":\n"); \
2627 IPRINTF (" " FMT "\n", PKL_AST_##MACRO (ast)); \
2628 } \
2629 while (0)
2630
2631 #define PRINT_AST_SUBAST(NAME,MACRO) \
2632 do \
2633 { \
2634 IPRINTF (#NAME ":\n"); \
2635 pkl_ast_print_1 (fp, PKL_AST_##MACRO (ast), indent + 2); \
2636 } \
2637 while (0)
2638
2639 #define PRINT_AST_OPT_IMM(NAME,MACRO,FMT) \
2640 if (PKL_AST_##MACRO (ast)) \
2641 { \
2642 PRINT_AST_IMM (NAME, MACRO, FMT); \
2643 }
2644
2645 #define PRINT_AST_OPT_SUBAST(NAME,MACRO) \
2646 if (PKL_AST_##MACRO (ast)) \
2647 { \
2648 PRINT_AST_SUBAST (NAME, MACRO); \
2649 }
2650
2651 #define PRINT_AST_SUBAST_CHAIN(MACRO) \
2652 for (child = PKL_AST_##MACRO (ast); \
2653 child; \
2654 child = PKL_AST_CHAIN (child)) \
2655 { \
2656 pkl_ast_print_1 (fp, child, indent + 2); \
2657 }
2658
2659 /* Auxiliary function used by `pkl_ast_print', defined below. */
2660
2661 static void
pkl_ast_print_1(FILE * fp,pkl_ast_node ast,int indent)2662 pkl_ast_print_1 (FILE *fp, pkl_ast_node ast, int indent)
2663 {
2664 pkl_ast_node child;
2665 size_t i;
2666
2667 if (ast == NULL)
2668 {
2669 IPRINTF ("NULL::\n");
2670 return;
2671 }
2672
2673 #define PRINT_COMMON_FIELDS \
2674 do \
2675 { \
2676 IPRINTF ("uid: %" PRIu64 "\n", PKL_AST_UID (ast)); \
2677 IPRINTF ("refcount: %d\n", PKL_AST_REFCOUNT (ast));\
2678 IPRINTF ("location: %d,%d-%d,%d\n", \
2679 PKL_AST_LOC (ast).first_line, \
2680 PKL_AST_LOC (ast).first_column, \
2681 PKL_AST_LOC (ast).last_line, \
2682 PKL_AST_LOC (ast).last_column); \
2683 } \
2684 while (0)
2685
2686 switch (PKL_AST_CODE (ast))
2687 {
2688 case PKL_AST_PROGRAM:
2689 IPRINTF ("PROGRAM::\n");
2690
2691 PRINT_COMMON_FIELDS;
2692 PRINT_AST_SUBAST_CHAIN (PROGRAM_ELEMS);
2693 break;
2694
2695 case PKL_AST_SRC:
2696 IPRINTF ("SRC::\n");
2697
2698 PRINT_COMMON_FIELDS;
2699 PRINT_AST_IMM (filename, SRC_FILENAME, "%p");
2700 PRINT_AST_OPT_IMM (*filename, SRC_FILENAME, "%s");
2701 break;
2702
2703 case PKL_AST_IDENTIFIER:
2704 IPRINTF ("IDENTIFIER::\n");
2705
2706 PRINT_COMMON_FIELDS;
2707 PRINT_AST_IMM (length, IDENTIFIER_LENGTH, "%zu");
2708 PRINT_AST_IMM (pointer, IDENTIFIER_POINTER, "%p");
2709 PRINT_AST_OPT_IMM (*pointer, IDENTIFIER_POINTER, "'%s'");
2710 break;
2711
2712 case PKL_AST_INTEGER:
2713 IPRINTF ("INTEGER::\n");
2714
2715 PRINT_COMMON_FIELDS;
2716 PRINT_AST_SUBAST (type, TYPE);
2717 PRINT_AST_IMM (value, INTEGER_VALUE, "%" PRIu64);
2718 break;
2719
2720 case PKL_AST_STRING:
2721 IPRINTF ("STRING::\n");
2722
2723 PRINT_COMMON_FIELDS;
2724 PRINT_AST_SUBAST (type, TYPE);
2725 PRINT_AST_IMM (length, STRING_LENGTH, "%zu");
2726 PRINT_AST_IMM (pointer, STRING_POINTER, "%p");
2727 PRINT_AST_OPT_IMM (*pointer, STRING_POINTER, "'%s'");
2728 break;
2729
2730 case PKL_AST_EXP:
2731 {
2732
2733 #define PKL_DEF_OP(SYM, STRING) STRING,
2734 static const char *pkl_ast_op_name[] =
2735 {
2736 #include "pkl-ops.def"
2737 };
2738 #undef PKL_DEF_OP
2739
2740 IPRINTF ("EXPRESSION::\n");
2741
2742 PRINT_COMMON_FIELDS;
2743 IPRINTF ("opcode: %s\n",
2744 pkl_ast_op_name[PKL_AST_EXP_CODE (ast)]);
2745 if (PKL_AST_EXP_ATTR (ast) != PKL_AST_ATTR_NONE)
2746 IPRINTF ("attr: %s\n", pkl_attr_name (PKL_AST_EXP_ATTR (ast)));
2747 IPRINTF ("literal_p: %d\n", PKL_AST_LITERAL_P (ast));
2748 PRINT_AST_SUBAST (type, TYPE);
2749 PRINT_AST_IMM (numops, EXP_NUMOPS, "%d");
2750 IPRINTF ("operands:\n");
2751 for (i = 0; i < PKL_AST_EXP_NUMOPS (ast); i++)
2752 pkl_ast_print_1 (fp, PKL_AST_EXP_OPERAND (ast, i),
2753 indent + 2);
2754 break;
2755 }
2756
2757 case PKL_AST_COND_EXP:
2758 IPRINTF ("COND_EXPRESSION::\n");
2759
2760 PRINT_COMMON_FIELDS;
2761 PRINT_AST_SUBAST (condition, COND_EXP_COND);
2762 PRINT_AST_OPT_SUBAST (thenexp, COND_EXP_THENEXP);
2763 PRINT_AST_OPT_SUBAST (elseexp, COND_EXP_ELSEEXP);
2764 break;
2765
2766 case PKL_AST_STRUCT_FIELD:
2767 IPRINTF ("STRUCT_FIELD::\n");
2768
2769 PRINT_COMMON_FIELDS;
2770 PRINT_AST_SUBAST (type, TYPE);
2771 PRINT_AST_SUBAST (name, STRUCT_FIELD_NAME);
2772 PRINT_AST_SUBAST (exp, STRUCT_FIELD_EXP);
2773 break;
2774
2775 case PKL_AST_STRUCT:
2776 IPRINTF ("STRUCT::\n");
2777
2778 PRINT_COMMON_FIELDS;
2779 PRINT_AST_SUBAST (type, TYPE);
2780 PRINT_AST_IMM (nelem, STRUCT_NELEM, "%zu");
2781 IPRINTF ("elems:\n");
2782 PRINT_AST_SUBAST_CHAIN (STRUCT_FIELDS);
2783 break;
2784
2785 case PKL_AST_ARRAY_INITIALIZER:
2786 IPRINTF ("ARRAY_INITIALIZER::\n");
2787
2788 PRINT_COMMON_FIELDS;
2789 PRINT_AST_SUBAST (index, ARRAY_INITIALIZER_INDEX);
2790 PRINT_AST_SUBAST (exp, ARRAY_INITIALIZER_EXP);
2791 break;
2792
2793 case PKL_AST_ARRAY:
2794 IPRINTF ("ARRAY::\n");
2795
2796 PRINT_COMMON_FIELDS;
2797 PRINT_AST_IMM (nelem, ARRAY_NELEM, "%zu");
2798 PRINT_AST_IMM (ninitializer, ARRAY_NINITIALIZER, "%zu");
2799 PRINT_AST_SUBAST (type, TYPE);
2800 IPRINTF ("initializers:\n");
2801 PRINT_AST_SUBAST_CHAIN (ARRAY_INITIALIZERS);
2802 break;
2803
2804 case PKL_AST_ENUMERATOR:
2805 IPRINTF ("ENUMERATOR::\n");
2806
2807 PRINT_COMMON_FIELDS;
2808 PRINT_AST_SUBAST (identifier, ENUMERATOR_IDENTIFIER);
2809 PRINT_AST_SUBAST (value, ENUMERATOR_VALUE);
2810 break;
2811
2812 case PKL_AST_ENUM:
2813 IPRINTF ("ENUM::\n");
2814
2815 PRINT_COMMON_FIELDS;
2816 PRINT_AST_SUBAST (tag, ENUM_TAG);
2817 IPRINTF ("values:\n");
2818 PRINT_AST_SUBAST_CHAIN (ENUM_VALUES);
2819 break;
2820
2821 case PKL_AST_TYPE:
2822 IPRINTF ("TYPE::\n");
2823
2824 PRINT_COMMON_FIELDS;
2825 if (PKL_AST_TYPE_NAME (ast))
2826 PRINT_AST_SUBAST (name, TYPE_NAME);
2827 else
2828 {
2829 IPRINTF ("code:\n");
2830 switch (PKL_AST_TYPE_CODE (ast))
2831 {
2832 case PKL_TYPE_ANY: IPRINTF (" any\n"); break;
2833 case PKL_TYPE_INTEGRAL: IPRINTF (" integral\n"); break;
2834 case PKL_TYPE_STRING: IPRINTF (" string\n"); break;
2835 case PKL_TYPE_ARRAY: IPRINTF (" array\n"); break;
2836 case PKL_TYPE_STRUCT: IPRINTF (" struct\n"); break;
2837 case PKL_TYPE_FUNCTION: IPRINTF (" function\n"); break;
2838 case PKL_TYPE_OFFSET: IPRINTF (" offset\n"); break;
2839 default:
2840 IPRINTF (" unknown (%d)\n", PKL_AST_TYPE_CODE (ast));
2841 break;
2842 }
2843 PRINT_AST_IMM (complete, TYPE_COMPLETE, "%d");
2844 switch (PKL_AST_TYPE_CODE (ast))
2845 {
2846 case PKL_TYPE_INTEGRAL:
2847 PRINT_AST_IMM (signed_p, TYPE_I_SIGNED_P, "%d");
2848 PRINT_AST_IMM (size, TYPE_I_SIZE, "%zu");
2849 break;
2850 case PKL_TYPE_ARRAY:
2851 PRINT_AST_SUBAST (bound, TYPE_A_BOUND);
2852 PRINT_AST_SUBAST (etype, TYPE_A_ETYPE);
2853 break;
2854 case PKL_TYPE_STRUCT:
2855 PRINT_AST_IMM (pinned_p, TYPE_S_PINNED_P, "%d");
2856 PRINT_AST_IMM (union_p, TYPE_S_UNION_P, "%d");
2857 PRINT_AST_IMM (nelem, TYPE_S_NELEM, "%zu");
2858 PRINT_AST_IMM (nfield, TYPE_S_NFIELD, "%zu");
2859 PRINT_AST_IMM (ndecl, TYPE_S_NDECL, "%zu");
2860 PRINT_AST_SUBAST (itype, TYPE_S_ITYPE);
2861 IPRINTF ("elems:\n");
2862 PRINT_AST_SUBAST_CHAIN (TYPE_S_ELEMS);
2863 break;
2864 case PKL_TYPE_FUNCTION:
2865 PRINT_AST_IMM (narg, TYPE_F_NARG, "%d");
2866 IPRINTF ("args:\n");
2867 PRINT_AST_SUBAST_CHAIN (TYPE_F_ARGS);
2868 break;
2869 case PKL_TYPE_OFFSET:
2870 PRINT_AST_SUBAST (base_type, TYPE_O_BASE_TYPE);
2871 PRINT_AST_SUBAST (unit, TYPE_O_UNIT);
2872 break;
2873 case PKL_TYPE_STRING:
2874 case PKL_TYPE_ANY:
2875 default:
2876 break;
2877 }
2878 }
2879 break;
2880
2881 case PKL_AST_STRUCT_TYPE_FIELD:
2882 IPRINTF ("STRUCT_TYPE_FIELD::\n");
2883
2884 PRINT_COMMON_FIELDS;
2885 PRINT_AST_SUBAST (name, STRUCT_TYPE_FIELD_NAME);
2886 PRINT_AST_SUBAST (type, STRUCT_TYPE_FIELD_TYPE);
2887 PRINT_AST_SUBAST (exp, STRUCT_TYPE_FIELD_CONSTRAINT);
2888 PRINT_AST_SUBAST (exp, STRUCT_TYPE_FIELD_INITIALIZER);
2889 PRINT_AST_SUBAST (exp, STRUCT_TYPE_FIELD_LABEL);
2890 PRINT_AST_SUBAST (exp, STRUCT_TYPE_FIELD_OPTCOND);
2891 PRINT_AST_IMM (endian, STRUCT_TYPE_FIELD_ENDIAN, "%d");
2892 break;
2893
2894 case PKL_AST_FUNC_TYPE_ARG:
2895 IPRINTF ("FUNC_TYPE_ARG::\n");
2896
2897 PRINT_COMMON_FIELDS;
2898 PRINT_AST_SUBAST (type, FUNC_TYPE_ARG_TYPE);
2899 PRINT_AST_SUBAST (type, FUNC_TYPE_ARG_NAME);
2900 PRINT_AST_IMM (optional, FUNC_TYPE_ARG_OPTIONAL, "%d");
2901 break;
2902
2903 case PKL_AST_TRIMMER:
2904 IPRINTF ("TRIMMER::\n");
2905 PRINT_AST_SUBAST (from, TRIMMER_FROM);
2906 PRINT_AST_SUBAST (to, TRIMMER_TO);
2907 PRINT_AST_SUBAST (entity, TRIMMER_ENTITY);
2908 PRINT_AST_SUBAST (addend, TRIMMER_ADDEND);
2909 break;
2910
2911 case PKL_AST_INDEXER:
2912 IPRINTF ("INDEXER::\n");
2913
2914 PRINT_COMMON_FIELDS;
2915 PRINT_AST_SUBAST (type, TYPE);
2916 PRINT_AST_SUBAST (entity, INDEXER_ENTITY);
2917 PRINT_AST_SUBAST (index, INDEXER_INDEX);
2918 break;
2919
2920 case PKL_AST_FUNC:
2921 IPRINTF ("FUNC::\n");
2922
2923 PRINT_COMMON_FIELDS;
2924 PRINT_AST_IMM (nargs, FUNC_NARGS, "%d");
2925 PRINT_AST_IMM (method_p, FUNC_METHOD_P, "%d");
2926 PRINT_AST_SUBAST (ret_type, FUNC_RET_TYPE);
2927 PRINT_AST_SUBAST_CHAIN (FUNC_ARGS);
2928 PRINT_AST_SUBAST (first_opt_arg, FUNC_FIRST_OPT_ARG);
2929 PRINT_AST_SUBAST (body, FUNC_BODY);
2930 break;
2931
2932 case PKL_AST_FUNC_ARG:
2933 IPRINTF ("FUNC_ARG::\n");
2934
2935 PRINT_COMMON_FIELDS;
2936 PRINT_AST_SUBAST (type, FUNC_ARG_TYPE);
2937 PRINT_AST_SUBAST (identifier, FUNC_ARG_IDENTIFIER);
2938 PRINT_AST_IMM (vararg, FUNC_ARG_VARARG, "%d");
2939 break;
2940
2941 case PKL_AST_STRUCT_REF:
2942 IPRINTF ("STRUCT_REF::\n");
2943
2944 PRINT_COMMON_FIELDS;
2945 PRINT_AST_SUBAST (type, TYPE);
2946 PRINT_AST_SUBAST (struct, STRUCT_REF_STRUCT);
2947 PRINT_AST_SUBAST (identifier, STRUCT_REF_IDENTIFIER);
2948 break;
2949
2950 case PKL_AST_DECL:
2951 IPRINTF ("DECL::\n");
2952
2953 PRINT_COMMON_FIELDS;
2954 PRINT_AST_IMM (kind, DECL_KIND, "%d");
2955 if (PKL_AST_DECL_SOURCE (ast))
2956 PRINT_AST_IMM (source, DECL_SOURCE, "'%s'");
2957 PRINT_AST_SUBAST (name, DECL_NAME);
2958 PRINT_AST_SUBAST (initial, DECL_INITIAL);
2959 break;
2960
2961 case PKL_AST_OFFSET:
2962 IPRINTF ("OFFSET::\n");
2963
2964 PRINT_COMMON_FIELDS;
2965 PRINT_AST_SUBAST (type, TYPE);
2966 PRINT_AST_SUBAST (magnitude, OFFSET_MAGNITUDE);
2967 PRINT_AST_SUBAST (unit, OFFSET_UNIT);
2968 break;
2969
2970 case PKL_AST_CAST:
2971 IPRINTF ("CAST::\n");
2972
2973 PRINT_COMMON_FIELDS;
2974 PRINT_AST_SUBAST (type, TYPE);
2975 PRINT_AST_SUBAST (cast_type, CAST_TYPE);
2976 PRINT_AST_SUBAST (exp, CAST_EXP);
2977 break;
2978
2979 case PKL_AST_ISA:
2980 IPRINTF ("ISA::\n");
2981
2982 PRINT_COMMON_FIELDS;
2983 PRINT_AST_SUBAST (type, TYPE);
2984 PRINT_AST_SUBAST (isa_type, ISA_TYPE);
2985 PRINT_AST_SUBAST (exp, ISA_EXP);
2986 break;
2987
2988 case PKL_AST_MAP:
2989 IPRINTF ("MAP::\n");
2990
2991 PRINT_COMMON_FIELDS;
2992 PRINT_AST_IMM (strict_p, MAP_STRICT_P, "%d");
2993 PRINT_AST_SUBAST (type, TYPE);
2994 PRINT_AST_SUBAST (map_type, MAP_TYPE);
2995 PRINT_AST_SUBAST (ios, MAP_IOS);
2996 PRINT_AST_SUBAST (offset, MAP_OFFSET);
2997 break;
2998
2999 case PKL_AST_CONS:
3000 IPRINTF ("CONS::\n");
3001
3002 PRINT_COMMON_FIELDS;
3003 PRINT_AST_SUBAST (type, TYPE);
3004 PRINT_AST_IMM (cons_kind, CONS_KIND, "%d");
3005 PRINT_AST_SUBAST (cons_type, CONS_TYPE);
3006 PRINT_AST_SUBAST (cons_value, CONS_VALUE);
3007 break;
3008
3009
3010 case PKL_AST_FUNCALL:
3011 IPRINTF ("FUNCALL::\n");
3012
3013 PRINT_COMMON_FIELDS;
3014 PRINT_AST_SUBAST (function, FUNCALL_FUNCTION);
3015 IPRINTF ("args:\n");
3016 PRINT_AST_SUBAST_CHAIN (FUNCALL_ARGS);
3017 break;
3018
3019 case PKL_AST_FUNCALL_ARG:
3020 IPRINTF ("FUNCALL_ARG::\n");
3021
3022 PRINT_AST_SUBAST (exp, FUNCALL_ARG_EXP);
3023 PRINT_AST_SUBAST (name, FUNCALL_ARG_NAME);
3024 PRINT_AST_IMM (first_vararg, FUNCALL_ARG_FIRST_VARARG, "%d");
3025 break;
3026
3027 case PKL_AST_VAR:
3028 IPRINTF ("VAR::\n");
3029
3030 PRINT_COMMON_FIELDS;
3031 PRINT_AST_SUBAST (type, TYPE);
3032 PRINT_AST_IMM (back, VAR_BACK, "%d");
3033 PRINT_AST_IMM (over, VAR_OVER, "%d");
3034 break;
3035
3036 case PKL_AST_LAMBDA:
3037 IPRINTF ("LAMBDA::\n");
3038
3039 PRINT_COMMON_FIELDS;
3040 PRINT_AST_SUBAST (function, LAMBDA_FUNCTION);
3041 break;
3042
3043 case PKL_AST_INCRDECR:
3044 IPRINTF ("INCRDECR::\n");
3045
3046 PRINT_COMMON_FIELDS;
3047 PRINT_AST_IMM (order, INCRDECR_ORDER, "%d");
3048 PRINT_AST_IMM (sign, INCRDECR_SIGN, "%d");
3049 PRINT_AST_SUBAST (exp, INCRDECR_EXP);
3050 break;
3051
3052 case PKL_AST_COMP_STMT:
3053 IPRINTF ("COMP_STMT::\n");
3054
3055 PRINT_COMMON_FIELDS;
3056 PRINT_AST_IMM (builtin, COMP_STMT_BUILTIN, "%d");
3057 PRINT_AST_IMM (numvars, COMP_STMT_NUMVARS, "%d");
3058 IPRINTF ("stmts:\n");
3059 PRINT_AST_SUBAST_CHAIN (COMP_STMT_STMTS);
3060 break;
3061
3062 case PKL_AST_ASS_STMT:
3063 IPRINTF ("ASS_STMT::\n");
3064
3065 PRINT_COMMON_FIELDS;
3066 PRINT_AST_SUBAST (lvalue, ASS_STMT_LVALUE);
3067 PRINT_AST_SUBAST (exp, ASS_STMT_EXP);
3068 break;
3069
3070 case PKL_AST_IF_STMT:
3071 IPRINTF ("IF_STMT::\n");
3072
3073 PRINT_COMMON_FIELDS;
3074 PRINT_AST_SUBAST (exp, IF_STMT_EXP);
3075 PRINT_AST_SUBAST (then_stmt, IF_STMT_THEN_STMT);
3076 PRINT_AST_SUBAST (else_stmt, IF_STMT_ELSE_STMT);
3077 break;
3078
3079 case PKL_AST_LOOP_STMT:
3080 IPRINTF ("LOOP_STMT::\n");
3081
3082 PRINT_COMMON_FIELDS;
3083 PRINT_AST_IMM (kind, LOOP_STMT_KIND, "%d");
3084 PRINT_AST_SUBAST (iterator, LOOP_STMT_ITERATOR);
3085 PRINT_AST_SUBAST (condition, LOOP_STMT_CONDITION);
3086 PRINT_AST_SUBAST (head, LOOP_STMT_HEAD);
3087 PRINT_AST_SUBAST (tail, LOOP_STMT_TAIL);
3088 PRINT_AST_SUBAST (body, LOOP_STMT_BODY);
3089 break;
3090
3091 case PKL_AST_LOOP_STMT_ITERATOR:
3092 IPRINTF ("LOOP_STMT_ITERATOR::\n");
3093
3094 PRINT_COMMON_FIELDS;
3095 PRINT_AST_SUBAST (decl, LOOP_STMT_ITERATOR_DECL);
3096 PRINT_AST_SUBAST (container, LOOP_STMT_ITERATOR_CONTAINER);
3097 break;
3098
3099 case PKL_AST_RETURN_STMT:
3100 IPRINTF ("RETURN_STMT::\n");
3101
3102 PRINT_COMMON_FIELDS;
3103 PRINT_AST_SUBAST (exp, RETURN_STMT_EXP);
3104 break;
3105
3106 case PKL_AST_EXP_STMT:
3107 IPRINTF ("EXP_STMT::\n");
3108
3109 PRINT_COMMON_FIELDS;
3110 PRINT_AST_SUBAST (exp_stmt, EXP_STMT_EXP);
3111 break;
3112
3113 case PKL_AST_TRY_CATCH_STMT:
3114 IPRINTF ("TRY_CATCH_STMT::\n");
3115
3116 PRINT_COMMON_FIELDS;
3117 PRINT_AST_SUBAST (try_catch_stmt_code, TRY_CATCH_STMT_CODE);
3118 PRINT_AST_SUBAST (try_catch_stmt_handler, TRY_CATCH_STMT_HANDLER);
3119 PRINT_AST_SUBAST (try_catch_stmt_arg, TRY_CATCH_STMT_ARG);
3120 PRINT_AST_SUBAST (try_catch_stmt_exp, TRY_CATCH_STMT_EXP);
3121 break;
3122
3123 case PKL_AST_TRY_UNTIL_STMT:
3124 IPRINTF ("TRY_UNTIL_STMT::\n");
3125
3126 PRINT_COMMON_FIELDS;
3127 PRINT_AST_SUBAST (try_until_stmt_code, TRY_UNTIL_STMT_CODE);
3128 PRINT_AST_SUBAST (try_until_stmt_exp, TRY_UNTIL_STMT_EXP);
3129 break;
3130
3131 case PKL_AST_PRINT_STMT_ARG:
3132 IPRINTF ("PRINT_STMT_ARG::\n");
3133 PRINT_COMMON_FIELDS;
3134 if (PKL_AST_PRINT_STMT_ARG_BEGIN_SC (ast))
3135 PRINT_AST_IMM (begin_sc, PRINT_STMT_ARG_BEGIN_SC, "'%s'");
3136 if (PKL_AST_PRINT_STMT_ARG_END_SC (ast))
3137 PRINT_AST_IMM (end_sc, PRINT_STMT_ARG_END_SC, "'%s'");
3138 if (PKL_AST_PRINT_STMT_ARG_SUFFIX (ast))
3139 PRINT_AST_IMM (suffix, PRINT_STMT_ARG_SUFFIX, "'%s'");
3140 PRINT_AST_SUBAST (exp, PRINT_STMT_ARG_EXP);
3141 break;
3142
3143 case PKL_AST_PRINT_STMT:
3144 IPRINTF ("PRINT_STMT::\n");
3145 PRINT_COMMON_FIELDS;
3146 if (PKL_AST_PRINT_STMT_PREFIX (ast))
3147 PRINT_AST_IMM (prefix, PRINT_STMT_PREFIX, "'%s'");
3148 PRINT_AST_SUBAST (fmt, PRINT_STMT_FMT);
3149 PRINT_AST_SUBAST_CHAIN (PRINT_STMT_TYPES);
3150 PRINT_AST_SUBAST_CHAIN (PRINT_STMT_ARGS);
3151 break;
3152
3153 case PKL_AST_BREAK_STMT:
3154 IPRINTF ("BREAK_STMT::\n");
3155 PRINT_COMMON_FIELDS;
3156 break;
3157
3158 case PKL_AST_CONTINUE_STMT:
3159 IPRINTF ("CONTINUE_STMT::\n");
3160 PRINT_COMMON_FIELDS;
3161 break;
3162
3163 case PKL_AST_RAISE_STMT:
3164 IPRINTF ("RAISE_STMT::\n");
3165
3166 PRINT_COMMON_FIELDS;
3167 PRINT_AST_SUBAST (raise_stmt_exp, RAISE_STMT_EXP);
3168 break;
3169
3170 case PKL_AST_NULL_STMT:
3171 IPRINTF ("NULL_STMT::\n");
3172
3173 PRINT_COMMON_FIELDS;
3174 break;
3175
3176 default:
3177 IPRINTF ("UNKNOWN:: code=%d\n", PKL_AST_CODE (ast));
3178 break;
3179 }
3180 }
3181
3182 /* Dump a printable representation of AST to the file descriptor FD.
3183 This function is intended to be useful to debug the PKL
3184 compiler. */
3185
3186 void
pkl_ast_print(FILE * fp,pkl_ast_node ast)3187 pkl_ast_print (FILE *fp, pkl_ast_node ast)
3188 {
3189 pkl_ast_print_1 (fp, ast, 0);
3190 }
3191
3192 #undef IPRINTF
3193 #undef PRINT_AST_IMM
3194 #undef PRINT_AST_SUBAST
3195 #undef PRINT_AST_OPT_FIELD
3196 #undef PRINT_AST_OPT_SUBAST
3197
3198 #endif /* PKL_DEBUG */
3199