fix(frontends/lean/inductive_cmd): generate error for inductive datatype declarations that will produce an eliminator that can only eliminate to Prop
This commit is contained in:
parent
e7a7458922
commit
488f989c46
2 changed files with 29 additions and 3 deletions
|
@ -377,6 +377,24 @@ struct inductive_cmd_fn {
|
||||||
}
|
}
|
||||||
}
|
}
|
||||||
|
|
||||||
|
/** \brief Conservative test for checking whether a datatype that may be Prop for some universe parameter instantiations
|
||||||
|
will be able to eliminate to any Type.
|
||||||
|
|
||||||
|
TODO(Leo): implement a more complete version
|
||||||
|
*/
|
||||||
|
bool is_prop_as_type(buffer<inductive_decl> const & decls) {
|
||||||
|
if (decls.size() != 1)
|
||||||
|
return false;
|
||||||
|
inductive_decl const & decl = decls[0];
|
||||||
|
unsigned nintro = length(inductive_decl_intros(decl));
|
||||||
|
if (nintro == 0)
|
||||||
|
return true;
|
||||||
|
if (nintro > 1)
|
||||||
|
return false;
|
||||||
|
expr intro_type = intro_rule_type(head(inductive_decl_intros(decl)));
|
||||||
|
return !is_pi(m_tc->whnf(intro_type).first);
|
||||||
|
}
|
||||||
|
|
||||||
/** \brief Convert inductive datatype declarations into local constants, and store them into \c r and \c map.
|
/** \brief Convert inductive datatype declarations into local constants, and store them into \c r and \c map.
|
||||||
\c map is a mapping from inductive datatype name into local constant. */
|
\c map is a mapping from inductive datatype name into local constant. */
|
||||||
void inductive_types_to_locals(buffer<inductive_decl> const & decls, buffer<expr> & r, name_map<expr> & map) {
|
void inductive_types_to_locals(buffer<inductive_decl> const & decls, buffer<expr> & r, name_map<expr> & map) {
|
||||||
|
@ -394,6 +412,14 @@ struct inductive_cmd_fn {
|
||||||
throw_error("resultant universe must be provided, when using explicit universe levels");
|
throw_error("resultant universe must be provided, when using explicit universe levels");
|
||||||
type = update_result_sort(type, m_u);
|
type = update_result_sort(type, m_u);
|
||||||
m_infer_result_universe = true;
|
m_infer_result_universe = true;
|
||||||
|
} else if (m_env.impredicative() && !is_zero(l) && !is_not_zero(l)) {
|
||||||
|
// If the resultant universe can be Prop for some parameter instantiations, then
|
||||||
|
// the kernel will produce an eliminator that only eliminates to Prop.
|
||||||
|
// There is on exception the singleton case. We perform a concervative check here,
|
||||||
|
// we generate the error only if decls is not the singleton case
|
||||||
|
if (!is_prop_as_type(decls))
|
||||||
|
throw_error("invalid universe polymorphic inductive declaration, the resultant universe is not Prop (i.e., 0), but it may "
|
||||||
|
"be Prop for some parameter values (solution: use 'l+1' or 'max 1 l')");
|
||||||
}
|
}
|
||||||
expr local = mk_local(m_p.mk_fresh_name(), n, type, binder_info(), type.get_tag());
|
expr local = mk_local(m_p.mk_fresh_name(), n, type, binder_info(), type.get_tag());
|
||||||
r.push_back(local);
|
r.push_back(local);
|
||||||
|
|
|
@ -6,14 +6,14 @@ unit : one
|
||||||
inductive pone : Type.{0} :=
|
inductive pone : Type.{0} :=
|
||||||
unit : pone
|
unit : pone
|
||||||
|
|
||||||
inductive two.{l} : Type.{l} :=
|
inductive two.{l} : Type.{max 1 l} :=
|
||||||
o : two,
|
o : two,
|
||||||
u : two
|
u : two
|
||||||
|
|
||||||
inductive wrap.{l} : Type.{l} :=
|
inductive wrap.{l} : Type.{max 1 l} :=
|
||||||
mk : true → wrap
|
mk : true → wrap
|
||||||
|
|
||||||
inductive wrap2.{l} (A : Type.{l}) : Type.{l} :=
|
inductive wrap2.{l} (A : Type.{l}) : Type.{max 1 l} :=
|
||||||
mk : A → wrap2 A
|
mk : A → wrap2 A
|
||||||
|
|
||||||
set_option pp.universes true
|
set_option pp.universes true
|
||||||
|
|
Loading…
Reference in a new issue