Skip to content
New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

[add-const] do not recompute the uctx for the evar map #651

Merged
merged 1 commit into from
Jul 17, 2024
Merged
Show file tree
Hide file tree
Changes from all commits
Commits
File filter

Filter by extension

Filter by extension

Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
3 changes: 2 additions & 1 deletion builtin-doc/coq-builtin.elpi
Original file line number Diff line number Diff line change
Expand Up @@ -804,7 +804,8 @@ external pred coq.env.add-axiom i:id, i:term, o:constant.

% [coq.env.add-section-variable Name Ty C] Declare a new section variable: C
% gets a constant derived from Name
% and the current module
% and the current module.
%
external pred coq.env.add-section-variable i:id, i:term, o:constant.

% [coq.env.add-indt Decl I] Declares an inductive type.
Expand Down
49 changes: 35 additions & 14 deletions src/coq_elpi_HOAS.ml
Original file line number Diff line number Diff line change
Expand Up @@ -864,8 +864,8 @@ module CoqEngine_HOAS : sig

(* when the env changes under the hood, we can adapt sigma or drop it but keep
its constraints *)
val from_env_keep_univ_of_sigma : env0:Environ.env -> env:Environ.env -> Evd.evar_map -> coq_engine
val from_env_keep_univ_and_sigma : env0:Environ.env -> env:Environ.env -> Evd.evar_map -> coq_engine
val from_env_keep_univ_of_sigma : uctx:Univ.ContextSet.t -> env0:Environ.env -> env:Environ.env -> Evd.evar_map -> coq_engine
val from_env_keep_univ_and_sigma : uctx:Univ.ContextSet.t -> env0:Environ.env -> env:Environ.env -> Evd.evar_map -> coq_engine

end = struct

Expand All @@ -882,16 +882,24 @@ let show_coq_engine ?with_univs e = Format.asprintf "%a" (pp_coq_engine ?with_un

let from_env env = from_env_sigma env (Evd.from_env env)

let from_env_keep_univ_and_sigma ~env0 ~env sigma0 =

[%%if coq = "8.19" || coq = "8.20"]
let demote uctx sigma0 env =
let uctx = UState.update_sigma_univs (Evd.evar_universe_context sigma0) (Environ.universes env) in
UState.demote_global_univs env uctx
[%%else]
let demote uctx sigma0 env =
UState.demote_global_univs uctx (Evd.evar_universe_context sigma0)
[%%endif]

let from_env_keep_univ_and_sigma ~uctx ~env0 ~env sigma0 =
assert(env0 != env);
let uctx = UState.update_sigma_univs (Evd.evar_universe_context sigma0) (Environ.universes env) in
let uctx = UState.demote_global_univs env uctx in
let uctx = demote uctx sigma0 env in
from_env_sigma env (Evd.set_universe_context sigma0 uctx)

let from_env_keep_univ_of_sigma ~env0 ~env sigma0 =
let from_env_keep_univ_of_sigma ~uctx ~env0 ~env sigma0 =
assert(env0 != env);
let uctx = UState.update_sigma_univs (Evd.evar_universe_context sigma0) (Environ.universes env) in
let uctx = UState.demote_global_univs env uctx in
let uctx = demote uctx sigma0 env in
from_env_sigma env (Evd.from_ctx uctx)

let init () =
Expand Down Expand Up @@ -2243,16 +2251,16 @@ let lp2constr syntactic_constraints coq_ctx ~depth state t =
let set_sigma state sigma = S.update engine state (fun x -> { x with sigma })

(* We reset the evar map since it depends on the env in which it was created *)
let grab_global_env state =
let grab_global_env ~uctx state =
let env0 = get_global_env state in
let env = Global.env () in
if env == env0 then state
else
if Environ.universes env0 == Environ.universes env then
let state = S.set engine state (CoqEngine_HOAS.from_env_sigma env (get_sigma state)) in
let state = S.set engine state (CoqEngine_HOAS.from_env_sigma env (get_sigma state)) in
state
else
let state = S.set engine state (CoqEngine_HOAS.from_env_keep_univ_and_sigma ~env0 ~env (get_sigma state)) in
let state = S.set engine state (CoqEngine_HOAS.from_env_keep_univ_and_sigma ~uctx ~env0 ~env (get_sigma state)) in
state
let grab_global_env_drop_univs_and_sigma state =
let env0 = get_global_env state in
Expand All @@ -2267,12 +2275,25 @@ let grab_global_env_drop_sigma state =
let env0 = get_global_env state in
let env = Global.env () in
if env == env0 then state
else
let state = S.set engine state (CoqEngine_HOAS.from_env_keep_univ_of_sigma ~env0 ~env (get_sigma state)) in
else begin
let sigma = get_sigma state in
let ustate = Evd.evar_universe_context sigma in
let state = S.set engine state (CoqEngine_HOAS.from_env_sigma env (Evd.from_ctx ustate)) in
let state = UVMap.empty state in
state
end


let grab_global_env_drop_sigma_keep_univs ~uctx state =
let env0 = get_global_env state in
let env = Global.env () in
if env == env0 then state
else begin
let sigma = get_sigma state in
let state = S.set engine state (CoqEngine_HOAS.from_env_keep_univ_of_sigma ~uctx ~env0 ~env sigma) in
let state = UVMap.empty state in
state
end

let solvec = E.Constants.declare_global_symbol "solve"
let msolvec = E.Constants.declare_global_symbol "msolve"
let goalc = E.Constants.declare_global_symbol "goal"
Expand Down
3 changes: 2 additions & 1 deletion src/coq_elpi_HOAS.mli
Original file line number Diff line number Diff line change
Expand Up @@ -296,9 +296,10 @@ val body_of_constant :
State.t -> Names.Constant.t -> UVars.Instance.t option ->
State.t * EConstr.t option * UVars.Instance.t option

val grab_global_env : State.t -> State.t
val grab_global_env : uctx:Univ.ContextSet.t -> State.t -> State.t
val grab_global_env_drop_univs_and_sigma : State.t -> State.t
val grab_global_env_drop_sigma : State.t -> State.t
val grab_global_env_drop_sigma_keep_univs : uctx:Univ.ContextSet.t -> State.t -> State.t

val mk_decl : depth:int -> Name.t -> ty:term -> term
(* Adds an Arg for the normal form with ctx_len context entry vars in scope *)
Expand Down
Loading
Loading