Skip to content

Commit e555445

Browse files
committed
Introduce PolyFlags to gather flags for polymorphic defs
Adapt the whole code base to using this instead of the multiple poly/sort_poly/cumulative flags. poly_flags -> poly PolyFlags.of_poly -> of_level_poly sort_polymorphic -> implicit_sort_polymorphic Implement suggested fixes from PR level_polymorphic -> univ_polymorphic implicit_sort_polymorphic -> collapse_sorts_to_type univ_polymorphic -> univ_poly cleaner parsing of attributes (cumulative and collapse_sort_variables are just not settable without universe polymorphism). Fixed comments Apply suggestions from code review Spacing/indentation Co-authored-by: yannl35133 <40719961+yannl35133@users.noreply.github.com> Fix wrong poly kind used for inductive and record decls Remove options that are not supported yet Add Changelog entry PolyFlags.assumption_or_definition -> PolyFlags.construction_kind Support the polymorphism attributes in Hint Rewrite Change plugin_tutorial to use the forward-compatible poly_def attribute Add overlays Fix rewrite rule integration of polyflags as per Y. Leray's comments Add debug printer
1 parent 04e69d1 commit e555445

Some content is hidden

Large Commits have some content hidden by default. Use the searchbox below for content that may be hidden.

80 files changed

+456
-313
lines changed
Lines changed: 11 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,11 @@
1+
overlay equations https://github.com/mattam82/Coq-Equations sort-poly-flags 21419
2+
overlay rewriter https://github.com/mattam82/rewriter sort-poly-flags 21419
3+
overlay smtcoq https://github.com/mattam82/smtcoq sort-poly-flags 21419
4+
overlay mtac2 https://github.com/mattam82/Mtac2 sort-poly-flags 21419
5+
overlay elpi https://github.com/mattam82/coq-elpi sort-poly-flags 21419
6+
overlay simple_io https://github.com/mattam82/coq-simple-io sort-poly-flags 21419
7+
overlay paramcoq https://github.com/mattam82/paramcoq sort-poly-flags 21419
8+
overlay waterproof https://github.com/mattam82/coq-waterproof sort-poly-flags 21419
9+
overlay itauto https://gitlab.inria.fr/sozeau/itauto sort-poly-flags 21419
10+
overlay metarocq https://github.com/mattam82/metacoq sort-poly-flags 21419
11+
overlay quickchick https://github.com/mattam82/quickchick sort-poly-flags 21419

dev/top_printers.dbg

Lines changed: 1 addition & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -82,6 +82,7 @@ install_printer Top_printers.ppuniverse_context_set
8282
install_printer Top_printers.ppuniverse_subst
8383
install_printer Top_printers.ppuniverse_opt_subst
8484
install_printer Top_printers.ppqvar_subst
85+
install_printer Top_printers.pppoly_flags
8586
install_printer Top_printers.ppuniverse_level_subst
8687
install_printer Top_printers.ppustate
8788
install_printer Top_printers.ppconstraints

dev/top_printers.ml

Lines changed: 1 addition & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -299,6 +299,7 @@ let ppuniverse_subst l = pp (UnivSubst.pr_universe_subst Level.raw_pr l)
299299
let ppuniverse_opt_subst l = pp (UnivFlex.pr Level.raw_pr l)
300300
let ppqvar_subst l = pp (UVars.pr_quality_level_subst QVar.raw_pr l)
301301
let ppuniverse_level_subst l = pp (UVars.pr_universe_level_subst Level.raw_pr l)
302+
let pppoly_flags f = pp (PolyFlags.pr f)
302303
let ppustate l = pp (UState.pr l)
303304
let ppconstraints c = pp (UnivConstraints.pr Level.raw_pr c)
304305
let ppqconstraints c = pp (ElimConstraints.pr prqvar c)

dev/top_printers.mli

Lines changed: 1 addition & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -162,6 +162,7 @@ val ppaucontext : UVars.AbstractContext.t -> unit
162162
val ppuniverse_context_set : PConstraints.ContextSet.t -> unit
163163
val ppuniverse_subst : UnivSubst.universe_subst -> unit
164164
val ppuniverse_opt_subst : UState.universe_opt_subst -> unit
165+
val pppoly_flags : PolyFlags.t -> unit
165166
val ppqvar_subst : Sorts.Quality.t Sorts.QVar.Map.t -> unit
166167
val ppuniverse_level_subst : UVars.universe_level_subst -> unit
167168
val ppustate : UState.t -> unit
Lines changed: 4 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,4 @@
1+
- **Changed:**
2+
Generalized universe polymorphism flag structure (ML API change)
3+
(`#21419 <https://github.com/rocq-prover/rocq/pull/21419>`_,
4+
by Matthieu Sozeau).

doc/plugin_tutorial/tuto1/src/g_tuto1.mlg

