diff options
| -rw-r--r-- | toplevel/discharge.ml | 9 |
1 files changed, 8 insertions, 1 deletions
diff --git a/toplevel/discharge.ml b/toplevel/discharge.ml index 84b46930e6..bab711ea42 100644 --- a/toplevel/discharge.ml +++ b/toplevel/discharge.ml @@ -65,13 +65,20 @@ let abstract_inductive hyps nparams inds = inds' in (params',ind'') +let refresh_polymorphic_type_of_inductive (_,mip) = + match mip.mind_arity with + | Monomorphic s -> + s.mind_user_arity + | Polymorphic ar -> + let ctx = List.rev mip.mind_arity_ctxt in + mkArity (List.rev ctx,Termops.new_Type_sort()) let process_inductive sechyps modlist mib = let nparams = mib.mind_nparams in let inds = array_map_to_list (fun mip -> - let arity = expmod_constr modlist (Termops.refresh_universes_strict (Inductive.type_of_inductive (Global.env()) (mib,mip))) in + let arity = expmod_constr modlist (refresh_polymorphic_type_of_inductive (mib,mip)) in let lc = Array.map (expmod_constr modlist) mip.mind_user_lc in (mip.mind_typename, arity, |