import ContractExact namespace FastAct /-! ## 128-bit products of 64-bit words -/ /-- The middle column of `a · b` from four 32-bit products (carries into the high half). -/ @[inline] def midW (a b : UInt64) : UInt64 := (((a &&& (0xffffffff : UInt64)) * (b &&& (0xffffffff : UInt64))) >>> (32 : UInt64)) + (((a &&& (0xffffffff : UInt64)) * (b >>> (32 : UInt64))) &&& (0xffffffff : UInt64)) + (((a >>> (32 : UInt64)) * (b &&& (0xffffffff : UInt64))) &&& (0xffffffff : UInt64)) /-- The high 64 bits of `a · b`. -/ @[inline] def mulHiW (a b : UInt64) : UInt64 := (a >>> (32 : UInt64)) * (b >>> (32 : UInt64)) + (((a &&& (0xffffffff : UInt64)) * (b >>> (32 : UInt64))) >>> (32 : UInt64)) + (((a >>> (32 : UInt64)) * (b &&& (0xffffffff : UInt64))) >>> (32 : UInt64)) + (midW a b >>> (32 : UInt64)) /-- The low 64 bits of `a · b`. -/ @[inline] def mulLoW (a b : UInt64) : UInt64 := (midW a b <<< (32 : UInt64)) + ((a &&& (0xffffffff : UInt64)) * (b &&& (0xffffffff : UInt64)) &&& (0xffffffff : UInt64)) /-- `a · b` as `(high, low)` 64-bit halves (for proofs; the code reads the halves directly). -/ def mul128 (a b : UInt64) : UInt64 × UInt64 := (mulHiW a b, mulLoW a b) theorem toNat_and_mask (x : UInt64) : (x &&& 0xffffffff).toNat = x.toNat % 2 ^ 32 := by rw [UInt64.toNat_and] exact Nat.and_two_pow_sub_one_eq_mod x.toNat 32 theorem toNat_shr32 (x : UInt64) : (x >>> 32).toNat = x.toNat / 2 ^ 32 := by rw [UInt64.toNat_shiftRight] simp [Nat.shiftRight_eq_div_pow] theorem mul128_spec (a b : UInt64) : (mul128 a b).1.toNat * 2 ^ 64 + (mul128 a b).2.toNat = a.toNat * b.toNat := by have ha := a.toNat_lt have hb := b.toNat_lt have hk : a.toNat * b.toNat < 2 ^ 128 := calc a.toNat * b.toNat < 2 ^ 64 * 2 ^ 64 := Nat.mul_lt_mul'' ha hb _ = 2 ^ 128 := by norm_num simp only [mul128, mulHiW, mulLoW, midW, UInt64.toNat_add, UInt64.toNat_mul, UInt64.toNat_shiftLeft, toNat_and_mask, toNat_shr32] have h32 : (32 : UInt64).toNat % 64 = 32 := by decide rw [h32, Nat.shiftLeft_eq] have hA := (Nat.div_add_mod' a.toNat (2 ^ 32)).symm have hB := (Nat.div_add_mod' b.toNat (2 ^ 32)).symm have hA0 : a.toNat % 2 ^ 32 < 2 ^ 32 := Nat.mod_lt _ (by norm_num) have hB0 : b.toNat % 2 ^ 32 < 2 ^ 32 := Nat.mod_lt _ (by norm_num) have hA1 : a.toNat / 2 ^ 32 < 2 ^ 32 := by omega have hB1 : b.toNat / 2 ^ 32 < 2 ^ 32 := by omega generalize a.toNat / 2 ^ 32 = A1 at * generalize a.toNat % 2 ^ 32 = A0 at * generalize b.toNat / 2 ^ 32 = B1 at * generalize b.toNat % 2 ^ 32 = B0 at * have prod_lt : ∀ x y : Nat, x < 2 ^ 32 → y < 2 ^ 32 → x * y < 2 ^ 64 := fun x y hx hy => calc x * y < 2 ^ 32 * 2 ^ 32 := Nat.mul_lt_mul'' hx hy _ = 2 ^ 64 := by norm_num have m00 := prod_lt A0 B0 hA0 hB0 have m01 := prod_lt A0 B1 hA0 hB1 have m10 := prod_lt A1 B0 hA1 hB0 have m11 := prod_lt A1 B1 hA1 hB1 have hab : a.toNat * b.toNat = A1 * B1 * 2 ^ 64 + (A0 * B1 + A1 * B0) * 2 ^ 32 + A0 * B0 := by rw [hA, hB]; ring simp only [Nat.mod_eq_of_lt m00, Nat.mod_eq_of_lt m01, Nat.mod_eq_of_lt m10, Nat.mod_eq_of_lt m11] rw [hab] generalize A0 * B0 = p00 at * generalize A0 * B1 = p01 at * generalize A1 * B0 = p10 at * generalize A1 * B1 = p11 at * omega /-! ## Fixed point on the grid `2^(−62)` A natural number `a` stands for `a / 2^62` (`V a`). Every quantity below is at most about `1`, so values stay below `2^63` and remain unboxed. -/ /-- `1` on the grid. -/ def one : Nat := 2 ^ 62 /-- The real value of a grid number. -/ noncomputable def V (a : Nat) : ℝ := (a : ℝ) / 2 ^ 62 theorem V_nonneg (a : Nat) : 0 ≤ V a := by unfold V; positivity theorem V_one : V one = 1 := by norm_num [V, one] theorem V_mono {a b : Nat} (h : a ≤ b) : V a ≤ V b := by unfold V; gcongr theorem V_add (a b : Nat) : V (a + b) = V a + V b := by unfold V; push_cast; ring theorem V_sub_ge (a b : Nat) : V a - V b ≤ V (a - b) := by unfold V rcases le_total b a with h | h · rw [Nat.cast_sub h]; ring_nf; rfl · rw [Nat.sub_eq_zero_of_le h] have : (a : ℝ) ≤ b := by exact_mod_cast h simp only [Nat.cast_zero, zero_div] rw [div_sub_div_same] exact div_nonpos_of_nonpos_of_nonneg (by linarith) (by positivity) theorem V_sub_le_of_le {a b : Nat} (h : b ≤ a) : V (a - b) = V a - V b := by unfold V; rw [Nat.cast_sub h]; ring /-- `⌊a · b / 2^62⌋` as a word (wrapping past `2^64`). -/ @[inline] def mulDnW (a b : UInt64) : UInt64 := (mulHiW a b <<< 2) + (mulLoW a b >>> 62) /-- `⌈a · b / 2^62⌉` as a word. -/ @[inline] def mulUpW (a b : UInt64) : UInt64 := if mulLoW a b &&& 0x3fffffffffffffff = 0 then mulDnW a b else mulDnW a b + 1 /-- `⌊a · b / 2^62⌋`; a lower bound for any `a, b`. -/ @[inline] def mulDn (a b : Nat) : Nat := (mulDnW a.toUInt64 b.toUInt64).toNat /-- `⌈a · b / 2^62⌉` for `a, b ≤ one`. -/ @[inline] def mulUp (a b : Nat) : Nat := (mulUpW a.toUInt64 b.toUInt64).toNat theorem toNat_toUInt64_le (a : Nat) : a.toUInt64.toNat ≤ a := by rw [UInt64.toNat_ofNat']; exact Nat.mod_le _ _ theorem toNat_toUInt64_of_lt {a : Nat} (h : a < 2 ^ 64) : a.toUInt64.toNat = a := by rw [UInt64.toNat_ofNat']; exact Nat.mod_eq_of_lt h theorem toNat_mulDnW (a b : UInt64) : (mulDnW a b).toNat = ((mulHiW a b).toNat * 4 % 2 ^ 64 + (mulLoW a b).toNat / 2 ^ 62) % 2 ^ 64 := by unfold mulDnW rw [UInt64.toNat_add, UInt64.toNat_shiftLeft, UInt64.toNat_shiftRight] have h2 : (2 : UInt64).toNat % 64 = 2 := by decide have h62 : (62 : UInt64).toNat % 64 = 62 := by decide rw [h2, h62, Nat.shiftLeft_eq, Nat.shiftRight_eq_div_pow] theorem low62_zero_iff (x : UInt64) : (x &&& 0x3fffffffffffffff = 0) ↔ x.toNat % 2 ^ 62 = 0 := by rw [← UInt64.toNat_inj, UInt64.toNat_and] have : (0x3fffffffffffffff : UInt64).toNat = 2 ^ 62 - 1 := by decide rw [this, Nat.and_two_pow_sub_one_eq_mod]; simp /-- The halves of a product of two numbers below `2^64`. -/ theorem halves {a b : Nat} (ha : a < 2 ^ 64) (hb : b < 2 ^ 64) : (mulHiW a.toUInt64 b.toUInt64).toNat * 2 ^ 64 + (mulLoW a.toUInt64 b.toUInt64).toNat = a * b := by have hs := mul128_spec a.toUInt64 b.toUInt64 rwa [toNat_toUInt64_of_lt ha, toNat_toUInt64_of_lt hb] at hs theorem mulDn_mul_le (a b : Nat) : mulDn a b * 2 ^ 62 ≤ a * b := by have hs := mul128_spec a.toUInt64 b.toUInt64 have hle : a.toUInt64.toNat * b.toUInt64.toNat ≤ a * b := Nat.mul_le_mul (toNat_toUInt64_le a) (toNat_toUInt64_le b) simp only [mul128] at hs unfold mulDn rw [toNat_mulDnW] generalize (mulHiW a.toUInt64 b.toUInt64).toNat = h at * generalize (mulLoW a.toUInt64 b.toUInt64).toNat = l at * omega /-- For operands at most `one`, `mulUp` is the exact ceiling: within `2^62` above `a · b`. -/ theorem mulUp_bounds {a b : Nat} (ha : a ≤ one) (hb : b ≤ one) : a * b ≤ mulUp a b * 2 ^ 62 ∧ mulUp a b * 2 ^ 62 < a * b + 2 ^ 62 := by have hs := halves (a := a) (b := b) (by unfold one at ha; omega) (by unfold one at hb; omega) have hab : a * b ≤ 2 ^ 62 * 2 ^ 62 := Nat.mul_le_mul ha hb have hl := (mulLoW a.toUInt64 b.toUInt64).toNat_lt unfold mulUp mulUpW split · rename_i h rw [low62_zero_iff] at h rw [toNat_mulDnW] generalize a * b = p at * generalize (mulHiW a.toUInt64 b.toUInt64).toNat = hi at * generalize (mulLoW a.toUInt64 b.toUInt64).toNat = l at * omega · rename_i h rw [low62_zero_iff] at h rw [UInt64.toNat_add, toNat_mulDnW, show (1 : UInt64).toNat = 1 from rfl] generalize a * b = p at * generalize (mulHiW a.toUInt64 b.toUInt64).toNat = hi at * generalize (mulLoW a.toUInt64 b.toUInt64).toNat = l at * omega theorem mulUp_mul_ge {a b : Nat} (ha : a ≤ one) (hb : b ≤ one) : a * b ≤ mulUp a b * 2 ^ 62 := (mulUp_bounds ha hb).1 theorem mulUp_le {a b : Nat} (ha : a ≤ one) (hb : b ≤ one) : mulUp a b ≤ one := by have h := (mulUp_bounds ha hb).2 have hab : a * b ≤ 2 ^ 62 * 2 ^ 62 := Nat.mul_le_mul ha hb unfold one at * generalize a * b = p at * omega theorem V_mulDn (a b : Nat) : V (mulDn a b) ≤ V a * V b := by have h := mulDn_mul_le a b unfold V rw [div_mul_div_comm, le_div_iff₀ (by positivity), div_mul_eq_mul_div, div_le_iff₀ (by positivity)] have : ((mulDn a b * 2 ^ 62 : Nat) : ℝ) ≤ ((a * b : Nat) : ℝ) := by exact_mod_cast h push_cast at this nlinarith [this] theorem V_mulUp {a b : Nat} (ha : a ≤ one) (hb : b ≤ one) : V a * V b ≤ V (mulUp a b) := by have h := mulUp_mul_ge ha hb unfold V rw [div_mul_div_comm, div_le_iff₀ (by positivity), div_mul_eq_mul_div, le_div_iff₀ (by positivity)] have : ((a * b : Nat) : ℝ) ≤ ((mulUp a b * 2 ^ 62 : Nat) : ℝ) := by exact_mod_cast h push_cast at this nlinarith [this] /-- Lower bounds multiply. -/ theorem V_mulDn_le {a b : Nat} {x y : ℝ} (ha : V a ≤ x) (hb : V b ≤ y) : V (mulDn a b) ≤ x * y := (V_mulDn a b).trans (mul_le_mul ha hb (V_nonneg b) ((V_nonneg a).trans ha)) /-- Upper bounds multiply (operands at most `1`). -/ theorem le_V_mulUp {a b : Nat} {x y : ℝ} (ha : x ≤ V a) (hb : y ≤ V b) (hy : 0 ≤ y) (ha1 : a ≤ one) (hb1 : b ≤ one) : x * y ≤ V (mulUp a b) := (mul_le_mul ha hb hy (V_nonneg a)).trans (V_mulUp ha1 hb1) theorem V_div_le (k : Nat) : V (one / k) ≤ 1 / k := by rcases Nat.eq_zero_or_pos k with rfl | hk · simp [V] have h : one / k * k ≤ one := Nat.div_mul_le_self one k have hc : ((one / k : Nat) : ℝ) * k ≤ (one : ℝ) := by exact_mod_cast h unfold V rw [div_le_div_iff₀ (by positivity) (by exact_mod_cast hk)] have : (one : ℝ) = 2 ^ 62 := by norm_num [one] linarith theorem le_V_divUp (k : Nat) (hk : 0 < k) : 1 / (k : ℝ) ≤ V ((one + k - 1) / k) := by have h : one ≤ (one + k - 1) / k * k := by have h2 := Nat.div_add_mod (one + k - 1) k have h3 := Nat.mod_lt (one + k - 1) hk have : (one + k - 1) / k * k = k * ((one + k - 1) / k) := Nat.mul_comm _ _ omega have hc : (one : ℝ) ≤ (((one + k - 1) / k : Nat) : ℝ) * k := by exact_mod_cast h unfold V rw [div_le_div_iff₀ (by exact_mod_cast hk) (by positivity)] have : (one : ℝ) = 2 ^ 62 := by norm_num [one] linarith /-! ## `e^(−r)` for `0 ≤ r ≤ 1/64`: Taylor sum of degree 6 with directed rounding -/ def f2l : Nat := one / 2 def f3l : Nat := one / 6 def f4l : Nat := one / 24 def f5l : Nat := one / 120 def f6l : Nat := one / 720 def f2h : Nat := (one + 2 - 1) / 2 def f3h : Nat := (one + 6 - 1) / 6 def f4h : Nat := (one + 24 - 1) / 24 def f5h : Nat := (one + 120 - 1) / 120 def f6h : Nat := (one + 720 - 1) / 720 /-- `8 / (7! · 7)` rounded up: the Taylor remainder factor (`Real.exp_bound`, `n = 7`). -/ def remF : Nat := (one + 35280 - 1) / 35280 * 8 /-- Enclosure of `e^(−r)` from `V rl ≤ r ≤ V rh`. -/ @[inline] def expSmall (rl rh : Nat) : Nat × Nat := let p2l := mulDn rl rl let p3l := mulDn p2l rl let p4l := mulDn p3l rl let p5l := mulDn p4l rl let p6l := mulDn p5l rl let p2h := mulUp rh rh let p3h := mulUp p2h rh let p4h := mulUp p3h rh let p5h := mulUp p4h rh let p6h := mulUp p5h rh let p7h := mulUp p6h rh let lo := (one + mulDn p2l f2l + mulDn p4l f4l + mulDn p6l f6l) - (rh + mulUp p3h f3h + mulUp p5h f5h + mulUp p7h remF) let hi := (one + mulUp p2h f2h + mulUp p4h f4h + mulUp p6h f6h + mulUp p7h remF) - (rl + mulDn p3l f3l + mulDn p5l f5l) (lo, min one hi) theorem exp_neg_taylor {r : ℝ} (h0 : 0 ≤ r) (h1 : r ≤ 1) : |Real.exp (-r) - (1 - r + r ^ 2 / 2 - r ^ 3 / 6 + r ^ 4 / 24 - r ^ 5 / 120 + r ^ 6 / 720)| ≤ r ^ 7 * (8 / 35280) := by have h := Real.exp_bound (x := -r) (by rw [abs_neg, abs_of_nonneg h0]; exact h1) (n := 7) (by norm_num) simp only [Finset.sum_range_succ, Finset.sum_range_zero, Nat.factorial] at h rw [abs_neg, abs_of_nonneg h0] at h convert h using 2 · norm_num; ring · norm_num theorem f_le_one {x : Nat} (k : Nat) (hk : 0 < k) (h : x = (one + k - 1) / k) : x ≤ one := by subst h; unfold one; apply Nat.div_le_of_le_mul; omega theorem expSmall_spec {rl rh : Nat} {r : ℝ} (hl : V rl ≤ r) (hh : r ≤ V rh) (hrh : rh ≤ one) : V (expSmall rl rh).1 ≤ Real.exp (-r) ∧ Real.exp (-r) ≤ V (expSmall rl rh).2 ∧ (expSmall rl rh).2 ≤ one := by have h0 : 0 ≤ r := (V_nonneg rl).trans hl have h1 : r ≤ 1 := hh.trans (V_one ▸ V_mono hrh) have hT := exp_neg_taylor h0 h1 have hp : ∀ n, 0 ≤ r ^ n := fun n => pow_nonneg h0 n -- lower powers have l2 : V (mulDn rl rl) ≤ r ^ 2 := by rw [sq]; exact V_mulDn_le hl hl have l3 : V (mulDn (mulDn rl rl) rl) ≤ r ^ 3 := by rw [pow_succ]; exact V_mulDn_le l2 hl have l4 : V (mulDn (mulDn (mulDn rl rl) rl) rl) ≤ r ^ 4 := by rw [pow_succ]; exact V_mulDn_le l3 hl have l5 : V (mulDn (mulDn (mulDn (mulDn rl rl) rl) rl) rl) ≤ r ^ 5 := by rw [pow_succ]; exact V_mulDn_le l4 hl have l6 : V (mulDn (mulDn (mulDn (mulDn (mulDn rl rl) rl) rl) rl) rl) ≤ r ^ 6 := by rw [pow_succ]; exact V_mulDn_le l5 hl -- upper powers, each at most `one` have u2 : r ^ 2 ≤ V (mulUp rh rh) := by rw [sq]; exact le_V_mulUp hh hh h0 hrh hrh have b2 : mulUp rh rh ≤ one := mulUp_le hrh hrh have u3 : r ^ 3 ≤ V (mulUp (mulUp rh rh) rh) := by rw [pow_succ]; exact le_V_mulUp u2 hh h0 b2 hrh have b3 := mulUp_le b2 hrh have u4 : r ^ 4 ≤ V (mulUp (mulUp (mulUp rh rh) rh) rh) := by rw [pow_succ]; exact le_V_mulUp u3 hh h0 b3 hrh have b4 := mulUp_le b3 hrh have u5 : r ^ 5 ≤ V (mulUp (mulUp (mulUp (mulUp rh rh) rh) rh) rh) := by rw [pow_succ]; exact le_V_mulUp u4 hh h0 b4 hrh have b5 := mulUp_le b4 hrh have u6 : r ^ 6 ≤ V (mulUp (mulUp (mulUp (mulUp (mulUp rh rh) rh) rh) rh) rh) := by rw [pow_succ]; exact le_V_mulUp u5 hh h0 b5 hrh have b6 := mulUp_le b5 hrh have u7 : r ^ 7 ≤ V (mulUp (mulUp (mulUp (mulUp (mulUp (mulUp rh rh) rh) rh) rh) rh) rh) := by rw [pow_succ]; exact le_V_mulUp u6 hh h0 b6 hrh have b7 := mulUp_le b6 hrh -- factorial factors have fl : ∀ (k : Nat) (x : Nat), x = one / k → V x ≤ 1 / k := fun k x h => h ▸ V_div_le k have fh : ∀ (k : Nat) (x : Nat), 0 < k → x = (one + k - 1) / k → 1 / (k : ℝ) ≤ V x := fun k x hk h => h ▸ le_V_divUp k hk have hf2l := fl 2 f2l rfl have hf3l := fl 6 f3l rfl have hf4l := fl 24 f4l rfl have hf5l := fl 120 f5l rfl have hf6l := fl 720 f6l rfl have hf2h := fh 2 f2h (by norm_num) rfl have hf3h := fh 6 f3h (by norm_num) rfl have hf4h := fh 24 f4h (by norm_num) rfl have hf5h := fh 120 f5h (by norm_num) rfl have hf6h := fh 720 f6h (by norm_num) rfl have hremF : 8 / (35280 : ℝ) ≤ V remF := by have h := fh 35280 ((one + 35280 - 1) / 35280) (by norm_num) rfl unfold remF V at * push_cast at * rw [mul_div_right_comm] nlinarith have bf2 := f_le_one 2 (by norm_num) (rfl : f2h = _) have bf3 := f_le_one 6 (by norm_num) (rfl : f3h = _) have bf4 := f_le_one 24 (by norm_num) (rfl : f4h = _) have bf5 := f_le_one 120 (by norm_num) (rfl : f5h = _) have bf6 := f_le_one 720 (by norm_num) (rfl : f6h = _) have brem : remF ≤ one := by unfold remF one; norm_num have c2 := V_mulDn_le l2 hf2l have c3 := V_mulDn_le l3 hf3l have c4 := V_mulDn_le l4 hf4l have c5 := V_mulDn_le l5 hf5l have c6 := V_mulDn_le l6 hf6l have d2 := le_V_mulUp u2 hf2h (by norm_num) b2 bf2 have d3 := le_V_mulUp u3 hf3h (by norm_num) b3 bf3 have d4 := le_V_mulUp u4 hf4h (by norm_num) b4 bf4 have d5 := le_V_mulUp u5 hf5h (by norm_num) b5 bf5 have d6 := le_V_mulUp u6 hf6h (by norm_num) b6 bf6 have d7 := le_V_mulUp u7 hremF (by norm_num) b7 brem have hexp1 : Real.exp (-r) ≤ 1 := Real.exp_le_one_iff.mpr (by linarith) have hab := abs_le.mp hT refine ⟨?_, ?_, min_le_left _ _⟩ · simp only [expSmall] refine le_trans (b := max 0 (V (one + mulDn (mulDn rl rl) f2l + mulDn (mulDn (mulDn (mulDn rl rl) rl) rl) f4l + mulDn (mulDn (mulDn (mulDn (mulDn (mulDn rl rl) rl) rl) rl) rl) f6l) - V (rh + mulUp (mulUp (mulUp rh rh) rh) f3h + mulUp (mulUp (mulUp (mulUp (mulUp rh rh) rh) rh) rh) f5h + mulUp (mulUp (mulUp (mulUp (mulUp (mulUp (mulUp rh rh) rh) rh) rh) rh) rh) remF))) ?_ ?_ · unfold V rw [le_max_iff] rcases le_total (rh + mulUp (mulUp (mulUp rh rh) rh) f3h + mulUp (mulUp (mulUp (mulUp (mulUp rh rh) rh) rh) rh) f5h + mulUp (mulUp (mulUp (mulUp (mulUp (mulUp (mulUp rh rh) rh) rh) rh) rh) rh) remF) (one + mulDn (mulDn rl rl) f2l + mulDn (mulDn (mulDn (mulDn rl rl) rl) rl) f4l + mulDn (mulDn (mulDn (mulDn (mulDn (mulDn rl rl) rl) rl) rl) rl) f6l) with h | h · right; rw [Nat.cast_sub h]; ring_nf; rfl · left; rw [Nat.sub_eq_zero_of_le h]; simp · apply max_le (Real.exp_pos _).le simp only [V_add, V_one] at * nlinarith · simp only [expSmall] rcases le_total one (one + mulUp (mulUp rh rh) f2h + mulUp (mulUp (mulUp (mulUp rh rh) rh) rh) f4h + mulUp (mulUp (mulUp (mulUp (mulUp (mulUp rh rh) rh) rh) rh) rh) f6h + mulUp (mulUp (mulUp (mulUp (mulUp (mulUp (mulUp rh rh) rh) rh) rh) rh) rh) remF - (rl + mulDn (mulDn (mulDn rl rl) rl) f3l + mulDn (mulDn (mulDn (mulDn (mulDn rl rl) rl) rl) rl) f5l)) with h | h · rw [min_eq_left h, V_one]; exact hexp1 · rw [min_eq_right h] refine le_trans ?_ (V_sub_ge _ _) simp only [V_add, V_one] linarith [hab.2] /-! ## Tables: powers of an enclosure -/ /-- An enclosure `(lo, hi)` of `e^(−b)` with `hi ≤ one`. -/ def Encl (iv : Nat × Nat) (b : ℝ) : Prop := V iv.1 ≤ Real.exp (-b) ∧ Real.exp (-b) ≤ V iv.2 ∧ iv.2 ≤ one /-- `j`-th power of an enclosure of `e^(−b)`: an enclosure of `e^(−j b)`. -/ def powOf (base : Nat × Nat) : Nat → Nat × Nat | 0 => (one, one) | j + 1 => let p := powOf base j; (mulDn p.1 base.1, min one (mulUp p.2 base.2)) /-- The product of enclosures of `e^(−a)` and `e^(−b)` encloses `e^(−(a + b))`. -/ theorem Encl.mul {x y : Nat × Nat} {a b : ℝ} (hx : Encl x a) (hy : Encl y b) : Encl (mulDn x.1 y.1, min one (mulUp x.2 y.2)) (a + b) := by have he : Real.exp (-(a + b)) = Real.exp (-a) * Real.exp (-b) := by rw [← Real.exp_add]; ring_nf refine ⟨?_, ?_, min_le_left _ _⟩ · rw [he]; exact V_mulDn_le hx.1 hy.1 · rw [he] rcases le_total one (mulUp x.2 y.2) with h | h · rw [min_eq_left h, V_one, ← he] exact Real.exp_le_one_iff.mpr (by have := Real.exp_le_one_iff.mp (le_trans hx.2.1 (V_one ▸ V_mono hx.2.2)) have := Real.exp_le_one_iff.mp (le_trans hy.2.1 (V_one ▸ V_mono hy.2.2)) linarith) · rw [min_eq_right h] exact le_V_mulUp hx.2.1 hy.2.1 (Real.exp_pos _).le hx.2.2 hy.2.2 theorem powOf_spec {base : Nat × Nat} {b : ℝ} (hb : Encl base b) : ∀ j : Nat, Encl (powOf base j) (j * b) | 0 => by refine ⟨?_, ?_, le_rfl⟩ <;> simp [powOf, V_one] | j + 1 => by have := (powOf_spec hb j).mul hb simp only [powOf] convert this using 2; push_cast; ring /-- `2^56`, that is `1/64` on the grid. -/ def sixtyFourth : Nat := 2 ^ 56 theorem V_sixtyFourth : V sixtyFourth = 1 / 64 := by norm_num [V, sixtyFourth] /-- An enclosure of `e^(−1/64)`. -/ def base64 : Nat × Nat := expSmall sixtyFourth sixtyFourth theorem base64_spec : Encl base64 (1 / 64) := by exact expSmall_spec (rl := sixtyFourth) (rh := sixtyFourth) (r := 1 / 64) V_sixtyFourth.le V_sixtyFourth.ge (by norm_num [sixtyFourth, one]) /-- `e^(−j/64)` for `j < 64`. -/ def fracTab : Array (Nat × Nat) := Array.ofFn (n := 64) fun j => powOf base64 j.val /-- An enclosure of `e^(−1)`. -/ def baseOne : Nat × Nat := powOf base64 64 /-- `e^(−n)` for `n ≤ 16`. -/ def intTab : Array (Nat × Nat) := Array.ofFn (n := 17) fun n => powOf baseOne n.val theorem getElem!_ofFn' {α : Type} [Inhabited α] {n : Nat} (f : Fin n → α) {i : Nat} (h : i < n) : (Array.ofFn f)[i]! = f ⟨i, h⟩ := by rw [getElem!_pos (Array.ofFn f) i (by simpa using h)] simp theorem fracTab_spec {j : Nat} (h : j < 64) : Encl fracTab[j]! (j * (1 / 64)) := by rw [fracTab, getElem!_ofFn' _ h] exact powOf_spec base64_spec j theorem intTab_spec {n : Nat} (h : n < 17) : Encl intTab[n]! n := by rw [intTab, getElem!_ofFn' _ h] have h1 : Encl baseOne 1 := by have := powOf_spec base64_spec 64 simp only [baseOne]; convert this using 1; norm_num have := powOf_spec h1 n simpa using this /-! ## `e^(−c)` for `0 ≤ c < 17`: `c = n + j/64 + r` -/ /-- `c · 2^56` rounded down and up, for `c = m · 2^e`. -/ @[inline] def scaled (m : Nat) (e : Int) : Nat × Nat := if 0 ≤ e + 56 then let v := m <<< (e + 56).toNat; (v, v) else let v := m >>> (-(e + 56)).toNat; (v, v + 1) theorem scaled_spec (m : Nat) (e : Int) : ((scaled m e).1 : ℝ) ≤ m * (2 : ℝ) ^ e * 2 ^ 56 ∧ (m : ℝ) * (2 : ℝ) ^ e * 2 ^ 56 ≤ (scaled m e).2 ∧ (scaled m e).1 ≤ (scaled m e).2 := by unfold scaled have hz : (m : ℝ) * (2 : ℝ) ^ e * 2 ^ 56 = m * (2 : ℝ) ^ (e + 56) := by rw [zpow_add₀ two_ne_zero]; norm_num; ring split · rename_i h have hk : ((2 : ℝ) ^ (e + 56)) = 2 ^ (e + 56).toNat := by rw [← zpow_natCast, Int.toNat_of_nonneg h] simp only [Nat.shiftLeft_eq, hz, hk]; push_cast; simp · rename_i h set k := (-(e + 56)).toNat have hk : ((2 : ℝ) ^ (e + 56)) = 1 / 2 ^ k := by rw [show e + 56 = -(k : Int) by omega, zpow_neg, zpow_natCast, one_div] simp only [Nat.shiftRight_eq_div_pow, hz, hk] have hp : (0 : ℝ) < 2 ^ k := by positivity have h1 := Nat.div_mul_le_self m (2 ^ k) have h2 := Nat.lt_succ_iff.mpr (le_refl (m / 2 ^ k)) have h3 : m < (m / 2 ^ k + 1) * 2 ^ k := by have := Nat.lt_mul_div_succ m (Nat.two_pow_pos k); linarith refine ⟨?_, ?_, Nat.le_succ _⟩ · rw [mul_one_div, le_div_iff₀ hp]; exact_mod_cast h1 · rw [mul_one_div, div_le_iff₀ hp]; push_cast; exact_mod_cast h3.le def lim17 : Nat := 17 * 2 ^ 56 /-- An enclosure of `e^(−c)` for `c = m · 2^e`, when `c < 17`. -/ @[inline] def expNeg (m : Nat) (e : Int) : Option (Nat × Nat) := let c := scaled m e if lim17 ≤ c.2 then none else let q := c.1 >>> 50 let rl := (c.1 - (q <<< 50)) <<< 6 let rh := (c.2 - (q <<< 50)) <<< 6 if one < rh then none else let P := expSmall rl rh let F := fracTab[q % 64]! let I := intTab[q >>> 6]! let IF := (mulDn I.1 F.1, min one (mulUp I.2 F.2)) some (mulDn IF.1 P.1, min one (mulUp IF.2 P.2)) theorem expNeg_spec {m : Nat} {e : Int} {iv : Nat × Nat} (h : expNeg m e = some iv) : Encl iv (m * (2 : ℝ) ^ e) := by unfold expNeg at h simp only [Nat.shiftRight_eq_div_pow, Nat.shiftLeft_eq] at h obtain ⟨hlo, hhi, hle⟩ := scaled_spec m e generalize (scaled m e).1 = cl at * generalize (scaled m e).2 = ch at * split at h · exact absurd h (by simp) rename_i hlim split at h · exact absurd h (by simp) rename_i hrh simp only [Option.some.injEq] at h subst h set q := cl / 2 ^ 50 have hq : q * 2 ^ 50 ≤ cl := Nat.div_mul_le_self cl _ have hqd : q = q / 2 ^ 6 * 64 + q % 64 := by have := Nat.div_add_mod q 64; omega have hn : q / 2 ^ 6 < 17 := by unfold lim17 at hlim; omega have hj : q % 64 < 64 := Nat.mod_lt _ (by norm_num) set C := (m : ℝ) * (2 : ℝ) ^ e set r := C - (q / 2 ^ 6 : Nat) - (q % 64 : Nat) * (1 / 64 : ℝ) have hr : C = (q / 2 ^ 6 : Nat) + (q % 64 : Nat) * (1 / 64 : ℝ) + r := by ring have hqr : ((q : Nat) : ℝ) * 2 ^ 50 = ((q / 2 ^ 6 : Nat) : ℝ) * 2 ^ 56 + ((q % 64 : Nat) : ℝ) * 2 ^ 50 := by have : ((q : Nat) : ℝ) = ((q / 2 ^ 6 * 64 + q % 64 : Nat) : ℝ) := by rw [← hqd] rw [this]; push_cast; ring have hrl : V ((cl - q * 2 ^ 50) * 2 ^ 6) ≤ r := by unfold V; rw [Nat.cast_mul, Nat.cast_sub hq]; push_cast rw [div_le_iff₀ (by positivity)] simp only [r]; nlinarith [hqr] have hrh' : r ≤ V ((ch - q * 2 ^ 50) * 2 ^ 6) := by unfold V; rw [Nat.cast_mul, Nat.cast_sub (hq.trans hle)]; push_cast rw [le_div_iff₀ (by positivity)] simp only [r]; nlinarith [hqr] have hP := expSmall_spec hrl hrh' (by omega) have hI := intTab_spec hn have hF := fracTab_spec hj rw [hr] exact (hI.mul hF).mul hP /-! ## Quotients: a guess, checked exactly -/ def two62f : Float := 4611686018427387904.0 /-- `q · d ≤ num · 2^62` by 128-bit comparison (for `q, d < 2^64`). -/ @[inline] def mulLe (q d num : Nat) : Bool := let h := (mulHiW q.toUInt64 d.toUInt64).toNat let nh := num >>> 2 h < nh || (h == nh && mulLoW q.toUInt64 d.toUInt64 ≤ (num % 4).toUInt64 <<< 62) /-- `num · 2^62 ≤ q · d`. -/ @[inline] def mulGe (q d num : Nat) : Bool := let h := (mulHiW q.toUInt64 d.toUInt64).toNat let nh := num >>> 2 nh < h || (h == nh && (num % 4).toUInt64 <<< 62 ≤ mulLoW q.toUInt64 d.toUInt64) theorem num_split (num : Nat) : ((num % 4).toUInt64 <<< 62).toNat = num % 4 * 2 ^ 62 := by have h4 : num % 4 < 4 := Nat.mod_lt _ (by norm_num) rw [UInt64.toNat_shiftLeft, toNat_toUInt64_of_lt (by omega)] have : (62 : UInt64).toNat % 64 = 62 := by decide rw [this, Nat.shiftLeft_eq, Nat.mod_eq_of_lt (by omega)] theorem mulLe_spec {q d num : Nat} (hq : q < 2 ^ 64) (hd : d < 2 ^ 64) (h : mulLe q d num = true) : q * d ≤ num * 2 ^ 62 := by have hs := halves hq hd unfold mulLe at h simp only [Nat.shiftRight_eq_div_pow, Bool.or_eq_true, decide_eq_true_eq, Bool.and_eq_true, beq_iff_eq, UInt64.le_iff_toNat_le, num_split] at h have hl := (mulLoW q.toUInt64 d.toUInt64).toNat_lt generalize (mulHiW q.toUInt64 d.toUInt64).toNat = a at * generalize (mulLoW q.toUInt64 d.toUInt64).toNat = b at * omega theorem mulGe_spec {q d num : Nat} (hq : q < 2 ^ 64) (hd : d < 2 ^ 64) (h : mulGe q d num = true) : num * 2 ^ 62 ≤ q * d := by have hs := halves hq hd unfold mulGe at h simp only [Nat.shiftRight_eq_div_pow, Bool.or_eq_true, decide_eq_true_eq, Bool.and_eq_true, beq_iff_eq, UInt64.le_iff_toNat_le, num_split] at h have hl := (mulLoW q.toUInt64 d.toUInt64).toNat_lt generalize (mulHiW q.toUInt64 d.toUInt64).toNat = a at * generalize (mulLoW q.toUInt64 d.toUInt64).toNat = b at * omega /-- A guess for `num · 2^62 / den` (untrusted; only the checks below matter). -/ @[inline] def guess (num den : Nat) : Nat := ((num.toUInt64.toFloat * two62f) / den.toUInt64.toFloat).toUInt64.toNat /-- `2^64`, computed once. -/ def lim64 : Nat := 2 ^ 64 /-- `q` with `V q · V den ≤ V num`. -/ @[inline] def divLo (num den : Nat) : Option Nat := let g := guess num den let q := g - ((g >>> 50) + 2) if q < lim64 && den < lim64 && mulLe q den num then some q else none /-- `q` with `V num ≤ V q · V den`. -/ @[inline] def divHi (num den : Nat) : Option Nat := let g := guess num den let q := g + ((g >>> 50) + 2) if q < lim64 && den < lim64 && mulGe q den num then some q else none theorem V_mul_iff (a b c : Nat) : V a * V b ≤ V c ↔ a * b ≤ c * 2 ^ 62 := by unfold V rw [div_mul_div_comm, div_le_div_iff₀ (by positivity) (by positivity)] constructor · intro h have : ((a * b : Nat) : ℝ) * 2 ^ 62 ≤ ((c * 2 ^ 62 : Nat) : ℝ) * 2 ^ 62 := by push_cast; nlinarith exact_mod_cast le_of_mul_le_mul_right this (by positivity) · intro h have : ((a * b : Nat) : ℝ) ≤ ((c * 2 ^ 62 : Nat) : ℝ) := by exact_mod_cast h push_cast at this; nlinarith theorem divLo_spec {num den q : Nat} (h : divLo num den = some q) : V q * V den ≤ V num := by unfold divLo at h dsimp only at h generalize guess num den = g at h split at h · rename_i hc simp only [Bool.and_eq_true, decide_eq_true_eq] at hc simp only [Option.some.injEq] at h; subst h exact (V_mul_iff _ _ _).mpr (mulLe_spec hc.1.1 hc.1.2 hc.2) · simp at h theorem divHi_spec {num den q : Nat} (h : divHi num den = some q) : V num ≤ V q * V den := by unfold divHi at h dsimp only at h generalize guess num den = g at h split at h · rename_i hc simp only [Bool.and_eq_true, decide_eq_true_eq] at hc simp only [Option.some.injEq] at h; subst h have h2 := mulGe_spec hc.1.1 hc.1.2 hc.2 unfold V rw [div_mul_div_comm, div_le_div_iff₀ (by positivity) (by positivity)] have : ((num * 2 ^ 62 : Nat) : ℝ) ≤ (((g + (g >>> 50 + 2)) * den : Nat) : ℝ) := by exact_mod_cast h2 push_cast at this ⊢; nlinarith · simp at h /-! ## Rounding both ends, and the bridge to the specs -/ open ExactRuntime FloatLib.Floats.Formats.BinaryInterchange FloatLib.Floats FloatLib.Numerics open ExactRuntime.FastRound /-- The word both ends of `[lo, hi] · 2^(−62)` round to, when they agree on a finite nonzero word, through FloatLib's rounding (the reference for `settle`). -/ def settleInt (lo hi : Int) : Option UInt32 := let a := finishWord lo (-62) false if lo ≠ 0 && hi ≠ 0 && a == finishWord hi (-62) false && expOf a != 255 && (decodeD a).significand != 0 then some a else none @[inline] def settle (neg : Bool) (a b : Nat) : Option UInt32 := let w := roundW neg a (-62) if a ≠ 0 && b ≠ 0 && w == roundW neg b (-62) && expOf w != 255 && (decodeD w).significand != 0 then some w else none theorem settle_eq (neg : Bool) (a b : Nat) : settle neg a b = settleInt (if neg then -(b : Int) else a) (if neg then -(a : Int) else b) := by unfold settle settleInt by_cases ha : a = 0 · subst ha; cases neg <;> simp by_cases hb : b = 0 · subst hb; cases neg <;> simp rw [roundW_signed neg a _ ha, roundW_signed neg b _ hb] cases neg · simp · simp only [ite_true] by_cases he : finishWord (-(a : Int)) (-62) false = finishWord (-(b : Int)) (-62) false · simp [ha, hb, he] · have he' : ¬ finishWord (-(b : Int)) (-62) false = finishWord (-(a : Int)) (-62) false := fun h => he h.symm simp [ha, hb, he, he'] /-- A finite word rounding `S · 2^e` has that rounding as its value. -/ theorem settleInt_spec {lo hi : Int} {a : UInt32} (h : settleInt lo hi = some a) {v : ℝ} (hl : (lo : ℝ) * 2 ^ (-62 : Int) ≤ v) (hh : v ≤ (hi : ℝ) * 2 ^ (-62 : Int)) {z : Model Fmt} (hz : Model.toReal z = Model.roundAt Fmt v) : toWord z = a := by unfold settleInt at h dsimp only at h split at h · rename_i hc simp only [Option.some.injEq] at h subst h simp only [Bool.and_eq_true, bne_iff_ne, ne_eq, decide_eq_true_eq, beq_iff_eq] at hc obtain ⟨⟨⟨⟨hlo, hhi⟩, heq⟩, hfin⟩, hsig⟩ := hc exact bracket_spec hlo hhi rfl heq.symm hfin hsig hl hh hz · simp at h theorem int_scale (n : Nat) : ((n : Int) : ℝ) * 2 ^ (-62 : Int) = V n := by unfold V; push_cast; rw [zpow_neg, zpow_ofNat]; ring /-- The value of a finite word: `±m · 2^e` from `decodeD`. -/ theorem toReal_ofW_decode {w : UInt32} (hfin : expOf w ≠ 255) : Model.toReal (ofW w) = (if (decodeD w).negative then -1 else 1) * ((decodeD w).significand * (2 : ℝ) ^ (decodeD w).exponent) := by rw [Model.toReal_eq, ofW, toDyadic_ofUInt32 _ hfin] simp only [FloatLib.Numerics.Dyadic.toReal, FloatLib.Numerics.Dyadic.cast_signedSignificand] ring /-! ### Sigmoid -/ theorem realSigmoid_neg_eq (C : ℝ) : realSigmoid (-C) = Real.exp (-C) / (1 + Real.exp (-C)) := by unfold realSigmoid rw [neg_neg] have hp := Real.exp_pos (-C) have h : Real.exp C = 1 / Real.exp (-C) := by rw [Real.exp_neg, one_div, inv_inv] rw [h]; field_simp; ring /-- Fast path for the correctly rounded sigmoid; `none` when it doesn't settle. -/ def sigmoidFast (w : UInt32) : Option UInt32 := if expOf w = 255 then none else let d := decodeD w match expNeg d.significand d.exponent with | none => none | some t => if d.negative then -- σ(−c) = t / (1 + t), increasing in t match divLo t.1 (one + t.1), divHi t.2 (one + t.2) with | some ql, some qh => settle false ql qh | _, _ => none else -- σ(c) = 1 / (1 + t), decreasing in t match divLo one (one + t.2), divHi one (one + t.1) with | some ql, some qh => settle false ql qh | _, _ => none theorem sigmoidFast_spec {w a : UInt32} (h : sigmoidFast w = some a) : sigmoidCR w = a := by unfold sigmoidFast at h split at h · simp at h rename_i hfin dsimp only at h have hx := toReal_ofW_decode hfin generalize decodeD w = d at h hx have hspec := (toReal_sigmoidModel (fmt := Fmt) (by decide) (input := Model.ofUInt32 w) (by simp [isFinite_ofUInt32, hfin])).2 change Model.toReal (sigmoidModel (ofW w)) = Model.roundAt Fmt (realSigmoid (Model.toReal (ofW w))) at hspec rw [hx] at hspec change toWord (sigmoidModel (ofW w)) = a split at h · simp at h rename_i t ht have hE := expNeg_spec ht set C := (d.significand : ℝ) * (2 : ℝ) ^ d.exponent set T := Real.exp (-C) have hT : 0 < T := Real.exp_pos _ obtain ⟨h1, h2, h3⟩ := hE have v1 := V_nonneg t.1 have v2 := V_nonneg t.2 split at h · rename_i hneg split at h · rename_i ql qh hql hqh have bl := divLo_spec hql have bh := divHi_spec hqh rw [V_add, V_one] at bl bh rw [settle_eq] at h simp only [Bool.false_eq_true, ite_false] at h refine settleInt_spec h (v := realSigmoid (-C)) ?_ ?_ (by rw [hspec, hneg]; simp) · rw [int_scale] have : realSigmoid (-C) = T / (1 + T) := realSigmoid_neg_eq C rw [this, le_div_iff₀ (by linarith)] nlinarith · rw [int_scale] have : realSigmoid (-C) = T / (1 + T) := realSigmoid_neg_eq C rw [this, div_le_iff₀ (by linarith)] nlinarith · simp at h · rename_i hneg split at h · rename_i ql qh hql hqh have bl := divLo_spec hql have bh := divHi_spec hqh rw [V_add, V_one] at bl bh have hs : realSigmoid C = 1 / (1 + T) := rfl rw [settle_eq] at h simp only [Bool.false_eq_true, ite_false] at h refine settleInt_spec h (v := realSigmoid C) ?_ ?_ (by rw [hspec]; simp [hneg]) · rw [int_scale, hs, le_div_iff₀ (by linarith)] nlinarith · rw [int_scale, hs, div_le_iff₀ (by linarith)] nlinarith · simp at h /-- `sigmoid`, fast where it settles and the spec elsewhere. -/ def sigmoidF (w : UInt32) : UInt32 := (sigmoidFast w).getD (sigmoidCR w) theorem sigmoidF_eq : sigmoidF = sigmoidCR := by funext w unfold sigmoidF cases h : sigmoidFast w with | none => rfl | some a => exact (sigmoidFast_spec h).symm /-! ### Tanh -/ /-- Fast path for the correctly rounded `tanh`: `tanh |x| = (1 − t)/(1 + t)`, `t = e^(−2|x|)`. -/ def tanhFast (w : UInt32) : Option UInt32 := if expOf w = 255 then none else let d := decodeD w match expNeg d.significand (d.exponent + 1) with | none => none | some t => if one < t.1 then none else match divLo (one - t.2) (one + t.2), divHi (one - t.1) (one + t.1) with | some ql, some qh => settle d.negative ql qh | _, _ => none theorem neg_int_scale (n : Nat) : ((-(n : Int) : Int) : ℝ) * 2 ^ (-62 : Int) = -V n := by rw [Int.cast_neg, neg_mul, int_scale] theorem tanhFast_spec {w a : UInt32} (h : tanhFast w = some a) : tanhCR w = a := by unfold tanhFast at h split at h · simp at h rename_i hfin dsimp only at h have hx := toReal_ofW_decode hfin generalize decodeD w = d at h hx have hspec := (toReal_tanhModel (fmt := Fmt) (by decide) (input := Model.ofUInt32 w) (by simp [isFinite_ofUInt32, hfin])).2 change Model.toReal (tanhModel (ofW w)) = Model.roundAt Fmt (Real.tanh (Model.toReal (ofW w))) at hspec rw [hx] at hspec change toWord (tanhModel (ofW w)) = a split at h · simp at h rename_i t ht have hE := expNeg_spec ht set C := (d.significand : ℝ) * (2 : ℝ) ^ d.exponent have h2C : (d.significand : ℝ) * (2 : ℝ) ^ (d.exponent + 1) = 2 * C := by rw [zpow_add₀ two_ne_zero]; simp only [C]; ring rw [h2C] at hE set T := Real.exp (-(2 * C)) have hT : 0 < T := Real.exp_pos _ have htanh : Real.tanh C = (1 - T) / (1 + T) := by rw [tanh_eq_exp_neg_two]; simp only [T]; ring_nf obtain ⟨h1, h2, h3⟩ := hE have v1 := V_nonneg t.1 have v2 := V_nonneg t.2 split at h · simp at h rename_i ht1 replace ht1 := not_lt.mp ht1 split at h · rename_i ql qh hql hqh have bl := divLo_spec hql have bh := divHi_spec hqh rw [V_add, V_one, V_sub_le_of_le h3, V_one] at bl rw [V_add, V_one, V_sub_le_of_le ht1, V_one] at bh have lo : V ql ≤ Real.tanh C := by rw [htanh, le_div_iff₀ (by linarith)]; nlinarith have hi : Real.tanh C ≤ V qh := by rw [htanh, div_le_iff₀ (by linarith)]; nlinarith rw [settle_eq] at h cases hneg : d.negative <;> simp only [hneg, ite_true, Bool.false_eq_true, ite_false] at h · refine settleInt_spec h (v := Real.tanh C) ?_ ?_ (by rw [hspec]; simp [hneg]) · rw [int_scale]; exact lo · rw [int_scale]; exact hi · refine settleInt_spec h (v := Real.tanh (-C)) ?_ ?_ (by rw [hspec, hneg]; simp) · rw [neg_int_scale, Real.tanh_neg]; linarith · rw [neg_int_scale, Real.tanh_neg]; linarith · simp at h /-- `tanh`, fast where it settles and the spec elsewhere. -/ def tanhF (w : UInt32) : UInt32 := (tanhFast w).getD (tanhCR w) theorem tanhF_eq : tanhF = tanhCR := by funext w unfold tanhF cases h : tanhFast w with | none => rfl | some a => exact (tanhFast_spec h).symm /-! ### Exp, for softmax's arguments (`x ≤ 0`) -/ /-- Fast path for the correctly rounded `exp` at `x ≤ 0`: `e^x = e^(−|x|)`, enclosed by `expNeg`. -/ def expFast (w : UInt32) : Option UInt32 := if expOf w = 255 then none else let d := decodeD w if !d.negative && d.significand != 0 then none else match expNeg d.significand d.exponent with | none => none | some t => settle false t.1 t.2 theorem expFast_spec {w a : UInt32} (h : expFast w = some a) : expW w = a := by unfold expFast at h split at h · simp at h rename_i hfin dsimp only at h have hx := toReal_ofW_decode hfin generalize hd : decodeD w = d at h hx split at h · simp at h rename_i hsign simp only [Bool.and_eq_true, Bool.not_eq_true', bne_iff_ne, ne_eq, not_and, not_not] at hsign split at h · simp at h rename_i t ht obtain ⟨h1, h2, -⟩ := expNeg_spec ht set C := (d.significand : ℝ) * (2 : ℝ) ^ d.exponent -- the input is `−C` have hxC : Model.toReal (ofW w) = -C := by rw [hx] by_cases hneg : d.negative = true · simp [hneg] · have hz : d.significand = 0 := hsign (by simpa using hneg) simp [C, hz] have hfinw : Model.isFinite (ofW w) = true := by simp [ofW, isFinite_ofUInt32, hfin] have hrange : Real.exp (Model.toReal (ofW w)) < (Model.Transcendentals.Certified.overflowThreshold Fmt : ℝ) := by have hC : 0 ≤ C := by simp only [C]; positivity have : Real.exp (-C) ≤ 1 := Real.exp_le_one_iff.mpr (by linarith) rw [hxC] exact lt_of_le_of_lt this (Model.Transcendentals.CorrectlyRounded.one_lt_overflowThreshold (by decide)) have hspec := Model.Transcendentals.CorrectlyRounded.toReal_exp_eq_roundAt (fmt := Fmt) (by decide) hfinw hrange (budget := {}) rw [hxC] at hspec rw [settle_eq] at h simp only [Bool.false_eq_true, ite_false] at h exact settleInt_spec h (v := Real.exp (-C)) (by rw [int_scale]; exact h1) (by rw [int_scale]; exact h2) hspec /-- `exp`, fast at `x ≤ 0` where it settles and the spec elsewhere. -/ def expF (w : UInt32) : UInt32 := (expFast w).getD (expW w) theorem expF_eq : expF = expW := by funext w unfold expF cases h : expFast w with | none => rfl | some a => exact (expFast_spec h).symm end FastAct namespace FastAct2 section open FastAct ExactRuntime theorem mulDnW_toNat (a b : UInt64) : (mulDnW a b).toNat = mulDn a.toNat b.toNat := by simp [mulDn] theorem mulUpW_toNat (a b : UInt64) : (mulUpW a b).toNat = mulUp a.toNat b.toNat := by simp [mulUp] theorem mulHiW_spec (a b : UInt64) : (mulHiW a b).toNat * 2 ^ 64 ≤ a.toNat * b.toNat ∧ a.toNat * b.toNat < ((mulHiW a b).toNat + 1) * 2 ^ 64 := by have h := mul128_spec a b simp only [mul128] at h have := (mulLoW a b).toNat_lt omega /-- Degree-3 Taylor sum of `e^(−r)` with its remainder (`Real.exp_bound`, `n = 4`). -/ theorem exp_neg_taylor3 {r : ℝ} (h0 : 0 ≤ r) (h1 : r ≤ 1) : |Real.exp (-r) - (1 - r + r ^ 2 / 2 - r ^ 3 / 6)| ≤ r ^ 4 * (5 / 96) := by have h := Real.exp_bound (x := -r) (by rw [abs_neg, abs_of_nonneg h0]; exact h1) (n := 4) (by norm_num) simp only [Finset.sum_range_succ, Finset.sum_range_zero, Nat.factorial] at h rw [abs_neg, abs_of_nonneg h0] at h convert h using 2 · norm_num; ring · norm_num end section open FastAct ExactRuntime def oneU : UInt64 := 4611686018427387904 theorem oneU_toNat : oneU.toNat = one := by decide theorem add_toNat {a b : UInt64} {x y : Nat} (ha : a.toNat = x) (hb : b.toNat = y) (h : x + y < 2 ^ 64) : (a + b).toNat = x + y := by rw [UInt64.toNat_add, ha, hb]; exact Nat.mod_eq_of_lt h theorem mul_toNat {a b : UInt64} {x y : Nat} (ha : a.toNat = x) (hb : b.toNat = y) (h : x * y < 2 ^ 64) : (a * b).toNat = x * y := by rw [UInt64.toNat_mul, ha, hb]; exact Nat.mod_eq_of_lt h theorem sub_toNat {a b : UInt64} {x y : Nat} (ha : a.toNat = x) (hb : b.toNat = y) (h : y ≤ x) : (a - b).toNat = x - y := by rw [UInt64.toNat_sub_of_le _ _ (by rw [UInt64.le_iff_toNat_le, ha, hb]; exact h), ha, hb] theorem div_toNat {a b : UInt64} {x y : Nat} (ha : a.toNat = x) (hb : b.toNat = y) : (a / b).toNat = x / y := by rw [UInt64.toNat_div, ha, hb] theorem le_of_V_le {a b : Nat} (h : V a ≤ V b) : a ≤ b := by unfold V at h rw [div_le_div_iff₀ (by positivity) (by positivity)] at h have h2 : (a : ℝ) ≤ (b : ℝ) := le_of_mul_le_mul_right h (by positivity) exact_mod_cast h2 theorem V_two_mul (n : Nat) : V (2 * n) = 2 * V n := by unfold V; push_cast; ring /-- Capping an upper bound at `1`. -/ theorem cap_spec (a : UInt64) {x : ℝ} (hx : x ≤ V a.toNat) (hx1 : x ≤ 1) : x ≤ V (if oneU < a then oneU else a).toNat ∧ (if oneU < a then oneU else a).toNat ≤ one := by by_cases h : oneU < a · rw [ite_eq_left h, oneU_toNat, V_one]; exact ⟨hx1, le_refl _⟩ · rw [ite_eq_right h] rw [UInt64.lt_iff_toNat_lt, oneU_toNat] at h exact ⟨hx, by omega⟩ end section open FastAct ExactRuntime def tabN : Nat := 20480 def tabW : Nat := 16384 def base10 : Nat × Nat := expSmall 4503599627370496 4503599627370496 theorem base10_spec : Encl base10 (1 / 1024) := by have h : V 4503599627370496 = 1 / 1024 := by norm_num [V] exact expSmall_spec (rl := 4503599627370496) (rh := 4503599627370496) (r := 1 / 1024) h.le h.ge (by norm_num [one]) def tabGo : Nat → Nat × Nat → Array Nat → Array Nat | 0, _, acc => acc | n + 1, p, acc => tabGo n (mulDn p.1 base10.1, min one (mulUp p.2 base10.2)) (acc.push (if p.2 ≤ p.1 + tabW then p.1 else 0)) /-- A stored entry: `0`, or a lower end whose `tabW`-wide interval encloses `e^(−j/1024)`. -/ def Good (x j : Nat) : Prop := x ≠ 0 → V x ≤ Real.exp (-((j : ℝ) * (1 / 1024))) ∧ Real.exp (-((j : ℝ) * (1 / 1024))) ≤ V (x + tabW) theorem tabGo_spec : ∀ (n : Nat) (p : Nat × Nat) (acc : Array Nat), Encl p ((acc.size : ℝ) * (1 / 1024)) → (∀ j, j < acc.size → Good acc[j]! j) → ∀ j, j < (tabGo n p acc).size → Good (tabGo n p acc)[j]! j | 0, _, _, _, h => h | n + 1, p, acc, hp, h => by rw [tabGo] refine tabGo_spec n _ _ ?_ ?_ · rw [Array.size_push] have := hp.mul base10_spec convert this using 2 push_cast; ring · intro j hj rw [Array.size_push] at hj rw [getElem!_pos _ _ (by rw [Array.size_push]; exact hj), Array.getElem_push] split · rename_i hlt have := h j hlt rwa [getElem!_pos acc j hlt] at this · rename_i hge have hj' : j = acc.size := by omega subst hj' by_cases hw : p.2 ≤ p.1 + tabW · rw [ite_eq_left hw]; intro _ exact ⟨hp.1, hp.2.1.trans (V_mono hw)⟩ · rw [ite_eq_right hw]; intro hne; exact absurd rfl hne def tab : Array Nat := tabGo tabN (one, one) (Array.mkEmpty tabN) theorem tab_spec (j : Nat) (h0 : tab[j]! ≠ 0) : V tab[j]! ≤ Real.exp (-((j : ℝ) * (1 / 1024))) ∧ Real.exp (-((j : ℝ) * (1 / 1024))) ≤ V (tab[j]! + tabW) := by by_cases hj : j < tab.size · refine tabGo_spec tabN (one, one) (Array.mkEmpty tabN) ?_ ?_ j hj h0 · refine ⟨?_, ?_, le_rfl⟩ <;> simp [V_one] · intro j hj; simp at hj · exact absurd (getElem!_neg tab j hj) h0 end section open FastAct ExactRuntime FloatLib.Floats.Formats.BinaryInterchange FloatLib.Floats FloatLib.Numerics open ExactRuntime.FastRound /-- The value of a normal word from its fields. -/ theorem toReal_normal {w : UInt32} (h0 : expOf w ≠ 0) (h255 : expOf w ≠ 255) : Model.toReal (ofW w) = (if signOf w then -1 else 1) * (((2 ^ 23 + (fracOf w).toNat : Nat) : ℝ) * (2 : ℝ) ^ (((expOf w).toNat : Int) - 150)) := by rw [toReal_ofW_decode h255] simp [decodeD, h0] theorem scale_pow (m E k : Nat) (hE : 150 - k ≤ E) (hk : k ≤ 150) : (m : ℝ) * (2 : ℝ) ^ ((E : Int) - 150) = ((m * 2 ^ (E - (150 - k)) : Nat) : ℝ) / 2 ^ k := by have : ((E : Int) - 150) = ((E - (150 - k) : Nat) : Int) - (k : Nat) := by omega rw [this, zpow_sub₀ two_ne_zero, zpow_natCast, zpow_natCast] push_cast; ring /-- An enclosure of `σ(x)` on the grid that settles gives the correctly rounded word. -/ theorem sigmoid_of_encl {w a : UInt32} (hfin : expOf w ≠ 255) {lo hi : Nat} (hl : V lo ≤ realSigmoid (Model.toReal (ofW w))) (hh : realSigmoid (Model.toReal (ofW w)) ≤ V hi) (h : settle false lo hi = some a) : sigmoidCR w = a := by have hspec := (toReal_sigmoidModel (fmt := Fmt) (by decide) (input := Model.ofUInt32 w) (by simp [isFinite_ofUInt32, hfin])).2 change Model.toReal (sigmoidModel (ofW w)) = Model.roundAt Fmt (realSigmoid (Model.toReal (ofW w))) at hspec change toWord (sigmoidModel (ofW w)) = a rw [settle_eq] at h simp only [Bool.false_eq_true, ite_false] at h exact settleInt_spec h (v := realSigmoid (Model.toReal (ofW w))) (by rw [int_scale]; exact hl) (by rw [int_scale]; exact hh) hspec /-- An enclosure of `tanh x` (mirrored for negative `x`) that settles gives the word. -/ theorem tanh_of_encl {w a : UInt32} (hfin : expOf w ≠ 255) {lo hi : Nat} {neg : Bool} (hl : (if neg then -V hi else V lo) ≤ Real.tanh (Model.toReal (ofW w))) (hh : Real.tanh (Model.toReal (ofW w)) ≤ (if neg then -V lo else V hi)) (h : settle neg lo hi = some a) : tanhCR w = a := by have hspec := (toReal_tanhModel (fmt := Fmt) (by decide) (input := Model.ofUInt32 w) (by simp [isFinite_ofUInt32, hfin])).2 change Model.toReal (tanhModel (ofW w)) = Model.roundAt Fmt (Real.tanh (Model.toReal (ofW w))) at hspec change toWord (tanhModel (ofW w)) = a rw [settle_eq] at h cases neg <;> simp only [ite_true, Bool.false_eq_true, ite_false] at h hl hh · exact settleInt_spec h (v := Real.tanh (Model.toReal (ofW w))) (by rw [int_scale]; exact hl) (by rw [int_scale]; exact hh) hspec · exact settleInt_spec h (v := Real.tanh (Model.toReal (ofW w))) (by rw [neg_int_scale]; exact hl) (by rw [neg_int_scale]; exact hh) hspec end section open FastAct ExactRuntime FloatLib.Floats.Formats.BinaryInterchange FloatLib.Floats FloatLib.Numerics open ExactRuntime.FastRound /-- The rounded significand of a normalised value stays in `[2^23, 2^24]`. -/ theorem rse_bounds (m : Nat) (h : 2 ^ 24 ≤ m) : 2 ^ 23 ≤ roundShiftRightEven m (m.log2 - 23) ∧ roundShiftRightEven m (m.log2 - 23) ≤ 2 ^ 24 := by have hm : m ≠ 0 := by omega have hL : 24 ≤ m.log2 := (Nat.le_log2 hm).2 h have h1 := Nat.log2_self_le hm have h2 := @Nat.lt_log2_self m have hs : 0 < m.log2 - 23 := by omega rw [roundShiftRightEven_eq_guard_sticky m _ hs] have hp : 2 ^ m.log2 = 2 ^ 23 * 2 ^ (m.log2 - 23) := by rw [← pow_add]; congr 1; omega have hp1 : 2 ^ (m.log2 + 1) = 2 ^ 24 * 2 ^ (m.log2 - 23) := by rw [← pow_add]; congr 1; omega have hpos : 0 < 2 ^ (m.log2 - 23) := Nat.two_pow_pos _ have q1 : 2 ^ 23 ≤ m / 2 ^ (m.log2 - 23) := (Nat.le_div_iff_mul_le hpos).2 (by rw [← hp]; exact h1) have q2 : m / 2 ^ (m.log2 - 23) < 2 ^ 24 := (Nat.div_lt_iff_lt_mul hpos).2 (by rw [← hp1]; exact h2) split <;> omega /-- `roundW` on `[2^24, 2^63) · 2^(−62)`: always the bit-operation branch. -/ theorem roundW_normal (neg : Bool) (m : Nat) (h1 : 2 ^ 24 ≤ m) (h2 : m < 2 ^ 63) : roundW neg m (-62) = (if neg then (0x80000000 : UInt32) else 0) + ((if roundShiftRightEven m (m.log2 - 23) = 2 ^ 24 then ((m.log2 : Int) + -62 + 128).toNat else ((m.log2 : Int) + -62 + 127).toNat).toUInt32 <<< 23) + (if roundShiftRightEven m (m.log2 - 23) = 2 ^ 24 then 0 else roundShiftRightEven m (m.log2 - 23) - 2 ^ 23).toUInt32 := by have hm : m ≠ 0 := by omega have hL : 24 ≤ m.log2 := (Nat.le_log2 hm).2 h1 have hL2 : m.log2 < 63 := (Nat.log2_lt hm).2 h2 obtain ⟨r1, r2⟩ := rse_bounds m h1 have hc : 23 ≤ m.log2 ∧ -126 ≤ (m.log2 : Int) + -62 ∧ (m.log2 : Int) + -62 ≤ 126 ∧ p23 ≤ roundShiftRightEven m (m.log2 - 23) ∧ roundShiftRightEven m (m.log2 - 23) ≤ p24 := ⟨by omega, by omega, by omega, r1, r2⟩ unfold roundW dsimp only split · rfl · rename_i hn; exact absurd hc hn /-- A word assembled from an exponent field and a fraction. -/ theorem asm_toNat (E F : Nat) (hE : E < 256) (hF : F < 2 ^ 23) : ((E.toUInt32 <<< 23) + F.toUInt32).toNat = E * 2 ^ 23 + F := by have h23 : (23 : UInt32).toNat % 32 = 23 := by decide simp only [UInt32.toNat_add, UInt32.toNat_shiftLeft, Nat.toUInt32, UInt32.toNat_ofNat', h23, Nat.shiftLeft_eq] omega /-- Round `a · 2^(−62)` to a positive binary32 word by word operations (`2^24 ≤ a < 2^63`). -/ @[inline] def rndU (a : UInt64) : UInt32 := ((a.log2 + 65).toUInt32 <<< 23) + (FloatLib.Numerics.FixedWord.roundShiftRightEven a (a.log2.toNat - 23) - 8388608).toUInt32 theorem rndU_toNat (a : UInt64) (h1 : 2 ^ 24 ≤ a.toNat) (h2 : a.toNat < 2 ^ 63) : (rndU a).toNat = (a.toNat.log2 + 65) * 2 ^ 23 + (roundShiftRightEven a.toNat (a.toNat.log2 - 23) - 2 ^ 23) := by have hm : a.toNat ≠ 0 := by omega have hL : 24 ≤ a.toNat.log2 := (Nat.le_log2 hm).2 h1 have hL2 : a.toNat.log2 < 63 := (Nat.log2_lt hm).2 h2 obtain ⟨r1, r2⟩ := rse_bounds a.toNat h1 have hr : (FloatLib.Numerics.FixedWord.roundShiftRightEven a (a.log2.toNat - 23)).toNat = roundShiftRightEven a.toNat (a.toNat.log2 - 23) := by rw [FloatLib.Numerics.FixedWord.roundShiftRightEven_toNat, FloatLib.Numerics.FixedWord.log2_toNat] have c1 : (65 : UInt64).toNat = 65 := by decide have c2 : (8388608 : UInt64).toNat = 2 ^ 23 := by decide have c3 : (23 : UInt32).toNat % 32 = 23 := by decide have hs : (FloatLib.Numerics.FixedWord.roundShiftRightEven a (a.log2.toNat - 23) - 8388608).toNat = roundShiftRightEven a.toNat (a.toNat.log2 - 23) - 2 ^ 23 := by rw [UInt64.toNat_sub_of_le _ _ (by rw [UInt64.le_iff_toNat_le, hr, c2]; exact r1), hr, c2] have hl : (a.log2 + 65).toNat = a.toNat.log2 + 65 := by rw [UInt64.toNat_add, FloatLib.Numerics.FixedWord.log2_toNat, c1]; omega unfold rndU rw [UInt32.toNat_add, UInt32.toNat_shiftLeft, UInt64.toNat_toUInt32, UInt64.toNat_toUInt32, hs, hl, c3, Nat.shiftLeft_eq] generalize roundShiftRightEven a.toNat (a.toNat.log2 - 23) = R at * generalize a.toNat.log2 = L at * omega theorem rndU_eq (neg : Bool) (a : UInt64) (h1 : 2 ^ 24 ≤ a.toNat) (h2 : a.toNat < 2 ^ 63) : (if neg then (0x80000000 : UInt32) else 0) + rndU a = roundW neg a.toNat (-62) := by have hm : a.toNat ≠ 0 := by omega have hL : 24 ≤ a.toNat.log2 := (Nat.le_log2 hm).2 h1 have hL2 : a.toNat.log2 < 63 := (Nat.log2_lt hm).2 h2 obtain ⟨r1, r2⟩ := rse_bounds a.toNat h1 have key : rndU a = ((if roundShiftRightEven a.toNat (a.toNat.log2 - 23) = 2 ^ 24 then ((a.toNat.log2 : Int) + -62 + 128).toNat else ((a.toNat.log2 : Int) + -62 + 127).toNat).toUInt32 <<< 23) + (if roundShiftRightEven a.toNat (a.toNat.log2 - 23) = 2 ^ 24 then 0 else roundShiftRightEven a.toNat (a.toNat.log2 - 23) - 2 ^ 23).toUInt32 := by apply UInt32.toNat_inj.mp rw [rndU_toNat a h1 h2, asm_toNat _ _ (by split <;> omega) (by split <;> omega)] split <;> omega rw [roundW_normal neg _ h1 h2, UInt32.add_assoc, key] /-- Both ends of `[lo, hi] · 2^(−62)` round to the same word (word operations). -/ @[inline] def settleU (neg : Bool) (lo hi : UInt64) : Option UInt32 := if 16777216 ≤ lo && lo < 9223372036854775808 && 16777216 ≤ hi && hi < 9223372036854775808 then let w := rndU lo if w == rndU hi then some ((if neg then (0x80000000 : UInt32) else 0) + w) else none else none theorem roundW_fields (neg : Bool) (m : Nat) (h1 : 2 ^ 24 ≤ m) (h2 : m < 2 ^ 63) : expOf (roundW neg m (-62)) ≠ 255 ∧ (decodeD (roundW neg m (-62))).significand ≠ 0 := by have hm : m ≠ 0 := by omega have hL : 24 ≤ m.log2 := (Nat.le_log2 hm).2 h1 have hL2 : m.log2 < 63 := (Nat.log2_lt hm).2 h2 obtain ⟨r1, r2⟩ := rse_bounds m h1 have hf := fields_of_word neg (if roundShiftRightEven m (m.log2 - 23) = 2 ^ 24 then ((m.log2 : Int) + -62 + 128).toNat else ((m.log2 : Int) + -62 + 127).toNat) (if roundShiftRightEven m (m.log2 - 23) = 2 ^ 24 then 0 else roundShiftRightEven m (m.log2 - 23) - 2 ^ 23) (by split <;> omega) (by split <;> omega) dsimp only at hf rw [← roundW_normal neg m h1 h2] at hf obtain ⟨-, he, -⟩ := hf have hE : (expOf (roundW neg m (-62))).toNat ≠ 255 ∧ (expOf (roundW neg m (-62))).toNat ≠ 0 := by rw [he]; constructor <;> (split <;> omega) generalize roundW neg m (-62) = w at hE obtain ⟨hE1, hE0⟩ := hE have n255 : expOf w ≠ 255 := fun h => hE1 (by rw [h]; rfl) have n0 : expOf w ≠ 0 := fun h => hE0 (by rw [h]; rfl) refine ⟨n255, ?_⟩ unfold decodeD rw [ite_eq_right n0] simp theorem settleU_spec {neg : Bool} {lo hi : UInt64} {a : UInt32} (h : settleU neg lo hi = some a) : settle neg lo.toNat hi.toNat = some a := by unfold settleU at h split at h · rename_i hc simp only [Bool.and_eq_true, decide_eq_true_eq, UInt64.le_iff_toNat_le, UInt64.lt_iff_toNat_lt, UInt64.reduceToNat] at hc obtain ⟨⟨⟨h1, h2⟩, h3⟩, h4⟩ := hc dsimp only at h split at h · rename_i he simp only [Option.some.injEq] at h have he' : rndU lo = rndU hi := by simpa using he have e1 := rndU_eq neg lo h1 h2 have e2 := rndU_eq neg hi h3 h4 rw [he'] at e1 obtain ⟨f1, f2⟩ := roundW_fields neg lo.toNat h1 h2 unfold settle dsimp only rw [← e1, ← e2] at * rw [← he', h] at * have ha : lo.toNat ≠ 0 := by omega have hb : hi.toNat ≠ 0 := by omega simp [ha, hb, f1, f2] · simp at h · simp at h end section open FastAct ExactRuntime /-- Number-level mirror of `expR`: an enclosure of `e^(−R / 2^59)` on the grid, `R < 2^49`. -/ def expRN (R : Nat) : Nat × Nat := (one - R * 8 + (R / 2 ^ 18) * (R / 2 ^ 18) / 2 ^ 21 - (((R / 2 ^ 18 + 1) * (R / 2 ^ 18 + 1) / 2 ^ 31 + 1) * (R / 2 ^ 18 + 1) / 2 ^ 30 / 6 + 1) - ((((R / 2 ^ 18 + 1) * (R / 2 ^ 18 + 1) / 2 ^ 31 + 1) * ((R / 2 ^ 18 + 1) * (R / 2 ^ 18 + 1) / 2 ^ 31 + 1)) / 2 ^ 40 / 19 + 1), one - R * 8 + ((R / 2 ^ 18 + 1) * (R / 2 ^ 18 + 1) / 2 ^ 21 + 1) - ((R / 2 ^ 18) * (R / 2 ^ 18) / 2 ^ 31 * (R / 2 ^ 18) / 2 ^ 30 / 6) + ((((R / 2 ^ 18 + 1) * (R / 2 ^ 18 + 1) / 2 ^ 31 + 1) * ((R / 2 ^ 18 + 1) * (R / 2 ^ 18 + 1) / 2 ^ 31 + 1)) / 2 ^ 40 / 19 + 1)) theorem lt_div_succ_mul (a k : Nat) (hk : 0 < k) : a < (a / k + 1) * k := by rw [Nat.add_mul, Nat.one_mul]; exact Nat.lt_div_mul_add hk theorem V_sub_le_max (a b : Nat) : V (a - b) ≤ max 0 (V a - V b) := by rcases le_total b a with h | h · rw [V_sub_le_of_le h]; exact le_max_right _ _ · rw [Nat.sub_eq_zero_of_le h]; simp [V] theorem expRN_spec (R : Nat) (hR : R < 2 ^ 49) : V (expRN R).1 ≤ Real.exp (-((R : ℝ) / 2 ^ 59)) ∧ Real.exp (-((R : ℝ) / 2 ^ 59)) ≤ V (expRN R).2 := by have hr0 : (0 : ℝ) ≤ (R : ℝ) / 2 ^ 59 := by positivity have hRr : (R : ℝ) < 2 ^ 49 := by exact_mod_cast hR have hr1 : (R : ℝ) / 2 ^ 59 ≤ 1 := by rw [div_le_one (by positivity)]; linarith [show (2 : ℝ) ^ 49 ≤ 2 ^ 59 by norm_num] have hT := abs_le.mp (exp_neg_taylor3 hr0 hr1) have hb : V (one - R * 8) = 1 - (R : ℝ) / 2 ^ 59 := by have h8 : R * 8 ≤ one := by unfold one; omega rw [V_sub_le_of_le h8, V_one] unfold V; push_cast; ring have hq1 : R / 2 ^ 18 * 2 ^ 18 ≤ R := Nat.div_mul_le_self _ _ have hq2 := lt_div_succ_mul R (2 ^ 18) (by positivity) generalize hρ : R / 2 ^ 18 = ρ at hq1 hq2 have hx : (ρ : ℝ) / 2 ^ 41 ≤ (R : ℝ) / 2 ^ 59 := by have hc : (ρ : ℝ) * 2 ^ 18 ≤ (R : ℝ) := by exact_mod_cast hq1 calc (ρ : ℝ) / 2 ^ 41 = (ρ : ℝ) * 2 ^ 18 / 2 ^ 59 := by ring _ ≤ (R : ℝ) / 2 ^ 59 := div_le_div_of_nonneg_right hc (by positivity) have hy : (R : ℝ) / 2 ^ 59 ≤ ((ρ : ℝ) + 1) / 2 ^ 41 := by have hc : (R : ℝ) ≤ ((ρ : ℝ) + 1) * 2 ^ 18 := by exact_mod_cast hq2.le calc (R : ℝ) / 2 ^ 59 ≤ ((ρ : ℝ) + 1) * 2 ^ 18 / 2 ^ 59 := div_le_div_of_nonneg_right hc (by positivity) _ = ((ρ : ℝ) + 1) / 2 ^ 41 := by ring have hx0 : (0 : ℝ) ≤ (ρ : ℝ) / 2 ^ 41 := by positivity generalize hr : (R : ℝ) / 2 ^ 59 = r at hr0 hr1 hT hb hx hy ⊢ generalize hxx : (ρ : ℝ) / 2 ^ 41 = x at hx hx0 generalize hyy : ((ρ : ℝ) + 1) / 2 ^ 41 = y at hy have hy0 : 0 ≤ y := hr0.trans hy have x2 : x ^ 2 ≤ r ^ 2 := pow_le_pow_left₀ hx0 hx 2 have y2 : r ^ 2 ≤ y ^ 2 := pow_le_pow_left₀ hr0 hy 2 have x3 : x ^ 3 ≤ r ^ 3 := pow_le_pow_left₀ hx0 hx 3 have y3 : r ^ 3 ≤ y ^ 3 := pow_le_pow_left₀ hr0 hy 3 have y4 : r ^ 4 ≤ y ^ 4 := pow_le_pow_left₀ hr0 hy 4 have A2l : V (ρ * ρ / 2 ^ 21) ≤ r ^ 2 / 2 := by have hn : ρ * ρ / 2 ^ 21 * 2 ^ 21 ≤ ρ * ρ := Nat.div_mul_le_self _ _ generalize ρ * ρ / 2 ^ 21 = a at hn ⊢ have hc : (a : ℝ) * 2 ^ 21 ≤ (ρ : ℝ) * ρ := by exact_mod_cast hn calc V a = (a : ℝ) * 2 ^ 21 / 2 ^ 83 := by unfold V; ring _ ≤ (ρ : ℝ) * ρ / 2 ^ 83 := div_le_div_of_nonneg_right hc (by positivity) _ = x ^ 2 / 2 := by rw [← hxx]; ring _ ≤ r ^ 2 / 2 := by linarith have A2h : r ^ 2 / 2 ≤ V ((ρ + 1) * (ρ + 1) / 2 ^ 21 + 1) := by have hn := lt_div_succ_mul ((ρ + 1) * (ρ + 1)) (2 ^ 21) (by positivity) generalize (ρ + 1) * (ρ + 1) / 2 ^ 21 = a at hn ⊢ have hc : ((ρ : ℝ) + 1) * ((ρ : ℝ) + 1) ≤ ((a : ℝ) + 1) * 2 ^ 21 := by exact_mod_cast hn.le calc r ^ 2 / 2 ≤ y ^ 2 / 2 := by linarith _ = ((ρ : ℝ) + 1) * ((ρ : ℝ) + 1) / 2 ^ 83 := by rw [← hyy]; ring _ ≤ ((a : ℝ) + 1) * 2 ^ 21 / 2 ^ 83 := div_le_div_of_nonneg_right hc (by positivity) _ = V (a + 1) := by unfold V; push_cast; ring have hu2n := lt_div_succ_mul ((ρ + 1) * (ρ + 1)) (2 ^ 31) (by positivity) generalize hu : (ρ + 1) * (ρ + 1) / 2 ^ 31 + 1 = u2 at hu2n have U2 : y ^ 2 ≤ (u2 : ℝ) / 2 ^ 51 := by have hc : ((ρ : ℝ) + 1) * ((ρ : ℝ) + 1) ≤ (u2 : ℝ) * 2 ^ 31 := by exact_mod_cast hu2n.le calc y ^ 2 = ((ρ : ℝ) + 1) * ((ρ : ℝ) + 1) / 2 ^ 82 := by rw [← hyy]; ring _ ≤ (u2 : ℝ) * 2 ^ 31 / 2 ^ 82 := div_le_div_of_nonneg_right hc (by positivity) _ = (u2 : ℝ) / 2 ^ 51 := by ring have A3l : V (ρ * ρ / 2 ^ 31 * ρ / 2 ^ 30 / 6) ≤ r ^ 3 / 6 := by have h1 : ρ * ρ / 2 ^ 31 * 2 ^ 31 ≤ ρ * ρ := Nat.div_mul_le_self _ _ generalize ρ * ρ / 2 ^ 31 = s at h1 ⊢ have h2 : s * ρ / 2 ^ 30 * 2 ^ 30 ≤ s * ρ := Nat.div_mul_le_self _ _ generalize s * ρ / 2 ^ 30 = t at h2 ⊢ have h3 : t / 6 * 6 ≤ t := Nat.div_mul_le_self _ _ generalize t / 6 = a at h3 ⊢ have c1 : (s : ℝ) * 2 ^ 31 ≤ (ρ : ℝ) * ρ := by exact_mod_cast h1 have c2 : (t : ℝ) * 2 ^ 30 ≤ (s : ℝ) * ρ := by exact_mod_cast h2 have c3 : (a : ℝ) * 6 ≤ (t : ℝ) := by exact_mod_cast h3 have hρ0 : (0 : ℝ) ≤ ρ := Nat.cast_nonneg ρ calc V a = (a : ℝ) * 6 / (6 * 2 ^ 62) := by unfold V; ring _ ≤ (t : ℝ) / (6 * 2 ^ 62) := div_le_div_of_nonneg_right c3 (by positivity) _ = (t : ℝ) * 2 ^ 30 / (6 * 2 ^ 92) := by ring _ ≤ (s : ℝ) * ρ / (6 * 2 ^ 92) := div_le_div_of_nonneg_right c2 (by positivity) _ = (s : ℝ) * 2 ^ 31 * ρ / (6 * 2 ^ 123) := by ring _ ≤ (ρ : ℝ) * ρ * ρ / (6 * 2 ^ 123) := div_le_div_of_nonneg_right (mul_le_mul_of_nonneg_right c1 hρ0) (by positivity) _ = x ^ 3 / 6 := by rw [← hxx]; ring _ ≤ r ^ 3 / 6 := by linarith have A3h : r ^ 3 / 6 ≤ V (u2 * (ρ + 1) / 2 ^ 30 / 6 + 1) := by have hn := lt_div_succ_mul (u2 * (ρ + 1)) (2 ^ 30 * 6) (by positivity) rw [← Nat.div_div_eq_div_mul] at hn generalize u2 * (ρ + 1) / 2 ^ 30 / 6 = a at hn ⊢ have hc : (u2 : ℝ) * ((ρ : ℝ) + 1) ≤ ((a : ℝ) + 1) * (2 ^ 30 * 6) := by exact_mod_cast hn.le calc r ^ 3 / 6 ≤ y ^ 3 / 6 := by linarith _ = y ^ 2 * y / 6 := by ring _ ≤ (u2 : ℝ) / 2 ^ 51 * y / 6 := div_le_div_of_nonneg_right (mul_le_mul_of_nonneg_right U2 hy0) (by norm_num) _ = (u2 : ℝ) * ((ρ : ℝ) + 1) / (6 * 2 ^ 92) := by rw [← hyy]; ring _ ≤ ((a : ℝ) + 1) * (2 ^ 30 * 6) / (6 * 2 ^ 92) := div_le_div_of_nonneg_right hc (by positivity) _ = V (a + 1) := by unfold V; push_cast; ring have R4 : r ^ 4 * (5 / 96) ≤ V (u2 * u2 / 2 ^ 40 / 19 + 1) := by have hn := lt_div_succ_mul (u2 * u2) (2 ^ 40 * 19) (by positivity) rw [← Nat.div_div_eq_div_mul] at hn generalize u2 * u2 / 2 ^ 40 / 19 = a at hn ⊢ have hc : (u2 : ℝ) * (u2 : ℝ) ≤ ((a : ℝ) + 1) * (2 ^ 40 * 19) := by exact_mod_cast hn.le have h4 : (0 : ℝ) ≤ r ^ 4 := by positivity have hy2 : (0 : ℝ) ≤ y ^ 2 := by positivity calc r ^ 4 * (5 / 96) ≤ y ^ 4 / 19 := by linarith _ = (y ^ 2) ^ 2 / 19 := by ring _ ≤ ((u2 : ℝ) / 2 ^ 51) ^ 2 / 19 := div_le_div_of_nonneg_right (pow_le_pow_left₀ hy2 U2 2) (by norm_num) _ = (u2 : ℝ) * (u2 : ℝ) / (19 * 2 ^ 102) := by ring _ ≤ ((a : ℝ) + 1) * (2 ^ 40 * 19) / (19 * 2 ^ 102) := div_le_div_of_nonneg_right hc (by positivity) _ = V (a + 1) := by unfold V; push_cast; ring unfold expRN simp only [hρ, hu] constructor · rw [Nat.sub_sub] refine (V_sub_le_max _ _).trans (max_le (Real.exp_pos _).le ?_) rw [V_add, V_add, hb] linarith [hT.1] · rw [V_add] have h1 := V_sub_ge (one - R * 8 + ((ρ + 1) * (ρ + 1) / 2 ^ 21 + 1)) (ρ * ρ / 2 ^ 31 * ρ / 2 ^ 30 / 6) rw [V_add, hb] at h1 linarith [hT.2] end section open FastAct ExactRuntime /-- An enclosure of `e^(−R / 2^59)` for `R < 2^49` (cubic Taylor polynomial, word arithmetic). -/ @[inline] def expR (R : UInt64) : UInt64 × UInt64 := let ρ := R / 262144 let ρ' := ρ + 1 let s2 := ρ * ρ let s2' := ρ' * ρ' let u2 := s2' / 2147483648 + 1 let b := oneU - R * 8 let rem4 := u2 * u2 / 1099511627776 / 19 + 1 (b + s2 / 2097152 - (u2 * ρ' / 1073741824 / 6 + 1) - rem4, b + (s2' / 2097152 + 1) - s2 / 2147483648 * ρ / 1073741824 / 6 + rem4) theorem expR_toNat (R : UInt64) (hR : R.toNat < 2 ^ 49) : (expR R).1.toNat = (expRN R.toNat).1 ∧ (expR R).2.toNat = (expRN R.toNat).2 := by have k18 : (262144 : UInt64).toNat = 2 ^ 18 := by decide have k1 : (1 : UInt64).toNat = 1 := by decide have k31 : (2147483648 : UInt64).toNat = 2 ^ 31 := by decide have k21 : (2097152 : UInt64).toNat = 2 ^ 21 := by decide have k30 : (1073741824 : UInt64).toNat = 2 ^ 30 := by decide have k40 : (1099511627776 : UInt64).toNat = 2 ^ 40 := by decide have k6 : (6 : UInt64).toNat = 6 := by decide have k19 : (19 : UInt64).toNat = 19 := by decide have k8 : (8 : UInt64).toNat = 8 := by decide unfold expR expRN dsimp only have eb : (oneU - R * 8).toNat = one - R.toNat * 8 := sub_toNat oneU_toNat (mul_toNat rfl k8 (by omega)) (by unfold one; omega) have hb1 : 2 ^ 61 ≤ one - R.toNat * 8 := by unfold one; omega have hb2 : one - R.toNat * 8 ≤ 2 ^ 62 := by unfold one; omega generalize one - R.toNat * 8 = bn at eb hb1 hb2 ⊢ generalize oneU - R * 8 = bw at eb ⊢ have eρ : (R / 262144).toNat = R.toNat / 2 ^ 18 := div_toNat rfl k18 have hρlt : R.toNat / 2 ^ 18 < 2 ^ 31 := by omega generalize R.toNat / 2 ^ 18 = ρ at eρ hρlt ⊢ generalize R / 262144 = ρw at eρ ⊢ clear hR have eρ' : (ρw + 1).toNat = ρ + 1 := add_toNat eρ k1 (by omega) have hs2 : ρ * ρ < 2 ^ 62 := by have := Nat.mul_lt_mul'' hρlt hρlt; omega have hs2' : (ρ + 1) * (ρ + 1) ≤ 2 ^ 62 := by have := Nat.mul_le_mul (show ρ + 1 ≤ 2 ^ 31 by omega) (show ρ + 1 ≤ 2 ^ 31 by omega); omega have es2 : (ρw * ρw).toNat = ρ * ρ := mul_toNat eρ eρ (by omega) have es2' : ((ρw + 1) * (ρw + 1)).toNat = (ρ + 1) * (ρ + 1) := mul_toNat eρ' eρ' (by omega) have h3l : ρ * ρ / 2 ^ 31 * ρ < 2 ^ 62 := by have := Nat.mul_lt_mul'' (show ρ * ρ / 2 ^ 31 < 2 ^ 31 by omega) hρlt; omega have e3l : (ρw * ρw / 2147483648 * ρw / 1073741824 / 6).toNat = ρ * ρ / 2 ^ 31 * ρ / 2 ^ 30 / 6 := div_toNat (div_toNat (mul_toNat (div_toNat es2 k31) eρ (by omega)) k30) k6 have h3lb : ρ * ρ / 2 ^ 31 * ρ / 2 ^ 30 / 6 ≤ 2 ^ 32 := by omega generalize ρ * ρ / 2 ^ 31 * ρ / 2 ^ 30 / 6 = a3l at e3l h3lb ⊢ generalize ρw * ρw / 2147483648 * ρw / 1073741824 / 6 = a3lw at e3l ⊢ clear h3l have e2l : (ρw * ρw / 2097152).toNat = ρ * ρ / 2 ^ 21 := div_toNat es2 k21 have h2lb : ρ * ρ / 2 ^ 21 ≤ 2 ^ 41 := by omega generalize ρ * ρ / 2 ^ 21 = a2l at e2l h2lb ⊢ generalize ρw * ρw / 2097152 = a2lw at e2l ⊢ clear es2 hs2 have e2h : ((ρw + 1) * (ρw + 1) / 2097152 + 1).toNat = (ρ + 1) * (ρ + 1) / 2 ^ 21 + 1 := add_toNat (div_toNat es2' k21) k1 (by omega) have h2hb : (ρ + 1) * (ρ + 1) / 2 ^ 21 + 1 ≤ 2 ^ 41 + 1 := by omega generalize (ρ + 1) * (ρ + 1) / 2 ^ 21 + 1 = a2h at e2h h2hb ⊢ generalize (ρw + 1) * (ρw + 1) / 2097152 + 1 = a2hw at e2h ⊢ have eu2 : ((ρw + 1) * (ρw + 1) / 2147483648 + 1).toNat = (ρ + 1) * (ρ + 1) / 2 ^ 31 + 1 := add_toNat (div_toNat es2' k31) k1 (by omega) have hu2 : (ρ + 1) * (ρ + 1) / 2 ^ 31 + 1 ≤ 2 ^ 31 + 1 := by omega generalize (ρ + 1) * (ρ + 1) / 2 ^ 31 + 1 = u2 at eu2 hu2 ⊢ generalize (ρw + 1) * (ρw + 1) / 2147483648 + 1 = u2w at eu2 ⊢ clear es2' hs2' have hp3 : u2 * (ρ + 1) ≤ (2 ^ 31 + 1) * 2 ^ 31 := Nat.mul_le_mul hu2 (by omega) have e3h : (u2w * (ρw + 1) / 1073741824 / 6 + 1).toNat = u2 * (ρ + 1) / 2 ^ 30 / 6 + 1 := add_toNat (div_toNat (div_toNat (mul_toNat eu2 eρ' (by omega)) k30) k6) k1 (by omega) have h3hb : u2 * (ρ + 1) / 2 ^ 30 / 6 + 1 ≤ 2 ^ 30 := by omega generalize u2 * (ρ + 1) / 2 ^ 30 / 6 + 1 = a3h at e3h h3hb ⊢ generalize u2w * (ρw + 1) / 1073741824 / 6 + 1 = a3hw at e3h ⊢ clear hp3 have hp4 : u2 * u2 ≤ (2 ^ 31 + 1) * (2 ^ 31 + 1) := Nat.mul_le_mul hu2 hu2 have er4 : (u2w * u2w / 1099511627776 / 19 + 1).toNat = u2 * u2 / 2 ^ 40 / 19 + 1 := add_toNat (div_toNat (div_toNat (mul_toNat eu2 eu2 (by omega)) k40) k19) k1 (by omega) have hr4 : u2 * u2 / 2 ^ 40 / 19 + 1 ≤ 2 ^ 20 := by omega generalize u2 * u2 / 2 ^ 40 / 19 + 1 = r4 at er4 hr4 ⊢ generalize u2w * u2w / 1099511627776 / 19 + 1 = r4w at er4 ⊢ clear hp4 exact ⟨sub_toNat (sub_toNat (add_toNat eb e2l (by omega)) e3h (by omega)) er4 (by omega), add_toNat (sub_toNat (add_toNat eb e2h (by omega)) e3l (by omega)) er4 (by omega)⟩ /-- `[Tl, Tl + 2^14]` (a table entry, `0` = none) times the short series for `R`. The second component is `0` when there is no entry. -/ @[inline] def enclT (Tl R : UInt64) : UInt64 × UInt64 := if Tl == 0 then (0, 0) else let P := expR R let Th := Tl + 16384 (mulDnW Tl P.1, mulUpW (if oneU < Th then oneU else Th) (if oneU < P.2 then oneU else P.2)) theorem enclT_spec {Tl R : UInt64} {t : UInt64 × UInt64} (ht : enclT Tl R = t) (h : t.2 ≠ 0) {x : ℝ} (hx1 : x ≤ 1) (hT : Tl ≠ 0 → V Tl.toNat ≤ x ∧ x ≤ V (Tl.toNat + tabW) ∧ Tl.toNat ≤ one) (hR : R.toNat < 2 ^ 49) : V t.1.toNat ≤ x * Real.exp (-((R.toNat : ℝ) / 2 ^ 59)) ∧ x * Real.exp (-((R.toNat : ℝ) / 2 ^ 59)) ≤ V t.2.toNat ∧ t.2.toNat ≤ one := by have kW : (16384 : UInt64).toNat = tabW := by decide unfold enclT at ht by_cases h0 : Tl = 0 · rw [ite_eq_left (beq_iff_eq.mpr h0)] at ht subst ht exact (h rfl).elim rw [ite_eq_right (mt beq_iff_eq.mp h0)] at ht subst ht clear h dsimp only obtain ⟨tlo, thi, ht1⟩ := hT h0 obtain ⟨eP1, eP2⟩ := expR_toNat R hR obtain ⟨pl, ph⟩ := expRN_spec R.toNat hR rw [← eP1] at pl rw [← eP2] at ph clear eP1 eP2 generalize expR R = P at pl ph ⊢ have hy1 : Real.exp (-((R.toNat : ℝ) / 2 ^ 59)) ≤ 1 := by rw [Real.exp_le_one_iff] have : (0 : ℝ) ≤ (R.toNat : ℝ) / 2 ^ 59 := by positivity linarith have eTh : (Tl + 16384).toNat = Tl.toNat + tabW := add_toNat rfl kW (by unfold one at ht1; unfold tabW; omega) obtain ⟨cT, cT1⟩ := cap_spec (Tl + 16384) (by rw [eTh]; exact thi) hx1 obtain ⟨cP, cP1⟩ := cap_spec P.2 ph hy1 refine ⟨?_, ?_, ?_⟩ · rw [mulDnW_toNat]; exact V_mulDn_le tlo pl · rw [mulUpW_toNat]; exact le_V_mulUp cT cP (Real.exp_pos _).le cT1 cP1 · rw [mulUpW_toNat]; exact mulUp_le cT1 cP1 /-- An enclosure of `e^(−v / 2^59)`: the table entry for the top bits of `v` times the short series for the rest. The second component is `0` when the table has no entry for `v`. -/ @[inline] def encl (v : UInt64) : UInt64 × UInt64 := enclT (tab.getD (v / 562949953421312).toNat 0).toUInt64 (v % 562949953421312) /-- A read that yields `0` outside the array, without the runtime's bounds message. -/ theorem getD0 (a : Array Nat) (j : Nat) : a.getD j 0 = a[j]! := Array.getElem!_eq_getD.symm theorem encl_spec {v : UInt64} {t : UInt64 × UInt64} (ht : encl v = t) (h : t.2 ≠ 0) : V t.1.toNat ≤ Real.exp (-((v.toNat : ℝ) / 2 ^ 59)) ∧ Real.exp (-((v.toNat : ℝ) / 2 ^ 59)) ≤ V t.2.toNat ∧ t.2.toNat ≤ one := by have k49 : (562949953421312 : UInt64).toNat = 2 ^ 49 := by decide have hj : (v / 562949953421312).toNat = v.toNat / 2 ^ 49 := div_toNat rfl k49 have hr : (v % 562949953421312).toNat = v.toNat % 2 ^ 49 := by rw [UInt64.toNat_mod, k49] have hrlt : (v % 562949953421312).toNat < 2 ^ 49 := by rw [hr]; exact Nat.mod_lt _ (by positivity) have hsplit : (v.toNat : ℝ) / 2 ^ 59 = ((v.toNat / 2 ^ 49 : Nat) : ℝ) * (1 / 1024) + ((v % 562949953421312).toNat : ℝ) / 2 ^ 59 := by rw [hr] have hc : (v.toNat : ℝ) = (2 : ℝ) ^ 49 * ((v.toNat / 2 ^ 49 : Nat) : ℝ) + ((v.toNat % 2 ^ 49 : Nat) : ℝ) := by exact_mod_cast (Nat.div_add_mod v.toNat (2 ^ 49)).symm generalize ((v.toNat / 2 ^ 49 : Nat) : ℝ) = q at hc ⊢ generalize ((v.toNat % 2 ^ 49 : Nat) : ℝ) = s at hc ⊢ rw [hc]; ring unfold encl at ht rw [getD0, hj] at ht rw [hsplit, neg_add, Real.exp_add] clear hsplit hj hr generalize v.toNat / 2 ^ 49 = j at ht ⊢ have hx1 : Real.exp (-((j : ℝ) * (1 / 1024))) ≤ 1 := by rw [Real.exp_le_one_iff] have : (0 : ℝ) ≤ (j : ℝ) * (1 / 1024) := by positivity linarith refine enclT_spec ht h hx1 (fun h0 => ?_) hrlt have ht0 : tab[j]! ≠ 0 := fun hz => h0 (by rw [hz]; rfl) obtain ⟨tlo, thi⟩ := tab_spec j ht0 have ht1 : tab[j]! ≤ one := le_of_V_le (by rw [V_one]; exact tlo.trans hx1) have eT : ((tab[j]!).toUInt64).toNat = tab[j]! := toNat_toUInt64_of_lt (by unfold one at ht1; omega) rw [eT] exact ⟨tlo, thi, ht1⟩ end section open FastAct ExactRuntime def c60 : UInt64 := 1152921504606846976 /-- Certificate for a reciprocal enclosure: `ul · (1 + th) < 1 ≤ uh · (1 + tl)` on the grid. -/ @[inline] def recipOk (ul uh tl th : UInt64) : Bool := c60 ≤ mulHiW uh (oneU + tl) && mulHiW ul (oneU + th) < c60 theorem recipOk_spec {ul uh tl th : UInt64} (h : recipOk ul uh tl th = true) (htl : tl.toNat ≤ one) (hth : th.toNat ≤ one) : V ul.toNat * (1 + V th.toNat) ≤ 1 ∧ 1 ≤ V uh.toNat * (1 + V tl.toNat) := by have k60 : c60.toNat = 2 ^ 60 := by decide simp only [recipOk, Bool.and_eq_true, decide_eq_true_eq, UInt64.le_iff_toNat_le, UInt64.lt_iff_toNat_lt] at h obtain ⟨h1, h2⟩ := h rw [k60] at h1 h2 have e1 : (oneU + tl).toNat = one + tl.toNat := add_toNat oneU_toNat rfl (by unfold one at *; omega) have e2 : (oneU + th).toNat = one + th.toNat := add_toNat oneU_toNat rfl (by unfold one at *; omega) have s1 := (mulHiW_spec uh (oneU + tl)).1 have s2 := (mulHiW_spec ul (oneU + th)).2 rw [e1] at s1 rw [e2] at s2 have n1 : 2 ^ 124 ≤ uh.toNat * (one + tl.toNat) := by have := Nat.mul_le_mul_right (2 ^ 64) h1 omega have n2 : ul.toNat * (one + th.toNat) ≤ 2 ^ 124 := by have := Nat.mul_le_mul_right (2 ^ 64) (Nat.succ_le_of_lt h2) omega have r1 : (ul.toNat : ℝ) * (2 ^ 62 + (th.toNat : ℝ)) ≤ 2 ^ 124 := by unfold one at n2; exact_mod_cast n2 have r2 : (2 : ℝ) ^ 124 ≤ (uh.toNat : ℝ) * (2 ^ 62 + (tl.toNat : ℝ)) := by unfold one at n1; exact_mod_cast n1 unfold V constructor · have e : (ul.toNat : ℝ) / 2 ^ 62 * (1 + (th.toNat : ℝ) / 2 ^ 62) = (ul.toNat : ℝ) * (2 ^ 62 + (th.toNat : ℝ)) / 2 ^ 124 := by ring rw [e, div_le_one (by positivity)]; exact r1 · have e : (uh.toNat : ℝ) / 2 ^ 62 * (1 + (tl.toNat : ℝ) / 2 ^ 62) = (uh.toNat : ℝ) * (2 ^ 62 + (tl.toNat : ℝ)) / 2 ^ 124 := by ring rw [e, le_div_iff₀ (by positivity), one_mul]; exact r2 theorem recip_bounds {ul uh tl th : UInt64} {T : ℝ} (h : recipOk ul uh tl th = true) (hl : V tl.toNat ≤ T) (hh : T ≤ V th.toNat) (hth : th.toNat ≤ one) : V ul.toNat ≤ 1 / (1 + T) ∧ 1 / (1 + T) ≤ V uh.toNat := by have hT0 : 0 ≤ T := (V_nonneg _).trans hl have hth1 : V th.toNat ≤ 1 := by rw [← V_one]; exact V_mono hth have htl : tl.toNat ≤ one := le_of_V_le (by rw [V_one]; linarith) obtain ⟨h1, h2⟩ := recipOk_spec h htl hth have p1 : (0 : ℝ) < 1 + T := by linarith constructor · rw [le_div_iff₀ p1] calc V ul.toNat * (1 + T) ≤ V ul.toNat * (1 + V th.toNat) := mul_le_mul_of_nonneg_left (by linarith) (V_nonneg _) _ ≤ 1 := h1 · rw [div_le_iff₀ p1] calc (1 : ℝ) ≤ V uh.toNat * (1 + V tl.toNat) := h2 _ ≤ V uh.toNat * (1 + T) := mul_le_mul_of_nonneg_left (by linarith) (V_nonneg _) theorem div_one_add (T : ℝ) (hT : 0 ≤ T) : (1 - T) / (1 + T) = 2 * (1 / (1 + T)) - 1 ∧ T / (1 + T) = 1 - 1 / (1 + T) := by have hne : (1 + T) ≠ 0 := (by linarith : (0 : ℝ) < 1 + T).ne' have hu : 1 / (1 + T) * (1 + T) = 1 := one_div_mul_cancel hne constructor · rw [div_eq_mul_one_div]; linear_combination (-1 : ℝ) * hu · rw [div_eq_mul_one_div]; linear_combination hu /-- `σ(±c)` from an enclosure `[tl, th]` of `e^(−c)` and a candidate reciprocal `[ul, uh]`. -/ @[inline] def sigFin (neg : Bool) (ul uh tl th : UInt64) : Option UInt32 := if recipOk ul uh tl th then let uc := if oneU < uh then oneU else uh if neg then settleU false (oneU - uc) (oneU - ul) else settleU false ul uc else none theorem sigFin_spec {neg : Bool} {ul uh tl th : UInt64} {a : UInt32} {T : ℝ} (h : sigFin neg ul uh tl th = some a) (hl : V tl.toNat ≤ T) (hh : T ≤ V th.toNat) (hth : th.toNat ≤ one) : ∃ lo hi : Nat, settle false lo hi = some a ∧ V lo ≤ (if neg then T / (1 + T) else 1 / (1 + T)) ∧ (if neg then T / (1 + T) else 1 / (1 + T)) ≤ V hi := by have hT0 : 0 ≤ T := (V_nonneg _).trans hl unfold sigFin at h dsimp only at h by_cases hc : recipOk ul uh tl th = true · rw [ite_eq_left hc] at h obtain ⟨b1, b2⟩ := recip_bounds hc hl hh hth have hle1 : 1 / (1 + T) ≤ 1 := by rw [div_le_one (by linarith)]; linarith have hpos : 0 ≤ 1 / (1 + T) := by positivity obtain ⟨c1, c2⟩ := cap_spec uh b2 hle1 generalize (if oneU < uh then oneU else uh) = uc at h c1 c2 have hul1 : ul.toNat ≤ one := le_of_V_le (by rw [V_one]; linarith) cases neg · simp only [Bool.false_eq_true, ite_false] at h ⊢ exact ⟨_, _, settleU_spec h, b1, c1⟩ · simp only [ite_true] at h ⊢ have h' := settleU_spec h rw [sub_toNat oneU_toNat rfl c2, sub_toNat oneU_toNat rfl hul1] at h' refine ⟨_, _, h', ?_, ?_⟩ · rw [V_sub_le_of_le c2, V_one, (div_one_add T hT0).2]; linarith · rw [V_sub_le_of_le hul1, V_one, (div_one_add T hT0).2]; linarith · rw [ite_eq_right hc] at h; exact absurd h (by simp) /-- `tanh` of `±c` from an enclosure `[tl, th]` of `e^(−2c)`. -/ @[inline] def tanhFin (neg : Bool) (ul uh tl th : UInt64) : Option UInt32 := if recipOk ul uh tl th then let uc := if oneU < uh then oneU else uh if oneU ≤ 2 * ul then settleU neg (2 * ul - oneU) (2 * uc - oneU) else none else none theorem tanhFin_spec {neg : Bool} {ul uh tl th : UInt64} {a : UInt32} {T : ℝ} (h : tanhFin neg ul uh tl th = some a) (hl : V tl.toNat ≤ T) (hh : T ≤ V th.toNat) (hth : th.toNat ≤ one) : ∃ lo hi : Nat, settle neg lo hi = some a ∧ V lo ≤ (1 - T) / (1 + T) ∧ (1 - T) / (1 + T) ≤ V hi := by have hT0 : 0 ≤ T := (V_nonneg _).trans hl have hT1 : T ≤ 1 := hh.trans (by rw [← V_one]; exact V_mono hth) have k2 : (2 : UInt64).toNat = 2 := by decide unfold tanhFin at h dsimp only at h by_cases hc : recipOk ul uh tl th = true · rw [ite_eq_left hc] at h obtain ⟨b1, b2⟩ := recip_bounds hc hl hh hth have hle1 : 1 / (1 + T) ≤ 1 := by rw [div_le_one (by linarith)]; linarith have hhalf : (1 : ℝ) / 2 ≤ 1 / (1 + T) := by rw [div_le_div_iff₀ (by norm_num) (by linarith)]; linarith obtain ⟨c1, c2⟩ := cap_spec uh b2 hle1 generalize (if oneU < uh then oneU else uh) = uc at h c1 c2 have hul1 : ul.toNat ≤ one := le_of_V_le (by rw [V_one]; linarith) have e2ul : (2 * ul).toNat = 2 * ul.toNat := mul_toNat k2 rfl (by unfold one at hul1; omega) have e2uc : (2 * uc).toNat = 2 * uc.toNat := mul_toNat k2 rfl (by unfold one at c2; omega) by_cases hd : oneU ≤ 2 * ul · rw [ite_eq_left hd] at h have hd' : one ≤ 2 * ul.toNat := by rw [UInt64.le_iff_toNat_le, oneU_toNat, e2ul] at hd; exact hd have huc : one ≤ 2 * uc.toNat := le_of_V_le (by rw [V_one, V_two_mul]; linarith) have h' := settleU_spec h rw [sub_toNat e2ul oneU_toNat hd', sub_toNat e2uc oneU_toNat huc] at h' refine ⟨_, _, h', ?_, ?_⟩ · rw [V_sub_le_of_le hd', V_one, V_two_mul, (div_one_add T hT0).1]; linarith · rw [V_sub_le_of_le huc, V_one, V_two_mul, (div_one_add T hT0).1]; linarith · rw [ite_eq_right hd] at h; exact absurd h (by simp) · rw [ite_eq_right hc] at h; exact absurd h (by simp) end section open FastAct ExactRuntime FloatLib.Floats.Formats.BinaryInterchange FloatLib.Floats FloatLib.Numerics open ExactRuntime.FastRound def two124f : Float := 21267647932558653966460912964485513216.0 /-- An unverified guess for `2^62 / (1 + tl · 2^(−62))`. -/ @[inline] def guess (tl : UInt64) : UInt64 := (two124f / (oneU + tl).toFloat).toUInt64 @[inline] def sigCore (neg : Bool) (tl th : UInt64) : Option UInt32 := let g := guess tl let e := (g >>> 50) + 2 sigFin neg (g - (e + (th - tl))) (g + e) tl th @[inline] def tanhCore (neg : Bool) (tl th : UInt64) : Option UInt32 := let g := guess tl let e := (g >>> 50) + 2 tanhFin neg (g - (e + (th - tl))) (g + e) tl th /-- `(2^23 + frac) · 2^(E − c)` as a word. -/ @[inline] def argOf (w c : UInt32) : UInt64 := ((fracOf w).toUInt64 + 8388608) <<< (expOf w - c).toUInt64 theorem frac_lt (w : UInt32) : (fracOf w).toNat < 2 ^ 23 := by unfold fracOf rw [UInt32.toNat_and] exact Nat.lt_of_le_of_lt Nat.and_le_right (by decide) theorem argOf_toNat (w c : UInt32) (hc : c.toNat ≤ (expOf w).toNat) (h2 : (expOf w).toNat - c.toNat ≤ 40) : (argOf w c).toNat = (2 ^ 23 + (fracOf w).toNat) * 2 ^ ((expOf w).toNat - c.toNat) := by have hf := frac_lt w have k : (8388608 : UInt64).toNat = 2 ^ 23 := by decide have e1 : ((fracOf w).toUInt64 + 8388608).toNat = 2 ^ 23 + (fracOf w).toNat := by rw [add_toNat (UInt32.toNat_toUInt64 _) k (by omega), Nat.add_comm] have e2 : ((expOf w - c).toUInt64).toNat = (expOf w).toNat - c.toNat := by rw [UInt32.toNat_toUInt64, UInt32.toNat_sub_of_le _ _ (UInt32.le_iff_toNat_le.mpr hc)] unfold argOf rw [UInt64.toNat_shiftLeft, e1, e2, Nat.mod_eq_of_lt (by omega : (expOf w).toNat - c.toNat < 64), Nat.shiftLeft_eq] apply Nat.mod_eq_of_lt calc (2 ^ 23 + (fracOf w).toNat) * 2 ^ ((expOf w).toNat - c.toNat) < 2 ^ 24 * 2 ^ 40 := Nat.mul_lt_mul_of_lt_of_le (by omega) (Nat.pow_le_pow_right (by norm_num) h2) (by positivity) _ = 2 ^ 64 := by norm_num /-- A normal word's value as a fraction over `2^k`. -/ theorem value_eq {w : UInt32} (k s : Nat) (hks : s + k = 150) (hE : s ≤ (expOf w).toNat) (h0 : expOf w ≠ 0) (h255 : expOf w ≠ 255) : Model.toReal (ofW w) = (if signOf w then -1 else 1) * ((((2 ^ 23 + (fracOf w).toNat) * 2 ^ ((expOf w).toNat - s) : Nat) : ℝ) / 2 ^ k) := by rw [toReal_normal h0 h255, scale_pow _ _ k (by omega) (by omega), show 150 - k = s by omega] @[inline] def sigmoidU? (w : UInt32) : Option UInt32 := if 91 ≤ expOf w && expOf w ≤ 131 then let t := encl (argOf w 91) if t.2 == 0 then none else sigCore (signOf w) t.1 t.2 else none theorem sigmoidU?_spec {w a : UInt32} (h : sigmoidU? w = some a) : sigmoidCR w = a := by have k91 : (91 : UInt32).toNat = 91 := by decide have k131 : (131 : UInt32).toNat = 131 := by decide unfold sigmoidU? at h dsimp only at h split at h · rename_i hE simp only [Bool.and_eq_true, decide_eq_true_eq, UInt32.le_iff_toNat_le] at hE rw [k91, k131] at hE obtain ⟨n1, n2⟩ := hE have h255 : expOf w ≠ 255 := fun e => by rw [e] at n2; exact absurd n2 (by decide) have h0 : expOf w ≠ 0 := fun e => by rw [e] at n1; exact absurd n1 (by decide) have hv := argOf_toNat w 91 (by rw [k91]; exact n1) (by rw [k91]; omega) rw [k91] at hv have hval := value_eq (w := w) 59 91 rfl n1 h0 h255 rw [← hv] at hval generalize argOf w 91 = v at h hval split at h · exact absurd h (by simp) · rename_i ht obtain ⟨el, eh, e1⟩ := encl_spec (v := v) rfl (fun e => ht (beq_iff_eq.mpr e)) obtain ⟨lo, hi, hs, b1, b2⟩ := sigFin_spec h el eh e1 have hσ : realSigmoid (Model.toReal (ofW w)) = (if signOf w then Real.exp (-((v.toNat : ℝ) / 2 ^ 59)) / (1 + Real.exp (-((v.toNat : ℝ) / 2 ^ 59))) else 1 / (1 + Real.exp (-((v.toNat : ℝ) / 2 ^ 59)))) := by rw [hval] cases signOf w · simp only [Bool.false_eq_true, ite_false, one_mul]; rfl · simp only [ite_true, neg_one_mul]; exact realSigmoid_neg_eq _ exact sigmoid_of_encl h255 (by rw [hσ]; exact b1) (by rw [hσ]; exact b2) hs · exact absurd h (by simp) /-- Correctly rounded sigmoid: the word-arithmetic tier, else the shipped function. -/ def sigmoidU (w : UInt32) : UInt32 := match sigmoidU? w with | some a => a | none => sigmoidF w theorem sigmoidU_eq : sigmoidU = sigmoidCR := by funext w unfold sigmoidU cases h : sigmoidU? w with | some a => exact (sigmoidU?_spec h).symm | none => exact congrFun sigmoidF_eq w @[inline] def tanhU? (w : UInt32) : Option UInt32 := if 90 ≤ expOf w && expOf w ≤ 130 then let t := encl (argOf w 90) if t.2 == 0 then none else tanhCore (signOf w) t.1 t.2 else none theorem tanhU?_spec {w a : UInt32} (h : tanhU? w = some a) : tanhCR w = a := by have k90 : (90 : UInt32).toNat = 90 := by decide have k130 : (130 : UInt32).toNat = 130 := by decide unfold tanhU? at h dsimp only at h split at h · rename_i hE simp only [Bool.and_eq_true, decide_eq_true_eq, UInt32.le_iff_toNat_le] at hE rw [k90, k130] at hE obtain ⟨n1, n2⟩ := hE have h255 : expOf w ≠ 255 := fun e => by rw [e] at n2; exact absurd n2 (by decide) have h0 : expOf w ≠ 0 := fun e => by rw [e] at n1; exact absurd n1 (by decide) have hv := argOf_toNat w 90 (by rw [k90]; exact n1) (by rw [k90]; omega) rw [k90] at hv have hval := value_eq (w := w) 60 90 rfl n1 h0 h255 rw [← hv] at hval generalize argOf w 90 = v at h hval split at h · exact absurd h (by simp) · rename_i ht obtain ⟨el, eh, e1⟩ := encl_spec (v := v) rfl (fun e => ht (beq_iff_eq.mpr e)) obtain ⟨lo, hi, hs, b1, b2⟩ := tanhFin_spec h el eh e1 have hC : Real.tanh ((v.toNat : ℝ) / 2 ^ 60) = (1 - Real.exp (-((v.toNat : ℝ) / 2 ^ 59))) / (1 + Real.exp (-((v.toNat : ℝ) / 2 ^ 59))) := by rw [tanh_eq_exp_neg_two, show -2 * ((v.toNat : ℝ) / 2 ^ 60) = -((v.toNat : ℝ) / 2 ^ 59) by ring] apply tanh_of_encl h255 _ _ hs · rw [hval] cases signOf w · simp only [Bool.false_eq_true, ite_false, one_mul]; rw [hC]; exact b1 · simp only [ite_true, neg_one_mul, Real.tanh_neg]; rw [hC]; linarith · rw [hval] cases signOf w · simp only [Bool.false_eq_true, ite_false, one_mul]; rw [hC]; exact b2 · simp only [ite_true, neg_one_mul, Real.tanh_neg]; rw [hC]; linarith · exact absurd h (by simp) /-- Correctly rounded tanh: the word-arithmetic tier, else the shipped function. -/ def tanhU (w : UInt32) : UInt32 := match tanhU? w with | some a => a | none => tanhF w theorem tanhU_eq : tanhU = tanhCR := by funext w unfold tanhU cases h : tanhU? w with | some a => exact (tanhU?_spec h).symm | none => exact congrFun tanhF_eq w end end FastAct2 namespace Submission open ExactRuntime FloatLib.Floats.Formats.BinaryInterchange FloatLib.Floats structure ConvShape where cin : Nat h : Nat w : Nat cout : Nat kh : Nat kw : Nat stride : Nat pad : Nat def ConvShape.ho (s : ConvShape) : Nat := (s.h + 2 * s.pad - s.kh) / s.stride + 1 def ConvShape.wo (s : ConvShape) : Nat := (s.w + 2 * s.pad - s.kw) / s.stride + 1 @[inline] def windowAt (s : ConvShape) (inp : Array Word) (y x t : Nat) : Word := let c := t / (s.kh * s.kw) let dy := t / s.kw % s.kh let dx := t % s.kw let yy := y * s.stride + dy let xx := x * s.stride + dx if yy < s.pad ∨ xx < s.pad ∨ yy - s.pad ≥ s.h ∨ xx - s.pad ≥ s.w then 0 else inp[(c * s.h + (yy - s.pad)) * s.w + (xx - s.pad)]! @[specialize] def conv2dWith (dot : DotFn) (s : ConvShape) (relu : Bool) (inp wts b : Array Word) : Array Word := let k := s.cin * s.kh * s.kw Array.ofFn (n := s.cout * (s.ho * s.wo)) fun q => let o := q.val / (s.ho * s.wo) let y := q.val / s.wo % s.ho let x := q.val % s.wo act relu <| dot (k + 1) (fun t => if t < k then windowAt s inp y x t else oneW) (fun t => if t < k then wts[o * k + t]! else b[o]!) def conv2dSpec := conv2dWith dotOf @[specialize] def depthwiseWith (dot : DotFn) (s : ConvShape) (relu : Bool) (inp wts b : Array Word) : Array Word := let k := s.kh * s.kw Array.ofFn (n := s.cin * (s.ho * s.wo)) fun q => let c := q.val / (s.ho * s.wo) let y := q.val / s.wo % s.ho let x := q.val % s.wo act relu <| dot (k + 1) (fun t => if t < k then windowAt s inp y x (c * k + t) else oneW) (fun t => if t < k then wts[c * k + t]! else b[c]!) def depthwiseSpec := depthwiseWith dotOf @[inline] def poolAt (h w k : Nat) (inp : Array Word) (ch y x t : Nat) : Word := inp[(ch * h + y * k + t / k) * w + x * k + t % k]! @[specialize] def avgpoolWith (dot : DotFn) (c h w k : Nat) (inp : Array Word) : Array Word := Array.ofFn (n := c * (h / k * (w / k))) fun q => let ch := q.val / (h / k * (w / k)) let y := q.val / (w / k) % (h / k) let x := q.val % (w / k) let s := dot (k * k) (poolAt h w k inp ch y x) (fun _ => oneW) toWord (Model.div (ofW s) (ofW (natW (k * k)))) def avgpoolSpec := avgpoolWith dotOf def maxpoolSpec (c h w k : Nat) (inp : Array Word) : Array Word := Array.ofFn (n := c * (h / k * (w / k))) fun q => let ch := q.val / (h / k * (w / k)) let y := q.val / (w / k) % (h / k) let x := q.val % (w / k) toWord <| (List.range (k * k)).foldl (fun acc t => Model.maximum acc (ofW (poolAt h w k inp ch y x t))) (ofW (poolAt h w k inp ch y x 0)) section open FloatLib.Numerics theorem roundDyadic_jam (s : Bool) (m : Nat) (e : Int) (j : Nat) (h : j + 25 ≤ m.log2) : Model.roundDyadic Fmt ⟨s, shiftRightJam m j, e + j⟩ = Model.roundDyadic Fmt ⟨s, m, e⟩ := by have hm0 : m ≠ 0 := by rintro rfl; simp at h have hpow : 2 ^ m.log2 ≤ m := Nat.log2_self_le hm0 have hm : 2 ^ (j + 1) ≤ m := le_trans (Nat.pow_le_pow_right (by norm_num) (by omega)) hpow have hlog : (shiftRightJam m j).log2 = m.log2 - j := log2_shiftRightJam m j have hne : shiftRightJam m j ≠ 0 := shiftRightJam_ne_zero m j (le_trans (Nat.pow_le_pow_right (by norm_num) (by clear*-;omega)) hm) rw [← Model.roundDyadicGeneral_eq_roundDyadic, ← Model.roundDyadicGeneral_eq_roundDyadic] unfold Model.roundDyadicGeneral simp only [hne, hm0, beq_iff_eq, ite_false, hlog] have htot : ((m.log2 - j : Nat) : Int) + (e + j) = (m.log2 : Int) + e := by clear*-h hne;omega rw [htot] have hfw : Fmt.fracWidth = 23 := rfl have hsub : Fmt.minSubnormalExponent = -149 := rfl have hmin : Fmt.minNormalExponent = -126 := rfl rw [hfw, hsub, hmin] split_ifs with h1 h2 h3 h4 <;> try omega ·rfl ·congr 1 obtain ⟨a, ha⟩ : ∃ a : Nat, e - -149 = Int.negSucc a := ⟨(-(e + 149) - 1).toNat, by clear*-h h2;omega⟩ have hb : e + j - -149 = Int.negSucc (a - j) := by clear*-h h2 ha;omega rw [ha, hb] dsimp only rw [show a - j + 1 = (a + 1) - j by clear*-ha hb;omega] exact roundShiftRightEven_shiftRightJam m j (a + 1) (by clear*-h h2 ha;omega) ·congr 1 rw [show m.log2 - j - 23 = (m.log2 - 23) - j by clear*-;omega] exact roundShiftRightEven_shiftRightJam m j _ (by clear*-h h4;omega) end theorem getElem!_ofFn (n : Nat) (f : Nat → UInt32) (k : Nat) (hk : k < n) : (Array.ofFn (n := n) fun i => f i.val)[k]! = f k := by rw [getElem!_pos _ k (by simpa using hk), Array.getElem_ofFn] namespace Core def tm (a b : Word) : Int := sv a * sv b * 2 ^ (idxOf a + idxOf b) def tsum (n : Nat) (fa fb : Nat → Word) : Int := ∑ k ∈ Finset.range n, tm (fa k) (fb k) def finAll (n : Nat) (fa fb : Nat → Word) : Prop := ∀ k, k < n → expOf (fa k) ≠ 255 ∧ expOf (fb k) ≠ 255 theorem tsum_succ (n : Nat) (fa fb : Nat → Word) : tsum (n + 1) fa fb = tsum n fa fb + tm (fa n) (fb n) := Finset.sum_range_succ _ _ theorem dotOf_val (n : Nat) (fa fb : Nat → Word) (hfin : finAll n fa fb) : dotOf n fa fb = finishWord (tsum n fa fb) (-298) (decide (n ≠ 0) && dallNZ (Array.ofFn (n := n) fun i => fa i.val) (Array.ofFn (n := n) fun i => fb i.val) 0 n) := by unfold dotOf dotSpec rw [← Model.Reduction.map_value_dot] set A := Array.ofFn (n := n) fun i => fa i.val set B := Array.ofFn (n := n) fun i => fb i.val set L := A.map (Model.ofUInt32 (fmt := Fmt)) set R := B.map (Model.ofUInt32 (fmt := Fmt)) have hLR : L.size = R.size := by simp [L, R, A, B] have hLfin : ∀ k (h : k < L.size), Model.isFinite L[k] = true := fun k h => by simp [L, A, isFinite_ofUInt32] at h ⊢; exact (hfin k h).1 have hRfin : ∀ k (h : k < R.size), Model.isFinite R[k] = true := fun k h => by simp [R, B, isFinite_ofUInt32] at h ⊢; exact (hfin k h).2 have hk : ∀ k, 0 ≤ k → k < 0 + L.size → expOf A[k]! ≠ 255 ∧ expOf B[k]! ≠ 255 := fun k _ h => by simp [L, A] at h; simp only [A, B, getElem!_ofFn n _ k h]; exact hfin k h have hd : ∀ i c, dsum A B i c = ∑ k ∈ Finset.range c, tm A[i + k]! B[i + k]! := fun i c => by induction c generalizing i with | zero => simp [dsum] | succ c ih => rw [dsum, ih (i + 1), Finset.sum_range_succ', add_comm] exact congrArg₂ _ (Finset.sum_congr rfl fun k _ => by rw [show i + 1 + k = i + (k + 1) by clear*-;omega]) rfl have hslice := (finiteDotSlice_eq A B 0 L.size (by simp [L]) (by simp [hLR, R]) hk).trans (c := (tsum n fa fb : ℚ) * 2 ^ (-298 : ℤ)) (by simp only [hd, tsum, L, A, B, Array.size_map, Array.size_ofFn]; congr 2; exact Finset.sum_congr rfl fun k hk => by simp at hk; simp [getElem!_ofFn n _ k hk]) have hx := Model.Reduction.Internal.dotState_exact_toRat (destination := Fmt) L R hLR by_cases hS : tsum n fa fb = 0 ·rw [hS, finishWord_zero, Model.Reduction.dot_status_eq_zero_of_finite Fmt L R .nearest hLR hLfin hRfin ((FloatLib.Numerics.Dyadic.toRat_eq_zero_iff _).1 (by rw [hx, hslice, hS]; simp))] obtain ⟨h1, h2⟩ := dotStateLoop_flags A B {} 0 L.size (by simp [L]) (by simp [hLR, R]) hk unfold Model.Reduction.Internal.dotState; rw [h1, h2] simp [L, A]; rfl ·rw [Model.Reduction.dot_status_eq_round_of_finite_nonzero Fmt L R .nearest hLR hLfin hRfin (by rw [Model.Reduction.Semantics.finiteDot_toList_eq_slice L R hLR, Ne, Except.ok.injEq, hslice]; simpa)] exact (finishWord_of_ne _ (tsum n fa fb) (-298) _ hS (by rw [hx, hslice])).symm theorem dotOf_round (n : Nat) (fa fb : Nat → Word) (hfin : finAll n fa fb) (hS : tsum n fa fb ≠ 0) : dotOf n fa fb = finishWord (tsum n fa fb) (-298) false := by simp [dotOf_val n fa fb hfin, finishWord, hS] @[inline] def nzW (w : UInt32) : UInt64 := if (w >>> 23) &&& 0xFF != 0 then 1 else 0 @[inline] def mW (w : UInt32) : UInt64 := (w &&& 0x7FFFFF).toUInt64 ||| (nzW w <<< 23) @[inline] def iW (w : UInt32) : UInt64 := ((w >>> 23) &&& 0xFF).toUInt64 - nzW w def sval (x : UInt64) : Int := x.toBitVec.toInt theorem mW_toNat (w : UInt32) : (mW w).toNat = mantOf w := by have hf : (w &&& 0x7FFFFF).toNat < 2 ^ 23 := by rw [UInt32.toNat_and]; exact lt_of_le_of_lt Nat.and_le_right (by decide) unfold mW nzW mantOf expOf fracOf by_cases he : (w >>> 23) &&& 0xFF = 0 ·simp [he] ·simp only [show ((w >>> 23) &&& 0xFF != 0) = true by simpa using he, he, ite_true, ite_false] rw [UInt64.toNat_or, UInt32.toNat_toUInt64, show ((1 : UInt64) <<< 23).toNat = 2 ^ 23 * 1 from rfl, Nat.or_comm, ← Nat.two_pow_add_eq_or_of_lt hf, Nat.mul_one, Nat.add_comm] theorem iW_toNat (w : UInt32) : (iW w).toNat = idxOf w := by unfold iW nzW idxOf expOf have hlt := expOf_toNat_lt w unfold expOf at hlt by_cases he : (w >>> 23) &&& 0xFF = 0 ·simp [he] ·have hpos : 1 ≤ ((w >>> 23) &&& 0xFF).toNat := Nat.one_le_iff_ne_zero.2 fun h => he (UInt32.toNat_inj.mp (by simpa using h)) simp only [show ((w >>> 23) &&& 0xFF != 0) = true by simpa using he, he, ite_true, ite_false] rw [UInt64.toNat_sub_of_le _ _ (UInt64.le_iff_toNat_le.mpr (by rw [UInt32.toNat_toUInt64]; simpa using hpos)), UInt32.toNat_toUInt64] rfl theorem signOf_iff (w : UInt32) : signOf w = true ↔ 2 ^ 31 ≤ w.toNat := by have := w.toNat_lt rw [signOf, bne_iff_ne, ne_eq, ← UInt32.toNat_inj, UInt32.toNat_and, show (0x80000000 : UInt32).toNat = 2 ^ 31 from rfl, Nat.and_two_pow, Nat.testBit_eq_decide_div_mod_eq] by_cases h : w.toNat / 2 ^ 31 % 2 = 1 <;> simp [h] <;> (clear*-h this;omega) theorem shr31_ne (w : UInt32) : (w >>> 31 != 0) = signOf w := by have := w.toNat_lt rw [Bool.eq_iff_iff, signOf_iff]; simp [← UInt32.toNat_inj, Nat.shiftRight_eq_div_pow] @[inline] def sx (k x : UInt64) : UInt64 := bif x >>> k == 0 then x else x >>> k @[inline] def sr (k x r : UInt64) : UInt64 := bif x >>> k == 0 then r else r + k @[inline] def fastLog2 (x0 : UInt64) : UInt64 := let x1 := sx 32 x0 let r1 := sr 32 x0 0 let x2 := sx 16 x1 let r2 := sr 16 x1 r1 let x3 := sx 8 x2 let r3 := sr 8 x2 r2 let x4 := sx 4 x3 let r4 := sr 4 x3 r3 let x5 := sx 2 x4 let r5 := sr 2 x4 r4 sr 1 x5 r5 @[inline] def rseB (value shift : UInt64) : UInt64 := let quotient := value >>> shift let remainder := value &&& ((1 <<< shift) - 1) let half := (1 : UInt64) <<< (shift - 1) quotient + (if remainder + (quotient &&& 1) > half then 1 else 0) @[inline] def rseAny (value shift : UInt64) : UInt64 := if shift == 0 then value else if shift < 64 then rseB value shift else if shift == 64 then (if value > 0x8000000000000000 then 1 else 0) else 0 @[inline] def mkW (sign : Bool) (e f : UInt32) : UInt32 := (if sign then (0x80000000 : UInt32) else 0) ||| ((e &&& 0xff) <<< 23) ||| (f &&& 0x007fffff) @[inline] def fracW (n : UInt64) : UInt32 := (if n < 0x800000 then 0 else n - 0x800000).toUInt32 @[inline] def rnd (sign : Bool) (product scale : UInt64) : UInt32 := if product == 0 then if sign then 0x80000000 else 0 else let leading := fastLog2 product let position := leading + scale if position < 172 then let fraction := if scale < 149 then rseAny product (149 - scale) else product <<< (scale - 149) if fraction == 0 then (if sign then 0x80000000 else 0) else if fraction == 0x800000 then mkW sign 1 0 else mkW sign 0 fraction.toUInt32 else let roundedMantissa := if leading < 23 then product <<< (23 - leading) else rseAny product (leading - 23) let carry := roundedMantissa == 0x1000000 let normalizedPosition := if carry then position + 1 else position if normalizedPosition > 425 then (if sign then 0xff800000 else 0x7f800000) else let normalizedMantissa := if carry then 0x800000 else roundedMantissa mkW sign (normalizedPosition - 171).toUInt32 (fracW normalizedMantissa) open Model.NativeBinary32 in theorem log2_shift (n k : Nat) (h : n >>> k ≠ 0) : n.log2 = k + (n >>> k).log2 := by rw [Nat.shiftRight_eq_div_pow] at * have := (Nat.le_log2 (by rintro rfl; simp at h)).2 (Nat.div_pos_iff.1 (Nat.pos_of_ne_zero h)).2 rw [Nat.log2_eq_log_two, Nat.log2_eq_log_two, Nat.log_div_base_pow] at *; omega theorem step (x0 r x k : UInt64) (hk : k.toNat ≤ 32) (hk0 : 0 < k.toNat) (hinv : x0.toNat.log2 = r.toNat + x.toNat.log2) (hb : x.toNat < 2 ^ (2 * k.toNat)) : x0.toNat.log2 = (sr k x r).toNat + (sx k x).toNat.log2 ∧ (sx k x).toNat < 2 ^ k.toNat := by have : x0.toNat.log2 < 64 := by by_cases h : x0.toNat = 0 <;> simp [h, Nat.log2_lt, x0.toNat_lt] have h6 : k.toNat % 64 = k.toNat := Nat.mod_eq_of_lt (by clear*-hk;omega) unfold sx sr by_cases hz : x >>> k = 0 <;> simp [hz, h6, hinv] ·simpa [h6, Nat.shiftRight_eq_div_pow, Nat.div_eq_zero_iff] using congrArg UInt64.toNat hz have := log2_shift x.toNat k.toNat (by simpa [← UInt64.toNat_inj, h6] using hz) refine ⟨by clear h6 hb hk hk0 hz;omega, ?_⟩ rw [Nat.shiftRight_eq_div_pow] exact Nat.div_lt_of_lt_mul (by rwa [← Nat.pow_add, show k.toNat + k.toNat = 2 * k.toNat by clear*-;omega]) theorem fastLog2_eq (x : UInt64) : fastLog2 x = x.log2 := by apply UInt64.toNat_inj.mp obtain ⟨e1, b1⟩ := step x 0 x 32 (by decide) (by decide) (by simp) x.toNat_lt obtain ⟨e2, b2⟩ := step x _ _ 16 (by decide) (by decide) e1 b1 obtain ⟨e3, b3⟩ := step x _ _ 8 (by decide) (by decide) e2 b2 obtain ⟨e4, b4⟩ := step x _ _ 4 (by decide) (by decide) e3 b3 obtain ⟨e5, b5⟩ := step x _ _ 2 (by decide) (by decide) e4 b4 obtain ⟨e6, b6⟩ := step x _ _ 1 (by decide) (by decide) e5 b5 rw [Nat.log2_def (sx 1 _).toNat, if_neg (by simpa using b6)] at e6 unfold fastLog2 exact e6.symm theorem rseAny_eq (value shift : UInt64) : rseAny value shift = FloatLib.Numerics.FixedWord.roundShiftRightEven value shift.toNat := by unfold rseAny FloatLib.Numerics.FixedWord.roundShiftRightEven by_cases h0 : shift = 0 ·subst h0; rfl have := shift.toNat_lt have h0' : shift.toNat ≠ 0 := by simpa [← UInt64.toNat_inj] using h0 simp only [h0, h0', beq_iff_eq, UInt64.ofNat_toNat, UInt64.lt_iff_toNat_lt, ↓reduceIte, show UInt64.ofNat (shift.toNat - 1) = shift - 1 from UInt64.toNat_inj.mp (by simp [UInt64.toNat_sub]; clear this;omega), show shift = 64 ↔ shift.toNat = 64 by rw [← UInt64.toNat_inj]; rfl] refine ite_congr rfl (fun hs => ?_) fun _ => rfl have : (value &&& ((1 <<< shift) - 1)).toNat < 2 ^ 63 := by have p2 : 2 ^ shift.toNat ≤ 2 ^ 63 := Nat.pow_le_pow_right two_pos (by clear this;omega) rw [UInt64.toNat_and, UInt64.toNat_sub_of_le, UInt64.toNat_shiftLeft] <;> simp [UInt64.le_iff_toNat_le, Nat.mod_eq_of_lt hs, Nat.one_shiftLeft, Nat.mod_eq_of_lt (by omega : 2 ^ shift.toNat < 18446744073709551616), Nat.one_le_two_pow] exact (Nat.mod_lt _ (Nat.two_pow_pos _)).trans_le p2 have : ((value >>> shift) &&& 1).toNat ≤ 1 := by simp [UInt64.toNat_and]; clear*-;omega have := (value >>> shift).toNat_lt simp only [rseB, gt_iff_lt, UInt64.lt_iff_toNat_lt, UInt64.toNat_add, beq_iff_eq, ← UInt64.toNat_inj, apply_ite UInt64.toNat, UInt64.toNat_one, UInt64.reduceToNat] generalize (value &&& ((1 <<< shift) - 1)).toNat = r at * generalize ((value >>> shift) &&& 1).toNat = b at * split_ifs <;> (clear h0 h0' hs;omega) theorem fracW_eq (n : UInt64) : fracW n = UInt32.ofNat (n.toNat - 0x800000) := by unfold fracW; split <;> simp_all [UInt64.toUInt32, Nat.toUInt32, UInt64.lt_iff_toNat_lt, UInt64.toNat_sub_of_le, UInt64.le_iff_toNat_le, Nat.sub_eq_zero_of_le, le_of_lt] open Model.NativeBinary32 in theorem toWord_native (w : UInt32) : toWord (ofUInt32 w) = w := by conv_rhs => rw [← toUInt32_ofUInt32 w] exact UInt32.toNat_inj.mp (Nat.mod_eq_of_lt (BitVec.isLt _)) open Model.NativeBinary32 in theorem rnd_eq (sign : Bool) (m scale : UInt64) (hs : scale.toNat ≤ 506) : rnd sign m scale = toWord (Model.roundDyadic Fmt ⟨sign, m.toNat, (scale.toNat : Int) - 298⟩) := by erw [← ofUInt32_roundDyadic, toWord_native, ← roundProduct_eq_roundDyadic _ _ _ hs] unfold rnd roundProduct mkW mkBits simp only [fastLog2_eq, rseAny_eq, fracW_eq, UInt64.toUInt32, Nat.toUInt32, FloatLib.Numerics.FixedWord.log2Word_eq_log2] rfl def val128 (hi lo : UInt64) : Int := sval hi * 2 ^ 64 + lo.toNat @[inline] def magLo (hi lo : UInt64) : UInt64 := if hi >>> 63 != 0 then (0 : UInt64) - lo else lo @[inline] def magHi (hi lo : UInt64) : UInt64 := if hi >>> 63 != 0 then (if lo == 0 then (0 : UInt64) - hi else ~~~hi) else hi theorem neg_iff (hi : UInt64) : (hi >>> 63 != 0) = decide (2 ^ 63 ≤ hi.toNat) := by have := hi.toNat_lt rw [Bool.eq_iff_iff]; simp [← UInt64.toNat_inj, Nat.shiftRight_eq_div_pow] theorem val128_eq (hi lo : UInt64) : val128 hi lo = (hi.toNat * 2 ^ 64 + lo.toNat : Int) - (if 2 ^ 63 ≤ hi.toNat then 2 ^ 128 else 0) := by unfold val128 sval rw [BitVec.toInt_eq_toNat_cond, UInt64.toNat_toBitVec] omega theorem mag_spec (hi lo : UInt64) : (val128 hi lo).natAbs = (magHi hi lo).toNat * 2 ^ 64 + (magLo hi lo).toNat ∧ decide (val128 hi lo < 0) = (hi >>> 63 != 0) := by have := hi.toNat_lt have := lo.toNat_lt unfold magHi magLo; rw [val128_eq, neg_iff] by_cases hn : 2 ^ 63 ≤ hi.toNat <;> simp only [hn, decide_true, decide_false, ite_true, ite_false, Bool.false_eq_true] ·split <;> simp_all [UInt64.size, UInt64.toNat_not, ← UInt64.toNat_inj] <;> omega ·simp; clear*-;omega @[inline] def fin128 (hi lo B : UInt64) : UInt64 := if hi == 0 && lo == 0 then 0x100000000 else if B > 442 then 0x100000000 else let neg := hi >>> 63 != 0 let mlo := magLo hi lo let mhi := magHi hi lo if mhi == 0 then (rnd neg mlo B).toUInt64 else if mhi >>> 32 == 0 then let q := (mhi <<< 32) + (mlo >>> 32) (rnd neg (if mlo &&& 0xFFFFFFFF == 0 then q else q ||| 1) (B + 32)).toUInt64 else (rnd neg (if mlo == 0 then mhi else mhi ||| 1) (B + 64)).toUInt64 theorem dotOf_of_fin128 (n : Nat) (fa fb : Nat → Word) (hi lo B : UInt64) (hfin : finAll n fa fb) (hval : tsum n fa fb = val128 hi lo * 2 ^ B.toNat) (h : fin128 hi lo B < 0x100000000) : dotOf n fa fb = (fin128 hi lo B).toUInt32 := by obtain ⟨hmag, hneg⟩ := mag_spec hi lo have := lo.toNat_lt have := hi.toNat_lt simp only [fin128] at h ⊢ have hz : ¬(hi == 0 && lo == 0) = true := fun c => by simp [c] at h have hB : ¬B > 442 := fun c => by simp [c] at h simp only [hz, hB, Bool.false_eq_true, ↓reduceIte] clear h have hS : tsum n fa fb ≠ 0 := by rw [hval]; refine mul_ne_zero (fun h0 => hz ?_) (by positivity) rw [val128_eq] at h0; simp only [Bool.and_eq_true, beq_iff_eq, ← UInt64.toNat_inj, UInt64.toNat_zero]; split at h0 <;> (clear hB hfin hmag hneg hval hz;omega) rw [dotOf_round n fa fb hfin hS, finishWord_of_ne (ofIntDyadic (val128 hi lo) ((B.toNat : Int) - 298)) _ _ _ hS (by rw [toRat_ofIntDyadic, hval]; push_cast; rw [zpow_sub₀ two_ne_zero, zpow_natCast]; field_simp), ofIntDyadic, hneg, hmag] symm simp only [apply_ite UInt64.toUInt32, UInt32.toUInt32_toUInt64] generalize magHi hi lo = mh at * generalize magLo hi lo = ml at * have := ml.toNat_lt simp only [UInt64.lt_iff_toNat_lt, gt_iff_lt, UInt64.reduceToNat, not_lt] at hB split <;> rename_i h0 <;> simp only [beq_iff_eq, ← UInt64.toNat_inj, UInt64.toNat_zero] at h0 ·simp [h0, rnd_eq _ _ B (by clear*-hB;omega)] split <;> rename_i h1 <;> simp [← UInt64.toNat_inj, Nat.shiftRight_eq_div_pow] at h1 ·rw [rnd_eq _ _ _ (by simp [UInt64.toNat_add]; clear*-hB;omega), ← roundDyadic_jam _ (mh.toNat * 2 ^ 64 + ml.toNat) _ 32 ((Nat.le_log2 (by clear*-h0;omega)).2 (by clear*-h0;omega))] congr 3 swap; · simp [UInt64.toNat_add]; clear*-hB;omega have e1 : (mh.toNat * 2 ^ 64 + ml.toNat) / 2 ^ 32 = (mh <<< 32 + ml >>> 32).toNat := by simp [Nat.shiftLeft_eq, Nat.shiftRight_eq_div_pow]; clear*-h1 this;omega have e2 : (mh.toNat * 2 ^ 64 + ml.toNat) % 2 ^ 32 = (ml &&& 4294967295).toNat := by rw [UInt64.toNat_and, show (4294967295 : UInt64).toNat = 2 ^ 32 - 1 from rfl, Nat.and_two_pow_sub_one_eq_mod]; clear*-;omega simp only [FloatLib.Numerics.shiftRightJam, UInt64.reduceToNat, e1, e2, apply_ite UInt64.toNat, UInt64.toNat_or, beq_iff_eq, ← UInt64.toNat_inj] ·rw [rnd_eq _ _ _ (by simp [UInt64.toNat_add]; clear*-hB;omega), ← roundDyadic_jam _ (mh.toNat * 2 ^ 64 + ml.toNat) _ 64 ((Nat.le_log2 (by clear*-h1;omega)).2 (by clear*-h1;omega))] congr 3 swap; · simp [UInt64.toNat_add]; clear*-hB;omega simp only [FloatLib.Numerics.shiftRightJam, UInt64.reduceToNat, show (mh.toNat * 2 ^ 64 + ml.toNat) / 2 ^ 64 = mh.toNat by clear*-this;omega, show (mh.toNat * 2 ^ 64 + ml.toNat) % 2 ^ 64 = ml.toNat by clear*-this;omega, apply_ite UInt64.toNat, UInt64.toNat_or, beq_iff_eq, ← UInt64.toNat_inj] @[inline] def rne39 (N : UInt64) : UInt64 := (N + (0x3FFFFFFFFF : UInt64) + ((N >>> 39) &&& 1)) >>> 39 @[inline] def fin64 (lb v B : UInt64) : UInt64 := let m := magLo v v let L := fastLog2 m let E := L + B - 172 if m - lb < 0x8000000000000000 - lb ∧ E < 253 then ((v >>> 63) <<< 31) + ((E <<< 23) + rne39 (m <<< (62 - L))) else 0x100000000 @[inline] def fin128F (hi lo B : UInt64) : UInt64 := let r := if hi = (0 : UInt64) - (lo >>> 63) then fin64 1 lo B else 0x100000000 if r = 0x100000000 then fin128 hi lo B else r theorem mkW_nat (n : Bool) (e f : UInt32) : (mkW n e f).toNat = (if n then 2 ^ 31 else 0) + e.toNat % 2 ^ 8 * 2 ^ 23 + f.toNat % 2 ^ 23 := by have h3 := Nat.mod_lt f.toNat (Nat.two_pow_pos 23) have := Nat.mod_lt e.toNat (Nat.two_pow_pos 8) have hx : ((e &&& 0xff) <<< 23 ||| (f &&& 0x007fffff)).toNat = 2 ^ 23 * (e.toNat % 2 ^ 8) + f.toNat % 2 ^ 23 := by rw [UInt32.toNat_or, UInt32.toNat_shiftLeft, UInt32.toNat_and, UInt32.toNat_and, show (0xff : UInt32).toNat = 2 ^ 8 - 1 from rfl, show (0x007fffff : UInt32).toNat = 2 ^ 23 - 1 from rfl, Nat.and_two_pow_sub_one_eq_mod, Nat.and_two_pow_sub_one_eq_mod, show (23 : UInt32).toNat % 32 = 23 from rfl, Nat.shiftLeft_eq, Nat.mul_comm, Nat.mod_eq_of_lt (by simp; clear*-;omega), ← Nat.two_pow_add_eq_or_of_lt h3] unfold mkW rw [UInt32.or_assoc] cases n <;> simp only [Bool.false_eq_true, ↓reduceIte, UInt32.zero_or, UInt32.toNat_or, hx] ·clear*-;omega ·rw [show (0x80000000 : UInt32).toNat = 2 ^ 31 * 1 from rfl, ← Nat.two_pow_add_eq_or_of_lt (by clear*-this;omega)]; clear*-;omega theorem rnd62n (n : Bool) (N sc : UInt64) (h1 : 2 ^ 62 ≤ N.toNat) (h2 : N.toNat < 2 ^ 63) (hs : 110 ≤ sc.toNat) (hs2 : sc.toNat < 363) : (rnd n N sc).toNat = (if n then 2 ^ 31 else 0) + ((sc.toNat - 110) * 2 ^ 23 + (rne39 N).toNat) ∧ 2 ^ 23 ≤ (rne39 N).toNat ∧ (rne39 N).toNat ≤ 2 ^ 24 := by have hq : (N >>> 39).toNat = N.toNat / 2 ^ 39 := by simp [Nat.shiftRight_eq_div_pow] have hb : ((N >>> 39) &&& 1).toNat = N.toNat / 2 ^ 39 % 2 := by simp [hq, Nat.and_one_is_mod] have hr : (rne39 N).toNat = N.toNat / 2 ^ 39 + if 2 ^ 38 < N.toNat % 2 ^ 39 + N.toNat / 2 ^ 39 % 2 then 1 else 0 := by unfold rne39; simp (disch := omega) only [UInt64.toNat_shiftRight, UInt64.toNat_add, hb, UInt64.reduceToNat, Nat.shiftRight_eq_div_pow, Nat.reducePow, Nat.mod_eq_of_lt] generalize N.toNat = x; clear * -; split <;> omega have hq1 : 2 ^ 23 ≤ N.toNat / 2 ^ 39 ∧ N.toNat / 2 ^ 39 < 2 ^ 24 := by clear * - h1 h2; omega have hR : (rseAny N (62 - 23)).toNat = (rne39 N).toNat ∧ 2 ^ 23 ≤ (rne39 N).toNat ∧ (rne39 N).toNat ≤ 2 ^ 24 := by have ha : (N &&& 0x7FFFFFFFFF).toNat = N.toNat % 2 ^ 39 := by rw [UInt64.toNat_and]; exact Nat.and_two_pow_sub_one_eq_mod _ 39 rw [hr]; show (rseB N 39).toNat = _ ∧ _; unfold rseB simp only [show ((1 : UInt64) <<< 39) - 1 = 0x7FFFFFFFFF from rfl, show (1 : UInt64) <<< (39 - 1) = 0x4000000000 from rfl, gt_iff_lt, UInt64.lt_iff_toNat_lt, UInt64.toNat_add, ha, hb, hq, apply_ite UInt64.toNat, UInt64.reduceToNat] clear * - hq1; split_ifs <;> omega refine ⟨?_, hR.2⟩ unfold rnd simp only [show fastLog2 N = 62 by rw [fastLog2_eq, ← UInt64.toNat_inj]; exact (Nat.log2_eq_iff (by clear*-h1;omega : N.toNat ≠ 0)).2 ⟨h1, h2⟩, show (N == 0) = false by simp [← UInt64.toNat_inj]; clear*-h1;omega, show ¬62 + sc < 172 by simp [UInt64.lt_iff_toNat_lt]; clear*-hs hs2;omega, show ¬(62 : UInt64) < 23 by decide, ite_false, Bool.false_eq_true] obtain ⟨hR, hb⟩ := hR generalize rseAny N (62 - 23) = R at hR ⊢ rw [← hR] at hb ⊢ clear * - hb hs hs2 by_cases hc : R.toNat = 16777216 <;> simp [hc, ← UInt64.toNat_inj, fracW_eq, UInt64.lt_iff_toNat_lt] <;> split <;> (try omega) <;> simp [mkW_nat, UInt32.toNat_sub, UInt32.toNat_add] <;> (clear*-hb hc hs hs2;omega) theorem rnd_fw (n : Bool) (M σ : UInt64) (hM : M.toNat ≠ 0) (hσ : σ.toNat ≤ 506) : rnd n M σ = finishWord ((if n then -(M.toNat : Int) else M.toNat) * 2 ^ σ.toNat) (-298) false := by rw [rnd_eq _ _ _ hσ] refine (finishWord_of_ne _ _ _ _ (mul_ne_zero (by split <;> (clear*-hM;omega)) (by positivity)) ?_).symm cases n <;> simp [FloatLib.Numerics.Dyadic.toRat, FloatLib.Numerics.Dyadic.signedSignificand, zpow_sub₀] <;> field_simp theorem fin128F_eq (hi lo B : UInt64) : fin128F hi lo B = fin128 hi lo B := by unfold fin128F; dsimp only split_ifs with hh h <;> try rfl swap; contradiction subst hh have hq : lo >>> 63 = 0 ∨ lo >>> 63 = 1 := by have := lo.toNat_lt; simp [← UInt64.toNat_inj, Nat.shiftRight_eq_div_pow]; omega simp only [fin64] at * split_ifs at * with hc swap; contradiction generalize hm : magLo lo lo = m at * have hl : (fastLog2 m).toNat = m.toNat.log2 := by rw [fastLog2_eq]; rfl generalize fastLog2 m = L at * have := m.toNat_lt have := B.toNat_lt simp only [UInt64.lt_iff_toNat_lt, UInt64.toNat_sub, UInt64.toNat_add, hl, UInt64.reduceToNat] at hc have hm0 : m.toNat ≠ 0 := by clear*-hc;omega have hl1 := Nat.log2_self_le hm0 have hl2 := @Nat.lt_log2_self m.toNat have := (Nat.log2_lt hm0).2 (by clear h hl hl1 hl2 hm hm0 hq this;omega : m.toNat < 2 ^ 63) generalize m.toNat.log2 = l at * replace hc : 172 ≤ l + B.toNat ∧ l + B.toNat < 425 := by clear h hl hl1 hl2 hm hm0 hq;omega have hf : fin128 ((0 : UInt64) - (lo >>> 63)) lo B = (rnd (lo >>> 63 != 0) m B).toUInt64 := by have hv : lo ≠ 0 := by rintro rfl; subst hm; simp [magLo] at hm0 have hB : ¬442 < B.toNat := by clear*-hc;omega rw [← hm]; unfold fin128 magHi magLo rcases hq with e | e <;> simp +decide [e, hv, hB, UInt64.lt_iff_toNat_lt] <;> rfl rw [hf] have hj : (62 - L).toNat = 62 - l := by simp [UInt64.toNat_sub, hl]; clear*-this;omega have hs : (B - (62 - L)).toNat = B.toNat - (62 - l) := by simp [UInt64.toNat_sub, hj]; clear*-hc this;omega have e := Nat.mul_le_mul_right (2 ^ (62 - l)) hl1 have e' := Nat.mul_lt_mul_of_pos_right hl2 (Nat.two_pow_pos (62 - l)) rw [← pow_add, show l + (62 - l) = 62 by clear*-this;omega] at e rw [← pow_add, show l + 1 + (62 - l) = 63 by clear*-this;omega] at e' have hN : (m <<< (62 - L)).toNat = m.toNat * 2 ^ (62 - l) := by simp [hj, Nat.shiftLeft_eq, Nat.mod_eq_of_lt (by clear*-;omega : 62 - l < 64)]; clear*-e';omega obtain ⟨r1, r2⟩ := rnd62n (lo >>> 63 != 0) (m <<< (62 - L)) (B - (62 - L)) (by clear*-e hN;omega) (by clear*-e' hN;omega) (by clear*-hc hs this;omega) (by clear*-hc hs this;omega) have e3 : rnd (lo >>> 63 != 0) m B = rnd (lo >>> 63 != 0) (m <<< (62 - L)) (B - (62 - L)) := by rw [rnd_fw _ m B hm0 (by clear*-hc;omega), rnd_fw, hN, hs, ← pow_sub_mul_pow (2:ℤ) (by clear*-hc this;omega : 62 - l ≤ B.toNat)] split <;> push_cast <;> ring_nf all_goals clear*-e hN hc hs this;omega rw [← UInt64.toNat_inj, UInt32.toNat_toUInt64, e3, r1, hs] rcases hq with e | e <;> simp [e, UInt64.toNat_add, UInt64.toNat_shiftLeft, UInt64.toNat_sub, hl] <;> (clear*-hc r2 this;omega) end Core theorem toWord_ofW (w : Word) : toWord (ofW w) = w := by apply UInt32.toNat_inj.mp simp only [toWord, ofW, Model.toNatBits, ofUInt32_bits, UInt32.toNat_ofNat'] exact Nat.mod_eq_of_lt w.toBitVec.isLt theorem ofW_toWord (z : Model Fmt) : ofW (toWord z) = z := by have h : z.toNatBits < 2 ^ 32 := Model.toNatBits_lt_two_pow z simp only [ofW, toWord, Model.ofUInt32, UInt32.toNat_ofNat', Nat.mod_eq_of_lt h] exact Model.ofNatBits_toNatBits z namespace Dense theorem usucc {k n : USize} (h : k < n) : (k + 1).toNat = k.toNat + 1 := by have := USize.lt_iff_toNat_lt.mp h; have := n.toNat_lt_size; have := USize.size_eq_two_pow rw [USize.toNat_add, USize.toNat_one, Nat.mod_eq_of_lt (by omega)] theorem uadd {a b : USize} (h : a.toNat + b.toNat < USize.size) : (a + b).toNat = a.toNat + b.toNat := by rw [USize.toNat_add, Nat.mod_eq_of_lt h] theorem toUSize_toNat {n : Nat} (h : n < USize.size) : n.toUSize.toNat = n := by rw [Nat.toUSize_eq, USize.toNat_ofNat_of_lt' h] theorem u32_toUSize (x : UInt32) : x.toUSize.toNat = x.toNat := by simp [UInt32.toNat_toUSize] theorem uget_eq (A : Array UInt32) (u : USize) (h : u.toNat < A.size) : A.uget u h = A[u.toNat]! := by simp_all theorem sval_eq (p : UInt64) : Core.sval p = (p.toNat : Int) - (if 2 ^ 63 ≤ p.toNat then 2 ^ 64 else 0) := by unfold Core.sval; rw [BitVec.toInt_eq_toNat_cond, UInt64.toNat_toBitVec] split <;> split <;> push_cast <;> omega @[inline] def absW (x : UInt32) : UInt32 := x &&& 0x7FFFFFFF theorem absA (x : UInt32) : (absW x).toNat = x.toNat % 2 ^ 31 := by unfold absW; rw [UInt32.toNat_and]; exact Nat.and_two_pow_sub_one_eq_mod _ 31 theorem expA (x : UInt32) : (expOf x).toNat = (absW x).toNat / 2 ^ 23 := by have : (expOf x).toNat = x.toNat / 2 ^ 23 % 2 ^ 8 := by unfold expOf; rw [UInt32.toNat_and, UInt32.toNat_shiftRight] simp only [UInt32.reduceToNat, Nat.reduceMod, Nat.shiftRight_eq_div_pow] exact Nat.and_two_pow_sub_one_eq_mod _ 8 rw [this, absA, show 2 ^ 31 = 2 ^ 23 * 2 ^ 8 by norm_num, Nat.mod_mul_right_div_self] theorem exp0 (x : UInt32) : expOf x = 0 ↔ (absW x).toNat < 2 ^ 23 := by rw [← UInt32.toNat_inj, expA]; simp; try omega theorem idxA (x : UInt32) : idxOf x = (absW x).toNat / 2 ^ 23 - 1 := by have := expA x; unfold idxOf; split <;> rename_i h ·have := (exp0 x).mp h; clear*-this;omega ·have := mt (exp0 x).mpr h; omega theorem idxE (x : UInt32) : idxOf x = (expOf x).toNat - 1 := by rw [idxA, expA] theorem wdiv (w : UInt32) : w.toNat / 2 ^ 23 = (expOf w).toNat + 256 * (w.toNat / 2 ^ 31) := by rw [expA, absA]; have := w.toNat_lt; omega theorem expL (x : UInt32) : (expOf x).toNat < 256 := by rw [expA, absA]; omega theorem fr23 (w : UInt32) : (w &&& 0x7FFFFF).toNat = w.toNat % 2 ^ 23 := by rw [UInt32.toNat_and]; exact Nat.and_two_pow_sub_one_eq_mod _ 23 theorem sv_abs (w : UInt32) : |sv w| < 2 ^ 24 := by have := mantOf_lt_24 w; unfold sv; split <;> simp <;> omega def lz (y n : UInt64) : UInt64 := if y = 0 then n else lz (y >>> 1) (n + 1) termination_by y.toNat decreasing_by have : y.toNat ≠ 0 := fun e => by simp_all [← UInt64.toNat_inj] rw [UInt64.toNat_shiftRight]; simp [Nat.shiftRight_eq_div_pow]; omega abbrev bl (k : Nat) : Nat := if k = 0 then 0 else k.log2 + 1 theorem bl_le (y : UInt64) : bl y.toNat ≤ 64 := by unfold bl; split; · omega rename_i h; have := (Nat.log2_lt h).mpr y.toNat_lt; omega theorem shr1 (y : UInt64) : (y >>> 1).toNat = y.toNat / 2 := by rw [UInt64.toNat_shiftRight]; simp [Nat.shiftRight_eq_div_pow] theorem bl_half (k : Nat) : bl (k / 2) = k.log2 := by unfold bl; rw [Nat.log2_def k]; by_cases h2 : 2 ≤ k ·rw [if_neg (by omega), if_pos h2] ·rw [if_pos (by omega), if_neg h2] theorem lz_spec (y n : UInt64) (h : n.toNat + bl y.toNat ≤ 64) : (lz y n).toNat = n.toNat + bl y.toNat := by rw [lz] by_cases hy : y = 0 ·rw [if_pos hy]; subst hy; simp ·rw [if_neg hy] have hy' : y.toNat ≠ 0 := fun e => hy (UInt64.toNat_inj.mp (by simpa using e)) have hb : bl y.toNat = bl (y.toNat / 2) + 1 := by rw [bl_half]; simp [bl, hy'] have hn : (n + 1).toNat = n.toNat + 1 := by rw [UInt64.toNat_add]; simp; clear hb;omega rw [lz_spec (y >>> 1) (n + 1) (by rw [hn, shr1]; clear hn;omega), hn, shr1]; omega termination_by y.toNat decreasing_by rw [shr1]; clear*-hy';omega @[inline] def lg (x : UInt64) : UInt64 := lz (x >>> 1) 0 theorem lg_eq (x : UInt64) : lg x = x.log2 := by apply UInt64.toNat_inj.mp rw [lg, lz_spec _ _ (by have := bl_le (x >>> 1); simpa using this), shr1, bl_half, UInt64.toNat_zero, Nat.zero_add]; rfl @[inline] def fin64Z (lb v B : UInt64) : UInt64 := let m := Core.magLo v v let L := lg m let E := L + B - 172 if m - lb < 0x8000000000000000 - lb ∧ E < 253 then ((v >>> 63) <<< 31) + ((E <<< 23) + Core.rne39 (m <<< (62 - L))) else 0x100000000 theorem fin64Z_eq : fin64Z = Core.fin64 := by funext lb v B; simp only [fin64Z, Core.fin64, Core.fastLog2_eq, lg_eq] @[inline] def fin128FZ (hi lo B : UInt64) : UInt64 := let r := if hi = (0 : UInt64) - (lo >>> 63) then fin64Z 1 lo B else 0x100000000 if r = 0x100000000 then Core.fin128 hi lo B else r theorem fin128FZ_eq : fin128FZ = Core.fin128F := by funext hi lo B; simp only [fin128FZ, Core.fin128F, fin64Z_eq] theorem ulen {k : USize} {a : Array UInt32} (h : k < a.usize) : k.toNat < a.size := by have := USize.lt_iff_toNat_lt.mp h; rw [Array.usize, Nat.toUSize_eq, USize.toNat_ofNat'] at this exact lt_of_lt_of_le this (Nat.mod_le _ _) @[inline] def x2a (h l m s : UInt64) : UInt64 × UInt64 := let l' := l + (m <<< s) (h + (m >>> 1 >>> (63 - s)) + (if l' < l then 1 else 0), l') theorem x2a_spec (h l m s : UInt64) (hs : s.toNat ≤ 60) (hb : h.toNat * 2 ^ 64 + l.toNat + m.toNat * 2 ^ s.toNat < 2 ^ 128) : (x2a h l m s).1.toNat * 2 ^ 64 + (x2a h l m s).2.toNat = h.toNat * 2 ^ 64 + l.toNat + m.toNat * 2 ^ s.toNat := by have e1 : (63 - s).toNat = 63 - s.toNat := by rw [UInt64.toNat_sub_of_le _ _ (by simp [UInt64.le_iff_toNat_le]; omega)]; rfl have e2 : m.toNat / 2 / 2 ^ (63 - s.toNat) = m.toNat * 2 ^ s.toNat / 2 ^ 64 := by rw [Nat.div_div_eq_div_mul, show (2 : Nat) ^ 64 = 2 ^ 1 * 2 ^ (63 - s.toNat) * 2 ^ s.toNat by rw [← pow_add, ← pow_add]; congr 1; clear*-hs;omega, pow_one, Nat.mul_div_mul_right _ _ (by positivity : 0 < 2 ^ s.toNat)] have := h.toNat_lt; have := l.toNat_lt simp only [x2a, UInt64.lt_iff_toNat_lt, UInt64.toNat_add, UInt64.toNat_shiftLeft, UInt64.toNat_shiftRight, e1, Nat.shiftLeft_eq, Nat.shiftRight_eq_div_pow, Nat.mod_eq_of_lt (by clear*-hs;omega : s.toNat < 64), Nat.mod_eq_of_lt (by clear*-;omega : 63 - s.toNat < 64), UInt64.reduceToNat, Nat.reduceMod, pow_one, e2] split <;> simp only [UInt64.reduceToNat] <;> (clear e1 e2 hs;omega) @[specialize] def x2m (fa fb : Nat → Word) (n t : Nat) (B : UInt64) : UInt64 := if t < n then x2m fa fb n (t + 1) (if Core.mW (fa t) * Core.mW (fb t) == 0 then B else min B (Core.iW (fa t) + Core.iW (fb t))) else B termination_by n - t @[specialize] def x2l (fa fb : Nat → Word) (n : Nat) (B : UInt64) (t : Nat) (pH pL nH nL : UInt64) : UInt64 := if t < n then let a := fa t let b := fb t let m := Core.mW a * Core.mW b let e := Core.iW a + Core.iW b if expOf a == 255 || expOf b == 255 || m != 0 && (e < B || 60 < e - B) then 0x100000000 else if m == 0 then x2l fa fb n B (t + 1) pH pL nH nL else let g := signOf a == signOf b let q := x2a (if g then pH else nH) (if g then pL else nL) m (e - B) x2l fa fb n B (t + 1) (if g then q.1 else pH) (if g then q.2 else pL) (if g then nH else q.1) (if g then nL else q.2) else Core.fin128 (pH - nH - (if pL < nL then 1 else 0)) (pL - nL) B termination_by n - t theorem x2v (pH pL nH nL : UInt64) (hP : pH.toNat * 2 ^ 64 + pL.toNat < 2 ^ 126) (hN : nH.toNat * 2 ^ 64 + nL.toNat < 2 ^ 126) : Core.val128 (pH - nH - (if pL < nL then 1 else 0)) (pL - nL) = ((pH.toNat * 2 ^ 64 + pL.toNat : Nat) : Int) - ((nH.toNat * 2 ^ 64 + nL.toNat : Nat) : Int) := by have Z:(pH-nH-(if pL(clear hN hP;omega) have:=pL.toNat_lt;have:=nL.toNat_lt;have:=pH.toNat_lt;have:=nH.toNat_lt;have:=(pH-nH).toNat_lt;have:=(pH-nH-1).toNat_lt;have:=(pL-nL).toNat_lt have a:=F pL nL;have b:=F pH nH;have c:=F (pH-nH) 1;clear F hP hN;simp only[UInt64.lt_iff_toNat_lt,UInt64.toNat_one] at*;split_ifs at a b c⊢<;>(try simp only[UInt64.sub_zero])<;>omega rw[Core.val128_eq];have:=(pL-nL).toNat_lt;have:=(pH-nH-(if pLsplit at *<;>push_cast<;>omega theorem x2l_spec (fa fb : Nat → Word) (n : Nat) (B : UInt64) (hn : n < 2 ^ 18) : ∀ k t (pH pL nH nL : UInt64), n - t = k → t ≤ n → Core.finAll t fa fb → pH.toNat * 2 ^ 64 + pL.toNat ≤ t * 2 ^ 108 → nH.toNat * 2 ^ 64 + nL.toNat ≤ t * 2 ^ 108 → Core.tsum t fa fb = (((pH.toNat * 2 ^ 64 + pL.toNat : Nat) : Int) - ((nH.toNat * 2 ^ 64 + nL.toNat : Nat) : Int)) * 2 ^ B.toNat → x2l fa fb n B t pH pL nH nL < 0x100000000 → dotOf n fa fb = (x2l fa fb n B t pH pL nH nL).toUInt32 := by intro k; induction k <;> intro t pH pL nH nL hk ht hf hP hN hT hr ·obtain rfl : t = n := by clear*-hk ht;omega rw [x2l, if_neg (by clear*-;omega)] at hr ⊢ exact Core.dotOf_of_fin128 _ _ _ _ _ _ hf (by rw [hT, x2v _ _ _ _ (by clear*-hP hn;omega) (by clear*-hN hn;omega)]) hr rename_i k ih have htn : t < n := by clear*-hk;omega have hk' : n - (t + 1) = k := by clear*-hk htn;omega have ht' : t + 1 ≤ n := by clear*-htn;omega rw [x2l, if_pos htn] at hr ⊢; dsimp only at hr ⊢ split at hr; · exact absurd hr (by decide) rename_i hx rw [if_neg hx] simp only [Bool.or_eq_true, beq_iff_eq, Bool.and_eq_true, bne_iff_ne, ne_eq, decide_eq_true_eq, not_or, not_and, UInt64.lt_iff_toNat_lt, UInt64.reduceToNat] at hx obtain ⟨⟨hxa, hxb⟩, hw⟩ := hx have hf' : Core.finAll (t + 1) fa fb := fun s hs => (Nat.lt_succ_iff_lt_or_eq.mp hs).elim (hf s) fun e => e ▸ ⟨hxa, hxb⟩ have hm48 : mantOf (fa t) * mantOf (fb t) < 2 ^ 48 := (Nat.mul_lt_mul'' (mantOf_lt_24 _) (mantOf_lt_24 _)).trans_eq (by norm_num) have hm : (Core.mW (fa t) * Core.mW (fb t)).toNat = mantOf (fa t) * mantOf (fb t) := by rw [UInt64.toNat_mul, Core.mW_toNat, Core.mW_toNat, Nat.mod_eq_of_lt (hm48.trans (by norm_num))] have hts := Core.tsum_succ t fa fb have hle := Nat.mul_le_mul_right (2 ^ 108) t.le_succ split at hr ·rename_i h0 rw [if_pos h0] have h0' : mantOf (fa t) * mantOf (fb t) = 0 := by rw [← hm, beq_iff_eq.mp h0]; rfl refine ih (t + 1) pH pL nH nL hk' ht' hf' (hP.trans hle) (hN.trans hle) ?_ hr rw [hts, hT, add_eq_left]; unfold Core.tm sv; rcases Nat.mul_eq_zero.mp h0' with h | h <;> simp [h] rename_i h0 rw [if_neg h0] obtain ⟨hB, hDw⟩ := hw fun h => h0 (by simp [h]) have hia := idxOf_le _ hxa; have hib := idxOf_le _ hxb have he : (Core.iW (fa t) + Core.iW (fb t)).toNat = idxOf (fa t) + idxOf (fb t) := by rw [UInt64.toNat_add, Core.iW_toNat, Core.iW_toNat, Nat.mod_eq_of_lt (by clear*-hia hib;omega)] rw [he] at hB have hs : (Core.iW (fa t) + Core.iW (fb t) - B).toNat = idxOf (fa t) + idxOf (fb t) - B.toNat := by rw [UInt64.toNat_sub_of_le _ _ (by rw [UInt64.le_iff_toNat_le, he]; clear*-hB;omega), he] rw [hs] at hDw have hsc : (2 : Int) ^ (idxOf (fa t) + idxOf (fb t)) = 2 ^ (idxOf (fa t) + idxOf (fb t) - B.toNat) * 2 ^ B.toNat := by rw [← pow_add]; congr 1; clear*-hB;omega generalize hT0 : (mantOf (fa t) * mantOf (fb t)) * 2 ^ (idxOf (fa t) + idxOf (fb t) - B.toNat) = T have hpow : T ≤ 2 ^ 108 := hT0 ▸ (Nat.mul_le_mul hm48.le (Nat.pow_le_pow_right (by norm_num) (by clear*-hDw;omega : _ ≤ 60))).trans_eq (by norm_num) have htm : Core.tm (fa t) (fb t) = (if signOf (fa t) == signOf (fb t) then (T : Int) else -T) * 2 ^ B.toNat := by rw [← hT0]; unfold Core.tm sv; rw [hsc] cases signOf (fa t) <;> cases signOf (fb t) <;> simp <;> ring have hq := fun H L (hHL : H.toNat * 2 ^ 64 + L.toNat ≤ t * 2 ^ 108) => x2a_spec H L _ _ (by rw [hs]; clear*-hDw;omega) (by rw [hm, hs, hT0]; clear*-hHL hn hpow htn;omega) rw [hm, hs, hT0] at hq cases hg : (signOf (fa t) == signOf (fb t)) <;> simp only [hg, ite_true, ite_false, Bool.false_eq_true] at htm hr ⊢ ·have q := hq nH nL hN refine ih (t + 1) pH pL _ _ hk' ht' hf' (hP.trans hle) (by rw [q]; exact Nat.succ_mul t _ ▸ Nat.add_le_add hN hpow) ?_ hr rw [hts, hT, q, htm]; push_cast; ring ·have q := hq pH pL hP refine ih (t + 1) _ _ nH nL hk' ht' hf' (by rw [q]; exact Nat.succ_mul t _ ▸ Nat.add_le_add hP hpow) (hN.trans hle) ?_ hr rw [hts, hT, q, htm]; push_cast; ring @[noinline] def pdot (n : Nat) (fa fb : Nat → Word) : Word := Pinned.dotFn n fa fb theorem pdot_eq (n : Nat) (fa fb : Nat → Word) : pdot n fa fb = dotOf n fa fb := by unfold pdot; rw [Pinned.dotFn_eq_dotOf] @[inline] def x2d (n : Nat) (fa fb : Nat → Word) : Word := let r := if n < 262144 then x2l fa fb n (x2m fa fb n 0 1023) 0 0 0 0 0 else 0x100000000 if r < 0x100000000 then r.toUInt32 else pdot n fa fb theorem x2d_eq (n : Nat) (fa fb : Nat → Word) : x2d n fa fb = dotOf n fa fb := by unfold x2d; dsimp only by_cases hn : n < 262144 ·rw [if_pos hn]; split ·exact (x2l_spec fa fb n _ (by omega) _ 0 0 0 0 0 rfl (by clear hn;omega) (fun _ h => absurd h (by omega)) (by simp) (by simp) (by simp [Core.tsum]) ‹_›).symm ·exact pdot_eq n fa fb ·rw [if_neg hn, if_neg (by decide)]; exact pdot_eq n fa fb @[noinline] def cellF0 (n : Nat) (relu : Bool) (X W b : @& Array Word) (xo s j : Nat) : Word := act relu (x2d (n + 1) (fun t => if t < n then X[xo + t * s]! else oneW) (fun t => if t < n then W[j * n + t]! else b[j]!)) theorem dzNZ (a b : Array UInt32) : ∀ (c i j : Nat), i ≤ j → j < i + c → Bool.xor (signOf a[j]!) (signOf b[j]!) = false → dallNZ a b i c = false := by intro c induction c with | zero => intro i j h1 h2; omega | succ c ih => intro i j h1 h2 hx rw [dallNZ] by_cases hj : j = i ·subst hj; rw [hx]; simp ·rw [ih (i + 1) j (by omega) (by omega) hx]; simp def zrow (X W : Array Word) (xo s wo : Nat) : Nat → Nat → Bool | _, 0 => true | i, c + 1 => ((X[xo + i * s]! == 0 || X[xo + i * s]! == 0x80000000) && expOf W[wo + i]! != 255) && zrow X W xo s wo (i + 1) c theorem zrow_spec (X W : Array Word) (xo s wo : Nat) : ∀ (c i : Nat), zrow X W xo s wo i c = true → ∀ j, i ≤ j → j < i + c → (X[xo + j * s]! = 0 ∨ X[xo + j * s]! = 0x80000000) ∧ expOf W[wo + j]! ≠ 255 := by intro c induction c with | zero => intro i _ j h1 h2; omega | succ c ih => intro i h j h1 h2 rw [zrow] at h simp only [Bool.and_eq_true, Bool.or_eq_true, beq_iff_eq, bne_iff_ne, ne_eq] at h by_cases hj : j = i ·subst hj; exact h.1 ·exact ih (i + 1) h.2 j (by omega) (by omega) @[noinline] def cellFB (n : Nat) (relu : Bool) (X W b : @& Array Word) (xo s j : Nat) : Word := if b[j]! == 0 && zrow X W xo s (j * n) 0 n then 0 else cellF0 n relu X W b xo s j theorem cellFB_eq (n : Nat) (relu : Bool) (X W b : Array Word) (xo s j : Nat) : cellFB n relu X W b xo s j = act relu (dotOf (n + 1) (fun t => if t < n then X[xo + t * s]! else oneW) (fun t => if t < n then W[j * n + t]! else b[j]!)) := by unfold cellFB split ·rename_i h simp only [Bool.and_eq_true, beq_iff_eq] at h obtain ⟨hb, hz⟩ := h have hzs := zrow_spec X W xo s (j * n) n 0 hz have hfin : Core.finAll (n + 1) (fun t => if t < n then X[xo + t * s]! else oneW) (fun t => if t < n then W[j * n + t]! else b[j]!) := by intro k hk by_cases hkn : k < n ·simp only [if_pos hkn] obtain ⟨h1, h2⟩ := hzs k (Nat.zero_le _) (by omega) exact ⟨by rcases h1 with h | h <;> rw [h] <;> decide, h2⟩ ·simp only [if_neg hkn, hb]; exact ⟨by decide, by decide⟩ have hsum : Core.tsum (n + 1) (fun t => if t < n then X[xo + t * s]! else oneW) (fun t => if t < n then W[j * n + t]! else b[j]!) = 0 := by unfold Core.tsum refine Finset.sum_eq_zero fun k _ => ?_ by_cases hkn : k < n ·simp only [if_pos hkn] obtain ⟨h1, -⟩ := hzs k (Nat.zero_le _) (by omega) have h0 : sv X[xo + k * s]! = 0 := by rcases h1 with h | h <;> rw [h] <;> decide simp [Core.tm, h0] ·simp only [if_neg hkn, hb] have h0 : sv (0 : Word) = 0 := by decide simp [Core.tm, h0] rw [Core.dotOf_val _ _ _ hfin, hsum] have hnz : dallNZ (Array.ofFn (n := n + 1) fun i : Fin (n + 1) => if i.val < n then X[xo + i.val * s]! else oneW) (Array.ofFn (n := n + 1) fun i : Fin (n + 1) => if i.val < n then W[j * n + i.val]! else b[j]!) 0 (n + 1) = false := by refine dzNZ _ _ (n + 1) 0 n (Nat.zero_le _) (by omega) ?_ rw [getElem!_ofFn (n + 1) (fun i => if i < n then X[xo + i * s]! else oneW) n (Nat.lt_succ_self n), getElem!_ofFn (n + 1) (fun i => if i < n then W[j * n + i]! else b[j]!) n (Nat.lt_succ_self n)] simp only [if_neg (Nat.lt_irrefl n), hb]; decide rw [hnz] cases relu <;> simp [finishWord, act, reluW] ·unfold cellF0; rw [x2d_eq] namespace F noncomputable def rv (v : Float) : ℝ := Model.toReal (Model.ofFloatModel v.toModel) def fv (v : Float) : Prop := Model.isFinite (Model.ofFloatModel v.toModel) = true theorem rvU (v : Float) : rv v = Model.unpackedToReal v.toModel.unpack := by unfold rv; rw [Model.toReal_eq_unpackedToReal_toModel (by decide), Model.toModel_ofFloatModel] theorem fvI (v : Float) : fv v ↔ v.toModel.unpack.isFinite = true := by unfold fv rw [← Model.toDyadic?_isSome_eq_isFinite, Model.toDyadic?_ieee_eq_model _ (by decide), Model.toModel_ofFloatModel] cases v.toModel.unpack <;> rfl theorem addM (x y : Float) (hx : fv x) (hy : fv y) : Model.ofFloatModel (x + y).toModel = Model.add (Model.ofFloatModel x.toModel) (Model.ofFloatModel y.toModel) := by change Model.ofFloatModel (Float.Model.add x.toModel y.toModel) = _ rw [Float.Model.add, Model.ofFloatModel_pack] have h := Model.add_eq_ofModel_add_of_isFinite (fmt := FloatFormat.binary64) (by decide) (Model.ofFloatModel x.toModel) (Model.ofFloatModel y.toModel) (by rw [Model.toModel_ofFloatModel]; exact (fvI x).1 hx) (by rw [Model.toModel_ofFloatModel]; exact (fvI y).1 hy) rw [Model.toModel_ofFloatModel, Model.toModel_ofFloatModel] at h exact h.symm theorem pm (E : Int) (he : E ≤ 971) : (2 : ℝ) ^ E ≤ Model.toReal (Model.posMaxFinite FloatFormat.binary64) := by have h971 : FloatFormat.binary64.maxNormalExponent - Int.ofNat FloatFormat.binary64.fracWidth = 971 := by decide have h := Model.abs_signed_mul_bpow_le_toReal_posMaxFinite FloatFormat.binary64 false 1 E (by decide) (by rw [h971]; exact he) simp only [Bool.false_eq_true, ite_false, Nat.cast_one, one_mul] at h change |(2 : ℝ) ^ E| ≤ _ at h simpa only [abs_of_pos (zpow_pos (by norm_num : (0 : ℝ) < 2) E)] using h open FloatLib.Floats.Formats.Flocq in theorem re (x : ℝ) (E : Int) (he : -1021 ≤ E) (hx : |x| < (2 : ℝ) ^ E) : |Model.roundAt FloatFormat.binary64 x - x| ≤ (2 : ℝ) ^ (E - 53) / 2 := by by_cases hz : x = 0 ·subst x; rw [Model.roundAt_zero]; simp only [sub_zero, abs_zero]; positivity have hm : magnitude FloatLib.Numerics.binaryRadix x ≤ E := magnitude_le_of_abs_lt_bpow _ x E hz hx apply (Model.abs_roundAt_sub_le FloatFormat.binary64 x).trans apply div_le_div_of_nonneg_right _ (by norm_num) change ulp FloatLib.Numerics.binaryRadix (Model.fexpOf FloatFormat.binary64) x ≤ (2 : ℝ) ^ (E - 53) rw [ulp.of_ne_zero _ _ x hz] change (2 : ℝ) ^ (max (magnitude FloatLib.Numerics.binaryRadix x - 53) (-1074)) ≤ (2 : ℝ) ^ (E - 53) apply zpow_le_zpow_right₀ (by norm_num) omega theorem faR (x y : Float) (hx : fv x) (hy : fv y) (hb : |rv x + rv y| ≤ Model.toReal (Model.posMaxFinite FloatFormat.binary64)) : fv (x + y) ∧ rv (x + y) = Model.roundAt FloatFormat.binary64 (rv x + rv y) := by have hm := addM x y hx hy have hf := Model.isFinite_add_of_abs_toReal_add_le_posMaxFinite (Model.ofFloatModel x.toModel) (Model.ofFloatModel y.toModel) (by decide) hx hy hb refine ⟨by unfold fv; rw [hm]; exact hf, ?_⟩ unfold rv; rw [hm]; exact Model.toReal_add_eq_roundAt _ _ (by decide) hf theorem fadd (x y : Float) (hx : fv x) (hy : fv y) (E : Int) (he : -1021 ≤ E) (he' : E ≤ 971) (hb : |rv x + rv y| < (2 : ℝ) ^ E) : fv (x + y) ∧ |rv (x + y) - (rv x + rv y)| ≤ (2 : ℝ) ^ (E - 53) / 2 := by obtain ⟨h1, h2⟩ := faR x y hx hy (hb.le.trans (pm E he')); exact ⟨h1, by rw [h2]; exact re _ E he hb⟩ theorem rx (d : FloatLib.Numerics.Dyadic) (hs : d.significand < 2 ^ 53) (he : -1074 ≤ d.exponent) (hb : |d.toReal| ≤ (2 : ℝ) ^ (971 : Int)) : Model.roundAt FloatFormat.binary64 d.toReal = d.toReal := by obtain ⟨hf, hr⟩ := Model.roundDyadic_of_representable FloatFormat.binary64 (by decide) d d.significand 0 (by simp) hs he (hb.trans (pm 971 le_rfl)) rw [← Model.toReal_roundDyadic_eq_roundAt _ (by decide) d hf, hr] theorem addX (x y : Float) (hx : fv x) (hy : fv y) (d : FloatLib.Numerics.Dyadic) (hd : d.toReal = rv x + rv y) (hs : d.significand < 2 ^ 53) (he : -1074 ≤ d.exponent) (hb : |d.toReal| ≤ (2 : ℝ) ^ (971 : Int)) : fv (x + y) ∧ rv (x + y) = rv x + rv y := by obtain ⟨h1, h2⟩ := faR x y hx hy (by rw [← hd]; exact hb.trans (pm 971 le_rfl)); exact ⟨h1, by rw [h2, ← hd]; exact rx d hs he hb⟩ theorem i64 (i : Int64) (hi : i.toInt.natAbs < 2 ^ 53) : fv i.toFloat ∧ rv i.toFloat = i.toInt := by have hm : Model.ofFloatModel i.toFloat.toModel = Model.roundDyadic FloatFormat.binary64 (FloatLib.Numerics.Dyadic.ofScaledInt i.toInt 0) := FloatLib.Floats.ExecFloat.Binary.toModel_ofFloat_int64ToFloat i have hd : (FloatLib.Numerics.Dyadic.ofScaledInt i.toInt 0).toReal = i.toInt := by rw [← FloatLib.Numerics.Dyadic.cast_toRat, FloatLib.Numerics.Dyadic.ofScaledInt_toRat]; simp obtain ⟨hf, hr⟩ := Model.roundDyadic_of_representable FloatFormat.binary64 (by decide) (FloatLib.Numerics.Dyadic.ofScaledInt i.toInt 0) i.toInt.natAbs 0 (Nat.mul_one _).symm hi (by change _ ≤ (0 : ℤ); decide) (by rw [hd, ← Int.cast_abs, Int.abs_eq_natAbs]; exact le_trans (by exact_mod_cast hi.le) (pm 53 (by norm_num))) exact ⟨by unfold fv; rw [hm]; exact hf, by unfold rv; rw [hm, hr, hd]⟩ theorem mulM (x y : Float) : Model.ofFloatModel (x * y).toModel = Model.ofModel FloatFormat.binary64 (Float.Model.UnpackedFloat.mul Float.Model.Format.binary64 x.toModel.unpack y.toModel.unpack) := by change Model.ofFloatModel (Float.Model.mul x.toModel y.toModel) = _ rw [Float.Model.mul, Model.ofFloatModel_pack] theorem unpN (b : BitVec 64) (s : Float.Model.UnpackedFloat.Sign) (m : Nat) (e : Int) (h : 0 < m) (hu : Float.Model.UnpackedFloat.unpack Float.Model.Format.binary64 b = .finite s m e h) : 2 ^ 52 ≤ m ∨ e = -1074 := by revert hu; unfold Float.Model.UnpackedFloat.unpack; dsimp only split ·split <;> intro hu <;> cases hu ·split ·split ·intro hu; cases hu ·rename_i hE _ intro hu; injection hu with _ _ h3 right; rw [← h3, hE]; decide ·intro hu; injection hu with _ h2 _ left; rw [← h2, BitVec.toNat_append] exact le_trans (by decide) Nat.left_le_or theorem fmR (x y : Float) (hx : fv x) (hy : fv y) (hb : |rv x * rv y| ≤ (2 : ℝ) ^ (971 : Int)) : fv (x * y) ∧ rv (x * y) = Model.roundAt FloatFormat.binary64 (rv x * rv y) := by simp only [fvI] at hx hy rw [rvU x, rvU y] at hb ⊢ unfold fv rv; rw [mulM] generalize ux : x.toModel.unpack = X at hx hb ⊢ generalize uy : y.toModel.unpack = Y at hy hb ⊢ cases X <;> cases Y <;> simp only [Float.Model.UnpackedFloat.isFinite, Bool.false_eq_true] at hx hy case finite.finite s1 m1 e1 h1 s2 m2 e2 h2 => have n1 := unpN _ s1 m1 e1 h1 ux have n2 := unpN _ s2 m2 e2 h2 uy have hpre : e1 + e2 ≤ Float.Model.Format.binary64.targetExponent (Float.Model.totalExponent (m1 * m2) (e1 + e2)) := by change e1 + e2 ≤ max ((Nat.log2 (m1 * m2) : Int) + 1 + (e1 + e2) - 53) (-1074) have := (Nat.le_log2 (n := m1 * m2) (k := 52) (by positivity)).2 have := Nat.le_mul_of_pos_right m1 h2; have := Nat.le_mul_of_pos_left m2 h1 clear h1 h2 hb hx hy ux uy;omega let d' : FloatLib.Numerics.Dyadic := ⟨xor (Model.modelSignBit s1) (Model.modelSignBit s2), m1 * m2, e1 + e2⟩ have hround : Model.ofModel FloatFormat.binary64 (Float.Model.UnpackedFloat.mul Float.Model.Format.binary64 (.finite s1 m1 e1 h1) (.finite s2 m2 e2 h2)) = Model.roundDyadic FloatFormat.binary64 d' := by rw [Float.Model.UnpackedFloat.mul, Model.roundWithAccuracy_exact_eq_round_of_le_targetExponent _ _ _ _ hpre] cases s1 <;> cases s2 <;> rfl have hreal : d'.toReal = Model.unpackedToReal (.finite s1 m1 e1 h1) * Model.unpackedToReal (.finite s2 m2 e2 h2) := Model.Dyadic.toReal_mul ⟨_, m1, e1⟩ ⟨_, m2, e2⟩ have hfin := Model.isFinite_roundDyadic_of_isIEEE_of_abs_toReal_le_posMaxFinite FloatFormat.binary64 (by decide) d' (by rw [hreal]; exact hb.trans (pm 971 le_rfl)) rw [hround] exact ⟨hfin, by rw [Model.toReal_roundDyadic_eq_roundAt _ (by decide) d' hfin, hreal]⟩ all_goals simp [Float.Model.UnpackedFloat.mul, Model.isFinite_ofModel_zero FloatFormat.binary64 (by decide), Model.toReal_ofModel_zero FloatFormat.binary64 (by decide)] theorem dyR (s : Bool) (m : Nat) (e : Int) : (⟨s, m, e⟩ : FloatLib.Numerics.Dyadic).toReal = (if s then -(m : ℝ) else m) * (2 : ℝ) ^ e := by simp only [FloatLib.Numerics.Dyadic.toReal, FloatLib.Numerics.Dyadic.cast_signedSignificand] split <;> simp def pw : Nat → Float | 0 => (1 : Int64).toFloat | k + 1 => let p := pw k; p + p theorem pwV (k : Nat) (hk : k ≤ 900) : fv (pw k) ∧ rv (pw k) = (2 : ℝ) ^ k := by induction k with | zero => have := i64 1 (by decide); simp only [pw]; exact ⟨this.1, by rw [this.2]; simp⟩ | succ k ih => obtain ⟨f, v⟩ := ih (by omega) have hd : (⟨false, 1, ((k + 1 : Nat) : Int)⟩ : FloatLib.Numerics.Dyadic).toReal = (2 : ℝ) ^ (k + 1) := by rw [dyR]; simp only [Bool.false_eq_true, ite_false, Nat.cast_one, one_mul]; exact zpow_natCast 2 (k + 1) have := addX (pw k) (pw k) f f _ (by rw [hd, v, pow_succ]; ring) (show (1 : Nat) < 2 ^ 53 by norm_num) (show (-1074 : Int) ≤ ((k + 1 : Nat) : Int) by clear hk;omega) (by rw [hd, abs_of_pos (by positivity), ← zpow_natCast] exact zpow_le_zpow_right₀ (by norm_num) (by omega)) simp only [pw]; exact ⟨this.1, by rw [this.2, v, pow_succ]; ring⟩ def nm : Float := (-1 : Int64).toFloat def P : FloatArray := ⟨Array.ofFn (n := 512) fun i => if i.val < 256 then pw (i.val - 1) else nm * pw (i.val - 256 - 1)⟩ theorem P_size : P.size = 512 := by simp [P, FloatArray.size] theorem P_get (i : USize) (h : i.toNat < P.size) : P.uget i h = if i.toNat < 256 then pw (i.toNat - 1) else nm * pw (i.toNat - 256 - 1) := by simp [P, FloatArray.uget] theorem sh23 (w : UInt32) : (w >>> 23).toNat = w.toNat / 2 ^ 23 := by rw [UInt32.toNat_shiftRight]; simp [Nat.shiftRight_eq_div_pow] @[inline] def dw (w : UInt32) : Float := (Core.mW w).toInt64.toFloat * P.uget (w >>> 23).toUSize (by rw [P_size, u32_toUSize, sh23]; have := w.toNat_lt; omega) theorem ofIntR (z e : Int) : (ofIntDyadic z e).toReal = (z : ℝ) * (2 : ℝ) ^ e := by rw [← FloatLib.Numerics.Dyadic.cast_toRat, toRat_ofIntDyadic]; push_cast; rfl theorem nmulZ (x y : Float) (hx : fv x) (hy : fv y) (z e : Int) (hd : rv x * rv y = (z : ℝ) * (2 : ℝ) ^ e) (hs : z.natAbs < 2 ^ 53) (he : -1074 ≤ e) (hb : |(z : ℝ) * (2 : ℝ) ^ e| ≤ (2 : ℝ) ^ (971 : Int)) : fv (x * y) ∧ rv (x * y) = (z : ℝ) * (2 : ℝ) ^ e := by obtain ⟨h1, h2⟩ := fmR x y hx hy (by rw [hd]; exact hb) have := rx (ofIntDyadic z e) hs he (by rw [ofIntR]; exact hb) rw [ofIntR] at this exact ⟨h1, by rw [h2, hd, this]⟩ theorem svB (w : UInt32) : (sv w).natAbs < 2 ^ 24 := by have := mantOf_lt_24 w; unfold sv; split <;> simp <;> omega theorem pwB (a b c : Nat) (hab : a + b ≤ c) (hc : c ≤ 971) (z : Int) (hz : z.natAbs < 2 ^ a) : |(z : ℝ) * (2 : ℝ) ^ (b : Int)| ≤ (2 : ℝ) ^ (971 : Int) := by rw [abs_mul, abs_of_pos (by positivity : (0 : ℝ) < 2 ^ (b : Int)), zpow_natCast] have h1 : |(z : ℝ)| ≤ 2 ^ a := by rw [← Int.cast_abs, Int.abs_eq_natAbs]; exact_mod_cast hz.le refine (mul_le_mul_of_nonneg_right h1 (by positivity)).trans ?_ rw [← pow_add, ← zpow_natCast]; exact zpow_le_zpow_right₀ (by norm_num) (by clear h1 hz;omega) theorem mV (u : UInt64) (n : Nat) (hu : u.toNat = n) (hn : n < 2 ^ 25) : fv u.toInt64.toFloat ∧ rv u.toInt64.toFloat = (n : Int) := by have : u.toInt64.toInt = n := by rw [show u.toInt64.toInt = Core.sval u from rfl, sval_eq, hu]; split <;> (clear hu;omega) rw [← this]; exact i64 _ (by rw [this]; simp; clear*-hn;omega) theorem qV (c : Nat) (A : FloatArray) (hA : ∀ i h, A.uget i h = if i.toNat < 256 then pw (i.toNat - c) else nm * pw (i.toNat - 256 - c)) (w : UInt32) (h) : fv (A.uget (w >>> 23).toUSize h) ∧ ∃ σ : Int, (∀ v, signOf v = signOf w → σ * mantOf v = sv v) ∧ σ.natAbs = 1 ∧ rv (A.uget (w >>> 23).toUSize h) = σ * 2 ^ ((expOf w).toNat - c) := by have := expL w; have := w.toNat_lt; have hsg := Core.signOf_iff w obtain ⟨f2, v2⟩ := pwV ((expOf w).toNat - c) (by clear h hA hsg this;omega) rw [hA, u32_toUSize, sh23, wdiv]; split ·rw [show (expOf w).toNat + 256 * (w.toNat / 2 ^ 31) - c = (expOf w).toNat - c by clear f2 h hA hsg this v2;omega] exact ⟨f2, 1, fun v hv => by simp only [sv, hv, hsg]; split <;> (clear f2 h hA hsg hv this v2;omega), rfl, by rw [v2]; push_cast; ring⟩ ·rw [show (expOf w).toNat + 256 * (w.toNat / 2 ^ 31) - 256 - c = (expOf w).toNat - c by clear f2 h hA hsg v2;omega] have e0 := i64 (-1) (by decide) obtain ⟨f3, v3⟩ := nmulZ _ _ e0.1 f2 (-1) ((expOf w).toNat - c : ℕ) (by rw [e0.2, v2, zpow_natCast]; rfl) (by decide) (by clear*-;omega) (pwB 1 _ 971 (by clear e0 f2 h hA hsg this v2;omega) le_rfl _ (by decide)) exact ⟨f3, -1, fun v hv => by simp only [sv, hv, hsg]; split <;> (clear e0 f2 f3 h hA hsg hv this v2 v3;omega), rfl, by rw [← zpow_natCast]; exact v3⟩ theorem dG (c q : Nat) (A : FloatArray) (hA : ∀ i h, A.uget i h = if i.toNat < 256 then pw (i.toNat - c) else nm * pw (i.toNat - 256 - c)) (u : UInt64) (v w : UInt32) (h) (hq : q ≤ 2) (hu : u.toNat = q * mantOf v) (hs : signOf v = signOf w) (he : (q : ℝ) * 2 ^ ((expOf w).toNat - c) = 2 ^ idxOf v) : fv (u.toInt64.toFloat * A.uget (w >>> 23).toUSize h) ∧ rv (u.toInt64.toFloat * A.uget (w >>> 23).toUSize h) = (sv v : ℝ) * 2 ^ idxOf v := by have := mantOf_lt_24 v; have := Nat.mul_le_mul_right (mantOf v) hq; have := expL w obtain ⟨e1, e2⟩ := mV u _ hu (by clear h hA he hq hs hu this;omega) obtain ⟨f2, σ, hs', h1, v2⟩ := qV c A hA w h have hb : (((q * mantOf v : Nat) : Int) * σ).natAbs < 2 ^ 25 := by rw [Int.natAbs_mul, h1]; simp; clear e1 e2 f2 h h1 hA he hq hs hs' hu this v2;omega have := nmulZ _ _ e1 f2 _ ((expOf w).toNat - c : Nat) (by rw [e2, v2, zpow_natCast]; push_cast; ring) (hb.trans (by norm_num)) (by clear*-;omega) (pwB 25 _ 971 (by clear*-this;omega) le_rfl _ hb) exact ⟨this.1, by rw [this.2, ← he, zpow_natCast, ← hs' v hs]; push_cast; ring⟩ theorem dwV (w : UInt32) (_ : expOf w ≠ 255) : fv (dw w) ∧ rv (dw w) = (sv w : ℝ) * 2 ^ idxOf w := dG 1 1 P P_get _ w w _ (by omega) (by simp [Core.mW_toNat]) rfl (by simp [idxE]) theorem pvV (x w : UInt32) (hx : expOf x ≠ 255) (hw : expOf w ≠ 255) : fv (dw x * dw w) ∧ rv (dw x * dw w) = (Core.tm x w : ℝ) := by obtain ⟨f1, v1⟩ := dwV x hx; obtain ⟨f2, v2⟩ := dwV w hw have hb : (sv x * sv w).natAbs < 2 ^ 48 := by rw [Int.natAbs_mul]; exact (Nat.mul_lt_mul'' (svB x) (svB w)).trans_eq (by norm_num) have := nmulZ _ _ f1 f2 (sv x * sv w) (idxOf x + idxOf w : Nat) (by rw [v1, v2, zpow_natCast, pow_add]; push_cast; ring) (lt_trans hb (by norm_num)) (by clear*-;omega) (pwB 48 _ 971 (by rw [idxE, idxE]; have := expL x; have := expL w; clear f1 f2 hb hw hx v1 v2;omega) le_rfl _ hb) refine ⟨this.1, ?_⟩; rw [this.2, Core.tm, zpow_natCast]; push_cast; ring @[inline] def eF (b : UInt64) : UInt64 := (b >>> 52) &&& 2047 @[inline] def mF (b : UInt64) : UInt64 := (b &&& 0xfffffffffffff) ||| 0x10000000000000 theorem sg63 (u : UInt64) : (u &&& 0x8000000000000000 != 0) = (u >>> 63 != 0) := by apply Bool.eq_iff_iff.mpr simp only [bne_iff_ne, ne_eq, ← UInt64.toNat_inj] rw [UInt64.toNat_and, UInt64.toNat_shiftRight] change ¬u.toNat &&& 2 ^ 63 = 0 ↔ ¬u.toNat >>> 63 = 0 rw [Nat.and_two_pow, Nat.shiftRight_eq_div_pow, Nat.testBit_eq_decide_div_mod_eq] have hq : u.toNat / 2 ^ 63 < 2 := by have h := UInt64.toNat_lt u; omega rw [Nat.mod_eq_of_lt hq] by_cases hh : u.toNat / 2 ^ 63 = 1 <;> simp <;> omega theorem fld (v : Float) : Model.ofFloatModel v.toModel = Model.ofFields FloatFormat.binary64 (v.toBits >>> 63 != 0) (((v.toBits >>> 52) &&& 2047).toNat) ((v.toBits &&& 0xfffffffffffff).toNat) := by rw [← Model.ofFields_signBit_expField_fracField (Model.ofFloatModel v.toModel)]; congr 1 rw [← sg63]; apply Bool.eq_iff_iff.mpr; simp only [Model.signBit, bne_iff_ne, ne_eq]; rw [← UInt64.toBitVec_inj]; exact Iff.rfl theorem fq (v : Float) : ((v.toBits >>> 52) &&& 2047).toNat < 2 ^ 11 ∧ (v.toBits &&& 0xfffffffffffff).toNat < 2 ^ 52 := by simp only [UInt64.toNat_and]; exact ⟨lt_of_le_of_lt Nat.and_le_right (by decide), lt_of_le_of_lt Nat.and_le_right (by decide)⟩ theorem bitsD (v : Float) (hv : fv v) (he : ¬eF v.toBits = 0) : rv v = (⟨v.toBits >>> 63 != 0, (v.toBits &&& 0xfffffffffffff).toNat + 2 ^ 52, ((eF v.toBits).toNat : Int) - 1075⟩ : FloatLib.Numerics.Dyadic).toReal := by unfold eF at he ⊢ have hq := (fq v).1 have hr := (fq v).2 have he' : ((v.toBits >>> 52) &&& 2047).toNat ≠ 0 := fun h => he (UInt64.toNat_inj.mp (by simpa using h)) unfold fv at hv; unfold rv rw [fld] at hv ⊢ rw [Model.toReal_eq, Model.toDyadic?_ofFields_of_isFinite _ _ _ _ hq hr hv, if_neg he'] simp only [show FloatFormat.binary64.fracWidth = 52 from rfl, show FloatFormat.binary64.exponentBias = 1023 from rfl, Model.pow2_eq_two_pow] congr 2 <;> (try simp only [Int.ofNat_eq_natCast, Nat.cast_ofNat]) <;> ring theorem ofW_toWord (z : Model Fmt) : ofW (toWord z) = z := by have h : z.toNatBits < 2 ^ 32 := Model.toNatBits_lt_two_pow z simp only [ofW, toWord, Model.ofUInt32, UInt32.toNat_ofNat', Nat.mod_eq_of_lt h] exact Model.ofNatBits_toNatBits z theorem toReal_ofW (w : Word) (hf : expOf w ≠ 255) : Model.toReal (ofW w) = (sv w : ℝ) * (2 : ℝ) ^ ((idxOf w : Int) - 149) := by rw [ofW, Model.toReal_eq, toDyadic_ofUInt32 w hf] change (decodeD w).toReal = _ rw [← FloatLib.Numerics.Dyadic.cast_toRat, decodeD_toRat] push_cast; rfl theorem ofW_ne (w : Word) (hf : expOf w ≠ 255) (hz : w &&& 0x7FFFFFFF ≠ 0) : Model.toReal (ofW w) ≠ 0 := by rw [toReal_ofW w hf] refine mul_ne_zero ?_ (zpow_ne_zero _ (by norm_num)) have hm : mantOf w ≠ 0 := by unfold mantOf; split ·rename_i h0 have h1 := (exp0 w).mp h0; rw [absA] at h1 have h2 : (absW w).toNat ≠ 0 := fun h => hz (UInt32.toNat_inj.mp (h.trans UInt32.toNat_zero.symm)) rw [absA] at h2; unfold fracOf; rw [fr23]; omega ·omega unfold sv; split <;> simp [hm] theorem sand (d1 d2 d3 : FloatLib.Numerics.Dyadic) (h12 : d1.toReal ≤ d2.toReal) (h23 : d2.toReal ≤ d3.toReal) (hw : toWord (Model.roundDyadic Fmt d1) = toWord (Model.roundDyadic Fmt d3)) (hf : expOf (toWord (Model.roundDyadic Fmt d1)) ≠ 255) (hz : toWord (Model.roundDyadic Fmt d1) &&& 0x7FFFFFFF ≠ 0) (hb : |d2.toReal| ≤ (2 : ℝ) ^ (127 : Int)) : toWord (Model.roundDyadic Fmt d2) = toWord (Model.roundDyadic Fmt d1) := by have e := ofW_toWord (Model.roundDyadic Fmt d1) have f1 : Model.isFinite (Model.roundDyadic Fmt d1) = true := by rw [← e, ofW, isFinite_ofUInt32]; simpa using hf have f2 := Model.isFinite_roundDyadic_of_isIEEE_of_abs_toReal_le_posMaxFinite Fmt (by decide) d2 (hb.trans ((Model.abs_signed_mul_bpow_le_toReal_posMaxFinite Fmt false (2 ^ 23) 104 (by decide) (by decide)).trans' (by change _ ≤ |(if false = true then (-1 : ℝ) else 1) * ((2 ^ 23 : ℕ) : ℝ) * (2 : ℝ) ^ (104 : ℤ)|; norm_num))) have e3 : Model.roundDyadic Fmt d3 = Model.roundDyadic Fmt d1 := by rw [← ofW_toWord (Model.roundDyadic Fmt d3), ← hw, e] have r := Model.toReal_roundDyadic_eq_roundAt Fmt (by decide) have m1 := Model.roundAt_mono Fmt h12 have m2 := Model.roundAt_mono Fmt h23 rw [← r d1 f1, ← r d2 f2] at m1 rw [← r d2 f2, ← r d3 (by rw [e3]; exact f1), e3] at m2 rw [Model.eq_of_toReal_eq_of_nonzero (le_antisymm m2 m1) (by rw [le_antisymm m2 m1, ← e]; exact ofW_ne _ hf hz)] theorem r39 (x : Nat) (hx : x < 2 ^ 53) (ht : x % 2 ^ 29 ≠ 2 ^ 28) : (Core.rne39 (UInt64.ofNat (x * 2 ^ 10))).toNat = (x + 2 ^ 28) / 2 ^ 29 := by simp only [Core.rne39, UInt64.toNat_shiftRight, UInt64.toNat_add, UInt64.toNat_and, UInt64.reduceToNat, UInt64.toNat_ofNat_of_lt' (by simp only [UInt64.size]; omega : x * 2 ^ 10 < UInt64.size), Nat.reduceMod, Nat.shiftRight_eq_div_pow, Nat.and_one_is_mod] grind @[inline, irreducible] def cert2 (S : Float) (h : UInt64) : UInt64 := let b := S.toBits let f := b &&& 0xfffffffffffff let E := eF b let d := h + 1075 - E let g := (1 : UInt64) <<< d let u := (f + 0x10000000) &&& 0x1FFFFFFF let r := ((b &&& 0x7FFFFFFFFFFFFFFF) + 0x10000000) >>> 29 if d ≤ 26 && E - 1195 < 253 && u - (g + 1) < 0x1FFFFFFF - (g + g) && r &&& 0x7FFFFF != 0 then ((b >>> 63) <<< 31) + r - 0x255000000 else 0x100000000 theorem rb (b : UInt64) (h : (((b &&& 0x7FFFFFFFFFFFFFFF) + 0x10000000) >>> 29 &&& 0x7FFFFF != 0) = true) : 2 ^ 28 ≤ (b &&& 0xfffffffffffff).toNat ∧ (b &&& 0xfffffffffffff).toNat + 2 ^ 28 < 2 ^ 52 := by simp only [bne_iff_ne, ne_eq, ← UInt64.toNat_inj, UInt64.toNat_and, UInt64.toNat_shiftRight, UInt64.toNat_add, UInt64.reduceToNat, Nat.reduceMod, Nat.shiftRight_eq_div_pow] at h ⊢ rw [Nat.and_two_pow_sub_one_eq_mod _ 63, Nat.and_two_pow_sub_one_eq_mod _ 23] at h rw [Nat.and_two_pow_sub_one_eq_mod _ 52] omega theorem c3c (h E f : UInt64) (hh : h.toNat < 2 ^ 63) (hE : E.toNat < 2048) (hf : f.toNat < 2 ^ 52) (c1 : h + 1075 - E ≤ 26) (c2 : E - 1195 < 253) (c3 : ((f + 0x10000000) &&& 0x1FFFFFFF) - (((1 : UInt64) <<< (h + 1075 - E)) + 1) < 0x1FFFFFFF - (((1 : UInt64) <<< (h + 1075 - E)) + ((1 : UInt64) <<< (h + 1075 - E)))) (c4 : 2 ^ 28 ≤ f.toNat ∧ f.toNat + 2 ^ 28 < 2 ^ 52) : E.toNat ≤ h.toNat + 1075 ∧ h.toNat + 1075 - E.toNat ≤ 26 ∧ 1195 ≤ E.toNat ∧ E.toNat ≤ 1447 ∧ 2 ^ (h.toNat + 1075 - E.toNat) + 1 ≤ (f.toNat + 2 ^ 28) % 2 ^ 29 ∧ (f.toNat + 2 ^ 28) % 2 ^ 29 + 2 ^ (h.toNat + 1075 - E.toNat) < 2 ^ 29 ∧ 2 ^ (h.toNat + 1075 - E.toNat) ≤ f.toNat ∧ f.toNat + 2 ^ (h.toNat + 1075 - E.toNat) < 2 ^ 52 := by simp only [UInt64.le_iff_toNat_le, UInt64.lt_iff_toNat_lt, UInt64.toNat_sub, UInt64.toNat_add, UInt64.toNat_and, UInt64.toNat_shiftLeft, UInt64.reduceToNat, UInt64.toNat_one, Nat.one_shiftLeft] at c1 c2 c3 have hk : (2 ^ 64 - E.toNat + (h.toNat + 1075) % 2 ^ 64) % 2 ^ 64 = h.toNat + 1075 - E.toNat := by clear*-c1 hE hh;omega rw [hk] at c1 c3 have := Nat.pow_le_pow_right (n := 2) (by norm_num) c1 rw [Nat.mod_eq_of_lt (by clear*-c1;omega : _ < 64), Nat.and_two_pow_sub_one_eq_mod _ 29] at c3 simp (disch:=omega) only[Nat.mod_eq_of_lt] at c3 have:E.toNat≤h.toNat+1075∧1195≤E.toNat∧E.toNat≤1447:=by clear*-c1 c2 hE hk;omega clear hk c2;generalize 2^(h.toNat+1075-E.toNat)=P at * have:P+1≤(f.toNat+2^28)%2^29∧(f.toNat+2^28)%2^29+P<2^29:=by clear*-c3 this;omega clear c3;clear hE;omega theorem c3w (b : UInt64) (hE : 1195 ≤ (eF b).toNat) : (((b >>> 63) <<< 31) + (((b &&& 0x7FFFFFFFFFFFFFFF) + 0x10000000) >>> 29) - 0x255000000).toNat = b.toNat / 2 ^ 63 * 2 ^ 31 + (((eF b).toNat - 1085 - 110) * 2 ^ 23 + (2 ^ 23 + ((b &&& 0xfffffffffffff).toNat + 2 ^ 28) / 2 ^ 29)) := by simp only [eF, UInt64.toNat_sub, UInt64.toNat_add, UInt64.toNat_shiftLeft, UInt64.toNat_shiftRight, UInt64.toNat_and, UInt64.reduceToNat, Nat.reduceMod, Nat.shiftRight_eq_div_pow, Nat.shiftLeft_eq] at hE ⊢ rw [Nat.and_two_pow_sub_one_eq_mod _ 11] at hE ⊢ rw [Nat.and_two_pow_sub_one_eq_mod _ 63, Nat.and_two_pow_sub_one_eq_mod _ 52] have := b.toNat_lt simp (disch:=omega) only[Nat.mod_eq_of_lt] generalize b.toNat=n at * have m:n%2^63=n/2^52%2^11*2^52+n%2^52:=by clear*-;omega have s:n/2^63<2:=by clear hE m;omega have h:n/2^52%2^11<2^11:=by clear*-;omega have f:n%2^52<2^52:=by clear*-;omega rw[m];clear m this generalize n/2^63=S,n/2^52%2^11=E,n%2^52=F at * have q:(E*2^52+F+268435456)/2^29=E*2^23+(F+2^28)/2^29:=by clear*-;omega have l:(F+2^28)/2^29≤2^23:=by clear*-f;omega rw[q];clear q f generalize (F+2^28)/2^29=U at * omega theorem cert2_spec (S : Float) (hS : fv S) (h : UInt64) (hh : h.toNat < 2 ^ 63) (T : Int) (hT : |rv S - (T : ℝ)| ≤ (2 : ℝ) ^ (h.toNat : Int)) (hTb : |(T : ℝ)| ≤ (2 : ℝ) ^ (425 : Int)) (hc : cert2 S h < 0x100000000) : T ≠ 0 ∧ (cert2 S h).toUInt32 = finishWord T (-298) false := by unfold cert2 at hc ⊢ dsimp only at hc ⊢ split; swap; · simp [*] at hc rename_i hc' simp only [Bool.and_eq_true, decide_eq_true_eq] at hc' obtain ⟨⟨⟨c1, c2⟩, c3⟩, c4⟩ := hc' have hsg : (if (S.toBits >>> 63 != 0) = true then 2 ^ 31 else 0) = S.toBits.toNat / 2 ^ 63 * 2 ^ 31 := by simp only [Core.neg_iff, decide_eq_true_eq]; have := S.toBits.toNat_lt; split <;> (clear c1 c2 c3 c4 hS hT hTb hc hh;omega) obtain ⟨d1, d2, e1, e2, u1, u2, f1, f2⟩ := c3c h (eF S.toBits) _ hh (fq S).1 (fq S).2 c1 c2 c3 (rb _ c4) have hw := c3w S.toBits e1 have hv := bitsD S hS (fun h0 => by rw [h0] at e1; simp at e1) rw [← hsg] at hw have hsc : (eF S.toBits - 1085).toNat = (eF S.toBits).toNat - 1085 := by rw [UInt64.toNat_sub]; simp only [UInt64.reduceToNat]; clear*-e1 e2;omega generalize hW : UInt64.toUInt32 _ = W generalize (S.toBits >>> 63 != 0) = ng at * generalize (eF S.toBits).toNat = EN at * generalize hG : 2 ^ (h.toNat + 1075 - EN) = G at * generalize (S.toBits &&& 0xfffffffffffff).toNat = fN at * have hWn : W.toNat = (if ng then 2 ^ 31 else 0) + ((EN - 1085 - 110) * 2 ^ 23 + (2 ^ 23 + (fN + 2 ^ 28) / 2 ^ 29)) := by rw [← hW, UInt64.toNat_toUInt32, hw]; split <;> (clear*-e1 e2 f2;omega) have key : ∀ N, fN + 2 ^ 52 ≤ N + G → N ≤ fN + 2 ^ 52 + G → toWord (Model.roundDyadic Fmt ⟨ng, N * 2 ^ 10, ((EN - 1085 : ℕ) : ℤ) - 298⟩) = W := fun N l r => by have n := UInt64.toNat_ofNat_of_lt' (show N * 2 ^ 10 < UInt64.size by simp only [UInt64.size]; clear*-f2 r;omega) have w := (Core.rnd62n ng (UInt64.ofNat (N * 2 ^ 10)) (eF S.toBits - 1085) (by clear*-f1 l n;omega) (by clear*-f2 n r;omega) (by clear*-e1 e2 hsc;omega) (by clear*-e1 e2 hsc;omega)).1 rw [← n, ← hsc, ← Core.rnd_eq _ _ _ (by clear*-e1 e2 hsc;omega)] exact UInt32.toNat_inj.mp (by rw [w, r39 N (by clear*-f2 r;omega) (by clear*-l r u1 u2;omega), hWn]; clear*-e1 e2 hsc l r u1 u2;omega) have qf : expOf W ≠ 255 := fun hx => by have := expA W; simp only [hx, absA, hWn, UInt32.reduceToNat] at this; split at this <;> (clear*-e1 e2 f2 this;omega) have qz : W &&& 0x7FFFFFFF ≠ 0 := fun hx => by have := absA W; simp only [absW, hx, hWn, UInt32.toNat_zero] at this; split at this <;> (clear hWn hsg u1;omega) have k1 := key (fN + 2 ^ 52 - G) (by clear*-f1;omega) (by clear*-f1;omega) have k3 := key (fN + 2 ^ 52 + G) (by clear*-;omega) (by clear*-;omega) have hM : G < fN + 2 ^ 52 := by clear*-f1;omega rw [dyR] at hv have hU : (2 : ℝ) ^ (h.toNat : Int) = G * (2 : ℝ) ^ ((EN : Int) - 1075) := by rw [← hG, Nat.cast_pow, Nat.cast_ofNat, ← zpow_natCast, ← zpow_add₀ two_ne_zero]; congr 1; clear*-d1 e1 e2;omega have hE2 : ∀ m : ℕ, ((m * 2 ^ 10 : ℕ) : ℝ) * 2 ^ (((EN - 1085 : ℕ) : ℤ) - 298) = m * 2 ^ ((EN : ℤ) - 1075) * 2 ^ (-298 : ℤ) := fun m => by rw [Nat.cast_mul, mul_assoc, mul_assoc, Nat.cast_pow, Nat.cast_ofNat, ← zpow_natCast (2 : ℝ) 10, ← zpow_add₀ two_ne_zero, ← zpow_add₀ two_ne_zero, show ((10 : ℕ) : ℤ) + (((EN - 1085 : ℕ) : ℤ) - 298) = (EN : ℤ) - 1075 + -298 by clear*-e1 e2;omega] have hu : (0 : ℝ) < (2 : ℝ) ^ ((EN : Int) - 1075) := by positivity have h298 : (0 : ℝ) < (2 : ℝ) ^ (-298 : Int) := by positivity have hT2 : |(ofIntDyadic T (-298)).toReal| ≤ (2 : ℝ) ^ (127 : Int) := by rw [ofIntR, abs_mul, abs_of_pos h298, show (127 : ℤ) = 425 + -298 by norm_num, zpow_add₀ two_ne_zero]; gcongr rw [hU, hv] at hT generalize fN + 2 ^ 52 = M at hT k1 k3 hM have c1' : ((M - G : ℕ) : ℝ) = M - G := Nat.cast_sub hM.le have hMl : (G : ℝ) < M := by exact_mod_cast hM cases ng <;> simp only [Bool.false_eq_true, ite_false, ite_true] at hT <;> obtain ⟨t1, t2⟩ := abs_le.mp hT <;> have hT0 : T ≠ 0 := by rintro rfl; push_cast at t1 t2; nlinarith only [t1, t2, hMl, hu] all_goals refine ⟨hT0, ?_⟩; simp only [finishWord, hT0, ↓reduceIte] on_goal 2 => refine ((sand _ _ _ ?_ ?_ (k3.trans k1.symm) (k3 ▸ qf) (k3 ▸ qz) hT2).trans k3).symm refine ((sand _ _ _ ?_ ?_ (k1.trans k3.symm) (k1 ▸ qf) (k1 ▸ qz) hT2).trans k1).symm all_goals simp only [ofIntR, dyR, Bool.false_eq_true, ite_false, ite_true, neg_mul, hE2, c1']; push_cast; nlinarith only [t1, t2, h298] @[specialize] def sfold (p : Nat → Float) (n t : Nat) (a : Float) : Float := if t < n then sfold p n (t + 1) (a + p t) else a termination_by n - t theorem fadd2 (x y : Float) (hx : fv x) (hy : fv y) (E : Nat) (hE : E ≤ 971) (hb : |rv x + rv y| < (2 : ℝ) ^ E) : fv (x + y) ∧ |rv (x + y) - (rv x + rv y)| ≤ (2 : ℝ) ^ E * 2 ^ (-54 : Int) := by have h := fadd x y hx hy E (by omega) (by exact_mod_cast hE) (by rwa [zpow_natCast]) refine ⟨h.1, h.2.trans (le_of_eq ?_)⟩ rw [show ((E : Int) - 53) = (E : Int) + (-54) + 1 by ring, zpow_add₀ two_ne_zero, zpow_add₀ two_ne_zero, zpow_natCast, zpow_one] ring theorem psum_le (n : Nat) (z : Nat → Int) (za : Int) (B : ℝ) (hz : ∀ t < n, |(z t : ℝ)| ≤ B) (hza : |(za : ℝ)| ≤ B) : ∀ t ≤ n, |(za : ℝ) + ∑ s ∈ Finset.range t, (z s : ℝ)| ≤ ((t : ℝ) + 1) * B := by intro t; induction t with | zero => intro _; simpa using hza | succ t ih => intro ht; rw [Finset.sum_range_succ, ← add_assoc]; push_cast linarith [abs_add_le ((za : ℝ) + ∑ s ∈ Finset.range t, (z s : ℝ)) (z t), ih (by omega), hz t (by omega)] structure A8 where a0 : Float a1 : Float a2 : Float a3 : Float a4 : Float a5 : Float a6 : Float a7 : Float local instance : Inhabited A8 := ⟨⟨0, 0, 0, 0, 0, 0, 0, 0⟩⟩ @[inline] def A8.f (s : A8) : Nat → Float | 0 => s.a0 | 1 => s.a1 | 2 => s.a2 | 3 => s.a3 | 4 => s.a4 | 5 => s.a5 | 6 => s.a6 | _ => s.a7 theorem uk {i k : USize} {S : Nat} (hk : k.toNat < 8) (h : i.toNat + 8 ≤ S) (hs : S < 2 ^ 32) : (i + k).toNat < S := by have := USize.le_size; rw [uadd (by omega)]; omega theorem ug (X : FloatArray) (i : USize) (h : i.toNat < X.size) : X.uget i h = X.data[i.toNat]! := by rcases X with ⟨d⟩; simp only [FloatArray.uget]; rw [getElem!_pos d i.toNat h]; rfl theorem psz (Y : FloatArray) (v : Float) : (Y.push v).size = Y.size + 1 := by rcases Y with ⟨d⟩; simp [FloatArray.push, FloatArray.size] theorem ssz (Y : FloatArray) (i : Nat) (v : Float) : (Y.set! i v).size = Y.size := by rcases Y with ⟨d⟩; simp [FloatArray.set!, FloatArray.size] theorem sg (Y : FloatArray) (i q : Nat) (v : Float) (hq : q < Y.size) : (Y.set! i v).data[q]! = if i = q then v else Y.data[q]! := by rcases Y with ⟨d⟩; change q < d.size at hq simp only [FloatArray.set!, Array.set!, getElem!_pos d q hq, getElem!_pos (d.setIfInBounds i v) q (by simpa using hq), Array.getElem_setIfInBounds hq] theorem pg (Y : FloatArray) (v : Float) (q : Nat) (hq : q < Y.size + 1) : (Y.push v).data[q]! = if q < Y.size then Y.data[q]! else v := by rcases Y with ⟨d⟩; change q < d.size + 1 at hq; change (d.push v)[q]! = if q < d.size then d[q]! else v rw [getElem!_pos _ _ (by simp; omega), Array.getElem_push]; split <;> simp [*, getElem!_pos] @[specialize] def bld (f : Nat → Float) (N : Nat) (Y : FloatArray) : FloatArray := if Y.size < N then bld f N (Y.push (f Y.size)) else Y termination_by N - Y.size decreasing_by rw [psz]; omega theorem bld_spec (f : Nat → Float) (N : Nat) : ∀ k (Y : FloatArray), N - Y.size = k → Y.size ≤ N → (bld f N Y).size = N ∧ (∀ q < Y.size, (bld f N Y).data[q]! = Y.data[q]!) ∧ ∀ q, Y.size ≤ q → q < N → (bld f N Y).data[q]! = f q := by intro k; induction k <;> intro Y hk hY ·rw [bld, if_neg (by omega)]; exact ⟨by omega, fun q _ => rfl, fun q h1 h2 => by omega⟩ rename_i ih rw [bld, if_pos (by clear hY;omega)] have hs := psz Y (f Y.size) obtain ⟨i1, i2, i3⟩ := ih (Y.push (f Y.size)) (by omega) (by clear hY;omega) refine ⟨i1, fun q hq => by rw [i2 q (by clear*-hq hs;omega), pg _ _ _ (by clear*-hq;omega), if_pos hq], fun q h1 h2 => ?_⟩ rcases eq_or_ne q Y.size with rfl | e ·rw [i2 _ (by clear*-hs;omega), pg _ _ _ (by clear*-;omega), if_neg (lt_irrefl _)] exact i3 q (by clear*-e h1 hs;omega) h2 theorem fvE (v : Float) (h : (eF v.toBits).toNat < 2047) : fv v := by unfold fv; rw [fld] have hq := (fq v).1 have hr := (fq v).2 rw [Model.isFinite_ofFields _ _ _ _ hq hr] have e1 : FloatFormat.binary64.expAllOnesNat = 2047 := by decide unfold eF at h simp only [show FloatFormat.binary64.encoding = .ieee from rfl, e1, bne_iff_ne, ne_eq]; omega theorem bitsB (v : Float) (hv : fv v) : |rv v| < (2 : ℝ) ^ (((eF v.toBits).toNat : Int) - 1022) := by have key : ∀ (m k : ℕ) (e f : ℤ), m < 2 ^ k → k + e ≤ f → (m : ℝ) * 2 ^ e < 2 ^ f := fun m k e f h h' => (mul_lt_mul_of_pos_right (by exact_mod_cast h : (m : ℝ) < 2 ^ k) (zpow_pos two_pos e)).trans_le (by rw [← zpow_natCast, ← zpow_add₀ two_ne_zero]; exact zpow_le_zpow_right₀ (by norm_num) h') unfold rv eF; unfold fv at hv; rw [fld] at hv ⊢ rw [Model.toReal_eq, Model.toDyadic?_ofFields_of_isFinite _ _ _ _ (fq v).1 (fq v).2 hv] have := (fq v).2 split_ifs with h0 <;> simp only [Model.Dyadic.abs_toReal] ·simp; positivity ·exact key _ 52 _ _ this (by rw [h0]; decide) ·exact key _ 53 _ _ (by simp only [FloatFormat.binary64, Model.pow2_eq_two_pow]; omega) (by simp [FloatFormat.binary64]; clear*-;omega) theorem rlt (x y : Float) (hx : fv x) (hy : fv y) (hs : fv (x + y)) (E : Int) (h1 : -1074 ≤ E) (h2 : E ≤ 971) (h : |rv (x + y)| < (2 : ℝ) ^ E) : |rv x + rv y| < (2 : ℝ) ^ E := by have hm := addM x y hx hy have hr := Model.toReal_add_eq_roundAt (Model.ofFloatModel x.toModel) (Model.ofFloatModel y.toModel) (by decide) (hm ▸ hs) unfold rv at h ⊢; rw [hm, hr, abs_lt] at h have hp := rx ⟨false, 1, E⟩ (by norm_num) h1 (by simp [dyR]; exact zpow_le_zpow_right₀ (by norm_num) h2) have hn := rx ⟨true, 1, E⟩ (by norm_num) h1 (by simp [dyR]; exact zpow_le_zpow_right₀ (by norm_num) h2) simp only [dyR, Bool.false_eq_true, ite_false, ite_true, Nat.cast_one, one_mul, neg_mul] at hp hn exact abs_lt.2 ⟨lt_of_not_ge fun h4 => by linarith [Model.roundAt_mono FloatFormat.binary64 h4], lt_of_not_ge fun h4 => by linarith [Model.roundAt_mono FloatFormat.binary64 h4]⟩ @[specialize] def sT (p : Nat → Float) (n t : Nat) (a : Float) (m : UInt64) : Float × UInt64 := if t < n then let a' := a + p t let e := eF a'.toBits sT p n (t + 1) a' (if m < e then e else m) else (a, m) termination_by n - t theorem mxv (m e : UInt64) : (if m < e then e else m).toNat = max m.toNat e.toNat := by split <;> rename_i h <;> simp only [UInt64.lt_iff_toNat_lt] at h <;> omega theorem sT_ge (p : Nat → Float) (n : Nat) : ∀ k t a m, n - t = k → m.toNat ≤ (sT p n t a m).2.toNat := by intro k; induction k with | zero => intro t a m h; rw [sT, if_neg (by omega)] | succ k ih => intro t a m h; rw [sT, if_pos (by omega)]; dsimp only have := ih (t + 1) (a + p t) (if m < eF (a + p t).toBits then eF (a + p t).toBits else m) (by omega) rw [mxv] at this; clear h ih;omega theorem sT_err (p : Nat → Float) (z : Nat → Int) (za : Int) (n K : Nat) (hK1 : 1 ≤ K) (hK2 : K ≤ 1993) (hp : ∀ t < n, fv (p t) ∧ rv (p t) = z t) : ∀ m t a M, n - t = m → t ≤ n → fv a → |rv a - ((za : ℝ) + ∑ s ∈ Finset.range t, (z s : ℝ))| ≤ t * (2 : ℝ) ^ ((K : Int) - 1076) → (sT p n t a M).2.toNat ≤ K → fv (sT p n t a M).1 ∧ |rv (sT p n t a M).1 - ((za : ℝ) + ∑ s ∈ Finset.range n, (z s : ℝ))| ≤ n * (2 : ℝ) ^ ((K : Int) - 1076) := by intro m; induction m <;> intro t a M hm ht ha he hk ·obtain rfl : t = n := by clear*-hm ht;omega rw [sT, if_neg (lt_irrefl _)]; exact ⟨ha, he⟩ rename_i ih have htn : t < n := by clear*-hm;omega rw [sT, if_pos htn] at hk ⊢; dsimp only at hk ⊢ obtain ⟨fp, vp⟩ := hp t htn have hg := sT_ge p n _ (t + 1) (a + p t) (if M < eF (a + p t).toBits then eF (a + p t).toBits else M) rfl rw [mxv] at hg have fs := fvE (a + p t) (by clear*-hK1 hK2 hg hk;omega) obtain ⟨f2, e2⟩ := fadd a (p t) ha fp _ (by clear*-hK1;omega) (by clear*-hK1 hK2;omega) (rlt a (p t) ha fp fs ((K : Int) - 1022) (by clear*-hK1;omega) (by clear*-hK1 hK2;omega) ((bitsB _ fs).trans_le (zpow_le_zpow_right₀ (by norm_num) (by clear*-hg hk;omega)))) refine ih (t + 1) (a + p t) _ (by clear*-hm htn;omega) (by clear*-htn;omega) f2 ?_ hk rw [show (K : Int) - 1022 - 53 = ((K : Int) - 1076) + 1 by ring, zpow_add_one₀ two_ne_zero, mul_div_cancel_right₀ _ two_ne_zero] at e2 push_cast [Finset.sum_range_succ, abs_le] at e2 he ⊢; constructor <;> linarith only [e2.1, e2.2, he.1, he.2, vp] theorem cw (n : Nat) (fa fb : Nat → Word) (hfin : Core.finAll n fa fb) (S : Float) (hS : fv S) (h : UInt64) (hh : h.toNat < 2 ^ 63) (hT : |rv S - (Core.tsum n fa fb : ℝ)| ≤ (2 : ℝ) ^ (h.toNat : Int)) (hTb : |(Core.tsum n fa fb : ℝ)| ≤ (2 : ℝ) ^ (425 : Int)) (hc : cert2 S h < 0x100000000) : (cert2 S h).toUInt32 = dotOf n fa fb := by obtain ⟨hT0, hw⟩ := cert2_spec S hS h hh _ hT hTb hc rw [hw, Core.dotOf_round n fa fb hfin hT0] def emx (A : Array Word) (i : USize) (m : UInt32) : UInt32 := if h : i < A.usize then let e := (A.uget i (ulen h) >>> 23) &&& 255 emx A (i + 1) (if m < e then e else m) else m termination_by A.size - i.toNat decreasing_by have := ulen h; rw [usucc h]; omega theorem emx_spec (A : Array Word) (hs : A.size < USize.size) : ∀ k (i : USize) (m : UInt32), A.size - i.toNat = k → m.toNat ≤ (emx A i m).toNat ∧ ∀ q, i.toNat ≤ q → q < A.size → (expOf A[q]!).toNat ≤ (emx A i m).toNat := by intro k; induction k <;> intro i m hk ·have h : ¬ i < A.usize := fun h => by have := ulen h; clear h hs;omega rw [emx, dif_neg h]; exact ⟨le_rfl, fun q h1 h2 => by clear h hs;omega⟩ rename_i ih have h : i < A.usize := by rw [USize.lt_iff_toNat_lt, Array.usize, toUSize_toNat hs]; clear*-hk;omega rw [emx, dif_pos h]; dsimp only have hv : ∀ e : UInt32, (if m < e then e else m).toNat = max m.toNat e.toNat := fun e => by split <;> rename_i he <;> simp only [UInt32.lt_iff_toNat_lt] at he <;> (clear*-he;omega) obtain ⟨i1, i2⟩ := ih (i + 1) (if m < (A.uget i (ulen h) >>> 23) &&& 255 then (A.uget i (ulen h) >>> 23) &&& 255 else m) (by rw [usucc h]; clear*-hk;omega) rw [hv] at i1 refine ⟨by clear*-h i1;omega, fun q h1 h2 => ?_⟩ rcases eq_or_ne q i.toNat with rfl | e ·rw [← uget_eq A i (ulen h)]; unfold expOf; clear*-h i1;omega exact i2 q (by rw [usucc h]; clear*-e h h1;omega) h2 theorem exF (A : Array Word) (hs : A.size < USize.size) (h : emx A 0 0 < 255) (q : Nat) : expOf A[q]! ≠ 255 ∧ idxOf A[q]! ≤ (emx A 0 0).toNat - 1 := by have h' := UInt32.lt_iff_toNat_lt.mp h have hq : (expOf A[q]!).toNat ≤ (emx A 0 0).toNat := by by_cases hq : q < A.size ·exact (emx_spec A hs _ 0 0 rfl).2 q (by simp) hq ·rw [getElem!_neg A q hq]; exact Nat.zero_le _ refine ⟨fun e => by rw [e] at hq; simp at hq h'; clear*-h' hq;omega, by rw [idxE]; clear*-hq;omega⟩ @[specialize] def sfZ (k : Nat → Bool) (p : Nat → Float) (n t : Nat) (a : Float) : Float := if t < n then sfZ k p n (t + 1) (if k t then a else a + p t) else a termination_by n - t theorem sfold_Z (p : Nat → Float) (n : Nat) : ∀ m t a, n - t = m → sfold p n t a = sfZ (fun _ => false) p n t a := by intro m; induction m <;> intro t a h <;> unfold sfold sfZ ·grind ·grind theorem sfZ_err (k : Nat → Bool) (p : Nat → Float) (z : Nat → Int) (za : Int) (P L n : Nat) (hp : ∀ t < n, fv (p t) ∧ rv (p t) = z t) (hk : ∀ t < n, k t = true → z t = 0) (hz : ∀ t < n, |(z t : ℝ)| ≤ 2 ^ P) (hza : |(za : ℝ)| ≤ 2 ^ P) (hL : n + 2 ≤ 2 ^ L) (hL27 : L ≤ 27) (hPL : P + L ≤ 971) : ∀ m t a, n - t = m → t ≤ n → fv a → |rv a - ((za : ℝ) + ∑ s ∈ Finset.range t, (z s : ℝ))| ≤ t * ((2 : ℝ) ^ (P + L) * 2 ^ (-54 : Int)) → fv (sfZ k p n t a) ∧ |rv (sfZ k p n t a) - ((za : ℝ) + ∑ s ∈ Finset.range n, (z s : ℝ))| ≤ n * ((2 : ℝ) ^ (P + L) * 2 ^ (-54 : Int)) := by have hK : (2 : ℝ) ^ L * 2 ^ L * 2 ^ (-54 : Int) ≤ 1 := by rw [← pow_add, ← zpow_natCast, ← zpow_add₀ two_ne_zero] exact zpow_le_one_of_nonpos₀ (by norm_num) (by push_cast; clear*-hL27;omega) intro m; induction m <;> intro t a hm ht ha he ·obtain rfl : t = n := by clear*-hm ht;omega rw [sfZ, if_neg (lt_irrefl _)]; exact ⟨ha, he⟩ rename_i ih have htn : t < n := by clear*-hm;omega obtain ⟨fp, vp⟩ := hp t htn have hS := psum_le n z za _ hz hza (t + 1) (by clear*-htn;omega) have h1 := sub_nonneg.2 (by exact_mod_cast (by clear*-hL htn;omega : t + 3 ≤ 2 ^ L) : (t : ℝ) + 3 ≤ 2 ^ L) have hc : (0 : ℝ) < 2 ^ L * 2 ^ (-54 : Int) * 2 ^ P := by positivity have := mul_nonneg h1 hc.le; have := mul_nonneg (sub_nonneg.2 hK) (pow_pos two_pos P).le have := mul_nonneg h1 (pow_pos two_pos P).le push_cast [Finset.sum_range_succ, pow_add, abs_le] at hS he rw [sfZ, if_pos htn]; split ·refine ih (t + 1) a (by clear*-hm htn;omega) (by clear*-htn;omega) ha ?_ push_cast [Finset.sum_range_succ, pow_add, abs_le, hk t htn ‹_›]; constructor <;> linarith obtain ⟨f2, e2⟩ := fadd2 a (p t) ha fp (P + L) (by omega) (by rw [pow_add, abs_lt]; constructor <;> linarith) refine ih (t + 1) (a + p t) (by clear*-hm htn;omega) (by clear*-htn;omega) f2 ?_ push_cast [Finset.sum_range_succ, pow_add, abs_le] at e2 ⊢; constructor <;> linarith theorem tmB (a b : Word) (A B : Nat) (ha : idxOf a ≤ A) (hb : idxOf b ≤ B) : |(Core.tm a b : ℝ)| ≤ (2 : ℝ) ^ (48 + A + B) := by have h1 := sv_abs a; have h2 := sv_abs b have e : (Core.tm a b).natAbs ≤ 2 ^ (48 + A + B) := by unfold Core.tm rw [Int.natAbs_mul, Int.natAbs_mul, Int.natAbs_pow] rw [Int.abs_eq_natAbs] at h1 h2 have n1 : (sv a).natAbs ≤ 2 ^ 24 := by clear*-h1;omega have n2 : (sv b).natAbs ≤ 2 ^ 24 := by clear*-h2;omega calc (sv a).natAbs * (sv b).natAbs * (2 : Int).natAbs ^ (idxOf a + idxOf b) ≤ 2 ^ 24 * 2 ^ 24 * 2 ^ (A + B) := by apply Nat.mul_le_mul (Nat.mul_le_mul n1 n2); exact Nat.pow_le_pow_right (by norm_num) (by omega) _ = 2 ^ (48 + A + B) := by rw [← pow_add, ← pow_add]; congr 1; clear*-;omega rw [← Int.cast_abs, Int.abs_eq_natAbs]; exact_mod_cast e @[inline] def s8 (Y : FloatArray) (o : USize) (e0 e1 e2 e3 e4 e5 e6 e7 : Float) : FloatArray := (((((((Y.set! o.toNat e0).set! (o + 1).toNat e1).set! (o + 2).toNat e2).set! (o + 3).toNat e3).set! (o + 4).toNat e4).set! (o + 5).toNat e5).set! (o + 6).toNat e6).set! (o + 7).toNat e7 theorem s8_spec (Y : FloatArray) (o : USize) (e : Nat → Float) (h : o.toNat + 8 < USize.size) : (s8 Y o (e 0) (e 1) (e 2) (e 3) (e 4) (e 5) (e 6) (e 7)).size = Y.size ∧ ∀ q < Y.size, (s8 Y o (e 0) (e 1) (e 2) (e 3) (e 4) (e 5) (e 6) (e 7)).data[q]! = if o.toNat ≤ q ∧ q < o.toNat + 8 then e (q - o.toNat) else Y.data[q]! := by refine ⟨by simp only [s8, ssz], fun q hq => ?_⟩ simp (disch := (try simp only [ssz, USize.reduceToNat]); omega) only [s8, sg, uadd, USize.reduceToNat] split_ifs <;> first | rfl | omega | (congr 1; clear h hq;omega) theorem gD (X : Array Word) (k : Nat) : X.getD k 0 = X[k]! := by unfold Array.getD; split <;> rename_i h ·rw [getElem!_pos X k h]; rfl ·rw [getElem!_neg X k h]; rfl @[inline] def xr (X : Array Word) (q st : USize) (r : Nat) : Float := dw (X.getD (q + r.toUSize * st).toNat 0) def bx (X : Array Word) (st s : USize) : Nat → USize → USize → FloatArray → FloatArray | 0, _, _, Y => Y | k + 1, q, o, Y => bx X st s k (q + s) (o + 8) (s8 Y o (xr X q st 0) (xr X q st 1) (xr X q st 2) (xr X q st 3) (xr X q st 4) (xr X q st 5) (xr X q st 6) (xr X q st 7)) theorem bx_spec (X : Array Word) (st s : USize) : ∀ k (q o : USize) (Y : FloatArray), q.toNat + k * s.toNat + 8 * st.toNat + o.toNat + 8 * k < USize.size → o.toNat + 8 * k ≤ Y.size → (bx X st s k q o Y).size = Y.size ∧ (∀ p < o.toNat, (bx X st s k q o Y).data[p]! = Y.data[p]!) ∧ ∀ τ r, τ < k → r < 8 → (bx X st s k q o Y).data[o.toNat + 8 * τ + r]! = dw X[q.toNat + τ * s.toNat + r * st.toNat]! := by intro k; induction k with | zero => intro q o Y _ _; exact ⟨rfl, fun _ _ => rfl, fun τ r h => absurd h (by clear*-h;omega)⟩ | succ k ih => intro q o Y hB hY; rw [Nat.succ_mul] at hB have := USize.le_size; have := USize.size_eq_two_pow obtain ⟨s1, s2⟩ := s8_spec Y o (xr X q st) (by clear*-hB;omega) have e1 : (q + s).toNat = q.toNat + s.toNat := uadd (by clear*-hB;omega) have e2 : (o + 8).toNat = o.toNat + 8 := by rw [uadd (by simp; clear*-hB;omega)]; simp obtain ⟨i1, i2, i3⟩ := ih (q + s) (o + 8) _ (by clear*-e1 e2 hB;omega) (by rw [s1]; clear*-e2 hY;omega) rw [e2] at i2; rw [e1, e2] at i3 refine ⟨by rw [bx, i1, s1], fun p hp => by rw [bx, i2 p (by clear*-hp;omega), s2 p (by clear*-hY hp;omega), if_neg (by clear*-hp;omega)], fun τ r h1 hr => ?_⟩ rw [bx]; rcases τ with _ | τ ·have m : (r.toUSize * st).toNat = r * st.toNat := by rw [USize.toNat_mul, toUSize_toNat (by clear e1 e2 h1 hB hY i1 i2 i3 ih s1 s2 this;omega), Nat.mod_eq_of_lt (by have := Nat.mul_le_mul_right st.toNat hr.le; clear e1 e2 h1 hY hr i1 i2 i3 ih s1 s2;omega)] rw [i2 _ (by clear*-hr;omega), s2 _ (by clear*-hY hr;omega), if_pos (by clear*-hr;omega), show o.toNat + 8 * 0 + r - o.toNat = r by clear*-hr;omega, xr, uadd (by rw [m]; have := Nat.mul_le_mul_right st.toNat hr.le; clear*-hB this;omega), m, gD]; simp ·grind def ZT : Array FloatArray := Array.ofFn (n := 10) fun k => ⟨Array.replicate (2 ^ (k.val + 7)) 0⟩ def zT (n : Nat) : FloatArray := let k := Nat.log2 (8 * n) + 1 - 7 if k < 10 then ZT[k]! else ⟨Array.replicate (8 * n) 0⟩ theorem zsz (n : Nat) : 8 * n ≤ (zT n).size ∧ ((zT n).size = 8 * n ∨ (zT n).size ≤ 2 ^ 16) := by unfold zT; dsimp only; split ·rw [getElem!_pos ZT _ (by simp [ZT]; omega)] simp only [ZT, Array.getElem_ofFn, FloatArray.size, Array.size_replicate] exact ⟨(Nat.lt_log2_self (n := 8 * n)).le.trans (Nat.pow_le_pow_right (by decide) (by omega)), .inr (Nat.pow_le_pow_right (by decide) (by omega))⟩ ·simp [FloatArray.size] @[inline] def rX (X : Array Word) (i : USize) : Float := if h : i < X.usize then dw (X.uget i (ulen h)) else dw 0 theorem fulen {Y : FloatArray} {i : USize} (h : i < Y.usize) : i.toNat < Y.size := by have := USize.lt_iff_toNat_lt.mp h simp only [FloatArray.usize, Nat.toUSize_eq, USize.toNat_ofNat] at this exact lt_of_lt_of_le this (Nat.mod_le _ _) @[inline] def wF (Y : FloatArray) (i : USize) (v : Float) : FloatArray := if h : i < Y.usize then Y.uset i v (fulen h) else Y @[inline] def cE (F a : Float) : UInt64 := let e := eF (F * a).toBits; if 1078 < e then e - 1078 else 0 @[inline] def tS (relu : Bool) (L n : Nat) (p : Nat → Float) (bpf : Unit → Float) (fbk : Unit → Word) : Word := let r := sT p n 0 (bpf ()) 0 let c := if 1 ≤ r.2.toNat ∧ r.2.toNat ≤ 1993 ∧ 1076 ≤ r.2.toNat + L then cert2 r.1 (r.2.toNat + L - 1076).toUInt64 else 0x100000000 if c < 0x100000000 then act relu c.toUInt32 else fbk () @[inline] def tf (relu : Bool) (S : Float) (hh : UInt64) (sl : Unit → Word) : Word := let c := cert2 S hh if c < 0x100000000 then act relu c.toUInt32 else sl () @[inline] def tw (relu : Bool) (S : Float) (hh : UInt64) (L n : Nat) (p : Nat → Float) (bpf : Unit → Float) (fbk : Unit → Word) : Word := tf relu S hh fun _ => tS relu L n p bpf fbk theorem twS (relu : Bool) (n : Nat) (fa fb : Nat → Word) (p : Nat → Float) (bpf : Unit → Float) (hh : UInt64) (P L : Nat) (fbk : Unit → Word) (hp : ∀ s < n, fv (p s) ∧ rv (p s) = Core.tm (fa s) (fb s)) (hbp : fv (bpf ()) ∧ rv (bpf ()) = Core.tm (fa n) (fb n)) (hfin : Core.finAll (n + 1) fa fb) (hP : ∀ s ≤ n, |(Core.tm (fa s) (fb s) : ℝ)| ≤ 2 ^ P) (hL : n + 2 ≤ 2 ^ L) (hL27 : L ≤ 27) (hPL : P + L ≤ 425) (hhv : hh.toNat = P + 2 * L - 54) (hk : fbk () = act relu (dotOf (n + 1) fa fb)) (S : Float) (fS : fv S) (hb2 : |rv S - (Core.tsum (n + 1) fa fb : ℝ)| ≤ (2 : ℝ) ^ (hh.toNat : Int)) : tw relu S hh L n p bpf fbk = act relu (dotOf (n + 1) fa fb) := by have hT : (Core.tsum (n + 1) fa fb : ℝ) = Core.tm (fa n) (fb n) + ∑ s ∈ Finset.range n, (Core.tm (fa s) (fb s) : ℝ) := by rw [Core.tsum_succ, Core.tsum]; push_cast; ring have hTb : |(Core.tsum (n + 1) fa fb : ℝ)| ≤ (2 : ℝ) ^ (425 : Int) := by rw [hT, zpow_ofNat] refine (psum_le n _ _ _ (fun s hs => hP s hs.le) (hP n le_rfl) n le_rfl).trans ?_ calc ((n : ℝ) + 1) * 2 ^ P ≤ 2 ^ L * 2 ^ P := by gcongr; exact_mod_cast (by clear*-hL;omega : n + 1 ≤ 2 ^ L) _ ≤ 2 ^ 425 := by rw [← pow_add]; exact pow_le_pow_right₀ (by norm_num) (by clear*-hPL;omega) simp only [tw, tf, tS] split_ifs with hc hk' hc' <;> try exact hk ·exact congrArg _ (cw _ _ _ hfin _ fS hh (by rw [hhv]; clear*-hPL;omega) hb2 hTb hc) ·obtain ⟨fS2, eS2⟩ := sT_err _ _ (Core.tm (fa n) (fb n)) n _ hk'.1 hk'.2.1 hp n 0 _ 0 rfl (by clear*-;omega) hbp.1 (by simp [hbp.2]) le_rfl rw [← hT] at eS2 refine congrArg _ (cw _ _ _ hfin _ fS2 _ ?_ (eS2.trans ?_) hTb hc') <;> rw [Nat.toUInt64_eq, UInt64.toNat_ofNat_of_lt' (by simp only [UInt64.size]; clear*-hL27 hk';omega)] ·clear*-hL27 hk';omega refine (mul_le_mul_of_nonneg_right (by exact_mod_cast (by clear*-hL;omega : n ≤ 2 ^ L) : (n : ℝ) ≤ 2 ^ L) (by positivity)).trans_eq ?_ rw [← zpow_natCast, ← zpow_add₀ two_ne_zero]; congr 1; clear*-hk';omega ·exact absurd ‹_› (by decide) theorem gg (X : FloatArray) (i : Nat) : X.get! i = X.data[i]! := by rcases X with ⟨d⟩; rfl theorem f8 (v : Float) (r : Nat) : A8.f ⟨v, v, v, v, v, v, v, v⟩ r = v := by unfold A8.f; split <;> rfl theorem rre (z : ℝ) : |Model.roundAt FloatFormat.binary64 z - z| ≤ (2 : ℝ) ^ (-53 : Int) * |z| + 2 ^ (-1075 : Int) := by by_cases h : |z| < (2 : ℝ) ^ (-1021 : Int) ·refine (re z (-1021) le_rfl h).trans ?_ rw [div_eq_mul_inv, ← zpow_sub_one₀ two_ne_zero]; norm_num ·have hz : 0 < |z| := lt_of_lt_of_le (by positivity) (not_lt.1 h) have h1 := Int.zpow_log_le_self (b := 2) (by norm_num) hz have h2 := Int.lt_zpow_succ_log_self (b := 2) (by norm_num) |z| simp only [Nat.cast_ofNat] at h1 h2 have hE : (-1021 : Int) ≤ Int.log 2 |z| + 1 := by by_contra hc; linarith [zpow_le_zpow_right₀ (by norm_num : (1 : ℝ) ≤ 2) (by omega : Int.log 2 |z| + 1 ≤ -1021)] refine (re z _ hE h2).trans ?_ rw [div_eq_mul_inv, ← zpow_sub_one₀ two_ne_zero, show Int.log 2 |z| + 1 - 53 - 1 = -53 + Int.log 2 |z| by ring, zpow_add₀ two_ne_zero] linarith [mul_le_mul_of_nonneg_left h1 (by positivity : (0 : ℝ) ≤ 2 ^ (-53 : Int)), show (0 : ℝ) ≤ 2 ^ (-1075 : Int) by positivity] theorem rra (x y : Float) (hx : fv x) (hy : fv y) (hb : |rv x + rv y| ≤ (2 : ℝ) ^ (970 : Int)) : fv (x + y) ∧ |rv (x + y) - (rv x + rv y)| ≤ (2 : ℝ) ^ (-53 : Int) * |rv x + rv y| + 2 ^ (-1075 : Int) := by obtain ⟨f, e⟩ := faR x y hx hy (hb.trans ((zpow_le_zpow_right₀ (by norm_num) (by norm_num)).trans (pm 971 le_rfl))) exact ⟨f, by rw [e]; exact rre _⟩ theorem rrm (x y : Float) (hx : fv x) (hy : fv y) (hb : |rv x * rv y| ≤ (2 : ℝ) ^ (971 : Int)) : fv (x * y) ∧ |rv (x * y) - rv x * rv y| ≤ (2 : ℝ) ^ (-53 : Int) * |rv x * rv y| + 2 ^ (-1075 : Int) := by obtain ⟨f, e⟩ := fmR x y hx hy hb exact ⟨f, by rw [e]; exact rre _⟩ theorem bitsS (v : Float) (hv : fv v) (he : eF v.toBits = 0) : rv v = (⟨v.toBits >>> 63 != 0, (v.toBits &&& 0xfffffffffffff).toNat, -1074⟩ : FloatLib.Numerics.Dyadic).toReal := by unfold eF at he; unfold fv at hv; unfold rv rw [fld] at hv ⊢ rw [Model.toReal_eq, Model.toDyadic?_ofFields_of_isFinite _ _ _ _ (fq v).1 (fq v).2 hv, ite_eq_left (by rw [he]; rfl)] split_ifs with h0 ·dsimp only; rw [dyR, dyR, h0]; simp ·rfl theorem eFb (v : Float) (hv : fv v) : |rv v| < (2 : ℝ) ^ (((eF v.toBits).toNat : Int) - 1022) := by have hr := (fq v).2 by_cases he : eF v.toBits = 0 ·rw [bitsS v hv he, dyR, show (eF v.toBits).toNat = 0 by rw [he]; rfl, show (2 : ℝ) ^ (((0 : Nat) : Int) - 1022) = 2 ^ 52 * 2 ^ (-1074 : Int) by rw [show (2 : ℝ) ^ 52 = 2 ^ (52 : Int) by norm_num, ← zpow_add₀ two_ne_zero]; norm_num] have : ((v.toBits &&& 0xfffffffffffff).toNat : ℝ) < 2 ^ 52 := by exact_mod_cast hr split <;> simp only [neg_mul, abs_neg, abs_mul, abs_zpow, abs_two, Nat.abs_cast] <;> exact mul_lt_mul_of_pos_right this (by positivity) ·rw [bitsD v hv he, dyR, show (2 : ℝ) ^ (((eF v.toBits).toNat : Int) - 1022) = 2 ^ 53 * 2 ^ (((eF v.toBits).toNat : Int) - 1075) by rw [show (2 : ℝ) ^ 53 = 2 ^ (53 : Int) by norm_num, ← zpow_add₀ two_ne_zero]; congr 1; ring] have : (((v.toBits &&& 0xfffffffffffff).toNat + 2 ^ 52 : Nat) : ℝ) < 2 ^ 53 := by exact_mod_cast (by omega : (v.toBits &&& 0xfffffffffffff).toNat + 2 ^ 52 < 2 ^ 53) split <;> simp only [neg_mul, abs_neg, abs_mul, abs_zpow, abs_two, Nat.abs_cast] <;> exact mul_lt_mul_of_pos_right this (by positivity) theorem sfR (p : Nat → Float) (z : Nat → ℝ) (za : ℝ) (n : Nat) (hp : ∀ t < n, fv (p t) ∧ rv (p t) = z t) (hn : n ≤ 2 ^ 32) (hA : |za| + ∑ s ∈ Finset.range n, |z s| ≤ (2 : ℝ) ^ (968 : Int)) : ∀ m t a, n - t = m → t ≤ n → fv a → |rv a - (za + ∑ s ∈ Finset.range t, z s)| ≤ t * ((2 : ℝ) ^ (-53 : Int) * (1 + 2 ^ (-20 : Int)) * (|za| + ∑ s ∈ Finset.range t, |z s|) + 2 ^ (-1074 : Int)) → fv (sfold p n t a) ∧ |rv (sfold p n t a) - (za + ∑ s ∈ Finset.range n, z s)| ≤ n * ((2 : ℝ) ^ (-53 : Int) * (1 + 2 ^ (-20 : Int)) * (|za| + ∑ s ∈ Finset.range n, |z s|) + 2 ^ (-1074 : Int)) := by have h970 : (2 : ℝ) ^ (970 : Int) = 2 ^ (968 : Int) * 4 := by rw [show (970 : Int) = 968 + 2 by norm_num, zpow_add₀ two_ne_zero]; norm_num have hη : (2 : ℝ) ^ (-1075 : Int) = 2 ^ (-1074 : Int) / 2 := by rw [show (-1074 : Int) = -1075 + 1 by norm_num, zpow_add_one₀ two_ne_zero]; ring have hηH : (4294967296 : ℝ) * 2 ^ (-1074 : Int) ≤ 2 ^ (968 : Int) := by rw [show (4294967296 : ℝ) = 2 ^ (32 : Int) by norm_num, ← zpow_add₀ two_ne_zero] exact zpow_le_zpow_right₀ (by norm_num) (by norm_num) have hη0 : (0 : ℝ) < 2 ^ (-1074 : Int) := by positivity intro m; induction m with | zero => intro t a hm ht ha h; obtain rfl : t = n := by omega rw [sfold, if_neg (lt_irrefl _)]; exact ⟨ha, h⟩ | succ m ih => intro t a hm ht ha h have htn : t < n := by omega rw [sfold, if_pos htn] obtain ⟨fp, vp⟩ := hp t htn have hS := Finset.sum_le_sum_of_subset_of_nonneg (Finset.range_mono htn) (fun i _ _ => abs_nonneg (z i)) have hT := (abs_add_le za _).trans (add_le_add le_rfl (Finset.abs_sum_le_sum_abs z (Finset.range (t + 1)))) simp only [Finset.sum_range_succ] at hS hT have hY := abs_add_le (rv a - (za + ∑ s ∈ Finset.range t, z s)) (za + (∑ s ∈ Finset.range t, z s + z t)) rw [show rv a - (za + ∑ s ∈ Finset.range t, z s) + (za + (∑ s ∈ Finset.range t, z s + z t)) = rv a + rv (p t) by rw [vp]; ring] at hY have ht' : (t : ℝ) ≤ 4294967296 := by exact_mod_cast (by clear*-hn htn;omega : t ≤ 2 ^ 32) have k1 := mul_le_mul_of_nonneg_right ht' (abs_nonneg za) have k2 := mul_le_mul_of_nonneg_right ht' (Finset.sum_nonneg fun i (_ : i ∈ Finset.range t) => abs_nonneg (z i)) have k3 := mul_le_mul_of_nonneg_right ht' (abs_nonneg (z t)) have k4 := mul_le_mul_of_nonneg_right ht' hη0.le have hs0 : 0 ≤ ∑ s ∈ Finset.range t, |z s| := Finset.sum_nonneg fun i _ => abs_nonneg (z i) have k5 := mul_nonneg (Nat.cast_nonneg t : (0 : ℝ) ≤ t) (abs_nonneg (z t)) have k6 := abs_nonneg za have k7 := abs_nonneg (z t) have h' : |rv a - (za + ∑ s ∈ Finset.range t, z s)| ≤ 1 / 9007199254740992 * (1 + 1 / 1048576) * (t * |za|) + 1 / 9007199254740992 * (1 + 1 / 1048576) * (t * ∑ s ∈ Finset.range t, |z s|) + t * 2 ^ (-1074 : Int) := h.trans_eq (by ring) obtain ⟨f2, e2⟩ := rra a (p t) ha fp (by rw [h970]; generalize (2 : ℝ) ^ (968 : Int) = H at *; generalize (2 : ℝ) ^ (-1074 : Int) = η at * linarith only [hY, h', hT, hS, hA, k1, k2, k4, hηH, hs0, k6, k7, hη0]) refine ih (t + 1) (a + p t) (by omega) (by clear*-htn;omega) f2 ?_ rw [hη, show (2 : ℝ) ^ (-53 : Int) = 1 / 9007199254740992 by norm_num] at e2 have key := abs_add_le (rv (a + p t) - (rv a + rv (p t))) (rv a - (za + ∑ s ∈ Finset.range t, z s)) rw [show rv (a + p t) - (rv a + rv (p t)) + (rv a - (za + ∑ s ∈ Finset.range t, z s)) = rv (a + p t) - (za + (∑ s ∈ Finset.range t, z s + z t)) by rw [vp]; ring] at key simp only [Finset.sum_range_succ] generalize (2 : ℝ) ^ (-1074 : Int) = η at * calc _ ≤ 1 / 9007199254740992 * (1 + 1 / 1048576) * (t * |za| + t * ∑ s ∈ Finset.range t, |z s| + t * |z t| + (|za| + (∑ s ∈ Finset.range t, |z s| + |z t|))) + t * η + η := by linarith _ = _ := by push_cast; ring theorem upAbs (m : Float.Model) : (Float.Model.pack m.unpack.abs).unpack = m.unpack.abs := by have h1 : (Float.Model.pack m.unpack).unpack = m.unpack := by have := Model.toFloatModel_ofFloatModel m conv_rhs => rw [← this] rfl generalize m.unpack = u at h1 ⊢ simp only [Float.Model.pack, Float.Model.unpack, UInt64.toBitVec_ofBitVec] at h1 ⊢ cases u with | notANumber => exact h1 | finite s mt e hm => simp only [Float.Model.UnpackedFloat.abs, Float.Model.UnpackedFloat.pack, Float.Model.UnpackedFloat.packedInfinity] at h1 ⊢ split_ifs at h1 ⊢ <;> simp only [Float.Model.UnpackedFloat.unpack, Float.Model.UnpackedFloat.unpackExponent_packComponents, Float.Model.UnpackedFloat.unpackMantissa_packComponents, Model.unpackSign_packComponents] at h1 ⊢ <;> split_ifs at h1 ⊢ <;> simp_all | _ => simp only [Float.Model.UnpackedFloat.abs, Float.Model.UnpackedFloat.pack, Float.Model.UnpackedFloat.packedInfinity, Float.Model.UnpackedFloat.packedZero, Float.Model.UnpackedFloat.unpack, Float.Model.UnpackedFloat.unpackExponent_packComponents, Float.Model.UnpackedFloat.unpackMantissa_packComponents, Model.unpackSign_packComponents] at h1 ⊢ split_ifs at h1 ⊢ <;> simp_all theorem fabs (v : Float) (hv : fv v) : fv v.abs ∧ rv v.abs = |rv v| := by have e : v.abs.toModel.unpack = v.toModel.unpack.abs := upAbs v.toModel rw [fvI] at hv ⊢; rw [rvU, rvU, e] generalize v.toModel.unpack = u at hv ⊢ cases u with | notANumber | infinity _ => simp [Float.Model.UnpackedFloat.isFinite] at hv | zero _ => simp [Float.Model.UnpackedFloat.abs, Float.Model.UnpackedFloat.isFinite, Model.unpackedToReal, Model.unpackedToDyadic?] | finite s mt e hm => refine ⟨by simp [Float.Model.UnpackedFloat.abs, Float.Model.UnpackedFloat.isFinite], ?_⟩ simp only [Float.Model.UnpackedFloat.abs, Model.unpackedToReal_finite, abs_mul] have hp := FloatLib.Floats.Formats.Flocq.bpow.pos FloatLib.Numerics.binaryRadix e split <;> split <;> simp_all [abs_of_pos hp] theorem c2T (S : Float) (hS : fv S) (h : UInt64) (hh : h.toNat < 2 ^ 63) (T : ℝ) (hT : |rv S - T| ≤ (2 : ℝ) ^ (h.toNat : Int)) (hc : cert2 S h < 0x100000000) : |T| ≤ (2 : ℝ) ^ (425 : Int) := by unfold cert2 at hc; dsimp only at hc split at hc swap; · exact absurd hc (by decide) rename_i g; simp only [Bool.and_eq_true, decide_eq_true_eq] at g obtain ⟨⟨⟨c1, c2⟩, c3⟩, c4⟩ := g obtain ⟨d1, d2, e1, e2, -, -, -, f2⟩ := c3c h (eF S.toBits) (S.toBits &&& 0xfffffffffffff) hh (fq S).1 (fq S).2 c1 c2 c3 (rb _ c4) have hv := bitsD S hS (fun h0 => by rw [h0] at e1; simp at e1) rw [dyR] at hv generalize (eF S.toBits).toNat = E at d1 d2 e1 e2 f2 hv generalize (S.toBits &&& 0xfffffffffffff).toNat = f at f2 hv have hu : (0 : ℝ) < 2 ^ ((E : Int) - 1075) := by positivity have hB : ((f + 2 ^ 52 : Nat) : ℝ) + ((2 ^ (h.toNat + 1075 - E) : Nat) : ℝ) ≤ 2 ^ 53 := by exact_mod_cast (by clear*-f2;omega : f + 2 ^ 52 + 2 ^ (h.toNat + 1075 - E) ≤ 2 ^ 53) have hS : |rv S| = ((f + 2 ^ 52 : Nat) : ℝ) * 2 ^ ((E : Int) - 1075) := by rw [hv, abs_mul, abs_of_pos hu]; split <;> simp only [abs_neg, Nat.abs_cast] have := abs_sub (rv S) (rv S - T) rw [sub_sub_cancel, hS] at this rw [show (2 : ℝ) ^ (h.toNat : Int) = ((2 ^ (h.toNat + 1075 - E) : Nat) : ℝ) * 2 ^ ((E : Int) - 1075) by push_cast; rw [← zpow_natCast, ← zpow_add₀ two_ne_zero]; congr 1; clear*-d1;omega] at hT have h425 : (2 : ℝ) ^ (53 : Nat) * 2 ^ ((E : Int) - 1075) ≤ 2 ^ (425 : Int) := by rw [← zpow_natCast, ← zpow_add₀ two_ne_zero]; exact zpow_le_zpow_right₀ (by norm_num) (by clear*-e1 e2;omega) linarith [mul_le_mul_of_nonneg_right hB hu.le] theorem cw2 (n : Nat) (fa fb : Nat → Word) (hfin : Core.finAll n fa fb) (S : Float) (hS : fv S) (h : UInt64) (hh : h.toNat < 2 ^ 63) (hT : |rv S - (Core.tsum n fa fb : ℝ)| ≤ (2 : ℝ) ^ (h.toNat : Int)) (hc : cert2 S h < 0x100000000) : (cert2 S h).toUInt32 = dotOf n fa fb := cw n fa fb hfin S hS h hh hT (c2T S hS h hh _ hT hc) hc theorem wF_eq (Y : FloatArray) (hY : Y.size < 2 ^ 32) (i : USize) (v : Float) : wF Y i v = Y.set! i.toNat v := by rcases Y with ⟨d⟩ unfold wF; split next h => simp only [FloatArray.uset, FloatArray.set!, Array.uset, Array.set!, Array.setIfInBounds]; rw [dite_eq_left (show i.toNat < d.size from fulen h)] next h => simp only [FloatArray.set!, Array.set!, Array.setIfInBounds] rw [dite_eq_right fun h' => h (by rw [USize.lt_iff_toNat_lt, FloatArray.usize, toUSize_toNat (lt_of_lt_of_le hY USize.le_size)]; exact h')] theorem rX_eq (X : Array Word) (hX : X.size < 2 ^ 32) (i : USize) : rX X i = dw X[i.toNat]! := by unfold rX; split ·rw [uget_eq] next h => rw [getElem!_neg X _ fun h' => h (by rw [USize.lt_iff_toNat_lt, Array.usize, toUSize_toNat (lt_of_lt_of_le hX USize.le_size)]; exact h')]; rfl theorem sfold_shift (p : Nat → Float) (n : Nat) : ∀ m t a, n - t = m → sfold p (n + 1) (t + 1) a = sfold (fun τ => p (τ + 1)) n t a := by intro m; induction m with | zero => intro t a h; unfold sfold; rw [if_neg (by omega), if_neg (by omega)] | succ m ih => intro t a h; unfold sfold; rw [if_pos (by omega), if_pos (by omega)]; exact ih (t + 1) _ (by omega) theorem bnd (n : ℕ) (σ za E A C H M : ℝ) (hσ : 0 ≤ σ) (hA : 0 < A) (hC : 1 ≤ C) (hn : (n : ℝ) ≤ 2 ^ (32 : Int)) (hE : E ≤ n * ((2 : ℝ) ^ (-53 : Int) * (1 + 2 ^ (-20 : Int)) * (|za| + A * σ) + 2 ^ (-1074 : Int)) + 2 ^ (26 : Int) * σ) (hK : (2 : ℝ) ^ (26 : Int) ≤ A * 2 ^ (-53 : Int)) (hc : 9 * ((n : ℝ) + 1) * σ * (1 - 2 ^ (-20 : Int)) ≤ C * 2 ^ (56 : Int) + 2 ^ (-900 : Int)) (hz : (n : ℝ) * |za| ≤ H * 2 ^ (49 : Int)) (hM1 : A * C ≤ M) (hM2 : H ≤ M) (hM3 : (2 : ℝ) ^ (79 : Int) ≤ M) : E ≤ M := by have h1 : (n : ℝ) * 2 ^ (-1074 : Int) ≤ 1 := (mul_le_mul_of_nonneg_right hn (by positivity)).trans (by rw [← zpow_add₀ two_ne_zero]; exact zpow_le_one_of_nonpos₀ (by norm_num) (by norm_num)) have h2 : (2 : ℝ) ^ (-900 : Int) ≤ 1 := zpow_le_one_of_nonpos₀ (by norm_num) (by norm_num) generalize (2 : ℝ) ^ (-1074 : Int) = η at * generalize (2 : ℝ) ^ (-900 : Int) = ε at * norm_num at hE hK hc hz hM3 linarith [mul_le_mul_of_nonneg_right hK hσ, mul_le_mul_of_nonneg_left hc hA.le, mul_le_mul_of_nonneg_left h2 hA.le, mul_le_mul_of_nonneg_left hC hA.le] theorem cE_spec (n : Nat) (hn : n < 2 ^ 29) (a : Float) (σ : ℝ) (ha : fv a) (hσ : 0 ≤ σ) (hσ2 : σ ≤ 2 ^ (400 : Int)) (herr : |rv a - σ| ≤ n * ((2 : ℝ) ^ (-53 : Int) * (1 + 2 ^ (-20 : Int)) * σ + 2 ^ (-1074 : Int))) : 9 * ((n : ℝ) + 1) * σ * (1 - 2 ^ (-20 : Int)) ≤ 2 ^ (((cE (9 * (n + 1)).toUInt64.toInt64.toFloat a).toNat : Int) + 56) + 2 ^ (-900 : Int) := by have e : (9 * (n + 1)).toUInt64.toInt64.toInt = ((9 * (n + 1) : Nat) : Int) := by rw [show (9 * (n + 1)).toUInt64.toInt64.toInt = Core.sval (9 * (n + 1)).toUInt64 from rfl, sval_eq, Nat.toUInt64_eq, UInt64.toNat_ofNat_of_lt' (by simp only [UInt64.size]; omega)] split <;> omega obtain ⟨fF, vF⟩ := i64 (9 * (n + 1)).toUInt64.toInt64 (by rw [e]; simp; clear*-hn;omega) rw [e] at vF; push_cast at vF have hc : (2 : ℝ) ^ (((eF ((9 * (n + 1)).toUInt64.toInt64.toFloat * a).toBits).toNat : Int) - 1022) ≤ 2 ^ (((cE (9 * (n + 1)).toUInt64.toInt64.toFloat a).toNat : Int) + 56) := by apply zpow_le_zpow_right₀ (by norm_num) unfold cE; dsimp only; split ·rw [UInt64.toNat_sub_of_le _ _ (UInt64.le_of_lt ‹_›)]; have := UInt64.lt_iff_toNat_lt.mp ‹_› simp only [UInt64.reduceToNat] at this ⊢; clear*-this;omega ·have := UInt64.le_iff_toNat_le.mp (UInt64.not_lt.mp ‹_›); simp only [UInt64.reduceToNat] at this ⊢; clear*-this;omega have hm : (n : ℝ) ≤ 536870912 := by exact_mod_cast hn.le have hy : (2 : ℝ) ^ (-1074 : Int) = 2 ^ (-1075 : Int) * 2 := by rw [← zpow_add_one₀ two_ne_zero]; norm_num have hε : (2 : ℝ) ^ (-1075 : Int) * 2 ^ 64 ≤ 2 ^ (-900 : Int) := by rw [← zpow_natCast, ← zpow_add₀ two_ne_zero]; exact zpow_le_zpow_right₀ (by norm_num) (by norm_num) have hW : (2 : ℝ) ^ 40 * 2 ^ (400 : Int) ≤ 2 ^ (971 : Int) := by rw [← zpow_natCast, ← zpow_add₀ two_ne_zero]; exact zpow_le_zpow_right₀ (by norm_num) (by norm_num) have hZ : (1 : ℝ) ≤ 2 ^ (400 : Int) := one_le_zpow₀ (by norm_num) (by norm_num) have hy0 : (0 : ℝ) < 2 ^ (-1075 : Int) := by positivity have he1 : (2 : ℝ) ^ (-900 : Int) ≤ 1 := zpow_le_one_of_nonpos₀ (by norm_num) (by norm_num) rw [show (2 : ℝ) ^ (-53 : Int) = 1 / 9007199254740992 by norm_num, show (2 : ℝ) ^ (-20 : Int) = 1 / 1048576 by norm_num, hy, mul_add, ← mul_assoc] at herr have k2 := mul_le_mul_of_nonneg_right hm hy0.le generalize hk : (n : ℝ) * (1 / 9007199254740992 * (1 + 1 / 1048576)) = kn at herr have hk1 : kn ≤ 1 / 8388608 := by rw [← hk]; nlinarith have k3 := mul_le_mul_of_nonneg_right hk1 hσ have hA : |rv a| ≤ 3 * 2 ^ (400 : Int) := by have := abs_sub_abs_le_abs_sub (rv a) σ; rw [abs_of_nonneg hσ] at this generalize (2 : ℝ) ^ (-1075 : Int) = y at *; generalize (2 : ℝ) ^ (-900 : Int) = ε at * generalize (2 : ℝ) ^ (400 : Int) = Z at *; linarith have hb : |rv (9 * (n + 1)).toUInt64.toInt64.toFloat * rv a| ≤ 2 ^ (971 : Int) := by rw [vF, abs_mul, abs_of_pos (by positivity)] have := mul_le_mul_of_nonneg_left hA (by positivity : (0 : ℝ) ≤ 9 * (n + 1)) have := mul_le_mul_of_nonneg_right hm (by positivity : (0 : ℝ) ≤ 2 ^ (400 : Int)) generalize (2 : ℝ) ^ (400 : Int) = Z at *; generalize (2 : ℝ) ^ (971 : Int) = Z' at *; linarith obtain ⟨fP, eP⟩ := rrm _ a fF ha hb have hQ := lt_of_le_of_lt' hc (lt_of_le_of_lt (abs_nonneg _) (eFb _ fP)) have hP := lt_of_lt_of_le (lt_of_le_of_lt (le_abs_self _) (eFb _ fP)) hc rw [vF, show (2 : ℝ) ^ (-53 : Int) = 1 / 9007199254740992 by norm_num] at eP rw [show (2 : ℝ) ^ (-20 : Int) = 1 / 1048576 by norm_num] generalize (2 : ℝ) ^ (((cE (9 * (n + 1)).toUInt64.toInt64.toFloat a).toNat : Int) + 56) = Q at * generalize rv ((9 * (n + 1)).toUInt64.toInt64.toFloat * a) = P at * generalize rv a = A at * generalize (2 : ℝ) ^ (-1075 : Int) = y at * generalize (2 : ℝ) ^ (-900 : Int) = ε at * have hen : (n : ℝ) * (y * 2) ≤ 1073741824 * y := by linarith generalize (n : ℝ) * (y * 2) = en at herr hen have hN : (0 : ℝ) ≤ 9 * (n + 1) := by positivity have hN4 := mul_le_mul_of_nonneg_right (by linarith : 9 * ((n : ℝ) + 1) ≤ 2 ^ 33) hy0.le generalize 9 * ((n : ℝ) + 1) = N at * obtain ⟨h1, -⟩ := abs_le.mp herr rcases le_or_gt 0 A with h0 | h0 ·rw [abs_of_nonneg (mul_nonneg hN h0)] at eP have := mul_le_mul_of_nonneg_left h1 (by linarith : 0 ≤ N * (1 - 1 / 9007199254740992)) nlinarith [(abs_le.mp eP).1] ·have := mul_le_mul_of_nonneg_left (by linarith : σ ≤ 2 * en) hN nlinarith theorem dwB (x : Word) (hx : expOf x ≠ 255) : |rv (dw x)| ≤ 2 ^ (277 : Int) := by rw [(dwV x hx).2, abs_mul, abs_pow, abs_two] have : (expOf x).toNat ≠ 255 := fun h => hx (UInt32.toNat_inj.mp (by simpa using h)) have := expL x calc _ ≤ (2 : ℝ) ^ 24 * 2 ^ 253 := mul_le_mul (by rw [← Int.cast_abs]; exact_mod_cast (sv_abs x).le) (pow_le_pow_right₀ (by norm_num) (by rw [idxE]; omega)) (by positivity) (by positivity) _ = 2 ^ (277 : Int) := by rw [← pow_add, ← zpow_natCast]; rfl theorem f0 : fv (0 : Float) ∧ rv (0 : Float) = 0 := by have e : (0 : Float).toModel.unpack = .zero .positive := rfl refine ⟨by rw [fvI, e]; rfl, by rw [rvU, e]; simp [Model.unpackedToReal, Model.unpackedToDyadic?]⟩ theorem ix3 (b s st τ r : Nat) (hs : s < 2 ^ 32) (hst : st < 2 ^ 32) (hτ : τ < 2 ^ 32) (hr : r < 2 ^ 32) (h : b + τ * s + r * st < 2 ^ 32) : (b.toUSize + τ.toUSize * s.toUSize + r.toUSize * st.toUSize).toNat = b + τ * s + r * st := by have := USize.le_size; have := USize.size_eq_two_pow have m : ∀ x y : Nat, x < 2 ^ 32 → y < 2 ^ 32 → x * y < 2 ^ 32 → (x.toUSize * y.toUSize).toNat = x * y := fun x y hx hy h => by rw [USize.toNat_mul, toUSize_toNat (by clear h hr hs hst hy hτ this;omega), toUSize_toNat (by clear h hr hs hst hx hτ this;omega), Nat.mod_eq_of_lt (by clear hr hs hst hx hy hτ;omega)] have m1 := m τ s hτ hs (by clear*-h;omega); have m2 := m r st hr hst (by clear*-h;omega) rw [uadd (by rw [uadd (by rw [toUSize_toNat (by clear hr hs hst hτ m m1 m2 this;omega), m1]; clear hr hs hst hτ m m1 m2 this;omega), toUSize_toNat (by clear hr hs hst hτ m m1 m2 this;omega), m1, m2]; clear hr hs hst hτ m m1 m2 this;omega), uadd (by rw [toUSize_toNat (by clear hr hs hst hτ m m1 m2 this;omega), m1]; clear hr hs hst hτ m m1 m2 this;omega), toUSize_toNat (by clear hr hs hst hτ m m1 m2 this;omega), m1, m2] theorem tmOne (b : Word) (IB : Nat) (hb : idxOf b ≤ IB) : |(Core.tm oneW b : ℝ)| ≤ 2 ^ (173 + IB) := by unfold Core.tm rw [show sv oneW = 2 ^ 23 by decide, show idxOf oneW = 126 by decide, Int.cast_mul, Int.cast_mul, abs_mul, abs_mul, Int.cast_pow, Int.cast_pow, Int.cast_ofNat, abs_pow, abs_pow, abs_two] have a1 : |(sv b : ℝ)| ≤ 2 ^ 24 := by rw [← Int.cast_abs]; exact_mod_cast (sv_abs _).le calc (2 : ℝ) ^ 23 * |(sv b : ℝ)| * 2 ^ (126 + idxOf b) ≤ 2 ^ 23 * 2 ^ 24 * 2 ^ (126 + IB) := by gcongr; norm_num _ = 2 ^ (173 + IB) := by rw [← pow_add, ← pow_add]; congr 1; omega theorem eF_le (b : UInt64) : (eF b).toNat ≤ 2047 := by unfold eF; simp only [UInt64.toNat_and, UInt64.reduceToNat]; exact Nat.and_le_right theorem cE_le (F a : Float) : (cE F a).toNat ≤ 969 := by unfold cE; dsimp only; split ·rename_i h; have := eF_le (F * a).toBits; have h' := UInt64.lt_iff_toNat_lt.mp h rw [UInt64.toNat_sub_of_le _ _ (UInt64.le_of_lt h)]; simp only [UInt64.reduceToNat] at h' ⊢; clear h';omega ·simp abbrev Iv (F : Nat → Word) (a : Array Word) (P : Nat → Prop) (A : Array Word) : Prop := A.size = a.size ∧ ∀ q, (A[q]? = a[q]? ∨ A[q]? = some (F q)) ∧ (P q → q < a.size → A[q]? = some (F q)) theorem lr8h_mono (F : Nat → Word) (u0 u2 : Array Word) (S U : Nat → Prop) (hU : ∀ q, U q → S q) (h : Iv F u0 S u2) : Iv F u0 U u2 := ⟨h.1, fun q => ⟨(h.2 q).1, fun hq' hq => (h.2 q).2 (hU q hq') hq⟩⟩ def emr (A : Array Word) (e : USize) (he : e ≤ A.usize) (i : USize) (m : UInt32) : UInt32 := if h : i < e then emr A e he (i + 1) (max m ((A.uget i (ulen (USize.lt_iff_toNat_lt.mpr (Nat.lt_of_lt_of_le (USize.lt_iff_toNat_lt.mp h) (USize.le_iff_toNat_le.mp he)))) >>> 23) &&& 255)) else m termination_by e.toNat - i.toNat decreasing_by have := USize.lt_iff_toNat_lt.mp h; rw [usucc h]; omega theorem emr_spec (A : Array Word) (e : USize) (he : e ≤ A.usize) : ∀ k (i : USize) (m : UInt32), e.toNat - i.toNat = k → m.toNat ≤ (emr A e he i m).toNat ∧ ∀ q, i.toNat ≤ q → q < e.toNat → (expOf A[q]!).toNat ≤ (emr A e he i m).toNat := by intro k; induction k with | zero => intro i m hk rw [emr, dif_neg fun h => by have := USize.lt_iff_toNat_lt.mp h; omega]; exact ⟨le_rfl, fun q h1 h2 => by omega⟩ | succ k ih => intro i m hk have h : i < e := USize.lt_iff_toNat_lt.mpr (by omega) have hi : i < A.usize := USize.lt_iff_toNat_lt.mpr (Nat.lt_of_lt_of_le (USize.lt_iff_toNat_lt.mp h) (USize.le_iff_toNat_le.mp he)) rw [emr, dif_pos h] obtain ⟨i1, i2⟩ := ih (i + 1) (max m ((A.uget i (ulen hi) >>> 23) &&& 255)) (by rw [usucc h]; omega) rw [UInt32.toNat_max] at i1 refine ⟨by clear hk i2 ih;omega, fun q h1' h2 => ?_⟩ by_cases hq : q = i.toNat ·subst hq; rw [← uget_eq A i (ulen hi)]; unfold expOf; clear*-h he hi i1;omega ·exact i2 q (by rw [usucc h]; clear*-h1' he hi hq;omega) h2 @[specialize] def ofA {α : Type} (f : Nat → α) (N : Nat) (a : Array α) : Array α := if a.size < N then ofA f N (a.push (f a.size)) else a termination_by N - a.size decreasing_by simp only [Array.size_push]; omega theorem ofA_eq {α : Type} (f : Nat → α) (N : Nat) : ofA f N (Array.emptyWithCapacity N) = Array.ofFn (n := N) fun q => f q.val := by suffices h : ∀ k (a : Array α), N - a.size = k → a.size ≤ N → (∀ i (h : i < a.size), a[i] = f i) → ofA f N a = Array.ofFn (n := N) fun q => f q.val from h _ _ rfl (by simp) (fun i h => by simp at h) intro k; induction k with | zero => intro a hk ha hf rw [ofA, if_neg (by omega)] exact Array.ext (by simp; omega) fun i h1 _ => by rw [hf i h1, Array.getElem_ofFn] | succ k ih => intro a hk ha hf rw [ofA, if_pos (by omega)] refine ih _ (by simp; omega) (by simp; omega) fun i h => ?_ rw [Array.getElem_push]; split ·exact hf i ‹_› ·grind theorem dN (n : Nat) (fa fb : Nat → Word) : ∀ c i, i + c = n → dallNZ (Array.ofFn (n := n + 1) fun t => if t.val < n then fb t.val else oneW) (Array.ofFn (n := n + 1) fun t => if t.val < n then fa t.val else 0x80000000) i (c + 1) = dallNZ (Array.ofFn (n := n) fun t => fa t.val) (Array.ofFn (n := n) fun t => fb t.val) i c := by intro c; induction c with | zero => intro i h; obtain rfl : i = n := by omega simp only [dallNZ, getElem!_ofFn (i + 1) (fun t => if t < i then fb t else oneW) i (by omega), getElem!_ofFn (i + 1) (fun t => if t < i then fa t else 0x80000000) i (by omega), lt_irrefl, if_false]; rfl | succ c ih => intro i h rw [dallNZ, ih (i + 1) (by omega), dallNZ, getElem!_ofFn (n + 1) (fun t => if t < n then fb t else oneW) i (by omega), getElem!_ofFn (n + 1) (fun t => if t < n then fa t else 0x80000000) i (by omega), getElem!_ofFn n fa i (by omega), getElem!_ofFn n fb i (by omega)] simp only [show i < n by omega, ↓reduceIte, Nat.mul_comm (mantOf (fb i)), Bool.xor_comm (signOf (fb i))] theorem dz (n : Nat) (fa fb : Nat → Word) (hn : 0 < n) (hf : Core.finAll n fa fb) : dotOf (n + 1) (fun t => if t < n then fb t else oneW) (fun t => if t < n then fa t else 0x80000000) = dotOf n fa fb := by rw [Core.dotOf_val _ _ _ fun t _ => by split; exacts [(hf t ‹_›).symm, by decide], Core.dotOf_val _ _ _ hf, Core.tsum_succ, dN n fa fb n 0 (by omega)] congr 1 ·simp only [lt_irrefl, if_false, show Core.tm oneW 0x80000000 = 0 by decide, add_zero] exact Finset.sum_congr rfl fun t ht => by simp only [if_pos (Finset.mem_range.mp ht)]; unfold Core.tm; rw [Nat.add_comm]; ring ·simp [hn.ne'] end F theorem lt32 {a : Nat} (h : a ≤ 4294967295) : a < 2 ^ 32 := by omega end Dense namespace Bn namespace NativeAdd theorem bridge (x : Float32) : Model.ofFloat32Model x.toModel = ofW x.toBits := congrArg Model.mk (ofUInt32_bits x.toBits).symm theorem nbits (x : Float32) : toWord (Model.ofFloat32Model x.toModel) = x.toBits := UInt32.ofNat_toNat theorem native_input (a : Word) (h : expOf a ≠ 255) : (Float32.ofBits a).toBits = a ∧ (Float32.ofBits a).isFinite = true := by have he : Float.Model.UnpackedFloat.unpackExponent (spec := Float.Model.Format.binary32) a.toBitVec ≠ -1#8 := fun bad => h (UInt32.toNat_inj.mp ((show (expOf a).toNat = (a.toBitVec.extractLsb' 23 8).toNat by simp only [expOf, UInt32.toNat_and, UInt32.toNat_shiftRight, BitVec.extractLsb'_toNat] exact Nat.and_two_pow_sub_one_eq_mod _ 8).trans (congrArg BitVec.toNat bad :))) have hb : (Float32.ofBits a).toBits = a := by change UInt32.ofBitVec (Float.Model.UnpackedFloat.pack Float.Model.Format.binary32 (Float.Model.UnpackedFloat.unpack Float.Model.Format.binary32 a.toBitVec)) = a rw [Model.pack_unpack_eq, if_neg (he ·.1)] refine ⟨hb, ?_⟩ change (Float.Model.UnpackedFloat.unpack Float.Model.Format.binary32 (Float32.ofBits a).toBits.toBitVec).isFinite = true simp only [hb, Float.Model.UnpackedFloat.unpack, he, ite_false] split_ifs <;> rfl @[noinline] def fallback (relu : Bool) (a b : Word) : Word := act relu (toWord (Model.add (ofW a) (ofW b))) @[inline] def actB (relu : Bool) (w : Word) : Word := w &&& ~~~((0 : Word) - ((if relu then w >>> 31 else 0) &&& (if w &&& 0x7FFFFFFF ≤ 0x7F800000 then 1 else 0))) theorem sgnW (w : Word) : (w &&& 0x80000000 != 0) = decide (2 ^ 31 ≤ w.toNat) := by have hw := w.toNat_lt rw [Bool.eq_iff_iff, bne_iff_ne, ne_eq, ← UInt32.toNat_inj, UInt32.toNat_and, decide_eq_true_iff, show (0x80000000 : UInt32).toNat = 2 ^ 31 from rfl, Nat.and_two_pow] simp only [UInt32.toNat_zero, Nat.testBit, Nat.shiftRight_eq_div_pow, Nat.one_and_eq_mod_two] constructor ·intro h; by_contra h'; apply h; rw [Nat.div_eq_of_lt (by clear hw;omega)]; simp ·intro h; rw [show w.toNat / 2 ^ 31 = 1 by omega]; simp theorem actB_eq (relu : Bool) (w : Word) : actB relu w = act relu w := by have hw := w.toNat_lt have hs : (w >>> 31).toNat = w.toNat / 2 ^ 31 := by rw [UInt32.toNat_shiftRight]; simp [Nat.shiftRight_eq_div_pow] have ha := Dense.absA w have he := Dense.expA w have hf : (fracOf w).toNat = w.toNat % 2 ^ 23 := by unfold fracOf; rw [UInt32.toNat_and]; exact Nat.and_two_pow_sub_one_eq_mod _ 23 unfold Dense.absW at ha he have k1 : ∀ x : Word, x &&& ~~~((0 : Word) - 0) = x := fun x => by apply UInt32.toNat_inj.mp; rw [UInt32.toNat_and] rw [show (~~~((0 : Word) - 0)).toNat = 2 ^ 32 - 1 from rfl, Nat.and_two_pow_sub_one_eq_mod, Nat.mod_eq_of_lt x.toNat_lt] have k0 : ∀ x : Word, x &&& ~~~((0 : Word) - 1) = 0 := fun x => by apply UInt32.toNat_inj.mp; rw [UInt32.toNat_and]; simp have e31 : w >>> 31 = if 2 ^ 31 ≤ w.toNat then 1 else 0 := by apply UInt32.toNat_inj.mp; rw [hs]; split <;> simp <;> (clear ha he hf hs k0 k1;omega) have eA : (w &&& 0x7FFFFFFF ≤ 0x7F800000) ↔ w.toNat % 2 ^ 31 ≤ 0x7F800000 := by rw [UInt32.le_iff_toNat_le, ha]; rfl have hR : (w &&& 0x80000000 != 0 && !(expOf w = 255 && fracOf w != 0)) = true ↔ (2 ^ 31 ≤ w.toNat ∧ w.toNat % 2 ^ 31 ≤ 0x7F800000) := by rw [sgnW] simp only [Bool.and_eq_true, decide_eq_true_eq, Bool.not_eq_true', Bool.and_eq_false_iff, decide_eq_false_iff_not, bne_eq_false_iff_eq, ← UInt32.toNat_inj, he, hf, ha, UInt32.reduceToNat, UInt32.toNat_zero] clear*-;omega unfold actB act cases relu ·simp only [Bool.false_eq_true, ite_false, UInt32.zero_and, k1] simp only [ite_true] unfold reluW rw [e31] by_cases c1 : 2 ^ 31 ≤ w.toNat ·rw [if_pos c1] by_cases c2 : w.toNat % 2 ^ 31 ≤ 0x7F800000 ·rw [if_pos (eA.mpr c2), show (1 : Word) &&& 1 = 1 from rfl, k0, if_pos (hR.mpr ⟨c1, c2⟩)] ·rw [if_neg (mt eA.mp c2), show (1 : Word) &&& 0 = 0 from rfl, k1, if_neg (fun h => c2 (hR.mp h).2)] ·rw [if_neg c1, UInt32.zero_and, k1, if_neg (fun h => c1 (hR.mp h).1)] @[inline] def add (relu : Bool) (a b : Word) : Word := if expOf a != 255 && expOf b != 255 then actB relu (Float32.ofBits a + Float32.ofBits b).toBits else fallback relu a b theorem add_eq (relu : Bool) (a b : Word) : add relu a b = act relu (toWord (Model.add (ofW a) (ofW b))) := by unfold add split ·rename_i h rw [actB_eq] simp only [Bool.and_eq_true, bne_iff_ne] at h have ha := native_input a h.1 have hb := native_input b h.2 have hn := ExecFloat.Binary.toModel_ofFloat32_add_of_isFinite _ _ ha.2 hb.2 simp only [ExecFloat.Binary.toModel_ofFloat32, bridge, ha.1, hb.1] at hn erw [← hn, ← bridge, nbits] ·rfl end NativeAdd @[noinline] def gen (relu : Bool) (w s t : Word) : Word := act relu (toWord (Model.fma (ofW w) (ofW s) (ofW t))) @[inline] def zsl (relu : Bool) (zp : Thunk Word) (w sc tc : Word) : Word := if w = 0 then zp.get else gen relu w sc tc theorem zsl_eq (relu : Bool) (w sc tc : Word) : zsl relu (Thunk.mk fun _ => gen relu 0 sc tc) w sc tc = gen relu w sc tc := by unfold zsl; split ·rename_i h; subst h; rfl ·rfl @[inline] def ad (rb : UInt32) (a b : Word) (_slow : Unit → Word) : Word := NativeAdd.add (rb != 0) a b @[specialize] def umap (stop : USize) (f : (i : USize) → i.toNat < stop.toNat → Word → Word) (i : USize) (x : Array Word) (h : stop.toNat ≤ x.size) : Array Word := if hi : i < stop then have hs := USize.lt_iff_toNat_lt.mp hi umap stop f (i + 1) (x.uset i (f i hs (x.uget i (by omega))) (by omega)) (by rw [Array.size_uset]; exact h) else x termination_by stop.toNat - i.toNat decreasing_by rw [Dense.usucc hi]; omega theorem umap_spec (stop : USize) (f : (i : USize) → i.toNat < stop.toNat → Word → Word) (F : Nat → Word → Word) (hF : ∀ i hi w, f i hi w = F i.toNat w) (i : USize) (x : Array Word) (h : stop.toNat ≤ x.size) : (umap stop f i x h).size = x.size ∧ ∀ j, (umap stop f i x h)[j]? = if i.toNat ≤ j ∧ j < stop.toNat then x[j]?.map (F j) else x[j]? := by fun_induction umap ·next i x h hi hs ih => refine ⟨by rw [ih.1, Array.size_uset], fun j => ?_⟩ rw [ih.2, Dense.usucc hi, Array.uset_eq_set, Array.getElem?_set (by clear*-h hs;omega)] split_ifs <;> first | rfl | omega | (subst_vars; rw [Array.getElem?_eq_getElem (by clear*-h hs;omega), Option.map_some, hF]; rfl) ·next i x h hi => exact ⟨rfl, fun j => by rw [if_neg (by rw [USize.lt_iff_toNat_lt] at hi; clear*-hi;omega)]⟩ @[inline] def wX (x : UInt64) : UInt64 := ((x >>> 34) <<< 31) + ((x &&& 0x3FFFFFFFF) - 0x255000000) theorem cX (S : Float) (h : ((S.toBits + 0x10000001) >>> 29 == (S.toBits + 0x0FFFFFFD) >>> 29 && (((S.toBits + 0x10000001) >>> 29 >>> 23) &&& 0x7FF) - 1195 < 253 && (S.toBits + 0x10000001) >>> 29 &&& 0x7FFFFF != 0) = true) : Dense.F.cert2 S (Dense.F.eF S.toBits - 1075) = wX ((S.toBits + 0x10000001) >>> 29) ∧ 1195 ≤ (Dense.F.eF S.toBits).toNat ∧ (Dense.F.eF S.toBits).toNat ≤ 1447 ∧ (Dense.F.cert2 S (Dense.F.eF S.toBits - 1075)).toUInt32.toNat % 2 ^ 31 < 255 * 2 ^ 23 ∧ Dense.F.cert2 S (Dense.F.eF S.toBits - 1075) < 0x100000000 := by unfold Dense.F.cert2 simp only [UInt64.sub_add_cancel, UInt64.sub_self, UInt64.shiftLeft_zero, UInt64.reduceLE, decide_true, Bool.true_and] generalize S.toBits = a at h ⊢ generalize hx : (a + 0x10000001) >>> 29 = x at h ⊢ have m11 : ∀ x, x &&& 2047 = x % 2 ^ 11 := (Nat.and_two_pow_sub_one_eq_mod · 11) have m23 : ∀ x, x &&& 8388607 = x % 2 ^ 23 := (Nat.and_two_pow_sub_one_eq_mod · 23) have m29 : ∀ x, x &&& 536870911 = x % 2 ^ 29 := (Nat.and_two_pow_sub_one_eq_mod · 29) have m34 : ∀ x, x &&& 17179869183 = x % 2 ^ 34 := (Nat.and_two_pow_sub_one_eq_mod · 34) simp only [Bool.and_eq_true, beq_iff_eq, decide_eq_true_eq, bne_iff_ne, ne_eq, ← UInt64.toNat_inj, UInt64.lt_iff_toNat_lt, UInt64.toNat_sub, UInt64.toNat_and, UInt64.toNat_add, UInt64.toNat_shiftRight, UInt64.reduceToNat, Nat.reduceMod, Nat.shiftRight_eq_div_pow, m11, m23] at h hx obtain ⟨⟨h1, h2⟩, h3⟩ := h have:=a.toNat_lt;have c:a.toNat+268435457<2^64:=by clear * - this hx h2;omega rw[Nat.mod_eq_of_lt c] at hx;rw[Nat.mod_eq_of_lt (by clear*-c;omega)] at h1 have hE : (Dense.F.eF a).toNat = a.toNat / 2 ^ 52 % 2 ^ 11 := by simp only [Dense.F.eF, UInt64.toNat_and, UInt64.toNat_shiftRight, UInt64.reduceToNat, Nat.reduceMod, Nat.shiftRight_eq_div_pow, m11] have hf : (a &&& 0xfffffffffffff).toNat = a.toNat % 2 ^ 52 := by rw [UInt64.toNat_and]; exact Nat.and_two_pow_sub_one_eq_mod _ 52 rw [if_pos (by simp only [Bool.and_eq_true, decide_eq_true_eq, UInt64.reduceAdd, UInt64.reduceSub, bne_iff_ne, ne_eq, ← UInt64.toNat_inj, UInt64.lt_iff_toNat_lt, UInt64.toNat_sub, UInt64.toNat_and, UInt64.toNat_add, UInt64.toNat_shiftRight, hE, hf, UInt64.reduceToNat, Nat.reduceMod, Nat.shiftRight_eq_div_pow, m23, m29] rw [Nat.and_two_pow_sub_one_eq_mod _ 63] clear * - this hx h1 h2 h3 c; omega)] obtain ⟨k1, k2, k7, k8⟩ : 1195 ≤ a.toNat / 2 ^ 52 % 2 ^ 11 ∧ a.toNat / 2 ^ 52 % 2 ^ 11 ≤ 1447 ∧ x.toNat / 2 ^ 34 = a.toNat / 2 ^ 63 ∧ x.toNat % 2 ^ 34 = a.toNat / 2 ^ 52 % 2 ^ 11 * 2 ^ 23 + (a.toNat % 2 ^ 52 + 2 ^ 28) / 2 ^ 29 := by clear * - this hx h1 h2 h3 c; omega have hw := Dense.F.c3w a (by rw [hE]; omega) rw [hE, hf] at hw have hs : a.toNat / 2 ^ 63 < 2 := by clear*-c this;omega have hq : (a.toNat % 2 ^ 52 + 2 ^ 28) / 2 ^ 29 ≤ 2 ^ 23 := by clear*-;omega generalize a.toNat/2^63=s,a.toNat/2^52%2^11=E,(a.toNat%2^52+2^28)/2^29=U at * simp only [UInt64.toNat_toUInt32, UInt64.lt_iff_toNat_lt, hw, UInt64.reduceToNat, hE] refine ⟨?_, by clear * - hs hq k1 k2; omega⟩ rw [← UInt64.toNat_inj, hw, wX] simp only [UInt64.toNat_add, UInt64.toNat_shiftLeft, UInt64.toNat_shiftRight, UInt64.toNat_sub, UInt64.toNat_and, UInt64.reduceToNat, Nat.reduceMod, Nat.shiftRight_eq_div_pow, Nat.shiftLeft_eq, m34, k7, k8] clear * - hs hq k1 k2; omega @[inline] def eB (g : Bool) (m : UInt32) (Y Z : Float) (w : Word) (slow : Unit → Word) : Word := if g && ((w >>> 23) &&& 0xFF) - 1 < 254 then let a := (Dense.F.dw w * Y + Z).toBits let x := (a + 0x10000001) >>> 29 if x == (a + 0x0FFFFFFD) >>> 29 && ((x >>> 23) &&& 0x7FF) - 1195 < 253 && x &&& 0x7FFFFF != 0 then let o := (wX x).toUInt32 if o &&& m != 0 then 0 else o else slow () else slow () def chLoop (relu : Bool) (hw c : Nat) (s t : Array Word) (ch : Nat) (x : Array Word) : Array Word := if ch < c then let sc := s[ch]! let tc := t[ch]! let stop := (ch * hw + hw).toUSize let m : UInt32 := if relu then 0x80000000 else 0 let g := (sc >>> 23) &&& 0xFF != 0xFF && (tc >>> 23) &&& 0xFF != 0xFF let Y := Dense.F.dw sc let Z := Dense.F.dw tc * Dense.F.pw 149 let zp : Thunk Word := Thunk.mk fun _ => gen relu 0 sc tc chLoop relu hw c s t (ch + 1) (if h : stop.toNat ≤ x.size then umap stop (fun _ _ w => eB g m Y Z w fun _ => zsl relu zp w sc tc) (ch * hw).toUSize x h else x) else x termination_by c - ch def scaleShift (relu : Bool) (c hw : Nat) (x s t : Array Word) : Array Word := if x.size = c * hw ∧ c * hw < USize.size then chLoop relu hw c s t 0 x else scaleShiftSpec relu c hw x s t theorem scaleShift_eq : scaleShift = scaleShiftSpec := by funext relu c hw x s t unfold scaleShift split; swap; rfl rename_i h refine Array.ext_getElem? fun j => ?_ have h32 := h.2 suffices C : ∀ ch x, x.size = c * hw → (chLoop relu hw c s t ch x)[j]? = if ch * hw ≤ j then x[j]?.map (fun w => act relu (toWord (Model.fma (ofW w) (ofW s[j / hw]!) (ofW t[j / hw]!)))) else x[j]? by rw [C 0 x h.1, if_pos (by simp), scaleShiftSpec, Array.getElem?_ofFn] split ·rw [Array.getElem?_eq_getElem (by omega), getElem!_pos x j (by omega)]; rfl ·rw [Array.getElem?_eq_none (by omega)]; rfl intro ch x hsz induction hk : c - ch generalizing ch x with | zero => rw [chLoop, if_neg (by clear*-hk;omega)] split; swap; rfl rw [Array.getElem?_eq_none (by have := Nat.mul_le_mul_right hw (by clear*-hk;omega : c ≤ ch); clear h h32 hk;omega)]; rfl | succ k ih => have hle : ch * hw + hw ≤ c * hw := by rw [← Nat.succ_mul]; exact Nat.mul_le_mul_right _ (by clear*-hk;omega) have hstop := Dense.toUSize_toNat (n := ch * hw + hw) (by clear*-h hle;omega) rw [chLoop, if_pos (by clear*-hk;omega)]; dsimp only; rw [dif_pos (by rw [hstop]; clear*-hle hsz;omega)] generalize hf : (fun _ _ w => eB _ _ _ _ w _) = f have ⟨hs1, hs2⟩ := umap_spec _ f (fun _ w => gen relu w s[ch]! t[ch]!) (fun _ _ w => ?_) (ch * hw).toUSize x (by rw [hstop]; clear*-hle hsz;omega) rw [ih (ch + 1) _ (by rw [hs1, hsz]) (by clear*-hk;omega), hs2, Dense.toUSize_toNat (by clear*-h hle;omega), hstop, Nat.succ_mul] split_ifs <;> first | omega | rw [Nat.div_eq_of_lt_le (k := ch) (by omega) (by rw [Nat.succ_mul]; omega)]; rfl | rfl subst hf; generalize s[ch]! = s, t[ch]! = t simp only [zsl_eq] dsimp only [eB, gen] split; swap; rfl rename_i hg simp only [Bool.and_eq_true, bne_iff_ne, ne_eq, decide_eq_true_eq] at hg obtain ⟨⟨hs, ht⟩, hw⟩ := hg replace hw : ¬expOf w = 255 := fun h => by simp [expOf] at h; simp [h] at hw split; swap; rfl obtain ⟨hcq, hE1, hE2, hX, hc⟩ := cX _ ‹_› open Dense.F in ·rw [← hcq] have it := Dense.idxE t; have et := Dense.expL t obtain ⟨f1, v1⟩ := pvV w s hw hs obtain ⟨f2, v2⟩ := dwV t ht obtain ⟨f3, v3⟩ := pwV 149 (by clear*-;omega) obtain ⟨f4, v4⟩ := nmulZ _ _ f2 f3 (sv t) ((idxOf t + 149 : Nat) : Int) (by rw [v2, v3, zpow_natCast, pow_add]; ring) ((svB t).trans (by norm_num)) (by clear*-;omega) (pwB 24 _ 971 (by clear*-et it;omega) le_rfl _ (svB t)) have fS := fvE (dw w * dw s + dw t * pw 149) (by clear*-hE2;omega) have hl := rlt _ _ f1 f4 fS _ (by clear*-hE1;omega) (by clear*-hE1 hE2;omega) (bitsB _ fS) obtain ⟨-, e⟩ := fadd _ _ f1 f4 _ (by clear*-hE1;omega) (by clear*-hE1 hE2;omega) hl have hV : rv (dw w * dw s) + rv (dw t * pw 149) = ((sv w * sv s * 2 ^ (idxOf w + idxOf s) + sv t * 2 ^ (idxOf t + 149) : Int) : ℝ) := by rw [v1, v4, Core.tm, zpow_natCast]; push_cast; ring rw [hV] at hl e generalize dw w * dw s + dw t * pw 149 = S at hc hE1 hE2 hX fS hl e ⊢ have hh : ((eF S.toBits - 1075).toNat : Int) = ((eF S.toBits).toNat : Int) - 1075 := by simp only [UInt64.toNat_sub, UInt64.reduceToNat]; clear*-hE1 hE2;omega obtain ⟨hV0, hwd⟩ := cert2_spec S fS (eF S.toBits - 1075) (by clear*-hE1 hE2 hh;omega) _ (e.trans (by rw [hh, sub_sub]; exact half_le_self (by positivity))) (hl.le.trans (zpow_le_zpow_right₀ (by norm_num) (by clear*-hE1 hE2;omega))) hc rw [show toWord (Model.fma (ofW w) (ofW s) (ofW t)) = (cert2 S (eF S.toBits - 1075)).toUInt32 from ?_] ·generalize UInt64.toUInt32 _ = o at hX ⊢ have he : expOf o ≠ 255 := fun h => by have := Dense.wdiv o; simp [h] at this; clear*-hX this;omega cases relu <;> simp [act, reluW, he] rw [hwd] have dx := toDyadic_ofUInt32 w hw have ds := toDyadic_ofUInt32 s hs have dt := toDyadic_ofUInt32 t ht open Model in ·rw [Proof.fma_eq_spec] simp (disch := assumption) only [Spec.fma, ofW, (chooseNaN3_eq_none_iff _ _ _).2 ⟨isNaN_eq_false_of_toDyadic?_some dx, isNaN_eq_false_of_toDyadic?_some ds, isNaN_eq_false_of_toDyadic?_some dt⟩, isInf_eq_false_of_toDyadic?_some, Bool.or_false, Bool.false_eq_true, ite_false, dx, ds, dt] refine (finishWord_of_ne _ _ _ _ hV0 ?_).symm rw [addDyadic, FloatLib.Numerics.Dyadic.add_toRat] erw [FloatLib.Numerics.Dyadic.mul_toRat (decodeD w) (decodeD s)] simp [decodeD_toRat, zpow_sub₀]; field_simp; ring theorem ad_eq (relu : Bool) (a b : Word) (slow : Unit → Word) (_hsl : slow () = act relu (toWord (Model.add (ofW a) (ofW b)))) : ad (if relu then 1 else 0) a b slow = act relu (toWord (Model.add (ofW a) (ofW b))) := by cases relu <;> simp [ad, NativeAdd.add_eq] @[noinline] def gena (relu : Bool) (x y : Word) : Word := act relu (toWord (Model.add (ofW x) (ofW y))) def addRelu (relu : Bool) (a b : Array Word) : Array Word := if h : a.size ≤ b.size ∧ a.size < USize.size then let rb : UInt32 := if relu then 1 else 0 umap a.size.toUSize (fun i hi x => let y := b.uget i (by rw [Dense.toUSize_toNat h.2] at hi; omega) ad rb x y fun _ => gena relu x y) 0 a (by rw [Dense.toUSize_toNat h.2]) else addReluSpec relu a b theorem addRelu_eq : addRelu = addReluSpec := by funext relu a b unfold addRelu; dsimp only split; swap; · rfl rename_i h have hs := Dense.toUSize_toNat h.2 refine Array.ext_getElem? fun j => ?_ rw [(umap_spec _ _ (fun j x => act relu (toWord (Model.add (ofW x) (ofW b[j]!)))) (fun i hi x => ?_) 0 a _).2 j, addReluSpec, Array.getElem?_ofFn] ·by_cases hj : j < a.size ·rw [if_pos ⟨by simp, by rwa [hs]⟩, dif_pos hj, Array.getElem?_eq_getElem hj]; rfl ·rw [if_neg (by rw [hs]; clear*-hj;omega), dif_neg hj, Array.getElem?_eq_none (by clear*-hj;omega)] ·rw [ad_eq relu _ _ _ rfl, getElem!_pos b i.toNat (by omega)]; rfl end Bn namespace Dense namespace F @[inline] def aF (relu : Bool) (w : Word) : Word := if relu then w &&& ((w >>> 31) - 1) else w theorem aF_eq (relu : Bool) (w : Word) (hw : expOf w ≠ 255) : aF relu w = act relu w := by unfold aF act reluW cases relu ·simp have hs := Core.signOf_iff w have h3 : (w >>> 31).toNat = w.toNat / 2 ^ 31 := by rw [UInt32.toNat_shiftRight]; simp [Nat.shiftRight_eq_div_pow] have hl := w.toNat_lt by_cases h : 2 ^ 31 ≤ w.toNat ·have e1 : w >>> 31 = 1 := UInt32.toNat_inj.mp (by rw [h3]; simp only [UInt32.toNat_one]; clear h3;omega) have e2 : signOf w = true := hs.mpr h unfold signOf at e2 simp [e1, e2, hw] ·have e1 : w >>> 31 = 0 := UInt32.toNat_inj.mp (by rw [h3]; simp only [UInt32.toNat_zero]; omega) have e2 : signOf w ≠ true := fun q => h (hs.mp q) unfold signOf at e2 simp only [Bool.not_eq_true] at e2 simp [e1, e2] theorem certF (S : Float) (h : UInt64) (hc : cert2 S h < 0x100000000) : expOf (cert2 S h).toUInt32 ≠ 255 := by unfold cert2 at hc ⊢ dsimp only at hc ⊢ split at hc swap; · exact absurd hc (by decide) rename_i hcond rw [if_pos hcond] simp only [Bool.and_eq_true, decide_eq_true_eq] at hcond obtain ⟨⟨⟨-, c2⟩, -⟩, -⟩ := hcond have hE11 : (eF S.toBits).toNat < 2048 := by unfold eF; rw [UInt64.toNat_and]; exact lt_of_le_of_lt Nat.and_le_right (by decide) have hf52 : (S.toBits &&& 0xfffffffffffff).toNat < 2 ^ 52 := by rw [UInt64.toNat_and]; exact lt_of_le_of_lt Nat.and_le_right (by decide) rw [UInt64.lt_iff_toNat_lt, UInt64.toNat_sub] at c2 simp only [UInt64.reduceToNat] at c2 have e1 : 1195 ≤ (eF S.toBits).toNat := by omega have hw := c3w S.toBits e1 have hs2 : S.toBits.toNat / 2 ^ 63 < 2 := by have := S.toBits.toNat_lt; clear*-this;omega rw [UInt64.lt_iff_toNat_lt] at hc simp only [UInt64.reduceToNat] at hc intro h255 have h2 := congrArg UInt32.toNat h255 rw [expOf, UInt32.toNat_and, UInt32.toNat_shiftRight, UInt64.toNat_toUInt32] at h2 simp only [UInt32.reduceToNat, Nat.reduceMod, Nat.shiftRight_eq_div_pow] at h2 rw [Nat.and_two_pow_sub_one_eq_mod _ 8, Nat.mod_eq_of_lt hc, hw] at h2 clear h255 hc hs2 hw;omega @[inline] def tfB (relu : Bool) (S : Float) (hh : UInt64) (sl : Unit → Word) : Word := let c := cert2 S hh if c < 0x100000000 then aF relu c.toUInt32 else sl () theorem tfB_eq (relu : Bool) (S : Float) (hh : UInt64) (sl : Unit → Word) : tfB relu S hh sl = tf relu S hh sl := by unfold tfB tf; dsimp only; split ·rename_i hc; rw [aF_eq _ _ (certF _ _ hc)] ·rfl theorem tmB3 (x w : Word) (e : Nat) (he : (expOf w).toNat ≤ e) : |(Core.tm x w : ℝ)| ≤ |(sv x : ℝ) * 2 ^ idxOf x| * 2 ^ (max e 56 + 23) := by unfold Core.tm push_cast rw [show (sv x : ℝ) * sv w * 2 ^ (idxOf x + idxOf w) = (sv x * 2 ^ idxOf x) * (sv w * 2 ^ idxOf w) by rw [pow_add]; ring, abs_mul] gcongr rw [abs_mul, abs_pow, abs_two] refine (mul_le_mul (b := 2 ^ 24) (by rw [← Int.cast_abs]; exact_mod_cast (sv_abs _).le) (pow_le_pow_right₀ (by norm_num) (by rw [idxE]; omega : _ ≤ max e 56 - 1)) (by positivity) (by positivity)).trans_eq ?_ rw [← pow_add]; congr 1; clear*-;omega theorem pw3 (relu : Bool) (n : Nat) (fa fb : Nat → Word) (ba : Word) (p : Nat → Float) (ib IB L : Nat) (e : Word) (c hb : UInt64) (S : Float) (fbk0 fbk : Unit → Word) (hx : ∀ s < n, expOf (fa s) ≠ 255) (hba : expOf ba ≠ 255 ∧ idxOf ba ≤ IB) (hib : 174 + IB ≤ ib) (hL : n + 2 ≤ 2 ^ L) (hL27 : L ≤ 27) (hibL : ib + L ≤ 425) (hn : 8 * n < 2 ^ 32) (hp : ∀ s < n, expOf (fb s) ≠ 255 → fv (p s) ∧ rv (p s) = Core.tm (fa s) (fb s)) (hS : S = sfold p n 0 (dw oneW * dw ba)) (he : ∀ s < n, (expOf (fb s)).toNat ≤ e.toNat) (hc : 9 * ((n : ℝ) + 1) * (∑ s ∈ Finset.range n, |rv (dw (fa s))|) * (1 - 2 ^ (-20 : Int)) ≤ 2 ^ ((c.toNat : Int) + 56) + 2 ^ (-900 : Int)) (hcB : c.toNat ≤ 1000) (hhb : hb.toNat = ib + L - 50) (hk0 : fbk0 () = act relu (dotOf (n + 1) (fun s => if s < n then fa s else oneW) (fun s => if s < n then fb s else ba))) (hk : (∀ s < n, expOf (fb s) ≠ 255) → fbk () = act relu (dotOf (n + 1) (fun s => if s < n then fa s else oneW) (fun s => if s < n then fb s else ba))) : (if e < 255 && (if e.toUInt64 < 56 then 56 else e.toUInt64) + 23 + c ≤ 400 then tfB relu S (if (if e.toUInt64 < 56 then 56 else e.toUInt64) + 23 + c < hb then hb else (if e.toUInt64 < 56 then 56 else e.toUInt64) + 23 + c) fbk else fbk0 ()) = act relu (dotOf (n + 1) (fun s => if s < n then fa s else oneW) (fun s => if s < n then fb s else ba)) := by have P : ∀ {a b : ℕ}, a ≤ b → (2 : ℝ) ^ a ≤ 2 ^ b := pow_le_pow_right₀ (by norm_num) generalize hP : (if e.toUInt64 < 56 then 56 else e.toUInt64) + 23 + c = q have hq : q.toNat = max e.toNat 56 + 23 + c.toNat := by have := UInt32.toNat_lt e rw [← hP]; split <;> rename_i h <;> simp only [UInt64.lt_iff_toNat_lt, UInt32.toNat_toUInt64, UInt64.toNat_add, UInt64.reduceToNat] at h ⊢ <;> (clear*-h hcB this;omega) split; swap; · exact hk0 rename_i hg; simp only [Bool.and_eq_true, decide_eq_true_eq, UInt32.lt_iff_toNat_lt, UInt64.le_iff_toNat_le, UInt32.reduceToNat, UInt64.reduceToNat] at hg generalize hH : (if q < hb then hb else q) = hh have hhv : hh.toNat = max q.toNat hb.toNat := by rw [← hH]; split <;> rename_i h <;> simp only [UInt64.lt_iff_toNat_lt] at h <;> (clear*-h;omega) have hw : ∀ s < n, expOf (fb s) ≠ 255 := fun s hs h => by have := he s hs; simp [h] at this; clear*-hg this;omega have hB := pvV oneW ba (by decide) hba.1 generalize hd : (∑ s ∈ Finset.range n, |rv (dw (fa s))|) = z at hc have h0 : 0 ≤ z := hd ▸ Finset.sum_nonneg fun _ _ => abs_nonneg _ rw [zpow_add₀ two_ne_zero, zpow_natCast] at hc have hz := tmOne ba IB hba.2 have h3 : (n : ℝ) ≤ 2 ^ 32 := by exact_mod_cast (show n ≤ 2 ^ 32 by clear*-hn;omega) have hN : z ≤ n * 2 ^ 277 := hd ▸ (Finset.sum_le_sum fun s (hs : s ∈ Finset.range n) => dwB _ (hx s (Finset.mem_range.1 hs))).trans_eq (by simp) have hZ : ∑ s ∈ Finset.range n, |(Core.tm (fa s) (fb s) : ℝ)| ≤ 2 ^ (max e.toNat 56 + 23) * z := by rw [← hd, Finset.mul_sum] exact Finset.sum_le_sum fun s hs => by rw [(dwV _ (hx s (Finset.mem_range.1 hs))).2] exact (tmB3 _ _ _ (he s (Finset.mem_range.1 hs))).trans_eq (mul_comm _ _) have hA : |(Core.tm oneW ba : ℝ)| + ∑ s ∈ Finset.range n, |(Core.tm (fa s) (fb s) : ℝ)| ≤ 2 ^ (968 : Int) := by rw [show (2 : ℝ) ^ (968 : Int) = 2 ^ 967 + 2 ^ 967 by rw [← two_mul, ← pow_succ']; norm_num] refine add_le_add (hz.trans (P (by clear*-hL27 hib hibL;omega))) (hZ.trans ((mul_le_mul (P (by clear*-hcB hg hq;omega : _ ≤ 400)) (hN.trans (mul_le_mul_of_nonneg_right h3 (by positivity))) h0 (by positivity)).trans ?_)) rw [← pow_add, ← pow_add]; exact P (by norm_num) obtain ⟨fS, eS⟩ := sfR p (fun s => (Core.tm (fa s) (fb s) : ℝ)) (Core.tm oneW ba : ℝ) n (fun s hs => hp s hs (hw s hs)) (by clear*-hn;omega) hA n 0 _ (by clear*-;omega) (Nat.zero_le _) hB.1 (by rw [hB.2]; simp) rw [← hS] at fS eS have hT : (Core.tsum (n + 1) (fun s => if s < n then fa s else oneW) (fun s => if s < n then fb s else ba) : ℝ) = Core.tm oneW ba + ∑ s ∈ Finset.range n, (Core.tm (fa s) (fb s) : ℝ) := by rw [Core.tsum_succ, Core.tsum]; push_cast; simp only [lt_irrefl, ite_false]; rw [add_comm]; congr 1 exact Finset.sum_congr rfl fun s hs => by simp [Finset.mem_range.1 hs] have hE : |rv S - (Core.tsum (n + 1) (fun s => if s < n then fa s else oneW) (fun s => if s < n then fb s else ba) : ℝ)| ≤ (2 : ℝ) ^ (hh.toNat : Int) := by rw [hT] refine bnd n z (Core.tm oneW ba : ℝ) _ (2 ^ (max e.toNat 56 + 23)) _ (2 ^ hb.toNat) _ h0 (by positivity) (one_le_pow₀ (by norm_num)) (by simpa using h3) ?_ ?_ hc ?_ ?_ ?_ ?_ ·exact (eS.trans (by gcongr)).trans (le_add_of_nonneg_right (by positivity)) ·rw [← zpow_natCast, ← zpow_add₀ two_ne_zero]; exact zpow_le_zpow_right₀ (by norm_num) (by clear*-;omega) ·rw [show (2 : ℝ) ^ (49 : Int) = 2 ^ 49 by norm_num, ← pow_add] refine (mul_le_mul (by exact_mod_cast (show n ≤ 2 ^ L by clear*-hL;omega) : (n : ℝ) ≤ 2 ^ L) hz (abs_nonneg _) (by positivity)).trans ?_ rw [← pow_add]; exact P (by clear*-hL27 hhb hib;omega) ·rw [← pow_add, zpow_natCast]; exact P (by clear*-hhv hq;omega) ·rw [zpow_natCast]; exact P (by clear*-hhv;omega) ·exact zpow_le_zpow_right₀ (by norm_num) (by clear*-hcB hhv hq;omega) rw [tfB_eq]; unfold tf; dsimp only; split ·rename_i hc' have hf : Core.finAll (n + 1) (fun s => if s < n then fa s else oneW) (fun s => if s < n then fb s else ba) := fun k _ => by by_cases h : k < n <;> simp only [h, ↓reduceIte] exacts [⟨hx k h, hw k h⟩, ⟨by decide, hba.1⟩] rw [cw2 _ _ _ hf S fS hh (by clear*-hg hhb hhv hibL;omega) hE hc'] ·exact hk hw theorem tS_eq (relu : Bool) (n : Nat) (fa fb : Nat → Word) (p : Nat → Float) (bpf : Unit → Float) (L : Nat) (fbk : Unit → Word) (hp : ∀ s < n, fv (p s) ∧ rv (p s) = Core.tm (fa s) (fb s)) (hbp : fv (bpf ()) ∧ rv (bpf ()) = Core.tm (fa n) (fb n)) (hfin : Core.finAll (n + 1) fa fb) (hL : n + 2 ≤ 2 ^ L) (hL27 : L ≤ 27) (hk : fbk () = act relu (dotOf (n + 1) fa fb)) : tS relu L n p bpf fbk = act relu (dotOf (n + 1) fa fb) := by unfold tS; dsimp only generalize hr : sT p n 0 (bpf ()) 0 = r split next hk' => split next hc => obtain ⟨fS2, eS2⟩ := sT_err _ _ (Core.tm (fa n) (fb n)) n r.2.toNat hk'.1 hk'.2.1 hp n 0 _ 0 rfl (by clear*-;omega) hbp.1 (by simp [hbp.2]) (by rw [hr]) rw [hr] at eS2 fS2 have hu : ((r.2.toNat + L - 1076).toUInt64).toNat = r.2.toNat + L - 1076 := by rw [Nat.toUInt64_eq, UInt64.toNat_ofNat_of_lt' (by simp only [UInt64.size]; clear*-hL27 hk';omega)] refine congrArg _ (cw2 _ _ _ hfin _ fS2 _ (by rw [hu]; clear*-hL27 hk';omega) ?_ hc) rw [Core.tsum_succ, hu]; unfold Core.tsum; push_cast; rw [add_comm] exact eS2.trans ((mul_le_mul_of_nonneg_right (by exact_mod_cast (by clear*-hL;omega : n ≤ 2 ^ L) : (n : ℝ) ≤ 2 ^ L) (by positivity)).trans_eq (by rw [← zpow_natCast, ← zpow_add₀ two_ne_zero]; exact congrArg (2 ^ ·) (by clear*-hk';omega))) ·exact hk ·rw [if_neg (by decide)]; exact hk end F end Dense namespace Sr structure Ent {α : Type} (f : Array Word → Array Word → Nat → α) where w : Array Word b : Array Word n : Nat v : α ok : v = f w b n a : USize structure St {α : Type} (f : Array Word → Array Word → Nat → α) where e : Array (Ent f) x : ByteArray hd : Nat tl : Nat u : Nat c : UInt64 structure Tab {α : Type} (f : Array Word → Array Word → Nat → α) where r : ST.Ref Unit (St f) z : Ent f zx : ByteArray cap : Nat tc : α → UInt64 variable {α : Type} {f : Array Word → Array Word → Nat → α} def Tab.makeT (f : Array Word → Array Word → Nat → α) (N cap : Nat) (tc : α → UInt64) : Tab f := let z : Ent f := ⟨#[], #[], 0, f #[] #[] 0, rfl, 0⟩ let zx : ByteArray := ⟨Array.replicate (4 * N) 0⟩ ⟨(ST.Prim.mkRef ⟨Array.replicate N z, zx, 0, 0, 0, 0⟩ (Void.mk ())).val, z, zx, cap, tc⟩ def Tab.make (f : Array Word → Array Word → Nat → α) (N cap : Nat) : Tab f := Tab.makeT f N cap fun _ => 0 def tAll (t : Tab f) (e : Array (Ent f)) : Nat → UInt64 → UInt64 | 0, c => c | p + 1, c => let q := e.getD p t.z; tAll t e p (if q.w.isEmpty then c else c + t.tc q.v) @[inline] def Ent.hit (e : Ent f) (w b : Array Word) (n : Nat) : Bool := e.n == n && withPtrEq e.w w (fun _ => e.w == w) (fun h => by rw [h]; simp) && withPtrEq e.b b (fun _ => e.b == b) (fun h => by rw [h]; simp) theorem Ent.hit_ok {e : Ent f} {w b : Array Word} {n : Nat} (h : e.hit w b n = true) : e.v = f w b n := by simp only [Ent.hit, withPtrEq, Bool.and_eq_true, beq_iff_eq] at h obtain ⟨⟨h1, h2⟩, h3⟩ := h rw [e.ok, h1, h2, h3] @[inline] def Ent.sz (e : Ent f) : Nat := e.w.size + e.b.size + 64 @[inline] def hs (a : USize) : USize := (((a >>> 4).toUInt64 * 0x9E3779B97F4A7C15) >>> 48).toUSize theorem ul {β : Type} {a : Array β} {i : USize} (h : i < a.usize) : i.toNat < a.size := by have h' := USize.lt_iff_toNat_lt.mp h simp only [Array.usize, Nat.toUSize_eq] at h' exact Nat.lt_of_lt_of_le h' (by simp [Nat.mod_le]) theorem ub {a : ByteArray} {i : USize} (h : i < a.usize) : i.toNat < a.size := by have h' := USize.lt_iff_toNat_lt.mp h simp only [ByteArray.usize, Nat.toUSize_eq] at h' exact Nat.lt_of_lt_of_le h' (by simp [Nat.mod_le]) def xput (x : ByteArray) (m : USize) (c : UInt8) : Nat → USize → ByteArray | 0, _ => x | p + 1, i => let k := i &&& m if h : k < x.usize then if x.uget k (ub h) == 0 then x.uset k c (ub h) else xput x m c p (i + 1) else x def xall (e : Array (Ent f)) (m : USize) (i : Nat) (x : ByteArray) : ByteArray := if h : i < e.size then let q := e[i] xall e m (i + 1) (if q.w.isEmpty then x else xput x m (i + 1).toUInt8 x.size (hs q.a)) else x termination_by e.size - i @[inline] def St.drop (s : St f) (z : Ent f) : St f := let o := s.e.getD s.hd z ⟨s.e.setIfInBounds s.hd z, s.x, (s.hd + 1) % s.e.size, s.tl, if o.w.isEmpty then s.u else s.u - o.sz, s.c⟩ def St.room (t : Tab f) (sz : Nat) : Nat → St f → St f | 0, s => s | p + 1, s => if s.u + sz ≤ t.cap then s else St.room t sz p (s.drop t.z) def St.fd (s : St f) (t : Tab f) (w b : Array Word) (n : Nat) : Nat → {y // y = f w b n} | 0 => ⟨f w b n, rfl⟩ | p + 1 => let e := s.e.getD p t.z if h : e.hit w b n = true then ⟨e.v, Ent.hit_ok h⟩ else s.fd t w b n p @[noinline] def Tab.miss (t : Tab f) (w b : Array Word) (n : Nat) (a : USize) : {y // y = f w b n} := let r := (ST.Prim.Ref.get t.r (Void.mk ())).val let y := r.fd t w b n r.e.size let q : Ent f := ⟨w, b, n, y.1, y.2, a⟩ let sz := q.sz if 4 * sz ≤ t.cap then let s := (ST.Prim.Ref.get t.r (Void.mk ())).val let s := St.room t sz s.e.size s let s := if (s.e.getD s.tl t.z).w.isEmpty then s else s.drop t.z let e := s.e.setIfInBounds s.tl q let x := xall e (t.zx.usize - 1) 0 t.zx let o := (ST.Prim.Ref.swap t.r ⟨e, x, s.hd, (s.tl + 1) % e.size, s.u + sz, tAll t e e.size 0⟩ (Void.mk ())).val if o.u = 0xFFFFFFFFFFFF then if h : (o.e.getD 0 t.z).hit w b n = true then ⟨_, Ent.hit_ok h⟩ else y else y else y def St.scan (s : St f) (t : Tab f) (w b : Array Word) (n : Nat) (a m : USize) : Nat → USize → {y // y = f w b n} | 0, _ => t.miss w b n a | p + 1, i => let k := i &&& m if h : k < s.x.usize then let c := s.x.uget k (ub h) if c == 0 then t.miss w b n a else let j := (c - 1).toUSize if hj : j < s.e.usize then let e := s.e.uget j (ul hj) if e.a == a then if hk : e.hit w b n = true then ⟨e.v, Ent.hit_ok hk⟩ else s.scan t w b n a m p (i + 1) else s.scan t w b n a m p (i + 1) else s.scan t w b n a m p (i + 1) else t.miss w b n a local instance {β : Type} (y : β) : Subsingleton {z // z = y} := ⟨fun p q => Subtype.ext (p.2.trans q.2.symm)⟩ @[inline] def Tab.get (t : Tab f) (w b : Array Word) (n : Nat) : {y // y = f w b n} := withPtrAddr w (fun a => let s := (ST.Prim.Ref.get t.r (Void.mk ())).val s.scan t w b n a (s.x.usize - 1) s.x.size (hs a)) (fun _ _ => Subsingleton.elim _ _) end Sr namespace Dense namespace F namespace Pn def dR (X : Array Word) (st : USize) : Nat → USize → USize → FloatArray → Float → FloatArray | 0, _, o, Y, a => wF Y o a | k + 1, q, o, Y, a => let v := rX X q; dR X st k (q + st) (o + 1) (wF Y o v) (a + v.abs) theorem us_e (Y : FloatArray) (i : USize) (v : Float) (h : i.toNat < Y.size) (hs : Y.size < 2 ^ 32) : Y.uset i v h = wF Y i v := by unfold wF; rw [dif_pos] have := USize.le_size rw [USize.lt_iff_toNat_lt, FloatArray.usize, toUSize_toNat (by omega)]; exact h theorem us_z (Y : FloatArray) (i : USize) (v : Float) (h : i.toNat < Y.size) : (Y.uset i v h).size = Y.size := by rcases Y with ⟨d⟩; simp only [FloatArray.uset, FloatArray.size, Array.uset]; apply Array.size_set def dU (X : Array Word) (st nu t q o : USize) (Y : FloatArray) (a : Float) (ht : t.toNat ≤ nu.toNat) (hb : o.toNat + (nu.toNat - t.toNat) < Y.size) (hs : Y.size < 2 ^ 32) : FloatArray := if h : t < nu then have htl := USize.lt_iff_toNat_lt.mp h have ul := USize.le_size let v := rX X q dU X st nu (t + 1) (q + st) (o + 1) (Y.uset o v (by omega)) (a + v.abs) (by rw [usucc h]; omega) (by rw [us_z, usucc h, uadd (by simp only [USize.reduceToNat]; omega)]; simp only [USize.reduceToNat]; omega) (by rw [us_z]; exact hs) else Y.uset o a (by omega) termination_by nu.toNat - t.toNat decreasing_by (have := USize.lt_iff_toNat_lt.mp h; rw [usucc h]; omega) theorem dU_eq (X : Array Word) (st nu : USize) : ∀ k (t q o : USize) (Y : FloatArray) (a : Float) (ht : t.toNat ≤ nu.toNat) (hb : o.toNat + (nu.toNat - t.toNat) < Y.size) (hs : Y.size < 2 ^ 32), nu.toNat - t.toNat = k → dU X st nu t q o Y a ht hb hs = dR X st k q o Y a := by intro k; induction k <;> intro t q o Y a ht hb hs hk · rw [dU, dif_neg (by rw [USize.lt_iff_toNat_lt]; omega), us_e _ _ _ _ hs, dR] rename_i k ih have h : t < nu := USize.lt_iff_toNat_lt.mpr (by omega) rw [dU, dif_pos h]; dsimp only rw [ih _ _ _ _ _ _ _ _ (by rw [usucc h]; omega), us_e _ _ _ _ hs, dR] @[inline] def dQ (X : Array Word) (st : USize) (n : Nat) (q o : USize) (Y : FloatArray) : FloatArray := if h : n ≤ 4294967295 ∧ o.toNat + n < Y.size ∧ Y.size ≤ 4294967295 then have e : n.toUSize.toNat = n := toUSize_toNat (by have := USize.le_size; omega) dU X st n.toUSize 0 q o Y 0 (by simp) (by rw [e]; simp only [USize.toNat_zero, Nat.sub_zero]; exact h.2.1) (by have := h.2.2; omega) else dR X st n q o Y 0 theorem dQ_eq (X : Array Word) (st : USize) (n : Nat) (q o : USize) (Y : FloatArray) : dQ X st n q o Y = dR X st n q o Y 0 := by unfold dQ; split · rename_i h have e : n.toUSize.toNat = n := toUSize_toNat (by have := USize.le_size; omega) exact dU_eq _ _ _ _ _ _ _ _ _ _ _ _ (by rw [e]; simp) · rfl def dO (X : Array Word) (st s m : USize) (n : Nat) : Nat → USize → USize → FloatArray → FloatArray | 0, _, _, Y => Y | k + 1, q, o, Y => dO X st s m n k (q + s) (o + m) (dQ X st n q o Y) def qL (W : Array Word) (su m : USize) (n : Nat) : Nat → USize → FloatArray → FloatArray | 0, _, Y => Y | k + 1, q, Y => qL W su m n k (q + m) (bx W su 1 n q (q + 1) Y) theorem usf (q st : USize) (τ : Nat) : q + st + τ.toUSize * st = q + (τ + 1).toUSize * st := by rw [Nat.toUSize_eq, Nat.toUSize_eq, USize.ofNat_add, USize.add_mul, show USize.ofNat 1 = 1 from rfl, USize.one_mul, USize.add_assoc, USize.add_comm st] theorem uz (q st : USize) : q + (0 : Nat).toUSize * st = q := by simp [Nat.toUSize_eq, show USize.ofNat 0 = 0 from rfl] theorem dR_spec (X : Array Word) (st : USize) : ∀ k (q o : USize) (Y : FloatArray) (a : Float), Y.size < 2 ^ 32 → o.toNat + k < Y.size → (dR X st k q o Y a).size = Y.size ∧ (∀ i, i < Y.size → i < o.toNat ∨ o.toNat + k < i → (dR X st k q o Y a).data[i]! = Y.data[i]!) ∧ (∀ τ < k, (dR X st k q o Y a).data[o.toNat + τ]! = rX X (q + τ.toUSize * st)) ∧ (dR X st k q o Y a).data[o.toNat + k]! = sfold (fun τ => (rX X (q + τ.toUSize * st)).abs) k 0 a := by intro k; induction k with | zero => intro q o Y a hY ho rw [dR, wF_eq Y hY, sfold, if_neg (by omega)] refine ⟨ssz .., fun i h1 h2 => ?_, fun τ h => absurd h (by clear*-h;omega), ?_⟩ ·rw [sg _ _ _ _ h1, if_neg (by clear*-h2;omega)] ·rw [sg _ _ _ _ ho, if_pos (by clear*-;omega)] | succ k ih => intro q o Y a hY ho have := USize.le_size have h1 : (o + 1).toNat = o.toNat + 1 := by rw [uadd (by simp only [USize.reduceToNat]; omega)]; simp only [USize.reduceToNat] rw [dR, wF_eq Y hY] obtain ⟨i1, i2, i3, i4⟩ := ih (q + st) (o + 1) (Y.set! o.toNat (rX X q)) (a + (rX X q).abs) (by rw [ssz]; exact hY) (by rw [ssz, h1]; clear*-ho;omega) rw [ssz] at i1 refine ⟨i1, fun i hi hc => ?_, fun τ h => ?_, ?_⟩ ·rw [i2 i (by rw [ssz]; exact hi) (by clear*-h1 hc;omega), sg _ _ _ _ hi, if_neg (by clear*-hc;omega)] ·rcases τ with _ | τ ·rw [i2 _ (by rw [ssz]; clear*-ho;omega) (by clear*-h1;omega), sg _ _ _ _ (by clear*-ho;omega), if_pos (by clear*-;omega), uz] ·have := i3 τ (by clear*-h;omega) rw [h1, show o.toNat + 1 + τ = o.toNat + (τ + 1) by clear*-;omega] at this rw [this, usf] ·have := i4 rw [h1, show o.toNat + 1 + k = o.toNat + (k + 1) by clear*-;omega] at this rw [this] conv_rhs => rw [sfold, if_pos (by clear*-;omega), sfold_shift _ k _ 0 _ rfl] simp only [usf, uz] theorem dO_spec (X : Array Word) (st s m : USize) (n : Nat) (hm : m.toNat = n + 1) (hn : n + 1 < 2 ^ 32) : ∀ k (q o : USize) (Y : FloatArray), Y.size < 2 ^ 32 → o.toNat + k * (n + 1) ≤ Y.size → (dO X st s m n k q o Y).size = Y.size ∧ (∀ i, i < Y.size → i < o.toNat → (dO X st s m n k q o Y).data[i]! = Y.data[i]!) ∧ (∀ j < k, ∀ τ < n, (dO X st s m n k q o Y).data[o.toNat + j * (n + 1) + τ]! = rX X (q + j.toUSize * s + τ.toUSize * st)) ∧ (∀ j < k, (dO X st s m n k q o Y).data[o.toNat + j * (n + 1) + n]! = sfold (fun τ => (rX X (q + j.toUSize * s + τ.toUSize * st)).abs) n 0 0) := by intro k; induction k with | zero => intro q o Y _ _; exact ⟨rfl, fun _ _ _ => rfl, fun j h => absurd h (by clear*-h;omega), fun j h => absurd h (by clear*-h;omega)⟩ | succ k ih => intro q o Y hY ho rw [Nat.succ_mul] at ho have := USize.le_size have h1 : (o + m).toNat = o.toNat + (n + 1) := by rw [uadd (by omega), hm] obtain ⟨r1, r2, r3, r4⟩ := dR_spec X st n q o Y 0 hY (by clear*-ho;omega) obtain ⟨i1, i2, i3, i4⟩ := ih (q + s) (o + m) (dR X st n q o Y 0) (by rw [r1]; exact hY) (by rw [r1, h1]; clear*-ho;omega) rw [r1] at i1 rw [dO, dQ_eq] refine ⟨i1, fun i hi hc => ?_, fun j h τ hτ => ?_, fun j h => ?_⟩ ·rw [i2 i (by rw [r1]; exact hi) (by clear*-h1 hc;omega), r2 i hi (by clear*-hc;omega)] ·rcases j with _ | j ·rw [Nat.zero_mul, Nat.add_zero, i2 _ (by rw [r1]; clear*-ho hτ;omega) (by clear*-h1 hτ;omega), r3 τ hτ, uz] ·have := i3 j (by clear*-h;omega) τ hτ rw [h1, show o.toNat + (n + 1) + j * (n + 1) = o.toNat + (j + 1) * (n + 1) by rw [Nat.succ_mul]; clear*-;omega] at this rw [this, usf] ·rcases j with _ | j ·rw [Nat.zero_mul, Nat.add_zero, i2 _ (by rw [r1]; clear*-ho;omega) (by clear*-h1;omega), r4] simp only [uz] ·have := i4 j (by clear*-h;omega) rw [h1, show o.toNat + (n + 1) + j * (n + 1) = o.toNat + (j + 1) * (n + 1) by rw [Nat.succ_mul]; clear*-;omega] at this rw [this]; simp only [usf] theorem qL_spec (W : Array Word) (su m : USize) (n : Nat) (hm : m.toNat = 8 * n) (hu : su.toNat = n) : ∀ k (q : USize) (Y : FloatArray), 2 * (q.toNat + k * (8 * n)) + 32 * n < 2 ^ 32 → q.toNat + k * (8 * n) + 1 ≤ Y.size → (qL W su m n k q Y).size = Y.size ∧ (∀ i, i < q.toNat + 1 → (qL W su m n k q Y).data[i]! = Y.data[i]!) ∧ ∀ g < k, ∀ τ < n, ∀ r < 8, (qL W su m n k q Y).data[q.toNat + g * (8 * n) + 1 + 8 * τ + r]! = dw W[q.toNat + g * (8 * n) + τ + r * n]! := by intro k; induction k with | zero => intro q Y _ _; exact ⟨rfl, fun _ _ => rfl, fun g h => absurd h (by clear*-h;omega)⟩ | succ k ih => intro q Y hB hY rw [Nat.add_mul, Nat.one_mul] at hB hY have := USize.le_size have h1 : (q + m).toNat = q.toNat + 8 * n := by rw [uadd (by clear hY hu ih;omega), hm] have h2 : (q + 1).toNat = q.toNat + 1 := by rw [uadd (by simp only [USize.reduceToNat]; clear*-h1 hB this;omega)]; simp only [USize.reduceToNat] obtain ⟨r1, r2, r3⟩ := bx_spec W su 1 n q (q + 1) Y (by simp only [USize.reduceToNat, h2]; clear*-hB hu this;omega) (by rw [h2]; clear*-hY;omega) simp only [USize.reduceToNat, Nat.mul_one, hu, h2] at r2 r3 obtain ⟨i1, i2, i3⟩ := ih (q + m) (bx W su 1 n q (q + 1) Y) (by rw [h1]; clear*-hB;omega) (by rw [r1, h1]; clear*-hY;omega) rw [r1] at i1 rw [qL] refine ⟨i1, fun i hi => ?_, fun g h τ hτ r hr => ?_⟩ ·rw [i2 i (by clear*-h1 hi;omega), r2 i hi] ·rcases g with _ | g ·rw [Nat.zero_mul, Nat.add_zero, i2 _ (by rw [h1]; clear*-hr hτ;omega), r3 τ r hτ hr, Nat.add_zero] ·have := i3 g (by clear*-h;omega) τ hτ r hr rw [h1, show q.toNat + 8 * n + g * (8 * n) = q.toNat + (g + 1) * (8 * n) by rw [Nat.add_mul, Nat.one_mul]; clear*-;omega] at this exact this @[inline] def pp (V P : FloatArray) (vo xb r s : Nat) : Float := V.get! (vo + s) * P.get! (xb + 8 * s + r) @[noinline] def sQ (n : Nat) (relu : Bool) (X W b : @& Array Word) (V P : @& FloatArray) (vo xb r xo st j : Nat) : Word := tS relu (Nat.log2 (n + 1) + 1) n (pp V P vo xb r) (fun _ => dw oneW * dw b[j]!) fun _ => cellFB n relu X W b xo st j @[inline] def pO (relu ok : Bool) (hh : UInt64) (n : Nat) (X W b : Array Word) (xo st o r : Nat) (V P : FloatArray) (vo : USize) (q : USize) (on : Bool) (acc : Array Word) (S : Float) : Array Word := if h : on = true ∧ q < acc.usize then acc.uset q (if ok then tfB relu S hh (fun _ => sQ n relu X W b V P vo.toNat (o * n + 1) r xo st (o + r)) else cellFB n relu X W b xo st (o + r)) (ulen h.2) else acc @[noinline] def fP (relu ok : Bool) (hh : UInt64) (n : Nat) (X W b : Array Word) (xo st o : Nat) (q0 so mu : USize) (V P : FloatArray) (vo : USize) (a0 a1 a2 a3 a4 a5 a6 a7 : Float) (acc : Array Word) : Array Word := pO relu ok hh n X W b xo st o 7 V P vo (q0 + 7 * so) (decide (7 < mu)) (pO relu ok hh n X W b xo st o 6 V P vo (q0 + 6 * so) (decide (6 < mu)) (pO relu ok hh n X W b xo st o 5 V P vo (q0 + 5 * so) (decide (5 < mu)) (pO relu ok hh n X W b xo st o 4 V P vo (q0 + 4 * so) (decide (4 < mu)) (pO relu ok hh n X W b xo st o 3 V P vo (q0 + 3 * so) (decide (3 < mu)) (pO relu ok hh n X W b xo st o 2 V P vo (q0 + 2 * so) (decide (2 < mu)) (pO relu ok hh n X W b xo st o 1 V P vo (q0 + 1 * so) (decide (1 < mu)) (pO relu ok hh n X W b xo st o 0 V P vo (q0 + 0 * so) (decide (0 < mu)) acc a0) a1) a2) a3) a4) a5) a6) a7 theorem fP_spec (relu ok : Bool) (hh : UInt64) (n : Nat) (X W b : Array Word) (xo st o : Nat) (q0 so mu : USize) (V P : FloatArray) (vo : USize) (a0 a1 a2 a3 a4 a5 a6 a7 : Float) (acc : Array Word) (F : Nat → Word) (hq0 : q0.toNat + 8 * so.toNat ≤ 4294967295) (hz : acc.size ≤ 4294967295) (hv : ∀ k < 8, k < mu.toNat → (if ok then tfB relu (A8.f ⟨a0, a1, a2, a3, a4, a5, a6, a7⟩ k) hh (fun _ => sQ n relu X W b V P vo.toNat (o * n + 1) k xo st (o + k)) else cellFB n relu X W b xo st (o + k)) = F (q0.toNat + k * so.toNat)) : Iv F acc (fun q => ∃ k, k < 8 ∧ k < mu.toNat ∧ q = q0.toNat + k * so.toNat) (fP relu ok hh n X W b xo st o q0 so mu V P vo a0 a1 a2 a3 a4 a5 a6 a7 acc) := by let I j := q0.toNat + j * so.toNat let Q k := Iv F acc fun q => ∃ j, j < k ∧ j < mu.toNat ∧ q = I j have ul := USize.le_size have st' : ∀ k {a qk on}, Q k a → k < 8 → (k < mu.toNat → USize.toNat qk = I k) → on = decide (k < mu.toNat) → Q (k + 1) (pO relu ok hh n X W b xo st o k V P vo qk on a (A8.f ⟨a0, a1, a2, a3, a4, a5, a6, a7⟩ k)) := by intro k a qk on ⟨h1, h2⟩ hk hq hon unfold pO; split next hc => have hk' : k < mu.toNat := by simpa [hon] using hc.1 refine ⟨by simp [h1], fun q => ?_⟩ rw [Array.uset_eq_set, Array.getElem?_set, hv k hk hk'] by_cases h : qk.toNat = q ·subst h; simp [hq hk', I] ·rw [if_neg h] exact ⟨(h2 q).1, fun ⟨j, hj, h3, h4⟩ => (h2 q).2 ⟨j, Nat.lt_of_le_of_ne (Nat.le_of_lt_succ hj) fun e => by subst e; exact h ((hq h3).trans h4.symm), h3, h4⟩⟩ next hc => refine ⟨h1, fun q => ⟨(h2 q).1, fun ⟨j, hj, h3, h4⟩ hq' => (h2 q).2 ⟨j, Nat.lt_of_le_of_ne (Nat.le_of_lt_succ hj) fun e => hc ⟨by simp [hon]; clear*-e h3;omega, ?_⟩, h3, h4⟩ hq'⟩⟩ subst e; rw [USize.lt_iff_toNat_lt, Array.usize, toUSize_toNat (by clear*-h1 hz ul;omega), hq h3, ← h4]; clear*-h1 hq';omega have hqk : ∀ c : USize, c.toNat < 8 → (q0 + c * so).toNat = q0.toNat + c.toNat * so.toNat := fun c hc => by have m1 : c.toNat * so.toNat ≤ 8 * so.toNat := Nat.mul_le_mul_right _ hc.le have e : (c * so).toNat = c.toNat * so.toNat := by rw [USize.toNat_mul, ← USize.size_eq_two_pow, Nat.mod_eq_of_lt (by omega)] rw [uadd (by omega), e] unfold fP refine st' 7 (st' 6 (st' 5 (st' 4 (st' 3 (st' 2 (st' 1 (st' 0 ?_ ?_ ?_ ?_) ?_ ?_ ?_) ?_ ?_ ?_) ?_ ?_ ?_) ?_ ?_ ?_) ?_ ?_ ?_) ?_ ?_ ?_) ?_ ?_ ?_ all_goals first | decide | (intro _; rw [hqk _ (by simp only [USize.reduceToNat]; omega)]; simp only [USize.reduceToNat, I]) | simp only [USize.lt_iff_toNat_lt, USize.reduceToNat] | simp [Q, Iv] def pk (V P : FloatArray) (vo nu : USize) (hs : V.size < 2 ^ 32 ∧ P.size < 2 ^ 32) (hV : vo.toNat + nu.toNat ≤ V.size) (t i : USize) (hi : i.toNat + 8 * (nu.toNat - t.toNat) ≤ P.size) (a0 a1 a2 a3 a4 a5 a6 a7 : Float) (relu ok : Bool) (hh : UInt64) (n : Nat) (X W b : Array Word) (xo st o : Nat) (q0 so mu : USize) (acc : Array Word) : Array Word := if h : t < nu then have ht := USize.lt_iff_toNat_lt.mp h have hI : i.toNat + 8 ≤ P.size := by omega have hJ : (i + 8).toNat + 8 * (nu.toNat - (t + 1).toNat) ≤ P.size := by rw [usucc h, uadd (by have := USize.le_size; simp only [USize.reduceToNat]; omega)]; simp only [USize.reduceToNat]; omega let x := V.uget (vo + t) (by have := USize.le_size; rw [uadd (by omega)]; omega) let b0 := a0 + x * P.uget (i + 0) (uk (by simp) hI hs.2) let b1 := a1 + x * P.uget (i + 1) (uk (by simp) hI hs.2) let b2 := a2 + x * P.uget (i + 2) (uk (by simp) hI hs.2) let b3 := a3 + x * P.uget (i + 3) (uk (by simp) hI hs.2) if mu ≤ 4 then pk V P vo nu hs hV (t + 1) (i + 8) hJ b0 b1 b2 b3 a4 a5 a6 a7 relu ok hh n X W b xo st o q0 so mu acc else let b4 := a4 + x * P.uget (i + 4) (uk (by simp) hI hs.2) let b5 := a5 + x * P.uget (i + 5) (uk (by simp) hI hs.2) let b6 := a6 + x * P.uget (i + 6) (uk (by simp) hI hs.2) let b7 := a7 + x * P.uget (i + 7) (uk (by simp) hI hs.2) pk V P vo nu hs hV (t + 1) (i + 8) hJ b0 b1 b2 b3 b4 b5 b6 b7 relu ok hh n X W b xo st o q0 so mu acc else fP relu ok hh n X W b xo st o q0 so mu V P vo a0 a1 a2 a3 a4 a5 a6 a7 acc termination_by nu.toNat - t.toNat decreasing_by all_goals (have := USize.lt_iff_toNat_lt.mp h; rw [usucc h]; omega) theorem pk_z (V P : FloatArray) (vo nu : USize) (hs : V.size < 2 ^ 32 ∧ P.size < 2 ^ 32) (hV : vo.toNat + nu.toNat ≤ V.size) (t i : USize) (hi : i.toNat + 8 * (nu.toNat - t.toNat) ≤ P.size) (a0 a1 a2 a3 a4 a5 a6 a7 : Float) (relu ok : Bool) (hh : UInt64) (n : Nat) (X W b : Array Word) (xo st o : Nat) (q0 so mu : USize) (acc : Array Word) (h : ¬t < nu) : pk V P vo nu hs hV t i hi a0 a1 a2 a3 a4 a5 a6 a7 relu ok hh n X W b xo st o q0 so mu acc = fP relu ok hh n X W b xo st o q0 so mu V P vo a0 a1 a2 a3 a4 a5 a6 a7 acc := (pk.eq_1 V P vo nu hs hV t i hi a0 a1 a2 a3 a4 a5 a6 a7 relu ok hh n X W b xo st o q0 so mu acc).trans (dif_neg h) theorem pO_off (relu ok : Bool) (hh : UInt64) (n : Nat) (X W b : Array Word) (xo st o r : Nat) (V P : FloatArray) (vo q : USize) (acc : Array Word) (S : Float) : pO relu ok hh n X W b xo st o r V P vo q false acc S = acc := by simp [pO] theorem pk_eq (V P : FloatArray) (vo nu : USize) (hs : V.size < 2 ^ 32 ∧ P.size < 2 ^ 32) (hV : vo.toNat + nu.toNat ≤ V.size) (relu ok : Bool) (hh : UInt64) (n : Nat) (X W b : Array Word) (xo st o : Nat) (q0 so mu : USize) (acc : Array Word) (xb : Nat) : ∀ m (t i : USize) (hi : i.toNat + 8 * (nu.toNat - t.toNat) ≤ P.size) (a0 a1 a2 a3 a4 a5 a6 a7 : Float), nu.toNat - t.toNat = m → i.toNat = xb + 8 * t.toNat → pk V P vo nu hs hV t i hi a0 a1 a2 a3 a4 a5 a6 a7 relu ok hh n X W b xo st o q0 so mu acc = fP relu ok hh n X W b xo st o q0 so mu V P vo (sfold (pp V P vo.toNat xb 0) nu.toNat t.toNat a0) (sfold (pp V P vo.toNat xb 1) nu.toNat t.toNat a1) (sfold (pp V P vo.toNat xb 2) nu.toNat t.toNat a2) (sfold (pp V P vo.toNat xb 3) nu.toNat t.toNat a3) (sfold (pp V P vo.toNat xb 4) nu.toNat t.toNat a4) (sfold (pp V P vo.toNat xb 5) nu.toNat t.toNat a5) (sfold (pp V P vo.toNat xb 6) nu.toNat t.toNat a6) (sfold (pp V P vo.toNat xb 7) nu.toNat t.toNat a7) acc := by intro m; induction m <;> intro t i hi a0 a1 a2 a3 a4 a5 a6 a7 hm hx ·rw [pk_z V P vo nu hs hV t i hi a0 a1 a2 a3 a4 a5 a6 a7 relu ok hh n X W b xo st o q0 so mu acc fun h => Nat.sub_ne_zero_of_lt (USize.lt_iff_toNat_lt.mp h) hm] have e : ∀ p a, sfold p nu.toNat t.toNat a = a := fun p a => by rw [sfold, if_neg fun h => Nat.sub_ne_zero_of_lt h hm] simp only [e] rename_i ih have := USize.le_size have ht : t.toNat < nu.toNat := by clear*-hm;omega have h : t < nu := USize.lt_iff_toNat_lt.mpr ht have h8 : (i + 8).toNat = i.toNat + 8 := by rw [uadd (by simp only [USize.reduceToNat]; clear h hV ht hx ih;omega)]; simp only [USize.reduceToNat] have hw : (vo + t).toNat = vo.toNat + t.toNat := uadd (by clear*-hV hs ht this;omega) have sp : ∀ r a, sfold (pp V P vo.toNat xb r) nu.toNat t.toNat a = sfold (pp V P vo.toNat xb r) nu.toNat (t.toNat + 1) (a + pp V P vo.toNat xb r t.toNat) := fun r a => by rw [sfold, if_pos ht] have e : ∀ (c : USize) (r : Nat) (hc : c.toNat = r) (hr : r < 8) (h1 : (vo + t).toNat < V.size) (h2 : (i + c).toNat < P.size), V.uget (vo + t) h1 * P.uget (i + c) h2 = pp V P vo.toNat xb r t.toNat := fun c r hc hr h1 h2 => by rw [ug, ug, pp, gg, gg, hw, uadd (by clear*-hc hi hm hr hs this;omega), hx, hc] have c : ∀ {k : USize}, mu.toNat ≤ k.toNat → decide (k < mu) = false := fun e => by rw [decide_eq_false_iff_not, USize.lt_iff_toNat_lt]; clear*-e;omega rw [pk, dif_pos h]; dsimp only by_cases hq : mu ≤ 4 <;> [rw [if_pos hq]; rw [if_neg hq]] <;> rw [ih (t + 1) (i + 8) _ _ _ _ _ _ _ _ _ (by rw [usucc h]; clear*-hm ht;omega) (by rw [usucc h, h8, hx]; ring), usucc h] <;> simp only [USize.le_iff_toNat_le, USize.reduceToNat] at hq ⊢ <;> simp (disch := simp only [USize.reduceToNat]; omega) only [sp, e 0 0 (by simp) (by clear*-;omega), e 1 1 (by simp) (by clear*-;omega), e 2 2 (by simp) (by clear*-;omega), e 3 3 (by simp) (by clear*-;omega), e 4 4 (by simp) (by clear*-;omega), e 5 5 (by simp) (by clear*-;omega), e 6 6 (by simp) (by clear*-;omega), e 7 7 (by simp) (by clear*-;omega), fP, c, pO_off] theorem k0 : (0 : USize).toNat < 8 := by simp theorem k1 : (1 : USize).toNat < 8 := by simp theorem k2 : (2 : USize).toNat < 8 := by simp theorem k3 : (3 : USize).toNat < 8 := by simp theorem k4 : (4 : USize).toNat < 8 := by simp theorem k5 : (5 : USize).toNat < 8 := by simp theorem k6 : (6 : USize).toNat < 8 := by simp theorem k7 : (7 : USize).toNat < 8 := by simp theorem ukq {V P : FloatArray} {vo t i k : USize} {R : Prop} (hk : k.toNat < 8) (q : (vo + t).toNat < V.size ∧ i.toNat + 8 ≤ P.size ∧ R) (hs : V.size < 2 ^ 32 ∧ P.size < 2 ^ 32) : (i + k).toNat < P.size := uk hk q.2.1 hs.2 theorem pkH {V P : FloatArray} {vo nu t i : USize} (hs : V.size < 2 ^ 32 ∧ P.size < 2 ^ 32) (hV : vo.toNat + nu.toNat ≤ V.size) (hi : i.toNat + 8 * (nu.toNat - t.toNat) ≤ P.size) (h : t < nu) : (vo + t).toNat < V.size ∧ i.toNat + 8 ≤ P.size ∧ (i + 8).toNat + 8 * (nu.toNat - (t + 1).toNat) ≤ P.size := have ht := USize.lt_iff_toNat_lt.mp h have hk : nu.toNat - t.toNat = nu.toNat - t.toNat - 1 + 1 := (Nat.sub_one_add_one (Nat.sub_ne_zero_of_lt ht)).symm have hi' : i.toNat + (8 * (nu.toNat - t.toNat - 1) + 8) ≤ P.size := hk ▸ hi have hI : i.toNat + 8 ≤ P.size := Nat.le_trans (Nat.add_le_add_left (Nat.le_add_left 8 _) _) hi' have hvt : vo.toNat + t.toNat < V.size := Nat.lt_of_lt_of_le (Nat.add_lt_add_left ht _) hV have e8 : (8 : USize).toNat = 8 := by simp only [USize.reduceToNat] have e1 : (i + 8).toNat = i.toNat + 8 := (uadd (Nat.lt_of_lt_of_le (Nat.lt_of_le_of_lt (e8 ▸ hI) hs.2) USize.le_size)).trans (congrArg (i.toNat + ·) e8) have e2 : nu.toNat - (t + 1).toNat = nu.toNat - t.toNat - 1 := (congrArg (nu.toNat - ·) (usucc h)).trans (Nat.sub_sub _ _ _).symm ⟨(uadd (Nat.lt_of_lt_of_le (Nat.lt_trans hvt hs.1) USize.le_size)).trans_lt hvt, hI, ((congrArg₂ (· + 8 * ·) e1 e2).trans ((Nat.add_assoc _ _ _).trans (congrArg (i.toNat + ·) (Nat.add_comm _ _)))).trans_le hi'⟩ theorem pkF {nu t : USize} {f : Nat} (hf : nu.toNat - t.toNat = 2 * (f + 1)) : t < nu ∧ t + 1 < nu ∧ nu.toNat - (t + 1 + 1).toNat = 2 * f := have hf' : nu.toNat - t.toNat = 2 * f + 1 + 1 := hf have ht : t.toNat + 1 < nu.toNat := Nat.add_lt_of_lt_sub' (hf' ▸ Nat.succ_lt_succ (Nat.succ_pos _)) have h1 : t < nu := USize.lt_iff_toNat_lt.mpr (Nat.lt_of_succ_lt ht) have h2 : t + 1 < nu := USize.lt_iff_toNat_lt.mpr ((usucc h1).trans_lt ht) ⟨h1, h2, (congrArg (nu.toNat - ·) ((usucc h2).trans (congrArg (· + 1) (usucc h1)))).trans ((Nat.sub_sub _ _ _).symm.trans ((Nat.sub_sub _ _ _).symm.trans (congrArg (· - 1 - 1) hf')))⟩ theorem pkO {nu t : USize} (h : (nu.toNat - t.toNat) % 2 = 1) : t < nu ∧ nu.toNat - (t + 1).toNat = 2 * ((nu.toNat - t.toNat) / 2) := have h1 : t < nu := USize.lt_iff_toNat_lt.mpr (Nat.lt_of_sub_ne_zero fun e => Nat.zero_ne_one ((congrArg (· % 2) e).symm.trans h)) ⟨h1, (congrArg (nu.toNat - ·) (usucc h1)).trans ((Nat.sub_sub _ _ _).symm.trans (Nat.two_mul_odd_div_two h).symm)⟩ theorem pkE {nu t : USize} (h : ¬(nu.toNat - t.toNat) % 2 = 1) : nu.toNat - t.toNat = 2 * ((nu.toNat - t.toNat) / 2) := (Nat.div_add_mod _ 2).symm.trans (congrArg (2 * ((nu.toNat - t.toNat) / 2) + ·) (Nat.mod_two_ne_one.mp h)) def pkU (V P : FloatArray) (vo nu : USize) (hs : V.size < 2 ^ 32 ∧ P.size < 2 ^ 32) (hV : vo.toNat + nu.toNat ≤ V.size) (relu ok : Bool) (hh : UInt64) (n : Nat) (X W b : Array Word) (xo st o : Nat) (q0 so mu : USize) (acc : Array Word) : (f : Nat) → (t i : USize) → i.toNat + 8 * (nu.toNat - t.toNat) ≤ P.size → nu.toNat - t.toNat = 2 * f → Float → Float → Float → Float → Float → Float → Float → Float → Array Word | 0, _, _, _, _, a0, a1, a2, a3, a4, a5, a6, a7 => fP relu ok hh n X W b xo st o q0 so mu V P vo a0 a1 a2 a3 a4 a5 a6 a7 acc | f + 1, t, i, hi, hf, a0, a1, a2, a3, a4, a5, a6, a7 => have g := pkF hf have q := pkH hs hV hi g.1 have q2 := pkH hs hV q.2.2 g.2.1 let x := V.uget (vo + t) q.1 let b0 := a0 + x * P.uget (i + 0) (ukq k0 q hs) let b1 := a1 + x * P.uget (i + 1) (ukq k1 q hs) let b2 := a2 + x * P.uget (i + 2) (ukq k2 q hs) let b3 := a3 + x * P.uget (i + 3) (ukq k3 q hs) let b4 := a4 + x * P.uget (i + 4) (ukq k4 q hs) let b5 := a5 + x * P.uget (i + 5) (ukq k5 q hs) let b6 := a6 + x * P.uget (i + 6) (ukq k6 q hs) let b7 := a7 + x * P.uget (i + 7) (ukq k7 q hs) let x1 := V.uget (vo + (t + 1)) q2.1 let c0 := b0 + x1 * P.uget (i + 8 + 0) (ukq k0 q2 hs) let c1 := b1 + x1 * P.uget (i + 8 + 1) (ukq k1 q2 hs) let c2 := b2 + x1 * P.uget (i + 8 + 2) (ukq k2 q2 hs) let c3 := b3 + x1 * P.uget (i + 8 + 3) (ukq k3 q2 hs) let c4 := b4 + x1 * P.uget (i + 8 + 4) (ukq k4 q2 hs) let c5 := b5 + x1 * P.uget (i + 8 + 5) (ukq k5 q2 hs) let c6 := b6 + x1 * P.uget (i + 8 + 6) (ukq k6 q2 hs) let c7 := b7 + x1 * P.uget (i + 8 + 7) (ukq k7 q2 hs) pkU V P vo nu hs hV relu ok hh n X W b xo st o q0 so mu acc f (t + 1 + 1) (i + 8 + 8) q2.2.2 g.2.2 c0 c1 c2 c3 c4 c5 c6 c7 theorem pk_s (V P : FloatArray) (vo nu : USize) (hs : V.size < 2 ^ 32 ∧ P.size < 2 ^ 32) (hV : vo.toNat + nu.toNat ≤ V.size) (t i : USize) (hi : i.toNat + 8 * (nu.toNat - t.toNat) ≤ P.size) (a0 a1 a2 a3 a4 a5 a6 a7 : Float) (relu ok : Bool) (hh : UInt64) (n : Nat) (X W b : Array Word) (xo st o : Nat) (q0 so mu : USize) (acc : Array Word) (hmu : ¬mu ≤ 4) (h : t < nu) (hJ : (i + 8).toNat + 8 * (nu.toNat - (t + 1).toNat) ≤ P.size) (q1 : (vo + t).toNat < V.size) (p0 : (i + 0).toNat < P.size) (p1 : (i + 1).toNat < P.size) (p2 : (i + 2).toNat < P.size) (p3 : (i + 3).toNat < P.size) (p4 : (i + 4).toNat < P.size) (p5 : (i + 5).toNat < P.size) (p6 : (i + 6).toNat < P.size) (p7 : (i + 7).toNat < P.size) : pk V P vo nu hs hV t i hi a0 a1 a2 a3 a4 a5 a6 a7 relu ok hh n X W b xo st o q0 so mu acc = pk V P vo nu hs hV (t + 1) (i + 8) hJ (a0 + V.uget (vo + t) q1 * P.uget (i + 0) p0) (a1 + V.uget (vo + t) q1 * P.uget (i + 1) p1) (a2 + V.uget (vo + t) q1 * P.uget (i + 2) p2) (a3 + V.uget (vo + t) q1 * P.uget (i + 3) p3) (a4 + V.uget (vo + t) q1 * P.uget (i + 4) p4) (a5 + V.uget (vo + t) q1 * P.uget (i + 5) p5) (a6 + V.uget (vo + t) q1 * P.uget (i + 6) p6) (a7 + V.uget (vo + t) q1 * P.uget (i + 7) p7) relu ok hh n X W b xo st o q0 so mu acc := by exact (pk.eq_1 V P vo nu hs hV t i hi a0 a1 a2 a3 a4 a5 a6 a7 relu ok hh n X W b xo st o q0 so mu acc).trans ((dif_pos h).trans (if_neg hmu)) theorem pkU_pk (V P : FloatArray) (vo nu : USize) (hs : V.size < 2 ^ 32 ∧ P.size < 2 ^ 32) (hV : vo.toNat + nu.toNat ≤ V.size) (relu ok : Bool) (hh : UInt64) (n : Nat) (X W b : Array Word) (xo st o : Nat) (q0 so mu : USize) (acc : Array Word) (hmu : ¬mu ≤ 4) : ∀ f (t i : USize) (hi : i.toNat + 8 * (nu.toNat - t.toNat) ≤ P.size) (hf : nu.toNat - t.toNat = 2 * f) (a0 a1 a2 a3 a4 a5 a6 a7 : Float), pkU V P vo nu hs hV relu ok hh n X W b xo st o q0 so mu acc f t i hi hf a0 a1 a2 a3 a4 a5 a6 a7 = pk V P vo nu hs hV t i hi a0 a1 a2 a3 a4 a5 a6 a7 relu ok hh n X W b xo st o q0 so mu acc := by intro f; induction f with | zero => intro t i hi hf a0 a1 a2 a3 a4 a5 a6 a7; exact (pk_z V P vo nu hs hV t i hi a0 a1 a2 a3 a4 a5 a6 a7 relu ok hh n X W b xo st o q0 so mu acc fun h => Nat.sub_ne_zero_of_lt (USize.lt_iff_toNat_lt.mp h) hf).symm | succ f ih => intro t i hi hf a0 a1 a2 a3 a4 a5 a6 a7 have g := pkF hf have q := pkH hs hV hi g.1 exact (ih _ _ _ _ _ _ _ _ _ _ _ _).trans ((pk_s V P vo nu hs hV _ _ q.2.2 _ _ _ _ _ _ _ _ relu ok hh n X W b xo st o q0 so mu acc hmu g.2.1 _ _ _ _ _ _ _ _ _ _).symm.trans (pk_s V P vo nu hs hV t i hi a0 a1 a2 a3 a4 a5 a6 a7 relu ok hh n X W b xo st o q0 so mu acc hmu g.1 q.2.2 _ _ _ _ _ _ _ _ _).symm) @[inline] def pkW (V P : FloatArray) (vo nu : USize) (hs : V.size < 2 ^ 32 ∧ P.size < 2 ^ 32) (hV : vo.toNat + nu.toNat ≤ V.size) (t i : USize) (hi : i.toNat + 8 * (nu.toNat - t.toNat) ≤ P.size) (a0 a1 a2 a3 a4 a5 a6 a7 : Float) (relu ok : Bool) (hh : UInt64) (n : Nat) (X W b : Array Word) (xo st o : Nat) (q0 so mu : USize) (acc : Array Word) : Array Word := if mu ≤ 4 then pk V P vo nu hs hV t i hi a0 a1 a2 a3 a4 a5 a6 a7 relu ok hh n X W b xo st o q0 so mu acc else if h : (nu.toNat - t.toNat) % 2 = 1 then have g := pkO h have q := pkH hs hV hi g.1 let x := V.uget (vo + t) q.1 let b0 := a0 + x * P.uget (i + 0) (ukq k0 q hs) let b1 := a1 + x * P.uget (i + 1) (ukq k1 q hs) let b2 := a2 + x * P.uget (i + 2) (ukq k2 q hs) let b3 := a3 + x * P.uget (i + 3) (ukq k3 q hs) let b4 := a4 + x * P.uget (i + 4) (ukq k4 q hs) let b5 := a5 + x * P.uget (i + 5) (ukq k5 q hs) let b6 := a6 + x * P.uget (i + 6) (ukq k6 q hs) let b7 := a7 + x * P.uget (i + 7) (ukq k7 q hs) pkU V P vo nu hs hV relu ok hh n X W b xo st o q0 so mu acc ((nu.toNat - t.toNat) / 2) (t + 1) (i + 8) q.2.2 g.2 b0 b1 b2 b3 b4 b5 b6 b7 else pkU V P vo nu hs hV relu ok hh n X W b xo st o q0 so mu acc ((nu.toNat - t.toNat) / 2) t i hi (pkE h) a0 a1 a2 a3 a4 a5 a6 a7 theorem pkW_eq_pk : pkW = pk := by funext V P vo nu hs hV t i hi a0 a1 a2 a3 a4 a5 a6 a7 relu ok hh n X W b xo st o q0 so mu acc by_cases hm : mu ≤ 4 ·exact if_pos hm refine (if_neg hm).trans ?_ by_cases h : (nu.toNat - t.toNat) % 2 = 1 ·exact (dif_pos h).trans ((pkU_pk V P vo nu hs hV relu ok hh n X W b xo st o q0 so mu acc hm _ _ _ _ _ _ _ _ _ _ _ _ _).trans (pk_s V P vo nu hs hV t i hi a0 a1 a2 a3 a4 a5 a6 a7 relu ok hh n X W b xo st o q0 so mu acc hm (pkO h).1 (pkH hs hV hi (pkO h).1).2.2 _ _ _ _ _ _ _ _ _).symm) ·exact (dif_neg h).trans (pkU_pk V P vo nu hs hV relu ok hh n X W b xo st o q0 so mu acc hm _ t i hi _ a0 a1 a2 a3 a4 a5 a6 a7) @[specialize] def l2 (U V : Nat) (f : Nat → Nat → Array Word → Array Word) (u v : Nat) (a : Array Word) : Array Word := if u < U then if v < V then l2 U V f u (v + 1) (f u v a) else l2 U V f (u + 1) 0 a else a termination_by (U - u, V - v) theorem l2_spec (U V N : Nat) (f : Nat → Nat → Array Word → Array Word) (F : Nat → Word) (C : Nat → Nat → Nat → Prop) (hf : ∀ u v a, u < U → v < V → a.size = N → Iv F a (C u v) (f u v a)) (u v : Nat) (a : Array Word) : a.size = N → (∀ q, (∃ u' v', u' < U ∧ v' < V ∧ (u' < u ∨ u' = u ∧ v' < v) ∧ C u' v' q) → q < a.size → a[q]? = some (F q)) → (l2 U V f u v a).size = a.size ∧ ∀ q, (∃ u' v', u' < U ∧ v' < V ∧ C u' v' q) → q < a.size → (l2 U V f u v a)[q]? = some (F q) := by induction u, v, a using l2.induct U V f with | case1 u v a hu hv ih => intro hN ha; rw [l2, if_pos hu, if_pos hv] obtain ⟨hs, hq⟩ := hf u v a hu hv hN obtain ⟨i1, i2⟩ := ih (by clear*-hN hs;omega) fun q ⟨u', v', h1, h2, h3, h4⟩ hq' => by have hq2 : q < a.size := by omega by_cases e : u' = u ∧ v' = v ·obtain ⟨rfl, rfl⟩ := e; exact (hq q).2 h4 hq2 ·have := ha q ⟨u', v', h1, h2, by omega, h4⟩ hq2 rcases (hq q).1 with h | h ·rw [h, this] ·exact h exact ⟨i1.trans hs, fun q hc hq' => i2 q hc (by clear*-hq' hs;omega)⟩ | case2 u v a hu hv ih => intro hN ha; rw [l2, if_pos hu, if_neg hv] exact ih hN fun q ⟨u', v', h1, h2, h3, h4⟩ hq' => ha q ⟨u', v', h1, h2, by omega, h4⟩ hq' | case3 u v a hu => intro hN ha; rw [l2, if_neg hu] exact ⟨rfl, fun q ⟨u', v', h1, h2, h4⟩ hq' => ha q ⟨u', v', h1, h2, by omega, h4⟩ hq'⟩ theorem l2_fin (U V N : Nat) (f : Nat → Nat → Array Word → Array Word) (F : Nat → Word) (C : Nat → Nat → Nat → Prop) (hf : ∀ u v a, u < U → v < V → a.size = N → Iv F a (C u v) (f u v a)) (hc : ∀ q, q < N → ∃ u v, u < U ∧ v < V ∧ C u v q) : l2 U V f 0 0 (Array.replicate N 0) = Array.ofFn (n := N) fun q => F q.val := by obtain ⟨h1, h2⟩ := l2_spec U V N f F C hf 0 0 (Array.replicate N 0) (by simp) fun q ⟨u', v', _, _, h, _⟩ _ => by omega apply Array.ext_getElem?; intro q by_cases hq : q < N ·obtain ⟨u, v, hu, hv, hC⟩ := hc q hq rw [h2 q ⟨u, v, hu, hv, hC⟩ (by simpa using hq), Array.getElem?_ofFn]; simp [hq] ·simp_all structure PD where Q : FloatArray B : FloatArray bw : Array Word e : Word eb : Word def pd (W b : Array Word) (n : Nat) : PD := let ow := W.size / n let G := (ow + 7) / 8 let bw := if b.isEmpty then Array.replicate ow 0x80000000 else b ⟨qL W n.toUSize (8 * n).toUSize n G 0 (zT (n * G + 1)), bld (fun o => dw oneW * rX bw o.toUSize) (8 * G) (FloatArray.emptyWithCapacity (8 * G)), bw, emx W 0 0, emx bw 0 0⟩ def oF (t : Bool) (R n ow : Nat) (relu : Bool) (X W b : Array Word) (q : Nat) : Word := act relu (dotOf (n + 1) (fun s => if s < n then X[if t then q % R + s * R else q / ow * n + s]! else oneW) (fun s => if s < n then W[(if t then q / R else q % ow) * n + s]! else b[if t then q / R else q % ow]!)) theorem ts {a S : Nat} (h : a ≤ S) (hS : S < 2 ^ 32) : a.toUSize.toNat = a := toUSize_toNat (by have := USize.le_size; omega) @[inline] def stp (u t : Bool) (R n ow : Nat) (relu : Bool) (X W bw : Array Word) (Y Q B : FloatArray) (F : Float) (hb e6 : UInt64) (eok : Bool) (hs : Y.size < 2 ^ 32 ∧ Q.size < 2 ^ 32) (hB : B.size < 2 ^ 32) (g r : Nat) (a : Array Word) : Array Word := let vo := r * (n + 1) let o := 8 * g if h : vo + n < Y.size ∧ o * n + 1 + 8 * n ≤ Q.size ∧ o + 8 ≤ B.size then have hn : n.toUSize.toNat = n := ts (by omega) hs.1 have hv : vo.toUSize.toNat = vo := ts (by omega) hs.1 have hb8 : o.toUSize.toNat + 8 ≤ B.size := by rw [ts (by omega) hB]; exact h.2.2 let bo := o.toUSize let p := e6 + 23 + cE F (Y.uget (vo + n).toUSize (by rw [ts (by omega) hs.1]; exact h.1)) (if u then pkW else pk) Y Q vo.toUSize n.toUSize hs (by rw [hv, hn]; omega) 0 (o * n + 1).toUSize (by rw [ts (by omega) hs.2, hn]; simp only [USize.toNat_zero, Nat.sub_zero]; omega) (B.uget (bo + 0) (uk (by simp) hb8 hB)) (B.uget (bo + 1) (uk (by simp) hb8 hB)) (B.uget (bo + 2) (uk (by simp) hb8 hB)) (B.uget (bo + 3) (uk (by simp) hb8 hB)) (B.uget (bo + 4) (uk (by simp) hb8 hB)) (B.uget (bo + 5) (uk (by simp) hb8 hB)) (B.uget (bo + 6) (uk (by simp) hb8 hB)) (B.uget (bo + 7) (uk (by simp) hb8 hB)) relu (eok && p ≤ 400) (if p < hb then hb else p) n X W bw (if t then r else r * n) (if t then R else 1) o (if t then o * R + r else r * ow + o).toUSize (if t then R else 1).toUSize (min 8 (ow - o)).toUSize a else a theorem cR (X : Array Word) (n : Nat) (hn : n < 2 ^ 29) (hx : ∀ q : Nat, expOf X[q]! ≠ 255) (f : Nat → Nat) (g : Nat → Float) (hg : ∀ τ < n, g τ = dw X[f τ]!) : 9 * ((n : ℝ) + 1) * (∑ τ ∈ Finset.range n, |rv (dw X[f τ]!)|) * (1 - 2 ^ (-20 : Int)) ≤ 2 ^ (((cE (9 * (n + 1)).toUInt64.toInt64.toFloat (sfold (fun τ => (g τ).abs) n 0 0)).toNat : Int) + 56) + 2 ^ (-900 : Int) := by have h0 : 0 ≤ ∑ τ ∈ Finset.range n, |rv (dw X[f τ]!)| := Finset.sum_nonneg fun _ _ => abs_nonneg _ have h1 : ∑ τ ∈ Finset.range n, |rv (dw X[f τ]!)| ≤ 2 ^ (400 : Int) := by refine (Finset.sum_le_sum fun τ _ => dwB _ (hx _)).trans ?_ have : (n : ℝ) ≤ 2 ^ 29 := by exact_mod_cast hn.le rw [Finset.sum_const, Finset.card_range, nsmul_eq_mul] calc (n : ℝ) * 2 ^ (277 : Int) ≤ 2 ^ 29 * 2 ^ (277 : Int) := by gcongr _ ≤ 2 ^ (400 : Int) := by rw [← zpow_natCast, ← zpow_add₀ two_ne_zero]; exact zpow_le_zpow_right₀ (by norm_num) (by norm_num) obtain ⟨fa, ea⟩ := sfR (fun τ => (g τ).abs) (fun τ => |rv (dw X[f τ]!)|) 0 n (fun τ hτ => by rw [hg τ hτ]; exact fabs _ (dwV _ (hx _)).1) (by omega) (by simpa using h1.trans (zpow_le_zpow_right₀ (by norm_num) (by norm_num : (400 : ℤ) ≤ 968))) n 0 0 rfl (Nat.zero_le _) f0.1 (by simp [f0.2]) simp only [abs_zero, zero_add, abs_abs] at ea exact cE_spec n hn _ _ fa h0 h1 ea theorem stp_spec (u t : Bool) (R n ow : Nat) (relu : Bool) (X W bw : Array Word) (Y Q B : FloatArray) (F : Float) (hb e6 : UInt64) (eok : Bool) (hs : Y.size < 2 ^ 32 ∧ Q.size < 2 ^ 32) (hB : B.size < 2 ^ 32) (e : Word) (ib IB L : Nat) (hLd : L = Nat.log2 (n + 1) + 1) (he6 : e6 = if e.toUInt64 < 56 then 56 else e.toUInt64) (hok : eok = decide (e < 255)) (hF : F = (9 * (n + 1)).toUInt64.toInt64.toFloat) (hhb : hb = (ib + L - 50).toUInt64) (hx : ∀ q : Nat, expOf X[q]! ≠ 255) (hbq : ∀ q : Nat, expOf bw[q]! ≠ 255 ∧ idxOf bw[q]! ≤ IB) (hib : 174 + IB ≤ ib) (hL : n + 2 ≤ 2 ^ L) (hL27 : L ≤ 27) (hibL : ib + L ≤ 425) (hn : 8 * n < 2 ^ 32) (he : ∀ q : Nat, (expOf W[q]!).toNat ≤ e.toNat) (hYs : R * (n + 1) ≤ Y.size) (hY1 : ∀ j < R, ∀ τ < n, Y.data[j * (n + 1) + τ]! = dw X[(if t then j else j * n) + τ * (if t then R else 1)]!) (hY2 : ∀ j < R, 9 * ((n : ℝ) + 1) * (∑ τ ∈ Finset.range n, |rv (dw X[(if t then j else j * n) + τ * (if t then R else 1)]!)|) * (1 - 2 ^ (-20 : Int)) ≤ 2 ^ (((cE F Y.data[j * (n + 1) + n]!).toNat : Int) + 56) + 2 ^ (-900 : Int)) (hQs : ∀ g < (ow + 7) / 8, 8 * g * n + 1 + 8 * n ≤ Q.size) (hQ : ∀ g < (ow + 7) / 8, ∀ τ < n, ∀ r < 8, Q.data[8 * g * n + 1 + 8 * τ + r]! = dw W[(8 * g + r) * n + τ]!) (hBs : 8 * ((ow + 7) / 8) ≤ B.size) (hB1 : ∀ o < ow, B.data[o]! = dw oneW * dw bw[o]!) (hsz : R * ow + 9 * R + ow + 8 ≤ 4294967295) (g r : Nat) (hg : g < (ow + 7) / 8) (hr : r < R) (a : Array Word) (ha : a.size = R * ow) : Iv (oF t R n ow relu X W bw) a (fun q => ∃ k, k < 8 ∧ 8 * g + k < ow ∧ q = if t then (8 * g + k) * R + r else r * ow + (8 * g + k)) (stp u t R n ow relu X W bw Y Q B F hb e6 eok hs hB g r a) := by subst hLd he6 hok hF hhb have ul := USize.le_size have hoo : 8 * g < ow := by clear*-hg;omega have h1 : r * (n + 1) + n < Y.size := by have := Nat.mul_le_mul_right (n + 1) hr; rw [Nat.succ_mul] at this; clear*-hYs this;omega have h2 := hQs g hg have h3 : 8 * g + 8 ≤ B.size := by clear*-hBs hg;omega have hnu : n.toUSize.toNat = n := ts (by clear*-h1;omega) hs.1 have hvo : (r * (n + 1)).toUSize.toNat = r * (n + 1) := ts (by clear*-h1;omega) hs.1 have hoU : (8 * g).toUSize.toNat = 8 * g := ts (by clear*-h3;omega) hB have hoi : (8 * g * n + 1).toUSize.toNat = 8 * g * n + 1 := ts (by clear*-h2;omega) hs.2 have hBk : ∀ (c : USize) (m : Nat) (hc : c.toNat = m) (hm : m < 8) (hh : ((8 * g).toUSize + c).toNat < B.size) (ho : 8 * g + m < ow), B.uget ((8 * g).toUSize + c) hh = dw oneW * dw bw[8 * g + m]! := fun c m hc hm hh ho => by rw [ug, uadd (by clear*-hc ho hoU hsz ul;omega), hoU, hc, hB1 _ ho] have hY0 : ∀ h, Y.uget (r * (n + 1) + n).toUSize h = Y.data[r * (n + 1) + n]! := fun h => by rw [ug, ts h1.le hs.1] have m1 : 8 * g * R ≤ ow * R := Nat.mul_le_mul_right R hoo.le have m2 : r * ow ≤ R * ow := Nat.mul_le_mul_right ow hr.le have cm : ow * R = R * ow := Nat.mul_comm _ _ have hq0 : (if t then 8 * g * R + r else r * ow + 8 * g).toUSize.toNat = if t then 8 * g * R + r else r * ow + 8 * g := toUSize_toNat (by cases t <;> simp only [Bool.false_eq_true, ↓reduceIte] <;> (clear*-cm hoo hr hsz m1 m2 ul;omega)) have hsu : (if t then R else 1).toUSize.toNat = if t then R else 1 := toUSize_toNat (by cases t <;> simp only [Bool.false_eq_true, ↓reduceIte] <;> (clear*-hsz ul;omega)) have hmu : (min 8 (ow - 8 * g)).toUSize.toNat = min 8 (ow - 8 * g) := toUSize_toNat (by clear*-ul;omega) have hI : ∀ k, (if t then 8 * g * R + r else r * ow + 8 * g) + k * (if t then R else 1) = if t then (8 * g + k) * R + r else r * ow + (8 * g + k) := fun k => by cases t <;> simp only [Bool.false_eq_true, ↓reduceIte, Nat.mul_one, Nat.add_mul] <;> (clear*-;omega) have dm : ∀ a c m : Nat, c < m → (a * m + c) / m = a ∧ (a * m + c) % m = c := fun a c m h => ⟨by rw [Nat.add_comm, Nat.add_mul_div_right _ _ (by clear*-h;omega), Nat.div_eq_of_lt h, Nat.zero_add], by rw [Nat.add_comm, Nat.add_mul_mod_self_right, Nat.mod_eq_of_lt h]⟩ unfold stp; dsimp only rw [show (if u then pkW else pk) = pk from (congrArg (fun g => if u then g else pk) pkW_eq_pk).trans (ite_self pk)] rw [dif_pos ⟨h1, h2, h3⟩, pk_eq _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ (8 * g * n + 1) _ _ _ _ _ _ _ _ _ _ _ _ rfl (by rw [hoi]; simp)] simp only [hY0, hnu, hvo, USize.toNat_zero] refine lr8h_mono _ _ _ _ _ (fun q ⟨k, hk, hok, hq⟩ => ⟨k, hk, ?_, ?_⟩) (fP_spec _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ a _ ?_ (by clear*-ha hsz;omega) fun k hk hk' => ?_) ·rw [hq0, hsu]; cases t <;> simp only [Bool.false_eq_true, ↓reduceIte] <;> (clear*-cm hoo hr hsz m1 m2;omega) rotate_left ·rw [hmu]; clear*-hk hok hoo;omega ·rw [hq0, hsu, hI]; exact hq rw [hmu] at hk' have hok : 8 * g + k < ow := by clear*-hk hk';omega rw [hq0, hsu, hI] have hA : A8.f ⟨sfold (pp Y Q (r * (n + 1)) (8 * g * n + 1) 0) n 0 (B.uget ((8 * g).toUSize + 0) (uk (by simp) (by rw [hoU]; exact h3) hB)), sfold (pp Y Q (r * (n + 1)) (8 * g * n + 1) 1) n 0 (B.uget ((8 * g).toUSize + 1) (uk (by simp) (by rw [hoU]; exact h3) hB)), sfold (pp Y Q (r * (n + 1)) (8 * g * n + 1) 2) n 0 (B.uget ((8 * g).toUSize + 2) (uk (by simp) (by rw [hoU]; exact h3) hB)), sfold (pp Y Q (r * (n + 1)) (8 * g * n + 1) 3) n 0 (B.uget ((8 * g).toUSize + 3) (uk (by simp) (by rw [hoU]; exact h3) hB)), sfold (pp Y Q (r * (n + 1)) (8 * g * n + 1) 4) n 0 (B.uget ((8 * g).toUSize + 4) (uk (by simp) (by rw [hoU]; exact h3) hB)), sfold (pp Y Q (r * (n + 1)) (8 * g * n + 1) 5) n 0 (B.uget ((8 * g).toUSize + 5) (uk (by simp) (by rw [hoU]; exact h3) hB)), sfold (pp Y Q (r * (n + 1)) (8 * g * n + 1) 6) n 0 (B.uget ((8 * g).toUSize + 6) (uk (by simp) (by rw [hoU]; exact h3) hB)), sfold (pp Y Q (r * (n + 1)) (8 * g * n + 1) 7) n 0 (B.uget ((8 * g).toUSize + 7) (uk (by simp) (by rw [hoU]; exact h3) hB))⟩ k = sfold (pp Y Q (r * (n + 1)) (8 * g * n + 1) k) n 0 (dw oneW * dw bw[8 * g + k]!) := by interval_cases k <;> (simp only [A8.f]; exact congrArg (sfold _ n 0) (hBk _ _ (by simp only [USize.reduceToNat]) (by omega) _ hok)) rw [hA] simp only [hvo] have hpp : ∀ s < n, expOf W[(8 * g + k) * n + s]! ≠ 255 → fv (pp Y Q (r * (n + 1)) (8 * g * n + 1) k s) ∧ rv (pp Y Q (r * (n + 1)) (8 * g * n + 1) k s) = Core.tm X[(if t then r else r * n) + s * (if t then R else 1)]! W[(8 * g + k) * n + s]! := fun s hs' h => by rw [pp, gg, gg, hY1 r hr s hs', hQ g hg s hs' k hk]; exact pvV _ _ (hx _) h have hk0 : cellFB n relu X W bw (if t then r else r * n) (if t then R else 1) (8 * g + k) = act relu (dotOf (n + 1) (fun s => if s < n then X[(if t then r else r * n) + s * (if t then R else 1)]! else oneW) (fun s => if s < n then W[(8 * g + k) * n + s]! else bw[8 * g + k]!)) := cellFB_eq _ _ _ _ _ _ _ _ refine (pw3 relu n (fun s => X[(if t then r else r * n) + s * (if t then R else 1)]!) (fun s => W[(8 * g + k) * n + s]!) bw[8 * g + k]! (pp Y Q (r * (n + 1)) (8 * g * n + 1) k) ib IB _ e _ _ _ (fun _ => cellFB n relu X W bw (if t then r else r * n) (if t then R else 1) (8 * g + k)) (fun _ => sQ n relu X W bw Y Q (r * (n + 1)) (8 * g * n + 1) k (if t then r else r * n) (if t then R else 1) (8 * g + k)) (fun s _ => hx _) (hbq _) hib hL hL27 hibL hn hpp rfl (fun s _ => he _) (hY2 r hr) (Nat.le_trans (cE_le _ _) (by decide : 969 ≤ 1000)) ?_ hk0 (fun hw => ?_)).trans ?_ ·rw [Nat.toUInt64_eq, UInt64.toNat_ofNat_of_lt' (by simp only [UInt64.size]; clear*-hibL;omega)] ·refine tS_eq _ _ _ _ _ _ _ _ (fun s hs' => ?_) ?_ (fun s _ => ?_) hL hL27 hk0 ·simpa only [if_pos hs'] using hpp s hs' (hw s hs') ·simpa only [lt_irrefl, ↓reduceIte] using pvV oneW bw[8 * g + k]! (by decide) (hbq _).1 ·by_cases h : s < n <;> simp only [h, ↓reduceIte] exacts [⟨hx _, hw s h⟩, ⟨by decide, (hbq _).1⟩] ·unfold oF cases t ·obtain ⟨d1, d2⟩ := dm r (8 * g + k) ow hok simp only [d1, d2, Bool.false_eq_true, ↓reduceIte, Nat.mul_one] ·obtain ⟨d1, d2⟩ := dm (8 * g + k) r R hr simp only [d1, d2, ↓reduceIte] @[inline] def runY (u t : Bool) (R n ow : Nat) (relu : Bool) (X W : Array Word) (d : PD) (ex : Word) (Y : FloatArray) : Array Word := let L := Nat.log2 (n + 1) + 1 let ib := 174 + (d.eb.toNat - 1) if h : ex < 255 ∧ d.eb < 255 ∧ ib + L ≤ 425 ∧ L ≤ 27 ∧ 0 < n ∧ 8 * n ≤ 4294967295 ∧ X.size ≤ 4294967295 ∧ ow * n ≤ W.size ∧ 2 * W.size + 64 * n ≤ 4294967295 ∧ d.bw.size ≤ 4294967295 ∧ R * ow + 9 * R + ow + 8 ≤ 4294967295 ∧ R * (n + 1) + 8 ≤ 4294967295 ∧ R * (if t then 1 else n) + (n + 1) * (if t then R else 1) ≤ 4294967295 ∧ Y.size ≤ 4294967295 ∧ d.Q.size ≤ 4294967295 ∧ d.B.size ≤ 4294967295 then let e6 := d.e.toUInt64 l2 ((ow + 7) / 8) R (stp u t R n ow relu X W d.bw Y d.Q d.B (9 * (n + 1)).toUInt64.toInt64.toFloat (ib + L - 50).toUInt64 (if e6 < 56 then 56 else e6) (decide (d.e < 255)) ⟨lt32 h.2.2.2.2.2.2.2.2.2.2.2.2.2.1, lt32 h.2.2.2.2.2.2.2.2.2.2.2.2.2.2.1⟩ (lt32 h.2.2.2.2.2.2.2.2.2.2.2.2.2.2.2)) 0 0 (Array.replicate (R * ow) 0) else Array.ofFn (n := R * ow) fun q => cellFB n relu X W d.bw (if t then q.val % R else q.val / ow * n) (if t then R else 1) (if t then q.val / R else q.val % ow) @[inline] def run (u t : Bool) (R n ow : Nat) (relu : Bool) (X W : Array Word) (d : PD) (ex : Word) : Array Word := runY u t R n ow relu X W d ex (dO X (if t then R else 1).toUSize (if t then 1 else n).toUSize (n + 1).toUSize n R (0 : Nat).toUSize 0 (zT ((R * (n + 1) + 7) / 8))) theorem pd_spec (W b : Array Word) (n ow : Nat) (hn : 0 < n) (ho : ow * n ≤ W.size) (hs : 2 * W.size + 64 * n ≤ 4294967295) (hbw : (pd W b n).bw.size < 2 ^ 32) : (∀ g < (ow + 7) / 8, 8 * g * n + 1 + 8 * n ≤ (pd W b n).Q.size) ∧ (∀ g < (ow + 7) / 8, ∀ τ < n, ∀ r < 8, (pd W b n).Q.data[8 * g * n + 1 + 8 * τ + r]! = dw W[(8 * g + r) * n + τ]!) ∧ 8 * ((ow + 7) / 8) ≤ (pd W b n).B.size ∧ ∀ o < ow, (pd W b n).B.data[o]! = dw oneW * dw (pd W b n).bw[o]! := by have ul := USize.le_size have h1 : ow ≤ W.size / n := (Nat.le_div_iff_mul_le hn).2 ho have h2 : W.size / n * n ≤ W.size := Nat.div_mul_le_self _ _ have h2' : W.size / n ≤ W.size := Nat.div_le_self _ _ generalize hO : W.size / n = O at h1 h2 h2' have h3 : (O + 7) / 8 * (8 * n) ≤ W.size + 7 * n := by have : 8 * ((O + 7) / 8) * n ≤ (O + 7) * n := Nat.mul_le_mul_right n (by clear*-;omega) rw [Nat.add_mul] at this rw [show (O + 7) / 8 * (8 * n) = 8 * ((O + 7) / 8) * n by ac_rfl]; clear*-h2 this;omega have hG : (ow + 7) / 8 ≤ (O + 7) / 8 := by clear*-h1;omega obtain ⟨z1, -⟩ := zsz (n * ((O + 7) / 8) + 1) have hc : 8 * (n * ((O + 7) / 8) + 1) = (O + 7) / 8 * (8 * n) + 8 := by ring have h0 : (0 : Nat).toUSize.toNat = 0 := toUSize_toNat (by clear*-ul;omega) obtain ⟨q1, -, q3⟩ := qL_spec W n.toUSize (8 * n).toUSize n (toUSize_toNat (by clear*-hs ul;omega)) (toUSize_toNat (by clear*-hs ul;omega)) ((O + 7) / 8) (0 : Nat).toUSize (zT (n * ((O + 7) / 8) + 1)) (by rw [h0]; clear*-h3 hn hs;omega) (by rw [h0]; clear*-hc z1;omega) have hb1 := bld_spec (fun o => dw oneW * rX (pd W b n).bw o.toUSize) (8 * ((O + 7) / 8)) _ (FloatArray.emptyWithCapacity (8 * ((O + 7) / 8))) rfl (Nat.zero_le _) have eQ : (pd W b n).Q = qL W n.toUSize (8 * n).toUSize n ((O + 7) / 8) (0 : Nat).toUSize (zT (n * ((O + 7) / 8) + 1)) := by simp only [pd, hO]; rfl have eB : (pd W b n).B = bld (fun o => dw oneW * rX (pd W b n).bw o.toUSize) (8 * ((O + 7) / 8)) (FloatArray.emptyWithCapacity (8 * ((O + 7) / 8))) := by simp only [pd, hO] refine ⟨fun g hg => ?_, fun g hg τ hτ r hr => ?_, ?_, fun o ho' => ?_⟩ ·have := Nat.mul_le_mul_right (8 * n) (show g + 1 ≤ (O + 7) / 8 by clear*-hG hg;omega) rw [Nat.add_mul, Nat.one_mul] at this rw [eQ, q1, show 8 * g * n = g * (8 * n) by ac_rfl]; clear*-hc this z1;omega ·have := q3 g (by clear*-hG hg;omega) τ hτ r hr rw [h0, Nat.zero_add] at this rw [eQ, show 8 * g * n = g * (8 * n) by ac_rfl, this] congr 2; rw [Nat.add_mul, show 8 * g * n = g * (8 * n) by ac_rfl]; clear*-;omega ·rw [eB, hb1.1]; clear*-hG;omega ·rw [eB, hb1.2.2 o (Nat.zero_le _) (by clear*-h1 ho';omega)] rw [rX_eq _ hbw, toUSize_toNat (by clear*-h1 h2' ho' hs ul;omega)] theorem dp {c : Prop} [Decidable c] {α : Type} {a : c → α} {b : ¬c → α} {y : α} (h1 : ∀ h : c, a h = y) (h2 : ∀ h, b h = y) : dite c a b = y := by by_cases h : c ·rw [dif_pos h]; exact h1 h ·rw [dif_neg h]; exact h2 h theorem run_eq (u t : Bool) (R n ow : Nat) (relu : Bool) (X W b : Array Word) (ex : Word) (hex : ex = emx X 0 0) : run u t R n ow relu X W (pd W b n) ex = Array.ofFn (n := R * ow) fun q => oF t R n ow relu X W (pd W b n).bw q.val := by have ul := USize.le_size unfold run runY; dsimp only refine dp (fun h => ?_) fun _ => ?_ swap ·congr 1; funext q; unfold oF; cases t <;> simp only [cellFB_eq, Nat.mul_one, ↓reduceIte, Bool.false_eq_true] obtain ⟨g1, g2, g3, g4, g5, g6, g7, g8, g9, g10, g11, g12, g13, g14, g15, g16⟩ := h obtain ⟨P1, P2, P3, P4⟩ := pd_spec W b n ow g5 g8 g9 (lt32 g10) have hx := exF X (by clear*-g7 ul;omega) (hex ▸ g1) have hbq := exF (pd W b n).bw (by clear*-g10 ul;omega) g2 have he : ∀ q : Nat, (expOf W[q]!).toNat ≤ (pd W b n).e.toNat := fun q => by by_cases hq : q < W.size ·exact (emx_spec W (by clear*-g5 g9 ul;omega) _ 0 0 rfl).2 q (by simp) hq ·rw [getElem!_neg W q hq]; exact Nat.zero_le _ have hL : n + 2 ≤ 2 ^ (Nat.log2 (n + 1) + 1) := @Nat.lt_log2_self (n + 1) have hR1 : R ≤ R * (n + 1) := Nat.le_mul_of_pos_right _ (by clear*-g5;omega) obtain ⟨z1, z2⟩ := zsz ((R * (n + 1) + 7) / 8) have hZ : (zT ((R * (n + 1) + 7) / 8)).size < 2 ^ 32 := by rcases z2 with h | h <;> (clear*-g12 h;omega) have hsu : (if t then 1 else n) < 2 ^ 32 := by cases t <;> simp only [Bool.false_eq_true, ↓reduceIte] <;> (clear*-g5 g6;omega) have hst : (if t then R else 1) < 2 ^ 32 := by cases t <;> simp only [Bool.false_eq_true, ↓reduceIte] <;> (clear*-g11;omega) have K := dO_spec X (if t then R else 1).toUSize (if t then 1 else n).toUSize (n + 1).toUSize n (toUSize_toNat (by clear*-g5 g6 ul;omega)) (by clear*-g5 g6;omega) R (0 : Nat).toUSize 0 _ hZ (by simp only [USize.toNat_zero, Nat.zero_add]; clear*-z1;omega) simp only [USize.toNat_zero, Nat.zero_add] at K obtain ⟨K1, -, K3, K4⟩ := K have key : ∀ j < R, ∀ τ < n, rX X ((0 : Nat).toUSize + j.toUSize * (if t then 1 else n).toUSize + τ.toUSize * (if t then R else 1).toUSize) = dw X[(if t then j else j * n) + τ * (if t then R else 1)]! := fun j hj τ hτ => by have m1 := Nat.mul_le_mul_right (if t then 1 else n) hj.le have m2 := Nat.mul_le_mul_right (if t then R else 1) (show τ ≤ n + 1 by clear*-hτ;omega) rw [rX_eq X (by clear*-g7;omega), ix3 0 _ _ j τ hsu hst (by clear*-g11 hj;omega) (by clear*-g9 hτ;omega) (by clear*-g13 m1 m2;omega)] cases t <;> simp only [Bool.false_eq_true, ↓reduceIte, Nat.zero_add, Nat.mul_one] generalize dO X (if t then R else 1).toUSize (if t then 1 else n).toUSize (n + 1).toUSize n R (0 : Nat).toUSize 0 _ = Y at * refine l2_fin _ _ _ _ _ (fun g r q => ∃ k, k < 8 ∧ 8 * g + k < ow ∧ q = if t then (8 * g + k) * R + r else r * ow + (8 * g + k)) (fun g r a hg hr ha => stp_spec u t R n ow relu X W _ Y _ _ _ _ _ _ _ _ (pd W b n).e _ ((pd W b n).eb.toNat - 1) _ rfl rfl rfl rfl rfl (fun q => (hx q).1) hbq le_rfl hL g4 g3 (by clear*-g5 g6;omega) he (by clear*-K1 z1;omega) (fun j hj τ hτ => by rw [K3 j hj τ hτ, key j hj τ hτ]) (fun j hj => by rw [K4 j hj] exact cR X n (by clear*-g5 g6;omega) (fun q => (hx q).1) (fun τ => (if t then j else j * n) + τ * (if t then R else 1)) _ (fun τ hτ => key j hj τ hτ)) P1 P2 P3 P4 g11 g r hg hr a ha) fun q hq => ?_ have hw : 0 < ow := Nat.pos_of_ne_zero fun h => by subst h; simp at hq have hR : 0 < R := Nat.pos_of_ne_zero fun h => by subst h; simp at hq cases t ·have h1 := Nat.div_add_mod q ow have h2 := Nat.mod_lt q hw refine ⟨q % ow / 8, q / ow, by clear*-h2;omega, Nat.div_lt_of_lt_mul (by rwa [Nat.mul_comm]), q % ow % 8, by clear*-;omega, by clear*-h2;omega, ?_⟩ simp only [Bool.false_eq_true, ↓reduceIte]; rw [Nat.mul_comm (q / ow)]; clear*-h1;omega ·have h1 := Nat.div_add_mod q R have h2 := Nat.mod_lt q hR have h3 : q / R < ow := Nat.div_lt_of_lt_mul hq refine ⟨q / R / 8, q % R, by clear*-h3;omega, h2, q / R % 8, by clear*-;omega, by clear*-h3;omega, ?_⟩ simp only [↓reduceIte]; rw [show 8 * (q / R / 8) + q / R % 8 = q / R by clear*-;omega, Nat.mul_comm (q / R)]; clear*-h1;omega def tF (Q : FloatArray) : Nat → Nat → UInt64 → UInt64 | 0, _, c => c | k + 1, i, c => tF Q k (i + 8) (c + (Q.get! i).toBits) @[noinline] def tQ (d : PD) : UInt64 := tF d.Q ((d.Q.size + 7) / 8) 0 (tF d.B ((d.B.size + 7) / 8) 0 0) @[noinline] def TP : Sr.Tab pd := Sr.Tab.makeT pd 64 (2 ^ 22) tQ @[inline] def dget (W b : Array Word) (n : Nat) : PD := if W.size < 16 then pd W b n else (TP.get W b n).1 theorem dget_eq (W b : Array Word) (n : Nat) : dget W b n = pd W b n := by unfold dget; split ·rfl ·exact (TP.get W b n).2 @[inline] def linQ (u : Bool) (rows n ow : Nat) (relu : Bool) (X W b : Array Word) : Array Word := if 0 < ow ∧ b.size = ow then run u false rows n ow relu X W (dget W b n) (emx X 0 0) else linearSpec rows n ow relu X W b theorem linQ_eq (u : Bool) : linQ u = linearSpec := by funext rows n ow relu X W b unfold linQ; split; swap; · rfl rename_i h have hb : (pd W b n).bw = b := by have : b.isEmpty = false := by simp [Array.isEmpty, h.2]; omega simp [pd, this] rw [dget_eq, run_eq _ _ _ _ _ _ _ _ _ _ rfl, hb] unfold linearSpec linearWith oF simp only [Bool.false_eq_true, ↓reduceIte] @[inline] def gemmQ (u : Bool) (batch m k n : Nat) (A B : Array Word) : Array Word := let d := dget A #[] k let ex := emx B 0 0 if batch = 1 ∧ 0 < k ∧ m * k ≤ A.size ∧ d.e < 255 ∧ ex < 255 ∧ A.size ≤ 4294967295 ∧ B.size ≤ 4294967295 then run u true n k m false B A d ex else gemmSpec batch m k n A B theorem gemmQ_eq (u : Bool) : gemmQ u = gemmSpec := by funext batch m k n A B unfold gemmQ; dsimp only; split; swap; · rfl rename_i h obtain ⟨rfl, hk, h2, h3, h4, h5, h6⟩ := h rw [dget_eq] at h3 ⊢ have ul := USize.le_size have hx := F.exF B (by clear*-h6 ul;omega) h4 have hw := F.exF A (by clear*-h5 ul;omega) h3 rw [run_eq _ _ _ _ _ _ _ _ _ _ rfl] have hb : (pd A #[] k).bw = Array.replicate (A.size / k) 0x80000000 := by simp [pd] have hm : m ≤ A.size / k := (Nat.le_div_iff_mul_le hk).2 h2 unfold gemmSpec gemmWith refine Array.ext (by simp [Nat.mul_comm]) fun q h1 _ => ?_ simp only [Array.size_ofFn] at h1 have hq : q / n < m := Nat.div_lt_of_lt_mul h1 have hz : (pd A #[] k).bw[q / n]! = 0x80000000 := by rw [hb, getElem!_pos _ _ (by rw [Array.size_replicate]; clear*-hm hq;omega), Array.getElem_replicate] simp only [Array.getElem_ofFn, oF, ↓reduceIte, hz, act, Nat.div_eq_of_lt (show q < m * n by rwa [Nat.mul_comm]), Nat.mod_eq_of_lt hq, Nat.zero_mul, Nat.zero_add, Bool.false_eq_true] exact (F.dz k (fun t => A[q / n * k + t]!) (fun t => B[q % n + t * n]!) hk fun t _ => ⟨(hw _).1, (hx _).1⟩).trans (by simp only [Nat.add_comm (q % n)]) @[noinline] def linP0 (rows n ow : Nat) (relu : Bool) (X W b : Array Word) : Array Word := linQ false rows n ow relu X W b @[noinline] def linPA (rows n ow : Nat) (relu : Bool) (X W b : Array Word) : Array Word := linQ true rows n ow relu X W b @[noinline] def gemmP0 (batch m k n : Nat) (A B : Array Word) : Array Word := gemmQ false batch m k n A B @[noinline] def gemmPA (batch m k n : Nat) (A B : Array Word) : Array Word := gemmQ true batch m k n A B /-- CPU dispatch on the target triple, as in #202/#184: the unrolled `pkU` (via `pkW`) on aarch64, `pk` elsewhere. One branch per call; the arms are plain calls, so each copy keeps its constant `u`. -/ def isA : Bool := System.Platform.target.startsWith "aarch64" def linP (rows n ow : Nat) (relu : Bool) (X W b : Array Word) : Array Word := if isA then linPA rows n ow relu X W b else linP0 rows n ow relu X W b def gemmP (batch m k n : Nat) (A B : Array Word) : Array Word := if isA then gemmPA batch m k n A B else gemmP0 batch m k n A B theorem linP_eq : linP = linearSpec := by funext rows n ow relu X W b exact (congrArg (fun g => if isA then g true rows n ow relu X W b else g false rows n ow relu X W b) (funext linQ_eq)).trans (ite_self _) theorem gemmP_eq : gemmP = gemmSpec := by funext batch m k n A B exact (congrArg (fun g => if isA then g true batch m k n A B else g false batch m k n A B) (funext gemmQ_eq)).trans (ite_self _) end Pn end F end Dense namespace Conv open Core Finset variable (C E V S : UInt64) (y z : Word) (t : Bool) (P W : Array UInt32) (c h w k n : Nat) (Q : Word → Bool) (fa : Nat → Word) (bx : UInt64) (s : ConvShape) (J : Bool) (I K b : Array Word) (D : Bool) (nc Y : Nat) (r d : Word) (x : UInt64) (v : Int) (B a : UInt64) (m : Nat) (e j : USize) (bw : UInt64) (u : UInt32) {α : Type} theorem mo {a b : Nat} (h : a < b) : a % b = a := Nat.mod_eq_of_lt h theorem mr {a b : Nat} (h : a ∈ range b) : a < b := Finset.mem_range.mp h theorem fT : (false = true) = False := Bool.false_eq_true local instance : Inhabited Dense.F.A8 := ⟨⟨0, 0, 0, 0, 0, 0, 0, 0⟩⟩ theorem usz_ge : 2 ^ 32 ≤ 2 ^ System.Platform.numBits := by cases System.Platform.numBits_eq <;> simp [*] theorem l32 {n : Nat} (h : n < 2 ^ 32) : n % 2 ^ System.Platform.numBits = n := mo (lt_of_lt_of_le h usz_ge) theorem uszP (a : Array UInt32) : a.usize.toNat ≤ a.size := Nat.mod_le _ _ @[inline] def ok (w : UInt32) : Bool := expOf w != 255 && (mW w == 0 || iW w - E ≤ C) @[inline] def minIdx (a : Array UInt32) : UInt64 := a.foldl (fun m w => if mW w != 0 && iW w < m then iW w else m) 255 @[inline] def loOf (h l : UInt64) : UInt64 := (h <<< 25) + l @[inline] def hiOf (h l : UInt64) : UInt64 := ((h + 0x8000000000000000) >>> (39 : UInt64)) - (0x1000000 : UInt64) - (l >>> (63 : UInt64)) + (if loOf h l < l then (1 : UInt64) else 0) @[inline] def sg (m : UInt64) : UInt64 := if u >>> 31 != 0 then 0 - m else m @[specialize] def lp (H : Nat) (f : Nat → Nat → Array UInt32 → Array UInt32) : Nat → Nat → Nat → Array UInt32 → Array UInt32 | 0, _, _, a => a | n + 1, o, y, a => let a := f o y a if y + 1 < H then lp H f n o (y + 1) a else lp H f n (o + 1) 0 a @[specialize] def rop (f : Nat → USize → UInt32) (s : USize) (x : Nat) : Nat → USize → Array UInt32 → Array UInt32 | 0, _, a => a | m + 1, e, a => rop f s (x + 1) m (e + s) (a.push (f x e)) @[inline] def tri (O H W : Nat) (f : Nat → Nat → Nat → UInt32) : Array UInt32 := if 0 < H then lp H (fun o y => rop (fun x _ => f o y x) 0 0 W 0) (O * H) 0 0 (Array.emptyWithCapacity (O * (H * W))) else #[] theorem uL {a : Array UInt32} {i : USize} (h : i < a.usize) : i.toNat < a.size := (USize.lt_iff_toNat_lt.1 h).trans_le (uszP a) @[noinline] def fbk (kk k cb o y x : Nat) : Word := Dense.x2d (k + 1) (fun i => if i < k then windowAt s I y x (cb * kk + i) else oneW) (fun i => if i < k then K[o * k + i]! else b[o]!) def dS : Array Word := if D then depthwiseSpec s J I K b else conv2dSpec s J I K b def dF (s : ConvShape) (J : Bool) (I K b : Array Word) (D : Bool) : Array Word := if D then depthwiseWith Dense.x2d s J I K b else conv2dWith Dense.x2d s J I K b theorem dF_eq (s : ConvShape) (J : Bool) (I K b : Array Word) (D : Bool) : dF s J I K b D = dS s J I K b D := by unfold dF dS rw [show Dense.x2d = dotOf from funext fun n => funext fun fa => funext fun fb => Dense.x2d_eq n fa fb] rfl theorem dallNZ_false (a b : Array UInt32) : ∀ (c i j : Nat), i ≤ j → j < i + c → Bool.xor (signOf a[j]!) (signOf b[j]!) = false → dallNZ a b i c = false := by intro c induction c with | zero => intro i j h1 h2; omega | succ c ih => intro i j h1 h2 hx rw [dallNZ] by_cases hj : j = i ·subst hj; rw [hx]; simp ·rw [ih (i + 1) j (by omega) (by omega) hx]; simp def zwin (s : ConvShape) (I K : Array Word) (kk k cb o y x : Nat) : Nat → Nat → Bool | _, 0 => true | i, c + 1 => ((windowAt s I y x (cb * kk + i) == 0 || windowAt s I y x (cb * kk + i) == 0x80000000) && expOf K[o * k + i]! != 255) && zwin s I K kk k cb o y x (i + 1) c theorem zwin_spec (s : ConvShape) (I K : Array Word) (kk k cb o y x : Nat) : ∀ (c i : Nat), zwin s I K kk k cb o y x i c = true → ∀ j, i ≤ j → j < i + c → (windowAt s I y x (cb * kk + j) = 0 ∨ windowAt s I y x (cb * kk + j) = 0x80000000) ∧ expOf K[o * k + j]! ≠ 255 := by intro c induction c with | zero => intro i _ j h1 h2; omega | succ c ih => intro i h j h1 h2 rw [zwin] at h simp only [Bool.and_eq_true, Bool.or_eq_true, beq_iff_eq, bne_iff_ne, ne_eq] at h by_cases hj : j = i ·subst hj; exact h.1 ·exact ih (i + 1) h.2 j (by omega) (by omega) @[noinline] def fbz (s : ConvShape) (I K b : Array Word) (kk k cb o y x : Nat) : Word := if b[o]! == 0 && zwin s I K kk k cb o y x 0 k then 0 else fbk s I K b kk k cb o y x theorem fbz_eq (s : ConvShape) (I K b : Array Word) (kk k cb o y x : Nat) : fbz s I K b kk k cb o y x = fbk s I K b kk k cb o y x := by unfold fbz split ·rename_i h simp only [Bool.and_eq_true, beq_iff_eq] at h obtain ⟨hb, hz⟩ := h have hzs := zwin_spec s I K kk k cb o y x k 0 hz unfold fbk rw [Dense.x2d_eq] have hfin : Core.finAll (k + 1) (fun i => if i < k then windowAt s I y x (cb * kk + i) else oneW) (fun i => if i < k then K[o * k + i]! else b[o]!) := by intro j hj by_cases hjk : j < k ·simp only [if_pos hjk] obtain ⟨h1, h2⟩ := hzs j (Nat.zero_le _) (by omega) exact ⟨by rcases h1 with h | h <;> rw [h] <;> decide, h2⟩ ·simp only [if_neg hjk, hb]; exact ⟨by decide, by decide⟩ have hsum : Core.tsum (k + 1) (fun i => if i < k then windowAt s I y x (cb * kk + i) else oneW) (fun i => if i < k then K[o * k + i]! else b[o]!) = 0 := by unfold Core.tsum refine Finset.sum_eq_zero fun j _ => ?_ by_cases hjk : j < k ·simp only [if_pos hjk] obtain ⟨h1, -⟩ := hzs j (Nat.zero_le _) (by omega) have h0 : sv (windowAt s I y x (cb * kk + j)) = 0 := by rcases h1 with h | h <;> rw [h] <;> decide simp [Core.tm, h0] ·simp only [if_neg hjk, hb] have h0 : sv (0 : Word) = 0 := by decide simp [Core.tm, h0] rw [Core.dotOf_val _ _ _ hfin, hsum] have hnz : dallNZ (Array.ofFn (n := k + 1) fun i : Fin (k + 1) => if i.val < k then windowAt s I y x (cb * kk + i.val) else oneW) (Array.ofFn (n := k + 1) fun i : Fin (k + 1) => if i.val < k then K[o * k + i.val]! else b[o]!) 0 (k + 1) = false := by refine dallNZ_false _ _ (k + 1) 0 k (Nat.zero_le _) (by omega) ?_ rw [getElem!_ofFn (k + 1) (fun i => if i < k then windowAt s I y x (cb * kk + i) else oneW) k (Nat.lt_succ_self k), getElem!_ofFn (k + 1) (fun i => if i < k then K[o * k + i]! else b[o]!) k (Nat.lt_succ_self k)] simp only [if_neg (Nat.lt_irrefl k), hb]; decide rw [hnz]; simp [finishWord] ·rfl @[inline] def sk : UInt32 := if u < 0x80000000 then u + 0x80000000 else if u == 0x80000000 then 0x80000000 else 0xFFFFFFFF - u @[inline] def mx : Word := if expOf y ≠ 255 ∧ expOf z ≠ 255 ∧ (sk y < sk z ∨ sk z < sk y ∨ y = z) then (if sk y < sk z then z else y) else toWord (Model.maximum (ofW y) (ofW z)) @[specialize] def wl {α : Type} (g : α → Word → α) (I : Array Word) (w k : Nat) : Nat → Nat → Nat → α → α | 0, _, _, acc => acc | n + 1, i, dx, acc => let acc := g acc I[i]! if dx + 1 < k then wl g I w k n (i + 1) (dx + 1) acc else wl g I w k n (i + w + 1 - k) 0 acc @[inline] def divq : Word := let q := expOf d - 127 if fracOf d = 0 ∧ 127 ≤ expOf d ∧ q < expOf r ∧ expOf r < 255 then r - (q <<< 23) else if r &&& 0x7FFFFFFF = 0 then r else toWord (Model.div (ofW r) (ofW d)) @[inline] def t1 : UInt64 := sg u (mW u <<< (iW u - B)) @[reducible] def asum (f : Word → UInt64) := wl fun (a : UInt64) x => a + f x @[reducible] def wa := wl fun (b : Bool) x => b && Q x @[noinline] def afb (ch y x : Nat) : Word := dotOf (k * k) (poolAt h w k I ch y x) fun _ => oneW @[inline] def wo (A H : UInt64) (g : Unit → Bool) (fb : Unit → Word) (d : Word) : Word := if A = 0 ∧ H = 0 then (if g () then 0x80000000 else 0) else let r := Dense.fin128FZ (hiOf H A) (loOf H A) (B + 149) divq (if r < 0x100000000 then r.toUInt32 else fb ()) d @[inline] def key (w : Word) : UInt64 := if mW w != 0 then iW w else 255 @[inline] def all4 (x0 x1 x2 x3 : Word) : Bool := Q x0 && Q x1 && Q x2 && Q x3 @[inline] def eF (u : Word) : UInt64 := ((u >>> 23) &&& 0xFF).toUInt64 @[inline] def a2o (ch y x : Nat) (e : USize) : Word := let v := w.toUSize if hb : e < I.usize ∧ e + 1 < I.usize ∧ e + v < I.usize ∧ e + v + 1 < I.usize then let x0 := I.uget e (uL hb.1) let x1 := I.uget (e + 1) (uL hb.2.1) let x2 := I.uget (e + v) (uL hb.2.2.1) let x3 := I.uget (e + v + 1) (uL hb.2.2.2) let B := min (min (key x0) (key x1)) (min (key x2) (key x3)) if max (max (eF x0) (eF x1)) (max (eF x2) (eF x3)) ≤ min (B + 37) 254 then wo B (t1 B x0 + t1 B x1 + t1 B x2 + t1 B x3) 0 (fun _ => all4 (· == 0x80000000) x0 x1 x2 x3) (fun _ => afb h w 2 I ch y x) d else toWord (Model.div (ofW (afb h w 2 I ch y x)) (ofW d)) else toWord (Model.div (ofW (afb h w 2 I ch y x)) (ofW d)) def rseg (I : Array Word) (B : UInt64) (stop : USize) (hs : stop.toNat ≤ I.size) (e : USize) (acc : UInt64) : UInt64 := if h : e < stop then rseg I B stop hs (e + 1) (acc + t1 B (I.uget e (by have := USize.lt_iff_toNat_lt.mp h; (exact Nat.lt_of_lt_of_le h hs)))) else acc termination_by stop.toNat - e.toNat decreasing_by have := USize.lt_iff_toNat_lt.mp h; rw [Dense.usucc h]; (exact Nat.sub_succ_lt_self stop.toNat e.toNat h) @[inline] def gsum (I : Array Word) (B : UInt64) (w k U : Nat) : UInt64 := if h : 0 < k ∧ w = k ∧ U + k * k ≤ I.size ∧ U + k * k ≤ 4294967295 then rseg I B (U + k * k).toUSize (by have := USize.le_size; rw [Dense.toUSize_toNat (by omega)]; exact h.2.2.1) U.toUSize 0 else asum (t1 B) I w k (k * k) U 0 0 abbrev DQ : Prop := signOf d = false ∧ expOf d ≠ 0 ∧ expOf d < 255 @[inline] def cK (m : Nat) : UInt64 := if m ≤ 64 then 33 else if m ≤ 256 then 31 else if m ≤ 1024 then 29 else 25 def apool : Array Word := let d := natW (k * k) if 0 < k ∧ 0 < h / k ∧ 0 < w / k ∧ k * k < 16384 ∧ DQ d then if k = 2 ∧ c * h * w < 2 ^ 30 then lp (h / 2) (fun o y => rop (a2o h w I d o y) 2 0 (w / 2) ((o * h + y * 2) * w).toUSize) (c * (h / 2)) 0 0 (Array.emptyWithCapacity (c * (h / 2 * (w / 2)))) else let q := cK (k * k) let bx := minIdx I if bx ≤ 255 ∧ I.all (ok q bx) = true then tri c (h / k) (w / k) fun ch y x => let U := (ch * h + y * k) * w + x * k wo bx (gsum I bx w k U) 0 (fun _ => wa (· == 0x80000000) I w k (k * k) U 0 true) (fun _ => afb h w k I ch y x) d else tri c (h / k) (w / k) fun ch y x => let U := (ch * h + y * k) * w + x * k let B := wl (fun (m : UInt64) v => min m (key v)) I w k (k * k) U 0 255 if B ≤ 255 ∧ wa (ok q B) I w k (k * k) U 0 true = true then wo B (asum (t1 B) I w k (k * k) U 0 0) 0 (fun _ => wa (· == 0x80000000) I w k (k * k) U 0 true) (fun _ => afb h w k I ch y x) d else toWord (Model.div (ofW (afb h w k I ch y x)) (ofW d)) else avgpoolSpec c h w k I theorem svD : sval x = (x.toNat : Int) - 2 ^ 64 * (x.toNat / 2 ^ 63 : Nat) := by unfold sval; rw [BitVec.toInt_eq_toNat_cond, UInt64.toNat_toBitVec];have := x.toNat_lt split <;> omega theorem svc (h : (x.toNat : Int) ≡ v [ZMOD 2 ^ 64]) (h1 : -2 ^ 63 ≤ v) (h2 : v < 2 ^ 63) : sval x = v := by rw [svD]; have := x.toNat_lt; unfold Int.ModEq at h; omega def Z : ZMod (2 ^ 64) := x.toNat theorem modZ : (x.toNat : Int) ≡ v [ZMOD 2 ^ 64] ↔ Z x = v := by rw [Z, ← Int.cast_natCast (R := ZMod (2 ^ 64)), ZMod.intCast_eq_intCast_iff]; rfl theorem sZ (h : Z x = v) (h1 : -2 ^ 63 ≤ v) (h2 : v < 2 ^ 63) : sval x = v := svc x v ((modZ x v).mpr h) h1 h2 theorem Z_add (b : UInt64) : Z (a + b) = Z a + Z b := by simp [Z, UInt64.toNat_add] theorem Z_sub (b : UInt64) : Z (a - b) = Z a - Z b := eq_sub_of_add_eq (by rw [← Z_add, UInt64.sub_add_cancel]) theorem Z_zero : Z 0 = 0 := by simp [Z] theorem u255 {B : UInt64} (h : B ≤ 255) : B.toNat ≤ 255 := UInt64.le_iff_toNat_le.mp h def fxv (e : Nat) (w : UInt32) : Int := sv w * 2 ^ (idxOf w - e) theorem sv_zero (h : mantOf u = 0) : sv u = 0 := by simp [sv, h] theorem ok_spec (w : UInt32) (he : E.toNat ≤ 255) (hc : C.toNat ≤ 62) (h : ok C E w = true) : expOf w ≠ 255 ∧ (mantOf w = 0 ∨ (E.toNat ≤ idxOf w ∧ idxOf w ≤ E.toNat + C.toNat ∧ (iW w - E).toNat = idxOf w - E.toNat)) := by simp only [ok, Bool.and_eq_true, bne_iff_ne, ne_eq, Bool.or_eq_true, beq_iff_eq] at h;refine ⟨h.1, h.2.imp (fun h0 => ?_) fun h1 => ?_⟩ ·have := mW_toNat w; rw [h0] at this; simp at this; clear*-this;(exact Eq.symm ((fun {a b} => Nat.succ_inj.mp) (congrArg Nat.succ this))) ·have hi := iW_toNat w;have h2 := UInt64.le_iff_toNat_le.mp (of_decide_eq_true h1);have := idxOf_le w h.1;rw [UInt64.toNat_sub, hi] at h2 ⊢;clear hi;omega theorem cAdd (b : UInt64) : ((a + b).toNat : Int) ≡ (a.toNat : Int) + b.toNat [ZMOD 2 ^ 64] := by unfold Int.ModEq; rw [UInt64.toNat_add]; omega theorem cSub (b : UInt64) : ((a - b).toNat : Int) ≡ (a.toNat : Int) - b.toNat [ZMOD 2 ^ 64] := by have := b.toNat_lt; unfold Int.ModEq; rw [UInt64.toNat_sub]; omega theorem val128_hl (aH aL : UInt64) : val128 (hiOf aH aL) (loOf aH aL) = sval aH * 2 ^ 25 + sval aL := by have hA := aH.toNat_lt;have hB := aL.toNat_lt;have h0 : (loOf aH aL).toNat = ((aH.toNat % 2 ^ 39) * 2 ^ 25 + aL.toNat) % 2 ^ 64 := by unfold loOf;rw [UInt64.toNat_add, UInt64.toNat_shiftLeft];simp only [Nat.shiftLeft_eq, UInt64.toNat_ofNat, Nat.reducePow, Nat.reduceMod];omega have h3 : ((hiOf aH aL).toNat : Int) ≡ (aH.toNat / 2 ^ 39 : Nat) + (if aH.toNat < 2 ^ 63 then 0 else -2 ^ 25) - (aL.toNat / 2 ^ 63 : Nat) + (if loOf aH aL < aL then 1 else 0) [ZMOD 2 ^ 64] := by unfold hiOf refine (cAdd _ _).trans (Int.ModEq.add ((cSub _ _).trans (Int.ModEq.sub ((cSub _ _).trans ?_) (by rw [UInt64.toNat_shiftRight];simp only [Nat.shiftRight_eq_div_pow, UInt64.toNat_ofNat, Nat.reducePow, Nat.reduceMod];rfl))) ?_) ·rw [UInt64.toNat_shiftRight, UInt64.toNat_add]; simp only [Nat.shiftRight_eq_div_pow, UInt64.toNat_ofNat, Nat.reducePow, Nat.reduceMod]; unfold Int.ModEq; split <;> (clear h0 hB;omega) ·split <;> rfl unfold val128;rw [svc _ _ h3 (by clear * - hA hB; split_ifs <;> (clear hA;omega)) (by clear * - hA hB; split_ifs <;> (clear hB;omega)), svD, svD, h0] simp only [UInt64.lt_iff_toNat_lt, h0];clear * - hA hB;split_ifs <;> omega abbrev ofFnN (g : Nat → UInt32) : Array UInt32 := Array.ofFn (n := m) fun q => g q.val theorem ofFnN_push (g : Nat → UInt32) : (ofFnN m g).push (g m) = ofFnN (m + 1) g := by simp [ofFnN, Array.ofFn_succ] theorem decomp (o y x H W : Nat) (hy : y < H) (hx : x < W) : ((o * H + y) * W + x) / (H * W) = o ∧ ((o * H + y) * W + x) / W % H = y ∧ ((o * H + y) * W + x) % W = x := by obtain ⟨h1, h3⟩ := (Nat.div_mod_unique (a := (o * H + y) * W + x) (d := o * H + y) (Nat.zero_lt_of_lt hx)).2 ⟨by ring, hx⟩ obtain ⟨h4, h5⟩ := (Nat.div_mod_unique (a := o * H + y) (d := o) (Nat.zero_lt_of_lt hy)).2 ⟨by ring, hy⟩ exact ⟨by rw [Nat.mul_comm H W, ← Nat.div_div_eq_div_mul, h1, h4], by rw [h1, h5], h3⟩ theorem lp_inv (H : Nat) (f : Nat → Nat → Array UInt32 → Array UInt32) (S : Nat → Array UInt32 → Prop) (hf : ∀ o y a, y < H → S (o * H + y) a → S (o * H + y + 1) (f o y a)) : ∀ n o y a, y < H → S (o * H + y) a → S (o * H + y + n) (lp H f n o y a) := by intro n; induction n ·exact fun _ _ _ _ => id rename_i n ih; intro o y a hy h;have h1 := hf o y a hy h simp [lp]; split_ifs with h2 ·rw [show o * H + y + (n + 1) = o * H + (y + 1) + n by ring]; exact ih _ _ _ h2 h1 obtain rfl : H = y + 1 := by omega rw [show o * (y + 1) + y + (n + 1) = (o + 1) * (y + 1) + 0 + n by ring];exact ih _ _ _ (by (exact Nat.zero_lt_succ y)) (by rwa [show (o + 1) * (y + 1) + 0 = o * (y + 1) + y + 1 by ring]) theorem rop_eq (f : Nat → USize → UInt32) (g : Nat → UInt32) (s : USize) : ∀ m x e M, (∀ j < m, g (M + j) = f (x + j) (e + s * j.toUSize)) → rop f s x m e (ofFnN M g) = ofFnN (M + m) g := by intro m; induction m <;> intro x e M hg ·rfl rename_i m ih have h0 : g M = f x e := by simpa [show USize.ofNat 0 = 0 from rfl] using hg 0 (by (exact Nat.zero_lt_succ m)) rw [rop, ← h0, ofFnN_push, ih _ _ _ fun j hj => by rw [show M + 1 + j = M + (j + 1) by clear*-;(exact Nat.succ_add_eq_add_succ M j), hg _ (by (exact Nat.add_lt_add_right hj 1)), show x + (j + 1) = x + 1 + j by clear*-;(exact Eq.symm (Nat.succ_add_eq_add_succ x j)), show (j + 1).toUSize = j.toUSize + 1 from USize.ofNat_add j 1, USize.mul_add, USize.mul_one, USize.add_assoc, USize.add_comm (s * _)]]; congr 1; (exact Nat.succ_add_eq_add_succ M m) theorem lrop1 (H W n c : Nat) (s : USize) (E : Nat → Nat → USize) (F : Nat → Nat → Nat → USize → UInt32) (hH : 0 < H) : lp H (fun o y => rop (F o y) s 0 W (E o y)) n 0 0 (Array.emptyWithCapacity c) = ofFnN (n * W) fun q => F (q / (H * W)) (q / W % H) (q % W) (E (q / (H * W)) (q / W % H) + s * (q % W).toUSize) := by have := lp_inv H (fun o y => rop (F o y) s 0 W (E o y)) (fun k a => k ≤ n → a = ofFnN (W * k) fun q => F (q / (H * W)) (q / W % H) (q % W) (E (q / (H * W)) (q / W % H) + s * (q % W).toUSize)) (fun o y a hy ha hk => by rw [ha (by clear*-hk;(exact Nat.le_of_succ_le hk))]; exact rop_eq _ _ _ _ _ _ _ fun j hj => by simp [show W * (o * H + y) + j = (o * H + y) * W + j by ring, decomp o y j H W hy hj]) n 0 0 _ hH fun _ => rfl simpa [Nat.mul_comm W n] using this theorem wl_eq (g : α → Word → α) (I : Array Word) (w k U : Nat) : ∀ n dy dx acc, dx < k → wl g I w k n (U + dy * w + dx) dx acc = (List.range' (dy * k + dx) n).foldl (fun acc t => g acc I[U + t / k * w + t % k]!) acc := by intro n; induction n <;> intro dy dx acc h0 ·rfl rename_i ih; obtain ⟨e1, e2⟩ := (Nat.div_mod_unique (a := dy * k + dx) (d := dy) (by (exact Nat.zero_lt_of_lt h0))).2 ⟨by ring, h0⟩ rw [List.range'_succ, List.foldl_cons];simp only [wl, e1, e2] split_ifs with h ·exact ih dy (dx + 1) _ h obtain rfl : k = dx + 1 := by omega rw [show U + dy * w + dx + w + 1 - (dx + 1) = U + (dy + 1) * w + 0 by rw [Nat.add_one_mul]; omega, ih (dy + 1) 0 _ (by (exact Nat.zero_lt_succ dx))]; congr 2; ring theorem wl0 (g : α → Word → α) (I : Array Word) (w k U n : Nat) (acc : α) (hk : 0 < k) : wl g I w k n U 0 acc = (List.range n).foldl (fun acc t => g acc I[U + t / k * w + t % k]!) acc := by have := wl_eq g I w k U n 0 0 acc hk;simp [← List.range_eq_range'] at this; exact this theorem toUSize_toNat (h : n < 2 ^ 32) : n.toUSize.toNat = n := l32 h theorem Z_int : Z x = ((x.toNat : Int) : ZMod (2 ^ 64)) := by unfold Z; norm_cast theorem Z_sv : Z x = ((sval x : Int) : ZMod (2 ^ 64)) := (modZ x _).mp (by rw [svD]; unfold Int.ModEq; omega) theorem sg_sv (m : UInt64) (h : m.toNat < 2 ^ 62) : sval (sg u m) = if signOf u then -(m.toNat : Int) else m.toNat := by unfold sg; rw [shr31_ne] cases signOf u <;> simp only [fT, ite_true, ite_false] <;> refine sZ _ _ ?_ (by clear*-h;omega) (by clear*-h;omega) exacts [Z_int m, by rw [Z_sub, Z_zero, Z_int]; push_cast; ring] @[inline] def pW3 (s : ConvShape) (I : Array Word) (c y x : Nat) : Word := if c < s.cin ∧ 1 ≤ y ∧ y ≤ s.h ∧ 1 ≤ x ∧ x ≤ s.w then I[(c * s.h + (y - 1)) * s.w + (x - 1)]! else 0 theorem ugW (A : Array Word) (u : USize) (h : u.toNat < A.size) : A.uget u h = A[u.toNat]! := (getElem!_pos A _ h).symm theorem uj {p j n : USize} {S : Nat} (hS : S < 2 ^ 32) (hp : p.toNat + n.toNat ≤ S) (h : j < n) : (p + j).toNat < S := by have := USize.le_size; have := USize.lt_iff_toNat_lt.mp h; rw [Dense.uadd (by omega)]; omega theorem fus_sz (X : FloatArray) (i : USize) (v : Float) (h : i.toNat < X.size) : (X.uset i v h).size = X.size := by rcases X with ⟨d⟩; exact Array.size_uset .. theorem fus_g (X : FloatArray) (i : USize) (v : Float) (h : i.toNat < X.size) (q : Nat) (hq : q < X.size) : (X.uset i v h).data[q]! = if i.toNat = q then v else X.data[q]! := by rcases X with ⟨d⟩; change i.toNat < d.size at h; change q < d.size at hq change (d.uset i v h)[q]! = if i.toNat = q then v else d[q]! rw [Array.uset_eq_set, getElem!_pos _ _ (by simp; omega), Array.getElem_set]; split <;> simp [*, getElem!_pos] def fcU (I : Array Word) (p n d : USize) (hs : I.size < 2 ^ 32) (hp : p.toNat + n.toNat ≤ I.size) (j : USize) (X : FloatArray) (hd : d.toNat + n.toNat ≤ X.size ∧ X.size < 2 ^ 32) : FloatArray := if h : j < n then fcU I p n d hs hp (j + 1) (X.uset (d + j) (Dense.F.dw (I.uget (p + j) (uj hs hp h))) (uj hd.2 hd.1 h)) (by rw [fus_sz]; exact hd) else X termination_by n.toNat - j.toNat decreasing_by have := USize.lt_iff_toNat_lt.mp h; rw [Dense.usucc h]; (exact Nat.sub_succ_lt_self n.toNat j.toNat h) theorem fcU_spec (I : Array Word) (p n d : USize) (hs : I.size < 2 ^ 32) (hp : p.toNat + n.toNat ≤ I.size) : ∀ m (j : USize) (X : FloatArray) hd, n.toNat - j.toNat = m → (fcU I p n d hs hp j X hd).size = X.size ∧ ∀ q < X.size, (fcU I p n d hs hp j X hd).data[q]! = if d.toNat + j.toNat ≤ q ∧ q < d.toNat + n.toNat then Dense.F.dw I[p.toNat + (q - d.toNat)]! else X.data[q]! := by intro m; induction m <;> intro j X hd hm <;> rw [fcU] ·rw [dif_neg (by rw [USize.lt_iff_toNat_lt]; clear*-hm;omega)]; exact ⟨rfl, fun q _ => by rw [if_neg (by clear*-hm;omega)]⟩ rename_i m ih have h : j < n := USize.lt_iff_toNat_lt.mpr (by clear*-hm;(exact Nat.lt_of_sub_eq_succ hm)); have := USize.lt_iff_toNat_lt.mp h; have := USize.le_size rw [dif_pos h] refine (ih (j + 1) _ (by rw [fus_sz]; exact hd) (by rw [Dense.usucc h]; clear h hd hp hs ih this;omega)).imp (Eq.trans · (fus_sz ..)) fun e1 q hq => ?_ rw [e1 q (by rw [fus_sz]; exact hq), Dense.usucc h, fus_g _ _ _ _ _ hq, Dense.uadd (by clear e1 h hm hp hq hs ih;omega)] split_ifs <;> first | omega | (rw [ugW, Dense.uadd (by clear e1 h hd hm hq ih;omega)]; congr 2; clear e1 h hd hm hp hq hs ih this;omega) | rfl def RV (s : ConvShape) (r j : Nat) (p d : USize) (n : Nat) : Prop := r < s.h + 2 ∧ (∃ c, j = c * (s.h + 2) + r ∧ p.toNat = (c * s.h + (r - 1)) * s.w) ∧ d.toNat = j * (s.w + 2) ∧ (s.cin * (s.h + 2) + 3) * (s.w + 2) ≤ n ∧ n < 2 ^ 32 theorem rvC {s : ConvShape} {c r j : Nat} (hj : j < s.cin * (s.h + 2)) (hc : j = c * (s.h + 2) + r) : c < s.cin := Nat.lt_of_not_le fun h => by have := Nat.mul_le_mul_right (s.h + 2) h; omega theorem rvB {s : ConvShape} {r j n m : Nat} {p d : USize} (hI : s.cin * s.h * s.w ≤ m) (h : RV s r j p d n) (hj : j < s.cin * (s.h + 2)) (hr : 1 ≤ r ∧ r ≤ s.h) : p.toNat + s.w ≤ m ∧ (d + 1).toNat = j * (s.w + 2) + 1 ∧ j * (s.w + 2) + 1 + s.w ≤ n := by obtain ⟨-, ⟨c, hjc, hp⟩, hd, hn⟩ := h have := Nat.mul_le_mul_right s.h (rvC hj hjc) have e1 := Nat.mul_le_mul_right s.w (show c * s.h + (r - 1) + 1 ≤ s.cin * s.h by rw [Nat.add_one_mul] at this; clear*-hr this;omega) have e2 := Nat.mul_le_mul_right (s.w + 2) (show j + 1 ≤ s.cin * (s.h + 2) + 3 by clear*-hj;(exact Nat.le_add_right_of_le hj)) rw [Nat.add_one_mul] at e1 e2 have := USize.le_size exact ⟨by clear*-e1 hI hp;omega, by rw [Dense.uadd (by rw [USize.toNat_one]; clear*-e2 hd hn this;omega), USize.toNat_one, hd], by clear*-e2 hn;omega⟩ theorem rvS {s : ConvShape} {r j n : Nat} {p d wU VU : USize} (hw : wU.toNat = s.w) (hV : VU.toNat = s.w + 2) (hIw : s.cin * s.h * s.w < 2 ^ 32) (h : RV s r j p d n) (hj : j < s.cin * (s.h + 2)) : ((1 ≤ r ∧ r ≤ s.h) → RV s (r + 1) (j + 1) (p + wU) (d + VU) n) ∧ (¬(1 ≤ r ∧ r ≤ s.h) → RV s (if r + 1 = s.h + 2 then 0 else r + 1) (j + 1) p (d + VU) n) := by obtain ⟨hr, ⟨c, hjc, hp⟩, hd, hn⟩ := id h have := USize.le_size have e2 := Nat.mul_le_mul_right (s.w + 2) (show j + 1 ≤ s.cin * (s.h + 2) + 3 by clear*-hj;(exact Nat.le_add_right_of_le hj)) rw [Nat.add_one_mul] at e2 have hd' : (d + VU).toNat = (j + 1) * (s.w + 2) := by rw [Dense.uadd (by clear*-e2 hV hd hn this;omega), hd, hV, Nat.add_one_mul] refine ⟨fun hr' => ⟨by clear*-hr';omega, ⟨c, by clear*-hjc;(exact Nat.add_left_inj.mpr hjc), ?_⟩, hd', hn⟩, fun hr' => ⟨by split <;> (clear e2 h hIw hV hd hd' hj hjc hn hp hr' hw this;omega), ?_, hd', hn⟩⟩ ·have := (rvB le_rfl h hj hr').1 rw [Dense.uadd (by clear e2 h hV hd hd' hj hjc hn hp hr hr';omega), hp, hw, ← Nat.add_one_mul]; congr 1; clear*-hr';omega ·split ·exact ⟨c + 1, by rw [Nat.add_one_mul]; clear e2 h hIw hV hd hd' hj hn hp hr hr' hw this;omega, by rw [hp, Nat.add_one_mul]; congr 1; clear e2 h hIw hV hd hd' hj hjc hn hp hr hr' hw this;omega⟩ ·exact ⟨c, by clear*-hjc;(exact Nat.add_left_inj.mpr hjc), by rw [hp]; congr 2; clear e2 h hIw hV hd hd' hj hjc hn hp hw this;omega⟩ def fRV (I : Array Word) (s : ConvShape) (hs : I.size < 2 ^ 32) (hI : s.cin * s.h * s.w ≤ I.size) (wU VU : USize) (hw : wU.toNat = s.w) (hV : VU.toNat = s.w + 2) (G : Nat) (hG : G = s.cin * (s.h + 2)) (r j : Nat) (p d : USize) (X : FloatArray) (h : RV s r j p d X.size) : FloatArray := if hj : j < G then have hS := rvS hw hV (by (exact Nat.lt_of_le_of_lt hI hs)) h (hG ▸ hj) if hr : 1 ≤ r ∧ r ≤ s.h then have hb := rvB hI h (hG ▸ hj) hr have hp' : p.toNat + wU.toNat ≤ I.size := by rw [hw]; exact hb.1 have hd' : (d + 1).toNat + wU.toNat ≤ X.size ∧ X.size < 2 ^ 32 := ⟨by rw [hw, hb.2.1]; exact hb.2.2, h.2.2.2.2⟩ fRV I s hs hI wU VU hw hV G hG (r + 1) (j + 1) (p + wU) (d + VU) (fcU I p wU (d + 1) hs hp' 0 X hd') (by rw [(fcU_spec I p wU (d + 1) hs hp' _ 0 X hd' rfl).1]; exact hS.1 hr) else fRV I s hs hI wU VU hw hV G hG (if r + 1 = s.h + 2 then 0 else r + 1) (j + 1) p (d + VU) X (hS.2 hr) else X termination_by G - j theorem fRV_spec (I : Array Word) (s : ConvShape) (hs : I.size < 2 ^ 32) (hI : s.cin * s.h * s.w ≤ I.size) (wU VU : USize) (hw : wU.toNat = s.w) (hV : VU.toNat = s.w + 2) (G : Nat) (hG : G = s.cin * (s.h + 2)) : ∀ m r j p d (X : FloatArray) h N, X.size = N → G - j = m → (∀ q < N, X.data[q]! = if q < j * (s.w + 2) then Dense.F.dw (pW3 s I (q / ((s.h + 2) * (s.w + 2))) (q / (s.w + 2) % (s.h + 2)) (q % (s.w + 2))) else Dense.F.dw 0) → (fRV I s hs hI wU VU hw hV G hG r j p d X h).size = N ∧ ∀ q < N, (fRV I s hs hI wU VU hw hV G hG r j p d X h).data[q]! = Dense.F.dw (pW3 s I (q / ((s.h + 2) * (s.w + 2))) (q / (s.w + 2) % (s.h + 2)) (q % (s.w + 2))) := by intro m; induction m <;> intro r j p d X h N hN hm hX <;> rw [fRV] ·rw [dif_neg (by clear*-hm;omega)]; refine ⟨hN, fun q hq => ?_⟩ rw [hX q hq, pW3]; split; · rfl have := Nat.mul_le_mul_right (s.w + 2) (show s.cin * (s.h + 2) ≤ j by clear*-hG hm;omega) rw [if_neg (by rw [Nat.div_lt_iff_lt_mul (by positivity), ← Nat.mul_assoc]; clear h hG hI hN hV hX hm hq hs hw;omega)] rename_i m ih have hj : j < G := by clear*-hm;(exact Nat.lt_of_sub_eq_succ hm) obtain ⟨hr, ⟨c, rfl, hp⟩, -⟩ := id h have hc := rvC (hG ▸ hj) rfl have e5 := Nat.add_one_mul (c * (s.h + 2) + r) (s.w + 2) rw [dif_pos hj]; split <;> rename_i hr' on_goal 2 => refine ih _ _ _ _ _ _ _ hN (by clear*-hj hm;omega) fun q hq => ?_; rw [hX q hq] obtain ⟨b1, b2, b3⟩ := rvB hI h (hG ▸ hj) hr' obtain ⟨s1, e1⟩ := fcU_spec I p wU (d + 1) hs (by clear*-b1 hw;(exact le_of_eq_of_le (congrArg (HAdd.hAdd p.toNat) hw) b1)) _ 0 X ⟨by clear*-b2 b3 hw;omega, h.2.2.2.2⟩ rfl refine ih _ _ _ _ _ _ _ (s1.trans hN) (by clear*-hm;omega) fun q hq => ?_ rw [e1 q (by clear e1 hG hI hX hc hj hm hr hr' ih;(exact Nat.lt_of_lt_of_eq hq (id (Eq.symm hN)))), hX q hq, USize.toNat_zero] all_goals split_ifs <;> try first | omega | with_reducible rfl all_goals obtain ⟨x, rfl⟩ := Nat.exists_eq_add_of_le (show (c * (s.h + 2) + r) * (s.w + 2) ≤ q by omega); simp only [decomp c r x _ (s.w + 2) hr (by omega), pW3]; split_ifs <;> first | omega | with_reducible rfl | (congr 2; omega) theorem ugN (A : Array Nat) (u : USize) (h : u.toNat < A.size) : A.uget u h = A[u.toNat]! := (getElem!_pos A _ h).symm theorem cj {i : USize} {e M S : Nat} (hS : S < 2 ^ 32) (hi : i.toNat + M + 8 ≤ S) (he : e ≤ M) : (i + e.toUSize).toNat = i.toNat + e := by have := USize.le_size rw [Dense.uadd (by rw [Dense.toUSize_toNat (by omega)]; omega), Dense.toUSize_toNat (by omega)] theorem a8e (A B : Dense.F.A8) (h : ∀ r < 8, A.f r = B.f r) : A = B := by cases A; cases B; simp only [Dense.F.A8.mk.injEq] refine ⟨h 0 ?_, h 1 ?_, h 2 ?_, h 3 ?_, h 4 ?_, h 5 ?_, h 6 ?_, h 7 ?_⟩ <;> omega def mk8 (f : Nat → Float) : Dense.F.A8 := ⟨f 0, f 1, f 2, f 3, f 4, f 5, f 6, f 7⟩ theorem mk8_f (f : Nat → Float) (r : Nat) (hr : r < 8) : (mk8 f).f r = f r := by unfold mk8; interval_cases r <;> rfl @[inline] def pc (kk t : Nat) : Nat := if kk = 9 then t / 9 else t @[inline] def py (kk t : Nat) : Nat := if kk = 9 then t / 3 % 3 else 1 @[inline] def px (kk t : Nat) : Nat := if kk = 9 then t % 3 else 1 theorem py_le (kk t : Nat) : py kk t ≤ 2 := by unfold py; split <;> omega theorem px_le (kk t : Nat) : px kk t ≤ 2 := by unfold px; split <;> omega theorem pc_lt (kk t nc : Nat) (hk : kk = 9 ∨ kk = 1) (ht : t < nc * kk) : pc kk t < nc := by rcases hk with rfl | rfl <;> simp [pc] <;> omega abbrev geo (s : ConvShape) (kk : Nat) : Prop := s.kh = 3 ∧ s.kw = 3 ∧ s.stride = 1 ∧ s.pad = 1 ∧ kk = 9 ∨ s.kh = 1 ∧ s.kw = 1 ∧ s.stride = 1 ∧ s.pad = 0 ∧ kk = 1 theorem tV (kk nc HV V : Nat) : (Dense.F.ofA (fun t => pc kk t * HV + py kk t * V + px kk t) (nc * kk) (Array.emptyWithCapacity (nc * kk))).size = nc * kk ∧ ∀ t < nc * kk, (Dense.F.ofA (fun t => pc kk t * HV + py kk t * V + px kk t) (nc * kk) (Array.emptyWithCapacity (nc * kk)))[t]! = pc kk t * HV + py kk t * V + px kk t := by rw [Dense.F.ofA_eq] exact ⟨Array.size_ofFn, fun t ht => by rw [getElem!_pos _ _ (by simpa using ht), Array.getElem_ofFn]⟩ theorem tM (kk nc HV V : Nat) (hk : kk = 9 ∨ kk = 1) : ∀ t < nc * kk, (Dense.F.ofA (fun t => pc kk t * HV + py kk t * V + px kk t) (nc * kk) (Array.emptyWithCapacity (nc * kk)))[t]! ≤ (nc - 1) * HV + 2 * V + 2 := fun t ht => by rw [(tV kk nc HV V).2 t ht] have h1 := Nat.mul_le_mul_right HV (show pc kk t ≤ nc - 1 by have := pc_lt kk t nc hk ht; clear*-this;(exact Nat.le_sub_one_of_lt this)) have h2 := Nat.mul_le_mul_right V (py_le kk t) have h3 := px_le kk t clear hk ht;(exact Nat.add_le_add (Nat.add_le_add h1 h2) h3) structure CD where s : ConvShape I : Array Word K : Array Word b : Array Word X : FloatArray T : Array Nat D : Bool J : Bool k : Nat M : Nat L : Nat hh : UInt64 Y : Nat kk : Nat hX : X.size < 2 ^ 32 hK : Y * k ≤ K.size ∧ K.size < 2 ^ 32 def isArm : Bool := System.Platform.target.startsWith "aarch64" structure CC (M : Nat) where Tz : Array Nat Wz : FloatArray wo : Nat n : Nat h1 : n ≤ Tz.size h2 : wo + n ≤ Wz.size h3 : wo + n < 2 ^ 32 h4 : ∀ t < n, Tz[t]! ≤ M h5 : Wz.size < 2 ^ 32 @[noinline] def ow (d : @& CD) (o y x : @& Nat) (S : Float) : Word := Dense.F.tw d.J S d.hh d.L d.k (let q := (if d.D then o else 0) * ((d.s.h + 2) * (d.s.w + 2)) + y * (d.s.w + 2) + x; let ko := o * d.k fun t => d.X.get! (q + d.T[t]!) * Dense.F.dw d.K[ko + t]!) (fun _ => Dense.F.dw oneW * Dense.F.dw d.b[o]!) fun _ => act d.J (fbz d.s d.I d.K d.b d.kk d.k (if d.D then o else 0) o y x) @[inline] def act' (relu : Bool) (w : Word) : Word := if relu && w &&& 0x80000000 != 0 then 0 else w @[inline] def ow1 (d : CD) (o y x : Nat) (S : Float) : Word := let c := Dense.F.cert2 S d.hh if h : c < 0x100000000 then act' d.J c.toUInt32 else ow d o y x S theorem ow1_eq (d : CD) (o y x : Nat) (S : Float) : ow1 d o y x S = ow d o y x S := by unfold ow1; dsimp only; split ·rename_i hc; have hw : expOf (Dense.F.cert2 S d.hh).toUInt32 ≠ 255 := by unfold Dense.F.cert2 at hc ⊢; dsimp only at hc ⊢; split_ifs at hc ⊢ with hcond <;> [skip; exact absurd hc (by decide)]; simp only [Bool.and_eq_true, decide_eq_true_eq] at hcond; obtain ⟨⟨⟨-, c2⟩, -⟩, -⟩ := hcond; have := (Dense.F.eF S.toBits).toNat_lt; have hf52 : (S.toBits &&& 0xfffffffffffff).toNat < 2 ^ 52 := (by rw [UInt64.toNat_and]; exact lt_of_le_of_lt Nat.and_le_right (by decide)); simp only [UInt64.lt_iff_toNat_lt, UInt64.toNat_sub, UInt64.reduceToNat] at c2; have hw := Dense.F.c3w S.toBits (by clear hc hf52;omega); have hs2 : S.toBits.toNat / 2 ^ 63 < 2 := (by have := S.toBits.toNat_lt; clear*-this;(exact Nat.div_lt_of_lt_mul this)); simp only [UInt64.lt_iff_toNat_lt, UInt64.reduceToNat] at hc; intro h255; have h2 := congrArg UInt32.toNat h255; rw [expOf, UInt32.toNat_and, UInt32.toNat_shiftRight, UInt64.toNat_toUInt32] at h2; simp only [UInt32.reduceToNat, Nat.reduceMod, Nat.shiftRight_eq_div_pow] at h2; rw [Nat.and_two_pow_sub_one_eq_mod _ 8, Nat.mod_eq_of_lt hc, hw] at h2; clear*-c2 h2 hf52;omega unfold ow Dense.F.tw Dense.F.tf act' act reluW; dsimp only; rw [if_pos hc]; cases d.J <;> simp [hw] ·rfl @[inline] def ow2 (d : CD) (o y : Nat) (xb : USize) (r : Nat) (S : Float) : Word := let c := Dense.F.cert2 S d.hh if c < 0x100000000 then act' d.J c.toUInt32 else ow d o y (xb.toNat + r) S theorem ow2_eq (d : CD) (o y : Nat) (xb : USize) (r : Nat) (S : Float) : ow2 d o y xb r S = ow1 d o y (xb.toNat + r) S := rfl @[inline] def su (a : Array Word) (u : USize) (v : Word) : Array Word := if h : u < a.usize then a.uset u v (lt_of_lt_of_le (USize.lt_iff_toNat_lt.mp h) (Nat.mod_le _ _)) else a.set! u.toNat v theorem su_st (a : Array Word) (u : USize) (v : Word) : su a u v = a.set! u.toNat v := by unfold su; split ·rename_i h rw [Array.uset_eq_set, Array.set!_eq_setIfInBounds, Array.setIfInBounds, dif_pos (lt_of_lt_of_le (USize.lt_iff_toNat_lt.mp h) (Nat.mod_le _ _))] ·rfl @[specialize] def pl (g : Nat → Word) (n r q : Nat) (a : Array Word) : Array Word := if r < n then pl g n (r + 1) q (a.set! (q + r) (g r)) else a termination_by n - r theorem pl_g (g : Nat → Word) (n q : Nat) : ∀ m r (a b : Array Word), pl g n r q a = b → n - r = m → r ≤ n → b.size = a.size ∧ ∀ i < a.size, b[i]! = if q + r ≤ i ∧ i < q + n then g (i - q) else a[i]! := by intro m; induction m with | zero => rintro r a _ rfl hm hr; rw [pl, if_neg (by omega)]; exact ⟨rfl, fun i hi => by rw [if_neg (by clear hi;omega)]⟩ | succ m ih => rintro r a _ rfl hm hr; obtain ⟨s1, g1⟩ := ih (r + 1) (a.set! (q + r) (g r)) _ rfl (by clear hr;omega) (by clear hr;omega); rw [pl, if_pos (by clear*-hm;(exact Nat.lt_of_sub_eq_succ hm)), s1, Array.size_set!]; refine ⟨rfl, fun i hi => ?_⟩; rw [g1 i (by simp [hi])]; rcases eq_or_ne i (q + r) with rfl | hiq <;> [rw [Array.getElem!_set!_self _ _ _ hi]; rw [Array.getElem!_set!_ne _ _ _ _ hiq.symm]] <;> split_ifs <;> first | rfl | omega | (congr 1; clear*-;(exact Nat.eq_sub_of_add_eq' rfl)) @[inline] def ln (d : CD) (o y : Nat) (xb nq q r : USize) (S : Float) (a : Array Word) : Array Word := if r < nq then su a (q + r) (ow2 d o y xb r.toNat S) else a @[inline] def wt8o (d : CD) (o y : Nat) (xb nq q : USize) (A : Dense.F.A8) (a : Array Word) : Array Word := ln d o y xb nq q 7 A.a7 (ln d o y xb nq q 6 A.a6 (ln d o y xb nq q 5 A.a5 (ln d o y xb nq q 4 A.a4 (ln d o y xb nq q 3 A.a3 (ln d o y xb nq q 2 A.a2 (ln d o y xb nq q 1 A.a1 (ln d o y xb nq q 0 A.a0 a))))))) @[inline] def wt8 (d : CD) (o y : Nat) (xb nq q : USize) (A : Dense.F.A8) (a : Array Word) : Array Word := if h : 8 ≤ nq ∧ q.toNat + 8 ≤ a.size ∧ a.size ≤ 4294967295 then have hu : ∀ k : USize, k.toNat < 8 → (q + k).toNat < a.size := fun _ hk => Dense.F.uk hk h.2.1 (by have := h.2.2; (exact Dense.lt32 this)) (((((((a.uset q (ow2 d o y xb 0 A.a0) (by have := h.2.1; (exact Nat.lt_of_add_right_lt this))).uset (q + 1) (ow2 d o y xb 1 A.a1) (by simp only [Array.size_uset]; exact hu 1 (by simp only [USize.reduceToNat]; (exact Nat.one_lt_succ_succ 6)))).uset (q + 2) (ow2 d o y xb 2 A.a2) (by simp only [Array.size_uset]; exact hu 2 (by simp only [USize.reduceToNat]; (exact Nat.lt_of_sub_eq_succ rfl)))).uset (q + 3) (ow2 d o y xb 3 A.a3) (by simp only [Array.size_uset]; exact hu 3 (by simp only [USize.reduceToNat]; (exact Nat.lt_of_sub_eq_succ rfl)))).uset (q + 4) (ow2 d o y xb 4 A.a4) (by simp only [Array.size_uset]; exact hu 4 (by simp only [USize.reduceToNat]; (exact Nat.lt_of_sub_eq_succ rfl)))).uset (q + 5) (ow2 d o y xb 5 A.a5) (by simp only [Array.size_uset]; exact hu 5 (by simp only [USize.reduceToNat]; (exact Nat.lt_of_sub_eq_succ rfl)))).uset (q + 6) (ow2 d o y xb 6 A.a6) (by simp only [Array.size_uset]; exact hu 6 (by simp only [USize.reduceToNat]; (exact Nat.lt_of_sub_eq_succ rfl)))).uset (q + 7) (ow2 d o y xb 7 A.a7) (by simp only [Array.size_uset]; exact hu 7 (by simp only [USize.reduceToNat]; (exact Nat.lt_add_one 7))) else wt8o d o y xb nq q A a theorem pl_last (g : Nat → Word) (n q : Nat) : ∀ m r (a : Array Word), n - r = m → r ≤ n → pl g (n + 1) r q a = (pl g n r q a).set! (q + n) (g n) := by intro m; induction m <;> intro r a hm hr ·obtain rfl : r = n := by omega conv_lhs => rw [pl, if_pos (by (exact lt_add_one r)), pl, if_neg (by (exact Nat.lt_irrefl (r + 1)))] conv_rhs => rw [pl, if_neg (by (exact Nat.lt_irrefl r))] rename_i ih conv_lhs => rw [pl, if_pos (by clear*-hr;omega)] rw [ih (r + 1) _ (by clear hr;omega) (by clear hr;omega)] conv_rhs => rw [pl, if_pos (by clear hr;(exact Nat.lt_of_sub_eq_succ hm))] theorem lnp (d : CD) (o y : Nat) (xb nq q : USize) (A : Dense.F.A8) (a : Array Word) (hq : q.toNat + nq.toNat < USize.size) (r : USize) (k : Nat) (hr : r.toNat = k) (S : Float) (hS : S = A.f k) : ln d o y xb nq q r S (pl (fun r => ow1 d o y (xb.toNat + r) (A.f r)) (min k nq.toNat) 0 q.toNat a) = pl (fun r => ow1 d o y (xb.toNat + r) (A.f r)) (min (k + 1) nq.toNat) 0 q.toNat a := by subst hS unfold ln by_cases h : r < nq ·have h' := USize.lt_iff_toNat_lt.mp h rw [if_pos h, su_st, Dense.uadd (by clear hr;omega), hr, show min (k + 1) nq.toNat = min k nq.toNat + 1 by clear h hq;omega, pl_last _ _ _ _ _ _ rfl (by clear*-;(exact Nat.zero_le (min k nq.toNat))), show min k nq.toNat = k by clear h hq;omega]; rfl ·have h' := mt USize.lt_iff_toNat_lt.mpr h rw [if_neg h, show min (k + 1) nq.toNat = min k nq.toNat by clear h hq;omega] theorem us_st (a : Array Word) (u : USize) (v : Word) (h : u.toNat < a.size) : a.uset u v h = a.set! u.toNat v := by rw [Array.uset_eq_set, Array.set!_eq_setIfInBounds, Array.setIfInBounds, dif_pos h] theorem wt8_eq (d : CD) (o y : Nat) (xb nq q : USize) (A : Dense.F.A8) (a : Array Word) (hq : q.toNat + nq.toNat < USize.size) : wt8 d o y xb nq q A a = pl (fun r => ow1 d o y (xb.toNat + r) (A.f r)) (min 8 nq.toNat) 0 q.toNat a := by unfold wt8; split ·rename_i h; obtain ⟨h1, h2, h3⟩ := h have := USize.le_size; have h8 := USize.le_iff_toNat_le.mp h1; simp only [USize.reduceToNat] at h8 have e : ∀ k : USize, k.toNat < 8 → (q + k).toNat = q.toNat + k.toNat := fun k hk => Dense.uadd (by clear*-h8 hk hq;omega) rw [show min 8 nq.toNat = 8 by clear*-h8;(exact Nat.min_eq_left h8)] iterate 8 rw [us_st] rw [e 1 (by simp only [USize.reduceToNat]; (exact Nat.one_lt_succ_succ 6)), e 2 (by simp only [USize.reduceToNat]; (exact Nat.lt_of_sub_eq_succ rfl)), e 3 (by simp only [USize.reduceToNat]; (exact Nat.lt_of_sub_eq_succ rfl)), e 4 (by simp only [USize.reduceToNat]; (exact Nat.lt_of_sub_eq_succ rfl)), e 5 (by simp only [USize.reduceToNat]; (exact Nat.lt_of_sub_eq_succ rfl)), e 6 (by simp only [USize.reduceToNat]; (exact Nat.lt_of_sub_eq_succ rfl)), e 7 (by simp only [USize.reduceToNat]; (exact Nat.lt_add_one 7))] simp only [USize.reduceToNat] iterate 8 rw [pl, if_pos (by omega)] rw [pl, if_neg (by (exact Nat.lt_irrefl (0 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1)))] simp only [ow2_eq, Nat.add_zero, Nat.zero_add, Nat.reduceAdd] rfl have L := lnp d o y xb nq q A a hq have s0 := L 0 0 (by simp only [USize.reduceToNat]) A.a0 rfl rw [Nat.zero_min, pl, if_neg (by (exact Nat.not_lt_zero 0))] at s0 unfold wt8o simp only [s0, L 1 1 (by simp only [USize.reduceToNat]) A.a1 rfl, L 2 2 (by simp only [USize.reduceToNat]) A.a2 rfl, L 3 3 (by simp only [USize.reduceToNat]) A.a3 rfl, L 4 4 (by simp only [USize.reduceToNat]) A.a4 rfl, L 5 5 (by simp only [USize.reduceToNat]) A.a5 rfl, L 6 6 (by simp only [USize.reduceToNat]) A.a6 rfl, L 7 7 (by simp only [USize.reduceToNat]) A.a7 rfl, Nat.reduceAdd] theorem l0 (nq : USize) (h : 0 < nq) : 0 < nq.toNat := by simpa only [USize.reduceToNat] using USize.lt_iff_toNat_lt.mp h theorem l8 (nq : USize) (h : 8 < nq) : 8 < nq.toNat := by simpa only [USize.reduceToNat] using USize.lt_iff_toNat_lt.mp h theorem u8 (x : USize) (h : x.toNat + 8 < USize.size) : (x + 8).toNat = x.toNat + 8 := by rw [Dense.uadd (by simp only [USize.reduceToNat]; (exact Nat.lt_of_succ_le h))]; simp only [USize.reduceToNat] theorem s8 (nq : USize) (h : 8 < nq) : (nq - 8).toNat = nq.toNat - 8 := by have := l8 nq h simpa only [USize.reduceToNat] using USize.toNat_sub_of_le nq 8 (USize.le_iff_toNat_le.mpr (by simp only [USize.reduceToNat]; (exact Nat.le_of_add_left_le this))) @[specialize] def cw8 (W : CD → Nat → Nat → USize → USize → USize → Dense.F.A8 → Array Word → Array Word) (Wz X : @& FloatArray) (Tz : @& Array Nat) (wo n : USize) (M : Nat) (hs : X.size < 2 ^ 32 ∧ Wz.size < 2 ^ 32) (hn : n.toNat ≤ Tz.size) (hT : ∀ t < n.toNat, Tz[t]! ≤ M) (hW : wo.toNat + n.toNat ≤ Wz.size) (i : USize) (hi : i.toNat + M + 8 ≤ X.size) (d : @& CD) (o y : Nat) (xb nq q : USize) (a : Array Word) (t : USize) (a0 a1 a2 a3 a4 a5 a6 a7 : Float) : Array Word := if h : t < n then have ht := USize.lt_iff_toNat_lt.mp h have hJ : (i + (Tz.uget t (by (exact Nat.lt_of_lt_of_le h hn))).toUSize).toNat + 8 ≤ X.size := by rw [cj hs.1 hi (by rw [ugN]; exact hT _ ht)]; have := hT _ ht; rw [ugN]; omega let j := i + (Tz.uget t (by (exact Nat.lt_of_lt_of_le h hn))).toUSize let w := Wz.uget (wo + t) (by have := USize.le_size; rw [Dense.uadd (by omega)]; omega) cw8 W Wz X Tz wo n M hs hn hT hW i hi d o y xb nq q a (t + 1) (a0 + X.uget (j + 0) (Dense.F.uk (by simp only [USize.reduceToNat]; (exact Nat.zero_lt_succ 7)) hJ hs.1) * w) (a1 + X.uget (j + 1) (Dense.F.uk (by simp only [USize.reduceToNat]; (exact Nat.one_lt_succ_succ 6)) hJ hs.1) * w) (a2 + X.uget (j + 2) (Dense.F.uk (by simp only [USize.reduceToNat]; (exact Nat.lt_of_sub_eq_succ rfl)) hJ hs.1) * w) (a3 + X.uget (j + 3) (Dense.F.uk (by simp only [USize.reduceToNat]; (exact Nat.lt_of_sub_eq_succ rfl)) hJ hs.1) * w) (a4 + X.uget (j + 4) (Dense.F.uk (by simp only [USize.reduceToNat]; (exact Nat.lt_of_sub_eq_succ rfl)) hJ hs.1) * w) (a5 + X.uget (j + 5) (Dense.F.uk (by simp only [USize.reduceToNat]; (exact Nat.lt_of_sub_eq_succ rfl)) hJ hs.1) * w) (a6 + X.uget (j + 6) (Dense.F.uk (by simp only [USize.reduceToNat]; (exact Nat.lt_of_sub_eq_succ rfl)) hJ hs.1) * w) (a7 + X.uget (j + 7) (Dense.F.uk (by simp only [USize.reduceToNat]; (exact Nat.lt_add_one 7)) hJ hs.1) * w) else W d o y xb nq q ⟨a0, a1, a2, a3, a4, a5, a6, a7⟩ a termination_by n.toNat - t.toNat decreasing_by have := USize.lt_iff_toNat_lt.mp h; rw [Dense.usucc h]; (exact Nat.sub_succ_lt_self n.toNat t.toNat h) theorem cw8_eq (W : CD → Nat → Nat → USize → USize → USize → Dense.F.A8 → Array Word → Array Word) (Wz X : FloatArray) (Tz : Array Nat) (wo n : USize) (M : Nat) (hs : X.size < 2 ^ 32 ∧ Wz.size < 2 ^ 32) (hn : n.toNat ≤ Tz.size) (hT : ∀ t < n.toNat, Tz[t]! ≤ M) (hW : wo.toNat + n.toNat ≤ Wz.size) (i : USize) (hi : i.toNat + M + 8 ≤ X.size) (d : CD) (o y : Nat) (xb nq q : USize) (a : Array Word) (m : Nat) (t : USize) (a0 a1 a2 a3 a4 a5 a6 a7 : Float) (A : Dense.F.A8) (hm : n.toNat - t.toNat = m) (hA : ∀ r < 8, A.f r = Dense.F.sfold (fun s => X.data[i.toNat + Tz[s]! + r]! * Wz.data[wo.toNat + s]!) n.toNat t.toNat (Dense.F.A8.f ⟨a0, a1, a2, a3, a4, a5, a6, a7⟩ r)) : cw8 W Wz X Tz wo n M hs hn hT hW i hi d o y xb nq q a t a0 a1 a2 a3 a4 a5 a6 a7 = W d o y xb nq q A a := by induction m generalizing t a0 a1 a2 a3 a4 a5 a6 a7 A with | zero => rw [cw8, dif_neg fun h => by have := USize.lt_iff_toNat_lt.mp h; clear*-hm this;omega]; congr 1 exact a8e _ _ fun r hr => by rw [hA r hr, Dense.F.sfold, if_neg (by clear*-hm;omega)] | succ m ih => have h : t < n := USize.lt_iff_toNat_lt.mpr (by clear*-hm;(exact Nat.lt_of_sub_eq_succ hm)) have ht := USize.lt_iff_toNat_lt.mp h have hM := hT _ ht have hJ := cj (i := i) hs.1 hi hM have := USize.le_size have rx : ∀ c : USize, c.toNat < 8 → (i + (Tz.uget t (by clear*-hn ht;(exact Nat.lt_of_lt_of_le ht hn))).toUSize + c).toNat = i.toNat + Tz[t.toNat]! + c.toNat := fun c hc => by rw [ugN, Dense.uadd (by rw [hJ]; clear*-hM hc hi hs this;omega), hJ] rw [cw8, dif_pos h] refine ih (t + 1) _ _ _ _ _ _ _ _ A (by rw [Dense.usucc h]; clear*-hm ht;omega) fun r hr => ?_ rw [hA r hr, Dense.F.sfold, if_pos ht, Dense.usucc h]; congr 1 interval_cases r <;> simp (disch := (try simp only [USize.reduceToNat]); omega) only [Dense.F.A8.f, Dense.F.ug, rx, Dense.uadd (by clear*-hW hs ht this;omega : wo.toNat + t.toNat < USize.size), USize.reduceToNat] @[noinline] def w8x (d : CD) (o y : Nat) (xb nq q : USize) (a0 a1 a2 a3 a4 a5 a6 a7 : Float) (a : Array Word) : Array Word := wt8 d o y xb nq q ⟨a0, a1, a2, a3, a4, a5, a6, a7⟩ a @[inline] def wt8m (d : CD) (o y : Nat) (xb nq q : USize) (A : Dense.F.A8) (a : Array Word) : Array Word := w8x d o y xb nq q A.a0 A.a1 A.a2 A.a3 A.a4 A.a5 A.a6 A.a7 a def sfB (d : CD) (c : CC d.M) (o y xb r : Nat) : Float := Dense.F.sfold (fun t => d.X.data[(if d.D then o else 0) * ((d.s.h + 2) * (d.s.w + 2)) + y * (d.s.w + 2) + xb + c.Tz[t]! + r]! * c.Wz.data[c.wo + t]!) c.n 0 (Dense.F.dw oneW * Dense.F.dw d.b[o]!) @[inline] def bw8 (W : CD → Nat → Nat → USize → USize → USize → Dense.F.A8 → Array Word → Array Word) (d : @& CD) (c : @& CC d.M) (o y : Nat) (xb nq q i : USize) (hi : i.toNat + d.M + 8 ≤ d.X.size) (bp : Float) (a : Array Word) : Array Word := cw8 W c.Wz d.X c.Tz c.wo.toUSize c.n.toUSize d.M ⟨d.hX, c.h5⟩ (by have := USize.le_size; have := c.h3; rw [Dense.toUSize_toNat (by omega)]; exact c.h1) (by have := USize.le_size; have := c.h3; rw [Dense.toUSize_toNat (by omega)]; exact c.h4) (by have := USize.le_size; have := c.h3; rw [Dense.toUSize_toNat (by omega), Dense.toUSize_toNat (by omega)]; exact c.h2) i hi d o y xb nq q a 0 bp bp bp bp bp bp bp bp theorem bw8_eq (d : CD) (c : CC d.M) (o y : Nat) (xb nq q i : USize) (hi : i.toNat + d.M + 8 ≤ d.X.size) (bp : Float) (a : Array Word) (hix : i.toNat = (if d.D then o else 0) * ((d.s.h + 2) * (d.s.w + 2)) + y * (d.s.w + 2) + xb.toNat) (hbp : bp = Dense.F.dw oneW * Dense.F.dw d.b[o]!) : bw8 wt8 d c o y xb nq q i hi bp a = wt8 d o y xb nq q (mk8 (sfB d c o y xb.toNat)) a := by subst hbp; unfold bw8; have := c.h3; refine cw8_eq _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ rfl fun r hr => ?_; simp only [mk8_f _ _ hr, sfB, hix, toUSize_toNat c.wo (by clear*-this;(exact Nat.lt_of_add_right_lt this)), toUSize_toNat c.n (by clear*-this;(exact Nat.lt_of_add_left_lt this)), USize.toNat_zero, Dense.F.f8] @[specialize] def rB (W : CD → Nat → Nat → USize → USize → USize → Dense.F.A8 → Array Word → Array Word) (d : @& CD) (c : @& CC d.M) (o y : Nat) (xb nq q i : USize) (bp : Float) (a : Array Word) (hI : i.toNat + nq.toNat + d.M + 7 ≤ d.X.size) : Array Word := if h : 0 < nq then let a' := bw8 W d c o y xb nq q i (by have := l0 nq h; omega) bp a if h8 : 8 < nq then rB W d c o y (xb + 8) (nq - 8) (q + 8) (i + 8) bp a' (by have := l8 nq h8; have := USize.le_size; have := d.hX; rw [u8 i (by omega), s8 nq h8]; omega) else a' else a termination_by nq.toNat decreasing_by have := l8 nq h8; rw [s8 nq h8]; omega theorem rB_eq (d : CD) (c : CC d.M) (o y : Nat) (bp : Float) (hbp : bp = Dense.F.dw oneW * Dense.F.dw d.b[o]!) (F : Nat → Word) (hF8 : ∀ xb r x, xb + r = x → r < 8 → x < d.s.w → ow1 d o y x (sfB d c o y xb r) = F x) : ∀ m (xb nq q i : USize) (a : Array Word) (hI : i.toNat + nq.toNat + d.M + 7 ≤ d.X.size), nq.toNat ≤ m → xb.toNat + nq.toNat = d.s.w → i.toNat = (if d.D then o else 0) * ((d.s.h + 2) * (d.s.w + 2)) + y * (d.s.w + 2) + xb.toNat → q.toNat + nq.toNat ≤ a.size → a.size < 2 ^ 32 → (rB wt8 d c o y xb nq q i bp a hI).size = a.size ∧ ∀ j < a.size, (rB wt8 d c o y xb nq q i bp a hI)[j]! = if q.toNat ≤ j ∧ j < q.toNat + nq.toNat then F (xb.toNat + (j - q.toNat)) else a[j]! := by intro m; induction m <;> intro xb nq q i a hI hm hx hi hq hN <;> by_cases h : 0 < nq ·have := l0 nq h; clear*-hm this;omega rotate_left ·rename_i ih; have := USize.le_size; have := d.hX; have h0 := l0 nq h rw [rB, dif_pos h]; dsimp only; rw [bw8_eq _ _ _ _ _ _ _ _ _ _ _ hi hbp]; obtain ⟨hs, hg⟩ := pl_g _ _ _ _ 0 a _ (wt8_eq d o y xb nq q (mk8 (sfB d c o y xb.toNat)) a (by clear h h0 hF8 hI hbp hi hm hx ih this;omega)).symm rfl (Nat.zero_le _) by_cases h8 : 8 < nq; rotate_left; rw [dif_neg h8]; simp [USize.lt_iff_toNat_lt] at h8; refine ⟨hs, fun j hj => ?_⟩; rw [hg j hj]; rotate_left have h8' := l8 nq h8; rw [dif_pos h8]; have e1 := u8 xb (by clear hx;omega); have e2 := u8 q (by clear e1 h h0 h8 hF8 hI hbp hg hi hm hs hx ih this;omega); have e3 := s8 nq h8; have e4 := u8 i (by clear e1 e2 e3 h h0 h8 hF8 hN hbp hg hi hm hq hs hx ih;omega) obtain ⟨s1, g1⟩ := ih (xb + 8) (nq - 8) (q + 8) (i + 8) _ _ (by omega) (by omega) (by omega) (by omega) (hs.trans_lt hN); refine ⟨by omega, fun j hj => ?_⟩; rw [g1 j (by (exact Nat.lt_of_lt_of_eq hj (id (Eq.symm hs)))), hg j hj, e1, e2, e3] all_goals split_ifs <;> first | rfl | omega | (congr 1; omega) | (rw [mk8_f _ _ (by omega)]; exact hF8 _ _ _ rfl (by omega) (by omega)) all_goals rw [rB, dif_neg h]; simp [USize.lt_iff_toNat_lt] at h; exact ⟨rfl, fun j _ => by rw [if_neg (by clear*-h hm;omega)]⟩ @[specialize] def lp3 (h len : Nat) (V : USize) (i0 : Nat) (hN : i0 + h * V.toNat < USize.size) (f : (y : Nat) → y < h → (q : Nat) → (i : USize) → i.toNat = i0 + y * V.toNat → Array Word → Array Word) (y q : Nat) (i : USize) (hi : i.toNat = i0 + y * V.toNat) (a : Array Word) : Array Word := if hy : y < h then lp3 h len V i0 hN f (y + 1) (q + len) (i + V) (by have := Nat.mul_le_mul_right V.toNat hy; rw [Nat.succ_mul] at this ⊢; rw [Dense.uadd (by omega), hi]; omega) (f y hy q i hi a) else a termination_by h - y theorem ml {a b : Nat} (k) (h : a < b) : a * k + k ≤ b * k := Nat.add_one_mul a k ▸ Nat.mul_le_mul_right k h theorem lp3_eq (h len : Nat) (V : USize) (i0 : Nat) (hN : i0 + h * V.toNat < USize.size) (f : (y : Nat) → y < h → (q : Nat) → (i : USize) → i.toNat = i0 + y * V.toNat → Array Word → Array Word) (q0 N : Nat) (G : Nat → Word) (hf : ∀ y (hy : y < h) q (i : USize) (hi : i.toNat = i0 + y * V.toNat) (a : Array Word), q = q0 + y * len → a.size = N → (f y hy q i hi a).size = a.size ∧ ∀ j < a.size, (f y hy q i hi a)[j]! = if q ≤ j ∧ j < q + len then G j else a[j]!) : ∀ m y q (i : USize) (hi : i.toNat = i0 + y * V.toNat) (a : Array Word), h - y = m → y ≤ h → q = q0 + y * len → a.size = N → (lp3 h len V i0 hN f y q i hi a).size = a.size ∧ ∀ j < a.size, (lp3 h len V i0 hN f y q i hi a)[j]! = if q ≤ j ∧ j < q0 + h * len then G j else a[j]! := by intro m; induction m with | zero => intro y q i hi a hm hy hq _; obtain rfl : y = h := by clear*-hm hy;omega rw [lp3, dif_neg (by clear*-;(exact Nat.lt_irrefl y))]; exact ⟨rfl, fun j _ => by rw [if_neg (by clear*-hq;omega)]⟩ | succ m ih => intro y q i hi a hm _ hq hN'; have hy : y < h := by clear*-hm;(exact Nat.lt_of_sub_eq_succ hm) rw [lp3, dif_pos hy]; obtain ⟨s1, e1⟩ := hf y hy q i hi a hq hN'; obtain ⟨s2, e2⟩ := ih (y + 1) (q + len) (i + V) _ _ (by clear*-hm hy;omega) (by clear*-hy;omega) (by rw [hq]; ring) (s1.trans hN'); have := ml len hy; exact ⟨by clear*-s1 s2;omega, fun j hj => by rw [e2 j (by clear*-hj s1;(exact Nat.lt_of_lt_of_eq hj (id (Eq.symm s1)))), e1 j hj]; split_ifs <;> first | rfl | (clear e1 e2 hN hN' hf hi hj hm hy ih s1 s2;omega)⟩ @[specialize] def pln (W : CD → Nat → Nat → USize → USize → USize → Dense.F.A8 → Array Word → Array Word) (d : @& CD) (c : @& CC d.M) (o q : Nat) (bp : Float) (a : Array Word) : Array Word := let V := d.s.w + 2 let i0 := (if d.D then o else 0) * ((d.s.h + 2) * V) if hb : i0 + (d.s.h - 1) * V + d.s.w + d.M + 7 ≤ d.X.size then lp3 d.s.h d.s.w V.toUSize i0 (by have := d.hX; have := USize.le_size; have := Nat.sub_one_mul d.s.h V; have hV : V = d.s.w + 2 := rfl; rw [Dense.toUSize_toNat (by omega)]; omega) (fun y hy q i hi a => rB W d c o y 0 d.s.w.toUSize q.toUSize i bp a (by have := d.hX; have := USize.le_size; have := Nat.mul_le_mul_right V (Nat.le_sub_one_of_lt hy) have hV : V = d.s.w + 2 := rfl; rw [Dense.toUSize_toNat (by omega)] at hi; rw [Dense.toUSize_toNat (by omega)]; omega)) 0 q i0.toUSize (by have := d.hX; have := USize.le_size; rw [Dense.toUSize_toNat (by omega)]; simp) a else a theorem pln_eq (d : CD) (c : CC d.M) (o q : Nat) (bp : Float) (a : Array Word) (N : Nat) (G : Nat → Word) (ROW : ∀ y < d.s.h, ∀ q' (i : USize) (a' : Array Word) (hI : i.toNat + d.s.w.toUSize.toNat + d.M + 7 ≤ d.X.size), i.toNat = (if d.D then o else 0) * ((d.s.h + 2) * (d.s.w + 2)) + y * (d.s.w + 2) → q' = q + y * d.s.w → a'.size = N → (rB wt8 d c o y 0 d.s.w.toUSize q'.toUSize i bp a' hI).size = a'.size ∧ ∀ j < a'.size, (rB wt8 d c o y 0 d.s.w.toUSize q'.toUSize i bp a' hI)[j]! = if q' ≤ j ∧ j < q' + d.s.w then G j else a'[j]!) (hN : a.size = N) (hw : d.s.w + 2 < USize.size) (hb : 0 < d.s.h → (if d.D then o else 0) * ((d.s.h + 2) * (d.s.w + 2)) + (d.s.h - 1) * (d.s.w + 2) + d.s.w + d.M + 7 ≤ d.X.size) : (pln wt8 d c o q bp a).size = a.size ∧ ∀ j < a.size, (pln wt8 d c o q bp a)[j]! = if q ≤ j ∧ j < q + d.s.h * d.s.w then G j else a[j]! := by unfold pln; dsimp only; by_cases hb' : (if d.D then o else 0) * ((d.s.h + 2) * (d.s.w + 2)) + (d.s.h - 1) * (d.s.w + 2) + d.s.w + d.M + 7 ≤ d.X.size ·rw [dif_pos hb']; exact lp3_eq d.s.h d.s.w _ _ _ _ q N G (fun y hy q' i hi a' hq' hN' => ROW y hy q' i a' _ (by rw [hi, Dense.toUSize_toNat hw]) hq' hN') _ 0 q _ _ a rfl (Nat.zero_le _) (by simp) hN ·rw [dif_neg hb', Nat.eq_zero_of_not_pos (mt hb hb')]; exact ⟨rfl, fun j _ => by rw [Nat.zero_mul, Nat.add_zero, if_neg (by clear*-;omega)]⟩ theorem aus_g (A : Array Nat) (i : USize) (v : Nat) (h : i.toNat < A.size) (q : Nat) (hq : q < A.size) : (A.uset i v h)[q]! = if i.toNat = q then v else A[q]! := by rw [Array.uset_eq_set, getElem!_pos _ _ (by simp; omega), Array.getElem_set]; split <;> simp [*, getElem!_pos] def nzu (K : Array Word) (T : Array Nat) (M : Nat) (ok k : USize) (hK : ok.toNat + k.toNat ≤ K.size ∧ K.size < 2 ^ 32) (hT : ∀ t < k.toNat, T[t]! ≤ M) (hkT : k.toNat ≤ T.size) (t c : USize) (Tz : Array Nat) (Wz : FloatArray) (hs : Tz.size = k.toNat ∧ Wz.size = k.toNat) (hc : c.toNat ≤ t.toNat ∧ t.toNat ≤ k.toNat) (hz : ∀ j < c.toNat, Tz[j]! ≤ M) : CC M := if h : t < k then have ht := USize.lt_iff_toNat_lt.mp h have hc' : c < k := USize.lt_iff_toNat_lt.mpr (by omega) let w := K.uget (ok + t) (uj hK.2 hK.1 h) if Core.mW w = 0 then nzu K T M ok k hK hT hkT (t + 1) c Tz Wz hs (by rw [Dense.usucc h]; omega) hz else nzu K T M ok k hK hT hkT (t + 1) (c + 1) (Tz.uset c (T.uget t (by (exact Nat.lt_of_lt_of_le h hkT))) (by omega)) (Wz.uset c (Dense.F.dw w) (by omega)) (by rw [Array.size_uset, fus_sz]; exact hs) (by rw [Dense.usucc h, Dense.usucc hc']; omega) (fun j hj => by rw [Dense.usucc hc'] at hj; rw [aus_g _ _ _ _ _ (by omega)]; split ·rw [ugN]; exact hT _ ht ·exact hz j (by omega)) else ⟨Tz, Wz, 0, c.toNat, by omega, by omega, by omega, hz, by omega⟩ termination_by k.toNat - t.toNat decreasing_by all_goals (have := USize.lt_iff_toNat_lt.mp h; rw [Dense.usucc h]; omega) def NZ (K : Array Word) (T : Array Nat) (ok t c : Nat) (Tz : Array Nat) (Wz : FloatArray) : Prop := c ≤ t ∧ ∃ ix : Nat → Nat, (∀ j < c, ix j < t ∧ Tz[j]! = T[ix j]! ∧ Wz.data[j]! = Dense.F.dw K[ok + ix j]!) ∧ ∀ z : Nat → ℝ, (∀ s < t, Core.mW K[ok + s]! = 0 → z s = 0) → ∑ j ∈ range c, z (ix j) = ∑ s ∈ range t, z s theorem nzu_spec (K : Array Word) (T : Array Nat) (M : Nat) (ok k : USize) (hK : ok.toNat + k.toNat ≤ K.size ∧ K.size < 2 ^ 32) (hT : ∀ t < k.toNat, T[t]! ≤ M) (hkT : k.toNat ≤ T.size) : ∀ m (t c : USize) Tz Wz hs hc hz (C : CC M), nzu K T M ok k hK hT hkT t c Tz Wz hs hc hz = C → k.toNat - t.toNat = m → NZ K T ok.toNat t.toNat c.toNat Tz Wz → C.Tz.size = k.toNat ∧ C.Wz.size = k.toNat ∧ C.wo = 0 ∧ NZ K T ok.toNat k.toNat C.n C.Tz C.Wz := by intro m; induction m with | zero => rintro t c Tz Wz hs hc hz _ rfl hm h; rw [nzu, dif_neg (by rw [USize.lt_iff_toNat_lt]; clear*-hm;omega)]; rw [show t.toNat = k.toNat by clear*-hc hm;omega] at h; exact ⟨hs.1, hs.2, rfl, h⟩ | succ m ih => rintro t c Tz Wz hs hc hz _ rfl hm ⟨hct, ix, hix, hsum⟩; have h' : t < k := USize.lt_iff_toNat_lt.mpr (by clear*-hm;(exact Nat.lt_of_sub_eq_succ hm)); have hc' : c < k := USize.lt_iff_toNat_lt.mpr (by clear*-hc hm;omega); have := USize.le_size; have := hK.1; have := hK.2; have := hs.1; have := hs.2; have := hc.1; have e1 := Dense.usucc h'; have e2 := Dense.usucc hc'; rw [nzu, dif_pos h']; dsimp only; have eK : K.uget (ok + t) (uj hK.2 hK.1 h') = K[ok.toNat + t.toNat]! := by rw [ugW, Dense.uadd (by clear e1 e2 h' hT hc' hct hix hkT hm hs hsum hz ih this;omega)] split ·rename_i h0; rw [eK] at h0; exact ih (t + 1) c _ _ _ _ _ _ rfl (by clear*-e1 hm;omega) ⟨by clear*-e1 hc;omega, ix, fun j hj => (hix j hj).imp (fun _ => by clear e2 eK h' h0 hK hT hc hc' hct hix hj hkT hm hs hsum hz ih this;omega) id, fun z h => by rw [e1, Finset.sum_range_succ, h t.toNat (by clear*-e1;omega) h0, add_zero]; exact hsum z fun s _ h' => h s (by clear e2 eK h h' h0 hK hT hc hc' hct hix hkT hm hs hsum hz ih this;omega) h'⟩ ·refine ih (t + 1) (c + 1) _ _ _ _ _ _ rfl (by omega) ⟨by omega, fun j => if j < c.toNat then ix j else t.toNat, fun j hj => ?_, fun z hz' => ?_⟩ ·rw [aus_g _ _ _ _ _ (by omega), fus_g _ _ _ _ _ (by omega)]; dsimp only; split_ifs <;> first | omega | exact (hix j ‹_›).imp (fun _ => by omega) id | exact ⟨by omega, ugN .., by rw [eK]⟩ ·rw [e2, e1, Finset.sum_range_succ, Finset.sum_range_succ, ← hsum z fun s _ h => hz' s (by omega) h]; dsimp only; rw [if_neg (lt_irrefl _)]; congr 1; exact Finset.sum_congr rfl fun j hj => by rw [if_pos (mr hj)] theorem mkb (d : CD) (o : Nat) (ho : o < d.Y) (hY : d.Y * d.k < 2 ^ 32) : (o * d.k).toUSize.toNat = o * d.k ∧ d.k.toUSize.toNat = d.k ∧ o * d.k + d.k ≤ d.Y * d.k := by have hok : o * d.k + d.k ≤ d.Y * d.k := by rw [← Nat.succ_mul]; exact Nat.mul_le_mul_right _ ho have := USize.le_size exact ⟨Dense.toUSize_toNat (by clear ho;omega), Dense.toUSize_toNat (by clear ho;omega), hok⟩ @[inline] def nzc (d : CD) (hT : ∀ t < d.k, d.T[t]! ≤ d.M) (hkT : d.k ≤ d.T.size) (hY : d.Y * d.k < 2 ^ 32) (o : Nat) (ho : o < d.Y) (Tz : Array Nat) (Wz : FloatArray) (hs : Tz.size = d.k ∧ Wz.size = d.k) : CC d.M := nzu d.K d.T d.M (o * d.k).toUSize d.k.toUSize (by have e := mkb d o ho hY; have := d.hK; rw [e.1, e.2.1]; omega) (by rw [(mkb d o ho hY).2.1]; exact hT) (by rw [(mkb d o ho hY).2.1]; exact hkT) 0 0 Tz Wz (by rw [(mkb d o ho hY).2.1]; exact hs) (by simp) (fun j hj => by simp at hj) abbrev CP (d : CD) (c : CC d.M) (o : Nat) : Prop := c.Wz.size < 2 ^ 32 ∧ ∃ ix : Nat → Nat, c.n ≤ d.k ∧ (∀ j < c.n, ix j < d.k ∧ c.Tz[j]! = d.T[ix j]! ∧ c.Wz.data[c.wo + j]! = Dense.F.dw d.K[o * d.k + ix j]!) ∧ ∀ z : Nat → ℝ, (∀ s < d.k, Core.mW d.K[o * d.k + s]! = 0 → z s = 0) → ∑ j ∈ range c.n, z (ix j) = ∑ s ∈ range d.k, z s theorem nzP (d : CD) (hT : ∀ t < d.k, d.T[t]! ≤ d.M) (hkT : d.k ≤ d.T.size) (hY : d.Y * d.k < 2 ^ 32) (o : Nat) (ho : o < d.Y) (Tz : Array Nat) (Wz : FloatArray) (hs : Tz.size = d.k ∧ Wz.size = d.k) (c : CC d.M) (hc : nzc d hT hkT hY o ho Tz Wz hs = c) : c.Tz.size = d.k ∧ c.Wz.size = d.k ∧ CP d c o := by obtain ⟨e1, e2, -⟩ := mkb d o ho hY; obtain ⟨hs1, hs2, hw0, hn1, ix, hix, hsum⟩ := nzu_spec _ _ _ _ _ _ _ _ _ 0 0 _ _ _ _ _ _ hc rfl ⟨le_rfl, id, fun j hj => by simp at hj, fun z _ => rfl⟩; simp only [e1, e2] at hs1 hs2 hn1 hix hsum; exact ⟨hs1, hs2, c.h5, ix, hn1, by simpa [hw0] using hix, hsum⟩ def mkc (d : CD) (Z : Bool) (Wd : FloatArray) (hT : ∀ t < d.k, d.T[t]! ≤ d.M) (hk : d.k < 2 ^ 32) (hkT : d.k ≤ d.T.size) (hW : Z = true ∨ d.Y * d.k ≤ Wd.size ∧ Wd.size < 2 ^ 32) (hY : d.Y * d.k < 2 ^ 32) (o : Nat) (ho : o < d.Y) : CC d.M := if hZ : Z = true then nzc d hT hkT hY o ho (Array.replicate d.k 0) ⟨Array.replicate d.k 0⟩ ⟨Array.size_replicate .., Array.size_replicate ..⟩ else have hok : o * d.k + d.k ≤ d.Y * d.k := by rw [← Nat.succ_mul]; exact Nat.mul_le_mul_right _ ho ⟨d.T, Wd, o * d.k, d.k, hkT, hok.trans (hW.resolve_left hZ).1, by (exact Nat.lt_of_le_of_lt hok hY), hT, (hW.resolve_left hZ).2⟩ theorem mkc_spec (d : CD) (Z : Bool) (Wd : FloatArray) (hT : ∀ t < d.k, d.T[t]! ≤ d.M) (hk : d.k < 2 ^ 32) (hkT : d.k ≤ d.T.size) (hW : Z = true ∨ d.Y * d.k ≤ Wd.size ∧ Wd.size < 2 ^ 32) (hY : d.Y * d.k < 2 ^ 32) (hWd : Z = false → Wd.size < 2 ^ 32 ∧ ∀ q < d.Y * d.k, Wd.data[q]! = Dense.F.dw d.K[q]!) (o : Nat) (ho : o < d.Y) (c : CC d.M) (hc : mkc d Z Wd hT hk hkT hW hY o ho = c) : CP d c o := by subst hc; cases Z ·have := ml d.k ho; exact ⟨(hW.resolve_left (by simp)).2, id, le_rfl, fun j (hj : j < d.k) => ⟨hj, rfl, (hWd rfl).2 (o * d.k + j) (by clear*-hj this;omega)⟩, fun z _ => rfl⟩ ·unfold mkc; rw [dif_pos rfl]; exact (nzP _ _ _ _ _ _ _ _ _ _ rfl).2.2 @[inline] def chS (d : CD) (c : CC d.M) (o q : Nat) (a : Array Word) : Array Word := if isArm then pln wt8m d c o q (Dense.F.dw oneW * Dense.F.dw d.b[o]!) a else pln wt8 d c o q (Dense.F.dw oneW * Dense.F.dw d.b[o]!) a local instance (M : Nat) : Inhabited (CC M) := ⟨⟨#[], ⟨#[]⟩, 0, 0, Nat.zero_le _, Nat.zero_le _, by decide, fun _ h => absurd h (Nat.not_lt_zero _), by simp [FloatArray.size]⟩⟩ def cvS (d : CD) (cs : Array (CC d.M)) (o q : Nat) (a : Array Word) : Array Word := if o < d.Y then cvS d cs (o + 1) (q + d.s.h * d.s.w) (chS d cs[o]! o q a) else a termination_by d.Y - o theorem cvS_eq (d : CD) (cs : Array (CC d.M)) (hcs : ∀ o < d.Y, CP d cs[o]! o) (N : Nat) (G : Nat → Word) (hf : ∀ o < d.Y, ∀ q (a : Array Word) c, CP d c o → q = o * (d.s.h * d.s.w) → a.size = N → (chS d c o q a).size = a.size ∧ ∀ j < a.size, (chS d c o q a)[j]! = if q ≤ j ∧ j < q + d.s.h * d.s.w then G j else a[j]!) : ∀ m o q (a : Array Word), d.Y - o = m → q = o * (d.s.h * d.s.w) → a.size = N → (cvS d cs o q a).size = a.size ∧ ∀ j < a.size, (cvS d cs o q a)[j]! = if q ≤ j ∧ j < d.Y * (d.s.h * d.s.w) then G j else a[j]! := by intro m; induction m with | zero => intro o q a hm hq _; rw [cvS, if_neg (by clear*-hm;omega)]; have := Nat.mul_le_mul_right (d.s.h * d.s.w) (show d.Y ≤ o by clear*-hm;(exact Nat.le_of_sub_eq_zero hm)); exact ⟨rfl, fun j _ => by rw [if_neg (by clear*-hq this;omega)]⟩ | succ m ih => intro o q a hm hq hN; have ho : o < d.Y := by clear*-hm;(exact Nat.lt_of_sub_eq_succ hm) rw [cvS, if_pos ho]; obtain ⟨s1, e1⟩ := hf o ho q a _ (hcs o ho) hq hN; obtain ⟨s2, e2⟩ := ih (o + 1) (q + d.s.h * d.s.w) _ (by clear*-hm ho;omega) (by rw [hq, Nat.succ_mul]) (s1.trans hN); have := ml (d.s.h * d.s.w) ho; exact ⟨by clear*-s1 s2;omega, fun j hj => by rw [e2 j (by clear*-hj s1;(exact Nat.lt_of_lt_of_eq hj (id (Eq.symm s1)))), e1 j hj]; split_ifs <;> first | rfl | (clear e1 e2 hN hcs hf hj hm ho ih s1 s2;omega)⟩ theorem pv_win (s : ConvShape) (I : Array Word) (kk : Nat) (hs : geo s kk) (y x t cb : Nat) (hy : y < s.h) (hx : x < s.w) (hc : cb + pc kk t < s.cin) : windowAt s I y x (cb * kk + t) = pW3 s I (cb + pc kk t) (y + py kk t) (x + px kk t) := by rcases hs with ⟨h1, h2, h3, h4, rfl⟩ | ⟨h1, h2, h3, h4, rfl⟩ <;> simp only [windowAt, pW3, pc, py, px, h1, h2, h3, h4, ↓reduceIte, show (1 : Nat) ≠ 9 by decide, Nat.mul_one, Nat.reduceMul, Nat.div_one, Nat.mod_one, Nat.add_zero, Nat.sub_zero, Nat.add_sub_cancel, show (cb * 9 + t) / 9 = cb + t / 9 by clear*-;omega, show (cb * 9 + t) / 3 % 3 = t / 3 % 3 by clear*-;omega, show (cb * 9 + t) % 3 = t % 3 by clear*-;omega] at hc ⊢ <;> split_ifs <;> first | rfl | (clear h1 h2 h3 h4;omega) theorem winB (s : ConvShape) (I : Array Word) (IX : Nat) (hx : ∀ q : Nat, expOf I[q]! ≠ 255 ∧ idxOf I[q]! ≤ IX) (y x t : Nat) : expOf (windowAt s I y x t) ≠ 255 ∧ idxOf (windowAt s I y x t) ≤ IX := by unfold windowAt; dsimp only; split ·exact ⟨by decide, by rw [show idxOf (0 : Word) = 0 by decide]; exact Nat.zero_le _⟩ ·exact hx _ def XT : Array FloatArray := Array.ofFn (n := 10) fun k => ⟨Array.replicate (2 ^ (k.val + 7)) (Dense.F.dw 0)⟩ def xT (n : Nat) : FloatArray := let k := Nat.log2 n + 1 - 7 if k < 10 then XT[k]! else ⟨Array.replicate n (Dense.F.dw 0)⟩ theorem xT_spec (n : Nat) : n ≤ (xT n).size ∧ ((xT n).size = n ∨ (xT n).size ≤ 2 ^ 16) ∧ ∀ q < (xT n).size, (xT n).data[q]! = Dense.F.dw 0 := by have hr : ∀ m q, q < m → (⟨Array.replicate m (Dense.F.dw 0)⟩ : FloatArray).data[q]! = Dense.F.dw 0 := fun m q h => by simp [getElem!_pos, h] unfold xT; dsimp only; split ·rw [getElem!_pos XT _ (by simp [XT]; omega)] simp only [XT, Array.getElem_ofFn, FloatArray.size, Array.size_replicate] exact ⟨(Nat.lt_log2_self (n := n)).le.trans (Nat.pow_le_pow_right (by decide) (by omega)), .inr (Nat.pow_le_pow_right (by decide) (by omega)), fun q hq => hr _ q hq⟩ ·refine ⟨?_, .inl ?_, fun q hq => hr _ q ?_⟩ <;> simp_all [FloatArray.size] theorem xF0 (s : ConvShape) (hN : (s.cin * (s.h + 2) + 3) * (s.w + 2) < 2 ^ 32) : s.w.toUSize.toNat = s.w ∧ (s.w + 2).toUSize.toNat = s.w + 2 ∧ RV s 0 0 0 0 (xT ((s.cin * (s.h + 2) + 3) * (s.w + 2))).size := by have := USize.le_size have e : s.w + 2 ≤ (s.cin * (s.h + 2) + 3) * (s.w + 2) := Nat.le_mul_of_pos_left _ (by clear*-;(exact Nat.zero_lt_succ (s.cin * (s.h + 2) + 2))) obtain ⟨z1, z2, -⟩ := xT_spec ((s.cin * (s.h + 2) + 3) * (s.w + 2)) exact ⟨Dense.toUSize_toNat (by omega), Dense.toUSize_toNat (by omega), by clear*-;(exact Nat.zero_lt_succ (s.h + 1)), ⟨0, by simp, by simp⟩, by simp, z1, by clear*-hN z2;omega⟩ def xF (s : ConvShape) (I : Array Word) (hs : I.size < 2 ^ 32) (hI : s.cin * s.h * s.w ≤ I.size) (hN : (s.cin * (s.h + 2) + 3) * (s.w + 2) < 2 ^ 32) : FloatArray := fRV I s hs hI s.w.toUSize (s.w + 2).toUSize (xF0 s hN).1 (xF0 s hN).2.1 (s.cin * (s.h + 2)) rfl 0 0 0 0 (xT ((s.cin * (s.h + 2) + 3) * (s.w + 2))) (xF0 s hN).2.2 theorem xF_spec (s : ConvShape) (I : Array Word) (hs : I.size < 2 ^ 32) (hI : s.cin * s.h * s.w ≤ I.size) (hN : (s.cin * (s.h + 2) + 3) * (s.w + 2) < 2 ^ 32) : (s.cin * (s.h + 2) + 3) * (s.w + 2) ≤ (xF s I hs hI hN).size ∧ (xF s I hs hI hN).size < 2 ^ 32 ∧ ∀ q < (xF s I hs hI hN).size, (xF s I hs hI hN).data[q]! = Dense.F.dw (pW3 s I (q / ((s.h + 2) * (s.w + 2))) (q / (s.w + 2) % (s.h + 2)) (q % (s.w + 2))) := by obtain ⟨z1, z2, z3⟩ := xT_spec ((s.cin * (s.h + 2) + 3) * (s.w + 2)) have := fRV_spec I s hs hI _ _ (xF0 s hN).1 (xF0 s hN).2.1 _ rfl _ 0 0 0 0 _ (xF0 s hN).2.2 _ rfl rfl fun q hq => by simp [z3 q hq] rw [xF, this.1]; exact ⟨z1, by clear*-hN z2;omega, this.2⟩ theorem bnd8 (h w cin nc cb y xb HV V : Nat) (hV : V = w + 2) (hHV : HV = (h + 2) * V) (hy : y < h) (hx : xb < w) (hc : cb + nc ≤ cin) (hnc : 0 < nc) : cb * HV + y * V + xb + ((nc - 1) * HV + 2 * V + 2) + 8 ≤ (cin * (h + 2) + 3) * V := by have e1 : cb * HV + (nc - 1) * HV + HV ≤ cin * HV := by rw [← Nat.add_mul, ← Nat.succ_mul]; exact Nat.mul_le_mul_right HV (by clear*-hc hnc;omega) have e2 : y * V + V ≤ h * V := by rw [← Nat.succ_mul]; exact Nat.mul_le_mul_right V hy have e3 : HV = h * V + 2 * V := by rw [hHV]; ring have e4 : (cin * (h + 2) + 3) * V = cin * HV + 3 * V := by rw [hHV]; ring clear hHV hc hnc hy;omega theorem ow_S (d : CD) (c : CC d.M) (nc IX IW IB P : Nat) (ix : Nat → Nat) (hs : geo d.s d.kk) (hnc : 0 < nc) (hkn : d.k = nc * d.kk) (hc : ∀ o < d.Y, (if d.D then o else 0) + nc ≤ d.s.cin) (hM : d.M = (nc - 1) * ((d.s.h + 2) * (d.s.w + 2)) + 2 * (d.s.w + 2) + 2) (hTv : ∀ t < d.k, d.T[t]! = pc d.kk t * ((d.s.h + 2) * (d.s.w + 2)) + py d.kk t * (d.s.w + 2) + px d.kk t) (hT : ∀ t < d.k, d.T[t]! ≤ d.M) (hXs : (d.s.cin * (d.s.h + 2) + 3) * (d.s.w + 2) ≤ d.X.size) (hXv : ∀ q < d.X.size, d.X.data[q]! = Dense.F.dw (pW3 d.s d.I (q / ((d.s.h + 2) * (d.s.w + 2))) (q / (d.s.w + 2) % (d.s.h + 2)) (q % (d.s.w + 2)))) (hx : ∀ q : Nat, expOf d.I[q]! ≠ 255 ∧ idxOf d.I[q]! ≤ IX) (hw : ∀ q : Nat, expOf d.K[q]! ≠ 255 ∧ idxOf d.K[q]! ≤ IW) (hb : ∀ q : Nat, expOf d.b[q]! ≠ 255 ∧ idxOf d.b[q]! ≤ IB) (hP1 : 48 + IX + IW ≤ P) (hP2 : 174 + IB ≤ P) (hL : d.k + 2 ≤ 2 ^ d.L) (hL27 : d.L ≤ 27) (hPL : P + d.L ≤ 425) (hhv : d.hh.toNat = P + 2 * d.L - 54) (o y x : Nat) (ho : o < d.Y) (hy : y < d.s.h) (hj : x < d.s.w) (hcn : c.n ≤ d.k) (hix : ∀ j < c.n, ix j < d.k ∧ c.Tz[j]! = d.T[ix j]! ∧ c.Wz.data[c.wo + j]! = Dense.F.dw d.K[o * d.k + ix j]!) (hsum : ∀ z : Nat → ℝ, (∀ s < d.k, Core.mW d.K[o * d.k + s]! = 0 → z s = 0) → ∑ j ∈ range c.n, z (ix j) = ∑ s ∈ range d.k, z s) (S : Float) (hS : S = Dense.F.sfold (fun j => d.X.data[(if d.D then o else 0) * ((d.s.h + 2) * (d.s.w + 2)) + y * (d.s.w + 2) + x + c.Tz[j]!]! * c.Wz.data[c.wo + j]!) c.n 0 (Dense.F.dw oneW * Dense.F.dw d.b[o]!)) : ow1 d o y x S = act d.J (fbk d.s d.I d.K d.b d.kk d.k (if d.D then o else 0) o y x) := by have hcb := hc o ho have hB := bnd8 d.s.h d.s.w d.s.cin nc _ y x _ _ rfl rfl hy hj hcb hnc have hbp := Dense.F.pvV oneW d.b[o]! (by decide) (hb _).1 have hza := (Dense.F.tmB oneW d.b[o]! 126 IB (by decide) (hb _).2).trans (pow_le_pow_right₀ one_le_two (by omega : _ ≤ P)) simp only [ow1_eq, hS, ow, fbz_eq, fbk, Dense.F.gg, Dense.x2d_eq] generalize (if d.D then o else 0) = cb at * generalize hq : cb * ((d.s.h + 2) * (d.s.w + 2)) + y * (d.s.w + 2) + x = q at * have W := winB d.s d.I IX hx y x have E := fun u v => (Dense.F.tmB (windowAt d.s d.I y x u) d.K[v]! _ _ (W _).2 (hw _).2).trans (pow_le_pow_right₀ one_le_two hP1) have V := fun u v => Dense.F.pvV (windowAt d.s d.I y x u) d.K[v]! (W _).1 (hw _).1 have hX : ∀ t < d.k, d.X.data[q + d.T[t]!]! = Dense.F.dw (windowAt d.s d.I y x (cb * d.kk + t)) := fun t ht => by obtain ⟨q1, q2, q3⟩ := decomp (cb + pc d.kk t) (y + py d.kk t) (x + px d.kk t) (d.s.h + 2) (d.s.w + 2) (by have := py_le d.kk t; clear*-hy this;(exact Nat.add_lt_add_of_lt_of_le hy this)) (by have := px_le d.kk t; clear*-hj this;(exact Nat.add_lt_add_of_lt_of_le hj this)) rw [hXv _ (by have := hT t ht; clear*-hB hM hXs this;omega), show q + d.T[t]! = ((cb + pc d.kk t) * (d.s.h + 2) + (y + py d.kk t)) * (d.s.w + 2) + (x + px d.kk t) by rw [← hq, hTv t ht]; ring, q1, q2, q3, pv_win d.s d.I d.kk hs y x t _ hy hj (by have := pc_lt d.kk t nc (hs.imp (·.2.2.2.2) (·.2.2.2.2)) (hkn ▸ ht); clear*-hcb this;omega)] obtain ⟨fS, eS⟩ := Dense.F.sfold_Z _ _ _ _ _ rfl ▸ Dense.F.sfZ_err (fun _ => false) (fun j => d.X.data[q + c.Tz[j]!]! * c.Wz.data[c.wo + j]!) _ _ P d.L c.n (fun j hj => by obtain ⟨i1, i2, i3⟩ := hix j hj; rw [i2, i3, hX _ i1]; exact V _ _) (fun _ _ => nofun) (fun j _ => E _ _) hza (by clear*-hL hcn;omega) hL27 (by clear*-hPL;omega) c.n 0 _ rfl c.n.zero_le hbp.1 (by simp [hbp.2]) refine Dense.F.twS _ _ _ _ _ _ _ _ _ _ (fun t ht => ?_) (by simpa using hbp) (fun t _ => ?_) (fun t _ => ?_) hL hL27 hPL hhv rfl _ fS (Eq.trans_le ?_ (eS.trans ?_)) ·simp only [if_pos ht, hX t ht]; exact V _ _ ·split; exacts [⟨(W _).1, (hw _).1⟩, ⟨by decide, (hb _).1⟩] ·split; exacts [E _ _, hza] ·rw [Core.tsum_succ, Core.tsum]; push_cast; rw [← hsum] ·simp only [lt_irrefl, if_false]; rw [add_comm]; congr 3 exact Finset.sum_congr rfl fun j hj => by simp [(hix j (mr hj)).1] ·exact fun s hs0 h0 => by simp [hs0, tm, sv, ← Core.mW_toNat, h0] calc _ ≤ (2 : ℝ) ^ d.L * (2 ^ (P + d.L) * 2 ^ (-54 : Int)) := by gcongr; exact_mod_cast (by clear*-hL hcn;omega : c.n ≤ 2 ^ d.L) _ = _ := by rw [hhv, ← zpow_natCast, ← zpow_natCast, ← zpow_add₀ two_ne_zero, ← zpow_add₀ two_ne_zero]; congr 1; clear*-hL27 hP2;omega def cvM (d : CD) (Z : Bool) (Wd : FloatArray) (cs : Array (CC d.M)) (hT : ∀ t < d.k, d.T[t]! ≤ d.M) (hk : d.k < 2 ^ 32) (hkT : d.k ≤ d.T.size) (hW : Z = true ∨ d.Y * d.k ≤ Wd.size ∧ Wd.size < 2 ^ 32) (hY : d.Y * d.k < 2 ^ 32) : Array Word := if Z then cvS d cs 0 0 (Array.replicate (d.Y * (d.s.h * d.s.w)) 0) else lp3 d.Y (d.s.h * d.s.w) 0 0 (by have := USize.le_size; simp only [USize.reduceToNat, Nat.mul_zero]; (exact Nat.lt_of_add_left_lt this)) (fun o ho q _ _ a => chS d (mkc d Z Wd hT hk hkT hW hY o ho) o q a) 0 0 0 (by simp) (Array.replicate (d.Y * (d.s.h * d.s.w)) 0) theorem oE {A a : Array Word} {M N} {G : Nat → Word} (h : A.size = a.size ∧ ∀ j < a.size, A[j]! = if 0 ≤ j ∧ j < M then G j else a[j]!) (hN : a.size = N) (hM : M = N) : A = ofFnN N G := by subst hM; refine Array.ext (by simp [h.1, hN]) fun i h1 h2 => ?_; have := h.2 i (h.1 ▸ h1); simp only [Array.size_ofFn] at h2; rw [getElem!_pos A i h1, if_pos ⟨Nat.zero_le _, h2⟩] at this; simp [this] theorem cvM_eq (d : CD) (Z : Bool) (Wd : FloatArray) (hW : Z = true ∨ d.Y * d.k ≤ Wd.size ∧ Wd.size < 2 ^ 32) (nc IX IW IB P : Nat) (hs : geo d.s d.kk) (hnc : 0 < nc) (hkn : d.k = nc * d.kk) (hc : ∀ o < d.Y, (if d.D then o else 0) + nc ≤ d.s.cin) (hM : d.M = (nc - 1) * ((d.s.h + 2) * (d.s.w + 2)) + 2 * (d.s.w + 2) + 2) (hTv : ∀ t < d.k, d.T[t]! = pc d.kk t * ((d.s.h + 2) * (d.s.w + 2)) + py d.kk t * (d.s.w + 2) + px d.kk t) (hT : ∀ t < d.k, d.T[t]! ≤ d.M) (hkT : d.k ≤ d.T.size) (hk32 : d.k < 2 ^ 32) (hY32 : d.Y * d.k < 2 ^ 32) (hXs : (d.s.cin * (d.s.h + 2) + 3) * (d.s.w + 2) ≤ d.X.size) (hXv : ∀ q < d.X.size, d.X.data[q]! = Dense.F.dw (pW3 d.s d.I (q / ((d.s.h + 2) * (d.s.w + 2))) (q / (d.s.w + 2) % (d.s.h + 2)) (q % (d.s.w + 2)))) (hWd : Z = false → Wd.size < 2 ^ 32 ∧ ∀ q < d.Y * d.k, Wd.data[q]! = Dense.F.dw d.K[q]!) (hx : ∀ q : Nat, expOf d.I[q]! ≠ 255 ∧ idxOf d.I[q]! ≤ IX) (hw : ∀ q : Nat, expOf d.K[q]! ≠ 255 ∧ idxOf d.K[q]! ≤ IW) (hb : ∀ q : Nat, expOf d.b[q]! ≠ 255 ∧ idxOf d.b[q]! ≤ IB) (hP1 : 48 + IX + IW ≤ P) (hP2 : 174 + IB ≤ P) (hL : d.k + 2 ≤ 2 ^ d.L) (hL27 : d.L ≤ 27) (hPL : P + d.L ≤ 425) (hhv : d.hh.toNat = P + 2 * d.L - 54) (cs : Array (CC d.M)) (hcs : Z = true → ∀ o < d.Y, CP d cs[o]! o) (hw0 : 0 < d.s.w) (hN32 : d.Y * (d.s.h * d.s.w) < 2 ^ 32) : cvM d Z Wd cs hT hk32 hkT hW hY32 = ofFnN (d.Y * (d.s.h * d.s.w)) fun q => act d.J (fbk d.s d.I d.K d.b d.kk d.k (if d.D then q / (d.s.h * d.s.w) else 0) (q / (d.s.h * d.s.w)) (q / d.s.w % d.s.h) (q % d.s.w)) := by have hf : ∀ o < d.Y, ∀ q (a : Array Word) c, CP d c o → q = o * (d.s.h * d.s.w) → a.size = d.Y * (d.s.h * d.s.w) → (chS d c o q a).size = a.size ∧ ∀ j < a.size, (chS d c o q a)[j]! = if q ≤ j ∧ j < q + d.s.h * d.s.w then act d.J (fbk d.s d.I d.K d.b d.kk d.k (if d.D then j / (d.s.h * d.s.w) else 0) (j / (d.s.h * d.s.w)) (j / d.s.w % d.s.h) (j % d.s.w)) else a[j]! := by rintro o ho q a c ⟨-, ix, hcn, hix, hsum⟩ hq hN; have := USize.le_size; have := d.hX; have := (Nat.le_mul_of_pos_left (d.s.w + 2) (Nat.succ_pos _)).trans hXs; have := ml (d.s.h * d.s.w) ho; simp only [chS, show wt8m = wt8 from rfl, ite_self] refine pln_eq _ _ _ _ _ _ _ _ (fun y hy q' i a' hI hi hq' hN' => ?_) hN (by clear hL hL27 hM hN hN32 hP1 hP2 hPL hT hTv hW hWd hXs hXv hY32 hb hc hcn hcs hhv hix hk32 hkT hkn hnc ho hq hs hsum hw hx this;omega) fun hh0 => by have hbd := bnd8 d.s.h d.s.w _ nc _ (d.s.h - 1) (d.s.w - 1) _ _ rfl rfl (by clear*-hh0;(exact Nat.sub_one_lt_of_lt hh0)) (by clear*-hw0;(exact Nat.sub_one_lt_of_lt hw0)) (hc o ho) hnc; clear*-hM hXs hbd hw0;omega have := ml d.s.w hy; have e1 := toUSize_toNat d.s.w (by clear hI hL hL27 hM hN hN' hP1 hP2 hPL hT hTv hW hWd hXs hXv hY32 hb hc hcn hcs hhv hi hix hk32 hkT hkn hnc ho hq hq' hs hsum hw hw0 hx hy;omega); have e2 := toUSize_toNat q' (by clear e1 hI hL hL27 hM hN hN' hP1 hP2 hPL hT hTv hW hWd hXs hXv hY32 hb hc hcn hcs hhv hi hix hk32 hkT hkn hnc ho hs hsum hw hw0 hx hy;omega); have e : (o * d.s.h + y) * d.s.w = q' := by rw [Nat.add_mul, Nat.mul_assoc, hq', hq] obtain ⟨s, g⟩ := rB_eq d c o y _ rfl _ (fun xb r x e h2 h3 => ow_S _ _ _ _ _ _ _ _ hs hnc hkn hc hM hTv hT hXs hXv hx hw hb hP1 hP2 hL hL27 hPL hhv o y x ho hy h3 hcn hix hsum _ (by subst e; unfold sfB; congr 1; funext t; congr 2; clear*-;omega)) _ 0 _ q'.toUSize _ a' hI le_rfl (by simp [e1]) (by simp [hi]) (by clear e hI hL hL27 hM hN hN32 hP1 hP2 hPL hT hTv hW hWd hXs hXv hY32 hb hc hcn hcs hhv hi hix hk32 hkT hkn hnc ho hs hsum hw hw0 hx hy;omega) (by clear*-hN' hN32;omega) refine ⟨s, fun i hi => ?_⟩; rw [g i hi, e1, e2]; refine ite_congr rfl (fun hc' => ?_) fun _ => rfl; obtain ⟨q1, q2, q3⟩ := decomp o y (i - q') d.s.h d.s.w hy (by clear*-hc';omega); rw [e, Nat.add_sub_of_le hc'.1] at q1 q2 q3; simp only [q1, q2, q3, USize.toNat_zero, Nat.zero_add] unfold cvM; split ·rename_i hZ; exact oE (cvS_eq _ _ (hcs hZ) _ _ hf _ 0 0 _ rfl (by simp) (by simp)) (by simp) rfl ·exact oE (lp3_eq _ _ _ _ _ _ 0 _ _ (fun o ho q _ _ a hq hN => hf o ho q a _ (mkc_spec _ _ _ _ _ _ _ _ hWd o ho _ rfl) (by clear*-hq;omega) hN) _ 0 0 0 _ _ rfl (by simp) (by simp) (by simp)) (by simp) (Nat.zero_add _) theorem wdb (K : Array Word) (n : Nat) : (Dense.F.bld (fun q => Dense.F.dw K[q]!) n (FloatArray.emptyWithCapacity n)).size = n ∧ ∀ q < n, (Dense.F.bld (fun q => Dense.F.dw K[q]!) n (FloatArray.emptyWithCapacity n)).data[q]! = Dense.F.dw K[q]! := by obtain ⟨i1, -, i3⟩ := Dense.F.bld_spec (fun q => Dense.F.dw K[q]!) n _ (FloatArray.emptyWithCapacity n) rfl (by simp [FloatArray.emptyWithCapacity, FloatArray.size]) exact ⟨i1, fun q hq => i3 q (by simp [FloatArray.emptyWithCapacity, FloatArray.size]) hq⟩ def wd (Z : Bool) (K : Array Word) (n : Nat) (hn : n < 2 ^ 32) (hK : n ≤ K.size) (hs : K.size < 2 ^ 32) : {W : FloatArray // Z = true ∨ n ≤ W.size ∧ W.size < 2 ^ 32} := if hZ : Z = true then ⟨FloatArray.emptyWithCapacity 0, Or.inl hZ⟩ else ⟨Dense.F.bld (fun q => Dense.F.dw K[q]!) n (FloatArray.emptyWithCapacity n), Or.inr (by rw [(wdb K n).1]; omega)⟩ theorem wdv (K : Array Word) (n : Nat) (hn : n < 2 ^ 32) (hK : n ≤ K.size) (hs : K.size < 2 ^ 32) : (wd false K n hn hK hs).1.size = n ∧ ∀ q < n, (wd false K n hn hK hs).1.data[q]! = Dense.F.dw K[q]! := by unfold wd; rw [dif_neg Bool.false_ne_true]; exact wdb K n @[noinline] def b32 : Nat := 2 ^ 32 @[inline] def pk (kk nc H V : Nat) : Nat := ((kk * 65536 + nc) * 65536 + H) * 65536 + V theorem pk_d (kk nc H V : Nat) (h1 : nc < 65536) (h2 : H < 65536) (h3 : V < 65536) : pk kk nc H V / 281474976710656 = kk ∧ pk kk nc H V / 4294967296 % 65536 = nc ∧ pk kk nc H V / 65536 % 65536 = H ∧ pk kk nc H V % 65536 = V := by have e : pk kk nc H V = kk * 281474976710656 + nc * 4294967296 + H * 65536 + V := by unfold pk; ring rw [e]; clear e;omega abbrev tT (kk nc HV V : Nat) : Array Nat := Dense.F.ofA (fun t => pc kk t * HV + py kk t * V + px kk t) (nc * kk) (Array.emptyWithCapacity (nc * kk)) theorem mkq (K : Array Word) (k o : Nat) (ho : o < K.size / k) (hs : K.size < 2 ^ 32) : (o * k).toUSize.toNat = o * k ∧ k.toUSize.toNat = k ∧ o * k + k ≤ K.size := by have h0 := Nat.div_mul_le_self K.size k have h1 := Nat.mul_le_mul_right k (show o + 1 ≤ K.size / k from ho) rw [Nat.add_mul, Nat.one_mul] at h1 have := USize.le_size exact ⟨Dense.toUSize_toNat (by clear ho;omega), Dense.toUSize_toNat (by clear ho;omega), by clear*-h0 h1;(exact Nat.le_trans h1 h0)⟩ def mkO (K : Array Word) (T : Array Nat) (M k : Nat) (hs : K.size < 2 ^ 32) (hT : ∀ t < k, T[t]! ≤ M) (hkT : k ≤ T.size) (o : Fin (K.size / k)) : CC M := nzu K T M (o.val * k).toUSize k.toUSize (by have e := mkq K k o.val o.isLt hs; rw [e.1, e.2.1]; exact ⟨e.2.2, hs⟩) (by rw [(mkq K k o.val o.isLt hs).2.1]; exact hT) (by rw [(mkq K k o.val o.isLt hs).2.1]; exact hkT) 0 0 (Array.replicate k 0) ⟨Array.replicate k 0⟩ (by rw [(mkq K k o.val o.isLt hs).2.1]; exact ⟨Array.size_replicate .., Array.size_replicate ..⟩) (by simp) (fun j hj => by simp at hj) def mkC (K : Array Word) (kk nc HV V : Nat) : Array (CC ((nc - 1) * HV + 2 * V + 2)) := if hg : (kk = 9 ∨ kk = 1) ∧ K.size < 2 ^ 32 then Array.ofFn (mkO K (tT kk nc HV V) _ (nc * kk) hg.2 (tM kk nc HV V hg.1) (tV kk nc HV V).1.ge) else #[] theorem mkC_e (K : Array Word) (kk nc HV V : Nat) (hk : kk = 9 ∨ kk = 1) (hs : K.size < 2 ^ 32) : mkC K kk nc HV V = Array.ofFn (mkO K (tT kk nc HV V) _ (nc * kk) hs (tM kk nc HV V hk) (tV kk nc HV V).1.ge) := by unfold mkC; rw [dif_pos ⟨hk, hs⟩] theorem mkC_P (d : CD) (hs : d.K.size < 2 ^ 32) (hT : ∀ t < d.k, d.T[t]! ≤ d.M) (hkT : d.k ≤ d.T.size) (hY : d.Y * d.k < 2 ^ 32) (hk : 0 < d.k) (cs : Array (CC d.M)) (hc : cs = Array.ofFn (mkO d.K d.T d.M d.k hs hT hkT)) (o : Nat) (ho : o < d.Y) : CP d cs[o]! o := by have h' : o < d.K.size / d.k := by have h1 := Nat.mul_le_mul_right d.k (show o + 1 ≤ d.Y from ho) exact (Nat.le_div_iff_mul_le hk).2 (h1.trans d.hK.1) subst hc rw [getElem!_pos _ _ (by simpa using h'), Array.getElem_ofFn] exact (nzP d hT hkT hY o ho (Array.replicate d.k 0) ⟨Array.replicate d.k 0⟩ ⟨Array.size_replicate .., Array.size_replicate ..⟩ _ rfl).2.2 def mkW (K : Array Word) (Z : Bool) : FloatArray := if hs : K.size < 2 ^ 32 then (wd Z K K.size hs le_rfl hs).1 else FloatArray.emptyWithCapacity 0 theorem mkW_s (K : Array Word) (Z : Bool) (n : Nat) (hs : K.size < 2 ^ 32) (hn : n ≤ K.size) : Z = true ∨ n ≤ (mkW K Z).size ∧ (mkW K Z).size < 2 ^ 32 := by unfold mkW; rw [dif_pos hs]; exact (wd Z K K.size hs le_rfl hs).2.imp id fun h => ⟨hn.trans h.1, h.2⟩ theorem mkW_v (K : Array Word) (n : Nat) (hs : K.size < 2 ^ 32) (hn : n ≤ K.size) : (mkW K false).size < 2 ^ 32 ∧ ∀ q < n, (mkW K false).data[q]! = Dense.F.dw K[q]! := by unfold mkW; rw [dif_pos hs]; obtain ⟨a, b⟩ := wdv K K.size hs le_rfl hs; exact ⟨by rw [a]; exact hs, fun q hq => b q (by clear a;(exact Nat.lt_of_lt_of_le hq hn))⟩ structure PV where M : Nat ew : UInt32 eb : UInt32 T : Array Nat Z : Bool W : FloatArray cs : Array (CC M) def mkP (K b : Array Word) (kk nc H V : Nat) : PV := ⟨(nc - 1) * (H * V) + 2 * V + 2, Dense.F.emx K 0 0, Dense.F.emx b 0 0, tT kk nc (H * V) V, K.any (fun u => Core.mW u == 0), mkW K (K.any fun u => Core.mW u == 0), if K.any (fun u => Core.mW u == 0) then mkC K kk nc (H * V) V else #[]⟩ def mkPV (K b : Array Word) (n : Nat) : PV := mkP K b (n / 281474976710656) (n / 4294967296 % 65536) (n / 65536 % 65536) (n % 65536) theorem mkPV_pk (K b : Array Word) (kk nc H V : Nat) (h1 : nc < 65536) (h2 : H < 65536) (h3 : V < 65536) : mkPV K b (pk kk nc H V) = mkP K b kk nc H V := by obtain ⟨e1, e2, e3, e4⟩ := pk_d kk nc H V h1 h2 h3; unfold mkPV; rw [e1, e2, e3, e4] @[noinline] def TC : Sr.Tab mkPV := Sr.Tab.make mkPV 64 (2 ^ 22) def cvP (s : ConvShape) (J : Bool) (I K b : Array Word) (D : Bool) (nc Y : Nat) (hq : geo s (s.kh * s.kw)) (p : PV) (hv : p = mkP K b (s.kh * s.kw) nc (s.h + 2) (s.w + 2)) : Array Word := let H := s.h + 2 let V := s.w + 2 let HV := H * V let kk := s.kh * s.kw let k := nc * kk let ex := Dense.F.emx I 0 0 let ew := p.ew let eb := p.eb let P := max (48 + (ex.toNat - 1) + (ew.toNat - 1)) (174 + (eb.toNat - 1)) let L := Nat.log2 (k + 1) + 1 if hg : 0 < s.h ∧ 0 < s.w ∧ 0 < nc ∧ ex < 255 ∧ ew < 255 ∧ eb < 255 ∧ P + L ≤ 425 ∧ L ≤ 27 ∧ I.size < b32 ∧ K.size < b32 ∧ b.size < b32 ∧ (s.cin * H + 3) * V < b32 ∧ s.w < b32 ∧ Y * k < b32 ∧ k < b32 ∧ s.cin * s.h * s.w ≤ I.size ∧ Y * (s.h * s.w) < b32 ∧ Y * k ≤ K.size then have ⟨_, _, _, _, _, _, _, _, hIs, hKs, _, hX32, hw32, hY32, hk32, hI, _, hYK⟩ := hg have hT : ∀ t < k, p.T[t]! ≤ p.M := by subst hv; exact tM kk nc HV V (hq.imp (fun h => h.2.2.2.2) (fun h => h.2.2.2.2)) have hkT : k ≤ p.T.size := by subst hv; exact (tV kk nc HV V).1.ge have hW : p.Z = true ∨ Y * k ≤ p.W.size ∧ p.W.size < 2 ^ 32 := by subst hv; exact mkW_s K _ _ hKs hYK cvM ⟨s, I, K, b, xF s I hIs hI hX32, p.T, D, J, k, p.M, L, (P + 2 * L - 54).toUInt64, Y, kk, (xF_spec s I hIs hI hX32).2.1, ⟨hYK, hKs⟩⟩ p.Z p.W p.cs hT hk32 hkT hW hY32 else dF s J I K b D theorem cvP_eq (s : ConvShape) (J : Bool) (I K b : Array Word) (D : Bool) (nc Y : Nat) (hd : D = false ∧ nc = s.cin ∧ Y = s.cout ∨ D = true ∧ nc = 1 ∧ Y = s.cin) (hs : geo s (s.kh * s.kw)) (p : PV) (hv : p = mkP K b (s.kh * s.kw) nc (s.h + 2) (s.w + 2)) : cvP s J I K b D nc Y hs p hv = dS s J I K b D := by subst hv; unfold cvP b32; dsimp only [mkP]; split; swap; exact dF_eq s J I K b D; rename_i hg; obtain ⟨-, hw0, hnc, hex, hew, heb, hPL, hL27, hIs, hKs, hbs, hX32, -, hY32, hk32, hI, hN32, hYK⟩ := hg; obtain ⟨hA, hB⟩ : s.ho = s.h ∧ s.wo = s.w := by rcases hs with ⟨h1, h2, h3, h4, -⟩ | ⟨h1, h2, h3, h4, -⟩ <;> simp [ConvShape.ho, ConvShape.wo, h1, h2, h3, h4] <;> (clear h1 h2 h3 h4 hI hIs hKs hL27 hN32 hPL hX32 hY32 hYK hbs hd heb hew hex hk32 hnc;omega) have hk9 : s.kh * s.kw = 9 ∨ s.kh * s.kw = 1 := hs.imp (fun h => h.2.2.2.2) (fun h => h.2.2.2.2) have hk0 : 0 < nc * (s.kh * s.kw) := Nat.mul_pos hnc (by rcases hk9 with h | h <;> (clear*-h;omega)) obtain ⟨hXs, -, hXv⟩ := xF_spec s I hIs hI hX32; have := USize.le_size; rw (config := { transparency := .default }) [cvM_eq _ _ _ _ nc _ _ _ _ ‹_› hnc (by rfl) (fun o ho => by rcases hd with ⟨rfl, rfl, rfl⟩ | ⟨rfl, rfl, rfl⟩ <;> simp <;> (exact Nat.lt_of_succ_le ho)) (by rfl) (by exact (tV _ _ _ _).2) (by exact tM _ _ _ _ hk9) (by exact (tV _ _ _ _).1.ge) ‹_› ‹_› ‹_› ‹_› (fun hZ => by dsimp only; rw [hZ]; exact mkW_v K _ hKs hYK) (by exact Dense.F.exF I (by clear*-hIs this;omega) hex) (by exact Dense.F.exF K (by clear*-hKs this;omega) hew) (by exact Dense.F.exF b (by clear*-hbs this;omega) heb) (le_max_left _ _) (le_max_right _ _) (by exact Nat.lt_log2_self) ‹_› ‹_› (by dsimp only; rw [Nat.toUInt64_eq, UInt64.toNat_ofNat_of_lt' (by simp only [UInt64.size]; clear*-hL27 hPL;omega)]) _ (fun hZ o ho => by rw [if_pos hZ]; exact mkC_P _ hKs _ _ hY32 hk0 _ (mkC_e K _ nc _ _ hk9 hKs) o ho) ‹_› ‹_›]; rcases hd with ⟨rfl, rfl, rfl⟩ | ⟨rfl, rfl, rfl⟩ <;> simp only [dS, fT, ite_true, ite_false, conv2dSpec, conv2dWith, depthwiseSpec, depthwiseWith, hA, hB] <;> refine Array.ext (by simp [hA, hB]) fun q _ _ => ?_ <;> simp only [ofFnN, Array.getElem_ofFn, fbk, Dense.x2d_eq, Nat.mul_assoc, Nat.one_mul, Nat.zero_mul, Nat.zero_add] def cvN (s : ConvShape) (J : Bool) (I K b : Array Word) (D : Bool) (nc Y : Nat) : Array Word := if hq : geo s (s.kh * s.kw) ∧ nc < 65536 ∧ s.h + 2 < 65536 ∧ s.w + 2 < 65536 then let p := TC.get K b (pk (s.kh * s.kw) nc (s.h + 2) (s.w + 2)) cvP s J I K b D nc Y hq.1 p.1 (p.2.trans (mkPV_pk K b _ nc _ _ hq.2.1 hq.2.2.1 hq.2.2.2)) else dF s J I K b D theorem cvN_eq (s : ConvShape) (J : Bool) (I K b : Array Word) (D : Bool) (nc Y : Nat) (hd : D = false ∧ nc = s.cin ∧ Y = s.cout ∨ D = true ∧ nc = 1 ∧ Y = s.cin) : cvN s J I K b D nc Y = dS s J I K b D := by unfold cvN; split ·exact cvP_eq s J I K b D nc Y hd _ _ _ ·exact dF_eq s J I K b D @[inline] def rs : ConvShape := if s.kh = 1 ∧ s.kw = 1 ∧ s.stride = 1 ∧ s.pad = 0 ∧ 0 < s.h ∧ s.w % 8 ≠ 0 then if s.h * s.w % 16 = 0 then { s with h := s.h * s.w / 16, w := 16 } else if s.h * s.w % 20 = 0 ∧ s.w < 20 then { s with h := s.h * s.w / 20, w := 20 } else s else s theorem c1 (h1 : s.kh = 1) (h2 : s.kw = 1) (h3 : s.stride = 1) (h4 : s.pad = 0) (hh : 0 < s.h) (hw : 0 < s.w) : conv2dSpec s J I K b = Array.ofFn (n := s.cout * (s.h * s.w)) fun q => act J (dotOf (s.cin + 1) (fun t => if t < s.cin then I[t * (s.h * s.w) + q.val % (s.h * s.w)]! else oneW) fun t => if t < s.cin then K[q.val / (s.h * s.w) * s.cin + t]! else b[q.val / (s.h * s.w)]!) := by have hA : s.ho = s.h := by simp [ConvShape.ho, h1, h3, h4]; clear*-hh;(exact Nat.sub_add_cancel hh) have hB : s.wo = s.w := by simp [ConvShape.wo, h2, h3, h4]; clear*-hw;(exact Nat.sub_add_cancel hw) simp only [conv2dSpec, conv2dWith] refine Array.ext (by simp [hA, hB]) fun q _ _ => ?_ simp only [Array.getElem_ofFn, hA, hB, h1, h2, Nat.mul_one] congr 2; funext t; split_ifs <;> [skip; rfl] have := Nat.mod_lt (q / s.w) hh; have := Nat.mod_lt q hw simp only [windowAt, h1, h2, h3, h4, Nat.mul_one, Nat.div_one, Nat.mod_one, Nat.add_zero, Nat.sub_zero] rw [if_neg (by clear h1 h2 h3 h4 hA hB hh hw;omega), Nat.mul_comm s.h s.w, Nat.mod_mul]; congr 1; ring theorem rs_eq : conv2dSpec (rs s) J I K b = conv2dSpec s J I K b := by unfold rs; split ·obtain ⟨h1, h2, h3, h4, h0, h8⟩ := ‹_ ∧ _›; have hw : 0 < s.w := by clear*-h8;omega have := Nat.mul_pos h0 hw; split <;> [skip; split <;> [skip; rfl]] all_goals rw [c1 s J I K b h1 h2 h3 h4 h0 hw, c1 _ J I K b ‹_› ‹_› ‹_› ‹_› (by dsimp only; clear h0 h1 h2 h3 h4 h8 hw;omega) (by exact Nat.succ_pos _), Nat.div_mul_cancel (by clear h0 h1 h2 h3 h4 h8 hw this;omega)] rfl def conv2d : Array Word := cvN (rs s) J I K b false (rs s).cin (rs s).cout def depthwise : Array Word := cvN s J I K b true 1 s.cin theorem conv2d_eq : conv2d = conv2dSpec := by funext s J I K b; rw [← rs_eq]; exact cvN_eq (rs s) J I K b false (rs s).cin (rs s).cout (.inl ⟨rfl, rfl, rfl⟩) theorem depthwise_eq : depthwise = depthwiseSpec := by funext s J I K b; exact cvN_eq s J I K b true 1 s.cin (.inr ⟨rfl, rfl, rfl⟩) theorem expOf_nat : (expOf u).toNat = u.toNat / 2 ^ 23 % 256 := by unfold expOf rw [UInt32.toNat_and, UInt32.toNat_shiftRight, show (0xFF : UInt32).toNat = 2 ^ 8 - 1 from rfl, Nat.and_two_pow_sub_one_eq_mod] simp [Nat.shiftRight_eq_div_pow] theorem fracOf_nat : (fracOf u).toNat = u.toNat % 2 ^ 23 := by unfold fracOf;rw [UInt32.toNat_and, show (0x7FFFFF : UInt32).toNat = 2 ^ 23 - 1 from rfl, Nat.and_two_pow_sub_one_eq_mod] def Kf : Nat := (if m / 2 ^ 23 = 0 then m % 2 ^ 23 else 2 ^ 23 + m % 2 ^ 23) * 2 ^ (if m / 2 ^ 23 = 0 then 0 else m / 2 ^ 23 - 1) theorem Kf_up : Kf m < 2 ^ (m / 2 ^ 23 + 23) := by unfold Kf split_ifs with h ·rw [h]; clear*-;omega ·have := Nat.mul_lt_mul_of_pos_right (show 2 ^ 23 + m % 2 ^ 23 < 2 ^ 24 by omega) (Nat.two_pow_pos (m / 2 ^ 23 - 1));rwa [← pow_add, show 24 + (m / 2 ^ 23 - 1) = m / 2 ^ 23 + 23 by clear*-h;omega] at this theorem Kf_mono (m1 m2 : Nat) (h : m1 < m2) : Kf m1 < Kf m2 := by rcases (Nat.div_le_div_right (c := 2 ^ 23) h.le).eq_or_lt with h3 | h4 ·unfold Kf; rw [h3]; split_ifs <;> [omega; exact Nat.mul_lt_mul_of_pos_right (by omega) (by positivity)] ·have := Kf_up m1; have : 2 ^ (m2 / 2 ^ 23 + 22) ≤ Kf m2 := by unfold Kf; rw [if_neg (by clear*-h4;(exact Nat.ne_zero_of_lt h4)), if_neg (by clear*-h4;(exact Nat.ne_zero_of_lt h4)), show m2 / 2 ^ 23 + 22 = 23 + (m2 / 2 ^ 23 - 1) by clear*-h4;omega, pow_add]; exact Nat.mul_le_mul_right _ (by clear*-;(exact Nat.le_add_right (2 ^ 23) (m2 % 2 ^ 23))) have := Nat.pow_le_pow_right two_pos (show m1 / 2 ^ 23 + 23 ≤ m2 / 2 ^ 23 + 22 by clear*-h4;(exact Nat.le_add_of_sub_le h4)); clear h h4;omega def kv (w : Word) : Int := sv w * 2 ^ idxOf w theorem kv_K : kv u = if 2 ^ 31 ≤ u.toNat then -(Kf (u.toNat % 2 ^ 31) : Int) else (Kf (u.toNat % 2 ^ 31) : Int) := by unfold kv sv; rw [show Kf (u.toNat % 2 ^ 31) = mantOf u * 2 ^ idxOf u by unfold mantOf idxOf Kf; rw [(by rw [expOf_nat]; omega : u.toNat % 2 ^ 31 / 2 ^ 23 = (expOf u).toNat), (by rw [fracOf_nat]; exact Nat.mod_mod_of_dvd _ (by decide) : u.toNat % 2 ^ 31 % 2 ^ 23 = (fracOf u).toNat)]; simp only [← UInt32.toNat_inj, UInt32.toNat_zero]]; simp only [← signOf_iff]; split_ifs <;> push_cast <;> ring theorem sk_nat : (sk u).toNat = if u.toNat < 2 ^ 31 then u.toNat + 2 ^ 31 else if u.toNat = 2 ^ 31 then 2 ^ 31 else 2 ^ 32 - 1 - u.toNat := by have := u.toNat_lt unfold sk; split_ifs <;> simp_all [UInt32.lt_iff_toNat_lt, ← UInt32.toNat_inj, UInt32.toNat_sub] <;> omega theorem sk_lt (a b : UInt32) (h : sk a < sk b) : kv a < kv b := by rw [UInt32.lt_iff_toNat_lt, sk_nat, sk_nat] at h;rw [kv_K, kv_K];have := a.toNat_lt;have := b.toNat_lt have F m n := And.intro (Kf_mono m n) (Kf_mono 0 m) have := F (a.toNat % 2 ^ 31) (b.toNat % 2 ^ 31);have := F (b.toNat % 2 ^ 31) (a.toNat % 2 ^ 31);split_ifs at h ⊢ <;> omega theorem cmp_dD : Model.cmpDyadic (decodeD y) (decodeD z) = compare (kv y) (kv z) := by have hr : ∀ w, (decodeD w).toReal = (kv w : ℝ) * 2 ^ (-149 : Int) := fun w => by rw [← FloatLib.Numerics.Dyadic.cast_toRat, decodeD_toRat]; unfold kv; push_cast;rw [zpow_sub₀ two_ne_zero, zpow_natCast]; ring have hs : (0 : ℝ) < 2 ^ (-149 : Int) := zpow_pos two_pos _;cases h : compare (kv y) (kv z) ·rw [Model.cmpDyadic_lt_iff, hr, hr];exact mul_lt_mul_of_pos_right (by exact_mod_cast compare_lt_iff_lt.mp h) hs ·rw [Model.cmpDyadic_eq_iff, hr, hr, compare_eq_iff_eq.mp h] ·rw [Model.cmpDyadic_gt_iff, hr, hr];exact mul_lt_mul_of_pos_right (by exact_mod_cast compare_gt_iff_gt.mp h) hs theorem zero_words (hm : mantOf u = 0) : u = 0 ∨ u = 0x80000000 := by have ha := u.toNat_lt;unfold mantOf at hm split_ifs at hm with h0 ·have he := expOf_nat u;have hf := fracOf_nat u;rw [h0] at he;rw [← UInt32.toNat_inj, ← UInt32.toNat_inj]; simp at he ⊢; omega ·omega theorem mx_spec : ofW (mx y z) = Model.maximum (ofW y) (ofW z) := by unfold mx;split ·rename_i h;have ha := toDyadic_ofUInt32 y h.1;have hb := toDyadic_ofUInt32 z h.2.1 unfold Model.maximum Model.Internal.Value.maximum; rw [Model.withNaNSelection_of_none _ _ ((Model.chooseNaN2_eq_none_iff (ofW y) (ofW z)).2 ⟨Model.isNaN_eq_false_of_toDyadic?_some ha, Model.isNaN_eq_false_of_toDyadic?_some hb⟩), Model.compareNonNaN_eq_of_compare_eq_some _ _ _ _ (cmp_dD y z ▸ Model.compare_eq_some_cmpDyadic_of_toDyadic? _ _ ha hb)] rcases h.2.2 with h1 | h1 | rfl ·rw [if_pos h1, compare_lt_iff_lt.mpr (sk_lt y z h1)] ·rw [if_neg (UInt32.lt_asymm h1), compare_gt_iff_gt.mpr (sk_lt z y h1)] ·rw [if_neg (UInt32.lt_irrefl _), compare_eq_iff_eq.mpr rfl] by_cases hm : mantOf y = 0 ·rcases zero_words y hm with rfl | rfl <;> decide ·simp [show Model.isZero (ofW y) = false by unfold ofW;rw [Model.isZero_eq_beq_zero_of_toDyadic?_some ha, decodeD_sig_zero]; simpa using hm] ·exact ofW_toWord _ theorem tu_ofU : Model.NativeBinary32.toUInt32 (Model.ofUInt32 u : Model Fmt) = u := by show UInt32.ofBitVec (Model.ofUInt32 u : Model Fmt).bits = u;rw [ofUInt32_bits] theorem decodeD_norm (h0 : expOf u ≠ 0) : decodeD u = ⟨signOf u, 2 ^ 23 + (fracOf u).toNat, ((expOf u).toNat : Int) - 150⟩ := if_neg h0 theorem rqe_exact : FloatLib.Numerics.roundQuotientEven (m * 2 ^ 23) (2 ^ 23) = m := by unfold FloatLib.Numerics.roundQuotientEven;simp theorem div_zero_p (hs : r = 0 ∨ r = 0x80000000) (h0 : expOf d ≠ 0) (h1 : expOf d ≠ 255) (h2 : signOf d = false) : toWord (Model.div (ofW r) (ofW d)) = r := by have hz : decodeD r = ⟨signOf r, 0, 0⟩ := by rcases hs with rfl | rfl <;> rfl rw [Model.Proof.div_eq_spec];unfold Model.Spec.div ofW;rw [toDyadic_ofUInt32 r (by rcases hs with rfl | rfl <;> decide), toDyadic_ofUInt32 d h1, decodeD_norm d h0, h2, hz] simp rcases hs with rfl | rfl <;> rfl abbrev av : Word := toWord (Model.div (ofW (dotOf n fa fun _ => oneW)) (ofW d)) theorem divq_eq (hD : DQ d) : divq r d = toWord (Model.div (ofW r) (ofW d)) := by obtain ⟨h1, h8, h2⟩ := hD;replace h2 := UInt32.ne_of_lt h2;unfold divq; dsimp only;split ·obtain ⟨h0, h7, h3, h4⟩ := ‹_ ∧ _›; replace h4 := UInt32.ne_of_lt h4; replace h3 := UInt32.lt_iff_toNat_lt.mp h3 have hq : (expOf d).toNat = (expOf d - 127).toNat + 127 := by rw [UInt32.toNat_sub_of_le _ _ h7];have := UInt32.le_iff_toNat_le.mp h7;simp at this ⊢; clear*-this;omega generalize expOf d - 127 = q at *; symm have h5 := expOf_nat r;have h6 := fracOf_nat r have h7 : (expOf r).toNat ≠ 255 := fun h => h4 (UInt32.toNat_inj.mp (by simpa using h)) have hf := fracOf_toNat_lt r;rw [Model.Proof.div_eq_spec];unfold Model.Spec.div ofW rw [toDyadic_ofUInt32 r h4, toDyadic_ofUInt32 d h2, decodeD_norm r fun h => by simp [h] at h3, decodeD_norm d fun h => by simp [h] at hq, h0, h1] have hA : ((2 : Nat) ^ 23 == 0) = false := by decide have hB : (2 ^ 23 + (fracOf r).toNat == 0) = false := by simp simp only [UInt32.toNat_zero, Nat.add_zero, Bool.xor_false, hA, hB, fT, ite_false] erw [← Model.NativeBinary32.ofUInt32_roundRatScaled, toWord_native] unfold Model.NativeBinary32.roundRatScaled;rw [show FloatLib.Numerics.RationalBinary.floorLog2 (2 ^ 23 + (fracOf r).toNat) (2 ^ 23) = 0 by unfold FloatLib.Numerics.RationalBinary.floorLog2; rw [(by rw [Nat.log2_eq_iff (by clear*-;omega)]; constructor <;> (clear*-h6;omega) : Nat.log2 (2 ^ 23 + (fracOf r).toNat) = 23), Nat.log2_two_pow]; simp [FloatLib.Numerics.RationalBinary.lessThanPowerOfTwo, FloatLib.Numerics.RationalBinary.atLeastPowerOfTwo, Nat.shiftLeft_eq] <;> (clear*-h6;omega)];simp only [hA, hB, fT, ite_false, zero_add, sub_zero];rw [if_neg (by omega), if_neg (by clear*-h3 hq;omega), if_neg (by clear*-h3 hq;omega)] rw [show ((23 : Int)) = Int.ofNat 23 from rfl, FloatLib.Numerics.RationalBinary.scaleByPowerOfTwo_ofNat] simp only [show ∀ a, Nat.shiftLeft a 23 = a * 2 ^ 23 from fun a => Nat.shiftLeft_eq a 23, rqe_exact];have hc : ((2 ^ 23 + (fracOf r).toNat : Nat) == Model.pow2 24) = false := by simp [Model.pow2]; clear*-h6;omega simp only [hc, fT, ite_false];rw [if_neg (by omega)] set s' := r - (q <<< 23) with hD have hF : (q <<< 23).toNat = q.toNat * 2 ^ 23 := by rw [UInt32.toNat_shiftLeft]; simp [Nat.shiftLeft_eq]; clear*-h3 h5;omega have hG : s'.toNat = r.toNat - q.toNat * 2 ^ 23 := by rw [hD, UInt32.toNat_sub_of_le _ _ (by rw [UInt32.le_iff_toNat_le, hF]; clear*-h3 h5;omega), hF] rw [← Model.NativeBinary32.toUInt32_ofFields, ← tu_ofU s', ofUInt32_eq_ofFields] have hH : signOf s' = signOf r := by rw [Bool.eq_iff_iff, signOf_iff, signOf_iff, hG]; clear*-h3 h5;omega have hI : (expOf s').toNat = (expOf r).toNat - q.toNat := by rw [expOf_nat s', hG]; clear*-h3 h5;omega have hJ : (fracOf s').toNat = (fracOf r).toNat := by rw [fracOf_nat s', hG]; clear*-h3 h5 h6;omega rw [hH, hI, hJ, show Int.toNat _ = (expOf r).toNat - q.toNat by clear*-h3 hq;omega, show Model.pow2 23 = 2 ^ 23 by decide, Nat.add_sub_cancel_left] split ·exact (div_zero_p r d (by rename_i h; have hs := r.toNat_lt; have hq := congrArg UInt32.toNat h; rw [UInt32.toNat_and, show (0x7FFFFFFF : UInt32).toNat = 2 ^ 31 - 1 from rfl, Nat.and_two_pow_sub_one_eq_mod] at hq; rw [← UInt32.toNat_inj, ← UInt32.toNat_inj]; simp at hq ⊢; omega) h8 h2 h1).symm rfl theorem foldl_Z (g : Nat → UInt64) (m : Nat) : ∀ acc : UInt64, Z ((List.range m).foldl (fun acc t => acc + g t) acc) = Z acc + ∑ t ∈ range m, Z (g t) := by induction m with | zero => simp | succ m ih => intro acc;rw [List.range_succ, List.foldl_append, List.foldl_cons, List.foldl_nil, Z_add, ih, Finset.sum_range_succ];ring theorem sv0 : sval 0 = 0 := rfl theorem term_nz : (decide (mantOf u * mantOf oneW = 0) && Bool.xor (signOf u) (signOf oneW)) = (u == 0x80000000) := by by_cases hm : mantOf u = 0 ·rcases zero_words u hm with rfl | rfl <;> decide ·simp [show mantOf oneW = 2 ^ 23 by decide, show signOf oneW = false by decide, hm]; rintro rfl; exact hm (by decide) theorem dallNZ_one (c : Nat) : ∀ i, i + c ≤ n → (dallNZ (Array.ofFn (n := n) fun j => fa j.val) (Array.ofFn (n := n) fun _ => oneW) i c = true ↔ ∀ t, i ≤ t → t < i + c → fa t = 0x80000000) := by induction c <;> intro i h0 ·simp [dallNZ]; intros; clear h0;omega rename_i ih; rw [dallNZ, getElem!_ofFn n fa i (by (exact Nat.lt_of_add_right_lt h0)), getElem!_ofFn n (fun _ => oneW) i (by (exact Nat.lt_of_add_right_lt h0)), term_nz, Bool.and_eq_true, ih (i + 1) (by omega), beq_iff_eq] exact ⟨fun ⟨h1, h2⟩ t h3 h4 => h3.eq_or_lt.elim (· ▸ h1) fun h => h2 t h (by clear*-h4;omega), fun h => ⟨h i le_rfl (by omega), fun t h1 h2 => h t (by clear*-h1;(exact Nat.le_of_succ_le h1)) (by clear*-h2;omega)⟩⟩ theorem wa_iff (w k U m : Nat) (hk : 0 < k) : wa Q I w k m U 0 true = true ↔ ∀ t < m, Q I[U + t / k * w + t % k]! = true := by simp only [wa, wl0 _ _ _ _ _ _ _ hk] induction m ·simp simp only [*, List.range_succ, List.foldl_append, List.foldl_cons, List.foldl_nil, Bool.and_eq_true, Nat.lt_succ_iff_lt_or_eq, or_imp, forall_and, forall_eq] theorem pidx (ch y x t : Nat) : I[(ch * h + y * k) * w + x * k + t / k * w + t % k]! = poolAt h w k I ch y x t := by congr 1; ring theorem wo_eq (B c A H : UInt64) (hB : B.toNat ≤ 255) (hc : c.toNat ≤ 62) (hn : 0 < n) (h1 : ∀ t < n, ok c B (fa t) = true) (fl fh : Word → UInt64) (L M : Int) (T : ∀ t < n, sval (fh (fa t)) * 2 ^ 25 + sval (fl (fa t)) = fxv B.toNat (fa t) ∧ |sval (fl (fa t))| ≤ L ∧ |sval (fh (fa t))| ≤ M) (hL : n * L < 2 ^ 63) (hM : n * M < 2 ^ 63) (hA : Z A = ∑ t ∈ range n, Z (fl (fa t))) (hH : Z H = ∑ t ∈ range n, Z (fh (fa t))) (g : Unit → Bool) (hg : g () = true ↔ ∀ t < n, fa t = 0x80000000) (fb : Unit → Word) (h2 : fb () = dotOf n fa fun _ => oneW) (d : Word) (hD : DQ d) : wo B A H g fb d = av n fa d := by have hk := fun t ht => ok_spec c B (fa t) hB hc (h1 t ht) have b1 := abs_le.mp ((Finset.abs_sum_le_sum_abs _ _).trans ((Finset.sum_le_sum fun t ht => (T t (mr ht)).2.1).trans (by simp : _ ≤ (n : ℤ) * L))); have b2 := abs_le.mp ((Finset.abs_sum_le_sum_abs _ _).trans ((Finset.sum_le_sum fun t ht => (T t (mr ht)).2.2).trans (by simp : _ ≤ (n : ℤ) * M))) have hT : Core.tsum n fa (fun _ => oneW) = (sval H * 2 ^ 25 + sval A) * 2 ^ (B.toNat + 149) := by rw [sZ A (∑ t ∈ range n, sval (fl (fa t))) (by simp [hA, Z_sv]) (by linarith) (by linarith), sZ H (∑ t ∈ range n, sval (fh (fa t))) (by simp [hH, Z_sv]) (by linarith) (by linarith), Finset.sum_mul, ← Finset.sum_add_distrib, Finset.sum_mul] refine Finset.sum_congr rfl fun t ht => ?_ rw [(T t (mr ht)).1]; unfold tm fxv; rcases (hk t (mr ht)).2 with h0 | ⟨h1, -⟩ ·simp [sv_zero _ h0] rw [show sv oneW = 2 ^ 23 by decide, show idxOf oneW = 126 by decide, mul_assoc, mul_assoc, ← pow_add, ← pow_add]; congr 2; clear*-h1;omega unfold wo av; split ·rw [div_zero_p _ d ?_ hD.2.1 (UInt32.ne_of_lt hD.2.2) hD.1] <;> rw [dotOf_val n fa _ fun t ht => ⟨(hk t ht).1, by decide⟩, show Core.tsum n fa (fun _ => oneW) = 0 by simp [*, sv0]] <;> simp [finishWord, hn.ne', dallNZ_one n fa n 0 (by clear*-;omega), hg] exact or_iff_not_imp_right.2 fun h => by simpa using h ·rw [divq_eq _ d hD, Dense.fin128FZ_eq, fin128F_eq]; refine congrArg (fun s => toWord (Model.div (ofW s) (ofW d))) ?_; split ·refine (dotOf_of_fin128 n fa _ _ _ _ (fun t ht => ⟨(hk t ht).1, by decide⟩) ?_ ‹_›).symm rw [hT, val128_hl, UInt64.toNat_add, mo (by simp; clear*-hB;omega)]; rfl ·exact h2 theorem t1_ok (c : UInt64) (x : Word) (hB : B.toNat ≤ 255) (hc : c.toNat ≤ 37) (h : ok c B x = true) : sval 0 * 2 ^ 25 + sval (t1 B x) = fxv B.toNat x ∧ |sval (t1 B x)| ≤ 2 ^ (24 + c.toNat) - 1 ∧ |sval 0| ≤ 0 := by obtain ⟨-, h0 | ⟨h1, h2, hs⟩⟩ := ok_spec c B x hB (by omega) h ·simp [t1, sg, (UInt64.toNat_inj.mp (by rw [mW_toNat, h0]; rfl) : mW x = 0), fxv, sv_zero x h0, sv0, one_le_pow₀] have hm := mantOf_lt_24 x; have : mantOf x * 2 ^ (idxOf x - B.toNat) < 2 ^ (24 + c.toNat) := (by rw [pow_add]; exact Nat.mul_lt_mul_of_lt_of_le hm (Nat.pow_le_pow_right (by norm_num) (by (exact Nat.sub_le_iff_le_add'.mpr h2))) (by positivity)); have : 2 ^ (24 + c.toNat) ≤ 2 ^ 61 := Nat.pow_le_pow_right (by norm_num) (by clear*-hc;omega) unfold t1 fxv sv; rw [sv0, sg_sv] <;> rw [UInt64.toNat_shiftLeft, mW_toNat, hs, Nat.shiftLeft_eq, mo (a := idxOf x - B.toNat) (by clear*-h2 hc;omega), mo (by clear h h1 h2 hB hc hm hs;omega)] ·cases signOf x <;> simp only [fT, ite_true, ite_false, neg_mul, abs_neg] <;> refine ⟨by push_cast; ring, ?_, by simp⟩ <;> rw [abs_of_nonneg (by positivity)] <;> exact Int.le_sub_one_of_lt (by exact_mod_cast ‹_ < 2 ^ (24 + c.toNat)›) clear h h1 h2 hB hc hm hs;omega theorem all4_iff : all4 Q (fa 0) (fa 1) (fa 2) (fa 3) = true ↔ ∀ t < 2 * 2, Q (fa t) = true := by simp only [all4, Bool.and_eq_true] refine ⟨fun ⟨⟨⟨a, b⟩, c⟩, e⟩ t ht => by interval_cases t <;> assumption, fun H => ⟨⟨⟨H 0 ?_, H 1 ?_⟩, H 2 ?_⟩, H 3 ?_⟩⟩ <;> decide theorem eF_nat : (eF u).toNat = (expOf u).toNat := by unfold eF expOf; simp theorem key_le (x : Word) : key x ≤ 255 := by unfold key; split ·rw [UInt64.le_iff_toNat_le, iW_toNat]; unfold idxOf; have := expOf_toNat_lt x; split <;> simp <;> (exact Nat.le_of_succ_le this) ·decide theorem mn (a b : UInt64) : (min a b).toNat = min a.toNat b.toNat := UInt64.toNat_min _ _ theorem mnl (a b : UInt64) : min a b ≤ a := UInt64.le_iff_toNat_le.mpr (by rw [mn]; (exact Nat.min_le_left a.toNat b.toNat)) theorem mnr (a b : UInt64) : min a b ≤ b := UInt64.le_iff_toNat_le.mpr (by rw [mn]; (exact Nat.min_le_right a.toNat b.toNat)) theorem mxl (a b : UInt64) : a ≤ max a b := by show a ≤ if a ≤ b then b else a; split <;> simp_all theorem mxr (a b : UInt64) : b ≤ max a b := UInt64.le_iff_toNat_le.mpr (by rw [UInt64.toNat_max]; (exact Nat.le_max_right a.toNat b.toNat)) theorem ok_mx (x : Word) (B M : UInt64) (hk : B ≤ key x) (hx : eF x ≤ M) (hM : M ≤ min (B + 37) 254) (hB : B ≤ 255) : ok 37 B x = true := by have e1 := eF_nat x; have hi := iW_toNat x; have he := expOf_toNat_lt x simp only [UInt64.le_iff_toNat_le, mn, UInt64.toNat_add, UInt64.reduceToNat] at hx hM hB simp only [ok, Bool.and_eq_true, bne_iff_ne, ne_eq, Bool.or_eq_true, beq_iff_eq] refine ⟨fun e => by rw [e] at e1; simp at e1; clear*-e1 hM hx;omega, (em _).imp id fun hm => ?_⟩ unfold key at hk; rw [if_pos (by simpa using hm), UInt64.le_iff_toNat_le, hi] at hk apply decide_eq_true rw [UInt64.le_iff_toNat_le, UInt64.toNat_sub_of_le _ _ (UInt64.le_iff_toNat_le.mpr (by rw [hi]; omega)), hi] unfold idxOf at hk ⊢; split <;> simp <;> (clear*-e1 hB hM he hx;omega) theorem a2o_eq (hD : DQ d) (ch y x : Nat) (e : USize) (he : e.toNat = (ch * h + y * 2) * w + x * 2) (hb : (ch * h + y * 2) * w + x * 2 + w + 1 < 2 ^ 31) : a2o h w I d ch y x e = av (2 * 2) (poolAt h w 2 I ch y x) d := by have q := pidx h w 2 I ch y x;have e0 := q 0; have e1 := q 1; have e2 := q 2; have e3 := q 3;simp only [Nat.reduceDiv, Nat.reduceMod, zero_mul, one_mul, add_zero] at e0 e1 e2 e3;have := usz_ge unfold a2o; dsimp only; split swap; · rfl simp (disch := omega) only [ugW, USize.toNat_add, USize.toNat_one, toUSize_toNat, mo, he, e0, e1, e2, e3];split ·rename_i hg;refine (fun hB h0 => wo_eq _ _ _ 37 _ _ (u255 hB) (by decide) (by decide) h0 _ (fun _ => 0) _ 0 (fun t ht => t1_ok _ _ _ (u255 hB) (by decide) (h0 t ht)) (by decide) (by decide) (by simp [Z_add, Finset.sum_range_succ]) (by simp [Z_zero]) _ (by rw [all4_iff]; simp only [beq_iff_eq]) _ rfl d hD) ?B ((all4_iff _ _).1 ?_) ·exact UInt64.le_trans (UInt64.le_trans (mnl _ _) (mnl _ _)) (key_le _) simp only [all4, Bool.and_eq_true]; exact ⟨⟨⟨ok_mx _ _ _ (UInt64.le_trans (mnl _ _) (mnl _ _)) (UInt64.le_trans (mxl _ _) (mxl _ _)) hg ?B, ok_mx _ _ _ (UInt64.le_trans (mnl _ _) (mnr _ _)) (UInt64.le_trans (mxr _ _) (mxl _ _)) hg ?B⟩, ok_mx _ _ _ (UInt64.le_trans (mnr _ _) (mnl _ _)) (UInt64.le_trans (mxl _ _) (mxr _ _)) hg ?B⟩, ok_mx _ _ _ (UInt64.le_trans (mnr _ _) (mnr _ _)) (UInt64.le_trans (mxr _ _) (mxr _ _)) hg ?B⟩ ·rfl theorem rseg_eq (B : UInt64) (stop : USize) (hs : stop.toNat ≤ I.size) : ∀ m (e : USize) (acc : UInt64), stop.toNat - e.toNat = m → rseg I B stop hs e acc = (List.range m).foldl (fun a j => a + t1 B I[e.toNat + j]!) acc := by intro m; induction m <;> intro e acc hm <;> rw [rseg] ·rw [dif_neg (by rw [USize.lt_iff_toNat_lt]; clear hs;omega)]; rfl rename_i ih; have h : e < stop := USize.lt_iff_toNat_lt.mpr (by clear*-hm;(exact Nat.lt_of_sub_eq_succ hm)); have he := Dense.usucc h rw [dif_pos h, ih (e + 1) _ (by rw [he]; clear*-hm;omega), List.range_succ_eq_map, List.foldl_cons, List.foldl_map] simp only [ugW, he, Nat.add_zero, Nat.succ_eq_add_one, Nat.add_assoc, Nat.add_comm 1] theorem gsum_eq (B : UInt64) (U : Nat) : gsum I B w k U = asum (t1 B) I w k (k * k) U 0 0 := by unfold gsum; split ·obtain ⟨hk, rfl, h1, h2⟩ := ‹_ ∧ _› rw [rseg_eq I B _ _ (w * w) _ 0 (by rw [toUSize_toNat _ (by (exact Dense.lt32 h2)), toUSize_toNat _ (by omega)]; clear*-;(exact Nat.add_sub_self_left U (w * w))), asum, wl0 _ _ _ _ _ _ _ hk, toUSize_toNat _ (by omega)] congr 1; funext a t; rw [Nat.add_assoc, Nat.div_add_mod'] ·rfl theorem cK_b (m : Nat) (h : m < 16384) : (cK m).toNat ≤ 37 ∧ (m : Int) * (2 ^ (24 + (cK m).toNat) - 1) < 2 ^ 63 := by unfold cK; split_ifs <;> simp <;> omega theorem apool_eq : apool = avgpoolSpec := by funext c h w k I;unfold apool;dsimp only;split ·obtain ⟨hk, hh, hw, h0, hD⟩ := ‹_ ∧ _›;split ·obtain ⟨rfl, hs⟩ := ‹_ ∧ _›;rw [lrop1 _ _ _ _ _ _ _ hh, Nat.mul_assoc]; unfold avgpoolSpec refine Array.ext (by simp [avgpoolWith]) fun q h1 _ => ?_ simp only [ofFnN, Array.getElem_ofFn, avgpoolWith, Array.size_ofFn] at h1 ⊢;have ho := (Nat.div_lt_iff_lt_mul (Nat.mul_pos hh hw)).mpr h1;have := Nat.mod_lt (q / (w / 2)) hh;have := Nat.mod_lt q hw;have a1 : q / (h / 2 * (w / 2)) * h + q / (w / 2) % (h / 2) * 2 + 1 ≤ c * h := by have := Nat.mul_le_mul_right h ho; rw [Nat.succ_mul] at this; clear h0 h1 hD hh hk ho hs hw;omega have a2 := Nat.mul_le_mul_right w a1;rw [Nat.add_one_mul] at a2;refine a2o_eq h w I _ hD _ _ _ _ ?_ (by clear*-a2 hs this;omega) rw [show (2 : USize) = USize.ofNat 2 from rfl, ← USize.ofNat_mul, ← USize.ofNat_add, Nat.mul_comm 2, ← Nat.toUSize_eq, toUSize_toNat _ (by clear*-a2 hs this;omega)] ·have hC := cK_b _ h0;split <;> unfold tri avgpoolSpec <;> rw [if_pos hh, lrop1 _ _ _ _ _ _ _ hh, Nat.mul_assoc] <;> refine Array.ext (by simp [avgpoolWith]) fun q h1 h2 => ?_ <;> simp only [ofFnN, Array.getElem_ofFn, avgpoolWith] on_goal 2 => split on_goal 3 => rfl on_goal 1 => simp only [gsum_eq] all_goals rename_i hg; refine (fun h6 => wo_eq _ _ _ (cK (k * k)) _ _ (u255 hg.1) (by clear*-hC;omega) (Nat.mul_pos hk hk) h6 _ (fun _ => 0) _ 0 (fun t ht => t1_ok _ _ _ (u255 hg.1) hC.1 (h6 t ht)) hC.2 (by simp) (by rw [asum, wl0 _ _ _ _ _ _ _ hk, foldl_Z, Z_zero, zero_add];simp only [pidx]) (by simp [Z_zero]) _ (by simp only [wa_iff _ _ _ _ _ _ hk, pidx, beq_iff_eq]) _ rfl _ hD) ?_ exacts [fun t _ => (em _).elim (fun hq => by unfold poolAt; rw [getElem!_pos I _ hq]; exact Array.all_eq_true.mp hg.2 _ hq) fun hq => by unfold poolAt; rw [getElem!_neg I _ hq]; rfl, by simpa only [pidx] using (wa_iff _ _ _ _ _ _ hk).1 hg.2] ·rfl @[inline] def ky (u : Word) : UInt32 := if u < 0x80000000 then u + 0x80000000 else 0xFFFFFFFF - u @[inline] def kmx (a b : Word) : Word := if ky a < ky b then b else a @[inline] def nn (u : Word) : Bool := expOf u != 255 theorem ky_nat : (ky u).toNat = if u.toNat < 2 ^ 31 then u.toNat + 2 ^ 31 else 2 ^ 32 - 1 - u.toNat := by have := u.toNat_lt unfold ky; split_ifs <;> simp_all [UInt32.lt_iff_toNat_lt, UInt32.toNat_add, UInt32.toNat_sub] <;> omega theorem kmx_ky (a b : Word) : (ky (kmx a b)).toNat = max (ky a).toNat (ky b).toNat := by unfold kmx; split <;> rename_i h <;> rw [UInt32.lt_iff_toNat_lt] at h <;> omega theorem ky_inj (a b : Word) (h : (ky a).toNat = (ky b).toNat) : a = b := by rw [ky_nat, ky_nat] at h; have := a.toNat_lt; have := b.toNat_lt; rw [← UInt32.toNat_inj]; split_ifs at h <;> omega theorem mxk (hy : expOf y ≠ 255) (hz : expOf z ≠ 255) : mx y z = kmx y z := by have F a b (h : sk a < sk b) : ky a < ky b := by simp only [UInt32.lt_iff_toNat_lt, sk_nat, ky_nat] at *; have := a.toNat_lt; have := b.toNat_lt; split_ifs at h ⊢ <;> omega unfold mx kmx by_cases h : sk y < sk z ∨ sk z < sk y ∨ y = z ·rw [if_pos ⟨hy, hz, h⟩]; rcases h with h | h | rfl <;> simp [*, F, UInt32.lt_asymm] rw [if_neg fun h' => h h'.2.2]; have := y.toNat_lt; have := z.toNat_lt obtain ⟨rfl, rfl⟩ | ⟨rfl, rfl⟩ : (y = 0 ∧ z = 0x80000000) ∨ (y = 0x80000000 ∧ z = 0) := by simp only [not_or, UInt32.lt_iff_toNat_lt, sk_nat, ← UInt32.toNat_inj, UInt32.reduceToNat] at h ⊢; split_ifs at h <;> omega all_goals decide @[inline] def m2k (x0 x1 x2 x3 : Word) : Word := if nn x0 && nn x1 && nn x2 && nn x3 then kmx (kmx x0 x1) (kmx x2 x3) else mx (mx (mx (mx x0 x0) x1) x2) x3 theorem m4 (x0 x1 x2 x3 : Word) : m2k x0 x1 x2 x3 = mx (mx (mx (mx x0 x0) x1) x2) x3 := by unfold m2k; split ·rename_i h; simp only [nn, Bool.and_eq_true, bne_iff_ne, ne_eq] at h; obtain ⟨⟨⟨h0, h1⟩, h2⟩, h3⟩ := h have kf : ∀ a b, expOf a ≠ 255 → expOf b ≠ 255 → expOf (kmx a b) ≠ 255 := fun a b ha hb => by unfold kmx; split <;> assumption have k1 := kf _ _ h0 h0; have k2 := kf _ _ k1 h1 rw [mxk _ _ h0 h0, mxk _ _ k1 h1, mxk _ _ k2 h2, mxk _ _ (kf _ _ k2 h2) h3] apply ky_inj; simp only [kmx_ky, Nat.max_self, Nat.max_assoc] ·rfl theorem mqB {I : Array Word} {v t e : USize} (hs : t.toNat + v.toNat < I.size ∧ I.size < 2 ^ 31) (h : e < t) : e.toNat + v.toNat + 1 < I.size ∧ (e + 1).toNat = e.toNat + 1 ∧ (e + v).toNat = e.toNat + v.toNat ∧ (e + v + 1).toNat = e.toNat + v.toNat + 1 ∧ (e + 2).toNat = e.toNat + 2 := by have := usz_ge; have := USize.lt_iff_toNat_lt.mp h simp (disch := omega) only [USize.toNat_add, USize.toNat_one, USize.reduceToNat, mo, and_true]; clear*-hs this;omega def mqr (I : Array Word) (v t : USize) (hs : t.toNat + v.toNat < I.size ∧ I.size < 2 ^ 31) (e q : USize) (a : Array Word) : Array Word := if h : e < t then have := mqB hs h mqr I v t hs (e + 2) (q + 1) (su a q (m2k (I.uget e (by omega)) (I.uget (e + 1) (by omega)) (I.uget (e + v) (by omega)) (I.uget (e + v + 1) (by omega)))) else a termination_by t.toNat - e.toNat decreasing_by have := mqB hs h; have := USize.lt_iff_toNat_lt.mp h; omega theorem mqr_g (v t : USize) (hs : t.toNat + v.toNat < I.size ∧ I.size < 2 ^ 31) (G : Nat → Word) : ∀ m (e q : USize) (a : Array Word), e.toNat + 2 * m = t.toNat + 1 → q.toNat + m ≤ a.size → a.size < 2 ^ 31 → (∀ j < m, m2k I[e.toNat + 2 * j]! I[e.toNat + 2 * j + 1]! I[e.toNat + 2 * j + v.toNat]! I[e.toNat + 2 * j + v.toNat + 1]! = G (q.toNat + j)) → (mqr I v t hs e q a).size = a.size ∧ ∀ i < a.size, (mqr I v t hs e q a)[i]! = if q.toNat ≤ i ∧ i < q.toNat + m then G i else a[i]! := by have := usz_ge intro m; induction m <;> intro e q a he h1 h2 hG ·rw [mqr, dif_neg (by rw [USize.lt_iff_toNat_lt]; clear*-he;omega)]; exact ⟨rfl, fun i _ => by rw [if_neg (by clear*-;omega)]⟩ rename_i m ih have h : e < t := USize.lt_iff_toNat_lt.mpr (by clear*-he;omega) obtain ⟨-, b1, b2, b3, b4⟩ := mqB hs h have hq : (q + 1).toNat = q.toNat + 1 := by simp (disch := omega) only [USize.toNat_add, USize.toNat_one, mo] have h0 := hG 0 (by clear*-;(exact Nat.zero_lt_succ m)); simp only [Nat.mul_zero, Nat.add_zero] at h0 have hs' : (su a q (G q.toNat)).size = a.size := by rw [su_st, Array.size_set!] rw [mqr, dif_pos h]; simp only [ugW, b1, b2, b3, h0] refine (ih (e + 2) (q + 1) _ (by clear*-b4 he;omega) (by clear*-h1 hq hs';omega) (by clear*-h2 hs';omega) fun j hj => by convert hG (j + 1) (by clear*-hj;(exact Nat.add_lt_add_right hj 1)) using 2 <;> first | omega | (congr 1; clear*-b4;omega)).imp (Eq.trans · hs') fun g1 i hi => ?_ rw [g1 i (by clear*-hi hs';(exact Nat.lt_of_lt_of_eq hi (id (Eq.symm hs')))), hq, su_st] rcases eq_or_ne i q.toNat with rfl | hiq <;> [rw [Array.getElem!_set!_self _ _ _ hi]; rw [Array.getElem!_set!_ne _ _ _ _ hiq.symm]] <;> split_ifs <;> first | rfl | (clear b1 b2 b3 b4 g1 h h0 h1 h2 hG he hi hq hs hs' ih this;omega) def mpool : Array Word := if k = 2 ∧ 0 < h / 2 ∧ 0 < w / 2 ∧ c * h * w ≤ I.size ∧ I.size < 2 ^ 31 then lp (h / 2) (fun o y a => if hs : (((o * h + y * 2) * w).toUSize + (w / 2 * 2 - 1).toUSize).toNat + w.toUSize.toNat < I.size ∧ I.size < 2 ^ 31 then mqr I w.toUSize _ hs ((o * h + y * 2) * w).toUSize ((o * (h / 2) + y) * (w / 2)).toUSize a else a) (c * (h / 2)) 0 0 (Array.replicate (c * (h / 2 * (w / 2))) 0) else maxpoolSpec c h w k I theorem mpool_eq : mpool = maxpoolSpec := by funext c h w k I; unfold mpool; split ·obtain ⟨rfl, hh, hw, hI, hI2⟩ := ‹_ ∧ _› have := usz_ge have hN : c * (h / 2 * (w / 2)) ≤ c * h * w := by rw [← Nat.mul_assoc]; exact Nat.mul_le_mul (Nat.mul_le_mul_left c (Nat.div_le_self h 2)) (Nat.div_le_self w 2) have L := lp_inv (h / 2) (fun o y a => if hs : (((o * h + y * 2) * w).toUSize + (w / 2 * 2 - 1).toUSize).toNat + w.toUSize.toNat < I.size ∧ I.size < 2 ^ 31 then mqr I w.toUSize _ hs ((o * h + y * 2) * w).toUSize ((o * (h / 2) + y) * (w / 2)).toUSize a else a) (fun r a => r ≤ c * (h / 2) → a.size = c * (h / 2 * (w / 2)) ∧ ∀ i < c * (h / 2 * (w / 2)), a[i]! = if i < r * (w / 2) then (maxpoolSpec c h w 2 I)[i]! else 0) (fun o y a hy ha hr => ?_) (c * (h / 2)) 0 0 _ hh (fun _ => ⟨Array.size_replicate .., fun i hi => by rw [if_neg (by simp), getElem!_pos _ _ (by simpa using hi), Array.getElem_replicate]⟩) (by simp) ·refine Array.ext (L.1.trans (by simp [maxpoolSpec])) fun i h1 h2 => ?_ have e := L.2 i (L.1 ▸ h1) rw [if_pos (by simp only [Nat.zero_mul, Nat.zero_add, Nat.mul_assoc]; exact L.1 ▸ h1), getElem!_pos, getElem!_pos] at e <;> assumption obtain ⟨s0, g0⟩ := ha (by clear*-hr;(exact Nat.le_of_succ_le hr)) have r1 := Nat.mul_le_mul_right (w / 2) hr; rw [Nat.add_one_mul] at r1 have ho : o < c := Nat.lt_of_mul_lt_mul_right (by clear*-hr;(exact Nat.lt_of_add_right_lt hr) : o * (h / 2) < c * (h / 2)) have r3 := Nat.mul_le_mul_right w (show o * h + y * 2 + 2 ≤ c * h by have := Nat.mul_le_mul_right h ho; rw [Nat.add_one_mul] at this; clear*-hy this;omega); rw [Nat.add_mul] at r3 have hA : c * (h / 2) * (w / 2) = c * (h / 2 * (w / 2)) := Nat.mul_assoc .. split ·obtain ⟨s1, g1⟩ := mqr_g I _ _ ‹_› ((maxpoolSpec c h w 2 I)[·]!) (w / 2) ((o * h + y * 2) * w).toUSize ((o * (h / 2) + y) * (w / 2)).toUSize a (by simp (disch := omega) only [USize.toNat_add, toUSize_toNat, mo]; clear g0 hA hI hI2 hN ha hh ho hr hw hy r1 r3 s0 this;omega) (by simp (disch := omega) only [toUSize_toNat]; clear*-hA r1 s0;omega) (by clear g0 hA hI hI2 ha hh ho hr hw hy r1 r3 this;omega) fun j hj => by obtain ⟨d1, d2, d3⟩ := decomp o y j (h / 2) (w / 2) hy hj have q := pidx h w 2 I o y j; have e0 := q 0; have e1 := q 1; have e2 := q 2; have e3 := q 3 simp only [Nat.reduceDiv, Nat.reduceMod, zero_mul, one_mul, add_zero] at e0 e1 e2 e3 simp (disch := omega) only [toUSize_toNat] rw [Nat.mul_comm 2 j, m4, ← toWord_ofW (mx _ _), mx_spec, mx_spec, mx_spec, mx_spec, e0, e1, e2, e3, maxpoolSpec, getElem!_pos _ _ (by simp; clear*-hA hj r1;omega), Array.getElem_ofFn] simp only [d1, d2, d3, List.range_succ, List.range_zero, List.foldl_append, List.foldl_cons, List.foldl_nil] simp (disch := omega) only [toUSize_toNat, s1, s0, true_and] at g1 ⊢ intro i hi rw [g1 i hi, g0 i hi, Nat.add_one_mul]; split_ifs <;> first | rfl | (clear g0 g1 hA hI hI2 hN ha hh hi ho hr hw hy r1 r3 s0 s1 this;omega) ·rename_i hn; exact (hn ⟨by simp (disch := omega) only [USize.toNat_add, toUSize_toNat, mo]; clear g0 hA hI hI2 hN ha hh hn ho hr hw hy r1 s0 this;omega, hI2⟩).elim ·rfl end Conv section open Float.Model.UnpackedFloat local notation "ZA" => rationalWord local notation "ZB" => Array Word local notation "ZC" => Core.mW local notation "ZD" => Core.iW local notation "ZE" => FloatFormat.toModel Fmt local notation "ZF" => zpow_natCast local notation "ZG" => UInt64.toNat_ofNat' local notation "ZH" => decide_eq_true_eq local notation "ZI" => Core.mW_toNat local notation "ZJ" => Nat.div_eq_zero_iff_lt local notation "ZK" => sqrtLower local notation "ZL" => zpow_add₀ local notation "ZM" => Finset.range local notation "ZO" => mantOf_lt_24 local notation "ZQ" => two_ne_zero local notation "ZR" => Core.fastLog2 local notation "ZS" => Core.iW_toNat local notation "ZT" => roundRational local notation "ZU" => Nat.div_add_mod' local notation "ZV" => Nat.div_le_self local notation "ZW" => mantOf local notation "ZX" => signOf local notation "ZY" => beq_iff_eq local notation "ZZ" => idxOf local notation "XA" => ite_false local notation "XB" => zpow_sub₀ local notation "XC" => two_ne_zero' local notation "XD" => mul_assoc local notation "XE" => ExtendedMantissa.ofMantissaAndAccuracy local notation "XF" => UInt64.ofNat local notation "XG" => Bool.xor local notation "XH" => rowVariance local notation "XI" => (by omega) local notation "XJ" => (by positivity) local notation "XK" => (by simp) namespace Norm def Ya:Accuracy→Nat | .exact=>0 | .inexact _=>1 theorem Yc {α:Type} (f:α→α) (n:Nat) (a:α): Nat.repeat f (n+1) a=Nat.repeat f n (f a):=by induction n generalizing a with | zero=>rfl | succ n ih=>exact congrArg f (ih a) theorem QA (R k:Nat) (acc:Accuracy): XE (2*R+Ya acc) .exact>>>(k+2)= XE R acc>>>(k+1):=by show Nat.repeat ExtendedMantissa.shiftRightOne (k+2) _= Nat.repeat ExtendedMantissa.shiftRightOne (k+1) _ rw [Yc,Yc,Yc];congr 1;rcases acc with _ | ⟨_ | _ | _⟩<;> simp [ExtendedMantissa.ofMantissaAndAccuracy,ExtendedMantissa.shiftRightOne,Ya]<;>omega open FloatLib.Numerics in theorem VY (q r D t:Nat) (hD:0rfl,←h, show (q*D+r)/D=q by rw [Nat.add_comm,Nat.add_mul_div_right _ _ hD,Nat.div_eq_of_lt hr,zero_add], show (q*D+r)%D=r by rw [Nat.add_comm,Nat.add_mul_mod_self_right,Nat.mod_eq_of_lt hr]] theorem Y5 (e:Int):Model.bpow e=(2:ℝ)^e:=by rfl theorem Vi (q b:Nat) (hq:q≠0) (hb:b≤1):(2*q+b).log2=q.log2+1:=by have h1:=Nat.log2_self_le hq;have h2:=Nat.lt_log2_self (n:=q);rw [Nat.log2_eq_iff (by clear*-hq;omega)];omega open FloatLib.Numerics in theorem V0 (s:Bool) (P Qd:Nat) (hP:P≠0) (hQ:Qd≠0) (q r D:Nat) (hD:0omega have hJ:=Vi q _ h3 hb;have h9:(r:ℝ)/D<1:=by rw [div_lt_one XJ];exact_mod_cast hr have h7:(0:ℝ)≤r/D:=XJ;push_cast at h1 h2;have h4:RationalBinary.floorLog2 P Qd=(q.log2:Int)+e:=by apply Model.floorLog2_eq_of_bounds P Qd _ ·rw [h0,Y5,ZL ZQ,ZF];gcongr;grind ·rw [h0,Y5,show (q.log2:Int)+e+1=((q.log2+1:Nat):Int)+e by push_cast;ring,ZL ZQ,ZF];gcongr;linarith have hm:roundQuotientEven (RationalBinary.scaleByPowerOfTwo P Qd (23-((q.log2:Int)+e))).1 (RationalBinary.scaleByPowerOfTwo P Qd (23-((q.log2:Int)+e))).2= roundShiftRightEven (2*q+if r=0 then 0 else 1) ((2*q+if r=0 then 0 else 1).log2-23):=by rw [roundShiftRightEven_eq_roundQuotientEven,hJ,show q.log2+1-23=(q.log2-23)+1 by clear * - hL hJ;clear hJ;omega,←VY q r D _ hD hr (by clear*-hL;omega)] apply Model.roundQuotientEven_eq_of_rat_eq _ _ _ _ (RationalBinary.scaleByPowerOfTwo_snd_ne_zero _ _ _ hQ) XJ rw [Model.scaleByPowerOfTwo_real];unfold Model.scaledRatToReal;rw [h0,Y5,XD,←ZL ZQ, show e+(23-((q.log2:Int)+e))=-((q.log2-23:Nat):Int) by clear * - hL hJ;clear hJ;omega, zpow_neg,ZF] push_cast;field_simp generalize h8:2*q+(if r=0 then 0 else 1)=J at hJ hm ⊢;rw [Model.roundDyadic,ite_eq_left (by decide),Model.ieeeRoundDyadic_eq_internal];simp only [Model.roundRat,Model.roundRatScaled,show Fmt.isIEEE=true by decide,↓reduceDIte, Model.ieeeRoundRatScaled,Model.Internal.ieeeRoundDyadic,ZY,hP,hQ,XA,h4, Int.add_zero,Int.ofNat_eq_natCast,hJ,show (FloatFormat.ieeeMaxNormalExponent Fmt:Int)=127 by decide, show FloatFormat.ieeeMinNormalExponent Fmt=-126 by decide, show (FloatFormat.normalMantissaExpOffset Fmt:Int)=150 by decide, show Fmt.fracWidth=23 by decide,show J≠0 by clear*-h8 hb hq;omega, show ((q.log2+1:Nat):Int)+(e-1)=(q.log2:Int)+e by push_cast;ring, show¬((q.log2:Int)+e>127) by clear*-h6;omega,show¬((q.log2:Int)+e< -150) by clear*-h5;omega, show¬((q.log2:Int)+e< -126) by clear*-h5;(exact Int.not_lt_of_ge h5),show 23≤q.log2+1 by clear*-hL;omega,ite_true, Nat.cast_ofNat,hm] theorem Y8 (v:ℚ) (hv:v≠0) (s:Bool) (hs:decide (v<0)=s) (q:Nat) (ρ:ℚ) (h4:0≤ρ) (h0:ρ<1) (e:Int) (h1:|v|=((q:ℚ)+ρ)*(2:ℚ)^e) (hq:2^25≤q) (h2:-126≤(q.log2:Int)+e) (h3:(q.log2:Int)+e≤126): ZT v= toWord (Model.roundDyadic Fmt ⟨s,2*q+(if ρ=0 then 0 else 1),e-1⟩):=by have hρ:ρ=(ρ.num.toNat:ℚ)/ρ.den:=by conv_lhs=>rw [←Rat.num_div_den ρ] congr 1;exact_mod_cast (Int.toNat_of_nonneg (Rat.num_nonneg.mpr h4)).symm have hD:=ρ.den_pos;generalize ρ.den=D,ρ.num.toNat=r at hρ hD;subst hρ;have hr:r(z:ℝ)) h1;rw [Rat.abs_def,Rat.divInt_eq_div] at this;push_cast at this;rwa [Nat.cast_natAbs,Int.cast_abs] theorem Q7 (R:Nat) (s:Int) (h:2^25≤R): -s+1≤(ZE).targetExponent (Float.Model.totalExponent R (-s)):=by have:=(Nat.le_log2 XI).2 h;have:(ZE).mantissaBits≤25:=by decide unfold Float.Model.Format.targetExponent Float.Model.totalExponent;clear h;omega theorem Vd (v:ℚ) (h5:0simp theorem YN (w:Word):(sv w:ℚ)=0↔ZW w=0:=by unfold sv;split_ifs<;>simp theorem Vr (w:Word):(sv w:ℚ)=(if ZX w then-1 else 1)*ZW w:=by unfold sv;simp theorem Y7 (x:UInt64):(ZR x).toNat=x.toNat.log2:=by rw [Core.fastLog2_eq];rfl theorem YK (w:Word):(ZC w==0)=decide (ZW w=0):=by by_cases h:ZW w=0 ·have:ZC w=0:=UInt64.toNat_inj.mp (by rw [ZI,h];rfl);grind ·have:ZC w≠0:=fun h'=>h (by rw [←ZI,h'];rfl) grind theorem Yk (n:Nat) (f:Nat→ℚ) (a:ℚ): (List.range n).foldl (fun t j=>t+f j) a=a+∑ j∈ZM n,f j:=by induction n generalizing a with | zero=>simp | succ n ih=> rw [List.range_succ,List.foldl_append,ih,Finset.sum_range_succ];simp;ring def Yf (num den:Nat) (s:Int):Word:= toWord (Model.ofModel Fmt (roundWithAccuracy (ZE) .positive (ZK num den) (-s) (sqrtAccuracy num den))) open Float.Model in theorem Q4 (spec:Format) (sign:Sign) (R:Nat) (e:Int) (acc:Accuracy) (hR:R≠0) (hk:e+1≤ spec.targetExponent (totalExponent R e)): roundWithAccuracy spec sign R e acc=UnpackedFloat.round spec sign (2*R+Ya acc) (e-1):=by have hb:Ya acc≤1:=by cases acc<;>simp [Ya] have h1:totalExponent (2*R+Ya acc) (e-1)=totalExponent R e:=by unfold totalExponent;rw [Vi R _ hR hb];clear*-;omega unfold UnpackedFloat.round decreaseExponent;simp only [h1];rw [show (e-1-spec.targetExponent (totalExponent R e)).toNat=0 by clear*-hk;omega];simp;unfold roundWithAccuracy shiftToTargetExponent shiftToExponent;rw [h1];generalize hT:spec.targetExponent (totalExponent R e)=T at* obtain ⟨k,h4⟩:∃ k,(T-e).toNat=k+1:=⟨(T-e).toNat-1,(by clear*-hk;omega)⟩ dsimp only;rw [h4,show (T-(e-1)).toNat=k+2 by clear*-h4;omega,QA,show e-1+((k+2:Nat):Int)=e+((k+1:Nat):Int) by push_cast;ring] theorem Vh (num den:Nat): Ya (sqrtAccuracy num den)=if num=ZK num den^2*den then 0 else 1:=by unfold sqrtAccuracy;dsimp only;split_ifs<;>rfl theorem V9 (num den:Nat) (s:Int) (hR:33554432≤ ZK num den) (h1:ZK num den>>>31=0) (h6:-209≤ s) (h7:s≤297): Yf num den s=Core.rnd false (XF (2*ZK num den+ (if num=ZK num den*ZK num den*den then 0 else 1))) (XF (297-s).toNat):=by set R:=ZK num den with h0 have h3:(XF (297-s).toNat).toNat=(297-s).toNat:=by rw [ZG,Nat.mod_eq_of_lt (by clear*-h6 h7;omega)] have hj:(if num=R*R*den then 0 else 1)≤1:=by split_ifs<;>(clear*-;omega) have hm:(XF (2*R+(if num=R*R*den then 0 else 1))).toNat= 2*R+(if num=R*R*den then 0 else 1):=by rw [ZG,Nat.mod_eq_of_lt (by clear*-h1 hj;omega)] rw [Core.rnd_eq _ _ _ (by clear*-h3 h6 h7;omega),h3,hm];unfold Yf;rw [←h0,Q4 _ _ R (-s) _ (by clear*-hR;(exact Nat.ne_zero_of_lt hR)) (Q7 R s XI),Vh,←h0,sq, show (((297-s).toNat:Nat):Int)-298=-s-1 by clear*-h6 h7;omega] rfl def V8 (B:Nat) (c:Int):Nat:=if 0≤c then B<<rw [Nat.shiftLeft_eq] ·refine ⟨h0, ?_⟩;push_cast;rw [←ZF (2:ℚ) c.toNat,show ((c.toNat:Nat):Int)=c by clear h0;(exact Int.toNat_of_nonneg hc)];ring ·refine ⟨XJ, ?_⟩;push_cast;rw [←ZF (2:ℚ) (-c).toNat,show (((-c).toNat:Nat):Int)=-c by clear h0;omega];have:(2:ℚ)^(-c)≠0:=XJ;rw [zpow_neg];grind @[inline] def V2 (r:Nat) (st:Bool):Nat:=if r !=0 || st then 1 else 0 theorem VI (N M:Nat) (hM:0 simp only [ite_true, Bool.false_eq_true, ite_false] at hv ⊢ <;> rw [hM] at hv <;> constructor <;> linarith only [hv, e1, e2, b1, b2] end NF namespace NE open NF Dense.F open Dense (sval_eq) @[inline] def mx (a b : UInt64) : UInt64 := if a < b then b else a theorem mxv (m e : UInt64) : (mx m e).toNat = max m.toNat e.toNat := by unfold mx; split <;> rename_i h <;> simp only [UInt64.lt_iff_toNat_lt] at h <;> omega @[inline] def pk (s : Bool) (q σ : UInt64) : Word := ((if s then (0x80000000:UInt64) else 0) + ((σ - 146) <<< 23 + Core.rne39 (((2:UInt64) * q + 1) <<< 36))).toUInt32 theorem pkE (s : Bool) (q σ : UInt64) (h1 : 2 ^ 25 ≤ q.toNat) (h2 : q.toNat < 2 ^ 26) (h3 : 146 ≤ σ.toNat) (h4 : σ.toNat ≤ 398) : pk s q σ = Core.rnd s ((2:UInt64) * q + 1) σ := by have hM : ((2:UInt64) * q + 1).toNat = 2 * q.toNat + 1 := by rw [UInt64.toNat_add, UInt64.toNat_mul]; simp only [UInt64.reduceToNat]; clear h3 h4;omega have hN : (((2:UInt64) * q + 1) <<< 36).toNat = (2 * q.toNat + 1) * 2 ^ 36 := by rw [UInt64.toNat_shiftLeft, hM]; simp only [UInt64.reduceToNat, Nat.reduceMod, Nat.shiftLeft_eq]; clear*-h1 h2;omega have hs : (σ - 36).toNat = σ.toNat - 36 := by rw [UInt64.toNat_sub_of_le σ 36 (UInt64.le_iff_toNat_le.2 (by simp only [UInt64.reduceToNat]; clear*-h3;(exact Nat.le_of_add_left_le h3)))]; rfl have e1 : Core.rnd s ((2:UInt64) * q + 1) σ = Core.rnd s (((2:UInt64) * q + 1) <<< 36) (σ - 36) := by rw [Core.rnd_fw s ((2:UInt64) * q + 1) σ (by clear*-hM;omega) (by clear*-h4;omega), Core.rnd_fw s (((2:UInt64) * q + 1) <<< 36) (σ - 36) (by clear*-hN;omega) (by clear*-h3 h4 hs;omega), hM, hN, hs, show (2:Int) ^ σ.toNat = 2 ^ 36 * 2 ^ (σ.toNat - 36) by rw [← pow_add, Nat.add_sub_cancel' (show 36 ≤ σ.toNat by clear*-h3;(exact Nat.le_of_add_left_le h3))]] cases s <;> simp only [ite_true, ite_false, Bool.false_eq_true] <;> push_cast <;> ring_nf have hp : (pk s q σ).toNat = (if s then 2 ^ 31 else 0) + ((σ.toNat - 146) * 2 ^ 23 + (Core.rne39 (((2:UInt64) * q + 1) <<< 36)).toNat) := by obtain ⟨-, -, r3⟩ := Core.rnd62n s (((2:UInt64) * q + 1) <<< 36) (σ - 36) (by clear*-h1 h2 hN;omega) (by clear*-h1 h2 hN;omega) (by clear*-h3 hs;omega) (by clear*-h3 h4 hs;omega) unfold pk rw [UInt64.toNat_toUInt32, UInt64.toNat_add, UInt64.toNat_add, UInt64.toNat_shiftLeft, UInt64.toNat_sub_of_le σ 146 (UInt64.le_iff_toNat_le.2 (by simp only [UInt64.reduceToNat]; omega))] cases s <;> simp only [ite_true, ite_false, Bool.false_eq_true, UInt64.reduceToNat, Nat.reduceMod, Nat.shiftLeft_eq] <;> (clear*-h3 h4 r3;omega) obtain ⟨r1, -, -⟩ := Core.rnd62n s (((2:UInt64) * q + 1) <<< 36) (σ - 36) (by clear*-h1 h2 hN;omega) (by clear*-h1 h2 hN;omega) (by clear*-h3 h4 hs;omega) (by clear*-h3 h4 hs;omega) rw [e1]; apply UInt32.toNat_inj.mp; clear e1 h1 h2 hM hN;omega theorem mo (a : ℝ) (p q : ℕ) (h : |a| ≤ 2 ^ p) (hpq : p ≤ q) : |a| ≤ 2 ^ q := h.trans (pow_le_pow_right₀ (by norm_num) hpq) theorem z9 (a : ℝ) (p : ℕ) (h : |a| ≤ 2 ^ p) (hp : p ≤ 971) : |a| ≤ (2:ℝ) ^ (971:ℤ) := by rw [show (971:ℤ) = ((971:ℕ):ℤ) from rfl, zpow_natCast]; exact mo a p 971 h hp theorem wB (w : Word) : |(sv w : ℝ) * 2 ^ idxOf w| ≤ 2 ^ (24 + idxOf w) := by rw [abs_mul, abs_of_pos (by positivity : (0:ℝ) < 2 ^ idxOf w), pow_add] have : |(sv w : ℝ)| ≤ 2 ^ 24 := by rw [← Int.cast_abs, Int.abs_eq_natAbs]; exact_mod_cast (svB w).le exact mul_le_mul_of_nonneg_right this (by positivity) end NE namespace NR open NF Dense.F open Dense (sval_eq) @[inline] def pt (j : Nat) : Float := P.get! (j + 1) theorem ptV (j : Nat) (hj : j ≤ 254) : fv (pt j) ∧ rv (pt j) = (2:ℝ) ^ j := by have h : pt j = pw j := by have e1 : P.get! (j + 1) = P.data[j + 1]! := by rcases P with ⟨dd⟩; rfl unfold pt; rw [e1, getElem!_pos P.data (j + 1) (by simp [P]; omega)] simp only [P, Array.getElem_ofFn]; rw [if_pos (by omega)]; rfl rw [h]; exact pwV j (by omega) theorem ndV (n:Nat) (hn:n<2^29):fv n.toUInt64.toInt64.toFloat∧rv n.toUInt64.toInt64.toFloat=n:=by have hz:n.toUInt64.toNat=n:=UInt64.toNat_ofNat_of_lt' (show n<2^64 by omega) have e:n.toUInt64.toInt64.toInt=n:=by show Core.sval n.toUInt64=n;rw [sval_eq,hz];split<;>(clear hz;omega) have:=i64 _ (by rw [e];simp;clear*-hn;omega);rw [e] at this;omega theorem fAl (a:ZB) (h:∀ i (hi:i0&&n>0&&x.size==rows*n&&g.size==n&&x.all finiteWord&&g.all finiteWord&&finiteWord eps&&(!ZX eps&&ZC eps !=0) theorem SN_eq (rows n:Nat) (eps:Word) (x g:ZB):SN rows n eps x g=stableNormDomain rows n eps x g:=by unfold SN stableNormDomain;congr 1;rw [Q6,Y2];have:(0:ℚ)<2^((ZZ eps:Int)-149):=XJ unfold sg;cases ZX eps<;>simp [this,Nat.pos_iff_ne_zero] theorem SNu {rows n:Nat} {eps:Word} {x g:ZB} (h:stableNormDomain rows n eps x g=true): 0NR.fAl x (by simpa [Array.all_eq_true] using h.1.1.1.2) i (by clear gs h;(exact Nat.lt_of_lt_of_eq hi (id (Eq.symm xs)))), fun j hj=>NR.fAl g (by simpa [Array.all_eq_true] using h.1.1.2) j (by clear h xs;(exact Nat.lt_of_lt_of_eq hj (id (Eq.symm gs))))⟩ namespace NF open Dense.F theorem subM (x y : Float) (hx : fv x) (hy : fv y) : Model.ofFloatModel (x - y).toModel = Model.sub (Model.ofFloatModel x.toModel) (Model.ofFloatModel y.toModel) := by change Model.ofFloatModel (Float.Model.sub x.toModel y.toModel) = _ rw [Float.Model.sub, Model.ofFloatModel_pack] have h := Model.sub_eq_ofModel_sub_of_isFinite (fmt := FloatFormat.binary64) (by decide) (Model.ofFloatModel x.toModel) (Model.ofFloatModel y.toModel) (by rw [Model.toModel_ofFloatModel]; exact (fvI x).1 hx) (by rw [Model.toModel_ofFloatModel]; exact (fvI y).1 hy) rw [Model.toModel_ofFloatModel, Model.toModel_ofFloatModel] at h exact h.symm theorem fsR (x y : Float) (hx : fv x) (hy : fv y) (hb : |rv x - rv y| ≤ Model.toReal (Model.posMaxFinite FloatFormat.binary64)) : fv (x - y) ∧ rv (x - y) = Model.roundAt FloatFormat.binary64 (rv x - rv y) := by have hm := subM x y hx hy have hf := Model.isFinite_sub_of_abs_toReal_sub_le_posMaxFinite (Model.ofFloatModel x.toModel) (Model.ofFloatModel y.toModel) (by decide) hx hy hb refine ⟨by unfold fv; rw [hm]; exact hf, ?_⟩ unfold rv; rw [hm]; exact Model.toReal_sub_eq_roundAt _ _ (by decide) hf theorem sqU (x:Float): Model.toModel (Model.ofFloatModel x.sqrt.toModel) = Model.toModel (Model.sqrt (Model.ofFloatModel x.toModel)) := by change Model.toModel (Model.ofFloatModel (Float.Model.sqrt x.toModel)) = _ rw [Float.Model.sqrt, Model.ofFloatModel_pack, show Float.Model.Format.binary64 = FloatFormat.binary64.toModel from rfl] have h := Model.canonicalizeModel_sqrt_eq_model (fmt := FloatFormat.binary64) (by decide) (Model.ofFloatModel x.toModel) rw [Model.toModel_ofFloatModel] at h rw [← h, Model.toModel_canonicalizeModel] theorem mEq {y z : Model FloatFormat.binary64} (h: Model.toModel y = Model.toModel z): Model.isFinite y = Model.isFinite z ∧ Model.toReal y = Model.toReal z := by constructor ·rw [← Model.toDyadic?_isSome_eq_isFinite, Model.toDyadic?_ieee_eq_model _ (by decide), ← Model.toDyadic?_isSome_eq_isFinite, Model.toDyadic?_ieee_eq_model _ (by decide), h] ·rw [Model.toReal_eq_unpackedToReal_toModel (by decide), Model.toReal_eq_unpackedToReal_toModel (by decide), h] theorem sgP (x:Float) (hx:fv x) (h0:0< rv x): Model.signBit (Model.ofFloatModel x.toModel) = false := by obtain ⟨d,hd⟩ := Model.exists_toDyadic?_of_isFinite hx rw [← Model.sign_eq_signBit_of_toDyadic?_some hd] have e : rv x = d.toReal := by unfold rv; simp [Model.toReal_eq, hd] cases hs : d.negative with | false => rfl | true => exfalso; rw [e] at h0; simp only [FloatLib.Numerics.Dyadic.toReal, hs] at h0 have : (0:ℝ) ≤ (d.significand:ℝ)*(2:ℝ)^d.exponent := by positivity simp only [FloatLib.Numerics.Dyadic.signedSignificand, hs] at h0 rw [Int.ofNat_eq_natCast] at h0; push_cast at h0; linarith theorem fqR (x:Float) (hx:fv x) (h0:0< rv x): fv x.sqrt ∧ rv x.sqrt = Model.roundAt FloatFormat.binary64 (Real.sqrt (rv x)) := by have hs := sgP x hx h0 have hfin := Model.isFinite_sqrt_of_isFinite _ (by decide) hx (Or.inr hs) have hr := Model.toReal_sqrt_eq_roundAt _ (by decide) hx (Or.inr hs) obtain ⟨a,b⟩ := mEq (sqU x) unfold fv rv; rw [a,b]; exact ⟨hfin, hr⟩ theorem fS (x y:Float) (hx:fv x) (hy:fv y) (hb:|rv x-rv y|≤(2:ℝ)^(971:Int)): fv (x-y)∧|rv (x-y)-(rv x-rv y)|≤|rv x-rv y|/2^53+1/2^1075:=by obtain ⟨h1, h2⟩ := fsR x y hx hy (hb.trans (pm 971 le_rfl)); exact ⟨h1, by rw [h2]; exact rel _⟩ theorem fQ (x:Float) (hx:fv x) (h0:0< rv x):fv x.sqrt∧|rv x.sqrt-Real.sqrt (rv x)|≤ Real.sqrt (rv x)/2^53+1/2^1075:=by obtain ⟨h1, h2⟩ := fqR x hx h0; refine ⟨h1, ?_⟩; rw [h2] have := rel (Real.sqrt (rv x)); rwa [abs_of_nonneg (Real.sqrt_nonneg _)] at this theorem rc (y r:Float) (hy:fv y) (h0:1≤ rv y) (h1:rv y≤2^400) (hr:(eF r.toBits).toNat<1100) (h:(r*y).toBits-0x3FEFFFFFFFFFFFFF<2):fv r∧|rv r-1/rv y|≤3/2^53/rv y:=by have fr:=fvE r (by omega) have hy0:(0:ℝ)< rv y:=by linarith have e:|rv r|≤2^(78:Int):=(bitsB r fr).le.trans (zpow_le_zpow_right₀ (by norm_num) (by omega)) obtain ⟨fp,ep⟩:=fM r y fr hy (by rw [abs_mul,abs_of_pos hy0];simp only [zpow_ofNat] at e ⊢ exact (mul_le_mul e h1 hy0.le (by positivity)).trans (by rw [←pow_add];exact pow_le_pow_right₀ (by norm_num) (by norm_num))) have hP:|rv (r*y)-1|≤1/2^53:=by have:=UInt64.lt_iff_toNat_lt.mp h;have:=(r*y).toBits.toNat_lt;simp only [UInt64.toNat_sub,UInt64.reduceToNat] at * obtain hB|hB:(r*y).toBits=0x3FEFFFFFFFFFFFFF∨(r*y).toBits=0x3FF0000000000000:=by simp only [←UInt64.toNat_inj,UInt64.reduceToNat];clear e ep fp fr h h0 h1 hr hy hy0;omega all_goals rw [bitsD _ fp (by rw [hB];decide),dyR,hB];norm_num +decide [eF] have k1:=abs_sub_le (rv r*rv y) (rv (r*y)) 1 have k2:=abs_sub_abs_le_abs_sub (rv r*rv y) 1 have t:(1:ℝ)/2^1075≤1/2^60:=by gcongr<;>norm_num rw [abs_sub_comm] at ep;generalize (1:ℝ)/2^1075=τ at * refine ⟨fr,?_⟩;rw [show rv r-1/rv y=(rv r*rv y-1)/rv y by field_simp,abs_div,abs_of_pos hy0];gcongr norm_num at *;linarith end NF open NF Dense.F @[inline] def pq (B:UInt64):Word:=(((B>>>63)<<<31)+(((B&&&0x7FFFFFFFFFFFFFFF)+0x10000000)>>>29)-((1045:UInt64)<<<23)).toUInt32 theorem rq9 (q:UInt64) (h:q.toNat<2^26):(Core.rne39 ((2*q+1)<<<36)).toNat=(q.toNat+2)/4:=by have e:((2*q+1)<<<36).toNat=(2*q.toNat+1)*2^36:=by simp only [UInt64.toNat_shiftLeft,UInt64.toNat_add,UInt64.toNat_mul,UInt64.reduceToNat,Nat.reduceMod,Nat.shiftLeft_eq];omega unfold Core.rne39 simp only [UInt64.toNat_shiftRight,UInt64.toNat_add,UInt64.toNat_and,e,UInt64.reduceToNat,Nat.reduceMod,Nat.shiftRight_eq_div_pow,Nat.and_one_is_mod] generalize q.toNat=a at * clear e;simp (disch:=omega) only[Nat.mod_eq_of_lt];omega theorem eFv (B:UInt64):(eF B).toNat=B.toNat/2^52%2048:=by unfold eF;rw [UInt64.toNat_and,UInt64.toNat_shiftRight];simp only [UInt64.reduceToNat,Nat.reduceMod,Nat.shiftRight_eq_div_pow];exact Nat.and_two_pow_sub_one_eq_mod _ 11 theorem mFw (B:UInt64):(mF B).toNat=B.toNat%2^52+2^52:=by rw [mFv,UInt64.toNat_and];congr 1;exact Nat.and_two_pow_sub_one_eq_mod _ 52 theorem pqG (B:UInt64) (h1:146≤(eF B-900).toNat) (h2:(eF B-900).toNat≤398):pq B=NE.pk (B>>>63!=0) (mF B>>>27) (eF B-900):=by have hE:(eF B).toNat=B.toNat/2^52%2048:=by unfold eF;rw [UInt64.toNat_and,UInt64.toNat_shiftRight];simp only [UInt64.reduceToNat,Nat.reduceMod,Nat.shiftRight_eq_div_pow];exact Nat.and_two_pow_sub_one_eq_mod _ 11 have hM:=mFv B have hF:(B&&&0xfffffffffffff).toNat=B.toNat%2^52:=by rw [UInt64.toNat_and];exact Nat.and_two_pow_sub_one_eq_mod _ 52 have hS:(B>>>63).toNat=B.toNat/2^63:=by rw [UInt64.toNat_shiftRight];simp only [UInt64.reduceToNat,Nat.reduceMod,Nat.shiftRight_eq_div_pow] have hA:(B&&&0x7FFFFFFFFFFFFFFF).toNat=B.toNat%2^63:=by rw [UInt64.toNat_and];exact Nat.and_two_pow_sub_one_eq_mod _ 63 have hB:=B.toNat_lt rw [hF] at hM have hq:(mF B>>>27).toNat=(B.toNat%2^52+2^52)/2^27:=by rw [UInt64.toNat_shiftRight,hM];simp only [UInt64.reduceToNat,Nat.reduceMod,Nat.shiftRight_eq_div_pow] have hσ:(eF B-900).toNat=B.toNat/2^52%2048-900:=by rw [UInt64.toNat_sub,hE];simp only [UInt64.reduceToNat] at h1 h2 ⊢;rw [UInt64.toNat_sub,hE] at h1 h2;simp only [UInt64.reduceToNat] at h1 h2;clear*-h2;omega have hr:=rq9 (mF B>>>27) (by rw [hq];clear*-;omega) rw [hq] at hr have hs:(B>>>63!=0)=decide (B.toNat/2^63=1):=by rw [Bool.eq_iff_iff];simp only [bne_iff_ne,ne_eq,decide_eq_true_eq,←UInt64.toNat_inj,hS,UInt64.reduceToNat];clear*-hB;omega apply UInt32.toNat_inj.mp unfold pq NE.pk;rw [hs] simp only [UInt64.toNat_toUInt32,UInt64.toNat_add,UInt64.toNat_sub,UInt64.toNat_shiftLeft,UInt64.toNat_shiftRight, hS,hA,hσ,hr,UInt64.reduceToNat,Nat.reduceMod,Nat.shiftLeft_eq,Nat.shiftRight_eq_div_pow] rw [hσ] at h1 h2 generalize B.toNat=N at * clear hM hF hE hS hA hq hs hσ hr have c:N%2^63+268435456<2^64:=by clear*-;omega have v:(N%2^63+268435456)/2^29=N/2^52%2048*2^23+(N%2^52+2^28)/2^29:=by clear*-;omega have u:((N%2^52+2^52)/2^27+2)/4=(N%2^52+2^28)/2^29+2^23:=by clear*-;omega have s:N/2^63≤1:=by clear*-hB;omega have l:(N%2^52+2^28)/2^29≤2^23:=by clear*-;omega rw[Nat.mod_eq_of_lt c,v,u];clear c v u generalize N/2^63=S,N/2^52%2048=E,(N%2^52+2^28)/2^29=U at * clear hB have e:(2^64-146+(E-900))%2^64=E-1046:=by clear l s;omega simp only [decide_eq_true_eq];rw[e];clear e split<;>simp only [UInt64.reduceToNat]<;>simp (disch:=omega) only[Nat.mod_eq_of_lt]<;>omega theorem pqE (B:UInt64) (h1:1046≤(eF B).toNat) (h2:(eF B).toNat≤1298):pq B=NE.pk (B>>>63!=0) (mF B>>>27) (eF B-900):=by have:(eF B-900).toNat=(eF B).toNat-900:=UInt64.toNat_sub_of_le _ _ (UInt64.le_iff_toNat_le.2 (by simp only [UInt64.reduceToNat];(exact Nat.le_of_add_left_le h1))) exact pqG B (by omega) (by omega) theorem tc (B c:UInt64) (hc:c≤25) (h:(B&&&0x7FFFFFF)-((1:UInt64)<<0 by norm_num) clear h hc hc' this;omega theorem te (E:UInt64) (h:E-1046≤252):1046≤E.toNat∧E.toNat≤1298:=by have h':=UInt64.le_iff_toNat_le.1 h;rw [UInt64.toNat_sub] at h';have:=E.toNat_lt;simp only [UInt64.reduceToNat] at h';omega theorem cl (V:Float) (hv:fv V) (c:ℕ) (Z:ℝ) (hE1:1046≤(eF V.toBits).toNat) (hE2:(eF V.toBits).toNat≤1298) (hc1:2^c>>27).toNat∧(mF V.toBits>>>27).toNat<2^26∧ ((mF V.toBits>>>27).toNat:ℝ)*2^(((eF V.toBits).toNat:Int)-1048)<(if V.toBits>>>63!=0 then -Z else Z)∧ (if V.toBits>>>63!=0 then -Z else Z)<(((mF V.toBits>>>27).toNat:ℝ)+1)*2^(((eF V.toBits).toNat:Int)-1048):=by have hE0:¬eF V.toBits=0:=fun h=>by rw [h] at hE1;simp at hE1 have hvd:=bitsD V hv hE0;rw [dyR] at hvd have hM:=mFw V.toBits have hF:(V.toBits&&&0xfffffffffffff).toNat=V.toBits.toNat%2^52:=by rw [UInt64.toNat_and];exact Nat.and_two_pow_sub_one_eq_mod _ 52 rw [hF,show V.toBits.toNat%2^52+2^52=(mF V.toBits).toNat by rw [hM]] at hvd have hL:V.toBits.toNat%2^27=(mF V.toBits).toNat%2^27:=by rw [hM];clear*-;omega rw [hL] at hc1 hc2 have hsw:=sandw _ Z _ _ _ _ c (by positivity) hvd rfl hc1 hc2 he have hq:(mF V.toBits>>>27).toNat=(mF V.toBits).toNat/2^27:=by rw [UInt64.toNat_shiftRight];simp only [UInt64.reduceToNat,Nat.reduceMod,Nat.shiftRight_eq_div_pow] have hb:=V.toBits.toNat_lt have h27:(2:ℝ)^27*2^(((eF V.toBits).toNat:Int)-1075)=2^(((eF V.toBits).toNat:Int)-1048):=by rw [←zpow_natCast,←zpow_add₀ (by norm_num)];congr 1;push_cast;ring rw [hq];refine ⟨by clear*-hM;omega,by clear*-hM;omega,?_,?_⟩ ·rw [←h27,←mul_assoc];exact hsw.1 ·rw [←h27,←mul_assoc];exact hsw.2 theorem eC (V:Float) (hv:fv V) (c:ℕ) (Y:ℚ) (hE1:1046≤(eF V.toBits).toNat) (hE2:(eF V.toBits).toNat≤1298) (hc1:2^c>>27).toNat with hq set s:=V.toBits>>>63!=0 with hs set E:=(eF V.toBits).toNat with hE set e:ℤ:=(E:ℤ)-1197 with he' have k:∀ a:ℝ,a*2^((E:ℤ)-1048)=a*2^e*2^149:=fun a=>by rw [mul_assoc,←zpow_natCast (2:ℝ) 149,←zpow_add₀ (by norm_num)];congr 2;rw [he'];push_cast;ring have k3:(if s then -((Y:ℝ)*2^149) else (Y:ℝ)*2^149)=((if s then -Y else Y:ℚ):ℝ)*2^149:=by split<;>push_cast<;>ring rw [k,k3] at lo;rw [k,k3] at hi have lo':=lt_of_mul_lt_mul_right lo (by positivity) have hi':=lt_of_mul_lt_mul_right hi (by positivity) have lo2:(q:ℚ)*2^e<(if s then -Y else Y):=by exact_mod_cast (by push_cast;ring:(((q:ℚ)*2^e:ℚ):ℝ)=(q:ℝ)*2^e).trans_lt lo' have hi2:(if s then -Y else Y)<((q:ℚ)+1)*2^e:=by exact_mod_cast hi'.trans_eq (by push_cast;ring:((q:ℝ)+1)*2^e=((((q:ℚ)+1)*2^e:ℚ):ℝ)) have hpe:(0:ℚ)<2^e:=by positivity have hpos:0<(if s then -Y else Y):=lt_of_le_of_lt (by positivity) lo2 have habs:|Y|=(if s then -Y else Y):=by grind set δ:ℚ:=(if s then -Y else Y)/2^e-q with hδ have hδ0:0<δ:=by rw [hδ,sub_pos,lt_div_iff₀ hpe];exact lo2 have hδ1:δ<1:=by rw [hδ,sub_lt_iff_lt_add,div_lt_iff₀ hpe];linarith only [hi2] have hlog:q.log2=25:=le_antisymm (Nat.lt_succ_iff.1 ((Nat.log2_lt (by clear*-q1;(exact Nat.ne_zero_of_lt q1))).2 q2)) ((Nat.le_log2 (by clear*-q1;(exact Nat.ne_zero_of_lt q1))).2 q1) rw [←Qx s q true 1 e Y δ ((2:UInt64)*(mF V.toBits>>>27)+1) (eF V.toBits-900) (by intro _;split at habs<;>rename_i h<;>simp only [h,ite_true,Bool.false_eq_true,ite_false] at hpos ⊢<;> simp only [decide_eq_true_eq,decide_eq_false_iff_not,not_lt]<;>linarith only [hpos]) hδ0.le hδ1 (by grind) one_pos (by rw [habs,hδ];field_simp;ring) (by simpa using q1) (by simp [hlog];clear*-hE1 hE2;omega) (by simp [hlog];clear*-hE1 hE2;omega) (by rw [UInt64.toNat_add,UInt64.toNat_mul];simp [V2,←hq];clear*-q1 q2;omega) (by rw [hσ];clear*-hE1 hE2;omega)] theorem rsh (s:Bool) (M σ:UInt64) (h1:2^26≤M.toNat) (h2:M.toNat<2^27) (h3:146≤σ.toNat) (h4:σ.toNat≤398): Core.rnd s M σ=Core.rnd s (M<<<36) (σ-36):=by have hN:(M<<<36).toNat=M.toNat*2^36:=by rw [UInt64.toNat_shiftLeft];simp only [UInt64.reduceToNat,Nat.reduceMod,Nat.shiftLeft_eq];clear*-h1 h2;omega have hs:(σ-36).toNat=σ.toNat-36:=by rw [UInt64.toNat_sub_of_le σ 36 (UInt64.le_iff_toNat_le.2 (by simp only [UInt64.reduceToNat];clear*-h3;omega))];rfl rw [Core.rnd_fw s M σ (by clear*-h1;omega) (by clear*-h4;omega), Core.rnd_fw s (M<<<36) (σ-36) (by clear*-hN h1;omega) (by clear*-h3 h4 hs;omega),hN,hs, show (2:Int)^σ.toNat=2^36*2^(σ.toNat-36) by rw [←pow_add,Nat.add_sub_cancel' (show 36≤σ.toNat by clear*-h3;omega)]] cases s<;>simp only [ite_true,ite_false,Bool.false_eq_true]<;>push_cast<;>ring_nf theorem rn8 (s:Bool) (M σ:UInt64) (P:Nat) (hP1:2^23subst h<;>simp (disch:=omega) only[Nat.mod_eq_of_lt]<;>(clear*-hP1 hP2;omega) rw [r1,hr,hs];clear*-h3;omega theorem sandw2 (v Y U:ℝ) (neg:Bool) (M P c:ℕ) (hU:0simp only [ite_true,Bool.false_eq_true,ite_false] at hv ⊢<;>constructor<;>linarith only [hv,e1,e2,b1,b2,b3] theorem lg25 (W:ℕ) (h1:2^25≤W) (h2:W<2^26):W.log2=25:= le_antisymm (Nat.lt_succ_iff.1 ((Nat.log2_lt (Nat.ne_zero_of_lt h1)).2 h2)) ((Nat.le_log2 (Nat.ne_zero_of_lt h1)).2 h1) @[inline] def nx (B:UInt64):Bool:=((B+0x2000000)&&&0x1FFFFFFF)≤0x4000000&&((B+0x2000000)>>>29)&&&0x7FFFFF!=0 theorem nxE (B:UInt64) (hE2:(eF B).toNat≤1298) (h:nx B=true): (B.toNat%2^52+2^25)%2^29≤2^26∧(B.toNat%2^52+2^25)/2^29%2^23≠0:=by have hE:=eFv B have hb:=B.toNat_lt have hA:(B+0x2000000).toNat=B.toNat+2^25:=by rw [UInt64.toNat_add];simp only [UInt64.reduceToNat];clear h;omega have h1:((B+0x2000000)&&&0x1FFFFFFF).toNat=(B.toNat+2^25)%2^29:=by rw [UInt64.toNat_and,hA];exact Nat.and_two_pow_sub_one_eq_mod _ 29 have h2:(((B+0x2000000)>>>29)&&&0x7FFFFF).toNat=(B.toNat+2^25)/2^29%2^23:=by rw [UInt64.toNat_and,UInt64.toNat_shiftRight,hA];simp only [UInt64.reduceToNat,Nat.reduceMod,Nat.shiftRight_eq_div_pow] exact Nat.and_two_pow_sub_one_eq_mod _ 23 unfold nx at h simp only [Bool.and_eq_true,decide_eq_true_eq,bne_iff_ne,ne_eq,UInt64.le_iff_toNat_le,←UInt64.toNat_inj,h1,h2,UInt64.reduceToNat] at h clear hA h1 h2 hE hE2;omega theorem eC2 (V:Float) (hv:fv V) (c:ℕ) (Y:ℚ) (hE1:1046≤(eF V.toBits).toNat) (hE2:(eF V.toBits).toNat≤1298) (hc:c≤25) (hn1:(V.toBits.toNat%2^52+2^25)%2^29≤2^26) (hn2:(V.toBits.toNat%2^52+2^25)/2^29%2^23≠0) (he:|rv V-(Y:ℝ)*2^149|≤2^c*(2:ℝ)^(((eF V.toBits).toNat:Int)-1075)):pq V.toBits=roundRational Y:=by have hE0:¬eF V.toBits=0:=fun h=>by rw [h] at hE1;simp at hE1 have hvd:=bitsD V hv hE0;rw [dyR] at hvd have hF:(V.toBits&&&0xfffffffffffff).toNat=V.toBits.toNat%2^52:=by rw [UInt64.toNat_and];exact Nat.and_two_pow_sub_one_eq_mod _ 52 rw [hF] at hvd have hMw:=mFw V.toBits have hq:(mF V.toBits>>>27).toNat=(mF V.toBits).toNat/2^27:=by rw [UInt64.toNat_shiftRight];simp only [UInt64.reduceToNat,Nat.reduceMod,Nat.shiftRight_eq_div_pow] have hσ:(eF V.toBits-900).toNat=(eF V.toBits).toNat-900:=by rw [UInt64.toNat_sub_of_le _ _ (UInt64.le_iff_toNat_le.2 (by simp only [UInt64.reduceToNat];clear*-hE1;(exact Nat.le_of_add_left_le hE1)))];rfl generalize hf:V.toBits.toNat%2^52=f at * have hf52:f<2^52:=by rw [←hf];exact Nat.mod_lt _ (by norm_num) obtain ⟨P,hPd⟩:∃ P,P=2^23+(f+2^25)/2^29:=⟨_,rfl⟩ have hP1:2^23>>27)+1).toNat=2*((f+2^52)/2^27)+1:=by rw [UInt64.toNat_add,UInt64.toNat_mul,hq,hMw];simp only [UInt64.reduceToNat];clear*-hf52;omega have q1:2^25≤(mF V.toBits>>>27).toNat:=by rw [hq,hMw];clear*-;omega have q2:(mF V.toBits>>>27).toNat<2^26:=by rw [hq,hMw];clear*-hf52;omega set s:=V.toBits>>>63!=0 with hs set E:=(eF V.toBits).toNat with hE set e:ℤ:=(E:ℤ)-1197 with he' have R:∀ M:UInt64,8*P≤M.toNat+1 → M.toNat≤8*P+1 → Core.rnd s M (eF V.toBits-900)=pq V.toBits:=by intro M m1 m2 rw [pqE _ hE1 hE2,NE.pkE _ _ _ q1 q2 (by rw [hσ];clear*-hE1;omega) (by rw [hσ];clear*-hE1 hE2;omega)] apply UInt32.toNat_inj.mp rw [rn8 s M _ P hP1 hP2 m1 m2 (by rw [hσ];clear*-hE1;omega) (by rw [hσ];clear*-hE1 hE2;omega), rn8 s _ _ P hP1 hP2 (by rw [hM0];clear*-hPa hPb;omega) (by rw [hM0];clear*-hPa hPb;omega) (by rw [hσ];clear*-hE1;omega) (by rw [hσ];clear*-hE1 hE2;omega)] have k:(2:ℝ)^27*2^((E:ℤ)-1075)=2^e*2^149:=by rw [←zpow_natCast (2:ℝ) 27,←zpow_natCast (2:ℝ) 149,←zpow_add₀ (by norm_num),←zpow_add₀ (by norm_num)];congr 1;rw [he'];push_cast;ring have k3:(if s then -((Y:ℝ)*2^149) else (Y:ℝ)*2^149)=((if s then -Y else Y:ℚ):ℝ)*2^149:=by split<;>push_cast<;>ring rw [k,k3,←mul_assoc] at lo;rw [k,k3,←mul_assoc] at hi have lo':=le_of_mul_le_mul_right lo (by positivity) have hi':=le_of_mul_le_mul_right hi (by positivity) have lo2:(4*(P:ℚ)-1/2)*2^e≤(if s then -Y else Y):=by exact_mod_cast (by push_cast;ring:((((4*(P:ℚ)-1/2)*2^e:ℚ)):ℝ)=(4*(P:ℝ)-1/2)*2^e).trans_le lo' have hi2:(if s then -Y else Y)≤(4*(P:ℚ)+1/2)*2^e:=by exact_mod_cast hi'.trans_eq (by push_cast;ring:(4*(P:ℝ)+1/2)*2^e=((((4*(P:ℚ)+1/2)*2^e:ℚ)):ℝ)) have hpe:(0:ℚ)<2^e:=by positivity have hPq:(2:ℚ)^23rename_i h<;>simp only [h,ite_true,Bool.false_eq_true,ite_false] at hpos ⊢<;> simp only [decide_eq_true_eq,decide_eq_false_iff_not,not_lt]<;>linarith only [hpos] obtain ⟨y,hy⟩:∃ y:ℚ,y=(if s then -Y else Y)/2^e:=⟨_,rfl⟩ have y1:4*(P:ℚ)-1/2≤y:=by rw [hy,le_div_iff₀ hpe];exact lo2 have y2:y≤4*(P:ℚ)+1/2:=by rw [hy,div_le_iff₀ hpe];exact hi2 have hYy:|Y|=y*2^e:=by rw [habs,hy];field_simp by_cases hlt:y<4*(P:ℚ) ·obtain ⟨W,hW⟩:∃ W,W+1=4*P:=⟨4*P-1,by clear*-hP1;omega⟩ have hWq:(W:ℚ)+1=4*P:=by exact_mod_cast hW have hlogW:W.log2=25:=lg25 W (by clear*-hW hP1;omega) (by clear*-hW hP2;omega) have hMA:(UInt64.ofNat (2*W+1)).toNat=2*W+1:=by rw [UInt64.toNat_ofNat'];clear*-hW hP2;omega rw [←R (UInt64.ofNat (2*W+1)) (by rw [hMA];clear*-hW;omega) (by rw [hMA];clear*-hW;omega)] exact Qx s W true 1 e Y (y-W) _ _ hsg (by linarith only [y1,hWq]) (by linarith only [hlt,hWq]) ⟨fun _=>ne_of_gt (by linarith only [y1,hWq]),fun _=>rfl⟩ one_pos (by rw [hYy];push_cast;ring) (by simp;clear*-hW hP1;omega) (by simp [hlogW];clear*-hE1 hE2;omega) (by simp [hlogW];clear*-hE1 hE2;omega) (by rw [hMA];simp [V2]) (by rw [hσ];clear*-hE1 hE2;omega) ·have hge:4*(P:ℚ)≤y:=not_lt.1 hlt obtain ⟨st,hst⟩:∃ st:Bool,st=decide (y-((4*P:ℕ):ℚ)≠0):=⟨_,rfl⟩ have hV:V2 0 st≤1:=by unfold V2;split<;>omega have hlogB:(4*P).log2=25:=lg25 _ (by clear*-hP1;omega) (by clear*-hP2;omega) have hMB:(UInt64.ofNat (2*(4*P)+V2 0 st)).toNat=2*(4*P)+V2 0 st:=by rw [UInt64.toNat_ofNat'];clear*-hV hP2;omega rw [←R (UInt64.ofNat (2*(4*P)+V2 0 st)) (by rw [hMB];clear*-hV;omega) (by rw [hMB];clear*-hV;omega)] exact Qx s (4*P) st 1 e Y (y-((4*P:ℕ):ℚ)) _ _ hsg (by push_cast;linarith only [hge]) (by push_cast;linarith only [y2]) (by rw [hst];simp) one_pos (by rw [hYy];push_cast;ring) (by simp;clear*-hP1;omega) (by simp [hlogB];clear*-hE1 hE2;omega) (by simp [hlogB];clear*-hE1 hE2;omega) (by rw [hMB,Nat.div_one,Nat.mod_one]) (by rw [hσ];clear*-hE1 hE2;omega) theorem dC (t:Float) (ht:fv t) (w:ℕ) (v:ℚ) (hv:0< v) (hE1:1046≤(eF t.toBits).toNat) (hE2:(eF t.toBits).toNat≤1298) (hc1:2^w>>27).toNat with hq set E:=(eF t.toBits).toNat with hE have hZ:0>>63!=0)=false:=by by_contra h;simp only [Bool.not_eq_false] at h;rw [if_pos h] at lo;linarith [show (0:ℝ)≤(q:ℝ)*2^((E:ℤ)-1048) by positivity] rw [hs] at lo hi;simp only [Bool.false_eq_true,ite_false] at lo hi set s:ℤ:=1197-E with hs' have k:(2:ℝ)^149=2^s*2^((E:ℤ)-1048):=by rw [←zpow_natCast,←zpow_add₀ two_ne_zero];congr 1;clear*-;omega rw [k,←mul_assoc] at lo hi have l1:=lt_of_mul_lt_mul_right lo (by positivity) have l2:=lt_of_mul_lt_mul_right hi (by positivity) have hsq:(Real.sqrt v*2^s)^2=(v:ℝ)*2^(2*s):=by rw [mul_pow,Real.sq_sqrt (by exact_mod_cast hv.le),←zpow_natCast,←zpow_mul];ring_nf have m1:(q:ℝ)^2<(v:ℝ)*2^(2*s):=by rw [←hsq];exact pow_lt_pow_left₀ l1 (by positivity) (by norm_num) have m2:(v:ℝ)*2^(2*s)<((q:ℝ)+1)^2:=by rw [←hsq];exact pow_lt_pow_left₀ l2 (by positivity) (by norm_num) have hn:0(z:ℝ)) hVE;push_cast at this;exact this rw [←h4] at m1 m2 have hd:(0:ℝ)>> 27).toNat) (2 ^ 64) 1) ·apply UInt64.toNat_inj.mp;rw [ZG,hσ];clear*-hE1 hE2;omega theorem eOv (w:Word):(expOf w).toNat=w.toNat/2^23%256:=by unfold expOf;rw [UInt32.toNat_and,UInt32.toNat_shiftRight];simp only [UInt32.reduceToNat,Nat.reduceMod,Nat.shiftRight_eq_div_pow] exact Nat.and_two_pow_sub_one_eq_mod _ 8 theorem fOv (w:Word):(fracOf w).toNat=w.toNat%2^23:=by unfold fracOf;rw [UInt32.toNat_and];simp only [UInt32.reduceToNat];exact Nat.and_two_pow_sub_one_eq_mod _ 23 theorem wV (w:Word) (K R:ℕ) (h:w.toNat=K*2^23+R) (h1:2^23≤ R) (h2:R≤2^24) (hK:K≤252): expOf w≠255∧signOf w=false∧(sv w:ℝ)*2^idxOf w=R*2^K:=by have he:=eOv w;have hf:=fOv w have hs:signOf w=false:=by have:¬ 2^31≤ w.toNat:=by clear he hf;omega exact Bool.eq_false_iff.2 (fun h'=>this ((Core.signOf_iff w).1 h')) have hE:(expOf w).toNat≠255:=by rw [he,h];clear h hf;omega refine ⟨fun h'=>hE (by rw [h'];rfl),hs,?_⟩ have hE0:expOf w≠0:=fun h'=>by rw [h'] at he;simp at he;clear hf;omega unfold sv mantOf idxOf;rw [hs,if_neg hE0,if_neg hE0];simp only [Bool.false_eq_true,ite_false] rw [hf,he,h] rcases Nat.lt_or_ge R (2^24) with hR|hR ·have q1:(K*2^23+R)/2^23%256=K+1:=by clear h hf;omega have q2:(K*2^23+R)%2^23=R-2^23:=by clear*-h1 h2 hR;omega rw [q1,q2,show K+1-1=K by clear*-;(exact Nat.add_sub_self_right K 1),Nat.cast_add,Nat.cast_sub h1];push_cast;ring ·have hR':R=2^24:=by clear*-h1 h2 hR;(exact Nat.le_antisymm h2 hR) subst hR' have q1:(K*2^23+2^24)/2^23%256=K+2:=by clear*-hK;omega have q2:(K*2^23+2^24)%2^23=0:=by clear*-;omega rw [q1,q2,show K+2-1=K+1 by clear*-;(exact Nat.add_succ_sub_one K 1)];push_cast;ring theorem pqW (B:UInt64) (h1:1046≤(eF B).toNat) (h2:(eF B).toNat≤1298) (hs:B.toNat<2^63): (pq B).toNat=((eF B).toNat-1046)*2^23+(2^23+(B.toNat%2^52+2^28)/2^29):=by have hE:=eFv B have hE':(eF B).toNat=B.toNat/2^52:=by rw [hE];exact Nat.mod_eq_of_lt (by clear*-hs;omega) have a1:((B>>>63)<<<31).toNat=0:=by rw [UInt64.toNat_shiftLeft,UInt64.toNat_shiftRight];simp only [UInt64.reduceToNat,Nat.reduceMod,Nat.shiftRight_eq_div_pow,Nat.shiftLeft_eq] rw [Nat.div_eq_of_lt hs] have a2:(B&&&0x7FFFFFFFFFFFFFFF).toNat=B.toNat:=by rw [UInt64.toNat_and];simp only [UInt64.reduceToNat];rw [show 9223372036854775807=2^63-1 by norm_num,Nat.and_two_pow_sub_one_eq_mod];exact Nat.mod_eq_of_lt hs have a3:(((B&&&0x7FFFFFFFFFFFFFFF)+0x10000000)>>>29).toNat=(B.toNat+2^28)/2^29:=by rw [UInt64.toNat_shiftRight,UInt64.toNat_add,a2];simp only [UInt64.reduceToNat,Nat.reduceMod,Nat.shiftRight_eq_div_pow] rw [Nat.mod_eq_of_lt (by clear*-hs;omega)];norm_num have a4:(B.toNat+2^28)/2^29=B.toNat/2^52*2^23+(B.toNat%2^52+2^28)/2^29:=by clear*-;omega have a5:(((B>>>63)<<<31)+(((B&&&0x7FFFFFFFFFFFFFFF)+0x10000000)>>>29)).toNat=(B.toNat+2^28)/2^29:=by rw [UInt64.toNat_add,a1,a3,zero_add];exact Nat.mod_eq_of_lt (by clear*-hs;omega) have a6:((1045:UInt64)<<<23).toNat=1045*2^23:=by decide have a7:(((B>>>63)<<<31)+(((B&&&0x7FFFFFFFFFFFFFFF)+0x10000000)>>>29)-((1045:UInt64)<<<23)).toNat=(B.toNat+2^28)/2^29-1045*2^23:=by rw [UInt64.toNat_sub_of_le _ _ (UInt64.le_iff_toNat_le.2 (by rw [a5,a6];clear*-a5 h1 h2 hE';omega)),a5,a6] unfold pq;rw [UInt64.toNat_toUInt32,a7,a4,hE'];clear a2 a3 a4 a5 hE hs;omega theorem bP (b:Float) (hb:fv b) (h0:0< rv b) (he:¬eF b.toBits=0):b.toBits.toNat<2^63∧rv b=((b.toBits.toNat%2^52+2^52:ℕ):ℝ)*(2:ℝ)^(((eF b.toBits).toNat:Int)-1075):=by have h:=bitsD b hb he;rw [dyR] at h have hs:(b.toBits>>>63!=0)=false:=by by_contra hc;simp only [Bool.not_eq_false] at hc;rw [hc,if_pos rfl] at h have:(0:ℝ)≤((b.toBits&&&0xfffffffffffff).toNat+2^52:ℕ)*(2:ℝ)^(((eF b.toBits).toNat:Int)-1075):=by positivity push_cast at this h;linarith rw [hs] at h;simp only [Bool.false_eq_true,ite_false] at h refine ⟨?_,?_⟩ ·have:b.toBits>>>63=0:=by simpa using hs have:=congrArg UInt64.toNat this;rw [UInt64.toNat_shiftRight] at this;simp only [UInt64.reduceToNat,Nat.reduceMod,Nat.shiftRight_eq_div_pow] at this have:=UInt64.toNat_lt b.toBits;omega ·rw [h];congr 2;rw [UInt64.toNat_and];simp only [UInt64.reduceToNat];rw [show (4503599627370495:ℕ)=2^52-1 by norm_num,Nat.and_two_pow_sub_one_eq_mod] theorem pqD (b:Float) (hb:fv b) (h0:0< rv b) (h1:1046≤(eF b.toBits).toNat) (h2:(eF b.toBits).toNat≤1298): expOf (pq b.toBits)≠255∧signOf (pq b.toBits)=false∧|(sv (pq b.toBits):ℝ)*2^idxOf (pq b.toBits)-rv b|≤ rv b/2^24:=by obtain ⟨hs,hv⟩:=bP b hb h0 (fun h=>by rw [h] at h1;simp at h1) have hw:=pqW b.toBits h1 h2 hs obtain ⟨w1,w2,w3⟩:=wV _ _ _ hw (by clear*-;(exact Nat.le_add_right (2 ^ 23) ((b.toBits.toNat % 2 ^ 52 + 2 ^ 28) / 2 ^ 29))) (by clear*-;omega) (by clear*-h2;(exact Nat.sub_le_of_le_add h2)) refine ⟨w1,w2,?_⟩ rw [w3,hv] set E:=(eF b.toBits).toNat set F:=b.toBits.toNat%2^52 set R:=2^23+(F+2^28)/2^29 have r1:R*2^29≤ F+2^52+2^28:=by clear*-;omega have r2:F+2^52+2^28< R*2^29+2^29:=by clear*-;omega have e0:(2:ℝ)^(E-1046)=2^(29:ℤ)*2^((E:ℤ)-1075):=by rw [←zpow_natCast,←zpow_add₀ (by norm_num)];congr 1;clear*-h1 h2;omega have e1:(R:ℝ)*2^(E-1046)=((R*2^29:ℕ):ℝ)*(2:ℝ)^((E:Int)-1075):=by rw [e0];push_cast;norm_num;ring rw [e1,←sub_mul,abs_mul,abs_of_pos (by positivity : (0:ℝ)<2^((E:Int)-1075))] have r3:|((R*2^29:ℕ):ℝ)-((F+2^52:ℕ):ℝ)|≤2^28:=by rw [abs_le];constructor ·have:((F+2^52:ℕ):ℝ)<((R*2^29:ℕ):ℝ)+2^29-2^28:=by have:F+2^52+2^28< R*2^29+2^29:=r2;have:=(Nat.cast_lt (α:=ℝ)).2 this;push_cast at this ⊢;linarith linarith ·have:=(Nat.cast_le (α:=ℝ)).2 r1;push_cast at this ⊢;linarith have r4:(2:ℝ)^28≤((F+2^52:ℕ):ℝ)/2^24:=by have:(0:ℝ)≤ F:=Nat.cast_nonneg _ push_cast;rw [le_div_iff₀ (by positivity)];norm_num;try linarith calc (|((R*2^29:ℕ):ℝ)-((F+2^52:ℕ):ℝ)|)*2^((E:Int)-1075)≤((F+2^52:ℕ):ℝ)/2^24*2^((E:Int)-1075):= mul_le_mul_of_nonneg_right (r3.trans r4) (by positivity) _=_:=by ring @[inline] def fdec (a:ZB):FloatArray:=bld (fun j=>dw a[j]!) a.size (FloatArray.emptyWithCapacity a.size) theorem fdecE (a:ZB):(fdec a).size=a.size∧∀ j,j< a.size→(fdec a).data[j]! =dw a[j]!:=by have h0:(FloatArray.emptyWithCapacity a.size).size=0:=rfl obtain ⟨h1,-,h3⟩:=bld_spec (fun j=>dw a[j]!) a.size a.size _ (by rw [h0];clear*-;(exact Nat.sub_zero a.size)) (by rw [h0];(exact Nat.zero_le a.size)) exact ⟨h1,fun j hj=>h3 j (by rw [h0];clear*-;(exact Nat.zero_le j)) hj⟩ theorem ugE (X:FloatArray) (i:USize) (h:i.toNat< X.size):X.uget i h=X.data[i.toNat]!:=by rcases X with ⟨d⟩;simp only [FloatArray.uget];rw [getElem!_pos d i.toNat h];rfl theorem u1 {i:USize} (h:i.toNat+1<2^32):(i+1).toNat=i.toNat+1:=by rw [USize.toNat_add,USize.toNat_one];exact Nat.mod_eq_of_lt (by have:=USize.size_eq_two_pow;have:=USize.le_size;omega) @[specialize] def PP (f:Word→Float) (x:ZB) (e:USize) (he:e.toNat≤ x.size) (hb:e.toNat+1<2^32) (i:USize) (hi:i.toNat≤ e.toNat) (s t:Float):Float:= have:=USize.le_size if h:i+1< e then have h1:=u1 (i:=i) (by omega) have:=USize.lt_iff_toNat_lt.mp h have h2:(i+1+1).toNat=i.toNat+2:=by rw [u1 (by omega),h1] PP f x e he hb (i+1+1) (by omega) (s+f (x.uget i (by omega))) (t+f (x.uget (i+1) (by (exact Nat.lt_of_lt_of_le h he)))) else if h:i< e then s+f (x.uget i (by have:=USize.lt_iff_toNat_lt.mp h;(exact Nat.lt_of_lt_of_le h he)))+t else s+t termination_by e.toNat-i.toNat decreasing_by omega theorem fv0:fv (0:Float)∧rv (0:Float)=0:=by have h:(0:Float).toModel.unpack=.zero .positive:=by rfl refine ⟨(fvI 0).2 (by rw [h];rfl),?_⟩;rw [rvU,h];simp [Model.unpackedToReal,Model.unpackedToDyadic?,FloatLib.Numerics.Dyadic.toReal] theorem h1_aE (a b:Float) (A B X Y WA WB:ℝ) (fa:fv a) (fb:fv b) (ea:|rv a-A|≤ X) (eb:|rv b-B|≤ Y) (hA:|A|≤ WA) (hB:|B|≤ WB) (hW:WA+WB≤2^960) (hX:X+Y≤2^30*((1/2^53+1/2^73)*(WA+WB)+1/2^1074)): fv (a+b)∧|rv (a+b)-(A+B)|≤ X+Y+((1/2^53+1/2^73)*(WA+WB)+1/2^1074):=by have k:=abs_add_le (rv a) (rv b) have k1:=abs_sub_abs_le_abs_sub (rv a) A have k2:=abs_sub_abs_le_abs_sub (rv b) B have k3:=abs_nonneg A have k4:=abs_nonneg B have t1:(1:ℝ)/2^1074≤1:=by rw [div_le_one (by positivity)];exact one_le_pow₀ (by norm_num) have t2:(0:ℝ)≤1/2^1074:=by positivity obtain ⟨f1,f2⟩:=fA a b fa fb (by rw [zpow_ofNat,show (2:ℝ)^971=2048*2^960 by rw [show (2048:ℝ)=2^11 by norm_num,←pow_add]] have:(2:ℝ)^30≤2^960:=pow_le_pow_right₀ (by norm_num) (by norm_num) generalize (2:ℝ)^960=G at *;generalize (1:ℝ)/2^1074=T at *;linarith) refine ⟨f1,?_⟩ rw [show (1:ℝ)/2^1075=1/2^1074/2 by rw [pow_succ];ring] at f2 have:|rv a+rv b-(A+B)|≤|rv a-A|+|rv b-B|:=by rw [show rv a+rv b-(A+B)=rv a-A+(rv b-B) by ring];exact abs_add_le _ _ have:=abs_sub_le (rv (a+b)) (rv a+rv b) (A+B) generalize (1:ℝ)/2^1074=T at *;linarith theorem ugw (x:ZB) (j:USize) (hj:j.toNat< x.size):x.uget j hj=x[j.toNat]! :=by rw [getElem!_pos x j.toNat hj];rfl theorem pE1 (s F:Float) (Ss Ws wi:ℝ) (c:ℕ) (hc:c≤2^30) (fs:fv s) (fF:fv F) (es:|rv s-Ss|≤ c*((1/2^53+1/2^73)*Ws+1/2^1074)) (hs:|Ss|≤ Ws) (hF:|rv F|≤ wi) (hW:Ws+wi≤2^960): fv (s+F)∧|rv (s+F)-(Ss+rv F)|≤((c+1:ℕ):ℝ)*((1/2^53+1/2^73)*(Ws+wi)+1/2^1074)∧|Ss+rv F|≤ Ws+wi:=by have hc:(c:ℝ)≤2^30:=by exact_mod_cast hc have h0:=(abs_nonneg _).trans hs have h1:=(abs_nonneg _).trans hF have:=mul_le_mul_of_nonneg_right hc h0 have:=mul_nonneg c.cast_nonneg h1 have:=mul_le_mul_of_nonneg_right hc (show (0:ℝ)≤1/2^1074 by positivity) obtain ⟨a,b⟩:=h1_aE s F Ss (rv F) _ 0 Ws wi fs fF es (by simp) hs hF hW (by linarith) exact ⟨a,by push_cast;linarith,(abs_add_le _ _).trans (add_le_add hs hF)⟩ theorem pE2 (a b:Float) (A B WA WB:ℝ) (ca cb N:ℕ) (hc:ca+cb=N) (h1:2*ca≤ N+1) (h2:2*cb≤ N+1) (hN:N≤2^30) (fa:fv a) (fb:fv b) (ea:|rv a-A|≤ ca*((1/2^53+1/2^73)*WA+1/2^1074)) (eb:|rv b-B|≤ cb*((1/2^53+1/2^73)*WB+1/2^1074)) (hA:|A|≤ WA) (hB:|B|≤ WB) (hW:WA+WB≤2^960): fv (a+b)∧|rv (a+b)-(A+B)|≤((N:ℝ)+3)/2*((1/2^53+1/2^73)*(WA+WB))+((N:ℝ)+1)*(1/2^1074):=by have hN:(N:ℝ)≤2^30:=by exact_mod_cast hN have hc:(ca:ℝ)+cb=N:=by exact_mod_cast hc have h1:2*(ca:ℝ)≤N+1:=by exact_mod_cast h1 have h2:2*(cb:ℝ)≤N+1:=by exact_mod_cast h2 have h0:=(abs_nonneg _).trans hA have h3:=(abs_nonneg _).trans hB have:=mul_le_mul_of_nonneg_right h1 h0 have:=mul_le_mul_of_nonneg_right h2 h3 have:=mul_le_mul_of_nonneg_right hN h0 have:=mul_le_mul_of_nonneg_right hN h3 have:=mul_nonneg ca.cast_nonneg h3 have:=mul_nonneg cb.cast_nonneg h0 have:=mul_le_mul_of_nonneg_right hN (show (0:ℝ)≤1/2^1074 by positivity) obtain ⟨u,v⟩:=h1_aE a b A B _ _ WA WB fa fb ea eb hA hB hW (by rw [←hc] at *;linarith) exact ⟨u,by rw [←hc] at *;linarith⟩ theorem PPi (f:Word→Float) (x:ZB) (e:USize) (he:e.toNat≤ x.size) (hb:e.toNat+1<2^32) (lo:Nat) (w:Nat→ℝ) (hf:∀ k,lo≤ k→k< e.toNat→fv (f x[k]!)∧|rv (f x[k]!)|≤ w k) (hW:∑ k∈Finset.Ico lo e.toNat,w k≤2^960) (hn:e.toNat≤ lo+2^29) (i:USize) (hi:i.toNat≤ e.toNat) (s t:Float) (c:Nat) (Ss St Ws Wt:ℝ) (hc:i.toNat=lo+2*c) (fs:fv s) (ft:fv t) (es:|rv s-Ss|≤ c*((1/2^53+1/2^73)*Ws+1/2^1074)) (et:|rv t-St|≤ c*((1/2^53+1/2^73)*Wt+1/2^1074)) (hs:|Ss|≤ Ws) (ht:|St|≤ Wt) (hS:Ss+St=∑ k∈Finset.Ico lo i.toNat,rv (f x[k]!)) (hWs:Ws+Wt=∑ k∈Finset.Ico lo i.toNat,w k): fv (PP f x e he hb i hi s t)∧|rv (PP f x e he hb i hi s t)-∑ k∈Finset.Ico lo e.toNat,rv (f x[k]!)|≤ (((e.toNat-lo:ℕ):ℝ)+3)/2*((1/2^53+1/2^73)*∑ k∈Finset.Ico lo e.toNat,w k)+(((e.toNat-lo:ℕ):ℝ)+1)*(1/2^1074):=by induction hk:e.toNat-i.toNat using Nat.strong_induction_on generalizing i hi s t c Ss St Ws Wt hc fs ft es et hs ht hS hWs with | _ k ih => have hw:∀ k,lo≤ k→k< e.toNat→0≤ w k:=fun k h1 h2=>(abs_nonneg _).trans (hf k h1 h2).2 have hp:∀ j≤ e.toNat,∑ k∈Finset.Ico lo j,w k≤2^960:=fun j hj=>(Finset.sum_le_sum_of_subset_of_nonneg (Finset.Ico_subset_Ico_right hj) (fun k hk _=>(Finset.mem_Ico.1 hk).elim (hw k))).trans hW have:=(abs_nonneg _).trans hs have:=(abs_nonneg _).trans ht have:=USize.le_size rw [PP];dsimp only;split next h=> have h1:=u1 (i:=i) (by clear*-hb hi;omega) have h0:=USize.lt_iff_toNat_lt.mp h have h2:(i+1+1).toNat=i.toNat+1+1:=by rw [u1 (by clear*-h0 h1 hb hc;omega),h1] rw [ugw x i (by clear*-h0 h1 he;omega),ugw x (i+1) (by clear*-h0 he;(exact Nat.lt_of_lt_of_le h0 he)),h1] obtain ⟨g1,g2⟩:=hf i.toNat (by clear*-hc;omega) (by clear*-h0 h1;omega) obtain ⟨g3,g4⟩:=hf (i.toNat+1) (by clear*-hc;omega) (by clear*-h0 h1;(exact lt_of_eq_of_lt (id (Eq.symm h1)) h0)) have sx:∀ g:ℕ→ℝ,∑ k∈Finset.Ico lo (i+1+1).toNat,g k=∑ k∈Finset.Ico lo i.toNat,g k+g i.toNat+g (i.toNat+1):=fun g=>by rw [h2,Finset.sum_Ico_succ_top (by clear*-hc;omega),Finset.sum_Ico_succ_top (by clear*-hc;omega)] have:=hp _ (by clear*-h0 h1 h2;omega:(i+1+1).toNat≤_);rw [sx,←hWs] at this have:=hw i.toNat (by clear*-hc;omega) (by clear*-h0 h1;omega) have:=hw (i.toNat+1) (by clear*-hc;omega) (by clear*-h0 h1;(exact lt_of_eq_of_lt (id (Eq.symm h1)) h0)) obtain ⟨a1,a2,a3⟩:=pE1 s _ Ss Ws (w i.toNat) c (by clear*-h0 h1 hc hn;omega) fs g1 es hs g2 (by linarith) obtain ⟨b1,b2,b3⟩:=pE1 t _ St Wt (w (i.toNat+1)) c (by clear*-h0 h1 hc hn;omega) ft g3 et ht g4 (by linarith) exact ih _ (by rw [← hk];clear*-h0 h1 h2;omega) (i+1+1) (by clear*-h0 h1 h2;omega) _ _ (c+1) _ _ _ _ (by clear h1;omega) a1 b1 a2 b2 a3 b3 (by rw [sx,←hS];ring) (by rw [sx,←hWs];ring) rfl next h=> split next h'=> have h0:=USize.lt_iff_toNat_lt.mp h' have h1:=u1 (i:=i) (by clear*-h0 hb;omega) have he1:e.toNat=i.toNat+1:=by have:=mt USize.lt_iff_toNat_lt.mpr h;clear*-h0 h1 this;omega rw [ugw x i (by clear*-he he1;omega)] obtain ⟨g1,g2⟩:=hf i.toNat (by clear*-hc;omega) (by omega) have:=hp (i.toNat+1) (by clear*-he1;(exact Nat.le_of_eq (id (Eq.symm he1))));rw [Finset.sum_Ico_succ_top (by clear*-hc;omega),←hWs] at this obtain ⟨a1,a2,a3⟩:=pE1 s _ Ss Ws (w i.toNat) c (by clear*-hc he1 hn;omega) fs g1 es hs g2 (by linarith) rw [he1,Finset.sum_Ico_succ_top (by clear*-hc;omega),Finset.sum_Ico_succ_top (by clear*-hc;omega),←hS,←hWs,add_right_comm Ss,add_right_comm Ws] exact pE2 _ t _ St _ Wt (c+1) c _ (by clear*-hc;omega) (by clear*-hc;omega) (by clear*-hc;omega) (by clear*-he1 hn;omega) a1 ft a2 et a3 ht (by linarith) next h'=> have he1:e.toNat=i.toNat:=by have:=mt USize.lt_iff_toNat_lt.mpr h';clear*-hi this;omega rw [he1,←hS,←hWs] exact pE2 s t Ss St Ws Wt c c _ (by clear*-hc;omega) (by clear*-hc;omega) (by clear*-hc;omega) (by clear*-he1 hn;omega) fs ft es et hs ht (by rw [hWs];exact hp _ (by omega)) theorem PPs (f:Word→Float) (x:ZB) (e:USize) (he:e.toNat≤ x.size) (hb:e.toNat+1<2^32) (lo:USize) (hl:lo.toNat≤ e.toNat) (w:Nat→ℝ) (hf:∀ k,lo.toNat≤ k→k< e.toNat→fv (f x[k]!)∧|rv (f x[k]!)|≤ w k) (hW:∑ k∈Finset.Ico lo.toNat e.toNat,w k≤2^960) (hn:e.toNat≤ lo.toNat+2^29): fv (PP f x e he hb lo hl 0 0)∧|rv (PP f x e he hb lo hl 0 0)-∑ k∈Finset.Ico lo.toNat e.toNat,rv (f x[k]!)|≤ (((e.toNat-lo.toNat:ℕ):ℝ)+3)/2*((1/2^53+1/2^73)*∑ k∈Finset.Ico lo.toNat e.toNat,w k)+(((e.toNat-lo.toNat:ℕ):ℝ)+1)*(1/2^1074):= PPi f x e he hb lo.toNat w hf hW hn lo hl 0 0 0 0 0 0 0 (by clear*-;(exact Eq.symm ((fun {a b} => Nat.add_eq_left.mpr) rfl))) fv0.1 fv0.1 (by rw [fv0.2];simp) (by rw [fv0.2];simp) (by simp) (by simp) (by simp) (by simp) structure RS where ok:Bool m:Float ri:Float d:Word A:UInt64 @[inline] def rq (y r:Float):Bool:=eF r.toBits<1100&&(r*y).toBits-0x3FEFFFFFFFFFFFFF<2 @[inline] def dn (V:Float) (w:UInt64) (k:UInt64→Bool):Bool×Word:= let B:=(Float.sqrt V).toBits let t:=(1:UInt64)<<< w (eF B-1046≤252&&((B&&&0x7FFFFFF)-t-1<0x7FFFFFF-2*t||k B),pq B) @[inline] def rL (Ln:UInt64) (k:UInt64→Bool) (Ep rn:Float) (x:ZB) (lo hi:USize) (h:hi.toNat≤ x.size) (hb:hi.toNat+1<2^32) (hl:lo.toNat≤ hi.toNat):RS:= let m:=PP dw x hi h hb lo hl 0 0*rn let V:=PP (fun w=>let d:=dw w-m;d*d) x hi h hb lo hl 0 0*rn+Ep let t:=dn V Ln k let D:=dw t.2 let ri:=1/D let a:=eF m.toBits let b:=eF D.toBits let mD:=if b≤ a then a-b+1 else 0 ⟨t.1&&Ln+mD≤25&&rq D ri,m,ri,t.2,Ln+mD+1047⟩ @[inline] def rR (Ln:UInt64) (k:UInt64→Bool) (Ep rn:Float) (x:ZB) (lo hi:USize) (h:hi.toNat≤ x.size) (hb:hi.toNat+1<2^32) (hl:lo.toNat≤ hi.toNat):RS:= let V:=PP (fun w=>let d:=dw w;d*d) x hi h hb lo hl 0 0*rn+Ep let t:=dn V Ln k let D:=dw t.2 let ri:=1/D ⟨t.1&&rq D ri,0,ri,t.2,0⟩ @[noinline] def sL (n:Nat) (x:ZB) (r:Nat) (xw gw bw d:Word):Word:=ZT ((ZA xw-rowMean n x r)*ZA gw/ZA d+ZA bw) def mL (x:ZB) (b:Nat):Nat→UInt64→UInt64 | 0, u => u | k+1, u => let w:=x[b]!;let i:=Core.iW w;mL x (b+1) k (if Core.mW w==0||u< i then u else i) @[inline] def zS (w:Word) (lo:UInt64):Nat:=let M:=Core.mW w;let h:=Core.iW w-lo;if h≤38 then (M<< (p,q) | k+1, p, q => let w:=x[b]! if Core.mW w==0 then sS x lo (b+1) k p q else if ZX w then sS x lo (b+1) k p (q+zS w lo) else sS x lo (b+1) k (p+zS w lo) q @[noinline] def sI (n:Nat) (x:ZB) (r:Nat) (xw gw bw d:Word):Word:= let lo:=mL x (r*n) n 255 let S:=sS x lo (r*n) n 0 0 let X:=if Core.mW xw==0 then 0 else n*zS xw lo let T:=(if ZX xw then -(X:Int) else X)-((S.1:Int)-S.2) let s1:Int:=(lo.toNat:Int)+idxOf gw-idxOf d let s2:Int:=idxOf bw let f:=min s1 s2 let md:=ZW d let P:=T*sv gw*((1<<<(s1-f).toNat:Nat):Int)+sv bw*(n*md:Nat)*((1<<<(s2-f).toNat:Nat):Int) let Q:=n*md let a:=P.natAbs let k1:Int:=26+(Q.log2:Int)-(a.log2:Int) let k:=if V8 a k1/YF Q k1<67108864 then k1 else k1-1 let W:=V8 a k let Dd:=YF Q k let q:=W/Dd let e:=f-149-k if 0< Q&&a==0 then ZT 0 else if 33554432≤ q&&q<67108864&&-151≤ e&&e≤101&&0< Q then Core.rnd (decide (P<0)) (2*q+V2 (W%Dd) false).toUInt64 (e+297).toNat.toUInt64 else sL n x r xw gw bw d theorem mLs (x:ZB):∀ k b u,(mL x b k u).toNat≤ u.toNat∧∀ j< k,ZW x[b+j]! ≠0→(mL x b k u).toNat≤ idxOf x[b+j]!:=by intro k;induction k with | zero=>intro b u;exact ⟨le_rfl,fun j h=>absurd h (Nat.not_lt_zero _)⟩ | succ k ih=> intro b u;simp only [mL] generalize hv:(if Core.mW x[b]! ==0||u< Core.iW x[b]! then u else Core.iW x[b]!)=v have hv1:v.toNat≤ u.toNat∧(ZW x[b]! ≠0→v.toNat≤ idxOf x[b]!):=by rw [←hv];have:=ZS x[b]!;split<;>rename_i h<;>simp only [Bool.or_eq_true,YK,decide_eq_true_eq,UInt64.lt_iff_toNat_lt,not_or,not_lt] at h<;>omega obtain ⟨h1,h2⟩:=ih (b+1) v refine ⟨by omega,fun j hj hm=>?_⟩ rcases j with _|j ·have:=hv1.2 hm;simp only [Nat.add_zero] at *;clear*-h1 this;(exact Nat.le_trans h1 this) ·have:=h2 j (by clear*-hj;(exact Nat.succ_lt_succ_iff.mp hj)) (by rwa [show b+1+j=b+(j+1) by clear*-;(exact Nat.succ_add_eq_add_succ b j)]);rw [show b+1+j=b+(j+1) by clear*-;(exact Nat.succ_add_eq_add_succ b j)] at this;exact this theorem zSv (w:Word) (lo:UInt64) (h:lo.toNat≤ idxOf w):zS w lo=ZW w*2^(idxOf w-lo.toNat):=by have hi:=ZS w;have hm:=ZI w;have hb:=ZO w have hl:(Core.iW w-lo).toNat=idxOf w-lo.toNat:=by rw [UInt64.toNat_sub_of_le _ _ (UInt64.le_iff_toNat_le.2 (by (exact le_of_le_of_eq h (id (Eq.symm hi))))),hi] unfold zS;dsimp only;split<;>rename_i h' ·have h38:idxOf w-lo.toNat≤38:=by have:=UInt64.le_iff_toNat_le.1 h';rw [hl] at this;simpa using this rw [UInt64.toNat_shiftLeft,hm,hl,Nat.mod_eq_of_lt (show idxOf w-lo.toNat<64 by clear*-h38;omega),Nat.shiftLeft_eq] apply Nat.mod_eq_of_lt;calc ZW w*2^(idxOf w-lo.toNat)<2^24*2^38:=Nat.mul_lt_mul_of_lt_of_le hb (Nat.pow_le_pow_right (by norm_num) h38) (by positivity) _=2^62:=by norm_num _<2^64:=by norm_num ·rw [Nat.shiftLeft_eq,hm,hl] theorem sSs (x:ZB) (lo:UInt64):∀ k b p q,(∀ j< k,ZW x[b+j]! ≠0→lo.toNat≤ idxOf x[b+j]!)→ ((sS x lo b k p q).1:ℤ)-(sS x lo b k p q).2=(p:ℤ)-q+∑ j∈ZM k,sv x[b+j]!*2^(idxOf x[b+j]!-lo.toNat):=by intro k;induction k with | zero=>intro b p q _;simp [sS] | succ k ih=> intro b p q h have h':∀ j< k,ZW x[b+1+j]! ≠0→lo.toNat≤ idxOf x[b+1+j]!:=fun j hj=>by rw [show b+1+j=b+(j+1) by clear*-;(exact Nat.succ_add_eq_add_succ b j)];exact h _ (by (exact Nat.add_lt_add_right hj 1)) rw [Finset.sum_range_succ',Finset.sum_congr rfl (fun t _=>by rw [show b+(t+1)=b+1+t by (exact Eq.symm (Nat.succ_add_eq_add_succ b t))]),Nat.add_zero] simp only [sS] split<;>rename_i hm ·rw [ih _ _ _ h'];have:ZW x[b]! =0:=by simpa [YK] using hm simp [sv,this] ·have h0:=h 0 (by (exact Nat.zero_lt_succ k)) (by simpa [YK] using hm);simp only [Nat.add_zero] at h0 split<;>rename_i hs<;>rw [ih _ _ _ h',zSv _ _ h0]<;>simp [sv,hs]<;>ring theorem ZAs (w:Word) (lo:ℕ) (h:ZW w=0∨lo≤ idxOf w):((ZA w:ℚ))=(sv w*2^(idxOf w-lo):ℤ)*(2:ℚ)^((lo:ℤ)-149):=by rw [Y1];rcases h with h|h ·have:(sv w:ℚ)=0:=(YN w).2 h;rw [this];simp [show sv w=0 by exact_mod_cast this] ·push_cast;rw [mul_assoc,←zpow_natCast,←zpow_add₀ (by norm_num)];congr 2;push_cast [h];ring theorem rME (n:Nat) (x:ZB) (r:Nat):rowMean n x r=(((sS x (mL x (r*n) n 255) (r*n) n 0 0).1:ℤ)-(sS x (mL x (r*n) n 255) (r*n) n 0 0).2:ℤ)*(2:ℚ)^(((mL x (r*n) n 255).toNat:ℤ)-149)/n:=by obtain ⟨-,hlo⟩:=mLs x n (r*n) 255 generalize mL x (r*n) n 255=lo at hlo ⊢ have hS:=sSs x lo n (r*n) 0 0 (fun j hj h=>hlo j hj h) unfold rowMean;rw [Yk,zero_add];congr 1;rw [hS];simp only [Nat.cast_zero,sub_zero,zero_add];push_cast;rw [Finset.sum_mul] refine Finset.sum_congr rfl fun t ht=>?_ rw [ZAs _ lo.toNat (by by_cases h:ZW x[r*n+t]! =0;exact Or.inl h;exact Or.inr (hlo t (Finset.mem_range.1 ht) h))];push_cast;ring theorem sIE (n:Nat) (x:ZB) (r j:Nat) (gw bw d:Word) (hj:j< n) (hd:ZX d=false): sI n x r x[r*n+j]! gw bw d=ZT ((ZA x[r*n+j]! -rowMean n x r)*ZA gw/ZA d+ZA bw):=by have hn:0< n:=by (exact Nat.zero_lt_of_lt hj) obtain ⟨-,hlo⟩:=mLs x n (r*n) 255 unfold sI sL;lift_lets;intro lo S X T s1 s2 f md P Q a k1 k W Dd q e have hrow:rowMean n x r=((S.1:ℤ)-S.2:ℤ)*(2:ℚ)^((lo.toNat:ℤ)-149)/n:=rME n x r have hX:(ZA x[r*n+j]!:ℚ)=((if ZX x[r*n+j]! then -(X:ℤ) else X:ℤ):ℚ)/n*(2:ℚ)^((lo.toNat:ℤ)-149):=by by_cases h0:ZW x[r*n+j]! =0 ·have:X=0:=by simp only [X,YK,h0,decide_true,ite_true] rw [ZAs _ lo.toNat (Or.inl h0),this,show sv x[r*n+j]! =0 by exact_mod_cast (YN _).2 h0];simp ·have:X=n*(ZW x[r*n+j]!*2^(idxOf x[r*n+j]!-lo.toNat)):=by simp only [X,YK,h0,decide_false,Bool.false_eq_true,ite_false];rw [zSv _ _ (hlo j hj h0)] rw [ZAs _ lo.toNat (Or.inr (hlo j hj h0)),this];unfold sv;split<;>push_cast<;>field_simp have hgw:=Y1 gw;have hbw:=Y1 bw;have hdw:=Y1 d have hsd:(sv d:ℚ)=md:=by unfold sv;simp [hd,md] have hv:(ZA x[r*n+j]! -rowMean n x r)*ZA gw/ZA d+ZA bw=(P:ℚ)*2^f/(Q*2^149)∨Q=0:=by by_cases hQ:Q=0;exact Or.inr hQ left;have hmd:(md:ℚ)≠0:=by intro h;apply hQ;simp only [Q];exact_mod_cast (show n*md=0 by rw [show md=0 by exact_mod_cast h];simp) rw [hX,hrow,hgw,hbw,hdw,hsd] have e1:(2:ℚ)^(s1-f)=2^s1/2^f:=by rw [zpow_sub₀ (by norm_num)] have e2:(2:ℚ)^(s2-f)=2^s2/2^f:=by rw [zpow_sub₀ (by norm_num)] have hf1:0≤ s1-f:=by simp only [f];clear*-;omega have hf2:0≤ s2-f:=by simp only [f];clear*-;omega simp only [P,Q,T,Nat.one_shiftLeft] push_cast rw [←zpow_natCast,←zpow_natCast,Int.toNat_of_nonneg hf1,Int.toNat_of_nonneg hf2,e1,e2] simp only [s1,s2,zpow_sub₀ (show (2:ℚ)≠0 by norm_num),zpow_add₀ (show (2:ℚ)≠0 by norm_num)] field_simp split_ifs with h1 h2 ·simp only [Bool.and_eq_true,decide_eq_true_eq,beq_iff_eq] at h1 obtain ⟨hQ,ha⟩:=h1;rcases hv with hv|hv ·rw [hv,show P=0 from Int.natAbs_eq_zero.1 ha];simp ·clear*-hQ hv;omega ·simp only [Bool.and_eq_true,decide_eq_true_eq] at h2 obtain ⟨⟨⟨⟨q1,q2⟩,e1⟩,e2⟩,hQ⟩:=h2 rcases hv with hv|hv;swap;clear*-hQ hv;omega rw [hv] have ha0:a≠0:=by intro h;apply h1;simp [hQ,h] obtain ⟨hD,hW⟩:=VE a Q hQ k have hP:(P:ℚ)≠0:=by intro h;apply ha0;simp only [a];exact_mod_cast Int.natAbs_eq_zero.2 (by exact_mod_cast h) have hlog:q.log2=25:=le_antisymm (Nat.lt_succ_iff.1 ((Nat.log2_lt (by clear*-q1;(exact Nat.ne_zero_of_lt q1))).2 q2)) ((Nat.le_log2 (by clear*-q1;(exact Nat.ne_zero_of_lt q1))).2 q1) refine Qx _ W false Dd e _ 0 _ _ ?_ le_rfl one_pos (by simp) hD ?_ q1 (by rw [hlog];clear*-e1;(exact Int.le_add_of_sub_left_le e1)) (by rw [hlog];clear*-e2;(exact Int.add_le_of_le_neg_add e2)) ?_ ?_ ·intro _;congr 1;apply propext;constructor<;>intro h ·by_contra h';push Not at h';have:(0:ℚ)≤ P*2^f/(Q*2^149):=by positivity linarith ·apply div_neg_of_neg_of_pos (mul_neg_of_neg_of_pos (by exact_mod_cast h) (by positivity)) (by positivity) ·rw [add_zero,abs_div,abs_mul,abs_of_pos (show (0:ℚ)<2^f by positivity),abs_of_pos (show (0:ℚ)(clear*-;omega) exact Nat.mod_eq_of_lt (by clear*-q1 q2 this;omega) ·rw [Nat.toUInt64_eq,ZG,Nat.mod_eq_of_lt (by clear*-e2;omega)];clear*-e1;omega ·rfl theorem zQ (w:Word) (lo:UInt64) (h:ZW w=0∨lo.toNat≤ idxOf w):(ZA w)^2=((zS w lo:ℕ):ℚ)^2*((2:ℚ)^((lo.toNat:ℤ)-149))^2:=by rw [ZAs _ _ h,mul_pow];congr 1;rcases h with h|h ·have:Core.mW w=0:=UInt64.toNat_inj.mp (by rw [ZI,h];rfl) rw [show sv w=0 by exact_mod_cast (YN _).2 h];unfold zS;simp [this] ·rw [zSv _ _ h];unfold sv;split<;>push_cast<;>ring def qZ (x:ZB) (lo:UInt64) (b:Nat):Nat→Nat→Nat | 0, a => a | k+1, a => let z:=zS x[b]! lo;qZ x lo (b+1) k (a+z*z) theorem qZs (x:ZB) (lo:UInt64):∀ k b a,(qZ x lo b k a:ℚ)=a+∑ j∈ZM k,((zS x[b+j]! lo:ℕ):ℚ)^2:=by intro k;induction k with | zero=>intro b a;simp [qZ] | succ k ih=> intro b a;rw [Finset.sum_range_succ',Finset.sum_congr rfl (fun t _=>by rw [show b+(t+1)=b+1+t by (exact Eq.symm (Nat.succ_add_eq_add_succ b t))]),Nat.add_zero,qZ,ih];push_cast;ring def V5 (A Dn u:Nat) (eps:Word):Word:= let E:=ZW eps let ie:=ZZ eps let w0:=min (2*u) (ie+149) let B:=(A<<<(2*u-w0))+((Dn*E)<<<(ie+149-w0)) let s:Int:=(350-(w0:Int)-((B.log2:Int)-(Dn.log2:Int)))/2 let c:Int:=(w0:Int)-298+2*s let num:=V8 B c let den:=YF Dn c let R:=ZK num den if 33554432≤R then Yf num den s else sqrtRational ((A:ℚ)*2^(2*(u:Int)-298)/Dn+ZA eps) theorem YW (A Dn u:Nat) (eps:Word) (h3:0(z:ℝ)) (hq.trans (by rw [←hB,ZL ZQ,h2 (2*u-w0) (2*(u:Int)-298) (by clear*-h4;omega), h2 (ie+149-w0) ((ie:Int)-149) (by clear*-h4;omega),Nat.shiftLeft_eq,Nat.shiftLeft_eq] push_cast;field_simp: _=((A:ℚ)*2^(2*(u:Int)-298)/Dn+E*2^((ie:Int)-149))*2^(2*s))) push_cast at this ⊢;omega ·rfl @[noinline] def xD (n:Nat) (x:ZB) (r:Nat) (eps:Word) (c:Bool) (B:UInt64):Bool:= let lo:=mL x (r*n) n 255 let S:=sS x lo (r*n) n 0 0 let s:=if c then ((S.1:Int)-S.2).natAbs else 0 V5 (n*n*qZ x lo (r*n) n 0-n*s*s) (n*n*n) lo.toNat eps==pq B @[noinline] def sQ (xw gw d:Word):Word:=ZT (ZA xw*ZA gw/ZA d) @[inline] def eL (n:Nat) (x:ZB) (r:Nat) (e:RS) (xw gw bw:Word) (gv bv:Float):Word:= let v:=(dw xw-e.m)*(gv*e.ri)+bv let B:=v.toBits let E:=eF B let c:=NE.mx (NE.mx (E+5) (Core.iW bw+1051)) (Core.iW gw+e.A)-E let t:=(1:UInt64)<<< c if E-1046≤252&&c≤25&&((B&&&0x7FFFFFF)-t-1<0x7FFFFFF-2*t||nx B) then pq B else sI n x r xw gw bw e.d @[inline] def eR0 (e:RS) (xw gw:Word) (gv:Float):Word:= let v:=dw xw*(gv*e.ri) let B:=v.toBits let L:=B&&&0x7FFFFFF if eF B-1046≤252&&L-17<0x7FFFFDF then pq B else if xw&&&0x7FFFFFFF==0 then 0 else sQ xw gw e.d @[inline] def eR (e:RS) (xw gw:Word) (gv:Float):Word:= let v:=dw xw*(gv*e.ri) let B:=v.toBits let z:UInt64:=((xw&&&0x7FFFFFFF).toUInt64-1)>>>(63:UInt64) let m:UInt64:=z-1 if ((eF B-1046)&&&m:UInt64)≤252&&((B&&&0x7FFFFFF)|||(z<<<(8:UInt64)))-17<0x7FFFFDF then pq B&&&m.toUInt32 else if xw&&&0x7FFFFFFF==0 then 0 else sQ xw gw e.d theorem uB {r rows n:Nat} (hr:r< rows) (hn:rows*n+1<2^32):r*n+n≤ rows*n∧(r*n).toUSize.toNat=r*n∧n.toUSize.toNat=n∧((r*n).toUSize+n.toUSize).toNat=r*n+n:=by have h1:=Nat.mul_le_mul_right n (Nat.succ_le_of_lt hr);rw [Nat.succ_mul] at h1 have:=USize.le_size;have h2:=Dense.toUSize_toNat (n:=r*n) (by clear hr;omega);have h3:=Dense.toUSize_toNat (n:=n) (by clear h2 hr;omega) exact ⟨h1,h2,h3,by rw [Dense.uadd (by have:=USize.le_size;clear hr this;omega),h2,h3]⟩ @[specialize] def QE (lo N:USize) (f:(j:USize)→j< N→Word) (hN:lo.toNat+N.toNat<2^32) (i:USize) (out:ZB) (ho:lo.toNat+N.toNat≤ out.size):ZB:= if h:i< N then have:=USize.lt_iff_toNat_lt.mp h QE lo N f hN (i+1) (out.uset (lo+i) (f i h) (by rw [Dense.uadd (by have:=USize.le_size;omega)];omega)) (by rw [Array.size_uset];exact ho) else out termination_by N.toNat-i.toNat decreasing_by have:=USize.toNat_lt_size N;rw [uS (by (exact Nat.lt_of_le_of_lt h this))];(exact Nat.sub_succ_lt_self N.toNat i.toNat h) theorem QEs (lo N:USize) (f:(j:USize)→j< N→Word) (hN:lo.toNat+N.toNat<2^32) (i:USize) (out:ZB) (ho:lo.toNat+N.toNat≤ out.size): (QE lo N f hN i out ho).size=out.size:=by unfold QE;split ·rw [QEs];exact Array.size_uset .. ·rfl termination_by N.toNat-i.toNat decreasing_by have:=USize.lt_iff_toNat_lt.mp ‹_›;have:=USize.toNat_lt_size N;rw [uS (by omega)];omega theorem gsU (a:ZB) (i:Nat) (v:Word) (h:i< a.size) (q:Nat):(a.set i v h)[q]! =if i=q then v else a[q]! :=by by_cases hq:q< a.size ·rw [getElem!_pos _ q (by simpa using hq),getElem!_pos a q hq,Array.getElem_set] ·rw [getElem!_neg _ q (by simpa using hq),getElem!_neg a q hq];split<;>first|rfl|omega theorem QEE (lo N:USize) (f:(j:USize)→j< N→Word) (F:Nat→Word) (hN:lo.toNat+N.toNat<2^32) (hf:∀ j h,f j h=F (lo.toNat+j.toNat)) (i:USize) (out:ZB) (ho:lo.toNat+N.toNat≤ out.size): (QE lo N f hN i out ho).size=out.size∧∀ q,(QE lo N f hN i out ho)[q]! =if lo.toNat+i.toNat≤ q∧q< lo.toNat+N.toNat then F q else out[q]!:=by induction hQz:N.toNat-i.toNat using Nat.strong_induction_on generalizing i out ho with | _ kQz iQz => rw [QE];split ·rename_i h have h0:=USize.lt_iff_toNat_lt.mp h have hl:=USize.le_size have hi1:(i+1).toNat=i.toNat+1:=uS (by (try clear iQz);clear h hf ho;omega) have hli:(lo+i).toNat=lo.toNat+i.toNat:=Dense.uadd (by (try clear iQz);clear*-h0 hN hl;omega) obtain ⟨s1,s2⟩:=(iQz _ (by rw [← hQz];have:=USize.le_size;rw [uS (by (try clear iQz);clear*-h0 hN this;omega)];(try clear iQz);clear*-h0;(exact Nat.sub_succ_lt_self N.toNat i.toNat h0)) (i+1) (out.uset (lo+i) (f i h) (by rw [hli];(try clear iQz);clear*-h0 ho;omega)) (by rw [Array.size_uset];exact ho) rfl) refine ⟨by rw [s1,Array.size_uset],fun q=>?_⟩ rw [s2 q,hi1] simp only [Array.uset];rw [gsU,hli,hf] split_ifs<;>first|rfl|omega|(subst_vars;rfl) ·rename_i h have h0:¬ i.toNat< N.toNat:=fun hh=>h (USize.lt_iff_toNat_lt.mpr hh) exact ⟨rfl,fun q=>by rw [if_neg (by (try clear iQz);clear*-h0;omega)]⟩ @[noinline] def fL (n:Nat) (eps:Word) (x g b:ZB) (r:Nat) (lo N:USize) (hN:lo.toNat+N.toNat<2^32) (out:ZB) (ho:lo.toNat+N.toNat≤ out.size):ZB:= let M:=rowMean n x r let d:=sqrtRational (rowVariance n x r M+ZA eps) QE lo N (fun j _=>ZT ((ZA x[r*n+j.toNat]! -M)*ZA g[j.toNat]! /ZA d+ZA b[j.toNat]!)) hN 0 out ho @[noinline] def fR (n:Nat) (eps:Word) (x g:ZB) (r:Nat) (lo N:USize) (hN:lo.toNat+N.toNat<2^32) (out:ZB) (ho:lo.toNat+N.toNat≤ out.size):ZB:= let d:=sqrtRational (rowVariance n x r 0+ZA eps) QE lo N (fun j _=>ZT (ZA x[r*n+j.toNat]!*ZA g[j.toNat]! /ZA d)) hN 0 out ho theorem rkS {r k rows:Nat} (hk:r+(k+1)=rows):r< rows∧r+1+k=rows:=by omega theorem eqge {a b c:Nat} (h:a=b) (hb:c≤ b):c≤ a:=h▸hb theorem rliB {r rows n:Nat} {x g b:ZB} {j:USize} (hr:r< rows) (hn:rows*n+1<2^32) (hx:rows*n≤ x.size) (hg:n≤ g.size) (hb:n≤ b.size) (hj:j< n.toUSize): j.toNat< g.size∧j.toNat< b.size∧((r*n).toUSize+j).toNat< x.size:=by obtain ⟨h1,h2,h3,h4⟩:=uB hr hn;have hj':=USize.lt_iff_toNat_lt.mp hj;rw [h3] at hj';have hl:=USize.le_size refine ⟨by clear*-hj' hg;(exact Nat.lt_of_lt_of_le hj' hg),by clear*-hj' hb;(exact Nat.lt_of_lt_of_le hj' hb),?_⟩ rw [Dense.uadd (by rw [h2];clear*-hj' h1 hn hl;omega),h2];clear*-hj' h1 hx;omega theorem rliA {r rows n:Nat} {x out:ZB} (hr:r< rows) (hn:rows*n+1<2^32) (hx:rows*n≤ x.size) (ho:rows*n≤ out.size): (r*n).toUSize.toNat+n.toUSize.toNat<2^32∧(r*n).toUSize.toNat+n.toUSize.toNat≤ out.size∧((r*n).toUSize+n.toUSize).toNat≤ x.size∧ ((r*n).toUSize+n.toUSize).toNat+1<2^32∧(r*n).toUSize.toNat≤((r*n).toUSize+n.toUSize).toNat:=by obtain ⟨h1,h2,h3,h4⟩:=uB hr hn rw [h2,h3,h4];clear*-h1 hn hx ho;omega theorem qfs (lo N:USize) (f:(j:USize)→j< N→Word) (hN:lo.toNat+N.toNat<2^32) (out:ZB) (ho:lo.toNat+N.toNat≤ out.size) (c:Bool) (n:Nat) (eps:Word) (x g b:ZB) (r:Nat): (if c=true then QE lo N f hN 0 out ho else fL n eps x g b r lo N hN out ho).size=out.size:=by split ·exact QEs .. ·simp only [fL];exact QEs .. theorem qfsR (lo N:USize) (f:(j:USize)→j< N→Word) (hN:lo.toNat+N.toNat<2^32) (out:ZB) (ho:lo.toNat+N.toNat≤ out.size) (c:Bool) (n:Nat) (eps:Word) (x g:ZB) (r:Nat): (if c=true then QE lo N f hN 0 out ho else fR n eps x g r lo N hN out ho).size=out.size:=by split ·exact QEs .. ·simp only [fR];exact QEs .. theorem rlD {r rows n:Nat} {gd bd:FloatArray} {j:USize} (hr:r< rows) (hn:rows*n+1<2^32) (hgd:n≤ gd.size) (hbd:n≤ bd.size) (hj:j< n.toUSize): j.toNat< gd.size∧j.toNat< bd.size:=by obtain ⟨h1,h2,h3,h4⟩:=uB hr hn;have hj':=USize.lt_iff_toNat_lt.mp hj;rw [h3] at hj';clear*-hj' hgd hbd;omega def RL (rows n:Nat) (Ln:UInt64) (Ep rn:Float) (eps:Word) (x g b:ZB) (gd bd:FloatArray) (hn:rows*n+1<2^32) (hx:rows*n≤ x.size) (hg:n≤ g.size) (hb:n≤ b.size) (hgd:n≤ gd.size) (hbd:n≤ bd.size) :(k r:Nat)→ r+k=rows→(out:ZB)→ rows*n≤ out.size→ZB | 0,_,_,out,_=>out | k+1,r,hk,out,ho=> have hr:=(rkS hk).1 have p:=rliA hr hn hx ho let e:=rL Ln (xD n x r eps true) Ep rn x (r*n).toUSize ((r*n).toUSize+n.toUSize) p.2.2.1 p.2.2.2.1 p.2.2.2.2 RL rows n Ln Ep rn eps x g b gd bd hn hx hg hb hgd hbd k (r+1) (rkS hk).2 (if e.ok then QE (r*n).toUSize n.toUSize (fun j hj=> have q:=rliB hr hn hx hg hb hj have q2:=rlD hr hn hgd hbd hj eL n x r e (x.uget ((r*n).toUSize+j) q.2.2) (g.uget j q.1) (b.uget j q.2.1) (gd.uget j q2.1) (bd.uget j q2.2)) p.1 0 out p.2.1 else fL n eps x g b r (r*n).toUSize n.toUSize p.1 out p.2.1) (eqge (qfs _ _ _ _ _ _ _ _ _ _ _ _ _) ho) theorem RL_0 (rows n:Nat) (Ln:UInt64) (Ep rn:Float) (eps:Word) (x g b:ZB) (gd bd:FloatArray) (hn:rows*n+1<2^32) (hx:rows*n≤ x.size) (hg:n≤ g.size) (hb:n≤ b.size) (hgd:n≤ gd.size) (hbd:n≤ bd.size) (r:Nat) (hk:r+0=rows) (out:ZB) (ho:rows*n≤ out.size):RL rows n Ln Ep rn eps x g b gd bd hn hx hg hb hgd hbd 0 r hk out ho=out:=rfl theorem RL_s (rows n:Nat) (Ln:UInt64) (Ep rn:Float) (eps:Word) (x g b:ZB) (gd bd:FloatArray) (hn:rows*n+1<2^32) (hx:rows*n≤ x.size) (hg:n≤ g.size) (hb:n≤ b.size) (hgd:n≤ gd.size) (hbd:n≤ bd.size) (k r:Nat) (hk:r+(k+1)=rows) (out:ZB) (ho:rows*n≤ out.size):RL rows n Ln Ep rn eps x g b gd bd hn hx hg hb hgd hbd (k+1) r hk out ho= (have hr:=(rkS hk).1 have p:=rliA hr hn hx ho let e:=rL Ln (xD n x r eps true) Ep rn x (r*n).toUSize ((r*n).toUSize+n.toUSize) p.2.2.1 p.2.2.2.1 p.2.2.2.2 RL rows n Ln Ep rn eps x g b gd bd hn hx hg hb hgd hbd k (r+1) (rkS hk).2 (if e.ok then QE (r*n).toUSize n.toUSize (fun j hj=> have q:=rliB hr hn hx hg hb hj have q2:=rlD hr hn hgd hbd hj eL n x r e (x.uget ((r*n).toUSize+j) q.2.2) (g.uget j q.1) (b.uget j q.2.1) (gd.uget j q2.1) (bd.uget j q2.2)) p.1 0 out p.2.1 else fL n eps x g b r (r*n).toUSize n.toUSize p.1 out p.2.1) (eqge (qfs _ _ _ _ _ _ _ _ _ _ _ _ _) ho)) :=rfl def RR (rows n:Nat) (Ln:UInt64) (Ep rn:Float) (eps:Word) (x g:ZB) (gd:FloatArray) (hn:rows*n+1<2^32) (hx:rows*n≤ x.size) (hg:n≤ g.size) (hgd:n≤ gd.size) :(k r:Nat)→ r+k=rows→(out:ZB)→ rows*n≤ out.size→ZB | 0,_,_,out,_=>out | k+1,r,hk,out,ho=> have hr:=(rkS hk).1 have p:=rliA hr hn hx ho let e:=rR Ln (xD n x r eps false) Ep rn x (r*n).toUSize ((r*n).toUSize+n.toUSize) p.2.2.1 p.2.2.2.1 p.2.2.2.2 RR rows n Ln Ep rn eps x g gd hn hx hg hgd k (r+1) (rkS hk).2 (if e.ok then QE (r*n).toUSize n.toUSize (fun j hj=> have q:=rliB (b:=g) hr hn hx hg hg hj have q2:=rlD (bd:=gd) hr hn hgd hgd hj eR e (x.uget ((r*n).toUSize+j) q.2.2) (g.uget j q.1) (gd.uget j q2.1)) p.1 0 out p.2.1 else fR n eps x g r (r*n).toUSize n.toUSize p.1 out p.2.1) (eqge (qfsR _ _ _ _ _ _ _ _ _ _ _ _) ho) theorem RR_0 (rows n:Nat) (Ln:UInt64) (Ep rn:Float) (eps:Word) (x g:ZB) (gd:FloatArray) (hn:rows*n+1<2^32) (hx:rows*n≤ x.size) (hg:n≤ g.size) (hgd:n≤ gd.size) (r:Nat) (hk:r+0=rows) (out:ZB) (ho:rows*n≤ out.size):RR rows n Ln Ep rn eps x g gd hn hx hg hgd 0 r hk out ho=out:=rfl theorem RR_s (rows n:Nat) (Ln:UInt64) (Ep rn:Float) (eps:Word) (x g:ZB) (gd:FloatArray) (hn:rows*n+1<2^32) (hx:rows*n≤ x.size) (hg:n≤ g.size) (hgd:n≤ gd.size) (k r:Nat) (hk:r+(k+1)=rows) (out:ZB) (ho:rows*n≤ out.size):RR rows n Ln Ep rn eps x g gd hn hx hg hgd (k+1) r hk out ho= (have hr:=(rkS hk).1 have p:=rliA hr hn hx ho let e:=rR Ln (xD n x r eps false) Ep rn x (r*n).toUSize ((r*n).toUSize+n.toUSize) p.2.2.1 p.2.2.2.1 p.2.2.2.2 RR rows n Ln Ep rn eps x g gd hn hx hg hgd k (r+1) (rkS hk).2 (if e.ok then QE (r*n).toUSize n.toUSize (fun j hj=> have q:=rliB (b:=g) hr hn hx hg hg hj have q2:=rlD (bd:=gd) hr hn hgd hgd hj eR e (x.uget ((r*n).toUSize+j) q.2.2) (g.uget j q.1) (gd.uget j q2.1)) p.1 0 out p.2.1 else fR n eps x g r (r*n).toUSize n.toUSize p.1 out p.2.1) (eqge (qfsR _ _ _ _ _ _ _ _ _ _ _ _) ho)) :=rfl @[inline] def lw (n:Nat):UInt64:=Core.fastLog2 (n+16).toUInt64+1 @[inline] def dom (rows n:Nat) (eps:Word) (x g:ZB):Bool:= SN rows n eps x g&&rows*n≤4294967294&&n≤1048576&&rq n.toUInt64.toInt64.toFloat (1/n.toUInt64.toInt64.toFloat) theorem dZ (w:Word) (hw:expOf w≠255):fv (dw w)∧rv (dw w)=(ZA w:ℝ)*2^149:=by obtain ⟨h1,h2⟩:=dwV w hw;refine ⟨h1,?_⟩;rw [h2,Y1];push_cast rw [mul_assoc,←zpow_natCast,←zpow_natCast,←zpow_add₀ (by norm_num)];congr 2;push_cast;ring theorem lwE (n:Nat) (hn:n≤2^20):(lw n).toNat≤21∧(n:ℝ)+17≤2^(lw n).toNat∧(32:ℝ)≤2^(lw n).toNat:=by have h0:((n+16).toUInt64).toNat=n+16:=UInt64.toNat_ofNat_of_lt' (show n+16<2^64 by omega) have hl:(Core.fastLog2 (n+16).toUInt64).toNat=(n+16).log2:=by rw [Y7,h0] have hl2:(n+16).log2≤20:=Nat.lt_succ_iff.1 ((Nat.log2_lt (by clear*-;(exact Ne.symm (Nat.zero_ne_add_one (n + 15))))).2 (by clear*-hn;omega)) have hl4:4≤(n+16).log2:=(Nat.le_log2 (by clear*-;(exact Ne.symm (Nat.zero_ne_add_one (n + 15))))).2 (by clear*-;(exact Nat.le_add_left (2 ^ 4) n)) have e:(lw n).toNat=(n+16).log2+1:=by unfold lw;rw [UInt64.toNat_add,hl];simp only [UInt64.reduceToNat];clear*-hl2 hl4;omega rw [e];refine ⟨by clear*-hl2 hl4;(exact Nat.succ_le_succ hl2),?_,?_⟩ ·have:=Nat.lt_log2_self (n:=n+16);have:(n+17:ℕ)≤2^((n+16).log2+1):=by clear*-this;(exact eqge rfl this) exact_mod_cast this ·have:2^5≤2^((n+16).log2+1):=Nat.pow_le_pow_right (by norm_num) (by clear*-hl4;(exact Nat.le_add_of_sub_le hl4)) exact_mod_cast this theorem sEp {rows n:Nat} {eps:Word} {x g:ZB} (h:stableNormDomain rows n eps x g=true):expOf eps≠255:=by simp only [stableNormDomain,Bool.and_eq_true,ZH,gt_iff_lt] at h have:=h.1.2;unfold finiteWord at this;simpa using this theorem epE (eps:Word) (hf:expOf eps≠255) (hp:0< ZA eps): fv (dw eps*NR.pt 149)∧|rv (dw eps*NR.pt 149)-(ZA eps:ℝ)*2^298|≤(ZA eps:ℝ)*2^298/2^53+1/2^1075∧(2:ℝ)^149≤(ZA eps:ℝ)*2^298:=by obtain ⟨d1,d2⟩:=dZ eps hf obtain ⟨p1,p2⟩:=NR.ptV 149 (by norm_num) have hz:(ZA eps:ℝ)*2^298=rv (dw eps)*rv (NR.pt 149):=by rw [d2,p2,mul_assoc,←pow_add] have hs:(1:ℤ)≤ sv eps:=by have:(0:ℚ)<(sv eps:ℚ)*2^((ZZ eps:Int)-149):=by rw [←Y1];exact hp have:(0:ℚ)<(sv eps:ℚ):=pos_of_mul_pos_left this (by positivity) exact_mod_cast this have hZ:(2:ℝ)^(-149:ℤ)≤(ZA eps:ℝ):=by have e:(ZA eps:ℝ)=(sv eps:ℝ)*2^((ZZ eps:Int)-149):=by rw [Y1];push_cast;rfl rw [e] have:(1:ℝ)≤(sv eps:ℝ):=by exact_mod_cast hs calc (2:ℝ)^(-149:ℤ)=1*2^(-149:ℤ):=by ring _≤(sv eps:ℝ)*2^((ZZ eps:Int)-149):=mul_le_mul this (zpow_le_zpow_right₀ (by norm_num) (by omega)) (by positivity) (by linarith) have hb:|rv (dw eps)*rv (NR.pt 149)|≤(2:ℝ)^(971:Int):=by rw [(dwV eps hf).2,p2,abs_mul,abs_of_pos (by positivity:(0:ℝ)<2^149)];have:=NE.wB eps;have h2:=ix254 eps calc (|(sv eps:ℝ)*2^ZZ eps|)*2^149≤2^(24+ZZ eps)*2^149:=by gcongr _=2^(24+ZZ eps+149):=by ring _≤(2:ℝ)^(971:ℕ):=pow_le_pow_right₀ (by norm_num) (by omega) _=_:=by norm_num obtain ⟨m1,m2⟩:=NF.fM _ _ d1 p1 hb have hnn:0≤ rv (dw eps)*rv (NR.pt 149):=by rw [←hz];exact mul_nonneg (by exact_mod_cast hp.le) (by positivity) rw [abs_of_nonneg hnn] at m2 refine ⟨m1,by rw [hz];exact m2,?_⟩ calc (2:ℝ)^149=2^(-149:ℤ)*2^298:=by rw [←zpow_natCast,←zpow_natCast,←zpow_add₀ (by norm_num)];norm_num _≤_:=by gcongr theorem rnE (n:Nat) (h1:1≤ n) (hn:n≤2^20) (h:rq n.toUInt64.toInt64.toFloat (1/n.toUInt64.toInt64.toFloat)=true): fv (1/n.toUInt64.toInt64.toFloat)∧|rv (1/n.toUInt64.toInt64.toFloat)-1/n|≤3/2^53/n:=by obtain ⟨f1,f2⟩:=NR.ndV n (by omega) simp only [rq,Bool.and_eq_true,decide_eq_true_eq] at h have k1:(n:ℝ)≤2^20:=by exact_mod_cast hn have k2:(2:ℝ)^20≤2^400:=pow_le_pow_right₀ (by norm_num) (by norm_num) have:=rc _ _ f1 (by rw [f2];exact_mod_cast h1) (by rw [f2];exact k1.trans k2) (by have:=UInt64.lt_iff_toNat_lt.mp h.1;simpa using this) h.2 rw [f2] at this;exact ⟨this.1,this.2⟩ theorem tS:(1:ℝ)/2^1075≤1∧(1:ℝ)/2^1074≤1∧(0:ℝ)≤1/2^1075∧(0:ℝ)≤1/2^1074:=by refine ⟨?_,?_,by positivity,by positivity⟩<;>rw [div_le_one (by positivity)]<;>exact one_le_pow₀ (by norm_num) theorem sqR (V T ρ:ℝ) (hT:0< T) (hV:0≤ V) (h:|V-T|≤ρ*T):|Real.sqrt V-Real.sqrt T|≤ρ*Real.sqrt T:=by have a:=Real.sqrt_nonneg V;have b:=Real.sqrt_pos.2 hT have p:0<√V+√T:=by linarith have e:(√V+√T)*|√V-√T|=|V-T|:=by rw [←abs_of_pos p,←abs_mul,show (√V+√T)*(√V-√T)=V-T by linear_combination Real.sq_sqrt hV-Real.sq_sqrt hT.le] refine le_of_mul_le_mul_left ?_ p rw [e];linarith [show ρ*T=ρ*√T*√T by rw [mul_assoc,Real.mul_self_sqrt hT.le],mul_nonneg (mul_nonneg (show 0≤ρ by nlinarith [abs_nonneg (V-T)]) b.le) a] theorem dR (n Ln:ℕ) (V T Bv U ρ:ℝ) (hn:n≤2^20) (hT:0< T) (hV0:0< V) (hV:|V-T|≤ρ*T) (hρ:ρ≤((n:ℝ)+32)/2^54) (hB:|Bv-Real.sqrt V|≤ Real.sqrt V/2^53+1/2^1075) (hBU:Bv<2^53*U) (hU:1/2^29≤ U) (hL1:(n:ℝ)+17≤2^Ln) (hL2:(32:ℝ)≤2^Ln): |Bv-Real.sqrt T|≤2^Ln*U:=by have h1:=sqR V T ρ hT hV0.le hV obtain ⟨a1,a2⟩:=abs_le.1 h1 obtain ⟨b1,b2⟩:=abs_le.1 hB have hS:=Real.sqrt_nonneg T have hn2:(n:ℝ)≤2^20:=by exact_mod_cast hn have hU0:0≤ U:=le_trans (by positivity) hU have k1:=mul_le_mul_of_nonneg_right (hρ.trans (by rw [div_le_div_iff₀ (by positivity) (by positivity)];norm_num;linarith):ρ≤1/2^33) hS have k2:=mul_le_mul_of_nonneg_right hρ hS have:(1:ℝ)/2^1075≤1/2^59:=by gcongr<;>norm_num have hSU:Real.sqrt T≤2^53*U*(1+1/2^30):=by linarith have:=mul_le_mul_of_nonneg_left hSU (by positivity:(0:ℝ)≤((n:ℝ)+32)/2^54) linarith [abs_sub_le Bv (Real.sqrt V) (Real.sqrt T),mul_le_mul_of_nonneg_right hL1 hU0,mul_le_mul_of_nonneg_right hL2 hU0,mul_le_mul_of_nonneg_right hn2 hU0] theorem vP (n:ℕ) (q rn Ep:Float) (A S Eps j1:ℝ) (hn1:1≤ n) (hn:n≤2^20) (hA:0≤ A) (hA2:A≤2^700) (hj0:0≤ j1) (hj:j1≤1) (fq:fv q) (frn:fv rn) (fE:fv Ep) (hS:|S-A|≤4/2^53*A+j1) (hq:|rv q-S|≤((n:ℝ)+3)/2*((1/2^53+1/2^73)*((1+4/2^53)*A+j1))+((n:ℝ)+1)*(1/2^1074)) (hrn:|rv rn-1/n|≤3/2^53/n) (hEp:|rv Ep-Eps|≤ Eps/2^53+1/2^1075) (hE:2^149≤ Eps) (hE2:Eps≤2^700): fv (q*rn+Ep)∧|rv (q*rn+Ep)-(A/n+Eps)|≤((n:ℝ)+30)/2^54*(A/n+Eps):=by obtain ⟨t1,t2,t3,t4⟩:=tS have hn':(1:ℝ)≤ n:=by exact_mod_cast hn1 have hn2:(n:ℝ)≤2^20:=by exact_mod_cast hn have hE0:0< Eps:=lt_of_lt_of_le (by positivity) hE have h2:((n:ℝ)+3)/2*((1/2^53+1/2^73)*((1+4/2^53)*A+j1))≤(2^20+3)/2*((1/2^53+1/2^73)*((1+4/2^53)*2^700+1)):=by gcongr have h3:((n:ℝ)+1)*(1/2^1074)≤(2^20+1)*1:=by gcongr have k1:=abs_sub_abs_le_abs_sub (rv q) S have k2:=abs_sub_abs_le_abs_sub S A have k3:=abs_sub_abs_le_abs_sub (rv rn) (1/n) have k4:=abs_sub_abs_le_abs_sub (rv Ep) Eps have:(1:ℝ)/n≤1:=div_le_one_of_le₀ hn' (by positivity) have:3/2^53/(n:ℝ)≤3/2^53:=div_le_self (by positivity) hn' rw [abs_of_nonneg hA] at k2;rw [abs_of_pos hE0] at k4;rw [abs_of_pos (by positivity:(0:ℝ)<1/n)] at k3 have h8:(8:ℝ)*2^700≤2^971:=by rw [show (8:ℝ)=2^3 by norm_num,←pow_add];exact pow_le_pow_right₀ (by norm_num) (by norm_num) have h6:(2:ℝ)^60≤2^700:=pow_le_pow_right₀ (by norm_num) (by norm_num) have hqr:=mul_le_mul (show |rv q|≤2*2^700 by generalize (2:ℝ)^700=T at *;linarith) (show |rv rn|≤2 by linarith) (abs_nonneg _) (by positivity) rw [←abs_mul] at hqr obtain ⟨m1,m2⟩:=NF.fM q rn fq frn (by rw [zpow_ofNat];generalize (2:ℝ)^700=T at *;generalize (2:ℝ)^971=U at *;linarith) have:=abs_add_le (rv (q*rn)) (rv Ep) have:=abs_sub_abs_le_abs_sub (rv (q*rn)) (rv q*rv rn) obtain ⟨a1,a2⟩:=NF.fA _ _ m1 fE (by rw [zpow_ofNat];generalize (2:ℝ)^700=T at *;generalize (2:ℝ)^971=U at *;linarith) refine ⟨a1,?_⟩ generalize rv (q*rn+Ep)=V at *;generalize rv (q*rn)=V1 at *;generalize rv q=q at *;generalize rv rn=rn at *;generalize rv Ep=Ep at * generalize (1:ℝ)/2^1075=τ at * generalize (1:ℝ)/2^1074=τ' at * have h0:(0:ℝ)>>63!=0 then -(((v.toBits&&&0xfffffffffffff).toNat+2^52:ℕ):ℝ) else ((v.toBits&&&0xfffffffffffff).toNat+2^52:ℕ))|= (((v.toBits&&&0xfffffffffffff).toNat+2^52:ℕ):ℝ):=by split<;>(try simp only [abs_neg])<;>exact abs_of_nonneg (by positivity) rw [this] calc (2:ℝ)^(((eF v.toBits).toNat:Int)-1023)=2^52*2^(((eF v.toBits).toNat:Int)-1075):=by rw [←zpow_natCast,←zpow_add₀ (by norm_num)];congr 1;push_cast;ring _≤_:=by gcongr;push_cast;linarith [show (0:ℝ)≤((v.toBits&&&0xfffffffffffff).toNat:ℝ) by positivity] theorem bU (v:Float) (hv:fv v):|rv v|<2^53*(2:ℝ)^(((eF v.toBits).toNat:Int)-1075):=by have:=bitsB v hv;rwa [show (2:ℝ)^(((eF v.toBits).toNat:Int)-1022)=2^53*2^(((eF v.toBits).toNat:Int)-1075) by rw [←zpow_natCast,←zpow_add₀ (by norm_num)];congr 1;push_cast;ring] at this theorem dnD (V:Float) (Ln:UInt64) (k:UInt64→Bool) (fV:fv V) (hV0:0< rv V) (hok:(dn V Ln k).1=true): fv V.sqrt∧1046≤(eF V.sqrt.toBits).toNat∧(eF V.sqrt.toBits).toNat≤1298∧ |rv V.sqrt-Real.sqrt (rv V)|≤ Real.sqrt (rv V)/2^53+1/2^1075∧ rv V.sqrt<2^53*(2:ℝ)^(((eF V.sqrt.toBits).toNat:Int)-1075)∧(2:ℝ)^(((eF V.sqrt.toBits).toNat:Int)-1023)≤ rv V.sqrt∧ (dn V Ln k).2=pq V.sqrt.toBits∧expOf (pq V.sqrt.toBits)≠255∧signOf (pq V.sqrt.toBits)=false∧ |(sv (pq V.sqrt.toBits):ℝ)*2^idxOf (pq V.sqrt.toBits)-rv V.sqrt|≤ rv V.sqrt/2^24:=by unfold dn at hok;simp only [Bool.and_eq_true,decide_eq_true_eq] at hok obtain ⟨e1,e2⟩:=te _ hok.1;clear hok obtain ⟨q1,q2⟩:=fQ V fV hV0 have hB:=bU _ q1 have hL':=bitsL _ q1 fun h=>by rw [h] at e1;simp at e1 have hpos:0< rv V.sqrt:=by have:(2:ℝ)^23≤(2:ℝ)^(((eF V.sqrt.toBits).toNat:Int)-1023):=by rw [←zpow_natCast];exact zpow_le_zpow_right₀ (by norm_num) (by push_cast;omega) have k:=(abs_le.1 q2).1 have:0≤ Real.sqrt (rv V):=Real.sqrt_nonneg _ have t:(1:ℝ)/2^1075≤1:=tS.1 rcases abs_cases (rv V.sqrt) with ⟨h,_⟩|⟨h,_⟩ ·linarith [show (0:ℝ)<2^23 by positivity] ·rw [h] at hL';have:(1:ℝ)≤2^23:=one_le_pow₀ (by norm_num);nlinarith rw [abs_of_pos hpos] at hB hL' obtain ⟨w1,w2,w3⟩:=pqD _ q1 hpos e1 e2 exact ⟨q1,e1,e2,q2,hB,hL',rfl,w1,w2,w3⟩ theorem dnC (V:Float) (n:ℕ) (k:UInt64→Bool) (v:ℚ) (ρ:ℝ) (hn:n≤2^20) (fV:fv V) (hv:0< v) (hV:|rv V-(v:ℝ)*2^298|≤ρ*((v:ℝ)*2^298)) (hρ:ρ≤((n:ℝ)+32)/2^54) (hk:∀ B,k B=true→pq B=sqrtRational v) (hok:(dn V (lw n) k).1=true):(dn V (lw n) k).2=sqrtRational v:=by obtain ⟨l1,l2,l3⟩:=lwE n hn have hT:(0:ℝ)<(v:ℝ)*2^298:=mul_pos (by exact_mod_cast hv) (by positivity) have hn2:(n:ℝ)≤2^20:=by exact_mod_cast hn have hρ1:ρ≤1/2:=hρ.trans (by rw [div_le_div_iff₀ (by positivity) (by positivity)];nlinarith) have hV0:0< rv V:=by have:=(abs_le.1 hV).1;nlinarith obtain ⟨q1,e1,e2,q2,hB,hL',hd,-⟩:=dnD V (lw n) k fV hV0 hok rw [hd];unfold dn at hok;simp only [Bool.and_eq_true,Bool.or_eq_true,decide_eq_true_eq] at hok rcases hok.2 with h|h;swap;exact hk _ h obtain ⟨c1,c2⟩:=tc _ (lw n) (UInt64.le_iff_toNat_le.2 (by simp only [UInt64.reduceToNat];clear*-l1;omega)) h have hU:(1:ℝ)/2^29≤(2:ℝ)^(((eF V.sqrt.toBits).toNat:Int)-1075):=by rw [one_div,←zpow_neg_one,←zpow_natCast,←zpow_mul];exact zpow_le_zpow_right₀ (by norm_num) (by push_cast;clear*-e1;omega) have hd2:=dR n (lw n).toNat (rv V) _ (rv V.sqrt) _ ρ hn hT hV0 hV hρ q2 hB hU l2 l3 apply dC _ q1 (lw n).toNat v hv e1 e2 c1 c2 have:Real.sqrt ((v:ℝ)*2^298)=Real.sqrt (v:ℝ)*2^149:=by rw [Real.sqrt_mul (by exact_mod_cast hv.le),show (2:ℝ)^298=(2^149)^2 by rw [←pow_mul]] rw [Real.sqrt_sq (by positivity)] rw [←this];exact hd2 theorem pS (f:Word→Float) (x:ZB) (lo hi:USize) (h:hi.toNat≤ x.size) (hb:hi.toNat+1<2^32) (hl:lo.toNat≤ hi.toNat) (n base:ℕ) (hlo:lo.toNat=base) (hhi:hi.toNat=base+n) (hn:n≤2^20) (d:ℕ→ℝ) (hd:∀ j< n,fv (f x[base+j]!)∧|rv (f x[base+j]!)-d j^2|≤4/2^53*d j^2+1/2^1000∧d j^2≤2^600): fv (PP f x hi h hb lo hl 0 0)∧ |rv (PP f x hi h hb lo hl 0 0)-∑ j∈Finset.range n,rv (f x[base+j]!)|≤((n:ℝ)+3)/2*((1/2^53+1/2^73)*((1+4/2^53)*∑ j∈Finset.range n,d j^2+n/2^1000))+((n:ℝ)+1)*(1/2^1074)∧ |∑ j∈Finset.range n,rv (f x[base+j]!)-∑ j∈Finset.range n,d j^2|≤4/2^53*∑ j∈Finset.range n,d j^2+n/2^1000:=by have cv:∀ g:ℕ→ℝ,∑ k∈Finset.Ico lo.toNat hi.toNat,g k=∑ j∈Finset.range n,g (base+j):=fun g=>by rw [Finset.sum_Ico_eq_sum_range,hlo,hhi,Nat.add_sub_cancel_left] have sm:∀ a:ℝ,∑ j∈Finset.range n,(a*d j^2+1/2^1000)=a*∑ j∈Finset.range n,d j^2+n/2^1000:=fun a=>by rw [Finset.sum_add_distrib,←Finset.mul_sum];simp;ring have hs:∑ j∈Finset.range n,d j^2≤ n*2^600:=by simpa using Finset.sum_le_card_nsmul _ _ _ fun j hj=>(hd j (Finset.mem_range.1 hj)).2.2 have hn2:(n:ℝ)≤2^20:=by exact_mod_cast hn have:(2:ℝ)^22*2^600≤2^960:=by rw [←pow_add];exact pow_le_pow_right₀ (by norm_num) (by norm_num) have:=mul_le_mul_of_nonneg_right hn2 (by positivity:(0:ℝ)≤2^600) have:(1:ℝ)≤2^600:=one_le_pow₀ (by norm_num) have:(n:ℝ)/2^1000≤ n:=div_le_self (by positivity) (one_le_pow₀ (by norm_num)) obtain ⟨p1,p2⟩:=PPs f x hi h hb lo hl (fun k=>(1+4/2^53)*d (k-base)^2+1/2^1000) (fun k k1 k2=>by obtain ⟨j,rfl⟩:∃ j,k=base+j:=⟨k-base,by clear*-hlo k1;omega⟩ obtain ⟨a,b,-⟩:=hd j (by clear*-hhi k2;omega) simp only [Nat.add_sub_cancel_left];refine ⟨a,?_⟩ have:=abs_sub_abs_le_abs_sub (rv (f x[base+j]!)) (d j^2);rw [abs_of_nonneg (sq_nonneg (d j))] at this;linarith) (by simp only [cv,Nat.add_sub_cancel_left,sm];generalize (2:ℝ)^600=T at *;generalize (2:ℝ)^960=U at *;linarith) (by clear*-hhi hlo hn;omega) rw [cv,cv] at p2;simp only [hhi,hlo,Nat.add_sub_cancel_left,sm] at p2 refine ⟨p1,p2,?_⟩ rw [←Finset.sum_sub_distrib,←sm] exact (Finset.abs_sum_le_sum_abs _ _).trans (Finset.sum_le_sum fun j hj=>(hd j (Finset.mem_range.1 hj)).2.1) theorem dB (w:Word) (hw:expOf w≠255):|rv (dw w)|≤2^278:=by rw [(dwV w hw).2];exact (NE.wB w).trans (pow_le_pow_right₀ (by norm_num) (by have:=ix254 w;omega)) theorem tR (w:Word) (hf:expOf w≠255):fv (dw w*dw w)∧|rv (dw w*dw w)-rv (dw w)^2|≤4/2^53*rv (dw w)^2+1/2^1000∧rv (dw w)^2≤2^600:=by have d1:=(dwV _ hf).1 have b1:=dB _ hf have b2:rv (dw w)^2≤2^556:=by have:=sq_le_sq' (abs_le.1 b1).1 (abs_le.1 b1).2;rw [←pow_mul] at this;exact this have b3:|rv (dw w)*rv (dw w)|≤(2:ℝ)^(971:Int):=by rw [abs_mul_self,←sq];exact b2.trans (by rw [show (971:ℤ)=((971:ℕ):ℤ) from rfl,zpow_natCast];exact pow_le_pow_right₀ (by norm_num) (by norm_num)) obtain ⟨m1,m2⟩:=NF.fM _ _ d1 d1 b3 refine ⟨m1,?_,b2.trans (pow_le_pow_right₀ (by norm_num) (by norm_num))⟩ rw [abs_mul_self,←sq] at m2 have:(1:ℝ)/2^1075≤1/2^1000:=one_div_le_one_div_of_le (by positivity) (pow_le_pow_right₀ (by norm_num) (by norm_num)) have:rv (dw w)^2/2^53≤4/2^53*rv (dw w)^2:=by have:=sq_nonneg (rv (dw w));rw [div_le_iff₀ (by positivity)];nlinarith linarith theorem sA (n:ℕ) (hn:n≤2^20) (d:ℕ→ℝ) (h:∀ j< n,d j^2≤2^600):∑ j∈Finset.range n,d j^2≤2^700:=by calc _≤∑ j∈Finset.range n,(2:ℝ)^600:=Finset.sum_le_sum fun j hj=>h j (Finset.mem_range.1 hj) _=n*2^600:=by simp _≤2^20*2^600:=by gcongr;exact_mod_cast hn _≤2^700:=by rw [←pow_add];exact pow_le_pow_right₀ (by norm_num) (by norm_num) theorem eB7 (eps:Word) (hef:expOf eps≠255):(ZA eps:ℝ)*2^298≤2^700:=by have:=dB eps hef;rw [(dZ eps hef).2] at this have e:(ZA eps:ℝ)*2^298=(ZA eps:ℝ)*2^149*2^149:=by rw [mul_assoc,←pow_add] rw [e];calc (ZA eps:ℝ)*2^149*2^149≤2^278*2^149:=by gcongr;exact le_trans (le_abs_self _) this _≤2^700:=by rw [←pow_add];exact pow_le_pow_right₀ (by norm_num) (by norm_num) theorem nJ (n:ℕ) (hn:n≤2^20):(n:ℝ)/2^1000≤1:=by have hn2:(n:ℝ)≤2^20:=by exact_mod_cast hn rw [div_le_one (by positivity)];exact hn2.trans (pow_le_pow_right₀ (by norm_num) (by norm_num)) theorem rVr (n:Nat) (eps:Word) (x:ZB) (r:Nat) (lo hi:USize) (h:hi.toNat≤ x.size) (hb:hi.toNat+1<2^32) (hl:lo.toNat≤ hi.toNat) (hlo:lo.toNat=r*n) (hhi:hi.toNat=r*n+n) (hn1:1≤ n) (hn:n≤2^20) (hxf:∀ j< n,expOf x[r*n+j]! ≠255) (hef:expOf eps≠255) (hE0:0< ZA eps) (hrq:rq n.toUInt64.toInt64.toFloat (1/n.toUInt64.toInt64.toFloat)=true): fv (PP (fun w=>let d:=dw w;d*d) x hi h hb lo hl 0 0*(1/n.toUInt64.toInt64.toFloat)+dw eps*NR.pt 149)∧ |rv (PP (fun w=>let d:=dw w;d*d) x hi h hb lo hl 0 0*(1/n.toUInt64.toInt64.toFloat)+dw eps*NR.pt 149)- ((rowVariance n x r 0+ZA eps:ℚ):ℝ)*2^298|≤((n:ℝ)+30)/2^54*(((rowVariance n x r 0+ZA eps:ℚ):ℝ)*2^298):=by obtain ⟨r1,r2⟩:=rnE n hn1 hn hrq obtain ⟨e1,e2,e3⟩:=epE eps hef hE0 obtain ⟨p1,p2,p3⟩:=pS (fun w=>let d:=dw w;d*d) x lo hi h hb hl n (r*n) hlo hhi hn (fun j=>rv (dw x[r*n+j]!)) (fun j hj=>tR _ (hxf j hj)) rw [show ((rowVariance n x r 0+ZA eps:ℚ):ℝ)*2^298=(∑ j∈Finset.range n,rv (dw x[r*n+j]!)^2)/n+(ZA eps:ℝ)*2^298 by unfold rowVariance;rw [Yk];push_cast rw [add_mul,div_mul_eq_mul_div,zero_add,Finset.sum_mul];congr 2 refine Finset.sum_congr rfl fun j hj=>?_ rw [sub_zero,(dZ _ (hxf j (Finset.mem_range.1 hj))).2,mul_pow,show (2:ℝ)^298=(2^149)^2 by rw [←pow_mul]]] exact vP n _ _ _ _ _ _ _ hn1 hn (Finset.sum_nonneg fun j _=>sq_nonneg _) (sA n hn _ fun j hj=>(tR _ (hxf j hj)).2.2) (by positivity) (nJ n hn) p1 r1 e1 p3 p2 r2 e2 e3 (eB7 eps hef) theorem dWr (V:Float) (Ln:UInt64) (k:UInt64→Bool) (fV:fv V) (hV0:0< rv V) (hok:(dn V Ln k).1=true) (hq:rq (dw (dn V Ln k).2) (1/dw (dn V Ln k).2)=true): expOf (dn V Ln k).2≠255∧signOf (dn V Ln k).2=false∧1≤ rv (dw (dn V Ln k).2)∧fv (1/dw (dn V Ln k).2)∧ |rv (1/dw (dn V Ln k).2)-1/rv (dw (dn V Ln k).2)|≤3/2^53/rv (dw (dn V Ln k).2):=by obtain ⟨q1,e1,e2,q2,hB,hL',hd,w1,w2,w3⟩:=dnD V Ln k fV hV0 hok rw [hd] at hq ⊢ obtain ⟨d1,d2⟩:=dwV _ w1 have hD1:1≤ rv (dw (pq V.sqrt.toBits)):=by rw [d2];have:(2:ℝ)^23≤(2:ℝ)^(((eF V.sqrt.toBits).toNat:Int)-1023):=by rw [←zpow_natCast];exact zpow_le_zpow_right₀ (by norm_num) (by push_cast;omega) linarith [(abs_le.1 w3).1] have hD2:rv (dw (pq V.sqrt.toBits))≤2^400:=(le_abs_self _).trans ((dB _ w1).trans (pow_le_pow_right₀ (by norm_num) (by norm_num))) simp only [rq,Bool.and_eq_true,decide_eq_true_eq] at hq have:=rc _ _ d1 hD1 hD2 (by have:=UInt64.lt_iff_toNat_lt.mp hq.1;simpa using this) hq.2 exact ⟨w1,w2,hD1,this.1,this.2⟩ theorem rVn (n:ℕ) (x:ZB) (r:ℕ) (m:ℚ):0≤ rowVariance n x r m:=by unfold rowVariance;rw [Yk];positivity theorem xDE (n:Nat) (x:ZB) (r:Nat) (eps:Word) (c:Bool) (hn:0< n) (he:0< ZA eps) (B:UInt64) (h:xD n x r eps c B=true): pq B=sqrtRational (rowVariance n x r (if c then rowMean n x r else 0)+ZA eps):=by obtain ⟨-,hlo⟩:=mLs x n (r*n) 255 have hM:=rME n x r have hm:rowMean n x r*n=∑ j∈ZM n,ZA x[r*n+j]!:=by unfold rowMean;rw [Yk,zero_add];field_simp have h0:=rVn n x r (if c then rowMean n x r else 0) unfold xD at h;rw [←beq_iff_eq.1 h,YW _ _ _ _ (Nat.mul_pos (Nat.mul_pos hn hn) hn) he];congr 2 generalize mL x (r*n) n 255=lo at hlo hM ⊢ generalize sS x lo (r*n) n 0 0=S at hM ⊢ have hV:rowVariance n x r (if c then rowMean n x r else 0)=((qZ x lo (r*n) n 0:ℚ)*((2:ℚ)^((lo.toNat:ℤ)-149))^2-n*((if c then ((S.1:ℤ)-S.2).natAbs else 0:ℕ):ℚ)^2*((2:ℚ)^((lo.toNat:ℤ)-149))^2/n^2)/n:=by rw [qZs,Nat.cast_zero,zero_add,Finset.sum_mul,Finset.sum_congr rfl fun j hj=>(zQ _ _ (by by_cases h:ZW x[r*n+j]! =0;exact Or.inl h;exact Or.inr (hlo j (Finset.mem_range.1 hj) h))).symm] unfold rowVariance;rw [Yk,zero_add];congr 1 simp only [sub_sq,Finset.sum_add_distrib,Finset.sum_sub_distrib,←Finset.sum_mul,←Finset.mul_sum,Finset.sum_const,Finset.card_range,nsmul_eq_mul] cases c<;>simp only [Bool.false_eq_true,ite_false,ite_true,←hm,hM,Nat.cast_natAbs,Int.cast_abs,sq_abs,Nat.cast_zero]<;>ring have e:((2:ℚ)^((lo.toNat:ℤ)-149))^2=2^(2*(lo.toNat:ℤ)-298):=by rw [←zpow_natCast,←zpow_mul];congr 1;push_cast;ring have hK:(0:ℚ)<2^(2*(lo.toNat:ℤ)-298):=by positivity rw [hV,e] at h0 ⊢ generalize (2:ℚ)^(2*(lo.toNat:ℤ)-298)=K at hK h0 ⊢;generalize qZ x lo (r*n) n 0=Q at h0 ⊢;generalize (if c then ((S.1:ℤ)-S.2).natAbs else 0)=s at h0 ⊢ have e2:((Q:ℚ)*K-n*(s:ℚ)^2*K/n^2)/n=(n*n*Q-n*s*s)*K/(n*n*n):=by field_simp rw [e2] at h0 ⊢ have:(0:ℚ)≤n*n*Q-n*s*s:=by by_contra h';push_neg at h';exact absurd h0 (not_le.2 (div_neg_of_neg_of_pos (mul_neg_of_neg_of_pos h' hK) (by positivity))) rw [Nat.cast_sub (by exact_mod_cast sub_nonneg.1 this)];push_cast;ring theorem rRf (Ln:UInt64) (k:UInt64→Bool) (Ep rn:Float) (x:ZB) (lo hi:USize) (h:hi.toNat≤ x.size) (hb:hi.toNat+1<2^32) (hl:lo.toNat≤ hi.toNat): rR Ln k Ep rn x lo hi h hb hl=⟨(dn (PP (fun w=>let d:=dw w;d*d) x hi h hb lo hl 0 0*rn+Ep) Ln k).1&& rq (dw (dn (PP (fun w=>let d:=dw w;d*d) x hi h hb lo hl 0 0*rn+Ep) Ln k).2) (1/dw (dn (PP (fun w=>let d:=dw w;d*d) x hi h hb lo hl 0 0*rn+Ep) Ln k).2), 0,1/dw (dn (PP (fun w=>let d:=dw w;d*d) x hi h hb lo hl 0 0*rn+Ep) Ln k).2,(dn (PP (fun w=>let d:=dw w;d*d) x hi h hb lo hl 0 0*rn+Ep) Ln k).2,0⟩:=rfl theorem rCv (n:ℕ) (V:Float) (k:UInt64→Bool) (v:ℚ) (hn20:n≤2^20) (fV:fv V) (hv:0< v) (hV:|rv V-(v:ℝ)*2^298|≤((n:ℝ)+30)/2^54*((v:ℝ)*2^298)) (hk:∀ B,k B=true→pq B=sqrtRational v) (hok:((dn V (lw n) k).1&&rq (dw (dn V (lw n) k).2) (1/dw (dn V (lw n) k).2))=true): (dn V (lw n) k).2=sqrtRational v∧expOf (dn V (lw n) k).2≠255∧signOf (dn V (lw n) k).2=false∧1≤ rv (dw (dn V (lw n) k).2)∧ fv (1/dw (dn V (lw n) k).2)∧|rv (1/dw (dn V (lw n) k).2)-1/rv (dw (dn V (lw n) k).2)|≤3/2^53/rv (dw (dn V (lw n) k).2):=by obtain ⟨l1,-,-⟩:=lwE n hn20 have hT:(0:ℝ)<(v:ℝ)*2^298:=mul_pos (by exact_mod_cast hv) (by positivity) simp only [Bool.and_eq_true] at hok have hp:0< rv V:=by linarith [(abs_le.1 hV).1,mul_le_mul_of_nonneg_right (show (n:ℝ)≤2^20 by exact_mod_cast hn20) hT.le] exact ⟨dnC V n k v _ hn20 fV hv hV (by gcongr;norm_num) hk hok.1,dWr V (lw n) k fV hp hok.1 hok.2⟩ theorem pB (a b:ℝ) (p q:ℕ) (ha:|a|≤2^p) (hb:|b|≤2^q):|a*b|≤2^(p+q):=by rw [abs_mul,pow_add];exact mul_le_mul ha hb (abs_nonneg _) (by positivity) theorem rB (y z:ℝ) (p:ℕ) (hz:|z|≤2^p) (h:|y-z|≤|z|/2^53+1/2^1075):|y|≤2^(p+1):=by have t:(1:ℝ)/2^1075≤1/4:=one_div_le_one_div_of_le (by norm_num) (le_trans (by norm_num:(4:ℝ)≤2^2) (pow_le_pow_right₀ (by norm_num) (by norm_num))) have:(1:ℝ)≤2^p:=one_le_pow₀ (by norm_num) rw [pow_succ];generalize (1:ℝ)/2^1075=τ at *;linarith [abs_sub_abs_le_abs_sub y z,div_le_div_of_nonneg_left (abs_nonneg z) (by norm_num:(0:ℝ)<2) (by norm_num:(2:ℝ)≤2^53)] theorem aB (a b:ℝ) (p:ℕ) (ha:|a|≤2^p) (hb:|b|≤2^p):|a+b|≤2^(p+1):=by rw [pow_succ];linarith [abs_add_le a b] theorem rib (D ri:ℝ) (h1:1≤ D) (h:|ri-1/D|≤3/2^53/D):|ri|≤2^1:=by have h0:0rename_i h ·rw [abs_of_nonneg h];field_simp ·rw [abs_of_neg (by linarith)];field_simp;try ring have hGD:|G|/D≤2^278:=(div_le_self (abs_nonneg _) hD).trans hG rw [e,abs_mul,abs_mul,abs_of_nonneg (div_nonneg (abs_nonneg _) hD0.le)] have:|(if 0≤ G then (1:ℝ) else -1)|=1:=by split<;>simp rw [this,mul_one] calc (|s-Xm|)*(|G|/D)≤(|Xm|/2^53+1/2^1075)*(|G|/D):=mul_le_mul_of_nonneg_right hs (div_nonneg (abs_nonneg _) hD0.le) _=|Xm*G/D|/2^53+1/2^1075*(|G|/D):=by rw [abs_div,abs_mul,abs_of_pos hD0];ring _≤_:=by gcongr have j1:(1:ℝ)/2^1075*2^278≤1/2^797:=by rw [div_mul_eq_mul_div,one_mul,div_le_div_iff₀ (by positivity) (by positivity),one_mul,←pow_add] have j2:(1:ℝ)/2^1075≤1/2^797:=one_div_le_one_div_of_le (by positivity) (pow_le_pow_right₀ (by norm_num) (by norm_num)) have j3:(1:ℝ)/2^797*16≤1/2^700:=by rw [div_mul_eq_mul_div,one_mul,div_le_div_iff₀ (by positivity) (by positivity),one_mul,show (16:ℝ)=2^4 by norm_num,←pow_add] exact pow_le_pow_right₀ (by norm_num) (by norm_num) have j4:(1:ℝ)/2^700*2=1/2^699:=by rw [div_mul_eq_mul_div,one_mul,div_eq_div_iff (by positivity) (by positivity),one_mul,←pow_succ'] have t0:(0:ℝ)≤1/2^797:=by positivity have tτ:(0:ℝ)≤1/2^1075:=by positivity have H4:=abs_sub_le v (q+Bv) (Xm*G/D+Bv) have H4b:|q+Bv-(Xm*G/D+Bv)|≤|q-s*G/D|+|s*G/D-Xm*G/D|:=by rw [show q+Bv-(Xm*G/D+Bv)=(q-s*G/D)+(s*G/D-Xm*G/D) by ring];exact abs_add_le _ _ have H5:|q+Bv|≤|v|+|v-(q+Bv)|:=by have:=abs_sub_abs_le_abs_sub (q+Bv) v;rw [abs_sub_comm] at this;linarith have H6:|q|≤|q+Bv|+|Bv|:=by have:=abs_sub_abs_le_abs_sub q (q+Bv);rw [show q-(q+Bv)=-Bv by ring,abs_neg] at this;linarith have H7:|Xm*G/D|≤|q|+|q-s*G/D|+|s*G/D-Xm*G/D|:=by have:=abs_sub_abs_le_abs_sub (Xm*G/D) q have:|Xm*G/D-q|≤|q-s*G/D|+|s*G/D-Xm*G/D|:=by rw [abs_sub_comm,show q-Xm*G/D=(q-s*G/D)+(s*G/D-Xm*G/D) by ring];exact abs_add_le _ _ linarith clear hs2 hX hG hri hgr hq hs generalize (2:ℝ)^278=P at e1 j1 generalize (1:ℝ)/2^1075=τ at *;generalize (1:ℝ)/2^797=σ at *;generalize (1:ℝ)/2^700=K at *;generalize (1:ℝ)/2^699=K2 at * have hg:=abs_nonneg v;have hh:=abs_nonneg Bv generalize |v-(Xm*G/D+Bv)|=w at *;generalize |q+Bv-(Xm*G/D+Bv)|=w2 at *;generalize |v-(q+Bv)|=a at * generalize |q-s*G/D|=b at *;generalize |s*G/D-Xm*G/D|=c at *;generalize |q+Bv|=d at *;generalize |q|=e at * generalize |Xm*G/D|=f at *;generalize |v|=g at *;generalize |Bv|=h at * linarith theorem zW (w:Word) (h:(w&&&0x7FFFFFFF==0)=true):ZA w=0:=by have h1:(w&&&0x7FFFFFFF).toNat=0:=by simp only [beq_iff_eq] at h;rw [h];rfl rw [UInt32.toNat_and] at h1;simp only [UInt32.reduceToNat] at h1 rw [show (2147483647:ℕ)=2^31-1 by norm_num,Nat.and_two_pow_sub_one_eq_mod] at h1 have he:=eOv w;have hf:=fOv w have hm:ZW w=0:=by unfold mantOf;have:(expOf w).toNat=0:=by rw [he];clear*-h1;omega have:expOf w=0:=UInt32.toNat_inj.mp (by rw [this];rfl) rw [if_pos this,hf];clear*-h1;omega rw [Y1,show (sv w:ℚ)=0 from (YN w).2 hm,zero_mul] theorem eRe0 (xw gw d:Word) (ri:Float) (b:Bool) (hx:expOf xw≠255) (hg:expOf gw≠255) (hdf:expOf d≠255) (hd1:1≤ rv (dw d)) (fri:fv ri) (hri:|rv ri-1/rv (dw d)|≤3/2^53/rv (dw d)):eR0 ⟨b,0,ri,d,0⟩ xw gw (dw gw)=ZT (ZA xw*ZA gw/ZA d):=by unfold eR0;dsimp only;split ·rename_i hc simp only [Bool.and_eq_true,decide_eq_true_eq] at hc obtain ⟨x1,x2⟩:=dZ xw hx;obtain ⟨p1,p2,p3⟩:=gp gw ri hg fri (rib _ _ hd1 hri);have bx:=dB xw hx obtain ⟨n1,n2⟩:=NF.fM _ _ x1 p1 (NE.z9 _ _ (pB _ _ 278 280 bx p3) (by norm_num)) obtain ⟨E1,E2⟩:=te _ hc.1 have hL:16<(dw xw*(dw gw*ri)).toBits.toNat%2^27∧(dw xw*(dw gw*ri)).toBits.toNat%2^27+16<2^27:=by have:=UInt64.lt_iff_toNat_lt.mp hc.2;rw [UInt64.toNat_sub,UInt64.toNat_and] at this;simp only [UInt64.reduceToNat] at this rw [show (134217727:ℕ)=2^27-1 by norm_num,Nat.and_two_pow_sub_one_eq_mod] at this have:=Nat.mod_lt (dw xw*(dw gw*ri)).toBits.toNat (show 0<2^27 by norm_num);clear E1 E2 bx fri hc hd1 hdf hg hri hx n1 n2 p1 p2 p3 this x1 x2;omega apply eC _ n1 4 _ E1 E2 (by simpa using hL.1) (by simpa using hL.2) have hD0:0< rv (dw d):=by linarith obtain ⟨-,d2⟩:=dZ d hdf have:(ZA d:ℝ)≠0:=fun h=>by rw [h] at d2;rw [d2] at hD0;simp at hD0 rw [show ((ZA xw*ZA gw/ZA d:ℚ):ℝ)*2^149=rv (dw xw)*rv (dw gw)/rv (dw d) by rw [x2,(dZ gw hg).2,d2];push_cast;field_simp] have e:=eR2 _ _ _ _ _ _ hd1 hri p2 n2 (bx.trans (pow_le_pow_right₀ (by norm_num) (by norm_num))) have hb:=bU _ n1 generalize dw xw*(dw gw*ri)=v at e hb E1 ⊢ generalize (eF v.toBits).toNat=E at E1 hb ⊢ have:(1:ℝ)/2^700≤2^((E:Int)-1075):=by rw [one_div,←zpow_natCast,←zpow_neg];exact zpow_le_zpow_right₀ (by norm_num) (by clear*-E1;omega) generalize (2:ℝ)^((E:Int)-1075)=U at *;generalize (1:ℝ)/2^700=K at * have:=abs_nonneg (rv v);norm_num at e hb ⊢;nlinarith ·split ·rename_i _ hz;rw [zW xw hz,zero_mul,zero_div];rfl ·rfl theorem eR00 (e:RS) (xw gw:Word) (gv:Float) (h:(xw&&&0x7FFFFFFF==0)=true):eR e xw gw gv=0:=by have h0:xw&&&0x7FFFFFFF=0:=by simpa using h have hz:((xw&&&0x7FFFFFFF).toUInt64-1)>>>(63:UInt64)=1:=by rw [h0];decide unfold eR;dsimp only;rw [hz,show (1:UInt64)-1=0 from rfl];split ·simp ·rfl theorem eR01 (e:RS) (xw gw:Word) (gv:Float) (h:(xw&&&0x7FFFFFFF==0)=false):eR e xw gw gv=eR0 e xw gw gv:=by have h0:(xw&&&0x7FFFFFFF)≠0:=by simpa using h have hz:(((xw&&&0x7FFFFFFF).toUInt64-1)>>>(63:UInt64))=0:=by have p:0<(xw&&&0x7FFFFFFF).toNat:=by rcases Nat.eq_zero_or_pos (xw&&&0x7FFFFFFF).toNat with q|q ·exact absurd (UInt32.toNat_inj.mp (by rw [q];rfl)) h0 ·exact q apply UInt64.toNat_inj.mp rw [UInt64.toNat_shiftRight,UInt64.toNat_sub_of_le _ _ (UInt64.le_iff_toNat_le.2 (by simp only [UInt32.toNat_toUInt64,UInt64.reduceToNat];(exact eqge rfl p)))] simp only [UInt32.toNat_toUInt64,UInt64.reduceToNat,Nat.reduceMod,Nat.shiftRight_eq_div_pow] have:=(xw&&&0x7FFFFFFF).toNat_lt;omega unfold eR eR0;dsimp only;rw [hz];simp theorem eRe (xw gw d:Word) (ri:Float) (b:Bool) (hx:expOf xw≠255) (hg:expOf gw≠255) (hdf:expOf d≠255) (hd1:1≤ rv (dw d)) (fri:fv ri) (hri:|rv ri-1/rv (dw d)|≤3/2^53/rv (dw d)):eR ⟨b,0,ri,d,0⟩ xw gw (dw gw)=ZT (ZA xw*ZA gw/ZA d):=by cases hz:xw&&&0x7FFFFFFF==0 ·rw [eR01 _ _ _ _ hz];exact eRe0 xw gw d ri b hx hg hdf hd1 fri hri ·rw [eR00 _ _ _ _ hz,zW xw hz,zero_mul,zero_div];rfl theorem eRok (rows n:Nat) (eps:Word) (x g:ZB) (hD:stableNormDomain rows n eps x g=true) (hn:rows*n+1<2^32) (hn20:n≤2^20) (hrq:rq n.toUInt64.toInt64.toFloat (1/n.toUInt64.toInt64.toFloat)=true) (r:Nat) (hr:r< rows) (h1 h2 h3) (hok:(rR (lw n) (xD n x r eps false) (dw eps*NR.pt 149) (1/n.toUInt64.toInt64.toFloat) x (r*n).toUSize ((r*n).toUSize+n.toUSize) h1 h2 h3).ok=true) (j:Nat) (hj:j< n): eR (rR (lw n) (xD n x r eps false) (dw eps*NR.pt 149) (1/n.toUInt64.toInt64.toFloat) x (r*n).toUSize ((r*n).toUSize+n.toUSize) h1 h2 h3) x[r*n+j]! g[j]! (dw g[j]!)= ZT (ZA x[r*n+j]! *ZA g[j]! /ZA (sqrtRational (rowVariance n x r 0+ZA eps))):=by obtain ⟨hn0,hE0,hxf,hgf⟩:=SNu hD have hef:=sEp hD obtain ⟨u1,u2,u3,u4⟩:=uB hr hn have hxf':∀ j< n,expOf x[r*n+j]! ≠255:=fun j hj=>hxf _ (by clear*-hj u1;omega) obtain ⟨v1,v2⟩:=rVr n eps x r _ _ h1 h2 h3 u2 u4 hn0 hn20 hxf' hef hE0 hrq have hv:0< rowVariance n x r 0+ZA eps:=by have:=rVn n x r 0;linarith rw [rRf] at hok ⊢;dsimp only at hok ⊢ generalize PP (fun w=>let d:=dw w;d*d) x ((r*n).toUSize+n.toUSize) h1 h2 (r*n).toUSize h3 0 0*(1/n.toUInt64.toInt64.toFloat)+dw eps*NR.pt 149=V at v1 v2 hok ⊢ obtain ⟨c,w1,w2,w3,w4,w5⟩:=rCv n V _ _ hn20 v1 hv (by push_cast at v2 ⊢;exact v2) (xDE n x r eps false hn0 hE0) hok generalize (dn V (lw n) (xD n x r eps false)).2=d at c w1 w2 w3 w4 w5 ⊢ rw [←c];exact eRe _ _ d _ _ (hxf _ (by clear*-hj u1;omega)) (hgf j hj) w1 w3 w4 w5 theorem eFb (b:UInt64):(eF b).toNat≤2047:=by unfold eF;rw [UInt64.toNat_and];exact Nat.and_le_right.trans (by simp) theorem s80 (a b:ℝ) (ha:|a|≤2^278) (hb:|b|≤2^279):|a-b|≤2^280:=by have h:=abs_sub_le a 0 b;rw [sub_zero,zero_sub,abs_neg] at h have e1:(2:ℝ)^279=2*2^278:=by rw [←pow_succ'] have e2:(2:ℝ)^280=2*2^279:=by rw [←pow_succ'] rw [e1] at hb;rw [e2,e1];clear e1 e2;generalize (2:ℝ)^278=T at *;have:0≤ T:=le_trans (abs_nonneg _) ha;linarith theorem cS (n:ℕ) (hn:1≤ n) (d:ℕ→ℝ):∑ j∈Finset.range n,|d j|≤ n*Real.sqrt ((∑ j∈Finset.range n,d j^2)/n):=by have hn':(0:ℝ)|d j|) simp only [Finset.card_range,sq_abs] at h have e:(n:ℝ)*∑ j∈Finset.range n,d j^2=(n:ℝ)^2*((∑ j∈Finset.range n,d j^2)/n):=by field_simp calc _≤ Real.sqrt ((n:ℝ)*∑ j∈Finset.range n,d j^2):=Real.le_sqrt_of_sq_le h _=_:=by rw [e,Real.sqrt_mul (sq_nonneg _),Real.sqrt_sq hn'.le] theorem mR (n:ℕ) (hn1:1≤ n) (hn:n≤2^20) (S SX W rn m:ℝ) (hW:|SX|≤ W) (hS:|S-SX|≤((n:ℝ)+3)/2*((1/2^53+1/2^73)*W)+((n:ℝ)+1)*(1/2^1074)) (hrn:|rn-1/n|≤3/2^53/n) (hm:|m-S*rn|≤|S*rn|/2^53+1/2^1075): |m-SX/n|≤((n:ℝ)+13)/2^54*(W/n)+1/2^1040:=by have hn':(1:ℝ)≤ n:=by exact_mod_cast hn1 have hn2:(n:ℝ)≤2^20:=by exact_mod_cast hn have h0:(0:ℝ)norm_num have:(1:ℝ)/2^1074*2^25≤1/2^1040:=by rw [div_mul_eq_mul_div,one_mul,div_le_div_iff₀ (by positivity) (by positivity),one_mul,←pow_add];exact pow_le_pow_right₀ (by norm_num) (by norm_num) refine le_of_mul_le_mul_left (e.trans ?_) h0 rw [show n*(((n:ℝ)+13)/2^54*(W/n)+1/2^1040)=((n:ℝ)+13)/2^54*W+1/2^1040*n by field_simp] linarith theorem mE (n:ℕ) (P Q D R mm δ W:ℝ) (hP:(n:ℝ)+17≤ P) (hP2:P≤2^21) (hQ:1≤ Q) (hD:1≤ D) (hδ:δ≤((n:ℝ)+13)/2^54*(W/n)+1/2^1040) (hW:W/n≤ R+|mm|) (hR:R≤ D*(1+1/2^22)) (hm:|mm|≤ Q*D):δ≤ P*Q/2^53*D:=by have h1:W/n≤ D*(1+1/2^22+Q):=by linarith have hn0:(0:ℝ)≤ n:=Nat.cast_nonneg n have h2:((n:ℝ)+13)/2^54*(W/n)≤((n:ℝ)+13)/2^54*(D*(1+1/2^22+Q)):=mul_le_mul_of_nonneg_left h1 (by positivity) have h3:((n:ℝ)+13)*(1+1/2^22+Q)≤2*P*Q-15/2:=by have a1:((n:ℝ)+13)*(1+1/2^22+Q)≤(P-4)*(1+1/2^22+Q):=mul_le_mul_of_nonneg_right (by linarith) (by linarith) have a2:0≤ P*(Q-1):=mul_nonneg (by linarith) (by linarith) nlinarith have h5:((n:ℝ)+13)*(1+1/2^22+Q)*D≤(2*P*Q-15/2)*D:=mul_le_mul_of_nonneg_right h3 (by linarith) have h6:(1:ℝ)/2^1040≤15/2*D/2^54:=by have a:(1:ℝ)/2^1040≤1/2^54:=one_div_le_one_div_of_le (by positivity) (pow_le_pow_right₀ (by norm_num) (by norm_num)) have b:(1:ℝ)/2^54≤15/2*D/2^54:=by rw [div_le_div_iff_of_pos_right (by positivity)];linarith linarith have e:((n:ℝ)+13)/2^54*(D*(1+1/2^22+Q))=((n:ℝ)+13)*(1+1/2^22+Q)*D/2^54:=by ring have e2:(2*P*Q-15/2)*D/2^54=P*Q/2^53*D-15/2*D/2^54:=by ring have:((n:ℝ)+13)*(1+1/2^22+Q)*D/2^54≤(2*P*Q-15/2)*D/2^54:=by gcongr linarith theorem dRR (n:ℕ) (hn:n≤2^20) (V R2 Bs D:ℝ) (hR2:2^149≤ R2) (hV:|V-R2|≤((n:ℝ)+30)/2^54*R2) (hV0:0< V) (hB:|Bs-Real.sqrt V|≤ Real.sqrt V/2^53+1/2^1075) (hD:|D-Bs|≤ Bs/2^24):|D-Real.sqrt R2|≤ Real.sqrt R2/2^23:=by have hR0:0< R2:=lt_of_lt_of_le (by positivity) hR2 have h1:=sqR V R2 _ hR0 hV0.le hV have hn2:(n:ℝ)≤2^20:=by exact_mod_cast hn have hρ:((n:ℝ)+30)/2^54≤1/2^33:=by rw [div_le_div_iff₀ (by positivity) (by positivity)];norm_num;linarith have hr:(2:ℝ)^74≤ Real.sqrt R2:=Real.le_sqrt_of_sq_le (le_trans (by rw [←pow_mul];exact pow_le_pow_right₀ (by norm_num) (by norm_num)) hR2) have hτ:(1:ℝ)/2^1075≤ Real.sqrt R2/2^60:=by have a:(1:ℝ)/2^1075≤1/2^60:=one_div_le_one_div_of_le (by positivity) (pow_le_pow_right₀ (by norm_num) (by norm_num)) have h74:(1:ℝ)≤2^74:=one_le_pow₀ (by norm_num) have b:(1:ℝ)/2^60≤ Real.sqrt R2/2^60:=by rw [div_le_div_iff_of_pos_right (by positivity)];linarith linarith have k1:((n:ℝ)+30)/2^54*Real.sqrt R2≤1/2^33*Real.sqrt R2:=mul_le_mul_of_nonneg_right hρ (Real.sqrt_nonneg _) have hD':=abs_le.1 hD;have hB':=abs_le.1 hB;have h1':=abs_le.1 h1 rw [abs_le];constructor<;>nlinarith [Real.sqrt_nonneg V,Real.sqrt_nonneg R2] theorem bI (n:ℕ) (hn:n≤2^20) (V T δ D:ℝ) (hT:0< T) (hV:|V-(T+δ^2)|≤((n:ℝ)+30)/2^54*(T+δ^2)) (hδ:|δ|≤ D/2^28) (hD:|D-Real.sqrt (T+δ^2)|≤ Real.sqrt (T+δ^2)/2^23):|V-T|≤((n:ℝ)+31)/2^54*T:=by have hn2:(n:ℝ)≤2^20:=by exact_mod_cast hn have h0:0≤ T+δ^2:=by positivity have hr:=Real.sq_sqrt h0 have hD0:0≤ D:=by have h:=le_trans (abs_nonneg δ) hδ;rwa [le_div_iff₀ (by positivity),zero_mul] at h have hDu:D≤ Real.sqrt (T+δ^2)*(1+1/2^23):=by have:=(abs_le.1 hD).2;linarith have hD2:D^2≤(T+δ^2)*(1+1/2^23)^2:=by rw [←hr,←mul_pow];exact pow_le_pow_left₀ hD0 hDu 2 have hδ2:δ^2≤ D^2/2^56:=by have:=pow_le_pow_left₀ (abs_nonneg δ) hδ 2;rw [sq_abs,div_pow] at this;norm_num at this ⊢;linarith have hδ3:δ^2≤ T/2^55:=by nlinarith have hρ:((n:ℝ)+30)/2^54*δ^2≤1/2^33*δ^2:=mul_le_mul_of_nonneg_right (by rw [div_le_div_iff₀ (by positivity) (by positivity)];norm_num;linarith) (sq_nonneg δ) have e:((n:ℝ)+30)/2^54*(T+δ^2)=((n:ℝ)+30)/2^54*T+((n:ℝ)+30)/2^54*δ^2:=by ring have e2:((n:ℝ)+31)/2^54*T=((n:ℝ)+30)/2^54*T+T/2^54:=by ring have:=abs_sub_le V (T+δ^2) T have e3:|T+δ^2-T|=δ^2:=by rw [add_sub_cancel_left,abs_of_nonneg (sq_nonneg δ)] rw [e3] at this;rw [e2];nlinarith theorem sId (n:ℕ) (hn:1≤ n) (X:ℕ→ℝ) (a:ℝ):∑ j∈Finset.range n,(X j-a)^2= ∑ j∈Finset.range n,(X j-(∑ k∈Finset.range n,X k)/n)^2+n*((∑ k∈Finset.range n,X k)/n-a)^2:=by have hn0:(n:ℝ)≠0:=Nat.cast_ne_zero.2 (by (exact Nat.ne_zero_of_lt hn)) generalize hM:(∑ k∈Finset.range n,X k)/n=M have h0:∑ j∈Finset.range n,(X j-M)=0:=by rw [Finset.sum_sub_distrib,Finset.sum_const,Finset.card_range,nsmul_eq_mul,←hM];field_simp;ring have e:∀ j,(X j-a)^2=(X j-M)^2+2*(M-a)*(X j-M)+(M-a)^2:=fun j=>by ring simp only [e,Finset.sum_add_distrib,←Finset.mul_sum,h0,Finset.sum_const,Finset.card_range,nsmul_eq_mul];ring theorem tL2 (d s p τ:ℝ) (hτ0:0≤τ) (hτ:τ+2^58*τ^2≤1/2^1000) (hs:|s-d|≤|d|/2^53+τ) (hp:|p-s^2|≤ s^2/2^53+τ): |p-d^2|≤4/2^53*d^2+1/2^1000:=by have k1:=abs_add_le (2*d*(s-d)) ((s-d)^2) rw [show 2*d*(s-d)+(s-d)^2=s^2-d^2 by ring,abs_mul,abs_mul,abs_two,abs_pow] at k1 have hE:=abs_nonneg (s-d);have hA:=abs_nonneg d have k2:(|s-d|)^2≤2*(|d|/2^53)^2+2*τ^2:=by nlinarith [sq_nonneg (|d|/2^53-τ)] have k3:2*(|d|)*(|s-d|)≤2*(|d|)*(|d|/2^53+τ):=by nlinarith have k4:2*(|d|)*τ≤2^57*τ^2+(|d|)^2/2^57:=by nlinarith [sq_nonneg (2^57*τ-|d|)] have k5:s^2≤ d^2+|s^2-d^2|:=by have:=le_abs_self (s^2-d^2);linarith have k6:=abs_sub_le p (s^2) (d^2) have k7:=sq_abs d generalize (1:ℝ)/2^1000=ζ at * nlinarith theorem tL (w:Word) (m:Float) (hf:expOf w≠255) (fm:fv m) (hm:|rv m|≤2^279): fv ((dw w-m)*(dw w-m))∧|rv ((dw w-m)*(dw w-m))-(rv (dw w)-rv m)^2|≤4/2^53*(rv (dw w)-rv m)^2+1/2^1000∧(rv (dw w)-rv m)^2≤2^600:=by have d1:=(dwV _ hf).1 have hd:=s80 _ _ (dB _ hf) hm obtain ⟨s1,s2⟩:=NF.fS _ _ d1 fm (NE.z9 _ 280 hd (by norm_num)) have hs:|rv (dw w-m)|≤2^281:=rB _ _ 280 hd s2 have hss:=pB _ _ 281 281 hs hs obtain ⟨p1,p2⟩:=NF.fM _ _ s1 s1 (NE.z9 _ _ hss (by norm_num)) rw [abs_mul_self,←sq] at p2 refine ⟨p1,tL2 _ _ _ (1/2^1075) (by positivity) ?_ s2 p2,?_⟩ ·have:(2:ℝ)^58*(1/2^1075)≤1:=by rw [mul_one_div,div_le_one (by positivity)];exact pow_le_pow_right₀ (by norm_num) (by norm_num) have:(1:ℝ)/2^1075≤1/2^1000/2:=by rw [div_div,←pow_succ];gcongr<;>norm_num have:(0:ℝ)≤1/2^1075:=by positivity generalize (1:ℝ)/2^1075=τ at *;nlinarith ·have:=sq_le_sq' (abs_le.1 hd).1 (abs_le.1 hd).2;rw [←pow_mul] at this exact this.trans (pow_le_pow_right₀ (by norm_num) (by norm_num)) theorem mFl (n:Nat) (x:ZB) (lo hi:USize) (h:hi.toNat≤ x.size) (hb:hi.toNat+1<2^32) (hl:lo.toNat≤ hi.toNat) (base:ℕ) (hlo:lo.toNat=base) (hhi:hi.toNat=base+n) (hn1:1≤ n) (hn:n≤2^20) (hxf:∀ j< n,expOf x[base+j]! ≠255) (hrq:rq n.toUInt64.toInt64.toFloat (1/n.toUInt64.toInt64.toFloat)=true): fv (PP dw x hi h hb lo hl 0 0*(1/n.toUInt64.toInt64.toFloat))∧ |rv (PP dw x hi h hb lo hl 0 0*(1/n.toUInt64.toInt64.toFloat))-(∑ j∈Finset.range n,rv (dw x[base+j]!))/n|≤ ((n:ℝ)+13)/2^54*((∑ j∈Finset.range n,|rv (dw x[base+j]!)|)/n)+1/2^1040∧ |rv (PP dw x hi h hb lo hl 0 0*(1/n.toUInt64.toInt64.toFloat))|≤2^279:=by obtain ⟨r1,r2⟩:=rnE n hn1 hn hrq have hn':(1:ℝ)≤ n:=by exact_mod_cast hn1 have hn2:(n:ℝ)≤2^20:=by exact_mod_cast hn have hn0:(0:ℝ)dB _ (hxf j (Finset.mem_range.1 hj)) _=n*2^278:=by simp have hW:∑ j∈Finset.range n,|rv (dw x[base+j]!)|≤2^298:=hWn.trans (by calc (n:ℝ)*2^278≤2^20*2^278:=by gcongr _=2^298:=by rw [←pow_add]) obtain ⟨p1,p2⟩:=PPs dw x hi h hb lo hl (fun k=>|rv (dw x[k]!)|) (fun k k1 k2=>by obtain ⟨j,rfl⟩:∃ j,k=base+j:=⟨k-base,by clear*-hlo k1;omega⟩ exact ⟨(dwV _ (hxf j (by clear*-hhi k2;omega))).1,le_rfl⟩) (by rw [cv];exact hW.trans (pow_le_pow_right₀ (by norm_num) (by norm_num))) (by clear*-hhi hlo hn hn1;omega) rw [cv,cv,hhi,hlo,show base+n-base=n by clear*-hn hn1;(exact Nat.add_sub_self_left base n)] at p2 have hSX:=Finset.abs_sum_le_sum_abs (fun j=>rv (dw x[base+j]!)) (Finset.range n) generalize ∑ j∈Finset.range n,|rv (dw x[base+j]!)|=W at hW hWn p2 hSX ⊢ generalize ∑ j∈Finset.range n,rv (dw x[base+j]!)=SX at p2 hSX ⊢ generalize PP dw x hi h hb lo hl 0 0=q at p1 p2 ⊢ have hw0:0≤ W:=le_trans (abs_nonneg _) hSX have hrnb:=rib _ _ hn' r2 have hq:|rv q|≤2^299:=by have c0:((n:ℝ)+3)/2*((1/2^53+1/2^73)*W)≤ W/2:=by have:((n:ℝ)+3)/2*(1/2^53+1/2^73)≤1/2:=by rw [div_mul_eq_mul_div,div_le_div_iff₀ (by norm_num) (by norm_num)];nlinarith nlinarith have c1:((n:ℝ)+1)*(1/2^1074)≤1:=by have:(1:ℝ)/2^1074≤1/2^21:=one_div_le_one_div_of_le (by positivity) (pow_le_pow_right₀ (by norm_num) (by norm_num)) have:((n:ℝ)+1)*(1/2^1074)≤(2^20+1)*(1/2^21):=by gcongr linarith have:=abs_sub_abs_le_abs_sub (rv q) SX clear hWn have e:(2:ℝ)^299=2*2^298:=by rw [←pow_succ'] have h1:(2:ℝ)≤2^298:=le_self_pow₀ (by norm_num) (by norm_num) rw [e];clear e;generalize (2:ℝ)^298=T at *;generalize ((n:ℝ)+3)/2*((1/2^53+1/2^73)*W)=c at * generalize ((n:ℝ)+1)*(1/2^1074)=j at *;linarith only [this,p2,c0,c1,hSX,hW,h1] have hqr:=pB _ _ 299 1 hq hrnb obtain ⟨m1,m2⟩:=NF.fM _ _ p1 r1 (NE.z9 _ _ hqr (by norm_num)) have hd:=mR n hn1 hn (rv q) SX W _ _ hSX p2 r2 m2 refine ⟨m1,hd,?_⟩ have k1:W/n≤2^278:=by rw [div_le_iff₀ hn0];calc W≤ n*2^278:=hWn _=_:=mul_comm _ _ have k2:|SX/n|≤W/n:=by rw [abs_div,abs_of_pos hn0];exact div_le_div_of_nonneg_right hSX hn0.le have k3:((n:ℝ)+13)/2^54*(W/n)≤ W/n/2:=by have:((n:ℝ)+13)/2^54≤1/2:=by rw [div_le_div_iff₀ (by positivity) (by positivity)];nlinarith have:=mul_le_mul_of_nonneg_right this (div_nonneg hw0 hn0.le);linarith have k4:(1:ℝ)/2^1040≤1:=by rw [div_le_one (by positivity)];exact one_le_pow₀ (by norm_num) have:=abs_sub_abs_le_abs_sub (rv (q*(1/n.toUInt64.toInt64.toFloat))) (SX/n) have e:(2:ℝ)^279=2*2^278:=by rw [←pow_succ'] have h1:(2:ℝ)≤2^278:=le_self_pow₀ (by norm_num) (by norm_num) clear hW hq hqr hWn;rw [e];clear e;generalize (2:ℝ)^278=T at *;generalize W/n=w at *;generalize (1:ℝ)/2^1040=ζ at * generalize ((n:ℝ)+13)/2^54*w=c at *;linarith only [this,hd,k1,k2,k3,k4,h1] theorem rVl (n:Nat) (eps:Word) (x:ZB) (lo hi:USize) (h:hi.toNat≤ x.size) (hb:hi.toNat+1<2^32) (hl:lo.toNat≤ hi.toNat) (base:ℕ) (hlo:lo.toNat=base) (hhi:hi.toNat=base+n) (hn1:1≤ n) (hn:n≤2^20) (hxf:∀ j< n,expOf x[base+j]! ≠255) (hef:expOf eps≠255) (hE0:0< ZA eps) (hrq:rq n.toUInt64.toInt64.toFloat (1/n.toUInt64.toInt64.toFloat)=true) (m:Float) (fm:fv m) (hm:|rv m|≤2^279): fv (PP (fun w=>let d:=dw w-m;d*d) x hi h hb lo hl 0 0*(1/n.toUInt64.toInt64.toFloat)+dw eps*NR.pt 149)∧ |rv (PP (fun w=>let d:=dw w-m;d*d) x hi h hb lo hl 0 0*(1/n.toUInt64.toInt64.toFloat)+dw eps*NR.pt 149)- ((∑ j∈Finset.range n,(rv (dw x[base+j]!)-rv m)^2)/n+(ZA eps:ℝ)*2^298)|≤ ((n:ℝ)+30)/2^54*((∑ j∈Finset.range n,(rv (dw x[base+j]!)-rv m)^2)/n+(ZA eps:ℝ)*2^298):=by obtain ⟨r1,r2⟩:=rnE n hn1 hn hrq obtain ⟨e1,e2,e3⟩:=epE eps hef hE0 obtain ⟨p1,p2,p3⟩:=pS (fun w=>let d:=dw w-m;d*d) x lo hi h hb hl n base hlo hhi hn (fun j=>rv (dw x[base+j]!)-rv m) (fun j hj=>tL _ m (hxf j hj) fm hm) have hA0:0≤∑ j∈Finset.range n,(rv (dw x[base+j]!)-rv m)^2:=Finset.sum_nonneg fun j _=>sq_nonneg _ exact vP n _ _ _ _ _ ((ZA eps:ℝ)*2^298) _ hn1 hn hA0 (sA n hn _ fun j hj=>(tL _ m (hxf j hj) fm hm).2.2) (by positivity) (nJ n hn) p1 r1 e1 p3 p2 r2 e2 e3 (eB7 eps hef) theorem mDb (m D:Float) (mD:UInt64) (fm:fv m) (fD:fv D) (hD:1≤ rv D) (h:mD=if eF D.toBits≤eF m.toBits then eF m.toBits-eF D.toBits+1 else 0): |rv m|≤2^mD.toNat*rv D∧mD.toNat≤2048:=by subst h have hb:=bitsB m fm have ha:=eFb m.toBits;have hb2:=eFb D.toBits have hne:¬eF D.toBits=0:=by intro h0;have k:=bitsB D fD;rw [h0] at k;simp only [UInt64.toNat_zero,Nat.cast_zero,zero_sub] at k have:(2:ℝ)^(-1022:ℤ)≤1:=zpow_le_one_of_nonpos₀ (by norm_num) (by norm_num) have:=le_abs_self (rv D);linarith have hL:=bitsL D fD hne;rw [abs_of_pos (by linarith)] at hL split ·rename_i hle have hle':=UInt64.le_iff_toNat_le.1 hle have e:(eF m.toBits-eF D.toBits+1).toNat=(eF m.toBits).toNat-(eF D.toBits).toNat+1:=by rw [UInt64.toNat_add,UInt64.toNat_sub_of_le _ _ hle];simp only [UInt64.reduceToNat];omega rw [e];refine ⟨?_,by clear*-ha hb2 hle';omega⟩ calc |rv m|≤(2:ℝ)^(((eF m.toBits).toNat:Int)-1022):=hb.le _=2^((eF m.toBits).toNat-(eF D.toBits).toNat+1)*2^(((eF D.toBits).toNat:Int)-1023):=by rw [←zpow_natCast,←zpow_add₀ (by norm_num)];congr 1;rw [Nat.cast_add,Nat.cast_sub hle'];push_cast;ring _≤_:=by gcongr ·rename_i hlt have hlt':(eF m.toBits).toNat<(eF D.toBits).toNat:=by have:=UInt64.le_iff_toNat_le.not.1 hlt;(exact Nat.lt_of_not_le hlt) refine ⟨?_,by simp⟩ simp only [UInt64.toNat_zero,pow_zero,one_mul] calc |rv m|≤(2:ℝ)^(((eF m.toBits).toNat:Int)-1022):=hb.le _≤(2:ℝ)^(((eF D.toBits).toNat:Int)-1023):=zpow_le_zpow_right₀ (by norm_num) (by omega) _≤_:=hL theorem rLf (Ln:UInt64) (k:UInt64→Bool) (Ep rn:Float) (x:ZB) (lo hi:USize) (h:hi.toNat≤ x.size) (hb:hi.toNat+1<2^32) (hl:lo.toNat≤ hi.toNat): ∃ m V mD,m=PP dw x hi h hb lo hl 0 0*rn∧V=PP (fun w=>let d:=dw w-m;d*d) x hi h hb lo hl 0 0*rn+Ep∧ mD=(if eF (dw (dn V Ln k).2).toBits≤eF m.toBits then eF m.toBits-eF (dw (dn V Ln k).2).toBits+1 else 0)∧ rL Ln k Ep rn x lo hi h hb hl=⟨(dn V Ln k).1&&Ln+mD≤25&&rq (dw (dn V Ln k).2) (1/dw (dn V Ln k).2),m,1/dw (dn V Ln k).2,(dn V Ln k).2,Ln+mD+1047⟩:= ⟨_,_,_,rfl,rfl,rfl,rfl⟩ theorem mrE (n:Nat) (x:ZB) (r:Nat) (hxf:∀ j< n,expOf x[r*n+j]! ≠255): ((rowMean n x r:ℚ):ℝ)*2^149=(∑ j∈Finset.range n,rv (dw x[r*n+j]!))/n:=by unfold rowMean;rw [Yk];push_cast simp only [zero_add,div_mul_eq_mul_div,Finset.sum_mul];congr 1 refine Finset.sum_congr rfl fun j hj=>?_ rw [(dZ _ (hxf j (Finset.mem_range.1 hj))).2] theorem vrE (n:Nat) (x:ZB) (r:Nat) (eps:Word) (hxf:∀ j< n,expOf x[r*n+j]! ≠255): ((rowVariance n x r (rowMean n x r)+ZA eps:ℚ):ℝ)*2^298= (∑ j∈Finset.range n,(rv (dw x[r*n+j]!)-(∑ k∈Finset.range n,rv (dw x[r*n+k]!))/n)^2)/n+(ZA eps:ℝ)*2^298:=by rw [←mrE n x r hxf] unfold rowVariance;rw [Yk];push_cast simp only [zero_add,add_mul,div_mul_eq_mul_div,Finset.sum_mul] congr 2 refine Finset.sum_congr rfl fun j hj=>?_ rw [(dZ _ (hxf j (Finset.mem_range.1 hj))).2,show (2:ℝ)^298=(2^149)^2 by rw [←pow_mul]] ring theorem cE (E ib ig A:UInt64) (k:ℕ) (hE:E.toNat≤2047) (hib:ib.toNat≤254) (hig:ig.toNat≤254) (hA:A.toNat=k+1047) (hk:k≤25): (NE.mx (NE.mx (E+5) (ib+1051)) (ig+A)-E).toNat=max (max (E.toNat+5) (ib.toNat+1051)) (ig.toNat+k+1047)-E.toNat:=by have h1:(E+5).toNat=E.toNat+5:=by rw [UInt64.toNat_add];simp only [UInt64.reduceToNat];clear*-hE;omega have h2:(ib+1051).toNat=ib.toNat+1051:=by rw [UInt64.toNat_add];simp only [UInt64.reduceToNat];clear*-hib;omega have h3:(ig+A).toNat=ig.toNat+k+1047:=by rw [UInt64.toNat_add,hA];clear*-hig hk;omega have hm:(NE.mx (NE.mx (E+5) (ib+1051)) (ig+A)).toNat=max (max (E.toNat+5) (ib.toNat+1051)) (ig.toNat+k+1047):=by rw [NE.mxv,NE.mxv,h1,h2,h3] rw [UInt64.toNat_sub_of_le _ _ (UInt64.le_iff_toNat_le.2 (by rw [hm];clear*-;omega)),hm] theorem eLe (n:Nat) (x:ZB) (r j:Nat) (hj:j< n) (gw bw d:Word) (m ri:Float) (ok:Bool) (k:ℕ) (A:UInt64) (hx:expOf x[r*n+j]! ≠255) (hg:expOf gw≠255) (hbw:expOf bw≠255) (hdf:expOf d≠255) (hds:ZX d=false) (hd1:1≤ rv (dw d)) (fri:fv ri) (hri:|rv ri-1/rv (dw d)|≤3/2^53/rv (dw d)) (fm:fv m) (hm:|rv m|≤2^279) (hA:A.toNat=k+1047) (hk:k≤25) (hδ:|rv m-((rowMean n x r:ℚ):ℝ)*2^149|≤2^k/2^53*rv (dw d)): eL n x r ⟨ok,m,ri,d,A⟩ x[r*n+j]! gw bw (dw gw) (dw bw)=ZT ((ZA x[r*n+j]! -rowMean n x r)*ZA gw/ZA d+ZA bw):=by unfold eL;dsimp only;split ·rename_i hc simp only [Bool.and_eq_true,Bool.or_eq_true,decide_eq_true_eq] at hc;obtain ⟨⟨c1,c2⟩,c3⟩:=hc generalize x[r*n+j]! =xw at hx c1 c2 c3 ⊢ obtain ⟨x1,x2⟩:=dZ xw hx;obtain ⟨b1,b2⟩:=dZ bw hbw;obtain ⟨-,d2⟩:=dZ d hdf obtain ⟨p1,p2,p3⟩:=gp gw ri hg fri (rib _ _ hd1 hri) have k0:=s80 _ _ (dB xw hx) hm obtain ⟨s1,s2⟩:=NF.fS _ _ x1 fm (NE.z9 _ 280 k0 (by norm_num)) have kq:=pB _ _ 281 280 (rB _ _ 280 k0 s2) p3 obtain ⟨q1,q2⟩:=NF.fM _ _ s1 p1 (NE.z9 _ _ kq (by norm_num)) obtain ⟨v1,v2⟩:=NF.fA _ _ q1 b1 (NE.z9 _ _ (aB _ _ 562 (rB _ _ 561 kq q2) ((dB bw hbw).trans (pow_le_pow_right₀ (by norm_num) (by norm_num)))) (by norm_num)) have e:=eL2 _ _ _ _ _ _ _ _ _ hd1 hri s2 p2 q2 v2 k0 (dB gw hg) have hb:=bU _ v1 generalize (dw xw-m)*(dw gw*ri)+dw bw=v at v1 e hb c1 c2 c3 ⊢ obtain ⟨E1,E2⟩:=te _ c1 have hct:=cE (eF v.toBits) (Core.iW bw) (Core.iW gw) A k (eFb _) (by rw [ZS];exact ix254 bw) (by rw [ZS];exact ix254 gw) hA hk rw [ZS,ZS] at hct generalize NE.mx (NE.mx (eF v.toBits+5) (Core.iW bw+1051)) (Core.iW gw+A)-eF v.toBits=c at c2 c3 hct suffices he:|rv v-((((ZA xw-rowMean n x r)*ZA gw/ZA d+ZA bw:ℚ)):ℝ)*2^149|≤2^c.toNat*(2:ℝ)^(((eF v.toBits).toNat:Int)-1075) by rcases c3 with c3|c3 ·obtain ⟨t1,t2⟩:=tc _ c c2 c3;exact eC _ v1 c.toNat _ E1 E2 t1 t2 he ·obtain ⟨n1,n2⟩:=nxE _ E2 c3;exact eC2 _ v1 c.toNat _ E1 E2 (UInt64.le_iff_toNat_le.1 c2) n1 n2 he generalize (eF v.toBits).toNat=E at E1 E2 hb hct ⊢ obtain ⟨M,hM⟩:∃ M,M=max (max (E+5) (idxOf bw+1051)) (idxOf gw+k+1047):=⟨_,rfl⟩ rw [←hM] at hct rw [←zpow_natCast (2:ℝ) c.toNat,←zpow_add₀ (by norm_num),show (c.toNat:ℤ)+((E:ℤ)-1075)=(M:ℤ)-1075 by clear*-hM hct;omega] have hD0:0< rv (dw d):=by linarith refine eBd _ _ _ _ _ _ _ _ k e ?_ hb (by rw [show (32:ℝ)=2^(5:ℤ) by norm_num,←zpow_add₀ (by norm_num)];exact zpow_le_zpow_right₀ (by norm_num) (by clear*-hM;omega)) (wb bw hbw 5 _ (by clear*-hM;omega)) (wb gw hg (k+1) _ (by clear*-hM;omega)) (by rw [show (1:ℝ)/2^699*64=2^6/2^699 by ring];exact zE _ _ _ (by clear*-hM;omega)) have:(ZA d:ℝ)≠0:=fun h=>by rw [h] at d2;rw [d2] at hD0;simp at hD0 rw [show (rv (dw xw)-rv m)*rv (dw gw)/rv (dw d)+rv (dw bw)-(((ZA xw-rowMean n x r)*ZA gw/ZA d+ZA bw:ℚ):ℝ)*2^149= (((rowMean n x r:ℚ):ℝ)*2^149-rv m)*(rv (dw gw)/rv (dw d)) by rw [x2,(dZ gw hg).2,d2,b2];push_cast;field_simp;ring, abs_mul,abs_sub_comm,abs_div,abs_of_pos hD0] calc _≤2^k/2^53*rv (dw d)*(|rv (dw gw)|/rv (dw d)):=mul_le_mul_of_nonneg_right hδ (div_nonneg (abs_nonneg _) hD0.le) _=_:=by have:=hD0.ne';field_simp ·exact sIE n x r j gw bw d hj hds theorem vp (n:ℕ) (hn:n≤2^20) (V A E:ℝ) (hA:0≤ A) (hE:2^149≤ E) (h:|V-(A+E)|≤((n:ℝ)+30)/2^54*(A+E)):0< V:=by have hn2:(n:ℝ)≤2^20:=by exact_mod_cast hn have:((n:ℝ)+30)/2^54*(A+E)≤1/2*(A+E):=mul_le_mul_of_nonneg_right (by rw [div_le_div_iff₀ (by positivity) (by positivity)];nlinarith) (by linarith [show (0:ℝ)<2^149 by positivity]) linarith [(abs_le.1 h).1,show (0:ℝ)<2^149 by positivity] theorem lnR (n:ℕ) (hn0:1≤ n) (hn:n≤2^20) (X:ℕ→ℝ) (m Eps V Bs D P Q:ℝ) (hE:2^149≤ Eps) (hV:|V-((∑ j∈Finset.range n,(X j-m)^2)/n+Eps)|≤((n:ℝ)+30)/2^54*((∑ j∈Finset.range n,(X j-m)^2)/n+Eps)) (hV0:0< V) (hB:|Bs-Real.sqrt V|≤ Real.sqrt V/2^53+1/2^1075) (hDB:|D-Bs|≤ Bs/2^24) (hD1:1≤ D) (hm:|m|≤ Q*D) (hf:|m-(∑ j∈Finset.range n,X j)/n|≤((n:ℝ)+13)/2^54*((∑ j∈Finset.range n,|X j|)/n)+1/2^1040) (hP:(n:ℝ)+17≤ P) (hP2:P≤2^21) (hQ:1≤ Q) (hPQ:P*Q≤2^25):|m-(∑ j∈Finset.range n,X j)/n|≤ P*Q/2^53*D∧ |V-((∑ j∈Finset.range n,(X j-(∑ k∈Finset.range n,X k)/n)^2)/n+Eps)|≤((n:ℝ)+31)/2^54*((∑ j∈Finset.range n,(X j-(∑ k∈Finset.range n,X k)/n)^2)/n+Eps):=by have hn':(0:ℝ)X j-m);beta_reduce at hcs have:∑ j∈Finset.range n,|X j|≤∑ j∈Finset.range n,|X j-m|+n*|m|:=by simpa [Finset.sum_add_distrib] using Finset.sum_le_sum fun j (_:j∈Finset.range n)=>abs_add_le (X j-m) m have hsq:=mul_le_mul_of_nonneg_left (Real.sqrt_le_sqrt (by linarith:(∑ j∈Finset.range n,(X j-m)^2)/n≤R2)) hn'.le have hmE:=mE n P Q D (Real.sqrt R2) m _ _ hP hP2 hQ hD1 hf (by rw [div_le_iff₀ hn'];nlinarith) (by nlinarith [(abs_le.1 hDR).1,Real.sqrt_nonneg R2]) hm refine ⟨hmE,?_⟩ have hsid:=sId n hn0 X m generalize ∑ k∈Finset.range n,X k=SX at hsid hmE hf ⊢ rw [show R2=((∑ j∈Finset.range n,(X j-SX/n)^2)/n+Eps)+(m-SX/n)^2 by rw [←hR,hsid,add_div,mul_div_cancel_left₀ _ hn'.ne'];ring] at hV hDR exact bI n hn V _ _ D (by positivity) hV (hmE.trans (by nlinarith)) hDR theorem domE {rows n:Nat} {eps:Word} {x g:ZB} (h:dom rows n eps x g=true): stableNormDomain rows n eps x g=true∧rows*n+1<2^32∧n≤2^20∧rq n.toUInt64.toInt64.toFloat (1/n.toUInt64.toInt64.toFloat)=true:=by simp only [dom,Bool.and_eq_true,decide_eq_true_eq] at h obtain ⟨⟨⟨h1,h2⟩,h3⟩,h4⟩:=h exact ⟨by rw [←SN_eq];exact h1,by omega,by (exact eqge rfl h3),h4⟩ theorem szD {rows n:Nat} {eps:Word} {x g:ZB} (h:stableNormDomain rows n eps x g=true):x.size=rows*n∧g.size=n:=by simp only [stableNormDomain,Bool.and_eq_true,ZH,gt_iff_lt] at h exact ⟨by simpa using h.1.1.1.1.1.2,by simpa using h.1.1.1.1.2⟩ theorem eLok (rows n:Nat) (eps:Word) (x g b:ZB) (hD:stableNormDomain rows n eps x g=true) (hbf:∀ j< n,expOf b[j]! ≠255) (hn:rows*n+1<2^32) (hn20:n≤2^20) (hrq:rq n.toUInt64.toInt64.toFloat (1/n.toUInt64.toInt64.toFloat)=true) (r:Nat) (hr:r< rows) (h1 h2 h3) (hok:(rL (lw n) (xD n x r eps true) (dw eps*NR.pt 149) (1/n.toUInt64.toInt64.toFloat) x (r*n).toUSize ((r*n).toUSize+n.toUSize) h1 h2 h3).ok=true) (j:Nat) (hj:j< n): eL n x r (rL (lw n) (xD n x r eps true) (dw eps*NR.pt 149) (1/n.toUInt64.toInt64.toFloat) x (r*n).toUSize ((r*n).toUSize+n.toUSize) h1 h2 h3) x[r*n+j]! g[j]! b[j]! (dw g[j]!) (dw b[j]!)= ZT ((ZA x[r*n+j]! -rowMean n x r)*ZA g[j]! /ZA (sqrtRational (rowVariance n x r (rowMean n x r)+ZA eps))+ZA b[j]!):=by obtain ⟨hn0,hE0,hxf,hgf⟩:=SNu hD obtain ⟨u1,u2,u3,u4⟩:=uB hr hn have hxf':∀ j< n,expOf x[r*n+j]! ≠255:=fun j hj=>hxf _ (by clear*-hj u1;omega) obtain ⟨l1,l2,-⟩:=lwE n hn20 obtain ⟨mm,V,mD,hmm,hV,hmD,e⟩:=rLf (lw n) _ (dw eps*NR.pt 149) (1/n.toUInt64.toInt64.toFloat) x _ _ h1 h2 h3 rw [e] at hok ⊢;simp only [Bool.and_eq_true,decide_eq_true_eq] at hok;obtain ⟨⟨o1,o2⟩,o3⟩:=hok obtain ⟨f1,f2,f3⟩:=mFl n x _ _ h1 h2 h3 (r*n) u2 u4 hn0 hn20 hxf' hrq;rw [←hmm] at f1 f2 f3 obtain ⟨v1,v2⟩:=rVl n eps x _ _ h1 h2 h3 (r*n) u2 u4 hn0 hn20 hxf' (sEp hD) hE0 hrq mm f1 f3;rw [←hV] at v1 v2 have hE:=(epE eps (sEp hD) hE0).2.2 have hV0:=vp n hn20 (rv V) _ _ (by positivity) hE v2 obtain ⟨-,-,-,q2,-,-,hd,-,-,w3⟩:=dnD V (lw n) _ v1 hV0 o1 obtain ⟨w1,w2,hD1,fri,hri⟩:=dWr V (lw n) _ v1 hV0 o1 o3 generalize hdd:(dn V (lw n) (xD n x r eps true)).2=d at hd w1 w2 hD1 fri hri hmD ⊢ rw [←hd] at w3 obtain ⟨hm,hm2⟩:=mDb mm (dw d) mD f1 (dwV d w1).1 hD1 hmD have hLm:(lw n).toNat+mD.toNat≤25:=by have:=UInt64.le_iff_toNat_le.1 o2;rw [UInt64.toNat_add] at this;simp only [UInt64.reduceToNat] at this;clear*-hm2 l1 this;omega obtain ⟨k1,k2⟩:=lnR n hn0 hn20 (fun j=>rv (dw x[r*n+j]!)) (rv mm) _ (rv V) _ (rv (dw d)) (2^(lw n).toNat) (2^mD.toNat) hE v2 hV0 q2 (by rw [(dwV d w1).2];exact w3) hD1 hm f2 l2 (pow_le_pow_right₀ (by norm_num) l1) (one_le_pow₀ (by norm_num)) (by rw [←pow_add];exact pow_le_pow_right₀ (by norm_num) hLm) have c:=dnC V n _ (rowVariance n x r (rowMean n x r)+ZA eps) (((n:ℝ)+31)/2^54) hn20 v1 (by have:=rVn n x r (rowMean n x r);linarith) (by rw [vrE n x r eps hxf'];exact k2) (by gcongr;norm_num) (xDE n x r eps true hn0 hE0) o1 rw [hdd] at c;rw [←c] exact eLe n x r j hj g[j]! b[j]! d mm (1/dw d) _ ((lw n).toNat+mD.toNat) _ (hxf' j hj) (hgf j hj) (hbf j hj) w1 w2 hD1 fri hri f1 f3 (by rw [UInt64.toNat_add,UInt64.toNat_add];simp only [UInt64.reduceToNat];clear*-hLm hm2;omega) hLm (by rw [mrE n x r hxf',pow_add];exact k1) theorem RLE (rows n:Nat) (Ln:UInt64) (Ep rn:Float) (eps:Word) (x g b:ZB) (gd bd:FloatArray) (hn:rows*n+1<2^32) (hx:rows*n≤ x.size) (hg:n≤ g.size) (hb:n≤ b.size) (hgd:n≤ gd.size) (hbd:n≤ bd.size) (F:Nat→Word) (hgv:∀ j< n,gd.data[j]! =dw g[j]!) (hbv:∀ j< n,bd.data[j]! =dw b[j]!) (hF:∀ r< rows,∀ j< n,F (r*n+j)=ZT ((ZA x[r*n+j]! -rowMean n x r)*ZA g[j]! /ZA (sqrtRational (rowVariance n x r (rowMean n x r)+ZA eps))+ZA b[j]!)) (hel:∀ r,r< rows→∀ h1 h2 h3,(rL Ln (xD n x r eps true) Ep rn x (r*n).toUSize ((r*n).toUSize+n.toUSize) h1 h2 h3).ok=true→∀ j< n, eL n x r (rL Ln (xD n x r eps true) Ep rn x (r*n).toUSize ((r*n).toUSize+n.toUSize) h1 h2 h3) x[r*n+j]! g[j]! b[j]! (dw g[j]!) (dw b[j]!)=F (r*n+j)) : ∀ (k r:Nat) (hk:r+k=rows) (out:ZB) (ho:rows*n≤ out.size), (RL rows n Ln Ep rn eps x g b gd bd hn hx hg hb hgd hbd k r hk out ho).size=out.size∧ ∀ q,(RL rows n Ln Ep rn eps x g b gd bd hn hx hg hb hgd hbd k r hk out ho)[q]! =if r*n≤ q∧q< rows*n then F q else out[q]!:=by intro k;induction k<;>intro r hk out ho ·refine ⟨by rw [RL_0],fun q=>?_⟩;rw [RL_0,if_neg] intro ⟨k1,k2⟩;have:=Nat.mul_le_mul_right n (show rows≤ r by clear*-hk;(exact Nat.le_of_eq (id (Eq.symm hk))));clear*-k1 k2 this;omega rename_i k ih have hr:=(rkS hk).1 obtain ⟨h1,h2,h3,h4⟩:=uB hr hn rw [RL_s];dsimp only have K:∀ hk' w hw,(w.size=out.size∧∀ q,w[q]! =if (r*n).toUSize.toNat+(0:USize).toNat≤ q∧q<(r*n).toUSize.toNat+n.toUSize.toNat then F q else out[q]!)→ (RL rows n Ln Ep rn eps x g b gd bd hn hx hg hb hgd hbd k (r+1) hk' w hw).size=out.size∧ ∀ q,(RL rows n Ln Ep rn eps x g b gd bd hn hx hg hb hgd hbd k (r+1) hk' w hw)[q]! =if r*n≤ q∧q< rows*n then F q else out[q]!:=by intro hk' w hw ⟨s1,s2⟩;obtain ⟨a1,a2⟩:=ih (r+1) hk' w hw refine ⟨a1.trans s1,fun q=>?_⟩;rw [a2,s2,h2,h3,USize.toNat_zero,Nat.succ_mul];split_ifs<;>first|rfl|omega refine K _ _ _ ?_ split ·rename_i hok;exact (QEE _ _ _ F _ (fun j hj=>by have:=USize.lt_iff_toNat_lt.mp hj;rw [h3] at this rw [ugw,ugw,ugw,ugE,ugE,Dense.uadd (a:=(r*n).toUSize) (b:=j) (by have:=USize.le_size;clear ih K h3 h4 hF hb hbd hbv hel hg hgd hgv hj ho hok hr hx hk;omega),show (r*n).toUSize.toNat+j.toNat=r*n+j.toNat by clear*-h2;(exact Nat.add_left_inj.mpr h2),hgv _ this,hbv _ this] exact hel r hr _ _ _ hok _ this) _ _ _) ·exact (QEE _ _ _ F _ (fun j hj=>by have:=USize.lt_iff_toNat_lt.mp hj;rw [h3] at this;rw [h2,hF r hr _ this]) _ _ _) theorem RRE (rows n:Nat) (Ln:UInt64) (Ep rn:Float) (eps:Word) (x g:ZB) (gd:FloatArray) (hn:rows*n+1<2^32) (hx:rows*n≤ x.size) (hg:n≤ g.size) (hgd:n≤ gd.size) (F:Nat→Word) (hgv:∀ j< n,gd.data[j]! =dw g[j]!) (hF:∀ r< rows,∀ j< n,F (r*n+j)=ZT (ZA x[r*n+j]! *ZA g[j]! /ZA (sqrtRational (rowVariance n x r 0+ZA eps)))) (hel:∀ r,r< rows→∀ h1 h2 h3,(rR Ln (xD n x r eps false) Ep rn x (r*n).toUSize ((r*n).toUSize+n.toUSize) h1 h2 h3).ok=true→∀ j< n, eR (rR Ln (xD n x r eps false) Ep rn x (r*n).toUSize ((r*n).toUSize+n.toUSize) h1 h2 h3) x[r*n+j]! g[j]! (dw g[j]!)=F (r*n+j)) : ∀ (k r:Nat) (hk:r+k=rows) (out:ZB) (ho:rows*n≤ out.size), (RR rows n Ln Ep rn eps x g gd hn hx hg hgd k r hk out ho).size=out.size∧ ∀ q,(RR rows n Ln Ep rn eps x g gd hn hx hg hgd k r hk out ho)[q]! =if r*n≤ q∧q< rows*n then F q else out[q]!:=by intro k;induction k<;>intro r hk out ho ·refine ⟨by rw [RR_0],fun q=>?_⟩;rw [RR_0,if_neg] intro ⟨k1,k2⟩;have:=Nat.mul_le_mul_right n (show rows≤ r by clear*-hk;(exact Nat.le_of_eq (id (Eq.symm hk))));clear*-k1 k2 this;omega rename_i k ih have hr:=(rkS hk).1 obtain ⟨h1,h2,h3,h4⟩:=uB hr hn rw [RR_s];dsimp only have K:∀ hk' w hw,(w.size=out.size∧∀ q,w[q]! =if (r*n).toUSize.toNat+(0:USize).toNat≤ q∧q<(r*n).toUSize.toNat+n.toUSize.toNat then F q else out[q]!)→ (RR rows n Ln Ep rn eps x g gd hn hx hg hgd k (r+1) hk' w hw).size=out.size∧ ∀ q,(RR rows n Ln Ep rn eps x g gd hn hx hg hgd k (r+1) hk' w hw)[q]! =if r*n≤ q∧q< rows*n then F q else out[q]!:=by intro hk' w hw ⟨s1,s2⟩;obtain ⟨a1,a2⟩:=ih (r+1) hk' w hw refine ⟨a1.trans s1,fun q=>?_⟩;rw [a2,s2,h2,h3,USize.toNat_zero,Nat.succ_mul];split_ifs<;>first|rfl|omega refine K _ _ _ ?_ split ·rename_i hok;exact (QEE _ _ _ F _ (fun j hj=>by have:=USize.lt_iff_toNat_lt.mp hj;rw [h3] at this rw [ugw,ugw,ugE,Dense.uadd (a:=(r*n).toUSize) (b:=j) (by have:=USize.le_size;clear ih K h3 h4 hF hel hg hgd hgv hj ho hok hr hx hk;omega),show (r*n).toUSize.toNat+j.toNat=r*n+j.toNat by clear*-h2;(exact Nat.add_left_inj.mpr h2),hgv _ this] exact hel r hr _ _ _ hok _ this) _ _ _) ·exact (QEE _ _ _ F _ (fun j hj=>by have:=USize.lt_iff_toNat_lt.mp hj;rw [h3] at this;rw [h2,hF r hr _ this]) _ _ _) def rmsnormE (rows n:Nat) (eps:Word) (x g:ZB):ZB:= if h:dom rows n eps x g then have d:=domE h;have z:=szD d.1 let gd:=fdec g RR rows n (lw n) (dw eps*NR.pt 149) (1/n.toUInt64.toInt64.toFloat) eps x g gd d.2.1 (by omega) (by omega) (by rw [(fdecE g).1];omega) rows 0 (Nat.zero_add rows) (Array.replicate (rows*n) 0) (by simp) else rmsnormSpec rows n eps x g theorem aX (a b:ZB) (h1:a.size=b.size) (h2:∀ q< b.size,a[q]! =b[q]!):a=b:=by apply Array.ext h1;intro q hq hq';have:=h2 q hq';rwa [getElem!_pos a q hq,getElem!_pos b q hq'] at this theorem ixE {rows n r j:ℕ} (hr:r< rows) (hj:j< n):r*n+j< rows*n∧(r*n+j)/n=r∧(r*n+j)%n=j:=by refine ⟨by have:=Nat.mul_le_mul_right n (Nat.succ_le_of_lt hr);rw [Nat.succ_mul] at this;clear hr;omega,?_,?_⟩ ·rw [Nat.add_comm,Nat.add_mul_div_right _ _ (by clear hr;(exact Nat.zero_lt_of_lt hj)),Nat.div_eq_of_lt hj,zero_add] ·rw [Nat.add_comm,Nat.add_mul_mod_self_right,Nat.mod_eq_of_lt hj] theorem rmsnormE_eq:rmsnormE=rmsnormSpec:=by funext rows n eps x g;by_cases h:dom rows n eps x g=true ·rw [rmsnormE,dif_pos h] have d:=domE h;have z:=szD d.1 unfold rmsnormSpec rmsnormWith;rw [if_pos d.1] have hs:(rmsnormStable rows n eps x g).size=rows*n:=by simp [rmsnormStable] have hF:∀ r< rows,∀ j< n,(fun q=>(rmsnormStable rows n eps x g)[q]!) (r*n+j)=ZT (ZA x[r*n+j]! *ZA g[j]! /ZA (sqrtRational (rowVariance n x r 0+ZA eps))):= (fun r hr j hj=>by obtain ⟨hq,e1,e2⟩:=ixE hr hj unfold rmsnormStable;dsimp only;rw [Qg _ hq];simp only [e1,e2];rw [Qg _ hr]) obtain ⟨s1,s2⟩:=RRE rows n (lw n) (dw eps*NR.pt 149) (1/n.toUInt64.toInt64.toFloat) eps x g (fdec g) d.2.1 (by clear*-z;omega) (by omega) (by rw [(fdecE g).1];omega) (fun q=>(rmsnormStable rows n eps x g)[q]!) (fun j hj=>(fdecE g).2 j (by clear*-hj z;omega)) hF (fun r hr h1 h2 h3 hok j hj=>(eRok rows n eps x g d.1 d.2.1 d.2.2.1 d.2.2.2 r hr h1 h2 h3 hok j hj).trans (hF r hr j hj).symm) rows 0 (Nat.zero_add rows) (Array.replicate (rows*n) 0) (by simp) apply aX _ _ (by rw [s1,hs,Array.size_replicate]) (fun q hq=>?_) rw [s2 q,if_pos ⟨by clear*-;omega,by rw [hs] at hq;exact hq⟩] ·rw [rmsnormE,dif_neg h] theorem lnD {rows n:Nat} {eps:Word} {x g b:ZB} (h:(dom rows n eps x g&&b.size==n&&b.all finiteWord)=true): dom rows n eps x g=true∧b.size=n∧∀ j< n,expOf b[j]! ≠255:=by simp only [Bool.and_eq_true,beq_iff_eq] at h obtain ⟨⟨h1,h2⟩,h3⟩:=h exact ⟨h1,h2,fun j hj=>NR.fAl b (by simpa [Array.all_eq_true] using h3) j (by (exact Nat.lt_of_lt_of_eq hj (id (Eq.symm h2))))⟩ def layernormE (rows n:Nat) (eps:Word) (x g b:ZB):ZB:= if h:dom rows n eps x g&&b.size==n&&b.all finiteWord then have l:=lnD h;have d:=domE l.1;have z:=szD d.1 RL rows n (lw n) (dw eps*NR.pt 149) (1/n.toUInt64.toInt64.toFloat) eps x g b (fdec g) (fdec b) d.2.1 (by omega) (by omega) (by omega) (by rw [(fdecE g).1];omega) (by rw [(fdecE b).1];omega) rows 0 (Nat.zero_add rows) (Array.replicate (rows*n) 0) (by simp) else layernormSpec rows n eps x g b theorem layernormE_eq:layernormE=layernormSpec:=by funext rows n eps x g b;by_cases h:(dom rows n eps x g&&b.size==n&&b.all finiteWord)=true ·rw [layernormE,dif_pos h] have l:=lnD h;have d:=domE l.1;have z:=szD d.1 unfold layernormSpec layernormWith;rw [if_pos (by have h':=h;simp only [Bool.and_eq_true,beq_iff_eq] at h' ⊢;exact ⟨⟨d.1,l.2.1⟩,h'.2⟩)] have hs:(layernormStable rows n eps x g b).size=rows*n:=by simp [layernormStable] have hF:∀ r< rows,∀ j< n,(fun q=>(layernormStable rows n eps x g b)[q]!) (r*n+j)=ZT ((ZA x[r*n+j]! -rowMean n x r)*ZA g[j]! /ZA (sqrtRational (rowVariance n x r (rowMean n x r)+ZA eps))+ZA b[j]!):= (fun r hr j hj=>by obtain ⟨hq,e1,e2⟩:=ixE hr hj unfold layernormStable;dsimp only;rw [Qg _ hq];simp only [e1,e2];simp only [Qg _ hr,Fin.val_mk]) obtain ⟨s1,s2⟩:=RLE rows n (lw n) (dw eps*NR.pt 149) (1/n.toUInt64.toInt64.toFloat) eps x g b (fdec g) (fdec b) d.2.1 (by clear*-z;omega) (by clear*-z;omega) (by clear*-l;omega) (by rw [(fdecE g).1];clear*-z;omega) (by rw [(fdecE b).1];clear*-l;omega) (fun q=>(layernormStable rows n eps x g b)[q]!) (fun j hj=>(fdecE g).2 j (by clear*-hj z;omega)) (fun j hj=>(fdecE b).2 j (by clear*-hj l;omega)) hF (fun r hr h1 h2 h3 hok j hj=>(eLok rows n eps x g b d.1 l.2.2 d.2.1 d.2.2.1 d.2.2.2 r hr h1 h2 h3 hok j hj).trans (hF r hr j hj).symm) rows 0 (Nat.zero_add rows) (Array.replicate (rows*n) 0) (by simp) apply aX _ _ (by rw [s1,hs,Array.size_replicate]) (fun q hq=>?_) rw [s2 q,if_pos ⟨by clear*-;omega,by rw [hs] at hq;exact hq⟩] ·rw [layernormE,dif_neg h] theorem RLc (rows n:Nat) (Ln:UInt64) (Ep rn:Float) (eps:Word) (x g b:ZB) (gd bd:FloatArray) (hn hx hg hb hgd hbd) (k r:Nat) (hk:r+k=rows) (a a':ZB) (ha ha') (h:a=a'): RL rows n Ln Ep rn eps x g b gd bd hn hx hg hb hgd hbd k r hk a ha=RL rows n Ln Ep rn eps x g b gd bd hn hx hg hb hgd hbd k r hk a' ha':=by subst h;rfl theorem QEf (lo N:USize) (f f':(j:USize)→j< N→Word) (hN:lo.toNat+N.toNat<2^32) (i:USize) (a:ZB) (ha:lo.toNat+N.toNat≤ a.size) (h:∀ j hj,f j hj=f' j hj):QE lo N f hN i a ha=QE lo N f' hN i a ha:=by have:f=f':=funext fun j=>funext fun hj=>h j hj subst this;rfl theorem iteC {α:Type} {c:Prop} [Decidable c] (a a' b:α) (h:c→a=a'):(if c then a else b)=(if c then a' else b):=by split ·exact h ‹_› ·rfl def RLi (rows n:Nat) (Ln:UInt64) (Ep rn:Float) (eps:Word) (x g b:ZB) (hn:rows*n+1<2^32) (hx:rows*n≤ x.size) (hg:n≤ g.size) (hb:n≤ b.size) :(k r:Nat)→ r+k=rows→(out:ZB)→ rows*n≤ out.size→ZB | 0,_,_,out,_=>out | k+1,r,hk,out,ho=> have hr:=(rkS hk).1 have p:=rliA hr hn hx ho let e:=rL Ln (xD n x r eps true) Ep rn x (r*n).toUSize ((r*n).toUSize+n.toUSize) p.2.2.1 p.2.2.2.1 p.2.2.2.2 RLi rows n Ln Ep rn eps x g b hn hx hg hb k (r+1) (rkS hk).2 (if e.ok then QE (r*n).toUSize n.toUSize (fun j hj=> have q:=rliB hr hn hx hg hb hj let gw:=g.uget j q.1;let bw:=b.uget j q.2.1 eL n x r e (x.uget ((r*n).toUSize+j) q.2.2) gw bw (dw gw) (dw bw)) p.1 0 out p.2.1 else fL n eps x g b r (r*n).toUSize n.toUSize p.1 out p.2.1) (eqge (qfs _ _ _ _ _ _ _ _ _ _ _ _ _) ho) theorem RLi_0 (rows n:Nat) (Ln:UInt64) (Ep rn:Float) (eps:Word) (x g b:ZB) (hn:rows*n+1<2^32) (hx:rows*n≤ x.size) (hg:n≤ g.size) (hb:n≤ b.size) (r:Nat) (hk:r+0=rows) (out:ZB) (ho:rows*n≤ out.size):RLi rows n Ln Ep rn eps x g b hn hx hg hb 0 r hk out ho=out:=rfl theorem RLi_s (rows n:Nat) (Ln:UInt64) (Ep rn:Float) (eps:Word) (x g b:ZB) (hn:rows*n+1<2^32) (hx:rows*n≤ x.size) (hg:n≤ g.size) (hb:n≤ b.size) (k r:Nat) (hk:r+(k+1)=rows) (out:ZB) (ho:rows*n≤ out.size):RLi rows n Ln Ep rn eps x g b hn hx hg hb (k+1) r hk out ho= (have hr:=(rkS hk).1 have p:=rliA hr hn hx ho let e:=rL Ln (xD n x r eps true) Ep rn x (r*n).toUSize ((r*n).toUSize+n.toUSize) p.2.2.1 p.2.2.2.1 p.2.2.2.2 RLi rows n Ln Ep rn eps x g b hn hx hg hb k (r+1) (rkS hk).2 (if e.ok then QE (r*n).toUSize n.toUSize (fun j hj=> have q:=rliB hr hn hx hg hb hj let gw:=g.uget j q.1;let bw:=b.uget j q.2.1 eL n x r e (x.uget ((r*n).toUSize+j) q.2.2) gw bw (dw gw) (dw bw)) p.1 0 out p.2.1 else fL n eps x g b r (r*n).toUSize n.toUSize p.1 out p.2.1) (eqge (qfs _ _ _ _ _ _ _ _ _ _ _ _ _) ho)) :=rfl theorem RLiE (rows n:Nat) (Ln:UInt64) (Ep rn:Float) (eps:Word) (x g b:ZB) (gd bd:FloatArray) (hn hx hg hb hgd hbd) (hgv:∀ j< n,gd.data[j]! =dw g[j]!) (hbv:∀ j< n,bd.data[j]! =dw b[j]!):∀ (k r:Nat) (hk:r+k=rows) (out:ZB) (ho), RLi rows n Ln Ep rn eps x g b hn hx hg hb k r hk out ho=RL rows n Ln Ep rn eps x g b gd bd hn hx hg hb hgd hbd k r hk out ho:=by intro k;induction k<;>intro r hk out ho ·rw [RLi_0,RL_0] rename_i k ih obtain ⟨h1,h2,h3,h4⟩:=uB (rkS hk).1 hn rw [RLi_s,RL_s];dsimp only refine (ih (r+1) _ _ _).trans (RLc _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ ?_) apply iteC;intro _;apply QEf;intro j hj have hj':=USize.lt_iff_toNat_lt.mp hj;rw [h3] at hj' rw [ugE,ugE,hgv _ hj',hbv _ hj',ugw g,ugw b] theorem mFq (a:ZB) (m:UInt32) (hs:a.size<2^32) (h:(emr a a.usize (USize.le_refl _) 0 m).toNat<255):m.toNat<255∧∀ q< a.size,expOf a[q]! ≠255:=by have hu:a.usize.toNat=a.size:=by rw [Array.usize,Dense.toUSize_toNat (by have:=USize.le_size;clear h;omega)] obtain ⟨h1,h2⟩:=emr_spec a a.usize (USize.le_refl _) _ 0 m rfl exact ⟨by clear*-h h1;(exact Nat.lt_of_le_of_lt h1 h),fun q hq he=>by have:=h2 q (by simp) (by rw [hu];exact hq);rw [he] at this;simp only [UInt32.reduceToNat] at this;clear*-h this;omega⟩ theorem mAl (a:ZB) (ha:∀ q< a.size,expOf a[q]! ≠255):a.all finiteWord=true:=by rw [Array.all_eq_true];intro i hi;have:=ha i hi;rw [getElem!_pos a i hi] at this;unfold finiteWord;simpa using this @[inline] def mDl (rows n:Nat) (eps:Word) (x g b:ZB):Bool:= rows>0&&n>0&&x.size==rows*n&&g.size==n&&b.size==n&&rows*n≤4294967294&&n≤1048576&& emr x x.usize (USize.le_refl _) 0 (emr g g.usize (USize.le_refl _) 0 (emr b b.usize (USize.le_refl _) 0 0))<255&& finiteWord eps&&(!ZX eps&&ZC eps !=0)&&rq n.toUInt64.toInt64.toFloat (1/n.toUInt64.toInt64.toFloat) theorem mDlE {rows n:Nat} {eps:Word} {x g b:ZB} (h:mDl rows n eps x g b=true):(dom rows n eps x g&&b.size==n&&b.all finiteWord)=true:=by simp only [mDl,Bool.and_eq_true,decide_eq_true_eq,beq_iff_eq] at h obtain ⟨⟨⟨⟨⟨⟨⟨⟨⟨⟨h1,h2⟩,h3⟩,h4⟩,h5⟩,h6⟩,h7⟩,h8⟩,h9⟩,h10⟩,h11⟩:=h have f1:=mFq x _ (by clear*-h3 h6;omega) (UInt32.lt_iff_toNat_lt.1 h8) have f2:=mFq g _ (by clear*-h4 h7;omega) f1.1 have f3:=mFq b _ (by clear*-h5 h7;omega) f2.1 simp only [dom,SN,Bool.and_eq_true,decide_eq_true_eq,beq_iff_eq,mAl x f1.2,mAl g f2.2,mAl b f3.2] exact ⟨⟨⟨⟨⟨⟨⟨⟨⟨⟨⟨⟨h1,h2⟩,h3⟩,h4⟩,trivial⟩,trivial⟩,h9⟩,h10⟩,h6⟩,h7⟩,h11⟩,h5⟩,trivial⟩ def layernormF (rows n:Nat) (eps:Word) (x g b:ZB):ZB:= if h:mDl rows n eps x g b then have l:=lnD (mDlE h);have d:=domE l.1;have z:=szD d.1 if rows<4 then RLi rows n (lw n) (dw eps*NR.pt 149) (1/n.toUInt64.toInt64.toFloat) eps x g b d.2.1 (by omega) (by omega) (by omega) rows 0 (Nat.zero_add rows) (Array.replicate (rows*n) 0) (by simp) else RL rows n (lw n) (dw eps*NR.pt 149) (1/n.toUInt64.toInt64.toFloat) eps x g b (fdec g) (fdec b) d.2.1 (by omega) (by omega) (by omega) (by rw [(fdecE g).1];omega) (by rw [(fdecE b).1];omega) rows 0 (Nat.zero_add rows) (Array.replicate (rows*n) 0) (by simp) else layernormSpec rows n eps x g b theorem layernormF_eq:layernormF=layernormSpec:=by funext rows n eps x g b unfold layernormF by_cases h:mDl rows n eps x g b=true ·rw [dif_pos h] have hc:=mDlE h rw [←layernormE_eq];unfold layernormE;rw [dif_pos hc] have l:=lnD hc;have d:=domE l.1;have z:=szD d.1 dsimp only by_cases h4:rows<4 ·rw [if_pos h4];exact RLiE _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ (fun j hj=>(fdecE g).2 j (by clear*-hj z;omega)) (fun j hj=>(fdecE b).2 j (by clear*-hj l;omega)) _ _ _ _ _ ·rw [if_neg h4] ·rw [dif_neg h] def RRi (rows n:Nat) (Ln:UInt64) (Ep rn:Float) (eps:Word) (x g:ZB) (hn:rows*n+1<2^32) (hx:rows*n≤ x.size) (hg:n≤ g.size) :(k r:Nat)→ r+k=rows→(out:ZB)→ rows*n≤ out.size→ZB | 0,_,_,out,_=>out | k+1,r,hk,out,ho=> have hr:=(rkS hk).1 have p:=rliA hr hn hx ho let e:=rR Ln (xD n x r eps false) Ep rn x (r*n).toUSize ((r*n).toUSize+n.toUSize) p.2.2.1 p.2.2.2.1 p.2.2.2.2 RRi rows n Ln Ep rn eps x g hn hx hg k (r+1) (rkS hk).2 (if e.ok then QE (r*n).toUSize n.toUSize (fun j hj=> have q:=rliB (b:=g) hr hn hx hg hg hj let gw:=g.uget j q.1 eR e (x.uget ((r*n).toUSize+j) q.2.2) gw (dw gw)) p.1 0 out p.2.1 else fR n eps x g r (r*n).toUSize n.toUSize p.1 out p.2.1) (eqge (qfsR _ _ _ _ _ _ _ _ _ _ _ _) ho) theorem RRi_0 (rows n:Nat) (Ln:UInt64) (Ep rn:Float) (eps:Word) (x g:ZB) (hn:rows*n+1<2^32) (hx:rows*n≤ x.size) (hg:n≤ g.size) (r:Nat) (hk:r+0=rows) (out:ZB) (ho:rows*n≤ out.size):RRi rows n Ln Ep rn eps x g hn hx hg 0 r hk out ho=out:=rfl theorem RRi_s (rows n:Nat) (Ln:UInt64) (Ep rn:Float) (eps:Word) (x g:ZB) (hn:rows*n+1<2^32) (hx:rows*n≤ x.size) (hg:n≤ g.size) (k r:Nat) (hk:r+(k+1)=rows) (out:ZB) (ho:rows*n≤ out.size):RRi rows n Ln Ep rn eps x g hn hx hg (k+1) r hk out ho= (have hr:=(rkS hk).1 have p:=rliA hr hn hx ho let e:=rR Ln (xD n x r eps false) Ep rn x (r*n).toUSize ((r*n).toUSize+n.toUSize) p.2.2.1 p.2.2.2.1 p.2.2.2.2 RRi rows n Ln Ep rn eps x g hn hx hg k (r+1) (rkS hk).2 (if e.ok then QE (r*n).toUSize n.toUSize (fun j hj=> have q:=rliB (b:=g) hr hn hx hg hg hj let gw:=g.uget j q.1 eR e (x.uget ((r*n).toUSize+j) q.2.2) gw (dw gw)) p.1 0 out p.2.1 else fR n eps x g r (r*n).toUSize n.toUSize p.1 out p.2.1) (eqge (qfsR _ _ _ _ _ _ _ _ _ _ _ _) ho)) :=rfl theorem RRc (rows n:Nat) (Ln:UInt64) (Ep rn:Float) (eps:Word) (x g:ZB) (gd:FloatArray) (hn hx hg hgd) (k r:Nat) (hk:r+k=rows) (a a':ZB) (ha ha') (h:a=a'): RR rows n Ln Ep rn eps x g gd hn hx hg hgd k r hk a ha=RR rows n Ln Ep rn eps x g gd hn hx hg hgd k r hk a' ha':=by subst h;rfl theorem RRiE (rows n:Nat) (Ln:UInt64) (Ep rn:Float) (eps:Word) (x g:ZB) (gd:FloatArray) (hn hx hg hgd) (hgv:∀ j< n,gd.data[j]! =dw g[j]!):∀ (k r:Nat) (hk:r+k=rows) (out:ZB) (ho), RRi rows n Ln Ep rn eps x g hn hx hg k r hk out ho=RR rows n Ln Ep rn eps x g gd hn hx hg hgd k r hk out ho:=by intro k;induction k<;>intro r hk out ho ·rw [RRi_0,RR_0] rename_i k ih obtain ⟨h1,h2,h3,h4⟩:=uB (rkS hk).1 hn rw [RRi_s,RR_s];dsimp only refine (ih (r+1) _ _ _).trans (RRc _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ ?_) apply iteC;intro _;apply QEf;intro j hj have hj':=USize.lt_iff_toNat_lt.mp hj;rw [h3] at hj' rw [ugE,hgv _ hj',ugw g] @[inline] def mDr (rows n:Nat) (eps:Word) (x g:ZB):Bool:= rows>0&&n>0&&x.size==rows*n&&g.size==n&&rows*n≤4294967294&&n≤1048576&& emr x x.usize (USize.le_refl _) 0 (emr g g.usize (USize.le_refl _) 0 0)<255&& finiteWord eps&&(!ZX eps&&ZC eps !=0)&&rq n.toUInt64.toInt64.toFloat (1/n.toUInt64.toInt64.toFloat) theorem mDrE {rows n:Nat} {eps:Word} {x g:ZB} (h:mDr rows n eps x g=true):dom rows n eps x g=true:=by simp only [mDr,Bool.and_eq_true,decide_eq_true_eq,beq_iff_eq] at h obtain ⟨⟨⟨⟨⟨⟨⟨⟨⟨h1,h2⟩,h3⟩,h4⟩,h6⟩,h7⟩,h8⟩,h9⟩,h10⟩,h11⟩:=h have f1:=mFq x _ (by clear*-h3 h6;omega) (UInt32.lt_iff_toNat_lt.1 h8) have f2:=mFq g _ (by clear*-h4 h7;omega) f1.1 simp only [dom,SN,Bool.and_eq_true,decide_eq_true_eq,beq_iff_eq,mAl x f1.2,mAl g f2.2] exact ⟨⟨⟨⟨⟨⟨⟨⟨⟨⟨h1,h2⟩,h3⟩,h4⟩,trivial⟩,trivial⟩,h9⟩,h10⟩,h6⟩,h7⟩,h11⟩ def rmsnormF (rows n:Nat) (eps:Word) (x g:ZB):ZB:= if h:mDr rows n eps x g then have d:=domE (mDrE h);have z:=szD d.1 if rows<4 then RRi rows n (lw n) (dw eps*NR.pt 149) (1/n.toUInt64.toInt64.toFloat) eps x g d.2.1 (by omega) (by omega) rows 0 (Nat.zero_add rows) (Array.replicate (rows*n) 0) (by simp) else let gd:=fdec g RR rows n (lw n) (dw eps*NR.pt 149) (1/n.toUInt64.toInt64.toFloat) eps x g gd d.2.1 (by omega) (by omega) (by rw [(fdecE g).1];omega) rows 0 (Nat.zero_add rows) (Array.replicate (rows*n) 0) (by simp) else rmsnormSpec rows n eps x g theorem rmsnormF_eq:rmsnormF=rmsnormSpec:=by funext rows n eps x g unfold rmsnormF by_cases h:mDr rows n eps x g=true ·rw [dif_pos h] have hc:=mDrE h rw [←rmsnormE_eq];unfold rmsnormE;rw [dif_pos hc] have d:=domE hc;have z:=szD d.1 dsimp only by_cases h4:rows<4 ·rw [if_pos h4];exact RRiE _ _ _ _ _ _ _ _ _ _ _ _ _ (fun j hj=>(fdecE g).2 j (by clear*-hj z;omega)) _ _ _ _ _ ·rw [if_neg h4] ·rw [dif_neg h] end Norm end namespace Br theorem x2dE : Dense.x2d = dotOf := funext fun n => funext fun fa => funext fun fb => Dense.x2d_eq n fa fb @[inline] def cs (s : ExactRuntime.ConvShape) : ConvShape := ⟨s.cin, s.h, s.w, s.cout, s.kh, s.kw, s.strideH, s.padT⟩ abbrev CG (s : ExactRuntime.ConvShape) : Prop := s.strideW = s.strideH ∧ s.padL = s.padT ∧ s.padB = s.padT ∧ s.padR = s.padT ∧ s.dilH = 1 ∧ s.dilW = 1 ∧ 0 < s.kh ∧ 0 < s.kw theorem shB (s : ExactRuntime.ConvShape) (h : CG s) : s.ho = (cs s).ho ∧ s.wo = (cs s).wo := by obtain ⟨h1, h2, h3, h4, h5, h6, h7, h8⟩ := h simp only [ExactRuntime.ConvShape.ho, ExactRuntime.ConvShape.wo, ExactRuntime.ConvShape.ekh, ExactRuntime.ConvShape.ekw, ConvShape.ho, ConvShape.wo, cs, h1, h2, h3, h4, h5, h6, Nat.one_mul] constructor <;> congr 2 <;> omega theorem winB (s : ExactRuntime.ConvShape) (inp : Array Word) (y x t : Nat) (h : CG s) : ExactRuntime.windowAt s inp 0 y x t = windowAt (cs s) inp y x t := by obtain ⟨h1, h2, -, -, h5, h6, -, -⟩ := h simp only [ExactRuntime.windowAt, windowAt, cs, Nat.zero_mul, Nat.zero_add, h1, h2, h5, h6, Nat.mul_one] rfl theorem convB (s : ExactRuntime.ConvShape) (relu : Bool) (inp wts b : Array Word) (h : CG s) (hg : s.groups = 1) : conv2dSpec (cs s) relu inp wts b = ExactRuntime.conv2dSpec s relu inp wts b := by obtain ⟨hHo, hWo⟩ := shB s h have hT : s.taps = s.cin * s.kh * s.kw := by simp [ExactRuntime.ConvShape.taps, ExactRuntime.ConvShape.cpg, hg] have hO : s.opg = s.cout := by simp [ExactRuntime.ConvShape.opg, hg] unfold conv2dSpec ExactRuntime.conv2dSpec conv2dWith ExactRuntime.conv2dWith apply Array.ext · simp only [Array.size_ofFn, hHo, hWo, cs] · intro q hq1 hq2 simp only [Array.size_ofFn] at hq2 have hq0 : q / (s.ho * s.wo) / s.cout = 0 := Nat.div_eq_of_lt (Nat.div_lt_of_lt_mul (by rw [Nat.mul_comm]; exact hq2)) simp only [Array.getElem_ofFn, hT, hO, hq0, winB s inp _ _ _ h] simp only [hHo, hWo, cs] rfl def conv2d (s : ExactRuntime.ConvShape) (relu : Bool) (inp wts b : Array Word) : Array Word := if CG s ∧ s.groups = 1 then Conv.conv2d (cs s) relu inp wts b else ExactRuntime.conv2dWith Dense.x2d s relu inp wts b theorem conv2d_eq : conv2d = ExactRuntime.conv2dSpec := by funext s relu inp wts b unfold conv2d split · rename_i h rw [Conv.conv2d_eq] exact convB s relu inp wts b h.1 h.2 · rw [x2dE]; rfl theorem dwI (o kh kw t : Nat) (hkh : 0 < kh) (hkw : 0 < kw) (ht : t < kh * kw) : (o * (kh * kw) + t) / (kh * kw) = o ∧ (o * (kh * kw) + t) / kw % kh = t / kw % kh ∧ (o * (kh * kw) + t) % kw = t % kw := by have hK : 0 < kh * kw := Nat.mul_pos hkh hkw refine ⟨?_, ?_, ?_⟩ · rw [Nat.add_comm, Nat.add_mul_div_right _ _ hK, Nat.div_eq_of_lt ht, Nat.zero_add] · rw [show o * (kh * kw) + t = t + (o * kh) * kw by ring, Nat.add_mul_div_right _ _ hkw, Nat.add_mul_mod_self_right] · rw [show o * (kh * kw) + t = t + (o * kh) * kw by ring, Nat.add_mul_mod_self_right] theorem dwW (s : ExactRuntime.ConvShape) (inp : Array Word) (o y x t : Nat) (h : CG s) (hc : 0 < s.cin) (ht : t < s.kh * s.kw) : ExactRuntime.windowAt s.depthwise inp o y x t = windowAt (cs s) inp y x (o * (s.kh * s.kw) + t) := by obtain ⟨h1, h2, -, -, h5, h6, h7, h8⟩ := h obtain ⟨a1, a2, a3⟩ := dwI o s.kh s.kw t h7 h8 ht simp only [ExactRuntime.windowAt, windowAt, cs, ExactRuntime.ConvShape.depthwise, ExactRuntime.ConvShape.cpg, Nat.div_self hc, Nat.mul_one, Nat.div_eq_of_lt ht, Nat.add_zero, h1, h2, h5, h6, a1, a2, a3] theorem dwB (s : ExactRuntime.ConvShape) (relu : Bool) (inp wts b : Array Word) (h : CG s) (hc : 0 < s.cin) : depthwiseSpec (cs s) relu inp wts b = ExactRuntime.depthwiseSpec s relu inp wts b := by have hd : CG s.depthwise := h have hHo : s.depthwise.ho = (cs s).ho := (shB s.depthwise hd).1 have hWo : s.depthwise.wo = (cs s).wo := (shB s.depthwise hd).2 have hC : s.depthwise.cout = s.cin := rfl have hT : s.depthwise.taps = s.kh * s.kw := by simp [ExactRuntime.ConvShape.depthwise, ExactRuntime.ConvShape.taps, ExactRuntime.ConvShape.cpg, Nat.div_self hc] have hO : s.depthwise.opg = 1 := by simp [ExactRuntime.ConvShape.depthwise, ExactRuntime.ConvShape.opg, Nat.div_self hc] unfold depthwiseSpec ExactRuntime.depthwiseSpec depthwiseWith ExactRuntime.depthwiseWith ExactRuntime.conv2dWith apply Array.ext · simp only [Array.size_ofFn, hHo, hWo, hC] rfl · intro q hq1 hq2 simp only [Array.getElem_ofFn, hT, hO, Nat.div_one, hHo, hWo] have hf : ∀ o y x, (fun t => if t < s.kh * s.kw then ExactRuntime.windowAt s.depthwise inp o y x t else oneW) = fun t => if t < s.kh * s.kw then windowAt (cs s) inp y x (o * (s.kh * s.kw) + t) else oneW := by intro o y x; funext t; by_cases ht : t < s.kh * s.kw · rw [if_pos ht, if_pos ht]; exact dwW s inp o y x t h hc ht · rw [if_neg ht, if_neg ht] rw [hf] rfl def depthwise (s : ExactRuntime.ConvShape) (relu : Bool) (inp wts b : Array Word) : Array Word := if CG s ∧ 0 < s.cin then Conv.depthwise (cs s) relu inp wts b else ExactRuntime.depthwiseWith Dense.x2d s relu inp wts b theorem depthwise_eq : depthwise = ExactRuntime.depthwiseSpec := by funext s relu inp wts b unfold depthwise split · rename_i h rw [Conv.depthwise_eq] exact dwB s relu inp wts b h.1 h.2 · rw [x2dE]; rfl abbrev PG (s : PoolShape) : Prop := s.kw = s.kh ∧ s.strideH = s.kh ∧ s.strideW = s.kh ∧ s.padT = 0 ∧ s.padL = 0 ∧ s.padB = 0 ∧ s.padR = 0 ∧ s.ceilMode = false ∧ s.countIncludePad = false ∧ 0 < s.kh ∧ s.kh ≤ s.h ∧ s.kh ≤ s.w theorem poB (n k : Nat) (hk : 0 < k) (hn : k ≤ n) : poolOut n 0 0 k k false = n / k := by simp only [poolOut, Nat.add_zero, Bool.false_eq_true, ite_false] exact (Nat.div_eq_sub_div hk hn).symm theorem pshB (s : PoolShape) (h : PG s) : s.ho = s.h / s.kh ∧ s.wo = s.w / s.kh := by obtain ⟨h1, h2, h3, h4, h5, h6, h7, h8, h9, h10, h11, h12⟩ := h simp only [PoolShape.ho, PoolShape.wo, h1, h2, h3, h4, h5, h6, h7, h8] exact ⟨poB _ _ h10 h11, poB _ _ h10 h12⟩ theorem pwinB (s : PoolShape) (h : PG s) (y x : Nat) (hy : y < s.h / s.kh) (hx : x < s.w / s.kh) : s.window y x = ⟨y * s.kh, x * s.kh, s.kh, s.kh⟩ := by obtain ⟨h1, h2, h3, h4, h5, h6, h7, h8, h9, h10, h11, h12⟩ := h have a1 : y * s.kh + s.kh ≤ s.h := by have := (Nat.le_div_iff_mul_le h10).1 hy; rwa [Nat.succ_mul] at this have a2 : x * s.kh + s.kh ≤ s.w := by have := (Nat.le_div_iff_mul_le h10).1 hx; rwa [Nat.succ_mul] at this simp only [PoolShape.window, poolSpan, h1, h2, h3, h4, h5, Nat.sub_zero, Nat.zero_add, Nat.min_eq_left a1, Nat.min_eq_left a2, Nat.add_sub_cancel_left] theorem pcB (s : PoolShape) (inp : Array Word) (ch y x : Nat) : poolCell s inp ch ⟨y * s.kh, x * s.kh, s.kh, s.kh⟩ = poolAt s.h s.w s.kh inp ch y x := by funext t; rfl theorem pdivB (s : PoolShape) (h : PG s) (y x : Nat) (hy : y < s.h / s.kh) (hx : x < s.w / s.kh) : s.divisor y x = s.kh * s.kh := by have hcp : s.countIncludePad = false := h.2.2.2.2.2.2.2.2.1 unfold PoolShape.divisor rw [if_neg (by rw [hcp]; exact Bool.false_ne_true), pwinB s h y x hy hx] theorem ofFnB {α : Type} {n m : Nat} (f : Fin n → α) (g : Fin m → α) (h : n = m) (hfg : ∀ (i : Nat) (h1 : i < n) (h2 : i < m), f ⟨i, h1⟩ = g ⟨i, h2⟩) : Array.ofFn f = Array.ofFn g := by subst h congr 1 funext i exact hfg i.val i.isLt i.isLt theorem apB (s : PoolShape) (inp : Array Word) (h : PG s) : avgpoolSpec s.c s.h s.w s.kh inp = ExactRuntime.avgpoolSpec s inp := by obtain ⟨hHo, hWo⟩ := pshB s h have hk : 0 < s.kh := h.2.2.2.2.2.2.2.2.2.1 have hH : 0 < s.h / s.kh := Nat.div_pos h.2.2.2.2.2.2.2.2.2.2.1 hk have hW : 0 < s.w / s.kh := Nat.div_pos h.2.2.2.2.2.2.2.2.2.2.2 hk unfold avgpoolSpec ExactRuntime.avgpoolSpec avgpoolWith ExactRuntime.avgpoolWith refine ofFnB _ _ (by rw [hHo, hWo]) (fun q h1 h2 => ?_) have hy := Nat.mod_lt (q / (s.w / s.kh)) hH have hx := Nat.mod_lt q hW dsimp only rw [hHo, hWo, pdivB s h _ _ hy hx, pwinB s h _ _ hy hx, pcB] theorem mpB (s : PoolShape) (inp : Array Word) (h : PG s) : maxpoolSpec s.c s.h s.w s.kh inp = ExactRuntime.maxpoolSpec s inp := by obtain ⟨hHo, hWo⟩ := pshB s h have hk : 0 < s.kh := h.2.2.2.2.2.2.2.2.2.1 have hH : 0 < s.h / s.kh := Nat.div_pos h.2.2.2.2.2.2.2.2.2.2.1 hk have hW : 0 < s.w / s.kh := Nat.div_pos h.2.2.2.2.2.2.2.2.2.2.2 hk unfold maxpoolSpec ExactRuntime.maxpoolSpec apply Array.ext · simp only [Array.size_ofFn, hHo, hWo] · intro q hq1 hq2 simp only [Array.getElem_ofFn, hHo, hWo, pwinB s h _ _ (Nat.mod_lt _ hH) (Nat.mod_lt _ hW), pcB] def apool (s : PoolShape) (inp : Array Word) : Array Word := if PG s then Conv.apool s.c s.h s.w s.kh inp else ExactRuntime.avgpoolWith Dense.x2d s inp theorem apool_eq : apool = ExactRuntime.avgpoolSpec := by funext s inp unfold apool split · rename_i h rw [Conv.apool_eq] exact apB s inp h · rw [x2dE]; rfl def mpool (s : PoolShape) (inp : Array Word) : Array Word := if PG s then Conv.mpool s.c s.h s.w s.kh inp else Pinned.maxpoolW s inp theorem mpool_eq : mpool = ExactRuntime.maxpoolSpec := by funext s inp unfold mpool split · rename_i h rw [Conv.mpool_eq] exact mpB s inp h · rw [Pinned.maxpoolW_eq] end Br /-- `softmaxWith` with the exponential as a parameter (the same definition). -/ @[specialize] def softmaxExp (dot : DotFn) (ex : Word → Word) (rows n : Nat) (x : Array Word) : Array Word := let mx := Array.ofFn (n := rows) fun r => rowMax n x r.val let e := Array.ofFn (n := rows * n) fun q => ex (toWord (Model.sub (ofW x[q.val]!) (ofW mx[q.val / n]!))) let s := Array.ofFn (n := rows) fun r => dot n (fun t => e[r.val * n + t]!) (fun _ => oneW) Array.ofFn (n := rows * n) fun q => toWord (Model.div (ofW e[q.val]!) (ofW s[q.val / n]!)) theorem softmaxExp_expW (dot : DotFn) : softmaxExp dot expW = softmaxWith dot := rfl /-- SiLU with the fast sigmoid. -/ def siluF (x : Array Word) : Array Word := x.map fun w => toWord (Model.mul (ofW w) (ofW (FastAct.sigmoidF w))) theorem siluF_eq : siluF = siluSpec := by funext x simp only [siluF, siluSpec, FastAct.sigmoidF_eq] namespace Rn /-! ## Recurrent kernels: gate rows through the dense kernel, weights interleaved once per process -/ theorem dotC (n : Nat) (fa fb ga gb : Nat → Word) (h : ∀ i, i < n → fa i = ga i ∧ fb i = gb i) : dotOf n fa fb = dotOf n ga gb := by unfold dotOf have h1 : (Array.ofFn (n := n) fun i => fa i.val) = Array.ofFn (n := n) fun i => ga i.val := by congr 1; funext i; exact (h i.val i.isLt).1 have h2 : (Array.ofFn (n := n) fun i => fb i.val) = Array.ofFn (n := n) fun i => gb i.val := by congr 1; funext i; exact (h i.val i.isLt).2 rw [h1, h2] /-- `Dense.x2d` with the pinned limb dot as the fallback: a wide exponent spread then costs about a microsecond, not the spec's exact rational path. -/ @[inline] def x2p (n : Nat) (fa fb : Nat → Word) : Word := let r := if n < 262144 then Dense.x2l fa fb n (Dense.x2m fa fb n 0 1023) 0 0 0 0 0 else 0x100000000 if r < 0x100000000 then r.toUInt32 else Pinned.dotFn n fa fb theorem x2p_eq (n : Nat) (fa fb : Nat → Word) : x2p n fa fb = dotOf n fa fb := by unfold x2p rw [Pinned.dotFn_eq_dotOf] have h := Dense.x2d_eq n fa fb unfold Dense.x2d at h rw [Dense.pdot_eq] at h exact h theorem x2pE : x2p = dotOf := by funext n fa fb; exact x2p_eq n fa fb /-- The activations the recurrent kernels use. A faster proved pair is swapped in here. -/ @[inline] def sigA (w : Word) : Word := FastAct2.sigmoidU w @[inline] def tanhA (w : Word) : Word := FastAct2.tanhU w theorem sigA_eq : sigA = sigmoidW := by funext w; exact congrFun FastAct2.sigmoidU_eq w theorem tanhA_eq : tanhA = tanhW := by funext w; exact congrFun FastAct2.tanhU_eq w /-- A one-pass exact dot: the caller supplies the window base `B`. Any `B` is sound; a base that does not fit the terms only costs the two-pass dot. -/ @[inline] def x1 (B : UInt64) (n : Nat) (fa fb : Nat → Word) : Word := let r := if n < 262144 then Dense.x2l fa fb n B 0 0 0 0 0 else 0x100000000 if r < 0x100000000 then r.toUInt32 else x2p n fa fb theorem x1_eq (B : UInt64) (n : Nat) (fa fb : Nat → Word) : x1 B n fa fb = dotOf n fa fb := by unfold x1; dsimp only rw [x2p_eq] by_cases hn : n < 262144 · rw [if_pos hn]; split · exact (Dense.x2l_spec fa fb n B (by omega) _ 0 0 0 0 0 rfl (Nat.zero_le _) (fun _ h => absurd h (by omega)) (by simp) (by simp) (by simp [Core.tsum]) ‹_›).symm · rfl · rw [if_neg hn, if_neg (by decide)] /-- `a · b` rounded once: the native binary32 product when both operands are finite. -/ @[inline] def mulW (a b : Word) : Word := if expOf a != 255 && expOf b != 255 then (Float32.ofBits a * Float32.ofBits b).toBits else toWord (Model.mul (ofW a) (ofW b)) theorem mulW_eq (a b : Word) : mulW a b = toWord (Model.mul (ofW a) (ofW b)) := by unfold mulW split · rename_i h simp only [Bool.and_eq_true, bne_iff_ne] at h have ha := Bn.NativeAdd.native_input a h.1 have hb := Bn.NativeAdd.native_input b h.2 have hn := ExecFloat.Binary.toModel_ofFloat32_mul_of_isFinite _ _ ha.2 hb.2 simp only [ExecFloat.Binary.toModel_ofFloat32, Bn.NativeAdd.bridge, ha.1, hb.1] at hn erw [← hn, ← Bn.NativeAdd.bridge, Bn.NativeAdd.nbits] · rfl /-- Window key of a word: its exponent index, or a sentinel above every index for a zero significand. -/ @[inline] def wk (w : Word) : UInt64 := if Core.mW w == 0 then 1023 else Core.iW w /-- Window key of a product. -/ @[inline] def wk2 (a b : Word) : UInt64 := if Core.mW a * Core.mW b == 0 then 1023 else Core.iW a + Core.iW b /-- Least window key of `a[o], …, a[o + n − 1]` and `acc`. -/ def kmin (a : Array Word) : Nat → Nat → UInt64 → UInt64 | _, 0, acc => acc | o, n + 1, acc => kmin a (o + 1) n (min acc (wk a[o]!)) /-- Per unit `u`, the least window key of row `2H + u` of `wih` (the candidate gate's input weights). Only a hint for `x1`: no property of it is used. -/ def nwG (wih : Array Word) (inW H : Nat) : Array Word := Array.ofFn (n := H) fun u => (kmin wih ((2 * H + u.val) * inW) inW 1023).toUInt32 def nwF (wih _d : Array Word) (m : Nat) : Array Word := nwG wih (m / 65536) (m % 65536) /-- `R` rows `[wih[k] | whh[k] | 0]` of length `inW + H + 1`. -/ def ihG (wih whh : Array Word) (inW H R : Nat) : Array Word := Array.ofFn (n := R * (inW + H + 1)) fun q => let k := q.val / (inW + H + 1) let j := q.val % (inW + H + 1) if j < inW then wih[k * inW + j]! else if j < inW + H then whh[k * H + (j - inW)]! else 0 /-- `ihG` keyed by one number: `m = (inW · 65536 + H) · 8 + g`, with `R = g · H` rows. -/ def ihF (wih whh : Array Word) (m : Nat) : Array Word := ihG wih whh (m / 8 / 65536) (m / 8 % 65536) (m % 8 * (m / 8 % 65536)) theorem ihF_enc (wih whh : Array Word) (inW H g : Nat) (hH : H < 65536) (hg : g < 8) : ihF wih whh ((inW * 65536 + H) * 8 + g) = ihG wih whh inW H (g * H) := by unfold ihF have h1 : ((inW * 65536 + H) * 8 + g) % 8 = g := by omega have h2 : ((inW * 65536 + H) * 8 + g) / 8 = inW * 65536 + H := by omega have h3 : (inW * 65536 + H) % 65536 = H := by omega have h4 : (inW * 65536 + H) / 65536 = inW := by omega rw [h1, h2, h3, h4] /-- Rows of length `n`: the last column replaced by `b`. -/ def bcG (Wp b : Array Word) (n : Nat) : Array Word := Array.ofFn (n := Wp.size) fun q => if q.val % n = n - 1 then b[q.val / n]! else Wp[q.val]! /-- The first `c` words of `b`. -/ def sl0 (b _d : Array Word) (c : Nat) : Array Word := Array.ofFn (n := c) fun k => b[k.val]! /-- The `c` words of `a` from position `2 · c`. -/ def slT (a _d : Array Word) (c : Nat) : Array Word := Array.ofFn (n := c) fun k => a[2 * c + k.val]! @[noinline] def TW : Sr.Tab ihF := Sr.Tab.make ihF 64 (2 ^ 22) @[noinline] def TC : Sr.Tab bcG := Sr.Tab.make bcG 64 (2 ^ 22) @[noinline] def T0 : Sr.Tab sl0 := Sr.Tab.make sl0 64 (2 ^ 22) @[noinline] def T2 : Sr.Tab slT := Sr.Tab.make slT 64 (2 ^ 22) @[noinline] def TN : Sr.Tab nwF := Sr.Tab.make nwF 64 (2 ^ 22) theorem wcAt (wih whh bih : Array Word) (inW H R k j : Nat) (hk : k < R) (hj : j < inW + H + 1) : (bcG (ihG wih whh inW H R) bih (inW + H + 1))[k * (inW + H + 1) + j]! = if j < inW then wih[k * inW + j]! else if j < inW + H then whh[k * H + (j - inW)]! else bih[k]! := by have hn : 0 < inW + H + 1 := Nat.succ_pos _ have hq : k * (inW + H + 1) + j < R * (inW + H + 1) := calc k * (inW + H + 1) + j < k * (inW + H + 1) + (inW + H + 1) := Nat.add_lt_add_left hj _ _ = (k + 1) * (inW + H + 1) := by rw [Nat.add_mul, Nat.one_mul] _ ≤ R * (inW + H + 1) := Nat.mul_le_mul_right _ hk have hm : (k * (inW + H + 1) + j) % (inW + H + 1) = j := by rw [Nat.add_comm, Nat.add_mul_mod_self_right, Nat.mod_eq_of_lt hj] have hd : (k * (inW + H + 1) + j) / (inW + H + 1) = k := by rw [Nat.add_comm, Nat.add_mul_div_right _ _ hn, Nat.div_eq_of_lt hj, Nat.zero_add] have hs : (ihG wih whh inW H R).size = R * (inW + H + 1) := by unfold ihG; rw [Array.size_ofFn] have e1 : (bcG (ihG wih whh inW H R) bih (inW + H + 1))[k * (inW + H + 1) + j]! = if (k * (inW + H + 1) + j) % (inW + H + 1) = inW + H + 1 - 1 then bih[(k * (inW + H + 1) + j) / (inW + H + 1)]! else (ihG wih whh inW H R)[k * (inW + H + 1) + j]! := FastAct.getElem!_ofFn' _ (hs ▸ hq) have e2 : (ihG wih whh inW H R)[k * (inW + H + 1) + j]! = if (k * (inW + H + 1) + j) % (inW + H + 1) < inW then wih[(k * (inW + H + 1) + j) / (inW + H + 1) * inW + (k * (inW + H + 1) + j) % (inW + H + 1)]! else if (k * (inW + H + 1) + j) % (inW + H + 1) < inW + H then whh[(k * (inW + H + 1) + j) / (inW + H + 1) * H + ((k * (inW + H + 1) + j) % (inW + H + 1) - inW)]! else 0 := FastAct.getElem!_ofFn' _ hq rw [e1, e2, hm, hd] by_cases h1 : j < inW · rw [if_neg (show ¬ j = inW + H + 1 - 1 by omega), if_pos h1, if_pos h1] · by_cases h2 : j < inW + H · rw [if_neg (show ¬ j = inW + H + 1 - 1 by omega), if_neg h1, if_pos h2, if_neg h1, if_pos h2] · rw [if_pos (show j = inW + H + 1 - 1 by omega), if_neg h1, if_neg h2] /-- `[x_t; h; 1]`. -/ @[inline] def xhOf (inW H : Nat) (x h : Array Word) (t : Nat) : Array Word := Array.ofFn (n := inW + H + 1) fun j => if j.val < inW then x[t * inW + j.val]! else if j.val < inW + H then h[j.val - inW]! else oneW /-- The first `R` gate rows of a step are one call of the dense kernel. -/ theorem gateL (x wih whh bih bhh h Wc b : Array Word) (inW H R t : Nat) (hW : ∀ k j, k < R → j < inW + H + 1 → Wc[k * (inW + H + 1) + j]! = if j < inW then wih[k * inW + j]! else if j < inW + H then whh[k * H + (j - inW)]! else bih[k]!) (hb : ∀ k, k < R → b[k]! = bhh[k]!) : Dense.F.Pn.linP 1 (inW + H + 1) R false (xhOf inW H x h t) Wc b = Array.ofFn (n := R) fun k => gateWith dotOf inW H x wih whh bih bhh h t k.val := by rw [Dense.F.Pn.linP_eq] unfold linearSpec linearWith refine Br.ofFnB _ _ (Nat.one_mul R) (fun q _ h2 => ?_) have hq0 : q / R = 0 := Nat.div_eq_of_lt h2 have hqm : q % R = q := Nat.mod_eq_of_lt h2 simp only [hq0, hqm, Nat.zero_mul, Nat.zero_add, act, Bool.false_eq_true, ↓reduceIte] unfold gateWith apply dotC intro i _ constructor · by_cases h1 : i < inW + H + 1 · have e : (xhOf inW H x h t)[i]! = if i < inW then x[t * inW + i]! else if i < inW + H then h[i - inW]! else oneW := FastAct.getElem!_ofFn' _ h1 rw [if_pos h1, e] · rw [if_neg h1, if_neg (show ¬ i < inW by omega), if_neg (show ¬ i < inW + H by omega)] · by_cases h1 : i < inW + H + 1 · rw [if_pos h1, hW q i h2 h1] by_cases h3 : i < inW · rw [if_pos h3, if_pos h3] · by_cases h4 : i < inW + H · rw [if_neg h3, if_pos h4, if_neg h3, if_pos h4] · rw [if_neg h3, if_neg h4, if_neg h3, if_neg h4, if_pos (show i = inW + H by omega)] · rw [if_neg h1, hb q h2, if_neg (show ¬ i < inW by omega), if_neg (show ¬ i < inW + H by omega), if_neg (show ¬ i = inW + H by omega)] /-- One LSTM step: gates by the dense kernel, each activation computed once. -/ @[inline] def lstmStep (sig tanh : Word → Word) (inW H : Nat) (x Wc b4 : Array Word) (t : Nat) (st : Array Word × Array Word) : Array Word × Array Word := let pre := Dense.F.Pn.linP 1 (inW + H + 1) (4 * H) false (xhOf inW H x st.1 t) Wc b4 let cell := Array.ofFn (n := H) fun u => let f := sig pre[H + u.val]! let i := sig pre[u.val]! let c := (st.2)[u.val]! let g := tanh pre[2 * H + u.val]! x2p 2 (fun j => if j = 0 then f else i) (fun j => if j = 0 then c else g) let hidden := Array.ofFn (n := H) fun u => mulW (sig pre[3 * H + u.val]!) (tanh (cell[u.val]!)) (hidden, cell) theorem lstmStep_eq (sig tanh : Word → Word) (inW H : Nat) (x wih whh bih bhh Wc b4 : Array Word) (hW : ∀ k j, k < 4 * H → j < inW + H + 1 → Wc[k * (inW + H + 1) + j]! = if j < inW then wih[k * inW + j]! else if j < inW + H then whh[k * H + (j - inW)]! else bih[k]!) (hb : ∀ k, k < 4 * H → b4[k]! = bhh[k]!) : lstmStep sig tanh inW H x Wc b4 = lstmStepWith dotOf sig tanh inW H x wih whh bih bhh := by funext t st unfold lstmStep lstmStepWith rw [gateL x wih whh bih bhh st.1 Wc b4 inW H (4 * H) t hW hb, x2pE] simp only [mulW_eq] theorem sl0At (b d : Array Word) (c k : Nat) (hk : k < c) : (sl0 b d c)[k]! = b[k]! := FastAct.getElem!_ofFn' _ hk theorem slTAt (a d : Array Word) (c k : Nat) (hk : k < c) : (slT a d c)[k]! = a[2 * c + k]! := FastAct.getElem!_ofFn' _ hk def lstmF (T inW H : Nat) (x wih whh bih bhh : Array Word) : Array Word := if H < 65536 then let Wc := (TC.get (TW.get wih whh ((inW * 65536 + H) * 8 + 4)).1 bih (inW + H + 1)).1 let b4 := (T0.get bhh #[] (4 * H)).1 recurWith T H (lstmStep sigA tanhA inW H x Wc b4) (Array.replicate H 0, Array.replicate H 0) else lstmWith Dense.x2d FastAct.sigmoidF FastAct.tanhF T inW H x wih whh bih bhh theorem lstmF_eq : lstmF = lstmSpec := by funext T inW H x wih whh bih bhh unfold lstmF lstmSpec lstmWith split · rename_i hH dsimp only rw [(TW.get wih whh _).2, (TC.get _ bih _).2, (T0.get bhh #[] _).2, ihF_enc wih whh inW H 4 hH (by decide), lstmStep_eq sigA tanhA inW H x wih whh bih bhh _ _ (fun k j hk hj => wcAt wih whh bih inW H (4 * H) k j hk hj) (fun k hk => sl0At bhh #[] (4 * H) k hk), sigA_eq, tanhA_eq] · rw [Br.x2dE, FastAct.sigmoidF_eq, FastAct.tanhF_eq] /-- `hn`: the candidate gate's hidden part, one call of the dense kernel on `h`. -/ theorem hnL (h whh bhh Whn bN : Array Word) (H : Nat) (hWn : ∀ u j, u < H → j < H → Whn[u * H + j]! = whh[(2 * H + u) * H + j]!) (hbn : ∀ u, u < H → bN[u]! = bhh[2 * H + u]!) : Dense.F.Pn.linP 1 H H false h Whn bN = Array.ofFn (n := H) fun u => dotOf (H + 1) (fun j => if j < H then h[j]! else oneW) (fun j => if j < H then whh[(2 * H + u.val) * H + j]! else bhh[2 * H + u.val]!) := by rw [Dense.F.Pn.linP_eq] unfold linearSpec linearWith refine Br.ofFnB _ _ (Nat.one_mul H) (fun q _ h2 => ?_) have hq0 : q / H = 0 := Nat.div_eq_of_lt h2 have hqm : q % H = q := Nat.mod_eq_of_lt h2 simp only [hq0, hqm, Nat.zero_mul, Nat.zero_add, act, Bool.false_eq_true, ↓reduceIte] apply dotC intro i _ constructor · rfl · by_cases h1 : i < H · rw [if_pos h1, if_pos h1, hWn q i h2 h1] · rw [if_neg h1, if_neg h1, hbn q h2] /-- One GRU step: `r`, `z` and `hn` by the dense kernel. -/ @[inline] def gruStep (sig tanh : Word → Word) (inW H : Nat) (x wih bih Wc bRZ Whn bN nw : Array Word) (t : Nat) (st : Array Word × Array Word) : Array Word × Array Word := let h := st.1 let bx := kmin x (t * inW) inW 1023 let prz := Dense.F.Pn.linP 1 (inW + H + 1) (2 * H) false (xhOf inW H x h t) Wc bRZ let r := Array.ofFn (n := H) fun u => sig prz[u.val]! let z := Array.ofFn (n := H) fun u => sig prz[H + u.val]! let hn := Dense.F.Pn.linP 1 H H false h Whn bN let n := Array.ofFn (n := H) fun u => tanh <| x1 (min (bx + (nw[u.val]!).toUInt64) (min (wk2 oneW bih[2 * H + u.val]!) (wk2 hn[u.val]! r[u.val]!))) (inW + 2) (fun j => if j < inW then x[t * inW + j]! else if j = inW then oneW else hn[u.val]!) (fun j => if j < inW then wih[(2 * H + u.val) * inW + j]! else if j = inW then bih[2 * H + u.val]! else r[u.val]!) let h' := Array.ofFn (n := H) fun u => x2p 3 (fun j => if j = 2 then h[u.val]! else n[u.val]!) (fun j => if j = 0 then oneW else if j = 1 then negW z[u.val]! else z[u.val]!) (h', st.2) theorem gruStep_eq (sig tanh : Word → Word) (inW H : Nat) (x wih whh bih bhh Wc bRZ Whn bN nw : Array Word) (hW : ∀ k j, k < 2 * H → j < inW + H + 1 → Wc[k * (inW + H + 1) + j]! = if j < inW then wih[k * inW + j]! else if j < inW + H then whh[k * H + (j - inW)]! else bih[k]!) (hb : ∀ k, k < 2 * H → bRZ[k]! = bhh[k]!) (hWn : ∀ u j, u < H → j < H → Whn[u * H + j]! = whh[(2 * H + u) * H + j]!) (hbn : ∀ u, u < H → bN[u]! = bhh[2 * H + u]!) : gruStep sig tanh inW H x wih bih Wc bRZ Whn bN nw = gruStepWith dotOf sig tanh inW H x wih whh bih bhh := by funext t st unfold gruStep gruStepWith have hr : (Array.ofFn (n := H) fun u => sig (Array.ofFn (n := 2 * H) fun k => gateWith dotOf inW H x wih whh bih bhh st.1 t k.val)[u.val]!) = Array.ofFn (n := H) fun u => sig (gateWith dotOf inW H x wih whh bih bhh st.1 t u.val) := by congr 1; funext u rw [FastAct.getElem!_ofFn' _ (show u.val < 2 * H by omega)] have hz : (Array.ofFn (n := H) fun u => sig (Array.ofFn (n := 2 * H) fun k => gateWith dotOf inW H x wih whh bih bhh st.1 t k.val)[H + u.val]!) = Array.ofFn (n := H) fun u => sig (gateWith dotOf inW H x wih whh bih bhh st.1 t (H + u.val)) := by congr 1; funext u rw [FastAct.getElem!_ofFn' _ (show H + u.val < 2 * H by omega)] dsimp only simp only [x1_eq] rw [gateL x wih whh bih bhh st.1 Wc bRZ inW H (2 * H) t hW hb, hnL st.1 whh bhh Whn bN H hWn hbn, x2pE, hr, hz] def gruF (T inW H : Nat) (x wih whh bih bhh : Array Word) : Array Word := if H < 65536 then let Wc := (TC.get (TW.get wih whh ((inW * 65536 + H) * 8 + 2)).1 bih (inW + H + 1)).1 let bRZ := (T0.get bhh #[] (2 * H)).1 let Whn := (T2.get whh #[] (H * H)).1 let bN := (T2.get bhh #[] H).1 let nw := (TN.get wih #[] (inW * 65536 + H)).1 recurWith T H (gruStep sigA tanhA inW H x wih bih Wc bRZ Whn bN nw) (Array.replicate H 0, #[]) else gruWith Dense.x2d FastAct.sigmoidF FastAct.tanhF T inW H x wih whh bih bhh theorem gruF_eq : gruF = gruSpec := by funext T inW H x wih whh bih bhh unfold gruF gruSpec gruWith split · rename_i hH dsimp only rw [(TW.get wih whh _).2, (TC.get _ bih _).2, (T0.get bhh #[] _).2, (T2.get whh #[] _).2, (T2.get bhh #[] _).2, ihF_enc wih whh inW H 2 hH (by decide), gruStep_eq sigA tanhA inW H x wih whh bih bhh _ _ _ _ _ (fun k j hk hj => wcAt wih whh bih inW H (2 * H) k j hk hj) (fun k hk => sl0At bhh #[] (2 * H) k hk) (fun u j hu hj => by rw [slTAt whh #[] (H * H) (u * H + j) (by calc u * H + j < u * H + H := Nat.add_lt_add_left hj _ _ = (u + 1) * H := by rw [Nat.add_mul, Nat.one_mul] _ ≤ H * H := Nat.mul_le_mul_right _ hu)] congr 1; ring) (fun u hu => slTAt bhh #[] H u hu), sigA_eq, tanhA_eq] · rw [Br.x2dE, FastAct.sigmoidF_eq, FastAct.tanhF_eq] end Rn def kernels : Kernels where core := ⟨sumSpec, dotSpec⟩ dense := ⟨Dense.F.Pn.linP, Dense.F.Pn.gemmP⟩ conv := ⟨Br.conv2d, Br.depthwise, convTransposeWith Dense.x2d⟩ elem := ⟨Br.apool, Br.mpool, Bn.addRelu, Bn.scaleShift⟩ norm := ⟨Norm.rmsnormF, Norm.layernormF⟩ attn := ⟨scoresWith Dense.x2d, mixWith Dense.x2d, softmaxExp Dense.x2d FastAct.expF, siluF⟩ rnn := ⟨Rn.lstmF, Rn.gruF⟩ theorem correct : Obligation kernels := by simp only [Obligation, kernels, specKernels, specCore, specDense, specConv, specElem, specNorm, specAttn, specRnn, Dense.F.Pn.linP_eq, Dense.F.Pn.gemmP_eq, Br.conv2d_eq, Br.depthwise_eq, Br.apool_eq, Br.mpool_eq, Bn.addRelu_eq, Bn.scaleShift_eq, Norm.rmsnormF_eq, Norm.layernormF_eq, Rn.lstmF_eq, Rn.gruF_eq, Br.x2dE, FastAct.sigmoidF_eq, FastAct.tanhF_eq, FastAct.expF_eq, softmaxExp_expW, siluF_eq, convTransposeSpec, scoresSpec, mixSpec, softmaxSpec, lstmSpec, gruSpec] end Submission