aboutsummaryrefslogtreecommitdiff
path: root/engine
diff options
context:
space:
mode:
Diffstat (limited to 'engine')
-rw-r--r--engine/eConstr.ml5
-rw-r--r--engine/eConstr.mli1
-rw-r--r--engine/evarutil.ml170
-rw-r--r--engine/evarutil.mli11
-rw-r--r--engine/evd.ml2
-rw-r--r--engine/proofview.ml30
-rw-r--r--engine/termops.ml12
-rw-r--r--engine/termops.mli10
-rw-r--r--engine/uState.ml22
-rw-r--r--engine/universes.ml78
-rw-r--r--engine/universes.mli5
11 files changed, 280 insertions, 66 deletions
diff --git a/engine/eConstr.ml b/engine/eConstr.ml
index a65b3941ef..9ac16b5b48 100644
--- a/engine/eConstr.ml
+++ b/engine/eConstr.ml
@@ -695,6 +695,10 @@ let cast_rel_context :
type a b. (a,b) eq -> (a, a) Rel.pt -> (b, b) Rel.pt =
fun Refl x -> x
+let cast_rec_decl :
+ type a b. (a,b) eq -> (a, a) Constr.prec_declaration -> (b, b) Constr.prec_declaration =
+ fun Refl x -> x
+
let cast_named_decl :
type a b. (a,b) eq -> (a, a) Named.Declaration.pt -> (b, b) Named.Declaration.pt =
fun Refl x -> x
@@ -817,6 +821,7 @@ let it_mkLambda_or_LetIn t ctx = List.fold_left (fun c d -> mkLambda_or_LetIn d
let push_rel d e = push_rel (cast_rel_decl unsafe_eq d) e
let push_rel_context d e = push_rel_context (cast_rel_context unsafe_eq d) e
+let push_rec_types d e = push_rec_types (cast_rec_decl unsafe_eq d) e
let push_named d e = push_named (cast_named_decl unsafe_eq d) e
let push_named_context d e = push_named_context (cast_named_context unsafe_eq d) e
let push_named_context_val d e = push_named_context_val (cast_named_decl unsafe_eq d) e
diff --git a/engine/eConstr.mli b/engine/eConstr.mli
index 30de748a19..6fa338c73d 100644
--- a/engine/eConstr.mli
+++ b/engine/eConstr.mli
@@ -251,6 +251,7 @@ end
val push_rel : rel_declaration -> env -> env
val push_rel_context : rel_context -> env -> env
+val push_rec_types : (t, t) Constr.prec_declaration -> env -> env
val push_named : named_declaration -> env -> env
val push_named_context : named_context -> env -> env
diff --git a/engine/evarutil.ml b/engine/evarutil.ml
index 3445b744a1..f82ffccdc3 100644
--- a/engine/evarutil.ml
+++ b/engine/evarutil.ml
@@ -257,22 +257,6 @@ let make_pure_subst evi args =
* we have the property that u and phi(t) are convertible in env.
*)
-let csubst_subst (k, s) c =
- (** Safe because this is a substitution *)
- let c = EConstr.Unsafe.to_constr c in
- let rec subst n c = match Constr.kind c with
- | Rel m ->
- if m <= n then c
- else if m - n <= k then EConstr.Unsafe.to_constr (Int.Map.find (k - m + n) s)
- else mkRel (m - k)
- | _ -> Constr.map_with_binders succ subst n c
- in
- let c = if k = 0 then c else subst 0 c in
- EConstr.of_constr c
-
-let subst2 subst vsubst c =
- csubst_subst subst (EConstr.Vars.replace_vars vsubst c)
-
let next_ident_away id avoid =
let avoid id = Id.Set.mem id avoid in
next_ident_away_from id avoid
@@ -282,19 +266,79 @@ let next_name_away na avoid =
let id = match na with Name id -> id | Anonymous -> default_non_dependent_ident in
next_ident_away_from id avoid
-type csubst = int * EConstr.t Int.Map.t
-
-let empty_csubst = (0, Int.Map.empty)
+type subst_val =
+| SRel of int
+| SVar of Id.t
+
+type csubst = {
+ csubst_len : int;
+ (** Cardinal of [csubst_rel] *)
+ csubst_var : Constr.t Id.Map.t;
+ (** A mapping of variables to variables. We use the more general
+ [Constr.t] to share allocations, but all values are of shape [Var _]. *)
+ csubst_rel : Constr.t Int.Map.t;
+ (** A contiguous mapping of integers to variables. Same remark for values. *)
+ csubst_rev : subst_val Id.Map.t;
+ (** Reverse mapping of the substitution *)
+}
+(** This type represent a name substitution for the named and De Bruijn parts of
+ a environment. For efficiency we also store the reverse substitution.
+ Invariant: all identifiers in the codomain of [csubst_var] and [csubst_rel]
+ must be pairwise distinct. *)
+
+let empty_csubst = {
+ csubst_len = 0;
+ csubst_rel = Int.Map.empty;
+ csubst_var = Id.Map.empty;
+ csubst_rev = Id.Map.empty;
+}
+
+let csubst_subst { csubst_len = k; csubst_var = v; csubst_rel = s } c =
+ (** Safe because this is a substitution *)
+ let c = EConstr.Unsafe.to_constr c in
+ let rec subst n c = match Constr.kind c with
+ | Rel m ->
+ if m <= n then c
+ else if m - n <= k then Int.Map.find (k - m + n) s
+ else mkRel (m - k)
+ | Var id ->
+ begin try Id.Map.find id v with Not_found -> c end
+ | _ -> Constr.map_with_binders succ subst n c
+ in
+ let c = if k = 0 && Id.Map.is_empty v then c else subst 0 c in
+ EConstr.of_constr c
type ext_named_context =
- csubst * (Id.t * EConstr.constr) list *
- Id.Set.t * EConstr.named_context
-
-let push_var id (n, s) =
- let s = Int.Map.add n (EConstr.mkVar id) s in
- (succ n, s)
-
-let push_rel_decl_to_named_context sigma decl (subst, vsubst, avoid, nc) =
+ csubst * Id.Set.t * EConstr.named_context
+
+let push_var id { csubst_len = n; csubst_var = v; csubst_rel = s; csubst_rev = r } =
+ let s = Int.Map.add n (Constr.mkVar id) s in
+ let r = Id.Map.add id (SRel n) r in
+ { csubst_len = succ n; csubst_var = v; csubst_rel = s; csubst_rev = r }
+
+(** Post-compose the substitution with the generator [src ↦ tgt] *)
+let update_var src tgt subst =
+ let cur =
+ try Some (Id.Map.find src subst.csubst_rev)
+ with Not_found -> None
+ in
+ match cur with
+ | None ->
+ (** Missing keys stand for identity substitution [src ↦ src] *)
+ let csubst_var = Id.Map.add src (Constr.mkVar tgt) subst.csubst_var in
+ let csubst_rev = Id.Map.add tgt (SVar src) subst.csubst_rev in
+ { subst with csubst_var; csubst_rev }
+ | Some bnd ->
+ let csubst_rev = Id.Map.add tgt bnd (Id.Map.remove src subst.csubst_rev) in
+ match bnd with
+ | SRel m ->
+ let csubst_rel = Int.Map.add m (Constr.mkVar tgt) subst.csubst_rel in
+ { subst with csubst_rel; csubst_rev }
+ | SVar id ->
+ let csubst_var = Id.Map.add id (Constr.mkVar tgt) subst.csubst_var in
+ { subst with csubst_var; csubst_rev }
+
+let push_rel_decl_to_named_context sigma decl (subst, avoid, nc) =
let open EConstr in
let open Vars in
let map_decl f d =
@@ -330,18 +374,17 @@ let push_rel_decl_to_named_context sigma decl (subst, vsubst, avoid, nc) =
binding named [id], we will keep [id0] (the name given
by the user) and rename [id0] into [id] in the named
context. Unless [id] is a section variable. *)
- let subst = (fst subst, Int.Map.map (replace_vars [id0,mkVar id]) (snd subst)) in
- let vsubst = (id0,mkVar id)::vsubst in
- let d = decl |> NamedDecl.of_rel_decl (fun _ -> id0) |> map_decl (subst2 subst vsubst) in
+ let subst = update_var id0 id subst in
+ let d = decl |> NamedDecl.of_rel_decl (fun _ -> id0) |> map_decl (csubst_subst subst) in
let nc = List.map (replace_var_named_declaration id0 id) nc in
- (push_var id0 subst, vsubst, Id.Set.add id avoid, d :: nc)
+ (push_var id0 subst, Id.Set.add id avoid, d :: nc)
| _ ->
(* spiwack: if [id0] is a section variable renaming it is
incorrect. We revert to a less robust behaviour where
the new binder has name [id]. Which amounts to the same
behaviour than when [id=id0]. *)
- let d = decl |> NamedDecl.of_rel_decl (fun _ -> id) |> map_decl (subst2 subst vsubst) in
- (push_var id subst, vsubst, Id.Set.add id avoid, d :: nc)
+ let d = decl |> NamedDecl.of_rel_decl (fun _ -> id) |> map_decl (csubst_subst subst) in
+ (push_var id subst, Id.Set.add id avoid, d :: nc)
let push_rel_context_to_named_context env sigma typ =
(* compute the instances relative to the named context and rel_context *)
@@ -350,17 +393,17 @@ let push_rel_context_to_named_context env sigma typ =
let ids = List.map get_id (named_context env) in
let inst_vars = List.map mkVar ids in
if List.is_empty (Environ.rel_context env) then
- (named_context_val env, typ, inst_vars, empty_csubst, [])
+ (named_context_val env, typ, inst_vars, empty_csubst)
else
let avoid = List.fold_right Id.Set.add ids Id.Set.empty in
let inst_rels = List.rev (rel_list 0 (nb_rel env)) in
(* move the rel context to a named context and extend the named instance *)
(* with vars of the rel context *)
(* We do keep the instances corresponding to local definition (see above) *)
- let (subst, vsubst, _, env) =
+ let (subst, _, env) =
Context.Rel.fold_outside (fun d acc -> push_rel_decl_to_named_context sigma d acc)
- (rel_context env) ~init:(empty_csubst, [], avoid, named_context env) in
- (val_of_named_context env, subst2 subst vsubst typ, inst_rels@inst_vars, subst, vsubst)
+ (rel_context env) ~init:(empty_csubst, avoid, named_context env) in
+ (val_of_named_context env, csubst_subst subst typ, inst_rels@inst_vars, subst)
(*------------------------------------*
* Entry points to define new evars *
@@ -425,8 +468,8 @@ let new_evar_from_context sign evd ?src ?filter ?candidates ?store ?naming ?prin
(* [new_evar] declares a new existential in an env env with type typ *)
(* Converting the env into the sign of the evar to define *)
let new_evar env evd ?src ?filter ?candidates ?store ?naming ?principal typ =
- let sign,typ',instance,subst,vsubst = push_rel_context_to_named_context env evd typ in
- let map c = subst2 subst vsubst c in
+ let sign,typ',instance,subst = push_rel_context_to_named_context env evd typ in
+ let map c = csubst_subst subst c in
let candidates = Option.map (fun l -> List.map map l) candidates in
let instance =
match filter with
@@ -692,6 +735,55 @@ let undefined_evars_of_evar_info evd evi =
(undefined_evars_of_named_context evd
(named_context_of_val evi.evar_hyps)))
+type undefined_evars_cache = {
+ mutable cache : (EConstr.named_declaration * Evar.Set.t) ref Id.Map.t;
+}
+
+let create_undefined_evars_cache () = { cache = Id.Map.empty; }
+
+let cached_evar_of_hyp cache sigma decl accu = match cache with
+| None ->
+ let fold c acc =
+ let evs = undefined_evars_of_term sigma c in
+ Evar.Set.union evs acc
+ in
+ NamedDecl.fold_constr fold decl accu
+| Some cache ->
+ let id = NamedDecl.get_id decl in
+ let r =
+ try Id.Map.find id cache.cache
+ with Not_found ->
+ (** Dummy value *)
+ let r = ref (NamedDecl.LocalAssum (id, EConstr.mkProp), Evar.Set.empty) in
+ let () = cache.cache <- Id.Map.add id r cache.cache in
+ r
+ in
+ let (decl', evs) = !r in
+ let evs =
+ if NamedDecl.equal (==) decl decl' then snd !r
+ else
+ let fold c acc =
+ let evs = undefined_evars_of_term sigma c in
+ Evar.Set.union evs acc
+ in
+ let evs = NamedDecl.fold_constr fold decl Evar.Set.empty in
+ let () = r := (decl, evs) in
+ evs
+ in
+ Evar.Set.fold Evar.Set.add evs accu
+
+let filtered_undefined_evars_of_evar_info ?cache sigma evi =
+ let evars_of_named_context cache accu nc =
+ let fold decl accu = cached_evar_of_hyp cache sigma (EConstr.of_named_decl decl) accu in
+ Context.Named.fold_outside fold nc ~init:accu
+ in
+ let accu = match evi.evar_body with
+ | Evar_empty -> Evar.Set.empty
+ | Evar_defined b -> evars_of_term b
+ in
+ let accu = Evar.Set.union (undefined_evars_of_term sigma (EConstr.of_constr evi.evar_concl)) accu in
+ evars_of_named_context cache accu (evar_filtered_context evi)
+
(* spiwack: this is a more complete version of
{!Termops.occur_evar}. The latter does not look recursively into an
[evar_map]. If unification only need to check superficially, tactics
diff --git a/engine/evarutil.mli b/engine/evarutil.mli
index 9d0b973a7e..923bf49a9c 100644
--- a/engine/evarutil.mli
+++ b/engine/evarutil.mli
@@ -133,6 +133,12 @@ val undefined_evars_of_term : evar_map -> constr -> Evar.Set.t
val undefined_evars_of_named_context : evar_map -> Context.Named.t -> Evar.Set.t
val undefined_evars_of_evar_info : evar_map -> evar_info -> Evar.Set.t
+type undefined_evars_cache
+
+val create_undefined_evars_cache : unit -> undefined_evars_cache
+
+val filtered_undefined_evars_of_evar_info : ?cache:undefined_evars_cache -> evar_map -> evar_info -> Evar.Set.t
+
(** [occur_evar_upto sigma k c] returns [true] if [k] appears in
[c]. It looks up recursively in [sigma] for the value of existential
variables. *)
@@ -216,14 +222,13 @@ val empty_csubst : csubst
val csubst_subst : csubst -> constr -> constr
type ext_named_context =
- csubst * (Id.t * constr) list *
- Id.Set.t * named_context
+ csubst * Id.Set.t * named_context
val push_rel_decl_to_named_context :
evar_map -> rel_declaration -> ext_named_context -> ext_named_context
val push_rel_context_to_named_context : Environ.env -> evar_map -> types ->
- named_context_val * types * constr list * csubst * (Id.t*constr) list
+ named_context_val * types * constr list * csubst
val generalize_evar_over_rels : evar_map -> existential -> types * constr list
diff --git a/engine/evd.ml b/engine/evd.ml
index e33c851f6e..0e94721589 100644
--- a/engine/evd.ml
+++ b/engine/evd.ml
@@ -855,7 +855,7 @@ let normalize_universe evd =
let normalize_universe_instance evd l =
let vars = ref (UState.subst evd.universes) in
- let normalize = Univ.level_subst_of (Universes.normalize_univ_variable_opt_subst vars) in
+ let normalize = Universes.level_subst_of (Universes.normalize_univ_variable_opt_subst vars) in
Univ.Instance.subst_fn normalize l
let normalize_sort evars s =
diff --git a/engine/proofview.ml b/engine/proofview.ml
index 3b945c87f9..0a64351950 100644
--- a/engine/proofview.ml
+++ b/engine/proofview.ml
@@ -634,32 +634,42 @@ let shelve_goals l =
InfoL.leaf (Info.Tactic (fun () -> Pp.str"shelve_goals")) >>
Shelf.modify (fun gls -> gls @ l)
-(** [contained_in_info e evi] checks whether the evar [e] appears in
- the hypotheses, the conclusion or the body of the evar_info
- [evi]. Note: since we want to use it on goals, the body is actually
- supposed to be empty. *)
-let contained_in_info sigma e evi =
- Evar.Set.mem e (Evd.evars_of_filtered_evar_info (Evarutil.nf_evar_info sigma evi))
-
(** [depends_on sigma src tgt] checks whether the goal [src] appears
as an existential variable in the definition of the goal [tgt] in
[sigma]. *)
let depends_on sigma src tgt =
let evi = Evd.find sigma tgt in
- contained_in_info sigma src evi
+ Evar.Set.mem src (Evd.evars_of_filtered_evar_info (Evarutil.nf_evar_info sigma evi))
+
+let unifiable_delayed g l =
+ CList.exists (fun (tgt, lazy evs) -> not (Evar.equal g tgt) && Evar.Set.mem g evs) l
+
+let free_evars sigma l =
+ let cache = Evarutil.create_undefined_evars_cache () in
+ let map ev =
+ (** Computes the set of evars appearing in the hypotheses, the conclusion or
+ the body of the evar_info [evi]. Note: since we want to use it on goals,
+ the body is actually supposed to be empty. *)
+ let evi = Evd.find sigma ev in
+ let fevs = lazy (Evarutil.filtered_undefined_evars_of_evar_info ~cache sigma evi) in
+ (ev, fevs)
+ in
+ List.map map l
(** [unifiable sigma g l] checks whether [g] appears in another
subgoal of [l]. The list [l] may contain [g], but it does not
affect the result. *)
let unifiable sigma g l =
- CList.exists (fun tgt -> not (Evar.equal g tgt) && depends_on sigma g tgt) l
+ let l = free_evars sigma l in
+ unifiable_delayed g l
(** [partition_unifiable sigma l] partitions [l] into a pair [(u,n)]
where [u] is composed of the unifiable goals, i.e. the goals on
whose definition other goals of [l] depend, and [n] are the
non-unifiable goals. *)
let partition_unifiable sigma l =
- CList.partition (fun g -> unifiable sigma g l) l
+ let fevs = free_evars sigma l in
+ CList.partition (fun g -> unifiable_delayed g fevs) l
(** Shelves the unifiable goals under focus, i.e. the goals which
appear in other goals under focus (the unfocused goals are not
diff --git a/engine/termops.ml b/engine/termops.ml
index a71bdff31e..40b3d0d8b6 100644
--- a/engine/termops.ml
+++ b/engine/termops.ml
@@ -1463,6 +1463,18 @@ let prod_applist sigma c l =
| _ -> anomaly (Pp.str "Not enough prod's.") in
app [] c l
+let prod_applist_assum sigma n c l =
+ let open EConstr in
+ let rec app n subst c l =
+ if Int.equal n 0 then
+ if l == [] then Vars.substl subst c
+ else anomaly (Pp.str "Not enough arguments.")
+ else match EConstr.kind sigma c, l with
+ | Prod(_,_,c), arg::l -> app (n-1) (arg::subst) c l
+ | LetIn(_,b,_,c), _ -> app (n-1) (Vars.substl subst b::subst) c l
+ | _ -> anomaly (Pp.str "Not enough prod/let's.") in
+ app n [] c l
+
(* Combinators on judgments *)
let on_judgment f j = { uj_val = f j.uj_val; uj_type = f j.uj_type }
diff --git a/engine/termops.mli b/engine/termops.mli
index c1600abe80..a3559a693b 100644
--- a/engine/termops.mli
+++ b/engine/termops.mli
@@ -159,8 +159,18 @@ val eta_reduce_head : Evd.evar_map -> constr -> constr
(** Flattens application lists *)
val collapse_appl : Evd.evar_map -> constr -> constr
+(** [prod_applist] [forall (x1:B1;...;xn:Bn), B] [a1...an] @return [B[a1...an]] *)
val prod_applist : Evd.evar_map -> constr -> constr list -> constr
+(** In [prod_applist_assum n c args], [c] is supposed to have the
+ form [∀Γ.c] with [Γ] of length [m] and possibly with let-ins; it
+ returns [c] with the assumptions of [Γ] instantiated by [args] and
+ the local definitions of [Γ] expanded.
+ Note that [n] counts both let-ins and prods, while the length of [args]
+ only counts prods. In other words, varying [n] changes how many
+ trailing let-ins are expanded. *)
+val prod_applist_assum : Evd.evar_map -> int -> constr -> constr list -> constr
+
(** Remove recursively the casts around a term i.e.
[strip_outer_cast (Cast (Cast ... (Cast c, t) ... ))] is [c]. *)
val strip_outer_cast : Evd.evar_map -> constr -> constr
diff --git a/engine/uState.ml b/engine/uState.ml
index 6131f4c033..4b650c9c94 100644
--- a/engine/uState.ml
+++ b/engine/uState.ml
@@ -201,14 +201,18 @@ let process_universe_constraints ctx cstrs =
| None -> user_err Pp.(str "Algebraic universe on the right")
| Some r' ->
if Univ.Level.is_small r' then
- let levels = Univ.Universe.levels l in
- let fold l' local =
- let l = Univ.Universe.make l' in
- if Univ.Level.is_small l' || is_local l' then
- equalize_variables false l l' r r' local
- else raise (Univ.UniverseInconsistency (Univ.Le, l, r, None))
- in
- Univ.LSet.fold fold levels local
+ if not (Univ.Universe.is_levels l)
+ then
+ raise (Univ.UniverseInconsistency (Univ.Le, l, r, None))
+ else
+ let levels = Univ.Universe.levels l in
+ let fold l' local =
+ let l = Univ.Universe.make l' in
+ if Univ.Level.is_small l' || is_local l' then
+ equalize_variables false l l' r r' local
+ else raise (Univ.UniverseInconsistency (Univ.Le, l, r, None))
+ in
+ Univ.LSet.fold fold levels local
else
Univ.enforce_leq l r local
end
@@ -516,7 +520,7 @@ let is_sort_variable uctx s =
| _ -> None
let subst_univs_context_with_def def usubst (ctx, cst) =
- (Univ.LSet.diff ctx def, Univ.subst_univs_constraints usubst cst)
+ (Univ.LSet.diff ctx def, Universes.subst_univs_constraints usubst cst)
let normalize_variables uctx =
let normalized_variables, undef, def, subst =
diff --git a/engine/universes.ml b/engine/universes.ml
index 30490ec56a..eaddf98a83 100644
--- a/engine/universes.ml
+++ b/engine/universes.ml
@@ -181,6 +181,30 @@ let enforce_eq_instances_univs strict x y c =
(fun x y -> Constraints.add (Universe.make x, d, Universe.make y))
ax ay c
+let enforce_univ_constraint (u,d,v) =
+ match d with
+ | Eq -> enforce_eq u v
+ | Le -> enforce_leq u v
+ | Lt -> enforce_leq (super u) v
+
+let subst_univs_level fn l =
+ try Some (fn l)
+ with Not_found -> None
+
+let subst_univs_constraint fn (u,d,v as c) cstrs =
+ let u' = subst_univs_level fn u in
+ let v' = subst_univs_level fn v in
+ match u', v' with
+ | None, None -> Constraint.add c cstrs
+ | Some u, None -> enforce_univ_constraint (u,d,Universe.make v) cstrs
+ | None, Some v -> enforce_univ_constraint (Universe.make u,d,v) cstrs
+ | Some u, Some v -> enforce_univ_constraint (u,d,v) cstrs
+
+let subst_univs_constraints subst csts =
+ Constraint.fold
+ (fun c cstrs -> subst_univs_constraint subst c cstrs)
+ csts Constraint.empty
+
let subst_univs_universe_constraint fn (u,d,v) =
let u' = subst_univs_universe fn u and v' = subst_univs_universe fn v in
if Universe.equal u' v' then None
@@ -519,13 +543,60 @@ let choose_canonical ctx flexible algs s =
let canon = LSet.choose algs in
canon, (global, rigid, LSet.remove canon flexible)
+let level_subst_of f =
+ fun l ->
+ try let u = f l in
+ match Universe.level u with
+ | None -> l
+ | Some l -> l
+ with Not_found -> l
+
+let subst_univs_fn_constr f c =
+ let changed = ref false in
+ let fu = Univ.subst_univs_universe f in
+ let fi = Univ.Instance.subst_fn (level_subst_of f) in
+ let rec aux t =
+ match kind t with
+ | Sort (Sorts.Type u) ->
+ let u' = fu u in
+ if u' == u then t else
+ (changed := true; mkSort (Sorts.sort_of_univ u'))
+ | Const (c, u) ->
+ let u' = fi u in
+ if u' == u then t
+ else (changed := true; mkConstU (c, u'))
+ | Ind (i, u) ->
+ let u' = fi u in
+ if u' == u then t
+ else (changed := true; mkIndU (i, u'))
+ | Construct (c, u) ->
+ let u' = fi u in
+ if u' == u then t
+ else (changed := true; mkConstructU (c, u'))
+ | _ -> map aux t
+ in
+ let c' = aux c in
+ if !changed then c' else c
+
+let subst_univs_constr subst c =
+ if Univ.is_empty_subst subst then c
+ else
+ let f = Univ.make_subst subst in
+ subst_univs_fn_constr f c
+
+let subst_univs_constr =
+ if Flags.profile then
+ let subst_univs_constr_key = CProfile.declare_profile "subst_univs_constr" in
+ 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 = Univ.level_subst_of subst in
+ let lsubst = level_subst_of subst in
let rec aux c =
match kind c with
| Evar (evk, args) ->
@@ -605,7 +676,7 @@ let normalize_opt_subst ctx =
in !ectx
type universe_opt_subst = Universe.t option universe_map
-
+
let make_opt_subst s =
fun x ->
(match Univ.LMap.find x s with
@@ -614,8 +685,7 @@ let make_opt_subst s =
let subst_opt_univs_constr s =
let f = make_opt_subst s in
- Vars.subst_univs_fn_constr f
-
+ subst_univs_fn_constr f
let normalize_univ_variables ctx =
let ctx = normalize_opt_subst ctx in
diff --git a/engine/universes.mli b/engine/universes.mli
index 1a98d969b4..130dcf8bb8 100644
--- a/engine/universes.mli
+++ b/engine/universes.mli
@@ -154,6 +154,11 @@ val extend_context : 'a in_universe_context_set -> ContextSet.t ->
module UF : Unionfind.PartitionSig with type elt = Level.t
+val level_subst_of : universe_subst_fn -> universe_level_subst_fn
+val subst_univs_constraints : universe_subst_fn -> Constraint.t -> Constraint.t
+
+val subst_univs_constr : universe_subst -> constr -> constr
+
type universe_opt_subst = Universe.t option universe_map
val make_opt_subst : universe_opt_subst -> universe_subst_fn
generated by cgit v1.2.3 (git 2.25.1) at 2026-05-01 16:55:18 +0000