From 498f74338d1c3fb93b6cdf440929b4dc1c93aa2a Mon Sep 17 00:00:00 2001
From: Mart Lubbers <mart@martlubbers.net>
Date: Thu, 11 Mar 2021 12:57:10 +0100
Subject: [PATCH] finalise type checking, code generation

---
 array.c                  |  45 +++++++--
 array.h                  |  27 +++---
 ast.c                    |  18 ++--
 genc.c                   | 195 ++++++++++++++++++++++++++++-----------
 ident.c                  |   4 +-
 input.txt                |  54 ++++-------
 parse.y                  |   2 +-
 rts/rts.c                |  17 ++--
 rts/rts.h                |   4 +
 sem.c                    |  10 +-
 sem/hm.c                 |  24 ++---
 sem/hm/gamma.c           |   8 +-
 sem/hm/scheme.c          |   8 +-
 sem/hm/subst.c           |  54 +++++------
 splc.c                   |   8 +-
 test/Makefile            |  19 ----
 test/test_sem_hm_gamma.c |  97 -------------------
 type.c                   |  31 +++++++
 type.h                   |   2 +
 util.c                   |   8 +-
 util.h                   |   5 +
 21 files changed, 331 insertions(+), 309 deletions(-)
 delete mode 100644 test/Makefile
 delete mode 100644 test/test_sem_hm_gamma.c

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 <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;
@@ -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, "//<<<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");
@@ -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 <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:
@@ -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; 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);
 }
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 <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);
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; 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)
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; 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);
 }
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; 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, "]");
 	}
 }
 
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 <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;
-}
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)))
-- 
2.20.1