From: Mart Lubbers <mart@martlubbers.net>
Date: Mon, 12 Apr 2021 09:51:45 +0000 (+0200)
Subject: fix generalisation
X-Git-Url: https://git.martlubbers.net/?a=commitdiff_plain;h=3f9d78e3849107bde8d5eb2a9668c2391f0bdcc0;p=ccc.git

fix generalisation
---

diff --git a/compilec.bash b/compilec.bash
deleted file mode 100755
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
--- 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
--- 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
--- 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
--- 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
--- 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
--- 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
--- 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
--- 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