9 static const char *binop_str
[] = {
10 [binor
] = "||", [binand
] = "&&", [eq
] = "==", [neq
] = "!=",
11 [leq
] = "<=", [le
] = "<", [geq
] = ">=", [ge
] = ">", [cons
] = ":",
12 [plus
] = "+", [minus
] = "-", [times
] = "*", [divide
] = "/",
13 [modulo
] = "%", [power
] = "^",
15 static const char *fieldspec_str
[] = {
16 [fst
] = "fst", [snd
] = "snd", [hd
] = "hd", [tl
] = "tl"};
17 static 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
*vars
, 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
.vars
= (struct vardecl
**)
51 list_to_array(vars
, &res
->data
.dfun
.nvar
, true);
52 res
->data
.dfun
.body
= (struct stmt
**)
53 list_to_array(body
, &res
->data
.dfun
.nbody
, true);
57 struct decl
*decl_var(struct vardecl
*vardecl
)
59 struct decl
*res
= safe_malloc(sizeof(struct decl
));
61 res
->data
.dvar
= vardecl
;
65 struct stmt
*stmt_assign(char *ident
, struct expr
*expr
)
67 struct stmt
*res
= safe_malloc(sizeof(struct stmt
));
69 res
->data
.sassign
.ident
= ident
;
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_while(struct expr
*pred
, struct list
*body
)
104 struct stmt
*res
= safe_malloc(sizeof(struct stmt
));
106 res
->data
.swhile
.pred
= pred
;
107 res
->data
.swhile
.body
= (struct stmt
**)
108 list_to_array(body
, &res
->data
.swhile
.nbody
, true);
112 struct expr
*expr_binop(struct expr
*l
, enum binop op
, struct expr
*r
)
114 struct expr
*res
= safe_malloc(sizeof(struct expr
));
116 res
->data
.ebinop
.l
= l
;
117 res
->data
.ebinop
.op
= op
;
118 res
->data
.ebinop
.r
= r
;
122 struct expr
*expr_bool(bool b
)
124 struct expr
*res
= safe_malloc(sizeof(struct expr
));
131 if (c
>= '0' && c
<= '9')
133 if (c
>= 'a' && c
<= 'f')
135 if (c
>= 'A' && c
<= 'F')
140 struct expr
*expr_char(const char *c
)
142 struct expr
*res
= safe_malloc(sizeof(struct expr
));
146 res
->data
.echar
= c
[1];
150 case '0': res
->data
.echar
= '\0'; break;
151 case 'a': res
->data
.echar
= '\a'; break;
152 case 'b': res
->data
.echar
= '\b'; break;
153 case 't': res
->data
.echar
= '\t'; break;
154 case 'v': res
->data
.echar
= '\v'; break;
155 case 'f': res
->data
.echar
= '\f'; break;
156 case 'r': res
->data
.echar
= '\r'; break;
160 res
->data
.echar
= (fromHex(c
[3])<<4)+fromHex(c
[4]);
164 struct expr
*expr_funcall(char *ident
, struct list
*args
)
166 struct expr
*res
= safe_malloc(sizeof(struct expr
));
167 res
->type
= efuncall
;
168 res
->data
.efuncall
.ident
= ident
;
169 res
->data
.efuncall
.args
= (struct expr
**)
170 list_to_array(args
, &res
->data
.efuncall
.nargs
, true);
174 struct expr
*expr_int(int integer
)
176 struct expr
*res
= safe_malloc(sizeof(struct expr
));
178 res
->data
.eint
= integer
;
182 struct expr
*expr_ident(char *ident
, struct list
*fields
)
184 struct expr
*res
= safe_malloc(sizeof(struct expr
));
186 res
->data
.eident
.ident
= ident
;
188 void **els
= list_to_array(fields
, &res
->data
.eident
.nfields
, true);
189 res
->data
.eident
.fields
= (enum fieldspec
*)safe_malloc(
190 res
->data
.eident
.nfields
*sizeof(enum fieldspec
));
191 for (int i
= 0; i
<res
->data
.eident
.nfields
; i
++) {
193 if (strcmp(t
, "fst") == 0)
194 res
->data
.eident
.fields
[i
] = fst
;
195 else if (strcmp(t
, "snd") == 0)
196 res
->data
.eident
.fields
[i
] = snd
;
197 else if (strcmp(t
, "hd") == 0)
198 res
->data
.eident
.fields
[i
] = hd
;
199 else if (strcmp(t
, "tl") == 0)
200 res
->data
.eident
.fields
[i
] = tl
;
207 struct expr
*expr_nil()
209 struct expr
*res
= safe_malloc(sizeof(struct expr
));
214 struct expr
*expr_tuple(struct expr
*left
, struct expr
*right
)
216 struct expr
*res
= safe_malloc(sizeof(struct expr
));
218 res
->data
.etuple
.left
= left
;
219 res
->data
.etuple
.right
= right
;
223 struct expr
*expr_unop(enum unop op
, struct expr
*l
)
225 struct expr
*res
= safe_malloc(sizeof(struct expr
));
227 res
->data
.eunop
.op
= op
;
228 res
->data
.eunop
.l
= l
;
232 struct type
*type_list(struct type
*type
)
234 struct type
*res
= safe_malloc(sizeof(struct type
));
236 res
->data
.tlist
= type
;
240 struct type
*type_tuple(struct type
*l
, struct type
*r
)
242 struct type
*res
= safe_malloc(sizeof(struct type
));
244 res
->data
.ttuple
.l
= l
;
245 res
->data
.ttuple
.r
= r
;
249 struct type
*type_var(char *ident
)
251 struct type
*res
= safe_malloc(sizeof(struct type
));
252 if (strcmp(ident
, "Int") == 0) {
254 res
->data
.tbasic
= btint
;
256 } else if (strcmp(ident
, "Char") == 0) {
258 res
->data
.tbasic
= btchar
;
260 } else if (strcmp(ident
, "Bool") == 0) {
262 res
->data
.tbasic
= btbool
;
264 } else if (strcmp(ident
, "Void") == 0) {
266 res
->data
.tbasic
= btvoid
;
270 res
->data
.tvar
= ident
;
276 const char *cescapes
[] = {
277 [0] = "\\0", [1] = "\\x01", [2] = "\\x02", [3] = "\\x03",
278 [4] = "\\x04", [5] = "\\x05", [6] = "\\x06", [7] = "\\a", [8] = "\\b",
279 [9] = "\\t", [10] = "\\n", [11] = "\\v", [12] = "\\f", [13] = "\\r",
280 [14] = "\\x0E", [15] = "\\x0F", [16] = "\\x10", [17] = "\\x11",
281 [18] = "\\x12", [19] = "\\x13", [20] = "\\x14", [21] = "\\x15",
282 [22] = "\\x16", [23] = "\\x17", [24] = "\\x18", [25] = "\\x19",
283 [26] = "\\x1A", [27] = "\\x1B", [28] = "\\x1C", [29] = "\\x1D",
284 [30] = "\\x1E", [31] = "\\x1F",
288 void ast_print(struct ast
*ast
, FILE *out
)
292 for (int i
= 0; i
<ast
->ndecls
; i
++)
293 decl_print(ast
->decls
[i
], 0, out
);
296 void vardecl_print(struct vardecl
*decl
, int indent
, FILE *out
)
298 pindent(indent
, out
);
299 if (decl
->type
== NULL
)
300 safe_fprintf(out
, "var");
302 type_print(decl
->type
, out
);
303 safe_fprintf(out
, " %s = ", decl
->ident
);
304 expr_print(decl
->expr
, out
);
305 safe_fprintf(out
, ";\n");
308 void decl_print(struct decl
*decl
, int indent
, FILE *out
)
314 pindent(indent
, out
);
315 safe_fprintf(out
, "%s (", decl
->data
.dfun
.ident
);
316 for (int i
= 0; i
<decl
->data
.dfun
.nargs
; i
++) {
317 safe_fprintf(out
, "%s", decl
->data
.dfun
.args
[i
]);
318 if (i
< decl
->data
.dfun
.nargs
- 1)
319 safe_fprintf(out
, ", ");
321 safe_fprintf(out
, ")");
322 if (decl
->data
.dfun
.rtype
!= NULL
) {
323 safe_fprintf(out
, " :: ");
324 for (int i
= 0; i
<decl
->data
.dfun
.natypes
; i
++) {
325 type_print(decl
->data
.dfun
.atypes
[i
], out
);
326 safe_fprintf(out
, " ");
328 safe_fprintf(out
, "-> ");
329 type_print(decl
->data
.dfun
.rtype
, out
);
331 safe_fprintf(out
, " {\n");
332 for (int i
= 0; i
<decl
->data
.dfun
.nvar
; i
++)
333 vardecl_print(decl
->data
.dfun
.vars
[i
], indent
+1, out
);
334 for (int i
= 0; i
<decl
->data
.dfun
.nbody
; i
++)
335 stmt_print(decl
->data
.dfun
.body
[i
], indent
+1, out
);
336 pindent(indent
, out
);
337 safe_fprintf(out
, "}\n");
340 vardecl_print(decl
->data
.dvar
, indent
, out
);
343 die("Unsupported decl node\n");
347 void stmt_print(struct stmt
*stmt
, int indent
, FILE *out
)
353 pindent(indent
, out
);
354 fprintf(out
, "%s", stmt
->data
.sassign
.ident
);
355 safe_fprintf(out
, " = ");
356 expr_print(stmt
->data
.sassign
.expr
, out
);
357 safe_fprintf(out
, ";\n");
360 pindent(indent
, out
);
361 safe_fprintf(out
, "if (");
362 expr_print(stmt
->data
.sif
.pred
, out
);
363 safe_fprintf(out
, ") {\n");
364 for (int i
= 0; i
<stmt
->data
.sif
.nthen
; i
++)
365 stmt_print(stmt
->data
.sif
.then
[i
], indent
+1, out
);
366 pindent(indent
, out
);
367 safe_fprintf(out
, "} else {\n");
368 for (int i
= 0; i
<stmt
->data
.sif
.nels
; i
++)
369 stmt_print(stmt
->data
.sif
.els
[i
], indent
+1, out
);
370 pindent(indent
, out
);
371 safe_fprintf(out
, "}\n");
374 pindent(indent
, out
);
375 safe_fprintf(out
, "return ");
376 expr_print(stmt
->data
.sreturn
, out
);
377 safe_fprintf(out
, ";\n");
380 pindent(indent
, out
);
381 expr_print(stmt
->data
.sexpr
, out
);
382 safe_fprintf(out
, ";\n");
385 pindent(indent
, out
);
386 safe_fprintf(out
, "while (");
387 expr_print(stmt
->data
.swhile
.pred
, out
);
388 safe_fprintf(out
, ") {\n");
389 for (int i
= 0; i
<stmt
->data
.swhile
.nbody
; i
++) {
390 stmt_print(stmt
->data
.swhile
.body
[i
], indent
+1, out
);
392 pindent(indent
, out
);
393 safe_fprintf(out
, "}\n");
396 die("Unsupported stmt node\n");
400 void expr_print(struct expr
*expr
, FILE *out
)
406 safe_fprintf(out
, "(");
407 expr_print(expr
->data
.ebinop
.l
, out
);
408 safe_fprintf(out
, "%s", binop_str
[expr
->data
.ebinop
.op
]);
409 expr_print(expr
->data
.ebinop
.r
, out
);
410 safe_fprintf(out
, ")");
413 safe_fprintf(out
, "%s", expr
->data
.ebool
? "true" : "false");
416 if (expr
->data
.echar
< 0)
417 safe_fprintf(out
, "'?'");
418 if (expr
->data
.echar
< ' ' || expr
->data
.echar
== 127)
419 safe_fprintf(out
, "'%s'",
420 cescapes
[(int)expr
->data
.echar
]);
422 safe_fprintf(out
, "'%c'", expr
->data
.echar
);
425 safe_fprintf(out
, "%s(", expr
->data
.efuncall
.ident
);
426 for(int i
= 0; i
<expr
->data
.efuncall
.nargs
; i
++) {
427 expr_print(expr
->data
.efuncall
.args
[i
], out
);
428 if (i
+1 < expr
->data
.efuncall
.nargs
)
429 safe_fprintf(out
, ", ");
431 safe_fprintf(out
, ")");
434 safe_fprintf(out
, "%d", expr
->data
.eint
);
437 fprintf(out
, "%s", expr
->data
.eident
.ident
);
438 for (int i
= 0; i
<expr
->data
.eident
.nfields
; i
++)
440 fieldspec_str
[expr
->data
.eident
.fields
[i
]]);
443 safe_fprintf(out
, "[]");
446 safe_fprintf(out
, "(");
447 expr_print(expr
->data
.etuple
.left
, out
);
448 safe_fprintf(out
, ", ");
449 expr_print(expr
->data
.etuple
.right
, out
);
450 safe_fprintf(out
, ")");
453 safe_fprintf(out
, "(%s", unop_str
[expr
->data
.eunop
.op
]);
454 expr_print(expr
->data
.eunop
.l
, out
);
455 safe_fprintf(out
, ")");
458 die("Unsupported expr node\n");
462 void type_print(struct type
*type
, FILE *out
)
466 switch (type
->type
) {
468 safe_fprintf(out
, "%s", basictype_str
[type
->data
.tbasic
]);
471 safe_fprintf(out
, "[");
472 type_print(type
->data
.tlist
, out
);
473 safe_fprintf(out
, "]");
476 safe_fprintf(out
, "(");
477 type_print(type
->data
.ttuple
.l
, out
);
478 safe_fprintf(out
, ",");
479 type_print(type
->data
.ttuple
.r
, out
);
480 safe_fprintf(out
, ")");
483 safe_fprintf(out
, "%s", type
->data
.tvar
);
486 die("Unsupported type node\n");
490 void ast_free(struct ast
*ast
)
494 for (int i
= 0; i
<ast
->ndecls
; i
++)
495 decl_free(ast
->decls
[i
]);
500 void vardecl_free(struct vardecl
*decl
)
502 type_free(decl
->type
);
504 expr_free(decl
->expr
);
508 void decl_free(struct decl
*decl
)
514 free(decl
->data
.dfun
.ident
);
515 for (int i
= 0; i
<decl
->data
.dfun
.nargs
; i
++)
516 free(decl
->data
.dfun
.args
[i
]);
517 free(decl
->data
.dfun
.args
);
518 for (int i
= 0; i
<decl
->data
.dfun
.natypes
; i
++)
519 type_free(decl
->data
.dfun
.atypes
[i
]);
520 free(decl
->data
.dfun
.atypes
);
521 type_free(decl
->data
.dfun
.rtype
);
522 for (int i
= 0; i
<decl
->data
.dfun
.nvar
; i
++)
523 vardecl_free(decl
->data
.dfun
.vars
[i
]);
524 free(decl
->data
.dfun
.vars
);
525 for (int i
= 0; i
<decl
->data
.dfun
.nbody
; i
++)
526 stmt_free(decl
->data
.dfun
.body
[i
]);
527 free(decl
->data
.dfun
.body
);
530 vardecl_free(decl
->data
.dvar
);
533 die("Unsupported decl node\n");
538 void stmt_free(struct stmt
*stmt
)
544 free(stmt
->data
.sassign
.ident
);
545 expr_free(stmt
->data
.sassign
.expr
);
548 expr_free(stmt
->data
.sif
.pred
);
549 for (int i
= 0; i
<stmt
->data
.sif
.nthen
; i
++)
550 stmt_free(stmt
->data
.sif
.then
[i
]);
551 free(stmt
->data
.sif
.then
);
552 for (int i
= 0; i
<stmt
->data
.sif
.nels
; i
++)
553 stmt_free(stmt
->data
.sif
.els
[i
]);
554 free(stmt
->data
.sif
.els
);
557 expr_free(stmt
->data
.sreturn
);
560 expr_free(stmt
->data
.sexpr
);
563 expr_free(stmt
->data
.swhile
.pred
);
564 for (int i
= 0; i
<stmt
->data
.swhile
.nbody
; i
++)
565 stmt_free(stmt
->data
.swhile
.body
[i
]);
566 free(stmt
->data
.swhile
.body
);
569 die("Unsupported stmt node\n");
574 void expr_free(struct expr
*expr
)
580 expr_free(expr
->data
.ebinop
.l
);
581 expr_free(expr
->data
.ebinop
.r
);
588 free(expr
->data
.efuncall
.ident
);
589 for (int i
= 0; i
<expr
->data
.efuncall
.nargs
; i
++)
590 expr_free(expr
->data
.efuncall
.args
[i
]);
591 free(expr
->data
.efuncall
.args
);
596 free(expr
->data
.eident
.ident
);
597 free(expr
->data
.eident
.fields
);
602 expr_free(expr
->data
.etuple
.left
);
603 expr_free(expr
->data
.etuple
.right
);
606 expr_free(expr
->data
.eunop
.l
);
609 die("Unsupported expr node\n");
614 void type_free(struct type
*type
)
618 switch (type
->type
) {
622 type_free(type
->data
.tlist
);
625 type_free(type
->data
.ttuple
.l
);
626 type_free(type
->data
.ttuple
.r
);
629 free(type
->data
.tvar
);
632 die("Unsupported type node\n");