sem.c

   1 #include <stdlib.h>
   2 #include <string.h>
   3
   4 #include "list.h"
   5 #include "sem/scc.h"
   6 #include "sem/hm.h"
   7 #include "ast.h"
   8
   9 void type_error(const char *msg, ...)
  10 {
  11         va_list ap;
  12         va_start(ap, msg);
  13         fprintf(stderr, "type error: ");
  14         vfprintf(stderr, msg, ap);
  15         va_end(ap);
  16         die("");
  17 }
  18
  19 void check_expr_constant(struct expr *expr)
  20 {
  21         switch (expr->type) {
  22         case ebinop:
  23                 check_expr_constant(expr->data.ebinop.l);
  24                 check_expr_constant(expr->data.ebinop.r);
  25                 break;
  26         case eunop:
  27                 check_expr_constant(expr->data.eunop.l);
  28                 break;
  29         case efuncall:
  30         case eident:
  31                 type_error("Initialiser is not constant\n");
  32                 break;
  33         default:
  34                 break;
  35         }
  36 }
  37
  38 struct vardecl *type_vardecl(struct gamma *gamma, struct vardecl *vardecl)
  39 {
  40         struct type *t = vardecl->type == NULL
  41                 ? gamma_fresh(gamma) : type_dup(vardecl->type);
  42         struct subst *s = infer_expr(gamma, vardecl->expr, t);
  43
  44         if (s == NULL)
  45                 die("error inferring variable\n");
  46         vardecl->type = subst_apply_t(s, t);
  47
  48         //subst_free(s);
  49
  50         return vardecl;
  51 }
  52
  53 struct ast *sem(struct ast *ast)
  54 {
  55         ast = ast_scc(ast);
  56
  57         struct gamma *gamma = gamma_init();
  58
  59         //Check all vardecls
  60         for (int i = 0; i<ast->ndecls; i++) {
  61                 switch(ast->decls[i]->type) {
  62                 case dvardecl:
  63                         //Check if constant
  64                         check_expr_constant(ast->decls[i]->data.dvar->expr);
  65                         //Infer if necessary
  66                         type_vardecl(gamma, ast->decls[i]->data.dvar);
  67                         break;
  68                 case dfundecl: {
  69 //                      struct type *f1 = gamma_fresh(gamma);
  70 //                      gamma_insert(gamma, ast->decls[i]->data.dfun->ident
  71 //                              , scheme_create(f1));
  72 //infer env (Let [(x, e1)] e2)
  73 //      =              fresh
  74 //      >>= \tv->      let env` = 'Data.Map'.put x (Forall [] tv) env
  75 //                     in infer env` e1
  76 //      >>= \(s1,t1)-> infer ('Data.Map'.put x (generalize (apply s1 env`) t1) env`) e2
  77 //      >>= \(s2, t2)->pure (s1 oo s2, t2)
  78                         break;
  79                 }
  80                 case dcomp:
  81                         break;
  82                 }
  83         }
  84
  85         gamma_free(gamma);
  86
  87         return ast;
  88 }