sem/hm/scheme.c

   1 #include <string.h>
   2 #include <stdlib.h>
   3
   4 #include "../hm.h"
   5
   6 struct type *scheme_instantiate(struct gamma *gamma, struct scheme *sch)
   7 {
   8         struct subst *s = subst_id();
   9         for (int i = 0; i<sch->nvar; i++) {
  10                 s = subst_union(s, subst_singleton(sch->var[i], gamma_fresh(gamma)));
  11         }
  12         struct type *t = subst_apply_t(s, type_dup(sch->type));
  13         for (int i = 0; i<s->nvar; i++)
  14                 free(s->vars[i]);
  15         free(s);
  16         return t;
  17 }
  18
  19 struct scheme *scheme_create(struct type *t)
  20 {
  21         struct scheme *s = safe_malloc(sizeof(struct scheme));
  22         s->type = t;
  23         s->nvar = 0;
  24         s->var = NULL;
  25 }
  26
  27 struct scheme *scheme_generalise(struct gamma *gamma, struct type *t)
  28 {
  29         struct scheme *s = safe_malloc(sizeof(struct scheme));
  30         int nftv = 0;
  31         char **ftv = NULL;
  32         type_ftv(t, &nftv, &ftv);
  33
  34         s->type = t;
  35         s->nvar = 0;
  36         s->var = safe_malloc(nftv*sizeof(char *));
  37         for (int i = 0; i<nftv; i++) {
  38                 bool skip = false;
  39                 for (int j = 0; j<gamma->nschemes; j++)
  40                         if (strcmp(gamma->vars[j], ftv[i]) == 0)
  41                                 skip = true;
  42                 if (skip)
  43                         continue;
  44                 s->nvar++;
  45                 s->var[i] = ftv[i];
  46         }
  47         return s;
  48 }
  49
  50 void scheme_print(struct scheme *scheme, FILE *out)
  51 {
  52         if (scheme->nvar > 0) {
  53                 fprintf(out, "A.");
  54                 for (int i = 0; i<scheme->nvar; i++)
  55                         fprintf(out, "%s", scheme->var[i]);
  56                 fprintf(out, ": ");
  57         }
  58         type_print(scheme->type, out);
  59 }
  60
  61 void scheme_free(struct scheme *scheme)
  62 {
  63         type_free(scheme->type);
  64         for (int i = 0; i<scheme->nvar; i++)
  65                 free(scheme->var[i]);
  66         free(scheme->var);
  67         free(scheme);
  68 }