diff options
author | Samuel Mimram <smimram@debian.org> | 2007-08-18 20:34:57 +0000 |
---|---|---|
committer | Samuel Mimram <smimram@debian.org> | 2007-08-18 20:34:57 +0000 |
commit | be2a2fda89bba47d5342b7aebc10efd97f1d68b9 (patch) | |
tree | 45a70ccd12dc139a53b49daba9c9821ffe2fd035 /toplevel/himsg.ml | |
parent | 763b05d3e66a0c0c49bad97434d891d22c1054dc (diff) | |
parent | 72b9a7df489ea47b3e5470741fd39f6100d31676 (diff) |
Merge commit 'upstream/8.1.pl1+dfsg'
Diffstat (limited to 'toplevel/himsg.ml')
-rw-r--r-- | toplevel/himsg.ml | 27 |
1 files changed, 13 insertions, 14 deletions
diff --git a/toplevel/himsg.ml b/toplevel/himsg.ml index dc2cc8cd..1809baa5 100644 --- a/toplevel/himsg.ml +++ b/toplevel/himsg.ml @@ -6,7 +6,7 @@ (* * GNU Lesser General Public License Version 2.1 *) (************************************************************************) -(* $Id: himsg.ml 9528 2007-01-24 09:43:03Z herbelin $ *) +(* $Id: himsg.ml 9976 2007-07-12 11:58:30Z msozeau $ *) open Pp open Util @@ -331,7 +331,7 @@ let explain_occur_check ctx ev rhs = str" with term" ++ brk(1,1) ++ pt let explain_hole_kind env = function - | QuestionMark -> str "a term for this placeholder" + | QuestionMark _ -> str "a term for this placeholder" | CasesType -> str "the type of this pattern-matching problem" | BinderType (Name id) -> @@ -352,9 +352,8 @@ let explain_hole_kind env = function let explain_not_clean ctx ev t k = let ctx = make_all_name_different ctx in - let c = mkRel (Intset.choose (free_rels t)) in let id = Evd.string_of_existential ev in - let var = pr_lconstr_env ctx c in + let var = pr_lconstr_env ctx t in str"Tried to define " ++ explain_hole_kind ctx k ++ str" (" ++ str id ++ str ")" ++ spc() ++ str"with a term using variable " ++ var ++ spc () ++ @@ -381,15 +380,15 @@ let explain_wrong_case_info ctx ind ci = spc () ++ pc -let explain_cannot_unify m n = - let pm = pr_lconstr m in - let pn = pr_lconstr n in +let explain_cannot_unify ctx m n = + let pm = pr_lconstr_env ctx m in + let pn = pr_lconstr_env ctx n in str"Impossible to unify" ++ brk(1,1) ++ pm ++ spc () ++ str"with" ++ brk(1,1) ++ pn let explain_cannot_unify_local env m n subn = - let pm = pr_lconstr m in - let pn = pr_lconstr n in + let pm = pr_lconstr_env env m in + let pn = pr_lconstr_env env n in let psubn = pr_lconstr_env env subn in str"Impossible to unify" ++ brk(1,1) ++ pm ++ spc () ++ str"with" ++ brk(1,1) ++ pn ++ spc() ++ str"as" ++ brk(1,1) ++ @@ -402,9 +401,9 @@ let explain_refiner_cannot_generalize ty = let explain_no_occurrence_found c = str "Found no subterm matching " ++ pr_lconstr c ++ str " in the current goal" -let explain_cannot_unify_binding_type m n = - let pm = pr_lconstr m in - let pn = pr_lconstr n in +let explain_cannot_unify_binding_type ctx m n = + let pm = pr_lconstr_env ctx m in + let pn = pr_lconstr_env ctx n in str "This binding has type" ++ brk(1,1) ++ pm ++ spc () ++ str "which should be unifiable with" ++ brk(1,1) ++ pn @@ -464,11 +463,11 @@ let explain_pretype_error ctx err = explain_unexpected_type ctx actual expected | NotProduct c -> explain_not_product ctx c - | CannotUnify (m,n) -> explain_cannot_unify m n + | CannotUnify (m,n) -> explain_cannot_unify ctx m n | CannotUnifyLocal (e,m,n,sn) -> explain_cannot_unify_local e m n sn | CannotGeneralize ty -> explain_refiner_cannot_generalize ty | NoOccurrenceFound c -> explain_no_occurrence_found c - | CannotUnifyBindingType (m,n) -> explain_cannot_unify_binding_type m n + | CannotUnifyBindingType (m,n) -> explain_cannot_unify_binding_type ctx m n (* Refiner errors *) |