aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorHugo Herbelin2015-09-23 18:25:15 +0200
committerHugo Herbelin2015-09-23 18:25:15 +0200
commit2ba2ca96be88bad5cd75a02c94cc48ef4f5209b7 (patch)
tree7546ab8a3bf1a0e2b5a75028e9efcade1d8d4321
parent13716dc6561a3379ba130f07ce7ecd1df379475c (diff)
Hopefully better names to constructors of internal_flag, as discussed
with Enrico.
-rw-r--r--library/declare.ml10
-rw-r--r--library/declare.mli6
-rw-r--r--tactics/extratactics.ml42
-rw-r--r--tactics/rewrite.ml2
-rw-r--r--tactics/tactics.ml2
-rw-r--r--toplevel/auto_ind_decl.ml6
-rw-r--r--toplevel/classes.ml4
-rw-r--r--toplevel/ind_tables.ml8
-rw-r--r--toplevel/indschemes.ml36
-rw-r--r--toplevel/record.ml2
10 files changed, 39 insertions, 39 deletions
diff --git a/library/declare.ml b/library/declare.ml
index c3181e4c75..8438380c9c 100644
--- a/library/declare.ml
+++ b/library/declare.ml
@@ -28,9 +28,9 @@ open Decl_kinds
(** flag for internal message display *)
type internal_flag =
- | KernelVerbose (* kernel action, a message is displayed *)
- | KernelSilent (* kernel action, no message is displayed *)
- | UserVerbose (* user action, a message is displayed *)
+ | UserAutomaticRequest (* kernel action, a message is displayed *)
+ | InternalTacticRequest (* kernel action, no message is displayed *)
+ | UserIndividualRequest (* user action, a message is displayed *)
(** Declaration of section variables and local definitions *)
@@ -253,7 +253,7 @@ let declare_sideff env fix_exn se =
if Constant.equal c c' then Some (x,kn) else None) inds_consts)
knl))
-let declare_constant ?(internal = UserVerbose) ?(local = false) id ?(export_seff=false) (cd, kind) =
+let declare_constant ?(internal = UserIndividualRequest) ?(local = false) id ?(export_seff=false) (cd, kind) =
let cd = (* We deal with side effects *)
match cd with
| Entries.DefinitionEntry de ->
@@ -283,7 +283,7 @@ let declare_constant ?(internal = UserVerbose) ?(local = false) id ?(export_seff
let kn = declare_constant_common id cst in
kn
-let declare_definition ?(internal=UserVerbose)
+let declare_definition ?(internal=UserIndividualRequest)
?(opaque=false) ?(kind=Decl_kinds.Definition) ?(local = false)
?(poly=false) id ?types (body,ctx) =
let cb =
diff --git a/library/declare.mli b/library/declare.mli
index d8a00db0cf..76538a6248 100644
--- a/library/declare.mli
+++ b/library/declare.mli
@@ -43,9 +43,9 @@ type constant_declaration = constant_entry * logical_kind
*)
type internal_flag =
- | KernelVerbose
- | KernelSilent
- | UserVerbose
+ | UserAutomaticRequest
+ | InternalTacticRequest
+ | UserIndividualRequest
(* Defaut definition entries, transparent with no secctx or proj information *)
val definition_entry : ?opaque:bool -> ?inline:bool -> ?types:types ->
diff --git a/tactics/extratactics.ml4 b/tactics/extratactics.ml4
index e4240cb5cc..af0870bc92 100644
--- a/tactics/extratactics.ml4
+++ b/tactics/extratactics.ml4
@@ -320,7 +320,7 @@ let project_hint pri l2r r =
Nameops.add_suffix (Nametab.basename_of_global gr) ("_proj_" ^ (if l2r then "l2r" else "r2l"))
in
let ctx = Evd.universe_context_set sigma in
- let c = Declare.declare_definition ~internal:Declare.KernelSilent id (c,ctx) in
+ let c = Declare.declare_definition ~internal:Declare.InternalTacticRequest id (c,ctx) in
(pri,false,true,Hints.PathAny, Hints.IsGlobRef (Globnames.ConstRef c))
let add_hints_iff l2r lc n bl =
diff --git a/tactics/rewrite.ml b/tactics/rewrite.ml
index 3c4550a3cf..c64a1226ab 100644
--- a/tactics/rewrite.ml
+++ b/tactics/rewrite.ml
@@ -1896,7 +1896,7 @@ let add_morphism_infer glob m n =
let instance = build_morphism_signature m in
let evd = Evd.empty (*FIXME *) in
if Lib.is_modtype () then
- let cst = Declare.declare_constant ~internal:Declare.KernelSilent instance_id
+ let cst = Declare.declare_constant ~internal:Declare.InternalTacticRequest instance_id
(Entries.ParameterEntry
(None,poly,(instance,Univ.UContext.empty),None),
Decl_kinds.IsAssumption Decl_kinds.Logical)
diff --git a/tactics/tactics.ml b/tactics/tactics.ml
index ad7ff14e6b..b113ed31e9 100644
--- a/tactics/tactics.ml
+++ b/tactics/tactics.ml
@@ -4450,7 +4450,7 @@ let abstract_subproof id gk tac =
let cd = Entries.DefinitionEntry const in
let decl = (cd, IsProof Lemma) in
(** ppedrot: seems legit to have abstracted subproofs as local*)
- let cst = Declare.declare_constant ~internal:Declare.KernelSilent ~local:true id decl in
+ let cst = Declare.declare_constant ~internal:Declare.InternalTacticRequest ~local:true id decl in
(* let evd, lem = Evd.fresh_global (Global.env ()) evd (ConstRef cst) in *)
let lem, ctx = Universes.unsafe_constr_of_global (ConstRef cst) in
let evd = Evd.set_universe_context evd ectx in
diff --git a/toplevel/auto_ind_decl.ml b/toplevel/auto_ind_decl.ml
index 118ffb3e80..4122487e23 100644
--- a/toplevel/auto_ind_decl.ml
+++ b/toplevel/auto_ind_decl.ml
@@ -626,9 +626,9 @@ repeat ( apply andb_prop in z;let z1:= fresh "Z" in destruct z as [z1 z]).
let bl_scheme_kind_aux = ref (fun _ -> failwith "Undefined")
let side_effect_of_mode = function
- | Declare.KernelVerbose -> false
- | Declare.KernelSilent -> true
- | Declare.UserVerbose -> false
+ | Declare.UserAutomaticRequest -> false
+ | Declare.InternalTacticRequest -> true
+ | Declare.UserIndividualRequest -> false
let make_bl_scheme mode mind =
let mib = Global.lookup_mind mind in
diff --git a/toplevel/classes.ml b/toplevel/classes.ml
index 33891ad94c..7fe79d948b 100644
--- a/toplevel/classes.ml
+++ b/toplevel/classes.ml
@@ -186,7 +186,7 @@ let new_instance ?(abstract=false) ?(global=false) poly ctx (instid, bk, cl) pro
in
Evarutil.check_evars env Evd.empty !evars termtype;
let ctx = Evd.universe_context !evars in
- let cst = Declare.declare_constant ~internal:Declare.KernelSilent id
+ let cst = Declare.declare_constant ~internal:Declare.InternalTacticRequest id
(Entries.ParameterEntry
(None,poly,(termtype,ctx),None), Decl_kinds.IsAssumption Decl_kinds.Logical)
in instance_hook k None global imps ?hook (ConstRef cst); id
@@ -363,7 +363,7 @@ let context poly l =
if Lib.is_modtype () && not (Lib.sections_are_opened ()) then
let uctx = Univ.ContextSet.to_context uctx in
let decl = (ParameterEntry (None,poly,(t,uctx),None), IsAssumption Logical) in
- let cst = Declare.declare_constant ~internal:Declare.KernelSilent id decl in
+ let cst = Declare.declare_constant ~internal:Declare.InternalTacticRequest id decl in
match class_of_constr t with
| Some (rels, ((tc,_), args) as _cl) ->
add_instance (Typeclasses.new_instance tc None false (*FIXME*)
diff --git a/toplevel/ind_tables.ml b/toplevel/ind_tables.ml
index b59d6fc8ae..218c47b28d 100644
--- a/toplevel/ind_tables.ml
+++ b/toplevel/ind_tables.ml
@@ -113,8 +113,8 @@ let is_visible_name id =
let compute_name internal id =
match internal with
- | KernelVerbose | UserVerbose -> id
- | KernelSilent ->
+ | UserAutomaticRequest | UserIndividualRequest -> id
+ | InternalTacticRequest ->
Namegen.next_ident_away_from (add_prefix "internal_" id) is_visible_name
let define internal id c p univs =
@@ -135,7 +135,7 @@ let define internal id c p univs =
} in
let kn = fd id (DefinitionEntry entry, Decl_kinds.IsDefinition Scheme) in
let () = match internal with
- | KernelSilent -> ()
+ | InternalTacticRequest -> ()
| _-> definition_message id
in
kn
@@ -186,7 +186,7 @@ let find_scheme_on_env_too kind ind =
kind (Global.safe_env()) [ind, s])
Declareops.no_seff
-let find_scheme ?(mode=KernelSilent) kind (mind,i as ind) =
+let find_scheme ?(mode=InternalTacticRequest) kind (mind,i as ind) =
try find_scheme_on_env_too kind ind
with Not_found ->
match Hashtbl.find scheme_object_table kind with
diff --git a/toplevel/indschemes.ml b/toplevel/indschemes.ml
index 286d164c42..452d5fbe50 100644
--- a/toplevel/indschemes.ml
+++ b/toplevel/indschemes.ml
@@ -146,8 +146,8 @@ let declare_beq_scheme_gen internal names kn =
let alarm what internal msg =
let debug = false in
match internal with
- | KernelVerbose
- | KernelSilent ->
+ | UserAutomaticRequest
+ | InternalTacticRequest ->
(if debug then
msg_warning
(hov 0 msg ++ fnl () ++ what ++ str " not defined."))
@@ -195,13 +195,13 @@ let beq_scheme_msg mind =
(List.init (Array.length mib.mind_packets) (fun i -> (mind,i)))
let declare_beq_scheme_with l kn =
- try_declare_scheme (beq_scheme_msg kn) declare_beq_scheme_gen UserVerbose l kn
+ try_declare_scheme (beq_scheme_msg kn) declare_beq_scheme_gen UserIndividualRequest l kn
let try_declare_beq_scheme kn =
(* TODO: handle Fix, eventually handle
proof-irrelevance; improve decidability by depending on decidability
for the parameters rather than on the bl and lb properties *)
- try_declare_scheme (beq_scheme_msg kn) declare_beq_scheme_gen KernelVerbose [] kn
+ try_declare_scheme (beq_scheme_msg kn) declare_beq_scheme_gen UserAutomaticRequest [] kn
let declare_beq_scheme = declare_beq_scheme_with []
@@ -215,7 +215,7 @@ let declare_one_case_analysis_scheme ind =
induction scheme, the other ones share the same code with the
apropriate type *)
if Sorts.List.mem InType kelim then
- ignore (define_individual_scheme dep KernelVerbose None ind)
+ ignore (define_individual_scheme dep UserAutomaticRequest None ind)
(* Induction/recursion schemes *)
@@ -238,7 +238,7 @@ let declare_one_induction_scheme ind =
List.map_filter (fun (sort,kind) ->
if Sorts.List.mem sort kelim then Some kind else None)
(if from_prop then kinds_from_prop else kinds_from_type) in
- List.iter (fun kind -> ignore (define_individual_scheme kind KernelVerbose None ind))
+ List.iter (fun kind -> ignore (define_individual_scheme kind UserAutomaticRequest None ind))
elims
let declare_induction_schemes kn =
@@ -261,11 +261,11 @@ let eq_dec_scheme_msg ind = (* TODO: mutual inductive case *)
let declare_eq_decidability_scheme_with l kn =
try_declare_scheme (eq_dec_scheme_msg (kn,0))
- declare_eq_decidability_gen UserVerbose l kn
+ declare_eq_decidability_gen UserIndividualRequest l kn
let try_declare_eq_decidability kn =
try_declare_scheme (eq_dec_scheme_msg (kn,0))
- declare_eq_decidability_gen KernelVerbose [] kn
+ declare_eq_decidability_gen UserAutomaticRequest [] kn
let declare_eq_decidability = declare_eq_decidability_scheme_with []
@@ -274,17 +274,17 @@ let ignore_error f x =
let declare_rewriting_schemes ind =
if Hipattern.is_inductive_equality ind then begin
- ignore (define_individual_scheme rew_r2l_scheme_kind KernelVerbose None ind);
- ignore (define_individual_scheme rew_r2l_dep_scheme_kind KernelVerbose None ind);
+ ignore (define_individual_scheme rew_r2l_scheme_kind UserAutomaticRequest None ind);
+ ignore (define_individual_scheme rew_r2l_dep_scheme_kind UserAutomaticRequest None ind);
ignore (define_individual_scheme rew_r2l_forward_dep_scheme_kind
- KernelVerbose None ind);
+ UserAutomaticRequest None ind);
(* These ones expect the equality to be symmetric; the first one also *)
(* needs eq *)
- ignore_error (define_individual_scheme rew_l2r_scheme_kind KernelVerbose None) ind;
+ ignore_error (define_individual_scheme rew_l2r_scheme_kind UserAutomaticRequest None) ind;
ignore_error
- (define_individual_scheme rew_l2r_dep_scheme_kind KernelVerbose None) ind;
+ (define_individual_scheme rew_l2r_dep_scheme_kind UserAutomaticRequest None) ind;
ignore_error
- (define_individual_scheme rew_l2r_forward_dep_scheme_kind KernelVerbose None) ind
+ (define_individual_scheme rew_l2r_forward_dep_scheme_kind UserAutomaticRequest None) ind
end
let declare_congr_scheme ind =
@@ -293,7 +293,7 @@ let declare_congr_scheme ind =
try Coqlib.check_required_library Coqlib.logic_module_name; true
with e when Errors.noncritical e -> false
then
- ignore (define_individual_scheme congr_scheme_kind KernelVerbose None ind)
+ ignore (define_individual_scheme congr_scheme_kind UserAutomaticRequest None ind)
else
msg_warning (strbrk "Cannot build congruence scheme because eq is not found")
end
@@ -301,7 +301,7 @@ let declare_congr_scheme ind =
let declare_sym_scheme ind =
if Hipattern.is_inductive_equality ind then
(* Expect the equality to be symmetric *)
- ignore_error (define_individual_scheme sym_scheme_kind KernelVerbose None) ind
+ ignore_error (define_individual_scheme sym_scheme_kind UserAutomaticRequest None) ind
(* Scheme command *)
@@ -372,7 +372,7 @@ let do_mutual_induction_scheme lnamedepindsort =
let decltype = Retyping.get_type_of env0 sigma decl in
(* let decltype = refresh_universes decltype in *)
let proof_output = Future.from_val ((decl,Univ.ContextSet.empty),Declareops.no_seff) in
- let cst = define fi UserVerbose sigma proof_output (Some decltype) in
+ let cst = define fi UserIndividualRequest sigma proof_output (Some decltype) in
ConstRef cst :: lrecref
in
let _ = List.fold_right2 declare listdecl lrecnames [] in
@@ -470,7 +470,7 @@ let do_combined_scheme name schemes =
in
let body,typ = build_combined_scheme (Global.env ()) csts in
let proof_output = Future.from_val ((body,Univ.ContextSet.empty),Declareops.no_seff) in
- ignore (define (snd name) UserVerbose Evd.empty proof_output (Some typ));
+ ignore (define (snd name) UserIndividualRequest Evd.empty proof_output (Some typ));
fixpoint_message None [snd name]
(**********************************************************************)
diff --git a/toplevel/record.ml b/toplevel/record.ml
index 484fd081df..e214f9ca71 100644
--- a/toplevel/record.ml
+++ b/toplevel/record.ml
@@ -298,7 +298,7 @@ let declare_projections indsp ?(kind=StructureComponent) binder_name coers field
const_entry_inline_code = false;
const_entry_feedback = None } in
let k = (DefinitionEntry entry,IsDefinition kind) in
- let kn = declare_constant ~internal:KernelSilent fid k in
+ let kn = declare_constant ~internal:InternalTacticRequest fid k in
let constr_fip =
let proj_args = (*Rel 1 refers to "x"*) paramargs@[mkRel 1] in
applist (mkConstU (kn,u),proj_args)