aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorGaëtan Gilbert2019-10-26 21:21:48 +0200
committerGaëtan Gilbert2019-10-26 21:21:48 +0200
commitf508ddcd2cfff152b8d6291d96e4b87ef9fe2ff9 (patch)
treea80f8a1646e81bdb94bc74229ef5b42bc24b31ff
parentf7659e6c5d197ddeff8509a4aab40316534b3a12 (diff)
parent4035b4a66dbd8e29aa933b1e301fbd07815768e4 (diff)
Merge PR #10516: [funind] Remove duplicate save function.
Reviewed-by: SkySkimmer Ack-by: gares
-rw-r--r--dev/ci/user-overlays/10516-ejgallego-proof+dup_save.sh6
-rw-r--r--doc/plugin_tutorial/tuto1/src/simple_declare.ml2
-rw-r--r--plugins/funind/gen_principle.ml26
-rw-r--r--plugins/funind/indfun_common.ml2
-rw-r--r--plugins/funind/indfun_common.mli3
-rw-r--r--plugins/funind/recdef.ml8
-rw-r--r--vernac/comAssumption.ml2
-rw-r--r--vernac/comDefinition.ml1
-rw-r--r--vernac/declareDef.ml5
-rw-r--r--vernac/declareDef.mli2
-rw-r--r--vernac/declareObl.ml3
11 files changed, 24 insertions, 36 deletions
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/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/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)
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 () ->
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 =