virtual expr visit_app(expr const & e) {
buffer<expr> args;
expr const & f = get_app_rev_args(e, args);
if (is_metavar(f)) {
if (auto p1 = m_subst.get_expr_assignment(mlocal_name(f))) {
if (m_use_jst)
save_jst(p1->second);
expr new_app = apply_beta(p1->first, args.size(), args.data());
return visit(new_app);
}
}
expr new_f = visit(f);
buffer<expr> new_args;
bool modified = !is_eqp(new_f, f);
for (expr const & arg : args) {
expr new_arg = visit(arg);
if (!is_eqp(arg, new_arg))
modified = true;
new_args.push_back(new_arg);
}
if (!modified)
return e;
else
return mk_rev_app(new_f, new_args);
}
expr collect(expr const & e) {
return replace(e, [&](expr const & e, unsigned) {
if (is_metavar(e)) {
name const & id = mlocal_name(e);
if (auto r = m_meta_to_param.find(id)) {
return some_expr(*r);
} else {
expr type = m_ctx.infer(e);
expr x = m_ctx.push_local("_x", type);
m_meta_to_param.insert(id, x);
m_meta_to_param_inv.insert(mlocal_name(x), e);
m_params.push_back(x);
return some_expr(x);
}
} else if (is_local(e)) {
name const & id = mlocal_name(e);
if (!m_found_local.contains(id)) {
m_found_local.insert(id);
m_params.push_back(e);
}
} else if (is_sort(e)) {
return some_expr(update_sort(e, collect(sort_level(e))));
} else if (is_constant(e)) {
return some_expr(update_constant(e, collect(const_levels(e))));
}
return none_expr();
});
}
expr update_mlocal(expr const & e, expr const & new_type) {
if (is_eqp(mlocal_type(e), new_type))
return e;
else if (is_metavar(e))
return mk_metavar(mlocal_name(e), new_type, e.get_tag());
else
return mk_local(mlocal_name(e), local_pp_name(e), new_type, local_info(e), e.get_tag());
}
// Return true iff lhs is of the form (B (x : ?m1), ?m2) or (B (x : ?m1), ?m2 x),
// where B is lambda or Pi
static bool is_valid_congr_rule_binding_lhs(expr const & lhs, name_set & found_mvars) {
lean_assert(is_binding(lhs));
expr const & d = binding_domain(lhs);
expr const & b = binding_body(lhs);
if (!is_metavar(d))
return false;
if (is_metavar(b) && b != d) {
found_mvars.insert(mlocal_name(b));
found_mvars.insert(mlocal_name(d));
return true;
}
if (is_app(b) && is_metavar(app_fn(b)) && is_var(app_arg(b), 0) && app_fn(b) != d) {
found_mvars.insert(mlocal_name(app_fn(b)));
found_mvars.insert(mlocal_name(d));
return true;
}
return false;
}
// Check whether rhs is of the form (mvar l_1 ... l_n) where mvar is a metavariable,
// and l_i's are local constants, and mvar does not occur in found_mvars.
// If it is return true and update found_mvars
static bool is_valid_congr_hyp_rhs(expr const & rhs, name_set & found_mvars) {
buffer<expr> rhs_args;
expr const & rhs_fn = get_app_args(rhs, rhs_args);
if (!is_metavar(rhs_fn) || found_mvars.contains(mlocal_name(rhs_fn)))
return false;
for (expr const & arg : rhs_args)
if (!is_local(arg))
return false;
found_mvars.insert(mlocal_name(rhs_fn));
return true;
}
bool is_ceqv(tmp_type_context & tctx, expr e) {
if (has_expr_metavar(e))
return false;
name_set to_find;
// Define a procedure for removing arguments from to_find.
auto visitor_fn = [&](expr const & e, unsigned) {
if (is_local(e)) {
to_find.erase(mlocal_name(e));
return false;
} else if (is_metavar(e)) {
return false;
} else {
return true;
}
};
environment const & env = tctx.env();
bool is_std = is_standard(env);
buffer<expr> hypotheses; // arguments that are propositions
while (is_pi(e)) {
if (!to_find.empty()) {
// Support for dependent types.
// We may find the instantiation for the previous arguments
// by matching the type.
for_each(binding_domain(e), visitor_fn);
}
expr local = tctx.mk_tmp_local(binding_domain(e));
if (binding_info(e).is_inst_implicit()) {
// If the argument can be instantiated by type class resolution, then
// we don't need to find it in the lhs
} else if (is_std && tctx.is_prop(binding_domain(e))) {
// If the argument is a proposition, we store it in hypotheses.
// We check whether the lhs occurs in hypotheses or not.
hypotheses.push_back(binding_domain(e));
} else {
to_find.insert(mlocal_name(local));
}
e = instantiate(binding_body(e), local);
}
expr lhs, rhs;
if (!is_simp_relation(env, e, lhs, rhs))
return false;
// traverse lhs, and remove found variables from to_find
for_each(lhs, visitor_fn);
if (!to_find.empty())
return false;
// basic looping ceq detection: the left-hand-side should not occur in the right-hand-side,
// nor it should occur in any of the hypothesis
if (occurs(lhs, rhs))
return false;
if (std::any_of(hypotheses.begin(), hypotheses.end(), [&](expr const & h) { return occurs(lhs, h); }))
return false;
return true;
}
unsigned hash_bi(expr const & e) {
unsigned h = e.hash();
for_each(e, [&](expr const & e, unsigned) {
if (is_binding(e)) {
h = hash(h, hash(binding_name(e).hash(), binding_info(e).hash()));
} else if (is_local(e)) {
h = hash(h, hash(mlocal_name(e).hash(), local_info(e).hash()));
return false; // do not visit type
} else if (is_metavar(e)) {
return false; // do not visit type
}
return true;
});
return h;
}
expr clear(metavar_context & mctx, expr const & mvar, expr const & H) {
lean_assert(is_metavar(mvar));
lean_assert(is_local(H));
optional<metavar_decl> g = mctx.get_metavar_decl(mvar);
if (!g) throw exception("clear tactic failed, there are no goals to be solved");
local_context lctx = g->get_context();
optional<local_decl> d = lctx.get_local_decl(H);
if (!d)
throw exception(sstream() << "clear tactic failed, unknown '" << local_pp_name(H) << "' hypothesis");
if (depends_on(g->get_type(), mctx, 1, &H))
throw exception(sstream() << "clear tactic failed, target type depends on '" << local_pp_name(H) << "'");
if (optional<local_decl> d2 = lctx.has_dependencies(*d, mctx))
throw exception(sstream() << "clear tactic failed, hypothesis '" << d2->get_pp_name() << "' depends on '" << local_pp_name(H) << "'");
lctx.clear(*d);
expr new_mvar = mctx.mk_metavar_decl(lctx, g->get_type());
mctx.assign(mvar, new_mvar);
return new_mvar;
}
bool substitution::occurs_expr_core(name const & m, expr const & e, name_set & visited) const {
bool found = false;
for_each(e, [&](expr const & e, unsigned) {
if (found || !has_expr_metavar(e)) return false;
if (is_metavar(e)) {
name const & n = mlocal_name(e);
if (n == m)
found = true;
auto s = get_expr(e);
if (!s || visited.contains(n))
return false; // do not visit type
visited.insert(n);
if (s && occurs_expr_core(m, *s, visited))
found = true;
return false; // do not visit type
}
if (is_local(e)) return false; // do not visit type
return true;
});
return found;
}
bool is_meta(expr const & e) {
return is_metavar(get_app_fn(e));
}
bool is_idx_metavar(expr const & e) {
if (!is_metavar(e))
return false;
name const & n = mlocal_name(e);
return !n.is_atomic() && n.is_numeral() && n.get_prefix() == *g_tmp_prefix;
}
void add_congr_core(environment const & env, simp_rule_sets & s, name const & n) {
declaration const & d = env.get(n);
type_checker tc(env);
buffer<level> us;
unsigned num_univs = d.get_num_univ_params();
for (unsigned i = 0; i < num_univs; i++) {
us.push_back(mk_meta_univ(name(*g_prefix, i)));
}
levels ls = to_list(us);
expr pr = mk_constant(n, ls);
expr e = instantiate_type_univ_params(d, ls);
buffer<bool> explicit_args;
buffer<expr> metas;
unsigned idx = 0;
while (is_pi(e)) {
expr mvar = mk_metavar(name(*g_prefix, idx), binding_domain(e));
idx++;
explicit_args.push_back(is_explicit(binding_info(e)));
metas.push_back(mvar);
e = instantiate(binding_body(e), mvar);
pr = mk_app(pr, mvar);
}
expr rel, lhs, rhs;
if (!is_simp_relation(env, e, rel, lhs, rhs) || !is_constant(rel)) {
throw exception(sstream() << "invalid congruence rule, '" << n
<< "' resulting type is not of the form t ~ s, where '~' is a transitive and reflexive relation");
}
name_set found_mvars;
buffer<expr> lhs_args, rhs_args;
expr const & lhs_fn = get_app_args(lhs, lhs_args);
expr const & rhs_fn = get_app_args(rhs, rhs_args);
if (is_constant(lhs_fn)) {
if (!is_constant(rhs_fn) || const_name(lhs_fn) != const_name(rhs_fn) || lhs_args.size() != rhs_args.size()) {
throw exception(sstream() << "invalid congruence rule, '" << n
<< "' resulting type is not of the form (" << const_name(lhs_fn) << " ...) "
<< "~ (" << const_name(lhs_fn) << " ...), where ~ is '" << const_name(rel) << "'");
}
for (expr const & lhs_arg : lhs_args) {
if (is_sort(lhs_arg))
continue;
if (!is_metavar(lhs_arg) || found_mvars.contains(mlocal_name(lhs_arg))) {
throw exception(sstream() << "invalid congruence rule, '" << n
<< "' the left-hand-side of the congruence resulting type must be of the form ("
<< const_name(lhs_fn) << " x_1 ... x_n), where each x_i is a distinct variable or a sort");
}
found_mvars.insert(mlocal_name(lhs_arg));
}
} else if (is_binding(lhs)) {
if (lhs.kind() != rhs.kind()) {
throw exception(sstream() << "invalid congruence rule, '" << n
<< "' kinds of the left-hand-side and right-hand-side of "
<< "the congruence resulting type do not match");
}
if (!is_valid_congr_rule_binding_lhs(lhs, found_mvars)) {
throw exception(sstream() << "invalid congruence rule, '" << n
<< "' left-hand-side of the congruence resulting type must "
<< "be of the form (fun/Pi (x : A), B x)");
}
} else {
throw exception(sstream() << "invalid congruence rule, '" << n
<< "' left-hand-side is not an application nor a binding");
}
buffer<expr> congr_hyps;
lean_assert(metas.size() == explicit_args.size());
for (unsigned i = 0; i < metas.size(); i++) {
expr const & mvar = metas[i];
if (explicit_args[i] && !found_mvars.contains(mlocal_name(mvar))) {
buffer<expr> locals;
expr type = mlocal_type(mvar);
while (is_pi(type)) {
expr local = mk_local(tc.mk_fresh_name(), binding_domain(type));
locals.push_back(local);
type = instantiate(binding_body(type), local);
}
expr h_rel, h_lhs, h_rhs;
if (!is_simp_relation(env, type, h_rel, h_lhs, h_rhs) || !is_constant(h_rel))
continue;
unsigned j = 0;
for (expr const & local : locals) {
j++;
if (!only_found_mvars(mlocal_type(local), found_mvars)) {
throw exception(sstream() << "invalid congruence rule, '" << n
<< "' argument #" << j << " of parameter #" << (i+1) << " contains "
<< "unresolved parameters");
}
}
if (!only_found_mvars(h_lhs, found_mvars)) {
throw exception(sstream() << "invalid congruence rule, '" << n
<< "' argument #" << (i+1) << " is not a valid hypothesis, the left-hand-side contains "
<< "unresolved parameters");
}
if (!is_valid_congr_hyp_rhs(h_rhs, found_mvars)) {
throw exception(sstream() << "invalid congruence rule, '" << n
<< "' argument #" << (i+1) << " is not a valid hypothesis, the right-hand-side must be "
<< "of the form (m l_1 ... l_n) where m is parameter that was not "
<< "'assigned/resolved' yet and l_i's are locals");
}
found_mvars.insert(mlocal_name(mvar));
congr_hyps.push_back(mvar);
}
}
congr_rule rule(n, ls, to_list(metas), lhs, rhs, pr, to_list(congr_hyps));
s.insert(const_name(rel), rule);
}
// Return true iff all metavariables in e are in found_mvars
static bool only_found_mvars(expr const & e, name_set const & found_mvars) {
return !find(e, [&](expr const & m, unsigned) {
return is_metavar(m) && !found_mvars.contains(mlocal_name(m));
});
}
static bool is_metavar_wo_local_context(expr const & e) {
return is_metavar(e) && !metavar_lctx(e);
}
static void assign(substitution & s, expr const & mvar, expr const & e) {
lean_assert(is_metavar(mvar));
s.insert(metavar_name(mvar), e);
}