From 0532397b693a25fbd992ed2e6046578ef5cbf6ad Mon Sep 17 00:00:00 2001
From: Mart Lubbers <mart@martlubbers.net>
Date: Fri, 26 Feb 2021 14:20:13 +0100
Subject: [PATCH] fix type checking/inference

---
 Makefile        |   3 +-
 ast.c           |  75 +++++++++++++++++-------------
 ast.h           |   9 +---
 genc.c          |   8 +---
 scan.l          |   9 ++--
 sem.c           | 121 ++++++++++++++++++++++++++++++++++++++++--------
 sem/hm.c        |  55 ++++++++++++----------
 sem/hm.h        |   1 +
 sem/hm/gamma.c  |  35 +++++++++++---
 sem/hm/gamma.h  |   2 +
 sem/hm/scheme.c |  10 ++--
 sem/hm/subst.c  |  17 ++++---
 sem/scc.c       |   6 ++-
 13 files changed, 234 insertions(+), 117 deletions(-)

diff --git a/Makefile b/Makefile
index 5328897..db8b684 100644
--- a/Makefile
+++ b/Makefile
@@ -3,8 +3,7 @@ YFLAGS+=-d --locations -v --defines=parse.h
 LFLAGS+=--header-file=scan.h
 
 OBJECTS:=scan.o parse.o ast.o type.o util.o list.o sem.o genc.o \
-	sem/scc.o\
-	$(addprefix sem/hm, .o /gamma.o /subst.o /scheme.o)
+	$(addprefix sem,.o /scc.o $(addprefix /hm, .o /gamma.o /subst.o /scheme.o))
 
 all: splc
 splc: $(OBJECTS)
diff --git a/ast.c b/ast.c
index 88083bd..3f1c97d 100644
--- a/ast.c
+++ b/ast.c
@@ -22,7 +22,6 @@ struct ast *ast(struct list *decls, YYLTYPE l)
 {
 	struct ast *res = safe_malloc(sizeof(struct ast));
 	res->loc = l;
-	res->loc = l;
 	res->decls = (struct decl **)list_to_array(decls, &res->ndecls, true);
 	return res;
 }
@@ -161,26 +160,27 @@ struct expr *expr_char(char *c, YYLTYPE l)
 	return res;
 }
 
-static void set_fields(enum fieldspec **farray, int *n, struct list *fields)
-{
-	void **els = list_to_array(fields, n, true);
-	*farray = (enum fieldspec *)safe_malloc(*n*sizeof(enum fieldspec));
-	for (int i = 0; i<*n; i++) {
-		char *t = els[i];
-		if (strcmp(t, "fst") == 0)
-			(*farray)[i] = fst;
-		else if (strcmp(t, "snd") == 0)
-			(*farray)[i] = snd;
-		else if (strcmp(t, "hd") == 0)
-			(*farray)[i] = hd;
-		else if (strcmp(t, "tl") == 0)
-			(*farray)[i] = tl;
-		free(t);
-	}
-	free(els);
+static bool is_valid_field(char *t)
+{
+	if (strcmp(t, "fst") == 0)
+		return true;
+	else if (strcmp(t, "snd") == 0)
+		return true;
+	else if (strcmp(t, "hd") == 0)
+		return true;
+	else if (strcmp(t, "tl") == 0)
+		return true;
+	return false;
 }
 
-struct expr *expr_funcall(char *ident, struct list *args, struct list *fields, YYLTYPE l)
+bool is_builtin(char *t)
+{
+	return is_valid_field(t)
+		|| strcmp(t, "isEmpty") == 0
+		|| strcmp(t, "print") == 0;
+}
+
+struct expr *expr_funcall_real(char *ident, struct list *args, YYLTYPE l)
 {
 	struct expr *res = safe_malloc(sizeof(struct expr));
 	res->loc = l;
@@ -188,8 +188,25 @@ struct expr *expr_funcall(char *ident, struct list *args, struct list *fields, Y
 	res->data.efuncall.ident = ident;
 	res->data.efuncall.args = (struct expr **)
 		list_to_array(args, &res->data.efuncall.nargs, true);
-	set_fields(&res->data.efuncall.fields,
-		&res->data.efuncall.nfields, fields);
+	return res;
+}
+
+static struct expr *expr_apply_fields(struct expr *r, struct list *fields, YYLTYPE l)
+{
+	FOREACH(field, fields) {
+		if (is_valid_field(field->el)) {
+			struct list *as = list_cons(r, NULL);
+			r = expr_funcall_real(field->el, as, l);
+		}
+	}
+	list_free(fields, NULL);
+	return r;
+}
+
+struct expr *expr_funcall(char *ident, struct list *args, struct list *fields, YYLTYPE l)
+{
+	struct expr *res = expr_funcall_real(ident, args, l);
+	res = expr_apply_fields(res, fields, l);
 	return res;
 }
 
@@ -207,8 +224,8 @@ struct expr *expr_ident(char *ident, struct list *fields, YYLTYPE l)
 	struct expr *res = safe_malloc(sizeof(struct expr));
 	res->loc = l;
 	res->type = eident;
-	res->data.eident.ident = ident;
-	set_fields(&res->data.eident.fields, &res->data.eident.nfields, fields);
+	res->data.eident = ident;
+	res = expr_apply_fields(res, fields, l);
 	return res;
 }
 
@@ -409,18 +426,12 @@ void expr_print(struct expr *expr, FILE *out)
 				safe_fprintf(out, ", ");
 		}
 		safe_fprintf(out, ")");
