Skip to content

Commit 33c087a

Browse files
Adapt to coq#19611 (#1402)
* adapt to coq#19611 * fix changelog, doc --------- Co-authored-by: Reynald Affeldt <reynald.affeldt@aist.go.jp>
1 parent 97d0779 commit 33c087a

2 files changed

Lines changed: 64 additions & 43 deletions

File tree

CHANGELOG_UNRELEASED.md

Lines changed: 7 additions & 3 deletions
Original file line numberDiff line numberDiff line change
@@ -164,16 +164,20 @@
164164
`setX_of_sigTK`, `setX_of_sigT_continuous`, and `sigT_of_setX_continuous`.
165165

166166
- in `tvs.v`:
167-
+ HB.structure `Tvs`
167+
+ HB structures `NbhsNmodule`, `NbhsZmodule`, `NbhsLmodule`, `TopologicalNmodule`,
168+
`TopologicalZmodule`
169+
+ notation `topologicalLmoduleType`, HB structure `TopologicalLmodule`
170+
+ HB structures `UniformZmodule`, `UniformLmodule`
171+
+ definition `convex`
172+
+ mixin `Uniform_isTvs`
173+
+ type `tvsType`, HB.structure `Tvs`
168174
+ HB.factory `TopologicalLmod_isTvs`
169175
+ lemma `nbhs0N`
170176
+ lemma `nbhsN`
171177
+ lemma `nbhsT`
172178
+ lemma `nbhsB`
173179
+ lemma `nbhs0Z`
174180
+ lemma `nbhZ`
175-
+ HB.Instance of a Tvs od R^o
176-
+ HB.Instance of a Tvs on a product of Tvs
177181

178182
### Changed
179183

theories/tvs.v

Lines changed: 57 additions & 40 deletions
Original file line numberDiff line numberDiff line change
@@ -13,12 +13,30 @@ From mathcomp Require Import separation_axioms.
1313
(* *)
1414
(* This file introduces locally convex topological vector spaces. *)
1515
(* ``` *)
16+
(* NbhsNmodule == HB class, join of Nbhs and Nmodule *)
17+
(* NbhsZmodule == HB class, join of Nbhs and Zmodule *)
18+
(* NbhsLmodule K == HB class, join of Nbhs and Lmodule over K *)
19+
(* K is a numDomainType. *)
20+
(* TopologicalNmodule == HB class, joint of Topological and Nmodule *)
21+
(* TopologicalZmodule == HB class, joint of Topological and Zmodule *)
22+
(* topologicalLmodType K == topological space and Lmodule over K *)
23+
(* K is a numDomainType. *)
24+
(* The HB class is TopologicalLmodule. *)
25+
(* UniformZmodule == HB class, joint of Uniform and Zmodule *)
26+
(* UniformLmodule K == HB class, joint of Uniform and Lmodule over K *)
27+
(* K is a numDomainType. *)
28+
(* convex A == A : set M is a convex set of elements of M *)
29+
(* M is an Lmodule over R : numDomainType. *)
1630
(* tvsType R == interface type for a locally convex topological *)
1731
(* vector space on a numDomain R *)
18-
(* A tvs is constructed over a uniform space *)
32+
(* A tvs is constructed over a uniform space. *)
33+
(* The HB class is Tvs. *)
1934
(* TopologicalLmod_isTvs == factory allowing the construction of a tvs from *)
20-
(* a lmodule which is also a topological space. *)
35+
(* an Lmodule which is also a topological space. *)
2136
(* ``` *)
37+
(* HB instances: *)
38+
(* - The type R^o (R : numFieldType) is endowed with the structure of Tvs. *)
39+
(* - The product of two Tvs is endowed with the structure of Tvs. *)
2240
(******************************************************************************)
2341

2442
Set Implicit Arguments.
@@ -45,19 +63,22 @@ HB.structure Definition NbhsZmodule := {M of Nbhs M & GRing.Zmodule M}.
4563
HB.structure Definition NbhsLmodule (K : numDomainType) :=
4664
{M of Nbhs M & GRing.Lmodule K M}.
4765

