diff --git a/src/frontends/lean/inductive_cmd.cpp b/src/frontends/lean/inductive_cmd.cpp index e0ac89719..e12b4b4d0 100644 --- a/src/frontends/lean/inductive_cmd.cpp +++ b/src/frontends/lean/inductive_cmd.cpp @@ -447,21 +447,47 @@ struct inductive_cmd_fn { } } + /* \brief Add \c lvl to \c r_lvls (if it is not already there. + + \pre lvl does not contain m_u. + */ + void accumulate_level(level const & lvl, buffer & r_lvls) { + if (occurs(m_u, lvl)) { + throw exception("failed to infer inductive datatype resultant universe, " + "provide the universe levels explicitly"); + } else if (std::find(r_lvls.begin(), r_lvls.end(), lvl) == r_lvls.end()) { + r_lvls.push_back(lvl); + } + } + + /** \bried Accumulate the universe levels occurring in an introduction rule argument universe. + In general, the argument of an introduction rule has type + Pi (a_1 : A_1) (a_2 : A_1[a_1]) ..., B[a_1, a_2, ...] + The universe associated with it will be + imax(l_1, imax(l_2, ..., r)) + where l_1 is the unvierse of A_1, l_2 of A_2, and r of B[a_1, ..., a_n]. + The result placeholder m_u must only appear as r. + */ + void accumulate_levels(level const & lvl, buffer & r_lvls) { + if (lvl == m_u) { + // ignore this is the auxiliary lvl + } else if (is_imax(lvl)) { + level lhs = imax_lhs(lvl); + level rhs = imax_rhs(lvl); + accumulate_level(lhs, r_lvls); + accumulate_levels(rhs, r_lvls); + } else { + accumulate_level(lvl, r_lvls); + } + } + /** \brief Traverse the introduction rule type and collect the universes where arguments reside in \c r_lvls. This information is used to compute the resultant universe level for the inductive datatype declaration. */ void accumulate_levels(expr intro_type, buffer & r_lvls) { while (is_pi(intro_type)) { expr s = m_tc->ensure_type(binding_domain(intro_type)).first; - level l = sort_level(s); - if (l == m_u) { - // ignore, this is the auxiliary level - } else if (occurs(m_u, l)) { - throw exception("failed to infer inductive datatype resultant universe, " - "provide the universe levels explicitly"); - } else if (std::find(r_lvls.begin(), r_lvls.end(), l) == r_lvls.end()) { - r_lvls.push_back(l); - } + accumulate_levels(sort_level(s), r_lvls); intro_type = instantiate(binding_body(intro_type), mk_local_for(intro_type)); } } diff --git a/tests/lean/ftree.lean b/tests/lean/ftree.lean new file mode 100644 index 000000000..e4fb30acb --- /dev/null +++ b/tests/lean/ftree.lean @@ -0,0 +1,31 @@ +import data.list + +namespace explicit + +inductive ftree.{l₁ l₂} (A : Type.{l₁}) (B : Type.{l₂}) : Type.{max 1 l₁ l₂} := +leafa : A → ftree A B, +leafb : B → ftree A B, +node : (A → ftree A B) → (B → ftree A B) → ftree A B + +end explicit + +namespace implicit + +inductive ftree (A : Type) (B : Type) : Type := +leafa : ftree A B, +node : (A → B → ftree A B) → (B → ftree A B) → ftree A B + +set_option pp.universes true +check ftree +end implicit + + +namespace implicit2 + +inductive ftree (A : Type) (B : Type) : Type := +leafa : A → ftree A B, +leafb : B → ftree A B, +node : (list A → ftree A B) → (B → ftree A B) → ftree A B + +check ftree +end implicit2 diff --git a/tests/lean/ftree.lean.expected.out b/tests/lean/ftree.lean.expected.out new file mode 100644 index 000000000..a3fc5d88b --- /dev/null +++ b/tests/lean/ftree.lean.expected.out @@ -0,0 +1,2 @@ +ftree.{l_1 l_2} : Type.{l_1} → Type.{l_2} → Type.{max 1 l_1 l_2} +ftree.{l_1 l_2} : Type.{l_1} → Type.{l_2} → Type.{max 1 l_1 l_2}