From: Mart Lubbers Date: Thu, 11 Mar 2021 11:57:10 +0000 (+0100) Subject: finalise type checking, code generation X-Git-Url: https://git.martlubbers.net/?a=commitdiff_plain;h=498f74338d1c3fb93b6cdf440929b4dc1c93aa2a;p=ccc.git finalise type checking, code generation --- diff --git a/array.c b/array.c index 5ca6654..22e3772 100644 --- a/array.c +++ b/array.c @@ -4,7 +4,7 @@ #include "util.h" #include "array.h" -struct array array_null = {.nel=0, .cap=0, .el=NULL}; +const struct array array_null = {.nel=0, .cap=0, .el=NULL}; void array_init(struct array *array, size_t cap) { @@ -28,14 +28,14 @@ struct array array_append(struct array a, void *x) return a; } -//struct array array_insert(struct array a, size_t idx, void *x) -//{ -// a = array_append(a, NULL); -// for (size_t i = a.nel; i>idx; i--) -// a.el[i] = a.el[i-1]; -// a.el[idx] = x; -// return a; -//} +struct array array_insert(struct array a, size_t idx, void *x) +{ + a = array_append(a, NULL); + for (size_t i = a.nel-1; i>idx; i--) + a.el[i] = a.el[i-1]; + a.el[idx] = x; + return a; +} void array_free(struct array a, void (*freefun)(void *)) { @@ -51,3 +51,30 @@ struct array array_clean(struct array a, void (*freefun)(void *)) a.nel = 0; return a; } + +static const void *bsearchfail; +static int (*realcmp)(const void *, const void *); +static int bscmp(const void *l, const void *r) +{ + bsearchfail = r; + return realcmp(l, r); +} +struct array array_binsert(void *key, struct array a, int (*cmp)(const void *, const void *)) { + if (ARRAY_SIZE(a) == 0) + return array_append(a, key); + bsearchfail = NULL; + realcmp = cmp; + void *e = bsearch(key, a.el, a.nel, sizeof(void *), bscmp); + if (e != NULL) + return a; + size_t idx = ((intptr_t)a.el-(intptr_t)bsearchfail)/sizeof(void *); + //check if it is smaller than the smallest + if (idx == 0) { + if (cmp(key, a.el) > 0) + idx++; + } else if (idx >= a.nel) { + idx = a.nel; + } + + return array_insert(a, idx, key); +} diff --git a/array.h b/array.h index a0dac15..a3e5932 100644 --- a/array.h +++ b/array.h @@ -2,23 +2,25 @@ #define ARRAY_H #include - -#define ARRAY_EL(type, array, idx)\ - ((type)(array.el[idx])) - -#define ARRAY_ITERI(iter, a)\ - for (size_t (iter) = 0; (iter)<(a).nel; (iter)++) - -#define ARRAY_ITER(type, x, iter, a)\ - ARRAY_ITERI (iter, a) {\ +#include + +/* Select an element */ +#define ARRAY_EL(type, array, idx) ((type)((array).el[idx])) +/* Iterate over the indices of an array */ +#define ARRAY_ITERI(iter, a) for (size_t (iter) = 0; (iter)<(a).nel; (iter)++) +/* Iterate over the indices and elements of an array */ +#define ARRAY_ITER(type, x, iter, a) ARRAY_ITERI (iter, a) {\ type (x) = ARRAY_EL(type, a, iter); #define AIEND } - +/* Get the size of the array */ #define ARRAY_SIZE(a) (a).nel +/* Get a pointer to the elements of the array */ #define ARRAY_ELS(type, a) ((type *)(a).el) +#define ARRAY_BSEARCH(type, key, a, cmp) (type)bsearch(key, ARRAY_ELS(type, a),\ + ARRAY_SIZE(a), sizeof(void *), (int (*)(const void *, const void *))cmp) -extern struct array array_null; +extern const struct array array_null; struct array { size_t nel; @@ -44,4 +46,7 @@ void array_free(struct array, void (*freefun)(void *)); //* free all element and keep the array struct array array_clean(struct array array, void (*freefun)(void *)); +//* insert an item in a sorted array +struct array array_binsert(void *key, struct array a, int (*cmp)(const void *, const void *)); + #endif diff --git a/ast.c b/ast.c index 8af8fe1..677153c 100644 --- a/ast.c +++ b/ast.c @@ -329,11 +329,11 @@ void decl_print(struct decl *decl, FILE *out) vardecl_print(decl->data.dvar, 0, out); break; case dcomp: - fprintf(out, "//<<data.dcomp) fundecl_print(d, out); AIEND - fprintf(out, "//>>>comp\n"); + safe_fprintf(out, "//>>>comp\n"); break; default: die("Unsupported decl node\n"); @@ -347,9 +347,9 @@ void stmt_print(struct stmt *stmt, int indent, FILE *out) switch(stmt->type) { case sassign: pindent(indent, out); - fprintf(out, "%s", stmt->data.sassign.ident); + safe_fprintf(out, "%s", stmt->data.sassign.ident); ARRAY_ITER(char *, f, i, stmt->data.sassign.fields) - fprintf(out, ".%s", f); + safe_fprintf(out, ".%s", f); AIEND safe_fprintf(out, " = "); expr_print(stmt->data.sassign.expr, out); @@ -452,14 +452,14 @@ static void expr_print2(struct expr *expr, FILE *out, struct ctx ctx) case ebinop: this = binop_ctx[expr->data.ebinop.op]; if (brace(this, ctx)) - fprintf(out, "("); + safe_fprintf(out, "("); this.branch = left; expr_print2(expr->data.ebinop.l, out, this); safe_fprintf(out, " %s ", binop_str[expr->data.ebinop.op]); this.branch = right; expr_print2(expr->data.ebinop.r, out, this); if (brace(this, ctx)) - fprintf(out, ")"); + safe_fprintf(out, ")"); break; case ebool: safe_fprintf(out, "%s", expr->data.ebool ? "true" : "false"); @@ -487,7 +487,7 @@ static void expr_print2(struct expr *expr, FILE *out, struct ctx ctx) safe_fprintf(out, "%d", expr->data.eint); break; case eident: - fprintf(out, "%s", expr->data.eident); + safe_fprintf(out, "%s", expr->data.eident); break; case enil: safe_fprintf(out, "[]"); @@ -509,12 +509,12 @@ static void expr_print2(struct expr *expr, FILE *out, struct ctx ctx) case eunop: this = unop_ctx[expr->data.eunop.op]; if (brace(this, ctx)) - fprintf(out, "("); + safe_fprintf(out, "("); safe_fprintf(out, "%s", unop_str[expr->data.eunop.op]); this.branch = right; expr_print2(expr->data.eunop.l, out, this); if (brace(this, ctx)) - fprintf(out, ")"); + safe_fprintf(out, ")"); break; default: die("Unsupported expr node\n"); diff --git a/genc.c b/genc.c index abf1ee3..cdcba6e 100644 --- a/genc.c +++ b/genc.c @@ -1,20 +1,46 @@ #include #include +#include #include "ast.h" +#include "sem.h" -void expr_genc(struct expr *expr, FILE *cout); +struct gencst { + struct array printtypes; // struct type * +}; +static void expr_genc(struct gencst *st, struct expr *expr, FILE *cout); -static void binop_genc(char *fun, struct expr *l, struct expr *r, FILE *cout) +static void binop_genc(struct gencst *st, char *fun, struct expr *l, struct expr *r, FILE *cout) { safe_fprintf(cout, "%s(", fun); - expr_genc(l, cout); + expr_genc(st, l, cout); safe_fprintf(cout, ", "); - expr_genc(r, cout); + expr_genc(st, r, cout); safe_fprintf(cout, ")"); } -static void call_print_type(struct type *type, FILE *cout) +static int type_cmpv(const void *l, const void *r) +{ + return type_cmp((struct type *)l, *(void **)r); +} + +static void call_print_register(struct gencst *st, struct type *type) +{ + st->printtypes = array_binsert(type, st->printtypes, type_cmpv); + switch(type->type) { + case tlist: + call_print_register(st, type->data.tlist); + break; + case ttuple: + call_print_register(st, type->data.ttuple.l); + call_print_register(st, type->data.ttuple.r); + break; + default: + break; + } +} + +static void call_print_type(YYLTYPE loc, struct type *type, FILE *cout) { switch(type->type) { case tarrow: @@ -25,38 +51,38 @@ static void call_print_type(struct type *type, FILE *cout) break; case tlist: safe_fprintf(cout, "l"); - call_print_type(type->data.tlist, cout); + call_print_type(loc, type->data.tlist, cout); break; case ttuple: safe_fprintf(cout, "t"); - type_print(type->data.ttuple.l, cout); - type_print(type->data.ttuple.r, cout); + call_print_type(loc, type->data.ttuple.l, cout); + call_print_type(loc, type->data.ttuple.r, cout); safe_fprintf(cout, "t"); break; case tvar: - die("cannot print overloaded types???"); + type_error(loc, true, "cannot print overloaded types???"); break; } } -void expr_genc(struct expr *expr, FILE *cout) +static void expr_genc(struct gencst *st, struct expr *expr, FILE *cout) { char buf[] = "\\x55"; if (expr == NULL) return; switch(expr->type) { case ebinop: - if (expr->type == ebinop && expr->data.ebinop.op == cons) { - binop_genc("splc_cons", expr->data.ebinop.l, + if (expr->data.ebinop.op == cons) { + binop_genc(st, "splc_cons", expr->data.ebinop.l, expr->data.ebinop.r, cout); - } else if (expr->type == ebinop && expr->data.ebinop.op == power) { - binop_genc("splc_power", expr->data.ebinop.l, + } else if (expr->data.ebinop.op == power) { + binop_genc(st, "splc_power", expr->data.ebinop.l, expr->data.ebinop.r, cout); } else { safe_fprintf(cout, "("); - expr_genc(expr->data.ebinop.l, cout); + expr_genc(st, expr->data.ebinop.l, cout); safe_fprintf(cout, "%s", binop_str[expr->data.ebinop.op]); - expr_genc(expr->data.ebinop.r, cout); + expr_genc(st, expr->data.ebinop.r, cout); safe_fprintf(cout, ")"); } break; @@ -69,14 +95,15 @@ void expr_genc(struct expr *expr, FILE *cout) break; case efuncall: if (strcmp(expr->data.efuncall.ident, "print") == 0) { - fprintf(cout, "print_"); - call_print_type(expr->data.efuncall.type, cout); + safe_fprintf(cout, "print_"); + call_print_register(st, expr->data.efuncall.type); + call_print_type(expr->loc, expr->data.efuncall.type, cout); } else { safe_fprintf(cout, "%s", expr->data.efuncall.ident); } safe_fprintf(cout, "("); ARRAY_ITER(struct expr *, e, i, expr->data.efuncall.args) { - expr_genc(e, cout); + expr_genc(st, e, cout); if (i+1 < ARRAY_SIZE(expr->data.efuncall.args)) safe_fprintf(cout, ", "); } AIEND @@ -86,13 +113,13 @@ void expr_genc(struct expr *expr, FILE *cout) safe_fprintf(cout, "%d", expr->data.eint); break; case eident: - fprintf(cout, "%s", expr->data.eident); + safe_fprintf(cout, "%s", expr->data.eident); break; case enil: safe_fprintf(cout, "NULL"); break; case etuple: - binop_genc("splc_tuple", expr->data.etuple.left, + binop_genc(st, "splc_tuple", expr->data.etuple.left, expr->data.etuple.right, cout); break; case estring: @@ -104,7 +131,7 @@ void expr_genc(struct expr *expr, FILE *cout) break; case eunop: safe_fprintf(cout, "(%s", unop_str[expr->data.eunop.op]); - expr_genc(expr->data.eunop.l, cout); + expr_genc(st, expr->data.eunop.l, cout); safe_fprintf(cout, ")"); break; default: @@ -112,23 +139,25 @@ void expr_genc(struct expr *expr, FILE *cout) } } -void type_genc(struct type *type, FILE *cout) +static void type_genc(struct type *type, FILE *cout) { - if (type == NULL) - die("unresolved var type\n"); + if (type == NULL) { + safe_fprintf(cout, "WORD "); + return; + } switch(type->type) { case tbasic: - fprintf(cout, "%s ", - type->data.tbasic == btvoid ? "void" : "WORD"); + safe_fprintf(cout, "%s ", type->data.tbasic == btvoid + ? "void" : "WORD"); break; case tlist: - fprintf(cout, "struct splc_list *"); + safe_fprintf(cout, "struct splc_list *"); break; case ttuple: - fprintf(cout, "struct splc_tuple *"); + safe_fprintf(cout, "struct splc_tuple *"); break; case tvar: - fprintf(cout, "WORD "); + safe_fprintf(cout, "WORD "); break; case tarrow: die("Arrows cannot be generated\n"); @@ -138,44 +167,44 @@ void type_genc(struct type *type, FILE *cout) } } -void vardecl_genc(struct vardecl *vardecl, int indent, FILE *cout) +static void vardecl_genc(struct gencst *st, struct vardecl *vardecl, int indent, FILE *cout) { if (vardecl == NULL) return; pindent(indent, cout); type_genc(vardecl->type, cout); - fprintf(cout, "%s = ", vardecl->ident); - expr_genc(vardecl->expr, cout); - fprintf(cout, ";\n"); + safe_fprintf(cout, "%s = ", vardecl->ident); + expr_genc(st, vardecl->expr, cout); + safe_fprintf(cout, ";\n"); } -void stmt_genc(struct stmt *stmt, int indent, FILE *cout) +static void stmt_genc(struct gencst *st, struct stmt *stmt, int indent, FILE *cout) { if (stmt == NULL) return; switch(stmt->type) { case sassign: pindent(indent, cout); - fprintf(cout, "%s", stmt->data.sassign.ident); + safe_fprintf(cout, "%s", stmt->data.sassign.ident); ARRAY_ITER(char *, f, i, stmt->data.sassign.fields) - fprintf(cout, "->%s", f); + safe_fprintf(cout, "->%s", f); AIEND safe_fprintf(cout, " = "); - expr_genc(stmt->data.sassign.expr, cout); + expr_genc(st, stmt->data.sassign.expr, cout); safe_fprintf(cout, ";\n"); break; case sif: pindent(indent, cout); safe_fprintf(cout, "if ("); - expr_genc(stmt->data.sif.pred, cout); + expr_genc(st, stmt->data.sif.pred, cout); safe_fprintf(cout, ") {\n"); ARRAY_ITER(struct stmt *, s, i, stmt->data.sif.then) - stmt_genc(s, indent+1, cout); + stmt_genc(st, s, indent+1, cout); AIEND pindent(indent, cout); safe_fprintf(cout, "} else {\n"); ARRAY_ITER(struct stmt *, s, i, stmt->data.sif.els) - stmt_genc(s, indent+1, cout); + stmt_genc(st, s, indent+1, cout); AIEND pindent(indent, cout); safe_fprintf(cout, "}\n"); @@ -183,24 +212,24 @@ void stmt_genc(struct stmt *stmt, int indent, FILE *cout) case sreturn: pindent(indent, cout); safe_fprintf(cout, "return "); - expr_genc(stmt->data.sreturn, cout); + expr_genc(st, stmt->data.sreturn, cout); safe_fprintf(cout, ";\n"); break; case sexpr: pindent(indent, cout); - expr_genc(stmt->data.sexpr, cout); + expr_genc(st, stmt->data.sexpr, cout); safe_fprintf(cout, ";\n"); break; case svardecl: - vardecl_genc(stmt->data.svardecl, indent, cout); + vardecl_genc(st, stmt->data.svardecl, indent, cout); break; case swhile: pindent(indent, cout); safe_fprintf(cout, "while ("); - expr_genc(stmt->data.swhile.pred, cout); + expr_genc(st, stmt->data.swhile.pred, cout); safe_fprintf(cout, ") {\n"); ARRAY_ITER(struct stmt *, s, i, stmt->data.swhile.body) - stmt_genc(s, indent+1, cout); + stmt_genc(st, s, indent+1, cout); AIEND pindent(indent, cout); safe_fprintf(cout, "}\n"); @@ -210,7 +239,7 @@ void stmt_genc(struct stmt *stmt, int indent, FILE *cout) } } -void fundecl_sig(struct fundecl *decl, FILE *cout) +static void fundecl_sig(struct fundecl *decl, FILE *cout) { type_genc(decl->rtype, cout); safe_fprintf(cout, "%s (", decl->ident); @@ -225,17 +254,17 @@ void fundecl_sig(struct fundecl *decl, FILE *cout) safe_fprintf(cout, ")"); } -void fundecl_genc(struct fundecl *decl, FILE *cout) +static void fundecl_genc(struct gencst *st, struct fundecl *decl, FILE *cout) { fundecl_sig(decl, cout); safe_fprintf(cout, "{\n"); ARRAY_ITER(struct stmt *, s, i, decl->body) - stmt_genc(s, 1, cout); + stmt_genc(st, s, 1, cout); AIEND safe_fprintf(cout, "}\n"); } -void decl_genc(struct decl *decl, FILE *cout) +static void decl_genc(struct gencst *st, struct decl *decl, FILE *cout) { switch (decl->type) { case dcomp: @@ -246,23 +275,79 @@ void decl_genc(struct decl *decl, FILE *cout) AIEND } ARRAY_ITER(struct fundecl *, d, i, decl->data.dcomp) - fundecl_genc(d, cout); + fundecl_genc(st, d, cout); AIEND break; case dfundecl: die("fundecls should be gone by now\n"); break; case dvardecl: - vardecl_genc(decl->data.dvar, 0, cout); + vardecl_genc(st, decl->data.dvar, 0, cout); + break; + } +} + +static void generate_print_body(struct type *type, FILE *cout) +{ + YYLTYPE loc; + switch(type->type) { + case tbasic: + safe_fprintf(cout, "\tprint_"); + call_print_type(loc, type, cout); + safe_fprintf(cout, ");\n"); + break; + case tlist: + safe_fprintf(cout, "\tprintf(\"[\");\n"); + safe_fprintf(cout, "\twhile(t != NULL) {\n"); + safe_fprintf(cout, "\t\tprint_"); + call_print_type(loc, type->data.tlist, cout); + safe_fprintf(cout, "(t->hd);\n"); + safe_fprintf(cout, "\t\tif (t->tl != NULL) printf(\", \");\n"); + safe_fprintf(cout, "\t\tt = t->tl;\n"); + safe_fprintf(cout, "\t}\n"); + safe_fprintf(cout, "\tprintf(\"]\");\n"); + break; + case ttuple: + safe_fprintf(cout, "\tprintf(\"(\");\n"); + safe_fprintf(cout, "\tprint_"); + call_print_type(loc, type->data.ttuple.l, cout); + safe_fprintf(cout, "(t->fst);\n"); + safe_fprintf(cout, "\tprintf(\",\");\n"); + safe_fprintf(cout, "\tprint_"); + call_print_type(loc, type->data.ttuple.r, cout); + safe_fprintf(cout, "(t->snd);\n"); + safe_fprintf(cout, "\tprintf(\")\");\n"); + break; + default: break; } } +static void generate_print(struct type *type, FILE *cout) +{ + if (type->type == tbasic) + return; + + safe_fprintf(cout, "void print_"); + YYLTYPE loc; + call_print_type(loc, type, cout); + safe_fprintf(cout, "("); + type_genc(type, cout); + safe_fprintf(cout, " t) {\n"); + generate_print_body(type, cout); + safe_fprintf(cout, "}\n"); +} + void genc(struct ast *ast, FILE *cout) { - fprintf(cout, "#include \"rts.h\"\n"); + safe_fprintf(cout, "#include \"rts.h\"\n"); + struct gencst st = {.printtypes = array_null}; for (int i = 0; indecls; i++) { - fprintf(cout, "\n"); - decl_genc(ast->decls[i], cout); + safe_fprintf(cout, "\n"); + decl_genc(&st, ast->decls[i], cout); } + ARRAY_ITER(struct type *, t, i, st.printtypes) { + generate_print(t, cout); + } AIEND + array_free(st.printtypes, NULL); } diff --git a/ident.c b/ident.c index 2abf4a7..39b899a 100644 --- a/ident.c +++ b/ident.c @@ -34,9 +34,9 @@ struct ident ident_dup(struct ident i) void ident_print(struct ident i, FILE *out) { if (i.type == istr) - fprintf(out, "%s", i.data.istr); + safe_fprintf(out, "%s", i.data.istr); else - fprintf(out, "%d", i.data.iint); + safe_fprintf(out, "%d", i.data.iint); } void ident_free(struct ident i) diff --git a/input.txt b/input.txt index db93041..966a6bb 100644 --- a/input.txt +++ b/input.txt @@ -1,41 +1,19 @@ -var x = 5 == 5; -var y = x; -fun(x){ - var x = 5; - Int y = 6; - 6; - x.fst = 5; - 6; - if(true){5;}else{5;} - '\t'; - '\''; - '\\'; - '\x01'; - '\xaa'; - "abr"; - "a\br"; - "a\br\""; - "a\xaar\\\0377\01\xa"; - Int b = 5; - while(true) { - Bool b = true; - var l = []; - 5; - } -return 5; -f(); -f(x); f(1, 2, []); -y = 5+x.fst.snd; +take (n, xs) { + if (len(xs) < 0 && n < 0) { + return hd(xs) : take(n - 1, tl(xs)); + } else { + return []; + } } -fun(x) :: Int Bool -> Int { +len (x) { + Int r = 0; + while (!isEmpty(x)) { + r = r + 1; + x = tl(x); + } + return r; } -fun(x) :: -> Void { + +main () { } -fun(x) :: /* abc */ a b c [a] ([a], b) -> Void { -} -/* abc */ -/* -*/ -//abc -var y = 0; -//blurp + diff --git a/parse.y b/parse.y index 40b4b1d..8d53296 100644 --- a/parse.y +++ b/parse.y @@ -12,7 +12,7 @@ extern YYLTYPE yylloc; void yyerror(struct ast **result, const char *str) { (void)result; - fprintf(stderr, "%d-%d: %s\n", yylloc.first_line, yylloc.last_column, str); + safe_fprintf(stderr, "%d-%d: %s\n", yylloc.first_line, yylloc.last_column, str); } int yywrap() diff --git a/rts/rts.c b/rts/rts.c index c34cdf5..d7f9180 100644 --- a/rts/rts.c +++ b/rts/rts.c @@ -7,26 +7,25 @@ void *splc_malloc(size_t size) { void *res = malloc(sizeof(void *)+size); - res++; - REFC(res) = 0; + //res++; + //REFC(res) = 0; return res; } - void splc_free(void *ptr) { - REFC(ptr)--; - if (REFC(ptr) == 0) - free(ptr-1); + free(ptr); +// REFC(ptr)--; +// if (REFC(ptr) == 0) +// free(ptr-1); } - struct splc_tuple *splc_tuple(WORD fst, WORD snd) { - struct splc_tuple *res = splc_malloc(sizeof(splc_tuple)); + struct splc_tuple *res = splc_malloc(sizeof(struct splc_tuple)); res->fst = fst; res->snd = snd; return res; } struct splc_list *splc_cons(WORD hd, struct splc_list *tl) { - struct splc_list *res = splc_malloc(sizeof(splc_tuple)); + struct splc_list *res = splc_malloc(sizeof(struct splc_tuple)); res->hd = hd; res->tl = tl; return res; diff --git a/rts/rts.h b/rts/rts.h index 5de6bb9..2fc07d4 100644 --- a/rts/rts.h +++ b/rts/rts.h @@ -3,11 +3,15 @@ #include #include +#include +#include #define WORD intptr_t struct splc_tuple { WORD fst; WORD snd; }; struct splc_list { WORD hd; struct splc_list *tl; }; +struct splc_tuple *splc_tuple(WORD fst, WORD snd); +struct splc_list *splc_cons(WORD hd, struct splc_list *tl); void print_Int(WORD l); void print_Char(WORD l); diff --git a/sem.c b/sem.c index 510a77a..490dfa0 100644 --- a/sem.c +++ b/sem.c @@ -12,8 +12,8 @@ void type_error(YYLTYPE l, bool d, const char *msg, ...) { va_list ap; va_start(ap, msg); - fprintf(stderr, "Type error\n%d-%d: ", l.first_line, l.first_column); - vfprintf(stderr, msg, ap); + safe_fprintf(stderr, "Type error\n%d-%d: ", l.first_line, l.first_column); + safe_vfprintf(stderr, msg, ap); va_end(ap); if (d) die(""); @@ -102,6 +102,8 @@ static void patch_overload_stmt(struct subst *subst, struct stmt *stmt) patch_overload_expr(subst, stmt->data.sexpr); break; case svardecl: + stmt->data.svardecl->type = subst_apply_t(subst, + stmt->data.svardecl->type); patch_overload_expr(subst, stmt->data.svardecl->expr); break; case swhile: @@ -131,7 +133,6 @@ static void type_comp(struct gamma *gamma, struct array decl) ARRAY_EL(struct fundecl *, decl, i), subst_apply_t(s0, fs[i])); s0 = subst_union(s1, s0); - subst_apply_g(s0, gamma); } //Generalise all functions and put in gamma @@ -254,9 +255,8 @@ static void add_return_if_none(struct array decl) AIEND } -bool checkmain (struct fundecl *d) +static bool checkmain (struct fundecl *d) { - fprintf(stderr, "%s\n", d->ident); if (strcmp(d->ident, "main") == 0) { if (ARRAY_SIZE(d->args) != 0) type_error(d->loc, true, "main cannot have arguments"); diff --git a/sem/hm.c b/sem/hm.c index 000abcd..6d5a4c5 100644 --- a/sem/hm.c +++ b/sem/hm.c @@ -57,7 +57,7 @@ struct subst *unify(YYLTYPE loc, struct type *l, struct type *r) } else { type_error(loc, false, "cannot unify "); type_print(l, stderr); - fprintf(stderr, " with "); + safe_fprintf(stderr, " with "); type_print(r, stderr); die("\n"); } @@ -277,7 +277,7 @@ struct subst *infer_stmt(struct gamma *gamma, struct stmt *stmt, struct type *ty return s0; case sif: s0 = infer_expr(gamma, stmt->data.sif.pred, &tybool); - //subst_apply_g(s0, gamma); + subst_apply_g(s0, gamma); s0 = subst_union(s0, infer_body(gamma, stmt->data.sif.then, type)); @@ -286,9 +286,9 @@ struct subst *infer_stmt(struct gamma *gamma, struct stmt *stmt, struct type *ty infer_body(gamma, stmt->data.sif.els, type)); return s0; case sreturn: - return stmt->data.sreturn == NULL - ? unify(stmt->loc, &tyvoid, type) - : infer_expr(gamma, stmt->data.sreturn, type); + if (stmt->data.sreturn == NULL) + return unify(stmt->loc, &tyvoid, type); + return infer_expr(gamma, stmt->data.sreturn, type); case sexpr: f1 = gamma_fresh(gamma); s0 = infer_expr(gamma, stmt->data.sexpr, f1); @@ -297,18 +297,21 @@ struct subst *infer_stmt(struct gamma *gamma, struct stmt *stmt, struct type *ty case svardecl: f1 = gamma_fresh(gamma); s0 = infer_expr(gamma, stmt->data.svardecl->expr, f1); - if (stmt->data.svardecl->type != NULL) + if (stmt->data.svardecl->type != NULL) { s1 = unify(stmt->loc, f1, stmt->data.svardecl->type); - else + type_free(f1); + f1 = stmt->data.svardecl->type; + } else { s1 = subst_id(); + } s0 = subst_union(s1, s0); + stmt->data.svardecl->type = subst_apply_t(s0, f1); gamma_insert(gamma, ident_str(stmt->data.svardecl->ident), - scheme_create(subst_apply_t(s0, f1))); - type_free(f1); + scheme_create(stmt->data.svardecl->type)); return s0; case swhile: s0 = infer_expr(gamma, stmt->data.swhile.pred, &tybool); - //subst_apply_g(s0, gamma); + subst_apply_g(s0, gamma); s0 = subst_union(s0, infer_body(gamma, stmt->data.swhile.body, type)); @@ -336,7 +339,6 @@ struct subst *infer_fundecl(struct gamma *gamma, struct fundecl *fundecl, struct ARRAY_ITER(struct stmt *, st, i, fundecl->body) { struct subst *s1 = infer_stmt(gamma, st, at); s = subst_union(s1, s); - subst_apply_g(s, gamma); } AIEND // Remove arguments from gamma diff --git a/sem/hm/gamma.c b/sem/hm/gamma.c index 1dcad70..08081d5 100644 --- a/sem/hm/gamma.c +++ b/sem/hm/gamma.c @@ -105,15 +105,15 @@ struct type *gamma_fresh(struct gamma *gamma) void gamma_print(struct gamma *gamma, FILE *out) { - fprintf(out, "{"); + safe_fprintf(out, "{"); for (int i = 0; inentries; i++) { ident_print(gamma->entries[i].var, out); - fprintf(out, "(%d) = ", gamma->entries[i].scope); + safe_fprintf(out, "(%d) = ", gamma->entries[i].scope); scheme_print(gamma->entries[i].scheme, out); if (i + 1 < gamma->nentries) - fprintf(out, ", "); + safe_fprintf(out, ", "); } - fprintf(out, "}"); + safe_fprintf(out, "}"); } void gamma_free(struct gamma *gamma) diff --git a/sem/hm/scheme.c b/sem/hm/scheme.c index ee10c7d..6cf356c 100644 --- a/sem/hm/scheme.c +++ b/sem/hm/scheme.c @@ -50,17 +50,17 @@ struct scheme *scheme_generalise(struct gamma *gamma, struct type *t) void scheme_print(struct scheme *scheme, FILE *out) { if (scheme == NULL) { - fprintf(out, "NULLSCHEME"); + safe_fprintf(out, "NULLSCHEME"); return; } if (scheme->nvar > 0) { - fprintf(out, "A."); + safe_fprintf(out, "A."); for (int i = 0; invar; i++) { if (i > 0) - fprintf(out, " "); + safe_fprintf(out, " "); ident_print(scheme->var[i], stderr); } - fprintf(out, ": "); + safe_fprintf(out, ": "); } type_print(scheme->type, out); } diff --git a/sem/hm/subst.c b/sem/hm/subst.c index aae1d5d..fdea48d 100644 --- a/sem/hm/subst.c +++ b/sem/hm/subst.c @@ -30,13 +30,6 @@ static inline void subst_increase_cap(struct subst *s) } } -static const void *bsearchfail; -static int idententrycmp(const void *l, const void *r) -{ - bsearchfail = r; - return ident_cmp(*(struct ident *)l, ((struct subst_entry *)r)->var); -} - struct subst *subst_insert(struct subst *s, struct ident ident, struct type *t) { size_t idx; @@ -48,25 +41,26 @@ struct subst *subst_insert(struct subst *s, struct ident ident, struct type *t) idx = s->nvar; subst_increase_cap(s); } else { - //See if it is already in here - bsearchfail = NULL; - struct subst_entry *e = bsearch(&ident, s->entries, s->nvar, - sizeof(struct subst_entry), idententrycmp); - if (e != NULL) { - type_free(e->type); - e->type = type_dup(t); - return s; - } - idx = ((intptr_t)s->entries-(intptr_t)bsearchfail) - /sizeof(struct subst_entry); - //check if it is smaller than the smallest - if (idx == 0) { - if (ident_cmp(ident, s->entries[0].var) > 0) - idx++; - } else if (idx >= s->nvar) - idx = s->nvar; - + size_t low = 0; + size_t high = s->nvar; + idx = low/s->nvar/2; + do { + idx = (low+high)/2; + int c = ident_cmp(ident, s->entries[idx].var); + if (c == 0) { + type_free(s->entries[idx].type); + s->entries[idx].type = type_dup(t); + return s; + } else if (c > 0) { + low = idx; + } else if (c < 0) { + high = idx; + } + } while (idx != (low+high)/2); subst_increase_cap(s); + if (idx != 0 || ident_cmp(ident, s->entries[idx].var) > 0) + idx++; + for (size_t i = s->nvar; i>idx; i--) s->entries[i] = s->entries[i-1]; } @@ -162,17 +156,17 @@ struct gamma *subst_apply_g(struct subst *subst, struct gamma *gamma) void subst_print(struct subst *s, FILE *out) { if (s == NULL) { - fprintf(out, "(nil)"); + safe_fprintf(out, "(nil)"); } else { - fprintf(out, "["); + safe_fprintf(out, "["); for (size_t i = 0; invar; i++) { ident_print(s->entries[i].var, out); - fprintf(out, "->"); + safe_fprintf(out, "->"); type_print(s->entries[i].type, out); if (i + 1 < s->nvar) - fprintf(out, ", "); + safe_fprintf(out, ", "); } - fprintf(out, "]"); + safe_fprintf(out, "]"); } } diff --git a/splc.c b/splc.c index 834797d..9b58990 100644 --- a/splc.c +++ b/splc.c @@ -11,7 +11,7 @@ extern int yylex_destroy(void); void usage(FILE *out, char *arg0) { - fprintf(out, + safe_fprintf(out, "Usage: %s [OPTS] [FILE]\n" "\n" "Compile an spl file. If FILE is not specified stdin is used.\n" @@ -75,14 +75,14 @@ int main(int argc, char *argv[]) yylex_destroy(); if (r != 0) return r; - fprintf(stderr, "lexical and syntactical done\n"); + safe_fprintf(stderr, "lexical and syntactical done\n"); if (pparse) ast_print(result, stdout); //Typecheck if ((result = sem(result)) == NULL) return 1; - fprintf(stderr, "semantic analyses done\n"); + safe_fprintf(stderr, "semantic analyses done\n"); if (ptype) ast_print(result, stdout); @@ -99,7 +99,7 @@ int main(int argc, char *argv[]) die("unsupported language\n"); } safe_fclose(cout); - fprintf(stderr, "code generation* done\n"); + safe_fprintf(stderr, "code generation* done\n"); ast_free(result); return r; } diff --git a/test/Makefile b/test/Makefile deleted file mode 100644 index faaff6a..0000000 --- a/test/Makefile +++ /dev/null @@ -1,19 +0,0 @@ -TESTOBJECTS:=$(patsubst %.c,%.o,$(wildcard *.c)) -TESTS:=$(patsubst %.o,%,$(TESTOBJECTS)) - -LDLIBS+=$(shell pkg-config --libs check) - -.PHONY: test - -test_sem_hm_gamma.o: CFLAGS+=$(shell pkg-config --cflags check) - -test_sem_hm_gamma: test_sem_hm_gamma.o $(addprefix ../sem/hm/,gamma.o scheme.o subst.o) ../util.o ../type.o - -test: $(TESTS) - $(foreach f,$^,./$(f);) - -clean: - $(RM) $(TESTOBJECTS) $(TESTS) -ifeq ($(MAKELEVEL), 0) - $(MAKE) -C ../ clean -endif diff --git a/test/test_sem_hm_gamma.c b/test/test_sem_hm_gamma.c deleted file mode 100644 index 4005e38..0000000 --- a/test/test_sem_hm_gamma.c +++ /dev/null @@ -1,97 +0,0 @@ -#include -#include -#include - -#include "../sem/hm/gamma.h" -#include "../sem/hm/subst.h" -#include "../sem/hm/scheme.h" - -START_TEST(test_gamma_lookup) -{ - struct gamma *gamma = gamma_init(); - - ck_assert_ptr_null(gamma_lookup(gamma, "fun")); - ck_assert_ptr_null(gamma_lookup(gamma, "fun2")); - - gamma_insert(gamma, "fun", scheme_generalise(gamma, type_basic(btint))); - - ck_assert_ptr_nonnull(gamma_lookup(gamma, "fun")); - ck_assert_ptr_null(gamma_lookup(gamma, "fun2")); - - struct type *t1 = gamma_fresh(gamma); - ck_assert(t1->type == tvar); - struct type *t2 = gamma_fresh(gamma); - ck_assert(t2->type == tvar); - struct type *t3 = gamma_fresh(gamma); - ck_assert(t3->type == tvar); - struct type *t4 = gamma_fresh(gamma); - ck_assert(t4->type == tvar); - - ck_assert_str_ne(t1->data.tvar, t2->data.tvar); - ck_assert_str_ne(t2->data.tvar, t3->data.tvar); - ck_assert_str_ne(t3->data.tvar, t4->data.tvar); -} -END_TEST - -START_TEST(test_scheme) -{ - struct gamma *gamma = gamma_init(); - - char **var = malloc(sizeof(char *)); - var[0] = safe_strdup("a"); - struct scheme scheme = {.type=type_var_str("a"), .nvar=1, .var=var}; - - struct type *t = scheme_instantiate(gamma, &scheme); - ck_assert(t->type == tvar); - ck_assert_str_eq(t->data.tvar, "0"); - - scheme.type = type_list(type_var("a")); - t = scheme_instantiate(gamma, &scheme); - ck_assert(t->type == tlist); - ck_assert(t->data.tlist->type == tvar); - ck_assert_str_eq(t->data.tlist->data.tvar, "1"); -} -END_TEST - -START_TEST(test_subst) -{ - struct subst *s1 = subst_id(); - ck_assert_int_eq(0, s1->nvar); - s1 = subst_singleton("i1", type_basic(btint)); - ck_assert_int_eq(1, s1->nvar); - s1 = subst_union(subst_id(), subst_singleton("i1", type_basic(btint))); - ck_assert_int_eq(1, s1->nvar); - s1 = subst_union(subst_singleton("i2", type_basic(btbool)), - subst_singleton("i1", type_basic(btint))); - ck_assert_int_eq(2, s1->nvar); - -} -END_TEST - -Suite *util_suite(void) -{ - Suite *s = suite_create("List"); - - TCase *tc_gamma = tcase_create("Gamma lookup"); - tcase_add_test(tc_gamma, test_gamma_lookup); - tcase_add_test(tc_gamma, test_scheme); - tcase_add_test(tc_gamma, test_subst); - suite_add_tcase(s, tc_gamma); - - return s; -} - -int main(void) -{ - int failed; - Suite *s; - SRunner *sr; - - s = util_suite(); - sr = srunner_create(s); - - srunner_run_all(sr, CK_NORMAL); - failed = srunner_ntests_failed(sr); - srunner_free(sr); - return (failed == 0) ? EXIT_SUCCESS : EXIT_FAILURE; -} diff --git a/type.c b/type.c index 29e20fc..6837123 100644 --- a/type.c +++ b/type.c @@ -196,3 +196,34 @@ void type_ftv(struct type *r, int *nftv, struct ident **ftv) die("Unsupported type node: %d\n", r->type); } } + +int type_cmp(struct type *l, struct type *r) +{ + if (l == NULL) + return r == NULL ? 0 : -1; + if (r == NULL) + return 1; + if (l->type != r->type) + return l->type-r->type; + int res = 0; + switch(l->type) { + case tarrow: + if ((res = type_cmp(l->data.tarrow.l, r->data.tarrow.l)) != 0) + res = type_cmp(l->data.tarrow.r, r->data.tarrow.r); + break; + case tbasic: + res = l->data.tbasic - r->data.tbasic; + break; + case tlist: + res = type_cmp(l->data.tlist, r->data.tlist); + break; + case ttuple: + if ((res = type_cmp(l->data.ttuple.l, r->data.ttuple.l)) != 0) + res = type_cmp(l->data.ttuple.r, r->data.ttuple.r); + break; + case tvar: + res = ident_cmp(l->data.tvar, r->data.tvar); + break; + } + return res; +} diff --git a/type.h b/type.h index e37ca1e..d7e55ae 100644 --- a/type.h +++ b/type.h @@ -35,6 +35,8 @@ struct type *type_var_int(int i); void type_print(struct type *type, FILE *stream); void type_free(struct type *type); +int type_cmp(struct type *l, struct type *r); + struct type *type_dup(struct type *t); void type_ftv(struct type *r, int *nftv, struct ident **ftv); diff --git a/util.c b/util.c index a95913a..f473dc6 100644 --- a/util.c +++ b/util.c @@ -123,7 +123,7 @@ void die(const char *msg, ...) { va_list ap; va_start(ap, msg); - vfprintf(stderr, msg, ap); + safe_vfprintf(stderr, msg, ap); va_end(ap); exit(1); } @@ -135,6 +135,12 @@ void pindent(int indent, FILE *out) pdie("fputc"); } +void safe_vfprintf(FILE *out, const char *msg, va_list ap) +{ + if (vfprintf(out, msg, ap) < 0) + pdie("vfprintf"); +} + void safe_fprintf(FILE *out, const char *msg, ...) { va_list ap; diff --git a/util.h b/util.h index 547bedb..a1f68de 100644 --- a/util.h +++ b/util.h @@ -7,7 +7,9 @@ #define min(x, y) ((x)<(y)?(x):(y)) +/* exit with an error message */ void die(const char *msg, ...); +/* exit with the system's error message prefixed by msg */ void pdie(const char *msg); /* if buf == NULL, a fresh buffer is allocated */ @@ -16,8 +18,11 @@ char *escape_char(char c, char *buf, bool str); char *unescape_char(char *c); /* Remove the last and first character from the string */ char *trimquotes(char *c); +/* Print indentation */ void pindent(int indent, FILE *out); +/* Safe wrappers around syscalls */ +void safe_vfprintf(FILE *out, const char *msg, va_list ap); void safe_fprintf(FILE *out, const char *msg, ...); void *safe_malloc(size_t size); #define xalloc(nmemb, type) ((type *)safe_malloc((nmemb)*sizeof(type)))