diff options
Diffstat (limited to 'kernel/indtypes.ml')
| -rw-r--r-- | kernel/indtypes.ml | 17 |
1 files changed, 9 insertions, 8 deletions
diff --git a/kernel/indtypes.ml b/kernel/indtypes.ml index b6b8e5265c..9da6c7842e 100644 --- a/kernel/indtypes.ml +++ b/kernel/indtypes.ml @@ -1,7 +1,7 @@ (************************************************************************) (* * The Coq Proof Assistant / The Coq Development Team *) -(* v * INRIA, CNRS and contributors - Copyright 1999-2019 *) -(* <O___,, * (see CREDITS file for the list of authors) *) +(* v * Copyright INRIA, CNRS and contributors *) +(* <O___,, * (see version control and CREDITS file for authors & dates) *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) @@ -102,7 +102,7 @@ let failwith_non_pos_list n ntypes l = (* Check the inductive type is called with the expected parameters *) (* [n] is the index of the last inductive type in [env] *) -let check_correct_par (env,n,ntypes,_) paramdecls ind_index args = +let check_correct_par ~chkpos (env,n,ntypes,_) paramdecls ind_index args = let nparams = Context.Rel.nhyps paramdecls in let args = Array.of_list args in if Array.length args < nparams then @@ -123,7 +123,7 @@ let check_correct_par (env,n,ntypes,_) paramdecls ind_index args = LocalNonPar (param_index+1, paramdecl_index_in_env, ind_index) in raise (IllFormedInd err) in check (nparams-1) (n-nparamdecls) paramdecls; - if not (Array.for_all (noccur_between n ntypes) realargs) then + if chkpos && not (Array.for_all (noccur_between n ntypes) realargs) then failwith_non_pos_vect n ntypes realargs (* Computes the maximum number of recursive parameters: @@ -325,7 +325,7 @@ let check_positivity_one ~chkpos recursive (env,_,ntypes,_ as ienv) paramsctxt ( if check_head then begin match hd with | Rel j when Int.equal j (n + ntypes - i - 1) -> - check_correct_par ienv paramsctxt (ntypes - i) largs + check_correct_par ~chkpos ienv paramsctxt (ntypes - i) largs | _ -> raise (IllFormedInd (LocalNotConstructor(paramsctxt,nnonrecargs))) end else @@ -466,7 +466,7 @@ let compute_projections (kn, i as ind) mib = Array.of_list (List.rev rs), Array.of_list (List.rev pbs) -let build_inductive env ~sec_univs names prv univs variance +let build_inductive env ~sec_univs names prv univs template variance paramsctxt kn isrecord isfinite inds nmr recargs = let ntypes = Array.length inds in (* Compute the set of used section variables *) @@ -538,6 +538,7 @@ let build_inductive env ~sec_univs names prv univs variance mind_params_ctxt = paramsctxt; mind_packets = packets; mind_universes = univs; + mind_template = template; mind_variance = variance; mind_sec_variance = sec_variance; mind_private = prv; @@ -562,7 +563,7 @@ let build_inductive env ~sec_univs names prv univs variance let check_inductive env ~sec_univs kn mie = (* First type-check the inductive definition *) - let (env_ar_par, univs, variance, record, paramsctxt, inds) = + let (env_ar_par, univs, template, variance, record, paramsctxt, inds) = IndTyping.typecheck_inductive env ~sec_univs mie in (* Then check positivity conditions *) @@ -575,6 +576,6 @@ let check_inductive env ~sec_univs kn mie = (Array.map (fun ((_,lc),(indices,_),_) -> Context.Rel.nhyps indices,lc) inds) in (* Build the inductive packets *) - build_inductive env ~sec_univs names mie.mind_entry_private univs variance + build_inductive env ~sec_univs names mie.mind_entry_private univs template variance paramsctxt kn record mie.mind_entry_finite inds nmr recargs |