diff options
| author | Gaëtan Gilbert | 2020-03-17 16:22:05 +0100 |
|---|---|---|
| committer | Gaëtan Gilbert | 2020-03-17 16:22:05 +0100 |
| commit | 5a2990d7a3a90f0c0554c8132b0b692ce13a5a02 (patch) | |
| tree | 45348b07d54ba9fbfe1255205b235f68bbf9e99e | |
| parent | 901cbfab468efa868e3838c2009ac09978ee661a (diff) | |
| parent | b62a6df9907169f47a72ee78ebe088c68932dd93 (diff) | |
Merge PR #11811: Remove a positivity check when Positivity Checking is off
Reviewed-by: SkySkimmer
| -rw-r--r-- | doc/changelog/01-kernel/11811-uncheck_positivity_bug.rst | 4 | ||||
| -rw-r--r-- | kernel/indtypes.ml | 6 | ||||
| -rw-r--r-- | test-suite/bugs/closed/bug_11811.v | 13 |
3 files changed, 20 insertions, 3 deletions
diff --git a/doc/changelog/01-kernel/11811-uncheck_positivity_bug.rst b/doc/changelog/01-kernel/11811-uncheck_positivity_bug.rst new file mode 100644 index 0000000000..c08ebb7f25 --- /dev/null +++ b/doc/changelog/01-kernel/11811-uncheck_positivity_bug.rst @@ -0,0 +1,4 @@ +- **Fixed:** + Allow more inductive types in `Unset Positivity Checking` mode + (`#11811 <https://github.com/coq/coq/pull/11811>`_, + by SimonBoulier). diff --git a/kernel/indtypes.ml b/kernel/indtypes.ml index 58e5e76b61..c5a39262a4 100644 --- a/kernel/indtypes.ml +++ b/kernel/indtypes.ml @@ -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 diff --git a/test-suite/bugs/closed/bug_11811.v b/test-suite/bugs/closed/bug_11811.v new file mode 100644 index 0000000000..a73494b630 --- /dev/null +++ b/test-suite/bugs/closed/bug_11811.v @@ -0,0 +1,13 @@ + +Unset Positivity Checking. + +Inductive foo : Type -> Type := +| bar : foo (foo unit) +| baz : foo nat. + +Definition toto : forall A, foo A -> {A = foo unit} + {A = nat}. +Proof. + intros A x. destruct x; intuition. +Defined. + +Check (eq_refl : toto _ baz = right eq_refl). |