diff options
| author |  msozeau <msozeau@85f007b7-540e-0410-9357-904b9bb8a0f7> | 2012-01-23 20:51:29 +0000 |
|---|---|---|
| committer | msozeau <msozeau@85f007b7-540e-0410-9357-904b9bb8a0f7> | 2012-01-23 20:51:29 +0000 |
| commit | 0a2d03537beaf5ba2ca07176cccba6ce6c6532b2 (patch) | |
| tree | f6be0ce6a2164170ae97853df6ca5dd8386239bb /pretyping | |
| parent | a9521af9d808e345917dd06445362427665a5846 (diff) | |
Fix for Program Instance not separately checking the resolution of evars of the type (mandatory) and the fields (optional)
git-svn-id: svn+ssh://scm.gforge.inria.fr/svn/coq/trunk@14940 85f007b7-540e-0410-9357-904b9bb8a0f7
Diffstat (limited to 'pretyping')
| -rw-r--r-- | pretyping/typeclasses.ml | 17 | ||||
| -rw-r--r-- | pretyping/typeclasses.mli | 1 |
2 files changed, 12 insertions, 6 deletions
diff --git a/pretyping/typeclasses.ml b/pretyping/typeclasses.ml index e85f174e0..d8a09f95c 100644 --- a/pretyping/typeclasses.ml +++ b/pretyping/typeclasses.ml @@ -473,19 +473,24 @@ let is_resolvable evi = assert (evi.evar_body = Evar_empty); Option.default true (resolvable.get evi.evar_extra) -let mark_unresolvable_undef evi = - let t = resolvable.set false evi.evar_extra in +let mark_resolvability_undef b evi = + let t = resolvable.set b evi.evar_extra in { evi with evar_extra = t } -let mark_unresolvable evi = +let mark_resolvability b evi = assert (evi.evar_body = Evar_empty); - mark_unresolvable_undef evi + mark_resolvability_undef false evi -let mark_unresolvables sigma = +let mark_unresolvable evi = mark_resolvability false evi + +let mark_resolvability b sigma = Evd.fold_undefined (fun ev evi evs -> - Evd.add evs ev (mark_unresolvable_undef evi)) + Evd.add evs ev (mark_resolvability_undef b evi)) sigma (Evd.defined_evars sigma) +let mark_unresolvables sigma = mark_resolvability false sigma +let mark_resolvables sigma = mark_resolvability true sigma + let has_typeclasses evd = Evd.fold_undefined (fun ev evi has -> has || (is_class_evar evd evi && is_resolvable evi)) diff --git a/pretyping/typeclasses.mli b/pretyping/typeclasses.mli index 74ccaf834..b49eeac4f 100644 --- a/pretyping/typeclasses.mli +++ b/pretyping/typeclasses.mli @@ -84,6 +84,7 @@ val instance_constructor : typeclass -> constr list -> constr option * types val is_resolvable : evar_info -> bool val mark_unresolvable : evar_info -> evar_info val mark_unresolvables : evar_map -> evar_map +val mark_resolvables : evar_map -> evar_map val is_class_evar : evar_map -> evar_info -> bool val resolve_typeclasses : ?onlyargs:bool -> ?split:bool -> ?fail:bool -> |