virtual pair<expr, constraint_seq> check_type(expr const & m, extension_context & ctx, bool infer_only) const { environment const & env = ctx.env(); check_num_args(env, m); if (!infer_only) infer_type(macro_arg(m, 0), ctx, infer_only); expr l = whnf(macro_arg(m, 0), ctx); expr not_l = whnf(mk_app(*g_not, l), ctx); expr C1 = infer_type(macro_arg(m, 1), ctx, infer_only); expr C2 = infer_type(macro_arg(m, 2), ctx, infer_only); return mk_pair(mk_resolvent(env, ctx, m, l, not_l, C1, C2), constraint_seq()); }
action_result no_confusion_action(hypothesis_idx hidx) { try { state & s = curr_state(); app_builder & b = get_app_builder(); hypothesis const & h = s.get_hypothesis_decl(hidx); expr type = h.get_type(); expr lhs, rhs; if (!is_eq(type, lhs, rhs)) return action_result::failed(); lhs = whnf(lhs); rhs = whnf(rhs); optional<name> c1 = is_constructor_app(env(), lhs); optional<name> c2 = is_constructor_app(env(), rhs); if (!c1 || !c2) return action_result::failed(); expr A = whnf(infer_type(lhs)); expr I = get_app_fn(A); if (!is_constant(I) || !inductive::is_inductive_decl(env(), const_name(I))) return action_result::failed(); name nct_name(const_name(I), "no_confusion_type"); if (!env().find(nct_name)) return action_result::failed(); expr target = s.get_target(); expr nct = whnf(b.mk_app(nct_name, target, lhs, rhs)); if (c1 == c2) { if (!is_pi(nct)) return action_result::failed(); if (s.has_target_forward_deps(hidx)) { // TODO(Leo): we currently do not handle this case. // To avoid non-termination we remove the given hypothesis, if there // forward dependencies, we would also have to remove them. // Remark: this is a low priority refinement since it will not happen // very often in practice. return action_result::failed(); } unsigned num_params = *inductive::get_num_params(env(), const_name(I)); unsigned cnstr_arity = get_arity(env().get(*c1).get_type()); lean_assert(cnstr_arity >= num_params); unsigned num_new_eqs = cnstr_arity - num_params; s.push_proof_step(new no_confusion_proof_step_cell(const_name(I), target, h.get_self(), num_new_eqs)); s.set_target(binding_domain(nct)); s.del_hypothesis(hidx); trace_action("no_confusion"); return action_result::new_branch(); } else { name nc_name(const_name(I), "no_confusion"); expr pr = b.mk_app(nc_name, {target, lhs, rhs, h.get_self()}); trace_action("no_confusion"); return action_result::solved(pr); } } catch (app_builder_exception &) { return action_result::failed(); } }
virtual optional<expr> expand(expr const & m, extension_context & ctx) const { environment const & env = ctx.env(); check_num_args(env, m); expr l = whnf(macro_arg(m, 0), ctx); expr not_l = whnf(mk_app(*g_not, l), ctx); expr H1 = macro_arg(m, 1); expr H2 = macro_arg(m, 2); expr C1 = infer_type(H1, ctx, true); expr C2 = infer_type(H2, ctx, true); expr R = mk_resolvent(env, ctx, m, l, not_l, C1, C2); return some_expr(mk_or_elim_tree1(l, not_l, C1, H1, C2, H2, R, ctx)); }
optional<pair<expr, constraint_seq>> projection_converter::reduce_projection(expr const & t) { projection_info const * info = is_projection(t); if (!info) return optional<pair<expr, constraint_seq>>(); buffer<expr> args; get_app_args(t, args); if (args.size() <= info->m_nparams) { return optional<pair<expr, constraint_seq>>(); } unsigned mkidx = info->m_nparams; expr const & mk = args[mkidx]; pair<expr, constraint_seq> new_mk_cs = whnf(mk); expr new_mk = new_mk_cs.first; expr const & new_mk_fn = get_app_fn(new_mk); if (!is_constant(new_mk_fn) || const_name(new_mk_fn) != info->m_constructor) { return optional<pair<expr, constraint_seq>>(); } buffer<expr> mk_args; get_app_args(new_mk, mk_args); unsigned i = info->m_nparams + info->m_i; if (i >= mk_args.size()) { return optional<pair<expr, constraint_seq>>(); } expr r = mk_args[i]; r = mk_app(r, args.size() - mkidx - 1, args.data() + mkidx + 1); return optional<pair<expr, constraint_seq>>(r, new_mk_cs.second); }
term* whnf(context *Sigma, typing_context* Delta, term* t) { if (t == NULL) return NULL; switch (t->tag) { case VAR: { term* defn = context_lookup(t->var, Sigma); if (defn == NULL) { return term_dup(t); } return whnf(Sigma, Delta, defn); } case APP: { term* l = whnf(Sigma, Delta, t->left); if (l->tag == LAM) { term* subs = substitute(l->var, t->right, l->right); free_term(l); return whnf_and_free(Sigma, Delta, subs); } return make_app(l, term_dup(t->right)); } case ELIM: { term* last = t->args[t->num_args - 1]; term* nlast = whnf(Sigma, Delta, last); term* c = term_dup(t); free_term(c->args[c->num_args - 1]); c->args[c->num_args - 1] = nlast; if (nlast->tag == INTRO) { return whnf_and_free(Sigma, Delta, elim_over_intro(Delta, c)); } else { return c; } } case HOLE: case DATATYPE: case TYPE: case LAM: case INTRO: case PI: case IMPLICIT: return term_dup(t); } }
optional<expr> projection_converter::is_stuck(expr const & e, type_checker & c) { projection_info const * info = is_projection(e); if (!info) return default_converter::is_stuck(e, c); buffer<expr> args; get_app_args(e, args); if (args.size() <= info->m_nparams) return none_expr(); expr mk = whnf(args[info->m_nparams], c).first; return c.is_stuck(mk); }
tactic intros_tactic(list<name> _ns, bool relax_main_opaque) { auto fn = [=](environment const & env, io_state const &, proof_state const & s) { list<name> ns = _ns; goals const & gs = s.get_goals(); if (empty(gs)) { throw_no_goal_if_enabled(s); return optional<proof_state>(); } goal const & g = head(gs); name_generator ngen = s.get_ngen(); auto tc = mk_type_checker(env, ngen.mk_child(), relax_main_opaque); expr t = g.get_type(); expr m = g.get_meta(); bool gen_names = empty(ns); try { while (true) { if (!gen_names && is_nil(ns)) break; if (!is_pi(t)) { if (!is_nil(ns)) { t = tc->ensure_pi(t).first; } else { expr new_t = tc->whnf(t).first; if (!is_pi(new_t)) break; t = new_t; } } name new_name; if (!is_nil(ns)) { new_name = head(ns); ns = tail(ns); } else { new_name = get_unused_name(binding_name(t), m); } expr new_local = mk_local(ngen.next(), new_name, binding_domain(t), binding_info(t)); t = instantiate(binding_body(t), new_local); m = mk_app(m, new_local); } goal new_g(m, t); return some(proof_state(s, goals(new_g, tail(gs)), ngen)); } catch (exception &) { return optional<proof_state>(); } }; return tactic01(fn); }
/** \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; } } }
tactic whnf_tactic(bool relax_main_opaque) { return tactic01([=](environment const & env, io_state const & ios, proof_state const & ps) { goals const & gs = ps.get_goals(); if (empty(gs)) return none_proof_state(); name_generator ngen = ps.get_ngen(); auto tc = mk_type_checker(env, ngen.mk_child(), relax_main_opaque); goal g = head(gs); goals tail_gs = tail(gs); expr type = g.get_type(); auto t_cs = tc->whnf(type); goals new_gs(goal(g.get_meta(), t_cs.first), tail_gs); proof_state new_ps(ps, new_gs, ngen); if (solve_constraints(env, ios, new_ps, t_cs.second)) { return some_proof_state(new_ps); } else { return none_proof_state(); } }); }
action_result by_contradiction_action() { state & s = curr_state(); expr target = whnf(s.get_target()); if (!is_prop(target)) return action_result::failed(); if (blast::is_false(target)) return action_result::failed(); expr not_target; if (is_not(target, not_target)) { s.set_target(mk_arrow(not_target, mk_constant(get_false_name()))); return intros_action(1); } blast_tmp_type_context tmp_tctx; optional<expr> target_decidable = tmp_tctx->mk_class_instance(mk_app(mk_constant(get_decidable_name()), target)); if (!target_decidable) return action_result::failed(); expr href = s.mk_hypothesis(get_app_builder().mk_not(target)); auto pcell = new by_contradiction_proof_step_cell(href); s.push_proof_step(pcell); s.set_target(mk_constant(get_false_name())); trace_action("by_contradiction"); return action_result::new_branch(); }
/* Whnf + Eta */ expr simplifier::whnf_eta(expr const & e) { return try_eta(whnf(e)); }
term* whnf_and_free(context *Sigma, typing_context* Delta, term* t) { term* ans = whnf(Sigma, Delta, t); free_term(t); return ans; }
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); }