aboutsummaryrefslogtreecommitdiffhomepage
path: root/pretyping/typing.ml
diff options
context:
space:
mode:
authorGravatar Pierre-Marie Pédrot <pierre-marie.pedrot@inria.fr>2016-09-14 10:27:38 +0200
committerGravatar Pierre-Marie Pédrot <pierre-marie.pedrot@inria.fr>2016-09-14 11:10:25 +0200
commit3e794be5f02ed438cdc5a351d09bdfb54c0be01a (patch)
tree3bbed56609e021f5c560a10037bafdae62e0db14 /pretyping/typing.ml
parent0e94cb62410354e5df4e65b34e7cbf8451b31d6e (diff)
parent2aaa58c22e37b05e3637ac7161bb464da7db054a (diff)
Merge branch 'v8.5' into v8.6
Diffstat (limited to 'pretyping/typing.ml')
-rw-r--r--pretyping/typing.ml12
1 files changed, 11 insertions, 1 deletions
diff --git a/pretyping/typing.ml b/pretyping/typing.ml
index 696d419af..9e9997f73 100644
--- a/pretyping/typing.ml
+++ b/pretyping/typing.ml
@@ -126,6 +126,16 @@ let e_judge_of_case env evdref ci pj cj lfj =
{ uj_val = mkCase (ci, pj.uj_val, cj.uj_val, Array.map j_val lfj);
uj_type = rslty }
+let check_type_fixpoint loc env evdref lna lar vdefj =
+ let lt = Array.length vdefj in
+ if Int.equal (Array.length lar) lt then
+ for i = 0 to lt-1 do
+ if not (Evarconv.e_cumul env evdref (vdefj.(i)).uj_type
+ (lift lt lar.(i))) then
+ Pretype_errors.error_ill_typed_rec_body_loc loc env !evdref
+ i lna vdefj lar
+ done
+
(* FIXME: might depend on the level of actual parameters!*)
let check_allowed_sort env sigma ind c p =
let pj = Retyping.get_judgment_of env sigma p in
@@ -263,7 +273,7 @@ and execute_recdef env evdref (names,lar,vdef) =
let env1 = push_rec_types (names,lara,vdef) env in
let vdefj = execute_array env1 evdref vdef in
let vdefv = Array.map j_val vdefj in
- let _ = type_fixpoint env1 names lara vdefj in
+ let _ = check_type_fixpoint Loc.ghost env1 evdref names lara vdefj in
(names,lara,vdefv)
and execute_array env evdref = Array.map (execute env evdref)