aboutsummaryrefslogtreecommitdiff
path: root/plugins
diff options
context:
space:
mode:
Diffstat (limited to 'plugins')
-rw-r--r--plugins/derive/Derive.v2
-rw-r--r--plugins/extraction/ExtrHaskellNatNum.v2
-rw-r--r--plugins/extraction/ExtrOcamlIntConv.v2
-rw-r--r--plugins/extraction/Extraction.v2
-rw-r--r--plugins/funind/functional_principles_types.ml22
-rw-r--r--plugins/funind/functional_principles_types.mli8
-rw-r--r--plugins/funind/g_indfun.ml44
-rw-r--r--plugins/funind/invfun.ml2
-rw-r--r--plugins/funind/recdef.ml9
-rw-r--r--plugins/ltac/extratactics.ml422
-rw-r--r--plugins/ltac/rewrite.ml2
-rw-r--r--plugins/ltac/tacentries.ml1
-rw-r--r--plugins/omega/coq_omega.ml7
-rw-r--r--plugins/romega/ROmega.v2
-rw-r--r--plugins/setoid_ring/Ring_tac.v2
-rw-r--r--plugins/setoid_ring/newring.ml2
16 files changed, 43 insertions, 48 deletions
diff --git a/plugins/derive/Derive.v b/plugins/derive/Derive.v
index 0d5a93b034..d1046ae79b 100644
--- a/plugins/derive/Derive.v
+++ b/plugins/derive/Derive.v
@@ -1 +1 @@
-Declare ML Module "derive_plugin". \ No newline at end of file
+Declare ML Module "derive_plugin".
diff --git a/plugins/extraction/ExtrHaskellNatNum.v b/plugins/extraction/ExtrHaskellNatNum.v
index fabe9a4c67..09b0444614 100644
--- a/plugins/extraction/ExtrHaskellNatNum.v
+++ b/plugins/extraction/ExtrHaskellNatNum.v
@@ -34,4 +34,4 @@ Extract Constant Init.Nat.sub => "(\n m -> Prelude.max 0 (n Prelude.- m))".
Extract Constant Nat.div => "(\n m -> if m Prelude.== 0 then 0 else Prelude.div n m)".
Extract Constant Nat.modulo => "(\n m -> if m Prelude.== 0 then 0 else Prelude.mod n m)".
Extract Constant Init.Nat.div => "(\n m -> if m Prelude.== 0 then 0 else Prelude.div n m)".
-Extract Constant Init.Nat.modulo => "(\n m -> if m Prelude.== 0 then 0 else Prelude.mod n m)". \ No newline at end of file
+Extract Constant Init.Nat.modulo => "(\n m -> if m Prelude.== 0 then 0 else Prelude.mod n m)".
diff --git a/plugins/extraction/ExtrOcamlIntConv.v b/plugins/extraction/ExtrOcamlIntConv.v
index fe6eb7780f..ab13d75ada 100644
--- a/plugins/extraction/ExtrOcamlIntConv.v
+++ b/plugins/extraction/ExtrOcamlIntConv.v
@@ -96,4 +96,4 @@ Extraction "/tmp/test.ml"
pos_of_int int_of_pos
z_of_int int_of_z
n_of_int int_of_n.
-*) \ No newline at end of file
+*)
diff --git a/plugins/extraction/Extraction.v b/plugins/extraction/Extraction.v
index 1374a91abf..b3f9d6556d 100644
--- a/plugins/extraction/Extraction.v
+++ b/plugins/extraction/Extraction.v
@@ -6,4 +6,4 @@
(* * GNU Lesser General Public License Version 2.1 *)
(************************************************************************)
-Declare ML Module "extraction_plugin". \ No newline at end of file
+Declare ML Module "extraction_plugin".
diff --git a/plugins/funind/functional_principles_types.ml b/plugins/funind/functional_principles_types.ml
index 513fce2484..409bb89eeb 100644
--- a/plugins/funind/functional_principles_types.ml
+++ b/plugins/funind/functional_principles_types.ml
@@ -11,7 +11,6 @@ open Tactics
open Context.Rel.Declaration
open Indfun_common
open Functional_principles_proofs
-open Misctypes
module RelDecl = Context.Rel.Declaration
@@ -339,13 +338,14 @@ let generate_functional_principle (evd: Evd.evar_map ref)
then
(* let id_of_f = Label.to_id (con_label f) in *)
let register_with_sort fam_sort =
- let evd' = Evd.from_env (Global.env ()) in
- let evd',s = Evd.fresh_sort_in_family env evd' fam_sort in
- let name = Indrec.make_elimination_ident base_new_princ_name fam_sort in
- 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' (EConstr.of_constr 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 evd' = Evd.from_env (Global.env ()) in
+ let evd',s = Evd.fresh_sort_in_family env evd' fam_sort in
+ let name = Indrec.make_elimination_ident base_new_princ_name fam_sort in
+ 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' (EConstr.of_constr value)) in
+ (* Pp.msgnl (str "new principle := " ++ pr_lconstr value); *)
+ let univs = (snd (Evd.universe_context ~names:[] ~extensible:true evd')) in
+ let ce = Declare.definition_entry ~poly:(Flags.is_universe_polymorphism ()) ~univs value in
ignore(
Declare.declare_constant
name
@@ -463,7 +463,7 @@ let get_funs_constant mp dp =
exception No_graph_found
exception Found_type of int
-let make_scheme evd (fas : (pconstant*glob_sort) list) : Safe_typing.private_constants definition_entry list =
+let make_scheme evd (fas : (pconstant*Sorts.family) list) : Safe_typing.private_constants definition_entry list =
let env = Global.env () in
let funs = List.map fst fas in
let first_fun = List.hd funs in
@@ -500,7 +500,7 @@ let make_scheme evd (fas : (pconstant*glob_sort) list) : Safe_typing.private_con
let i = ref (-1) in
let sorts =
List.rev_map (fun (_,x) ->
- Evarutil.evd_comb1 (Evd.fresh_sort_in_family env) evd (Pretyping.interp_elimination_sort x)
+ Evarutil.evd_comb1 (Evd.fresh_sort_in_family env) evd x
)
fas
in
@@ -674,7 +674,7 @@ let build_case_scheme fa =
let scheme_type = EConstr.Unsafe.to_constr ((Typing.unsafe_type_of env sigma) (EConstr.of_constr scheme)) in
let sorts =
(fun (_,_,x) ->
- Universes.new_sort_in_family (Pretyping.interp_elimination_sort x)
+ Universes.new_sort_in_family x
)
fa
in
diff --git a/plugins/funind/functional_principles_types.mli b/plugins/funind/functional_principles_types.mli
index 5a7ffe0590..2eb1b7935d 100644
--- a/plugins/funind/functional_principles_types.mli
+++ b/plugins/funind/functional_principles_types.mli
@@ -8,7 +8,6 @@
open Names
open Term
-open Misctypes
val generate_functional_principle :
Evd.evar_map ref ->
@@ -37,8 +36,7 @@ val compute_new_princ_type_from_rel : constr array -> Sorts.t array ->
exception No_graph_found
val make_scheme : Evd.evar_map ref ->
- (pconstant*glob_sort) list -> Safe_typing.private_constants Entries.definition_entry list
-
-val build_scheme : (Id.t*Libnames.reference*glob_sort) list -> unit
-val build_case_scheme : (Id.t*Libnames.reference*glob_sort) -> unit
+ (pconstant*Sorts.family) list -> Safe_typing.private_constants Entries.definition_entry list
+val build_scheme : (Id.t*Libnames.reference*Sorts.family) list -> unit
+val build_case_scheme : (Id.t*Libnames.reference*Sorts.family) -> unit
diff --git a/plugins/funind/g_indfun.ml4 b/plugins/funind/g_indfun.ml4
index 16d9f200f3..62ecaa552b 100644
--- a/plugins/funind/g_indfun.ml4
+++ b/plugins/funind/g_indfun.ml4
@@ -166,11 +166,11 @@ END
let pr_fun_scheme_arg (princ_name,fun_name,s) =
Names.Id.print princ_name ++ str " :=" ++ spc() ++ str "Induction for " ++
Libnames.pr_reference fun_name ++ spc() ++ str "Sort " ++
- Ppconstr.pr_glob_sort s
+ Termops.pr_sort_family s
VERNAC ARGUMENT EXTEND fun_scheme_arg
PRINTED BY pr_fun_scheme_arg
-| [ ident(princ_name) ":=" "Induction" "for" reference(fun_name) "Sort" sort(s) ] -> [ (princ_name,fun_name,s) ]
+| [ ident(princ_name) ":=" "Induction" "for" reference(fun_name) "Sort" sort_family(s) ] -> [ (princ_name,fun_name,s) ]
END
diff --git a/plugins/funind/invfun.ml b/plugins/funind/invfun.ml
index 8dea6c90f5..5f8d50da12 100644
--- a/plugins/funind/invfun.ml
+++ b/plugins/funind/invfun.ml
@@ -797,7 +797,7 @@ let derive_correctness make_scheme functional_induction (funs: pconstant list) (
(fun entry ->
(EConstr.of_constr (fst (fst(Future.force entry.Entries.const_entry_body))), EConstr.of_constr (Option.get entry.Entries.const_entry_type ))
)
- (make_scheme evd (Array.map_to_list (fun const -> const,GType []) funs))
+ (make_scheme evd (Array.map_to_list (fun const -> const,Sorts.InType) funs))
)
)
in
diff --git a/plugins/funind/recdef.ml b/plugins/funind/recdef.ml
index 41a10cba3c..7b63366e8a 100644
--- a/plugins/funind/recdef.ml
+++ b/plugins/funind/recdef.ml
@@ -1288,8 +1288,8 @@ let build_new_goal_type () =
let is_opaque_constant c =
let cb = Global.lookup_constant c in
match cb.Declarations.const_body with
- | Declarations.OpaqueDef _ -> Vernacexpr.Opaque None
- | Declarations.Undef _ -> Vernacexpr.Opaque None
+ | Declarations.OpaqueDef _ -> Vernacexpr.Opaque
+ | Declarations.Undef _ -> Vernacexpr.Opaque
| Declarations.Def _ -> Vernacexpr.Transparent
let open_new_goal build_proof sigma using_lemmas ref_ goal_name (gls_type,decompose_and_tac,nb_goal) =
@@ -1543,7 +1543,10 @@ let recursive_definition is_mes function_name rec_impls type_of_f r rec_arg_num
let equation_id = add_suffix function_name "_equation" in
let functional_id = add_suffix function_name "_F" in
let term_id = add_suffix function_name "_terminate" in
- let functional_ref = declare_fun functional_id (IsDefinition Decl_kinds.Definition) ~ctx:(snd (Evd.universe_context evm)) res in
+ let functional_ref =
+ let ctx = (snd (Evd.universe_context ~names:[] ~extensible:true evm)) in
+ declare_fun functional_id (IsDefinition Decl_kinds.Definition) ~ctx res
+ in
(* Refresh the global universes, now including those of _F *)
let evm = Evd.from_env (Global.env ()) in
let env_with_pre_rec_args = push_rel_context(List.map (function (x,t) -> LocalAssum (x,t)) pre_rec_args) env in
diff --git a/plugins/ltac/extratactics.ml4 b/plugins/ltac/extratactics.ml4
index 99e4440102..b4c6f9c90e 100644
--- a/plugins/ltac/extratactics.ml4
+++ b/plugins/ltac/extratactics.ml4
@@ -403,38 +403,38 @@ open Leminv
let seff id = Vernacexpr.VtSideff [id], Vernacexpr.VtLater
-VERNAC ARGUMENT EXTEND sort
-| [ "Set" ] -> [ GSet ]
-| [ "Prop" ] -> [ GProp ]
-| [ "Type" ] -> [ GType [] ]
-END
+(*VERNAC ARGUMENT EXTEND sort_family
+| [ "Set" ] -> [ InSet ]
+| [ "Prop" ] -> [ InProp ]
+| [ "Type" ] -> [ InType ]
+END*)
VERNAC COMMAND EXTEND DeriveInversionClear
-| [ "Derive" "Inversion_clear" ident(na) "with" constr(c) "Sort" sort(s) ]
+| [ "Derive" "Inversion_clear" ident(na) "with" constr(c) "Sort" sort_family(s) ]
=> [ seff na ]
-> [ add_inversion_lemma_exn na c s false inv_clear_tac ]
| [ "Derive" "Inversion_clear" ident(na) "with" constr(c) ] => [ seff na ]
- -> [ add_inversion_lemma_exn na c GProp false inv_clear_tac ]
+ -> [ add_inversion_lemma_exn na c InProp false inv_clear_tac ]
END
VERNAC COMMAND EXTEND DeriveInversion
-| [ "Derive" "Inversion" ident(na) "with" constr(c) "Sort" sort(s) ]
+| [ "Derive" "Inversion" ident(na) "with" constr(c) "Sort" sort_family(s) ]
=> [ seff na ]
-> [ add_inversion_lemma_exn na c s false inv_tac ]
| [ "Derive" "Inversion" ident(na) "with" constr(c) ] => [ seff na ]
- -> [ add_inversion_lemma_exn na c GProp false inv_tac ]
+ -> [ add_inversion_lemma_exn na c InProp false inv_tac ]
END
VERNAC COMMAND EXTEND DeriveDependentInversion
-| [ "Derive" "Dependent" "Inversion" ident(na) "with" constr(c) "Sort" sort(s) ]
+| [ "Derive" "Dependent" "Inversion" ident(na) "with" constr(c) "Sort" sort_family(s) ]
=> [ seff na ]
-> [ add_inversion_lemma_exn na c s true dinv_tac ]
END
VERNAC COMMAND EXTEND DeriveDependentInversionClear
-| [ "Derive" "Dependent" "Inversion_clear" ident(na) "with" constr(c) "Sort" sort(s) ]
+| [ "Derive" "Dependent" "Inversion_clear" ident(na) "with" constr(c) "Sort" sort_family(s) ]
=> [ seff na ]
-> [ add_inversion_lemma_exn na c s true dinv_clear_tac ]
END
diff --git a/plugins/ltac/rewrite.ml b/plugins/ltac/rewrite.ml
index 75b665aad9..3d01cbe8dd 100644
--- a/plugins/ltac/rewrite.ml
+++ b/plugins/ltac/rewrite.ml
@@ -1884,7 +1884,7 @@ let declare_projection n instance_id r =
in it_mkProd_or_LetIn ccl ctx
in
let typ = it_mkProd_or_LetIn typ ctx in
- let pl, ctx = Evd.universe_context sigma in
+ let pl, ctx = Evd.universe_context ~names:[] ~extensible:true sigma in
let typ = EConstr.to_constr sigma typ in
let term = EConstr.to_constr sigma term in
let cst =
diff --git a/plugins/ltac/tacentries.ml b/plugins/ltac/tacentries.ml
index cf676f598f..a8d518fbd8 100644
--- a/plugins/ltac/tacentries.ml
+++ b/plugins/ltac/tacentries.ml
@@ -216,7 +216,6 @@ let interp_prod_item = function
assert (String.equal s "tactic");
begin match Tacarg.wit_tactic with
| ExtraArg tag -> ArgT.Any tag
- | _ -> assert false
end
in
let symbol = interp_entry_name interp symbol in
diff --git a/plugins/omega/coq_omega.ml b/plugins/omega/coq_omega.ml
index d07b2e0b45..99493d6982 100644
--- a/plugins/omega/coq_omega.ml
+++ b/plugins/omega/coq_omega.ml
@@ -1773,11 +1773,6 @@ let onClearedName2 id tac =
tclTHENLIST [ introduction id1; introduction id2; tac id1 id2 ]
end)
-let rec is_Prop sigma c = match EConstr.kind sigma c with
- | Sort s -> Sorts.is_prop (ESorts.kind sigma s)
- | Cast (c,_,_) -> is_Prop sigma c
- | _ -> false
-
let destructure_hyps =
Proofview.Goal.enter begin fun gl ->
let type_of = Tacmach.New.pf_unsafe_type_of gl in
@@ -1809,7 +1804,7 @@ let destructure_hyps =
| Kimp(t1,t2) ->
(* t1 and t2 might be in Type rather than Prop.
For t1, the decidability check will ensure being Prop. *)
- if is_Prop sigma (type_of t2)
+ if Termops.is_Prop sigma (type_of t2)
then
let d1 = decidability t1 in
tclTHENLIST [
diff --git a/plugins/romega/ROmega.v b/plugins/romega/ROmega.v
index 3ddb6bed12..657aae90e8 100644
--- a/plugins/romega/ROmega.v
+++ b/plugins/romega/ROmega.v
@@ -11,4 +11,4 @@ Require Export Setoid.
Require Export PreOmega.
Require Export ZArith_base.
Require Import OmegaPlugin.
-Declare ML Module "romega_plugin". \ No newline at end of file
+Declare ML Module "romega_plugin".
diff --git a/plugins/setoid_ring/Ring_tac.v b/plugins/setoid_ring/Ring_tac.v
index 329fa0ee81..36d1e7c542 100644
--- a/plugins/setoid_ring/Ring_tac.v
+++ b/plugins/setoid_ring/Ring_tac.v
@@ -460,4 +460,4 @@ Tactic Notation "ring_simplify" "["constr_list(lH)"]" constr_list(rl) "in" hyp(H
intro H';
move H' after H;
clear H;rename H' into H;
- unfold g;clear g. \ No newline at end of file
+ unfold g;clear g.
diff --git a/plugins/setoid_ring/newring.ml b/plugins/setoid_ring/newring.ml
index d0fe1f9570..b8fae2494f 100644
--- a/plugins/setoid_ring/newring.ml
+++ b/plugins/setoid_ring/newring.ml
@@ -220,7 +220,7 @@ let exec_tactic env evd n f args =
let gls = Proofview.V82.of_tactic (Tacinterp.eval_tactic_ist ist (ltac_call f (args@[getter]))) gl in
let evd, nf = Evarutil.nf_evars_and_universes (Refiner.project gls) in
let nf c = nf (constr_of c) in
- Array.map nf !tactic_res, snd (Evd.universe_context evd)
+ Array.map nf !tactic_res, snd (Evd.universe_context ~names:[] ~extensible:true evd)
let stdlib_modules =
[["Coq";"Setoids";"Setoid"];
generated by cgit v1.2.3 (git 2.25.1) at 2026-03-09 11:54:25 +0000