diff options
| -rw-r--r-- | pretyping/evd.ml | 7 | ||||
| -rw-r--r-- | pretyping/evd.mli | 2 | ||||
| -rw-r--r-- | proofs/clenv.ml | 4 | ||||
| -rw-r--r-- | proofs/clenv.mli | 2 | ||||
| -rw-r--r-- | tactics/tactics.ml | 4 |
5 files changed, 12 insertions, 7 deletions
diff --git a/pretyping/evd.ml b/pretyping/evd.ml index 4a9466f4f3..c9b9f34414 100644 --- a/pretyping/evd.ml +++ b/pretyping/evd.ml @@ -1550,9 +1550,12 @@ let meta_with_name evd id = let clear_metas evd = {evd with metas = Metamap.empty} -let meta_merge evd1 evd2 = +let meta_merge ?(with_univs = true) evd1 evd2 = let metas = Metamap.fold Metamap.add evd1.metas evd2.metas in - let universes = union_evar_universe_context evd2.universes evd1.universes in + let universes = + if with_univs then union_evar_universe_context evd2.universes evd1.universes + else evd2.universes + in {evd2 with universes; metas; } type metabinding = metavariable * constr * instance_status diff --git a/pretyping/evd.mli b/pretyping/evd.mli index 5c508419a4..117e52958b 100644 --- a/pretyping/evd.mli +++ b/pretyping/evd.mli @@ -451,7 +451,7 @@ val meta_reassign : metavariable -> constr * instance_status -> evar_map -> eva val clear_metas : evar_map -> evar_map (** [meta_merge evd1 evd2] returns [evd2] extended with the metas of [evd1] *) -val meta_merge : evar_map -> evar_map -> evar_map +val meta_merge : ?with_univs:bool -> evar_map -> evar_map -> evar_map val undefined_metas : evar_map -> metavariable list val map_metas_fvalue : (constr -> constr) -> evar_map -> evar_map diff --git a/proofs/clenv.ml b/proofs/clenv.ml index a2cccc0e0b..5de8338ab6 100644 --- a/proofs/clenv.ml +++ b/proofs/clenv.ml @@ -379,12 +379,12 @@ let fchain_flags () = { (default_unify_flags ()) with allow_K_in_toplevel_higher_order_unification = true } -let clenv_fchain ?(flags=fchain_flags ()) mv clenv nextclenv = +let clenv_fchain ?with_univs ?(flags=fchain_flags ()) mv clenv nextclenv = (* Add the metavars of [nextclenv] to [clenv], with their name-environment *) let clenv' = { templval = clenv.templval; templtyp = clenv.templtyp; - evd = meta_merge nextclenv.evd clenv.evd; + evd = meta_merge ?with_univs nextclenv.evd clenv.evd; env = nextclenv.env } in (* unify the type of the template of [nextclenv] with the type of [mv] *) let clenv'' = diff --git a/proofs/clenv.mli b/proofs/clenv.mli index eb10817069..26e803354e 100644 --- a/proofs/clenv.mli +++ b/proofs/clenv.mli @@ -51,7 +51,7 @@ val refresh_undefined_univs : clausenv -> clausenv * Univ.universe_level_subst val connect_clenv : Goal.goal sigma -> clausenv -> clausenv val clenv_fchain : - ?flags:unify_flags -> metavariable -> clausenv -> clausenv -> clausenv + ?with_univs:bool -> ?flags:unify_flags -> metavariable -> clausenv -> clausenv -> clausenv (** {6 Unification with clenvs } *) diff --git a/tactics/tactics.ml b/tactics/tactics.ml index 0a013e95f7..0551787e3a 100644 --- a/tactics/tactics.ml +++ b/tactics/tactics.ml @@ -1319,7 +1319,9 @@ let simplest_elim c = default_elim false None (c,NoBindings) *) let clenv_fchain_in id ?(flags=elim_flags ()) mv elimclause hypclause = - try clenv_fchain ~flags mv elimclause hypclause + (** The evarmap of elimclause is assumed to be an extension of hypclause, so + we do not need to merge the universes coming from hypclause. *) + try clenv_fchain ~with_univs:false ~flags mv elimclause hypclause with PretypeError (env,evd,NoOccurrenceFound (op,_)) -> (* Set the hypothesis name in the message *) raise (PretypeError (env,evd,NoOccurrenceFound (op,Some id))) |