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);
}
expr visit_projection(name const & fn, buffer<expr> const & args) {
projection_info const & info = *get_projection_info(env(), fn);
expr major = visit(args[info.m_nparams]);
buffer<bool> rel_fields;
name I_name = *inductive::is_intro_rule(env(), info.m_constructor);
get_constructor_info(info.m_constructor, rel_fields);
lean_assert(info.m_i < rel_fields.size());
lean_assert(rel_fields[info.m_i]); /* We already erased irrelevant information */
/* Adjust projection index by ignoring irrelevant fields */
unsigned j = 0;
for (unsigned i = 0; i < info.m_i; i++) {
if (rel_fields[i])
j++;
}
expr r;
if (has_trivial_structure(I_name, rel_fields)) {
lean_assert(j == 0);
r = major;
} else {
r = mk_app(mk_proj(j), major);
}
/* Add additional arguments */
for (unsigned i = info.m_nparams + 1; i < args.size(); i++)
r = mk_app(r, visit(args[i]));
return r;
}
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);
}
static optional<pair<expr, expr>> mk_op(environment const & env, old_local_context & ctx, type_checker_ptr & tc,
name const & op, unsigned nunivs, unsigned nargs, std::initializer_list<expr> const & explicit_args,
constraint_seq & cs, tag g) {
levels lvls;
for (unsigned i = 0; i < nunivs; i++)
lvls = levels(mk_meta_univ(mk_fresh_name()), lvls);
expr c = mk_constant(op, lvls);
expr op_type = instantiate_type_univ_params(env.get(op), lvls);
buffer<expr> args;
for (unsigned i = 0; i < nargs; i++) {
if (!is_pi(op_type))
return optional<pair<expr, expr>>();
expr arg = ctx.mk_meta(some_expr(binding_domain(op_type)), g);
args.push_back(arg);
op_type = instantiate(binding_body(op_type), arg);
}
expr r = mk_app(c, args, g);
for (expr const & explicit_arg : explicit_args) {
if (!is_pi(op_type))
return optional<pair<expr, expr>>();
r = mk_app(r, explicit_arg);
expr type = tc->infer(explicit_arg, cs);
justification j = mk_app_justification(r, op_type, explicit_arg, type);
if (!tc->is_def_eq(binding_domain(op_type), type, j, cs))
return optional<pair<expr, expr>>();
op_type = instantiate(binding_body(op_type), explicit_arg);
}
return some(mk_pair(r, op_type));
}
expr from_string_core(std::string const & s) {
expr r = *g_empty;
for (unsigned i = 0; i < s.size(); i++) {
expr n = to_nat_expr(mpz(static_cast<unsigned char>(s[i])));
expr c = mk_app(*g_char_of_nat, n);
r = mk_app(*g_str, c, r);
}
return r;
}
expr mk_codomain(expr const & codomain, expr p, buffer<expr> const & locals, unsigned n) {
buffer<expr> terms;
for (unsigned i = 0; i < n - 1; i++) {
terms.push_back(mk_app(m_ctx, get_psigma_fst_name(), p));
p = mk_app(m_ctx, get_psigma_snd_name(), p);
}
terms.push_back(p);
return replace_locals(codomain, locals, terms);
}
// If restricted is true, we don't use (e <-> true) rewrite
list<expr_pair> apply(expr const & e, expr const & H, bool restrited) {
expr c, Hdec, A, arg1, arg2;
if (is_relation(e)) {
return mk_singleton(e, H);
} else if (is_standard(m_env) && is_not(m_env, e, arg1)) {
expr new_e = mk_iff(arg1, mk_false());
expr new_H = mk_app(mk_constant(get_iff_false_intro_name()), arg1, H);
return mk_singleton(new_e, new_H);
} else if (is_standard(m_env) && is_and(e, arg1, arg2)) {
// TODO(Leo): we can extend this trick to any type that has only one constructor
expr H1 = mk_app(mk_constant(get_and_elim_left_name()), arg1, arg2, H);
expr H2 = mk_app(mk_constant(get_and_elim_right_name()), arg1, arg2, H);
auto r1 = apply(arg1, H1, restrited);
auto r2 = apply(arg2, H2, restrited);
return append(r1, r2);
} else if (is_pi(e)) {
// TODO(dhs): keep name?
expr local = m_tctx.mk_tmp_local(binding_domain(e), binding_info(e));
expr new_e = instantiate(binding_body(e), local);
expr new_H = mk_app(H, local);
auto r = apply(new_e, new_H, restrited);
unsigned len = length(r);
if (len == 0) {
return r;
} else if (len == 1 && head(r).first == new_e && head(r).second == new_H) {
return mk_singleton(e, H);
} else {
return lift(local, r);
}
} else if (is_standard(m_env) && is_ite(e, c, Hdec, A, arg1, arg2) && is_prop(e)) {
// TODO(Leo): support HoTT mode if users request
expr not_c = mk_app(mk_constant(get_not_name()), c);
expr Hc = m_tctx.mk_tmp_local(c);
expr Hnc = m_tctx.mk_tmp_local(not_c);
expr H1 = mk_app({mk_constant(get_implies_of_if_pos_name()),
c, arg1, arg2, Hdec, e, Hc});
expr H2 = mk_app({mk_constant(get_implies_of_if_neg_name()),
c, arg1, arg2, Hdec, e, Hnc});
auto r1 = lift(Hc, apply(arg1, H1, restrited));
auto r2 = lift(Hnc, apply(arg2, H2, restrited));
return append(r1, r2);
} else if (!restrited) {
expr new_e = m_tctx.whnf(e);
if (new_e != e) {
if (auto r = apply(new_e, H, true))
return r;
}
if (is_standard(m_env) && is_prop(e)) {
expr new_e = mk_iff(e, mk_true());
expr new_H = mk_app(mk_constant(get_iff_true_intro_name()), e, H);
return mk_singleton(new_e, new_H);
} else {
return list<expr_pair>();
}
} else {
return list<expr_pair>();
}
}
virtual action_result resolve(expr const & pr) const override {
try {
expr it = pr;
bool skip = true;
for (unsigned i = 0; i < m_num_new_eqs; i++) {
if (!is_lambda(it)) {
break;
skip = false;
}
it = binding_body(it);
}
if (skip && closed(it)) {
// new eq hypotheses were not used
return action_result::solved(it);
}
state & s = curr_state();
app_builder & b = get_app_builder();
hypothesis const & h = s.get_hypothesis_decl(href_index(m_eq_href));
expr type = h.get_type();
expr lhs, rhs;
lean_verify(is_eq(type, lhs, rhs));
name nc_name(m_I_name, "no_confusion");
expr new_pr = mk_app(b.mk_app(nc_name, {m_target, lhs, rhs, m_eq_href}), pr);
return action_result::solved(new_pr);
} catch (app_builder_exception &) {
return action_result::failed();
}
}
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);
}
expr dsimplify_core_fn::visit_app(expr const & e) {
buffer<expr> args;
bool modified = false;
expr f = get_app_args(e, args);
unsigned i = 0;
if (!m_cfg.m_canonize_instances) {
fun_info info = get_fun_info(m_ctx, f, args.size());
for (param_info const & pinfo : info.get_params_info()) {
lean_assert(i < args.size());
expr new_a;
if (pinfo.is_inst_implicit()) {
new_a = m_defeq_canonizer.canonize(args[i], m_need_restart);
} else {
new_a = visit(args[i]);
}
if (new_a != args[i])
modified = true;
args[i] = new_a;
i++;
}
}
for (; i < args.size(); i++) {
expr new_a = visit(args[i]);
if (new_a != args[i])
modified = true;
args[i] = new_a;
}
if (modified)
return mk_app(f, args);
else
return e;
}
optional<expr> expand_core(expr const & e) {
lean_assert(!is_lambda(e));
expr t = ctx().whnf(ctx().infer(e));
if (!is_pi(t))
return none_expr();
expr r = mk_lambda(name("x"), binding_domain(t), mk_app(e, mk_var(0)));
return some_expr(visit(r));
}
expr mk_app_vars(expr const & f, unsigned n, tag g) {
expr r = f;
while (n > 0) {
--n;
r = mk_app(r, mk_var(n, g), g);
}
return r;
}
expr pack(unsigned i, unsigned arity, buffer<expr> const & args, expr const & type) {
lean_assert(arity > 0);
if (i == arity - 1) {
return args[i];
} else {
lean_assert(is_constant(get_app_fn(type), get_psigma_name()));
expr a = args[i];
expr A = app_arg(app_fn(type));
expr B = app_arg(type);
lean_assert(is_lambda(B));
expr new_type = instantiate(binding_body(B), a);
expr b = pack(i+1, arity, args, new_type);
bool mask[2] = {true, true};
expr AB[2] = {A, B};
return mk_app(mk_app(m_ctx, get_psigma_mk_name(), 2, mask, AB), a, b);
}
}
expr mk_rev_app(expr const & f, unsigned num_args, expr const * args, tag g) {
expr r = f;
unsigned i = num_args;
while (i > 0) {
--i;
r = mk_app(r, args[i], g);
}
return r;
}
expr visit_cases_on(name const & fn, buffer<expr> & args) {
name const & I_name = fn.get_prefix();
if (is_inductive_predicate(env(), I_name))
throw exception(sstream() << "code generation failed, inductive predicate '" << I_name << "' is not supported");
bool is_builtin = is_vm_builtin_function(fn);
buffer<name> cnames;
get_intro_rule_names(env(), I_name, cnames);
lean_assert(args.size() >= cnames.size() + 1);
if (args.size() > cnames.size() + 1)
distribute_extra_args_over_minors(I_name, cnames, args);
lean_assert(args.size() == cnames.size() + 1);
/* Process major premise */
args[0] = visit(args[0]);
unsigned num_reachable = 0;
optional<expr> reachable_case;
/* Process minor premises */
for (unsigned i = 0; i < cnames.size(); i++) {
buffer<bool> rel_fields;
get_constructor_info(cnames[i], rel_fields);
auto p = visit_minor_premise(args[i+1], rel_fields);
expr new_minor = p.first;
if (i == 0 && has_trivial_structure(I_name, rel_fields)) {
/* Optimization for an inductive datatype that has a single constructor with only one relevant field */
return beta_reduce(mk_app(new_minor, args[0]));
}
args[i+1] = new_minor;
if (!p.second) {
num_reachable++;
reachable_case = p.first;
}
}
if (num_reachable == 0) {
return mk_unreachable_expr();
} else if (num_reachable == 1 && !is_builtin) {
/* Use _cases.1 */
return mk_app(mk_cases(1), args[0], *reachable_case);
} else if (is_builtin) {
return mk_app(mk_constant(fn), args);
} else {
return mk_app(mk_cases(cnames.size()), args);
}
}
list<expr> get_coercions_from_to(type_checker & from_tc, type_checker & to_tc,
expr const & from_type, expr const & to_type, constraint_seq & cs, bool lift_coe) {
constraint_seq new_cs;
environment const & env = to_tc.env();
expr whnf_from_type = from_tc.whnf(from_type, new_cs);
expr whnf_to_type = to_tc.whnf(to_type, new_cs);
if (lift_coe && is_pi(whnf_from_type)) {
// Try to lift coercions.
// The idea is to convert a coercion from A to B, into a coercion from D->A to D->B
if (!is_pi(whnf_to_type))
return list<expr>(); // failed
if (!from_tc.is_def_eq(binding_domain(whnf_from_type), binding_domain(whnf_to_type), justification(), new_cs))
return list<expr>(); // failed, the domains must be definitionally equal
expr x = mk_local(mk_fresh_name(), "x", binding_domain(whnf_from_type), binder_info());
expr A = instantiate(binding_body(whnf_from_type), x);
expr B = instantiate(binding_body(whnf_to_type), x);
list<expr> coe = get_coercions_from_to(from_tc, to_tc, A, B, new_cs, lift_coe);
if (coe) {
cs += new_cs;
// Remark: each coercion c in coe is a function from A to B
// We create a new list: (fun (f : D -> A) (x : D), c (f x))
expr f = mk_local(mk_fresh_name(), "f", whnf_from_type, binder_info());
expr fx = mk_app(f, x);
return map(coe, [&](expr const & c) { return Fun(f, Fun(x, mk_app(c, fx))); });
} else {
return list<expr>();
}
} else {
expr const & fn = get_app_fn(whnf_to_type);
list<expr> r;
if (is_constant(fn)) {
r = get_coercions(env, whnf_from_type, const_name(fn));
} else if (is_pi(whnf_to_type)) {
r = get_coercions_to_fun(env, whnf_from_type);
} else if (is_sort(whnf_to_type)) {
r = get_coercions_to_sort(env, whnf_from_type);
}
if (r)
cs += new_cs;
return r;
}
}
/** \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");
}
}
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());
}
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));
}
virtual expr visit_app(expr const & e) override {
buffer<expr> args;
expr const & fn = get_app_args(e, args);
for (expr & arg : args)
arg = visit(arg);
auto fnidx = get_fn_idx(fn);
if (!fnidx) return replace_visitor_with_tc::visit_app(e);
expr new_fn = m_ues.get_fn(*fnidx);
if (fn == new_fn) return replace_visitor_with_tc::visit_app(e);
unsigned arity = m_ues.get_arity_of(*fnidx);
if (args.size() < arity) {
expr new_e = m_ctx.eta_expand(e);
if (!is_lambda(new_e)) throw_ill_formed_eqns();
return visit(new_e);
}
expr new_fn_type = m_ctx.infer(new_fn);
expr sigma_type = binding_domain(new_fn_type);
expr arg = pack(0, arity, args, sigma_type);
expr r = mk_app(new_fn, arg);
return copy_tag(e, mk_app(r, args.size() - arity, args.data() + arity));
}
void initialize_string() {
g_string_macro = new name("string_macro");
g_string_opcode = new std::string("Str");
g_nat = new expr(Const(get_nat_name()));
g_char = new expr(Const(get_char_name()));
g_char_of_nat = new expr(Const(get_char_of_nat_name()));
g_string = new expr(Const(get_string_name()));
g_empty = new expr(Const(get_string_empty_name()));
g_str = new expr(Const(get_string_str_name()));
g_fin_mk = new expr(Const(get_fin_mk_name()));
g_list_char = new expr(mk_app(mk_constant(get_list_name(), {mk_level_one()}), *g_char));
g_list_cons = new expr(mk_constant(get_list_cons_name(), {mk_level_one()}));
g_list_nil_char = new expr(mk_app(mk_constant(get_list_nil_name(), {mk_level_one()}), *g_char));
register_macro_deserializer(*g_string_opcode,
[](deserializer & d, unsigned num, expr const *) {
if (num != 0)
throw corrupted_stream_exception();
std::string v = d.read_string();
return mk_string_macro(v);
});
}
expr visit_constructor(name const & fn, buffer<expr> const & args) {
bool is_builtin = is_vm_builtin_function(fn);
name I_name = *inductive::is_intro_rule(env(), fn);
unsigned nparams = *inductive::get_num_params(env(), I_name);
unsigned cidx = get_constructor_idx(env(), fn);
buffer<bool> rel_fields;
get_constructor_info(fn, rel_fields);
lean_assert(args.size() == nparams + rel_fields.size());
buffer<expr> new_args;
for (unsigned i = 0; i < rel_fields.size(); i++) {
if (rel_fields[i]) {
new_args.push_back(visit(args[nparams + i]));
}
}
if (has_trivial_structure(I_name, rel_fields)) {
lean_assert(new_args.size() == 1);
return new_args[0];
} else if (is_builtin) {
return mk_app(mk_constant(fn), new_args);
} else {
return mk_app(mk_cnstr(cidx), new_args);
}
}
/**
Given
l : H
(or lhs2 rhs2) : H2, where lhs2 or rhs2 contain not_l
produce a proof for R
*/
expr mk_or_elim_tree2(expr const & l, expr const & H, expr const & not_l,
expr const & lhs2, expr const & rhs2, expr const & H2,
expr const & R, extension_context & ctx) const {
expr l_1 = lift(l);
expr H_1 = lift(H);
expr not_l_1 = lift(not_l);
expr lhs2_1 = lift(lhs2);
expr rhs2_1 = lift(rhs2);
expr R_1 = lift(R);
// or_elim {a b c : Prop} (H1 : a ∨ b) (H2 : a → c) (H3 : b → c) : c
return mk_app({*g_or_elim,
lhs2, rhs2, R, H2,
mk_lambda("H2", lhs2, mk_or_elim_tree2(l_1, H_1, not_l_1, lhs2_1, *g_var_0, R_1, ctx)),
mk_lambda("H3", rhs2, mk_or_elim_tree2(l_1, H_1, not_l_1, rhs2_1, *g_var_0, R_1, ctx))});
}
optional<constraints> coercion_elaborator::next() {
if (!m_choices)
return optional<constraints>();
if (m_id) {
m_id = false;
m_info.erase_coercion_info(m_arg);
} else if (m_coercions) {
expr c = head(m_coercions);
m_coercions = tail(m_coercions);
m_info.save_coercion_info(m_arg, mk_app(c, m_arg));
}
auto r = head(m_choices);
m_choices = tail(m_choices);
return optional<constraints>(r);
}
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();
}
expr compiler_step_visitor::visit_app(expr const & e) {
buffer<expr> args;
expr const & fn = get_app_args(e, args);
expr new_fn = visit(fn);
bool modified = !is_eqp(fn, new_fn);
for (expr & arg : args) {
expr new_arg = visit(arg);
if (!is_eqp(new_arg, arg))
modified = true;
arg = new_arg;
}
if (!modified)
return e;
else
return copy_tag(e, mk_app(new_fn, args));
}
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);
}
environment mk_rec_on(environment const & env, name const & n) {
if (!inductive::is_inductive_decl(env, n))
throw exception(sstream() << "error in 'rec_on' generation, '" << n << "' is not an inductive datatype");
name rec_on_name(n, "rec_on");
name_generator ngen;
declaration rec_decl = env.get(inductive::get_elim_name(n));
buffer<expr> locals;
expr rec_type = rec_decl.get_type();
while (is_pi(rec_type)) {
expr local = mk_local(ngen.next(), binding_name(rec_type), binding_domain(rec_type), binding_info(rec_type));
rec_type = instantiate(binding_body(rec_type), local);
locals.push_back(local);
}
// locals order
// A C minor_premises indices major-premise
// new_locals order
// A C indices major-premise minor-premises
buffer<expr> new_locals;
unsigned idx_major_sz = *inductive::get_num_indices(env, n) + 1;
unsigned minor_sz = *inductive::get_num_minor_premises(env, n);
unsigned AC_sz = locals.size() - minor_sz - idx_major_sz;
for (unsigned i = 0; i < AC_sz; i++)
new_locals.push_back(locals[i]);
for (unsigned i = 0; i < idx_major_sz; i++)
new_locals.push_back(locals[AC_sz + minor_sz + i]);
unsigned rec_on_major_idx = new_locals.size() - 1;
for (unsigned i = 0; i < minor_sz; i++)
new_locals.push_back(locals[AC_sz + i]);
expr rec_on_type = Pi(new_locals, rec_type);
levels ls = param_names_to_levels(rec_decl.get_univ_params());
expr rec = mk_constant(rec_decl.get_name(), ls);
expr rec_on_val = Fun(new_locals, mk_app(rec, locals));
bool use_conv_opt = true;
environment new_env = module::add(env,
check(env, mk_definition(env, rec_on_name, rec_decl.get_univ_params(),
rec_on_type, rec_on_val, use_conv_opt)));
new_env = set_reducible(new_env, rec_on_name, reducible_status::Reducible);
new_env = add_unfold_hint(new_env, rec_on_name, rec_on_major_idx);
new_env = add_aux_recursor(new_env, rec_on_name);
return add_protected(new_env, rec_on_name);
}
optional<constraints> try_instance(expr const & inst, expr const & inst_type) {
type_checker & tc = m_C->tc();
name_generator & ngen = m_C->m_ngen;
tag g = inst.get_tag();
try {
flet<local_context> scope(m_ctx, m_ctx);
buffer<expr> locals;
expr meta_type = m_meta_type;
while (true) {
meta_type = tc.whnf(meta_type).first;
if (!is_pi(meta_type))
break;
expr local = mk_local(ngen.next(), binding_name(meta_type),
binding_domain(meta_type), binding_info(meta_type));
m_ctx.add_local(local);
locals.push_back(local);
meta_type = instantiate(binding_body(meta_type), local);
}
expr type = inst_type;
expr r = inst;
buffer<constraint> cs;
while (true) {
type = tc.whnf(type).first;
if (!is_pi(type))
break;
expr arg;
if (binding_info(type).is_inst_implicit()) {
pair<expr, constraint> ac = mk_class_instance_elaborator(m_C, m_ctx, some_expr(binding_domain(type)),
g, m_depth+1);
arg = ac.first;
cs.push_back(ac.second);
} else {
arg = m_ctx.mk_meta(m_C->m_ngen, some_expr(binding_domain(type)), g);
}
r = mk_app(r, arg, g);
type = instantiate(binding_body(type), arg);
}
r = Fun(locals, r);
trace(meta_type, r);
bool relax = m_C->m_relax;
constraint c = mk_eq_cnstr(m_meta, r, m_jst, relax);
return optional<constraints>(mk_constraints(c, cs));
} catch (exception &) {
return optional<constraints>();
}
}
/**
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);
}
}
}
