bool match_pattern(type_checker & tc, expr const & pattern, declaration const & d, unsigned max_steps, bool cheap) {
name_generator ngen = tc.mk_ngen();
buffer<level> ls;
unsigned num_ls = d.get_num_univ_params();
for (unsigned i = 0; i < num_ls; i++)
ls.push_back(mk_meta_univ(ngen.next()));
expr dt = instantiate_type_univ_params(d, to_list(ls.begin(), ls.end()));
unsigned num_e = get_expect_num_args(tc, pattern);
unsigned num_d = get_expect_num_args(tc, dt);
if (num_e > num_d)
return false;
for (unsigned i = 0; i < num_d - num_e; i++) {
dt = tc.whnf(dt).first;
expr local = mk_local(ngen.next(), binding_domain(dt));
dt = instantiate(binding_body(dt), local);
}
try {
unifier_config cfg;
cfg.m_max_steps = max_steps;
cfg.m_kind = cheap ? unifier_kind::Cheap : unifier_kind::Liberal;
cfg.m_ignore_context_check = true;
auto r = unify(tc.env(), pattern, dt, tc.mk_ngen(), substitution(), cfg);
return static_cast<bool>(r.pull());
} catch (exception&) {
return false;
}
}
list<expr> get_coercions_from_to(type_checker & from_tc, type_checker & to_tc,
expr const & from_type, expr const & to_type, constraint_seq & cs, bool lift_coe) {
constraint_seq new_cs;
environment const & env = to_tc.env();
expr whnf_from_type = from_tc.whnf(from_type, new_cs);
expr whnf_to_type = to_tc.whnf(to_type, new_cs);
if (lift_coe && is_pi(whnf_from_type)) {
// Try to lift coercions.
// The idea is to convert a coercion from A to B, into a coercion from D->A to D->B
if (!is_pi(whnf_to_type))
return list<expr>(); // failed
if (!from_tc.is_def_eq(binding_domain(whnf_from_type), binding_domain(whnf_to_type), justification(), new_cs))
return list<expr>(); // failed, the domains must be definitionally equal
expr x = mk_local(mk_fresh_name(), "x", binding_domain(whnf_from_type), binder_info());
expr A = instantiate(binding_body(whnf_from_type), x);
expr B = instantiate(binding_body(whnf_to_type), x);
list<expr> coe = get_coercions_from_to(from_tc, to_tc, A, B, new_cs, lift_coe);
if (coe) {
cs += new_cs;
// Remark: each coercion c in coe is a function from A to B
// We create a new list: (fun (f : D -> A) (x : D), c (f x))
expr f = mk_local(mk_fresh_name(), "f", whnf_from_type, binder_info());
expr fx = mk_app(f, x);
return map(coe, [&](expr const & c) { return Fun(f, Fun(x, mk_app(c, fx))); });
} else {
return list<expr>();
}
} else {
expr const & fn = get_app_fn(whnf_to_type);
list<expr> r;
if (is_constant(fn)) {
r = get_coercions(env, whnf_from_type, const_name(fn));
} else if (is_pi(whnf_to_type)) {
r = get_coercions_to_fun(env, whnf_from_type);
} else if (is_sort(whnf_to_type)) {
r = get_coercions_to_sort(env, whnf_from_type);
}
if (r)
cs += new_cs;
return r;
}
}
lean_unreachable();
} catch (kernel_exception & ex) {
std::cout << "expected error: " << ex.pp(mk_formatter(ex.get_environment())) << "\n";
}
expr Type = mk_Type();
expr A = Local("A", Type);
expr x = Local("x", A);
auto env3 = add_decl(env2, mk_definition("id", level_param_names(),
Pi(A, A >> A),
Fun({A, x}, x)));
expr Prop = mk_Prop();
expr c = mk_local("c", Prop);
expr id = Const("id");
type_checker checker(env3, name_generator("tmp"));
lean_assert(checker.check(mk_app(id, Prop)).first == Prop >> Prop);
lean_assert(checker.whnf(mk_app(id, Prop, c)).first == c);
lean_assert(checker.whnf(mk_app(id, Prop, mk_app(id, Prop, mk_app(id, Prop, c)))).first == c);
type_checker checker2(env2, name_generator("tmp"));
lean_assert(checker2.whnf(mk_app(id, Prop, mk_app(id, Prop, mk_app(id, Prop, c)))).first == mk_app(id, Prop, mk_app(id, Prop, mk_app(id, Prop, c))));
}
static void tst2() {
environment env;
name base("base");
expr Prop = mk_Prop();
env = add_decl(env, mk_constant_assumption(name(base, 0u), level_param_names(), Prop >> (Prop >> Prop)));
expr x = Local("x", Prop);
expr y = Local("y", Prop);
for (unsigned i = 1; i <= 100; i++) {
expr prev = Const(name(base, i-1));
try {
auto env7 = add_decl(env2, mk_definition("foo", level_param_names(), mk_Type() >> mk_Type(), mk_Prop()));
lean_unreachable();
} catch (kernel_exception & ex) {
std::cout << "expected error: " << ex.pp(mk_formatter(ex.get_environment())) << "\n";
}
expr A = Local("A", Type);
expr x = Local("x", A);
auto env3 = add_decl(env2, mk_definition("id", level_param_names(),
Pi(A, A >> A),
Fun({A, x}, x)));
expr c = mk_local("c", Prop);
expr id = Const("id");
type_checker checker(env3, name_generator("tmp"));
lean_assert(checker.check(id(Prop)) == Prop >> Prop);
lean_assert(checker.whnf(id(Prop, c)) == c);
lean_assert(checker.whnf(id(Prop, id(Prop, id(Prop, c)))) == c);
type_checker checker2(env2, name_generator("tmp"));
lean_assert(checker2.whnf(id(Prop, id(Prop, id(Prop, c)))) == id(Prop, id(Prop, id(Prop, c))));
}
static void tst2() {
environment env;
name base("base");
env = add_decl(env, mk_var_decl(name(base, 0u), level_param_names(), Prop >> (Prop >> Prop)));
expr x = Local("x", Prop);
expr y = Local("y", Prop);
for (unsigned i = 1; i <= 100; i++) {
expr prev = Const(name(base, i-1));
env = add_decl(env, mk_definition(env, name(base, i), level_param_names(), Prop >> (Prop >> Prop),
/** \brief Given a term <tt>a : a_type</tt>, and a metavariable \c m, creates a constraint
that considers coercions from a_type to the type assigned to \c m. */
constraint mk_coercion_cnstr(type_checker & from_tc, type_checker & to_tc, coercion_info_manager & infom,
expr const & m, expr const & a, expr const & a_type,
justification const & j, unsigned delay_factor, bool lift_coe) {
auto choice_fn = [=, &from_tc, &to_tc, &infom](expr const & meta, expr const & d_type, substitution const & s) {
expr new_a_type;
justification new_a_type_jst;
if (is_meta(a_type)) {
auto p = substitution(s).instantiate_metavars(a_type);
new_a_type = p.first;
new_a_type_jst = p.second;
} else {
new_a_type = a_type;
}
if (is_meta(new_a_type)) {
if (delay_factor < to_delay_factor(cnstr_group::DelayedChoice)) {
// postpone...
return lazy_list<constraints>(constraints(mk_coercion_cnstr(from_tc, to_tc, infom, m, a, a_type, justification(),
delay_factor+1, lift_coe)));
} else {
// giveup...
return lazy_list<constraints>(constraints(mk_eq_cnstr(meta, a, justification())));
}
}
constraint_seq cs;
new_a_type = from_tc.whnf(new_a_type, cs);
if ((lift_coe && is_pi_meta(d_type)) || (!lift_coe && is_meta(d_type))) {
// case-split
buffer<expr> locals;
expr it_from = new_a_type;
expr it_to = d_type;
while (is_pi(it_from) && is_pi(it_to)) {
expr dom_from = binding_domain(it_from);
expr dom_to = binding_domain(it_to);
if (!from_tc.is_def_eq(dom_from, dom_to, justification(), cs))
return lazy_list<constraints>();
expr local = mk_local(mk_fresh_name(), binding_name(it_from), dom_from, binder_info());
locals.push_back(local);
it_from = instantiate(binding_body(it_from), local);
it_to = instantiate(binding_body(it_to), local);
}
buffer<expr> alts;
get_coercions_from(from_tc.env(), it_from, alts);
expr fn_a;
if (!locals.empty())
fn_a = mk_local(mk_fresh_name(), "f", new_a_type, binder_info());
buffer<constraints> choices;
buffer<expr> coes;
// first alternative: no coercion
constraint_seq cs1 = cs + mk_eq_cnstr(meta, a, justification());
choices.push_back(cs1.to_list());
unsigned i = alts.size();
while (i > 0) {
--i;
expr coe = alts[i];
if (!locals.empty())
coe = Fun(fn_a, Fun(locals, mk_app(coe, mk_app(fn_a, locals))));
expr new_a = copy_tag(a, mk_app(coe, a));
coes.push_back(coe);
constraint_seq csi = cs + mk_eq_cnstr(meta, new_a, new_a_type_jst);
choices.push_back(csi.to_list());
}
return choose(std::make_shared<coercion_elaborator>(infom, meta,
to_list(choices.begin(), choices.end()),
to_list(coes.begin(), coes.end())));
} else {
list<expr> coes = get_coercions_from_to(from_tc, to_tc, new_a_type, d_type, cs, lift_coe);
if (is_nil(coes)) {
expr new_a = a;
infom.erase_coercion_info(a);
cs += mk_eq_cnstr(meta, new_a, new_a_type_jst);
return lazy_list<constraints>(cs.to_list());
} else if (is_nil(tail(coes))) {
expr new_a = copy_tag(a, mk_app(head(coes), a));
infom.save_coercion_info(a, new_a);
cs += mk_eq_cnstr(meta, new_a, new_a_type_jst);
return lazy_list<constraints>(cs.to_list());
} else {
list<constraints> choices = map2<constraints>(coes, [&](expr const & coe) {
expr new_a = copy_tag(a, mk_app(coe, a));
constraint c = mk_eq_cnstr(meta, new_a, new_a_type_jst);
return (cs + c).to_list();
});
return choose(std::make_shared<coercion_elaborator>(infom, meta, choices, coes, false));
}
}
};
return mk_choice_cnstr(m, choice_fn, delay_factor, true, j);
}
