aboutsummaryrefslogtreecommitdiffhomepage
path: root/proofs
diff options
context:
space:
mode:
Diffstat (limited to 'proofs')
-rw-r--r--proofs/pfedit.ml10
-rw-r--r--proofs/pfedit.mli7
-rw-r--r--proofs/proof_global.ml28
-rw-r--r--proofs/proof_global.mli17
4 files changed, 42 insertions, 20 deletions
diff --git a/proofs/pfedit.ml b/proofs/pfedit.ml
index 86bc44a62..9f2a00135 100644
--- a/proofs/pfedit.ml
+++ b/proofs/pfedit.ml
@@ -20,14 +20,15 @@ let get_current_proof_name = Proof_global.get_current_proof_name
let get_all_proof_names = Proof_global.get_all_proof_names
type lemma_possible_guards = Proof_global.lemma_possible_guards
+type universe_binders = Proof_global.universe_binders
let delete_proof = Proof_global.discard
let delete_current_proof = Proof_global.discard_current
let delete_all_proofs = Proof_global.discard_all
-let start_proof (id : Id.t) str sigma hyps c ?init_tac terminator =
+let start_proof (id : Id.t) ?pl str sigma hyps c ?init_tac terminator =
let goals = [ (Global.env_of_context hyps , c) ] in
- Proof_global.start_proof sigma id str goals terminator;
+ Proof_global.start_proof sigma id ?pl str goals terminator;
let env = Global.env () in
ignore (Proof_global.with_current_proof (fun _ p ->
match init_tac with
@@ -54,6 +55,9 @@ let set_used_variables l =
let get_used_variables () =
Proof_global.get_used_variables ()
+let get_universe_binders () =
+ Proof_global.get_universe_binders ()
+
exception NoSuchGoal
let _ = Errors.register_handler begin function
| NoSuchGoal -> Errors.error "No such goal."
@@ -140,7 +144,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
delete_current_proof ();
- const, status, univs
+ const, status, fst univs
with reraise ->
let reraise = Errors.push reraise in
delete_current_proof ();
diff --git a/proofs/pfedit.mli b/proofs/pfedit.mli
index fc521ea43..d0528c9fd 100644
--- a/proofs/pfedit.mli
+++ b/proofs/pfedit.mli
@@ -55,8 +55,10 @@ val delete_all_proofs : unit -> unit
type lemma_possible_guards = Proof_global.lemma_possible_guards
+type universe_binders = Id.t Loc.located list
+
val start_proof :
- Id.t -> goal_kind -> Evd.evar_map -> named_context_val -> constr ->
+ Id.t -> ?pl:universe_binders -> goal_kind -> Evd.evar_map -> named_context_val -> constr ->
?init_tac:unit Proofview.tactic ->
Proof_global.proof_terminator -> unit
@@ -121,6 +123,9 @@ val set_used_variables :
Id.t list -> Context.section_context * (Loc.t * Names.Id.t) list
val get_used_variables : unit -> Context.section_context option
+(** {6 Universe binders } *)
+val get_universe_binders : unit -> universe_binders option
+
(** {6 ... } *)
(** [solve (SelectNth n) tac] applies tactic [tac] to the [n]th
subgoal of the current focused proof or raises a [UserError] if no
diff --git a/proofs/proof_global.ml b/proofs/proof_global.ml
index 1e0de05dd..31706b3d0 100644
--- a/proofs/proof_global.ml
+++ b/proofs/proof_global.ml
@@ -63,14 +63,14 @@ let _ =
(* Extra info on proofs. *)
type lemma_possible_guards = int list list
-type proof_universes = Evd.evar_universe_context
+type proof_universes = Evd.evar_universe_context * Universes.universe_binders option
+type universe_binders = Id.t Loc.located list
type proof_object = {
id : Names.Id.t;
entries : Safe_typing.private_constants Entries.definition_entry list;
persistence : Decl_kinds.goal_kind;
universes: proof_universes;
- (* constraints : Univ.constraints; *)
}
type proof_ending =
@@ -89,6 +89,7 @@ type pstate = {
proof : Proof.proof;
strength : Decl_kinds.goal_kind;
mode : proof_mode Ephemeron.key;
+ universe_binders: universe_binders option;
}
let make_terminator f = f
@@ -229,7 +230,7 @@ let disactivate_proof_mode mode =
end of the proof to close the proof. The proof is started in the
evar map [sigma] (which can typically contain universe
constraints). *)
-let start_proof sigma id str goals terminator =
+let start_proof sigma id ?pl str goals terminator =
let initial_state = {
pid = id;
terminator = Ephemeron.create terminator;
@@ -237,10 +238,11 @@ let start_proof sigma id str goals terminator =
endline_tactic = None;
section_vars = None;
strength = str;
- mode = find_proof_mode "No" } in
+ mode = find_proof_mode "No";
+ universe_binders = pl } in
push initial_state pstates
-let start_dependent_proof id str goals terminator =
+let start_dependent_proof id ?pl str goals terminator =
let initial_state = {
pid = id;
terminator = Ephemeron.create terminator;
@@ -248,10 +250,12 @@ let start_dependent_proof id str goals terminator =
endline_tactic = None;
section_vars = None;
strength = str;
- mode = find_proof_mode "No" } in
+ mode = find_proof_mode "No";
+ universe_binders = pl } in
push initial_state pstates
let get_used_variables () = (cur_pstate ()).section_vars
+let get_universe_binders () = (cur_pstate ()).universe_binders
let proof_using_auto_clear = ref true
let _ = Goptions.declare_bool_option
@@ -304,7 +308,8 @@ let constrain_variables init uctx =
Univ.ContextSet.add_constraints cstrs (UState.context_set uctx)
let close_proof ~keep_body_ucst_separate ?feedback_id ~now fpl =
- let { pid; section_vars; strength; proof; terminator } = cur_pstate () in
+ let { pid; section_vars; strength; proof; terminator; universe_binders } =
+ cur_pstate () in
let poly = pi2 strength (* Polymorphic *) in
let initial_goals = Proof.initial_goals proof in
let initial_euctx = Proof.initial_euctx proof in
@@ -370,8 +375,13 @@ let close_proof ~keep_body_ucst_separate ?feedback_id ~now fpl =
const_entry_opaque = true;
const_entry_universes = univs;
const_entry_polymorphic = poly})
- fpl initial_goals in
- { id = pid; entries = entries; persistence = strength; universes = universes },
+ fpl initial_goals in
+ let binders =
+ Option.map (fun names -> fst (Evd.universe_context ~names (Evd.from_ctx universes)))
+ universe_binders
+ in
+ { id = pid; entries = entries; persistence = strength;
+ universes = (universes, binders) },
fun pr_ending -> Ephemeron.get terminator pr_ending
type closed_proof_output = (Term.constr * Safe_typing.private_constants) list * Evd.evar_universe_context
diff --git a/proofs/proof_global.mli b/proofs/proof_global.mli
index 3fbcefd0a..5f1158950 100644
--- a/proofs/proof_global.mli
+++ b/proofs/proof_global.mli
@@ -55,18 +55,18 @@ val compact_the_proof : unit -> unit
(i.e. an proof ending command) and registers the appropriate
values. *)
type lemma_possible_guards = int list list
-type proof_universes = Evd.evar_universe_context
+type proof_universes = Evd.evar_universe_context * Universes.universe_binders option
+type universe_binders = Names.Id.t Loc.located list
type proof_object = {
id : Names.Id.t;
entries : Safe_typing.private_constants Entries.definition_entry list;
persistence : Decl_kinds.goal_kind;
universes: proof_universes;
- (* constraints : Univ.constraints; *)
- (** guards : lemma_possible_guards; *)
}
type proof_ending =
- | Admitted of Names.Id.t * Decl_kinds.goal_kind * Entries.parameter_entry * proof_universes
+ | Admitted of Names.Id.t * Decl_kinds.goal_kind * Entries.parameter_entry *
+ proof_universes
| Proved of Vernacexpr.opacity_flag *
(Vernacexpr.lident * Decl_kinds.theorem_kind option) option *
proof_object
@@ -83,14 +83,15 @@ val apply_terminator : proof_terminator -> proof_ending -> unit
closing commands and the xml plugin); [terminator] is used at the
end of the proof to close the proof. *)
val start_proof :
- Evd.evar_map -> Names.Id.t -> Decl_kinds.goal_kind -> (Environ.env * Term.types) list ->
+ Evd.evar_map -> Names.Id.t -> ?pl:universe_binders ->
+ Decl_kinds.goal_kind -> (Environ.env * Term.types) list ->
proof_terminator -> unit
(** Like [start_proof] except that there may be dependencies between
initial goals. *)
val start_dependent_proof :
- Names.Id.t -> Decl_kinds.goal_kind -> Proofview.telescope ->
- proof_terminator -> unit
+ Names.Id.t -> ?pl:universe_binders -> Decl_kinds.goal_kind ->
+ Proofview.telescope -> proof_terminator -> unit
(** Update the proofs global environment after a side-effecting command
(e.g. a sublemma definition) has been run inside it. Assumes
@@ -143,6 +144,8 @@ val set_used_variables :
Names.Id.t list -> Context.section_context * (Loc.t * Names.Id.t) list
val get_used_variables : unit -> Context.section_context option
+val get_universe_binders : unit -> universe_binders option
+
(**********************************************************)
(* *)
(* Proof modes *)
generated by cgit v1.2.3 (git 2.39.1) at 2024-07-08 13:13:51 +0000