aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
-rw-r--r--checker/cic.mli12
-rw-r--r--checker/values.ml17
-rw-r--r--kernel/declarations.ml1
-rw-r--r--kernel/declareops.ml3
-rw-r--r--kernel/declareops.mli2
-rw-r--r--kernel/environ.ml6
-rw-r--r--kernel/pre_env.ml4
-rw-r--r--kernel/pre_env.mli1
8 files changed, 36 insertions, 10 deletions
diff --git a/checker/cic.mli b/checker/cic.mli
index 4a0e706aa1..95dd18f5f3 100644
--- a/checker/cic.mli
+++ b/checker/cic.mli
@@ -170,6 +170,17 @@ type set_predicativity = ImpredicativeSet | PredicativeSet
type engagement = set_predicativity
+(** {6 Conversion oracle} *)
+
+type level = Expand | Level of int | Opaque
+
+type oracle = {
+ var_opacity : level Id.Map.t;
+ cst_opacity : level Cmap.t;
+ var_trstate : Id.Pred.t;
+ cst_trstate : Cpred.t;
+}
+
(** {6 Representation of constants (Definition/Axiom) } *)
@@ -219,6 +230,7 @@ type typing_flags = {
check_guarded : bool; (** If [false] then fixed points and co-fixed
points are assumed to be total. *)
check_universes : bool; (** If [false] universe constraints are not checked *)
+ conv_oracle : oracle; (** Unfolding strategies for conversion *)
}
type constant_body = {
diff --git a/checker/values.ml b/checker/values.ml
index 4698227ff0..313067cb6b 100644
--- a/checker/values.ml
+++ b/checker/values.ml
@@ -13,7 +13,7 @@
To ensure this file is up-to-date, 'make' now compares the md5 of cic.mli
with a copy we maintain here:
-MD5 56ac4cade33eff3d26ed5cdadb580c7e checker/cic.mli
+MD5 483493b20fe91cc1bea4350a2db2f82d checker/cic.mli
*)
@@ -70,6 +70,8 @@ let v_map vk vd =
let v_hset v = v_map Int (v_set v)
let v_hmap vk vd = v_map Int (v_map vk vd)
+let v_pred v = v_pair v_bool (v_set v)
+
(* lib/future *)
let v_computation f =
Annot ("Future.computation",
@@ -199,6 +201,17 @@ let v_lazy_constr =
let v_impredicative_set = v_enum "impr-set" 2
let v_engagement = v_impredicative_set
+let v_conv_level =
+ v_sum "conv_level" 2 [|[|Int|]|]
+
+let v_oracle =
+ v_tuple "oracle" [|
+ v_map v_id v_conv_level;
+ v_hmap v_cst v_conv_level;
+ v_pred v_id;
+ v_pred v_cst;
+ |]
+
let v_pol_arity =
v_tuple "polymorphic_arity" [|List(Opt v_level);v_univ|]
@@ -213,7 +226,7 @@ let v_projbody =
v_constr|]
let v_typing_flags =
- v_tuple "typing_flags" [|v_bool; v_bool|]
+ v_tuple "typing_flags" [|v_bool; v_bool; v_oracle|]
let v_const_univs = v_sum "constant_universes" 0 [|[|v_context_set|]; [|v_abs_context|]|]
diff --git a/kernel/declarations.ml b/kernel/declarations.ml
index 7f4b85fd05..5b9e1a1414 100644
--- a/kernel/declarations.ml
+++ b/kernel/declarations.ml
@@ -74,6 +74,7 @@ type typing_flags = {
check_guarded : bool; (** If [false] then fixed points and co-fixed
points are assumed to be total. *)
check_universes : bool; (** If [false] universe constraints are not checked *)
+ conv_oracle : Conv_oracle.oracle; (** Unfolding strategies for conversion *)
}
(* some contraints are in constant_constraints, some other may be in
diff --git a/kernel/declareops.ml b/kernel/declareops.ml
index d8768a0fc5..9eed9efcbd 100644
--- a/kernel/declareops.ml
+++ b/kernel/declareops.ml
@@ -15,9 +15,10 @@ module RelDecl = Context.Rel.Declaration
(** Operations concernings types in [Declarations] :
[constant_body], [mutual_inductive_body], [module_body] ... *)
-let safe_flags = {
+let safe_flags oracle = {
check_guarded = true;
check_universes = true;
+ conv_oracle = oracle;
}
(** {6 Arities } *)
diff --git a/kernel/declareops.mli b/kernel/declareops.mli
index 198831848e..0eed11f49c 100644
--- a/kernel/declareops.mli
+++ b/kernel/declareops.mli
@@ -67,7 +67,7 @@ val inductive_is_cumulative : mutual_inductive_body -> bool
(** {6 Kernel flags} *)
(** A default, safe set of flags for kernel type-checking *)
-val safe_flags : typing_flags
+val safe_flags : Conv_oracle.oracle -> typing_flags
(** {6 Hash-consing} *)
diff --git a/kernel/environ.ml b/kernel/environ.ml
index 1afab453ac..3c86129fed 100644
--- a/kernel/environ.ml
+++ b/kernel/environ.ml
@@ -37,8 +37,10 @@ type env = Pre_env.env
let pre_env env = env
let env_of_pre_env env = env
-let oracle env = env.env_conv_oracle
-let set_oracle env o = { env with env_conv_oracle = o }
+let oracle env = env.env_typing_flags.conv_oracle
+let set_oracle env o =
+ let env_typing_flags = { env.env_typing_flags with conv_oracle = o } in
+ { env with env_typing_flags }
let empty_named_context_val = empty_named_context_val
diff --git a/kernel/pre_env.ml b/kernel/pre_env.ml
index c5254b453a..4ef89f8c0e 100644
--- a/kernel/pre_env.ml
+++ b/kernel/pre_env.ml
@@ -75,7 +75,6 @@ type env = {
env_nb_rel : int;
env_stratification : stratification;
env_typing_flags : typing_flags;
- env_conv_oracle : Conv_oracle.oracle;
retroknowledge : Retroknowledge.retroknowledge;
indirect_pterms : Opaqueproof.opaquetab;
}
@@ -98,8 +97,7 @@ let empty_env = {
env_stratification = {
env_universes = UGraph.initial_universes;
env_engagement = PredicativeSet };
- env_typing_flags = Declareops.safe_flags;
- env_conv_oracle = Conv_oracle.empty;
+ env_typing_flags = Declareops.safe_flags Conv_oracle.empty;
retroknowledge = Retroknowledge.initial_retroknowledge;
indirect_pterms = Opaqueproof.empty_opaquetab }
diff --git a/kernel/pre_env.mli b/kernel/pre_env.mli
index 054ae17437..fef530c872 100644
--- a/kernel/pre_env.mli
+++ b/kernel/pre_env.mli
@@ -53,7 +53,6 @@ type env = {
env_nb_rel : int;
env_stratification : stratification;
env_typing_flags : typing_flags;
- env_conv_oracle : Conv_oracle.oracle;
retroknowledge : Retroknowledge.retroknowledge;
indirect_pterms : Opaqueproof.opaquetab;
}