diff options
| author | Hugo Herbelin | 2015-09-23 18:25:15 +0200 |
|---|---|---|
| committer | Hugo Herbelin | 2015-09-23 18:25:15 +0200 |
| commit | 2ba2ca96be88bad5cd75a02c94cc48ef4f5209b7 (patch) | |
| tree | 7546ab8a3bf1a0e2b5a75028e9efcade1d8d4321 | |
| parent | 13716dc6561a3379ba130f07ce7ecd1df379475c (diff) | |
Hopefully better names to constructors of internal_flag, as discussed
with Enrico.
| -rw-r--r-- | library/declare.ml | 10 | ||||
| -rw-r--r-- | library/declare.mli | 6 | ||||
| -rw-r--r-- | tactics/extratactics.ml4 | 2 | ||||
| -rw-r--r-- | tactics/rewrite.ml | 2 | ||||
| -rw-r--r-- | tactics/tactics.ml | 2 | ||||
| -rw-r--r-- | toplevel/auto_ind_decl.ml | 6 | ||||
| -rw-r--r-- | toplevel/classes.ml | 4 | ||||
| -rw-r--r-- | toplevel/ind_tables.ml | 8 | ||||
| -rw-r--r-- | toplevel/indschemes.ml | 36 | ||||
| -rw-r--r-- | toplevel/record.ml | 2 |
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) |
