From c1729637d4fe32ebe0268eb338fcf4d032bb5df7 Mon Sep 17 00:00:00 2001 From: Hugo Herbelin Date: Wed, 25 Mar 2015 11:26:21 +0100 Subject: Fully fixing bug #3491 (anomaly when building _rect scheme in the presence of let-ins and recursively non-uniform parameters). The bug was in the List.chop of Inductiveops.get_arity which was wrong in the presence of let-ins and recursively non-uniform parameters. The bug #3491 showed up because, in addition to have let-ins, it was wrongly detected as having recursively non-uniform parameters. Also added some comments in declarations.mli. --- pretyping/inductiveops.ml | 16 +++++++++------- 1 file changed, 9 insertions(+), 7 deletions(-) (limited to 'pretyping/inductiveops.ml') diff --git a/pretyping/inductiveops.ml b/pretyping/inductiveops.ml index 7f6a4a6442..dfdc24d480 100644 --- a/pretyping/inductiveops.ml +++ b/pretyping/inductiveops.ml @@ -365,14 +365,16 @@ let get_arity env ((ind,u),params) = let (mib,mip) = Inductive.lookup_mind_specif env ind in let parsign = (* Dynamically detect if called with an instance of recursively - uniform parameter only or also of non recursively uniform + uniform parameter only or also of recursively non-uniform parameters *) - let parsign = mib.mind_params_ctxt in - let nnonrecparams = mib.mind_nparams - mib.mind_nparams_rec in - if Int.equal (List.length params) (rel_context_nhyps parsign - nnonrecparams) then - snd (List.chop nnonrecparams mib.mind_params_ctxt) - else - parsign in + let nparams = List.length params in + if Int.equal nparams mib.mind_nparams then + mib.mind_params_ctxt + else begin + assert (Int.equal nparams mib.mind_nparams_rec); + let nnonrecparamdecls = List.length mib.mind_params_ctxt - mib.mind_nparams_rec in + snd (List.chop nnonrecparamdecls mib.mind_params_ctxt) + end in let parsign = Vars.subst_instance_context u parsign in let arproperlength = List.length mip.mind_arity_ctxt - List.length parsign in let arsign,_ = List.chop arproperlength mip.mind_arity_ctxt in -- cgit v1.2.3