aboutsummaryrefslogtreecommitdiff
path: root/engine
diff options
context:
space:
mode:
Diffstat (limited to 'engine')
-rw-r--r--engine/eConstr.ml1
-rw-r--r--engine/eConstr.mli4
-rw-r--r--engine/evar_kinds.ml3
-rw-r--r--engine/evarutil.ml2
-rw-r--r--engine/evarutil.mli6
-rw-r--r--engine/evd.ml32
-rw-r--r--engine/evd.mli2
-rw-r--r--engine/termops.mli8
-rw-r--r--engine/universes.ml60
-rw-r--r--engine/universes.mli18
10 files changed, 60 insertions, 76 deletions
diff --git a/engine/eConstr.ml b/engine/eConstr.ml
index a72bdee123..d30cb74d7a 100644
--- a/engine/eConstr.ml
+++ b/engine/eConstr.ml
@@ -500,6 +500,7 @@ let eq_universes env sigma cstrs cv_pb ref nargs l l' =
let l = Evd.normalize_universe_instance sigma l
and l' = Evd.normalize_universe_instance sigma l' in
let open Universes in
+ let open GlobRef in
match ref with
| VarRef _ -> assert false (* variables don't have instances *)
| ConstRef _ ->
diff --git a/engine/eConstr.mli b/engine/eConstr.mli
index 9a5b5ec3a3..743888a9be 100644
--- a/engine/eConstr.mli
+++ b/engine/eConstr.mli
@@ -284,9 +284,9 @@ val map_rel_context_in_env :
(* XXX Missing Sigma proxy *)
val fresh_global :
?loc:Loc.t -> ?rigid:Evd.rigid -> ?names:Univ.Instance.t -> Environ.env ->
- Evd.evar_map -> Globnames.global_reference -> Evd.evar_map * t
+ Evd.evar_map -> GlobRef.t -> Evd.evar_map * t
-val is_global : Evd.evar_map -> Globnames.global_reference -> t -> bool
+val is_global : Evd.evar_map -> GlobRef.t -> t -> bool
(** {5 Extra} *)
diff --git a/engine/evar_kinds.ml b/engine/evar_kinds.ml
index c964ecf1f5..6e123d6429 100644
--- a/engine/evar_kinds.ml
+++ b/engine/evar_kinds.ml
@@ -9,7 +9,6 @@
(************************************************************************)
open Names
-open Globnames
open Misctypes
(** The kinds of existential variable *)
@@ -24,7 +23,7 @@ type matching_var_kind = FirstOrderPatVar of patvar | SecondOrderPatVar of patva
type subevar_kind = Domain | Codomain | Body
type t =
- | ImplicitArg of global_reference * (int * Id.t option)
+ | ImplicitArg of GlobRef.t * (int * Id.t option)
* bool (** Force inference *)
| BinderType of Name.t
| NamedHole of Id.t (* coming from some ?[id] syntax *)
diff --git a/engine/evarutil.ml b/engine/evarutil.ml
index 710491f848..6c27d59375 100644
--- a/engine/evarutil.ml
+++ b/engine/evarutil.ml
@@ -534,7 +534,7 @@ type clear_dependency_error =
| OccurHypInSimpleClause of Id.t option
| EvarTypingBreak of existential
-exception ClearDependencyError of Id.t * clear_dependency_error * Globnames.global_reference option
+exception ClearDependencyError of Id.t * clear_dependency_error * GlobRef.t option
exception Depends of Id.t
diff --git a/engine/evarutil.mli b/engine/evarutil.mli
index e3e8f16c8b..3bbd2923c1 100644
--- a/engine/evarutil.mli
+++ b/engine/evarutil.mli
@@ -78,8 +78,8 @@ val restrict_evar : evar_map -> Evar.t -> Filter.t ->
(** Polymorphic constants *)
-val new_global : evar_map -> Globnames.global_reference -> evar_map * constr
-val e_new_global : evar_map ref -> Globnames.global_reference -> constr
+val new_global : evar_map -> GlobRef.t -> evar_map * constr
+val e_new_global : evar_map ref -> GlobRef.t -> constr
(** Create a fresh evar in a context different from its definition context:
[new_evar_instance sign evd ty inst] creates a new evar of context
@@ -235,7 +235,7 @@ type clear_dependency_error =
| OccurHypInSimpleClause of Id.t option
| EvarTypingBreak of Constr.existential
-exception ClearDependencyError of Id.t * clear_dependency_error * Globnames.global_reference option
+exception ClearDependencyError of Id.t * clear_dependency_error * GlobRef.t option
val clear_hyps_in_evi : env -> evar_map ref -> named_context_val -> types ->
Id.Set.t -> named_context_val * types
diff --git a/engine/evd.ml b/engine/evd.ml
index 6dcec2760b..af22de5cd4 100644
--- a/engine/evd.ml
+++ b/engine/evd.ml
@@ -1290,30 +1290,14 @@ module MiniEConstr = struct
let unsafe_eq = Refl
let to_constr ?(abort_on_undefined_evars=true) sigma c =
- let rec to_constr c = match Constr.kind c with
- | Evar ev ->
- begin match safe_evar_value sigma ev with
- | Some c -> to_constr c
- | None ->
- if abort_on_undefined_evars then
- anomaly ~label:"econstr" Pp.(str "grounding a non evar-free term")
- else
- Constr.map (fun c -> to_constr c) c
- end
- | Sort (Sorts.Type u) ->
- let u' = normalize_universe sigma u in
- if u' == u then c else mkSort (Sorts.sort_of_univ u')
- | Const (c', u) when not (Univ.Instance.is_empty u) ->
- let u' = normalize_universe_instance sigma u in
- if u' == u then c else mkConstU (c', u')
- | Ind (i, u) when not (Univ.Instance.is_empty u) ->
- let u' = normalize_universe_instance sigma u in
- if u' == u then c else mkIndU (i, u')
- | Construct (co, u) when not (Univ.Instance.is_empty u) ->
- let u' = normalize_universe_instance sigma u in
- if u' == u then c else mkConstructU (co, u')
- | _ -> Constr.map (fun c -> to_constr c) c
- in to_constr c
+ let evar_value =
+ if not abort_on_undefined_evars then fun ev -> safe_evar_value sigma ev
+ else fun ev ->
+ match safe_evar_value sigma ev with
+ | Some _ as v -> v
+ | None -> anomaly ~label:"econstr" Pp.(str "grounding a non evar-free term")
+ in
+ Universes.nf_evars_and_universes_opt_subst evar_value (universe_subst sigma) c
let of_named_decl d = d
let unsafe_to_named_decl d = d
diff --git a/engine/evd.mli b/engine/evd.mli
index 5ce16459c2..509db525d9 100644
--- a/engine/evd.mli
+++ b/engine/evd.mli
@@ -649,7 +649,7 @@ val fresh_inductive_instance : ?loc:Loc.t -> env -> evar_map -> inductive -> eva
val fresh_constructor_instance : ?loc:Loc.t -> env -> evar_map -> constructor -> evar_map * pconstructor
val fresh_global : ?loc:Loc.t -> ?rigid:rigid -> ?names:Univ.Instance.t -> env ->
- evar_map -> Globnames.global_reference -> evar_map * econstr
+ evar_map -> GlobRef.t -> evar_map * econstr
(********************************************************************)
(* constr with holes and pending resolution of classes, conversion *)
diff --git a/engine/termops.mli b/engine/termops.mli
index 3b0c4bba64..e2ddcd36e7 100644
--- a/engine/termops.mli
+++ b/engine/termops.mli
@@ -112,7 +112,7 @@ val dependent_in_decl : Evd.evar_map -> constr -> named_declaration -> bool
val count_occurrences : Evd.evar_map -> constr -> constr -> int
val collect_metas : Evd.evar_map -> constr -> int list
val collect_vars : Evd.evar_map -> constr -> Id.Set.t (** for visible vars only *)
-val vars_of_global_reference : env -> Globnames.global_reference -> Id.Set.t
+val vars_of_global_reference : env -> GlobRef.t -> Id.Set.t
val occur_term : Evd.evar_map -> constr -> constr -> bool (** Synonymous of dependent *)
[@@ocaml.deprecated "alias of Termops.dependent"]
@@ -261,7 +261,7 @@ val clear_named_body : Id.t -> env -> env
val global_vars : env -> Evd.evar_map -> constr -> Id.t list
val global_vars_set : env -> Evd.evar_map -> constr -> Id.Set.t
val global_vars_set_of_decl : env -> Evd.evar_map -> named_declaration -> Id.Set.t
-val global_app_of_constr : Evd.evar_map -> constr -> (Globnames.global_reference * EInstance.t) * constr option
+val global_app_of_constr : Evd.evar_map -> constr -> (GlobRef.t * EInstance.t) * constr option
(** Gives an ordered list of hypotheses, closed by dependencies,
containing a given set *)
@@ -270,9 +270,9 @@ val dependency_closure : env -> Evd.evar_map -> named_context -> Id.Set.t -> Id.
(** Test if an identifier is the basename of a global reference *)
val is_section_variable : Id.t -> bool
-val global_of_constr : Evd.evar_map -> constr -> Globnames.global_reference * EInstance.t
+val global_of_constr : Evd.evar_map -> constr -> GlobRef.t * EInstance.t
-val is_global : Evd.evar_map -> Globnames.global_reference -> constr -> bool
+val is_global : Evd.evar_map -> GlobRef.t -> constr -> bool
val isGlobalRef : Evd.evar_map -> constr -> bool
diff --git a/engine/universes.ml b/engine/universes.ml
index e987087242..938f5ad9cb 100644
--- a/engine/universes.ml
+++ b/engine/universes.ml
@@ -74,7 +74,7 @@ let subst_ubinder (subst,(ref,l as orig)) =
let discharge_ubinder (_,(ref,l)) =
Some (Lib.discharge_global ref, l)
-let ubinder_obj : Globnames.global_reference * universe_binders -> Libobject.obj =
+let ubinder_obj : GlobRef.t * universe_binders -> Libobject.obj =
let open Libobject in
declare_object { (default_object "universe binder") with
cache_function = cache_ubinder;
@@ -592,35 +592,6 @@ let subst_univs_constr =
CProfile.profile2 subst_univs_constr_key subst_univs_constr
else subst_univs_constr
-let subst_univs_fn_puniverses lsubst (c, u as cu) =
- let u' = Instance.subst_fn lsubst u in
- if u' == u then cu else (c, u')
-
-let nf_evars_and_universes_opt_subst f subst =
- let subst = fun l -> match LMap.find l subst with None -> raise Not_found | Some l' -> l' in
- let lsubst = level_subst_of subst in
- let rec aux c =
- match kind c with
- | Evar (evk, args) ->
- let args = Array.map aux args in
- (match try f (evk, args) with Not_found -> None with
- | None -> c
- | Some c -> aux c)
- | Const pu ->
- let pu' = subst_univs_fn_puniverses lsubst pu in
- if pu' == pu then c else mkConstU pu'
- | Ind pu ->
- let pu' = subst_univs_fn_puniverses lsubst pu in
- if pu' == pu then c else mkIndU pu'
- | Construct pu ->
- let pu' = subst_univs_fn_puniverses lsubst pu in
- if pu' == pu then c else mkConstructU pu'
- | Sort (Type u) ->
- let u' = Univ.subst_univs_universe subst u in
- if u' == u then c else mkSort (sort_of_univ u')
- | _ -> Constr.map aux c
- in aux
-
let fresh_universe_context_set_instance ctx =
if ContextSet.is_empty ctx then LMap.empty, ctx
else
@@ -679,6 +650,35 @@ let normalize_opt_subst ctx =
type universe_opt_subst = Universe.t option universe_map
+let subst_univs_fn_puniverses f (c, u as cu) =
+ let u' = Instance.subst_fn f u in
+ if u' == u then cu else (c, u')
+
+let nf_evars_and_universes_opt_subst f subst =
+ let subst = normalize_univ_variable_opt_subst (ref subst) in
+ let lsubst = level_subst_of subst in
+ let rec aux c =
+ match kind c with
+ | Evar (evk, args) ->
+ let args = Array.map aux args in
+ (match try f (evk, args) with Not_found -> None with
+ | None -> mkEvar (evk, args)
+ | Some c -> aux c)
+ | Const pu ->
+ let pu' = subst_univs_fn_puniverses lsubst pu in
+ if pu' == pu then c else mkConstU pu'
+ | Ind pu ->
+ let pu' = subst_univs_fn_puniverses lsubst pu in
+ if pu' == pu then c else mkIndU pu'
+ | Construct pu ->
+ let pu' = subst_univs_fn_puniverses lsubst pu in
+ if pu' == pu then c else mkConstructU pu'
+ | Sort (Type u) ->
+ let u' = Univ.subst_univs_universe subst u in
+ if u' == u then c else mkSort (sort_of_univ u')
+ | _ -> Constr.map aux c
+ in aux
+
let make_opt_subst s =
fun x ->
(match Univ.LMap.find x s with
diff --git a/engine/universes.mli b/engine/universes.mli
index a0a7749f8b..e6bee42bb3 100644
--- a/engine/universes.mli
+++ b/engine/universes.mli
@@ -37,8 +37,8 @@ type universe_binders = Univ.Level.t Names.Id.Map.t
val empty_binders : universe_binders
-val register_universe_binders : Globnames.global_reference -> universe_binders -> unit
-val universe_binders_of_global : Globnames.global_reference -> universe_binders
+val register_universe_binders : GlobRef.t -> universe_binders -> unit
+val universe_binders_of_global : GlobRef.t -> universe_binders
type univ_name_list = Misctypes.lname list
@@ -48,7 +48,7 @@ type univ_name_list = Misctypes.lname list
May error if the lengths mismatch.
Otherwise return [universe_binders_of_global ref]. *)
-val universe_binders_with_opt_names : Globnames.global_reference ->
+val universe_binders_with_opt_names : Names.GlobRef.t ->
Univ.Level.t list -> univ_name_list option -> universe_binders
(** The global universe counter *)
@@ -132,7 +132,7 @@ val fresh_inductive_instance : env -> inductive ->
val fresh_constructor_instance : env -> constructor ->
pconstructor in_universe_context_set
-val fresh_global_instance : ?names:Univ.Instance.t -> env -> Globnames.global_reference ->
+val fresh_global_instance : ?names:Univ.Instance.t -> env -> GlobRef.t ->
constr in_universe_context_set
val fresh_global_or_constr_instance : env -> Globnames.global_reference_or_constr ->
@@ -144,9 +144,9 @@ val fresh_universe_context_set_instance : ContextSet.t ->
universe_level_subst * ContextSet.t
(** Raises [Not_found] if not a global reference. *)
-val global_of_constr : constr -> Globnames.global_reference puniverses
+val global_of_constr : constr -> GlobRef.t puniverses
-val constr_of_global_univ : Globnames.global_reference puniverses -> constr
+val constr_of_global_univ : GlobRef.t puniverses -> constr
val extend_context : 'a in_universe_context_set -> ContextSet.t ->
'a in_universe_context_set
@@ -204,16 +204,16 @@ val normalize_universe_subst : universe_subst ref ->
the constraints should be properly added to an evd.
See Evd.fresh_global, Evarutil.new_global, and pf_constr_of_global for
the proper way to get a fresh copy of a global reference. *)
-val constr_of_global : Globnames.global_reference -> constr
+val constr_of_global : GlobRef.t -> constr
(** ** DEPRECATED ** synonym of [constr_of_global] *)
-val constr_of_reference : Globnames.global_reference -> constr
+val constr_of_reference : GlobRef.t -> constr
[@@ocaml.deprecated "synonym of [constr_of_global]"]
(** Returns the type of the global reference, by creating a fresh instance of polymorphic
references and computing their instantiated universe context. (side-effect on the
universe counter, use with care). *)
-val type_of_global : Globnames.global_reference -> types in_universe_context_set
+val type_of_global : GlobRef.t -> types in_universe_context_set
(** Full universes substitutions into terms *)
generated by cgit v1.2.3 (git 2.25.1) at 2026-05-02 16:26:35 +0000