diff options
| author | Pierre-Marie Pédrot | 2019-06-28 13:58:27 +0200 |
|---|---|---|
| committer | Pierre-Marie Pédrot | 2019-06-28 13:58:27 +0200 |
| commit | a2751a19e9c5c0fd91031f9a62948ad29efea038 (patch) | |
| tree | 8418340ce7d32621eeab718fc2acc268b99ae16a /plugins | |
| parent | a4f6189978b15df8ce4cc8c8fcb8acb6f069ee8e (diff) | |
| parent | e74322d0dc134088ef05bd7b5cbb548578f0bf3f (diff) | |
Merge PR #10434: [declare] Fine tuning of Hook type.
Ack-by: ejgallego
Reviewed-by: ppedrot
Diffstat (limited to 'plugins')
| -rw-r--r-- | plugins/funind/functional_principles_types.ml | 6 | ||||
| -rw-r--r-- | plugins/funind/indfun_common.ml | 6 | ||||
| -rw-r--r-- | plugins/funind/recdef.ml | 4 | ||||
| -rw-r--r-- | plugins/ltac/rewrite.ml | 2 |
4 files changed, 9 insertions, 9 deletions
diff --git a/plugins/funind/functional_principles_types.ml b/plugins/funind/functional_principles_types.ml index edda2f2eef..3bab750534 100644 --- a/plugins/funind/functional_principles_types.ml +++ b/plugins/funind/functional_principles_types.ml @@ -354,7 +354,7 @@ let generate_functional_principle (evd: Evd.evar_map ref) in let names = ref [new_princ_name] in let hook = - fun new_principle_type _ _ _ _ -> + fun new_principle_type _ -> if Option.is_empty sorts then (* let id_of_f = Label.to_id (con_label f) in *) @@ -526,7 +526,7 @@ let make_scheme evd (fas : (pconstant*Sorts.family) list) : Evd.side_effects Pro this_block_funs 0 (prove_princ_for_struct evd false 0 (Array.of_list (List.map fst funs))) - (fun _ _ _ _ _ -> ()) + (fun _ _ -> ()) with e when CErrors.noncritical e -> raise (Defining_principle e) @@ -588,7 +588,7 @@ let make_scheme evd (fas : (pconstant*Sorts.family) list) : Evd.side_effects Pro this_block_funs !i (prove_princ_for_struct evd false !i (Array.of_list (List.map fst funs))) - (fun _ _ _ _ _ -> ()) + (fun _ _ -> ()) in const with Found_type i -> diff --git a/plugins/funind/indfun_common.ml b/plugins/funind/indfun_common.ml index 254760cb50..56ed406e2f 100644 --- a/plugins/funind/indfun_common.ml +++ b/plugins/funind/indfun_common.ml @@ -123,9 +123,9 @@ open DeclareDef let definition_message = Declare.definition_message -let save id const ?hook uctx locality kind = +let save id const ?hook uctx scope kind = let fix_exn = Future.fix_exn_of const.Proof_global.proof_entry_body in - let r = match locality with + let r = match scope with | Discharge -> let k = Kindops.logical_kind_of_goal_kind kind in let c = SectionLocalDef const in @@ -136,7 +136,7 @@ let save id const ?hook uctx locality kind = let kn = declare_constant id ~local (Declare.DefinitionEntry const, k) in ConstRef kn in - DeclareDef.Hook.call ?hook ~fix_exn uctx [] locality r; + DeclareDef.Hook.(call ?hook ~fix_exn { S.uctx; obls = []; scope; dref = r }); definition_message id let with_full_print f a = diff --git a/plugins/funind/recdef.ml b/plugins/funind/recdef.ml index b68b31c93b..d38e28c0e7 100644 --- a/plugins/funind/recdef.ml +++ b/plugins/funind/recdef.ml @@ -1308,7 +1308,7 @@ let open_new_goal ~lemma build_proof sigma using_lemmas ref_ goal_name (gls_type let na = next_global_ident_away name Id.Set.empty in if Termops.occur_existential sigma gls_type then CErrors.user_err Pp.(str "\"abstract\" cannot handle existentials"); - let hook _ _ _ _ = + let hook _ = let opacity = let na_ref = qualid_of_ident na in let na_global = Smartlocate.global_with_alias na_ref in @@ -1547,7 +1547,7 @@ let recursive_definition ~interactive_proof ~is_mes function_name rec_impls type let tcc_lemma_name = add_suffix function_name "_tcc" in let tcc_lemma_constr = ref Undefined in (* let _ = Pp.msgnl (fun _ _ -> str "relation := " ++ Printer.pr_lconstr_env env_with_pre_rec_args relation) in *) - let hook uctx _ _ _ = + let hook { DeclareDef.Hook.S.uctx ; _ } = let term_ref = Nametab.locate (qualid_of_ident term_id) in let f_ref = declare_f function_name (IsProof Lemma) arg_types term_ref in let _ = Extraction_plugin.Table.extraction_inline true [qualid_of_ident term_id] in diff --git a/plugins/ltac/rewrite.ml b/plugins/ltac/rewrite.ml index 8acb29ba74..19866df8e3 100644 --- a/plugins/ltac/rewrite.ml +++ b/plugins/ltac/rewrite.ml @@ -1997,7 +1997,7 @@ let add_morphism_interactive atts m n : Lemmas.t = let poly = atts.polymorphic in let kind = Decl_kinds.DefinitionBody Decl_kinds.Instance in let tac = make_tactic "Coq.Classes.SetoidTactics.add_morphism_tactic" in - let hook _ _ _ = function + let hook { DeclareDef.Hook.S.dref; _ } = dref |> function | Globnames.ConstRef cst -> Classes.add_instance (Classes.mk_instance (PropGlobal.proper_class env evd) Hints.empty_hint_info |
