[WIP] replace the infrastructure of mpoly with monalg

src/monalg.v

@@ -11,7 +11,7 @@
 From mathcomp Require Import tuple bigop ssralg ssrint ssrnum.
 Unset SsrOldRewriteGoalsOrder.  (* remove the line when requiring MathComp >= 2.6 *)
 
 Require Import xfinmap.
 
 Set Implicit Arguments.
 Unset Strict Implicit.
@@ -45,7 +45,7 @@
 Reserved Notation "g @_ k"
   (at level 3, k at level 2, left associativity, format "g @_ k").
 Reserved Notation "c %:MP" (format "c %:MP").
-Reserved Notation "''X_{1..' n '}'".
+Reserved Notation "''X_{1..' n '}'" (n at level 2).
 Reserved Notation "'U_(' n )" (format "'U_(' n )").
 Reserved Notation "x ^[ f , g ]" (at level 1, format "x ^[ f , g ]").
 
@@ -137,11 +137,30 @@
 #[export]
 HB.instance Definition _ := Monoid.isLaw.Build M 1 mmul mulmA mul1m mulm1.
 
+Definition expmn (x : M) (n : nat) : M := iterop n *%M x 1%M.
+
+Arguments expmn : simpl never.
+
 Lemma unitmP (x y : M) : reflect (x == 1 /\ y == 1) (x * y == 1).
 Proof.
 by apply: (iffP eqP)=> [/unitm[-> ->]|[/eqP-> /eqP->]] //; rewrite mulm1.
 Qed.
 
+Lemma mulm_eq1 (x y : M) : (x * y == 1) = (x == 1) && (y == 1).
+Proof. exact/unitmP/andP. Qed.
+
+Lemma expmnS (x : M) (n : nat) : expmn x n.+1 = x * expmn x n.
+Proof. by rewrite /expmn !Monoid.iteropE iterS. Qed.
+
+Lemma expmnD (x : M) (n m : nat) : expmn x (n + m) = expmn x n * expmn x m.
+Proof.
+elim: n => [|n IHn]; first by rewrite mul1m.
+by rewrite addSn !expmnS IHn mulmA.
+Qed.
+
+Lemma expmnSr (x : M) (n : nat) : expmn x n.+1 = expmn x n * x.
+Proof. by rewrite -addn1 expmnD. Qed.
+
 End Monomial.
 
 #[export]
@@ -166,12 +185,6 @@
 
 Module MMorphismExports.
 Notation "{ 'mmorphism' M -> S }" := (@MMorphism.type M S) : type_scope.
-#[deprecated(since="multinomials 2.2.0", note="Use MMorphism.clone instead.")]
-Notation "[ 'mmorphism' 'of' f 'as' g ]" := (MMorphism.clone _ _ f g)
-  (at level 0, only parsing) : form_scope.
-#[deprecated(since="multinomials 2.2.0", note="Use MMorphism.clone instead.")]
-Notation "[ 'mmorphism' 'of' f ]" := (MMorphism.clone _ _ f _)
-  (at level 0, only parsing) : form_scope.
 End MMorphismExports.
 Export MMorphismExports.
 
@@ -197,7 +210,7 @@
 
 Fact malg_key : unit. Proof. by []. Qed.
 
-#[deprecated(since="multinomials 2.5.0", note="Use Malg instead")]
+#[deprecated(since="multinomials 2.5.0", use=Malg)]
 Definition malg_of_fsfun   k := locked_with k Malg.
 #[warning="-deprecated-reference"]
 Canonical  malg_unlockable k := [unlockable fun malg_of_fsfun k].
@@ -223,15 +236,16 @@
 
 Definition mcoeff (x : K) (g : {malg G[K]}) : G := malg_val g x.
 
-#[deprecated(since="multinomials 2.5.0", note="Use Malg instead")]
+#[deprecated(since="multinomials 2.5.0", use=Malg)]
 Definition mkmalg : {fsfun K -> G with 0} -> {malg G[K]} := @Malg K G.
 
-Definition mkmalgU (k : K) (x : G) := [malg y in [fset k] => x].
-
 Definition msupp (g : {malg G[K]}) : {fset K} := finsupp (malg_val g).
 
 End MalgBaseOp.
 
+HB.lock Definition mkmalgU (K : choiceType) (G : nmodType) (k : K) (x : G) :=
+  [malg y in [fset k] => x].
+
 Arguments mcoeff  {K G} x%_monom_scope g%_ring_scope.
 #[warning="-deprecated-reference"]
 Arguments mkmalg  {K G} _.
