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.

4 files changed, 32 insertions, 17 deletions

diff --git a/kernel/declarations.mli b/kernel/declarations.mli
index cef920c6a5..c68e39ce33 100644
--- a/kernel/declarations.mli
+++ b/kernel/declarations.mli
@@ -139,7 +139,7 @@ type one_inductive_body = {
 
     mind_kelim : sorts_family list; (** List of allowed elimination sorts *)
 
-    mind_nf_lc : types array; (** Head normalized constructor types so that their conclusion is atomic *)
+    mind_nf_lc : types array; (** Head normalized constructor types so that their conclusion exposes the inductive type *)
 
     mind_consnrealargs : int array;
  (** Number of expected proper arguments of the constructors (w/o params)
@@ -172,7 +172,7 @@ type mutual_inductive_body = {
 
     mind_hyps : Context.section_context;  (** Section hypotheses on which the block depends *)
 
-    mind_nparams : int;  (** Number of expected parameters *)
+    mind_nparams : int;  (** Number of expected parameters including non-uniform ones (i.e. length of mind_params_ctxt w/o let-in) *)
 
     mind_nparams_rec : int;  (** Number of recursively uniform (i.e. ordinary) parameters *)
 
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
diff --git a/pretyping/inductiveops.mli b/pretyping/inductiveops.mli
index af1783b705..7959759a3f 100644
--- a/pretyping/inductiveops.mli
+++ b/pretyping/inductiveops.mli
@@ -25,7 +25,9 @@ val type_of_constructors : env -> pinductive -> types array
 (** Return constructor types in normal form *)
 val arities_of_constructors : env -> pinductive -> types array
 
-(** An inductive type with its parameters *)
+(** An inductive type with its parameters (transparently supports
+    reasoning either with only recursively uniform parameters or with all
+    parameters including the recursively non-uniform ones *)
 type inductive_family
 val make_ind_family : inductive puniverses * constr list -> inductive_family
 val dest_ind_family : inductive_family -> inductive puniverses * constr list
@@ -138,10 +140,14 @@ val lift_constructor : int -> constructor_summary -> constructor_summary
 val get_constructor :
   pinductive * mutual_inductive_body * one_inductive_body * constr list ->
   int -> constructor_summary
-val get_arity        : env -> inductive_family -> rel_context * sorts_family
 val get_constructors : env -> inductive_family -> constructor_summary array
 val get_projections  : env -> inductive_family -> constant array option
 
+(** [get_arity] returns the arity of the inductive family instantiated
+    with the parameters; if recursively non-uniform parameters are not
+    part of the inductive family, they appears in the arity *)
+val get_arity        : env -> inductive_family -> rel_context * sorts_family
+
 val build_dependent_constructor : constructor_summary -> constr
 val build_dependent_inductive   : env -> inductive_family -> constr
 val make_arity_signature : env -> bool -> inductive_family -> rel_context
diff --git a/test-suite/success/Inductive.v b/test-suite/success/Inductive.v
index 0a4ae68733..9661b3bfac 100644
--- a/test-suite/success/Inductive.v
+++ b/test-suite/success/Inductive.v
@@ -139,12 +139,6 @@ Inductive IND4 (A:Type) := CONS4 : IND4 ((fun x => A) IND4) -> IND4 A.
 
 Inductive IND5 (A : Type) (T := A) : Type := CONS5 : IND5 ((fun _ => A) 0) -> IND5 A.
 
-(* This type was raising an anomaly when building the _rect scheme,
-   because of a wrong computation of the number of non-recursively
-   uniform parameters in the presence of let-ins (see #3491) *)
-
-Inductive IND6 (A:Type) (T:=A) := CONS6 : IND6 T -> IND6 A.
-
 (* An example of nested positivity which was rejected by the kernel
    before 24 March 2015 (even with Unset Elimination Schemes to avoid
    the _rect bug) due to the wrong computation of non-recursively
@@ -155,3 +149,16 @@ Inductive list' (A:Type) (B:=A) :=
 | cons' : A -> list' B -> list' A.
 
 Inductive tree := node : list' tree -> tree.
+
+(* This type was raising an anomaly when building the _rect scheme,
+   because of a bug in Inductiveops.get_arity in the presence of
+   let-ins and recursively non-uniform parameters. *)
+
+Inductive L (A:Type) (T:=A) : Type := C : L nat -> L A.
+
+(* This type was raising an anomaly when building the _rect scheme,
+   because of a wrong computation of the number of non-recursively
+   uniform parameters when conversion is needed, leading the example to
+   hit the Inductiveops.get_arity bug mentioned above (see #3491) *)
+
+Inductive IND6 (A:Type) (T:=A) := CONS6 : IND6 T -> IND6 A.