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