kernel/type_errors.ml

git-svn-id: svn+ssh://scm.gforge.inria.fr/svn/coq/trunk@583 85f007b7-540e-0410-9357-904b9bb8a0f7

6 files changed, 52 insertions, 34 deletions

diff --git a/.depend b/.depend
index ba4d941ee..6de79fd64 100644
--- a/.depend
+++ b/.depend
@@ -32,8 +32,6 @@ kernel/typeops.cmi: kernel/environ.cmi kernel/evd.cmi kernel/inductive.cmi \
     kernel/names.cmi kernel/sign.cmi kernel/term.cmi kernel/univ.cmi 
 kernel/univ.cmi: kernel/names.cmi lib/pp.cmi 
 lib/pp.cmi: lib/pp_control.cmi 
-lib/system.cmi: lib/pp.cmi 
-lib/util.cmi: lib/pp.cmi 
 library/declare.cmi: kernel/declarations.cmi kernel/environ.cmi \
     kernel/inductive.cmi kernel/names.cmi kernel/sign.cmi kernel/term.cmi 
 library/global.cmi: kernel/declarations.cmi kernel/environ.cmi \
@@ -49,6 +47,8 @@ library/library.cmi: lib/pp.cmi
 library/nametab.cmi: kernel/names.cmi 
 library/redinfo.cmi: kernel/names.cmi kernel/term.cmi 
 library/summary.cmi: kernel/names.cmi 
+lib/system.cmi: lib/pp.cmi 
+lib/util.cmi: lib/pp.cmi 
 parsing/ast.cmi: parsing/coqast.cmi lib/dyn.cmi kernel/names.cmi \
     parsing/pcoq.cmi lib/pp.cmi 
 parsing/astterm.cmi: parsing/coqast.cmi kernel/environ.cmi kernel/evd.cmi \
@@ -61,7 +61,7 @@ parsing/esyntax.cmi: parsing/ast.cmi parsing/coqast.cmi parsing/extend.cmi \
     lib/pp.cmi 
 parsing/extend.cmi: parsing/ast.cmi parsing/coqast.cmi parsing/pcoq.cmi \
     lib/pp.cmi 
-parsing/g_minicoq.cmi: kernel/names.cmi lib/pp.cmi kernel/sign.cmi \
+parsing/g_minicoq.cmi: kernel/environ.cmi kernel/names.cmi lib/pp.cmi \
     kernel/term.cmi 
 parsing/pattern.cmi: kernel/environ.cmi kernel/evd.cmi kernel/names.cmi \
     pretyping/rawterm.cmi kernel/sign.cmi kernel/term.cmi 
@@ -187,11 +187,11 @@ toplevel/record.cmi: parsing/coqast.cmi kernel/names.cmi kernel/term.cmi
 toplevel/searchisos.cmi: library/libobject.cmi kernel/names.cmi \
     kernel/term.cmi 
 toplevel/toplevel.cmi: parsing/pcoq.cmi lib/pp.cmi 
-toplevel/vernac.cmi: parsing/coqast.cmi parsing/pcoq.cmi 
 toplevel/vernacentries.cmi: kernel/names.cmi kernel/term.cmi \
     toplevel/vernacinterp.cmi 
 toplevel/vernacinterp.cmi: parsing/coqast.cmi lib/dyn.cmi kernel/names.cmi \
     proofs/proof_type.cmi 
+toplevel/vernac.cmi: parsing/coqast.cmi parsing/pcoq.cmi 
 config/coq_config.cmo: config/coq_config.cmi 
 config/coq_config.cmx: config/coq_config.cmi 
 dev/db_printers.cmo: kernel/names.cmi lib/pp.cmi 
@@ -318,30 +318,22 @@ lib/dyn.cmo: lib/util.cmi lib/dyn.cmi
 lib/dyn.cmx: lib/util.cmx lib/dyn.cmi 
 lib/edit.cmo: lib/bstack.cmi lib/pp.cmi lib/util.cmi lib/edit.cmi 
 lib/edit.cmx: lib/bstack.cmx lib/pp.cmx lib/util.cmx lib/edit.cmi 
-lib/gmap.cmo: lib/gmap.cmi 
-lib/gmap.cmx: lib/gmap.cmi 
 lib/gmapl.cmo: lib/gmap.cmi lib/util.cmi lib/gmapl.cmi 
 lib/gmapl.cmx: lib/gmap.cmx lib/util.cmx lib/gmapl.cmi 
