fix(frontends/lean/elaborator): more robust support for coercions to
function-class that contains implicit arguments
This commit is contained in:
parent
d0d23eb525
commit
dffe9a6f17
2 changed files with 42 additions and 12 deletions
|
@ -336,6 +336,35 @@ public:
|
||||||
return mc.first;
|
return mc.first;
|
||||||
}
|
}
|
||||||
|
|
||||||
|
static bool is_implicit_pi(expr const & e) {
|
||||||
|
if (!is_pi(e))
|
||||||
|
return false;
|
||||||
|
binder_info bi = binding_info(e);
|
||||||
|
return bi.is_strict_implicit() || bi.is_implicit();
|
||||||
|
}
|
||||||
|
|
||||||
|
expr add_implict_args(expr e, constraint_seq & cs, bool relax) {
|
||||||
|
type_checker & tc = *m_tc[relax];
|
||||||
|
constraint_seq new_cs;
|
||||||
|
expr type = tc.whnf(tc.infer(e, new_cs), new_cs);
|
||||||
|
if (!is_implicit_pi(type))
|
||||||
|
return e;
|
||||||
|
cs += new_cs;
|
||||||
|
while (true) {
|
||||||
|
lean_assert(is_pi(type));
|
||||||
|
tag g = e.get_tag();
|
||||||
|
bool is_strict = false;
|
||||||
|
expr imp_arg = mk_placeholder_meta(some_expr(binding_domain(type)), g, is_strict, cs);
|
||||||
|
e = mk_app(e, imp_arg, g);
|
||||||
|
type = instantiate(binding_body(type), imp_arg);
|
||||||
|
constraint_seq new_cs;
|
||||||
|
type = tc.whnf(type, new_cs);
|
||||||
|
if (!is_implicit_pi(type))
|
||||||
|
return e;
|
||||||
|
cs += new_cs;
|
||||||
|
}
|
||||||
|
}
|
||||||
|
|
||||||
/** \brief Make sure \c f is really a function, if it is not, try to apply coercions.
|
/** \brief Make sure \c f is really a function, if it is not, try to apply coercions.
|
||||||
The result is a pair <tt>new_f, f_type</tt>, where new_f is the new value for \c f,
|
The result is a pair <tt>new_f, f_type</tt>, where new_f is the new value for \c f,
|
||||||
and \c f_type is its type (and a Pi-expression)
|
and \c f_type is its type (and a Pi-expression)
|
||||||
|
@ -362,7 +391,9 @@ public:
|
||||||
throw_kernel_exception(env(), f, [=](formatter const & fmt) { return pp_function_expected(fmt, f); });
|
throw_kernel_exception(env(), f, [=](formatter const & fmt) { return pp_function_expected(fmt, f); });
|
||||||
} else if (is_nil(tail(coes))) {
|
} else if (is_nil(tail(coes))) {
|
||||||
expr old_f = f;
|
expr old_f = f;
|
||||||
|
bool relax = m_relax_main_opaque;
|
||||||
f = mk_app(head(coes), f, f.get_tag());
|
f = mk_app(head(coes), f, f.get_tag());
|
||||||
|
f = add_implict_args(f, cs, relax);
|
||||||
f_type = infer_type(f, cs);
|
f_type = infer_type(f, cs);
|
||||||
save_coercion_info(old_f, f);
|
save_coercion_info(old_f, f);
|
||||||
lean_assert(is_pi(f_type));
|
lean_assert(is_pi(f_type));
|
||||||
|
@ -375,18 +406,7 @@ public:
|
||||||
list<constraints> choices = map2<constraints>(coes, [&](expr const & coe) {
|
list<constraints> choices = map2<constraints>(coes, [&](expr const & coe) {
|
||||||
expr new_f = copy_tag(f, ::lean::mk_app(coe, f));
|
expr new_f = copy_tag(f, ::lean::mk_app(coe, f));
|
||||||
constraint_seq cs;
|
constraint_seq cs;
|
||||||
while (true) {
|
new_f = add_implict_args(new_f, cs, relax);
|
||||||
expr new_f_type = m_tc[relax]->infer(new_f, cs);
|
|
||||||
if (!is_pi(new_f_type))
|
|
||||||
break;
|
|
||||||
binder_info bi = binding_info(new_f_type);
|
|
||||||
if (!bi.is_strict_implicit() && !bi.is_implicit())
|
|
||||||
break;
|
|
||||||
tag g = f.get_tag();
|
|
||||||
bool is_strict = false;
|
|
||||||
expr imp_arg = mk_placeholder_meta(some_expr(binding_domain(new_f_type)), g, is_strict, cs);
|
|
||||||
new_f = mk_app(new_f, imp_arg, g);
|
|
||||||
}
|
|
||||||
cs += mk_eq_cnstr(meta, new_f, j, relax);
|
cs += mk_eq_cnstr(meta, new_f, j, relax);
|
||||||
return cs.to_list();
|
return cs.to_list();
|
||||||
});
|
});
|
||||||
|
|
10
tests/lean/run/coe12.lean
Normal file
10
tests/lean/run/coe12.lean
Normal file
|
@ -0,0 +1,10 @@
|
||||||
|
import data.nat
|
||||||
|
inductive foo (A B : Type) : Type :=
|
||||||
|
mk : (Π {C : Type}, A → C → B) → foo A B
|
||||||
|
|
||||||
|
definition to_fun [coercion] {A B : Type} (f : foo A B) : Π {C : Type}, A → C → B :=
|
||||||
|
foo.rec (λf, f) f
|
||||||
|
|
||||||
|
variable f : foo nat nat
|
||||||
|
variable a : nat
|
||||||
|
check f a true
|
Loading…
Reference in a new issue