aboutsummaryrefslogtreecommitdiff
path: root/kernel/indtypes.ml
diff options
context:
space:
mode:
authorEnrico Tassi2015-03-30 11:30:53 +0200
committerEnrico Tassi2015-03-30 11:30:53 +0200
commitaeec29a177e8f1c89996c0449e4cd81ca3ca4377 (patch)
treecc39f942a75fd621633b1ac0999bbe4b3918fcfd /kernel/indtypes.ml
parent224d3b0e8be9b6af8194389141c9508504cf887c (diff)
parent41e4725805588b3fffdfdc0cd5ee6859de1612b5 (diff)
Merge branch 'v8.5' into trunk
Diffstat (limited to 'kernel/indtypes.ml')
-rw-r--r--kernel/indtypes.ml10
1 files changed, 5 insertions, 5 deletions
diff --git a/kernel/indtypes.ml b/kernel/indtypes.ml
index 799471c68a..6b909824ba 100644
--- a/kernel/indtypes.ml
+++ b/kernel/indtypes.ml
@@ -346,7 +346,7 @@ let typecheck_inductive env mie =
in
(id,cn,lc,(sign,arity)))
inds
- in (env_arities, params, inds)
+ in (env_arities, env_ar_par, params, inds)
(************************************************************************)
(************************************************************************)
@@ -366,9 +366,8 @@ exception IllFormedInd of ill_formed_ind
let mind_extract_params = decompose_prod_n_assum
-let explain_ind_err id ntyp env0 nbpar c nargs err =
+let explain_ind_err id ntyp env nbpar c nargs err =
let (lpar,c') = mind_extract_params nbpar c in
- let env = push_rel_context lpar env0 in
match err with
| LocalNonPos kt ->
raise (InductiveError (NonPos (env,c',mkRel (kt+nbpar))))
@@ -486,6 +485,7 @@ let check_positivity_one (env,_,ntypes,_ as ienv) hyps (_,i as ind) nargs lcname
check_pos (ienv_push_var ienv (na, b, mk_norec)) nmr d)
| Rel k ->
(try let (ra,rarg) = List.nth ra_env (k-1) in
+ let largs = List.map (whd_betadeltaiota env) largs in
let nmr1 =
(match ra with
Mrec _ -> compute_rec_par ienv hyps nmr largs
@@ -822,9 +822,9 @@ let build_inductive env p prv ctx env_ar params kn isrecord isfinite inds nmr re
let check_inductive env kn mie =
(* First type-check the inductive definition *)
- let (env_ar, params, inds) = typecheck_inductive env mie in
+ let (env_ar, env_ar_par, params, inds) = typecheck_inductive env mie in
(* Then check positivity conditions *)
- let (nmr,recargs) = check_positivity kn env_ar params inds in
+ let (nmr,recargs) = check_positivity kn env_ar_par params inds in
(* Build the inductive packets *)
build_inductive env mie.mind_entry_polymorphic mie.mind_entry_private
mie.mind_entry_universes