2013-08-25 01:02:38 +00:00
|
|
|
/*
|
|
|
|
Copyright (c) 2013 Microsoft Corporation. All rights reserved.
|
|
|
|
Released under Apache 2.0 license as described in the file LICENSE.
|
|
|
|
|
|
|
|
Author: Leonardo de Moura
|
|
|
|
*/
|
2013-08-30 03:12:43 +00:00
|
|
|
#include <deque>
|
2013-08-25 01:02:38 +00:00
|
|
|
#include "elaborator.h"
|
2013-09-01 21:52:17 +00:00
|
|
|
#include "normalize.h"
|
2013-08-30 03:12:43 +00:00
|
|
|
#include "metavar.h"
|
|
|
|
#include "printer.h"
|
|
|
|
#include "context.h"
|
2013-08-25 01:02:38 +00:00
|
|
|
#include "builtin.h"
|
2013-08-30 03:12:43 +00:00
|
|
|
#include "free_vars.h"
|
|
|
|
#include "for_each.h"
|
|
|
|
#include "replace.h"
|
|
|
|
#include "flet.h"
|
|
|
|
#include "elaborator_exception.h"
|
2013-08-25 01:02:38 +00:00
|
|
|
|
|
|
|
namespace lean {
|
2013-09-01 17:24:10 +00:00
|
|
|
static name g_choice_name(name(name(name(0u), "library"), "choice"));
|
|
|
|
static expr g_choice = mk_constant(g_choice_name);
|
2013-08-31 23:46:41 +00:00
|
|
|
static format g_assignment_fmt = format(":=");
|
|
|
|
static format g_unification_fmt = format("\u2248");
|
2013-08-25 17:34:19 +00:00
|
|
|
|
2013-09-01 17:24:10 +00:00
|
|
|
expr mk_choice(unsigned num_fs, expr const * fs) {
|
|
|
|
lean_assert(num_fs >= 2);
|
|
|
|
return mk_eq(g_choice, mk_app(num_fs, fs));
|
2013-08-25 17:34:19 +00:00
|
|
|
}
|
|
|
|
|
2013-09-01 17:24:10 +00:00
|
|
|
bool is_choice(expr const & e) {
|
|
|
|
return is_eq(e) && eq_lhs(e) == g_choice;
|
|
|
|
}
|
|
|
|
|
|
|
|
unsigned get_num_choices(expr const & e) {
|
|
|
|
lean_assert(is_choice(e));
|
|
|
|
return num_args(eq_rhs(e));
|
|
|
|
}
|
|
|
|
|
|
|
|
expr const & get_choice(expr const & e, unsigned i) {
|
|
|
|
lean_assert(is_choice(e));
|
|
|
|
return arg(eq_rhs(e), i);
|
2013-08-25 17:34:19 +00:00
|
|
|
}
|
2013-08-25 01:02:38 +00:00
|
|
|
|
2013-08-30 03:12:43 +00:00
|
|
|
class elaborator::imp {
|
|
|
|
// unification constraint lhs == second
|
|
|
|
struct constraint {
|
|
|
|
expr m_lhs;
|
|
|
|
expr m_rhs;
|
|
|
|
context m_ctx;
|
|
|
|
expr m_source; // auxiliary field used for producing error msgs
|
|
|
|
context m_source_ctx; // auxiliary field used for producing error msgs
|
|
|
|
unsigned m_arg_pos; // auxiliary field used for producing error msgs
|
|
|
|
constraint(expr const & lhs, expr const & rhs, context const & ctx, expr const & src, context const & src_ctx, unsigned arg_pos):
|
|
|
|
m_lhs(lhs), m_rhs(rhs), m_ctx(ctx), m_source(src), m_source_ctx(src_ctx), m_arg_pos(arg_pos) {}
|
|
|
|
constraint(expr const & lhs, expr const & rhs, constraint const & c):
|
|
|
|
m_lhs(lhs), m_rhs(rhs), m_ctx(c.m_ctx), m_source(c.m_source), m_source_ctx(c.m_source_ctx), m_arg_pos(c.m_arg_pos) {}
|
|
|
|
constraint(expr const & lhs, expr const & rhs, context const & ctx, constraint const & c):
|
|
|
|
m_lhs(lhs), m_rhs(rhs), m_ctx(ctx), m_source(c.m_source), m_source_ctx(c.m_source_ctx), m_arg_pos(c.m_arg_pos) {}
|
|
|
|
};
|
2013-08-25 01:02:38 +00:00
|
|
|
|
2013-08-30 03:12:43 +00:00
|
|
|
// information associated with the metavariable
|
|
|
|
struct metavar_info {
|
|
|
|
expr m_assignment;
|
|
|
|
expr m_type;
|
|
|
|
expr m_mvar;
|
|
|
|
context m_ctx;
|
2013-08-31 00:18:39 +00:00
|
|
|
bool m_mark; // for implementing occurs check
|
|
|
|
bool m_type_cnstr; // true when type constraint was already generated
|
2013-08-30 03:12:43 +00:00
|
|
|
metavar_info() {
|
|
|
|
m_mark = false;
|
2013-08-31 00:18:39 +00:00
|
|
|
m_type_cnstr = false;
|
2013-08-30 03:12:43 +00:00
|
|
|
}
|
|
|
|
};
|
|
|
|
|
|
|
|
typedef std::deque<constraint> constraint_queue;
|
|
|
|
typedef std::vector<metavar_info> metavars;
|
|
|
|
|
|
|
|
environment const & m_env;
|
|
|
|
name_set const * m_available_defs;
|
|
|
|
elaborator const * m_owner;
|
2013-08-31 23:46:41 +00:00
|
|
|
expr m_root;
|
2013-08-25 01:02:38 +00:00
|
|
|
|
2013-08-30 03:12:43 +00:00
|
|
|
constraint_queue m_constraints;
|
|
|
|
metavars m_metavars;
|
|
|
|
|
2013-09-01 21:52:17 +00:00
|
|
|
normalizer m_normalizer;
|
|
|
|
|
2013-08-30 03:12:43 +00:00
|
|
|
bool m_add_constraints;
|
|
|
|
|
2013-08-31 23:46:41 +00:00
|
|
|
// The following mapping is used to store the relationship
|
|
|
|
// between elaborated expressions and non-elaborated expressions.
|
|
|
|
// We need that because a frontend may associate line number information
|
|
|
|
// with the original non-elaborated expressions.
|
|
|
|
expr_map<expr> m_trace;
|
|
|
|
|
2013-08-30 03:12:43 +00:00
|
|
|
volatile bool m_interrupted;
|
|
|
|
|
2013-09-01 17:24:10 +00:00
|
|
|
expr mk_metavar(context const & ctx) {
|
|
|
|
unsigned midx = m_metavars.size();
|
|
|
|
expr r = ::lean::mk_metavar(midx);
|
|
|
|
m_metavars.push_back(metavar_info());
|
|
|
|
m_metavars[midx].m_mvar = r;
|
|
|
|
m_metavars[midx].m_ctx = ctx;
|
|
|
|
return r;
|
|
|
|
}
|
|
|
|
|
2013-08-30 03:12:43 +00:00
|
|
|
expr metavar_type(expr const & m) {
|
|
|
|
lean_assert(is_metavar(m));
|
|
|
|
unsigned midx = metavar_idx(m);
|
|
|
|
if (m_metavars[midx].m_type) {
|
|
|
|
return m_metavars[midx].m_type;
|
|
|
|
} else {
|
2013-09-01 17:24:10 +00:00
|
|
|
expr t = mk_metavar(m_metavars[midx].m_ctx);
|
2013-08-30 03:12:43 +00:00
|
|
|
m_metavars[midx].m_type = t;
|
|
|
|
return t;
|
|
|
|
}
|
2013-08-25 01:02:38 +00:00
|
|
|
}
|
|
|
|
|
2013-08-30 03:12:43 +00:00
|
|
|
expr lookup(context const & c, unsigned i) {
|
|
|
|
auto p = lookup_ext(c, i);
|
|
|
|
context_entry const & def = p.first;
|
|
|
|
context const & def_c = p.second;
|
|
|
|
lean_assert(length(c) > length(def_c));
|
|
|
|
return lift_free_vars_mmv(def.get_domain(), 0, length(c) - length(def_c));
|
|
|
|
}
|
|
|
|
|
|
|
|
expr check_pi(expr const & e, context const & ctx, expr const & s, context const & s_ctx) {
|
|
|
|
check_interrupted(m_interrupted);
|
|
|
|
if (is_pi(e)) {
|
|
|
|
return e;
|
|
|
|
} else {
|
|
|
|
expr r = head_reduce_mmv(e, m_env, m_available_defs);
|
|
|
|
if (!is_eqp(r, e)) {
|
|
|
|
return check_pi(r, ctx, s, s_ctx);
|
|
|
|
} else if (is_var(e)) {
|
|
|
|
try {
|
|
|
|
auto p = lookup_ext(ctx, var_idx(e));
|
|
|
|
context_entry const & entry = p.first;
|
|
|
|
context const & entry_ctx = p.second;
|
|
|
|
if (entry.get_body()) {
|
|
|
|
return lift_free_vars_mmv(check_pi(entry.get_body(), entry_ctx, s, s_ctx), 0, length(ctx) - length(entry_ctx));
|
|
|
|
}
|
|
|
|
} catch (exception&) {
|
|
|
|
// this can happen if we access a variable out of scope
|
|
|
|
throw function_expected_exception(m_env, s_ctx, s);
|
|
|
|
}
|
2013-08-25 01:02:38 +00:00
|
|
|
}
|
2013-08-30 03:12:43 +00:00
|
|
|
throw function_expected_exception(m_env, s_ctx, s);
|
2013-08-25 01:02:38 +00:00
|
|
|
}
|
|
|
|
}
|
|
|
|
|
2013-08-30 03:12:43 +00:00
|
|
|
level check_universe(expr const & e, context const & ctx, expr const & s, context const & s_ctx) {
|
|
|
|
check_interrupted(m_interrupted);
|
|
|
|
if (is_metavar(e)) {
|
|
|
|
// approx: assume it is level 0
|
|
|
|
return level();
|
|
|
|
} else if (is_type(e)) {
|
|
|
|
return ty_level(e);
|
2013-08-31 00:07:45 +00:00
|
|
|
} else if (e == Bool) {
|
|
|
|
return level();
|
2013-08-30 03:12:43 +00:00
|
|
|
} else {
|
|
|
|
expr r = head_reduce_mmv(e, m_env, m_available_defs);
|
|
|
|
if (!is_eqp(r, e)) {
|
|
|
|
return check_universe(r, ctx, s, s_ctx);
|
|
|
|
} else if (is_var(e)) {
|
|
|
|
try {
|
|
|
|
auto p = lookup_ext(ctx, var_idx(e));
|
|
|
|
context_entry const & entry = p.first;
|
|
|
|
context const & entry_ctx = p.second;
|
|
|
|
if (entry.get_body()) {
|
|
|
|
return check_universe(entry.get_body(), entry_ctx, s, s_ctx);
|
|
|
|
}
|
|
|
|
} catch (exception&) {
|
|
|
|
// this can happen if we access a variable out of scope
|
|
|
|
throw type_expected_exception(m_env, s_ctx, s);
|
|
|
|
}
|
2013-08-25 01:02:38 +00:00
|
|
|
}
|
2013-08-30 03:12:43 +00:00
|
|
|
throw type_expected_exception(m_env, s_ctx, s);
|
2013-08-25 01:02:38 +00:00
|
|
|
}
|
|
|
|
}
|
|
|
|
|
2013-09-01 21:52:17 +00:00
|
|
|
bool is_convertible(expr const & t1, expr const & t2, context const & ctx) {
|
|
|
|
return m_normalizer.is_convertible(t1, t2, ctx);
|
|
|
|
}
|
|
|
|
|
2013-08-30 03:12:43 +00:00
|
|
|
void add_constraint(expr const & t1, expr const & t2, context const & ctx, expr const & s, unsigned arg_pos) {
|
|
|
|
if (has_metavar(t1) || has_metavar(t2)) {
|
|
|
|
m_constraints.push_back(constraint(t1, t2, ctx, s, ctx, arg_pos));
|
|
|
|
}
|
|
|
|
}
|
|
|
|
|
2013-09-01 21:52:17 +00:00
|
|
|
void choose(buffer<expr> const & f_choices, buffer<expr> const & f_choice_types,
|
|
|
|
buffer<expr> & args, buffer<expr> & types,
|
|
|
|
context const & ctx, expr const & src) {
|
|
|
|
lean_assert(f_choices.size() == f_choice_types.size());
|
|
|
|
buffer<unsigned> good_choices;
|
|
|
|
unsigned num_choices = f_choices.size();
|
|
|
|
unsigned num_args = args.size();
|
|
|
|
for (unsigned j = 0; j < num_choices; j++) {
|
|
|
|
expr f_t = f_choice_types[j];
|
|
|
|
try {
|
|
|
|
unsigned i = 1;
|
|
|
|
for (; i < num_args; i++) {
|
|
|
|
f_t = check_pi(f_t, ctx, src, ctx);
|
|
|
|
expr const & expected = abst_domain(f_t);
|
|
|
|
if (!has_metavar(expected) && !has_metavar(types[i])) {
|
|
|
|
if (!is_convertible(expected, types[i], ctx)) {
|
|
|
|
break;
|
|
|
|
}
|
|
|
|
}
|
|
|
|
f_t = instantiate_free_var_mmv(abst_body(f_t), 0, args[i]);
|
|
|
|
}
|
|
|
|
if (i == num_args) {
|
|
|
|
good_choices.push_back(j);
|
|
|
|
}
|
|
|
|
} catch (exception & ex) {
|
|
|
|
// candidate failed
|
|
|
|
// do nothing
|
|
|
|
}
|
|
|
|
}
|
|
|
|
if (good_choices.size() == 0) {
|
|
|
|
// TODO add information to the exception
|
|
|
|
throw exception("none of the overloads are good");
|
|
|
|
} else if (good_choices.size() == 1) {
|
|
|
|
args[0] = f_choices[good_choices[0]];
|
|
|
|
types[0] = f_choice_types[good_choices[0]];
|
|
|
|
} else {
|
|
|
|
// TODO add information to the exception
|
|
|
|
throw exception("ambiguous overload");
|
|
|
|
}
|
|
|
|
}
|
|
|
|
|
2013-09-01 17:24:10 +00:00
|
|
|
typedef std::pair<expr, expr> expr_pair;
|
|
|
|
|
|
|
|
/**
|
|
|
|
\brief Traverse the expression \c e, and compute
|
|
|
|
|
|
|
|
1- A new expression that does not contain choice expressions,
|
|
|
|
coercions have been added when appropriate, and placeholders
|
|
|
|
have been replaced with metavariables.
|
|
|
|
|
|
|
|
2- The type of \c e.
|
|
|
|
|
|
|
|
It also populates m_constraints with a set of constraints that
|
|
|
|
need to be solved to infer the value of the metavariables.
|
|
|
|
*/
|
|
|
|
expr_pair process(expr const & e, context const & ctx) {
|
2013-08-30 03:12:43 +00:00
|
|
|
check_interrupted(m_interrupted);
|
|
|
|
switch (e.kind()) {
|
|
|
|
case expr_kind::Constant:
|
2013-09-01 17:24:10 +00:00
|
|
|
if (is_placeholder(e)) {
|
|
|
|
expr m = mk_metavar(ctx);
|
|
|
|
m_trace[m] = e;
|
|
|
|
return expr_pair(m, metavar_type(m));
|
|
|
|
} else if (is_metavar(e)) {
|
|
|
|
return expr_pair(e, metavar_type(e));
|
2013-08-25 22:21:01 +00:00
|
|
|
} else {
|
2013-09-01 17:24:10 +00:00
|
|
|
return expr_pair(e, m_env.get_object(const_name(e)).get_type());
|
2013-08-25 22:21:01 +00:00
|
|
|
}
|
2013-08-30 03:12:43 +00:00
|
|
|
case expr_kind::Var:
|
2013-09-01 17:24:10 +00:00
|
|
|
return expr_pair(e, lookup(ctx, var_idx(e)));
|
2013-08-30 03:12:43 +00:00
|
|
|
case expr_kind::Type:
|
2013-09-01 17:24:10 +00:00
|
|
|
return expr_pair(e, mk_type(ty_level(e) + 1));
|
2013-08-30 03:12:43 +00:00
|
|
|
case expr_kind::Value:
|
2013-09-01 17:24:10 +00:00
|
|
|
return expr_pair(e, to_value(e).get_type());
|
2013-08-30 03:12:43 +00:00
|
|
|
case expr_kind::App: {
|
2013-09-01 17:24:10 +00:00
|
|
|
buffer<expr> args;
|
2013-08-30 03:12:43 +00:00
|
|
|
buffer<expr> types;
|
2013-09-01 17:24:10 +00:00
|
|
|
buffer<expr> f_choices;
|
|
|
|
buffer<expr> f_choice_types;
|
2013-08-30 03:12:43 +00:00
|
|
|
unsigned num = num_args(e);
|
2013-09-01 17:24:10 +00:00
|
|
|
unsigned i = 0;
|
|
|
|
bool modified = false;
|
|
|
|
expr const & f = arg(e, 0);
|
|
|
|
if (is_metavar(f)) {
|
2013-08-30 03:12:43 +00:00
|
|
|
throw invalid_placeholder_exception(*m_owner, ctx, e);
|
2013-09-01 17:24:10 +00:00
|
|
|
} else if (is_choice(f)) {
|
|
|
|
unsigned num_alts = get_num_choices(f);
|
|
|
|
for (unsigned j = 0; j < num_alts; j++) {
|
|
|
|
auto p = process(get_choice(f, j), ctx);
|
|
|
|
f_choices.push_back(p.first);
|
|
|
|
f_choice_types.push_back(p.second);
|
|
|
|
}
|
|
|
|
args.push_back(expr()); // placeholder
|
|
|
|
types.push_back(expr()); // placeholder
|
|
|
|
modified = true;
|
|
|
|
i++;
|
2013-08-30 03:12:43 +00:00
|
|
|
}
|
2013-09-01 17:24:10 +00:00
|
|
|
for (; i < num; i++) {
|
|
|
|
expr const & a_i = arg(e, i);
|
|
|
|
auto p = process(a_i, ctx);
|
|
|
|
if (!is_eqp(p.first, a_i))
|
|
|
|
modified = true;
|
|
|
|
args.push_back(p.first);
|
|
|
|
types.push_back(p.second);
|
|
|
|
}
|
2013-09-01 21:52:17 +00:00
|
|
|
if (!f_choices.empty()) {
|
|
|
|
// choose one of the functions (overloads) based on the types in types
|
|
|
|
choose(f_choices, f_choice_types, args, types, ctx, e);
|
|
|
|
}
|
2013-09-01 17:24:10 +00:00
|
|
|
expr f_t = types[0];
|
2013-08-30 03:12:43 +00:00
|
|
|
for (unsigned i = 1; i < num; i++) {
|
|
|
|
f_t = check_pi(f_t, ctx, e, ctx);
|
|
|
|
if (m_add_constraints)
|
|
|
|
add_constraint(abst_domain(f_t), types[i], ctx, e, i);
|
2013-09-01 17:24:10 +00:00
|
|
|
f_t = instantiate_free_var_mmv(abst_body(f_t), 0, args[i]);
|
|
|
|
}
|
|
|
|
if (modified) {
|
|
|
|
expr new_e = mk_app(args.size(), args.data());
|
|
|
|
m_trace[new_e] = e;
|
|
|
|
return expr_pair(new_e, f_t);
|
|
|
|
} else {
|
|
|
|
return expr_pair(e, f_t);
|
2013-08-30 03:12:43 +00:00
|
|
|
}
|
|
|
|
}
|
|
|
|
case expr_kind::Eq: {
|
2013-09-01 17:24:10 +00:00
|
|
|
auto lhs_p = process(eq_lhs(e), ctx);
|
|
|
|
auto rhs_p = process(eq_rhs(e), ctx);
|
|
|
|
if (is_eqp(lhs_p.first, eq_lhs(e)) && is_eqp(rhs_p.first, eq_rhs(e))) {
|
|
|
|
return expr_pair(e, mk_bool_type());
|
|
|
|
} else {
|
|
|
|
expr new_e = mk_eq(lhs_p.first, rhs_p.first);
|
|
|
|
m_trace[new_e] = e;
|
|
|
|
return expr_pair(new_e, mk_bool_type());
|
|
|
|
}
|
2013-08-30 03:12:43 +00:00
|
|
|
}
|
|
|
|
case expr_kind::Pi: {
|
2013-09-01 17:24:10 +00:00
|
|
|
auto d_p = process(abst_domain(e), ctx);
|
|
|
|
auto b_p = process(abst_body(e), extend(ctx, abst_name(e), d_p.first));
|
|
|
|
expr t = mk_type(max(check_universe(d_p.second, ctx, e, ctx), check_universe(b_p.second, ctx, e, ctx)));
|
|
|
|
if (is_eqp(d_p.first, abst_domain(e)) && is_eqp(b_p.first, abst_body(e))) {
|
|
|
|
return expr_pair(e, t);
|
|
|
|
} else {
|
|
|
|
expr new_e = mk_pi(abst_name(e), d_p.first, b_p.first);
|
|
|
|
m_trace[new_e] = e;
|
|
|
|
return expr_pair(new_e, t);
|
|
|
|
}
|
2013-08-30 03:12:43 +00:00
|
|
|
}
|
|
|
|
case expr_kind::Lambda: {
|
2013-09-01 17:24:10 +00:00
|
|
|
auto d_p = process(abst_domain(e), ctx);
|
|
|
|
auto b_p = process(abst_body(e), extend(ctx, abst_name(e), d_p.first));
|
|
|
|
expr t = mk_pi(abst_name(e), d_p.first, b_p.second);
|
|
|
|
if (is_eqp(d_p.first, abst_domain(e)) && is_eqp(b_p.first, abst_body(e))) {
|
|
|
|
return expr_pair(e, t);
|
|
|
|
} else {
|
|
|
|
expr new_e = mk_lambda(abst_name(e), d_p.first, b_p.first);
|
|
|
|
m_trace[new_e] = e;
|
|
|
|
return expr_pair(new_e, t);
|
|
|
|
}
|
2013-08-30 03:12:43 +00:00
|
|
|
}
|
|
|
|
case expr_kind::Let: {
|
2013-09-01 17:24:10 +00:00
|
|
|
auto v_p = process(let_value(e), ctx);
|
|
|
|
auto b_p = process(let_body(e), extend(ctx, let_name(e), v_p.second, v_p.first));
|
|
|
|
expr t = lower_free_vars_mmv(b_p.second, 1, 1);
|
|
|
|
if (is_eqp(v_p.first, let_value(e)) && is_eqp(b_p.first, let_body(e))) {
|
|
|
|
return expr_pair(e, t);
|
|
|
|
} else {
|
|
|
|
expr new_e = mk_let(let_name(e), v_p.first, b_p.first);
|
|
|
|
m_trace[new_e] = e;
|
|
|
|
return expr_pair(new_e, t);
|
|
|
|
}
|
2013-08-30 03:12:43 +00:00
|
|
|
}}
|
|
|
|
lean_unreachable();
|
2013-09-01 17:24:10 +00:00
|
|
|
return expr_pair(expr(), expr());
|
|
|
|
}
|
|
|
|
|
|
|
|
expr infer(expr const & e, context const & ctx) {
|
|
|
|
return process(e, ctx).second;
|
2013-08-30 03:12:43 +00:00
|
|
|
}
|
|
|
|
|
|
|
|
bool is_simple_ho_match(expr const & e1, expr const & e2, context const & ctx) {
|
|
|
|
if (is_app(e1) && is_meta(arg(e1,0)) && is_var(arg(e1,1), 0) && num_args(e1) == 2 && length(ctx) > 0) {
|
|
|
|
return true;
|
2013-08-25 01:02:38 +00:00
|
|
|
} else {
|
2013-08-30 03:12:43 +00:00
|
|
|
return false;
|
|
|
|
}
|
|
|
|
}
|
2013-08-25 01:02:38 +00:00
|
|
|
|
2013-08-30 03:12:43 +00:00
|
|
|
void unify_simple_ho_match(expr const & e1, expr const & e2, constraint const & c) {
|
|
|
|
context const & ctx = c.m_ctx;
|
|
|
|
m_constraints.push_back(constraint(arg(e1,0), mk_lambda(car(ctx).get_name(), car(ctx).get_domain(), e2), c));
|
2013-08-25 22:21:01 +00:00
|
|
|
}
|
2013-08-30 03:12:43 +00:00
|
|
|
|
|
|
|
struct cycle_detected {};
|
|
|
|
void occ_core(expr const & t) {
|
|
|
|
check_interrupted(m_interrupted);
|
|
|
|
auto proc = [&](expr const & e, unsigned offset) {
|
|
|
|
if (is_metavar(e)) {
|
|
|
|
unsigned midx = metavar_idx(e);
|
|
|
|
if (m_metavars[midx].m_mark)
|
|
|
|
throw cycle_detected();
|
|
|
|
if (m_metavars[midx].m_assignment) {
|
|
|
|
flet<bool> set(m_metavars[midx].m_mark, true);
|
|
|
|
occ_core(m_metavars[midx].m_assignment);
|
|
|
|
}
|
|
|
|
}
|
|
|
|
};
|
|
|
|
for_each_fn<decltype(proc)> visitor(proc);
|
|
|
|
visitor(t);
|
|
|
|
}
|
|
|
|
|
|
|
|
// occurs check
|
|
|
|
bool occ(expr const & t, unsigned midx) {
|
|
|
|
lean_assert(!m_metavars[midx].m_mark);
|
|
|
|
flet<bool> set(m_metavars[midx].m_mark, true);
|
|
|
|
try {
|
|
|
|
occ_core(t);
|
|
|
|
return true;
|
|
|
|
} catch (cycle_detected&) {
|
|
|
|
return false;
|
|
|
|
}
|
|
|
|
}
|
|
|
|
|
|
|
|
[[noreturn]] void throw_unification_exception(constraint const & c) {
|
|
|
|
// display(std::cout);
|
|
|
|
m_constraints.push_back(c);
|
|
|
|
if (c.m_arg_pos != static_cast<unsigned>(-1)) {
|
|
|
|
throw unification_app_mismatch_exception(*m_owner, c.m_source_ctx, c.m_source, c.m_arg_pos);
|
|
|
|
} else {
|
|
|
|
throw unification_type_mismatch_exception(*m_owner, c.m_source_ctx, c.m_source);
|
|
|
|
}
|
|
|
|
}
|
|
|
|
|
|
|
|
void solve_mvar(expr const & m, expr const & t, constraint const & c) {
|
|
|
|
lean_assert(is_metavar(m));
|
|
|
|
unsigned midx = metavar_idx(m);
|
|
|
|
if (m_metavars[midx].m_assignment) {
|
|
|
|
m_constraints.push_back(constraint(m_metavars[midx].m_assignment, t, c));
|
|
|
|
} else if (has_metavar(t, midx) || !occ(t, midx)) {
|
|
|
|
throw_unification_exception(c);
|
|
|
|
} else {
|
|
|
|
m_metavars[midx].m_assignment = t;
|
|
|
|
}
|
|
|
|
}
|
|
|
|
|
|
|
|
bool solve_meta(expr const & e, expr const & t, constraint const & c) {
|
|
|
|
lean_assert(!is_metavar(e));
|
|
|
|
expr const & m = get_metavar(e);
|
|
|
|
unsigned midx = metavar_idx(m);
|
|
|
|
unsigned i, s, n;
|
|
|
|
expr v, a, b;
|
|
|
|
|
|
|
|
if (m_metavars[midx].m_assignment) {
|
|
|
|
expr s = instantiate_metavar(e, midx, m_metavars[midx].m_assignment);
|
|
|
|
m_constraints.push_back(constraint(s, t, c));
|
|
|
|
return true;
|
|
|
|
}
|
|
|
|
|
|
|
|
if (!has_metavar(t)) {
|
|
|
|
if (is_lower(e, a, s, n)) {
|
|
|
|
m_constraints.push_back(constraint(a, lift_free_vars_mmv(t, s-n, n), c));
|
|
|
|
return true;
|
|
|
|
}
|
|
|
|
|
|
|
|
if (is_lift(e, a, s, n)) {
|
|
|
|
if (!has_free_var(t, s, s+n)) {
|
|
|
|
m_constraints.push_back(constraint(a, lower_free_vars_mmv(t, s+n, n), c));
|
|
|
|
return true;
|
|
|
|
} else {
|
|
|
|
// display(std::cout);
|
|
|
|
throw_unification_exception(c);
|
|
|
|
}
|
|
|
|
}
|
|
|
|
}
|
|
|
|
|
|
|
|
if (has_assigned_metavar(t)) {
|
|
|
|
m_constraints.push_back(constraint(e, instantiate(t), c));
|
|
|
|
return true;
|
|
|
|
}
|
|
|
|
|
|
|
|
if (is_subst(e, a, i, v) && is_lift(a, b, s, n) && has_free_var(t, s, s+n)) {
|
|
|
|
// subst (lift b s n) i v == t
|
|
|
|
// (lift b s n) does not have free-variables in the range [s, s+n)
|
|
|
|
// Thus, if t has a free variables in [s, s+n), then the only possible solution is
|
|
|
|
// (lift b s n) == i
|
|
|
|
// v == t
|
|
|
|
m_constraints.push_back(constraint(a, mk_var(i), c));
|
|
|
|
m_constraints.push_back(constraint(v, t, c));
|
|
|
|
return true;
|
|
|
|
}
|
|
|
|
|
|
|
|
return false;
|
|
|
|
}
|
|
|
|
|
|
|
|
void solve_core() {
|
|
|
|
unsigned delayed = 0;
|
|
|
|
unsigned last_num_constraints = 0;
|
|
|
|
while (!m_constraints.empty()) {
|
|
|
|
check_interrupted(m_interrupted);
|
|
|
|
constraint c = m_constraints.front();
|
|
|
|
m_constraints.pop_front();
|
|
|
|
expr const & lhs = c.m_lhs;
|
|
|
|
expr const & rhs = c.m_rhs;
|
|
|
|
// std::cout << "Solving " << lhs << " === " << rhs << "\n";
|
|
|
|
if (lhs == rhs || (!has_metavar(lhs) && !has_metavar(rhs))) {
|
|
|
|
// do nothing
|
|
|
|
delayed = 0;
|
|
|
|
} else if (is_metavar(lhs)) {
|
|
|
|
delayed = 0;
|
|
|
|
solve_mvar(lhs, rhs, c);
|
|
|
|
} else if (is_metavar(rhs)) {
|
|
|
|
delayed = 0;
|
|
|
|
solve_mvar(rhs, lhs, c);
|
|
|
|
} else if (is_meta(lhs) || is_meta(rhs)) {
|
|
|
|
if (is_meta(lhs) && solve_meta(lhs, rhs, c)) {
|
|
|
|
delayed = 0;
|
|
|
|
} else if (is_meta(rhs) && solve_meta(rhs, lhs, c)) {
|
|
|
|
delayed = 0;
|
|
|
|
} else {
|
|
|
|
m_constraints.push_back(c);
|
|
|
|
if (delayed == 0) {
|
|
|
|
last_num_constraints = m_constraints.size();
|
|
|
|
delayed++;
|
|
|
|
} else if (delayed > last_num_constraints) {
|
|
|
|
throw_unification_exception(c);
|
|
|
|
} else {
|
|
|
|
delayed++;
|
|
|
|
}
|
|
|
|
}
|
|
|
|
} else if (is_type(lhs) && is_type(rhs)) {
|
|
|
|
delayed = 0;
|
|
|
|
return; // ignoring type universe levels. We let the kernel check that
|
|
|
|
} else if (is_abstraction(lhs) && is_abstraction(rhs)) {
|
|
|
|
delayed = 0;
|
|
|
|
m_constraints.push_back(constraint(abst_domain(lhs), abst_domain(rhs), c));
|
|
|
|
m_constraints.push_back(constraint(abst_body(lhs), abst_body(rhs), extend(c.m_ctx, abst_name(lhs), abst_domain(lhs)), c));
|
|
|
|
} else if (is_eq(lhs) && is_eq(rhs)) {
|
|
|
|
delayed = 0;
|
|
|
|
m_constraints.push_back(constraint(eq_lhs(lhs), eq_lhs(rhs), c));
|
|
|
|
m_constraints.push_back(constraint(eq_rhs(lhs), eq_rhs(rhs), c));
|
|
|
|
} else {
|
|
|
|
expr new_lhs = head_reduce_mmv(lhs, m_env, m_available_defs);
|
|
|
|
expr new_rhs = head_reduce_mmv(rhs, m_env, m_available_defs);
|
|
|
|
if (!is_eqp(lhs, new_lhs) || !is_eqp(rhs, new_rhs)) {
|
|
|
|
delayed = 0;
|
|
|
|
m_constraints.push_back(constraint(new_lhs, new_rhs, c));
|
|
|
|
} else if (is_app(new_lhs) && is_app(new_rhs) && num_args(new_lhs) == num_args(new_rhs)) {
|
|
|
|
delayed = 0;
|
|
|
|
unsigned num = num_args(new_lhs);
|
|
|
|
for (unsigned i = 0; i < num; i++) {
|
|
|
|
m_constraints.push_back(constraint(arg(new_lhs, i), arg(new_rhs, i), c));
|
|
|
|
}
|
|
|
|
} else if (is_simple_ho_match(new_lhs, new_rhs, c.m_ctx)) {
|
|
|
|
delayed = 0;
|
|
|
|
unify_simple_ho_match(new_lhs, new_rhs, c);
|
|
|
|
} else if (is_simple_ho_match(new_rhs, new_lhs, c.m_ctx)) {
|
|
|
|
delayed = 0;
|
|
|
|
unify_simple_ho_match(new_rhs, new_lhs, c);
|
|
|
|
} else {
|
|
|
|
throw_unification_exception(c);
|
|
|
|
}
|
|
|
|
}
|
|
|
|
}
|
|
|
|
}
|
|
|
|
|
|
|
|
struct found_assigned {};
|
|
|
|
bool has_assigned_metavar(expr const & e) {
|
|
|
|
auto proc = [&](expr const & n, unsigned offset) {
|
|
|
|
if (is_metavar(n)) {
|
|
|
|
unsigned midx = metavar_idx(n);
|
|
|
|
if (m_metavars[midx].m_assignment)
|
|
|
|
throw found_assigned();
|
|
|
|
}
|
|
|
|
};
|
|
|
|
for_each_fn<decltype(proc)> visitor(proc);
|
|
|
|
try {
|
|
|
|
visitor(e);
|
|
|
|
return false;
|
|
|
|
} catch (found_assigned&) {
|
|
|
|
return true;
|
|
|
|
}
|
|
|
|
}
|
|
|
|
|
|
|
|
expr instantiate(expr const & e) {
|
2013-08-30 16:04:11 +00:00
|
|
|
auto proc = [&](expr const & n, unsigned offset) -> expr {
|
2013-08-30 03:12:43 +00:00
|
|
|
if (is_meta(n)) {
|
|
|
|
expr const & m = get_metavar(n);
|
|
|
|
unsigned midx = metavar_idx(m);
|
|
|
|
if (m_metavars[midx].m_assignment) {
|
|
|
|
if (has_assigned_metavar(m_metavars[midx].m_assignment)) {
|
|
|
|
m_metavars[midx].m_assignment = instantiate(m_metavars[midx].m_assignment);
|
|
|
|
}
|
|
|
|
return instantiate_metavar(n, midx, m_metavars[midx].m_assignment);
|
|
|
|
}
|
|
|
|
}
|
|
|
|
return n;
|
|
|
|
};
|
2013-08-31 23:46:41 +00:00
|
|
|
|
|
|
|
auto tracer = [&](expr const & old_e, expr const & new_e) {
|
|
|
|
if (!is_eqp(new_e, old_e)) {
|
|
|
|
m_trace[new_e] = old_e;
|
|
|
|
}
|
|
|
|
};
|
|
|
|
|
|
|
|
replace_fn<decltype(proc), decltype(tracer)> replacer(proc, tracer);
|
2013-08-30 03:12:43 +00:00
|
|
|
return replacer(e);
|
|
|
|
}
|
|
|
|
|
2013-09-01 17:24:10 +00:00
|
|
|
void solve() {
|
|
|
|
unsigned num_meta = m_metavars.size();
|
2013-08-30 03:12:43 +00:00
|
|
|
m_add_constraints = false;
|
|
|
|
while (true) {
|
|
|
|
solve_core();
|
|
|
|
bool cont = false;
|
|
|
|
bool progress = false;
|
2013-08-31 23:46:41 +00:00
|
|
|
// unsigned unsolved_midx = 0;
|
2013-08-30 03:12:43 +00:00
|
|
|
for (unsigned midx = 0; midx < num_meta; midx++) {
|
|
|
|
if (m_metavars[midx].m_assignment) {
|
|
|
|
if (has_assigned_metavar(m_metavars[midx].m_assignment)) {
|
|
|
|
m_metavars[midx].m_assignment = instantiate(m_metavars[midx].m_assignment);
|
|
|
|
}
|
|
|
|
if (has_metavar(m_metavars[midx].m_assignment)) {
|
2013-08-31 23:46:41 +00:00
|
|
|
// unsolved_midx = midx;
|
2013-08-30 03:12:43 +00:00
|
|
|
cont = true; // must continue
|
|
|
|
} else {
|
2013-08-31 00:18:39 +00:00
|
|
|
if (m_metavars[midx].m_type && !m_metavars[midx].m_type_cnstr) {
|
2013-08-30 03:12:43 +00:00
|
|
|
try {
|
|
|
|
expr t = infer(m_metavars[midx].m_assignment, m_metavars[midx].m_ctx);
|
2013-08-31 00:18:39 +00:00
|
|
|
m_metavars[midx].m_type_cnstr = true;
|
2013-08-30 03:12:43 +00:00
|
|
|
m_constraints.push_back(constraint(m_metavars[midx].m_type, t, m_metavars[midx].m_ctx,
|
|
|
|
m_metavars[midx].m_mvar, m_metavars[midx].m_ctx, static_cast<unsigned>(-1)));
|
|
|
|
progress = true;
|
|
|
|
} catch (exception&) {
|
2013-08-31 21:24:07 +00:00
|
|
|
// std::cout << "Failed to infer type of: ?M" << midx << "\n"
|
|
|
|
// << m_metavars[midx].m_assignment << "\nAT\n" << m_metavars[midx].m_ctx << "\n";
|
2013-08-30 03:12:43 +00:00
|
|
|
throw unification_type_mismatch_exception(*m_owner, m_metavars[midx].m_ctx, m_metavars[midx].m_mvar);
|
|
|
|
}
|
|
|
|
}
|
|
|
|
}
|
|
|
|
}
|
|
|
|
}
|
|
|
|
if (!cont)
|
|
|
|
return;
|
|
|
|
if (!progress)
|
2013-08-31 23:46:41 +00:00
|
|
|
throw unsolved_placeholder_exception(*m_owner, context(), m_root);
|
2013-08-30 03:12:43 +00:00
|
|
|
}
|
|
|
|
}
|
|
|
|
|
|
|
|
public:
|
|
|
|
imp(environment const & env, name_set const * defs):
|
|
|
|
m_env(env),
|
2013-09-01 21:52:17 +00:00
|
|
|
m_available_defs(defs),
|
|
|
|
m_normalizer(env) {
|
2013-08-30 03:12:43 +00:00
|
|
|
m_interrupted = false;
|
|
|
|
m_owner = nullptr;
|
|
|
|
}
|
|
|
|
|
|
|
|
void clear() {
|
2013-08-31 23:46:41 +00:00
|
|
|
m_trace.clear();
|
2013-09-01 21:52:17 +00:00
|
|
|
m_normalizer.clear();
|
2013-08-30 03:12:43 +00:00
|
|
|
}
|
|
|
|
|
|
|
|
void set_interrupt(bool flag) {
|
|
|
|
m_interrupted = flag;
|
2013-09-01 21:52:17 +00:00
|
|
|
m_normalizer.set_interrupt(flag);
|
2013-08-30 03:12:43 +00:00
|
|
|
}
|
|
|
|
|
|
|
|
void display(std::ostream & out) {
|
|
|
|
for (unsigned i = 0; i < m_metavars.size(); i++) {
|
|
|
|
out << "#" << i << " ";
|
|
|
|
auto m = m_metavars[i];
|
|
|
|
if (m.m_assignment)
|
|
|
|
out << m.m_assignment;
|
|
|
|
else
|
|
|
|
out << "[unassigned]";
|
|
|
|
if (m.m_type)
|
|
|
|
out << ", type: " << m.m_type;
|
|
|
|
out << "\n";
|
|
|
|
}
|
|
|
|
|
|
|
|
for (auto c : m_constraints) {
|
|
|
|
out << c.m_lhs << " === " << c.m_rhs << "\n";
|
|
|
|
}
|
|
|
|
}
|
|
|
|
|
|
|
|
environment const & get_environment() const {
|
|
|
|
return m_env;
|
|
|
|
}
|
|
|
|
|
|
|
|
expr operator()(expr const & e, elaborator const & elb) {
|
2013-09-01 21:52:17 +00:00
|
|
|
m_constraints.clear();
|
|
|
|
m_metavars.clear();
|
|
|
|
m_owner = &elb;
|
|
|
|
m_add_constraints = true;
|
|
|
|
m_root = process(e, context()).first;
|
|
|
|
if (has_metavar(m_root)) {
|
2013-09-01 17:24:10 +00:00
|
|
|
solve();
|
2013-09-01 00:11:06 +00:00
|
|
|
return instantiate(m_root);
|
2013-08-31 23:46:41 +00:00
|
|
|
} else {
|
2013-09-01 21:52:17 +00:00
|
|
|
return m_root;
|
2013-08-31 23:46:41 +00:00
|
|
|
}
|
|
|
|
}
|
|
|
|
|
|
|
|
expr const & get_original(expr const & e) const {
|
|
|
|
expr const * r = &e;
|
|
|
|
while (true) {
|
|
|
|
auto it = m_trace.find(*r);
|
|
|
|
if (it == m_trace.end()) {
|
|
|
|
return *r;
|
|
|
|
} else {
|
|
|
|
r = &(it->second);
|
|
|
|
}
|
|
|
|
}
|
|
|
|
}
|
|
|
|
|
|
|
|
format pp(formatter & f, options const & o) const {
|
|
|
|
format r;
|
|
|
|
bool first = true;
|
|
|
|
for (unsigned i = 0; i < m_metavars.size(); i++) {
|
|
|
|
metavar_info const & info = m_metavars[i];
|
|
|
|
expr m = ::lean::mk_metavar(i);
|
|
|
|
if (first) first = false; else r += line();
|
|
|
|
format r_assignment;
|
|
|
|
if (info.m_assignment)
|
|
|
|
r_assignment = f(info.m_assignment, o);
|
|
|
|
else
|
|
|
|
r_assignment = highlight(format("[unassigned]"));
|
|
|
|
r += group(format{f(m,o), space(), g_assignment_fmt, line(), r_assignment});
|
|
|
|
}
|
|
|
|
for (auto c : m_constraints) {
|
|
|
|
if (first) first = false; else r += line();
|
|
|
|
r += group(format{f(c.m_lhs, o), space(), g_unification_fmt, line(), f(c.m_rhs, o)});
|
|
|
|
}
|
|
|
|
return r;
|
2013-08-30 03:12:43 +00:00
|
|
|
}
|
|
|
|
};
|
|
|
|
elaborator::elaborator(environment const & env):m_ptr(new imp(env, nullptr)) {}
|
|
|
|
elaborator::~elaborator() {}
|
|
|
|
expr elaborator::operator()(expr const & e) { return (*m_ptr)(e, *this); }
|
2013-08-31 23:46:41 +00:00
|
|
|
expr const & elaborator::get_original(expr const & e) const { return m_ptr->get_original(e); }
|
2013-08-30 03:12:43 +00:00
|
|
|
void elaborator::set_interrupt(bool flag) { m_ptr->set_interrupt(flag); }
|
|
|
|
void elaborator::clear() { m_ptr->clear(); }
|
|
|
|
environment const & elaborator::get_environment() const { return m_ptr->get_environment(); }
|
|
|
|
void elaborator::display(std::ostream & out) const { m_ptr->display(out); }
|
2013-08-31 23:46:41 +00:00
|
|
|
format elaborator::pp(formatter & f, options const & o) const { return m_ptr->pp(f,o); }
|
2013-08-31 00:18:39 +00:00
|
|
|
void elaborator::print(imp * ptr) { ptr->display(std::cout); }
|
2013-08-25 01:02:38 +00:00
|
|
|
}
|