+lib/gmap.cmo: lib/gmap.cmi 
+lib/gmap.cmx: lib/gmap.cmi 
 lib/gset.cmo: lib/gset.cmi 
 lib/gset.cmx: lib/gset.cmi 
 lib/hashcons.cmo: lib/hashcons.cmi 
 lib/hashcons.cmx: lib/hashcons.cmi 
 lib/options.cmo: lib/util.cmi lib/options.cmi 
 lib/options.cmx: lib/util.cmx lib/options.cmi 
-lib/pp.cmo: lib/pp_control.cmi lib/pp.cmi 
-lib/pp.cmx: lib/pp_control.cmx lib/pp.cmi 
 lib/pp_control.cmo: lib/pp_control.cmi 
 lib/pp_control.cmx: lib/pp_control.cmi 
+lib/pp.cmo: lib/pp_control.cmi lib/pp.cmi 
+lib/pp.cmx: lib/pp_control.cmx lib/pp.cmi 
 lib/profile.cmo: lib/system.cmi lib/profile.cmi 
 lib/profile.cmx: lib/system.cmx lib/profile.cmi 
-lib/stamps.cmo: lib/stamps.cmi 
-lib/stamps.cmx: lib/stamps.cmi 
-lib/system.cmo: lib/pp.cmi lib/util.cmi lib/system.cmi 
-lib/system.cmx: lib/pp.cmx lib/util.cmx lib/system.cmi 
-lib/tlm.cmo: lib/gmap.cmi lib/gset.cmi lib/tlm.cmi 
-lib/tlm.cmx: lib/gmap.cmx lib/gset.cmx lib/tlm.cmi 
-lib/util.cmo: lib/pp.cmi lib/util.cmi 
-lib/util.cmx: lib/pp.cmx lib/util.cmi 
 library/declare.cmo: kernel/declarations.cmi kernel/environ.cmi \
     kernel/evd.cmi kernel/generic.cmi library/global.cmi library/impargs.cmi \
     library/indrec.cmi kernel/inductive.cmi library/lib.cmi \
@@ -418,6 +410,14 @@ library/summary.cmo: lib/dyn.cmi kernel/names.cmi lib/pp.cmi lib/util.cmi \
     library/summary.cmi 
 library/summary.cmx: lib/dyn.cmx kernel/names.cmx lib/pp.cmx lib/util.cmx \
     library/summary.cmi 
+lib/stamps.cmo: lib/stamps.cmi 
+lib/stamps.cmx: lib/stamps.cmi 
+lib/system.cmo: lib/pp.cmi lib/util.cmi lib/system.cmi 
+lib/system.cmx: lib/pp.cmx lib/util.cmx lib/system.cmi 
+lib/tlm.cmo: lib/gmap.cmi lib/gset.cmi lib/tlm.cmi 
+lib/tlm.cmx: lib/gmap.cmx lib/gset.cmx lib/tlm.cmi 
+lib/util.cmo: lib/pp.cmi lib/util.cmi 
+lib/util.cmx: lib/pp.cmx lib/util.cmi 
 parsing/ast.cmo: parsing/coqast.cmi lib/dyn.cmi lib/hashcons.cmi \
     kernel/names.cmi parsing/pcoq.cmi lib/pp.cmi lib/util.cmi parsing/ast.cmi 
 parsing/ast.cmx: parsing/coqast.cmx lib/dyn.cmx lib/hashcons.cmx \
@@ -766,6 +766,8 @@ proofs/tacmach.cmx: parsing/ast.cmx parsing/astterm.cmx library/declare.cmx \
     proofs/proof_type.cmx kernel/reduction.cmx proofs/refiner.cmx \
     kernel/sign.cmx lib/stamps.cmx pretyping/tacred.cmx kernel/term.cmx \
     pretyping/typing.cmx lib/util.cmx proofs/tacmach.cmi 
+scripts/coqc.cmo: config/coq_config.cmi toplevel/usage.cmi 
+scripts/coqc.cmx: config/coq_config.cmx toplevel/usage.cmx 
 scripts/coqmktop.cmo: config/coq_config.cmi scripts/tolink.cmo 
 scripts/coqmktop.cmx: config/coq_config.cmx scripts/tolink.cmx 
 tactics/auto.cmo: parsing/astterm.cmi tactics/btermdn.cmi proofs/clenv.cmi \
@@ -994,12 +996,10 @@ tactics/wcclausenv.cmx: proofs/clenv.cmx kernel/environ.cmx kernel/evd.cmx \
     lib/pp.cmx proofs/proof_trees.cmx kernel/reduction.cmx \
     pretyping/retyping.cmx kernel/sign.cmx proofs/tacmach.cmx kernel/term.cmx \
     lib/util.cmx tactics/wcclausenv.cmi 
