fix generalisation

diff --git a/compilec.bash b/compilec.bash
deleted file mode 100755 (executable)
index 62d7557..0000000
--- a/compilec.bash
+++ /dev/null
@@ -1,25 +0,0 @@
-#!/bin/bash
-usage() {
-       echo "Usage: $0 CSOURCE [-o OFILE]" >&2
-       exit 1
-}
-if [ $# -lt 1 ]
-then
-       usage
-fi
-if [ $# -eq 3 ]
-then
-       if [ $2 != "-o" ]
-       then
-               usage
-       fi
-       OFILE=$3
-else
-       OFILE=a.out
-fi
-CFLAGS=${CFLAGS:-}
-LDLIBS=${LDLIBS:-}
-LDFLAGS=${LDFLAGS:-}
-CC=${CC:-gcc}
-set -xe
-"$CC" $CFLAGS "$1" $LDFLAGS rts.c $LDLIBS -o "$OFILE"

diff --git a/sem/hm.c b/sem/hm.c
index 30fc02a..e9cef4d 100644 (file)
--- a/sem/hm.c
+++ b/sem/hm.c
@@ -344,6 +344,7 @@ 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 08081d5..9134dca 100644 (file)
--- a/sem/hm/gamma.c
+++ b/sem/hm/gamma.c
@@ -96,6 +96,18 @@ struct scheme *gamma_lookup(struct gamma *gamma, struct ident ident)
        return res;
 }
 
+bool gamma_free_in(struct gamma *gamma, struct ident ident)
+{
+       bool free_in = false;
+       for (int i = 0; i<gamma->nentries; i++) {
+               if (gamma->entries[i].scope != 0)
+                       continue;
+               if (scheme_free_in(gamma->entries[i].scheme, ident))
+                       return true;
+       }
+       return free_in;
+}
+
 struct type *gamma_fresh(struct gamma *gamma)
 {
        char buf[10] = {0};

diff --git a/sem/hm/gamma.h b/sem/hm/gamma.h
index d84b7eb..c477771 100644 (file)
--- a/sem/hm/gamma.h
+++ b/sem/hm/gamma.h
@@ -18,6 +18,7 @@ void gamma_decrement_scope(struct gamma *gamma);
 void gamma_iter(struct gamma *gamma, void *st, void (*iter)(struct ident, struct scheme *, void *));
 
 struct scheme *gamma_lookup(struct gamma *gamma, struct ident ident);
+bool gamma_free_in(struct gamma *gamma, struct ident ident);
 struct type *gamma_fresh(struct gamma *gamma);
 
 void gamma_print(struct gamma *gamma, FILE *out);

diff --git a/sem/hm/scheme.c b/sem/hm/scheme.c
index 6cf356c..abb28b9 100644 (file)
--- a/sem/hm/scheme.c
+++ b/sem/hm/scheme.c
@@ -38,7 +38,7 @@ struct scheme *scheme_generalise(struct gamma *gamma, struct type *t)
        s->nvar = 0;
        s->var = xalloc(nftv, struct ident);
        for (int i = 0; i<nftv; i++) {
-               if (gamma_lookup(gamma, ftv[i]) != NULL)
+               if (gamma_free_in(gamma, ftv[i]))
                        continue;
                s->nvar++;
                s->var[i] = ident_dup(ftv[i]);
@@ -47,6 +47,14 @@ struct scheme *scheme_generalise(struct gamma *gamma, struct type *t)
        return s;
 }
 
+bool scheme_free_in(struct scheme *scheme, struct ident ident)
+{
+       for (int i = 0; i<scheme->nvar; i++)
+               if (ident_cmp(scheme->var[i], ident) == 0)
+                       return false;
+       return type_free_in(scheme->type, ident);
+}
+
 void scheme_print(struct scheme *scheme, FILE *out)
 {
        if (scheme == NULL) {
@@ -58,7 +66,7 @@ void scheme_print(struct scheme *scheme, FILE *out)
                for (int i = 0; i<scheme->nvar; i++) {
                        if (i > 0)
                                safe_fprintf(out, " ");
-                       ident_print(scheme->var[i], stderr);
+                       ident_print(scheme->var[i], out);
                }
                safe_fprintf(out, ": ");
        }

diff --git a/sem/hm/scheme.h b/sem/hm/scheme.h
index 8fe3d6f..b194e00 100644 (file)
--- a/sem/hm/scheme.h
+++ b/sem/hm/scheme.h
@@ -16,6 +16,7 @@ struct scheme {
 struct type *scheme_instantiate(struct gamma *gamma, struct scheme *s);
 struct scheme *scheme_create(struct type *t);
 struct scheme *scheme_generalise(struct gamma *gamma, struct type *t);
+bool scheme_free_in(struct scheme *scheme, struct ident ident);
 
 void scheme_print(struct scheme *scheme, FILE *out);
 void scheme_free(struct scheme *scheme);

diff --git a/sem/type.c b/sem/type.c
index ead0b40..a69d3be 100644 (file)
--- a/sem/type.c
+++ b/sem/type.c
@@ -206,5 +206,6 @@ void sem_check_types(struct ast *ast)
                        break;
                }
        }
+       gamma_print(gamma, stdout);
        gamma_free(gamma);
 }

diff --git a/type.c b/type.c
index 6837123..5a61d4a 100644 (file)
--- a/type.c
+++ b/type.c
@@ -197,6 +197,27 @@ void type_ftv(struct type *r, int *nftv, struct ident **ftv)
        }
 }
 
+bool type_free_in(struct type *r, struct ident ident)
+{
+       switch (r->type) {
+       case tarrow:
+               return type_free_in(r->data.ttuple.l, ident)
+                       || type_free_in(r->data.ttuple.r, ident);
+       case tbasic:
+               break;
+       case tlist:
+               return type_free_in(r->data.tlist, ident);
+       case ttuple:
+               return type_free_in(r->data.ttuple.l, ident)
+                       || type_free_in(r->data.ttuple.r, ident);
+       case tvar:
+               return ident_cmp(r->data.tvar, ident) == 0;
+       default:
+               die("Unsupported type node: %d\n", r->type);
+       }
+       return false;
+}
+
 int type_cmp(struct type *l, struct type *r)
 {
        if (l == NULL)

diff --git a/type.h b/type.h
index d7e55ae..467696b 100644 (file)
--- a/type.h
+++ b/type.h
@@ -39,5 +39,6 @@ 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);
+bool type_free_in(struct type *type, struct ident ident);
 
 #endif