void get_rec_args(environment const & env, name const & n, buffer<buffer<bool>> & r) { lean_assert(inductive::is_inductive_decl(env, n)); type_checker tc(env); name_generator ngen; declaration ind_decl = env.get(n); declaration rec_decl = env.get(inductive::get_elim_name(n)); unsigned nparams = *inductive::get_num_params(env, n); unsigned nminors = *inductive::get_num_minor_premises(env, n); unsigned ntypeformers = *inductive::get_num_type_formers(env, n); buffer<expr> rec_args; to_telescope(ngen, rec_decl.get_type(), rec_args); buffer<name> typeformer_names; for (unsigned i = nparams; i < nparams + ntypeformers; i++) { typeformer_names.push_back(mlocal_name(rec_args[i])); } lean_assert(typeformer_names.size() == ntypeformers); r.clear(); // add minor premises for (unsigned i = nparams + ntypeformers; i < nparams + ntypeformers + nminors; i++) { r.push_back(buffer<bool>()); buffer<bool> & bv = r.back(); expr minor_type = mlocal_type(rec_args[i]); buffer<expr> minor_args; to_telescope(ngen, minor_type, minor_args); for (expr & minor_arg : minor_args) { buffer<expr> minor_arg_args; expr minor_arg_type = to_telescope(tc, mlocal_type(minor_arg), minor_arg_args); bv.push_back(is_typeformer_app(typeformer_names, minor_arg_type)); } } }
bool is_lt(expr const & a, expr const & b, bool use_hash) { if (is_eqp(a, b)) return false; unsigned wa = get_weight(a); unsigned wb = get_weight(b); if (wa < wb) return true; if (wa > wb) return false; if (a.kind() != b.kind()) return a.kind() < b.kind(); if (use_hash) { if (a.hash() < b.hash()) return true; if (a.hash() > b.hash()) return false; } if (a == b) return false; switch (a.kind()) { case expr_kind::Var: return var_idx(a) < var_idx(b); case expr_kind::Constant: if (const_name(a) != const_name(b)) return const_name(a) < const_name(b); else return is_lt(const_levels(a), const_levels(b), use_hash); case expr_kind::App: if (app_fn(a) != app_fn(b)) return is_lt(app_fn(a), app_fn(b), use_hash); else return is_lt(app_arg(a), app_arg(b), use_hash); case expr_kind::Lambda: case expr_kind::Pi: if (binding_domain(a) != binding_domain(b)) return is_lt(binding_domain(a), binding_domain(b), use_hash); else return is_lt(binding_body(a), binding_body(b), use_hash); case expr_kind::Let: if (let_type(a) != let_type(b)) return is_lt(let_type(a), let_type(b), use_hash); else if (let_value(a) != let_value(b)) return is_lt(let_value(a), let_value(b), use_hash); else return is_lt(let_body(a), let_body(b), use_hash); case expr_kind::Sort: return is_lt(sort_level(a), sort_level(b), use_hash); case expr_kind::Local: case expr_kind::Meta: if (mlocal_name(a) != mlocal_name(b)) return mlocal_name(a) < mlocal_name(b); else return is_lt(mlocal_type(a), mlocal_type(b), use_hash); case expr_kind::Macro: if (macro_def(a) != macro_def(b)) return macro_def(a) < macro_def(b); if (macro_num_args(a) != macro_num_args(b)) return macro_num_args(a) < macro_num_args(b); for (unsigned i = 0; i < macro_num_args(a); i++) { if (macro_arg(a, i) != macro_arg(b, i)) return is_lt(macro_arg(a, i), macro_arg(b, i), use_hash); } return false; } lean_unreachable(); // LCOV_EXCL_LINE }
bool apply(expr const & a, expr const & b) { if (is_eqp(a, b)) return true; if (a.hash() != b.hash()) return false; if (a.kind() != b.kind()) return false; if (is_var(a)) return var_idx(a) == var_idx(b); if (m_cache.check(a, b)) return true; switch (a.kind()) { case expr_kind::Var: lean_unreachable(); // LCOV_EXCL_LINE case expr_kind::Constant: return const_name(a) == const_name(b) && compare(const_levels(a), const_levels(b), [](level const & l1, level const & l2) { return l1 == l2; }); case expr_kind::Meta: return mlocal_name(a) == mlocal_name(b) && apply(mlocal_type(a), mlocal_type(b)); case expr_kind::Local: return mlocal_name(a) == mlocal_name(b) && apply(mlocal_type(a), mlocal_type(b)) && (!CompareBinderInfo || local_pp_name(a) == local_pp_name(b)) && (!CompareBinderInfo || local_info(a) == local_info(b)); case expr_kind::App: check_system(); return apply(app_fn(a), app_fn(b)) && apply(app_arg(a), app_arg(b)); case expr_kind::Lambda: case expr_kind::Pi: check_system(); return apply(binding_domain(a), binding_domain(b)) && apply(binding_body(a), binding_body(b)) && (!CompareBinderInfo || binding_name(a) == binding_name(b)) && (!CompareBinderInfo || binding_info(a) == binding_info(b)); case expr_kind::Let: check_system(); return apply(let_type(a), let_type(b)) && apply(let_value(a), let_value(b)) && apply(let_body(a), let_body(b)) && (!CompareBinderInfo || let_name(a) == let_name(b)); case expr_kind::Sort: return sort_level(a) == sort_level(b); case expr_kind::Macro: check_system(); if (macro_def(a) != macro_def(b) || macro_num_args(a) != macro_num_args(b)) return false; for (unsigned i = 0; i < macro_num_args(a); i++) { if (!apply(macro_arg(a, i), macro_arg(b, i))) return false; } return true; } lean_unreachable(); // LCOV_EXCL_LINE }
bool expr_eq_fn::apply(expr const & a, expr const & b) { if (is_eqp(a, b)) return true; if (a.hash() != b.hash()) return false; if (a.kind() != b.kind()) return false; if (is_var(a)) return var_idx(a) == var_idx(b); if (m_counter >= LEAN_EQ_CACHE_THRESHOLD && is_shared(a) && is_shared(b)) { auto p = std::make_pair(a.raw(), b.raw()); if (!m_eq_visited) m_eq_visited.reset(new expr_cell_pair_set); if (m_eq_visited->find(p) != m_eq_visited->end()) return true; m_eq_visited->insert(p); } check_system("expression equality test"); switch (a.kind()) { case expr_kind::Var: lean_unreachable(); // LCOV_EXCL_LINE case expr_kind::Constant: return const_name(a) == const_name(b) && compare(const_levels(a), const_levels(b), [](level const & l1, level const & l2) { return l1 == l2; }); case expr_kind::Local: case expr_kind::Meta: return mlocal_name(a) == mlocal_name(b) && apply(mlocal_type(a), mlocal_type(b)); case expr_kind::App: m_counter++; return apply(app_fn(a), app_fn(b)) && apply(app_arg(a), app_arg(b)); case expr_kind::Lambda: case expr_kind::Pi: m_counter++; return apply(binding_domain(a), binding_domain(b)) && apply(binding_body(a), binding_body(b)) && (!m_compare_binder_info || binding_info(a) == binding_info(b)); case expr_kind::Sort: return sort_level(a) == sort_level(b); case expr_kind::Macro: m_counter++; if (macro_def(a) != macro_def(b) || macro_num_args(a) != macro_num_args(b)) return false; for (unsigned i = 0; i < macro_num_args(a); i++) { if (!apply(macro_arg(a, i), macro_arg(b, i))) return false; } return true; case expr_kind::Let: m_counter++; return apply(let_type(a), let_type(b)) && apply(let_value(a), let_value(b)) && apply(let_body(a), let_body(b)); } lean_unreachable(); // LCOV_EXCL_LINE }
bool is_lt_no_level_params(expr const & a, expr const & b) { if (is_eqp(a, b)) return false; unsigned wa = get_weight(a); unsigned wb = get_weight(b); if (wa < wb) return true; if (wa > wb) return false; if (a.kind() != b.kind()) return a.kind() < b.kind(); switch (a.kind()) { case expr_kind::Var: return var_idx(a) < var_idx(b); case expr_kind::Constant: if (const_name(a) != const_name(b)) return const_name(a) < const_name(b); else return is_lt_no_level_params(const_levels(a), const_levels(b)); case expr_kind::App: if (is_lt_no_level_params(app_fn(a), app_fn(b))) return true; else if (is_lt_no_level_params(app_fn(b), app_fn(a))) return false; else return is_lt_no_level_params(app_arg(a), app_arg(b)); case expr_kind::Lambda: case expr_kind::Pi: if (is_lt_no_level_params(binding_domain(a), binding_domain(b))) return true; else if (is_lt_no_level_params(binding_domain(b), binding_domain(a))) return false; else return is_lt_no_level_params(binding_body(a), binding_body(b)); case expr_kind::Sort: return is_lt_no_level_params(sort_level(a), sort_level(b)); case expr_kind::Local: case expr_kind::Meta: if (mlocal_name(a) != mlocal_name(b)) return mlocal_name(a) < mlocal_name(b); else return is_lt_no_level_params(mlocal_type(a), mlocal_type(b)); case expr_kind::Macro: if (macro_def(a) != macro_def(b)) return macro_def(a) < macro_def(b); if (macro_num_args(a) != macro_num_args(b)) return macro_num_args(a) < macro_num_args(b); for (unsigned i = 0; i < macro_num_args(a); i++) { if (is_lt_no_level_params(macro_arg(a, i), macro_arg(b, i))) return true; else if (is_lt_no_level_params(macro_arg(b, i), macro_arg(a, i))) return false; } return false; } lean_unreachable(); }
expr apply(expr const & a) { check_system("max_sharing"); auto r = m_expr_cache.find(a); if (r != m_expr_cache.end()) return *r; expr res; switch (a.kind()) { case expr_kind::Var: res = a; break; case expr_kind::Constant: res = update_constant(a, map(const_levels(a), [&](level const & l) { return apply(l); })); break; case expr_kind::Sort: res = update_sort(a, apply(sort_level(a))); break; case expr_kind::App: res = update_app(a, apply(app_fn(a)), apply(app_arg(a))); break; case expr_kind::Lambda: case expr_kind::Pi: res = update_binding(a, apply(binding_domain(a)), apply(binding_body(a))); break; case expr_kind::Meta: case expr_kind::Local: res = update_mlocal(a, apply(mlocal_type(a))); break; case expr_kind::Macro: { buffer<expr> new_args; for (unsigned i = 0; i < macro_num_args(a); i++) new_args.push_back(macro_arg(a, i)); res = update_macro(a, new_args.size(), new_args.data()); break; }} m_expr_cache.insert(res); return res; }
expr update_mlocal(expr const & e, expr const & new_type) { if (is_eqp(mlocal_type(e), new_type)) return e; else if (is_metavar(e)) return mk_metavar(mlocal_name(e), new_type, e.get_tag()); else return mk_local(mlocal_name(e), local_pp_name(e), new_type, local_info(e), e.get_tag()); }
void collect_locals(expr const & e, collected_locals & ls, bool restricted) { if (!has_local(e)) return; expr_set visited; std::function<void(expr const & e)> visit = [&](expr const & e) { if (!has_local(e)) return; if (restricted && is_meta(e)) return; if (visited.find(e) != visited.end()) return; visited.insert(e); switch (e.kind()) { case expr_kind::Var: case expr_kind::Constant: case expr_kind::Sort: break; // do nothing case expr_kind::Local: if (!restricted) visit(mlocal_type(e)); ls.insert(e); break; case expr_kind::Meta: lean_assert(!restricted); visit(mlocal_type(e)); break; case expr_kind::Macro: for (unsigned i = 0; i < macro_num_args(e); i++) visit(macro_arg(e, i)); break; case expr_kind::App: visit(app_fn(e)); visit(app_arg(e)); break; case expr_kind::Lambda: case expr_kind::Pi: visit(binding_domain(e)); visit(binding_body(e)); break; case expr_kind::Let: visit(let_type(e)); visit(let_value(e)); visit(let_body(e)); break; } }; visit(e); }
void assert_no_locals(name const & n, expr const & e) { if (!has_local(e)) return; collected_locals ls; collect_locals(e, ls); lean_trace(name({"debug", "inductive_compiler"}), tout() << "\n\nerror: found locals in '" << n << "'\n" << e << "\n"; for (expr const & l : ls.get_collected()) { tout() << mlocal_name(l) << "." << mlocal_pp_name(l) << " : " << mlocal_type(l) << "\n"; });
bool goal::validate_locals() const { buffer<expr> locals; get_app_args(m_meta, locals); if (!::lean::validate_locals(m_type, locals.size(), locals.data())) return false; unsigned i = locals.size(); while (i > 0) { --i; if (!::lean::validate_locals(mlocal_type(locals[i]), i, locals.data())) return false; } return true; }
format congr_rule::pp(formatter const & fmt) const { format r; r += format("#") + format(length(m_metas)); format r1; for (expr const & h : m_congr_hyps) { r1 += space() + paren(fmt(mlocal_type(h))); } r += group(r1); r += space() + format(":") + space(); format r2 = paren(fmt(m_lhs)); r2 += space() + format("↦") + space() + paren(fmt(m_rhs)); r += group(r2); return r; }
virtual optional<constraints> next() { while (!empty(m_local_instances)) { expr inst = head(m_local_instances); m_local_instances = tail(m_local_instances); if (!is_local(inst)) continue; if (auto r = try_instance(inst, mlocal_type(inst))) return r; } while (!empty(m_instances)) { name inst = head(m_instances); m_instances = tail(m_instances); if (auto cs = try_instance(inst)) return cs; } return optional<constraints>(); }
expr apply(expr const & e, unsigned offset) { bool shared = false; if (m_use_cache && is_shared(e)) { if (auto r = m_cache->find(e, offset)) return *r; shared = true; } check_interrupted(); check_memory("replace"); if (optional<expr> r = m_f(e, offset)) { return save_result(e, offset, *r, shared); } else { switch (e.kind()) { case expr_kind::Constant: case expr_kind::Sort: case expr_kind::Var: return save_result(e, offset, e, shared); case expr_kind::Meta: case expr_kind::Local: { expr new_t = apply(mlocal_type(e), offset); return save_result(e, offset, update_mlocal(e, new_t), shared); } case expr_kind::App: { expr new_f = apply(app_fn(e), offset); expr new_a = apply(app_arg(e), offset); return save_result(e, offset, update_app(e, new_f, new_a), shared); } case expr_kind::Pi: case expr_kind::Lambda: { expr new_d = apply(binding_domain(e), offset); expr new_b = apply(binding_body(e), offset+1); return save_result(e, offset, update_binding(e, new_d, new_b), shared); } case expr_kind::Macro: { buffer<expr> new_args; unsigned nargs = macro_num_args(e); for (unsigned i = 0; i < nargs; i++) new_args.push_back(apply(macro_arg(e, i), offset)); return save_result(e, offset, update_macro(e, new_args.size(), new_args.data()), shared); }} lean_unreachable(); } }
/** \brief Given a sequence metas: <tt>(?m_1 ...) (?m_2 ... ) ... (?m_k ...)</tt>, we say ?m_i is "redundant" if it occurs in the type of some ?m_j. This procedure removes from metas any redundant element. */ static void remove_redundant_metas(buffer<expr> & metas) { buffer<expr> mvars; for (expr const & m : metas) mvars.push_back(get_app_fn(m)); unsigned k = 0; for (unsigned i = 0; i < metas.size(); i++) { bool found = false; for (unsigned j = 0; j < metas.size(); j++) { if (j != i) { if (occurs(mvars[i], mlocal_type(mvars[j]))) { found = true; break; } } } if (!found) { metas[k] = metas[i]; k++; } } metas.shrink(k); }
expr visit_binding(expr e) { expr_kind k = e.kind(); buffer<expr> es; buffer<expr> ls; while (e.kind() == k) { expr d = visit(instantiate_rev(binding_domain(e), ls.size(), ls.data())); expr l = mk_local(m_tc.mk_fresh_name(), binding_name(e), d, binding_info(e)); ls.push_back(l); es.push_back(e); e = binding_body(e); } e = visit(instantiate_rev(e, ls.size(), ls.data())); expr r = abstract_locals(e, ls.size(), ls.data()); while (!ls.empty()) { expr d = mlocal_type(ls.back()); ls.pop_back(); d = abstract_locals(d, ls.size(), ls.data()); r = update_binding(es.back(), d, r); es.pop_back(); } return r; }
optional<expr> placeholder_type(expr const & e) { if (is_local(e) && is_placeholder(e)) return some_expr(mlocal_type(e)); else return none_expr(); }
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); }
bool abstract_expr_manager::is_equal(expr const & a, expr const & b) { if (is_eqp(a, b)) return true; if (a.kind() != b.kind()) return false; if (is_var(a)) return var_idx(a) == var_idx(b); bool is_eq; switch (a.kind()) { case expr_kind::Var: lean_unreachable(); // LCOV_EXCL_LINE case expr_kind::Constant: case expr_kind::Sort: return a == b; case expr_kind::Meta: case expr_kind::Local: return mlocal_name(a) == mlocal_name(b) && is_equal(mlocal_type(a), mlocal_type(b)); case expr_kind::Lambda: case expr_kind::Pi: if (!is_equal(binding_domain(a), binding_domain(b))) return false; // see comment at abstract_expr_manager::hash m_locals.push_back(instantiate_rev(m_tctx.mk_tmp_local(binding_domain(a)), m_locals.size(), m_locals.data())); is_eq = is_equal(binding_body(a), binding_body(b)); m_locals.pop_back(); return is_eq; case expr_kind::Macro: if (macro_def(a) != macro_def(b) || macro_num_args(a) != macro_num_args(b)) return false; for (unsigned i = 0; i < macro_num_args(a); i++) { if (!is_equal(macro_arg(a, i), macro_arg(b, i))) return false; } return true; case expr_kind::App: buffer<expr> a_args, b_args; expr const & f_a = get_app_args(a, a_args); expr const & f_b = get_app_args(b, b_args); if (!is_equal(f_a, f_b)) return false; if (a_args.size() != b_args.size()) return false; unsigned prefix_sz = m_congr_lemma_manager.get_specialization_prefix_size(instantiate_rev(f_a, m_locals.size(), m_locals.data()), a_args.size()); for (unsigned i = 0; i < prefix_sz; i++) { if (!is_equal(a_args[i], b_args[i])) return false; } expr new_f_a = a; unsigned rest_sz = a_args.size() - prefix_sz; for (unsigned i = 0; i < rest_sz; i++) { new_f_a = app_fn(new_f_a); } new_f_a = instantiate_rev(new_f_a, m_locals.size(), m_locals.data()); optional<congr_lemma> congr = m_congr_lemma_manager.mk_congr(new_f_a, rest_sz); bool not_equal = false; if (!congr) { for (unsigned i = prefix_sz; i < a_args.size(); ++i) { if (!is_equal(a_args[i], b_args[i])) { not_equal = true; break; } } } else { lean_assert(length(congr->get_arg_kinds()) == rest_sz); unsigned i = prefix_sz; for_each(congr->get_arg_kinds(), [&](congr_arg_kind const & c_kind) { if (not_equal) return; if (c_kind != congr_arg_kind::Cast && !is_equal(a_args[i], b_args[i])) { not_equal = true; } i++; }); } return !not_equal; } lean_unreachable(); // LCOV_EXCL_LINE }
expr update_local(expr const & e, binder_info const & bi) { return update_local(e, mlocal_type(e), bi); }
expr update_local(expr const & e, expr const & new_type, binder_info const & bi) { if (is_eqp(mlocal_type(e), new_type) && local_info(e) == bi) return e; else return mk_local(mlocal_name(e), local_pp_name(e), new_type, bi, e.get_tag()); }
void add_congr_core(environment const & env, simp_rule_sets & s, name const & n) { declaration const & d = env.get(n); type_checker tc(env); buffer<level> us; unsigned num_univs = d.get_num_univ_params(); for (unsigned i = 0; i < num_univs; i++) { us.push_back(mk_meta_univ(name(*g_prefix, i))); } levels ls = to_list(us); expr pr = mk_constant(n, ls); expr e = instantiate_type_univ_params(d, ls); buffer<bool> explicit_args; buffer<expr> metas; unsigned idx = 0; while (is_pi(e)) { expr mvar = mk_metavar(name(*g_prefix, idx), binding_domain(e)); idx++; explicit_args.push_back(is_explicit(binding_info(e))); metas.push_back(mvar); e = instantiate(binding_body(e), mvar); pr = mk_app(pr, mvar); } expr rel, lhs, rhs; if (!is_simp_relation(env, e, rel, lhs, rhs) || !is_constant(rel)) { throw exception(sstream() << "invalid congruence rule, '" << n << "' resulting type is not of the form t ~ s, where '~' is a transitive and reflexive relation"); } name_set found_mvars; buffer<expr> lhs_args, rhs_args; expr const & lhs_fn = get_app_args(lhs, lhs_args); expr const & rhs_fn = get_app_args(rhs, rhs_args); if (is_constant(lhs_fn)) { if (!is_constant(rhs_fn) || const_name(lhs_fn) != const_name(rhs_fn) || lhs_args.size() != rhs_args.size()) { throw exception(sstream() << "invalid congruence rule, '" << n << "' resulting type is not of the form (" << const_name(lhs_fn) << " ...) " << "~ (" << const_name(lhs_fn) << " ...), where ~ is '" << const_name(rel) << "'"); } for (expr const & lhs_arg : lhs_args) { if (is_sort(lhs_arg)) continue; if (!is_metavar(lhs_arg) || found_mvars.contains(mlocal_name(lhs_arg))) { throw exception(sstream() << "invalid congruence rule, '" << n << "' the left-hand-side of the congruence resulting type must be of the form (" << const_name(lhs_fn) << " x_1 ... x_n), where each x_i is a distinct variable or a sort"); } found_mvars.insert(mlocal_name(lhs_arg)); } } else if (is_binding(lhs)) { if (lhs.kind() != rhs.kind()) { throw exception(sstream() << "invalid congruence rule, '" << n << "' kinds of the left-hand-side and right-hand-side of " << "the congruence resulting type do not match"); } if (!is_valid_congr_rule_binding_lhs(lhs, found_mvars)) { throw exception(sstream() << "invalid congruence rule, '" << n << "' left-hand-side of the congruence resulting type must " << "be of the form (fun/Pi (x : A), B x)"); } } else { throw exception(sstream() << "invalid congruence rule, '" << n << "' left-hand-side is not an application nor a binding"); } buffer<expr> congr_hyps; lean_assert(metas.size() == explicit_args.size()); for (unsigned i = 0; i < metas.size(); i++) { expr const & mvar = metas[i]; if (explicit_args[i] && !found_mvars.contains(mlocal_name(mvar))) { buffer<expr> locals; expr type = mlocal_type(mvar); while (is_pi(type)) { expr local = mk_local(tc.mk_fresh_name(), binding_domain(type)); locals.push_back(local); type = instantiate(binding_body(type), local); } expr h_rel, h_lhs, h_rhs; if (!is_simp_relation(env, type, h_rel, h_lhs, h_rhs) || !is_constant(h_rel)) continue; unsigned j = 0; for (expr const & local : locals) { j++; if (!only_found_mvars(mlocal_type(local), found_mvars)) { throw exception(sstream() << "invalid congruence rule, '" << n << "' argument #" << j << " of parameter #" << (i+1) << " contains " << "unresolved parameters"); } } if (!only_found_mvars(h_lhs, found_mvars)) { throw exception(sstream() << "invalid congruence rule, '" << n << "' argument #" << (i+1) << " is not a valid hypothesis, the left-hand-side contains " << "unresolved parameters"); } if (!is_valid_congr_hyp_rhs(h_rhs, found_mvars)) { throw exception(sstream() << "invalid congruence rule, '" << n << "' argument #" << (i+1) << " is not a valid hypothesis, the right-hand-side must be " << "of the form (m l_1 ... l_n) where m is parameter that was not " << "'assigned/resolved' yet and l_i's are locals"); } found_mvars.insert(mlocal_name(mvar)); congr_hyps.push_back(mvar); } } congr_rule rule(n, ls, to_list(metas), lhs, rhs, pr, to_list(congr_hyps)); s.insert(const_name(rel), rule); }
environment mk_no_confusion(environment const & env, name const & n) { optional<environment> env1 = mk_no_confusion_type(env, n); if (!env1) return env; environment new_env = *env1; type_checker tc(new_env); inductive::inductive_decls decls = *inductive::is_inductive_decl(new_env, n); unsigned nparams = std::get<1>(decls); name_generator ngen; declaration no_confusion_type_decl = new_env.get(name{n, "no_confusion_type"}); declaration cases_decl = new_env.get(name(n, "cases_on")); level_param_names lps = no_confusion_type_decl.get_univ_params(); levels ls = param_names_to_levels(lps); expr no_confusion_type_type = instantiate_type_univ_params(no_confusion_type_decl, ls); name eq_name("eq"); name heq_name("heq"); name eq_refl_name{"eq", "refl"}; name heq_refl_name{"heq", "refl"}; buffer<expr> args; expr type = no_confusion_type_type; type = to_telescope(ngen, type, args, some(mk_implicit_binder_info())); lean_assert(args.size() >= nparams + 3); unsigned nindices = args.size() - nparams - 3; // 3 is for P v1 v2 expr range = mk_app(mk_constant(no_confusion_type_decl.get_name(), ls), args); expr P = args[args.size()-3]; expr v1 = args[args.size()-2]; expr v2 = args[args.size()-1]; expr v_type = mlocal_type(v1); level v_lvl = sort_level(tc.ensure_type(v_type).first); expr eq_v = mk_app(mk_constant(eq_name, to_list(v_lvl)), v_type); expr H12 = mk_local(ngen.next(), "H12", mk_app(eq_v, v1, v2), binder_info()); args.push_back(H12); name no_confusion_name{n, "no_confusion"}; expr no_confusion_ty = Pi(args, range); // The gen proof is of the form // (fun H11 : v1 = v1, cases_on Params (fun Indices v1, no_confusion_type Params Indices P v1 v1) Indices v1 // <for-each case> // (fun H : (equations -> P), H (refl) ... (refl)) // ... // ) // H11 is for creating the generalization expr H11 = mk_local(ngen.next(), "H11", mk_app(eq_v, v1, v1), binder_info()); // Create the type former (fun Indices v1, no_confusion_type Params Indices P v1 v1) buffer<expr> type_former_args; for (unsigned i = nparams; i < nparams + nindices; i++) type_former_args.push_back(args[i]); type_former_args.push_back(v1); buffer<expr> no_confusion_type_args; for (unsigned i = 0; i < nparams + nindices; i++) no_confusion_type_args.push_back(args[i]); no_confusion_type_args.push_back(P); no_confusion_type_args.push_back(v1); no_confusion_type_args.push_back(v1); expr no_confusion_type_app = mk_app(mk_constant(no_confusion_type_decl.get_name(), ls), no_confusion_type_args); expr type_former = Fun(type_former_args, no_confusion_type_app); // create cases_on levels clvls = ls; expr cases_on = mk_app(mk_app(mk_constant(cases_decl.get_name(), clvls), nparams, args.data()), type_former); cases_on = mk_app(mk_app(cases_on, nindices, args.data() + nparams), v1); expr cot = tc.infer(cases_on).first; while (is_pi(cot)) { buffer<expr> minor_args; expr minor = to_telescope(tc, binding_domain(cot), minor_args); lean_assert(!minor_args.empty()); expr H = minor_args.back(); expr Ht = mlocal_type(H); buffer<expr> refl_args; while (is_pi(Ht)) { buffer<expr> eq_args; expr eq_fn = get_app_args(binding_domain(Ht), eq_args); if (const_name(eq_fn) == eq_name) { refl_args.push_back(mk_app(mk_constant(eq_refl_name, const_levels(eq_fn)), eq_args[0], eq_args[1])); } else { refl_args.push_back(mk_app(mk_constant(heq_refl_name, const_levels(eq_fn)), eq_args[0], eq_args[1])); } Ht = binding_body(Ht); } expr pr = mk_app(H, refl_args); cases_on = mk_app(cases_on, Fun(minor_args, pr)); cot = binding_body(cot); } expr gen = Fun(H11, cases_on); // Now, we use gen to build the final proof using eq.rec // // eq.rec InductiveType v1 (fun (a : InductiveType), v1 = a -> no_confusion_type Params Indices v1 a) gen v2 H12 H12 // name eq_rec_name{"eq", "rec"}; expr eq_rec = mk_app(mk_constant(eq_rec_name, {head(ls), v_lvl}), v_type, v1); // create eq_rec type_former // (fun (a : InductiveType), v1 = a -> no_confusion_type Params Indices v1 a) expr a = mk_local(ngen.next(), "a", v_type, binder_info()); expr H1a = mk_local(ngen.next(), "H1a", mk_app(eq_v, v1, a), binder_info()); // reusing no_confusion_type_args... we just replace the last argument with a no_confusion_type_args.pop_back(); no_confusion_type_args.push_back(a); expr no_confusion_type_app_1a = mk_app(mk_constant(no_confusion_type_decl.get_name(), ls), no_confusion_type_args); expr rec_type_former = Fun(a, Pi(H1a, no_confusion_type_app_1a)); // finalize eq_rec eq_rec = mk_app(mk_app(eq_rec, rec_type_former, gen, v2, H12), H12); // expr no_confusion_val = Fun(args, eq_rec); bool opaque = false; bool use_conv_opt = true; declaration new_d = mk_definition(new_env, no_confusion_name, lps, no_confusion_ty, no_confusion_val, opaque, no_confusion_type_decl.get_module_idx(), use_conv_opt); new_env = module::add(new_env, check(new_env, new_d)); return add_protected(new_env, no_confusion_name); }
static environment mk_brec_on(environment const & env, name const & n, bool ind) { if (!is_recursive_datatype(env, n)) return env; if (is_inductive_predicate(env, n)) return env; inductive::inductive_decls decls = *inductive::is_inductive_decl(env, n); type_checker tc(env); name_generator ngen; unsigned nparams = std::get<1>(decls); declaration ind_decl = env.get(n); declaration rec_decl = env.get(inductive::get_elim_name(n)); // declaration below_decl = env.get(name(n, ind ? "ibelow" : "below")); unsigned nindices = *inductive::get_num_indices(env, n); unsigned nminors = *inductive::get_num_minor_premises(env, n); unsigned ntypeformers = length(std::get<2>(decls)); level_param_names lps = rec_decl.get_univ_params(); bool is_reflexive = is_reflexive_datatype(tc, n); level lvl = mk_param_univ(head(lps)); levels lvls = param_names_to_levels(tail(lps)); level rlvl; level_param_names blps; levels blvls; // universe level parameters of brec_on/binduction_on // The arguments of brec_on (binduction_on) are the ones in the recursor - minor premises. // The universe we map to is also different (l+1 for below of reflexive types) and (0 fo ibelow). expr ref_type; if (ind) { // we are eliminating to Prop blps = tail(lps); blvls = lvls; rlvl = mk_level_zero(); ref_type = instantiate_univ_param(rec_decl.get_type(), param_id(lvl), mk_level_zero()); } else if (is_reflexive) { blps = lps; blvls = cons(lvl, lvls); rlvl = get_datatype_level(ind_decl.get_type()); // if rlvl is of the form (max 1 l), then rlvl <- l if (is_max(rlvl) && is_one(max_lhs(rlvl))) rlvl = max_rhs(rlvl); rlvl = mk_max(mk_succ(lvl), rlvl); // inner_prod, inner_prod_intro, pr1, pr2 do not use the same universe levels for // reflective datatypes. ref_type = instantiate_univ_param(rec_decl.get_type(), param_id(lvl), mk_succ(lvl)); } else { // we can simplify the universe levels for non-reflexive datatypes blps = lps; blvls = cons(lvl, lvls); rlvl = mk_max(mk_level_one(), lvl); ref_type = rec_decl.get_type(); } buffer<expr> ref_args; to_telescope(ngen, ref_type, ref_args); if (ref_args.size() != nparams + ntypeformers + nminors + nindices + 1) throw_corrupted(n); // args contains the brec_on/binduction_on arguments buffer<expr> args; buffer<name> typeformer_names; // add parameters and typeformers for (unsigned i = 0; i < nparams; i++) args.push_back(ref_args[i]); for (unsigned i = nparams; i < nparams + ntypeformers; i++) { args.push_back(ref_args[i]); typeformer_names.push_back(mlocal_name(ref_args[i])); } // add indices and major premise for (unsigned i = nparams + ntypeformers + nminors; i < ref_args.size(); i++) args.push_back(ref_args[i]); // create below terms (one per datatype) // (below.{lvls} params type-formers) // Remark: it also creates the result type buffer<expr> belows; expr result_type; unsigned k = 0; for (auto const & decl : std::get<2>(decls)) { name const & n1 = inductive::inductive_decl_name(decl); if (n1 == n) { result_type = ref_args[nparams + k]; for (unsigned i = nparams + ntypeformers + nminors; i < ref_args.size(); i++) result_type = mk_app(result_type, ref_args[i]); } k++; name bname = name(n1, ind ? "ibelow" : "below"); expr below = mk_constant(bname, blvls); for (unsigned i = 0; i < nparams; i++) below = mk_app(below, ref_args[i]); for (unsigned i = nparams; i < nparams + ntypeformers; i++) below = mk_app(below, ref_args[i]); belows.push_back(below); } // create functionals (one for each type former) // Pi idxs t, below idxs t -> C idxs t buffer<expr> Fs; name F_name("F"); for (unsigned i = nparams, j = 0; i < nparams + ntypeformers; i++, j++) { expr const & C = ref_args[i]; buffer<expr> F_args; to_telescope(ngen, mlocal_type(C), F_args); expr F_result = mk_app(C, F_args); expr F_below = mk_app(belows[j], F_args); F_args.push_back(mk_local(ngen.next(), "f", F_below, binder_info())); expr F_type = Pi(F_args, F_result); expr F = mk_local(ngen.next(), F_name.append_after(j+1), F_type, binder_info()); Fs.push_back(F); args.push_back(F); } // We define brec_on/binduction_on using the recursor for this type levels rec_lvls = cons(rlvl, lvls); expr rec = mk_constant(rec_decl.get_name(), rec_lvls); // add parameters to rec for (unsigned i = 0; i < nparams; i++) rec = mk_app(rec, ref_args[i]); // add type formers to rec // Pi indices t, prod (C ... t) (below ... t) for (unsigned i = nparams, j = 0; i < nparams + ntypeformers; i++, j++) { expr const & C = ref_args[i]; buffer<expr> C_args; to_telescope(ngen, mlocal_type(C), C_args); expr C_t = mk_app(C, C_args); expr below_t = mk_app(belows[j], C_args); expr prod = mk_prod(tc, C_t, below_t, ind); rec = mk_app(rec, Fun(C_args, prod)); } // add minor premises to rec for (unsigned i = nparams + ntypeformers, j = 0; i < nparams + ntypeformers + nminors; i++, j++) { expr minor = ref_args[i]; expr minor_type = mlocal_type(minor); buffer<expr> minor_args; minor_type = to_telescope(ngen, minor_type, minor_args); buffer<expr> pairs; for (expr & minor_arg : minor_args) { buffer<expr> minor_arg_args; expr minor_arg_type = to_telescope(tc, mlocal_type(minor_arg), minor_arg_args); if (auto k = is_typeformer_app(typeformer_names, minor_arg_type)) { buffer<expr> C_args; get_app_args(minor_arg_type, C_args); expr new_minor_arg_type = mk_prod(tc, minor_arg_type, mk_app(belows[*k], C_args), ind); minor_arg = update_mlocal(minor_arg, Pi(minor_arg_args, new_minor_arg_type)); if (minor_arg_args.empty()) { pairs.push_back(minor_arg); } else { expr r = mk_app(minor_arg, minor_arg_args); expr r_1 = Fun(minor_arg_args, mk_pr1(tc, r, ind)); expr r_2 = Fun(minor_arg_args, mk_pr2(tc, r, ind)); pairs.push_back(mk_pair(tc, r_1, r_2, ind)); } } } expr b = foldr([&](expr const & a, expr const & b) { return mk_pair(tc, a, b, ind); }, [&]() { return mk_unit_mk(rlvl, ind); }, pairs.size(), pairs.data()); unsigned F_idx = *is_typeformer_app(typeformer_names, minor_type); expr F = Fs[F_idx]; buffer<expr> F_args; get_app_args(minor_type, F_args); F_args.push_back(b); expr new_arg = mk_pair(tc, mk_app(F, F_args), b, ind); rec = mk_app(rec, Fun(minor_args, new_arg)); } // add indices and major to rec for (unsigned i = nparams + ntypeformers + nminors; i < ref_args.size(); i++) rec = mk_app(rec, ref_args[i]); name brec_on_name = name(n, ind ? "binduction_on" : "brec_on"); expr brec_on_type = Pi(args, result_type); expr brec_on_value = Fun(args, mk_pr1(tc, rec, ind)); bool use_conv_opt = true; declaration new_d = mk_definition(env, brec_on_name, blps, brec_on_type, brec_on_value, use_conv_opt); environment new_env = module::add(env, check(env, new_d)); new_env = set_reducible(new_env, brec_on_name, reducible_status::Reducible); if (!ind) new_env = add_unfold_hint(new_env, brec_on_name, nparams + nindices + ntypeformers); return add_protected(new_env, brec_on_name); }
optional<environment> mk_no_confusion_type(environment const & env, name const & n) { optional<inductive::inductive_decls> decls = inductive::is_inductive_decl(env, n); if (!decls) throw exception(sstream() << "error in 'no_confusion' generation, '" << n << "' is not an inductive datatype"); if (is_inductive_predicate(env, n)) return optional<environment>(); // type is a proposition name_generator ngen; unsigned nparams = std::get<1>(*decls); declaration ind_decl = env.get(n); declaration cases_decl = env.get(name(n, "cases_on")); level_param_names lps = cases_decl.get_univ_params(); level rlvl = mk_param_univ(head(lps)); levels ilvls = param_names_to_levels(tail(lps)); if (length(ilvls) != length(ind_decl.get_univ_params())) return optional<environment>(); // type does not have only a restricted eliminator expr ind_type = instantiate_type_univ_params(ind_decl, ilvls); name eq_name("eq"); name heq_name("heq"); // All inductive datatype parameters and indices are arguments buffer<expr> args; ind_type = to_telescope(ngen, ind_type, args, some(mk_implicit_binder_info())); if (!is_sort(ind_type) || args.size() < nparams) throw_corrupted(n); lean_assert(!(env.impredicative() && is_zero(sort_level(ind_type)))); unsigned nindices = args.size() - nparams; // Create inductive datatype expr I = mk_app(mk_constant(n, ilvls), args); // Add (P : Type) expr P = mk_local(ngen.next(), "P", mk_sort(rlvl), binder_info()); args.push_back(P); // add v1 and v2 elements of the inductive type expr v1 = mk_local(ngen.next(), "v1", I, binder_info()); expr v2 = mk_local(ngen.next(), "v2", I, binder_info()); args.push_back(v1); args.push_back(v2); expr R = mk_sort(rlvl); name no_confusion_type_name{n, "no_confusion_type"}; expr no_confusion_type_type = Pi(args, R); // Create type former buffer<expr> type_former_args; for (unsigned i = nparams; i < nparams + nindices; i++) type_former_args.push_back(args[i]); type_former_args.push_back(v1); expr type_former = Fun(type_former_args, R); // Create cases_on levels clvls = levels(mk_succ(rlvl), ilvls); expr cases_on = mk_app(mk_app(mk_constant(cases_decl.get_name(), clvls), nparams, args.data()), type_former); cases_on = mk_app(cases_on, nindices, args.data() + nparams); expr cases_on1 = mk_app(cases_on, v1); expr cases_on2 = mk_app(cases_on, v2); type_checker tc(env); expr t1 = tc.infer(cases_on1).first; expr t2 = tc.infer(cases_on2).first; buffer<expr> outer_cases_on_args; unsigned idx1 = 0; while (is_pi(t1)) { buffer<expr> minor1_args; expr minor1 = to_telescope(tc, binding_domain(t1), minor1_args); expr curr_t2 = t2; buffer<expr> inner_cases_on_args; unsigned idx2 = 0; while (is_pi(curr_t2)) { buffer<expr> minor2_args; expr minor2 = to_telescope(tc, binding_domain(curr_t2), minor2_args); if (idx1 != idx2) { // infeasible case, constructors do not match inner_cases_on_args.push_back(Fun(minor2_args, P)); } else { if (minor1_args.size() != minor2_args.size()) throw_corrupted(n); buffer<expr> rtype_hyp; // add equalities for (unsigned i = 0; i < minor1_args.size(); i++) { expr lhs = minor1_args[i]; expr rhs = minor2_args[i]; expr lhs_type = mlocal_type(lhs); expr rhs_type = mlocal_type(rhs); level l = sort_level(tc.ensure_type(lhs_type).first); expr h_type; if (tc.is_def_eq(lhs_type, rhs_type).first) { h_type = mk_app(mk_constant(eq_name, to_list(l)), lhs_type, lhs, rhs); } else { h_type = mk_app(mk_constant(heq_name, to_list(l)), lhs_type, lhs, rhs_type, rhs); } rtype_hyp.push_back(mk_local(ngen.next(), local_pp_name(lhs).append_after("_eq"), h_type, binder_info())); } inner_cases_on_args.push_back(Fun(minor2_args, mk_arrow(Pi(rtype_hyp, P), P))); } idx2++; curr_t2 = binding_body(curr_t2); } outer_cases_on_args.push_back(Fun(minor1_args, mk_app(cases_on2, inner_cases_on_args))); idx1++; t1 = binding_body(t1); } expr no_confusion_type_value = Fun(args, mk_app(cases_on1, outer_cases_on_args)); bool opaque = false; bool use_conv_opt = true; declaration new_d = mk_definition(env, no_confusion_type_name, lps, no_confusion_type_type, no_confusion_type_value, opaque, ind_decl.get_module_idx(), use_conv_opt); environment new_env = module::add(env, check(env, new_d)); return some(add_protected(new_env, no_confusion_type_name)); }
static environment mk_below(environment const & env, name const & n, bool ibelow) { if (!is_recursive_datatype(env, n)) return env; if (is_inductive_predicate(env, n)) return env; inductive::inductive_decls decls = *inductive::is_inductive_decl(env, n); type_checker tc(env); name_generator ngen; unsigned nparams = std::get<1>(decls); declaration ind_decl = env.get(n); declaration rec_decl = env.get(inductive::get_elim_name(n)); unsigned nindices = *inductive::get_num_indices(env, n); unsigned nminors = *inductive::get_num_minor_premises(env, n); unsigned ntypeformers = length(std::get<2>(decls)); level_param_names lps = rec_decl.get_univ_params(); bool is_reflexive = is_reflexive_datatype(tc, n); level lvl = mk_param_univ(head(lps)); levels lvls = param_names_to_levels(tail(lps)); level_param_names blvls; // universe level parameters of ibelow/below level rlvl; // universe level of the resultant type // The arguments of below (ibelow) are the ones in the recursor - minor premises. // The universe we map to is also different (l+1 for below of reflexive types) and (0 fo ibelow). expr ref_type; expr Type_result; if (ibelow) { // we are eliminating to Prop blvls = tail(lps); rlvl = mk_level_zero(); ref_type = instantiate_univ_param(rec_decl.get_type(), param_id(lvl), mk_level_zero()); } else if (is_reflexive) { blvls = lps; rlvl = get_datatype_level(ind_decl.get_type()); // if rlvl is of the form (max 1 l), then rlvl <- l if (is_max(rlvl) && is_one(max_lhs(rlvl))) rlvl = max_rhs(rlvl); rlvl = mk_max(mk_succ(lvl), rlvl); ref_type = instantiate_univ_param(rec_decl.get_type(), param_id(lvl), mk_succ(lvl)); } else { // we can simplify the universe levels for non-reflexive datatypes blvls = lps; rlvl = mk_max(mk_level_one(), lvl); ref_type = rec_decl.get_type(); } Type_result = mk_sort(rlvl); buffer<expr> ref_args; to_telescope(ngen, ref_type, ref_args); if (ref_args.size() != nparams + ntypeformers + nminors + nindices + 1) throw_corrupted(n); // args contains the below/ibelow arguments buffer<expr> args; buffer<name> typeformer_names; // add parameters and typeformers for (unsigned i = 0; i < nparams; i++) args.push_back(ref_args[i]); for (unsigned i = nparams; i < nparams + ntypeformers; i++) { args.push_back(ref_args[i]); typeformer_names.push_back(mlocal_name(ref_args[i])); } // we ignore minor premises in below/ibelow for (unsigned i = nparams + ntypeformers + nminors; i < ref_args.size(); i++) args.push_back(ref_args[i]); // We define below/ibelow using the recursor for this type levels rec_lvls = cons(mk_succ(rlvl), lvls); expr rec = mk_constant(rec_decl.get_name(), rec_lvls); for (unsigned i = 0; i < nparams; i++) rec = mk_app(rec, args[i]); // add type formers for (unsigned i = nparams; i < nparams + ntypeformers; i++) { buffer<expr> targs; to_telescope(ngen, mlocal_type(args[i]), targs); rec = mk_app(rec, Fun(targs, Type_result)); } // add minor premises for (unsigned i = nparams + ntypeformers; i < nparams + ntypeformers + nminors; i++) { expr minor = ref_args[i]; expr minor_type = mlocal_type(minor); buffer<expr> minor_args; minor_type = to_telescope(ngen, minor_type, minor_args); buffer<expr> prod_pairs; for (expr & minor_arg : minor_args) { buffer<expr> minor_arg_args; expr minor_arg_type = to_telescope(tc, mlocal_type(minor_arg), minor_arg_args); if (is_typeformer_app(typeformer_names, minor_arg_type)) { expr fst = mlocal_type(minor_arg); minor_arg = update_mlocal(minor_arg, Pi(minor_arg_args, Type_result)); expr snd = Pi(minor_arg_args, mk_app(minor_arg, minor_arg_args)); prod_pairs.push_back(mk_prod(tc, fst, snd, ibelow)); } } expr new_arg = foldr([&](expr const & a, expr const & b) { return mk_prod(tc, a, b, ibelow); }, [&]() { return mk_unit(rlvl, ibelow); }, prod_pairs.size(), prod_pairs.data()); rec = mk_app(rec, Fun(minor_args, new_arg)); } // add indices and major premise for (unsigned i = nparams + ntypeformers; i < args.size(); i++) { rec = mk_app(rec, args[i]); } name below_name = ibelow ? name{n, "ibelow"} : name{n, "below"}; expr below_type = Pi(args, Type_result); expr below_value = Fun(args, rec); bool use_conv_opt = true; declaration new_d = mk_definition(env, below_name, blvls, below_type, below_value, use_conv_opt); environment new_env = module::add(env, check(env, new_d)); new_env = set_reducible(new_env, below_name, reducible_status::Reducible); if (!ibelow) new_env = add_unfold_hint(new_env, below_name, nparams + nindices + ntypeformers); return add_protected(new_env, below_name); }
expr replace_visitor::visit_mlocal(expr const & e) { lean_assert(is_mlocal(e)); return update_mlocal(e, visit(mlocal_type(e))); }
bool light_lt_manager::is_lt(expr const & a, expr const & b) { if (is_eqp(a, b)) return false; unsigned wa = get_weight(a); unsigned wb = get_weight(b); if (wa < wb) return true; if (wa > wb) return false; if (is_constant(get_app_fn(a))) { unsigned const * light_arg = m_lrs.find(const_name(get_app_fn(a))); if (light_arg) { buffer<expr> args; get_app_args(a, args); if (args.size() > *light_arg) return is_lt(args[*light_arg], b); } } if (is_constant(get_app_fn(b))) { unsigned const * light_arg = m_lrs.find(const_name(get_app_fn(b))); if (light_arg) { buffer<expr> args; get_app_args(b, args); if (args.size() > *light_arg) return !is_lt(args[*light_arg], a); } } if (a.kind() != b.kind()) return a.kind() < b.kind(); if (a == b) return false; switch (a.kind()) { case expr_kind::Var: return var_idx(a) < var_idx(b); case expr_kind::Constant: if (const_name(a) != const_name(b)) return const_name(a) < const_name(b); else return ::lean::is_lt(const_levels(a), const_levels(b), false); case expr_kind::App: if (app_fn(a) != app_fn(b)) return is_lt(app_fn(a), app_fn(b)); else return is_lt(app_arg(a), app_arg(b)); case expr_kind::Lambda: case expr_kind::Pi: if (binding_domain(a) != binding_domain(b)) return is_lt(binding_domain(a), binding_domain(b)); else return is_lt(binding_body(a), binding_body(b)); case expr_kind::Sort: return ::lean::is_lt(sort_level(a), sort_level(b), false); case expr_kind::Local: case expr_kind::Meta: if (mlocal_name(a) != mlocal_name(b)) return mlocal_name(a) < mlocal_name(b); else return is_lt(mlocal_type(a), mlocal_type(b)); case expr_kind::Macro: if (macro_def(a) != macro_def(b)) return macro_def(a) < macro_def(b); if (macro_num_args(a) != macro_num_args(b)) return macro_num_args(a) < macro_num_args(b); for (unsigned i = 0; i < macro_num_args(a); i++) { if (macro_arg(a, i) != macro_arg(b, i)) return is_lt(macro_arg(a, i), macro_arg(b, i)); } return false; } lean_unreachable(); // LCOV_EXCL_LINE }
void compute_index_types() { for (expr const & ind : m_mut_decl.get_inds()) { m_index_types.push_back(to_sigma_type(mlocal_type(ind))); lean_trace(name({"inductive_compiler", "mutual", "index_types"}), tout() << mlocal_name(ind) << " ==> " << m_index_types.back() << "\n";); }