diff options
| author | Pierre-Marie Pédrot | 2016-09-14 11:40:15 +0200 |
|---|---|---|
| committer | Pierre-Marie Pédrot | 2016-09-14 11:40:15 +0200 |
| commit | 5e4dc9a1896a1dff832089be20cd43f4f4776869 (patch) | |
| tree | f8661480501f26b7d3dd46e064c1a6084991a280 /proofs | |
| parent | 93a03345830047310d975d5de3742fa58a0a224b (diff) | |
| parent | 3e794be5f02ed438cdc5a351d09bdfb54c0be01a (diff) | |
Merge branch 'v8.6'
Diffstat (limited to 'proofs')
| -rw-r--r-- | proofs/clenvtac.ml | 26 | ||||
| -rw-r--r-- | proofs/redexpr.ml | 2 |
2 files changed, 24 insertions, 4 deletions
diff --git a/proofs/clenvtac.ml b/proofs/clenvtac.ml index 04a2eb4879..98b5bc8b05 100644 --- a/proofs/clenvtac.ml +++ b/proofs/clenvtac.ml @@ -59,6 +59,19 @@ let clenv_pose_dependent_evars with_evars clenv = (RefinerError (UnresolvedBindings (List.map (meta_name clenv.evd) dep_mvs))); clenv_pose_metas_as_evars clenv dep_mvs +(** Use our own fast path, more informative than from Typeclasses *) +let check_tc evd = + let has_resolvable = ref false in + let check _ evi = + let res = Typeclasses.is_resolvable evi in + if res then + let () = has_resolvable := true in + Typeclasses.is_class_evar evd evi + else false + in + let has_typeclass = Evar.Map.exists check (Evd.undefined_map evd) in + (has_typeclass, !has_resolvable) + let clenv_refine with_evars ?(with_classes=true) clenv = (** ppedrot: a Goal.enter here breaks things, because the tactic below may solve goals by side effects, while the compatibility layer keeps those @@ -67,9 +80,16 @@ let clenv_refine with_evars ?(with_classes=true) clenv = let clenv = clenv_pose_dependent_evars with_evars clenv in let evd' = if with_classes then - let evd' = Typeclasses.resolve_typeclasses ~filter:Typeclasses.all_evars - ~fail:(not with_evars) clenv.env clenv.evd - in Typeclasses.mark_unresolvables ~filter:Typeclasses.all_goals evd' + let (has_typeclass, has_resolvable) = check_tc clenv.evd in + let evd' = + if has_typeclass then + Typeclasses.resolve_typeclasses ~fast_path:false ~filter:Typeclasses.all_evars + ~fail:(not with_evars) clenv.env clenv.evd + else clenv.evd + in + if has_resolvable then + Typeclasses.mark_unresolvables ~filter:Typeclasses.all_goals evd' + else evd' else clenv.evd in let clenv = { clenv with evd = evd' } in diff --git a/proofs/redexpr.ml b/proofs/redexpr.ml index 41ad7d94e5..34443b93da 100644 --- a/proofs/redexpr.ml +++ b/proofs/redexpr.ml @@ -44,7 +44,7 @@ let cbv_native env sigma c = let whd_cbn flags env sigma t = let (state,_) = - (whd_state_gen true flags env sigma (t,Reductionops.Stack.empty)) + (whd_state_gen true true flags env sigma (t,Reductionops.Stack.empty)) in Reductionops.Stack.zip ~refold:true state let strong_cbn flags = |