/* Copyright (c) 2013 Microsoft Corporation. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Author: Leonardo de Moura */ #include #include "elaborator.h" #include "normalize.h" #include "metavar.h" #include "printer.h" #include "context.h" #include "builtin.h" #include "free_vars.h" #include "for_each.h" #include "update_expr.h" #include "replace.h" #include "flet.h" #include "elaborator_exception.h" namespace lean { static name g_choice_name(name(name(name(0u), "library"), "choice")); static expr g_choice = mk_constant(g_choice_name); static format g_assignment_fmt = format(":="); static format g_unification_fmt = format("\u2248"); expr mk_choice(unsigned num_fs, expr const * fs) { lean_assert(num_fs >= 2); return mk_eq(g_choice, mk_app(num_fs, fs)); } 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); } 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) {} }; // information associated with the metavariable struct metavar_info { expr m_assignment; expr m_type; expr m_mvar; context m_ctx; bool m_mark; // for implementing occurs check bool m_type_cnstr; // true when type constraint was already generated metavar_info() { m_mark = false; m_type_cnstr = false; } }; typedef std::deque constraint_queue; typedef std::vector metavars; environment const & m_env; name_set const * m_available_defs; elaborator const * m_owner; expr m_root; constraint_queue m_constraints; metavars m_metavars; normalizer m_normalizer; bool m_add_constraints; // 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 m_trace; volatile bool m_interrupted; void add_trace(expr const & old_e, expr const & new_e) { if (!is_eqp(old_e, new_e)) { m_trace[new_e] = old_e; } } 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; } 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 { expr t = mk_metavar(m_metavars[midx].m_ctx); m_metavars[midx].m_type = t; return t; } } 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); } } throw function_expected_exception(m_env, s_ctx, s); } } 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); } else if (e == Bool) { return level(); } 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); } } throw type_expected_exception(m_env, s_ctx, s); } } bool is_convertible(expr const & t1, expr const & t2, context const & ctx) { return m_normalizer.is_convertible(t1, t2, ctx); } 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)); } } void choose(buffer const & f_choices, buffer const & f_choice_types, buffer & args, buffer & types, context const & ctx, expr const & src) { lean_assert(f_choices.size() == f_choice_types.size()); buffer 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"); } } typedef std::pair 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) { check_interrupted(m_interrupted); switch (e.kind()) { case expr_kind::Constant: 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)); } else { return expr_pair(e, m_env.get_object(const_name(e)).get_type()); } case expr_kind::Var: return expr_pair(e, lookup(ctx, var_idx(e))); case expr_kind::Type: return expr_pair(e, mk_type(ty_level(e) + 1)); case expr_kind::Value: return expr_pair(e, to_value(e).get_type()); case expr_kind::App: { buffer args; buffer types; buffer f_choices; buffer f_choice_types; unsigned num = num_args(e); unsigned i = 0; bool modified = false; expr const & f = arg(e, 0); if (is_metavar(f)) { throw invalid_placeholder_exception(*m_owner, ctx, e); } 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++; } 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); } 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); } expr f_t = types[0]; 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); 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); } } case expr_kind::Eq: { auto lhs_p = process(eq_lhs(e), ctx); auto rhs_p = process(eq_rhs(e), ctx); expr new_e = update_eq(e, lhs_p.first, rhs_p.first); add_trace(e, new_e); return expr_pair(new_e, mk_bool_type()); } case expr_kind::Pi: { 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))); expr new_e = update_pi(e, d_p.first, b_p.first); add_trace(e, new_e); return expr_pair(new_e, t); } case expr_kind::Lambda: { 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); expr new_e = update_lambda(e, d_p.first, b_p.first); add_trace(e, new_e); return expr_pair(new_e, t); } case expr_kind::Let: { 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); expr new_e = update_let(e, v_p.first, b_p.first); add_trace(e, new_e); return expr_pair(new_e, t); }} lean_unreachable(); return expr_pair(expr(), expr()); } expr infer(expr const & e, context const & ctx) { return process(e, ctx).second; } 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; } else { return false; } } 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)); } 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 set(m_metavars[midx].m_mark, true); occ_core(m_metavars[midx].m_assignment); } } }; for_each_fn visitor(proc); visitor(t); } // occurs check bool occ(expr const & t, unsigned midx) { lean_assert(!m_metavars[midx].m_mark); flet 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(-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 visitor(proc); try { visitor(e); return false; } catch (found_assigned&) { return true; } } expr instantiate(expr const & e) { auto proc = [&](expr const & n, unsigned offset) -> expr { 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; }; auto tracer = [&](expr const & old_e, expr const & new_e) { add_trace(old_e, new_e); }; replace_fn replacer(proc, tracer); return replacer(e); } void solve() { unsigned num_meta = m_metavars.size(); m_add_constraints = false; while (true) { solve_core(); bool cont = false; bool progress = false; // unsigned unsolved_midx = 0; 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)) { // unsolved_midx = midx; cont = true; // must continue } else { if (m_metavars[midx].m_type && !m_metavars[midx].m_type_cnstr) { try { expr t = infer(m_metavars[midx].m_assignment, m_metavars[midx].m_ctx); m_metavars[midx].m_type_cnstr = true; 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(-1))); progress = true; } catch (exception&) { // std::cout << "Failed to infer type of: ?M" << midx << "\n" // << m_metavars[midx].m_assignment << "\nAT\n" << m_metavars[midx].m_ctx << "\n"; throw unification_type_mismatch_exception(*m_owner, m_metavars[midx].m_ctx, m_metavars[midx].m_mvar); } } } } } if (!cont) return; if (!progress) throw unsolved_placeholder_exception(*m_owner, context(), m_root); } } public: imp(environment const & env, name_set const * defs): m_env(env), m_available_defs(defs), m_normalizer(env) { m_interrupted = false; m_owner = nullptr; } void clear() { m_trace.clear(); m_normalizer.clear(); } void set_interrupt(bool flag) { m_interrupted = flag; m_normalizer.set_interrupt(flag); } 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) { m_constraints.clear(); m_metavars.clear(); m_owner = &elb; m_add_constraints = true; m_root = process(e, context()).first; if (has_metavar(m_root)) { solve(); return instantiate(m_root); } else { return m_root; } } 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; } }; elaborator::elaborator(environment const & env):m_ptr(new imp(env, nullptr)) {} elaborator::~elaborator() {} expr elaborator::operator()(expr const & e) { return (*m_ptr)(e, *this); } expr const & elaborator::get_original(expr const & e) const { return m_ptr->get_original(e); } 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); } format elaborator::pp(formatter & f, options const & o) const { return m_ptr->pp(f,o); } void elaborator::print(imp * ptr) { ptr->display(std::cout); } }