tactic clear_tactic(name const & n) { auto fn = [=](environment const &, io_state const &, proof_state const & _s) -> optional<proof_state> { if (!_s.get_goals()) { throw_no_goal_if_enabled(_s); return none_proof_state(); } proof_state s = apply_substitution(_s); goals const & gs = s.get_goals(); 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 (depends_on(g.get_type(), h)) { throw_tactic_exception_if_enabled(s, sstream() << "invalid 'clear' tactic, conclusion depends on '" << n << "'"); return none_proof_state(); } if (auto h2 = depends_on(i, hyps.end() - i, h)) { throw_tactic_exception_if_enabled(s, sstream() << "invalid 'clear' tactic, hypothesis '" << *h2 << "' depends on '" << n << "'"); return none_proof_state(); } name_generator ngen = s.get_ngen(); expr new_type = 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, new_meta); 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 'clear' tactic, goal does not have a hypothesis " << " named '" << n << "'"); return none_proof_state(); } }; return tactic01(fn); }
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()); }
expr copy(expr const & a) { switch (a.kind()) { case expr_kind::Var: return mk_var(var_idx(a)); case expr_kind::Constant: return mk_constant(const_name(a)); case expr_kind::Type: return mk_type(ty_level(a)); case expr_kind::Value: return mk_value(static_cast<expr_value*>(a.raw())->m_val); case expr_kind::App: return mk_app(num_args(a), begin_args(a)); case expr_kind::Eq: return mk_eq(eq_lhs(a), eq_rhs(a)); case expr_kind::Lambda: return mk_lambda(abst_name(a), abst_domain(a), abst_body(a)); case expr_kind::Pi: return mk_pi(abst_name(a), abst_domain(a), abst_body(a)); case expr_kind::Let: return mk_let(let_name(a), let_type(a), let_value(a), let_body(a)); case expr_kind::MetaVar: return mk_metavar(metavar_idx(a), metavar_ctx(a)); } lean_unreachable(); }
simp_rule_sets add_core(type_checker & tc, simp_rule_sets const & s, name const & id, levels const & univ_metas, expr const & e, expr const & h) { list<expr_pair> ceqvs = to_ceqvs(tc, e, h); environment const & env = tc.env(); simp_rule_sets new_s = s; for (expr_pair const & p : ceqvs) { expr new_e = p.first; expr new_h = p.second; bool is_perm = is_permutation_ceqv(env, new_e); buffer<expr> metas; unsigned idx = 0; while (is_pi(new_e)) { expr mvar = mk_metavar(name(*g_prefix, idx), binding_domain(new_e)); idx++; metas.push_back(mvar); new_e = instantiate(binding_body(new_e), mvar); } expr rel, lhs, rhs; if (is_simp_relation(env, new_e, rel, lhs, rhs) && is_constant(rel)) { new_s.insert(const_name(rel), simp_rule(id, univ_metas, to_list(metas), lhs, rhs, new_h, is_perm)); } } return new_s; }
expr goal::mk_meta(name const & n, expr const & type) const { buffer<expr> locals; expr this_mvar = get_app_args(m_meta, locals); expr mvar = copy_tag(this_mvar, mk_metavar(n, Pi(locals, type))); return copy_tag(m_meta, mk_app(mvar, locals)); }
expr mk_idx_metavar(unsigned i, expr const & type) { return mk_metavar(name(*g_tmp_prefix, i), type); }
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); }