@@ -332,7 +346,7 @@
 Lemma mcoeffMn  k n : {morph mcoeff k: x / x *+ n} . Proof. exact: raddfMn. Qed.
 
 Lemma mcoeffU k x k' : << x *g k >>@_k' = x *+ (k == k').
-Proof. by rewrite [LHS]fsfunE inE mulrb eq_sym. Qed.
+Proof. by rewrite unlock [LHS]fsfunE inE mulrb eq_sym. Qed.
 
 Lemma mcoeffUU k x : << x *g k >>@_k = x.
 Proof. by rewrite mcoeffU eqxx. Qed.
@@ -968,6 +982,9 @@
 HB.instance Definition _ :=
   GRing.LSemiModule_isLSemiAlgebra.Build R {malg R[K]} (@fgscaleAl K R).
 
+(* FIXME: HB.saturate *)
+HB.instance Definition _ := GRing.RMorphism.on (mcoeff 1 : {malg R[K]} -> R).
+
 End MalgNzSemiRingTheory.
 
 (* -------------------------------------------------------------------- *)
@@ -1276,7 +1293,7 @@
 
 (* -------------------------------------------------------------------- *)
 HB.mixin Record isMeasure (M : monomType) (mf : M -> nat) := {
-  mf0 : mf 1%M = 0%N;
+  mf1 : mf 1%M = 0%N;
   mfM : {morph mf : m1 m2 / (m1 * m2)%M >-> (m1 + m2)%N};
   mf_eq0I : forall m, mf m = 0%N -> m = 1%M
 }.
@@ -1296,7 +1313,7 @@
 Implicit Types (g : {malg G[M]}).
 
 Lemma mf_eq0 m : (mf m == 0%N) = (m == 1%M).
-Proof. by apply/eqP/eqP=> [|->]; rewrite ?mf0 // => /mf_eq0I. Qed.
+Proof. by apply/eqP/eqP=> [|->]; rewrite ?mf1 // => /mf_eq0I. Qed.
 
 Definition mmeasure g := (\max_(m <- msupp g) (mf m).+1)%N.
 
@@ -1318,7 +1335,7 @@
 Lemma mmeasureC c : mmeasure c%:MP = (c != 0%R) :> nat.
 Proof.
 rewrite mmeasureE msuppC; case: (_ == 0)=> /=.
-by rewrite big_nil. by rewrite big_seq_fset1 mf0.
+by rewrite big_nil. by rewrite big_seq_fset1 mf1.
 Qed.
 
 Lemma mmeasureD_le g1 g2 :
@@ -1370,18 +1387,21 @@
 
 Fact cmonom_key : unit. Proof. by []. Qed.
 
-#[deprecated(since="multinomials 2.5.0", note="Use CMonom instead")]
+#[deprecated(since="multinomials 2.5.0", use=CMonom)]
 Definition cmonom_of_fsfun   k := locked_with k CMonom.
 #[warning="-deprecated-reference"]
 Canonical  cmonom_unlockable k := [unlockable fun cmonom_of_fsfun k].
 
 End CmonomDef.
 
+Arguments cmonom_val : simpl never.
+Bind Scope monom_scope with cmonom.
+
 Notation "{ 'cmonom' I }" := (cmonom I) : type_scope.
 Notation "''X_{1..' n '}'" :=  (cmonom 'I_n) : type_scope.
 Notation "{ 'mpoly' R [ n ] }" := {malg R['X_{1..n}]} : type_scope.
 
-#[deprecated(since="multinomials 2.5.0", note="Use CMonom instead"),
+#[deprecated(since="multinomials 2.5.0", use=CMonom),
   warning="-deprecated-reference"]
 Notation mkcmonom := (cmonom_of_fsfun cmonom_key).
 Notation "[ 'cmonom' E | i 'in' P ]" :=
@@ -1394,8 +1414,8 @@
 
 Context (I : choiceType).
 
-HB.instance Definition _ := [isNew for @cmonom_val I].
-HB.instance Definition _ := [Choice of cmonom I by <:].
+#[hnf] HB.instance Definition _ := [isNew for @cmonom_val I].
+#[hnf] HB.instance Definition _ := [Choice of cmonom I by <:].
 
 (* -------------------------------------------------------------------- *)
 Implicit Types (m : cmonom I).
@@ -1408,7 +1428,7 @@
 by rewrite [mkcmonom]unlock.
 Qed.
 
-Lemma cmP m1 m2 : reflect (forall i, m1 i = m2 i) (m1 == m2).
+Lemma cmP m1 m2 : reflect (m1 =1 m2) (m1 == m2).
 Proof. by apply: (iffP eqP) => [->//|eq]; apply/val_inj/fsfunP. Qed.
 
 Definition onecm : cmonom I := CMonom [fsfun of _ => 0%N].
@@ -1420,8 +1440,6 @@
 
 Definition divcm m1 m2 : cmonom I := [cmonom m1 i - m2 i | i in finsupp m1]%M.
 
-Definition expcmn m n : cmonom I := iterop n mulcm m onecm.
-
 Lemma onecmE i : onecm i = 0%N.
 Proof. by rewrite fsfun_ffun insubF. Qed.
 
@@ -1456,12 +1474,16 @@
 by move=> m1 m2 h; split; move: h; last rewrite mulcmC; apply/gen.
 Qed.
 
+#[hnf]
 HB.instance Definition _ := Choice_isMonomialDef.Build (cmonom I)
   mulcmA mul0cm mulcm0 mulcm_eq0.
+#[hnf]
 HB.instance Definition _ := MonomialDef_isConomialDef.Build (cmonom I) mulcmC.
 
 End CmonomCanonicals.
 
+HB.instance Definition _ (I : countType) := [Countable of cmonom I by <:].
+
 (* -------------------------------------------------------------------- *)
 Definition mdeg {I : choiceType} (m : cmonom I) :=
   (\sum_(k <- finsupp m) m k)%N.
@@ -1558,9 +1580,6 @@
 Lemma mdeg_eq0 m : (mdeg m == 0%N) = (m == 1%M).
 Proof. exact/mf_eq0. Qed.
 
-Lemma cmM_eq1 m1 m2 : (m1 * m2 == 1)%M = (m1 == 1%M) && (m2 == 1%M).
-Proof. by rewrite -!mdeg_eq0 mdegM addn_eq0. Qed.
-
 Lemma cm1_eq1 i : (U_(i) == 1)%M = false.
 Proof. by rewrite -mdeg_eq0 mdegU. Qed.
 
@@ -1643,6 +1662,33 @@
 Definition msizeN (I : choiceType) (G : zmodType) :=
   @mmeasureN (cmonom I) G mdeg.
 
+Section CMMap.
+
+Definition cmmap
+  {I : choiceType} {R : pzSemiRingType} (f : I -> R) (m : cmonom I) :=
+  \prod_(k <- finsupp m) f k ^+ m k.
+
+Context (I : choiceType) (R : comPzSemiRingType) (f : I -> R).
+
+Lemma cmmapw (d : {fset I}) (m : {cmonom I}) :
+  finsupp m `<=` d -> cmmap f m = \prod_(k <- d) f k ^+ m k.
+Proof.
+by move=> md; apply: big_fset_incl md _ => x xd; rewrite -cmE_eq0 => /eqP->.
+Qed.
+
+Fact cmmap_is_mmorphism : mmorphism (cmmap f).
+Proof.
+split=> [|x y]; first by rewrite /cmmap mdom1 big_seq_fset0.
+rewrite [cmmap f x](cmmapw (fsubsetUl _ (finsupp y))).
+rewrite [cmmap f y](cmmapw (fsubsetUr (finsupp x) _)).
+by rewrite -big_split/= /cmmap mdomD; apply/eq_bigr => i _; rewrite cmM exprD.
+Qed.
+
+HB.instance Definition _ :=
+  isMultiplicative.Build _ _ (cmmap f) cmmap_is_mmorphism.
+
+End CMMap.
+
 (* -------------------------------------------------------------------- *)
 Section FmonomDef.
 
@@ -1659,6 +1705,8 @@
 
 End FmonomDef.
 
+Bind Scope monom_scope with fmonom.
+
 Notation "{ 'fmonom' I }" := (fmonom I) : type_scope.
 
 Local Notation mkfmonom s := (fmonom_of_seq fmonom_key s).
@@ -1715,6 +1763,8 @@
 
 End FmonomCanonicals.
 
+HB.instance Definition _ (I : countType) := [Countable of fmonom I by <:].
+
 (* -------------------------------------------------------------------- *)
 Definition fdeg (I : choiceType) (m : fmonom I) := size m.
 
@@ -1767,10 +1817,23 @@
 Lemma fdeg_eq0 m : (fdeg m == 0%N) = (m == 1%M).
 Proof. exact/mf_eq0. Qed.
 
-Lemma fmM_eq1 m1 m2 : (m1 * m2 == 1)%M = (m1 == 1%M) && (m2 == 1%M).
-Proof. by rewrite -!fdeg_eq0 fdegM addn_eq0. Qed.
-
 Lemma fm1_eq1 i : (U_(i) == 1)%M = false.
 Proof. by rewrite -fdeg_eq0 fdegU. Qed.
 
 End FmonomTheory.
+
+Section FMMap.
+
+Context (I : choiceType) (R : pzSemiRingType) (f : I -> R).
+
+Definition fmmap (m : fmonom I) := \prod_(k <- m) f k.
+
+Fact fmmap_is_mmorphism : mmorphism fmmap.
+Proof.
+split=> [|x y]; first by rewrite /fmmap [1%M]fmoneE/= big_nil.
+by rewrite /fmmap [(x * y)%M]fmmulE/= big_cat/=.
+Qed.
+
+HB.instance Definition _ := isMultiplicative.Build _ _ fmmap fmmap_is_mmorphism.
+
+End FMMap.