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