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)); }