From 119f9ef620c4318dc3221808b0583f1b02182f38 Mon Sep 17 00:00:00 2001
From: msozeau
Date: Wed, 9 Apr 2008 14:59:09 +0000
Subject: Fix evar bugs in type classes: - disallow uninstantiated hypotheses
 (typically local variables with no assigned types) as solutions for typeclass
 instantiation. - Fix resolve_typeclasses call in pretyping that was not
 propagating found instances in the term.

git-svn-id: svn+ssh://scm.gforge.inria.fr/svn/coq/trunk@10772 85f007b7-540e-0410-9357-904b9bb8a0f7
---
 pretyping/pretyping.ml    | 8 +++++---
 tactics/class_tactics.ml4 | 9 +++++++--
 2 files changed, 12 insertions(+), 5 deletions(-)

diff --git a/pretyping/pretyping.ml b/pretyping/pretyping.ml
index 83381710d3..df1e45d868 100644
--- a/pretyping/pretyping.ml
+++ b/pretyping/pretyping.ml
@@ -687,9 +687,11 @@ module Pretyping_F (Coercion : Coercion.S) = struct
     let c = pretype_gen evdref env lvar kind c in
     let evd,_ = consider_remaining_unif_problems env !evdref in
       if fail_evar then 
-	(let evd = Typeclasses.resolve_typeclasses ~onlyargs:false ~all:false env (evars_of evd) evd in
-	   check_evars env Evd.empty evd c);
-      evd, c
+	let evd = Typeclasses.resolve_typeclasses ~onlyargs:false ~all:false env (evars_of evd) evd in
+	let c = Evarutil.nf_isevar evd c in
+	  check_evars env Evd.empty evd c;
+	  evd, c
+      else evd, c
 
   (** Entry points of the high-level type synthesis algorithm *)
 
diff --git a/tactics/class_tactics.ml4 b/tactics/class_tactics.ml4
index bbd29e6654..48c94a0746 100644
--- a/tactics/class_tactics.ml4
+++ b/tactics/class_tactics.ml4
@@ -134,6 +134,11 @@ type search_state = {
   dblist : Auto.Hint_db.t list;
   localdb :  Auto.Hint_db.t list }
     
+let filter_hyp t = 
+  match kind_of_term t with
+    | Evar _ | Meta _ | Sort _ -> false
+    | _ -> true
+
 module SearchProblem = struct
     
   type state = search_state
@@ -203,8 +208,8 @@ module SearchProblem = struct
 	    (List.map 
 		(fun id -> (Eauto.e_give_exact_constr (mkVar id), 0,
 			   (str "exact" ++ spc () ++ pr_id id)))
-(* 		(List.filter (fun id -> filt (pf_get_hyp_typ g id)) *)
-		    (pf_ids_of_hyps g))
+		(List.filter (fun id -> filter_hyp (pf_get_hyp_typ g id))
+		    (pf_ids_of_hyps g)))
 	in
 	  List.map (fun (res,pri,pp) -> { s with tacres = res; pri = 0;
 	    last_tactic = pp; localdb = List.tl s.localdb }) l
-- 
cgit v1.2.3