From c4d3daaeb75a746b2a2717d2aaf21a65ebcc7775 Mon Sep 17 00:00:00 2001 From: Hugo Herbelin Date: Wed, 10 Oct 2018 14:26:12 +0200 Subject: Adding a functional version of constant_of_delta_kn. --- kernel/safe_typing.ml | 6 ++++++ kernel/safe_typing.mli | 3 +++ 2 files changed, 9 insertions(+) (limited to 'kernel') diff --git a/kernel/safe_typing.ml b/kernel/safe_typing.ml index 820c5b3a2b..625b7e5073 100644 --- a/kernel/safe_typing.ml +++ b/kernel/safe_typing.ml @@ -168,6 +168,12 @@ let is_initial senv = let delta_of_senv senv = senv.modresolver,senv.paramresolver +let constant_of_delta_kn_senv senv kn = + Mod_subst.constant_of_deltas_kn senv.paramresolver senv.modresolver kn + +let mind_of_delta_kn_senv senv kn = + Mod_subst.mind_of_deltas_kn senv.paramresolver senv.modresolver kn + (** The safe_environment state monad *) type safe_transformer0 = safe_environment -> safe_environment diff --git a/kernel/safe_typing.mli b/kernel/safe_typing.mli index 0f150ea971..26fa91adbd 100644 --- a/kernel/safe_typing.mli +++ b/kernel/safe_typing.mli @@ -204,6 +204,9 @@ val exists_objlabel : Label.t -> safe_environment -> bool val delta_of_senv : safe_environment -> Mod_subst.delta_resolver * Mod_subst.delta_resolver +val constant_of_delta_kn_senv : safe_environment -> KerName.t -> Constant.t +val mind_of_delta_kn_senv : safe_environment -> KerName.t -> MutInd.t + (** {6 Retroknowledge / Native compiler } *) open Retroknowledge -- cgit v1.2.3 From 23fc1c59d78ffb524265caa1908503f50816335a Mon Sep 17 00:00:00 2001 From: Hugo Herbelin Date: Sat, 6 Oct 2018 11:04:03 +0200 Subject: A state-free version of is_polymorphic. --- kernel/environ.ml | 10 ++++++++++ kernel/environ.mli | 2 +- 2 files changed, 11 insertions(+), 1 deletion(-) (limited to 'kernel') diff --git a/kernel/environ.ml b/kernel/environ.ml index dffcd70282..2fa33eb1cd 100644 --- a/kernel/environ.ml +++ b/kernel/environ.ml @@ -680,6 +680,16 @@ let remove_hyps ids check_context check_value ctxt = in fst (remove_hyps ctxt) +(* A general request *) + +let is_polymorphic env r = + let open Names.GlobRef in + match r with + | VarRef _id -> false + | ConstRef c -> polymorphic_constant c env + | IndRef ind -> polymorphic_ind ind env + | ConstructRef cstr -> polymorphic_ind (inductive_of_constructor cstr) env + (*spiwack: the following functions assemble the pieces of the retroknowledge note that the "consistent" register function is available in the module Safetyping, Environ only synchronizes the proactive and the reactive parts*) diff --git a/kernel/environ.mli b/kernel/environ.mli index 55ff7ff162..031e7968d7 100644 --- a/kernel/environ.mli +++ b/kernel/environ.mli @@ -315,7 +315,7 @@ val apply_to_hyp : named_context_val -> variable -> val remove_hyps : Id.Set.t -> (Constr.named_declaration -> Constr.named_declaration) -> (lazy_val -> lazy_val) -> named_context_val -> named_context_val - +val is_polymorphic : env -> Names.GlobRef.t -> bool open Retroknowledge (** functions manipulating the retroknowledge -- cgit v1.2.3