From 7cc81d4bebb993ea6f71290a808a74439465cdde Mon Sep 17 00:00:00 2001 From: herbelin Date: Fri, 8 Apr 2011 14:08:47 +0000 Subject: Replaced printing number of ill-typed branch by printing name of constructor when a "match" is kernel-ill-typed (probably rarely visible from end user anyway but useful for debugging) + dead code. git-svn-id: svn+ssh://scm.gforge.inria.fr/svn/coq/trunk@13969 85f007b7-540e-0410-9357-904b9bb8a0f7 --- pretyping/pretype_errors.mli | 2 +- pretyping/pretyping.ml | 7 ------- pretyping/typing.ml | 6 +++--- 3 files changed, 4 insertions(+), 11 deletions(-) (limited to 'pretyping') diff --git a/pretyping/pretype_errors.mli b/pretyping/pretype_errors.mli index 30ee6aaf6..3a3dccb4b 100644 --- a/pretyping/pretype_errors.mli +++ b/pretyping/pretype_errors.mli @@ -74,7 +74,7 @@ val error_case_not_inductive_loc : val error_ill_formed_branch_loc : loc -> env -> Evd.evar_map -> - constr -> int -> constr -> constr -> 'b + constr -> constructor -> constr -> constr -> 'b val error_number_branches_loc : loc -> env -> Evd.evar_map -> diff --git a/pretyping/pretyping.ml b/pretyping/pretyping.ml index aefa7dfd4..42dd243d0 100644 --- a/pretyping/pretyping.ml +++ b/pretyping/pretyping.ml @@ -221,13 +221,6 @@ module Pretyping_F (Coercion : Coercion.S) = struct i lna vdefj lar done - let check_branches_message loc env evdref c (explft,lft) = - for i = 0 to Array.length explft - 1 do - if not (e_cumul env evdref lft.(i) explft.(i)) then - let sigma = !evdref in - error_ill_formed_branch_loc loc env sigma c i lft.(i) explft.(i) - done - (* coerce to tycon if any *) let inh_conv_coerce_to_tycon loc env evdref j = function | None -> j diff --git a/pretyping/typing.ml b/pretyping/typing.ml index c39be8b68..b40605f22 100644 --- a/pretyping/typing.ml +++ b/pretyping/typing.ml @@ -50,12 +50,12 @@ let e_judge_of_apply env evdref funj argjv = in apply_rec 1 funj.uj_type (Array.to_list argjv) -let check_branch_types env evdref cj (lfj,explft) = +let check_branch_types env evdref ind cj (lfj,explft) = if Array.length lfj <> Array.length explft then error_number_branches env cj (Array.length explft); for i = 0 to Array.length explft - 1 do if not (Evarconv.e_cumul env evdref lfj.(i).uj_type explft.(i)) then - error_ill_formed_branch env cj.uj_val i lfj.(i).uj_type explft.(i) + error_ill_formed_branch env cj.uj_val (ind,i+1) lfj.(i).uj_type explft.(i) done let e_judge_of_case env evdref ci pj cj lfj = @@ -64,7 +64,7 @@ let e_judge_of_case env evdref ci pj cj lfj = with Not_found -> error_case_not_inductive env cj in let _ = check_case_info env (fst indspec) ci in let (bty,rslty,univ) = type_case_branches env indspec pj cj.uj_val in - check_branch_types env evdref cj (lfj,bty); + check_branch_types env evdref (fst indspec) cj (lfj,bty); { uj_val = mkCase (ci, pj.uj_val, cj.uj_val, Array.map j_val lfj); uj_type = rslty } -- cgit v1.2.3