aboutsummaryrefslogtreecommitdiff
path: root/vernac/comInductive.ml
diff options
context:
space:
mode:
authorEmilio Jesus Gallego Arias2020-02-22 15:54:11 -0500
committerEmilio Jesus Gallego Arias2020-02-22 15:54:11 -0500
commitfe86fb5561f2bbde86236d8c91e973df4393049f (patch)
treeb593c748432234e0ba990f9e583708fda8a37a71 /vernac/comInductive.ml
parent53c9fd8339873b2bd77d756a96a2908eb5ce078a (diff)
parent2ed097cfba9136a0fba9b961d24c408077fac11d (diff)
Merge PR #11596: ComInductive: use lbound=Prop iff non polymorphic
Reviewed-by: ejgallego
Diffstat (limited to 'vernac/comInductive.ml')
-rw-r--r--vernac/comInductive.ml19
1 files changed, 5 insertions, 14 deletions
diff --git a/vernac/comInductive.ml b/vernac/comInductive.ml
index 85f2bf3708..edb03a5c89 100644
--- a/vernac/comInductive.ml
+++ b/vernac/comInductive.ml
@@ -433,26 +433,17 @@ let interp_mutual_inductive_gen env0 ~template udecl (uparamsl,paramsl,indl) not
then user_err (str "Inductives with uniform parameters may not have attached notations.");
let indnames = List.map (fun ind -> ind.ind_name) indl in
- let sigma, env_params, infos =
+
+ (* In case of template polymorphism, we need to compute more constraints *)
+ let env0 = if poly then env0 else Environ.set_universes_lbound env0 Univ.Level.prop in
+
+ let sigma, env_params, (ctx_params, env_uparams, ctx_uparams, params, userimpls, useruimpls, impls, udecl) =
interp_params env0 udecl uparamsl paramsl
in
(* Interpret the arities *)
let arities = List.map (intern_ind_arity env_params sigma) indl in
- let sigma, env_params, (ctx_params, env_uparams, ctx_uparams, params, userimpls, useruimpls, impls, udecl), arities, is_template =
- let is_template = List.exists (fun (_,_,_,pseudo_poly) -> not (Option.is_empty pseudo_poly)) arities in
- if not poly && is_template then
- (* In case of template polymorphism, we need to compute more constraints *)
- let env0 = Environ.set_universes_lbound env0 Univ.Level.prop in
- let sigma, env_params, infos =
- interp_params env0 udecl uparamsl paramsl
- in
- let arities = List.map (intern_ind_arity env_params sigma) indl in
- sigma, env_params, infos, arities, is_template
- else sigma, env_params, infos, arities, is_template
- in
-
let sigma, arities = List.fold_left_map (pretype_ind_arity env_params) sigma arities in
let arities, relevances, arityconcl, indimpls = List.split4 arities in