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