Exemple #1
0
term* normalize_no_unfold(typing_context* Delta, term* t) {
  if (t == NULL) return NULL;

  switch (t->tag) {
  case VAR:
    {
      return term_dup(t);
    }
  case APP:
    {
      term* l = normalize_no_unfold(Delta, t->left);
      term* r = normalize_no_unfold(Delta, t->right);
      if (l->tag == LAM) {
        term* subs = substitute(l->var, r, l->right);
        free_term(l);
        free_term(r);
        return normalize_no_unfold_and_free(Delta, subs);
      }
      return make_app(l, r);
    }
  case IMPLICIT:
  case HOLE:
  case TYPE:
  case LAM:
  case PI:
    return term_dup(t);
  default:
    sentinel("unexpected tag %d");
  }
 error:
  return NULL;
}
Exemple #2
0
static term* elim_over_intro(typing_context* Delta, term* t) {
  check(t && t->args && t->args[t->num_args - 1], "ill formed term");
  check(t->tag == ELIM && t->args[t->num_args - 1]->tag == INTRO,
        "elim_over_intro must be called on an eliminator applied to a constructor");
  term* last = t->args[t->num_args - 1];
  datatype* T = elim_to_datatype(t->var, Delta);
  int index = datatype_intro_index(last->var, T);
  check(index != -1, "bad intro index while evaluating %W", t, print_term);
  term *app = term_dup(t->args[index + 1]);
  int i;
  for (i = 0; i < last->num_args; i++) {
    app = make_app(app, term_dup(last->args[i]));
    if (constructor_arg_is_inductive(T, last->var, i)) {
      term *inductive = term_dup(t);
      free_term(inductive->args[inductive->num_args - 1]);
      inductive->args[inductive->num_args - 1] = term_dup(last->args[i]);
      app = make_app(app, inductive);
    }
  }
  free_term(t);
  t = NULL;
  return app;
 error:
  return NULL;
}
Exemple #3
0
term* normalize_fuel(context *Sigma, typing_context* Delta, term* t, int fuel) {
  if (t == NULL) return NULL;
  check(term_locally_well_formed(t), "%W must be locally well formed", t, print_term);
  check(fuel >= 0, "Stack depth exceeded")

  switch (t->tag) {
  case VAR:
    return normalize_fuel_var(Sigma, Delta, t, fuel);
  case APP:
    return normalize_fuel_app(Sigma, Delta, t, fuel);
  case LAM:
    return normalize_fuel_lambda(Sigma, Delta, t, fuel);
  case PI:
    return normalize_fuel_pi(Sigma, Delta, t, fuel);
  case ELIM:
    return normalize_fuel_elim(Sigma, Delta, t, fuel);
  case INTRO:
    return normalize_fuel_intro(Sigma, Delta, t, fuel);
  case DATATYPE:
    return normalize_fuel_datatype(Sigma, Delta, t, fuel);
  default:
    return term_dup(t);
  }
 error:
  return NULL;
}
Exemple #4
0
term* normalize_fuel_var(context *Sigma, typing_context* Delta, term* t, int fuel) {
  term* defn = context_lookup(t->var, Sigma);
  if (defn == NULL) {
    return term_dup(t);
  }
  return normalize_fuel(Sigma, Delta, defn, fuel-1);
}
Exemple #5
0
term* normalize_fuel_elim(context *Sigma, typing_context* Delta, term* t, int fuel) {
  term* ans = NULL;
  term* last = normalize_fuel(Sigma, Delta, t->args[t->num_args - 1], fuel-1);
  if (!last) goto error;
  if (last->tag == INTRO) {
    term* c = term_dup(t);
    free_term(c->args[c->num_args - 1]);
    c->args[c->num_args - 1] = last;
    return normalize_and_free_fuel(Sigma, Delta, elim_over_intro(Delta, c), fuel-1);
  } else {
    ans = make_elim(variable_dup(t->var), t->num_args, t->num_params, t->num_indices);
    int i;
    for (i = 0; i < t->num_indices; i++) {
      ans->indices[i] = normalize_fuel(Sigma, Delta, t->indices[i], fuel-1);
      if (!ans->indices[i]) goto error;
    }
    for (i = 0; i < t->num_params; i++) {
      ans->params[i] = normalize_fuel(Sigma, Delta, t->params[i], fuel-1);
      if (!ans->params[i]) goto error;
    }
    for (i = 0; i < t->num_args - 1; i++) {
      ans->args[i] = normalize_fuel(Sigma, Delta, t->args[i], fuel-1);
      if (!ans->args[i]) goto error;
    }
    ans->args[t->num_args-1] = last;
    return ans;
  }
 error:
  free_term(last);
  free_term(ans);
  return NULL;
}
Exemple #6
0
term* whnf(context *Sigma, typing_context* Delta, term* t) {
  if (t == NULL) return NULL;

  switch (t->tag) {
  case VAR:
    {
      term* defn = context_lookup(t->var, Sigma);
      if (defn == NULL) {
        return term_dup(t);
      }
      return whnf(Sigma, Delta, defn);
    }
  case APP:
    {
      term* l = whnf(Sigma, Delta, t->left);
      if (l->tag == LAM) {
        term* subs = substitute(l->var, t->right, l->right);
        free_term(l);
        return whnf_and_free(Sigma, Delta, subs);
      }
      return make_app(l, term_dup(t->right));
    }
  case ELIM:
    {
      term* last = t->args[t->num_args - 1];
      term* nlast = whnf(Sigma, Delta, last);
      term* c = term_dup(t);
      free_term(c->args[c->num_args - 1]);
      c->args[c->num_args - 1] = nlast;
      if (nlast->tag == INTRO) {
        return whnf_and_free(Sigma, Delta, elim_over_intro(Delta, c));
      } else {
        return c;
      }
    }
  case HOLE:
  case DATATYPE:
  case TYPE:
  case LAM:
  case INTRO:
  case PI:
  case IMPLICIT:
    return term_dup(t);
  }
}
Exemple #7
0
static term* elim_over_intro(typing_context* Delta, term* t) {
  check(t && t->args && t->args[t->num_args - 1], "ill formed term");
  term* last = t->args[t->num_args - 1];
  datatype* T = elim_to_datatype(t->var, Delta);
  int index = datatype_intro_index(last->var, T);
  term *app = term_dup(t->args[index + 1]);
  int i;
  for (i = 0; i < last->num_args; i++) {
    app = make_app(app, term_dup(last->args[i]));
    if (constructor_arg_is_inductive(T, last->var, i)) {
      term *inductive = term_dup(t);
      free_term(inductive->args[inductive->num_args - 1]);
      inductive->args[inductive->num_args - 1] = term_dup(last->args[i]);
      app = make_app(app, inductive);
    }
  }
  free_term(t);
  t = NULL;
  return app;
 error:
  return NULL;
}
Exemple #8
0
term* term_dup(term* t) {
  if (t == NULL) return NULL;

  term* ans = make_term();
  ans->tag = t->tag;
  ans->var = variable_dup(t->var);
  ans->left = term_dup(t->left);
  ans->right = term_dup(t->right);

  DUP_VEC(ans->num_args, ans->args,
          t->num_args, t->args,
          term_dup, struct term*);

  DUP_VEC(ans->num_params, ans->params,
          t->num_params, t->params,
          term_dup, struct term*);

  DUP_VEC(ans->num_indices, ans->indices,
          t->num_indices, t->indices,
          term_dup, struct term*);


  return ans;
}
Exemple #9
0
term* normalize_fuel_intro(context *Sigma, typing_context* Delta, term* t, int fuel) {
  term* ans = make_intro(variable_dup(t->var), term_dup(t->left), t->num_args, t->num_params);
  int i;
  for (i = 0; i < t->num_params; i++) {
    ans->params[i] = normalize_fuel(Sigma, Delta, t->params[i], fuel-1);
  }

  for (i = 0; i < t->num_args; i++) {
    // FIXME: this leaks on error --jrw
    ans->args[i] = normalize_fuel(Sigma, Delta, t->args[i], fuel-1);
    if (!ans->args[i]) goto error;
  }
  return ans;
 error:
  free_term(ans);
  return NULL;
}
Exemple #10
0
/*
  invariant: no sharing between returned term and *any* arguments.
  the caller must free the result.
 */
