diff options
Diffstat (limited to 'toplevel/discharge.ml')
| -rw-r--r-- | toplevel/discharge.ml | 13 |
1 files changed, 10 insertions, 3 deletions
diff --git a/toplevel/discharge.ml b/toplevel/discharge.ml index 6f74c526..58122e11 100644 --- a/toplevel/discharge.ml +++ b/toplevel/discharge.ml @@ -1,12 +1,12 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2010 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2011 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) (************************************************************************) -(* $Id: discharge.ml 13323 2010-07-24 15:57:30Z herbelin $ *) +(* $Id: discharge.ml 14641 2011-11-06 11:59:10Z herbelin $ *) open Names open Util @@ -67,13 +67,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, |