diff options
| author | msozeau | 2008-04-09 14:59:09 +0000 |
|---|---|---|
| committer | msozeau | 2008-04-09 14:59:09 +0000 |
| commit | 119f9ef620c4318dc3221808b0583f1b02182f38 (patch) | |
| tree | d516d81b756c901cd6fa1a8482d6ea7914a66950 | |
| parent | 7bf9b0c621d8cfebbecaf0ffc1a3ee84429a665f (diff) | |
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
| -rw-r--r-- | pretyping/pretyping.ml | 8 | ||||
| -rw-r--r-- | 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 |