diff options
| author | msozeau | 2013-06-12 15:17:05 +0000 |
|---|---|---|
| committer | msozeau | 2013-06-12 15:17:05 +0000 |
| commit | 6f9a4b28bca5a218eb31bb7afe9d3dffe01f76f0 (patch) | |
| tree | 878c71daf9ddcd467045fd77973509d54b8f9d5f /pretyping/typeclasses.ml | |
| parent | af1947ae57d0fa6f35a61b86ea9e73e66f2f5fd8 (diff) | |
One more fix for rewrite: disallow resolving of the (partial) constraints
happening silently in w_unify and handle this explicitely. Class resolution
filters now can test the existential key. Fixes Ergo contrib.
git-svn-id: svn+ssh://scm.gforge.inria.fr/svn/coq/trunk@16571 85f007b7-540e-0410-9357-904b9bb8a0f7
Diffstat (limited to 'pretyping/typeclasses.ml')
| -rw-r--r-- | pretyping/typeclasses.ml | 14 |
1 files changed, 7 insertions, 7 deletions
diff --git a/pretyping/typeclasses.ml b/pretyping/typeclasses.ml index c14f107ec6..6da6624228 100644 --- a/pretyping/typeclasses.ml +++ b/pretyping/typeclasses.ml @@ -481,19 +481,19 @@ let mark_unresolvable evi = mark_resolvability false evi let mark_resolvable evi = mark_resolvability true evi open Evar_kinds -type evar_filter = Evar_kinds.t -> bool +type evar_filter = existential_key -> Evar_kinds.t -> bool -let all_evars _ = true -let all_goals = function GoalEvar -> true | _ -> false -let no_goals evi = not (all_goals evi) -let no_goals_or_obligations = function +let all_evars _ _ = true +let all_goals _ = function GoalEvar -> true | _ -> false +let no_goals ev evi = not (all_goals ev evi) +let no_goals_or_obligations _ = function | GoalEvar | QuestionMark _ -> false | _ -> true let mark_resolvability filter b sigma = Evd.fold_undefined (fun ev evi evs -> - if filter (snd evi.evar_source) then + if filter ev (snd evi.evar_source) then Evd.add evs ev (mark_resolvability_undef b evi) else Evd.add evs ev evi) sigma (Evd.defined_evars sigma) @@ -503,7 +503,7 @@ let mark_resolvables sigma = mark_resolvability all_evars true sigma let has_typeclasses filter evd = Evd.fold_undefined (fun ev evi has -> has || - (filter (snd evi.evar_source) && is_class_evar evd evi && is_resolvable evi)) + (filter ev (snd evi.evar_source) && is_class_evar evd evi && is_resolvable evi)) evd false let solve_instanciations_problem = ref (fun _ _ _ _ _ -> assert false) |
