#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)
{
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 *))
{
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);
+}
#define ARRAY_H
#include <stdint.h>
-
-#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 <stdlib.h>
+
+/* 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;
//* 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
vardecl_print(decl->data.dvar, 0, out);
break;
case dcomp:
- fprintf(out, "//<<<comp\n");
+ safe_fprintf(out, "//<<<comp\n");
ARRAY_ITER(struct fundecl *, d, i, decl->data.dcomp)
fundecl_print(d, out);
AIEND
- fprintf(out, "//>>>comp\n");
+ safe_fprintf(out, "//>>>comp\n");
break;
default:
die("Unsupported decl node\n");
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);
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");
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, "[]");
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");
#include <stdbool.h>
#include <string.h>
+#include <stdlib.h>
#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:
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;
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
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:
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:
}
}
-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");
}
}
-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");
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");
}
}
-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);
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:
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; i<ast->ndecls; 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);
}
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)
-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
+
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()
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;
#include <stdint.h>
#include <stddef.h>
+#include <stdio.h>
+#include <stdbool.h>
#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);
{
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("");
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:
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
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");
} else {
type_error(loc, false, "cannot unify ");
type_print(l, stderr);
- fprintf(stderr, " with ");
+ safe_fprintf(stderr, " with ");
type_print(r, stderr);
die("\n");
}
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));
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);
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));
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
void gamma_print(struct gamma *gamma, FILE *out)
{
- fprintf(out, "{");
+ safe_fprintf(out, "{");
for (int i = 0; i<gamma->nentries; 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)
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; i<scheme->nvar; 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);
}
}
}
-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;
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];
}
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; i<s->nvar; 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, "]");
}
}
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"
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);
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;
}
+++ /dev/null
-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
+++ /dev/null
-#include <stdbool.h>
-#include <stdlib.h>
-#include <check.h>
-
-#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;
-}
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;
+}
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);
{
va_list ap;
va_start(ap, msg);
- vfprintf(stderr, msg, ap);
+ safe_vfprintf(stderr, msg, ap);
va_end(ap);
exit(1);
}
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;
#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 */
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)))
repositories / ccc.git / commitdiff