@@ -165,24 +165,24 @@ namespace RingCompute
165165
166166/-- Evaluate the sum of two normalized expressions in `R` using `ring`. -/
167167def add (cR : Common.Cache sR) {a b : Q($A)} (za : BaseType sAlg a) (zb : BaseType sAlg b) :
168- MetaM (Common.Result (BaseType sAlg) q($a + $b) × Option Q(IsNat ($a + $b) 0 )) := do
169- let ⟨r, vr⟩ := za
170- let ⟨s, vs⟩ := zb
171- let ⟨t, vt, pt⟩ ← Common.evalAdd (Ring.ringCompute cR) rcℕ vr vs
172- match vt with
173- | .zero =>
174- have : $t =Q 0 := ⟨⟩
175- return ⟨⟨_, .mk _ vt, q(add_algebraMap $pt)⟩, some q(add_algebraMap_isNat_zero $pt)⟩
176- | vt =>
177- return ⟨⟨_, .mk _ vt, q(add_algebraMap $pt)⟩, none⟩
168+ MetaM (Common.Result (BaseType sAlg) q($a + $b) × Option Q(IsNat ($a + $b) 0 )) :=
169+ match za, zb with
170+ | .mk r vr, .mk s vs => do
171+ let ⟨t, vt, pt⟩ ← Common.evalAdd (Ring.ringCompute cR) rcℕ vr vs
172+ match (dependent := true) vt with
173+ | .zero =>
174+ have : $t =Q 0 := ⟨⟩
175+ return ⟨⟨_, .mk _ vt, q(add_algebraMap $pt)⟩, some q(add_algebraMap_isNat_zero $pt)⟩
176+ | vt =>
177+ return ⟨⟨_, .mk _ vt, q(add_algebraMap $pt)⟩, none⟩
178178
179179/-- Evaluate the product of two normalized expressions in `R` using `ring`. -/
180180def mul (cR : Common.Cache sR) {a b : Q($A)} (za : BaseType sAlg a) (zb : BaseType sAlg b) :
181- MetaM (Common.Result (BaseType sAlg) q($a * $b)) := do
182- let ⟨r, vr⟩ := za
183- let ⟨s, vs⟩ := zb
184- let ⟨t, vt, pt⟩ ← Common.evalMul (Ring.ringCompute cR) rcℕ vr vs
185- return ⟨_, .mk _ vt, q(by simp [← $pt, map_mul])⟩
181+ MetaM (Common.Result (BaseType sAlg) q($a * $b)) :=
182+ match za, zb with
183+ | .mk r vr, .mk s vs => do
184+ let ⟨t, vt, pt⟩ ← Common.evalMul (Ring.ringCompute cR) rcℕ vr vs
185+ return ⟨_, .mk _ vt, q(by simp [← $pt, map_mul])⟩
186186
187187/-- Take an expression `r'` in a ring `R'` such that `R` is an `R'`-algebra and cast `r'` to `R`
188188using `algebraMap R' R`, so that the scalar multiplication action on `A` is preserved. -/
@@ -195,7 +195,7 @@ def cast (cR : Algebra.Cache sR) (u' : Level) (R' : Q(Type u'))
195195 let ⟨r, pf_smul⟩ ← evalSMulCast q($sAlg) q($_smul) r'
196196 let ⟨_r'', vr, pr⟩ ←
197197 Common.eval rcℕ (Ring.ringCompute cR.toCache) cR.toCache q($r)
198- match vr with
198+ match (dependent := true) vr with
199199 | .zero .. =>
200200 assumeInstancesCommute
201201 return ⟨_, .zero, q(cast_zero_smul_eq_zero_mul $pr $pf_smul)⟩
@@ -206,37 +206,40 @@ def cast (cR : Algebra.Cache sR) (u' : Level) (R' : Q(Type u'))
206206
207207/-- Evaluate the product of two normalized expressions in `R` using `ring`. -/
208208def neg (cR : Algebra.Cache sR) {a : Q($A)} (_rA : Q(CommRing $A)) (za : BaseType sAlg a) :
209- MetaM (Common.Result (BaseType sAlg) q(-$a)) := do
210- let ⟨r, vr⟩ := za
211- match cR.rα with
212- | some rR =>
213- let ⟨_, vt, pt⟩ ← Common.evalNeg (Ring.ringCompute cR.toCache) q($rR) vr
214- assumeInstancesCommute
215- return ⟨_, .mk _ vt, q(neg_algebraMap $pt)⟩
216- | none => failure
209+ MetaM (Common.Result (BaseType sAlg) q(-$a)) :=
210+ match za with
211+ | .mk r vr => do
212+ match cR.rα with
213+ | some rR =>
214+ let ⟨_, vt, pt⟩ ← Common.evalNeg (Ring.ringCompute cR.toCache) q($rR) vr
215+ assumeInstancesCommute
216+ return ⟨_, .mk _ vt, q(neg_algebraMap $pt)⟩
217+ | none => failure
217218
218219/-- Raise a normalized expression in `R` to the power of a normalized natural number expression
219220using `ring`. -/
220221def pow (cR : Common.Cache sR) {a : Q($A)} {b : Q(ℕ)} (za : BaseType sAlg a)
221222 (vb : Common.ExProdNat q($b)) :
222- OptionT MetaM (Common.Result (BaseType sAlg) q($a ^ $b)) := do
223- let ⟨r, vr⟩ := za
224- let ⟨_, vs, ps⟩ ← Common.evalPow₁ (Ring.ringCompute cR) rcℕ vr vb
225- return ⟨_, ⟨_, vs⟩, q(pow_algebraMap $ps)⟩
223+ OptionT MetaM (Common.Result (BaseType sAlg) q($a ^ $b)) :=
224+ match za with
225+ | .mk r vr => do
226+ let ⟨_, vs, ps⟩ ← Common.evalPow₁ (Ring.ringCompute cR) rcℕ vr vb
227+ return ⟨_, ⟨_, vs⟩, q(pow_algebraMap $ps)⟩
226228
227229/-- Evaluate the inverse of two normalized expressions in `R` using `ring`. -/
228230/- We include the CharZero argument to match the type signature of the ringCompute entry. -/
229231@[nolint unusedArguments]
230232def inv (cR : Algebra.Cache sR) {a : Q($A)} (_ : Option Q(CharZero $A)) (fA : Q(Semifield $A))
231- (za : BaseType sAlg a) : AtomM (Option (Common.Result (BaseType sAlg) q($a⁻¹))) := do
232- match cR.dsα with
233- | some fR =>
234- let ⟨r, vr⟩ := za
235- let ⟨_, vs, ps⟩ ← Common.ExSum.evalInv (Ring.ringCompute cR.toCache) rcℕ q($fR) cR.czα vr
236- assumeInstancesCommute
237- return some ⟨_, ⟨_, vs⟩, q(inv_algebraMap $ps)⟩
238- | none =>
239- return none
233+ (za : BaseType sAlg a) : AtomM (Option (Common.Result (BaseType sAlg) q($a⁻¹))) :=
234+ match za with
235+ | .mk r vr => do
236+ match cR.dsα with
237+ | some fR =>
238+ let ⟨_, vs, ps⟩ ← Common.ExSum.evalInv (Ring.ringCompute cR.toCache) rcℕ q($fR) cR.czα vr
239+ assumeInstancesCommute
240+ return some ⟨_, ⟨_, vs⟩, q(inv_algebraMap $ps)⟩
241+ | none =>
242+ return none
240243
241244/-- Evaluate constants in `A` using `norm_num`. -/
242245def derive (cR : Algebra.Cache sR) (cA : Algebra.Cache sA) (x : Q($A)) :
0 commit comments