diff options
| author | Pierre-Marie Pédrot | 2016-09-09 16:37:35 +0200 |
|---|---|---|
| committer | Pierre-Marie Pédrot | 2016-09-09 17:07:39 +0200 |
| commit | ff980722521812d19bc1e25cd504567b4a6b549a (patch) | |
| tree | 548c8e5b872305ee6e10bc007a0a940a7e18ccd7 /pretyping | |
| parent | 306dfe775009681e492a2a59e3dcdc5b67bd9d73 (diff) | |
Fast path in Clenvtac.clenv_refine typeclass resolution.
This legacy function is still used by destruct, and is a hotspot in various
examples from the wild. We hijack the check from Typeclass and perform a
double check at once not to mark unresolvable evars in vain a lot.
Diffstat (limited to 'pretyping')
| -rw-r--r-- | pretyping/typeclasses.ml | 4 | ||||
| -rw-r--r-- | pretyping/typeclasses.mli | 2 |
2 files changed, 3 insertions, 3 deletions
diff --git a/pretyping/typeclasses.ml b/pretyping/typeclasses.ml index 4ae72a5151..31ef3dfdd7 100644 --- a/pretyping/typeclasses.ml +++ b/pretyping/typeclasses.ml @@ -548,7 +548,7 @@ let solve_all_instances env evd filter unique split fail = (* let solve_classeskey = Profile.declare_profile "solve_typeclasses" *) (* let solve_problem = Profile.profile5 solve_classeskey solve_problem *) -let resolve_typeclasses ?(filter=no_goals) ?(unique=get_typeclasses_unique_solutions ()) +let resolve_typeclasses ?(fast_path = true) ?(filter=no_goals) ?(unique=get_typeclasses_unique_solutions ()) ?(split=true) ?(fail=true) env evd = - if not (has_typeclasses filter evd) then evd + if fast_path && not (has_typeclasses filter evd) then evd else solve_all_instances env evd filter unique split fail diff --git a/pretyping/typeclasses.mli b/pretyping/typeclasses.mli index 25460ef7d3..2530f5dfae 100644 --- a/pretyping/typeclasses.mli +++ b/pretyping/typeclasses.mli @@ -101,7 +101,7 @@ val mark_resolvable : evar_info -> evar_info val is_class_evar : evar_map -> evar_info -> bool val is_class_type : evar_map -> types -> bool -val resolve_typeclasses : ?filter:evar_filter -> ?unique:bool -> +val resolve_typeclasses : ?fast_path:bool -> ?filter:evar_filter -> ?unique:bool -> ?split:bool -> ?fail:bool -> env -> evar_map -> evar_map val resolve_one_typeclass : ?unique:bool -> env -> evar_map -> types -> open_constr |