-		for (int i = 0; i<expr->data.efuncall.nfields; i++)
-			fprintf(out, ".%s",
-				fieldspec_str[expr->data.efuncall.fields[i]]);
 		break;
 	case eint:
 		safe_fprintf(out, "%d", expr->data.eint);
 		break;
 	case eident:
-		fprintf(out, "%s", expr->data.eident.ident);
-		for (int i = 0; i<expr->data.eident.nfields; i++)
-			fprintf(out, ".%s",
-				fieldspec_str[expr->data.eident.fields[i]]);
+		fprintf(out, "%s", expr->data.eident);
 		break;
 	case enil:
 		safe_fprintf(out, "[]");
@@ -564,14 +575,12 @@ void expr_free(struct expr *expr)
 		free(expr->data.efuncall.ident);
 		for (int i = 0; i<expr->data.efuncall.nargs; i++)
 			expr_free(expr->data.efuncall.args[i]);
-		free(expr->data.efuncall.fields);
 		free(expr->data.efuncall.args);
 		break;
 	case eint:
 		break;
 	case eident:
-		free(expr->data.eident.ident);
-		free(expr->data.eident.fields);
+		free(expr->data.eident);
 		break;
 	case enil:
 		break;
diff --git a/ast.h b/ast.h
index 5b6c506..ae5db70 100644
--- a/ast.h
+++ b/ast.h
@@ -83,6 +83,7 @@ enum binop {
 	divide, modulo, power,
 };
 enum fieldspec {fst,snd,hd,tl};