term* substitute(variable* from, term* to, term* haystack) {
  if (haystack == NULL) return NULL;

  check(from != NULL && to != NULL, "substitute requires non-NULL arguments");
  check(term_locally_well_formed(to), "substitute requires %W to be locally well-formed", to, print_term);
  check(term_locally_well_formed(haystack),"substitute requires %W to be locally well-formed", haystack, print_term);



  switch(haystack->tag) {
  case VAR:
    if (variable_equal(from, haystack->var)) {
      return term_dup(to);
    } else {
      return term_dup(haystack);
    }
  case HOLE:
    return term_dup(haystack);
  case LAM:
    if (variable_equal(from, haystack->var)) {
      return make_lambda(variable_dup(haystack->var),
                         substitute(from, to, haystack->left),
                         term_dup(haystack->right));
    } else {
      if (is_free(haystack->var, to)) {
        variable *g = gensym(haystack->var->name);
        term *tg = make_var(g);
        term* new_haystack = make_lambda(variable_dup(g), term_dup(haystack->left),
                                         substitute(haystack->var, tg, haystack->right));
        free_term(tg);
        term* ans = substitute(from, to, new_haystack);
        free_term(new_haystack);
        return ans;
      }
      return make_lambda(variable_dup(haystack->var),
                         substitute(from, to, haystack->left),
                         substitute(from, to, haystack->right));
    }
  case PI:
    if (variable_equal(from, haystack->var)) {
      return make_pi(variable_dup(haystack->var),
                     substitute(from, to, haystack->left),
                     term_dup(haystack->right));
    } else {
      if (is_free(haystack->var, to)) {
        variable *g = gensym(haystack->var->name);
        term *tg = make_var(g);
        term* new_haystack = make_pi(variable_dup(g), term_dup(haystack->left),
                                     substitute(haystack->var, tg, haystack->right));
        free_term(tg);
        term* ans = substitute(from, to, new_haystack);
        free_term(new_haystack);
        return ans;
      }
      return make_pi(variable_dup(haystack->var),
                     substitute(from, to, haystack->left),
                     substitute(from, to, haystack->right));
    }
  case APP:
    return make_app(substitute(from, to, haystack->left),
                    substitute(from, to, haystack->right));
  case TYPE:
    return term_dup(haystack);
  case DATATYPE:
    {
      term* ans = make_datatype_term(variable_dup(haystack->var),
                                     haystack->num_params, haystack->num_indices);
#define SUB_VEC(dst, src, n) do {                       \
        int __i;                                        \
        for (__i = 0; __i < n; __i++) {                 \
          dst[__i] = substitute(from, to, src[__i]);    \
        }                                               \
      } while(0)

      SUB_VEC(ans->params, haystack->params, haystack->num_params);
      SUB_VEC(ans->indices, haystack->indices, haystack->num_indices);

      return ans;
    }

  case INTRO:
    {
      term* ans = make_intro(variable_dup(haystack->var),
                             substitute(from, to, haystack->left),
                             haystack->num_args,
                             haystack->num_params,
                             haystack->num_indices);

      SUB_VEC(ans->args, haystack->args, haystack->num_args);
      SUB_VEC(ans->params, haystack->params, haystack->num_params);
      SUB_VEC(ans->indices, haystack->indices, haystack->num_indices);
      return ans;
    }
  case ELIM:
    {
      term* ans = make_elim(variable_dup(haystack->var), haystack->num_args, haystack->num_params, haystack->num_indices);

      SUB_VEC(ans->args, haystack->args, haystack->num_args);
      SUB_VEC(ans->params, haystack->params, haystack->num_params);
      SUB_VEC(ans->indices, haystack->indices, haystack->num_indices);

      return ans;
    }
  case IMPLICIT:
    return term_dup(haystack);
  default:
    sentinel("malformed term with tag %d", haystack->tag);
  }

 error:
  return NULL;
}
Exemple #11
0
int syntactically_identical(term* a, term* b) {
  if (a == NULL || b == NULL) return a == b;
  check(term_locally_well_formed(a) && term_locally_well_formed(b), 
        "alpha equiv requires well-formed arguments");

  if (a->tag == HOLE) {
    log_info("Hole should unify with %W", b, print_term);
    return 1;
  }

  if (b->tag == HOLE) {
    log_info("Hole should unify with %W", a, print_term);
    return 1;
  }

  if (a->tag != b-> tag) return 0;

  switch (a->tag) {
  case VAR:
    return variable_equal(a->var, b->var);
  case LAM:
    {
      if (a->left != NULL && b->left != NULL && !syntactically_identical(a->left, b->left))
        return 0;
      if (variable_equal(a->var, b->var))
        return syntactically_identical(a->right, b->right);

      term* va = make_var(variable_dup(a->var));
      term* bsubs = substitute(b->var, va, b->right);
      free_term(va);

      term* c = make_lambda(variable_dup(a->var), term_dup(b->left), bsubs);
      int ans = syntactically_identical(a, c);
      free_term(c);
      return ans;

    }
  case PI:
    {
      if (!syntactically_identical(a->left, b->left))
        return 0;
      if (variable_equal(a->var, b->var))
        return syntactically_identical(a->right, b->right);


      term* va = make_var(variable_dup(a->var));
      term* bsubs = substitute(b->var, va, b->right);
      free_term(va);

      term* c = make_pi(variable_dup(a->var), term_dup(b->left), bsubs);
      int ans = syntactically_identical(a, c);
      free_term(c);
      return ans;
    }
  case APP:
    return 
      syntactically_identical(a->left, b->left) &&
      syntactically_identical(a->right, b->right);
  case DATATYPE:
    {
      if (!variable_equal(a->var, b->var)) {
        return 0;
      }
#define EQ_VEC(a, an, b, bn) do {                                       \
        if (an != bn) return 0;                                         \
        int __i;                                                        \
        for (__i = 0; __i < an; __i++) {                                \
          if (!syntactically_identical(a[__i], b[__i])) return 0;       \
        }                                                               \
      } while(0)

      EQ_VEC(a->params, a->num_params, b->params, b->num_params);
      EQ_VEC(a->indices, a->num_indices, b->indices, b->num_indices);

      return 1;
    }
  case INTRO:
  case ELIM:
    {
      if (!variable_equal(a->var, b->var)) {
        return 0;
      }

      EQ_VEC(a->args, a->num_args, b->args, b->num_args);
      EQ_VEC(a->params, a->num_params, b->params, b->num_params);
      EQ_VEC(a->indices, a->num_indices, b->indices, b->num_indices);
      return 1;
    }
  case TYPE:
    return 1;
  case IMPLICIT:
    return syntactically_identical(a->right, b->right);
  default:
    sentinel("malformed term");
  }
  
 error:
  return 0;
}