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 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 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 collect(expr const & e) { return replace(e, [&](expr const & e, unsigned) { if (is_metavar(e)) { name const & id = mlocal_name(e); if (auto r = m_meta_to_param.find(id)) { return some_expr(*r); } else { expr type = m_ctx.infer(e); expr x = m_ctx.push_local("_x", type); m_meta_to_param.insert(id, x); m_meta_to_param_inv.insert(mlocal_name(x), e); m_params.push_back(x); return some_expr(x); } } else if (is_local(e)) { name const & id = mlocal_name(e); if (!m_found_local.contains(id)) { m_found_local.insert(id); m_params.push_back(e); } } else if (is_sort(e)) { return some_expr(update_sort(e, collect(sort_level(e)))); } else if (is_constant(e)) { return some_expr(update_constant(e, collect(const_levels(e)))); } return none_expr(); }); }
bool has_placeholder(expr const & e) { return (bool) find(e, [](expr const & e, unsigned) { // NOLINT if (is_placeholder(e)) return true; else if (is_sort(e)) return has_placeholder(sort_level(e)); else if (is_constant(e)) return std::any_of(const_levels(e).begin(), const_levels(e).end(), [](level const & l) { return has_placeholder(l); }); else return false; }); }
bool has_idx_metavar(expr const & e) { if (!has_univ_metavar(e) && !has_expr_metavar(e)) return false; bool found = false; for_each(e, [&](expr const & e, unsigned) { if (found) return false; if (!has_univ_metavar(e) && !has_expr_metavar(e)) return false; if (is_idx_metavar(e)) found = true; else if (is_constant(e) && std::any_of(const_levels(e).begin(), const_levels(e).end(), has_idx_metauniv)) found = true; else if (is_sort(e) && has_idx_metauniv(sort_level(e))) found = true; return true; }); return found; }
name_set collect_univ_params(expr const & e, name_set const & ls) { if (!has_param_univ(e)) { return ls; } else { name_set r = ls; for_each(e, [&](expr const & e, unsigned) { if (!has_param_univ(e)) { return false; } else if (is_sort(e)) { collect_univ_params_core(sort_level(e), r); } else if (is_constant(e)) { for (auto const & l : const_levels(e)) collect_univ_params_core(l, r); } return true; }); return r; } }
expr update_sort(expr const & e, level const & new_level) { if (!is_eqp(sort_level(e), new_level)) return mk_sort(new_level, e.get_tag()); else return e; }
optional<expr> mk_hset_instance(type_checker & tc, io_state const & ios, list<expr> const & ctx, expr const & type) { expr trunc_index = mk_app(mk_constant(get_is_trunc_trunc_index_of_nat_name()), mk_constant(get_nat_zero_name())); level lvl = sort_level(tc.ensure_type(type).first); expr is_hset = mk_app(mk_constant(get_is_trunc_name(), {lvl}), trunc_index, type); return mk_class_instance(tc.env(), ios, ctx, tc.mk_fresh_name(), is_hset); }
static bool is_prop(expr type) { while (is_pi(type)) { type = binding_body(type); } return is_sort(type) && is_zero(sort_level(type)); }
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)); }
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); }
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); }
virtual expr visit_sort(expr const & s) { return update_sort(s, visit_level(sort_level(s))); }
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 }
environment mk_projections(environment const & env, name const & n, buffer<name> const & proj_names, implicit_infer_kind infer_k, bool inst_implicit) { // Given an inductive datatype C A (where A represent parameters) // intro : Pi A (x_1 : B_1[A]) (x_2 : B_2[A, x_1]) ..., C A // // we generate projections of the form // proj_i A (c : C A) : B_i[A, (proj_1 A n), ..., (proj_{i-1} A n)] // C.rec A (fun (x : C A), B_i[A, ...]) (fun (x_1 ... x_n), x_i) c auto p = get_nparam_intro_rule(env, n); name_generator ngen; unsigned nparams = p.first; inductive::intro_rule intro = p.second; expr intro_type = inductive::intro_rule_type(intro); name rec_name = inductive::get_elim_name(n); declaration ind_decl = env.get(n); if (env.impredicative() && is_prop(ind_decl.get_type())) throw exception(sstream() << "projection generation, '" << n << "' is a proposition"); declaration rec_decl = env.get(rec_name); level_param_names lvl_params = ind_decl.get_univ_params(); levels lvls = param_names_to_levels(lvl_params); buffer<expr> params; // datatype parameters for (unsigned i = 0; i < nparams; i++) { if (!is_pi(intro_type)) throw_ill_formed(n); expr param = mk_local(ngen.next(), binding_name(intro_type), binding_domain(intro_type), binder_info()); intro_type = instantiate(binding_body(intro_type), param); params.push_back(param); } expr C_A = mk_app(mk_constant(n, lvls), params); binder_info c_bi = inst_implicit ? mk_inst_implicit_binder_info() : binder_info(); expr c = mk_local(ngen.next(), name("c"), C_A, c_bi); buffer<expr> intro_type_args; // arguments that are not parameters expr it = intro_type; while (is_pi(it)) { expr local = mk_local(ngen.next(), binding_name(it), binding_domain(it), binding_info(it)); intro_type_args.push_back(local); it = instantiate(binding_body(it), local); } buffer<expr> projs; // projections generated so far unsigned i = 0; environment new_env = env; for (name const & proj_name : proj_names) { if (!is_pi(intro_type)) throw exception(sstream() << "generating projection '" << proj_name << "', '" << n << "' does not have sufficient data"); expr result_type = binding_domain(intro_type); buffer<expr> proj_args; proj_args.append(params); proj_args.push_back(c); expr type_former = Fun(c, result_type); expr minor_premise = Fun(intro_type_args, mk_var(intro_type_args.size() - i - 1)); expr major_premise = c; type_checker tc(new_env); level l = sort_level(tc.ensure_sort(tc.infer(result_type).first).first); levels rec_lvls = append(to_list(l), lvls); expr rec = mk_constant(rec_name, rec_lvls); buffer<expr> rec_args; rec_args.append(params); rec_args.push_back(type_former); rec_args.push_back(minor_premise); rec_args.push_back(major_premise); expr rec_app = mk_app(rec, rec_args); expr proj_type = Pi(proj_args, result_type); proj_type = infer_implicit_params(proj_type, nparams, infer_k); expr proj_val = Fun(proj_args, rec_app); bool opaque = false; bool use_conv_opt = false; declaration new_d = mk_definition(env, proj_name, lvl_params, proj_type, proj_val, opaque, rec_decl.get_module_idx(), use_conv_opt); new_env = module::add(new_env, check(new_env, new_d)); new_env = set_reducible(new_env, proj_name, reducible_status::Reducible); new_env = add_unfold_c_hint(new_env, proj_name, nparams); new_env = save_projection_info(new_env, proj_name, inductive::intro_rule_name(intro), nparams, i, inst_implicit); expr proj = mk_app(mk_app(mk_constant(proj_name, lvls), params), c); intro_type = instantiate(binding_body(intro_type), proj); i++; } return new_env; }