48-
HB.structure Definition TopologicalNmodule := {M of Topological M & GRing.Nmodule M}.
66+
HB.structure Definition TopologicalNmodule :=
67+
{M of Topological M & GRing.Nmodule M}.
4968
HB.structure Definition TopologicalZmodule :=
5069
{M of Topological M & GRing.Zmodule M}.
70+
71+
#[short(type="topologicalLmodType")]
5172
HB.structure Definition TopologicalLmodule (K : numDomainType) :=
5273
{M of Topological M & GRing.Lmodule K M}.
74+
5375
HB.structure Definition UniformZmodule := {M of Uniform M & GRing.Zmodule M}.
5476
HB.structure Definition UniformLmodule (K : numDomainType) :=
5577
{M of Uniform M & GRing.Lmodule K M}.
5678

5779
Definition convex (R : numDomainType) (M : lmodType R) (A : set M) :=
5880
forall x y (lambda : R), x \in A -> y \in A ->
59-
(0< lambda) -> (lambda < 1) -> lambda *: x + (1 - lambda) *: y \in A.
60-
81+
0 < lambda -> lambda < 1 -> lambda *: x + (1 - lambda) *: y \in A.
6182

6283
HB.mixin Record Uniform_isTvs (R : numDomainType) E
6384
of Uniform E & GRing.Lmodule R E := {
@@ -71,43 +92,41 @@ HB.mixin Record Uniform_isTvs (R : numDomainType) E
7192
HB.structure Definition Tvs (R : numDomainType) :=
7293
{E of Uniform_isTvs R E & Uniform E & GRing.Lmodule R E}.
7394

74-
Section properties_of_topologicallmodule.
75-
Context (R : numDomainType) (E : topologicalType)
76-
(Me : GRing.Lmodule R E) (U : set E).
77-
Let ME := GRing.Lmodule.Pack Me.
95+
Section properties_of_topologicalLmodule.
96+
Context (R : numDomainType) (E : topologicalLmodType R) (U : set E).
7897

79-
Lemma nbhsN_subproof (f : continuous (fun z : R^o * E => z.1 *: (z.2 : ME))) (x : E) :
80-
nbhs x U -> nbhs (-(x:ME)) (-%R @` (U : set ME)).
98+
Lemma nbhsN_subproof (f : continuous (fun z : R^o * E => z.1 *: z.2)) (x : E) :
99+
nbhs x U -> nbhs (-x) (-%R @` U).
81100
Proof.
82-
move=> Ux; move: (f (-1, - (x:ME)) U); rewrite /= scaleN1r opprK => /(_ Ux) [] /=.
83-
move=> [B] B12 [B1 B2] BU; near=> y; exists (- (y:ME)); rewrite ?opprK// -scaleN1r//.
101+
move=> Ux; move: (f (-1, -x) U); rewrite /= scaleN1r opprK => /(_ Ux) [] /=.
102+
move=> [B] B12 [B1 B2] BU; near=> y; exists (- y); rewrite ?opprK// -scaleN1r//.
84103
apply: (BU (-1, y)); split => /=; last by near: y.
85104
by move: B1 => [] ? ?; apply => /=; rewrite subrr normr0.
86105
Unshelve. all: by end_near. Qed.
87106

88-
Lemma nbhs0N_subproof (f : continuous (fun z : R^o * E => z.1 *: (z.2:ME) : E)) :
89-
nbhs (0 :ME) (U : set ME) -> nbhs (0 : ME) (-%R @` (U : set ME)).
107+
Lemma nbhs0N_subproof (f : continuous (fun z : R^o * E => z.1 *: z.2)) :
108+
nbhs 0 U -> nbhs 0 (-%R @` U).
90109
Proof. by move => Ux; rewrite -oppr0; exact: nbhsN_subproof. Qed.
91110

92-
Lemma nbhsT_subproof (f : continuous (fun x : E * E => (x.1 : ME) + (x.2 : ME))) (x : E) :
93-
nbhs (0 : ME) U -> nbhs (x : ME) (+%R (x : ME) @` U).
111+
Lemma nbhsT_subproof (f : continuous (fun x : E * E => x.1 + x.2)) (x : E) :
112+
nbhs 0 U -> nbhs x (+%R x @` U).
94113
Proof.
95-
move => U0; have /= := f (x, -(x : ME)) U; rewrite subrr => /(_ U0).
114+
move => U0; have /= := f (x, -x) U; rewrite subrr => /(_ U0).
96115
move=> [B] [B1 B2] BU; near=> x0.
97-
exists ((x0 : ME) - (x : ME)); last by rewrite addrCA subrr addr0.
98-
by apply: (BU ((x0 : ME), -(x : ME))); split; [near: x0; rewrite nearE|exact: nbhs_singleton].
116+
exists (x0 - x); last by rewrite addrCA subrr addr0.
117+
by apply: (BU (x0, -x)); split; [near: x0; rewrite nearE|exact: nbhs_singleton].
99118
Unshelve. all: by end_near. Qed.
100119

101-
Lemma nbhsB_subproof (f : continuous (fun x : E * E => (x.1 : ME) + (x.2 : ME))) (z x : E) :
102-
nbhs (z : ME) U -> nbhs ((x : ME) + (z : ME)) (+%R (x : ME) @` U).
120+
Lemma nbhsB_subproof (f : continuous (fun x : E * E => x.1 + x.2)) (z x : E) :
121+
nbhs z U -> nbhs (x + z) (+%R x @` U).
103122
Proof.
104-
move=> U0; move: (@f ((x : ME) + (z : ME), -(x : ME)) U); rewrite /= addrAC subrr add0r.
123+
move=> U0; have /= := f (x + z, -x) U; rewrite addrAC subrr add0r.
105124
move=> /(_ U0)[B] [B1 B2] BU; near=> x0.
106-
exists ((x0 : ME) - (x : ME)); last by rewrite addrCA subrr addr0.
107-
by apply: (BU ((x0 : ME), -(x : ME))); split; [near: x0; rewrite nearE|exact: nbhs_singleton].
125+
exists (x0 - x); last by rewrite addrCA subrr addr0.
126+
by apply: (BU (x0, -x)); split; [near: x0; rewrite nearE|exact: nbhs_singleton].
108127
Unshelve. all: by end_near. Qed.
109128

110-
End properties_of_topologicallmodule.
129+
End properties_of_topologicalLmodule.
111130

112131
HB.factory Record TopologicalLmod_isTvs (R : numDomainType) E
113132
of Topological E & GRing.Lmodule R E := {
@@ -127,9 +146,7 @@ Let nbhs0N (U : set E) : nbhs (0 : E) U -> nbhs (0 : E) (-%R @` U).
127146
Proof. by apply: nbhs0N_subproof; exact: scale_continuous. Qed.
128147

129148
Lemma nbhsN (U : set E) (x : E) : nbhs x U -> nbhs (-x) (-%R @` U).
130-
Proof.
131-
by apply: nbhsN_subproof; exact: scale_continuous.
132-
Qed.
149+
Proof. by apply: nbhsN_subproof; exact: scale_continuous. Qed.
133150

134151
Let nbhsT (U : set E) (x : E) : nbhs (0 : E) U -> nbhs x (+%R x @`U).
135152
Proof. by apply: nbhsT_subproof; exact: add_continuous. Qed.
@@ -228,8 +245,8 @@ End Tvs_numDomain.
228245

229246
Section Tvs_numField.
230247

231-
Lemma nbhs0Z (R : numFieldType) (E : tvsType R) (U : set E) (r : R) :
232-
r != 0 -> nbhs 0 U -> nbhs 0 ( *:%R r @` U).
248+
Lemma nbhs0Z (R : numFieldType) (E : tvsType R) (U : set E) (r : R) :
249+
r != 0 -> nbhs 0 U -> nbhs 0 ( *:%R r @` U ).
233250
Proof.
234251
move=> r0 U0; have /= := scale_continuous (r^-1, 0) U.
235252
rewrite scaler0 => /(_ U0)[]/= B [B1 B2] BU.
@@ -238,9 +255,9 @@ by apply: (BU (r^-1, x)); split => //=;[exact: nbhs_singleton|near: x].
238255
Unshelve. all: by end_near. Qed.
239256

240257
Lemma nbhsZ (R : numFieldType) (E : tvsType R) (U : set E) (r : R) (x :E) :
241-
r != 0 -> nbhs x U -> nbhs (r *:x) ( *:%R r @` U).
258+
r != 0 -> nbhs x U -> nbhs (r *:x) ( *:%R r @` U ).
242259
Proof.
243-
move => r0 U0; have /= := scale_continuous ((r^-1, r *: x)) U.
260+
move=> r0 U0; have /= := scale_continuous ((r^-1, r *: x)) U.
244261
rewrite scalerA mulVf// scale1r =>/(_ U0)[] /= B [B1 B2] BU.
245262
near=> z; exists (r^-1 *: z); last by rewrite scalerA divff// scale1r.
246263
by apply: (BU (r^-1,z)); split; [exact: nbhs_singleton|near: z].
@@ -251,7 +268,7 @@ End Tvs_numField.
251268
Section standard_topology.
252269
Variable R : numFieldType.
253270

254-
Lemma standard_add_continuous : continuous (fun x : R^o * R^o => x.1 + x.2).
271+
Local Lemma standard_add_continuous : continuous (fun x : R^o * R^o => x.1 + x.2).
255272
Proof.
256273
(* NB(rei): almost the same code as in normedtype.v *)
257274
move=> [/= x y]; apply/cvg_ballP => e e0 /=.
@@ -261,7 +278,7 @@ rewrite /ball /ball_/= => xy /= [nx ny].
261278
by rewrite opprD addrACA (le_lt_trans (ler_normD _ _)) // (splitr e) ltrD.
262279
Qed.
263280

264-
Lemma standard_scale_continuous : continuous (fun z : R^o * R^o => z.1 *: z.2).
281+
Local Lemma standard_scale_continuous : continuous (fun z : R^o * R^o => z.1 *: z.2).
265282
Proof.
266283
(* NB: This lemma is proved once again in normedtype, in a shorter way with much more machinery *)
267284
(* To be rewritten once normedtype is split and tvs can depend on these lemmas *)
@@ -312,7 +329,7 @@ rewrite -mulrBl normrM (@le_lt_trans _ _ (`|k - z1| * M)) ?ler_wpM2l//.
312329
by rewrite -ltr_pdivlMr ?(lt_le_trans k1r) ?normr_gt0.
313330
Qed.
314331

315-
Lemma standard_locally_convex :
332+
Local Lemma standard_locally_convex :
316333
exists2 B : set (set R^o), (forall b, b \in B -> convex b) & basis B.
317334
Proof.
318335
(* NB(rei): almost the same code as in normedtype.v *)
@@ -342,15 +359,15 @@ move=> x B; rewrite -nbhs_ballE/= => -[r] r0 Bxr /=.
342359
by exists (ball x r) => //; split; [exists x, r|exact: ballxx].
343360
Qed.
344361

345-
HB.instance Definition _ := Uniform_isTvs.Build R (R^o)%type
362+
HB.instance Definition _ := Uniform_isTvs.Build R R^o
346363
standard_add_continuous standard_scale_continuous standard_locally_convex.
347364

348365
End standard_topology.
349366

350367
Section prod_Tvs.
351368
Context (K : numFieldType) (E F : tvsType K).
352369

353-
Lemma prod_add_continuous : continuous (fun x : (E * F) * (E * F) => x.1 + x.2).
370+
Local Lemma prod_add_continuous : continuous (fun x : (E * F) * (E * F) => x.1 + x.2).
354371
Proof.
355372
move => [/= xy1 xy2] /= U /= [] [A B] /= [nA nB] nU.
356373
have [/= A0 [A01 A02] nA1] := @add_continuous K E (xy1.1, xy2.1) _ nA.
@@ -361,7 +378,7 @@ move => [[x1 y1][x2 y2]] /= [] [] a1 b1 [] a2 b2.
361378
by apply: nU; split; [exact: (nA1 (x1, x2))|exact: (nB1 (y1, y2))].
362379
Qed.
363380

364-
Lemma prod_scale_continuous : continuous (fun z : K^o * (E * F) => z.1 *: z.2).
381+
Local Lemma prod_scale_continuous : continuous (fun z : K^o * (E * F) => z.1 *: z.2).
365382
Proof.
366383
move => [/= r [x y]] /= U /= []/= [A B] /= [nA nB] nU.
367384
have [/= A0 [A01 A02] nA1] := @scale_continuous K E (r, x) _ nA.
@@ -372,7 +389,7 @@ by move=> [l [e f]] /= [] [Al Bl] [] Ae Be; apply: nU; split;
372389
[exact: (nA1 (l, e))|exact: (nB1 (l, f))].
373390
Qed.
374391

375-
Lemma prod_locally_convex :
392+
Local Lemma prod_locally_convex :
376393
exists2 B : set (set (E * F)), (forall b, b \in B -> convex b) & basis B.
377394
Proof.
378395
have [Be Bcb Beb] := @locally_convex K E.

0 commit comments

Comments
 (0)