diff options
| author |  herbelin <herbelin@85f007b7-540e-0410-9357-904b9bb8a0f7> | 2010-05-13 07:24:56 +0000 |
|---|---|---|
| committer | herbelin <herbelin@85f007b7-540e-0410-9357-904b9bb8a0f7> | 2010-05-13 07:24:56 +0000 |
| commit | 6cca4015db457f91b8eb9cf824f21246cbe7c6e6 (patch) | |
| tree | 18ea61a1332e519db396c527823981e8145fb4c5 /pretyping/unification.ml | |
| parent | 21c1f0f84540b8871e4c43fde114a7aedf165f60 (diff) | |
Improved the efficiency of evars traverals thanks to a split of
evar_map into a map for defined evars and a map for undefined evars.
Even before Spiwack's new proof engine, some Evd.fold were very
costly, e.g. in check_evars or progress_evar_map. With the new proof
engine, undefined evars traversals are apparently even more common (at
least, it improves significantly the complexity of some calls to omega
in JordanCurveTheorem - a new factor 5-7 after the factor 5-6 obtained
by removal of evar_merge in clenv_fchain in commit 13007, arriving to
figures comparable to the 8.3 ones).
git-svn-id: svn+ssh://scm.gforge.inria.fr/svn/coq/trunk@13011 85f007b7-540e-0410-9357-904b9bb8a0f7
Diffstat (limited to 'pretyping/unification.ml')
| -rw-r--r-- | pretyping/unification.ml | 22 |
1 files changed, 12 insertions, 10 deletions
diff --git a/pretyping/unification.ml b/pretyping/unification.ml index 7ae05a85f..b1b925f78 100644 --- a/pretyping/unification.ml +++ b/pretyping/unification.ml @@ -622,8 +622,8 @@ let w_merge env with_types flags (evd,metas,evars) = (* Process evars *) match evars with - | ((evn,_ as ev),rhs)::evars' -> - if is_defined_evar evd ev then + | ((evk,_ as ev),rhs)::evars' -> + if Evd.is_defined evd evk then let v = Evd.existential_value evd ev in let (evd,metas',evars'') = unify_0 env evd topconv flags rhs v in @@ -632,15 +632,17 @@ let w_merge env with_types flags (evd,metas,evars) = let rhs' = subst_meta_instances metas rhs in match kind_of_term rhs with | App (f,cl) when occur_meta rhs' -> - if occur_evar evn rhs' then - error_occur_check env evd evn rhs'; + if occur_evar evk rhs' then + error_occur_check env evd evk rhs'; if is_mimick_head f then - let evd' = mimick_evar evd flags f (Array.length cl) evn in - w_merge_rec evd' metas evars eqns + let evd' = + mimick_undefined_evar evd flags f (Array.length cl) evk in + w_merge_rec evd' metas evars eqns else let evd', rhs'' = pose_all_metas_as_evars env evd rhs' in - w_merge_rec (solve_simple_evar_eqn env evd' ev rhs'') - metas evars' eqns + w_merge_rec (solve_simple_evar_eqn env evd' ev rhs'') + metas evars' eqns + | _ -> w_merge_rec (solve_simple_evar_eqn env evd ev rhs') metas evars' eqns @@ -682,8 +684,8 @@ let w_merge env with_types flags (evd,metas,evars) = w_merge_rec evd metas evars eqns | [] -> evd - and mimick_evar evd flags hdc nargs sp = - let ev = Evd.find evd sp in + and mimick_undefined_evar evd flags hdc nargs sp = + let ev = Evd.find_undefined evd sp in let sp_env = Global.env_of_context ev.evar_hyps in let (evd', c) = applyHead sp_env evd nargs hdc in let (evd'',mc,ec) = |