aboutsummaryrefslogtreecommitdiffhomepage
path: root/plugins
diff options
context:
space:
mode:
authorGravatar Maxime Dénès <mail@maximedenes.fr>2016-09-20 09:11:09 +0200
committerGravatar Maxime Dénès <mail@maximedenes.fr>2016-09-20 17:18:36 +0200
commitaa29c92dfa395e2f369e81bd72cef482cdf90c65 (patch)
treefbffe7f83d1d76a21d39bf90b93d8f948aa42143 /plugins
parent424de98770e1fd8c307a7cd0053c268a48532463 (diff)
Stylistic improvements in intf/decl_kinds.mli.
We get rid of tuples containing booleans (typically for universe polymorphism) by replacing them with records. The previously common idom: if pi2 kind (* polymorphic *) then ... else ... becomes: if kind.polymorphic then ... else ... To make the construction and destruction of these records lightweight, the labels of boolean arguments for universe polymorphism are now usually also called "polymorphic".
Diffstat (limited to 'plugins')
-rw-r--r--plugins/derive/derive.ml5
-rw-r--r--plugins/funind/functional_principles_proofs.ml4
-rw-r--r--plugins/funind/functional_principles_types.ml8
-rw-r--r--plugins/funind/indfun.ml4
-rw-r--r--plugins/funind/indfun_common.ml7
-rw-r--r--plugins/funind/invfun.ml15
-rw-r--r--plugins/funind/recdef.ml16
7 files changed, 43 insertions, 16 deletions
diff --git a/plugins/derive/derive.ml b/plugins/derive/derive.ml
index e39d17b52..12fd8359a 100644
--- a/plugins/derive/derive.ml
+++ b/plugins/derive/derive.ml
@@ -22,7 +22,10 @@ let start_deriving f suchthat lemma =
let env = Global.env () in
let sigma = Evd.from_env env in
- let kind = Decl_kinds.(Global,false,DefinitionBody Definition) in
+ let kind = Decl_kinds.{ locality = Global;
+ polymorphic = false;
+ object_kind = DefinitionBody Definition }
+ in
(** create a sort variable for the type of [f] *)
(* spiwack: I don't know what the rigidity flag does, picked the one
diff --git a/plugins/funind/functional_principles_proofs.ml b/plugins/funind/functional_principles_proofs.ml
index 527f4f0b1..bba7b3c59 100644
--- a/plugins/funind/functional_principles_proofs.ml
+++ b/plugins/funind/functional_principles_proofs.ml
@@ -996,7 +996,9 @@ let generate_equation_lemma evd fnames f fun_num nb_params nb_args rec_args_num
Ensures by: obvious
i*)
(mk_equation_id f_id)
- (Decl_kinds.Global, Flags.is_universe_polymorphism (), (Decl_kinds.Proof Decl_kinds.Theorem))
+ Decl_kinds.{ locality = Global;
+ polymorphic = Flags.is_universe_polymorphism ();
+ object_kind = Proof Theorem }
evd
lemma_type
(Lemmas.mk_hook (fun _ _ -> ()));
diff --git a/plugins/funind/functional_principles_types.ml b/plugins/funind/functional_principles_types.ml
index cc699e5d3..4f5f167c2 100644
--- a/plugins/funind/functional_principles_types.ml
+++ b/plugins/funind/functional_principles_types.ml
@@ -288,7 +288,9 @@ let build_functional_principle (evd:Evd.evar_map ref) interactive_proof old_prin
begin
Lemmas.start_proof
new_princ_name
- (Decl_kinds.Global,Flags.is_universe_polymorphism (),(Decl_kinds.Proof Decl_kinds.Theorem))
+ Decl_kinds.{ locality = Decl_kinds.Global;
+ polymorphic = Flags.is_universe_polymorphism ();
+ object_kind = Decl_kinds.Proof Decl_kinds.Theorem }
!evd
new_principle_type
hook
@@ -339,7 +341,9 @@ let generate_functional_principle (evd: Evd.evar_map ref)
let evd',value = change_property_sort evd' s new_principle_type new_princ_name in
let evd' = fst (Typing.type_of ~refresh:true (Global.env ()) evd' value) in
(* Pp.msgnl (str "new principle := " ++ pr_lconstr value); *)
- let ce = Declare.definition_entry ~poly:(Flags.is_universe_polymorphism ()) ~univs:(snd (Evd.universe_context evd')) value in
+ let ce = Declare.definition_entry ~polymorphic:(Flags.is_universe_polymorphism ())
+ ~univs:(snd (Evd.universe_context evd')) value
+ in
ignore(
Declare.declare_constant
name
diff --git a/plugins/funind/indfun.ml b/plugins/funind/indfun.ml
index 99b04898b..efbc1507f 100644
--- a/plugins/funind/indfun.ml
+++ b/plugins/funind/indfun.ml
@@ -395,7 +395,9 @@ let register_struct is_rec (fixpoint_exprl:(Vernacexpr.fixpoint_expr * Vernacexp
let body = match body with | Some body -> body | None -> user_err ~hdr:"Function" (str "Body of Function must be given") in
Command.do_definition
fname
- (Decl_kinds.Global,(Flags.is_universe_polymorphism ()),Decl_kinds.Definition) pl
+ { locality = Decl_kinds.Global;
+ polymorphic = Flags.is_universe_polymorphism ();
+ object_kind = Decl_kinds.Definition } pl
bl None body (Some ret_type) (Lemmas.mk_hook (fun _ _ -> ()));
let evd,rev_pconstants =
List.fold_left
diff --git a/plugins/funind/indfun_common.ml b/plugins/funind/indfun_common.ml
index a45effb16..8c6673732 100644
--- a/plugins/funind/indfun_common.ml
+++ b/plugins/funind/indfun_common.ml
@@ -148,17 +148,18 @@ let get_locality = function
| Local -> true
| Global -> false
-let save with_clean id const (locality,_,kind) hook =
+let save with_clean id const goal_kind hook =
let fix_exn = Future.fix_exn_of const.const_entry_body in
+ let locality = goal_kind.locality in
let l,r = match locality with
| Discharge when Lib.sections_are_opened () ->
- let k = Kindops.logical_kind_of_goal_kind kind in
+ let k = Kindops.logical_kind_of_goal_kind goal_kind.object_kind in
let c = SectionLocalDef const in
let _ = declare_variable id (Lib.cwd(), c, k) in
(Local, VarRef id)
| Discharge | Local | Global ->
let local = get_locality locality in
- let k = Kindops.logical_kind_of_goal_kind kind in
+ let k = Kindops.logical_kind_of_goal_kind goal_kind.object_kind in
let kn = declare_constant id ~local (DefinitionEntry const, k) in
(locality, ConstRef kn)
in
diff --git a/plugins/funind/invfun.ml b/plugins/funind/invfun.ml
index c8b4e4833..6d042b3a4 100644
--- a/plugins/funind/invfun.ml
+++ b/plugins/funind/invfun.ml
@@ -832,7 +832,9 @@ let derive_correctness make_scheme functional_induction (funs: pconstant list) (
let (typ,_) = lemmas_types_infos.(i) in
Lemmas.start_proof
lem_id
- (Decl_kinds.Global,Flags.is_universe_polymorphism (),((Decl_kinds.Proof Decl_kinds.Theorem)))
+ Decl_kinds.{ locality = Decl_kinds.Global;
+ polymorphic = Flags.is_universe_polymorphism ();
+ object_kind = Decl_kinds.Proof Decl_kinds.Theorem }
!evd
typ
(Lemmas.mk_hook (fun _ _ -> ()));
@@ -893,10 +895,13 @@ let derive_correctness make_scheme functional_induction (funs: pconstant list) (
Ensures by: obvious
i*)
let lem_id = mk_complete_id f_id in
- Lemmas.start_proof lem_id
- (Decl_kinds.Global,Flags.is_universe_polymorphism (),(Decl_kinds.Proof Decl_kinds.Theorem)) sigma
- (fst lemmas_types_infos.(i))
- (Lemmas.mk_hook (fun _ _ -> ()));
+ Lemmas.start_proof lem_id
+ Decl_kinds.{ locality = Decl_kinds.Global;
+ polymorphic = Flags.is_universe_polymorphism ();
+ object_kind = Decl_kinds.Proof Decl_kinds.Theorem }
+ sigma
+ (fst lemmas_types_infos.(i))
+ (Lemmas.mk_hook (fun _ _ -> ()));
ignore (Pfedit.by
(Proofview.V82.tactic (observe_tac ("prove completeness ("^(Id.to_string f_id)^")")
(proving_tac i)))) ;
diff --git a/plugins/funind/recdef.ml b/plugins/funind/recdef.ml
index f43251bc5..75495ed98 100644
--- a/plugins/funind/recdef.ml
+++ b/plugins/funind/recdef.ml
@@ -1348,7 +1348,9 @@ let open_new_goal build_proof sigma using_lemmas ref_ goal_name (gls_type,decomp
in
Lemmas.start_proof
na
- (Decl_kinds.Global, false (* FIXME *), Decl_kinds.Proof Decl_kinds.Lemma)
+ { locality = Decl_kinds.Global;
+ polymorphic = false (* FIXME *);
+ object_kind = Decl_kinds.Proof Decl_kinds.Lemma }
sigma gls_type
(Lemmas.mk_hook hook);
if Indfun_common.is_strict_tcc ()
@@ -1394,8 +1396,12 @@ let com_terminate
hook =
let start_proof ctx (tac_start:tactic) (tac_end:tactic) =
let (evmap, env) = Lemmas.get_current_context() in
+ let goal_kind = { locality = Global;
+ polymorphic = false; (* FIXME *)
+ object_kind = Proof Lemma }
+ in
Lemmas.start_proof thm_name
- (Global, false (* FIXME *), Proof Lemma) ~sign:(Environ.named_context_val env)
+ goal_kind ~sign:(Environ.named_context_val env)
ctx (compute_terminate_type nb_args fonctional_ref) hook;
ignore (by (Proofview.V82.tactic (observe_tac (str "starting_tac") tac_start)));
@@ -1445,7 +1451,11 @@ let (com_eqn : int -> Id.t ->
let evmap = Evd.from_ctx (Evd.evar_universe_context evmap) in
let f_constr = constr_of_global f_ref in
let equation_lemma_type = subst1 f_constr equation_lemma_type in
- (Lemmas.start_proof eq_name (Global, false, Proof Lemma)
+ let goal_kind = { locality = Global;
+ polymorphic = false;
+ object_kind = Proof Lemma }
+ in
+ (Lemmas.start_proof eq_name goal_kind
~sign:(Environ.named_context_val env)
evmap
equation_lemma_type