-tools/coqdep.cmo: config/coq_config.cmi tools/coqdep_lexer.cmo 
-tools/coqdep.cmx: config/coq_config.cmx tools/coqdep_lexer.cmx 
 tools/coqdep_lexer.cmo: config/coq_config.cmi 
 tools/coqdep_lexer.cmx: config/coq_config.cmx 
-tools/gallina.cmo: tools/gallina_lexer.cmo 
-tools/gallina.cmx: tools/gallina_lexer.cmx 
+tools/coqdep.cmo: config/coq_config.cmi tools/coqdep_lexer.cmo 
+tools/coqdep.cmx: config/coq_config.cmx tools/coqdep_lexer.cmx 
 toplevel/command.cmo: parsing/ast.cmi parsing/astterm.cmi parsing/coqast.cmi \
     kernel/declarations.cmi library/declare.cmi kernel/environ.cmi \
     kernel/evd.cmi kernel/generic.cmi library/global.cmi library/indrec.cmi \
@@ -1118,14 +1118,6 @@ toplevel/toplevel.cmx: parsing/ast.cmx toplevel/errors.cmx toplevel/mltop.cmi \
     toplevel/vernac.cmx toplevel/vernacinterp.cmx toplevel/toplevel.cmi 
 toplevel/usage.cmo: toplevel/usage.cmi 
 toplevel/usage.cmx: toplevel/usage.cmi 
-toplevel/vernac.cmo: parsing/ast.cmi parsing/coqast.cmi library/library.cmi \
-    lib/options.cmi parsing/pcoq.cmi proofs/pfedit.cmi lib/pp.cmi \
-    library/states.cmi lib/system.cmi lib/util.cmi toplevel/vernacinterp.cmi \
-    toplevel/vernac.cmi 
-toplevel/vernac.cmx: parsing/ast.cmx parsing/coqast.cmx library/library.cmx \
-    lib/options.cmx parsing/pcoq.cmx proofs/pfedit.cmx lib/pp.cmx \
-    library/states.cmx lib/system.cmx lib/util.cmx toplevel/vernacinterp.cmx \
-    toplevel/vernac.cmi 
 toplevel/vernacentries.cmo: parsing/ast.cmi parsing/astterm.cmi \
     pretyping/class.cmi toplevel/command.cmi parsing/coqast.cmi \
     library/declare.cmi toplevel/discharge.cmi kernel/environ.cmi \
@@ -1162,6 +1154,14 @@ toplevel/vernacinterp.cmx: parsing/ast.cmx toplevel/command.cmx \
     parsing/coqast.cmx lib/dyn.cmx toplevel/himsg.cmx kernel/names.cmx \
     lib/options.cmx lib/pp.cmx proofs/proof_type.cmx proofs/tacinterp.cmx \
     lib/util.cmx toplevel/vernacinterp.cmi 
+toplevel/vernac.cmo: parsing/ast.cmi parsing/coqast.cmi library/library.cmi \
+    lib/options.cmi parsing/pcoq.cmi proofs/pfedit.cmi lib/pp.cmi \
+    library/states.cmi lib/system.cmi lib/util.cmi toplevel/vernacinterp.cmi \
+    toplevel/vernac.cmi 
+toplevel/vernac.cmx: parsing/ast.cmx parsing/coqast.cmx library/library.cmx \
+    lib/options.cmx parsing/pcoq.cmx proofs/pfedit.cmx lib/pp.cmx \
+    library/states.cmx lib/system.cmx lib/util.cmx toplevel/vernacinterp.cmx \
+    toplevel/vernac.cmi 
 contrib/omega/coq_omega.cmo: parsing/ast.cmi proofs/clenv.cmi \
     library/declare.cmi kernel/environ.cmi tactics/equality.cmi \
     kernel/generic.cmi library/global.cmi kernel/inductive.cmi \
diff --git a/kernel/type_errors.mli b/kernel/type_errors.mli
index 284f244f1..20fa410e4 100644
--- a/kernel/type_errors.mli
+++ b/kernel/type_errors.mli
@@ -35,6 +35,7 @@ type type_error =
   | OccurCheck of int * constr
   | NotClean of int * constr
   | VarNotFound of identifier
+  | UnexpectedType of constr * constr
   | NotProduct of constr
   (* Pattern-matching errors *)
   | BadConstructor of constructor * inductive
@@ -91,4 +92,6 @@ val error_not_inductive : path_kind -> env -> constr -> 'a
 val error_ml_case : path_kind -> env -> 
   string -> constr -> constr -> constr -> constr -> 'a
 
