diff options
| author | Pierre-Marie Pédrot | 2015-10-12 18:54:31 +0200 |
|---|---|---|
| committer | Pierre-Marie Pédrot | 2015-10-12 18:54:31 +0200 |
| commit | 10e5883fed21f9631e1aa65adb7a7e62a529987f (patch) | |
| tree | f04cfc472e6345585eb5f606e2957fcf0f2740ea /kernel/typeops.ml | |
| parent | 75c5e421e91d49eec9cd55c222595d2ef45325d6 (diff) | |
| parent | 26974a4a2301cc7b1188a3f2f29f3d3368eccc0b (diff) | |
Merge branch 'v8.5'
Diffstat (limited to 'kernel/typeops.ml')
| -rw-r--r-- | kernel/typeops.ml | 14 |
1 files changed, 10 insertions, 4 deletions
diff --git a/kernel/typeops.ml b/kernel/typeops.ml index fe82d85d5d..8895bae5da 100644 --- a/kernel/typeops.ml +++ b/kernel/typeops.ml @@ -134,10 +134,16 @@ let extract_context_levels env l = let make_polymorphic_if_constant_for_ind env {uj_val = c; uj_type = t} = let params, ccl = dest_prod_assum env t in match kind_of_term ccl with - | Sort (Type u) when isInd (fst (decompose_app (whd_betadeltaiota env c))) -> - let param_ccls = extract_context_levels env params in - let s = { template_param_levels = param_ccls; template_level = u} in - TemplateArity (params,s) + | Sort (Type u) -> + let ind, l = decompose_app (whd_betadeltaiota env c) in + if isInd ind && List.is_empty l then + let mis = lookup_mind_specif env (fst (destInd ind)) in + let nparams = Inductive.inductive_params mis in + let paramsl = CList.lastn nparams params in + let param_ccls = extract_context_levels env paramsl in + let s = { template_param_levels = param_ccls; template_level = u} in + TemplateArity (params,s) + else RegularArity t | _ -> RegularArity t |
