/* Copyright (c) 2015 Microsoft Corporation. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Author: Leonardo de Moura */ #include #include "kernel/abstract.h" #include "kernel/instantiate.h" #include "library/util.h" #include "library/locals.h" #include "library/constants.h" #include "library/reducible.h" #include "library/class_instance_synth.h" #include "library/tactic/util.h" #include "library/tactic/intros_tactic.h" #include "library/tactic/subst_tactic.h" #include "library/tactic/expr_to_tactic.h" namespace lean { enum class congr_arg_kind { Fixed, Singleton, Eq }; optional mk_congr_subsingleton_thm(type_checker & tc, io_state const & ios, expr const & fn, optional const & expected_num_args, buffer & arg_kinds, constraint_seq & cs) { expr fn_type = tc.infer(fn, cs); buffer hyps; collected_locals ctx_buffer; collect_locals(fn_type, ctx_buffer); collect_locals(fn, ctx_buffer); hyps.append(ctx_buffer.get_collected()); list ctx = to_list(hyps); buffer domain; expr codomain = to_telescope(tc, fn_type, domain, optional(), cs); if (expected_num_args && *expected_num_args != domain.size()) { if (*expected_num_args > domain.size()) return none_expr(); lean_assert(*expected_num_args < domain.size()); while (domain.size() > *expected_num_args) { codomain = Pi(domain.back(), codomain); domain.pop_back(); } } buffer prop; // pp[i] iff i-th arg is a proposition buffer ss; // ss[i] is not none iff i-th arg is a subsingleton buffer codomain_deps_on; // codomain_deps_on[i] iff codomain depends on i-th argument for (expr const & d : domain) { prop.push_back(tc.is_prop(mlocal_type(d), cs) && tc.env().prop_proof_irrel()); if (prop.back()) { ss.push_back(true); } else { ss.push_back(static_cast(mk_subsingleton_instance(tc, ios, ctx, mlocal_type(d)))); } codomain_deps_on.push_back(depends_on(codomain, d)); ctx = cons(d, ctx); } buffer new_domain; buffer conclusion_lhs; for (unsigned i = 0; i < domain.size(); i++) { lean_assert(i == new_domain.size()); expr const & d_i = domain[i]; expr new_type = replace_locals(mlocal_type(d_i), i, domain.data(), new_domain.data()); expr new_d_i = mk_local(get_unused_name(local_pp_name(d_i), hyps), new_type); hyps.push_back(new_d_i); conclusion_lhs.push_back(new_d_i); new_domain.push_back(new_d_i); } buffer lhss, rhss; buffer> eqs; buffer ss_elim; // true if equality proof should be synthesized using singletion elimination buffer conclusion_rhs; name h("he"); unsigned eqidx = 1; for (unsigned i = 0; i < new_domain.size(); i++) { expr const & d_i = new_domain[i]; if (ss[i]) { arg_kinds.push_back(congr_arg_kind::Singleton); expr new_type = replace_locals(mlocal_type(d_i), rhss, lhss); expr new_d_i = mk_local(get_unused_name(name(local_pp_name(d_i), "new"), hyps), new_type); hyps.push_back(new_d_i); rhss.push_back(d_i); lhss.push_back(new_d_i); conclusion_rhs.push_back(new_d_i); ss_elim.push_back(!prop[i]); eqs.push_back(none_expr()); } else { unsigned j = i+1; for (; j < new_domain.size(); j++) { expr t_j = mlocal_type(new_domain[j]); if (depends_on(t_j, d_i) && !ss[j]) break; } if (j < new_domain.size() || codomain_deps_on[i]) { arg_kinds.push_back(congr_arg_kind::Fixed); conclusion_rhs.push_back(d_i); } else { arg_kinds.push_back(congr_arg_kind::Eq); expr new_type = replace_locals(mlocal_type(d_i), rhss, lhss); expr new_d_i = mk_local(get_unused_name(name(local_pp_name(d_i), "new"), hyps), new_type); name new_h_name = get_unused_name(name(h, eqidx), hyps); eqidx++; expr new_eq = mk_local(new_h_name, mk_eq(tc, new_d_i, d_i)); hyps.push_back(new_d_i); rhss.push_back(d_i); lhss.push_back(new_d_i); conclusion_rhs.push_back(new_d_i); ss_elim.push_back(false); eqs.push_back(some_expr(new_eq)); } } } for (optional const & eq : eqs) { if (eq) hyps.push_back(*eq); } expr conclusion = mk_eq(tc, mk_app(fn, conclusion_lhs), mk_app(fn, conclusion_rhs)); expr mvar_type = Pi(hyps, conclusion); expr mvar = mk_metavar(tc.mk_fresh_name(), mvar_type); expr meta = mk_app(mvar, hyps); proof_state ps = to_proof_state(meta, conclusion, tc.mk_ngen()).update_report_failure(false); for (unsigned i = 0; i < eqs.size(); i++) { goal const & g = head(ps.get_goals()); optional const & eq = eqs[i]; if (eq) { auto new_eq = g.find_hyp(local_pp_name(*eq)); if (auto new_ps = subst(tc.env(), mlocal_name(new_eq->first), false, ps)) { ps = *new_ps; } else { return none_expr(); } } else if (ss_elim[i]) { expr lhs = lhss[i]; expr rhs = rhss[i]; expr new_lhs, new_rhs; if (auto it = g.find_hyp(local_pp_name(lhs))) new_lhs = it->first; else return none_expr(); if (auto it = g.find_hyp(local_pp_name(rhs))) new_rhs = it->first; else return none_expr(); buffer hyps; g.get_hyps(hyps); auto spr = mk_subsingleton_instance(tc, ios, to_list(hyps), mlocal_type(new_lhs)); if (!spr) return none_expr(); expr new_eq = mk_local(get_unused_name(name(h, eqidx), hyps), mk_eq(tc, new_rhs, new_lhs)); eqidx++; expr new_eq_pr = mk_subsingleton_elim(tc, *spr, new_rhs, new_lhs); expr aux_mvar = mk_metavar(tc.mk_fresh_name(), Pi(hyps, g.get_type())); expr aux_meta_core = mk_app(aux_mvar, hyps); goal aux_g(mk_app(aux_meta_core, new_eq), g.get_type()); substitution new_subst = ps.get_subst(); assign(new_subst, g, mk_app(aux_meta_core, new_eq_pr)); proof_state aux_ps = proof_state(ps, goals(aux_g), new_subst); if (auto new_ps = subst(tc.env(), mlocal_name(new_eq), false, aux_ps)) { ps = *new_ps; } else { return none_expr(); } } else { // do nothing, it is a proposition } } substitution subst = ps.get_subst(); goal const & g = head(ps.get_goals()); assign(subst, g, mk_refl(tc, app_arg(g.get_type()))); expr result = subst.instantiate_all(mvar); try { check_term(tc, result); } catch (exception &) { return none_expr(); } for (expr const & ctx_local : ctx_buffer.get_collected()) { result = mk_app(result, ctx_local); mvar_type = instantiate(binding_body(mvar_type), ctx_local); } result = head_beta_reduce(result); return some_expr(result); } tactic congruence_tactic() { auto fn = [=](environment const & env, io_state const & ios, proof_state const & s) -> optional { goals const & gs = s.get_goals(); if (empty(gs)) { throw_no_goal_if_enabled(s); return none_proof_state(); } goal const & g = head(gs); expr t = g.get_type(); substitution subst = s.get_subst(); name_generator ngen = s.get_ngen(); auto tc = mk_type_checker(env, ngen.mk_child()); constraint_seq cs; t = tc->whnf(t, cs); expr lhs, rhs; if (!is_eq(t, lhs, rhs)) { throw_tactic_exception_if_enabled(s, "invalid 'congruence' tactic, goal is not an equality"); return none_proof_state(); } if (!is_app(lhs) || !is_app(rhs)) { throw_tactic_exception_if_enabled(s, "invalid 'congruence' tactic, left and right hand side of equation must be a function application"); return none_proof_state(); } buffer lhs_args, rhs_args; expr lhs_fn = get_app_args(lhs, lhs_args); expr rhs_fn = get_app_args(rhs, rhs_args); if (lhs_args.size() != rhs_args.size()) { throw_tactic_exception_if_enabled(s, "invalid 'congruence' tactic, left and right hand side of equation must have the same number of arguments"); return none_proof_state(); } expr lhs_fn_type = tc->whnf(tc->infer(lhs_fn, cs), cs); expr rhs_fn_type = tc->whnf(tc->infer(rhs_fn, cs), cs); if (!tc->is_def_eq(lhs_fn_type, rhs_fn_type, justification(), cs)) { throw_tactic_exception_if_enabled(s, "invalid 'congruence' tactic, functions do not have the same type"); return none_proof_state(); } buffer new_goals; optional fn_pr; if (!tc->is_def_eq(lhs_fn, rhs_fn, justification(), cs)) { expr new_type = mk_eq(*tc, lhs_fn, rhs_fn); expr new_meta = g.mk_meta(ngen.next(), new_type); new_goals.push_back(goal(new_meta, new_type)); fn_pr = new_meta; } buffer arg_kinds; auto cg_proof = mk_congr_subsingleton_thm(*tc, ios, lhs_fn, some(lhs_args.size()), arg_kinds, cs); if (!cg_proof) { throw_tactic_exception_if_enabled(s, "invalid 'congruence' tactic, tactic does not support this kind of dependent function"); return none_proof_state(); } expr pr = mk_app(*cg_proof, lhs_args); for (unsigned i = 0; i < arg_kinds.size(); i++) { if (arg_kinds[i] == congr_arg_kind::Fixed) { if (!tc->is_def_eq(lhs_args[i], rhs_args[i], justification(), cs)) { throw_tactic_exception_if_enabled(s, sstream() << "invalid 'congruence' tactic, argument #" << (i+1) << " must be the same in the left and right hand sides"); return none_proof_state(); } } else { pr = mk_app(pr, rhs_args[i]); } } for (unsigned i = 0; i < arg_kinds.size(); i++) { if (arg_kinds[i] == congr_arg_kind::Eq) { if (tc->is_def_eq(lhs_args[i], rhs_args[i], justification(), cs)) { pr = mk_app(pr, mk_refl(*tc, lhs_args[i])); } else { expr new_type = mk_eq(*tc, lhs_args[i], rhs_args[i]); expr new_meta = g.mk_meta(ngen.next(), new_type); new_goals.push_back(goal(new_meta, new_type)); pr = mk_app(pr, mk_symm(*tc, new_meta)); } } } if (fn_pr) { expr motive_rhs = mk_app(mk_var(0), rhs_args); expr motive = mk_lambda("f", lhs_fn_type, mk_app(app_fn(app_fn(g.get_type())), lhs, motive_rhs)); pr = mk_subst(*tc, motive, lhs_fn, rhs_fn, *fn_pr, pr); } assign(subst, g, pr); proof_state new_ps(s, to_list(new_goals.begin(), new_goals.end(), tail(gs)), subst, ngen); if (solve_constraints(env, ios, new_ps, cs)) return some_proof_state(new_ps); return none_proof_state(); }; return tactic01(fn); } void initialize_congruence_tactic() { register_simple_tac(name{"tactic", "congruence"}, congruence_tactic); } void finalize_congruence_tactic() {} }