10 const char *binop_str
[] = {
11 [binor
] = "||", [binand
] = "&&", [eq
] = "==", [neq
] = "!=",
12 [leq
] = "<=", [le
] = "<", [geq
] = ">=", [ge
] = ">", [cons
] = ":",
13 [plus
] = "+", [minus
] = "-", [times
] = "*", [divide
] = "/",
14 [modulo
] = "%", [power
] = "^",
16 const char *fieldspec_str
[] = {
17 [fst
] = "fst", [snd
] = "snd", [hd
] = "hd", [tl
] = "tl"};
18 const char *unop_str
[] = { [inverse
] = "!", [negate
] = "-", };
19 static const char *basictype_str
[] = {
20 [btbool
] = "Bool", [btchar
] = "Char", [btint
] = "Int",
24 struct ast
*ast(struct list
*decls
)
26 struct ast
*res
= safe_malloc(sizeof(struct ast
));
27 res
->decls
= (struct decl
**)list_to_array(decls
, &res
->ndecls
, true);
31 struct vardecl
*vardecl(struct type
*type
, char *ident
, struct expr
*expr
)
33 struct vardecl
*res
= safe_malloc(sizeof(struct vardecl
));
39 struct fundecl
*fundecl(char *ident
, struct list
*args
, struct list
*atypes
,
40 struct type
*rtype
, struct list
*body
)
42 struct fundecl
*res
= safe_malloc(sizeof(struct fundecl
));
44 res
->args
= (char **)list_to_array(args
, &res
->nargs
, true);
45 res
->atypes
= (struct type
**)list_to_array(atypes
, &res
->natypes
, true);
47 res
->body
= (struct stmt
**)list_to_array(body
, &res
->nbody
, true);
51 struct decl
*decl_fun(struct fundecl
*fundecl
)
53 struct decl
*res
= safe_malloc(sizeof(struct decl
));
55 res
->data
.dfun
= fundecl
;
59 struct decl
*decl_var(struct vardecl
*vardecl
)
61 struct decl
*res
= safe_malloc(sizeof(struct decl
));
63 res
->data
.dvar
= vardecl
;
67 struct stmt
*stmt_assign(char *ident
, struct list
*fields
, struct expr
*expr
)
69 struct stmt
*res
= safe_malloc(sizeof(struct stmt
));
71 res
->data
.sassign
.ident
= ident
;
72 res
->data
.sassign
.fields
= (char **)
73 list_to_array(fields
, &res
->data
.sassign
.nfields
, true);
74 res
->data
.sassign
.expr
= expr
;
78 struct stmt
*stmt_if(struct expr
*pred
, struct list
*then
, struct list
*els
)
80 struct stmt
*res
= safe_malloc(sizeof(struct stmt
));
82 res
->data
.sif
.pred
= pred
;
83 res
->data
.sif
.then
= (struct stmt
**)
84 list_to_array(then
, &res
->data
.sif
.nthen
, true);
85 res
->data
.sif
.els
= (struct stmt
**)
86 list_to_array(els
, &res
->data
.sif
.nels
, true);
90 struct stmt
*stmt_return(struct expr
*rtrn
)
92 struct stmt
*res
= safe_malloc(sizeof(struct stmt
));
94 res
->data
.sreturn
= rtrn
;
98 struct stmt
*stmt_expr(struct expr
*expr
)
100 struct stmt
*res
= safe_malloc(sizeof(struct stmt
));
102 res
->data
.sexpr
= expr
;
106 struct stmt
*stmt_vardecl(struct vardecl
*vardecl
)
108 struct stmt
*res
= safe_malloc(sizeof(struct stmt
));
109 res
->type
= svardecl
;
110 res
->data
.svardecl
= vardecl
;
114 struct stmt
*stmt_while(struct expr
*pred
, struct list
*body
)
116 struct stmt
*res
= safe_malloc(sizeof(struct stmt
));
118 res
->data
.swhile
.pred
= pred
;
119 res
->data
.swhile
.body
= (struct stmt
**)
120 list_to_array(body
, &res
->data
.swhile
.nbody
, true);
124 struct expr
*expr_binop(struct expr
*l
, enum binop op
, struct expr
*r
)
126 struct expr
*res
= safe_malloc(sizeof(struct expr
));
128 res
->data
.ebinop
.l
= l
;
129 res
->data
.ebinop
.op
= op
;
130 res
->data
.ebinop
.r
= r
;
134 struct expr
*expr_bool(bool b
)
136 struct expr
*res
= safe_malloc(sizeof(struct expr
));
142 struct expr
*expr_char(char *c
)
144 struct expr
*res
= safe_malloc(sizeof(struct expr
));
146 res
->data
.echar
= unescape_char(c
)[0];
150 static void set_fields(enum fieldspec
**farray
, int *n
, struct list
*fields
)
152 void **els
= list_to_array(fields
, n
, true);
153 *farray
= (enum fieldspec
*)safe_malloc(*n
*sizeof(enum fieldspec
));
154 for (int i
= 0; i
<*n
; i
++) {
156 if (strcmp(t
, "fst") == 0)
158 else if (strcmp(t
, "snd") == 0)
160 else if (strcmp(t
, "hd") == 0)
162 else if (strcmp(t
, "tl") == 0)
170 struct expr
*expr_funcall(char *ident
, struct list
*args
, struct list
*fields
)
172 struct expr
*res
= safe_malloc(sizeof(struct expr
));
173 res
->type
= efuncall
;
174 res
->data
.efuncall
.ident
= ident
;
175 res
->data
.efuncall
.args
= (struct expr
**)
176 list_to_array(args
, &res
->data
.efuncall
.nargs
, true);
177 set_fields(&res
->data
.efuncall
.fields
,
178 &res
->data
.efuncall
.nfields
, fields
);
182 struct expr
*expr_int(int integer
)
184 struct expr
*res
= safe_malloc(sizeof(struct expr
));
186 res
->data
.eint
= integer
;
190 struct expr
*expr_ident(char *ident
, struct list
*fields
)
192 struct expr
*res
= safe_malloc(sizeof(struct expr
));
194 res
->data
.eident
.ident
= ident
;
195 set_fields(&res
->data
.eident
.fields
, &res
->data
.eident
.nfields
, fields
);
199 struct expr
*expr_nil()
201 struct expr
*res
= safe_malloc(sizeof(struct expr
));
206 struct expr
*expr_tuple(struct expr
*left
, struct expr
*right
)
208 struct expr
*res
= safe_malloc(sizeof(struct expr
));
210 res
->data
.etuple
.left
= left
;
211 res
->data
.etuple
.right
= right
;
215 struct expr
*expr_string(char *str
)
217 struct expr
*res
= safe_malloc(sizeof(struct expr
));
219 res
->data
.estring
.nchars
= 0;
220 res
->data
.estring
.chars
= safe_malloc(strlen(str
)+1);
221 char *p
= res
->data
.estring
.chars
;
222 while(*str
!= '\0') {
223 str
= unescape_char(str
);
225 res
->data
.estring
.nchars
++;
231 struct expr
*expr_unop(enum unop op
, struct expr
*l
)
233 struct expr
*res
= safe_malloc(sizeof(struct expr
));
235 res
->data
.eunop
.op
= op
;
236 res
->data
.eunop
.l
= l
;
240 struct type
*type_basic(enum basictype type
)
242 struct type
*res
= safe_malloc(sizeof(struct type
));
244 res
->data
.tbasic
= type
;
248 struct type
*type_list(struct type
*type
)
250 struct type
*res
= safe_malloc(sizeof(struct type
));
252 res
->data
.tlist
= type
;
256 struct type
*type_tuple(struct type
*l
, struct type
*r
)
258 struct type
*res
= safe_malloc(sizeof(struct type
));
260 res
->data
.ttuple
.l
= l
;
261 res
->data
.ttuple
.r
= r
;
265 struct type
*type_var(char *ident
)
267 struct type
*res
= safe_malloc(sizeof(struct type
));
268 if (strcmp(ident
, "Int") == 0) {
270 res
->data
.tbasic
= btint
;
272 } else if (strcmp(ident
, "Char") == 0) {
274 res
->data
.tbasic
= btchar
;
276 } else if (strcmp(ident
, "Bool") == 0) {
278 res
->data
.tbasic
= btbool
;
280 } else if (strcmp(ident
, "Void") == 0) {
282 res
->data
.tbasic
= btvoid
;
286 res
->data
.tvar
= ident
;
291 void ast_print(struct ast
*ast
, FILE *out
)
295 for (int i
= 0; i
<ast
->ndecls
; i
++)
296 decl_print(ast
->decls
[i
], out
);
299 void vardecl_print(struct vardecl
*decl
, int indent
, FILE *out
)
301 pindent(indent
, out
);
302 if (decl
->type
== NULL
)
303 safe_fprintf(out
, "var");
305 type_print(decl
->type
, out
);
306 safe_fprintf(out
, " %s = ", decl
->ident
);
307 expr_print(decl
->expr
, out
);
308 safe_fprintf(out
, ";\n");
311 void fundecl_print(struct fundecl
*decl
, FILE *out
)
313 safe_fprintf(out
, "%s (", decl
->ident
);
314 for (int i
= 0; i
<decl
->nargs
; i
++) {
315 safe_fprintf(out
, "%s", decl
->args
[i
]);
316 if (i
< decl
->nargs
- 1)
317 safe_fprintf(out
, ", ");
319 safe_fprintf(out
, ")");
320 if (decl
->rtype
!= NULL
) {
321 safe_fprintf(out
, " :: ");
322 for (int i
= 0; i
<decl
->natypes
; i
++) {
323 type_print(decl
->atypes
[i
], out
);
324 safe_fprintf(out
, " ");
326 safe_fprintf(out
, "-> ");
327 type_print(decl
->rtype
, out
);
329 safe_fprintf(out
, " {\n");
330 for (int i
= 0; i
<decl
->nbody
; i
++)
331 stmt_print(decl
->body
[i
], 1, out
);
332 safe_fprintf(out
, "}\n");
335 void decl_print(struct decl
*decl
, FILE *out
)
341 fundecl_print(decl
->data
.dfun
, out
);
344 vardecl_print(decl
->data
.dvar
, 0, out
);
347 fprintf(out
, "//<<<comp\n");
348 for (int i
= 0; i
<decl
->data
.dcomp
.ndecls
; i
++)
349 fundecl_print(decl
->data
.dcomp
.decls
[i
], out
);
350 fprintf(out
, "//>>>comp\n");
353 die("Unsupported decl node\n");
357 void stmt_print(struct stmt
*stmt
, int indent
, FILE *out
)
363 pindent(indent
, out
);
364 fprintf(out
, "%s", stmt
->data
.sassign
.ident
);
365 for (int i
= 0; i
<stmt
->data
.sassign
.nfields
; i
++)
366 fprintf(out
, ".%s", stmt
->data
.sassign
.fields
[i
]);
367 safe_fprintf(out
, " = ");
368 expr_print(stmt
->data
.sassign
.expr
, out
);
369 safe_fprintf(out
, ";\n");
372 pindent(indent
, out
);
373 safe_fprintf(out
, "if (");
374 expr_print(stmt
->data
.sif
.pred
, out
);
375 safe_fprintf(out
, ") {\n");
376 for (int i
= 0; i
<stmt
->data
.sif
.nthen
; i
++)
377 stmt_print(stmt
->data
.sif
.then
[i
], indent
+1, out
);
378 pindent(indent
, out
);
379 safe_fprintf(out
, "} else {\n");
380 for (int i
= 0; i
<stmt
->data
.sif
.nels
; i
++)
381 stmt_print(stmt
->data
.sif
.els
[i
], indent
+1, out
);
382 pindent(indent
, out
);
383 safe_fprintf(out
, "}\n");
386 pindent(indent
, out
);
387 safe_fprintf(out
, "return ");
388 expr_print(stmt
->data
.sreturn
, out
);
389 safe_fprintf(out
, ";\n");
392 pindent(indent
, out
);
393 expr_print(stmt
->data
.sexpr
, out
);
394 safe_fprintf(out
, ";\n");
397 vardecl_print(stmt
->data
.svardecl
, indent
, out
);
400 pindent(indent
, out
);
401 safe_fprintf(out
, "while (");
402 expr_print(stmt
->data
.swhile
.pred
, out
);
403 safe_fprintf(out
, ") {\n");
404 for (int i
= 0; i
<stmt
->data
.swhile
.nbody
; i
++)
405 stmt_print(stmt
->data
.swhile
.body
[i
], indent
+1, out
);
406 pindent(indent
, out
);
407 safe_fprintf(out
, "}\n");
410 die("Unsupported stmt node\n");
414 void expr_print(struct expr
*expr
, FILE *out
)
418 char buf
[] = "\\xff";
421 safe_fprintf(out
, "(");
422 expr_print(expr
->data
.ebinop
.l
, out
);
423 safe_fprintf(out
, "%s", binop_str
[expr
->data
.ebinop
.op
]);
424 expr_print(expr
->data
.ebinop
.r
, out
);
425 safe_fprintf(out
, ")");
428 safe_fprintf(out
, "%s", expr
->data
.ebool
? "true" : "false");
431 safe_fprintf(out
, "'%s'",
432 escape_char(expr
->data
.echar
, buf
, false));
435 safe_fprintf(out
, "%s(", expr
->data
.efuncall
.ident
);
436 for(int i
= 0; i
<expr
->data
.efuncall
.nargs
; i
++) {
437 expr_print(expr
->data
.efuncall
.args
[i
], out
);
438 if (i
+1 < expr
->data
.efuncall
.nargs
)
439 safe_fprintf(out
, ", ");
441 safe_fprintf(out
, ")");
442 for (int i
= 0; i
<expr
->data
.efuncall
.nfields
; i
++)
444 fieldspec_str
[expr
->data
.efuncall
.fields
[i
]]);
447 safe_fprintf(out
, "%d", expr
->data
.eint
);
450 fprintf(out
, "%s", expr
->data
.eident
.ident
);
451 for (int i
= 0; i
<expr
->data
.eident
.nfields
; i
++)
453 fieldspec_str
[expr
->data
.eident
.fields
[i
]]);
456 safe_fprintf(out
, "[]");
459 safe_fprintf(out
, "(");
460 expr_print(expr
->data
.etuple
.left
, out
);
461 safe_fprintf(out
, ", ");
462 expr_print(expr
->data
.etuple
.right
, out
);
463 safe_fprintf(out
, ")");
466 safe_fprintf(out
, "\"");
467 for (int i
= 0; i
<expr
->data
.estring
.nchars
; i
++)
468 safe_fprintf(out
, "%s", escape_char(
469 expr
->data
.estring
.chars
[i
], buf
, true));
470 safe_fprintf(out
, "\"");
473 safe_fprintf(out
, "(%s", unop_str
[expr
->data
.eunop
.op
]);
474 expr_print(expr
->data
.eunop
.l
, out
);
475 safe_fprintf(out
, ")");
478 die("Unsupported expr node\n");
482 void type_print(struct type
*type
, FILE *out
)
486 switch (type
->type
) {
488 safe_fprintf(out
, "%s", basictype_str
[type
->data
.tbasic
]);
491 safe_fprintf(out
, "[");
492 type_print(type
->data
.tlist
, out
);
493 safe_fprintf(out
, "]");
496 safe_fprintf(out
, "(");
497 type_print(type
->data
.ttuple
.l
, out
);
498 safe_fprintf(out
, ",");
499 type_print(type
->data
.ttuple
.r
, out
);
500 safe_fprintf(out
, ")");
503 safe_fprintf(out
, "%s", type
->data
.tvar
);
506 die("Unsupported type node\n");
510 void ast_free(struct ast
*ast
)
514 for (int i
= 0; i
<ast
->ndecls
; i
++)
515 decl_free(ast
->decls
[i
]);
520 void vardecl_free(struct vardecl
*decl
)
522 type_free(decl
->type
);
524 expr_free(decl
->expr
);
528 void fundecl_free(struct fundecl
*decl
)
531 for (int i
= 0; i
<decl
->nargs
; i
++)
534 for (int i
= 0; i
<decl
->natypes
; i
++)
535 type_free(decl
->atypes
[i
]);
537 type_free(decl
->rtype
);
538 for (int i
= 0; i
<decl
->nbody
; i
++)
539 stmt_free(decl
->body
[i
]);
544 void decl_free(struct decl
*decl
)
550 for (int i
= 0; i
<decl
->data
.dcomp
.ndecls
; i
++)
551 fundecl_free(decl
->data
.dcomp
.decls
[i
]);
552 free(decl
->data
.dcomp
.decls
);
555 fundecl_free(decl
->data
.dfun
);
558 vardecl_free(decl
->data
.dvar
);
561 die("Unsupported decl node\n");
566 void stmt_free(struct stmt
*stmt
)
572 free(stmt
->data
.sassign
.ident
);
573 for (int i
= 0; i
<stmt
->data
.sassign
.nfields
; i
++)
574 free(stmt
->data
.sassign
.fields
[i
]);
575 free(stmt
->data
.sassign
.fields
);
576 expr_free(stmt
->data
.sassign
.expr
);
579 expr_free(stmt
->data
.sif
.pred
);
580 for (int i
= 0; i
<stmt
->data
.sif
.nthen
; i
++)
581 stmt_free(stmt
->data
.sif
.then
[i
]);
582 free(stmt
->data
.sif
.then
);
583 for (int i
= 0; i
<stmt
->data
.sif
.nels
; i
++)
584 stmt_free(stmt
->data
.sif
.els
[i
]);
585 free(stmt
->data
.sif
.els
);
588 expr_free(stmt
->data
.sreturn
);
591 expr_free(stmt
->data
.sexpr
);
594 expr_free(stmt
->data
.swhile
.pred
);
595 for (int i
= 0; i
<stmt
->data
.swhile
.nbody
; i
++)
596 stmt_free(stmt
->data
.swhile
.body
[i
]);
597 free(stmt
->data
.swhile
.body
);
600 vardecl_free(stmt
->data
.svardecl
);
603 die("Unsupported stmt node\n");
608 void expr_free(struct expr
*expr
)
614 expr_free(expr
->data
.ebinop
.l
);
615 expr_free(expr
->data
.ebinop
.r
);
622 free(expr
->data
.efuncall
.ident
);
623 for (int i
= 0; i
<expr
->data
.efuncall
.nargs
; i
++)
624 expr_free(expr
->data
.efuncall
.args
[i
]);
625 free(expr
->data
.efuncall
.fields
);
626 free(expr
->data
.efuncall
.args
);
631 free(expr
->data
.eident
.ident
);
632 free(expr
->data
.eident
.fields
);
637 expr_free(expr
->data
.etuple
.left
);
638 expr_free(expr
->data
.etuple
.right
);
641 free(expr
->data
.estring
.chars
);
644 expr_free(expr
->data
.eunop
.l
);
647 die("Unsupported expr node\n");
652 void type_free(struct type
*type
)
656 switch (type
->type
) {
660 type_free(type
->data
.tlist
);
663 type_free(type
->data
.ttuple
.l
);
664 type_free(type
->data
.ttuple
.r
);
667 free(type
->data
.tvar
);
670 die("Unsupported type node\n");