bool apply(expr const & a, expr const & b) {
if (is_eqp(a, b)) return true;
if (a.hash() != b.hash()) return false;
if (a.kind() != b.kind()) return false;
if (is_var(a)) return var_idx(a) == var_idx(b);
if (m_cache.check(a, b))
return true;
switch (a.kind()) {
case expr_kind::Var:
lean_unreachable(); // LCOV_EXCL_LINE
case expr_kind::Constant:
return
const_name(a) == const_name(b) &&
compare(const_levels(a), const_levels(b), [](level const & l1, level const & l2) { return l1 == l2; });
case expr_kind::Meta:
return
mlocal_name(a) == mlocal_name(b) &&
apply(mlocal_type(a), mlocal_type(b));
case expr_kind::Local:
return
mlocal_name(a) == mlocal_name(b) &&
apply(mlocal_type(a), mlocal_type(b)) &&
(!CompareBinderInfo || local_pp_name(a) == local_pp_name(b)) &&
(!CompareBinderInfo || local_info(a) == local_info(b));
case expr_kind::App:
check_system();
return
apply(app_fn(a), app_fn(b)) &&
apply(app_arg(a), app_arg(b));
case expr_kind::Lambda: case expr_kind::Pi:
check_system();
return
apply(binding_domain(a), binding_domain(b)) &&
apply(binding_body(a), binding_body(b)) &&
(!CompareBinderInfo || binding_name(a) == binding_name(b)) &&
(!CompareBinderInfo || binding_info(a) == binding_info(b));
case expr_kind::Let:
check_system();
return
apply(let_type(a), let_type(b)) &&
apply(let_value(a), let_value(b)) &&
apply(let_body(a), let_body(b)) &&
(!CompareBinderInfo || let_name(a) == let_name(b));
case expr_kind::Sort:
return sort_level(a) == sort_level(b);
case expr_kind::Macro:
check_system();
if (macro_def(a) != macro_def(b) || macro_num_args(a) != macro_num_args(b))
return false;
for (unsigned i = 0; i < macro_num_args(a); i++) {
if (!apply(macro_arg(a, i), macro_arg(b, i)))
return false;
}
return true;
}
lean_unreachable(); // LCOV_EXCL_LINE
}
static bool uses_name(name const & n, buffer<expr> const & locals) {
for (expr const & local : locals) {
if (is_local(local) && local_pp_name(local) == n)
return true;
}
return false;
}
tactic revert_tactic(name const & n) {
auto fn = [=](environment const &, io_state const &, proof_state const & s) -> optional<proof_state> {
goals const & gs = s.get_goals();
if (empty(gs)) {
throw_no_goal_if_enabled(s);
return none_proof_state();
}
goal g = head(gs);
goals tail_gs = tail(gs);
if (auto p = g.find_hyp(n)) {
expr const & h = p->first;
unsigned i = p->second;
buffer<expr> hyps;
g.get_hyps(hyps);
hyps.erase(hyps.size() - i - 1);
if (optional<expr> other_h = depends_on(i, hyps.end() - i, h)) {
throw_tactic_exception_if_enabled(s, sstream() << "invalid 'revert' tactic, hypothesis '" << local_pp_name(*other_h)
<< "' depends on '" << local_pp_name(h) << "'");
return none_proof_state(); // other hypotheses depend on h
}
name_generator ngen = s.get_ngen();
expr new_type = Pi(h, g.get_type());
expr new_meta = mk_app(mk_metavar(ngen.next(), Pi(hyps, new_type)), hyps);
goal new_g(new_meta, new_type);
substitution new_subst = s.get_subst();
assign(new_subst, g, mk_app(new_meta, h));
proof_state new_s(s, goals(new_g, tail_gs), new_subst, ngen);
return some_proof_state(new_s);
} else {
throw_tactic_exception_if_enabled(s, sstream() << "invalid 'revert' tactic, unknown hypothesis '" << n << "'");
return none_proof_state();
}
};
return tactic01(fn);
}
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());
}
void assert_no_locals(name const & n, expr const & e) {
if (!has_local(e))
return;
collected_locals ls;
collect_locals(e, ls);
lean_trace(name({"debug", "inductive_compiler"}),
tout() << "\n\nerror: found locals in '" << n << "'\n" << e << "\n";
for (expr const & l : ls.get_collected()) {
tout() << mlocal_name(l) << "." << local_pp_name(l) << " : " << mlocal_type(l) << "\n";
});
vm_obj revert(list<expr> const & ls, tactic_state const & s) {
optional<metavar_decl> g = s.get_main_goal_decl();
if (!g) return mk_no_goals_exception(s);
local_context lctx = g->get_context();
buffer<expr> locals;
for (expr const & l : ls) {
if (lctx.get_local_decl(l)) {
locals.push_back(l);
} else {
return mk_tactic_exception(sstream() << "revert tactic failed, unknown '"
<< local_pp_name(l) << "' hypothesis", s);
}
}
tactic_state new_s = revert(locals, s);
return mk_tactic_success(mk_vm_nat(locals.size()), new_s);
}
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;
}
/* Collect (and sort) dependencies of collected parameters */
void collect_and_normalize_dependencies(buffer<expr> & norm_params) {
name_map<expr> new_types;
for (unsigned i = 0; i < m_params.size(); i++) {
expr x = m_params[i];
expr new_type = collect(m_ctx.instantiate_mvars(m_ctx.infer(x)));
new_types.insert(mlocal_name(x), new_type);
}
local_context const & lctx = m_ctx.lctx();
std::sort(m_params.begin(), m_params.end(), [&](expr const & l1, expr const & l2) {
return lctx.get_local_decl(l1)->get_idx() < lctx.get_local_decl(l2)->get_idx();
});
for (unsigned i = 0; i < m_params.size(); i++) {
expr x = m_params[i];
expr type = *new_types.find(mlocal_name(x));
expr new_type = replace_locals(type, i, m_params.data(), norm_params.data());
expr new_param = m_ctx.push_local(local_pp_name(x), new_type, local_info(x));
norm_params.push_back(new_param);
}
}
list<list<name>> collect_choice_symbols(expr const & e) {
buffer<list<name>> r;
for_each(e, [&](expr const & e, unsigned) {
if (is_choice(e)) {
buffer<name> cs;
for (unsigned i = 0; i < get_num_choices(e); i++) {
expr const & c = get_app_fn(get_choice(e, i));
if (is_constant(c))
cs.push_back(const_name(c));
else if (is_local(c))
cs.push_back(local_pp_name(c));
}
if (cs.size() > 1)
r.push_back(to_list(cs));
}
return true;
});
return to_list(r);
}
optional<pair<expr, unsigned>> goal::find_hyp(name const & uname) const {
return find_hyp_core(m_meta, [&](expr const & h) { return local_pp_name(h) == uname; });
}
expr update_local(expr const & e, expr const & new_type, binder_info const & bi) {
if (is_eqp(mlocal_type(e), new_type) && local_info(e) == bi)
return e;
else
return mk_local(mlocal_name(e), local_pp_name(e), new_type, bi, e.get_tag());
}
optional<environment> mk_no_confusion_type(environment const & env, name const & n) {
optional<inductive::inductive_decls> decls = inductive::is_inductive_decl(env, n);
if (!decls)
throw exception(sstream() << "error in 'no_confusion' generation, '" << n << "' is not an inductive datatype");
if (is_inductive_predicate(env, n))
return optional<environment>(); // type is a proposition
name_generator ngen;
unsigned nparams = std::get<1>(*decls);
declaration ind_decl = env.get(n);
declaration cases_decl = env.get(name(n, "cases_on"));
level_param_names lps = cases_decl.get_univ_params();
level rlvl = mk_param_univ(head(lps));
levels ilvls = param_names_to_levels(tail(lps));
if (length(ilvls) != length(ind_decl.get_univ_params()))
return optional<environment>(); // type does not have only a restricted eliminator
expr ind_type = instantiate_type_univ_params(ind_decl, ilvls);
name eq_name("eq");
name heq_name("heq");
// All inductive datatype parameters and indices are arguments
buffer<expr> args;
ind_type = to_telescope(ngen, ind_type, args, some(mk_implicit_binder_info()));
if (!is_sort(ind_type) || args.size() < nparams)
throw_corrupted(n);
lean_assert(!(env.impredicative() && is_zero(sort_level(ind_type))));
unsigned nindices = args.size() - nparams;
// Create inductive datatype
expr I = mk_app(mk_constant(n, ilvls), args);
// Add (P : Type)
expr P = mk_local(ngen.next(), "P", mk_sort(rlvl), binder_info());
args.push_back(P);
// add v1 and v2 elements of the inductive type
expr v1 = mk_local(ngen.next(), "v1", I, binder_info());
expr v2 = mk_local(ngen.next(), "v2", I, binder_info());
args.push_back(v1);
args.push_back(v2);
expr R = mk_sort(rlvl);
name no_confusion_type_name{n, "no_confusion_type"};
expr no_confusion_type_type = Pi(args, R);
// Create type former
buffer<expr> type_former_args;
for (unsigned i = nparams; i < nparams + nindices; i++)
type_former_args.push_back(args[i]);
type_former_args.push_back(v1);
expr type_former = Fun(type_former_args, R);
// Create cases_on
levels clvls = levels(mk_succ(rlvl), ilvls);
expr cases_on = mk_app(mk_app(mk_constant(cases_decl.get_name(), clvls), nparams, args.data()), type_former);
cases_on = mk_app(cases_on, nindices, args.data() + nparams);
expr cases_on1 = mk_app(cases_on, v1);
expr cases_on2 = mk_app(cases_on, v2);
type_checker tc(env);
expr t1 = tc.infer(cases_on1).first;
expr t2 = tc.infer(cases_on2).first;
buffer<expr> outer_cases_on_args;
unsigned idx1 = 0;
while (is_pi(t1)) {
buffer<expr> minor1_args;
expr minor1 = to_telescope(tc, binding_domain(t1), minor1_args);
expr curr_t2 = t2;
buffer<expr> inner_cases_on_args;
unsigned idx2 = 0;
while (is_pi(curr_t2)) {
buffer<expr> minor2_args;
expr minor2 = to_telescope(tc, binding_domain(curr_t2), minor2_args);
if (idx1 != idx2) {
// infeasible case, constructors do not match
inner_cases_on_args.push_back(Fun(minor2_args, P));
} else {
if (minor1_args.size() != minor2_args.size())
throw_corrupted(n);
buffer<expr> rtype_hyp;
// add equalities
for (unsigned i = 0; i < minor1_args.size(); i++) {
expr lhs = minor1_args[i];
expr rhs = minor2_args[i];
expr lhs_type = mlocal_type(lhs);
expr rhs_type = mlocal_type(rhs);
level l = sort_level(tc.ensure_type(lhs_type).first);
expr h_type;
if (tc.is_def_eq(lhs_type, rhs_type).first) {
h_type = mk_app(mk_constant(eq_name, to_list(l)), lhs_type, lhs, rhs);
} else {
h_type = mk_app(mk_constant(heq_name, to_list(l)), lhs_type, lhs, rhs_type, rhs);
}
rtype_hyp.push_back(mk_local(ngen.next(), local_pp_name(lhs).append_after("_eq"), h_type, binder_info()));
}
inner_cases_on_args.push_back(Fun(minor2_args, mk_arrow(Pi(rtype_hyp, P), P)));
}
idx2++;
curr_t2 = binding_body(curr_t2);
}
outer_cases_on_args.push_back(Fun(minor1_args, mk_app(cases_on2, inner_cases_on_args)));
idx1++;
t1 = binding_body(t1);
}
expr no_confusion_type_value = Fun(args, mk_app(cases_on1, outer_cases_on_args));
bool opaque = false;
bool use_conv_opt = true;
declaration new_d = mk_definition(env, no_confusion_type_name, lps, no_confusion_type_type, no_confusion_type_value,
opaque, ind_decl.get_module_idx(), use_conv_opt);
environment new_env = module::add(env, check(env, new_d));
return some(add_protected(new_env, no_confusion_type_name));
}
