fix type checking/inference

diff --git a/Makefile b/Makefile
index 5328897..db8b684 100644 (file)
--- 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 (file)
--- 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 (file)
--- 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 (file)
--- 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 (file)
--- 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 (file)
--- 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 (file)
--- 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 (file)
--- 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 (file)
--- 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 (file)
--- 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 (file)
--- 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 (file)
--- 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 (file)
--- 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;