9 const char *binop_str
[] = {
10 [binor
] = "||", [binand
] = "&&", [eq
] = "==", [neq
] = "!=",
11 [leq
] = "<=", [le
] = "<", [geq
] = ">=", [ge
] = ">", [cons
] = ":",
12 [plus
] = "+", [minus
] = "-", [times
] = "*", [divide
] = "/",
13 [modulo
] = "%", [power
] = "^",
15 const char *fieldspec_str
[] = {
16 [fst
] = "fst", [snd
] = "snd", [hd
] = "hd", [tl
] = "tl"};
17 const char *unop_str
[] = { [inverse
] = "!", [negate
] = "-", };
18 static const char *basictype_str
[] = {
19 [btbool
] = "Bool", [btchar
] = "Char", [btint
] = "Int",
23 struct ast
*ast(struct list
*decls
)
25 struct ast
*res
= safe_malloc(sizeof(struct ast
));
26 res
->decls
= (struct decl
**)list_to_array(decls
, &res
->ndecls
, true);
30 struct vardecl
*vardecl(struct type
*type
, char *ident
, struct expr
*expr
)
32 struct vardecl
*res
= safe_malloc(sizeof(struct vardecl
));
39 struct decl
*decl_fun(char *ident
, struct list
*args
, struct list
*atypes
,
40 struct type
*rtype
, struct list
*body
)
42 struct decl
*res
= safe_malloc(sizeof(struct decl
));
44 res
->data
.dfun
.ident
= ident
;
45 res
->data
.dfun
.args
= (char **)
46 list_to_array(args
, &res
->data
.dfun
.nargs
, true);
47 res
->data
.dfun
.atypes
= (struct type
**)
48 list_to_array(atypes
, &res
->data
.dfun
.natypes
, true);
49 res
->data
.dfun
.rtype
= rtype
;
50 res
->data
.dfun
.body
= (struct stmt
**)
51 list_to_array(body
, &res
->data
.dfun
.nbody
, true);
55 struct decl
*decl_var(struct vardecl
*vardecl
)
57 struct decl
*res
= safe_malloc(sizeof(struct decl
));
59 res
->data
.dvar
= vardecl
;
63 struct stmt
*stmt_assign(char *ident
, struct list
*fields
, struct expr
*expr
)
65 struct stmt
*res
= safe_malloc(sizeof(struct stmt
));
67 res
->data
.sassign
.ident
= ident
;
68 res
->data
.sassign
.fields
= (char **)
69 list_to_array(fields
, &res
->data
.sassign
.nfields
, true);
70 res
->data
.sassign
.expr
= expr
;
74 struct stmt
*stmt_if(struct expr
*pred
, struct list
*then
, struct list
*els
)
76 struct stmt
*res
= safe_malloc(sizeof(struct stmt
));
78 res
->data
.sif
.pred
= pred
;
79 res
->data
.sif
.then
= (struct stmt
**)
80 list_to_array(then
, &res
->data
.sif
.nthen
, true);
81 res
->data
.sif
.els
= (struct stmt
**)
82 list_to_array(els
, &res
->data
.sif
.nels
, true);
86 struct stmt
*stmt_return(struct expr
*rtrn
)
88 struct stmt
*res
= safe_malloc(sizeof(struct stmt
));
90 res
->data
.sreturn
= rtrn
;
94 struct stmt
*stmt_expr(struct expr
*expr
)
96 struct stmt
*res
= safe_malloc(sizeof(struct stmt
));
98 res
->data
.sexpr
= expr
;
102 struct stmt
*stmt_vardecl(struct vardecl
*vardecl
)
104 struct stmt
*res
= safe_malloc(sizeof(struct stmt
));
105 res
->type
= svardecl
;
106 res
->data
.svardecl
= vardecl
;
110 struct stmt
*stmt_while(struct expr
*pred
, struct list
*body
)
112 struct stmt
*res
= safe_malloc(sizeof(struct stmt
));
114 res
->data
.swhile
.pred
= pred
;
115 res
->data
.swhile
.body
= (struct stmt
**)
116 list_to_array(body
, &res
->data
.swhile
.nbody
, true);
120 struct expr
*expr_binop(struct expr
*l
, enum binop op
, struct expr
*r
)
122 struct expr
*res
= safe_malloc(sizeof(struct expr
));
124 res
->data
.ebinop
.l
= l
;
125 res
->data
.ebinop
.op
= op
;
126 res
->data
.ebinop
.r
= r
;
130 struct expr
*expr_bool(bool b
)
132 struct expr
*res
= safe_malloc(sizeof(struct expr
));
138 struct expr
*expr_char(char *c
)
140 struct expr
*res
= safe_malloc(sizeof(struct expr
));
142 res
->data
.echar
= unescape_char(c
)[0];
146 static void set_fields(enum fieldspec
**farray
, int *n
, struct list
*fields
)
148 void **els
= list_to_array(fields
, n
, true);
149 *farray
= (enum fieldspec
*)safe_malloc(*n
*sizeof(enum fieldspec
));
150 for (int i
= 0; i
<*n
; i
++) {
152 if (strcmp(t
, "fst") == 0)
154 else if (strcmp(t
, "snd") == 0)
156 else if (strcmp(t
, "hd") == 0)
158 else if (strcmp(t
, "tl") == 0)
166 struct expr
*expr_funcall(char *ident
, struct list
*args
, struct list
*fields
)
168 struct expr
*res
= safe_malloc(sizeof(struct expr
));
169 res
->type
= efuncall
;
170 res
->data
.efuncall
.ident
= ident
;
171 res
->data
.efuncall
.args
= (struct expr
**)
172 list_to_array(args
, &res
->data
.efuncall
.nargs
, true);
173 set_fields(&res
->data
.efuncall
.fields
,
174 &res
->data
.efuncall
.nfields
, fields
);
178 struct expr
*expr_int(int integer
)
180 struct expr
*res
= safe_malloc(sizeof(struct expr
));
182 res
->data
.eint
= integer
;
186 struct expr
*expr_ident(char *ident
, struct list
*fields
)
188 struct expr
*res
= safe_malloc(sizeof(struct expr
));
190 res
->data
.eident
.ident
= ident
;
191 set_fields(&res
->data
.eident
.fields
, &res
->data
.eident
.nfields
, fields
);
195 struct expr
*expr_nil()
197 struct expr
*res
= safe_malloc(sizeof(struct expr
));
202 struct expr
*expr_tuple(struct expr
*left
, struct expr
*right
)
204 struct expr
*res
= safe_malloc(sizeof(struct expr
));
206 res
->data
.etuple
.left
= left
;
207 res
->data
.etuple
.right
= right
;
211 struct expr
*expr_string(char *str
)
213 struct expr
*res
= safe_malloc(sizeof(struct expr
));
215 res
->data
.estring
.nchars
= 0;
216 res
->data
.estring
.chars
= safe_malloc(strlen(str
)+1);
217 char *p
= res
->data
.estring
.chars
;
218 while(*str
!= '\0') {
219 str
= unescape_char(str
);
221 res
->data
.estring
.nchars
++;
227 struct expr
*expr_unop(enum unop op
, struct expr
*l
)
229 struct expr
*res
= safe_malloc(sizeof(struct expr
));
231 res
->data
.eunop
.op
= op
;
232 res
->data
.eunop
.l
= l
;
236 struct type
*type_basic(enum basictype type
)
238 struct type
*res
= safe_malloc(sizeof(struct type
));
240 res
->data
.tbasic
= type
;
244 struct type
*type_list(struct type
*type
)
246 struct type
*res
= safe_malloc(sizeof(struct type
));
248 res
->data
.tlist
= type
;
252 struct type
*type_tuple(struct type
*l
, struct type
*r
)
254 struct type
*res
= safe_malloc(sizeof(struct type
));
256 res
->data
.ttuple
.l
= l
;
257 res
->data
.ttuple
.r
= r
;
261 struct type
*type_var(char *ident
)
263 struct type
*res
= safe_malloc(sizeof(struct type
));
264 if (strcmp(ident
, "Int") == 0) {
266 res
->data
.tbasic
= btint
;
268 } else if (strcmp(ident
, "Char") == 0) {
270 res
->data
.tbasic
= btchar
;
272 } else if (strcmp(ident
, "Bool") == 0) {
274 res
->data
.tbasic
= btbool
;
276 } else if (strcmp(ident
, "Void") == 0) {
278 res
->data
.tbasic
= btvoid
;
282 res
->data
.tvar
= ident
;
287 void ast_print(struct ast
*ast
, FILE *out
)
291 for (int i
= 0; i
<ast
->ndecls
; i
++)
292 decl_print(ast
->decls
[i
], out
);
295 void vardecl_print(struct vardecl
*decl
, int indent
, FILE *out
)
297 pindent(indent
, out
);
298 if (decl
->type
== NULL
)
299 safe_fprintf(out
, "var");
301 type_print(decl
->type
, out
);
302 safe_fprintf(out
, " %s = ", decl
->ident
);
303 expr_print(decl
->expr
, out
);
304 safe_fprintf(out
, ";\n");
307 void decl_print(struct decl
*decl
, FILE *out
)
313 safe_fprintf(out
, "%s (", decl
->data
.dfun
.ident
);
314 for (int i
= 0; i
<decl
->data
.dfun
.nargs
; i
++) {
315 safe_fprintf(out
, "%s", decl
->data
.dfun
.args
[i
]);
316 if (i
< decl
->data
.dfun
.nargs
- 1)
317 safe_fprintf(out
, ", ");
319 safe_fprintf(out
, ")");
320 if (decl
->data
.dfun
.rtype
!= NULL
) {
321 safe_fprintf(out
, " :: ");
322 for (int i
= 0; i
<decl
->data
.dfun
.natypes
; i
++) {
323 type_print(decl
->data
.dfun
.atypes
[i
], out
);
324 safe_fprintf(out
, " ");
326 safe_fprintf(out
, "-> ");
327 type_print(decl
->data
.dfun
.rtype
, out
);
329 safe_fprintf(out
, " {\n");
330 for (int i
= 0; i
<decl
->data
.dfun
.nbody
; i
++)
331 stmt_print(decl
->data
.dfun
.body
[i
], 1, out
);
332 safe_fprintf(out
, "}\n");
335 vardecl_print(decl
->data
.dvar
, 0, out
);
338 for (int i
= 0; i
<decl
->data
.dcomponent
.ndecls
; i
++)
339 decl_print(decl
, out
);
342 die("Unsupported decl node\n");
346 void stmt_print(struct stmt
*stmt
, int indent
, FILE *out
)
352 pindent(indent
, out
);
353 fprintf(out
, "%s", stmt
->data
.sassign
.ident
);
354 for (int i
= 0; i
<stmt
->data
.sassign
.nfields
; i
++)
355 fprintf(out
, ".%s", stmt
->data
.sassign
.fields
[i
]);
356 safe_fprintf(out
, " = ");
357 expr_print(stmt
->data
.sassign
.expr
, out
);
358 safe_fprintf(out
, ";\n");
361 pindent(indent
, out
);
362 safe_fprintf(out
, "if (");
363 expr_print(stmt
->data
.sif
.pred
, out
);
364 safe_fprintf(out
, ") {\n");
365 for (int i
= 0; i
<stmt
->data
.sif
.nthen
; i
++)
366 stmt_print(stmt
->data
.sif
.then
[i
], indent
+1, out
);
367 pindent(indent
, out
);
368 safe_fprintf(out
, "} else {\n");
369 for (int i
= 0; i
<stmt
->data
.sif
.nels
; i
++)
370 stmt_print(stmt
->data
.sif
.els
[i
], indent
+1, out
);
371 pindent(indent
, out
);
372 safe_fprintf(out
, "}\n");
375 pindent(indent
, out
);
376 safe_fprintf(out
, "return ");
377 expr_print(stmt
->data
.sreturn
, out
);
378 safe_fprintf(out
, ";\n");
381 pindent(indent
, out
);
382 expr_print(stmt
->data
.sexpr
, out
);
383 safe_fprintf(out
, ";\n");
386 vardecl_print(stmt
->data
.svardecl
, indent
, out
);
389 pindent(indent
, out
);
390 safe_fprintf(out
, "while (");
391 expr_print(stmt
->data
.swhile
.pred
, out
);
392 safe_fprintf(out
, ") {\n");
393 for (int i
= 0; i
<stmt
->data
.swhile
.nbody
; i
++)
394 stmt_print(stmt
->data
.swhile
.body
[i
], indent
+1, out
);
395 pindent(indent
, out
);
396 safe_fprintf(out
, "}\n");
399 die("Unsupported stmt node\n");
403 void expr_print(struct expr
*expr
, FILE *out
)
407 char buf
[] = "\\xff";
410 safe_fprintf(out
, "(");
411 expr_print(expr
->data
.ebinop
.l
, out
);
412 safe_fprintf(out
, "%s", binop_str
[expr
->data
.ebinop
.op
]);
413 expr_print(expr
->data
.ebinop
.r
, out
);
414 safe_fprintf(out
, ")");
417 safe_fprintf(out
, "%s", expr
->data
.ebool
? "true" : "false");
420 safe_fprintf(out
, "'%s'",
421 escape_char(expr
->data
.echar
, buf
, false));
424 safe_fprintf(out
, "%s(", expr
->data
.efuncall
.ident
);
425 for(int i
= 0; i
<expr
->data
.efuncall
.nargs
; i
++) {
426 expr_print(expr
->data
.efuncall
.args
[i
], out
);
427 if (i
+1 < expr
->data
.efuncall
.nargs
)
428 safe_fprintf(out
, ", ");
430 safe_fprintf(out
, ")");
431 for (int i
= 0; i
<expr
->data
.efuncall
.nfields
; i
++)
433 fieldspec_str
[expr
->data
.efuncall
.fields
[i
]]);
436 safe_fprintf(out
, "%d", expr
->data
.eint
);
439 fprintf(out
, "%s", expr
->data
.eident
.ident
);
440 for (int i
= 0; i
<expr
->data
.eident
.nfields
; i
++)
442 fieldspec_str
[expr
->data
.eident
.fields
[i
]]);
445 safe_fprintf(out
, "[]");
448 safe_fprintf(out
, "(");
449 expr_print(expr
->data
.etuple
.left
, out
);
450 safe_fprintf(out
, ", ");
451 expr_print(expr
->data
.etuple
.right
, out
);
452 safe_fprintf(out
, ")");
455 safe_fprintf(out
, "\"");
456 for (int i
= 0; i
<expr
->data
.estring
.nchars
; i
++)
457 safe_fprintf(out
, "%s", escape_char(
458 expr
->data
.estring
.chars
[i
], buf
, true));
459 safe_fprintf(out
, "\"");
462 safe_fprintf(out
, "(%s", unop_str
[expr
->data
.eunop
.op
]);
463 expr_print(expr
->data
.eunop
.l
, out
);
464 safe_fprintf(out
, ")");
467 die("Unsupported expr node\n");
471 void type_print(struct type
*type
, FILE *out
)
475 switch (type
->type
) {
477 safe_fprintf(out
, "%s", basictype_str
[type
->data
.tbasic
]);
480 safe_fprintf(out
, "[");
481 type_print(type
->data
.tlist
, out
);
482 safe_fprintf(out
, "]");
485 safe_fprintf(out
, "(");
486 type_print(type
->data
.ttuple
.l
, out
);
487 safe_fprintf(out
, ",");
488 type_print(type
->data
.ttuple
.r
, out
);
489 safe_fprintf(out
, ")");
492 safe_fprintf(out
, "%s", type
->data
.tvar
);
495 die("Unsupported type node\n");
499 void ast_free(struct ast
*ast
)
503 for (int i
= 0; i
<ast
->ndecls
; i
++)
504 decl_free(ast
->decls
[i
]);
509 void vardecl_free(struct vardecl
*decl
)
511 type_free(decl
->type
);
513 expr_free(decl
->expr
);
517 void decl_free(struct decl
*decl
)
523 for (int i
= 0; i
<decl
->data
.dcomponent
.ndecls
; i
++)
524 decl_free(decl
->data
.dcomponent
.decls
[i
]);
525 free(decl
->data
.dcomponent
.decls
);
528 free(decl
->data
.dfun
.ident
);
529 for (int i
= 0; i
<decl
->data
.dfun
.nargs
; i
++)
530 free(decl
->data
.dfun
.args
[i
]);
531 free(decl
->data
.dfun
.args
);
532 for (int i
= 0; i
<decl
->data
.dfun
.natypes
; i
++)
533 type_free(decl
->data
.dfun
.atypes
[i
]);
534 free(decl
->data
.dfun
.atypes
);
535 type_free(decl
->data
.dfun
.rtype
);
536 for (int i
= 0; i
<decl
->data
.dfun
.nbody
; i
++)
537 stmt_free(decl
->data
.dfun
.body
[i
]);
538 free(decl
->data
.dfun
.body
);
541 vardecl_free(decl
->data
.dvar
);
544 die("Unsupported decl node\n");
549 void stmt_free(struct stmt
*stmt
)
555 free(stmt
->data
.sassign
.ident
);
556 for (int i
= 0; i
<stmt
->data
.sassign
.nfields
; i
++)
557 free(stmt
->data
.sassign
.fields
[i
]);
558 free(stmt
->data
.sassign
.fields
);
559 expr_free(stmt
->data
.sassign
.expr
);
562 expr_free(stmt
->data
.sif
.pred
);
563 for (int i
= 0; i
<stmt
->data
.sif
.nthen
; i
++)
564 stmt_free(stmt
->data
.sif
.then
[i
]);
565 free(stmt
->data
.sif
.then
);
566 for (int i
= 0; i
<stmt
->data
.sif
.nels
; i
++)
567 stmt_free(stmt
->data
.sif
.els
[i
]);
568 free(stmt
->data
.sif
.els
);
571 expr_free(stmt
->data
.sreturn
);
574 expr_free(stmt
->data
.sexpr
);
577 expr_free(stmt
->data
.swhile
.pred
);
578 for (int i
= 0; i
<stmt
->data
.swhile
.nbody
; i
++)
579 stmt_free(stmt
->data
.swhile
.body
[i
]);
580 free(stmt
->data
.swhile
.body
);
583 vardecl_free(stmt
->data
.svardecl
);
586 die("Unsupported stmt node\n");
591 void expr_free(struct expr
*expr
)
597 expr_free(expr
->data
.ebinop
.l
);
598 expr_free(expr
->data
.ebinop
.r
);
605 free(expr
->data
.efuncall
.ident
);
606 for (int i
= 0; i
<expr
->data
.efuncall
.nargs
; i
++)
607 expr_free(expr
->data
.efuncall
.args
[i
]);
608 free(expr
->data
.efuncall
.fields
);
609 free(expr
->data
.efuncall
.args
);
614 free(expr
->data
.eident
.ident
);
615 free(expr
->data
.eident
.fields
);
620 expr_free(expr
->data
.etuple
.left
);
621 expr_free(expr
->data
.etuple
.right
);
624 free(expr
->data
.estring
.chars
);
627 expr_free(expr
->data
.eunop
.l
);
630 die("Unsupported expr node\n");
635 void type_free(struct type
*type
)
639 switch (type
->type
) {
643 type_free(type
->data
.tlist
);
646 type_free(type
->data
.ttuple
.l
);
647 type_free(type
->data
.ttuple
.r
);
650 free(type
->data
.tvar
);
653 die("Unsupported type node\n");