From 0508f7b0fba0582c38129a2787965c99a15eb1c7 Mon Sep 17 00:00:00 2001 From: Emilio Jesus Gallego Arias Date: Mon, 15 Jul 2019 10:06:38 +0200 Subject: [funind] Removed dead code. --- plugins/funind/indfun_common.ml | 2 -- plugins/funind/indfun_common.mli | 3 --- plugins/funind/recdef.ml | 8 +------- 3 files changed, 1 insertion(+), 12 deletions(-) diff --git a/plugins/funind/indfun_common.ml b/plugins/funind/indfun_common.ml index 80fc64fe65..b55d8537d6 100644 --- a/plugins/funind/indfun_common.ml +++ b/plugins/funind/indfun_common.ml @@ -10,8 +10,6 @@ let mk_correct_id id = Nameops.add_suffix (mk_rel_id id) "_correct" let mk_complete_id id = Nameops.add_suffix (mk_rel_id id) "_complete" let mk_equation_id id = Nameops.add_suffix id "_equation" -let msgnl m = () - let fresh_id avoid s = Namegen.next_ident_away_in_goal (Id.of_string s) (Id.Set.of_list avoid) let fresh_name avoid s = Name (fresh_id avoid s) diff --git a/plugins/funind/indfun_common.mli b/plugins/funind/indfun_common.mli index cd5202a6c7..550f727951 100644 --- a/plugins/funind/indfun_common.mli +++ b/plugins/funind/indfun_common.mli @@ -9,9 +9,6 @@ val mk_correct_id : Id.t -> Id.t val mk_complete_id : Id.t -> Id.t val mk_equation_id : Id.t -> Id.t - -val msgnl : Pp.t -> unit - val fresh_id : Id.t list -> string -> Id.t val fresh_name : Id.t list -> string -> Name.t val get_name : Id.t list -> ?default:string -> Name.t -> Name.t diff --git a/plugins/funind/recdef.ml b/plugins/funind/recdef.ml index 4c5eab1a9b..29356df81d 100644 --- a/plugins/funind/recdef.ml +++ b/plugins/funind/recdef.ml @@ -1539,13 +1539,7 @@ let recursive_definition ~interactive_proof ~is_mes function_name rec_impls type generate_induction_principle f_ref tcc_lemma_constr functional_ref eq_ref rec_arg_num (EConstr.of_constr rec_arg_type) - (nb_prod evd (EConstr.of_constr res)) relation; - Flags.if_verbose - msgnl (h 1 (Ppconstr.pr_id function_name ++ - spc () ++ str"is defined" )++ fnl () ++ - h 1 (Ppconstr.pr_id equation_id ++ - spc () ++ str"is defined" ) - ) + (nb_prod evd (EConstr.of_constr res)) relation in (* XXX STATE Why do we need this... why is the toplevel protection not enough *) funind_purify (fun () -> -- cgit v1.2.3 From 11fb93285b2e7c528d8abe7da5924d84e0a97002 Mon Sep 17 00:00:00 2001 From: Emilio Jesus Gallego Arias Date: Fri, 25 Oct 2019 00:30:07 +0200 Subject: [declare] Generalize kind type on declareDef This is useful to remove some duplicate bits in other declare files. --- doc/plugin_tutorial/tuto1/src/simple_declare.ml | 2 +- vernac/comAssumption.ml | 2 +- vernac/comDefinition.ml | 1 + vernac/declareDef.ml | 5 +++-- vernac/declareDef.mli | 2 +- vernac/declareObl.ml | 3 ++- 6 files changed, 9 insertions(+), 6 deletions(-) diff --git a/doc/plugin_tutorial/tuto1/src/simple_declare.ml b/doc/plugin_tutorial/tuto1/src/simple_declare.ml index 9dd4700db5..307214089f 100644 --- a/doc/plugin_tutorial/tuto1/src/simple_declare.ml +++ b/doc/plugin_tutorial/tuto1/src/simple_declare.ml @@ -9,4 +9,4 @@ let edeclare ?hook ~name ~poly ~scope ~kind ~opaque sigma udecl body tyopt imps let declare_definition ~poly name sigma body = let udecl = UState.default_univ_decl in edeclare ~name ~poly ~scope:(DeclareDef.Global Declare.ImportDefaultBehavior) - ~kind:Decls.Definition ~opaque:false sigma udecl body None [] + ~kind:Decls.(IsDefinition Definition) ~opaque:false sigma udecl body None [] diff --git a/vernac/comAssumption.ml b/vernac/comAssumption.ml index f9b73a59eb..a0b0dcf4c8 100644 --- a/vernac/comAssumption.ml +++ b/vernac/comAssumption.ml @@ -217,7 +217,7 @@ let context_insection sigma ~poly ctx = in let entry = Declare.definition_entry ~univs ~types:t b in let _ : GlobRef.t = DeclareDef.declare_definition ~name ~scope:DeclareDef.Discharge - ~kind:Decls.Definition UnivNames.empty_binders entry [] + ~kind:Decls.(IsDefinition Definition) UnivNames.empty_binders entry [] in () in diff --git a/vernac/comDefinition.ml b/vernac/comDefinition.ml index 9745358ba2..5b3f15a08c 100644 --- a/vernac/comDefinition.ml +++ b/vernac/comDefinition.ml @@ -104,4 +104,5 @@ let do_definition ~program_mode ?hook ~name ~scope ~poly ~kind univdecl bl red_o let ce = check_definition ~program_mode def in let uctx = Evd.evar_universe_context evd in let hook_data = Option.map (fun hook -> hook, uctx, []) hook in + let kind = Decls.IsDefinition kind in ignore(DeclareDef.declare_definition ~name ~scope ~kind ?hook_data (Evd.universe_binders evd) ce imps) diff --git a/vernac/declareDef.ml b/vernac/declareDef.ml index 1926faaf0e..67733c95a1 100644 --- a/vernac/declareDef.ml +++ b/vernac/declareDef.ml @@ -48,11 +48,11 @@ let declare_definition ~name ~scope ~kind ?hook_data udecl ce imps = let gr = match scope with | Discharge -> let () = - declare_variable ~name ~kind:Decls.(IsDefinition kind) (SectionLocalDef ce) + declare_variable ~name ~kind (SectionLocalDef ce) in Names.GlobRef.VarRef name | Global local -> - let kn = declare_constant ~name ~local ~kind:Decls.(IsDefinition kind) (DefinitionEntry ce) in + let kn = declare_constant ~name ~local ~kind (DefinitionEntry ce) in let gr = Names.GlobRef.ConstRef kn in let () = Declare.declare_univ_binders gr udecl in gr @@ -69,6 +69,7 @@ let declare_definition ~name ~scope ~kind ?hook_data udecl ce imps = let declare_fix ?(opaque = false) ?hook_data ~name ~scope ~kind udecl univs ((def,_),eff) t imps = let ce = definition_entry ~opaque ~types:t ~univs ~eff def in + let kind = Decls.IsDefinition kind in declare_definition ~name ~scope ~kind ?hook_data udecl ce imps let check_definition_evars ~allow_evars sigma = diff --git a/vernac/declareDef.mli b/vernac/declareDef.mli index 54a0c9a7e8..d6001f5970 100644 --- a/vernac/declareDef.mli +++ b/vernac/declareDef.mli @@ -42,7 +42,7 @@ end val declare_definition : name:Id.t -> scope:locality - -> kind:Decls.definition_object_kind + -> kind:Decls.logical_kind -> ?hook_data:(Hook.t * UState.t * (Id.t * Constr.t) list) -> UnivNames.universe_binders -> Evd.side_effects Declare.proof_entry diff --git a/vernac/declareObl.ml b/vernac/declareObl.ml index 8fd6bc7eab..2c56f707f1 100644 --- a/vernac/declareObl.ml +++ b/vernac/declareObl.ml @@ -351,7 +351,8 @@ let declare_definition prg = let ubinders = UState.universe_binders uctx in let hook_data = Option.map (fun hook -> hook, uctx, obls) prg.prg_hook in DeclareDef.declare_definition - ~name:prg.prg_name ~scope:prg.prg_scope ubinders ~kind:prg.prg_kind ce + ~name:prg.prg_name ~scope:prg.prg_scope ubinders + ~kind:Decls.(IsDefinition prg.prg_kind) ce prg.prg_implicits ?hook_data let rec lam_index n t acc = -- cgit v1.2.3 From 4035b4a66dbd8e29aa933b1e301fbd07815768e4 Mon Sep 17 00:00:00 2001 From: Emilio Jesus Gallego Arias Date: Fri, 25 Oct 2019 00:31:36 +0200 Subject: [funind] Remove duplicate save function. AFAICT the reasoning for introducing this function doesn't hold anymore. This is needed for future refactorings that should make some types private. --- .../10516-ejgallego-proof+dup_save.sh | 6 +++++ plugins/funind/gen_principle.ml | 26 +++++++--------------- 2 files changed, 14 insertions(+), 18 deletions(-) create mode 100644 dev/ci/user-overlays/10516-ejgallego-proof+dup_save.sh diff --git a/dev/ci/user-overlays/10516-ejgallego-proof+dup_save.sh b/dev/ci/user-overlays/10516-ejgallego-proof+dup_save.sh new file mode 100644 index 0000000000..7001c3d0c8 --- /dev/null +++ b/dev/ci/user-overlays/10516-ejgallego-proof+dup_save.sh @@ -0,0 +1,6 @@ +if [ "$CI_PULL_REQUEST" = "10516" ] || [ "$CI_BRANCH" = "proof+dup_save" ]; then + + elpi_CI_REF=proof+dup_save + elpi_CI_GITURL=https://github.com/ejgallego/coq-elpi + +fi diff --git a/plugins/funind/gen_principle.ml b/plugins/funind/gen_principle.ml index 6011af74e5..0452665585 100644 --- a/plugins/funind/gen_principle.ml +++ b/plugins/funind/gen_principle.ml @@ -234,23 +234,6 @@ let change_property_sort evd toSort princ princName = ) (List.map (fun d -> Termops.map_rel_decl EConstr.Unsafe.to_constr d) princ_info.Tactics.params) -(* XXX: To be cleaned up soon in favor of common save path. *) -let save name const ?hook uctx scope kind = - let open Declare in - let open DeclareDef in - let fix_exn = Future.fix_exn_of const.Declare.proof_entry_body in - let r = match scope with - | Discharge -> - let c = SectionLocalDef const in - let () = declare_variable ~name ~kind c in - GlobRef.VarRef name - | Global local -> - let kn = declare_constant ~name ~kind ~local (DefinitionEntry const) in - GlobRef.ConstRef kn - in - DeclareDef.Hook.(call ?hook ~fix_exn { S.uctx; obls = []; scope; dref = r }); - definition_message name - let generate_functional_principle (evd: Evd.evar_map ref) interactive_proof old_princ_type sorts new_princ_name funs i proof_tac @@ -307,7 +290,14 @@ let generate_functional_principle (evd: Evd.evar_map ref) Don't forget to close the goal if an error is raised !!!! *) let uctx = Evd.evar_universe_context sigma in - save new_princ_name entry ~hook uctx (DeclareDef.Global Declare.ImportDefaultBehavior) Decls.(IsProof Theorem) + let hook_data = hook, uctx, [] in + let _ : Names.GlobRef.t = DeclareDef.declare_definition + ~name:new_princ_name ~hook_data + ~scope:(DeclareDef.Global Declare.ImportDefaultBehavior) + ~kind:Decls.(IsProof Theorem) + UnivNames.empty_binders + entry [] in + () with e when CErrors.noncritical e -> raise (Defining_principle e) -- cgit v1.2.3