aboutsummaryrefslogtreecommitdiff
path: root/proofs
diff options
context:
space:
mode:
authorMaxime Dénès2017-12-11 11:32:20 +0100
committerMaxime Dénès2017-12-11 11:32:20 +0100
commit340e90e366e002e475fb0e6c4718b8614c95f366 (patch)
tree0313a27a044e39ae6a1ba9f4dedad151fa8ed752 /proofs
parent98c0c64749b6656df2a6522a3277ca2b96ae58ba (diff)
parentea87cce3f81e9b73047c1695ea716162aeb09ede (diff)
Merge PR #6324: Fix #6323: stronger restrict universe context vs abstract.
Diffstat (limited to 'proofs')
-rw-r--r--proofs/pfedit.ml1
-rw-r--r--proofs/proof_global.ml12
2 files changed, 5 insertions, 8 deletions
diff --git a/proofs/pfedit.ml b/proofs/pfedit.ml
index 31a73db04f..6b503a0112 100644
--- a/proofs/pfedit.ml
+++ b/proofs/pfedit.ml
@@ -140,6 +140,7 @@ let build_constant_by_tactic id ctx sign ?(goal_kind = Global, false, Proof Theo
let status = by tac in
let _,(const,univs,_) = cook_proof () in
Proof_global.discard_current ();
+ let univs = UState.demote_seff_univs const univs in
const, status, univs
with reraise ->
let reraise = CErrors.push reraise in
diff --git a/proofs/proof_global.ml b/proofs/proof_global.ml
index 535ef2013d..167d6bda0d 100644
--- a/proofs/proof_global.ml
+++ b/proofs/proof_global.ml
@@ -348,13 +348,9 @@ let close_proof ~keep_body_ucst_separate ?feedback_id ~now
nf t
else t
in
- let used_univs_body = Univops.universes_of_constr body in
- let used_univs_typ = Univops.universes_of_constr typ in
- (* Universes for private constants are relevant to the body *)
- let used_univs_body =
- List.fold_left (fun acc (us,_) -> Univ.LSet.union acc us)
- used_univs_body (Safe_typing.universes_of_private eff)
- in
+ let env = Global.env () in
+ let used_univs_body = Univops.universes_of_constr env body in
+ let used_univs_typ = Univops.universes_of_constr env typ in
if keep_body_ucst_separate ||
not (Safe_typing.empty_private_constants = eff) then
let initunivs = UState.const_univ_entry ~poly initial_euctx in
@@ -362,7 +358,7 @@ let close_proof ~keep_body_ucst_separate ?feedback_id ~now
(* For vi2vo compilation proofs are computed now but we need to
complement the univ constraints of the typ with the ones of
the body. So we keep the two sets distinct. *)
- let used_univs = Univ.LSet.union used_univs_body used_univs_typ in
+ let used_univs = Univ.LSet.union used_univs_body used_univs_typ in
let ctx_body = UState.restrict ctx used_univs in
let univs = UState.check_mono_univ_decl ctx_body universe_decl in
(initunivs, typ), ((body, univs), eff)