/** \brief Return true if \c ls already contains a literal that is definitionally equal to \c l */ bool already_contains(expr const & l, buffer<expr> const & ls, extension_context & ctx) const { for (expr const & old_l : ls) { if (is_def_eq(l, old_l, ctx)) return true; } return false; }
/** \brief Given l : H, and R == (or ... l ...), create a proof term for R using or_intro_left and or_intro_right */ expr mk_or_intro(expr const & l, expr const & H, expr const & R, extension_context & ctx) const { check_system("resolve macro"); if (is_or_app(R)) { expr lhs = app_arg(app_fn(R)); expr rhs = app_arg(R); // or_intro_left {a : Prop} (H : a) (b : Prop) : a ∨ b // or_intro_right {b : Prop} (a : Prop) (H : b) : a ∨ b if (is_def_eq(l, lhs, ctx)) { return mk_app(*g_or_intro_left, l, H, rhs); } else if (is_def_eq(l, rhs, ctx)) { return mk_app(*g_or_intro_right, l, lhs, H); } else { return mk_app(*g_or_intro_right, rhs, lhs, mk_or_intro(l, H, rhs, ctx)); } } else if (is_def_eq(l, R, ctx)) { return H; } else { throw_kernel_exception(ctx.env(), "bug in resolve macro"); } }
tactic change_goal_tactic(elaborate_fn const & elab, expr const & e) { return tactic([=](environment const & env, io_state const & ios, proof_state const & s) { proof_state new_s = s; goals const & gs = new_s.get_goals(); if (!gs) { throw_no_goal_if_enabled(s); return proof_state_seq(); } expr t = head(gs).get_type(); bool report_unassigned = true; if (auto new_e = elaborate_with_respect_to(env, ios, elab, new_s, e, none_expr(), report_unassigned)) { goals const & gs = new_s.get_goals(); goal const & g = head(gs); substitution subst = new_s.get_subst(); auto tc = mk_type_checker(env); constraint_seq cs; if (tc->is_def_eq(t, *new_e, justification(), cs)) { if (cs) { unifier_config cfg(ios.get_options()); buffer<constraint> cs_buf; cs.linearize(cs_buf); to_buffer(new_s.get_postponed(), cs_buf); unify_result_seq rseq = unify(env, cs_buf.size(), cs_buf.data(), subst, cfg); return map2<proof_state>(rseq, [=](pair<substitution, constraints> const & p) -> proof_state { substitution const & subst = p.first; constraints const & postponed = p.second; substitution new_subst = subst; expr final_e = new_subst.instantiate_all(*new_e); expr M = g.mk_meta(mk_fresh_name(), final_e); goal new_g(M, final_e); assign(new_subst, g, M); return proof_state(new_s, cons(new_g, tail(gs)), new_subst, postponed); }); } expr M = g.mk_meta(mk_fresh_name(), *new_e); goal new_g(M, *new_e); assign(subst, g, M); return proof_state_seq(proof_state(new_s, cons(new_g, tail(gs)), subst)); } else { throw_tactic_exception_if_enabled(new_s, [=](formatter const & fmt) { format r = format("invalid 'change' tactic, the given type"); r += pp_indent_expr(fmt, *new_e); r += compose(line(), format("does not match the goal type")); r += pp_indent_expr(fmt, t); return r; }); return proof_state_seq(); } } return proof_state_seq(); }); }
/** \brief Given C1 : H1, where C1 contains l C2 : H2, where C2 contains not_l Return a proof of the resolvent R of C1 and C2 */ expr mk_or_elim_tree1(expr const & l, expr const & not_l, expr C1, expr const & H1, expr const & C2, expr const & H2, expr const & R, extension_context & ctx) const { check_system("resolve macro"); expr lhs, rhs; if (is_or(C1, lhs, rhs)) { return mk_or_elim_tree1(l, not_l, lhs, rhs, H1, C2, H2, R, ctx); } else { C1 = whnf(C1, ctx); if (is_or(C1, lhs, rhs)) { return mk_or_elim_tree1(l, not_l, lhs, rhs, H1, C2, H2, R, ctx); } else if (is_def_eq(C1, l, ctx)) { return mk_or_elim_tree2(C1, H1, not_l, C2, H2, R, ctx); } else { return mk_or_intro(C1, H1, R, ctx); } } }
/** Given l : H C2 : H2, where C2 contains not_l produce a proof for R */ expr mk_or_elim_tree2(expr const & l, expr const & H, expr const & not_l, expr C2, expr const & H2, expr const & R, extension_context & ctx) const { check_system("resolve macro"); expr lhs, rhs; if (is_or(C2, lhs, rhs)) { return mk_or_elim_tree2(l, H, not_l, lhs, rhs, H2, R, ctx); } else { C2 = whnf(C2, ctx); if (is_or(C2, lhs, rhs)) { return mk_or_elim_tree2(l, H, not_l, lhs, rhs, H2, R, ctx); } else if (is_def_eq(C2, not_l, ctx)) { // absurd_elim {a : Prop} (b : Prop) (H1 : a) (H2 : ¬ a) : b return mk_app(*g_absurd_elim, l, R, H, H2); } else { return mk_or_intro(C2, H2, R, ctx); } } }
bool collect(expr cls, expr const & l, buffer<expr> & R, extension_context & ctx) const { check_system("resolve macro"); expr lhs, rhs; if (is_or(cls, lhs, rhs)) { return collect(lhs, rhs, l, R, ctx); } else { cls = whnf(cls, ctx); if (is_or(cls, lhs, rhs)) { return collect(lhs, rhs, l, R, ctx); } else if (is_def_eq(cls, l, ctx)) { return true; // found literal l } else { if (!already_contains(cls, R, ctx)) R.push_back(cls); return false; } } }
pair<bool, constraint_seq> converter::is_def_eq(expr const & t, expr const & s, type_checker & c) { return is_def_eq(t, s, c, *g_no_delayed_jst); }
tactic contradiction_tactic() { auto fn = [=](environment const & env, io_state const & ios, proof_state const & s) { goals const & gs = s.get_goals(); if (empty(gs)) { throw_no_goal_if_enabled(s); return optional<proof_state>(); } goal const & g = head(gs); expr const & t = g.get_type(); substitution subst = s.get_subst(); auto tc = mk_type_checker(env); auto conserv_tc = mk_type_checker(env, UnfoldReducible); buffer<expr> hyps; g.get_hyps(hyps); for (expr const & h : hyps) { expr h_type = mlocal_type(h); h_type = tc->whnf(h_type).first; expr lhs, rhs, arg; if (is_false(env, h_type)) { assign(subst, g, mk_false_rec(*tc, h, t)); return some_proof_state(proof_state(s, tail(gs), subst)); } else if (is_not(env, h_type, arg)) { optional<expr> h_pos; for (expr const & h_prime : hyps) { constraint_seq cs; if (conserv_tc->is_def_eq(arg, mlocal_type(h_prime), justification(), cs) && !cs) { h_pos = h_prime; break; } } if (h_pos) { assign(subst, g, mk_absurd(*tc, t, *h_pos, h)); return some_proof_state(proof_state(s, tail(gs), subst)); } } else if (is_eq(h_type, lhs, rhs)) { lhs = tc->whnf(lhs).first; rhs = tc->whnf(rhs).first; optional<name> lhs_c = is_constructor_app(env, lhs); optional<name> rhs_c = is_constructor_app(env, rhs); if (lhs_c && rhs_c && *lhs_c != *rhs_c) { if (optional<name> I_name = inductive::is_intro_rule(env, *lhs_c)) { name no_confusion(*I_name, "no_confusion"); try { expr I = tc->whnf(tc->infer(lhs).first).first; buffer<expr> args; expr I_fn = get_app_args(I, args); if (is_constant(I_fn)) { level t_lvl = sort_level(tc->ensure_type(t).first); expr V = mk_app(mk_app(mk_constant(no_confusion, cons(t_lvl, const_levels(I_fn))), args), t, lhs, rhs, h); if (auto r = lift_down_if_hott(*tc, V)) { check_term(*tc, *r); assign(subst, g, *r); return some_proof_state(proof_state(s, tail(gs), subst)); } } } catch (kernel_exception & ex) { regular(env, ios) << ex << "\n"; } } } } } return none_proof_state(); }; return tactic01(fn); }