diff options
| author | msozeau | 2008-07-28 09:10:41 +0000 |
|---|---|---|
| committer | msozeau | 2008-07-28 09:10:41 +0000 |
| commit | 14c5325d2e94d9d60c47af734579731abb74573f (patch) | |
| tree | b84cd0c230314a7c8306c18655fc30484ddf2999 /pretyping | |
| parent | da84cdafe0ef6d82d27fbbcc87f7a78b210d5b97 (diff) | |
Fix bug in term dnet preventing some unifications. Allow "higher-order"
class constraints of the form Π x1 ... xn, Class args.
git-svn-id: svn+ssh://scm.gforge.inria.fr/svn/coq/trunk@11278 85f007b7-540e-0410-9357-904b9bb8a0f7
Diffstat (limited to 'pretyping')
| -rw-r--r-- | pretyping/typeclasses.ml | 11 | ||||
| -rw-r--r-- | pretyping/typeclasses.mli | 1 |
2 files changed, 10 insertions, 2 deletions
diff --git a/pretyping/typeclasses.ml b/pretyping/typeclasses.ml index 0d15034ce5..04b34db383 100644 --- a/pretyping/typeclasses.ml +++ b/pretyping/typeclasses.ml @@ -357,10 +357,17 @@ let mark_unresolvables sigma = Evd.add evs ev (mark_unresolvable evi)) sigma Evd.empty +let rec is_class_type c = + match kind_of_term c with + | Prod (_, _, t) -> is_class_type t + | _ -> class_of_constr c <> None + +let is_class_evar evi = + is_class_type evi.Evd.evar_concl + let has_typeclasses evd = Evd.fold (fun ev evi has -> has || - (evi.evar_body = Evar_empty && class_of_constr evi.evar_concl <> None - && is_resolvable evi)) + (evi.evar_body = Evar_empty && is_class_evar evi && is_resolvable evi)) evd false let solve_instanciations_problem = ref (fun _ _ _ _ _ -> assert false) diff --git a/pretyping/typeclasses.mli b/pretyping/typeclasses.mli index 8960ab21b6..ce0975c69e 100644 --- a/pretyping/typeclasses.mli +++ b/pretyping/typeclasses.mli @@ -75,6 +75,7 @@ val bool_out : Dyn.t -> bool val is_resolvable : evar_info -> bool val mark_unresolvable : evar_info -> evar_info val mark_unresolvables : evar_map -> evar_map +val is_class_evar : evar_info -> bool val resolve_typeclasses : ?onlyargs:bool -> ?split:bool -> ?fail:bool -> env -> evar_defs -> evar_defs |