aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorPierre-Marie Pédrot2018-06-22 00:43:01 +0200
committerPierre-Marie Pédrot2018-11-19 13:29:55 +0100
commit96e78e0d4ab9e2c2ccf1bb0565384e4e0d322904 (patch)
tree9f54ad363b2c8f855be97860ba1900572353e164
parentecfbeaa62f9d8bd4dc4600cf39df2262af718313 (diff)
Move transparent_state to its own module.
-rw-r--r--dev/top_printers.mli2
-rw-r--r--kernel/cClosure.ml6
-rw-r--r--kernel/cClosure.mli12
-rw-r--r--kernel/conv_oracle.mli2
-rw-r--r--kernel/kernel.mllib1
-rw-r--r--kernel/names.ml7
-rw-r--r--kernel/names.mli8
-rw-r--r--kernel/reduction.ml8
-rw-r--r--kernel/reduction.mli8
-rw-r--r--kernel/transpState.ml18
-rw-r--r--kernel/transpState.mli26
-rw-r--r--kernel/vconv.ml4
-rw-r--r--plugins/funind/functional_principles_proofs.ml2
-rw-r--r--plugins/funind/recdef.ml2
-rw-r--r--plugins/ltac/rewrite.ml8
-rw-r--r--pretyping/cases.ml2
-rw-r--r--pretyping/evarconv.ml8
-rw-r--r--pretyping/evarconv.mli17
-rw-r--r--pretyping/reductionops.ml12
-rw-r--r--pretyping/reductionops.mli18
-rw-r--r--pretyping/tacred.ml2
-rw-r--r--pretyping/typeclasses.mli4
-rw-r--r--pretyping/unification.ml36
-rw-r--r--pretyping/unification.mli9
-rw-r--r--printing/printer.mli2
-rw-r--r--proofs/clenvtac.ml7
-rw-r--r--proofs/evar_refiner.ml3
-rw-r--r--tactics/auto.ml8
-rw-r--r--tactics/auto.mli2
-rw-r--r--tactics/btermdn.mli9
-rw-r--r--tactics/class_tactics.ml12
-rw-r--r--tactics/class_tactics.mli4
-rw-r--r--tactics/eauto.ml6
-rw-r--r--tactics/equality.ml16
-rw-r--r--tactics/hints.ml16
-rw-r--r--tactics/hints.mli10
-rw-r--r--tactics/tactics.ml8
-rw-r--r--tactics/tactics.mli2
-rw-r--r--vernac/assumptions.mli2
-rw-r--r--vernac/vernacentries.ml2
40 files changed, 178 insertions, 153 deletions
diff --git a/dev/top_printers.mli b/dev/top_printers.mli
index 63d7d58053..5876b7c5c6 100644
--- a/dev/top_printers.mli
+++ b/dev/top_printers.mli
@@ -101,7 +101,7 @@ val ppdelta : Mod_subst.delta_resolver -> unit
val pp_idpred : Names.Id.Pred.t -> unit
val pp_cpred : Names.Cpred.t -> unit
-val pp_transparent_state : Names.transparent_state -> unit
+val pp_transparent_state : TranspState.t -> unit
val pp_stack_t : Constr.t Reductionops.Stack.t -> unit
val pp_cst_stack_t : Reductionops.Cst_stack.t -> unit
diff --git a/kernel/cClosure.ml b/kernel/cClosure.ml
index 95546a83e1..c8028f713a 100644
--- a/kernel/cClosure.ml
+++ b/kernel/cClosure.ml
@@ -93,8 +93,8 @@ module type RedFlagsSig = sig
val no_red : reds
val red_add : reds -> red_kind -> reds
val red_sub : reds -> red_kind -> reds
- val red_add_transparent : reds -> transparent_state -> reds
- val red_transparent : reds -> transparent_state
+ val red_add_transparent : reds -> TranspState.t -> reds
+ val red_transparent : reds -> TranspState.t
val mkflags : red_kind list -> reds
val red_set : reds -> red_kind -> bool
val red_projection : reds -> Projection.t -> bool
@@ -110,7 +110,7 @@ module RedFlags = (struct
r_beta : bool;
r_delta : bool;
r_eta : bool;
- r_const : transparent_state;
+ r_const : TranspState.t;
r_zeta : bool;
r_match : bool;
r_fix : bool;
diff --git a/kernel/cClosure.mli b/kernel/cClosure.mli
index 1ee4bccc25..9d41ee0695 100644
--- a/kernel/cClosure.mli
+++ b/kernel/cClosure.mli
@@ -26,11 +26,11 @@ val with_stats: 'a Lazy.t -> 'a
-val all_opaque : transparent_state
-val all_transparent : transparent_state
+val all_opaque : TranspState.t
+val all_transparent : TranspState.t
-val is_transparent_variable : transparent_state -> variable -> bool
-val is_transparent_constant : transparent_state -> Constant.t -> bool
+val is_transparent_variable : TranspState.t -> variable -> bool
+val is_transparent_constant : TranspState.t -> Constant.t -> bool
(** Sets of reduction kinds. *)
module type RedFlagsSig = sig
@@ -60,10 +60,10 @@ module type RedFlagsSig = sig
val red_sub : reds -> red_kind -> reds
(** Adds a reduction kind to a set *)
- val red_add_transparent : reds -> transparent_state -> reds
+ val red_add_transparent : reds -> TranspState.t -> reds
(** Retrieve the transparent state of the reduction flags *)
- val red_transparent : reds -> transparent_state
+ val red_transparent : reds -> TranspState.t
(** Build a reduction set from scratch = iter [red_add] on [no_red] *)
val mkflags : red_kind list -> reds
diff --git a/kernel/conv_oracle.mli b/kernel/conv_oracle.mli
index 67add5dd35..3b51515352 100644
--- a/kernel/conv_oracle.mli
+++ b/kernel/conv_oracle.mli
@@ -41,5 +41,5 @@ val set_strategy : oracle -> Constant.t tableKey -> level -> oracle
(** Fold over the non-transparent levels of the oracle. Order unspecified. *)
val fold_strategy : (Constant.t tableKey -> level -> 'a -> 'a) -> oracle -> 'a -> 'a
-val get_transp_state : oracle -> transparent_state
+val get_transp_state : oracle -> TranspState.t
diff --git a/kernel/kernel.mllib b/kernel/kernel.mllib
index a18c5d1e20..e716972ebe 100644
--- a/kernel/kernel.mllib
+++ b/kernel/kernel.mllib
@@ -1,4 +1,5 @@
Names
+TranspState
Uint31
Univ
UGraph
diff --git a/kernel/names.ml b/kernel/names.ml
index 18560d5f8d..b2d6a489a6 100644
--- a/kernel/names.ml
+++ b/kernel/names.ml
@@ -715,13 +715,6 @@ let hcons_construct = Hashcons.simple_hcons Hconstruct.generate Hconstruct.hcons
(*****************)
-type transparent_state = Id.Pred.t * Cpred.t
-
-let empty_transparent_state = (Id.Pred.empty, Cpred.empty)
-let full_transparent_state = (Id.Pred.full, Cpred.full)
-let var_full_transparent_state = (Id.Pred.full, Cpred.empty)
-let cst_full_transparent_state = (Id.Pred.empty, Cpred.full)
-
type 'a tableKey =
| ConstKey of 'a
| VarKey of Id.t
diff --git a/kernel/names.mli b/kernel/names.mli
index 98995752a2..350db871d5 100644
--- a/kernel/names.mli
+++ b/kernel/names.mli
@@ -510,14 +510,6 @@ type 'a tableKey =
| VarKey of Id.t
| RelKey of Int.t
-(** Sets of names *)
-type transparent_state = Id.Pred.t * Cpred.t
-
-val empty_transparent_state : transparent_state
-val full_transparent_state : transparent_state
-val var_full_transparent_state : transparent_state
-val cst_full_transparent_state : transparent_state
-
type inv_rel_key = int (** index in the [rel_context] part of environment
starting by the end, {e inverse}
of de Bruijn indice *)
diff --git a/kernel/reduction.ml b/kernel/reduction.ml
index 5515ff9767..a45a5b3247 100644
--- a/kernel/reduction.ml
+++ b/kernel/reduction.ml
@@ -177,7 +177,7 @@ type 'a kernel_conversion_function = env -> 'a -> 'a -> unit
(* functions of this type can be called from outside the kernel *)
type 'a extended_conversion_function =
- ?l2r:bool -> ?reds:Names.transparent_state -> env ->
+ ?l2r:bool -> ?reds:TranspState.t -> env ->
?evars:((existential->constr option) * UGraph.t) ->
'a -> 'a -> unit
@@ -758,7 +758,7 @@ let gen_conv cv_pb l2r reds env evars univs t1 t2 =
()
(* Profiling *)
-let gen_conv cv_pb ?(l2r=false) ?(reds=full_transparent_state) env ?(evars=(fun _->None), universes env) =
+let gen_conv cv_pb ?(l2r=false) ?(reds=TranspState.full) env ?(evars=(fun _->None), universes env) =
let evars, univs = evars in
if Flags.profile then
let fconv_universes_key = CProfile.declare_profile "trans_fconv_universes" in
@@ -792,11 +792,11 @@ let infer_conv_universes =
CProfile.profile8 infer_conv_universes_key infer_conv_universes
else infer_conv_universes
-let infer_conv ?(l2r=false) ?(evars=fun _ -> None) ?(ts=full_transparent_state)
+let infer_conv ?(l2r=false) ?(evars=fun _ -> None) ?(ts=TranspState.full)
env univs t1 t2 =
infer_conv_universes CONV l2r evars ts env univs t1 t2
-let infer_conv_leq ?(l2r=false) ?(evars=fun _ -> None) ?(ts=full_transparent_state)
+let infer_conv_leq ?(l2r=false) ?(evars=fun _ -> None) ?(ts=TranspState.full)
env univs t1 t2 =
infer_conv_universes CUMUL l2r evars ts env univs t1 t2
diff --git a/kernel/reduction.mli b/kernel/reduction.mli
index 581e8bd88a..9b26e7b3dc 100644
--- a/kernel/reduction.mli
+++ b/kernel/reduction.mli
@@ -31,7 +31,7 @@ exception NotConvertibleVect of int
type 'a kernel_conversion_function = env -> 'a -> 'a -> unit
type 'a extended_conversion_function =
- ?l2r:bool -> ?reds:Names.transparent_state -> env ->
+ ?l2r:bool -> ?reds:TranspState.t -> env ->
?evars:((existential->constr option) * UGraph.t) ->
'a -> 'a -> unit
@@ -77,15 +77,15 @@ val conv_leq : types extended_conversion_function
(** These conversion functions are used by module subtyping, which needs to infer
universe constraints inside the kernel *)
val infer_conv : ?l2r:bool -> ?evars:(existential->constr option) ->
- ?ts:Names.transparent_state -> constr infer_conversion_function
+ ?ts:TranspState.t -> constr infer_conversion_function
val infer_conv_leq : ?l2r:bool -> ?evars:(existential->constr option) ->
- ?ts:Names.transparent_state -> types infer_conversion_function
+ ?ts:TranspState.t -> types infer_conversion_function
(** Depending on the universe state functions, this might raise
[UniverseInconsistency] in addition to [NotConvertible] (for better error
messages). *)
val generic_conv : conv_pb -> l2r:bool -> (existential->constr option) ->
- Names.transparent_state -> (constr,'a) generic_conversion_function
+ TranspState.t -> (constr,'a) generic_conversion_function
val default_conv : conv_pb -> ?l2r:bool -> types kernel_conversion_function
val default_conv_leq : ?l2r:bool -> types kernel_conversion_function
diff --git a/kernel/transpState.ml b/kernel/transpState.ml
new file mode 100644
index 0000000000..9acb7244f7
--- /dev/null
+++ b/kernel/transpState.ml
@@ -0,0 +1,18 @@
+(************************************************************************)
+(* * The Coq Proof Assistant / The Coq Development Team *)
+(* v * INRIA, CNRS and contributors - Copyright 1999-2018 *)
+(* <O___,, * (see CREDITS file for the list of authors) *)
+(* \VV/ **************************************************************)
+(* // * This file is distributed under the terms of the *)
+(* * GNU Lesser General Public License Version 2.1 *)
+(* * (see LICENSE file for the text of the license) *)
+(************************************************************************)
+
+open Names
+
+type t = Id.Pred.t * Cpred.t
+
+let empty = (Id.Pred.empty, Cpred.empty)
+let full = (Id.Pred.full, Cpred.full)
+let var_full = (Id.Pred.full, Cpred.empty)
+let cst_full = (Id.Pred.empty, Cpred.full)
diff --git a/kernel/transpState.mli b/kernel/transpState.mli
new file mode 100644
index 0000000000..a8d301549b
--- /dev/null
+++ b/kernel/transpState.mli
@@ -0,0 +1,26 @@
+(************************************************************************)
+(* * The Coq Proof Assistant / The Coq Development Team *)
+(* v * INRIA, CNRS and contributors - Copyright 1999-2018 *)
+(* <O___,, * (see CREDITS file for the list of authors) *)
+(* \VV/ **************************************************************)
+(* // * This file is distributed under the terms of the *)
+(* * GNU Lesser General Public License Version 2.1 *)
+(* * (see LICENSE file for the text of the license) *)
+(************************************************************************)
+
+open Names
+
+(** Sets of names *)
+type t = Id.Pred.t * Cpred.t
+
+val empty : t
+(** Everything opaque *)
+
+val full : t
+(** Everything transparent *)
+
+val var_full : t
+(** All variables transparent *)
+
+val cst_full : t
+(** All constant transparent *)
diff --git a/kernel/vconv.ml b/kernel/vconv.ml
index c1130e62c9..46e52121c7 100644
--- a/kernel/vconv.ml
+++ b/kernel/vconv.ml
@@ -191,7 +191,7 @@ let warn_bytecode_compiler_failed =
let vm_conv_gen cv_pb env univs t1 t2 =
if not (typing_flags env).Declarations.enable_VM then
Reduction.generic_conv cv_pb ~l2r:false (fun _ -> None)
- full_transparent_state env univs t1 t2
+ TranspState.full env univs t1 t2
else
try
let v1 = val_of_constr env t1 in
@@ -200,7 +200,7 @@ let vm_conv_gen cv_pb env univs t1 t2 =
with Not_found | Invalid_argument _ ->
warn_bytecode_compiler_failed ();
Reduction.generic_conv cv_pb ~l2r:false (fun _ -> None)
- full_transparent_state env univs t1 t2
+ TranspState.full env univs t1 t2
let vm_conv cv_pb env t1 t2 =
let univs = Environ.universes env in
diff --git a/plugins/funind/functional_principles_proofs.ml b/plugins/funind/functional_principles_proofs.ml
index 651895aa08..e81335037a 100644
--- a/plugins/funind/functional_principles_proofs.ml
+++ b/plugins/funind/functional_principles_proofs.ml
@@ -1487,7 +1487,7 @@ let new_prove_with_tcc is_mes acc_inv hrec tcc_hyps eqs : tactic =
Eauto.eauto_with_bases
(true,5)
[(fun _ sigma -> (sigma, Lazy.force refl_equal))]
- [Hints.Hint_db.empty empty_transparent_state false]
+ [Hints.Hint_db.empty TranspState.empty false]
)
)
)
diff --git a/plugins/funind/recdef.ml b/plugins/funind/recdef.ml
index 63a3e0582d..84c5b4fbe4 100644
--- a/plugins/funind/recdef.ml
+++ b/plugins/funind/recdef.ml
@@ -1359,7 +1359,7 @@ let open_new_goal build_proof sigma using_lemmas ref_ goal_name (gls_type,decomp
Eauto.eauto_with_bases
(true,5)
[(fun _ sigma -> (sigma, (Lazy.force refl_equal)))]
- [Hints.Hint_db.empty empty_transparent_state false]
+ [Hints.Hint_db.empty TranspState.empty false]
]
)
)
diff --git a/plugins/ltac/rewrite.ml b/plugins/ltac/rewrite.ml
index 7d917c58fe..1f31a617be 100644
--- a/plugins/ltac/rewrite.ml
+++ b/plugins/ltac/rewrite.ml
@@ -537,8 +537,8 @@ let rewrite_core_unif_flags = {
Unification.modulo_conv_on_closed_terms = None;
Unification.use_metas_eagerly_in_conv_on_closed_terms = true;
Unification.use_evars_eagerly_in_conv_on_closed_terms = true;
- Unification.modulo_delta = empty_transparent_state;
- Unification.modulo_delta_types = full_transparent_state;
+ Unification.modulo_delta = TranspState.empty;
+ Unification.modulo_delta_types = TranspState.full;
Unification.check_applied_meta_types = true;
Unification.use_pattern_unification = true;
Unification.use_meta_bound_pattern_unification = true;
@@ -585,12 +585,12 @@ let general_rewrite_unif_flags () =
Unification.modulo_conv_on_closed_terms = Some ts;
Unification.use_evars_eagerly_in_conv_on_closed_terms = true;
Unification.modulo_delta = ts;
- Unification.modulo_delta_types = full_transparent_state;
+ Unification.modulo_delta_types = TranspState.full;
Unification.modulo_betaiota = true }
in {
Unification.core_unify_flags = core_flags;
Unification.merge_unify_flags = core_flags;
- Unification.subterm_unify_flags = { core_flags with Unification.modulo_delta = empty_transparent_state };
+ Unification.subterm_unify_flags = { core_flags with Unification.modulo_delta = TranspState.empty };
Unification.allow_K_in_toplevel_higher_order_unification = true;
Unification.resolve_evars = true
}
diff --git a/pretyping/cases.ml b/pretyping/cases.ml
index 164f5ab96d..647ef5092f 100644
--- a/pretyping/cases.ml
+++ b/pretyping/cases.ml
@@ -1698,7 +1698,7 @@ let abstract_tycon ?loc env sigma subst tycon extenv t =
try list_assoc_in_triple i subst0 with Not_found -> mkRel i)
1 (rel_context !!env) in
let sigma, ev' = Evarutil.new_evar ~src ~typeclass_candidate:false !!env sigma ty in
- begin match solve_simple_eqn (evar_conv_x full_transparent_state) !!env sigma (None,ev,substl inst ev') with
+ begin match solve_simple_eqn (evar_conv_x TranspState.full) !!env sigma (None,ev,substl inst ev') with
| Success evd -> evdref := evd
| UnifFailure _ -> assert false
end;
diff --git a/pretyping/evarconv.ml b/pretyping/evarconv.ml
index 6a75be352b..68b53787f9 100644
--- a/pretyping/evarconv.ml
+++ b/pretyping/evarconv.ml
@@ -30,7 +30,7 @@ open Context.Named.Declaration
module RelDecl = Context.Rel.Declaration
module NamedDecl = Context.Named.Declaration
-type unify_fun = transparent_state ->
+type unify_fun = TranspState.t ->
env -> evar_map -> conv_pb -> EConstr.constr -> EConstr.constr -> Evarsolve.unification_result
let debug_unification = ref (false)
@@ -1211,7 +1211,7 @@ let second_order_matching ts env_rhs evd (evk,args) argoccs rhs =
| [] ->
let evd =
try Evarsolve.check_evar_instance evd evk rhs
- (evar_conv_x full_transparent_state)
+ (evar_conv_x TranspState.full)
with IllTypedInstance _ -> raise (TypingFailed evd)
in
Evd.define evk rhs evd
@@ -1354,7 +1354,7 @@ let solve_unconstrained_impossible_cases env evd =
let j, ctx = coq_unit_judge env in
let evd' = Evd.merge_context_set Evd.univ_flexible_alg ?loc evd' ctx in
let ty = j_type j in
- let conv_algo = evar_conv_x full_transparent_state in
+ let conv_algo = evar_conv_x TranspState.full in
let evd' = check_evar_instance evd' evk ty conv_algo in
Evd.define evk ty evd'
| _ -> evd') evd evd
@@ -1393,7 +1393,7 @@ let solve_unif_constraints_with_heuristics env
exception UnableToUnify of evar_map * unification_error
-let default_transparent_state env = full_transparent_state
+let default_transparent_state env = TranspState.full
(* Conv_oracle.get_transp_state (Environ.oracle env) *)
let the_conv_x env ?(ts=default_transparent_state env) t1 t2 evd =
diff --git a/pretyping/evarconv.mli b/pretyping/evarconv.mli
index 350dece28a..721a6fad8e 100644
--- a/pretyping/evarconv.mli
+++ b/pretyping/evarconv.mli
@@ -8,7 +8,6 @@
(* * (see LICENSE file for the text of the license) *)
(************************************************************************)
-open Names
open EConstr
open Environ
open Reductionops
@@ -22,20 +21,20 @@ exception UnableToUnify of evar_map * Pretype_errors.unification_error
(** {6 Main unification algorithm for type inference. } *)
(** returns exception NotUnifiable with best known evar_map if not unifiable *)
-val the_conv_x : env -> ?ts:transparent_state -> constr -> constr -> evar_map -> evar_map
-val the_conv_x_leq : env -> ?ts:transparent_state -> constr -> constr -> evar_map -> evar_map
+val the_conv_x : env -> ?ts:TranspState.t -> constr -> constr -> evar_map -> evar_map
+val the_conv_x_leq : env -> ?ts:TranspState.t -> constr -> constr -> evar_map -> evar_map
(** The same function resolving evars by side-effect and
catching the exception *)
-val conv : env -> ?ts:transparent_state -> evar_map -> constr -> constr -> evar_map option
-val cumul : env -> ?ts:transparent_state -> evar_map -> constr -> constr -> evar_map option
+val conv : env -> ?ts:TranspState.t -> evar_map -> constr -> constr -> evar_map option
+val cumul : env -> ?ts:TranspState.t -> evar_map -> constr -> constr -> evar_map option
(** {6 Unification heuristics. } *)
(** Try heuristics to solve pending unification problems and to solve
evars with candidates *)
-val solve_unif_constraints_with_heuristics : env -> ?ts:transparent_state -> evar_map -> evar_map
+val solve_unif_constraints_with_heuristics : env -> ?ts:TranspState.t -> evar_map -> evar_map
(** Check all pending unification problems are solved and raise an
error otherwise *)
@@ -55,14 +54,14 @@ val check_conv_record : env -> evar_map ->
(** Try to solve problems of the form ?x[args] = c by second-order
matching, using typing to select occurrences *)
-val second_order_matching : transparent_state -> env -> evar_map ->
+val second_order_matching : TranspState.t -> env -> evar_map ->
EConstr.existential -> occurrences option list -> constr -> evar_map * bool
(** Declare function to enforce evars resolution by using typing constraints *)
val set_solve_evars : (env -> evar_map -> constr -> evar_map * constr) -> unit
-type unify_fun = transparent_state ->
+type unify_fun = TranspState.t ->
env -> evar_map -> conv_pb -> constr -> constr -> Evarsolve.unification_result
(** Override default [evar_conv_x] algorithm. *)
@@ -73,7 +72,7 @@ val evar_conv_x : unify_fun
(**/**)
(* For debugging *)
-val evar_eqappr_x : ?rhs_is_already_stuck:bool -> transparent_state * bool ->
+val evar_eqappr_x : ?rhs_is_already_stuck:bool -> TranspState.t * bool ->
env -> evar_map ->
conv_pb -> state * Cst_stack.t -> state * Cst_stack.t ->
Evarsolve.unification_result
diff --git a/pretyping/reductionops.ml b/pretyping/reductionops.ml
index 17003cd1dd..18b0bab892 100644
--- a/pretyping/reductionops.ml
+++ b/pretyping/reductionops.ml
@@ -1305,13 +1305,13 @@ let test_trans_conversion (f: constr Reduction.extended_conversion_function) red
with Reduction.NotConvertible -> false
| e when is_anomaly e -> report_anomaly e
-let is_conv ?(reds=full_transparent_state) env sigma = test_trans_conversion f_conv reds env sigma
-let is_conv_leq ?(reds=full_transparent_state) env sigma = test_trans_conversion f_conv_leq reds env sigma
-let is_fconv ?(reds=full_transparent_state) = function
+let is_conv ?(reds=TranspState.full) env sigma = test_trans_conversion f_conv reds env sigma
+let is_conv_leq ?(reds=TranspState.full) env sigma = test_trans_conversion f_conv_leq reds env sigma
+let is_fconv ?(reds=TranspState.full) = function
| Reduction.CONV -> is_conv ~reds
| Reduction.CUMUL -> is_conv_leq ~reds
-let check_conv ?(pb=Reduction.CUMUL) ?(ts=full_transparent_state) env sigma x y =
+let check_conv ?(pb=Reduction.CUMUL) ?(ts=TranspState.full) env sigma x y =
let f = match pb with
| Reduction.CONV -> f_conv
| Reduction.CUMUL -> f_conv_leq
@@ -1345,7 +1345,7 @@ let sigma_univ_state =
compare_cumul_instances = sigma_check_inductive_instances; }
let infer_conv_gen conv_fun ?(catch_incon=true) ?(pb=Reduction.CUMUL)
- ?(ts=full_transparent_state) env sigma x y =
+ ?(ts=TranspState.full) env sigma x y =
(** FIXME *)
try
let ans = match pb with
@@ -1378,7 +1378,7 @@ let infer_conv = infer_conv_gen (fun pb ~l2r sigma ->
Reduction.generic_conv pb ~l2r (safe_evar_value sigma))
(* This reference avoids always having to link C code with the kernel *)
-let vm_infer_conv = ref (infer_conv ~catch_incon:true ~ts:full_transparent_state)
+let vm_infer_conv = ref (infer_conv ~catch_incon:true ~ts:TranspState.full)
let set_vm_infer_conv f = vm_infer_conv := f
let vm_infer_conv ?(pb=Reduction.CUMUL) env t1 t2 =
!vm_infer_conv ~pb env t1 t2
diff --git a/pretyping/reductionops.mli b/pretyping/reductionops.mli
index 41de779414..2f2728465f 100644
--- a/pretyping/reductionops.mli
+++ b/pretyping/reductionops.mli
@@ -266,21 +266,21 @@ type conversion_test = Constraint.t -> Constraint.t
val pb_is_equal : conv_pb -> bool
val pb_equal : conv_pb -> conv_pb
-val is_conv : ?reds:transparent_state -> env -> evar_map -> constr -> constr -> bool
-val is_conv_leq : ?reds:transparent_state -> env -> evar_map -> constr -> constr -> bool
-val is_fconv : ?reds:transparent_state -> conv_pb -> env -> evar_map -> constr -> constr -> bool
+val is_conv : ?reds:TranspState.t -> env -> evar_map -> constr -> constr -> bool
+val is_conv_leq : ?reds:TranspState.t -> env -> evar_map -> constr -> constr -> bool
+val is_fconv : ?reds:TranspState.t -> conv_pb -> env -> evar_map -> constr -> constr -> bool
(** [check_conv] Checks universe constraints only.
pb defaults to CUMUL and ts to a full transparent state.
*)
-val check_conv : ?pb:conv_pb -> ?ts:transparent_state -> env -> evar_map -> constr -> constr -> bool
+val check_conv : ?pb:conv_pb -> ?ts:TranspState.t -> env -> evar_map -> constr -> constr -> bool
(** [infer_conv] Adds necessary universe constraints to the evar map.
pb defaults to CUMUL and ts to a full transparent state.
@raise UniverseInconsistency iff catch_incon is set to false,
otherwise returns false in that case.
*)
-val infer_conv : ?catch_incon:bool -> ?pb:conv_pb -> ?ts:transparent_state ->
+val infer_conv : ?catch_incon:bool -> ?pb:conv_pb -> ?ts:TranspState.t ->
env -> evar_map -> constr -> constr -> evar_map option
(** Conversion with inference of universe constraints *)
@@ -292,9 +292,9 @@ val vm_infer_conv : ?pb:conv_pb -> env -> evar_map -> constr -> constr ->
(** [infer_conv_gen] behaves like [infer_conv] but is parametrized by a
conversion function. Used to pretype vm and native casts. *)
-val infer_conv_gen : (conv_pb -> l2r:bool -> evar_map -> transparent_state ->
+val infer_conv_gen : (conv_pb -> l2r:bool -> evar_map -> TranspState.t ->
(Constr.constr, evar_map) Reduction.generic_conversion_function) ->
- ?catch_incon:bool -> ?pb:conv_pb -> ?ts:transparent_state -> env ->
+ ?catch_incon:bool -> ?pb:conv_pb -> ?ts:TranspState.t -> env ->
evar_map -> constr -> constr -> evar_map option
(** {6 Special-Purpose Reduction Functions } *)
@@ -302,13 +302,13 @@ val infer_conv_gen : (conv_pb -> l2r:bool -> evar_map -> transparent_state ->
val whd_meta : local_reduction_function
val plain_instance : evar_map -> constr Metamap.t -> constr -> constr
val instance : evar_map -> constr Metamap.t -> constr -> constr
-val head_unfold_under_prod : transparent_state -> reduction_function
+val head_unfold_under_prod : TranspState.t -> reduction_function
val betazetaevar_applist : evar_map -> int -> constr -> constr list -> constr
(** {6 Heuristic for Conversion with Evar } *)
val whd_betaiota_deltazeta_for_iota_state :
- transparent_state -> Environ.env -> Evd.evar_map -> Cst_stack.t -> state ->
+ TranspState.t -> Environ.env -> Evd.evar_map -> Cst_stack.t -> state ->
state * Cst_stack.t
(** {6 Meta-related reduction functions } *)
diff --git a/pretyping/tacred.ml b/pretyping/tacred.ml
index 4ec8569dd8..988d1c7579 100644
--- a/pretyping/tacred.ml
+++ b/pretyping/tacred.ml
@@ -638,7 +638,7 @@ let whd_nothing_for_iota env sigma s =
| Meta ev ->
(try whrec (Evd.meta_value sigma ev, stack)
with Not_found -> s)
- | Const (const, u) when is_transparent_constant full_transparent_state const ->
+ | Const (const, u) when is_transparent_constant TranspState.full const ->
let u = EInstance.kind sigma u in
(match constant_opt_value_in env (const, u) with
| Some body -> whrec (EConstr.of_constr body, stack)
diff --git a/pretyping/typeclasses.mli b/pretyping/typeclasses.mli
index ee9c83dad3..c6a58fc1e9 100644
--- a/pretyping/typeclasses.mli
+++ b/pretyping/typeclasses.mli
@@ -119,8 +119,8 @@ val resolve_one_typeclass : ?unique:bool -> env -> evar_map -> EConstr.types ->
val set_typeclass_transparency_hook : (evaluable_global_reference -> bool (*local?*) -> bool -> unit) Hook.t
val set_typeclass_transparency : evaluable_global_reference -> bool -> bool -> unit
-val classes_transparent_state_hook : (unit -> transparent_state) Hook.t
-val classes_transparent_state : unit -> transparent_state
+val classes_transparent_state_hook : (unit -> TranspState.t) Hook.t
+val classes_transparent_state : unit -> TranspState.t
val add_instance_hint_hook :
(global_reference_or_constr -> GlobRef.t list ->
diff --git a/pretyping/unification.ml b/pretyping/unification.ml
index e3b942b610..6e5295a912 100644
--- a/pretyping/unification.ml
+++ b/pretyping/unification.ml
@@ -149,7 +149,7 @@ let abstract_list_all_with_dependencies env evd typ c l =
let n = List.length l in
let argoccs = set_occurrences_of_last_arg (Array.sub (snd ev') 0 n) in
let evd,b =
- Evarconv.second_order_matching empty_transparent_state
+ Evarconv.second_order_matching TranspState.empty
env evd ev' argoccs c in
if b then
let p = nf_evar evd ev in
@@ -247,7 +247,7 @@ let sort_eqns = unify_r2l
*)
type core_unify_flags = {
- modulo_conv_on_closed_terms : Names.transparent_state option;
+ modulo_conv_on_closed_terms : TranspState.t option;
(* What this flag controls was activated with all constants transparent, *)
(* even for auto, since Coq V5.10 *)
@@ -257,11 +257,11 @@ type core_unify_flags = {
use_evars_eagerly_in_conv_on_closed_terms : bool;
- modulo_delta : Names.transparent_state;
+ modulo_delta : TranspState.t;
(* This controls which constants are unfoldable; this is on for apply *)
(* (but not simple apply) since Feb 2008 for 8.2 *)
- modulo_delta_types : Names.transparent_state;
+ modulo_delta_types : TranspState.t;
check_applied_meta_types : bool;
(* This controls whether meta's applied to arguments have their *)
@@ -322,7 +322,7 @@ type unify_flags = {
(* Default flag for unifying a type against a type (e.g. apply) *)
(* We set all conversion flags (no flag should be modified anymore) *)
let default_core_unify_flags () =
- let ts = Names.full_transparent_state in {
+ let ts = TranspState.full in {
modulo_conv_on_closed_terms = Some ts;
use_metas_eagerly_in_conv_on_closed_terms = true;
use_evars_eagerly_in_conv_on_closed_terms = false;
@@ -344,14 +344,14 @@ let default_unify_flags () =
let flags = default_core_unify_flags () in {
core_unify_flags = flags;
merge_unify_flags = flags;
- subterm_unify_flags = { flags with modulo_delta = var_full_transparent_state };
+ subterm_unify_flags = { flags with modulo_delta = TranspState.var_full };
allow_K_in_toplevel_higher_order_unification = false; (* Why not? *)
resolve_evars = false
}
let set_no_delta_core_flags flags = { flags with
modulo_conv_on_closed_terms = None;
- modulo_delta = empty_transparent_state;
+ modulo_delta = TranspState.empty;
check_applied_meta_types = false;
use_pattern_unification = false;
use_meta_bound_pattern_unification = true;
@@ -370,7 +370,7 @@ let set_no_delta_flags flags = {
(* For the first phase of keyed unification, restrict
to conversion (including beta-iota) only on closed terms *)
let set_no_delta_open_core_flags flags = { flags with
- modulo_delta = empty_transparent_state;
+ modulo_delta = TranspState.empty;
modulo_betaiota = false;
}
@@ -388,7 +388,7 @@ let set_no_delta_open_flags flags = {
(* We set only the flags available at the time the new "apply" extended *)
(* out of "simple apply" *)
let default_no_delta_core_unify_flags () = { (default_core_unify_flags ()) with
- modulo_delta = empty_transparent_state;
+ modulo_delta = TranspState.empty;
check_applied_meta_types = false;
use_pattern_unification = false;
use_meta_bound_pattern_unification = true;
@@ -425,7 +425,7 @@ let elim_flags_evars sigma =
let flags = elim_core_flags sigma in {
core_unify_flags = flags;
merge_unify_flags = flags;
- subterm_unify_flags = { flags with modulo_delta = empty_transparent_state };
+ subterm_unify_flags = { flags with modulo_delta = TranspState.empty };
allow_K_in_toplevel_higher_order_unification = true;
resolve_evars = false
}
@@ -433,7 +433,7 @@ let elim_flags_evars sigma =
let elim_flags () = elim_flags_evars Evd.empty
let elim_no_delta_core_flags () = { (elim_core_flags Evd.empty) with
- modulo_delta = empty_transparent_state;
+ modulo_delta = TranspState.empty;
check_applied_meta_types = false;
use_pattern_unification = false;
modulo_betaiota = false;
@@ -935,8 +935,8 @@ let rec unify_0_with_initial_metas (sigma,ms,es as subst : subst0) conv_at_top e
let ty1 = get_type_of curenv ~lax:true sigma c1 in
let ty2 = get_type_of curenv ~lax:true sigma c2 in
unify_0_with_initial_metas substn true curenv cv_pb
- { flags with modulo_conv_on_closed_terms = Some full_transparent_state;
- modulo_delta = full_transparent_state;
+ { flags with modulo_conv_on_closed_terms = Some TranspState.full;
+ modulo_delta = TranspState.full;
modulo_eta = true;
modulo_betaiota = true }
ty1 ty2
@@ -1534,11 +1534,11 @@ let finish_evar_resolution ?(flags=Pretyping.all_and_fail_flags) env current_sig
(sigma, nf_evar sigma c)
let default_matching_core_flags sigma =
- let ts = Names.full_transparent_state in {
- modulo_conv_on_closed_terms = Some empty_transparent_state;
+ let ts = TranspState.full in {
+ modulo_conv_on_closed_terms = Some TranspState.empty;
use_metas_eagerly_in_conv_on_closed_terms = false;
use_evars_eagerly_in_conv_on_closed_terms = false;
- modulo_delta = empty_transparent_state;
+ modulo_delta = TranspState.empty;
modulo_delta_types = ts;
check_applied_meta_types = true;
use_pattern_unification = false;
@@ -1550,7 +1550,7 @@ let default_matching_core_flags sigma =
}
let default_matching_merge_flags sigma =
- let ts = Names.full_transparent_state in
+ let ts = TranspState.full in
let flags = default_matching_core_flags sigma in {
flags with
modulo_conv_on_closed_terms = Some ts;
@@ -1580,7 +1580,7 @@ let make_pattern_test from_prefix_of_ind is_correct_type env sigma (pending,c) =
if from_prefix_of_ind then
let flags = default_matching_flags pending in
{ flags with core_unify_flags = { flags.core_unify_flags with
- modulo_conv_on_closed_terms = Some Names.full_transparent_state;
+ modulo_conv_on_closed_terms = Some TranspState.full;
restrict_conv_on_strict_subterms = true } }
else default_matching_flags pending in
let n = Array.length (snd (decompose_app_vect sigma c)) in
diff --git a/pretyping/unification.mli b/pretyping/unification.mli
index e2e261ae7a..b7b525c9fc 100644
--- a/pretyping/unification.mli
+++ b/pretyping/unification.mli
@@ -8,18 +8,17 @@
(* * (see LICENSE file for the text of the license) *)
(************************************************************************)
-open Names
open Constr
open EConstr
open Environ
open Evd
type core_unify_flags = {
- modulo_conv_on_closed_terms : Names.transparent_state option;
+ modulo_conv_on_closed_terms : TranspState.t option;
use_metas_eagerly_in_conv_on_closed_terms : bool;
use_evars_eagerly_in_conv_on_closed_terms : bool;
- modulo_delta : Names.transparent_state;
- modulo_delta_types : Names.transparent_state;
+ modulo_delta : TranspState.t;
+ modulo_delta_types : TranspState.t;
check_applied_meta_types : bool;
use_pattern_unification : bool;
use_meta_bound_pattern_unification : bool;
@@ -41,7 +40,7 @@ val default_core_unify_flags : unit -> core_unify_flags
val default_no_delta_core_unify_flags : unit -> core_unify_flags
val default_unify_flags : unit -> unify_flags
-val default_no_delta_unify_flags : transparent_state -> unify_flags
+val default_no_delta_unify_flags : TranspState.t -> unify_flags
val elim_flags : unit -> unify_flags
val elim_no_delta_flags : unit -> unify_flags
diff --git a/printing/printer.mli b/printing/printer.mli
index f9d1a62895..fb4e790c10 100644
--- a/printing/printer.mli
+++ b/printing/printer.mli
@@ -134,7 +134,7 @@ val pr_context_of : env -> evar_map -> Pp.t
val pr_predicate : ('a -> Pp.t) -> (bool * 'a list) -> Pp.t
val pr_cpred : Cpred.t -> Pp.t
val pr_idpred : Id.Pred.t -> Pp.t
-val pr_transparent_state : transparent_state -> Pp.t
+val pr_transparent_state : TranspState.t -> Pp.t
(** Proofs, these functions obey [Hyps Limit] and [Compact contexts]. *)
diff --git a/proofs/clenvtac.ml b/proofs/clenvtac.ml
index b99cf245fe..ac3f52c6ef 100644
--- a/proofs/clenvtac.ml
+++ b/proofs/clenvtac.ml
@@ -9,7 +9,6 @@
(************************************************************************)
open Util
-open Names
open Constr
open Termops
open Evd
@@ -102,11 +101,11 @@ let res_pf ?with_evars ?(with_classes=true) ?(flags=dft ()) clenv =
provenant de w_Unify. (Utilisé seulement dans prolog.ml) *)
let fail_quick_core_unif_flags = {
- modulo_conv_on_closed_terms = Some full_transparent_state;
+ modulo_conv_on_closed_terms = Some TranspState.full;
use_metas_eagerly_in_conv_on_closed_terms = false;
use_evars_eagerly_in_conv_on_closed_terms = false;
- modulo_delta = empty_transparent_state;
- modulo_delta_types = full_transparent_state;
+ modulo_delta = TranspState.empty;
+ modulo_delta_types = TranspState.full;
check_applied_meta_types = false;
use_pattern_unification = false;
use_meta_bound_pattern_unification = true; (* ? *)
diff --git a/proofs/evar_refiner.ml b/proofs/evar_refiner.ml
index cb71f09826..fb42a9cebe 100644
--- a/proofs/evar_refiner.ml
+++ b/proofs/evar_refiner.ml
@@ -10,7 +10,6 @@
open CErrors
open Util
-open Names
open Evd
open Evarutil
open Evarsolve
@@ -38,7 +37,7 @@ let define_and_solve_constraints evk c env evd =
match
List.fold_left
(fun p (pbty,env,t1,t2) -> match p with
- | Success evd -> Evarconv.evar_conv_x full_transparent_state env evd pbty t1 t2
+ | Success evd -> Evarconv.evar_conv_x TranspState.full env evd pbty t1 t2
| UnifFailure _ as x -> x) (Success evd)
pbs
with
diff --git a/tactics/auto.ml b/tactics/auto.ml
index 65b2615b6b..07b9bac2c7 100644
--- a/tactics/auto.ml
+++ b/tactics/auto.ml
@@ -45,7 +45,7 @@ let auto_core_unif_flags_of st1 st2 = {
use_metas_eagerly_in_conv_on_closed_terms = false;
use_evars_eagerly_in_conv_on_closed_terms = false;
modulo_delta = st2;
- modulo_delta_types = full_transparent_state;
+ modulo_delta_types = TranspState.full;
check_applied_meta_types = false;
use_pattern_unification = false;
use_meta_bound_pattern_unification = true;
@@ -59,13 +59,13 @@ let auto_unif_flags_of st1 st2 =
let flags = auto_core_unif_flags_of st1 st2 in {
core_unify_flags = flags;
merge_unify_flags = flags;
- subterm_unify_flags = { flags with modulo_delta = empty_transparent_state };
+ subterm_unify_flags = { flags with modulo_delta = TranspState.empty };
allow_K_in_toplevel_higher_order_unification = false;
resolve_evars = true
}
let auto_unif_flags =
- auto_unif_flags_of full_transparent_state empty_transparent_state
+ auto_unif_flags_of TranspState.full TranspState.empty
(* Try unification with the precompiled clause, then use registered Apply *)
@@ -291,7 +291,7 @@ let flags_of_state st =
auto_unif_flags_of st st
let auto_flags_of_state st =
- auto_unif_flags_of full_transparent_state st
+ auto_unif_flags_of TranspState.full st
let hintmap_of sigma secvars hdc concl =
match hdc with
diff --git a/tactics/auto.mli b/tactics/auto.mli
index a835c1ed95..c7acbd4bfb 100644
--- a/tactics/auto.mli
+++ b/tactics/auto.mli
@@ -22,7 +22,7 @@ val compute_secvars : Proofview.Goal.t -> Id.Pred.t
val default_search_depth : int ref
-val auto_flags_of_state : transparent_state -> Unification.unify_flags
+val auto_flags_of_state : TranspState.t -> Unification.unify_flags
val connect_hint_clenv : polymorphic -> raw_hint -> clausenv ->
Proofview.Goal.t -> clausenv * constr
diff --git a/tactics/btermdn.mli b/tactics/btermdn.mli
index 861c9b6250..6af5012def 100644
--- a/tactics/btermdn.mli
+++ b/tactics/btermdn.mli
@@ -9,7 +9,6 @@
(************************************************************************)
open Pattern
-open Names
(** Discrimination nets with bounded depth. *)
@@ -19,7 +18,7 @@ open Names
order in such a way patterns having the same prefix have this common
prefix shared and the seek for the action associated to the patterns
that a term matches are found in time proportional to the maximal
-number of nodes of the patterns matching the term. The [transparent_state]
+number of nodes of the patterns matching the term. The [TranspState.t]
indicates which constants and variables can be considered as rigid.
These dnets are able to cope with existential variables as well, which match
[Everything]. *)
@@ -31,10 +30,10 @@ sig
val empty : t
- val add : transparent_state option -> t -> (constr_pattern * Z.t) -> t
- val rmv : transparent_state option -> t -> (constr_pattern * Z.t) -> t
+ val add : TranspState.t option -> t -> (constr_pattern * Z.t) -> t
+ val rmv : TranspState.t option -> t -> (constr_pattern * Z.t) -> t
- val lookup : Evd.evar_map -> transparent_state option -> t -> EConstr.constr -> Z.t list
+ val lookup : Evd.evar_map -> TranspState.t option -> t -> EConstr.constr -> Z.t list
val app : (Z.t -> unit) -> t -> unit
end
diff --git a/tactics/class_tactics.ml b/tactics/class_tactics.ml
index 81cf9289d1..f27e5e281a 100644
--- a/tactics/class_tactics.ml
+++ b/tactics/class_tactics.ml
@@ -585,9 +585,9 @@ module Search = struct
(** Local hints *)
let autogoal_cache = Summary.ref ~name:"autogoal_cache"
(DirPath.empty, true, Context.Named.empty,
- Hint_db.empty full_transparent_state true)
+ Hint_db.empty TranspState.full true)
- let make_autogoal_hints only_classes ?(st=full_transparent_state) g =
+ let make_autogoal_hints only_classes ?(st=TranspState.full) g =
let open Proofview in
let open Tacmach.New in
let sign = Goal.hyps g in
@@ -605,7 +605,7 @@ module Search = struct
in
autogoal_cache := (cwd, only_classes, sign, hints); hints
- let make_autogoal ?(st=full_transparent_state) only_classes dep cut i g =
+ let make_autogoal ?(st=TranspState.full) only_classes dep cut i g =
let hints = make_autogoal_hints only_classes ~st g in
{ search_hints = hints;
search_depth = [i]; last_tac = lazy (str"none");
@@ -843,7 +843,7 @@ module Search = struct
let info = make_autogoal ?st only_classes dep (cut_of_hints hints) i gl in
search_tac hints depth 1 info
- let search_tac ?(st=full_transparent_state) only_classes dep hints depth =
+ let search_tac ?(st=TranspState.full) only_classes dep hints depth =
let open Proofview in
let tac sigma gls i =
Goal.enter
@@ -873,7 +873,7 @@ module Search = struct
| (e,ie) -> Proofview.tclZERO ~info:ie e)
in aux 1
- let eauto_tac ?(st=full_transparent_state) ?(unique=false)
+ let eauto_tac ?(st=TranspState.full) ?(unique=false)
~only_classes ?strategy ~depth ~dep hints =
let open Proofview in
let tac =
@@ -985,7 +985,7 @@ end
(** Binding to either V85 or Search implementations. *)
-let typeclasses_eauto ?(only_classes=false) ?(st=full_transparent_state)
+let typeclasses_eauto ?(only_classes=false) ?(st=TranspState.full)
?strategy ~depth dbs =
let dbs = List.map_filter
(fun db -> try Some (searchtable_map db)
diff --git a/tactics/class_tactics.mli b/tactics/class_tactics.mli
index 9ba69a0584..9e2b0d26b5 100644
--- a/tactics/class_tactics.mli
+++ b/tactics/class_tactics.mli
@@ -25,7 +25,7 @@ type search_strategy = Dfs | Bfs
val set_typeclasses_strategy : search_strategy -> unit
-val typeclasses_eauto : ?only_classes:bool -> ?st:transparent_state -> ?strategy:search_strategy ->
+val typeclasses_eauto : ?only_classes:bool -> ?st:TranspState.t -> ?strategy:search_strategy ->
depth:(Int.t option) ->
Hints.hint_db_name list -> unit Proofview.tactic
@@ -39,7 +39,7 @@ val autoapply : constr -> Hints.hint_db_name -> unit Proofview.tactic
module Search : sig
val eauto_tac :
- ?st:Names.transparent_state ->
+ ?st:TranspState.t ->
(** The transparent_state used when working with local hypotheses *)
?unique:bool ->
(** Should we force a unique solution *)
diff --git a/tactics/eauto.ml b/tactics/eauto.ml
index 5067315d08..c18b7bb214 100644
--- a/tactics/eauto.ml
+++ b/tactics/eauto.ml
@@ -29,7 +29,7 @@ open Locusops
open Hints
open Proofview.Notations
-let eauto_unif_flags = auto_flags_of_state full_transparent_state
+let eauto_unif_flags = auto_flags_of_state TranspState.full
let e_give_exact ?(flags=eauto_unif_flags) c =
Proofview.Goal.enter begin fun gl ->
@@ -307,7 +307,7 @@ module SearchProblem = struct
let gls = {Evd.it = gl; sigma = lgls.Evd.sigma } in
let hyps' = pf_hyps gls in
if hyps' == hyps then List.hd s.localdb
- else make_local_hint_db (pf_env gls) (project gls) ~ts:full_transparent_state true s.local_lemmas)
+ else make_local_hint_db (pf_env gls) (project gls) ~ts:TranspState.full true s.local_lemmas)
(List.firstn ((nbgl'-nbgl) + 1) (sig_it lgls))
in
{ depth = pred s.depth; priority = cost; tacres = lgls;
@@ -388,7 +388,7 @@ let make_initial_state dbg n gl dblist localdb lems =
}
let e_search_auto debug (in_depth,p) lems db_list gl =
- let local_db = make_local_hint_db (pf_env gl) (project gl) ~ts:full_transparent_state true lems in
+ let local_db = make_local_hint_db (pf_env gl) (project gl) ~ts:TranspState.full true lems in
let d = mk_eauto_dbg debug in
let tac = match in_depth,d with
| (true,Debug) -> Search.debug_depth_first
diff --git a/tactics/equality.ml b/tactics/equality.ml
index c4a6b1605d..8377cd5c75 100644
--- a/tactics/equality.ml
+++ b/tactics/equality.ml
@@ -101,8 +101,8 @@ let rewrite_core_unif_flags = {
modulo_conv_on_closed_terms = None;
use_metas_eagerly_in_conv_on_closed_terms = true;
use_evars_eagerly_in_conv_on_closed_terms = false;
- modulo_delta = empty_transparent_state;
- modulo_delta_types = empty_transparent_state;
+ modulo_delta = TranspState.empty;
+ modulo_delta_types = TranspState.empty;
check_applied_meta_types = true;
use_pattern_unification = true;
use_meta_bound_pattern_unification = true;
@@ -169,7 +169,7 @@ let instantiate_lemma gl c ty l l2r concl =
[eqclause]
let rewrite_conv_closed_core_unif_flags = {
- modulo_conv_on_closed_terms = Some full_transparent_state;
+ modulo_conv_on_closed_terms = Some TranspState.full;
(* We have this flag for historical reasons, it has e.g. the consequence *)
(* to rewrite "?x+2" in "y+(1+1)=0" or to rewrite "?x+?x" in "2+(1+1)=0" *)
@@ -178,8 +178,8 @@ let rewrite_conv_closed_core_unif_flags = {
(* Combined with modulo_conv_on_closed_terms, this flag allows since 8.2 *)
(* to rewrite e.g. "?x+(2+?x)" in "1+(1+2)=0" *)
- modulo_delta = empty_transparent_state;
- modulo_delta_types = full_transparent_state;
+ modulo_delta = TranspState.empty;
+ modulo_delta_types = TranspState.full;
check_applied_meta_types = true;
use_pattern_unification = true;
(* To rewrite "?n x y" in "y+x=0" when ?n is *)
@@ -204,7 +204,7 @@ let rewrite_conv_closed_unif_flags = {
}
let rewrite_keyed_core_unif_flags = {
- modulo_conv_on_closed_terms = Some full_transparent_state;
+ modulo_conv_on_closed_terms = Some TranspState.full;
(* We have this flag for historical reasons, it has e.g. the consequence *)
(* to rewrite "?x+2" in "y+(1+1)=0" or to rewrite "?x+?x" in "2+(1+1)=0" *)
@@ -213,8 +213,8 @@ let rewrite_keyed_core_unif_flags = {
(* Combined with modulo_conv_on_closed_terms, this flag allows since 8.2 *)
(* to rewrite e.g. "?x+(2+?x)" in "1+(1+2)=0" *)
- modulo_delta = full_transparent_state;
- modulo_delta_types = full_transparent_state;
+ modulo_delta = TranspState.full;
+ modulo_delta_types = TranspState.full;
check_applied_meta_types = true;
use_pattern_unification = true;
(* To rewrite "?n x y" in "y+x=0" when ?n is *)
diff --git a/tactics/hints.ml b/tactics/hints.ml
index 2f2d32e887..5f0d3a2503 100644
--- a/tactics/hints.ml
+++ b/tactics/hints.ml
@@ -497,7 +497,7 @@ type hint_db_name = string
module Hint_db :
sig
type t
-val empty : ?name:hint_db_name -> transparent_state -> bool -> t
+val empty : ?name:hint_db_name -> TranspState.t -> bool -> t
val find : GlobRef.t -> t -> search_entry
val map_none : secvars:Id.Pred.t -> t -> full_hint list
val map_all : secvars:Id.Pred.t -> GlobRef.t -> t -> full_hint list
@@ -513,8 +513,8 @@ val remove_one : GlobRef.t -> t -> t
val remove_list : GlobRef.t list -> t -> t
val iter : (GlobRef.t option -> hint_mode array list -> full_hint list -> unit) -> t -> unit
val use_dn : t -> bool
-val transparent_state : t -> transparent_state
-val set_transparent_state : t -> transparent_state -> t
+val transparent_state : t -> TranspState.t
+val set_transparent_state : t -> TranspState.t -> t
val add_cut : hints_path -> t -> t
val add_mode : GlobRef.t -> hint_mode array -> t -> t
val cut : t -> hints_path
@@ -526,7 +526,7 @@ end =
struct
type t = {
- hintdb_state : Names.transparent_state;
+ hintdb_state : TranspState.t;
hintdb_cut : hints_path;
hintdb_unfolds : Id.Set.t * Cset.t;
hintdb_max_id : int;
@@ -740,8 +740,8 @@ let typeclasses_db = "typeclass_instances"
let rewrite_db = "rewrite"
let auto_init_db =
- Hintdbmap.add typeclasses_db (Hint_db.empty full_transparent_state true)
- (Hintdbmap.add rewrite_db (Hint_db.empty cst_full_transparent_state true)
+ Hintdbmap.add typeclasses_db (Hint_db.empty TranspState.full true)
+ (Hintdbmap.add rewrite_db (Hint_db.empty TranspState.cst_full true)
Hintdbmap.empty)
let searchtable = Summary.ref ~name:"searchtable" auto_init_db
@@ -977,7 +977,7 @@ let make_trivial env sigma poly ?(name=PathAny) r =
let get_db dbname =
try searchtable_map dbname
- with Not_found -> Hint_db.empty ~name:dbname empty_transparent_state false
+ with Not_found -> Hint_db.empty ~name:dbname TranspState.empty false
let add_hint dbname hintlist =
let check (_, h) =
@@ -1015,7 +1015,7 @@ let remove_hint dbname grs =
searchtable_add (dbname, db')
type hint_action =
- | CreateDB of bool * transparent_state
+ | CreateDB of bool * TranspState.t
| AddTransparency of evaluable_global_reference hints_transparency_target * bool
| AddHints of hint_entry list
| RemoveHints of GlobRef.t list
diff --git a/tactics/hints.mli b/tactics/hints.mli
index 6db8feccd0..43cfb6a059 100644
--- a/tactics/hints.mli
+++ b/tactics/hints.mli
@@ -122,7 +122,7 @@ val glob_hints_path :
module Hint_db :
sig
type t
- val empty : ?name:hint_db_name -> transparent_state -> bool -> t
+ val empty : ?name:hint_db_name -> TranspState.t -> bool -> t
val find : GlobRef.t -> t -> search_entry
(** All hints which have no pattern.
@@ -155,8 +155,8 @@ module Hint_db :
hint_mode array list -> full_hint list -> unit) -> t -> unit
val use_dn : t -> bool
- val transparent_state : t -> transparent_state
- val set_transparent_state : t -> transparent_state -> t
+ val transparent_state : t -> TranspState.t
+ val set_transparent_state : t -> TranspState.t -> t
val add_cut : hints_path -> t -> t
val cut : t -> hints_path
@@ -191,7 +191,7 @@ val searchtable_add : (hint_db_name * hint_db) -> unit
[use_dn] switches the use of the discrimination net for all hints
and patterns. *)
-val create_hint_db : bool -> hint_db_name -> transparent_state -> bool -> unit
+val create_hint_db : bool -> hint_db_name -> TranspState.t -> bool -> unit
val remove_hints : bool -> hint_db_name list -> GlobRef.t list -> unit
@@ -273,7 +273,7 @@ val repr_hint : hint -> (raw_hint * clausenv) hint_ast
Useful to take the current goal hypotheses as hints;
Boolean tells if lemmas with evars are allowed *)
-val make_local_hint_db : env -> evar_map -> ?ts:transparent_state -> bool -> delayed_open_constr list -> hint_db
+val make_local_hint_db : env -> evar_map -> ?ts:TranspState.t -> bool -> delayed_open_constr list -> hint_db
val make_db_list : hint_db_name list -> hint_db list
diff --git a/tactics/tactics.ml b/tactics/tactics.ml
index 03ad1b4c4f..2601b5fd84 100644
--- a/tactics/tactics.ml
+++ b/tactics/tactics.ml
@@ -1660,7 +1660,7 @@ let general_apply ?(respect_opaque=false) with_delta with_destruct with_evars
let sigma = Tacmach.New.project gl in
let ts =
if respect_opaque then Conv_oracle.get_transp_state (oracle env)
- else full_transparent_state
+ else TranspState.full
in
let flags =
if with_delta then default_unify_flags () else default_no_delta_unify_flags ts in
@@ -1826,7 +1826,7 @@ let apply_in_once ?(respect_opaque = false) sidecond_first with_delta
let sigma = Tacmach.New.project gl in
let ts =
if respect_opaque then Conv_oracle.get_transp_state (oracle env)
- else full_transparent_state
+ else TranspState.full
in
let flags =
if with_delta then default_unify_flags () else default_no_delta_unify_flags ts in
@@ -4909,7 +4909,7 @@ let constr_eq ~strict x y =
| None -> fail
end
-let unify ?(state=full_transparent_state) x y =
+let unify ?(state=TranspState.full) x y =
Proofview.Goal.enter begin fun gl ->
let env = Proofview.Goal.env gl in
let sigma = Proofview.Goal.sigma gl in
@@ -4922,7 +4922,7 @@ let unify ?(state=full_transparent_state) x y =
let flags = { (default_unify_flags ()) with
core_unify_flags = core_flags;
merge_unify_flags = core_flags;
- subterm_unify_flags = { core_flags with modulo_delta = empty_transparent_state } }
+ subterm_unify_flags = { core_flags with modulo_delta = TranspState.empty } }
in
let sigma = w_unify (Tacmach.New.pf_env gl) sigma Reduction.CONV ~flags x y in
Proofview.Unsafe.tclEVARS sigma
diff --git a/tactics/tactics.mli b/tactics/tactics.mli
index b298524ff8..1db65fc1aa 100644
--- a/tactics/tactics.mli
+++ b/tactics/tactics.mli
@@ -419,7 +419,7 @@ val generalize_dep : ?with_let:bool (** Don't lose let bindings *) -> constr -
are added to the evar map. *)
val constr_eq : strict:bool -> constr -> constr -> unit Proofview.tactic
-val unify : ?state:Names.transparent_state -> constr -> constr -> unit Proofview.tactic
+val unify : ?state:TranspState.t -> constr -> constr -> unit Proofview.tactic
val abstract_generalize : ?generalize_vars:bool -> ?force_dep:bool -> Id.t -> unit Proofview.tactic
val specialize_eqs : Id.t -> unit Proofview.tactic
diff --git a/vernac/assumptions.mli b/vernac/assumptions.mli
index aead345d8c..56d6202194 100644
--- a/vernac/assumptions.mli
+++ b/vernac/assumptions.mli
@@ -28,5 +28,5 @@ val traverse :
on which a term relies (together with their type). The above warning of
{!traverse} also applies. *)
val assumptions :
- ?add_opaque:bool -> ?add_transparent:bool -> transparent_state ->
+ ?add_opaque:bool -> ?add_transparent:bool -> TranspState.t ->
GlobRef.t -> constr -> types ContextObjectMap.t
diff --git a/vernac/vernacentries.ml b/vernac/vernacentries.ml
index 7a76fb9560..34ddf3377f 100644
--- a/vernac/vernacentries.ml
+++ b/vernac/vernacentries.ml
@@ -1096,7 +1096,7 @@ let vernac_restore_state file =
(* Commands *)
let vernac_create_hintdb ~module_local id b =
- Hints.create_hint_db module_local id full_transparent_state b
+ Hints.create_hint_db module_local id TranspState.full b
let vernac_remove_hints ~module_local dbs ids =
Hints.remove_hints module_local dbs (List.map Smartlocate.global_with_alias ids)