diff options
| author | Matthieu Sozeau | 2014-07-03 16:06:45 +0200 |
|---|---|---|
| committer | Matthieu Sozeau | 2014-07-03 16:06:45 +0200 |
| commit | f222f46e7d231c5afe72e146de92dc8dcadbdcb6 (patch) | |
| tree | 2906793aada2899d1ebca4714371901cca44be59 | |
| parent | 964d1b702e5696d2b6767f972310cc324a6a4aa9 (diff) | |
When defining a monomorphic Program, do not allow arbitrary instantiations
of the universe context in the obligations, it gets gradually fixed
globally by each one of them.
Fixes bug found in Misc/Overloading.
| -rw-r--r-- | pretyping/evd.ml | 7 | ||||
| -rw-r--r-- | pretyping/evd.mli | 2 | ||||
| -rw-r--r-- | toplevel/obligations.ml | 7 |
3 files changed, 11 insertions, 5 deletions
diff --git a/pretyping/evd.ml b/pretyping/evd.ml index b2bad0c0ba..ed3459a524 100644 --- a/pretyping/evd.ml +++ b/pretyping/evd.ml @@ -1155,16 +1155,15 @@ let normalize_evar_universe_context_variables uctx = (* let normalize_evar_universe_context_variables = *) (* Profile.profile1 normvarsconstrkey normalize_evar_universe_context_variables;; *) -let mark_undefs_as_nonalg uctx = +let abstract_undefined_variables uctx = let vars' = Univ.LMap.fold (fun u v acc -> if v == None then Univ.LSet.remove u acc else acc) uctx.uctx_univ_variables uctx.uctx_univ_algebraic - in { uctx with uctx_univ_algebraic = vars' } + in { uctx with uctx_local = Univ.ContextSet.empty; + uctx_univ_algebraic = vars' } -let abstract_undefined_variables evd = - {evd with universes = mark_undefs_as_nonalg evd.universes} let refresh_undefined_univ_variables uctx = let subst, ctx' = Universes.fresh_universe_context_set_instance uctx.uctx_local in diff --git a/pretyping/evd.mli b/pretyping/evd.mli index a44a67656b..5aa8a13d70 100644 --- a/pretyping/evd.mli +++ b/pretyping/evd.mli @@ -478,7 +478,7 @@ val merge_universe_subst : evar_map -> Universes.universe_opt_subst -> evar_map val with_context_set : rigid -> evar_map -> 'a Univ.in_universe_context_set -> evar_map * 'a val nf_univ_variables : evar_map -> evar_map * Univ.universe_subst -val abstract_undefined_variables : evar_map -> evar_map +val abstract_undefined_variables : evar_universe_context -> evar_universe_context val refresh_undefined_universes : evar_map -> evar_map * Univ.universe_level_subst diff --git a/toplevel/obligations.ml b/toplevel/obligations.ml index fc1df9f00d..8f637aa325 100644 --- a/toplevel/obligations.ml +++ b/toplevel/obligations.ml @@ -833,6 +833,13 @@ let rec solve_obligation prg num tac = in let obls = Array.copy obls in let _ = obls.(num) <- obl in + let ctx' = + if not (pi2 prg.prg_kind) (* Not polymorphic *) then + (* This context is already declared globally, we cannot + instantiate the rigid variables anymore *) + Evd.abstract_undefined_variables ctx' + else ctx' + in let res = try update_obls {prg with prg_body = prg.prg_body; |