Lines changed: 4 additions & 4 deletions
Original file line numberDiff line numberDiff line change
@@ -136,8 +136,8 @@ END
136136
* then we call another function. We define this function in
137137
* the Simple_declare module.
138138
*
139-
* The line #[ poly = Attributes.polymorphic ] says that this command accepts
140-
* polymorphic attributes.
139+
* The line #[ poly = Attributes.poly_def ] says that this command accepts
140+
* universe polymorphism attributes for definitions.
141141
* @SkySkimmer: Here, poly is what the result is bound to in the
142142
* rule's code. Multiple attributes may be used separated by ;, and we have
143143
* punning so foo is equivalent to foo = foo.
@@ -151,7 +151,7 @@ END
151151
* as a side-effect (CLASSIFIED AS SIDEFF).
152152
*)
153153
VERNAC COMMAND EXTEND MyDefine CLASSIFIED AS SIDEFF
154-
| #[ poly = Attributes.polymorphic ] [ "MyDefine" ident(i) ":=" constr(e) ] ->
154+
| #[ poly = Attributes.poly_def ] [ "MyDefine" ident(i) ":=" constr(e) ] ->
155155
{
156156
let env = Global.env () in
157157
let sigma = Evd.from_env env in
@@ -205,7 +205,7 @@ END
205205
* [![opaque_access]] is equivalent to [STATE opaque_access] but is specific to that parsing rule.
206206
*)
207207
VERNAC COMMAND EXTEND DefineLookup CLASSIFIED AS SIDEFF
208-
| #[ poly = Attributes.polymorphic ] ![opaque_access] [ "DefineLookup" ident(i) ":=" constr(e) ] ->
208+
| #[ poly = Attributes.poly_def ] ![opaque_access] [ "DefineLookup" ident(i) ":=" constr(e) ] ->
209209
{ fun ~opaque_access ->
210210
let env = Global.env () in
211211
let sigma = Evd.from_env env in
Lines changed: 1 addition & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -1,4 +1,4 @@
11
open Names
22

33
val declare_definition :
4-
poly:bool -> Id.t -> Evd.evar_map -> EConstr.t -> Names.GlobRef.t
4+
poly:PolyFlags.t -> Id.t -> Evd.evar_map -> EConstr.t -> Names.GlobRef.t

engine/evd.ml

Lines changed: 1 addition & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -1023,7 +1023,7 @@ let check_univ_decl ~poly evd decl = UState.check_univ_decl ~poly evd.universes
10231023

10241024
let check_univ_decl_early ~poly ~with_obls sigma udecl terms =
10251025
let () =
1026-
if with_obls && not poly &&
1026+
if with_obls && not @@ PolyFlags.univ_poly poly &&
10271027
(not udecl.UState.univdecl_extensible_instance
10281028
|| not udecl.UState.univdecl_extensible_constraints)
10291029
then

engine/evd.mli

Lines changed: 3 additions & 3 deletions
Original file line numberDiff line numberDiff line change
@@ -625,13 +625,13 @@ val universes : evar_map -> UGraph.t
625625
[PConstraints.ContextSet.to_context]. *)
626626
val to_universe_context : evar_map -> UVars.UContext.t
627627

628-
val univ_entry : poly:bool -> evar_map -> UState.named_universes_entry
628+
val univ_entry : poly:PolyFlags.t -> evar_map -> UState.named_universes_entry
629629

630-
val check_univ_decl : poly:bool -> evar_map -> UState.universe_decl -> UState.named_universes_entry
630+
val check_univ_decl : poly:PolyFlags.t -> evar_map -> UState.universe_decl -> UState.named_universes_entry
631631

632632
(** An early check of compatibility of the universe declaration before
633633
starting to build a declaration interactively *)
634-
val check_univ_decl_early : poly:bool -> with_obls:bool -> evar_map -> UState.universe_decl -> Constr.t list -> unit
634+
val check_univ_decl_early : poly:PolyFlags.t -> with_obls:bool -> evar_map -> UState.universe_decl -> Constr.t list -> unit
635635

636636
val merge_universe_context : evar_map -> UState.t -> evar_map
637637
val set_universe_context : evar_map -> UState.t -> evar_map

engine/polyFlags.ml

Lines changed: 40 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,40 @@
1+
(************************************************************************)
2+
(* * The Rocq Prover / The Rocq Development Team *)
3+
(* v * Copyright INRIA, CNRS and contributors *)
4+
(* <O___,, * (see version control and CREDITS file for authors & dates) *)
5+
(* \VV/ **************************************************************)
6+
(* // * This file is distributed under the terms of the *)
7+
(* * GNU Lesser General Public License Version 2.1 *)
8+
(* * (see LICENSE file for the text of the license) *)
9+
(************************************************************************)
10+
11+
type t = {
12+
univ_poly : bool;
13+
collapse_sort_variables : bool;
14+
cumulative : bool;
15+
}
16+
17+
let make ~univ_poly ~collapse_sort_variables ~cumulative =
18+
if cumulative && not univ_poly then
19+
CErrors.user_err Pp.(str "Cannot have cumulative but not universe polymorphic constructions");
20+
if not collapse_sort_variables && not univ_poly then
21+
CErrors.user_err Pp.(str "Sort metavariables must be collapsed to Type in universe monomorphic constructions");
22+
{ collapse_sort_variables; univ_poly; cumulative }
23+
24+
let default = { collapse_sort_variables = true; univ_poly = false; cumulative = false }
25+
let of_univ_poly b = { default with univ_poly = b }
26+
27+
let collapse_sort_variables x = x.collapse_sort_variables
28+
let univ_poly x = x.univ_poly
29+
let cumulative x = x.cumulative
30+
31+
let pr f =
32+
let open Pp in
33+
str "{ univ_poly = " ++ bool f.univ_poly ++ spc () ++
34+
str "; cumulative = " ++ bool f.cumulative ++ spc () ++
35+
str "; collapse_sort_variables = " ++ bool f.collapse_sort_variables ++ spc () ++
36+
str "}"
37+
38+
(* Used to have distinguished default behaviors when treating assumptions/axioms, definitions or inductives *)
39+
type construction_kind =
40+
Assumption | Definition | Inductive

0 commit comments

Comments
 (0)