work on type inference some more

[ccc.git] / sem.c

diff --git a/sem.c b/sem.c
index 1cea48f..3404fb4 100644 (file)
--- a/sem.c
+++ b/sem.c
@@ -3,6 +3,7 @@
 
 #include "list.h"
 #include "sem/scc.h"
+#include "sem/hm.h"
 #include "ast.h"
 
 void type_error(const char *msg, ...)
@@ -34,38 +35,54 @@ void check_expr_constant(struct expr *expr)
        }
 }
 
-struct vardecl *type_vardecl(struct vardecl *vardecl)
+struct vardecl *type_vardecl(struct gamma *gamma, struct vardecl *vardecl)
 {
-       return vardecl;
-}
+       struct type *t = vardecl->type == NULL
+               ? gamma_fresh(gamma) : type_dup(vardecl->type);
+       struct subst *s = infer_expr(gamma, vardecl->expr, t);
 
-struct decl *type_decl(struct decl *decl)
-{
-       switch (decl->type) {
-       case dcomp:
-               fprintf(stderr, "type_decl:component unsupported\n");
-               break;
-       case dfundecl:
-               fprintf(stderr, "type_decl:fundecl unsupported\n");
-               break;
-       case dvardecl:
-               decl->data.dvar = type_vardecl(decl->data.dvar);
-               break;
-       }
-       return decl;
+       if (s == NULL)
+               die("error inferring variable\n");
+       vardecl->type = subst_apply_t(s, t);
+
+       //subst_free(s);
+
+       return vardecl;
 }
 
 struct ast *sem(struct ast *ast)
 {
        ast = ast_scc(ast);
 
-       //Check that all globals are constant
+       struct gamma *gamma = gamma_init();
+
+       //Check all vardecls
        for (int i = 0; i<ast->ndecls; i++) {
-               if (ast->decls[i]->type == dvardecl) {
-                       //Check globals
+               switch(ast->decls[i]->type) {
+               case dvardecl:
+                       //Check if constant
                        check_expr_constant(ast->decls[i]->data.dvar->expr);
+                       //Infer if necessary
+                       type_vardecl(gamma, ast->decls[i]->data.dvar);
+                       break;
+               case dfundecl: {
+//                     struct type *f1 = gamma_fresh(gamma);
+//                     gamma_insert(gamma, ast->decls[i]->data.dfun->ident
+//                             , scheme_create(f1));
+//infer env (Let [(x, e1)] e2)
+//     =              fresh
+//     >>= \tv->      let env` = 'Data.Map'.put x (Forall [] tv) env
+//                    in infer env` e1
+//     >>= \(s1,t1)-> infer ('Data.Map'.put x (generalize (apply s1 env`) t1) env`) e2
+//     >>= \(s2, t2)->pure (s1 oo s2, t2)
+                       break;
+               }
+               case dcomp:
                        break;
                }
        }
+
+       gamma_free(gamma);
+
        return ast;
 }