+val error_unexpected_type : env -> actual:constr -> expected:constr -> 'a
+
 val error_not_product : env -> constr -> 'a
diff --git a/pretyping/pretype_errors.ml b/pretyping/pretype_errors.ml
index 247620a67..b8a080366 100644
--- a/pretyping/pretype_errors.ml
+++ b/pretyping/pretype_errors.ml
@@ -49,13 +49,16 @@ let error_wrong_predicate_arity_loc loc k env c n1 n2 =
 let error_needs_inversion k env x t =
   raise (TypeError (k, env, NeedsInversion (x,t)))
 
-
 let error_ill_formed_branch_loc loc k env c i actty expty =
   raise_pretype_error (loc, k, env, IllFormedBranch (c,i,actty,expty))
 
+(*s Implicit arguments synthesis errors *)
+
+let error_unexpected_type_loc loc env actty expty =
+  raise_pretype_error (loc, CCI, env, UnexpectedType (actty, expty))
+
 let error_occur_check k env ev c =
   raise (TypeError (k, env, OccurCheck (ev,c)))
 
 let error_not_clean k env ev c =
   raise (TypeError (k, env, NotClean (ev,c)))
-
diff --git a/pretyping/pretype_errors.mli b/pretyping/pretype_errors.mli
index 852232897..aab6abc08 100644
--- a/pretyping/pretype_errors.mli
+++ b/pretyping/pretype_errors.mli
@@ -11,7 +11,7 @@ open Type_errors
 open Rawterm
 (*i*)
 
-(* The type of errors raised by the pretyper *)
+(*s The type of errors raised by the pretyper *)
 
 val error_var_not_found_loc :
   loc -> path_kind -> identifier -> 'a
@@ -38,7 +38,7 @@ val error_number_branches_loc :
 val error_case_not_inductive_loc :
   loc -> path_kind -> env -> constr -> constr -> 'b
 
-(* Pattern-matching errors *)
+(*s Pattern-matching errors *)
 
 val error_bad_constructor_loc : 
   loc -> path_kind -> constructor -> inductive -> 'b
@@ -52,7 +52,9 @@ val error_wrong_predicate_arity_loc :
 val error_needs_inversion : path_kind -> env -> constr -> constr -> 'a
 
 
-(* Implicit arguments synthesis errors *)
+(*s Implicit arguments synthesis errors *)
+
+val error_unexpected_type_loc : loc -> env -> constr -> constr -> 'b
 
 val error_occur_check : path_kind -> env -> int -> constr -> 'a
 
diff --git a/pretyping/pretyping.ml b/pretyping/pretyping.ml
index cadaa7f78..147960ade 100644
--- a/pretyping/pretyping.ml
+++ b/pretyping/pretyping.ml
@@ -461,7 +461,8 @@ and pretype_type valcon env isevars lvar lmeta = function
 	then
 	  { uj_val = nf_ise1 !isevars tj.uj_val;
 	    uj_type = tj.uj_type }
-	else error "This type should be another one !"
+	else
+	  error_unexpected_type_loc (loc_of_rawconstr c) env tj.uj_val v
 
 
 let unsafe_fmachine tycon nocheck isevars metamap env lvar lmeta constr =
diff --git a/toplevel/himsg.ml b/toplevel/himsg.ml
index 9608f5af5..d9dd3d903 100644
--- a/toplevel/himsg.ml
+++ b/toplevel/himsg.ml
@@ -153,6 +153,13 @@ let explain_cant_apply_not_functional k ctx rator randl =
      'sTR("cannot be applied to the "^term_string); 'fNL; 
      'sTR" "; v 0 appl; 'fNL >]
 
+let explain_unexpected_type k ctx actual_type expected_type =
+  let ctx = make_all_name_different ctx in
+  let pract = prterm_env ctx actual_type in
+  let prexp = prterm_env ctx expected_type in
+  [< 'sTR"This type is"; 'sPC; pract; 'sPC; 'sTR "but is expected to be";
+     'sPC; prexp; 'fNL >]
+
 let explain_not_product k ctx c =
   let ctx = make_all_name_different ctx in
   let pr = prterm_env ctx c in
@@ -306,6 +313,8 @@ let explain_type_error k ctx = function
       explain_not_clean k ctx n c
   | VarNotFound id ->
       explain_var_not_found k ctx id
+  | UnexpectedType (actual,expected) ->
+      explain_unexpected_type k ctx actual expected
   | NotProduct c ->
       explain_not_product k ctx c
   (* Pattern-matching errors *)