+bool is_builtin(char *t);
 enum unop {negate,inverse};
 struct expr {
 	YYLTYPE loc;
@@ -100,15 +101,9 @@ struct expr {
 			char *ident;
 			int nargs;
 			struct expr **args;
-			int nfields;
-			enum fieldspec *fields;
 		} efuncall;
 		int eint;
-		struct {
-			char *ident;
-			int nfields;
-			enum fieldspec *fields;
-		} eident;
+		char *eident;
 		struct {
 			struct expr *left;
 			struct expr *right;
diff --git a/genc.c b/genc.c
index d808c36..72777c9 100644
--- a/genc.c
+++ b/genc.c
@@ -49,18 +49,12 @@ void expr_genc(struct expr *expr, FILE *cout)
 				safe_fprintf(cout, ", ");
 		}
 		safe_fprintf(cout, ")");
-		for (int i = 0; i<expr->data.efuncall.nfields; i++)
-			fprintf(cout, "->%s",
-				fieldspec_str[expr->data.efuncall.fields[i]]);
 		break;
 	case eint:
 		safe_fprintf(cout, "%d", expr->data.eint);
 		break;
 	case eident:
-		fprintf(cout, "%s", expr->data.eident.ident);
-		for (int i = 0; i<expr->data.eident.nfields; i++)
-			fprintf(cout, "->%s",
-				fieldspec_str[expr->data.eident.fields[i]]);
+		fprintf(cout, "%s", expr->data.eident);
 		break;
 	case enil:
 		safe_fprintf(cout, "NULL");
diff --git a/scan.l b/scan.l
index 31620af..96349dc 100644
--- a/scan.l
+++ b/scan.l
@@ -1,14 +1,13 @@
 D [0-9]
 H [0-9a-fA-F]
+O [0-7]
 E ([0\\abtnvfr]|x{H}?{H}|0[0-3]?{O}?{O})
 I [a-zA-Z_]
-O [0-7]
 
 %option noinput
 %option nounput
 %{
 
-#include <stdio.h>
 #define YY_USER_ACTION \
     yylloc.first_line = yylloc.last_line; \
     yylloc.first_column = yylloc.last_column; \
@@ -39,8 +38,8 @@ if          return IF;
 else        return ELSE;
 while       return WHILE;
 var         return VAR;
-true        { yylval.expr = expr_bool(true, yylloc); return BOOL; }
-false       { yylval.expr = expr_bool(false, yylloc); return BOOL; }
+True        { yylval.expr = expr_bool(true, yylloc); return BOOL; }
+False       { yylval.expr = expr_bool(false, yylloc); return BOOL; }
 return      return RETURN;
 Int         return TINT;
 Bool        return TBOOL;
@@ -85,7 +84,7 @@ Void        return TVOID;
 }
 <IN_COMMENT>{
 \*\/       BEGIN(INITIAL);
-.          ;
+.|\n       {}
 }
 
 %%
diff --git a/sem.c b/sem.c
index 48ea8a0..f856b97 100644
--- a/sem.c
+++ b/sem.c
@@ -43,8 +43,6 @@ struct vardecl *type_vardecl(struct gamma *gamma, struct vardecl *vardecl)
 		? gamma_fresh(gamma) : vardecl->type;
 	struct subst *s = infer_expr(gamma, vardecl->expr, t);
 
-	if (s == NULL)
-		die("error inferring variable\n");
 	vardecl->type = subst_apply_t(s, t);
 	gamma_insert(gamma, vardecl->ident, scheme_create(vardecl->type));
 
@@ -69,11 +67,9 @@ void type_comp(struct gamma *gamma, int ndecls, struct fundecl **decl)
 	//Create a fresh variable for every function in the component
 	struct type **fs = safe_malloc(ndecls*sizeof(struct type *));
 	for (int i = 0; i<ndecls; i++) {
-		bool fresh = decl[i]->rtype == NULL || decl[i]->atypes == NULL;
-		fs[i] = fresh ? gamma_fresh(gamma) : decl[i]->rtype;
+		fs[i] = gamma_fresh(gamma);
 		for (int j = 0; j<decl[i]->nargs; j++) {
-			struct type *a = fresh ? gamma_fresh(gamma)
-				: type_dup(decl[i]->atypes[j]);
+			struct type *a = gamma_fresh(gamma);
 			fs[i] = type_arrow(a, fs[i]);
 		}
 		gamma_insert(gamma, decl[i]->ident, scheme_create(fs[i]));
@@ -91,18 +87,28 @@ void type_comp(struct gamma *gamma, int ndecls, struct fundecl **decl)
 	//Generalise all functions and put in gamma
 	for (int i = 0; i<ndecls; i++) {
 		struct type *t = subst_apply_t(s0, fs[i]);
-		gamma_insert(gamma, decl[i]->ident, scheme_generalise(gamma, t));
 
-		for (int j = 0; i<decl[i]->natypes; j++) {
-			free(decl[i]->atypes[i]);
+		//unify against given type specification
+		if (decl[i]->rtype != NULL) {
+			struct type *dt = decl[i]->rtype;
+			for (int j = decl[i]->natypes-1; j>=0; j--)
+				dt = type_arrow(decl[i]->atypes[j], dt);
+			unify(decl[i]->loc, dt, t);
+			//Free the old types if there were any
+			for (int j = 0; j<decl[i]->natypes; j++)
+				type_free(decl[i]->atypes[j]);
+			free(decl[i]->atypes);
+			type_free(decl[i]->rtype);
 		}
-		free(decl[i]->atypes);
+
+		gamma_insert(gamma, decl[i]->ident, scheme_generalise(gamma, t));
+
+
+		//Put the type in the ast
 		decl[i]->atypes = safe_malloc(decl[i]->nargs*sizeof(struct type *));
 		decl[i]->natypes = decl[i]->nargs;
-		for (int j = 0; j<decl[i]->nargs; j++) {
+		for (int j = 0; j<decl[i]->nargs; j++, t = t->data.tarrow.r)
 			decl[i]->atypes[j] = type_dup(t->data.tarrow.l);
-			t = t->data.tarrow.r;
-		}
 		decl[i]->rtype = type_dup(t);
 	}
 
@@ -113,29 +119,106 @@ void type_comp(struct gamma *gamma, int ndecls, struct fundecl **decl)
 	subst_free(s0);
 }
 
+void gamma_preamble(struct gamma *gamma)
+{
+	struct type *t = type_arrow(type_tuple(type_var(safe_strdup("a"))
+		, type_var(safe_strdup("b"))) ,type_var(safe_strdup("a")));
+	gamma_insert(gamma, "fst", scheme_generalise(gamma, t));
+	type_free(t);
+
+	t = type_arrow(type_tuple(type_var(safe_strdup("a"))
+		, type_var(safe_strdup("b"))) ,type_var(safe_strdup("b")));
+	gamma_insert(gamma, "snd", scheme_generalise(gamma, t));
+	type_free(t);
+
+	t = type_arrow(type_list(type_var(safe_strdup("a"))),
+			type_var(safe_strdup("a")));
+	gamma_insert(gamma, "hd", scheme_generalise(gamma, t));
+	type_free(t);
+
+	t = type_arrow(type_list(type_var(safe_strdup("a"))),
+			type_list(type_var(safe_strdup("a"))));
+	gamma_insert(gamma, "tl", scheme_generalise(gamma, t));
+	type_free(t);
+
+	t = type_arrow(type_list(type_var(safe_strdup("a"))),
+			type_basic(btbool));
+	gamma_insert(gamma, "isEmpty", scheme_generalise(gamma, t));
+	type_free(t);
+
+	t = type_arrow(type_var(safe_strdup("a")), type_basic(btvoid));
+	gamma_insert(gamma, "print", scheme_generalise(gamma, t));
+	type_free(t);
+}
+
+bool check_return_stmt(struct stmt *stmt);
+bool check_return_body(int nbody, struct stmt **body)
+{
+	for (int i = 0; i<nbody; i++)
+		if (check_return_stmt(body[i]))
+			return true;
+	return false;
+}
+
+
+bool check_return_stmt(struct stmt *stmt)
+{
+	switch (stmt->type) {
+	case sassign:
+		return false;
+	case sif:
+		return check_return_body(stmt->data.sif.nthen, stmt->data.sif.then)
+			&& check_return_body(stmt->data.sif.nels, stmt->data.sif.els);
+	case swhile:
+		return check_return_body(stmt->data.swhile.nbody,
+			stmt->data.swhile.body);
+	case sreturn:
+		return true;
+	default:
+		return false;
+	}
+}
+
+void check_return_comp(int ndecl, struct fundecl **decls)
+{
+	for (int i = 0; i<ndecl; i++) {
+		if (decls[i]->rtype->type == tbasic && decls[i]->rtype->data.tbasic == btvoid)
+			continue;
+		if (!check_return_body(decls[i]->nbody, decls[i]->body))
+			type_error(decls[i]->loc, true,
+				"%s doesn't return properly", decls[i]->ident);
+	}
+}
+
 struct ast *sem(struct ast *ast)
 {
+	//Break up into strongly connected components
 	ast = ast_scc(ast);
 
 	struct gamma *gamma = gamma_init();
+	gamma_preamble(gamma);
 
 	//Check all vardecls
 	for (int i = 0; i<ast->ndecls; i++) {
-		switch(ast->decls[i]->type) {
+		struct decl *decl = ast->decls[i];
+		switch(decl->type) {
 		case dvardecl:
 			//Check if constant
-			check_expr_constant(ast->decls[i]->data.dvar->expr);
+			check_expr_constant(decl->data.dvar->expr);
 			//Infer if necessary
-			type_vardecl(gamma, ast->decls[i]->data.dvar);
+			type_vardecl(gamma, decl->data.dvar);
 			break;
 		case dfundecl:
 			//Infer function as singleton component
-			type_comp(gamma, 1, &ast->decls[i]->data.dfun);
+			type_comp(gamma, 1, &decl->data.dfun);
+//			check_return_comp(1, &decl->data.dfun);
 			break;
 		case dcomp:
 			//Infer function as singleton component
-			type_comp(gamma, ast->decls[i]->data.dcomp.ndecls,
-				ast->decls[i]->data.dcomp.decls);
+			type_comp(gamma, decl->data.dcomp.ndecls,
+				decl->data.dcomp.decls);
+//			check_return_comp(decl->data.dcomp.ndecls,
+//				decl->data.dcomp.decls);
 			break;
 		}
 	}
diff --git a/sem/hm.c b/sem/hm.c
index e19c9e6..6e4ca9d 100644
--- a/sem/hm.c
+++ b/sem/hm.c
@@ -33,8 +33,8 @@ struct subst *unify(YYLTYPE loc, struct type *l, struct type *r)
 	struct subst *s1, *s2;
 	if (l->type == tarrow && r->type == tarrow) {
 		s1 = unify(loc, l->data.tarrow.l, r->data.tarrow.l);
-		s2 = unify(loc, subst_apply_t(s1, l->data.tarrow.l),
-			subst_apply_t(s1, r->data.tarrow.l));
+		s2 = unify(loc, subst_apply_t(s1, l->data.tarrow.r),
+			subst_apply_t(s1, r->data.tarrow.r));
 		return subst_union(s2, s1);
 	} else if (l->type == tbasic && r->type == tbasic
 			&& l->data.tbasic == r->data.tbasic) {
@@ -64,17 +64,6 @@ struct subst *unify(YYLTYPE loc, struct type *l, struct type *r)
 	return NULL;
 }
 
-struct subst *unifyfree(YYLTYPE loc,
-	struct type *l, struct type *r, bool freel, bool freer)
-{
-	struct subst *s = unify(loc, l, r);
-	if (freel)
-		type_free(l);
-	if (freer)
-		type_free(r);
-	return s;
-}
-
 struct subst *infer_binop(struct gamma *gamma, struct expr *l, struct expr *r,
 	struct type *a1, struct type *a2, struct type *rt, struct type *sigma)
 {
@@ -93,6 +82,7 @@ struct subst *infer_unop(struct gamma *gamma, struct expr *e,
 	return subst_union(s2, s1);
 }
 
+static struct type tyvoid = {.type=tbasic, .data={.tbasic=btvoid}};
 static struct type tybool = {.type=tbasic, .data={.tbasic=btbool}};
 static struct type tychar = {.type=tbasic, .data={.tbasic=btchar}};
 static struct type tyint = {.type=tbasic, .data={.tbasic=btint}};
@@ -142,7 +132,7 @@ struct subst *infer_expr(struct gamma *gamma, struct expr *expr, struct type *ty
 		return unify(expr->loc, &tychar, type);
 	case efuncall:
 		if ((s = gamma_lookup(gamma, expr->data.efuncall.ident)) == NULL)
-			type_error(expr->loc, "Unbound function: %s\n"
+			type_error(expr->loc, true, "Unbound function: %s\n"
 				, expr->data.efuncall.ident);
 		struct type *ft = scheme_instantiate(gamma, s);
 		struct type *t = ft;
@@ -167,22 +157,22 @@ struct subst *infer_expr(struct gamma *gamma, struct expr *expr, struct type *ty
 		s1 = unify(expr->loc, t, type);
 		s0 = subst_union(s1, s0);
 		type_free(ft);
-		//TODO fields
 		return s0;
 	case eint:
 		return unify(expr->loc, &tyint, type);
 	case eident:
-		if ((s = gamma_lookup(gamma, expr->data.eident.ident)) == NULL)
+		if ((s = gamma_lookup(gamma, expr->data.eident)) == NULL)
 			type_error(expr->loc, true, "Unbound variable: %s\n"
-				, expr->data.eident.ident);
+				, expr->data.eident);
 		f1 = scheme_instantiate(gamma, s);
 		s0 = unify(expr->loc, f1, type);
 		type_free(f1);
-		//TODO field
 		return s0;
 	case enil:
-		f1 = gamma_fresh(gamma);
-		return unifyfree(expr->loc, type_list(f1), type, true, false);
+		f1 = type_list(gamma_fresh(gamma));
+		s0 = unify(expr->loc, f1, type);
+		type_free(f1);
+		return s0;
 	case etuple:
 		f1 = gamma_fresh(gamma);
 		f2 = gamma_fresh(gamma);
@@ -230,14 +220,26 @@ struct subst *infer_stmt(struct gamma *gamma, struct stmt *stmt, struct type *ty
 		}
 		return s0;
 	case sreturn:
-		return infer_expr(gamma, stmt->data.sreturn, type);
+		return stmt->data.sreturn == NULL
+			? unify(stmt->loc, &tyvoid, type)
+			: infer_expr(gamma, stmt->data.sreturn, type);
 	case sexpr:
 		f1 = gamma_fresh(gamma);
 		s0 = infer_expr(gamma, stmt->data.sexpr, f1);
 		type_free(f1);
 		return s0;
 	case svardecl:
-		break;
+		f1 = gamma_fresh(gamma);
+		s0 = infer_expr(gamma, stmt->data.svardecl->expr, f1);
+		if (stmt->data.svardecl->type != NULL)
+			s1 = unify(stmt->loc, f1, stmt->data.svardecl->type);
+		else
+			s1 = subst_id();
+		s0 = subst_union(s1, s0);
+		//TODO fielsd
+		//TODO
+		gamma_insert(gamma, stmt->data.svardecl->ident, scheme_create(subst_apply_t(s0, f1)));
+		return s0;
 	case swhile:
 		s0 = infer_expr(gamma, stmt->data.swhile.pred, &tybool);
 		subst_apply_g(s0, gamma);
@@ -269,11 +271,16 @@ struct subst *infer_fundecl(struct gamma *gamma, struct fundecl *fundecl, struct
 
 	struct subst *s = subst_id();
 	for (int i = 0; i<fundecl->nbody; i++) {
-		struct subst *s1 = infer_stmt(gamma,
-			fundecl->body[i], at);
+		struct subst *s1 = infer_stmt(gamma, fundecl->body[i], at);
 		s = subst_union(s1, s);
 		subst_apply_g(s, gamma);
 	}
 
+	// Remove arguments from gamma
+	at = ftype;
+	for (int i = 0; i<fundecl->nargs; i++) {
+		gamma_remove(gamma, fundecl->args[i]);
+		at = at->data.tarrow.r;
+	}
 	return s;
 }
diff --git a/sem/hm.h b/sem/hm.h
index 423ce70..0a92475 100644
--- a/sem/hm.h
+++ b/sem/hm.h
@@ -7,6 +7,7 @@
 #include "hm/scheme.h"
 
 struct ast *infer(struct ast *ast);
+struct subst *unify(YYLTYPE loc, struct type *l, struct type *r);
 struct subst *infer_expr(struct gamma *gamma, struct expr *expr, struct type *type);
 struct subst *infer_stmt(struct gamma *gamma, struct stmt *stmt, struct type *type);
 struct subst *infer_fundecl(struct gamma *gamma, struct fundecl *fundecl, struct type *ftype);
diff --git a/sem/hm/gamma.c b/sem/hm/gamma.c
index a5b46c5..c5ad9eb 100644
--- a/sem/hm/gamma.c
+++ b/sem/hm/gamma.c
@@ -3,13 +3,16 @@
 
 #include "../hm.h"
 
+#define IN_CAP 25
+
 struct gamma *gamma_init()
 {
 	struct gamma *gamma = safe_malloc(sizeof(struct gamma));
+	gamma->capacity = IN_CAP;
 	gamma->fresh = 0;
 	gamma->nschemes = 0;
-	gamma->vars = NULL;
-	gamma->schemes = NULL;
+	gamma->vars = safe_malloc(IN_CAP*sizeof(char *));
+	gamma->schemes = safe_malloc(IN_CAP*sizeof(struct scheme *));
 	return gamma;
 }
 
@@ -23,14 +26,34 @@ void gamma_insert(struct gamma *gamma, char *ident, struct scheme *scheme)
 		}
 	}
 	gamma->nschemes++;
-	gamma->vars = safe_realloc(gamma->vars,
-		gamma->nschemes*sizeof(char *));
-	gamma->schemes = safe_realloc(gamma->schemes,
-		gamma->nschemes*sizeof(struct scheme *));
+	if (gamma->nschemes >= gamma->capacity) {
+		gamma->capacity += gamma->capacity;
+		gamma->vars = safe_realloc(gamma->vars,
+			gamma->capacity*sizeof(char *));
+		gamma->schemes = safe_realloc(gamma->schemes,
+			gamma->capacity*sizeof(struct scheme *));
+	}
 	gamma->vars[gamma->nschemes-1] = safe_strdup(ident);
 	gamma->schemes[gamma->nschemes-1] = scheme;
 }
 
+void gamma_remove(struct gamma *gamma, char *ident)
+{
+	int i = 0;
+	for (i = 0; i<gamma->nschemes; i++) {
+		if (strcmp(gamma->vars[i], ident) == 0) {
+			scheme_free(gamma->schemes[i]);
+			free(gamma->vars[i]);
+			break;
+		}
+	}
+	for (i++; i<gamma->nschemes; i++) {
+		gamma->vars[i-1] = gamma->vars[i];
+		gamma->schemes[i-1] = gamma->schemes[i];
+	}
+	gamma->nschemes--;
+}
+
 struct scheme *gamma_lookup(struct gamma *gamma, char *ident)
 {
 	for (int i = 0; i<gamma->nschemes; i++)
diff --git a/sem/hm/gamma.h b/sem/hm/gamma.h
index 8499144..f146621 100644
--- a/sem/hm/gamma.h
+++ b/sem/hm/gamma.h
@@ -6,6 +6,7 @@
 #include "../hm.h"
 
 struct gamma {
+	int capacity;
 	int fresh;
 	int nschemes;
 	char **vars;
@@ -14,6 +15,7 @@ struct gamma {
 
 struct gamma *gamma_init();
 void gamma_insert(struct gamma *gamma, char *ident, struct scheme *scheme);
+void gamma_remove(struct gamma *gamma, char *ident);
 
 struct scheme *gamma_lookup(struct gamma *gamma, char *ident);
 struct type *gamma_fresh(struct gamma *gamma);
diff --git a/sem/hm/scheme.c b/sem/hm/scheme.c
index 166bba2..b9b9861 100644
--- a/sem/hm/scheme.c
+++ b/sem/hm/scheme.c
@@ -6,10 +6,14 @@
 struct type *scheme_instantiate(struct gamma *gamma, struct scheme *sch)
 {
 	struct subst *s = subst_id();
-	for (int i = 0; i<sch->nvar; i++)
-		subst_insert(s, safe_strdup(sch->var[i]), gamma_fresh(gamma));
+	struct type *t;
+	for (int i = 0; i<sch->nvar; i++) {
+		t = gamma_fresh(gamma);
+		subst_insert(s, sch->var[i], t);
+		type_free(t);
+	}
 
-	struct type *t = subst_apply_t(s, type_dup(sch->type));
+	t = subst_apply_t(s, type_dup(sch->type));
 	subst_free(s);
 	return t;
 }
diff --git a/sem/hm/subst.c b/sem/hm/subst.c
index 032f4b1..1fcfbbc 100644
--- a/sem/hm/subst.c
+++ b/sem/hm/subst.c
@@ -3,7 +3,7 @@
 
 #include "../hm.h"
 
-#define INCAP 10
+#define INCAP 25
 
 struct subst *subst_id()
 {
@@ -17,6 +17,7 @@ struct subst *subst_id()
 
 struct subst *subst_insert(struct subst *s, char *ident, struct type *t)
 {
+
 	int i = 0;
 	while (i < s->nvar) {
 		if (strcmp(s->vars[i], ident) == 0) {
@@ -28,12 +29,12 @@ struct subst *subst_insert(struct subst *s, char *ident, struct type *t)
 		}
 		i++;
 	}
-	s->nvar++;
-	if (s->nvar > s->capacity) {
+	if (s->nvar >= s->capacity) {
 		s->capacity += s->capacity;
 		s->vars = safe_realloc(s->vars, s->capacity*sizeof(char *));
-		s->types = safe_realloc(s->vars, s->capacity*sizeof(struct type *));
+		s->types = safe_realloc(s->types, s->capacity*sizeof(struct type *));
 	}
+	s->nvar ++;
 	s->vars[i] = safe_strdup(ident);
 	s->types[i] = type_dup(t);
 	return s;
@@ -41,9 +42,7 @@ struct subst *subst_insert(struct subst *s, char *ident, struct type *t)
 
 struct subst *subst_singleton(char *ident, struct type *t)
 {
-	struct subst *res = subst_id();
-	subst_insert(res, ident, t);
-	return res;
+	return subst_insert(subst_id(), ident, t);
 }
 
 struct subst *subst_union(struct subst *s1, struct subst *s2)
@@ -120,7 +119,7 @@ struct gamma *subst_apply_g(struct subst *subst, struct gamma *gamma)
 void subst_print(struct subst *s, FILE *out)
 {
 	if (s == NULL) {
-		fprintf(out, "no subst\n");
+		fprintf(out, "(nil)");
 	} else {
 		fprintf(out, "[");
 		for (int i = 0; i<s->nvar; i++) {
@@ -129,7 +128,7 @@ void subst_print(struct subst *s, FILE *out)
 			if (i + 1 < s->nvar)
 				fprintf(out, ", ");
 		}
-		fprintf(out, "]\n");
+		fprintf(out, "]");
 	}
 }
 
diff --git a/sem/scc.c b/sem/scc.c
index a490b4c..29a3bee 100644
--- a/sem/scc.c
+++ b/sem/scc.c
@@ -4,6 +4,7 @@
 
 #include "../ast.h"
 #include "../list.h"
+#include "../sem.h"
 
 #ifndef min
 #define min(x, y) ((x)<(y) ? (x) : (y))
@@ -181,8 +182,9 @@ struct list *edges_expr(int ndecls, struct decl **decls, void *parent,
 				found = true;
 			}
 		}
-		if (!found)
-			die("Malformed function call\n");
+		if (!found && !is_builtin(expr->data.efuncall.ident))
+			type_error(expr->loc, true, "Unbound function: %s\n",
+				expr->data.efuncall.ident);
 		break;
 	case eint:
 		break;
-- 
2.20.1