import ContractExact namespace Submission open ExactRuntime FloatLib.Floats.Formats.BinaryInterchange FloatLib.Floats structure Acc where pos:Array Nat neg:Array Nat special:Bool negZero:Bool def Acc.empty:Acc:=⟨Array.replicate 18 0,Array.replicate 18 0,false,true⟩ def Acc.total (acc:Acc):Int:=(limbVal acc.pos.toList:Int)-limbVal acc.neg.toList @[inline] def Acc.add (acc:Acc) (m idx:Nat) (neg:Bool):Acc := match acc with | ⟨pos,ng,sp,nz⟩ => if m=0 then ⟨pos,ng,sp,nz&&neg⟩ else if neg then ⟨pos,addLimbs64 ng m.toUInt64 idx,sp,false⟩ else ⟨addLimbs64 pos m.toUInt64 idx,ng,sp,false⟩ @[inline] def Acc.markSpecial (acc:Acc):Acc := match acc with | ⟨pos,ng,_,nz⟩=>⟨pos,ng,true,nz⟩ lemma Acc.add_spec (acc:Acc) (m idx:Nat) (neg:Bool) (hp:acc.pos.size=18) (hn:acc.neg.size=18) (hm:m < 2^64) (hi:idx/32+1 < 18) : (acc.add m idx neg).pos.size=18/\(acc.add m idx neg).neg.size=18 /\ (acc.add m idx neg).special=acc.special /\ (acc.add m idx neg).negZero=(acc.negZero&&(decide (m=0)&&neg)) /\ (acc.add m idx neg).total=acc.total+(if neg then -(m:Int) else m)*2^idx:=by obtain ⟨pos,ng,sp,nz⟩:=acc;simp only at hp hn;by_cases h0:m=0 . simp [Acc.add,Acc.total,h0,hp,hn] . cases neg . refine ⟨by simp [Acc.add,h0,addLimbs64_size,hp],by simp [Acc.add,h0,hn],by simp [Acc.add,h0],by simp [Acc.add,h0],?_⟩ simp only [Acc.add,h0,ite_false,Bool.false_eq_true,addLimbs64_eq _ _ _ hm,Acc.total];rw [addLimbs_val _ _ _ (by omega)];push_cast; ring . refine ⟨by simp [Acc.add,h0,hp],by simp [Acc.add,h0,addLimbs64_size,hn],by simp [Acc.add,h0],by simp [Acc.add,h0],?_⟩ simp only [Acc.add,h0,ite_false,ite_true,addLimbs64_eq _ _ _ hm,Acc.total];rw [addLimbs_val _ _ _ (by omega)];push_cast; ring lemma Acc.total_empty:Acc.empty.total=0:=by decide section open FloatLib.Numerics lemma ZbF (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 h7:m≠0:=by rintro rfl; simp at h have h9:2^m.log2 <= m:=Nat.log2_self_le h7 have hm:2^(j+1) <= m:=le_trans (Nat.pow_le_pow_right (by norm_num) (by omega)) h9 have h0:(shiftRightJam m j).log2=m.log2-j:=log2_shiftRightJam m j hm have hc:shiftRightJam m j≠0 := shiftRightJam_ne_zero m j (le_trans (Nat.pow_le_pow_right (by norm_num) (by omega)) hm) rw [<- Model.roundDyadicGeneral_eq_roundDyadic, <- Model.roundDyadicGeneral_eq_roundDyadic] unfold Model.roundDyadicGeneral simp only [beq_iff_eq,ite_false,h0] have hd:((m.log2-j:Nat):Int)+(e+j)=(m.log2:Int)+e:=by omega have h8:Fmt.fracWidth=23:=rfl have h6:Fmt.minSubnormalExponent = -149:=rfl have h5:Fmt.minNormalExponent = -126:=rfl rw [h8,h6,h5] 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 omega⟩ have hb:e+j - -149=Int.negSucc (a-j):=by omega rw [ha,hb] dsimp only rw [show a-j+1=(a+1)-j by omega] exact roundShiftRightEven_shiftRightJam m j (a+1) (by omega) . congr 1;rw [show m.log2-j-23=(m.log2-23)-j by omega];exact roundShiftRightEven_shiftRightJam m j _ (by omega) def Yg (a:Array Nat) (i:Nat):Nat -> Nat | 0=>0 | k+1=>a[i]! + 2^32*Yg a (i+1) k lemma Zv (a:Array Nat) (i k m:Nat) : Yg a i (k+m)=Yg a i k+2^(32*k)*Yg a (i+k) m:=by induction k generalizing i with | zero=>simp [Yg] | succ k ih => rw [show k+1+m=(k+m)+1 by omega,Yg,Yg,ih,show i+1+k=i+(k+1) by omega];ring lemma ZbG (a b:Array Nat) (i j k:Nat) (h : ∀ t,t < k -> a[i+t]! = b[j+t]!) : Yg a i k=Yg b j k:=by induction k generalizing i j with | zero=>rfl | succ k ih => rw [Yg,Yg,ih (i+1) (j+1) (λ t ht=>by rw [show i+1+t=i+(t+1) by omega,show j+1+t=j+(t+1) by omega];exact h (t+1) (by omega)),show a[i]! = b[j]! from by simpa using h 0 (by omega)] lemma Zw (a:Array Nat) (i k:Nat) : Yg a i k=0 ↔ ∀ t,t < k -> a[i+t]! = 0:=by induction k generalizing i with | zero=>simp [Yg] | succ k ih => rw [Yg,Nat.add_eq_zero_iff,Nat.mul_eq_zero,ih (i+1)] have hp:(2:ℕ)^32≠0:=by simp constructor . rintro ⟨h0,h1 | h1⟩ t ht . exact absurd h1 hp . rcases t with _ | t . simpa using h0 . rw [show i+(t+1)=i+1+t by omega]; exact h1 t (by omega) . intro h refine ⟨by simpa using h 0 (by omega),Or.inr λ t ht => ?_⟩ rw [show i+1+t=i+(t+1) by omega]; exact h (t+1) (by omega) lemma ZbH (a:Array Nat) (i k:Nat) (h : ∀ t,t < k -> a[i+t]! < 2^32) : Yg a i k < 2^(32*k):=by induction k generalizing i with | zero=>simp [Yg] | succ k ih => have h0:=h 0 (by omega);have h1:=ih (i+1) (λ t ht=>by rw [show i+1+t=i+(t+1) by omega]; exact h (t+1) (by omega)) simp at h0;rw [Yg,show 32*(k+1)=32+32*k by ring,pow_add];nlinarith lemma Zav (a:Array Nat) (t:Nat) (h:a.size <= t):a[t]! = 0:=by simp_all lemma ZbI (a:Array Nat) (i k:Nat) (h:a.size <= i+k) : Yg a i k=limbVal (a.toList.drop i):=by induction k generalizing i with | zero=>simp [Yg,List.drop_of_length_le (by simpa using h:a.toList.length <= i),limbVal] | succ k ih => rw [Yg,ih (i+1) (by omega)];by_cases hi:i < a.size . have hl:i < a.toList.length:=by omega simp only [List.drop_eq_getElem_cons hl,limbVal,getElem!_pos a i hi,Array.getElem_toList] . rw [Zav a i (by omega),List.drop_of_length_le (by simp; omega),List.drop_of_length_le (by simp; omega)] simp [limbVal] lemma ZbJ (a:Array Nat) (lo n:Nat) (h0 : ∀ t,t < lo -> a[t]! = 0) (h1 : ∀ t,lo+n <= t -> a[t]! = 0) : limbVal a.toList=2^(32*lo)*Yg a lo n:=by rw [<- List.drop_zero (l:=a.toList), <- ZbI a 0 (lo+(n+a.size)) (by omega),Zv,Zv] rw [(Zw a 0 lo).2 (λ t ht=>by simpa using h0 t ht),(Zw a (0+lo+n) a.size).2 (λ t _=>h1 _ (by omega))] simp def YP (a b:Array Nat) (i ca cb br:Nat) (out:Array Nat) : Nat -> Array Nat × Nat × Nat × Nat | 0=>(out,ca,cb,br) | k+1 => let ta:=a[i]! + ca let tb:=b[i]! + cb let t:=ta%4294967296+4294967296-tb%4294967296-br YP a b (i+1) (ta/4294967296) (tb/4294967296) (1-t/4294967296) (out.push (t%4294967296)) k lemma Zaw (a b:Array Nat) (i ca cb br:Nat) (out:Array Nat) (k:Nat) (ha:br <= 1) (h0 : ∀ t,t < out.size -> out[t]! < 2^32) : let r:=YP a b i ca cb br out k r.1.size=out.size+k/\(∀ t,t < r.1.size -> r.1[t]! < 2^32) /\ (Yg r.1 0 r.1.size:Int)+2^(32*(out.size+k))*(r.2.1-r.2.2.1-r.2.2.2:Int) = Yg out 0 out.size+2^(32*out.size) * ((Yg a i k:Int)-Yg b i k+ca-cb-br):=by induction k generalizing i ca cb br out with | zero=>exact ⟨by simp [YP],by simpa [YP] using h0,by simp [YP,Yg]⟩ | succ k ih => simp only [YP] set ta:=a[i]! + ca set tb:=b[i]! + cb set t:=ta%4294967296+4294967296-tb%4294967296-br have h9:tb%4294967296 < 4294967296:=Nat.mod_lt _ (by norm_num) have h7:ta%4294967296 < 4294967296:=Nat.mod_lt _ (by norm_num) have h8:t < 2*4294967296:=by omega have hq:t/4294967296 <= 1:=by omega have hd:t%4294967296 < 2^32:=by omega have h5 : ∀ s,s < (out.push (t%4294967296)).size -> (out.push (t%4294967296))[s]! < 2^32:=by intro s hs simp only [Array.size_push] at hs rcases Nat.lt_or_eq_of_le (Nat.lt_succ_iff.mp hs) with hs | rfl . rw [getElem!_pos _ s (by simp; omega),Array.getElem_push_lt hs, <- getElem!_pos out s hs];exact h0 s hs . rw [getElem!_pos _ _ (by simp),Array.getElem_push_eq]; exact hd obtain ⟨h1,h2,h3⟩:=ih (i+1) (ta/4294967296) (tb/4294967296) (1-t/4294967296) (out.push (t%4294967296)) (by omega) h5 refine ⟨by simp [h1]; omega,h2,?_⟩;have h4:Yg (out.push (t%4294967296)) 0 (out.size+1) = Yg out 0 out.size+2^(32*out.size)*(t%4294967296):=by rw [Zv,ZbG _ out 0 0 out.size (λ s hs=>by rw [getElem!_pos _ _ (by simp; omega),Array.getElem_push_lt (by omega),<- getElem!_pos out _ (by omega)])] simp only [Yg,Nat.zero_add,Nat.mul_zero,Nat.add_zero];rw [getElem!_pos _ _ (by simp),Array.getElem_push_eq] simp only [Array.size_push] at h3 ⊢;rw [show out.size+(k+1)=out.size+1+k by omega];rw [h3,h4,Yg,Yg];have h6:((t%4294967296:Nat):Int)+4294967296*((ta/4294967296:Nat)-(tb/4294967296:Nat)-(1-t/4294967296:Nat)) = (a[i]! : Int)-b[i]! + ca-cb-br:=by have e1:=Nat.mod_add_div ta 4294967296 have e2:=Nat.mod_add_div tb 4294967296 have e3:=Nat.mod_add_div t 4294967296 have e4:(1-t/4294967296:Nat)=1-(t/4294967296:Int):=by omega have e5:(t:Int)=ta%4294967296+4294967296-tb%4294967296-br:=by omega push_cast [e4] omega rw [show 32*(out.size+1)=32*out.size+32 by ring,pow_add];simp only [Nat.cast_add,Nat.cast_mul,Nat.cast_pow,Nat.cast_ofNat];linear_combination (2:Int)^(32*out.size)*h6 def YW (r:Array Nat):Nat -> Option Nat | 0=>none | k+1=>if r[k]! != 0 then some k else YW r k def YX (r:Array Nat):Nat -> Bool | 0=>false | k+1=>r[k]! != 0||YX r k lemma ZbK (r:Array Nat) (k:Nat) (h:YW r k=none) : ∀ t,t < k -> r[t]! = 0:=by induction k with | zero=>intro t ht; omega | succ k ih => simp only [YW] at h;split at h . cases h . rename_i hk;intro t ht;rcases Nat.lt_or_eq_of_le (Nat.lt_succ_iff.mp ht) with ht | rfl . exact ih h t ht . simpa using hk lemma Zax (r:Array Nat) (k h:Nat) (hh:YW r k=some h) : h < k/\r[h]! ≠ 0 /\ ∀ t,h < t -> t < k -> r[t]! = 0:=by induction k with | zero=>simp [YW] at hh | succ k ih => simp only [YW] at hh;split at hh . rename_i hk;cases hh;exact ⟨by omega,by simpa using hk,λ t h1 h2=>by omega⟩ . rename_i hk;obtain ⟨a,b,c⟩:=ih hh;refine ⟨by omega,b,λ t h1 h2 => ?_⟩;rcases Nat.lt_or_eq_of_le (Nat.lt_succ_iff.mp h2) with h2 | rfl . exact c t h1 h2 . simpa using hk lemma Zay (r:Array Nat) (k:Nat):YX r k=false ↔ ∀ t,t < k -> r[t]! = 0:=by induction k with | zero=>simp [YX] | succ k ih => simp only [YX,Bool.or_eq_false_iff,bne_eq_false_iff_eq,ih];constructor . rintro ⟨h0,h1⟩ t ht;rcases Nat.lt_or_eq_of_le (Nat.lt_succ_iff.mp ht) with ht | rfl . exact h1 t ht . exact h0 . intro h; exact ⟨h k (by omega),λ t ht=>h t (by omega)⟩ lemma ZbL (r:Array Nat) (k:Nat):YX r k=(Yg r 0 k != 0):=by have hz:=Zw r 0 k;simp at hz;cases h:YX r k . rw [hz.2 ((Zay r k).1 h)]; rfl . have:Yg r 0 k≠0:=λ h0=>by have:=(Zay r k).2 (hz.1 h0); simp_all simp [this] lemma ZbM (low x y h:Nat) (h6:low < 2^(32*h)) : shiftRightJam (low+2^(32*h)*(x+2^32*y)) (32*h+2) = if x%4 != 0||low != 0 then (y*1073741824+x/4)|||1 else y*1073741824+x/4:=by have h5:2^(32*h+2)=4*2^(32*h):=by grind have hs:x%4 < 4:=Nat.mod_lt x (by norm_num) have hA:low+2^(32*h)*(x%4) < 4*2^(32*h):=by nlinarith have h3:low+2^(32*h)*(x+2^32*y) = (low+2^(32*h)*(x%4))+4*2^(32*h)*(y*1073741824+x/4):=by have h4:=Nat.mod_add_div x 4 rw [show (2:Nat)^32=4*1073741824 by norm_num] conv_lhs=>rw [<- h4] ring have hz:low+2^(32*h)*(x%4)=0 ↔ ¬(x%4≠0\/low≠0):=by constructor . intro h0;have h1:=Nat.eq_zero_of_add_eq_zero h0;rcases Nat.mul_eq_zero.mp h1.2 with h2 | h2 <;> omega . intro h0; simp at h0; simp [h0.1,h0.2] unfold shiftRightJam;dsimp only;rw [h5,h3,Nat.add_mul_div_left _ _ (by omega),Nat.div_eq_of_lt hA,Nat.zero_add,Nat.add_mul_mod_self_left,Nat.mod_eq_of_lt hA] by_cases hc:x%4≠0\/low≠0 . have:¬ (low+2^(32*h)*(x%4)=0):=λ h0=>hz.mp h0 hc have hb:(x%4 != 0||low != 0)=true:=by grind simp only [beq_iff_eq,this,ite_false,hb,ite_true] . have:low+2^(32*h)*(x%4)=0:=hz.mpr hc have hb:(x%4 != 0||low != 0)=false:=by grind simp only [beq_iff_eq,this,ite_true,hb] rfl def Yas (neg:Bool) (r:Array Nat) (e:Int) (negZero:Bool):UInt32 := match YW r r.size with | none=>finishWord 0 e negZero | some 0=>finishWord (if neg then -(r[0]! : Int) else r[0]!) e negZero | some (h+1) => let x:=r[h]! let v:=r[h+1]! * 1073741824+x/4 let m:=if x%4 != 0||YX r h then v|||1 else v toWord (Model.roundDyadic Fmt ⟨neg,m,e+((32*h+2:Nat):Int)⟩) lemma ZbN (neg:Bool) (R:Nat) (e:Int) (negZero:Bool) (hR:R≠0) : finishWord (if neg then -(R:Int) else R) e negZero=toWord (Model.roundDyadic Fmt ⟨neg,R,e⟩):=by have h0:(0:Int) < R:=by omega cases neg <;> simp [finishWord,ofIntDyadic,hR,not_lt.mpr h0.le,Nat.pos_of_ne_zero hR] lemma Zaz (neg:Bool) (r:Array Nat) (e:Int) (negZero:Bool) (hr : ∀ t,t < r.size -> r[t]! < 2^32) : Yas neg r e negZero = finishWord (if neg then -(Yg r 0 r.size:Int) else Yg r 0 r.size) e negZero:=by unfold Yas;split . rename_i h7;rw [(Zw r 0 r.size).2 (λ t ht=>by simpa using ZbK r _ h7 t ht)];simp . rename_i h0;obtain ⟨h1,h2,h3⟩:=Zax r _ 0 h0;rw [show r.size=1+(r.size-1) by omega,Zv,(Zw r (0+1) (r.size-1)).2 (λ t ht=>h3 _ (by omega) (by omega))] simp [Yg] . rename_i h h0;obtain ⟨h1,h2,h3⟩:=Zax r _ (h+1) h0;have hR:Yg r 0 r.size=Yg r 0 h+2^(32*h)*(r[h]! + 2^32*r[h+1]!):=by rw [show r.size=h+(2+(r.size-h-2)) by omega,Zv,Zv,(Zw r (0+h+2) _).2 (λ t ht=>h3 _ (by omega) (by omega))] simp [Yg] have h5:Yg r 0 h < 2^(32*h):=ZbH r 0 h (λ t ht=>hr _ (by omega));have h4:Yg r 0 r.size≠0:=by rw [hR]; have:0 < 2^(32*h)*(r[h]! + 2^32*r[h+1]!):=by have:=Nat.pos_of_ne_zero h2; positivity omega have h6:32*h+2+25 <= (Yg r 0 r.size).log2:=by rw [Nat.le_log2 h4,hR];have:1 <= r[h+1]! := Nat.pos_of_ne_zero h2 calc 2^(32*h+2+25) <= 2^(32*h)*2^32:=by rw [<- pow_add]; exact Nat.pow_le_pow_right (by norm_num) (by omega) _ <= 2^(32*h)*(r[h]! + 2^32*r[h+1]!):=by gcongr; nlinarith _ <= _:=by omega rw [ZbN neg _ e negZero h4, <- ZbF neg _ e _ h6,hR,ZbM _ _ _ h h5,ZbL] def Yab (pos neg:Array Nat):Nat -> Nat | 0=>0 | k+1=>if pos[k]! != 0||neg[k]! != 0 then k+1 else Yab pos neg k lemma ZbO (pos neg:Array Nat) (k:Nat) : ∀ t,Yab pos neg k <= t -> t < k -> pos[t]! = 0/\neg[t]! = 0:=by induction k with | zero=>intro t _ ht; omega | succ k ih => intro t h1 h2;simp only [Yab] at h1;split at h1 . omega . rename_i hk;rcases Nat.lt_or_eq_of_le (Nat.lt_succ_iff.mp h2) with h2 | rfl . exact ih t h1 h2 . simpa [Bool.or_eq_true,bne_iff_ne,not_or] using hk def YaL (pos neg:Array Nat) (e:Int) (negZero:Bool):UInt32 := let lo:=lowLimb pos neg pos.size 0 let n:=Yab pos neg (max pos.size neg.size)+1-lo let e':=e+((32*lo:Nat):Int) let d:=YP pos neg lo 0 0 0 (Array.emptyWithCapacity n) n if d.2.1=0/\d.2.2.1=0/\d.2.2.2=0 then Yas false d.1 e' negZero else let d':=YP neg pos lo 0 0 0 (Array.emptyWithCapacity n) n if d'.2.1=0/\d'.2.2.1=0/\d'.2.2.2=0 then Yas true d'.1 e' negZero else finishLimbs pos neg e negZero lemma ZaA (pos neg:Array Nat) (e:Int) (negZero:Bool) : YaL pos neg e negZero = finishWord ((limbVal pos.toList:Int)-limbVal neg.toList) e negZero:=by unfold YaL;dsimp only;set lo:=lowLimb pos neg pos.size 0;set n:=Yab pos neg (max pos.size neg.size)+1-lo;have h3:=lowLimb_zero pos neg pos.size 0;have h4:=ZbO pos neg (max pos.size neg.size);have h5 (a:Array Nat) (ha:a=pos\/a=neg) : limbVal a.toList=2^(32*lo)*Yg a lo n:=by apply ZbJ a lo n . intro t ht; rcases ha with rfl | rfl . exact (h3 t (by omega) ht).1 . exact (h3 t (by omega) ht).2 . intro t ht;by_cases h6:t < max pos.size neg.size . rcases ha with rfl | rfl . exact (h4 t (by omega) h6).1 . exact (h4 t (by omega) h6).2 . rcases ha with rfl | rfl <;> exact Zav _ t (by omega) have hP:=h5 pos (Or.inl rfl);have hN:=h5 neg (Or.inr rfl);rw [show (Array.emptyWithCapacity n:Array Nat) = #[] from rfl];have hd:=Zaw pos neg lo 0 0 0 #[] n (by omega) (by simp);have h7:=Zaw neg pos lo 0 0 0 #[] n (by omega) (by simp);have h9:Yg (#[]:Array Nat) 0 0=0:=rfl;simp only [List.size_toArray,List.length_nil,Nat.mul_zero,pow_zero,one_mul,h9,Nat.cast_zero,zero_add] at hd h7 obtain ⟨-, hb,hv⟩:=hd;obtain ⟨-, h8,h0⟩:=h7;split_ifs with h1 h2 . rw [Zaz false _ _ _ hb,finishWord_scale,hP,hN];simp;congr 1;rw [h1.1,h1.2.1,h1.2.2] at hv;push_cast at hv ⊢;linear_combination (2:Int)^(32*lo)*hv . rw [Zaz true _ _ _ h8,finishWord_scale,hP,hN];simp;congr 1;rw [h2.1,h2.2.1,h2.2.2] at h0;push_cast at h0 ⊢;linear_combination (-(2:Int)^(32*lo))*h0 . exact finishLimbs_eq pos neg e negZero end @[inline] def Yy (acc:Acc) (wa wb:UInt32):Acc := if expOf wa=255\/expOf wb=255 then acc.markSpecial else acc.add (mantOf wa*mantOf wb) (idxOf wa+idxOf wb) (Bool.xor (signOf wa) (signOf wb)) @[specialize] def Yw (fa fb:Nat -> UInt32) (pos neg:Array Nat) (sp nz:Bool) (index:Nat):Nat -> Acc | 0=>⟨pos,neg,sp,nz⟩ | count+1 => match Yy ⟨pos,neg,sp,nz⟩ (fa index) (fb index) with | ⟨p,n,s,z⟩=>Yw fa fb p n s z (index+1) count @[inline] def Yn (n:Nat) (fa fb:Nat -> UInt32):UInt32 := let acc:=Yw fa fb (Array.replicate 18 0) (Array.replicate 18 0) false true 0 n if acc.special then dotSpec (Array.ofFn (n:=n) λ i=>fa i) (Array.ofFn (n:=n) λ i=>fb i) else YaL acc.pos acc.neg (-298) (n≠0&&acc.negZero) lemma Zn (wa wb:UInt32) : (if Bool.xor (signOf wa) (signOf wb) then -((mantOf wa*mantOf wb:Nat):Int) else ((mantOf wa*mantOf wb:Nat):Int))=sv wa*sv wb:=by unfold sv; cases signOf wa <;> cases signOf wb <;> simp lemma ZbP (fa fb:Nat -> UInt32) (pos neg:Array Nat) (nz:Bool) (index count:Nat):(Yw fa fb pos neg true nz index count).special=true:=by induction count generalizing pos neg nz index with | zero=>rfl | succ count ih => rw [Yw];have hs:(Yy ⟨pos,neg,true,nz⟩ (fa index) (fb index)).special=true:=by unfold Yy Acc.markSpecial Acc.add; split_ifs <;> rfl generalize Yy ⟨pos,neg,true,nz⟩ (fa index) (fb index)=r at hs ⊢;obtain ⟨p,q,s,z⟩:=r;simp only at hs; subst hs;exact ih .. lemma ZaB (fa fb:Nat -> UInt32) (A B:Array UInt32) (n:Nat) (hA : ∀ k,k < n -> A[k]! = fa k) (hB : ∀ k,k < n -> B[k]! = fb k) (acc:Acc) (index remaining:Nat) (h:index+remaining <= n) (hp:acc.pos.size=18) (hn:acc.neg.size=18) (h0:(Yw fa fb acc.pos acc.neg acc.special acc.negZero index remaining).special = false) : acc.special=false /\ (∀ k,index <= k -> k < index+remaining -> expOf A[k]! ≠ 255/\expOf B[k]! ≠ 255) /\ (Yw fa fb acc.pos acc.neg acc.special acc.negZero index remaining).total = acc.total+dsum A B index remaining /\ (Yw fa fb acc.pos acc.neg acc.special acc.negZero index remaining).negZero = (acc.negZero&&dallNZ A B index remaining):=by induction remaining generalizing acc index with | zero=>obtain ⟨p,n,s,z⟩:=acc; simp_all [Yw,dsum,dallNZ] | succ count ih => obtain ⟨p,q,s,z⟩:=acc;simp only at hp hn;have ha:=hA index (by omega);have hb:=hB index (by omega);by_cases he:expOf (fa index)=255\/expOf (fb index)=255 . exfalso;rw [Yw] at h0;have hs:(Yy ⟨p,q,s,z⟩ (fa index) (fb index)).special=true:=by simp [Yy,he,Acc.markSpecial] generalize Yy ⟨p,q,s,z⟩ (fa index) (fb index)=r at hs h0;obtain ⟨p',q',s',z'⟩:=r;simp only at hs; subst hs;rw [ZbP] at h0;exact Bool.noConfusion h0 . have h6:=not_or.mp he obtain ⟨h1,h2,h3,h4,h5⟩ := Acc.add_spec ⟨p,q,s,z⟩ (mantOf (fa index)*mantOf (fb index)) (idxOf (fa index)+idxOf (fb index)) (Bool.xor (signOf (fa index)) (signOf (fb index))) hp hn (mul_mant_lt _ _) (by have:=idxOf_le _ h6.1; have:=idxOf_le _ h6.2; omega) have h7:Yy ⟨p,q,s,z⟩ (fa index) (fb index) = Acc.add ⟨p,q,s,z⟩ (mantOf (fa index)*mantOf (fb index)) (idxOf (fa index)+idxOf (fb index)) (Bool.xor (signOf (fa index)) (signOf (fb index))):=by simp [Yy,he] rw [Yw,h7] at h0 ⊢;obtain ⟨hs,h8,hD,hz⟩:=ih _ (index+1) (by omega) h1 h2 h0;refine ⟨by rw [<- h3,hs],?_,?_,?_⟩ . intro k k1 k2;rcases Nat.lt_or_ge k (index+1) with hk | hk . have:k=index:=by omega subst this; rw [ha,hb]; exact h6 . exact h8 k hk (by omega) . rw [hD,h5,dsum,ha,hb,Zn]; ring . rw [hz,h4,dallNZ,ha,hb]; simp [Bool.and_assoc] lemma Ze (n:Nat) (f:Nat -> UInt32) (k:Nat) (hk:k < n) : (Array.ofFn (n:=n) λ i=>f i.val)[k]! = f k:=by simp_all lemma Z5 (n:Nat) (fa fb:Nat -> UInt32) : Yn n fa fb = dotSpec (Array.ofFn (n:=n) λ i=>fa i) (Array.ofFn (n:=n) λ i=>fb i):=by unfold Yn;set A:=Array.ofFn (n:=n) λ i=>fa i with hA;set B:=Array.ofFn (n:=n) λ i=>fb i with hB;set acc:=Yw fa fb (Array.replicate 18 0) (Array.replicate 18 0) false true 0 n with hj;by_cases hh:acc.special=true . simp [hh] . have h9:acc.special=false:=by grind obtain ⟨-, h3,hD,hz⟩:=ZaB fa fb A B n (Ze n fa) (Ze n fb) Acc.empty 0 n (by omega) (by simp [Acc.empty]) (by simp [Acc.empty]) h9 have hD:acc.total=dsum A B 0 n:=by have:=hD; simp only [Acc.total_empty,Int.zero_add] at this; exact this have hz:acc.negZero=dallNZ A B 0 n:=by have:=hz; simp only [Acc.empty,Bool.true_and] at this; exact this simp only [h9,Bool.false_eq_true,ite_false];rw [ZaA,show ((limbVal acc.pos.toList:Int)-limbVal acc.neg.toList)=acc.total from rfl] have hc:A.size=n:=by simp [hA] have ha:B.size=n:=by simp [hB] set L:=A.map (Model.ofUInt32 (fmt:=Fmt)) with hL set R:=B.map (Model.ofUInt32 (fmt:=Fmt)) with hR have h0:L.size=R.size:=by grind have hd:L.size=n:=by grind have h5 : ∀ k (hk:k < L.size),Model.isFinite L[k]=true:=by intro k hk have h6:k < A.size:=by omega have:=(h3 k (by omega) (by omega)).1 rw [getElem!_pos A k h6] at this simp [hL,isFinite_ofUInt32,this] have h8 : ∀ k (hk:k < R.size),Model.isFinite R[k]=true:=by intro k hk have h6:k < B.size:=by omega have:=(h3 k (by omega) (by omega)).2 rw [getElem!_pos B k h6] at this simp [hR,isFinite_ofUInt32,this] have h7:Model.Reduction.Semantics.finiteDotSlice L R 0 L.size (by simp) (by simp [h0])=(acc.total:ℚ)*2^(-298:ℤ):=by have:=finiteDotSlice_eq A B 0 L.size (by simp [hL]) (by simp [hL,hc,ha]) (by intro k k1 k2; exact h3 k k1 (by omega)) exact this.trans (by rw [hd,hD]) have hb:=Model.Reduction.Internal.dotState_exact_toRat (destination:=Fmt) L R h0 h5 h8 unfold dotSpec Model.dot;by_cases h4:acc.total=0 . have hf:(Model.Reduction.Internal.dotState L R h0 : Model.Reduction.Internal.State Fmt).exact.significand=0:=by rw [<- FloatLib.Numerics.Dyadic.toRat_eq_zero_iff,hb,h7,h4]; simp rw [Model.Reduction.dotWithStatus_eq_zero_of_finite Fmt L R .nearestEven h0 h5 h8 hf,h4,finishWord_zero] unfold Model.Reduction.Internal.dotState;obtain ⟨h1,h2⟩:=dotStateLoop_flags A B {} 0 L.size (by simp [hL]) (by simp [hL,hc,ha]) (by intro k k1 k2; exact h3 k k1 (by omega)) have hg:(Model.Reduction.Internal.dotStateLoop L R ({} : Model.Reduction.Internal.State Fmt) 0 L.size (by simp) (by simp [h0])).sawFiniteTerm=decide (L.size≠0):=by rw [show decide (L.size≠0)=(false||decide (L.size≠0)) by simp]; exact h1 have he:(Model.Reduction.Internal.dotStateLoop L R ({} : Model.Reduction.Internal.State Fmt) 0 L.size (by simp) (by simp [h0])).allTermsNegativeZero=dallNZ A B 0 L.size:=by rw [show dallNZ A B 0 L.size=(true&&dallNZ A B 0 L.size) by simp]; exact h2 simp only [Except.map,hg,he];rw [hz];simp [hd] . have hi:Model.Reduction.Semantics.finiteDot L.toList R.toList ≠ .ok 0:=by rw [Model.Reduction.Semantics.finiteDot_toList_eq_slice L R h0];intro h;injection h with h;rw [h7] at h;simp at h; exact h4 h rw [Model.Reduction.dotWithStatus_eq_round_of_finite_nonzero Fmt L R .nearestEven h0 h5 h8 hi] simp;exact finishWord_of_ne _ _ _ _ h4 (by rw [hb,h7]) lemma Z6 (a:Array UInt32) (n:Nat) (h:n=a.size) : (Array.ofFn (n:=n) λ i=>a[i.val]!)=a:=by subst h;apply Array.ext (by simp);intro i h1 h2;rw [Array.getElem_ofFn,getElem!_pos a i h2] lemma ZbQ (n:Nat) (c:UInt32) : (Array.ofFn (n:=n) λ _=>c)=Array.replicate n c:=by apply Array.ext (by simp);simp def YaM (a b:Array UInt32):UInt32 := if a.size=b.size then Yn a.size (λ i=>a[i]!) (λ i=>b[i]!) else dotSpec a b def YaN (x:Array UInt32):UInt32:=Yn x.size (λ i=>x[i]!) (λ _=>oneW) lemma ZbR (a b:Array UInt32):YaM a b=dotSpec a b:=by unfold YaM;split . rename_i h;rw [Z5,Z6 a _ rfl,Z6 b _ h] . rfl lemma ZbS (x:Array UInt32):YaN x=sumSpec x:=by rw [YaN,Z5,Z6 x _ rfl,ZbQ,sumSpec] lemma Zi:Yn=dotOf := funext λ n=>funext λ fa=>funext λ fb=>Z5 n fa fb lemma ZaC (w:Word):toWord (ofW w)=w:=by apply UInt32.toNat_inj.mp;simp only [toWord,ofW,Model.toNatBits,ofUInt32_bits];exact Nat.mod_eq_of_lt w.toBitVec.isLt lemma ZaD (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 @[inline] def Yz (w:Word):Int := if signOf w then -((mantOf w<< simp [Nat.shiftLeft_eq] lemma Zx (w:Word) : (decodeD w).toReal=(Yz w:ℝ)*2^(-149:Int):=by rw [<- FloatLib.Numerics.Dyadic.cast_toRat,decodeD_toRat,ZbT];push_cast;rw [zpow_sub₀ two_ne_zero,zpow_natCast];ring lemma ZH (w:UInt32):(expOf w).toNat=w.toNat/2^23%256:=by simp only [expOf,UInt32.toNat_and,UInt32.toNat_shiftRight,Nat.shiftRight_eq_div_pow];exact Nat.and_two_pow_sub_one_eq_mod _ 8 lemma ZR (w:UInt32):(fracOf w).toNat=w.toNat%2^23:=by exact Nat.and_two_pow_sub_one_eq_mod _ 23 @[inline] def Yac (w:Word):Int:=let m:Int:=(w.toNat%2147483648:Nat);if signOf w then -m else m def mg (n:Nat):Nat:=if n/2^23%256=0 then n%2^23 else (2^23+n%2^23)*2^(n/2^23%256-1) lemma mxs (w:Word):mantOf w<< simp lemma ZS (a b:Nat) (h:a%2^31 nlinarith [Nat.one_le_two_pow (n:=A-1)] lemma ZbU (a b:Word):compare (Yac a) (Yac b)=compare (Yz a) (Yz b):=by have e:∀ a b:Nat,a%2^31=b%2^31 -> mg a=mg b:=λ a b h=>by unfold mg;rw [show a/2^23%256=b/2^23%256 by omega,show a%2^23=b%2^23 by omega] have:=ZS a.toNat b.toNat;have:=ZS b.toNat a.toNat;have:=e a.toNat b.toNat;have:=ZS 0 a.toNat;have:=ZS 0 b.toNat;have:=e a.toNat 0;have:=e b.toNat 0;have:mg 0=0:=rfl unfold Yac Yz;rw [mxs,mxs];simp only [compare,compareOfLessAndEq];split_ifs <;> first|rfl|omega lemma ZbV (a:Word) (ha:expOf a≠255):ofW a=(if Model.isZero (ofW a)&&Model.isZero (ofW a) then Model.zero Fmt (Model.signBit (ofW a)&&Model.signBit (ofW a)) else ofW a):=by simp only [Bool.and_self];split . rename_i hz;obtain ⟨h1,h2⟩:=(Model.isZero_iff_fields_of_isFinite (by simp [ofW,isFinite_ofUInt32,ha])).1 hz conv_lhs => rw [<- Model.ofFields_signBit_expField_fracField (ofW a),h1,h2] cases Model.signBit (ofW a) <;> decide . rfl @[inline] def YQ (a b:Word):Word := if expOf a=255\/expOf b=255 then toWord (Model.maximum (ofW a) (ofW b)) else match compare (Yac a) (Yac b) with | .lt=>b | .gt=>a | .eq=>if a=b then a else toWord (if Model.isZero (ofW a)&&Model.isZero (ofW b) then Model.zero Fmt (Model.signBit (ofW a)&&Model.signBit (ofW b)) else ofW a) lemma ZbW (a b:Word) : Model.cmpDyadic (decodeD a) (decodeD b)=compare (Yz a) (Yz b):=by have hs:(0:ℝ) < 2^(-149:Int):=zpow_pos two_pos _;cases h:compare (Yz a) (Yz b) . rw [Model.cmpDyadic_lt_iff,Zx,Zx];exact mul_lt_mul_of_pos_right (by exact_mod_cast compare_lt_iff_lt.mp h) hs . rw [Model.cmpDyadic_eq_iff,Zx,Zx,compare_eq_iff_eq.mp h] . rw [Model.cmpDyadic_gt_iff,Zx,Zx];exact mul_lt_mul_of_pos_right (by exact_mod_cast compare_gt_iff_gt.mp h) hs lemma ZbX (a b:Word):ofW (YQ a b)=Model.maximum (ofW a) (ofW b):=by unfold YQ;split . exact ZaD _ . rename_i hs;rw [ZbU];have ha:=toDyadic_ofUInt32 a (λ h=>hs (Or.inl h));have hb:=toDyadic_ofUInt32 b (λ h=>hs (Or.inr h));have h0:=Model.isNaN_eq_false_of_toDyadic?_some ha;have h1:=Model.isNaN_eq_false_of_toDyadic?_some hb;have hc:Model.compare (ofW a) (ofW b)=some _ := Model.compare_eq_some_cmpDyadic_of_toDyadic? _ _ ha hb rw [ZbW] at hc;have h2:Model.chooseNaN2 (ofW a) (ofW b)=none := (Model.chooseNaN2_eq_none_iff _ _).2 ⟨h0,h1⟩ unfold Model.maximum;rw [Model.withNaNSelection_of_none _ _ h2];dsimp only;rw [Model.compareNonNaN_eq_of_compare_eq_some _ _ _ _ hc];cases compare (Yz a) (Yz b) <;> simp only [ZaD,apply_ite ofW];by_cases h:a=b . subst h; rw [if_pos rfl]; exact ZbV a (λ h=>hs (Or.inl h)) . rw [if_neg h] def Yad (c h w k:Nat) (inp:Array Word):Array Word := Array.ofFn (n:=c*(h/k*(w/k))) λ q => let ch:=q.val/(h/k*(w/k)) let y:=q.val/(w/k)%(h/k) let x:=q.val%(w/k) (List.range (k*k)).foldl (λ acc t=>YQ acc (poolAt h w k inp ch y x t)) (poolAt h w k inp ch y x 0) lemma ZbY (p:Nat -> Word) (l:List Nat) (acc:Word) : l.foldl (λ m t=>Model.maximum m (ofW (p t))) (ofW acc) = ofW (l.foldl (λ a t=>YQ a (p t)) acc):=by induction l generalizing acc with | nil=>rfl | cons t l ih=>simp only [List.foldl_cons, <- ZbX,ih] lemma ZaF:Yad=maxpoolSpec:=by funext c h w k inp;simp only [Yad,maxpoolSpec,ZbY,ZaC] def kernels0:Kernels where core:=⟨YaN,YaM⟩ dense:=⟨linearWith Yn,gemmWith Yn⟩ conv:=⟨conv2dWith Yn,depthwiseWith Yn⟩ elem:=⟨avgpoolWith Yn,Yad,addReluSpec,scaleShiftSpec⟩ norm:=⟨rmsnormWith Yn,layernormWith Yn⟩ lemma ZbZ:Obligation kernels0:=by simp only [Obligation,kernels0,specKernels,specCore,specDense,specConv,specElem,specNorm,linearSpec,gemmSpec,conv2dSpec,depthwiseSpec,avgpoolSpec,rmsnormSpec,layernormSpec, ZaF,Zi,funext ZbS,funext λ a=>funext (ZbR a)] def Yo (fa fb:Nat -> UInt32) (i:Nat):Nat -> Int | 0=>0 | r+1=>sv (fa i)*sv (fb i)*2^(idxOf (fa i)+idxOf (fb i))+Yo fa fb (i+1) r def Yq (fa fb:Nat -> UInt32) (i:Nat):Nat -> Bool | 0=>true | r+1=>(decide (mantOf (fa i)*mantOf (fb i)=0)&&Bool.xor (signOf (fa i)) (signOf (fb i))) && Yq fa fb (i+1) r lemma Zb0 (n:Nat) (fa fb:Nat -> UInt32) (i r:Nat) (h:i+r <= n) : dsum (Array.ofFn (n:=n) λ k=>fa k.val) (Array.ofFn (n:=n) λ k=>fb k.val) i r = Yo fa fb i r:=by induction r generalizing i with | zero=>rfl | succ r ih => rw [dsum,Yo,Ze n fa i (by omega),Ze n fb i (by omega),ih (i+1) (by omega)] lemma Zb1 (n:Nat) (fa fb:Nat -> UInt32) (i r:Nat) (h:i+r <= n) : dallNZ (Array.ofFn (n:=n) λ k=>fa k.val) (Array.ofFn (n:=n) λ k=>fb k.val) i r = Yq fa fb i r:=by induction r generalizing i with | zero=>rfl | succ r ih => rw [dallNZ,Yq,Ze n fa i (by omega),Ze n fb i (by omega),ih (i+1) (by omega)] lemma Zb2 (fa fb:Nat -> UInt32) (pos neg:Array Nat) (nz:Bool) (index remaining:Nat) (h0 : ∀ k,index <= k -> k < index+remaining -> expOf (fa k)≠255/\expOf (fb k)≠255) : (Yw fa fb pos neg false nz index remaining).special=false:=by induction remaining generalizing pos neg nz index with | zero=>rfl | succ count ih => rw [Yw];have hf:=h0 index le_rfl (by omega);have hs:(Yy ⟨pos,neg,false,nz⟩ (fa index) (fb index)).special=false:=by have hc:¬(expOf (fa index)=255\/expOf (fb index)=255):=by rintro (h | h) . exact hf.1 h . exact hf.2 h unfold Yy;unfold Acc.add;split_ifs <;> rfl generalize Yy ⟨pos,neg,false,nz⟩ (fa index) (fb index)=r at hs ⊢;obtain ⟨p,q,s,z⟩:=r;simp only at hs;subst hs;exact ih _ _ _ _ (λ k h1 h2=>h0 k (by omega) (by omega)) lemma Zy (n:Nat) (fa fb:Nat -> UInt32) (h1 : ∀ k,k < n -> expOf (fa k)≠255/\expOf (fb k)≠255) : dotOf n fa fb=finishWord (Yo fa fb 0 n) (-298) (decide (n≠0)&&Yq fa fb 0 n):=by rw [<- Zi];unfold Yn;set A:=Array.ofFn (n:=n) λ i=>fa i.val with hA;set B:=Array.ofFn (n:=n) λ i=>fb i.val with hB;set acc:=Yw fa fb (Array.replicate 18 0) (Array.replicate 18 0) false true 0 n with h5;have h0:acc.special=false := Zb2 fa fb _ _ true 0 n (λ k _ h2=>h1 k (by omega)) obtain ⟨-, -, hD,hz⟩:=ZaB fa fb A B n (Ze n fa) (Ze n fb) Acc.empty 0 n (by omega) (by simp [Acc.empty]) (by simp [Acc.empty]) h0 have h4:acc.total=Yo fa fb 0 n:=by have:=hD;simp only [Acc.total_empty,Int.zero_add] at this;rw [<- Zb0 n fa fb 0 n (by omega)];exact this have h3:acc.negZero=Yq fa fb 0 n:=by have:=hz;simp only [Acc.empty] at this;rw [<- Zb1 n fa fb 0 n (by omega)];exact this simp only [h0,Bool.false_eq_true,ite_false];rw [ZaA,show ((limbVal acc.pos.toList:Int)-limbVal acc.neg.toList)=acc.total from rfl,h4,h3] def YC (w2 w1 w0:UInt64):Int := ((w2.toNat*2^128+w1.toNat*2^64+w0.toNat:Nat):Int) - (if w2.toNat < 2^63 then 0 else 2^192) def Ym (w:UInt64):Int:=(w.toNat:Int)-(if w.toNat < 2^63 then 0 else 2^64) lemma Zb3 (s:Bool) (E F:Nat) (hE:E < 256) (hF:F < 2^23) : (Model.ofFields Fmt s E F).toNatBits=(if s then 2^31 else 0)+E*2^23+F:=by rw [Model.ofFields_eq_ofFieldsImpl] simp only [Model.ofFieldsImpl,Model.mkBitsImpl,Model.ofBits,Model.toNatBits,BitVec.toNat_ofNatLT] have h1:E&&&Fmt.expAllOnesNat=E:=Nat.and_two_pow_sub_one_of_lt_two_pow (n:=8) hE have h2:F&&&Fmt.fracMaskNat=F:=Nat.and_two_pow_sub_one_of_lt_two_pow (n:=23) hF rw [h1,h2,show E.shiftLeft Fmt.fracWidth=E<<<23 from rfl,Nat.or_assoc, <- Nat.shiftLeft_add_eq_or_of_lt hF] have hb:E<<<23+F < 2^31:=by omega cases s . simp [Nat.shiftLeft_eq] . simp only [ite_true] rw [show Nat.shiftLeft 1 (Fmt.expWidth+Fmt.fracWidth)=1<<<31 from rfl, <- Nat.shiftLeft_add_eq_or_of_lt hb] simp; omega @[inline] def Yv (neg:Bool) (E F:UInt32):UInt32:=(if neg then (0x80000000:UInt32) else 0)+(E<<<23)+F lemma ZT (neg:Bool) (E F:UInt32) (hE:E.toNat < 256) (hF:F.toNat < 2^23) : Yv neg E F=toWord (Model.ofFields Fmt neg E.toNat F.toNat):=by unfold toWord; rw [Zb3 neg _ _ hE hF];apply UInt32.toNat_inj.mp;unfold Yv;cases neg <;> simp <;> omega lemma ZaG (neg:Bool):Yv neg 255 0=toWord (Model.nativeOverflow Fmt neg):=by rw [Model.nativeOverflow_eq_signedInf_of_isIEEE Fmt (by decide)]; cases neg <;> decide lemma Zb4 (neg:Bool):Yv neg 0 0=toWord (Model.zero Fmt neg):=by cases neg <;> decide @[inline] def YH (x r d:UInt64):UInt64:=if x>>>(r+d) != 0 then r+d else r @[inline] def Yj (x:UInt64):UInt64 := YH x (YH x (YH x (YH x (YH x (YH x 0 32) 16) 8) 4) 2) 1 lemma Zz (x r d:UInt64) (D:Nat) (hD:d.toNat=D) (hd:1 <= D) (hr:r.toNat+2*D <= 64) (h1:2^r.toNat <= x.toNat) (h2:x.toNat < 2^(r.toNat+2*D)) : (YH x r d).toNat+D <= 64/\2^(YH x r d).toNat <= x.toNat /\ x.toNat < 2^((YH x r d).toNat+D):=by subst hD have h3:(r+d).toNat=r.toNat+d.toNat:=by rw [UInt64.toNat_add]; omega have hs:(x>>>(r+d)).toNat=x.toNat/2^(r.toNat+d.toNat):=by rw [UInt64.toNat_shiftRight,h3,Nat.mod_eq_of_lt (by omega),Nat.shiftRight_eq_div_pow] unfold YH;by_cases hc:x>>>(r+d) != 0 . simp only [hc,ite_true,h3];have:x.toNat/2^(r.toNat+d.toNat)≠0:=by intro h; apply (bne_iff_ne.mp hc); apply UInt64.toNat_inj.mp; rw [hs,h]; rfl refine ⟨by omega,?_,by rw [show r.toNat+d.toNat+d.toNat=r.toNat+2*d.toNat by omega]; exact h2⟩;exact (Nat.le_div_iff_mul_le (Nat.two_pow_pos _)).mp (Nat.one_le_iff_ne_zero.mpr this) |>.trans' (by simp) . simp only [hc,ite_false,Bool.false_eq_true] have h0:x>>>(r+d)=0:=by grind have:x.toNat/2^(r.toNat+d.toNat)=0:=by rw [<- hs,h0]; rfl refine ⟨by omega,h1,?_⟩ exact (Nat.div_eq_zero_iff_lt (Nat.two_pow_pos _)).mp this lemma Zj (x:UInt64) (hx:x≠0):(Yj x).toNat=x.toNat.log2:=by have h0:1 <= x.toNat:=Nat.one_le_iff_ne_zero.mpr λ h=>hx (UInt64.toNat_inj.mp (by simpa using h));have h1:=x.toNat_lt;obtain ⟨a1,b1,c1⟩:=Zz x 0 32 32 rfl (by decide) (by decide) (by simpa using h0) (by simpa using h1);obtain ⟨a2,b2,c2⟩:=Zz x _ 16 16 rfl (by decide) (by omega) b1 (by simpa using c1);obtain ⟨a3,b3,c3⟩:=Zz x _ 8 8 rfl (by decide) (by omega) b2 (by simpa using c2);obtain ⟨a4,b4,c4⟩:=Zz x _ 4 4 rfl (by decide) (by omega) b3 (by simpa using c3);obtain ⟨a5,b5,c5⟩:=Zz x _ 2 2 rfl (by decide) (by omega) b4 (by simpa using c4);obtain ⟨a6,b6,c6⟩:=Zz x _ 1 1 rfl (by decide) (by omega) b5 (by simpa using c5);exact ((Nat.log2_eq_iff (by omega)).mpr ⟨b6,c6⟩).symm @[inline] def Ybm (m:UInt64) (e:Int):UInt64 := match e+149 with | .ofNat k=>m<<FloatLib.Numerics.FixedWord.roundShiftRightEven m (k+1) @[inline] def YaO (neg:Bool) (m:UInt64) (e:Int):UInt32 := let fr:=Ybm m e if fr==0 then Yv neg 0 0 else if (0x800000:UInt64) <= fr then Yv neg 1 0 else Yv neg 0 fr.toUInt32 lemma Zb5 (neg:Bool) (m:UInt64) (e:Int) (hm:m.toNat≠0) (h:(m.toNat.log2:Int)+e < -126) : YaO neg m e=toWord (Model.packRoundedSubnormal Fmt neg (Model.zero Fmt neg) (match e-Fmt.minSubnormalExponent with | Int.ofNat shift=>m.toNat<<FloatLib.Numerics.roundShiftRightEven m.toNat (shift+1))):=by have h2:m.toNat < 2^(m.toNat.log2+1):=Nat.lt_log2_self;rw [show e-Fmt.minSubnormalExponent=e+149 by rw [show Fmt.minSubnormalExponent = -149 from rfl]; omega];unfold YaO Ybm;generalize hs:e+149=s;suffices H : ∀ (fr:UInt64) (F:Nat),fr.toNat=F -> F <= 2^23 -> (if fr==0 then Yv neg 0 0 else if (0x800000:UInt64) <= fr then Yv neg 1 0 else Yv neg 0 fr.toUInt32) = toWord (Model.packRoundedSubnormal Fmt neg (Model.zero Fmt neg) F) by cases s with | ofNat k => have hk:(k:Int)=e+149:=by grind have hb:m.toNat*2^k < 2^23:=by calc m.toNat*2^k < 2^(m.toNat.log2+1)*2^k:=Nat.mul_lt_mul_of_pos_right h2 (Nat.two_pow_pos k) _=2^(m.toNat.log2+1+k):=by rw [<- Nat.pow_add] _ <= 2^23:=Nat.pow_le_pow_right (by norm_num) (by omega) apply H _ (m.toNat<< have hk:Int.negSucc k=e+149:=by rw [hs] apply H _ _ (FloatLib.Numerics.FixedWord.roundShiftRightEven_toNat m (k+1)) have hq:m.toNat/2^(k+1) < 2^23:=by rw [Nat.div_lt_iff_lt_mul (Nat.two_pow_pos _)] calc m.toNat < 2^(m.toNat.log2+1):=h2 _ <= 2^(23+(k+1)):=Nat.pow_le_pow_right (by norm_num) (by rw [Int.negSucc_eq] at hk; omega) _=2^23*2^(k+1):=by rw [Nat.pow_add] have:=FloatLib.Numerics.roundShiftRightEven_le_succ m.toNat (k+1);omega intro fr F hF h5;subst hF;unfold Model.packRoundedSubnormal;by_cases h0:fr=0 . subst h0; simp only [show ((0:UInt64)==0)=true from rfl];exact Zb4 neg have h4:(fr.toNat==0)=false:=by simpa using λ h=>h0 (UInt64.toNat_inj.mp (by simpa using h)) simp only [show (fr==0)=false by simpa using h0,h4,Bool.false_eq_true,ite_false];by_cases h1:fr.toNat >= 2^23 . have:(0x800000:UInt64) <= fr:=by rw [UInt64.le_iff_toNat_le]; simpa using h1 simp only [this,ite_true,show fr.toNat >= Model.pow2 Fmt.fracWidth from h1] exact ZT neg 1 0 (by decide) (by decide) . have:¬ (0x800000:UInt64) <= fr:=by rw [UInt64.le_iff_toNat_le]; simpa using h1 simp only [this,ite_false,show ¬ fr.toNat >= Model.pow2 Fmt.fracWidth from h1] have hc:fr.toUInt32.toNat=fr.toNat:=by rw [UInt64.toNat_toUInt32]; omega rw [ZT neg 0 _ (by decide) (by rw [hc]; omega),hc]; rfl @[inline] def YK (m L:UInt64):UInt64 := if 23 <= L then FloatLib.Numerics.FixedWord.roundShiftRightEven m (L-23).toNat else m<<<(23-L) @[inline] def Yae (neg:Bool) (m L:UInt64) (t:Int):UInt32 := let rm:=YK m L if rm==0x1000000 then (if t+1 > 127 then Yv neg 255 0 else Yv neg (t+128).toNat.toUInt32 0) else Yv neg (t+127).toNat.toUInt32 (rm.toUInt32-0x800000) lemma Z7 (m:UInt64) (hm:m≠0) : (YK m (Yj m)).toNat=(if Fmt.fracWidth <= m.toNat.log2 then FloatLib.Numerics.roundShiftRightEven m.toNat (m.toNat.log2-Fmt.fracWidth) else m.toNat<<<(Fmt.fracWidth-m.toNat.log2)) /\ 2^23 <= (YK m (Yj m)).toNat/\(YK m (Yj m)).toNat <= 2^24:=by have h3:m.toNat≠0:=λ h=>hm (UInt64.toNat_inj.mp (by simpa using h));have hL:=Zj m hm;have h0:2^m.toNat.log2 <= m.toNat:=Nat.log2_self_le h3;have h1:m.toNat < 2^(m.toNat.log2+1):=Nat.lt_log2_self;rw [show Fmt.fracWidth=23 from rfl];unfold YK;generalize Yj m=L at hL ⊢;generalize hN:m.toNat.log2=N at * by_cases h:23 <= N . have hu:(23:UInt64) <= L:=by rw [UInt64.le_iff_toNat_le,hL]; simp; omega have hs:(L-23).toNat=N-23:=by simp_all simp only [hu,ite_true,h,hs,FloatLib.Numerics.FixedWord.roundShiftRightEven_toNat] have h4:2^23 <= m.toNat/2^(N-23):=by rw [Nat.le_div_iff_mul_le (Nat.two_pow_pos _), <- Nat.pow_add,show 23+(N-23)=N by omega] exact h0 have h6:m.toNat/2^(N-23) < 2^24:=by rw [Nat.div_lt_iff_lt_mul (Nat.two_pow_pos _), <- Nat.pow_add,show 24+(N-23)=N+1 by omega];exact h1 have:=FloatLib.Numerics.div_two_pow_le_roundShiftRightEven m.toNat (N-23);have:=FloatLib.Numerics.roundShiftRightEven_le_succ m.toNat (N-23);refine ⟨trivial,by omega,by omega⟩ . have hu:¬ (23:UInt64) <= L:=by rw [UInt64.le_iff_toNat_le,hL]; simp; omega have hs:(23-L).toNat=23-N:=by rw [UInt64.toNat_sub_of_le _ _ (by rw [UInt64.le_iff_toNat_le,hL]; simp; omega),hL]; rfl simp only [hu,ite_false,h];have h2:2^23 <= m.toNat*2^(23-N):=by calc 2^23=2^N*2^(23-N):=by rw [<- Nat.pow_add]; congr 1; omega _ <= m.toNat*2^(23-N):=Nat.mul_le_mul_right _ h0 have h5:m.toNat*2^(23-N) < 2^24:=by calc m.toNat*2^(23-N) < 2^(N+1)*2^(23-N):=Nat.mul_lt_mul_of_pos_right h1 (Nat.two_pow_pos _) _=2^24:=by rw [<- Nat.pow_add]; congr 1; omega have he:(m<<<(23-L)).toNat=m.toNat*2^(23-N):=by rw [UInt64.toNat_shiftLeft,hs,Nat.mod_eq_of_lt (show 23-N < 64 by omega),Nat.shiftLeft_eq];exact Nat.mod_eq_of_lt (by omega) rw [he,Nat.shiftLeft_eq];exact ⟨rfl,h2,by omega⟩ lemma Zb6 (neg:Bool) (m:UInt64) (e:Int) (hm:m≠0) (h1:¬ ((m.toNat.log2:Int)+e > 127)) (h2:¬ ((m.toNat.log2:Int)+e < -126)) : Yae neg m (Yj m) ((m.toNat.log2:Int)+e) = toWord (Model.packRoundedNormal Fmt neg (Model.nativeOverflow Fmt neg) (↑m.toNat.log2+e) (if Fmt.fracWidth <= m.toNat.log2 then FloatLib.Numerics.roundShiftRightEven m.toNat (m.toNat.log2-Fmt.fracWidth) else m.toNat<<<(Fmt.fracWidth-m.toNat.log2))):=by obtain ⟨hr,h5,h4⟩:=Z7 m hm;rw [<- hr];unfold Yae Model.packRoundedNormal;generalize YK m (Yj m)=rm at h5 h4 ⊢;generalize (m.toNat.log2:Int)+e=t at h1 h2 ⊢;simp only [Model.pow2_eq_two_pow,show Fmt.fracWidth=23 from rfl,show Fmt.maxNormalExponent=127 from rfl,show Fmt.exponentBias=127 from rfl,show Fmt.maxFiniteExpField=254 from rfl, show Fmt.maxFiniteFracField=8388607 from rfl,Nat.reducePow,Nat.reduceAdd,Int.ofNat_eq_natCast,Nat.cast_ofNat] by_cases hc:rm.toNat=16777216 . have h0:(rm==0x1000000)=true:=by rw [beq_iff_eq]; apply UInt64.toNat_inj.mp; rw [hc]; rfl simp only [h0,ite_true,hc,BEq.rfl,Nat.reduceSub];by_cases ho:t+1 > 127 . simp only [ho,ite_true]; exact ZaG neg . simp only [ho,ite_false];have hE:((t+128).toNat.toUInt32).toNat=(t+1+127).toNat:=by rw [Nat.toUInt32_eq,UInt32.toNat_ofNat',Nat.mod_eq_of_lt (by omega)]; omega have h3:((t+1+127).toNat > 254||((t+1+127).toNat==254&&decide (0 > 8388607)))=false:=by grind simp only [h3,Bool.false_eq_true,ite_false];rw [ZT neg _ 0 (by rw [hE]; omega) (by decide),hE];rfl . have h0:(rm==0x1000000)=false:=by rw [beq_eq_false_iff_ne]; intro h; apply hc; rw [h]; rfl have h6:(rm.toNat==16777216)=false:=by grind simp only [h0,h6,Bool.false_eq_true,ite_false,show ¬ t > 127 by omega] have hE:((t+127).toNat.toUInt32).toNat=(t+127).toNat:=by rw [Nat.toUInt32_eq,UInt32.toNat_ofNat',Nat.mod_eq_of_lt (by omega)] have hF:(rm.toUInt32-0x800000).toNat=rm.toNat-8388608:=by rw [UInt32.toNat_sub_of_le _ _ (by rw [UInt32.le_iff_toNat_le,UInt64.toNat_toUInt32]; simp; omega),UInt64.toNat_toUInt32]; simp; omega have h3:((t+127).toNat > 254||((t+127).toNat==254&&decide (rm.toNat-8388608 > 8388607)))=false:=by grind simp only [h3,Bool.false_eq_true,ite_false];rw [ZT neg _ _ (by rw [hE]; omega) (by rw [hF]; omega),hE,hF] @[inline] def YA (neg:Bool) (m:UInt64) (e:Int):UInt32 := let L:=Yj m let t:Int:=(L.toNat:Int)+e if t > 127 then Yv neg 255 0 else if t < -126 then YaO neg m e else Yae neg m L t lemma ZU (neg:Bool) (m:UInt64) (e:Int) (hm:m≠0) : YA neg m e=toWord (Model.roundDyadicGeneral Fmt ⟨neg,m.toNat,e⟩):=by have h0:m.toNat≠0:=λ h=>hm (UInt64.toNat_inj.mp (by simpa using h));have hL:=Zj m hm;unfold YA Model.roundDyadicGeneral;simp only [show (m.toNat==0)=false by simpa using h0,Bool.false_eq_true,ite_false,hL,show Fmt.maxNormalExponent=127 from rfl,show Fmt.minNormalExponent = -126 from rfl] by_cases h1:(m.toNat.log2:Int)+e > 127 . simp only [h1,ite_true]; exact ZaG neg . simp only [h1,ite_false];by_cases h2:(m.toNat.log2:Int)+e < -126 . simp only [h2,ite_true]; exact Zb5 neg m e h0 h2 . simp only [h2,ite_false]; exact Zb6 neg m e hm h1 h2 @[noinline] def Ybn (neg:Bool) (m:UInt64) (e:Int):UInt32:=YA neg m e @[noinline] def Yat (neg:Bool) (m:UInt64) (e:Int) (L c:UInt64):UInt32 := YA neg m (e+((L.toNat+c.toNat:Nat):Int)) @[inline] def YY (n:UInt64):UInt64 := let q:=n>>>40 q+(((n&&&0xFFFFFFFFFF)+0x7FFFFFFFFF+(q&&&1))>>>40) lemma Zb7 (n:UInt64):(YY n).toNat=FloatLib.Numerics.roundShiftRightEven n.toNat 40:=by rw [FloatLib.Numerics.roundShiftRightEven_eq_guard_sticky _ _ (by decide)];have hn:=n.toNat_lt;have h1:(n>>>40).toNat=n.toNat/2^40:=by rw [UInt64.toNat_shiftRight,Nat.shiftRight_eq_div_pow]; rfl have h2:(n&&&0xFFFFFFFFFF).toNat=n.toNat%2^40:=by rw [UInt64.toNat_and,show (0xFFFFFFFFFF:UInt64).toNat=2^40-1 from rfl,Nat.and_two_pow_sub_one_eq_mod] have h3:((n>>>40)&&&1).toNat=n.toNat/2^40%2:=by simp_all have g1:n.toNat/2^(40-1)%2=n.toNat%2^40/2^39:=by rw [show (2:Nat)^40=2^39*2 by norm_num,Nat.mod_mul_right_div_self] have g2:n.toNat%2^(40-1)=n.toNat%2^40%2^39:=by rw [show (2:Nat)^40=2^39*2 by norm_num,Nat.mod_mul_right_mod] have hR:=Nat.mod_lt n.toNat (show 0 < 2^40 by decide);have hQ:n.toNat/2^40 < 2^24:=by rw [Nat.div_lt_iff_lt_mul (by decide)]; exact hn unfold YY;simp only [UInt64.toNat_add,UInt64.toNat_shiftRight,h1,h2,h3,Nat.testBit_eq_decide_div_mod_eq,g1,g2];clear h1 h2 h3 g1 g2;generalize n.toNat%2^40=R at * generalize n.toNat/2^40=Q at * simp only [UInt64.reduceToNat,Nat.reduceMod,Nat.reducePow,Nat.shiftRight_eq_div_pow] at * split . rename_i h; simp at h; omega . rename_i h; simp at h; omega lemma Z8 (neg:Bool) (E F:UInt32) (h:E.toNat*2^23+F.toNat < 2^31) : (Yv neg E F).toNat=(if neg then 2^31 else 0)+E.toNat*2^23+F.toNat:=by unfold Yv;cases neg <;> simp <;> omega @[inline] def YZ (neg:Bool) (u n:UInt64):UInt32 := (if neg then (0x80000000:UInt32) else 0)+((u<<<23)+YY n).toUInt32 lemma Zb8 (neg:Bool) (u n:UInt64) (hu:u.toNat <= 253) (hq:(YY n).toNat <= 2^24) : (YZ neg u n).toNat=(if neg then 2^31 else 0)+u.toNat*2^23+(YY n).toNat:=by have hs:(u<<<23).toNat=u.toNat*2^23:=by rw [UInt64.toNat_shiftLeft]; simp; omega unfold YZ;cases neg <;> simp <;> omega lemma ZaH (neg:Bool) (m:UInt64) (e:Int) (u:UInt64) (hm:m≠0) (hu:(u.toNat:Int)=(m.toNat.log2:Int)+e+126) (h2:u.toNat <= 253) : YZ neg u (m<<<(63-Yj m))=YA neg m e:=by have h5:m.toNat≠0:=λ h=>hm (UInt64.toNat_inj.mp (by simpa using h));have hL:=Zj m hm;obtain ⟨hr,h4,h7⟩:=Z7 m hm;have hN:m.toNat.log2 < 64:=(Nat.log2_lt h5).mpr m.toNat_lt;have h1:m.toNat < 2^(m.toNat.log2+1):=Nat.lt_log2_self;have hq:(YY (m<<<(63-Yj m))).toNat=(YK m (Yj m)).toNat:=by rw [Zb7,hr];have hs:(63-Yj m).toNat=63-m.toNat.log2:=by rw [UInt64.toNat_sub_of_le _ _ (by rw [UInt64.le_iff_toNat_le,hL]; simp; omega -splitDisjunctions),hL]; rfl have h3:(m<<<(63-Yj m)).toNat=m.toNat*2^(63-m.toNat.log2):=by rw [UInt64.toNat_shiftLeft,hs,Nat.mod_eq_of_lt (show 63-m.toNat.log2 < 64 by omega),Nat.shiftLeft_eq];apply Nat.mod_eq_of_lt calc m.toNat*2^(63-m.toNat.log2) < 2^(m.toNat.log2+1)*2^(63-m.toNat.log2) := Nat.mul_lt_mul_of_pos_right h1 (Nat.two_pow_pos _) _=2^64:=by rw [<- Nat.pow_add,show m.toNat.log2+1+(63-m.toNat.log2)=64 by omega] rw [h3,show Fmt.fracWidth=23 from rfl];split . rw [show (40:Nat)=(m.toNat.log2-23)+(63-m.toNat.log2) by omega,FloatLib.Numerics.roundShiftRightEven_mul_two_pow] . rw [FloatLib.Numerics.roundShiftRightEven_mul_two_pow_of_le _ _ _ (by omega),Nat.shiftLeft_eq,show 63-m.toNat.log2-40=23-m.toNat.log2 by omega] have h6:(YY (m<<<(63-Yj m))).toNat <= 2^24:=by omega rw [show YA neg m e=Yae neg m (Yj m) ((m.toNat.log2:Int)+e) by unfold YA; simp only [hL,show ¬ ((m.toNat.log2:Int)+e > 127) by omega -splitDisjunctions,show ¬ ((m.toNat.log2:Int)+e < -126) by omega -splitDisjunctions,ite_false]] apply UInt32.toNat_inj.mp rw [Zb8 neg u _ h2 h6,hq] unfold Yae generalize YK m (Yj m)=rm at hq h4 h7 ⊢ generalize (m.toNat.log2:Int)+e=t at hu ⊢ by_cases hc:rm.toNat=16777216 . have h0:(rm==0x1000000)=true:=by rw [beq_iff_eq]; apply UInt64.toNat_inj.mp; rw [hc]; rfl simp only [h0,ite_true] by_cases ho:t+1 > 127 . simp only [ho,ite_true]; rw [Z8 neg 255 0 (by decide)]; simp; omega . simp only [ho,ite_false] have hE:((t+128).toNat.toUInt32).toNat=(t+128).toNat:=by rw [Nat.toUInt32_eq,UInt32.toNat_ofNat',Nat.mod_eq_of_lt (by omega)] rw [Z8 neg _ 0 (by rw [hE]; simp; omega),hE];simp; omega . have h0:(rm==0x1000000)=false:=by rw [beq_eq_false_iff_ne]; intro h; apply hc; rw [h]; rfl simp only [h0,Bool.false_eq_true,ite_false] have hE:((t+127).toNat.toUInt32).toNat=(t+127).toNat:=by rw [Nat.toUInt32_eq,UInt32.toNat_ofNat',Nat.mod_eq_of_lt (by omega)] have hF:(rm.toUInt32-0x800000).toNat=rm.toNat-8388608:=by rw [UInt32.toNat_sub_of_le _ _ (by rw [UInt32.le_iff_toNat_le,UInt64.toNat_toUInt32]; simp; omega -splitDisjunctions),UInt64.toNat_toUInt32]; simp; omega rw [Z8 neg _ _ (by rw [hE,hF]; omega),hE,hF]; omega lemma ZaI (neg:Bool) (n:UInt64) (E:Int) (u:UInt64) (hn:2^63 <= n.toNat) (hu:(u.toNat:Int)=E+189) (h3:u.toNat <= 253) : YZ neg u n=YA neg n E:=by have h2:n.toNat≠0:=Nat.pos_iff_ne_zero.mp (lt_of_lt_of_le (Nat.two_pow_pos 63) hn);have h1:n≠0:=λ h=>h2 (by rw [h]; rfl);have h0:n.toNat.log2=63:=(Nat.log2_eq_iff h2).mpr ⟨hn,n.toNat_lt⟩;have hL:Yj n=63:=UInt64.toNat_inj.mp (by rw [Zj n h1,h0]; rfl);have:=ZaH neg n E u h1 (by rw [h0]; push_cast; omega) h3;rw [hL,show n<<<(63-63:UInt64)=n from UInt64.toNat_inj.mp (by rw [UInt64.toNat_shiftLeft]; simp only [UInt64.reduceSub,Nat.zero_mod,Nat.shiftLeft_zero];exact Nat.mod_eq_of_lt n.toNat_lt)] at this exact this lemma Zb9 (e:Int) (c:UInt64) (hc:c.toNat < 2^62) (h:(Int64.ofInt e).toInt=e) (hu:((Int64.ofInt e).toUInt64+c).toNat <= 253) : (((Int64.ofInt e).toUInt64+c).toNat:Int)=e+c.toNat:=by have h1:=Int64.toInt_lt (Int64.ofInt e);have h2:=Int64.le_toInt (Int64.ofInt e);have hx:((Int64.ofInt e).toUInt64.toNat:Int)=e%2^64:=by simp;exact Int.toNat_of_nonneg (Int.emod_nonneg _ (by decide)) rw [UInt64.toNat_add] at hu ⊢;omega def Y0 (e:Int) (ok:Bool) (B:UInt64):Prop := ∀ c:UInt64,c.toNat < 2^62 -> ok=true -> (B+c).toNat <= 253 -> ((B+c).toNat:Int)=e+c.toNat lemma ZaJ (e:Int):Y0 e ((Int64.ofInt e).toInt==e) (Int64.ofInt e).toUInt64 := λ c hc h0 hu=>Zb9 e c hc (beq_iff_eq.mp h0) hu @[inline] def Yau (neg:Bool) (m:UInt64) (e:Int) (ok:Bool) (b:UInt64):UInt32 := let L:=Yj m let u:=b+L+126 if ok&&u <= 253 then YZ neg u (m<<<(63-L)) else Ybn neg m e lemma ZaK (neg:Bool) (m:UInt64) (e:Int) (ok:Bool) (B:UInt64) (hm:m≠0) (hr:Y0 e ok B):Yau neg m e ok B=YA neg m e:=by have h3:m.toNat≠0:=λ h=>hm (UInt64.toNat_inj.mp (by simpa using h));have hL:=Zj m hm;have hN:m.toNat.log2 < 64:=(Nat.log2_lt h3).mpr m.toNat_lt;unfold Yau Ybn;dsimp only;split . rename_i h;simp at h;obtain ⟨h1,h2⟩:=h;have hc:(Yj m+126).toNat=m.toNat.log2+126:=by rw [UInt64.toNat_add,hL]; simp; omega rw [UInt64.add_assoc] at h2 ⊢;have h0:(B+(Yj m+126)).toNat <= 253:=by have:=UInt64.le_iff_toNat_le.mp h2; simpa using this have hw:=hr _ (by rw [hc]; omega) h1 h0;rw [hc] at hw;exact ZaH neg m e _ hm (by rw [hw]; push_cast; omega) h0 . rfl @[inline] def YaP (w:UInt64) (e:Int) (negZero ok:Bool) (B:UInt64):UInt32 := if w=0 then (if negZero then 0x80000000 else 0) else let neg:=w>>>63 != 0 Yau neg (if neg then 0-w else w) e ok B lemma Zca (w:UInt64) (e:Int) (negZero ok:Bool) (B:UInt64) (hr:Y0 e ok B) : YaP w e negZero ok B=finishWord (Ym w) e negZero:=by unfold YaP finishWord;by_cases hw:w=0 . subst hw; simp [Ym] . have h7:w.toNat≠0:=λ h=>hw (UInt64.toNat_inj.mp (by simpa using h)) have h6:=w.toNat_lt have h2:(w>>>63).toNat=w.toNat/2^63:=by rw [UInt64.toNat_shiftRight,Nat.shiftRight_eq_div_pow]; rfl obtain ⟨h5,h3,hS⟩:(w>>>63 != 0)=decide (Ym w < 0) /\ (if (w>>>63 != 0)=true then 0-w else w).toNat=(Ym w).natAbs/\Ym w≠0:=by by_cases h:w.toNat < 2^63 . have hv:Ym w=(w.toNat:Int):=by unfold Ym; simp; omega have h0:(w>>>63 != 0)=false:=by simp; apply UInt64.toNat_inj.mp; rw [h2]; simp; omega rw [hv,h0]; simp only [Bool.false_eq_true,ite_false,Int.natAbs_natCast];refine ⟨by simp,trivial,by omega⟩ . have hv:Ym w=(w.toNat:Int)-2^64:=by unfold Ym; simp only [h,ite_false] have h1:(w>>>63 != 0)=true:=by simp; intro e; have:=congrArg UInt64.toNat e; rw [h2] at this simp at this; omega have h4:(0-w).toNat=2^64-w.toNat:=by rw [UInt64.toNat_sub]; simp; omega rw [hv,h1]; simp only [ite_true,h4];refine ⟨by simp; omega,by omega,by omega⟩ simp only [hw,ite_false,hS];rw [<- Model.roundDyadicGeneral_eq_roundDyadic];have hm:(if (w>>>63 != 0)=true then 0-w else w)≠0:=by grind rw [ZaK _ _ _ _ _ hm hr,ZU _ _ _ hm,h3,h5]; rfl def YaQ (w:UInt64) (e:Int) (negZero:Bool):UInt32 := YaP w e negZero ((Int64.ofInt e).toInt==e) (Int64.ofInt e).toUInt64 lemma ZaL (w:UInt64) (e:Int) (negZero:Bool) : YaQ w e negZero=finishWord (Ym w) e negZero := Zca w e negZero _ _ (ZaJ e) lemma Zcb (V s:Nat) (h:s+25 <= V.log2) : (FloatLib.Numerics.shiftRightJam V s).log2=V.log2-s:=by have hV:V≠0:=by intro h0; subst h0; simp at h have h4:2^V.log2 <= V:=Nat.log2_self_le hV have h5:V < 2^(V.log2+1):=Nat.lt_log2_self have h1:2^(V.log2-s) <= V/2^s:=by rw [Nat.le_div_iff_mul_le (Nat.two_pow_pos _), <- Nat.pow_add,show V.log2-s+s=V.log2 by omega]; exact h4 have h3:V/2^s < 2^(V.log2-s+1):=by rw [Nat.div_lt_iff_lt_mul (Nat.two_pow_pos _), <- Nat.pow_add,show V.log2-s+1+s=V.log2+1 by omega]; exact h5 unfold FloatLib.Numerics.shiftRightJam;simp only;split . exact (Nat.log2_eq_iff (by omega)).mpr ⟨h1,h3⟩ . rw [FloatLib.Numerics.or_one_eq];split . rename_i _ h6 apply (Nat.log2_eq_iff (by omega)).mpr refine ⟨by omega,?_⟩ have h2:2^(V.log2-s+1)%2=0:=by simp omega . exact (Nat.log2_eq_iff (by omega)).mpr ⟨h1,h3⟩ lemma ZaM (neg:Bool) (V s:Nat) (e:Int) (h:s+25 <= V.log2) : Model.roundDyadicGeneral Fmt ⟨neg,FloatLib.Numerics.shiftRightJam V s,e+s⟩ = Model.roundDyadicGeneral Fmt ⟨neg,V,e⟩:=by have hV:V≠0:=by intro h0; subst h0; simp at h have h1:2^s <= V:=le_trans (Nat.pow_le_pow_right (by norm_num) (by omega)) (Nat.log2_self_le hV) have hx:FloatLib.Numerics.shiftRightJam V s≠0:=FloatLib.Numerics.shiftRightJam_ne_zero V s h1 have hl:=Zcb V s h unfold Model.roundDyadicGeneral simp only [show (FloatLib.Numerics.shiftRightJam V s==0)=false by simpa using hx,show (V==0)=false by simpa using hV,Bool.false_eq_true,ite_false,hl] have ht:((V.log2-s:Nat):Int)+(e+s)=V.log2+e:=by omega rw [ht] split . rfl . split . rename_i _ h2;have h3:Fmt.minSubnormalExponent = -149:=rfl;have h6:(V.log2:Int)+e < -126:=lt_of_lt_of_eq h2 rfl;obtain ⟨a,ha⟩ : ∃ a:Nat,e-Fmt.minSubnormalExponent=Int.negSucc a/\s+2 <= a+1:=by refine ⟨(-(e+149)-1).toNat,?_,by omega⟩;rw [h3,Int.negSucc_eq]; omega have hb:e+(s:Int)-Fmt.minSubnormalExponent=Int.negSucc (a-s):=by omega rw [ha.1,hb];simp only;rw [show a-s+1=a+1-s by omega,FloatLib.Numerics.roundShiftRightEven_shiftRightJam V s (a+1) ha.2] . rename_i _ h2 have h5:Fmt.fracWidth <= V.log2-s:=by rw [show Fmt.fracWidth=23 from rfl]; omega have h4:Fmt.fracWidth <= V.log2:=by omega simp only [h5,h4,ite_true] rw [show Fmt.fracWidth=23 from rfl,show V.log2-s-23=V.log2-23-s by omega,FloatLib.Numerics.roundShiftRightEven_shiftRightJam V s (V.log2-23) (by omega)] lemma Z9 (hi lo Lw:UInt64) (L:Nat) (h2:Lw.toNat=L) (hL:L <= 63) (h4:hi.toNat < 2^(L+1)) : ((hi<<<(63-Lw))|||((lo>>>Lw)>>>1)).toNat=(hi.toNat*2^64+lo.toNat)/2^(L+1) /\ ((lo<<<(63-Lw)) != 0)=decide ((hi.toNat*2^64+lo.toNat)%2^(L+1)≠0):=by have hs:(63-Lw).toNat=63-L:=by rw [UInt64.toNat_sub_of_le _ _ (by rw [UInt64.le_iff_toNat_le,h2]; simp; omega),h2]; rfl have hp:(2:Nat)^64=2^(63-L)*2^(L+1):=by rw [<- Nat.pow_add]; congr 1; omega have hA:(hi<<<(63-Lw)).toNat=hi.toNat*2^(63-L):=by rw [UInt64.toNat_shiftLeft,hs,Nat.mod_eq_of_lt (show 63-L < 64 by omega),Nat.shiftLeft_eq] apply Nat.mod_eq_of_lt calc hi.toNat*2^(63-L) < 2^(L+1)*2^(63-L):=Nat.mul_lt_mul_of_pos_right h4 (Nat.two_pow_pos _) _=2^64:=by rw [<- Nat.pow_add]; congr 1; omega have hB:((lo>>>Lw)>>>1).toNat=lo.toNat/2^(L+1):=by rw [UInt64.toNat_shiftRight,UInt64.toNat_shiftRight,h2,Nat.mod_eq_of_lt (show L < 64 by omega)];simp only [UInt64.reduceToNat,Nat.reduceMod,Nat.shiftRight_eq_div_pow,Nat.div_div_eq_div_mul, <- Nat.pow_succ] have h7:lo.toNat/2^(L+1) < 2^(63-L):=by rw [Nat.div_lt_iff_lt_mul (Nat.two_pow_pos _), <- hp]; exact lo.toNat_lt have h3:(hi.toNat*2^64+lo.toNat)/2^(L+1)=hi.toNat*2^(63-L)+lo.toNat/2^(L+1):=by rw [hp, <- Nat.mul_assoc,Nat.add_comm,Nat.add_mul_div_right _ _ (Nat.two_pow_pos _),Nat.add_comm] have h6:(hi.toNat*2^64+lo.toNat)%2^(L+1)=lo.toNat%2^(L+1):=by rw [hp, <- Nat.mul_assoc,Nat.add_comm,Nat.add_mul_mod_self_right] refine ⟨?_,?_⟩ . rw [UInt64.toNat_or,hA,hB,h3, <- Nat.shiftLeft_eq, <- Nat.shiftLeft_add_eq_or_of_lt h7] . rw [h6];have hC:(lo<<<(63-Lw)).toNat=lo.toNat%2^(L+1)*2^(63-L):=by rw [UInt64.toNat_shiftLeft,hs,Nat.mod_eq_of_lt (show 63-L < 64 by omega),Nat.shiftLeft_eq,hp,Nat.mul_comm (2^(63-L)),Nat.mul_mod_mul_right] have h5:0 < 2^(63-L):=Nat.two_pow_pos _;by_cases h0:lo.toNat%2^(L+1)=0 . have:lo<<<(63-Lw)=0:=UInt64.toNat_inj.mp (by rw [hC,h0,UInt64.toNat_zero]; simp);simp [this,h0] . have:lo<<<(63-Lw)≠0:=λ e=>by have h1:=congrArg UInt64.toNat e;rw [hC,UInt64.toNat_zero] at h1;rcases Nat.mul_eq_zero.mp h1 with h | h . exact h0 h . exact absurd h (Nat.pos_iff_ne_zero.mp h5) simp [this,h0] @[inline] def Yav (w0:UInt64):UInt64 := ~~~w0+1 @[inline] def Yaw (w1 w0:UInt64):UInt64 := ~~~w1+(if w0==0 then 1 else 0) @[inline] def Yax (w2 w1 w0:UInt64):UInt64 := ~~~w2+(if w1==0&&w0==0 then 1 else 0) lemma Zcc (w2 w1 w0:UInt64) (h:w2.toNat*2^128+w1.toNat*2^64+w0.toNat≠0) : (Yax w2 w1 w0).toNat*2^128+(Yaw w1 w0).toNat*2^64+(Yav w0).toNat = 2^192-(w2.toNat*2^128+w1.toNat*2^64+w0.toNat):=by have a2:=w2.toNat_lt; have a1:=w1.toNat_lt; have a0:=w0.toNat_lt;unfold Yax Yaw Yav;have n2:=UInt64.toNat_not w2; have n1:=UInt64.toNat_not w1; have n0:=UInt64.toNat_not w0;by_cases z0:w0=0 . have z0':w0.toNat=0:=by simp_all by_cases z1:w1=0 . have z1':w1.toNat=0:=by grind simp only [z0,z1,Bool.and_self,ite_true,UInt64.toNat_not] at * simp at *; omega . have z1b:(w1==0)=false:=by grind have z1':w1.toNat≠0:=λ h=>z1 (UInt64.toNat_inj.mp (by rw [h]; rfl)) simp only [z0,z1b,beq_self_eq_true,Bool.false_and,Bool.false_eq_true,ite_false,ite_true,UInt64.toNat_add,UInt64.toNat_not] at * simp at *; omega . have z0b:(w0==0)=false:=by grind have z0':w0.toNat≠0:=λ h=>z0 (UInt64.toNat_inj.mp (by rw [h]; rfl)) simp only [z0b,Bool.and_false,Bool.false_eq_true,ite_false,UInt64.toNat_add,UInt64.toNat_not] at * simp at *; omega @[inline] def Yaf (neg:Bool) (m2 m1 m0:UInt64) (e:Int):UInt32 := let L:=Yj m2 let x:=(m2<<<(63-L))|||((m1>>>L)>>>1) let st:=(m1<<<(63-L)) != 0||m0 != 0 YA neg (if st then x|||1 else x) (e+((L.toNat+65:Nat):Int)) @[inline] def Yag (neg:Bool) (m1 m0:UInt64) (e:Int):UInt32 := let L:=Yj m1 let x:=(m1<<<(63-L))|||((m0>>>L)>>>1) let st:=(m0<<<(63-L)) != 0 YA neg (if st then x|||1 else x) (e+((L.toNat+1:Nat):Int)) @[inline] def Yay (neg:Bool) (m2 m1 m0:UInt64) (e:Int):UInt32 := if m2 != 0 then Yaf neg m2 m1 m0 e else if m1 != 0 then Yag neg m1 m0 e else YA neg m0 e lemma ZaN (x:UInt64) (st:Bool) (Q R:Nat) (hx:x.toNat=Q) (h0:st=decide (R≠0)) (hQ:2 <= Q) : (if st then x|||1 else x).toNat=(if R==0 then Q else Q|||1):=by subst hx h0;by_cases hR:R=0 . simp [hR] . simp [hR] lemma Zcd (neg:Bool) (m1 m0:UInt64) (e:Int) (h1:m1≠0) : Yag neg m1 m0 e=toWord (Model.roundDyadicGeneral Fmt ⟨neg,m1.toNat*2^64+m0.toNat,e⟩):=by have a1:=m1.toNat_lt; have a0:=m0.toNat_lt unfold Yag have h5:m1.toNat≠0:=λ h=>h1 (UInt64.toNat_inj.mp (by rw [h]; rfl)) have hK:=Zj m1 h1 generalize h0:m1.toNat.log2=K at hK have h8:K <= 63:=by rw [<- h0]; have:=(Nat.log2_lt h5).mpr m1.toNat_lt; omega have h6:m1.toNat < 2^(K+1):=by rw [<- h0]; exact Nat.lt_log2_self have h4:2^K <= m1.toNat:=by rw [<- h0]; exact Nat.log2_self_le h5 obtain ⟨hx,h2⟩:=Z9 m1 m0 (Yj m1) K hK h8 h6 generalize Yj m1=L at hK hx h2 ⊢ have hQ:2 <= (m1.toNat*2^64+m0.toNat)/2^(K+1):=by rw [Nat.le_div_iff_mul_le (Nat.two_pow_pos _)] calc 2*2^(K+1)=2^K*2^2:=by rw [<- Nat.pow_add, <- Nat.pow_succ'] _ <= m1.toNat*2^64:=Nat.mul_le_mul h4 (Nat.pow_le_pow_right (by norm_num) (by norm_num)) _ <= _:=Nat.le_add_right _ _ have hj:=ZaN _ _ _ _ hx h2 hQ;have h7:(if ((m0<<<(63-L)) != 0)=true then ((m1<<<(63-L))|||((m0>>>L)>>>1))|||1 else (m1<<<(63-L))|||((m0>>>L)>>>1))≠0:=by intro h; have h3:=congrArg UInt64.toNat h; rw [hj,UInt64.toNat_zero] at h3;split at h3 . omega . rw [FloatLib.Numerics.or_one_eq] at h3; split at h3 <;> omega rw [ZU _ _ _ h7,hj,hK];have h9:(m1.toNat*2^64+m0.toNat).log2=64+K:=by apply (Nat.log2_eq_iff (by omega)).mpr;constructor . calc 2^(64+K)=2^K*2^64:=by rw [<- Nat.pow_add,Nat.add_comm] _ <= m1.toNat*2^64:=Nat.mul_le_mul_right _ h4 _ <= _:=Nat.le_add_right _ _ . calc m1.toNat*2^64+m0.toNat < m1.toNat*2^64+2^64:=by omega _=(m1.toNat+1)*2^64:=by ring _ <= 2^(K+1)*2^64:=Nat.mul_le_mul_right _ h6 _=2^(64+K+1):=by rw [<- Nat.pow_add,Nat.add_comm (K+1),Nat.add_assoc] have:=ZaM neg (m1.toNat*2^64+m0.toNat) (K+1) e (by omega);unfold FloatLib.Numerics.shiftRightJam at this;rw [this] lemma Zce (neg:Bool) (m2 m1 m0:UInt64) (e:Int) (h2:m2≠0) : Yaf neg m2 m1 m0 e = toWord (Model.roundDyadicGeneral Fmt ⟨neg,m2.toNat*2^128+m1.toNat*2^64+m0.toNat,e⟩):=by have a1:=m1.toNat_lt; have a0:=m0.toNat_lt;unfold Yaf;have h0:m2.toNat≠0:=λ h=>h2 (UInt64.toNat_inj.mp (by rw [h]; rfl));have hM:m2.toNat*2^128+m1.toNat*2^64+m0.toNat≠0:=by have hp:0 < m2.toNat*2^128:=Nat.mul_pos (Nat.pos_of_ne_zero h0) (Nat.two_pow_pos _);rw [Nat.add_assoc]; exact Nat.ne_of_gt (Nat.lt_of_lt_of_le hp (Nat.le_add_right _ _)) have hK:=Zj m2 h2 generalize h4:m2.toNat.log2=K at hK have hd:K <= 63:=by rw [<- h4]; have:=(Nat.log2_lt h0).mpr m2.toNat_lt; omega have h5:m2.toNat < 2^(K+1):=by rw [<- h4]; exact Nat.lt_log2_self have h8:2^K <= m2.toNat:=by rw [<- h4]; exact Nat.log2_self_le h0 obtain ⟨hx,h1⟩:=Z9 m2 m1 (Yj m2) K hK hd h5 generalize Yj m2=L at hK hx h1 ⊢ obtain ⟨A,hA⟩ : ∃ A,m2.toNat*2^64+m1.toNat=A:=⟨_,rfl⟩ rw [hA] at hx h1 have hb:A=A/2^(K+1)*2^(K+1)+A%2^(K+1):=(Nat.div_add_mod' A _).symm have hg:A%2^(K+1) < 2^(K+1):=Nat.mod_lt _ (Nat.two_pow_pos _) have h6:(2:Nat)^(K+65)=2^(K+1)*2^64:=by grind have h7:m2.toNat*2^128+m1.toNat*2^64+m0.toNat = (A%2^(K+1)*2^64+m0.toNat)+A/2^(K+1)*2^(K+65):=by have:m2.toNat*2^128+m1.toNat*2^64=A*2^64:=by rw [<- hA]; ring rw [this,h6]; conv_lhs=>rw [hb] ring have h9:A%2^(K+1)*2^64+m0.toNat < 2^(K+65):=by rw [h6] calc A%2^(K+1)*2^64+m0.toNat < A%2^(K+1)*2^64+2^64:=by omega _=(A%2^(K+1)+1)*2^64:=by ring _ <= 2^(K+1)*2^64:=Nat.mul_le_mul_right _ hg have hQ:(m2.toNat*2^128+m1.toNat*2^64+m0.toNat)/2^(K+65)=A/2^(K+1):=by rw [h7,Nat.add_mul_div_right _ _ (Nat.two_pow_pos _),Nat.div_eq_of_lt h9,Nat.zero_add] have hR:(m2.toNat*2^128+m1.toNat*2^64+m0.toNat)%2^(K+65)=A%2^(K+1)*2^64+m0.toNat:=by rw [h7,Nat.add_mul_mod_self_right,Nat.mod_eq_of_lt h9] have hc:((m1<<<(63-L) != 0)||(m0 != 0)) = decide ((m2.toNat*2^128+m1.toNat*2^64+m0.toNat)%2^(K+65)≠0):=by rw [h1,hR];have hf:(m0 != 0)=decide (m0.toNat≠0):=by by_cases h:m0=0 . subst h; rfl . have:m0.toNat≠0:=λ h'=>h (UInt64.toNat_inj.mp (by rw [h']; rfl));simp [h,this] rw [hf];by_cases hz:A%2^(K+1)=0 <;> by_cases hh:m0.toNat=0 <;> simp have ha:2 <= A/2^(K+1):=by rw [Nat.le_div_iff_mul_le (Nat.two_pow_pos _), <- hA] calc 2*2^(K+1)=2^K*2^2:=by rw [<- Nat.pow_add, <- Nat.pow_succ'] _ <= m2.toNat*2^64:=Nat.mul_le_mul h8 (Nat.pow_le_pow_right (by norm_num) (by norm_num)) _ <= _:=Nat.le_add_right _ _ rw [<- hQ] at hx ha;have hj:=ZaN _ _ _ _ hx hc ha;have he:(if ((m1<<<(63-L) != 0)||(m0 != 0))=true then ((m2<<<(63-L))|||((m1>>>L)>>>1))|||1 else (m2<<<(63-L))|||((m1>>>L)>>>1))≠0:=by intro h; have h3:=congrArg UInt64.toNat h; rw [hj,UInt64.toNat_zero] at h3;split at h3 . omega . rw [FloatLib.Numerics.or_one_eq] at h3; split at h3 <;> omega rw [ZU _ _ _ he,hj,hK];have hi:(m2.toNat*2^128+m1.toNat*2^64+m0.toNat).log2=128+K:=by apply (Nat.log2_eq_iff hM).mpr;constructor . calc 2^(128+K)=2^K*2^128:=by rw [<- Nat.pow_add,Nat.add_comm] _ <= m2.toNat*2^128:=Nat.mul_le_mul_right _ h8 _ <= _:=by rw [Nat.add_assoc]; exact Nat.le_add_right _ _ . have:m1.toNat*2^64+m0.toNat < 2^128:=by calc m1.toNat*2^64+m0.toNat < m1.toNat*2^64+2^64:=Nat.add_lt_add_left a0 _ _=(m1.toNat+1)*2^64:=by ring _ <= 2^64*2^64:=Nat.mul_le_mul_right _ a1 _=2^128:=by rw [<- Nat.pow_add] calc m2.toNat*2^128+m1.toNat*2^64+m0.toNat < m2.toNat*2^128+2^128:=by rw [Nat.add_assoc]; exact Nat.add_lt_add_left this _ _=(m2.toNat+1)*2^128:=by ring _ <= 2^(K+1)*2^128:=Nat.mul_le_mul_right _ h5 _=2^(128+K+1):=by rw [<- Nat.pow_add,Nat.add_comm (K+1),Nat.add_assoc] have:=ZaM neg (m2.toNat*2^128+m1.toNat*2^64+m0.toNat) (K+65) e (by omega);unfold FloatLib.Numerics.shiftRightJam at this;rw [this] lemma ZaO (neg:Bool) (m2 m1 m0:UInt64) (e:Int) (hM:m2.toNat*2^128+m1.toNat*2^64+m0.toNat≠0) : Yay neg m2 m1 m0 e = toWord (Model.roundDyadicGeneral Fmt ⟨neg,m2.toNat*2^128+m1.toNat*2^64+m0.toNat,e⟩):=by unfold Yay;by_cases h2:m2=0 . subst h2;simp only [ite_false,UInt64.toNat_zero,Nat.zero_mul,Nat.zero_add] at hM ⊢;by_cases h1:m1=0 . subst h1;simp at hM ⊢;exact ZU neg m0 e (λ h=>hM (by rw [h]; rfl)) . simp only [show (m1 != 0)=true by simpa using h1,ite_true];exact Zcd neg m1 m0 e h1 . simp only [show (m2 != 0)=true by simpa using h2,ite_true];exact Zce neg m2 m1 m0 e h2 lemma ZaP (hi lo Lw:UInt64) (L:Nat) (h0:Lw.toNat=L) (hL:L <= 63) (h1:hi.toNat < 2^(L+1)) (h2:2^L <= hi.toNat) (st:Bool) : 2^63 <= (if st then ((hi<<<(63-Lw))|||((lo>>>Lw)>>>1))|||1 else (hi<<<(63-Lw))|||((lo>>>Lw)>>>1)).toNat:=by obtain ⟨hx, -⟩:=Z9 hi lo Lw L h0 hL h1;have hQ:2^63 <= (hi.toNat*2^64+lo.toNat)/2^(L+1):=by rw [Nat.le_div_iff_mul_le (Nat.two_pow_pos _)] calc 2^63*2^(L+1)=2^L*2^64:=by rw [<- Nat.pow_add, <- Nat.pow_add,show 63+(L+1)=L+64 by omega] _ <= hi.toNat*2^64:=Nat.mul_le_mul_right _ h2 _ <= _:=Nat.le_add_right _ _ cases st . simp only [Bool.false_eq_true,ite_false]; rw [hx]; exact hQ . simp only [ite_true];rw [UInt64.toNat_or,hx,show (1:UInt64).toNat=1 from rfl,FloatLib.Numerics.or_one_eq];split <;> omega @[inline] def YaR (neg:Bool) (m1 m0:UInt64) (e:Int) (ok:Bool) (b:UInt64):UInt32 := let L:=Yj m1 let x:=(m1<<<(63-L))|||((m0>>>L)>>>1) let st:=(m0<<<(63-L)) != 0 let x':=if st then x|||1 else x let u:=b+L+190 if ok&&u <= 253 then YZ neg u x' else Yat neg x' e L 1 lemma Zcf (neg:Bool) (m1 m0:UInt64) (e:Int) (ok:Bool) (B:UInt64) (h1:m1≠0) (hr:Y0 e ok B):YaR neg m1 m0 e ok B=Yag neg m1 m0 e:=by have h2:m1.toNat≠0:=λ h=>h1 (UInt64.toNat_inj.mp (by rw [h]; rfl)) have hK:=Zj m1 h1 generalize h0:m1.toNat.log2=K at hK have h5:K <= 63:=by rw [<- h0]; have:=(Nat.log2_lt h2).mpr m1.toNat_lt; omega have h4:m1.toNat < 2^(K+1):=by rw [<- h0]; exact Nat.lt_log2_self have h6:2^K <= m1.toNat:=by rw [<- h0]; exact Nat.log2_self_le h2 have hn:=ZaP m1 m0 (Yj m1) K hK h5 h4 h6 unfold YaR Yag Yat dsimp only generalize Yj m1=L at hK hn ⊢ split . rename_i h simp at h obtain ⟨ha,hb⟩:=h have hc:(L+190).toNat=K+190:=by rw [UInt64.toNat_add,hK]; simp; omega rw [UInt64.add_assoc] at hb ⊢ have h3:(B+(L+190)).toNat <= 253:=by have:=UInt64.le_iff_toNat_le.mp hb; simpa using this have hw:=hr _ (by rw [hc]; omega) ha h3;rw [hc] at hw;exact ZaI neg _ _ _ (hn _) (by rw [hw]; push_cast; omega) h3 . rfl @[inline] def YaS (neg:Bool) (m2 m1 m0:UInt64) (e:Int) (ok:Bool) (b:UInt64):UInt32 := let L:=Yj m2 let x:=(m2<<<(63-L))|||((m1>>>L)>>>1) let st:=(m1<<<(63-L)) != 0||m0 != 0 let x':=if st then x|||1 else x let u:=b+L+254 if ok&&u <= 253 then YZ neg u x' else Yat neg x' e L 65 lemma Zcg (neg:Bool) (m2 m1 m0:UInt64) (e:Int) (ok:Bool) (B:UInt64) (h2:m2≠0) (hr:Y0 e ok B):YaS neg m2 m1 m0 e ok B=Yaf neg m2 m1 m0 e:=by have h1:m2.toNat≠0:=λ h=>h2 (UInt64.toNat_inj.mp (by rw [h]; rfl)) have hK:=Zj m2 h2 generalize h0:m2.toNat.log2=K at hK have h5:K <= 63:=by rw [<- h0]; have:=(Nat.log2_lt h1).mpr m2.toNat_lt; omega have h4:m2.toNat < 2^(K+1):=by rw [<- h0]; exact Nat.lt_log2_self have h6:2^K <= m2.toNat:=by rw [<- h0]; exact Nat.log2_self_le h1 have hn:=ZaP m2 m1 (Yj m2) K hK h5 h4 h6 unfold YaS Yaf Yat dsimp only generalize Yj m2=L at hK hn ⊢ split . rename_i h simp at h obtain ⟨ha,hb⟩:=h have hc:(L+254).toNat=K+254:=by rw [UInt64.toNat_add,hK]; simp; omega rw [UInt64.add_assoc] at hb ⊢ have h3:(B+(L+254)).toNat <= 253:=by have:=UInt64.le_iff_toNat_le.mp hb; simpa using this have hw:=hr _ (by rw [hc]; omega) ha h3;rw [hc] at hw;exact ZaI neg _ _ _ (hn _) (by rw [hw]; push_cast; omega) h3 . rfl @[inline] def Yaz (neg:Bool) (m2 m1 m0:UInt64) (e:Int) (ok:Bool) (b:UInt64):UInt32 := if m2 != 0 then YaS neg m2 m1 m0 e ok b else if m1 != 0 then YaR neg m1 m0 e ok b else Yau neg m0 e ok b lemma ZaQ (neg:Bool) (m2 m1 m0:UInt64) (e:Int) (ok:Bool) (B:UInt64) (hM:m2.toNat*2^128+m1.toNat*2^64+m0.toNat≠0) (hr:Y0 e ok B) : Yaz neg m2 m1 m0 e ok B=Yay neg m2 m1 m0 e:=by unfold Yaz Yay;by_cases h2:m2=0 . subst h2;simp only [ite_false,UInt64.toNat_zero,Nat.zero_add] at hM ⊢;by_cases h1:m1=0 . subst h1;simp at hM ⊢;exact ZaK neg m0 e ok B (λ h=>hM (by rw [h]; rfl)) hr . simp only [show (m1 != 0)=true by simpa using h1,ite_true];exact Zcf neg m1 m0 e ok B h1 hr . simp only [show (m2 != 0)=true by simpa using h2,ite_true];exact Zcg neg m2 m1 m0 e ok B h2 hr @[inline] def YaT (w2 w1 w0:UInt64) (e:Int) (negZero ok:Bool) (B:UInt64):UInt32 := if w2=0/\w1=0/\w0=0 then (if negZero then 0x80000000 else 0) else if w2>>>63 != 0 then Yaz true (Yax w2 w1 w0) (Yaw w1 w0) (Yav w0) e ok B else Yaz false w2 w1 w0 e ok B lemma Zch (w2 w1 w0:UInt64) (e:Int) (negZero ok:Bool) (B:UInt64) (hr:Y0 e ok B) : YaT w2 w1 w0 e negZero ok B=finishWord (YC w2 w1 w0) e negZero:=by have a2:=w2.toNat_lt; have a1:=w1.toNat_lt; have a0:=w0.toNat_lt;have hV:w2.toNat*2^128+w1.toNat*2^64+w0.toNat < 2^192:=by have:w1.toNat*2^64+w0.toNat < 2^128:=by calc w1.toNat*2^64+w0.toNat < w1.toNat*2^64+2^64:=Nat.add_lt_add_left a0 _ _=(w1.toNat+1)*2^64:=by ring _ <= 2^64*2^64:=Nat.mul_le_mul_right _ a1 _=2^128:=by rw [<- Nat.pow_add] calc w2.toNat*2^128+w1.toNat*2^64+w0.toNat < w2.toNat*2^128+2^128:=by rw [Nat.add_assoc]; exact Nat.add_lt_add_left this _ _=(w2.toNat+1)*2^128:=by ring _ <= 2^64*2^128:=Nat.mul_le_mul_right _ a2 _=2^192:=by rw [<- Nat.pow_add] have h4:(w2>>>63).toNat=w2.toNat/2^63:=by rw [UInt64.toNat_shiftRight,Nat.shiftRight_eq_div_pow]; rfl unfold YaT finishWord;by_cases hz:w2=0/\w1=0/\w0=0 . obtain ⟨r2,r1,r0⟩:=hz; subst r2 r1 r0; simp [YC] have h2:w2.toNat*2^128+w1.toNat*2^64+w0.toNat≠0:=by intro h0; apply hz;obtain ⟨h5,hc⟩:=Nat.add_eq_zero_iff.mp h0;obtain ⟨ha,hb⟩:=Nat.add_eq_zero_iff.mp h5;have z2:w2.toNat=0:=(Nat.mul_eq_zero.mp ha).resolve_right (Nat.pos_iff_ne_zero.mp (Nat.two_pow_pos _));have z1:w1.toNat=0:=(Nat.mul_eq_zero.mp hb).resolve_right (Nat.pos_iff_ne_zero.mp (Nat.two_pow_pos _));exact ⟨UInt64.toNat_inj.mp (by rw [z2]; rfl),UInt64.toNat_inj.mp (by rw [z1]; rfl),UInt64.toNat_inj.mp (by rw [hc]; rfl)⟩ simp only [hz,ite_false];generalize hN:w2.toNat*2^128+w1.toNat*2^64+w0.toNat=N at hV h2;by_cases hn:w2.toNat < 2^63 . have hv:YC w2 w1 w0=(N:Int):=by unfold YC; rw [hN]; simp only [hn,ite_true,Int.sub_zero] have h0:(w2>>>63 != 0)=false:=by simp; apply UInt64.toNat_inj.mp; rw [h4]; simp; omega have hS:YC w2 w1 w0≠0:=by omega simp only [h0,Bool.false_eq_true,ite_false,hS] rw [<- Model.roundDyadicGeneral_eq_roundDyadic,ZaQ false w2 w1 w0 e _ _ (by rw [hN]; exact h2) hr, ZaO false w2 w1 w0 e (by rw [hN]; exact h2),hN] unfold ofIntDyadic; rw [hv,Int.natAbs_natCast,decide_eq_false (Int.not_lt.mpr (Int.natCast_nonneg N))] . have hv:YC w2 w1 w0=(N:Int)-2^192:=by unfold YC; rw [hN]; simp only [hn,ite_false] have h1:(w2>>>63 != 0)=true:=by simp; intro e; have:=congrArg UInt64.toNat e; rw [h4] at this;simp at this; omega have h6:(N:Int)-2^192 = -((2^192-N:Nat):Int):=by omega have hS:YC w2 w1 w0≠0:=by omega have h3:=Zcc w2 w1 w0 (by rw [hN]; exact h2);rw [hN] at h3;have hM:(Yax w2 w1 w0).toNat*2^128+(Yaw w1 w0).toNat*2^64+(Yav w0).toNat≠0:=by omega simp only [h1,ite_true,hS,ite_false];rw [<- Model.roundDyadicGeneral_eq_roundDyadic,ZaQ true _ _ _ e _ _ hM hr,ZaO true _ _ _ e hM,h3] unfold ofIntDyadic;rw [hv,h6,Int.natAbs_neg,Int.natAbs_natCast,decide_eq_true (Int.neg_neg_of_pos (Int.natCast_pos.mpr (Nat.sub_pos_of_lt hV)))] def Ybo (w2 w1 w0:UInt64) (e:Int) (negZero:Bool):UInt32 := YaT w2 w1 w0 e negZero ((Int64.ofInt e).toInt==e) (Int64.ofInt e).toUInt64 lemma Zci (w2 w1 w0:UInt64) (e:Int) (negZero:Bool) : Ybo w2 w1 w0 e negZero=finishWord (YC w2 w1 w0) e negZero := Zch w2 w1 w0 e negZero _ _ (ZaJ e) @[inline] def Yf (w:UInt32):UInt64 := if expOf w=0 then (fracOf w).toUInt64 else (fracOf w).toUInt64+0x800000 @[inline] def Yd (w:UInt32):UInt64 := if expOf w=0 then 0 else (expOf w).toUInt64-1 lemma Zk (w:UInt32):(Yf w).toNat=mantOf w:=by have:=fracOf_toNat_lt w;unfold Yf mantOf;split_ifs . simp . simp only [UInt64.toNat_add];show ((fracOf w).toNat+8388608)%2^64=2^23+(fracOf w).toNat omega lemma Zf (w:UInt32):(Yd w).toNat=idxOf w:=by unfold Yd idxOf;split_ifs with h . rfl . have h1:1 <= (expOf w).toNat:=by rcases Nat.eq_zero_or_pos (expOf w).toNat with h0 | h0 . exact absurd (UInt32.toNat_inj.mp (by simpa using h0)) h . exact h0 rw [UInt64.toNat_sub_of_le _ _ (by rw [UInt64.le_iff_toNat_le]; simp; omega)];simp lemma Zc (a b:USize) (h:a.toNat+b.toNat < USize.size) : (a+b).toNat=a.toNat+b.toNat:=by exact Nat.mod_eq_of_lt h lemma Zaa (A:Array Word) (base n k:USize) (hA:base.toNat+n.toNat <= A.size) (hs:base.toNat+n.toNat < USize.size) (h:k < n):(base+k).toNat < A.size:=by have hk:=USize.lt_iff_toNat_lt.mp h;rw [Zc _ _ (by omega)];omega lemma ZI (n k:USize) (h:k < n):n.toNat-(k+1).toNat < n.toNat-k.toNat:=by have hk:=USize.lt_iff_toNat_lt.mp h;have hn:=USize.toNat_lt_size n;rw [Zc _ _ (by simp; omega),USize.toNat_one];omega lemma ZaR (s:UInt64):(s&&&63).toNat=s.toNat%64:=by rw [UInt64.toNat_and,show (63:UInt64).toNat=2^6-1 from rfl,Nat.and_two_pow_sub_one_eq_mod] lemma Zcj (r:UInt64) (h0:r.toNat < 64):(63-r).toNat=63-r.toNat:=by rw [UInt64.toNat_sub_of_le _ _ (by rw [UInt64.le_iff_toNat_le]; show r.toNat <= 63; omega)];rfl lemma ZaS (m r:UInt64) (h0:r.toNat < 64) : (m<<>>1)>>>(63-r)).toNat=m.toNat/2^(64-r.toNat):=by rw [UInt64.toNat_shiftRight,UInt64.toNat_shiftRight,Zcj r h0,Nat.shiftRight_eq_div_pow,Nat.shiftRight_eq_div_pow,Nat.mod_eq_of_lt (show 63-r.toNat < 64 by omega), show (1:UInt64).toNat%64=1 from rfl,Nat.div_div_eq_div_mul, <- Nat.pow_add] congr 2;omega lemma ZaU (m r:Nat) (hr:r < 64) : m*2^r%2^64+m/2^(64-r)*2^64=m*2^r:=by have h:m*2^r/2^64=m/2^(64-r):=by rw [show (2:Nat)^64=2^r*2^(64-r) by rw [<- Nat.pow_add]; congr 1; omega,<- Nat.div_div_eq_div_mul,Nat.mul_div_cancel _ (Nat.two_pow_pos r)] rw [<- h];exact Nat.mod_add_div' _ _ lemma Zck (m s:UInt64) (h0:s.toNat < 64) : ((m>>>1)>>>(63-(s&&&63))).toNat*2^64+(m<<<(s&&&63)).toNat = m.toNat*2^s.toNat:=by have hr:(s&&&63).toNat=s.toNat:=by rw [ZaR]; exact Nat.mod_eq_of_lt h0 rw [ZaS _ _ (by omega),ZaT _ _ (by omega),hr] have Zh:=ZaU m.toNat s.toNat h0 omega lemma Zcl (m s:UInt64) (h1:64 <= s.toNat) (h2:s.toNat < 128) : ((m>>>1)>>>(63-(s&&&63))).toNat*2^128+(m<<<(s&&&63)).toNat*2^64 = m.toNat*2^s.toNat:=by have hr:(s&&&63).toNat=s.toNat-64:=by rw [ZaR]; omega rw [ZaS _ _ (by omega),ZaT _ _ (by omega),hr] have Zh:=ZaU m.toNat (s.toNat-64) (by omega) have hp:m.toNat*2^s.toNat=m.toNat*2^(s.toNat-64)*2^64:=by rw [Nat.mul_assoc, <- Nat.pow_add]; congr 2; omega omega lemma Zcm (m s:UInt64) (hs:s.toNat < 128) : (if s < 64 then (0:UInt64) else (m>>>1)>>>(63-(s&&&63))).toNat*2^128 + (if s < 64 then (m>>>1)>>>(63-(s&&&63)) else m<<<(s&&&63)).toNat*2^64 + (if s < 64 then m<<<(s&&&63) else 0).toNat=m.toNat*2^s.toNat:=by by_cases h:s < 64 . rw [if_pos h,if_pos h,if_pos h,UInt64.toNat_zero,Nat.zero_mul,Nat.zero_add];exact Zck m s (UInt64.lt_iff_toNat_lt.mp h) . rw [if_neg h,if_neg h,if_neg h,UInt64.toNat_zero,Nat.add_zero];exact Zcl m s (by have:=UInt64.lt_iff_toNat_lt.not.mp h; simp at this; omega) hs lemma Zab (y ng:UInt64) (h:ng.toNat <= 1) : (y^^^(0-ng)).toNat=if ng.toNat=1 then 2^64-1-y.toNat else y.toNat:=by rcases Nat.le_one_iff_eq_zero_or_eq_one.mp h with h0 | h1 . have:ng=0:=UInt64.toNat_inj.mp (by simpa using h0);subst this;simp . have:ng=1:=UInt64.toNat_inj.mp (by simpa using h1) subst this have hm:(0-1:UInt64)=⟨BitVec.allOnes 64⟩:=by decide show (y.toBitVec^^^BitVec.allOnes 64).toNat=_ rw [BitVec.xor_allOnes,BitVec.toNat_not] simp lemma ZJ (a b:UInt64) : (a+b).toNat=(a.toNat+b.toNat)%2^64 /\ (if a+b < a then (1:UInt64) else 0).toNat=(a.toNat+b.toNat)/2^64:=by have ha:a.toNat < 2^64:=UInt64.toNat_lt_size a;have hb:b.toNat < 2^64:=UInt64.toNat_lt_size b;have hs:(a+b).toNat=(a.toNat+b.toNat)%2^64:=UInt64.toNat_add a b;refine ⟨hs,?_⟩;split_ifs with h . rw [UInt64.lt_iff_toNat_lt,hs] at h;show 1=_;omega . rw [UInt64.lt_iff_toNat_lt,hs] at h;show 0=_;omega lemma Zcn (w2 w1 w0 z2 z1 z0:UInt64) : (w2+z2+((if w1+z1 < w1 then (1:UInt64) else 0) ||| (if w1+z1+(if w0+z0 < w0 then (1:UInt64) else 0) < w1+z1 then 1 else 0))).toNat * 2^128 + (w1+z1+(if w0+z0 < w0 then (1:UInt64) else 0)).toNat*2^64+(w0+z0).toNat = (w2.toNat*2^128+w1.toNat*2^64+w0.toNat + (z2.toNat*2^128+z1.toNat*2^64+z0.toNat))%2^192:=by obtain ⟨h6,h4⟩:=ZJ w0 z0;obtain ⟨h5,h3⟩:=ZJ w1 z1;generalize hk:(if w0+z0 < w0 then (1:UInt64) else 0)=k0 at h4 ⊢;obtain ⟨h7,h0⟩:=ZJ (w1+z1) k0;generalize (if w1+z1 < w1 then (1:UInt64) else 0)=ka at h3 ⊢;generalize (if w1+z1+k0 < w1+z1 then (1:UInt64) else 0)=kb at h0 ⊢;have hc:w1.toNat < 2^64:=UInt64.toNat_lt_size w1;have hb:z1.toNat < 2^64:=UInt64.toNat_lt_size z1;have h9:w0.toNat < 2^64:=UInt64.toNat_lt_size w0;have ha:z0.toNat < 2^64:=UInt64.toNat_lt_size z0;have h8:(ka|||kb).toNat=ka.toNat+kb.toNat:=by simp have:ka.toNat+kb.toNat <= 1:=by rw [h3,h0,h5]; omega -splitDisjunctions rcases Nat.lt_or_ge ka.toNat 1 with h1 | h1 <;> rcases Nat.lt_or_ge kb.toNat 1 with h2 | h2 . rw [show ka.toNat=0 by omega,show kb.toNat=0 by omega]; rfl . rw [show ka.toNat=0 by omega,Nat.zero_or]; omega . rw [show kb.toNat=0 by omega,Nat.or_zero]; omega . omega -splitDisjunctions rw [UInt64.toNat_add,UInt64.toNat_add,h8,h7,h6,h3,h0,h5,h4];omega lemma Zco (w2 w1 w0 c:UInt64) : (w2+(if w1+(if w0+c < w0 then (1:UInt64) else 0) < w1 then (1:UInt64) else 0)).toNat * 2^128 + (w1+(if w0+c < w0 then (1:UInt64) else 0)).toNat*2^64+(w0+c).toNat = (w2.toNat*2^128+w1.toNat*2^64+w0.toNat+c.toNat)%2^192:=by obtain ⟨h2,h0⟩:=ZJ w0 c;generalize (if w0+c < w0 then (1:UInt64) else 0)=k0 at h0 ⊢;obtain ⟨h1,h3⟩:=ZJ w1 k0;rw [UInt64.toNat_add,h1,h2,h3,h0];omega lemma Zcp (t2 t1 t0:UInt64) (S:Int) (h3 : -2^191 <= S) (h2:S < 2^191) (h:((t2.toNat*2^128+t1.toNat*2^64+t0.toNat:Nat):Int)=S%2^192) : YC t2 t1 t0=S:=by have h1:t1.toNat < 2^64:=UInt64.toNat_lt_size t1;have h0:t0.toNat < 2^64:=UInt64.toNat_lt_size t0;unfold YC;split_ifs with hc <;> omega lemma Zcq (t0 t1 t2:UInt64) : ((t0|||t1|||t2)==0)=decide (t2.toNat*2^128+t1.toNat*2^64+t0.toNat=0):=by have h0:t0=0 ↔ t0.toNat=0:=by rw [<- UInt64.toNat_inj]; simp have h1:t1=0 ↔ t1.toNat=0:=by rw [<- UInt64.toNat_inj]; simp have h2:t2=0 ↔ t2.toNat=0:=by rw [<- UInt64.toNat_inj]; simp rw [Bool.eq_iff_iff,beq_iff_eq,decide_eq_true_iff,UInt64.or_eq_zero_iff,UInt64.or_eq_zero_iff,h0,h1,h2] omega lemma Zcr (a b:UInt32) : ((a^^^b)>>>31).toUInt64.toNat=if Bool.xor (signOf a) (signOf b) then 1 else 0:=by have ha:a.toNat < 2^32:=UInt32.toNat_lt_size a;have hb:b.toNat < 2^32:=UInt32.toNat_lt_size b;have h0:signOf a=decide (a.toNat/2^31=1):=by unfold signOf;have h1:(a.toNat&&&2^31)%2^31=0:=by rw [Nat.and_mod_two_pow,Nat.mod_self,Nat.and_zero] have h2:(a.toNat&&&2^31)/2^31=a.toNat/2^31%2:=by rw [Nat.and_div_two_pow,Nat.div_self (Nat.two_pow_pos 31),Nat.and_one_is_mod] have h3:(a&&&0x80000000).toNat=a.toNat&&&2^31:=by simp have h4:(a&&&0x80000000 != 0)=decide ((a&&&0x80000000).toNat≠0):=by rw [Bool.eq_iff_iff,bne_iff_ne,decide_eq_true_iff,ne_eq,ne_eq, <- UInt32.toNat_inj];simp rw [h4,h3,Bool.eq_iff_iff,decide_eq_true_iff,decide_eq_true_iff];omega have h5:signOf b=decide (b.toNat/2^31=1):=by unfold signOf;have h1:(b.toNat&&&2^31)%2^31=0:=by rw [Nat.and_mod_two_pow,Nat.mod_self,Nat.and_zero] have h2:(b.toNat&&&2^31)/2^31=b.toNat/2^31%2:=by rw [Nat.and_div_two_pow,Nat.div_self (Nat.two_pow_pos 31),Nat.and_one_is_mod] have h3:(b&&&0x80000000).toNat=b.toNat&&&2^31:=by simp have h4:(b&&&0x80000000 != 0)=decide ((b&&&0x80000000).toNat≠0):=by rw [Bool.eq_iff_iff,bne_iff_ne,decide_eq_true_iff,ne_eq,ne_eq, <- UInt32.toNat_inj];simp rw [h4,h3,Bool.eq_iff_iff,decide_eq_true_iff,decide_eq_true_iff];omega rw [UInt32.toNat_toUInt64,UInt32.toNat_shiftRight,UInt32.toNat_xor,show (31:UInt32).toNat%32=31 from rfl,Nat.shiftRight_xor_distrib, Nat.shiftRight_eq_div_pow,Nat.shiftRight_eq_div_pow,h0,h5] have:a.toNat/2^31 <= 1:=by omega have:b.toNat/2^31 <= 1:=by omega rcases Nat.le_one_iff_eq_zero_or_eq_one.mp ‹a.toNat/2^31 <= 1› with h | h <;> rcases Nat.le_one_iff_eq_zero_or_eq_one.mp ‹b.toNat/2^31 <= 1› with h' | h' <;> rw [h,h'] <;> decide @[inline] def YL {β:Type} (lo:UInt64) (a b:UInt32) (w2 w1 w0 c:UInt64) (kont:UInt64 -> UInt64 -> UInt64 -> UInt64 -> β):β := let m:=Yf a*Yf b let s:=Yd a+Yd b-lo let rr:=s&&&63 let x0:=m<<>>1)>>>(63-rr) let lowq:=s < 64 let y0:=if lowq then x0 else 0 let y1:=if lowq then x1 else x0 let y2:=if lowq then 0 else x1 let ng:=((a^^^b)>>>31).toUInt64 let mk:UInt64:=0-ng let s0:=w0+(y0^^^mk) let k0:UInt64:=if s0 < w0 then 1 else 0 let u1:=w1+(y1^^^mk) let ka:UInt64:=if u1 < w1 then 1 else 0 let s1:=u1+k0 let kb:UInt64:=if s1 < u1 then 1 else 0 kont (w2+(y2^^^mk)+(ka|||kb)) s1 s0 (c+ng) def Yx (w2 w1 w0:UInt64):Nat:=w2.toNat*2^128+w1.toNat*2^64+w0.toNat lemma Zcs (m s:UInt64) (hm:m.toNat=0) : (if s < 64 then (0:UInt64) else (m>>>1)>>>(63-(s&&&63))).toNat*2^128 + (if s < 64 then (m>>>1)>>>(63-(s&&&63)) else m<<<(s&&&63)).toNat*2^64 + (if s < 64 then m<<<(s&&&63) else 0).toNat=0:=by have h0:m=0:=UInt64.toNat_inj.mp (by simpa using hm);subst h0;split_ifs <;> simp <;> rfl lemma Zg (w:UInt32):idxOf w <= 254:=by have:=expOf_toNat_lt w;unfold idxOf; split_ifs <;> omega lemma ZK (a b:UInt32):mantOf a*mantOf b < 2^48 := calc mantOf a*mantOf b < 2^24*2^24 := Nat.mul_lt_mul'' (mantOf_lt_24 a) (mantOf_lt_24 b) lemma Zr {β:Type} (lo:UInt64) (a b:UInt32) (w2 w1 w0 c:UInt64) (kont:UInt64 -> UInt64 -> UInt64 -> UInt64 -> β) (hc:c.toNat+1 < 2^64) (hw:mantOf a*mantOf b≠0 -> lo.toNat <= idxOf a+idxOf b/\idxOf a+idxOf b < lo.toNat+128) : ∃ v2 v1 v0 c',YL lo a b w2 w1 w0 c kont=kont v2 v1 v0 c' /\ c'.toNat <= c.toNat+1 /\ ((Yx v2 v1 v0+c'.toNat:Nat):Int)%2^192 = ((Yx w2 w1 w0+c.toNat:Nat)+sv a*sv b*2^(idxOf a+idxOf b-lo.toNat)) % 2^192:=by have hM:=ZK a b;have h3:=Zcr a b;have h4:(Yf a*Yf b).toNat=mantOf a*mantOf b:=by rw [UInt64.toNat_mul,Zk,Zk];exact Nat.mod_eq_of_lt (by omega -splitDisjunctions) refine ⟨_,_,_,_,rfl,?_,?_⟩;all_goals generalize Yf a*Yf b=m at h4 ⊢;generalize hs:Yd a+Yd b-lo=s;generalize ((a^^^b)>>>31).toUInt64=ng at h3 ⊢ . rw [UInt64.toNat_add] have:ng.toNat <= 1:=by rw [h3]; split_ifs <;> omega -splitDisjunctions omega -splitDisjunctions · have hY:(if s < 64 then (0:UInt64) else (m>>>1)>>>(63-(s&&&63))).toNat*2^128 + (if s < 64 then (m>>>1)>>>(63-(s&&&63)) else m<<<(s&&&63)).toNat*2^64 + (if s < 64 then m<<<(s&&&63) else 0).toNat = mantOf a*mantOf b*2^(idxOf a+idxOf b-lo.toNat):=by by_cases h0:mantOf a*mantOf b=0 . rw [h0,Nat.zero_mul]; exact Zcs m s (by rw [h4,h0]) . obtain ⟨h1,h2⟩:=hw h0;have h7:s.toNat=idxOf a+idxOf b-lo.toNat:=by rw [<- hs,UInt64.toNat_sub_of_le _ _ (by rw [UInt64.le_iff_toNat_le,UInt64.toNat_add,Zf,Zf];have:=Zg a; have:=Zg b;rw [Nat.mod_eq_of_lt (by omega -splitDisjunctions)]; omega -splitDisjunctions), UInt64.toNat_add,Zf,Zf] have:=Zg a; have:=Zg b;rw [Nat.mod_eq_of_lt (by omega -splitDisjunctions)] rw [<- h4, <- h7];exact Zcm m s (by omega) generalize (if s < 64 then (0:UInt64) else (m>>>1)>>>(63-(s&&&63)))=y2 at hY ⊢ generalize (if s < 64 then (m>>>1)>>>(63-(s&&&63)) else m<<<(s&&&63))=y1 at hY ⊢ generalize (if s < 64 then m<<<(s&&&63) else 0)=y0 at hY ⊢ have h5:ng.toNat <= 1:=by grind have z2:=Zab y2 ng h5 have z1:=Zab y1 ng h5 have z0:=Zab y0 ng h5 have hd:y2.toNat < 2^64:=UInt64.toNat_lt_size y2 have ha:y1.toNat < 2^64:=UInt64.toNat_lt_size y1 have hf:y0.toNat < 2^64:=UInt64.toNat_lt_size y0 unfold Yx rw [Zcn,UInt64.toNat_add,Nat.mod_eq_of_lt (a:=c.toNat+ng.toNat) (by omega -splitDisjunctions),<- Zn] generalize hP:mantOf a*mantOf b*2^(idxOf a+idxOf b-lo.toNat)=P at hY;have h6:(if Bool.xor (signOf a) (signOf b) then -((mantOf a*mantOf b:Nat):Int) else ((mantOf a*mantOf b:Nat):Int))*2^(idxOf a+idxOf b-lo.toNat) = if Bool.xor (signOf a) (signOf b) then -(P:Int) else (P:Int):=by rw [<- hP]; split_ifs <;> push_cast <;> ring rw [h6] have he:w0.toNat < 2^64:=UInt64.toNat_lt_size w0 have hb:w1.toNat < 2^64:=UInt64.toNat_lt_size w1 have h8:w2.toNat < 2^64:=UInt64.toNat_lt_size w2 split_ifs at h3 z2 z1 z0 ⊢ with hx h9 <;> omega @[inline] def YD (w2 w1 w0 c:UInt64) (e:Int):UInt64 := let t0:=w0+c let k0:UInt64:=if t0 < w0 then 1 else 0 let t1:=w1+k0 let k1:UInt64:=if t1 < w1 then 1 else 0 let t2:=w2+k1 if (t0|||t1|||t2)==0 then 0x100000000 else (Ybo t2 t1 t0 e false).toUInt64 lemma ZV (w2 w1 w0 c:UInt64) (e S:Int) (h0 : -2^191 <= S) (h1:S < 2^191) (h:((Yx w2 w1 w0+c.toNat:Nat):Int)%2^192=S%2^192) : YD w2 w1 w0 c e=if S=0 then 0x100000000 else (finishWord S e false).toUInt64:=by have ha:=Zco w2 w1 w0 c;unfold YD;simp only [];generalize (w0+c)=t0 at ha ⊢;generalize (w1+(if t0 < w0 then (1:UInt64) else 0))=t1 at ha ⊢;generalize (w2+(if t1 < w1 then (1:UInt64) else 0))=t2 at ha ⊢;have hv:((t2.toNat*2^128+t1.toNat*2^64+t0.toNat:Nat):Int)=S%2^192:=by rw [ha, <- h]; unfold Yx; push_cast; omega have hi:=Zcp t2 t1 t0 S h0 h1 hv;rw [Zcq];by_cases hS:S=0 . subst hS have:t2.toNat*2^128+t1.toNat*2^64+t0.toNat=0:=by omega rw [decide_eq_true this,if_pos rfl,if_pos rfl] . have:t2.toNat*2^128+t1.toNat*2^64+t0.toNat≠0:=by omega simp only [this,decide_false,Bool.false_eq_true,hS,Zci,hi] lemma Za (x:Nat) (h:x < 4294967296):x.toUSize.toNat=x:=by exact Nat.mod_eq_of_lt (Nat.lt_of_lt_of_le h USize.le_size) lemma Zac (A:Array Word) (base k:USize) (h:(base+k).toNat < A.size) (hb:base.toNat+k.toNat < USize.size) : A.uget (base+k) h=A[base.toNat+k.toNat]! := by have he:=Zc base k hb;rw [getElem!_pos A (base.toNat+k.toNat) (by omega)];show A[(base+k).toNat]=_;simp only [he] def YR (a:UInt32):Nat:=(((a&&&0x7FFFFFFF)-1)>>>23).toNat def YM (a:UInt32):Nat:=((a&&&0x7FFFFFFF)>>>23).toNat lemma Zct (a:UInt32) : (a&&&0x7FFFFFFF).toNat=(expOf a).toNat*2^23+(fracOf a).toNat:=by simp only [UInt32.toNat_and,expOf,fracOf,UInt32.toNat_shiftRight];rw [show (0x7FFFFFFF:UInt32).toNat=2^31-1 from rfl,show (0xFF:UInt32).toNat=2^8-1 from rfl,show (0x7FFFFF:UInt32).toNat=2^23-1 from rfl, show (23:UInt32).toNat%32=23 from rfl,Nat.and_two_pow_sub_one_eq_mod, Nat.and_two_pow_sub_one_eq_mod,Nat.and_two_pow_sub_one_eq_mod,Nat.shiftRight_eq_div_pow] omega lemma Zb (a:UInt32) : YR a <= 511/\YM a <= 255/\(YM a < 255 -> expOf a≠255) /\ (mantOf a≠0 -> YR a <= idxOf a+1/\idxOf a+1 <= max (YM a) 1):=by have hv:=Zct a;have hE:=expOf_toNat_lt a;have hF:=fracOf_toNat_lt a;have h3:YR a=if (a&&&0x7FFFFFFF).toNat=0 then 511 else ((a&&&0x7FFFFFFF).toNat-1)/2^23:=by unfold YR;rw [UInt32.toNat_shiftRight,UInt32.toNat_sub,show (23:UInt32).toNat%32=23 from rfl,Nat.shiftRight_eq_div_pow,show (1:UInt32).toNat=1 from rfl] split_ifs with h0 <;> omega have h4:YM a=(expOf a).toNat:=by unfold YM;rw [UInt32.toNat_shiftRight,show (23:UInt32).toNat%32=23 from rfl,Nat.shiftRight_eq_div_pow,hv] omega have h1:expOf a=0 ↔ (expOf a).toNat=0:=by rw [<- UInt32.toNat_inj]; simp have h2:expOf a=255 ↔ (expOf a).toNat=255:=by rw [<- UInt32.toNat_inj]; simp unfold mantOf idxOf;rw [h3,h4];refine ⟨by split_ifs <;> omega,by omega -splitDisjunctions,λ h he=>by rw [h2] at he; omega -splitDisjunctions,λ hm => ?_⟩;by_cases h0:expOf a=0 . rw [if_pos h0] at hm ⊢;rw [h1] at h0;split_ifs <;> omega . rw [if_neg h0] at hm ⊢;rw [h1] at h0;split_ifs <;> omega def Yah (A:Array Word) (base n:USize) (hA:base.toNat+n.toNat <= A.size) (hs:base.toNat+n.toNat < USize.size) (lo hi:UInt32) (k:USize):UInt32 := if h:k < n then let v:=A.uget (base+k) (Zaa A base n k hA hs h)&&&0x7FFFFFFF let kl:=(v-1)>>>23 let kh:=v>>>23 Yah A base n hA hs (if kl < lo then kl else lo) (if hi < kh then kh else hi) (k+1) else (lo<<<16)+hi termination_by n.toNat-k.toNat decreasing_by exact ZI n k h lemma Zcu (A:Array Word) (base n:USize) (hA:base.toNat+n.toNat <= A.size) (hs:base.toNat+n.toNat < USize.size) (lo hi:UInt32) (k:USize) (hk:k.toNat <= n.toNat) (ha:lo.toNat <= 511) (h7:hi.toNat <= 255) : ∃ L H:Nat,(Yah A base n hA hs lo hi k).toNat=L*2^16+H/\L <= 511/\H <= 255 /\ L <= lo.toNat/\hi.toNat <= H /\ ∀ t,k.toNat <= t -> t < n.toNat -> L <= YR A[base.toNat+t]! /\ YM A[base.toNat+t]! <= H:=by generalize hd:n.toNat-k.toNat=d;induction d generalizing k lo hi with | zero => have h0:¬ k < n:=by rw [USize.lt_iff_toNat_lt]; omega rw [Yah,dif_neg h0] refine ⟨lo.toNat,hi.toNat,?_,ha,h7,le_refl _,le_refl _,λ t h1 h2=>by omega⟩ rw [UInt32.toNat_add,UInt32.toNat_shiftLeft,show (16:UInt32).toNat%32=16 from rfl,Nat.shiftLeft_eq] have:lo.toNat*2^16 < 2^32:=by omega rw [Nat.mod_eq_of_lt this] omega | succ d ih => have h0:k < n:=by rw [USize.lt_iff_toNat_lt]; omega have he:(k+1).toNat=k.toNat+1:=by rw [Zc _ _ (by have:=USize.toNat_lt_size n; simp; omega),USize.toNat_one] rw [Yah,dif_pos h0] dsimp only rw [Zac A base k _ (by omega)] generalize hw:A[base.toNat+k.toNat]! = w have hf:(((w&&&0x7FFFFFFF)-1)>>>23).toNat=YR w:=rfl have hg:((w&&&0x7FFFFFFF)>>>23).toNat=YM w:=rfl obtain ⟨k1,k2, -, -⟩:=Zb w obtain ⟨L,H,h1,h2,h3,h5,h6,h4⟩:=ih (if ((w&&&0x7FFFFFFF)-1)>>>23 < lo then ((w&&&0x7FFFFFFF)-1)>>>23 else lo) (if hi < (w&&&0x7FFFFFFF)>>>23 then (w&&&0x7FFFFFFF)>>>23 else hi) (k+1) (by omega) (by split_ifs <;> omega) (by split_ifs <;> omega) (by omega) have hh:(if ((w&&&0x7FFFFFFF)-1)>>>23 < lo then ((w&&&0x7FFFFFFF)-1)>>>23 else lo).toNat <= lo.toNat/\(if ((w&&&0x7FFFFFFF)-1)>>>23 < lo then ((w&&&0x7FFFFFFF)-1)>>>23 else lo).toNat <= YR w:=by split_ifs with hc . rw [UInt32.lt_iff_toNat_lt] at hc; omega . rw [UInt32.lt_iff_toNat_lt] at hc; omega have hj:hi.toNat <= (if hi < (w&&&0x7FFFFFFF)>>>23 then (w&&&0x7FFFFFFF)>>>23 else hi).toNat/\YM w <= (if hi < (w&&&0x7FFFFFFF)>>>23 then (w&&&0x7FFFFFFF)>>>23 else hi).toNat:=by split_ifs with hc . rw [UInt32.lt_iff_toNat_lt] at hc; omega . rw [UInt32.lt_iff_toNat_lt] at hc; omega refine ⟨L,H,h1,h2,h3,by omega,by omega,λ t hb h9 => ?_⟩;rcases Nat.lt_or_ge t (k.toNat+1) with ht | ht . have h8:t=k.toNat:=by omega subst h8 rw [hw] omega . exact h4 t (by omega) h9 def YS (X W:Array Word) (xa wa n:USize) (hX:xa.toNat+n.toNat <= X.size) (hW:wa.toNat+n.toNat <= W.size) (hx:xa.toNat+n.toNat < USize.size) (hw:wa.toNat+n.toNat < USize.size) (lo:UInt64) (e:Int) (bw:UInt32) (w2 w1 w0 c:UInt64) (k:USize):UInt64 := if h:k < n then YL lo (X.uget (xa+k) (Zaa X xa n k hX hx h)) (W.uget (wa+k) (Zaa W wa n k hW hw h)) w2 w1 w0 c λ v2 v1 v0 c'=>YS X W xa wa n hX hW hx hw lo e bw v2 v1 v0 c' (k+1) else YL lo oneW bw w2 w1 w0 c λ v2 v1 v0 c'=>YD v2 v1 v0 c' e termination_by n.toNat-k.toNat decreasing_by exact ZI n k h def YB (X W:Array Word) (xa wa lo k:Nat):Nat -> Int | 0=>0 | r+1=>sv X[xa+k]! * sv W[wa+k]! * 2^(idxOf X[xa+k]! + idxOf W[wa+k]! - lo) + YB X W xa wa lo (k+1) r lemma Zcv (X W:Array Word) (xa wa n:USize) (hX:xa.toNat+n.toNat <= X.size) (hW:wa.toNat+n.toNat <= W.size) (hx:xa.toNat+n.toNat < USize.size) (hw:wa.toNat+n.toNat < USize.size) (lo:UInt64) (e:Int) (bw:UInt32) (hn:n.toNat < 2^32) (h9:mantOf oneW*mantOf bw≠0 -> lo.toNat <= idxOf oneW+idxOf bw/\idxOf oneW+idxOf bw < lo.toNat+128) : ∀ (d:Nat) (k:USize) (w2 w1 w0 c:UInt64) (S0 S:Int),n.toNat-k.toNat=d -> k.toNat <= n.toNat -> c.toNat <= k.toNat -> (∀ t,k.toNat <= t -> t < n.toNat -> mantOf X[xa.toNat+t]! * mantOf W[wa.toNat+t]! ≠ 0 -> lo.toNat <= idxOf X[xa.toNat+t]! + idxOf W[wa.toNat+t]! /\ idxOf X[xa.toNat+t]! + idxOf W[wa.toNat+t]! < lo.toNat+128) -> ((Yx w2 w1 w0+c.toNat:Nat):Int)%2^192=S0%2^192 -> S=S0+YB X W xa.toNat wa.toNat lo.toNat k.toNat (n.toNat-k.toNat) + sv oneW*sv bw*2^(idxOf oneW+idxOf bw-lo.toNat) -> -2^191 <= S -> S < 2^191 -> YS X W xa wa n hX hW hx hw lo e bw w2 w1 w0 c k = if S=0 then 0x100000000 else (finishWord S e false).toUInt64:=by intro d induction d with | zero => intro k w2 w1 w0 c S0 S hd hk hc h5 hv hS h6 h7 have h0:¬ k < n:=by rw [USize.lt_iff_toNat_lt]; omega rw [YS,dif_neg h0] obtain ⟨v2,v1,v0,c',h3,ha,h4⟩:=Zr lo oneW bw w2 w1 w0 c (λ v2 v1 v0 c'=>YD v2 v1 v0 c' e) (by omega -splitDisjunctions) h9 rw [h3];apply ZV v2 v1 v0 c' e S h6 h7;rw [h4,hS,show n.toNat-k.toNat=0 by omega -splitDisjunctions,YB];omega | succ d ih => intro k w2 w1 w0 c S0 S hd hk hc h5 hv hS h6 h7 have h0:k < n:=by rw [USize.lt_iff_toNat_lt]; omega have h8:(k+1).toNat=k.toNat+1:=by rw [Zc _ _ (by have:=USize.toNat_lt_size n; simp; omega),USize.toNat_one] rw [YS,dif_pos h0,Zac X xa k _ (by omega -splitDisjunctions),Zac W wa k _ (by omega -splitDisjunctions)] obtain ⟨v2,v1,v0,c',h3,ha,h4⟩:=Zr lo X[xa.toNat+k.toNat]! W[wa.toNat+k.toNat]! w2 w1 w0 c (λ v2 v1 v0 c'=>YS X W xa wa n hX hW hx hw lo e bw v2 v1 v0 c' (k+1)) (by omega -splitDisjunctions) (h5 k.toNat (le_refl _) (by omega)) rw [h3] refine ih (k+1) v2 v1 v0 c' (S0+sv X[xa.toNat+k.toNat]! * sv W[wa.toNat+k.toNat]! * 2^(idxOf X[xa.toNat+k.toNat]! + idxOf W[wa.toNat+k.toNat]! - lo.toNat)) S (by omega) (by omega) (by omega -splitDisjunctions) (λ t h1 h2=>h5 t (by omega -splitDisjunctions) h2) ?_ ?_ h6 h7 . rw [h4]; omega . rw [hS,show n.toNat-k.toNat=(n.toNat-(k+1).toNat)+1 by omega,YB,h8];ring lemma ZL (a b:UInt32) (lo:Nat) (h:mantOf a*mantOf b≠0 -> lo <= idxOf a+idxOf b/\idxOf a+idxOf b <= lo+122) : -(2^170:Int) <= sv a*sv b*2^(idxOf a+idxOf b-lo) /\ sv a*sv b*2^(idxOf a+idxOf b-lo) <= 2^170:=by rw [<- Zn];have hM:=ZK a b;by_cases h0:mantOf a*mantOf b=0 . rw [h0]; split_ifs <;> simp . obtain ⟨h1,h2⟩:=h h0;have hp:2^(idxOf a+idxOf b-lo) <= 2^122:=Nat.pow_le_pow_right (by norm_num) (by omega);have hP:mantOf a*mantOf b*2^(idxOf a+idxOf b-lo) <= 2^170 := calc mantOf a*mantOf b*2^(idxOf a+idxOf b-lo) <= 2^48*2^122 := Nat.mul_le_mul (by omega) hp _=2^170:=by norm_num have Zh:((mantOf a*mantOf b:Nat):Int)*2^(idxOf a+idxOf b-lo) = ((mantOf a*mantOf b*2^(idxOf a+idxOf b-lo):Nat):Int):=by push_cast; ring split_ifs . rw [neg_mul,Zh]; omega . rw [Zh]; omega lemma Zcw (X W:Array Word) (xa wa lo:Nat) : ∀ (r k:Nat),(∀ t,k <= t -> t < k+r -> mantOf X[xa+t]! * mantOf W[wa+t]! ≠ 0 -> lo <= idxOf X[xa+t]! + idxOf W[wa+t]! /\ idxOf X[xa+t]! + idxOf W[wa+t]! <= lo+122) -> -((r:Int)*2^170) <= YB X W xa wa lo k r/\YB X W xa wa lo k r <= (r:Int)*2^170:=by intro r;induction r with | zero=>intro k _; simp [YB] | succ r ih => intro k h;obtain ⟨a1,a2⟩:=ZL X[xa+k]! W[wa+k]! lo (h k (le_refl _) (by omega));obtain ⟨b1,b2⟩:=ih (k+1) (λ t h1 h2=>h t (by omega) (by omega));rw [YB];push_cast;constructor <;> linarith lemma ZW (fa fb:Nat -> UInt32) : ∀ r k,Yo fa fb k (r+1)=Yo fa fb k r + sv (fa (k+r))*sv (fb (k+r))*2^(idxOf (fa (k+r))+idxOf (fb (k+r))):=by intro r;induction r with | zero=>intro k; simp [Yo] | succ r ih => intro k;rw [Yo,ih (k+1),Yo,show k+1+r=k+(r+1) by omega];ring lemma ZA (a b:UInt32) (lo:Nat) (h:mantOf a*mantOf b≠0 -> lo <= idxOf a+idxOf b) : sv a*sv b*2^(idxOf a+idxOf b)=2^lo*(sv a*sv b*2^(idxOf a+idxOf b-lo)):=by by_cases h0:mantOf a*mantOf b=0 . have:sv a*sv b=0:=by rw [<- Zn,h0]; split_ifs <;> simp rw [this]; ring . have h1:=h h0;rw [show idxOf a+idxOf b=lo+(idxOf a+idxOf b-lo) by omega,pow_add];rw [show lo+(idxOf a+idxOf b-lo)-lo=idxOf a+idxOf b-lo by omega];ring lemma Zcx (X W:Array Word) (inW xa wa lo:Nat) (bw:UInt32) : ∀ r k,k+r <= inW -> (∀ t,k <= t -> t < k+r -> mantOf X[xa+t]! * mantOf W[wa+t]! ≠ 0 -> lo <= idxOf X[xa+t]! + idxOf W[wa+t]!) -> Yo (λ t=>if t < inW then X[xa+t]! else oneW) (λ t=>if t < inW then W[wa+t]! else bw) k r=2^lo*YB X W xa wa lo k r:=by intro r;induction r with | zero=>intro k _ _; simp [Yo,YB] | succ r ih => intro k hk h;rw [Yo,YB,ih (k+1) (by omega) (λ t h1 h2=>h t (by omega) (by omega))];simp only [show k < inW by omega,if_true];rw [ZA _ _ lo (h k (le_refl _) (by omega))];ring @[inline] def Yc (A:Array Word) (inW i:Nat):UInt32 := if h:i*inW+inW <= A.size/\i*inW+inW <= 4294967295 then Yah A (i*inW).toUSize inW.toUSize (by rw [Za _ (by omega),Za _ (by omega)]; exact h.1) (by rw [Za _ (by omega),Za _ (by omega)]; have:=USize.le_size; omega) 511 0 0 else 0x01FF00FF @[inline] def Yk (k:UInt32):UInt64:=(if k=0 then 0 else k-1).toUInt64 @[inline] def Yp (bx bv bw:UInt32):UInt64 := let lo0:=Yk (bx>>>16)+Yk (bv>>>16) let xb:=Yd oneW+Yd bw if !(Yf bw==0)&&xb < lo0 then xb else lo0 @[inline] def Yu (bx bv bw:UInt32):UInt64 := let hi0:=Yk (bx&&&0xFFFF)+Yk (bv&&&0xFFFF) let xb:=Yd oneW+Yd bw if !(Yf bw==0)&&hi0 < xb then xb else hi0 @[noinline] def Yai (X W b:Array Word) (inW i j:Nat):Word := Yn (inW+1) (λ t=>if t < inW then X[i*inW+t]! else oneW) (λ t=>if t < inW then W[j*inW+t]! else b[j]!) @[inline] def YL6 {β:Type} (lo:UInt64) (a b:UInt32) (w2 w1 w0 c:UInt64) (kont:UInt64 -> UInt64 -> UInt64 -> UInt64 -> β):β := let m:=Yf a*Yf b let s:=Yd a+Yd b-lo let rr:=s&&&63 let y0:=m<<>>1)>>>(63-rr) let ng:=((a^^^b)>>>31).toUInt64 let mk:UInt64:=0-ng let s0:=w0+(y0^^^mk) let k0:UInt64:=if s0 < w0 then 1 else 0 let u1:=w1+(y1^^^mk) let ka:UInt64:=if u1 < w1 then 1 else 0 let s1:=u1+k0 let kb:UInt64:=if s1 < u1 then 1 else 0 kont (w2+mk+(ka|||kb)) s1 s0 (c+ng) lemma YL6e {β:Type} (lo:UInt64) (a b:UInt32) (w2 w1 w0 c:UInt64) (kont:UInt64 -> UInt64 -> UInt64 -> UInt64 -> β) (h:mantOf a*mantOf b=0\/(lo.toNat <= idxOf a+idxOf b/\idxOf a+idxOf b <= lo.toNat+63)) : YL6 lo a b w2 w1 w0 c kont=YL lo a b w2 w1 w0 c kont:=by unfold YL6 YL; dsimp only by_cases hs:Yd a+Yd b-lo < 64 · simp only [hs,ite_true,UInt64.zero_xor] · have hm:Yf a*Yf b=0:=by rcases h with h|⟨h1,h2⟩ · rcases Nat.mul_eq_zero.mp h with h|h · have:Yf a=0:=UInt64.toNat_inj.mp (by rw [Zk,h]; rfl) rw [this]; simp · have:Yf b=0:=UInt64.toNat_inj.mp (by rw [Zk,h]; rfl) rw [this]; simp · exfalso; apply hs have fa:=Zf a; have fb:=Zf b; have ia:=Zg a; have ib:=Zg b rw [UInt64.lt_iff_toNat_lt,UInt64.toNat_sub_of_le _ _ (UInt64.le_iff_toNat_le.mpr (by rw [UInt64.toNat_add,fa,fb]; norm_num; omega)),UInt64.toNat_add,fa,fb] norm_num; omega simp only [hs,ite_false,hm,UInt64.zero_shiftLeft,UInt64.zero_shiftRight,UInt64.zero_xor] def YS6 (X W:Array Word) (xa wa n:USize) (hX:xa.toNat+n.toNat <= X.size) (hW:wa.toNat+n.toNat <= W.size) (hx:xa.toNat+n.toNat < USize.size) (hw:wa.toNat+n.toNat < USize.size) (lo:UInt64) (e:Int) (bw:UInt32) (w2 w1 w0 c:UInt64) (k:USize):UInt64 := if h:k < n then YL6 lo (X.uget (xa+k) (Zaa X xa n k hX hx h)) (W.uget (wa+k) (Zaa W wa n k hW hw h)) w2 w1 w0 c λ v2 v1 v0 c'=>YS6 X W xa wa n hX hW hx hw lo e bw v2 v1 v0 c' (k+1) else YL lo oneW bw w2 w1 w0 c λ v2 v1 v0 c'=>YD v2 v1 v0 c' e termination_by n.toNat-k.toNat decreasing_by exact ZI n k h lemma YS6e (X W:Array Word) (xa wa n:USize) (hX:xa.toNat+n.toNat <= X.size) (hW:wa.toNat+n.toNat <= W.size) (hx:xa.toNat+n.toNat < USize.size) (hw:wa.toNat+n.toNat < USize.size) (lo:UInt64) (e:Int) (bw:UInt32) (h5:∀ t,t < n.toNat -> mantOf X[xa.toNat+t]! * mantOf W[wa.toNat+t]! ≠ 0 -> lo.toNat <= idxOf X[xa.toNat+t]! + idxOf W[wa.toNat+t]! /\ idxOf X[xa.toNat+t]! + idxOf W[wa.toNat+t]! <= lo.toNat+63) : ∀ (d:Nat) (k:USize) (w2 w1 w0 c:UInt64),n.toNat-k.toNat=d -> YS6 X W xa wa n hX hW hx hw lo e bw w2 w1 w0 c k=YS X W xa wa n hX hW hx hw lo e bw w2 w1 w0 c k:=by intro d induction d with | zero=> intro k w2 w1 w0 c hd have h0:¬ k < n:=by rw [USize.lt_iff_toNat_lt]; omega rw [YS6,YS,dif_neg h0,dif_neg h0] | succ d ih=> intro k w2 w1 w0 c hd have h0:k < n:=by rw [USize.lt_iff_toNat_lt]; omega have h8:(k+1).toNat=k.toNat+1:=by rw [Zc _ _ (by have:=USize.toNat_lt_size n; simp; omega),USize.toNat_one] rw [YS6,YS,dif_pos h0,dif_pos h0,Zac X xa k _ (by omega),Zac W wa k _ (by omega)] have hk:=h5 k.toNat (by omega) rw [YL6e lo _ _ w2 w1 w0 c _ (by by_cases hm:mantOf X[xa.toNat+k.toNat]! * mantOf W[wa.toNat+k.toNat]! = 0; exact Or.inl hm; exact Or.inr (hk hm))] congr 1; funext v2 v1 v0 c'; exact ih (k+1) v2 v1 v0 c' (by omega) @[inline] def YL16 {β:Type} (lo:UInt64) (a b:UInt32) (h w0 c:UInt64) (kont:UInt64 -> UInt64 -> UInt64 -> β):β := let m:=Yf a*Yf b let s:=Yd a+Yd b-lo let y0:=m<<<(s&&&63) let ng:=((a^^^b)>>>31).toUInt64 let mk:UInt64:=0-ng let s0:=w0+(y0^^^mk) let k0:UInt64:=if s0 < w0 then 1 else 0 kont (h+mk+k0) s0 (c+ng) lemma sxs (h mk k0:UInt64) (hm:mk=0\/mk=0-1) (hk:k0=0\/k0=1) (hb:h.toNat ≠ 2^63-1/\h.toNat ≠ 2^63) : (0:UInt64)-(h>>>63)+mk+((if h+mk < h then (1:UInt64) else 0)|||(if h+mk+k0 < h+mk then (1:UInt64) else 0))=(0:UInt64)-((h+mk+k0)>>>63):=by have e:∀ x:UInt64,((0:UInt64)-(x>>>63)).toNat=if x.toNat < 2^63 then 0 else 2^64-1:=by intro x; have:=x.toNat_lt rw [UInt64.toNat_sub,UInt64.toNat_shiftRight,Nat.shiftRight_eq_div_pow] simp only [UInt64.toNat_zero,show (63:UInt64).toNat%64=63 from rfl] split_ifs <;> omega have h64:=h.toNat_lt apply UInt64.toNat_inj.mp rcases hm with rfl|rfl <;> rcases hk with rfl|rfl <;> split_ifs with c1 c2 <;> simp only [UInt64.lt_iff_toNat_lt,UInt64.toNat_add,e,UInt64.toNat_or,show (0-1:UInt64).toNat=2^64-1 from rfl,UInt64.toNat_zero,UInt64.toNat_one,Nat.zero_or,Nat.or_zero,Nat.or_self] at * <;> split_ifs at * <;> omega lemma sxb (h mk k0:UInt64) (k:Nat) (hm:mk=0\/mk=0-1) (hk:k0=0\/k0=1) (hh:h.toNat <= k\/2^64-k <= h.toNat) (hk2:k < 2^62) : (h+mk+k0).toNat <= k+1\/2^64-(k+1) <= (h+mk+k0).toNat:=by have h64:=h.toNat_lt rcases hm with rfl|rfl <;> rcases hk with rfl|rfl <;> simp only [UInt64.toNat_add,show (0-1:UInt64).toNat=2^64-1 from rfl,UInt64.toNat_zero,UInt64.toNat_one] <;> omega lemma shz (m r:UInt64) (hm:m.toNat < 2^48) (hr:r.toNat <= 16) : (m>>>1)>>>(63-r)=0:=by apply UInt64.toNat_inj.mp rw [UInt64.toNat_shiftRight,UInt64.toNat_shiftRight,UInt64.toNat_sub_of_le _ _ (UInt64.le_iff_toNat_le.mpr (by show r.toNat <= 63; omega)), Nat.shiftRight_eq_div_pow,Nat.shiftRight_eq_div_pow,show (63:UInt64).toNat=63 from rfl,show (1:UInt64).toNat%64=1 from rfl,UInt64.toNat_zero, Nat.mod_eq_of_lt (show 63-r.toNat < 64 by omega),Nat.div_div_eq_div_mul] apply Nat.div_eq_of_lt calc m.toNat < 2^48 := hm _ <= 2^1*2^(63-r.toNat) := by rw [<- Nat.pow_add]; exact Nat.pow_le_pow_right (by norm_num) (by omega) lemma smk (a b:UInt32):(0:UInt64)-((a^^^b)>>>31).toUInt64=0\/(0:UInt64)-((a^^^b)>>>31).toUInt64=0-1:=by have:=Zcr a b; split at this · right; rw [UInt64.toNat_inj.mp (show ((a^^^b)>>>31).toUInt64.toNat=(1:UInt64).toNat from this)] · left; rw [UInt64.toNat_inj.mp (show ((a^^^b)>>>31).toUInt64.toNat=(0:UInt64).toNat from this)]; rfl lemma YL16e {β:Type} (lo:UInt64) (a b:UInt32) (h w0 c:UInt64) (kont:UInt64 -> UInt64 -> UInt64 -> UInt64 -> β) (hc:mantOf a*mantOf b=0\/(lo.toNat <= idxOf a+idxOf b/\idxOf a+idxOf b <= lo.toNat+16)) (hb:h.toNat ≠ 2^63-1/\h.toNat ≠ 2^63) : YL lo a b ((0:UInt64)-(h>>>63)) h w0 c kont=YL16 lo a b h w0 c (λ h' v0 c'=>kont ((0:UInt64)-(h'>>>63)) h' v0 c'):=by have fa:=Zf a; have fb:=Zf b; have ia:=Zg a; have ib:=Zg b have hm0:mantOf a*mantOf b=0 -> Yf a*Yf b=0:=λ h0=>UInt64.toNat_inj.mp (by rw [UInt64.toNat_mul,Zk,Zk,h0]; rfl) have hx1:((Yf a*Yf b)>>>1)>>>(63-((Yd a+Yd b-lo)&&&63))=0:=by rcases hc with h0|⟨h1,h2⟩ · rw [hm0 h0]; simp · apply shz · rw [UInt64.toNat_mul,Zk,Zk]; have:=ZK a b; omega · rw [ZaR,UInt64.toNat_sub_of_le _ _ (UInt64.le_iff_toNat_le.mpr (by rw [UInt64.toNat_add,fa,fb]; omega)),UInt64.toNat_add,fa,fb] omega unfold YL YL16; dsimp only by_cases hs:Yd a+Yd b-lo < 64 · simp only [hs,ite_true,hx1,UInt64.zero_xor] rw [sxs h _ _ (smk a b) ?_ hb]; split <;> simp · have hm:Yf a*Yf b=0:=by rcases hc with h0|⟨h1,h2⟩ · exact hm0 h0 · exfalso; apply hs rw [UInt64.lt_iff_toNat_lt,UInt64.toNat_sub_of_le _ _ (UInt64.le_iff_toNat_le.mpr (by rw [UInt64.toNat_add,fa,fb]; omega)),UInt64.toNat_add,fa,fb] norm_num; omega simp only [hs,ite_false,hm,UInt64.zero_shiftLeft,UInt64.zero_shiftRight,UInt64.zero_xor] rw [sxs h _ _ (smk a b) ?_ hb]; split <;> simp def YS16 (X W:Array Word) (xa wa n:USize) (hX:xa.toNat+n.toNat <= X.size) (hW:wa.toNat+n.toNat <= W.size) (hx:xa.toNat+n.toNat < USize.size) (hw:wa.toNat+n.toNat < USize.size) (lo:UInt64) (e:Int) (bw:UInt32) (h w0 c:UInt64) (k:USize):UInt64 := if hk:k < n then YL16 lo (X.uget (xa+k) (Zaa X xa n k hX hx hk)) (W.uget (wa+k) (Zaa W wa n k hW hw hk)) h w0 c λ v1 v0 c'=>YS16 X W xa wa n hX hW hx hw lo e bw v1 v0 c' (k+1) else YL lo oneW bw ((0:UInt64)-(h>>>63)) h w0 c λ v2 v1 v0 c'=>YD v2 v1 v0 c' e termination_by n.toNat-k.toNat decreasing_by exact ZI n k hk lemma YS16e (X W:Array Word) (xa wa n:USize) (hX:xa.toNat+n.toNat <= X.size) (hW:wa.toNat+n.toNat <= W.size) (hx:xa.toNat+n.toNat < USize.size) (hw:wa.toNat+n.toNat < USize.size) (lo:UInt64) (e:Int) (bw:UInt32) (hn:n.toNat < 2^62) (h5:∀ t,t < n.toNat -> mantOf X[xa.toNat+t]! * mantOf W[wa.toNat+t]! ≠ 0 -> lo.toNat <= idxOf X[xa.toNat+t]! + idxOf W[wa.toNat+t]! /\ idxOf X[xa.toNat+t]! + idxOf W[wa.toNat+t]! <= lo.toNat+16) : ∀ (d:Nat) (k:USize) (h w0 c:UInt64),n.toNat-k.toNat=d -> (h.toNat <= k.toNat\/2^64-k.toNat <= h.toNat) -> YS16 X W xa wa n hX hW hx hw lo e bw h w0 c k=YS X W xa wa n hX hW hx hw lo e bw ((0:UInt64)-(h>>>63)) h w0 c k:=by intro d induction d with | zero=> intro k h w0 c hd _ have h0:¬ k < n:=by rw [USize.lt_iff_toNat_lt]; omega rw [YS16,YS,dif_neg h0,dif_neg h0] | succ d ih=> intro k h w0 c hd hb have h0:k < n:=by rw [USize.lt_iff_toNat_lt]; omega have h8:(k+1).toNat=k.toNat+1:=by rw [Zc _ _ (by have:=USize.toNat_lt_size n; simp; omega),USize.toNat_one] rw [YS16,YS,dif_pos h0,dif_pos h0,Zac X xa k _ (by omega),Zac W wa k _ (by omega)] have hk:=h5 k.toNat (by omega) rw [YL16e lo _ _ h w0 c _ (by by_cases hm:mantOf X[xa.toNat+k.toNat]! * mantOf W[wa.toNat+k.toNat]! = 0; exact Or.inl hm; exact Or.inr (hk hm)) (by have:=h.toNat_lt; omega)] unfold YL16; dsimp only apply ih (k+1) _ _ _ (by omega) rw [h8]; apply sxb h _ _ k.toNat (smk _ _) ?_ hb (by omega) split <;> simp @[inline] def YaU (X W b:Array Word) (inW i j:Nat) (bx bv:UInt32):Word := if h:i*inW+inW <= X.size/\j*inW+inW <= W.size/\i*inW+inW <= 4294967295 /\ j*inW+inW <= 4294967295/\inW < 1048576 then let bw:=b[j]! let lo:=Yp bx bv bw let hi:=Yu bx bv bw if (bx&&&0xFFFF)=255||(bv&&&0xFFFF)=255||expOf bw=255||hi < lo || hi-lo > 122 then Yai X W b inW i j else let r:=if hi-lo <= 63 then if hi-lo <= 16 then YS16 X W (i*inW).toUSize (j*inW).toUSize inW.toUSize (by rw [Za _ (by omega),Za _ (by omega)]; exact h.1) (by rw [Za _ (by omega),Za _ (by omega)]; exact h.2.1) (by rw [Za _ (by omega),Za _ (by omega)]; have:=USize.le_size; omega) (by rw [Za _ (by omega),Za _ (by omega)]; have:=USize.le_size; omega) lo ((lo.toNat:Int)-298) bw 0 0 0 0 else YS6 X W (i*inW).toUSize (j*inW).toUSize inW.toUSize (by rw [Za _ (by omega),Za _ (by omega)]; exact h.1) (by rw [Za _ (by omega),Za _ (by omega)]; exact h.2.1) (by rw [Za _ (by omega),Za _ (by omega)]; have:=USize.le_size; omega) (by rw [Za _ (by omega),Za _ (by omega)]; have:=USize.le_size; omega) lo ((lo.toNat:Int)-298) bw 0 0 0 0 0 else YS X W (i*inW).toUSize (j*inW).toUSize inW.toUSize (by rw [Za _ (by omega),Za _ (by omega)]; exact h.1) (by rw [Za _ (by omega),Za _ (by omega)]; exact h.2.1) (by rw [Za _ (by omega),Za _ (by omega)]; have:=USize.le_size; omega) (by rw [Za _ (by omega),Za _ (by omega)]; have:=USize.le_size; omega) lo ((lo.toNat:Int)-298) bw 0 0 0 0 0 if r < 0x100000000 then r.toUInt32 else Yai X W b inW i j else Yai X W b inW i j @[specialize] def Yaj (hw:Nat) (f:Nat -> Nat -> Word) (ch j:Nat) (acc:Array Word):Array Word := if j < hw then Yaj hw f ch (j+1) (acc.push (f ch j)) else acc termination_by hw-j @[specialize] def Yak (c hw:Nat) (f:Nat -> Nat -> Word) (ch:Nat) (acc:Array Word):Array Word := if ch < c then Yak c hw f (ch+1) (Yaj hw f ch 0 acc) else acc termination_by c-ch @[inline] def YT (c hw:Nat) (f:Nat -> Nat -> Word):Array Word:=Yak c hw f 0 (Array.mkEmpty (c*hw)) lemma Zcy (hw:Nat) (f:Nat -> Nat -> Word) (ch:Nat):∀ k j (acc:Array Word),hw-j=k -> (Yaj hw f ch j acc).toList=acc.toList++(List.range' j (hw-j)).map (f ch):=by intro k;induction k with | zero=>intro j acc h; unfold Yaj; rw [if_neg (by omega)]; simp [h] | succ k ih=> intro j acc h;unfold Yaj; rw [if_pos (by omega),ih (j+1) _ (by omega),show hw-j=(hw-(j+1))+1 by omega,List.range'_succ];simp lemma Zcz (c hw:Nat) (f:Nat -> Nat -> Word):∀ k ch (acc:Array Word),c-ch=k -> (Yak c hw f ch acc).toList=acc.toList++(List.range' (ch*hw) ((c-ch)*hw)).map (λ i=>f (i/hw) (i%hw)):=by intro k;induction k with | zero=>intro ch acc h; unfold Yak; rw [if_neg (by omega)]; simp [h] | succ k ih=> intro ch acc h;unfold Yak; rw [if_pos (by omega),ih (ch+1) _ (by omega),Zcy hw f ch _ 0 _ rfl, show (c-ch)*hw=hw+(c-(ch+1))*hw by rw [show c-ch=(c-(ch+1))+1 by omega,Nat.add_mul,Nat.one_mul,Nat.add_comm], <- List.range'_append,List.map_append,Nat.succ_mul] simp only [List.append_assoc,Nat.sub_zero];congr 2 . rw [show List.range' (ch*hw) hw=(List.range' 0 hw).map (ch*hw+·) by rw [List.map_add_range']; simp,List.map_map];apply List.map_congr_left;intro j hj;rw [List.mem_range'_1] at hj;simp only [Function.comp_def,Nat.add_comm (ch*hw) j,Nat.add_mul_div_right _ _ (show 0 < hw by omega),Nat.div_eq_of_lt (show j < hw by omega),Nat.zero_add,Nat.add_mul_mod_self_right,Nat.mod_eq_of_lt (show j < hw by omega)] . simp lemma ZB (c hw N:Nat) (hN:c*hw=N) (f:Nat -> Nat -> Word) : YT c hw f=Array.ofFn (n:=N) λ i=>f (i.val/hw) (i.val%hw):=by subst hN;apply Array.ext';rw [YT,Zcz c hw f _ 0 _ rfl];apply List.ext_getElem <;> simp def YaV (rows inW outW:Nat) (relu:Bool) (X W b:Array Word):Array Word := let BX:Array UInt32:=Array.ofFn (n:=rows) λ i=>Yc X inW i.val let BV:Array UInt32:=Array.ofFn (n:=outW) λ j=>Yc W inW j.val YT rows outW λ i j=>act relu (YaU X W b inW i j BX[i]! BV[j]!) lemma Zq (k:UInt32):(Yk k).toNat=k.toNat-1:=by unfold Yk;split_ifs with h . subst h; rfl . rw [UInt32.toNat_toUInt64,UInt32.toNat_sub_of_le _ _ (by rw [UInt32.le_iff_toNat_le]; have:k.toNat≠0:=λ h0=>h (UInt32.toNat_inj.mp (by simpa using h0));show 1 <= k.toNat; omega)] rfl lemma ZM (bw:UInt32):(Yd oneW+Yd bw).toNat=idxOf oneW+idxOf bw:=by rw [UInt64.toNat_add,Zf,Zf];have:=Zg oneW; have:=Zg bw;exact Nat.mod_eq_of_lt (by omega) lemma Zad (bx bv bw:UInt32) : (Yp bx bv bw).toNat <= ((bx>>>16).toNat-1)+((bv>>>16).toNat-1) /\ (mantOf bw≠0 -> (Yp bx bv bw).toNat <= idxOf oneW+idxOf bw):=by have h1:(Yk (bx>>>16)+Yk (bv>>>16)).toNat = ((bx>>>16).toNat-1)+((bv>>>16).toNat-1):=by rw [UInt64.toNat_add,Zq,Zq];have:(bx>>>16).toNat < 2^32:=UInt32.toNat_lt_size _;have:(bv>>>16).toNat < 2^32:=UInt32.toNat_lt_size _;exact Nat.mod_eq_of_lt (by omega) have h2:=ZM bw;have hm:(Yf bw==0)=decide (mantOf bw=0):=by rw [Bool.eq_iff_iff,beq_iff_eq,decide_eq_true_iff, <- Zk, <- UInt64.toNat_inj]; rfl unfold Yp;dsimp only;rw [hm];split_ifs with hc . simp only [Bool.and_eq_true,Bool.not_eq_true',decide_eq_false_iff_not,decide_eq_true_eq,UInt64.lt_iff_toNat_lt] at hc omega . simp only [Bool.and_eq_true,Bool.not_eq_true',decide_eq_false_iff_not,decide_eq_true_eq,UInt64.lt_iff_toNat_lt,not_and,not_lt] at hc constructor . omega . intro hb; have:=hc hb; omega lemma Zae (bx bv bw:UInt32) : ((bx&&&0xFFFF).toNat-1)+((bv&&&0xFFFF).toNat-1) <= (Yu bx bv bw).toNat /\ (mantOf bw≠0 -> idxOf oneW+idxOf bw <= (Yu bx bv bw).toNat):=by have h1:(Yk (bx&&&0xFFFF)+Yk (bv&&&0xFFFF)).toNat = ((bx&&&0xFFFF).toNat-1)+((bv&&&0xFFFF).toNat-1):=by rw [UInt64.toNat_add,Zq,Zq];have:(bx&&&0xFFFF).toNat < 2^32:=UInt32.toNat_lt_size _;have:(bv&&&0xFFFF).toNat < 2^32:=UInt32.toNat_lt_size _;exact Nat.mod_eq_of_lt (by omega) have h2:=ZM bw;have hm:(Yf bw==0)=decide (mantOf bw=0):=by rw [Bool.eq_iff_iff,beq_iff_eq,decide_eq_true_iff, <- Zk, <- UInt64.toNat_inj]; rfl unfold Yu;dsimp only;rw [hm];split_ifs with hc . simp only [Bool.and_eq_true,Bool.not_eq_true',decide_eq_false_iff_not,decide_eq_true_eq,UInt64.lt_iff_toNat_lt] at hc omega . simp only [Bool.and_eq_true,Bool.not_eq_true',decide_eq_false_iff_not,decide_eq_true_eq,UInt64.lt_iff_toNat_lt,not_and,not_lt] at hc constructor . omega . intro hb; have:=hc hb; omega lemma Zo (bx:UInt32) (L H:Nat) (h:bx.toNat=L*2^16+H) (hH:H < 2^16) : (bx>>>16).toNat=L/\(bx&&&0xFFFF).toNat=H:=by constructor . rw [UInt32.toNat_shiftRight,show (16:UInt32).toNat%32=16 from rfl,Nat.shiftRight_eq_div_pow,h] omega . rw [UInt32.toNat_and,show (0xFFFF:UInt32).toNat=2^16-1 from rfl,Nat.and_two_pow_sub_one_eq_mod,h] omega lemma Zaf (X W b:Array Word) (inW i j:Nat) : Yai X W b inW i j=dotOf (inW+1) (λ t=>if t < inW then X[i*inW+t]! else oneW) (λ t=>if t < inW then W[j*inW+t]! else b[j]!):=by unfold Yai; rw [Zi] lemma Zp (A:Array Word) (inW i:Nat) (h1:i*inW+inW <= A.size) (h2:i*inW+inW <= 4294967295) : ∃ L H:Nat,(Yc A inW i).toNat=L*2^16+H/\L <= 511/\H <= 255 /\ ∀ t,t < inW -> L <= YR A[i*inW+t]! /\ YM A[i*inW+t]! <= H:=by have h0:(i*inW).toUSize.toNat=i*inW:=Za _ (by omega);have h3:inW.toUSize.toNat=inW:=Za _ (by omega);unfold Yc;rw [dif_pos ⟨h1,by omega⟩];obtain ⟨L,H,e,hL,hH, -, -, h4⟩:=Zcu A (i*inW).toUSize inW.toUSize (by rw [h0,h3]; exact h1) (by rw [h0,h3]; have:=USize.le_size; omega) 511 0 0 (by simp) (by decide) (by decide) refine ⟨L,H,e,hL,hH,λ t ht => ?_⟩;have:=h4 t (by simp) (by rw [h3]; exact ht);rwa [h0] at this lemma ZcA (X W:Array Word) (inW i j:Nat) (bw:UInt32) (lo:UInt64) (p1:(i*inW).toUSize.toNat+inW.toUSize.toNat <= X.size) (p2:(j*inW).toUSize.toNat+inW.toUSize.toNat <= W.size) (p3:(i*inW).toUSize.toNat+inW.toUSize.toNat < USize.size) (p4:(j*inW).toUSize.toNat+inW.toUSize.toNat < USize.size) (h8:(i*inW).toUSize.toNat=i*inW) (h6:(j*inW).toUSize.toNat=j*inW) (h7:inW.toUSize.toNat=inW) (hn:inW < 1048576) (hb : ∀ t,t < inW -> expOf X[i*inW+t]! ≠ 255) (he : ∀ t,t < inW -> expOf W[j*inW+t]! ≠ 255) (hg:expOf bw≠255) (h5 : ∀ t,t < inW -> mantOf X[i*inW+t]! * mantOf W[j*inW+t]! ≠ 0 -> lo.toNat <= idxOf X[i*inW+t]! + idxOf W[j*inW+t]! /\ idxOf X[i*inW+t]! + idxOf W[j*inW+t]! <= lo.toNat+122) (h1:mantOf oneW*mantOf bw≠0 -> lo.toNat <= idxOf oneW+idxOf bw/\idxOf oneW+idxOf bw <= lo.toNat+122) (FB:Word) (hi:FB=dotOf (inW+1) (λ t=>if t < inW then X[i*inW+t]! else oneW) (λ t=>if t < inW then W[j*inW+t]! else bw)) : (if YS X W (i*inW).toUSize (j*inW).toUSize inW.toUSize p1 p2 p3 p4 lo ((lo.toNat:Int)-298) bw 0 0 0 0 0 < 0x100000000 then (YS X W (i*inW).toUSize (j*inW).toUSize inW.toUSize p1 p2 p3 p4 lo ((lo.toNat:Int)-298) bw 0 0 0 0 0).toUInt32 else FB) = dotOf (inW+1) (λ t=>if t < inW then X[i*inW+t]! else oneW) (λ t=>if t < inW then W[j*inW+t]! else bw):=by have hl:=Zcw X W (i*inW) (j*inW) lo.toNat inW 0 (λ t _ h2 h3=>h5 t (by omega) h3) have hm:=ZL oneW bw lo.toNat h1;generalize h9:YB X W (i*inW) (j*inW) lo.toNat 0 inW + sv oneW*sv bw*2^(idxOf oneW+idxOf bw-lo.toNat)=Srel have hh : -2^191 <= Srel:=by omega have hj:Srel < 2^191:=by omega have hc:=Zcv X W (i*inW).toUSize (j*inW).toUSize inW.toUSize p1 p2 p3 p4 lo ((lo.toNat:Int)-298) bw (by omega) (λ h=>⟨(h1 h).1,by have:=(h1 h).2; omega⟩) inW 0 0 0 0 0 0 Srel (by simp [h7]) (by simp) (by simp) (λ t _ h2 h3=>by rw [h8,h6] at h3 ⊢;have:=h5 t (by omega) h3;exact ⟨this.1,by omega⟩) (by simp [Yx]) (by rw [<- h9,h8,h6,h7]; simp) hh hj rw [hc];have hd : ∀ k,k < inW+1 -> expOf ((λ t=>if t < inW then X[i*inW+t]! else oneW) k)≠255 /\ expOf ((λ t=>if t < inW then W[j*inW+t]! else bw) k)≠255:=by intro k hk;by_cases h0:k < inW . simp only [h0]; exact ⟨hb k h0,he k h0⟩ . simp only [h0,if_false]; exact ⟨by decide,hg⟩ have hf:dotOf (inW+1) (λ t=>if t < inW then X[i*inW+t]! else oneW) (λ t=>if t < inW then W[j*inW+t]! else bw) = finishWord (Srel*2^lo.toNat) (-298) (decide (inW+1≠0) && Yq (λ t=>if t < inW then X[i*inW+t]! else oneW) (λ t=>if t < inW then W[j*inW+t]! else bw) 0 (inW+1)):=by rw [Zy (inW+1) _ _ hd];congr 1;rw [ZW,Zcx X W inW (i*inW) (j*inW) lo.toNat bw inW 0 (by omega) (λ t _ h2 h3=>(h5 t (by omega) h3).1)] simp;rw [ZA oneW bw lo.toNat (λ h=>(h1 h).1), <- h9];ring by_cases h4:Srel=0 . rw [if_pos h4,if_neg (by decide),hi] . rw [if_neg h4];have ha:(finishWord Srel ((lo.toNat:Int)-298) false).toUInt64 < 0x100000000:=by simp_all;have:(finishWord Srel ((lo.toNat:Int)-298) false).toNat < 2^32 := UInt32.toNat_lt_size _ exact this rw [if_pos ha,hf, <- finishWord_scale];have e1:(finishWord Srel ((lo.toNat:Int)-298) false).toUInt64.toUInt32 = finishWord Srel ((lo.toNat:Int)-298) false:=by apply UInt32.toNat_inj.mp;simp rw [e1];unfold finishWord;rw [if_neg h4,if_neg h4,show (-298:Int)+(lo.toNat:Int)=(lo.toNat:Int)-298 by ring] lemma ZcB (X W b:Array Word) (inW i j:Nat) : YaU X W b inW i j (Yc X inW i) (Yc W inW j) = dotOf (inW+1) (λ t=>if t < inW then X[i*inW+t]! else oneW) (λ t=>if t < inW then W[j*inW+t]! else b[j]!):=by have ZQa:∀ {L r i:Nat},L <= r -> r <= i+1 -> L-1 <= i:=by intros;omega have ZQb:∀ {m H i:Nat},m <= H -> i+1 <= max m 1 -> i <= H-1:=by intros;omega have ZQ:∀ {p u a b c d B:Nat} {x w:Word},p <= (a-1)+(b-1) -> (c-1)+(d-1) <= u -> u-p <= B -> (a <= YR x/\YM x <= c) -> (b <= YR w/\YM w <= d) -> mantOf x*mantOf w≠0 -> p <= idxOf x+idxOf w/\idxOf x+idxOf w <= p+B:= λ {p u a b c d B} {x w} wl wh d5 r1 r2 hm=>have k1:=(Zb x).2.2.2 (left_ne_zero_of_mul hm);have k2:=(Zb w).2.2.2 (right_ne_zero_of_mul hm);⟨wl.trans (Nat.add_le_add (ZQa r1.1 k1.1) (ZQa r2.1 k2.1)),(Nat.add_le_add (ZQb r1.2 k1.2) (ZQb r2.2 k2.2)).trans (wh.trans (Nat.sub_le_iff_le_add'.mp d5))⟩ unfold YaU;split . rename_i hg;obtain ⟨hk,ha,hi,hf,hd⟩:=hg;have hh:(i*inW).toUSize.toNat=i*inW:=Za _ (by omega -splitDisjunctions);have hb:(j*inW).toUSize.toNat=j*inW:=Za _ (by omega -splitDisjunctions);have he:inW.toUSize.toNat=inW:=Za _ (by omega -splitDisjunctions);obtain ⟨Lx,Hx,h5,hl,hp,h1⟩:=Zp X inW i hk hi;obtain ⟨Lv,Hv,h4,hq,ho,h8⟩:=Zp W inW j ha hf;generalize Yc X inW i=bx at h5 ⊢;generalize Yc W inW j=bv at h4 ⊢;obtain ⟨hj,h3⟩:=Zo bx Lx Hx h5 (by omega -splitDisjunctions);obtain ⟨h9,h7⟩:=Zo bv Lv Hv h4 (by omega -splitDisjunctions);obtain ⟨wl1,wl2⟩:=Zad bx bv b[j]!;obtain ⟨wh1,wh2⟩:=Zae bx bv b[j]!;dsimp only;split . exact Zaf X W b inW i j . rename_i hc;have c1:¬ (bx&&&0xFFFF)=255:=λ h=>hc (by simp [h]);have c2:¬ (bv&&&0xFFFF)=255:=λ h=>hc (by simp [h]);have c3:¬ expOf b[j]! = 255:=λ h=>hc (by simp [h]);have c4:¬ Yu bx bv b[j]! < Yp bx bv b[j]! := λ h=>hc (by simp [h]);have c5:¬ Yu bx bv b[j]! - Yp bx bv b[j]! > 122:=λ h=>hc (by simp [h]);have d1:Hx≠255:=λ h=>c1 (UInt32.toNat_inj.mp (by rw [h3,h]; rfl));have d2:Hv≠255:=λ h=>c2 (UInt32.toNat_inj.mp (by rw [h7,h]; rfl));have d4:(Yp bx bv b[j]!).toNat <= (Yu bx bv b[j]!).toNat:=by rw [UInt64.lt_iff_toNat_lt] at c4; omega -splitDisjunctions have d5:(Yu bx bv b[j]!).toNat-(Yp bx bv b[j]!).toNat <= 122:=by rw [gt_iff_lt,UInt64.lt_iff_toNat_lt,UInt64.toNat_sub_of_le _ _ (UInt64.le_iff_toNat_le.mpr d4)] at c5 simp only [not_lt] at c5;exact c5 rw [hj,h9] at wl1;rw [h3,h7] at wh1 by_cases h63:Yu bx bv b[j]! - Yp bx bv b[j]! <= 63 . rw [if_pos h63] have d6:(Yu bx bv b[j]!).toNat-(Yp bx bv b[j]!).toNat <= 63:=by rw [UInt64.le_iff_toNat_le,UInt64.toNat_sub_of_le _ _ (UInt64.le_iff_toNat_le.mpr d4)] at h63; exact h63 by_cases h16:Yu bx bv b[j]! - Yp bx bv b[j]! <= 16 . rw [if_pos h16] have d7:(Yu bx bv b[j]!).toNat-(Yp bx bv b[j]!).toNat <= 16:=by rw [UInt64.le_iff_toNat_le,UInt64.toNat_sub_of_le _ _ (UInt64.le_iff_toNat_le.mpr d4)] at h16; exact h16 rw [YS16e X W (i*inW).toUSize (j*inW).toUSize inW.toUSize _ _ _ _ (Yp bx bv b[j]!) _ b[j]! (by rw [he]; omega) (λ t ht hm=>by rw [hh,hb] at hm ⊢; rw [he] at ht; exact ZQ wl1 wh1 d7 (h1 t ht) (h8 t ht) hm) inW.toUSize.toNat 0 0 0 0 (by simp) (by simp),show (0:UInt64)-((0:UInt64)>>>63)=0 from rfl] apply ZcA X W inW i j b[j]! (Yp bx bv b[j]!) _ _ _ _ hh hb he hd . intro t ht;exact (Zb X[i*inW+t]!).2.2.1 (by have:=(h1 t ht).2; omega) . intro t ht;exact (Zb W[j*inW+t]!).2.2.1 (by have:=(h8 t ht).2; omega) . exact c3 . exact λ t ht hm=>ZQ wl1 wh1 d5 (h1 t ht) (h8 t ht) hm . intro hm;have h0:mantOf b[j]! ≠ 0:=λ h=>hm (by rw [h,Nat.mul_zero]);have:=wl2 h0;have:=wh2 h0;clear hm h0 c1 c2 c3 c5 wl2 wh2;constructor <;> omega . exact Zaf X W b inW i j . rw [if_neg h16] rw [YS6e X W (i*inW).toUSize (j*inW).toUSize inW.toUSize _ _ _ _ (Yp bx bv b[j]!) _ b[j]! (λ t ht hm=>by rw [hh,hb] at hm ⊢; rw [he] at ht; exact ZQ wl1 wh1 d6 (h1 t ht) (h8 t ht) hm) inW.toUSize.toNat 0 0 0 0 0 (by simp)] apply ZcA X W inW i j b[j]! (Yp bx bv b[j]!) _ _ _ _ hh hb he hd . intro t ht;exact (Zb X[i*inW+t]!).2.2.1 (by have:=(h1 t ht).2; omega) . intro t ht;exact (Zb W[j*inW+t]!).2.2.1 (by have:=(h8 t ht).2; omega) . exact c3 . exact λ t ht hm=>ZQ wl1 wh1 d5 (h1 t ht) (h8 t ht) hm . intro hm;have h0:mantOf b[j]! ≠ 0:=λ h=>hm (by rw [h,Nat.mul_zero]);have:=wl2 h0;have:=wh2 h0;clear hm h0 c1 c2 c3 c5 wl2 wh2;constructor <;> omega . exact Zaf X W b inW i j . rw [if_neg h63] apply ZcA X W inW i j b[j]! (Yp bx bv b[j]!) _ _ _ _ hh hb he hd . intro t ht;exact (Zb X[i*inW+t]!).2.2.1 (by have:=(h1 t ht).2; omega) . intro t ht;exact (Zb W[j*inW+t]!).2.2.1 (by have:=(h8 t ht).2; omega) . exact c3 . exact λ t ht hm=>ZQ wl1 wh1 d5 (h1 t ht) (h8 t ht) hm . intro hm;have h0:mantOf b[j]! ≠ 0:=λ h=>hm (by rw [h,Nat.mul_zero]);have:=wl2 h0;have:=wh2 h0;clear hm h0 c1 c2 c3 c5 wl2 wh2;constructor <;> omega . exact Zaf X W b inW i j . exact Zaf X W b inW i j lemma ZcC:YaV=linearSpec:=by funext rows inW outW relu X W b;unfold YaV linearSpec linearWith;rw [ZB _ _ _ rfl];congr 1;funext q;have hq:=q.isLt;have h0:0 < outW:=by rcases Nat.eq_zero_or_pos outW with h | h . subst h; simp at hq . exact h have hi:q.val/outW < rows:=Nat.div_lt_of_lt_mul (lt_of_lt_of_eq hq (Nat.mul_comm rows outW));have hj:q.val%outW < outW:=Nat.mod_lt _ h0;rw [Ze rows (λ i=>Yc X inW i) _ hi,Ze outW (λ j=>Yc W inW j) _ hj,ZcB] lemma ZaV (x y:FloatLib.Numerics.Dyadic) (h:(Model.addDyadic x y).significand=0) : (Model.addDyadic x y).negative=(x.negative&&y.negative):=by unfold Model.addDyadic FloatLib.Numerics.Dyadic.add FloatLib.Numerics.Dyadic.addFields at h ⊢;dsimp only at h ⊢;split_ifs at h ⊢ <;> simp_all lemma ZaW (d:FloatLib.Numerics.Dyadic) (h:d.significand=0) : Model.roundDyadic Fmt d=Model.zero Fmt d.negative:=by rw [Model.roundDyadic_eq_roundDyadicImpl];unfold Model.roundDyadicImpl;rw [if_pos (by decide)];unfold Model.ieeeRoundDyadicImpl;rw [if_pos (by simp [h])];cases d.negative <;> rfl lemma ZN (k:Nat):(2:ℚ)^((k:ℤ)-149)=2^k*2^(-149:ℤ):=by rw [sub_eq_add_neg,zpow_add₀ two_ne_zero,zpow_natCast] lemma ZcD (a b:Word) (ha:expOf a≠255) (hb:expOf b≠255) : toWord (Model.add (ofW a) (ofW b)) = finishWord (sv a*2^idxOf a+sv b*2^idxOf b) (-149) (signOf a&&signOf b):=by rw [Model.Proof.add_eq_spec];simp only [Model.Spec.add,ofW,toDyadic_ofUInt32 a ha,toDyadic_ofUInt32 b hb];have h0:(Model.addDyadic (decodeD a) (decodeD b)).toRat = ((sv a*2^idxOf a+sv b*2^idxOf b:Int):ℚ)*2^(-149:ℤ):=by rw [Model.addDyadic,FloatLib.Numerics.Dyadic.add_toRat,decodeD_toRat,decodeD_toRat,ZN,ZN] push_cast; ring by_cases hS:sv a*2^idxOf a+sv b*2^idxOf b=0 . have hz:(Model.addDyadic (decodeD a) (decodeD b)).significand=0:=by simp_all rw [ZaW _ hz,ZaV _ _ hz,decodeD_negative,decodeD_negative,hS,finishWord_zero] . exact (finishWord_of_ne _ _ _ _ hS h0).symm @[inline] def Yl (w:Word):UInt64 := if expOf w=0 then (fracOf w).toUInt64 else (fracOf w).toUInt64+0x800000 lemma Zs (w:Word):(Yl w).toNat=mantOf w:=by have hf:=fracOf_toNat_lt w;unfold Yl mantOf;split . simp . rw [UInt64.toNat_add,UInt32.toNat_toUInt64,show (0x800000:UInt64).toNat=2^23 from rfl,Nat.mod_eq_of_lt (by omega)] omega lemma ZcJ (m:UInt64) (neg:Bool) (hm:m.toNat < 2^63) : Ym (if neg then 0-m else m)=if neg then -(m.toNat:Int) else (m.toNat:Int):=by cases neg . simp only [Bool.false_eq_true,ite_false,Ym];rw [if_pos hm];simp . simp only [ite_true,Ym];rw [UInt64.toNat_sub,show (0:UInt64).toNat=0 from rfl];by_cases h0:m.toNat=0 . rw [h0]; norm_num . have h1:(2^64-m.toNat+0)%2^64=2^64-m.toNat:=by omega rw [h1,if_neg (by omega)];omega lemma ZcK (x:UInt64) : -2^63 <= Ym x/\Ym x < 2^63:=by have:=x.toNat_lt_size;simp only [UInt64.size] at this;unfold Ym;split <;> omega lemma ZaZ (x y:UInt64) (h1 : -2^63 <= Ym x+Ym y) (h2:Ym x+Ym y < 2^63):Ym (x+y)=Ym x+Ym y:=by unfold Ym at h1 h2 ⊢;rw [UInt64.toNat_add];split_ifs at h1 h2 ⊢ <;> omega lemma ZcL (m:UInt64) (d:Nat) (hd:d < 64) (h:m.toNat*2^d < 2^64) : (m<< simp [Nat.cast_mul,Nat.cast_pow] lemma Zai (w:Word) : (if signOf w then -((Yl w).toNat:Int) else ((Yl w).toNat:Int))=sv w:=by rw [Zs]; rfl lemma ZO:sv oneW=2^23/\idxOf oneW=126:=by decide lemma Za0 (a b:Word) (e:Nat) (h:mantOf a*mantOf b≠0 -> e < 128) : -2^175 < sv a*sv b*2^e/\sv a*sv b*2^e < 2^175:=by rw [<- Zn];have hM:=ZK a b;by_cases h0:mantOf a*mantOf b=0 . rw [h0]; simp . have he:=h h0 have hb:((mantOf a*mantOf b:Nat):Int)*2^e < 2^175:=by have h1:(mantOf a*mantOf b)*2^e < 2^48*2^127 := Nat.mul_lt_mul_of_lt_of_le hM (Nat.pow_le_pow_right (by norm_num) (by omega)) (by positivity) have h2:(2:Nat)^48*2^127=2^175:=by simp rw [h2] at h1 exact_mod_cast h1 have h3:(0:Int) <= ((mantOf a*mantOf b:Nat):Int)*2^e:=by grind split <;> constructor <;> nlinarith lemma ZcN (S e:Int) (n1 n2:Bool) (h:S≠0) : finishWord S e n1=finishWord S e n2:=by simp [finishWord,h] lemma ZcO (m1 m2 p q:UInt64) : (m1≠0 -> (if m1=0 then q else if m2=0 then p else if p <= q then p else q) <= p) /\ (m2≠0 -> (if m1=0 then q else if m2=0 then p else if p <= q then p else q) <= q):=by grind @[inline] def Yal (a b c d:Word) (nz:Bool) (slow:Unit -> Word):Word := let p:=Yd a+Yd b let q:=Yd c+Yd d let m1:=Yf a*Yf b let m2:=Yf c*Yf d let lo:=if m1=0 then q else if m2=0 then p else if p <= q then p else q if (m1=0\/p-lo < 128)/\(m2=0\/q-lo < 128) then YL lo a b 0 0 0 0 λ w2 w1 w0 k => YL lo c d w2 w1 w0 k λ v2 v1 v0 k' => let r:=YD v2 v1 v0 k' ((lo.toNat:Int)-298) if r=0x100000000 then (if nz then 0x80000000 else 0) else r.toUInt32 else slow () lemma Za1 (a b c d:Word) (nz:Bool) (slow:Unit -> Word) (h9:slow ()=finishWord (sv a*sv b*2^(idxOf a+idxOf b) + sv c*sv d*2^(idxOf c+idxOf d)) (-298) nz) : Yal a b c d nz slow=finishWord (sv a*sv b*2^(idxOf a+idxOf b) + sv c*sv d*2^(idxOf c+idxOf d)) (-298) nz:=by unfold Yal;dsimp only;have ia:=Zg a;have ib:=Zg b;have ic:=Zg c;have id:=Zg d;have hp:(Yd a+Yd b).toNat=idxOf a+idxOf b:=by rw [UInt64.toNat_add,Zf,Zf,Nat.mod_eq_of_lt (by omega)] have hq:(Yd c+Yd d).toNat=idxOf c+idxOf d:=by rw [UInt64.toNat_add,Zf,Zf,Nat.mod_eq_of_lt (by omega)] have hc:(Yf a*Yf b).toNat=mantOf a*mantOf b:=by rw [UInt64.toNat_mul,Zk,Zk];exact Nat.mod_eq_of_lt (by have:=ZK a b; omega) have hd:(Yf c*Yf d).toNat=mantOf c*mantOf d:=by rw [UInt64.toNat_mul,Zk,Zk];exact Nat.mod_eq_of_lt (by have:=ZK c d; omega) have z1:Yf a*Yf b=0 ↔ mantOf a*mantOf b=0:=by rw [<- hc, <- UInt64.toNat_inj]; rfl have z2:Yf c*Yf d=0 ↔ mantOf c*mantOf d=0:=by rw [<- hd, <- UInt64.toNat_inj]; rfl obtain ⟨L1,L2⟩:=ZcO (Yf a*Yf b) (Yf c*Yf d) (Yd a+Yd b) (Yd c+Yd d) generalize hg:(if Yf a*Yf b=0 then Yd c+Yd d else if Yf c*Yf d=0 then Yd a+Yd b else if Yd a+Yd b <= Yd c+Yd d then Yd a+Yd b else Yd c+Yd d)=lo at L1 L2 ⊢ split . rename_i h6;have F1:mantOf a*mantOf b≠0 -> lo.toNat <= idxOf a+idxOf b/\idxOf a+idxOf b < lo.toNat+128:=by intro h0;have hm:Yf a*Yf b≠0:=λ h=>h0 (z1.mp h);have h3:=L1 hm;have h1:Yd a+Yd b-lo < 128:=by rcases h6.1 with h | h . exact absurd h hm . exact h rw [UInt64.le_iff_toNat_le,hp] at h3;rw [UInt64.lt_iff_toNat_lt,UInt64.toNat_sub_of_le _ _ (L1 hm),hp] at h1;simp at h1;omega have F2:mantOf c*mantOf d≠0 -> lo.toNat <= idxOf c+idxOf d/\idxOf c+idxOf d < lo.toNat+128:=by intro h0;have hm:Yf c*Yf d≠0:=λ h=>h0 (z2.mp h);have h3:=L2 hm;have h1:Yd c+Yd d-lo < 128:=by rcases h6.2 with h | h . exact absurd h hm . exact h rw [UInt64.le_iff_toNat_le,hq] at h3;rw [UInt64.lt_iff_toNat_lt,UInt64.toNat_sub_of_le _ _ (L2 hm),hq] at h1;simp at h1;omega obtain ⟨w2,w1,w0,k,e1,hk,hv⟩:=Zr lo a b 0 0 0 0 (λ w2 w1 w0 k=>YL lo c d w2 w1 w0 k λ v2 v1 v0 k' => let r:=YD v2 v1 v0 k' ((lo.toNat:Int)-298);if r=0x100000000 then (if nz then (0x80000000:UInt32) else 0) else r.toUInt32) (by simp) F1 rw [e1];obtain ⟨v2,v1,v0,k',e2,hf,h8⟩:=Zr lo c d w2 w1 w0 k (λ v2 v1 v0 k' => let r:=YD v2 v1 v0 k' ((lo.toNat:Int)-298);if r=0x100000000 then (if nz then (0x80000000:UInt32) else 0) else r.toUInt32) (by simp at hk; omega) F2 rw [e2];dsimp only;have h5:=Za0 a b (idxOf a+idxOf b-lo.toNat) (λ h0=>by have:=F1 h0; omega) have h4:=Za0 c d (idxOf c+idxOf d-lo.toNat) (λ h0=>by have:=F2 h0; omega) have ha:Yx 0 0 0=0:=rfl;rw [ha,show (0:UInt64).toNat=0 from rfl] at hv;have hb:((Yx v2 v1 v0+k'.toNat:Nat):Int)%2^192 = (sv a*sv b*2^(idxOf a+idxOf b-lo.toNat) + sv c*sv d*2^(idxOf c+idxOf d-lo.toNat))%2^192:=by rw [h8];push_cast at hv ⊢;rw [Int.add_emod,hv, <- Int.add_emod];simp rw [ZV v2 v1 v0 k' _ _ (by linarith [h5.1,h4.1]) (by linarith [h5.2,h4.2]) hb];have hS:sv a*sv b*2^(idxOf a+idxOf b)+sv c*sv d*2^(idxOf c+idxOf d) = (sv a*sv b*2^(idxOf a+idxOf b-lo.toNat) + sv c*sv d*2^(idxOf c+idxOf d-lo.toNat))*2^lo.toNat:=by have e1:=ZC (sv a*sv b) (idxOf a+idxOf b) lo.toNat (by by_cases h0:mantOf a*mantOf b=0 . left; rw [<- Zn,h0]; simp . right; exact (F1 h0).1) have e2:=ZC (sv c*sv d) (idxOf c+idxOf d) lo.toNat (by by_cases h0:mantOf c*mantOf d=0 . left; rw [<- Zn,h0]; simp . right; exact (F2 h0).1) rw [e1,e2]; ring by_cases hz:sv a*sv b*2^(idxOf a+idxOf b-lo.toNat) + sv c*sv d*2^(idxOf c+idxOf d-lo.toNat)=0 . rw [if_pos hz,if_pos rfl,hS,hz,zero_mul];cases nz <;> rfl . rw [if_neg hz];have h7:(finishWord (sv a*sv b*2^(idxOf a+idxOf b-lo.toNat) + sv c*sv d*2^(idxOf c+idxOf d-lo.toNat)) ((lo.toNat:Int)-298) false).toUInt64 ≠ 0x100000000:=by intro h;have h2:=congrArg UInt64.toNat h;rw [UInt32.toNat_toUInt64] at h2;have:=UInt32.toNat_lt_size (finishWord (sv a*sv b*2^(idxOf a+idxOf b-lo.toNat) + sv c*sv d*2^(idxOf c+idxOf d-lo.toNat)) ((lo.toNat:Int)-298) false) simp only [UInt32.size] at this;simp at h2;omega rw [if_neg h7,UInt32.toUInt32_toUInt64,hS,show ((lo.toNat:Int)-298) = -298+(lo.toNat:Int) by ring,finishWord_scale] apply ZcN;intro h;apply hz;have he:(2:Int)^lo.toNat≠0:=pow_ne_zero _ two_ne_zero;exact (mul_eq_zero.mp h).resolve_right he . exact h9 @[inline] def Y1 (ma mb:UInt64) (ia ib:Nat):Nat := if ma=0 then ib else if mb=0 then ia else min ia ib lemma Za2 (ma mb:UInt64) (ia ib:Nat) : (ma=0\/Y1 ma mb ia ib <= ia)/\(mb=0\/Y1 ma mb ia ib <= ib):=by unfold Y1;refine ⟨?_,?_⟩ <;> split_ifs <;> first | (left; assumption) | (right; omega) @[inline] def YaW (sa:Bool) (ma:UInt64) (ia:Nat) (sb:Bool) (mb:UInt64) (ib:Nat) (sh:Int) (nz:Bool) (slow:Unit -> Word):Word := let k:=Y1 ma mb ia ib let da:=ia-k let db:=ib-k if da <= 38/\db <= 38 then let ta:=ma<< Word) (h5:ma.toNat < 2^24) (h0:mb.toNat < 2^24) (h6:slow ()=finishWord ((if sa then -(ma.toNat:Int) else ma.toNat)*2^ia + (if sb then -(mb.toNat:Int) else mb.toNat)*2^ib) sh nz) : YaW sa ma ia sb mb ib sh nz slow = finishWord ((if sa then -(ma.toNat:Int) else ma.toNat)*2^ia + (if sb then -(mb.toNat:Int) else mb.toNat)*2^ib) sh nz:=by unfold YaW;dsimp only;split . rename_i hd;obtain ⟨h8,h7⟩:=Za2 ma mb ia ib;set k:=Y1 ma mb ia ib;have hA:=ZY ma (ia-k) sa (by omega -splitDisjunctions) (by calc ma.toNat*2^(ia-k) < 2^24*2^38 := Nat.mul_lt_mul_of_lt_of_le h5 (Nat.pow_le_pow_right (by norm_num) hd.1) (by positivity) _=2^62:=by norm_num) have hB:=ZY mb (ib-k) sb (by omega -splitDisjunctions) (by calc mb.toNat*2^(ib-k) < 2^24*2^38 := Nat.mul_lt_mul_of_lt_of_le h0 (Nat.pow_le_pow_right (by norm_num) hd.2) (by positivity) _=2^62:=by norm_num) have h9:=ZcK (if sa then 0-(ma<<<(ia-k).toUInt64) else ma<<<(ia-k).toUInt64);rw [ZaL,ZaZ _ _ ?_ ?_,hA,hB] . rw [show ((k:Int)+sh)=sh+(k:Int) by ring,finishWord_scale];congr 1;have e1:=ZC (if sa then -(ma.toNat:Int) else ma.toNat) ia k (by rcases h8 with h | h . left; subst h; simp . right; exact h) have e2:=ZC (if sb then -(mb.toNat:Int) else mb.toNat) ib k (by rcases h7 with h | h . left; subst h; simp . right; exact h) rw [e1,e2]; ring . rw [hA,hB] have h1:(ma.toNat*2^(ia-k):Int) < 2^62:=by exact_mod_cast (by calc ma.toNat*2^(ia-k) < 2^24*2^38 := Nat.mul_lt_mul_of_lt_of_le h5 (Nat.pow_le_pow_right (by norm_num) hd.1) (by positivity) _=2^62:=by norm_num) have h2:(mb.toNat*2^(ib-k):Int) < 2^62:=by exact_mod_cast (by calc mb.toNat*2^(ib-k) < 2^24*2^38 := Nat.mul_lt_mul_of_lt_of_le h0 (Nat.pow_le_pow_right (by norm_num) hd.2) (by positivity) _=2^62:=by norm_num) have h3:(0:Int) <= ma.toNat*2^(ia-k):=by simp have h4:(0:Int) <= mb.toNat*2^(ib-k):=by simp cases sa <;> cases sb <;> simp <;> nlinarith . rw [hA,hB] have h1:(ma.toNat*2^(ia-k):Int) < 2^62:=by exact_mod_cast (by calc ma.toNat*2^(ia-k) < 2^24*2^38 := Nat.mul_lt_mul_of_lt_of_le h5 (Nat.pow_le_pow_right (by norm_num) hd.1) (by positivity) _=2^62:=by norm_num) have h2:(mb.toNat*2^(ib-k):Int) < 2^62:=by exact_mod_cast (by calc mb.toNat*2^(ib-k) < 2^24*2^38 := Nat.mul_lt_mul_of_lt_of_le h0 (Nat.pow_le_pow_right (by norm_num) hd.2) (by positivity) _=2^62:=by norm_num) have h3:(0:Int) <= ma.toNat*2^(ia-k):=by simp have h4:(0:Int) <= mb.toNat*2^(ib-k):=by simp cases sa <;> cases sb <;> simp <;> nlinarith . exact h6 @[inline] def YaX (a b:Word):Word := if expOf a=255\/expOf b=255 then toWord (Model.add (ofW a) (ofW b)) else YaW (signOf a) (Yl a) (idxOf a) (signOf b) (Yl b) (idxOf b) (-149) (signOf a&&signOf b) (λ _=>Yal a oneW b oneW (signOf a&&signOf b) (λ _=>toWord (Model.add (ofW a) (ofW b)))) lemma ZcQ (a b:Word):YaX a b=toWord (Model.add (ofW a) (ofW b)):=by unfold YaX;split . rfl . rename_i h;have ha:expOf a≠255:=λ h'=>h (Or.inl h');have hb:expOf b≠255:=λ h'=>h (Or.inr h');have hS:=ZcD a b ha hb;have h2:toWord (Model.add (ofW a) (ofW b))=finishWord (sv a*sv oneW*2^(idxOf a + idxOf oneW)+sv b*sv oneW*2^(idxOf b+idxOf oneW)) (-298) (signOf a&&signOf b):=by rw [hS,ZO.1,ZO.2,show (-149:Int) = -298+((149:Nat):Int) by norm_num,finishWord_scale] congr 1;rw [pow_add,pow_add]; ring have hT:Yal a oneW b oneW (signOf a&&signOf b) (λ _=>toWord (Model.add (ofW a) (ofW b)))=toWord (Model.add (ofW a) (ofW b)):=by rw [Za1 _ _ _ _ _ _ h2,h2] rw [<- Zai a, <- Zai b] at hS;rw [ZcP _ _ _ _ _ _ _ _ _ (by rw [Zs]; exact mantOf_lt_24 a) (by rw [Zs]; exact mantOf_lt_24 b) (by rw [hT]; exact hS),hS] @[specialize] def YE (n:USize) (fx fw:(t:USize) -> t < n -> Word) (lo:UInt64) (e:Int) (bx bw:UInt32) (w2 w1 w0 c:UInt64) (k:USize):UInt64 := if h:k < n then YL lo (fx k h) (fw k h) w2 w1 w0 c λ v2 v1 v0 c' => YE n fx fw lo e bx bw v2 v1 v0 c' (k+1) else YL lo bx bw w2 w1 w0 c λ v2 v1 v0 c'=>YD v2 v1 v0 c' e termination_by n.toNat-k.toNat decreasing_by exact ZI n k h def Yr (fa fb:Nat -> Word) (lo k:Nat):Nat -> Int | 0=>0 | r+1=>sv (fa k)*sv (fb k)*2^(idxOf (fa k)+idxOf (fb k)-lo)+Yr fa fb lo (k+1) r lemma Za5 (n:USize) (fx fw:(t:USize) -> t < n -> Word) (Yi fwN:Nat -> Word) (h9 : ∀ t h,fx t h=Yi t.toNat) (he : ∀ t h,fw t h=fwN t.toNat) (lo:UInt64) (e:Int) (bx bw:UInt32) (hn:n.toNat < 2^32) (hb:mantOf bx*mantOf bw≠0 -> lo.toNat <= idxOf bx+idxOf bw/\idxOf bx+idxOf bw < lo.toNat+128) : ∀ (d:Nat) (k:USize) (w2 w1 w0 c:UInt64) (S0 S:Int),n.toNat-k.toNat=d -> k.toNat <= n.toNat -> c.toNat <= k.toNat -> (∀ t,k.toNat <= t -> t < n.toNat -> mantOf (Yi t)*mantOf (fwN t)≠0 -> lo.toNat <= idxOf (Yi t)+idxOf (fwN t)/\idxOf (Yi t)+idxOf (fwN t) < lo.toNat+128) -> ((Yx w2 w1 w0+c.toNat:Nat):Int)%2^192=S0%2^192 -> S=S0+Yr Yi fwN lo.toNat k.toNat (n.toNat-k.toNat) + sv bx*sv bw*2^(idxOf bx+idxOf bw-lo.toNat) -> -2^191 <= S -> S < 2^191 -> YE n fx fw lo e bx bw w2 w1 w0 c k = if S=0 then 0x100000000 else (finishWord S e false).toUInt64:=by intro d induction d with | zero => intro k w2 w1 w0 c S0 S hd hk hc h5 hv hS h6 h7 have h0:¬ k < n:=by rw [USize.lt_iff_toNat_lt]; omega rw [YE,dif_neg h0] obtain ⟨v2,v1,v0,c',h3,ha,h4⟩:=Zr lo bx bw w2 w1 w0 c (λ v2 v1 v0 c'=>YD v2 v1 v0 c' e) (by omega) hb rw [h3];apply ZV v2 v1 v0 c' e S h6 h7;rw [h4,hS,show n.toNat-k.toNat=0 by omega,Yr];omega | succ d ih => intro k w2 w1 w0 c S0 S hd hk hc h5 hv hS h6 h7 have h0:k < n:=by rw [USize.lt_iff_toNat_lt]; omega have h8:(k+1).toNat=k.toNat+1:=by rw [Zc _ _ (by have:=USize.toNat_lt_size n; simp; omega),USize.toNat_one] rw [YE,dif_pos h0,h9,he] obtain ⟨v2,v1,v0,c',h3,ha,h4⟩:=Zr lo (Yi k.toNat) (fwN k.toNat) w2 w1 w0 c (λ v2 v1 v0 c'=>YE n fx fw lo e bx bw v2 v1 v0 c' (k+1)) (by omega) (h5 k.toNat (le_refl _) (by omega)) rw [h3] refine ih (k+1) v2 v1 v0 c' (S0+sv (Yi k.toNat)*sv (fwN k.toNat) * 2^(idxOf (Yi k.toNat)+idxOf (fwN k.toNat)-lo.toNat)) S (by omega) (by omega) (by omega) (λ t h1 h2=>h5 t (by omega) h2) ?_ ?_ h6 h7 . rw [h4]; omega . rw [hS,show n.toNat-k.toNat=(n.toNat-(k+1).toNat)+1 by omega,Yr,h8];ring lemma Zaj (fa fb:Nat -> Word) (lo:Nat) : ∀ (r k:Nat),(∀ t,k <= t -> t < k+r -> mantOf (fa t)*mantOf (fb t)≠0 -> lo <= idxOf (fa t)+idxOf (fb t)/\idxOf (fa t)+idxOf (fb t) <= lo+122) -> -((r:Int)*2^170) <= Yr fa fb lo k r/\Yr fa fb lo k r <= (r:Int)*2^170:=by intro r;induction r with | zero=>intro k _; simp [Yr] | succ r ih => intro k h;obtain ⟨a1,a2⟩:=ZL (fa k) (fb k) lo (h k (le_refl _) (by omega));obtain ⟨b1,b2⟩:=ih (k+1) (λ t h1 h2=>h t (by omega) (by omega));rw [Yr];push_cast;constructor <;> linarith lemma Z0 (wts:Array Word) (o k:Nat) (h:o*k+k <= wts.size/\o*k+k <= 4294967295) (t:USize) (ht:t < k.toUSize) : ((o*k).toUSize+t).toNat=o*k+t.toNat/\o*k+t.toNat < wts.size:=by have h0:k.toUSize.toNat=k:=Za _ (by omega) have h1:t.toNat < k:=by rw [USize.lt_iff_toNat_lt,h0] at ht; exact ht have hp:(o*k).toUSize.toNat=o*k:=Za _ (by omega) refine ⟨?_,by omega⟩ rw [Zc _ _ (by rw [hp]; have:=USize.le_size; omega),hp] lemma Zt (A B C q:Nat) (hq:q < A*(B*C)):q/C%B < B/\q%C < C/\q/(B*C) < A:=by have h0:0 < B*C:=by rcases Nat.eq_zero_or_pos (B*C) with h | h . rw [h,Nat.mul_zero] at hq; omega . exact h have hB:0 < B:=Nat.pos_of_mul_pos_right h0;have hC:0 < C:=Nat.pos_of_mul_pos_left h0;exact ⟨Nat.mod_lt _ hB,Nat.mod_lt _ hC,Nat.div_lt_of_lt_mul (by rwa [Nat.mul_comm] at hq)⟩ lemma ZcX (fa fb:Nat -> Word) (lo:Nat) : ∀ r k,(∀ t,k <= t -> t < k+r -> mantOf (fa t)*mantOf (fb t)≠0 -> lo <= idxOf (fa t)+idxOf (fb t)) -> Yo fa fb k r=2^lo*Yr fa fb lo k r:=by intro r;induction r with | zero=>intro k _; simp [Yo,Yr] | succ r ih => intro k h;rw [Yo,Yr,ih (k+1) (λ t h1 h2=>h t (by omega) (by omega)), ZA _ _ lo (h k (le_refl _) (by omega))] ring lemma ZcY (K:Nat) (fx fw:(t:USize) -> t < K.toUSize -> Word) (Yi fwN:Nat -> Word) (ha : ∀ t h,fx t h=Yi t.toNat) (he : ∀ t h,fw t h=fwN t.toNat) (lo:UInt64) (hK:K < 1048576) (h7 : ∀ t,t < K -> expOf (Yi t)≠255) (h9 : ∀ t,t < K -> expOf (fwN t)≠255) (h1 : ∀ t,t < K -> mantOf (Yi t)*mantOf (fwN t)≠0 -> lo.toNat <= idxOf (Yi t)+idxOf (fwN t)/\idxOf (Yi t)+idxOf (fwN t) <= lo.toNat+122) (FB:Word) (hf:FB=dotOf K Yi fwN) : (if YE K.toUSize fx fw lo ((lo.toNat:Int)-298) 0 0 0 0 0 0 0 < 0x100000000 then (YE K.toUSize fx fw lo ((lo.toNat:Int)-298) 0 0 0 0 0 0 0).toUInt32 else FB) = dotOf K Yi fwN:=by have h4:K.toUSize.toNat=K:=Za _ (by omega) have hh:=Zaj Yi fwN lo.toNat K 0 (λ t _ h2 h3=>h1 t (by omega) h3) have hc:sv (0:UInt32)=0:=by decide generalize h5:Yr Yi fwN lo.toNat 0 K=Srel have hd : -2^191 <= Srel:=by omega have hg:Srel < 2^191:=by omega have h8:=Za5 K.toUSize fx fw Yi fwN ha he lo ((lo.toNat:Int)-298) 0 0 (by omega) (λ h=>absurd (by decide:mantOf (0:UInt32)*mantOf 0=0) h) K 0 0 0 0 0 0 Srel (by simp [h4]) (by simp) (by simp) (λ t _ h2 h3=>by have:=h1 t (by omega) h3;exact ⟨this.1,by omega⟩) (by simp [Yx]) (by rw [<- h5,h4,hc]; simp) hd hg rw [h8];have hb:dotOf K Yi fwN = finishWord (Srel*2^lo.toNat) (-298) (decide (K≠0)&&Yq Yi fwN 0 K):=by rw [Zy K Yi fwN (λ t ht=>⟨h7 t ht,h9 t ht⟩)];congr 1;rw [ZcX Yi fwN lo.toNat K 0 (λ t _ h2 h3=>(h1 t (by omega) h3).1), <- h5];ring by_cases h0:Srel=0 . rw [if_pos h0,if_neg (by decide),hf] . rw [if_neg h0];have h6:(finishWord Srel ((lo.toNat:Int)-298) false).toUInt64 < 0x100000000:=by simp_all;have:(finishWord Srel ((lo.toNat:Int)-298) false).toNat < 2^32 := UInt32.toNat_lt_size _ exact this rw [if_pos h6,hb, <- finishWord_scale];have e1:(finishWord Srel ((lo.toNat:Int)-298) false).toUInt64.toUInt32 = finishWord Srel ((lo.toNat:Int)-298) false:=by apply UInt32.toNat_inj.mp;simp rw [e1];unfold finishWord;rw [if_neg h0,if_neg h0,show (-298:Int)+(lo.toNat:Int)=(lo.toNat:Int)-298 by ring] lemma Zbb (B:Array Word) (k n bk j:Nat) (h:(bk+k)*n <= B.size/\j < n/\B.size <= 4294967295) (hk:k < 1048576) (t:USize) (ht:t < k.toUSize) : ((bk*n+j).toUSize+t*n.toUSize).toNat=(bk+t.toNat)*n+j /\ (bk+t.toNat)*n+j < B.size:=by have h1:k.toUSize.toNat=k:=Za _ (by omega) have h3:t.toNat < k:=by rw [USize.lt_iff_toNat_lt,h1] at ht; exact ht have h0:(bk+t.toNat)*n+j < B.size:=by calc (bk+t.toNat)*n+j < (bk+t.toNat)*n+n:=by omega _=(bk+t.toNat+1)*n:=by ring _ <= (bk+k)*n:=Nat.mul_le_mul_right _ (by omega) _ <= B.size:=h.1 have e1:(bk+t.toNat)*n+j=(bk*n+j)+t.toNat*n:=by ring have hb:(bk*n+j).toUSize.toNat=bk*n+j:=Za _ (by omega) have h2:n <= (bk+k)*n:=Nat.le_mul_of_pos_left n (by omega) have hn:n.toUSize.toNat=n:=Za _ (by omega) have hm:(t*n.toUSize).toNat=t.toNat*n:=by simp exact Nat.mod_eq_of_lt (by have:=USize.le_size; rw [<- USize.size_eq_two_pow] at *; omega) refine ⟨?_,h0⟩;rw [Zc _ _ (by rw [hb,hm]; have:=USize.le_size; omega),hb,hm,e1] @[noinline] def Yan (A B:Array Word) (k n r bk j:Nat):Word := Yn k (λ t=>A[r*k+t]!) (λ t=>B[(bk+t)*n+j]!) lemma Zam (A B:Array Word) (k n r bk j:Nat) : Yan A B k n r bk j=dotOf k (λ t=>A[r*k+t]!) (λ t=>B[(bk+t)*n+j]!):=by unfold Yan; rw [Zi] @[specialize] def YE16 (n:USize) (fx fw:(t:USize) -> t < n -> Word) (lo:UInt64) (e:Int) (bx bw:UInt32) (h w0 c:UInt64) (k:USize):UInt64 := if hk:k < n then YL16 lo (fx k hk) (fw k hk) h w0 c λ v1 v0 c' => YE16 n fx fw lo e bx bw v1 v0 c' (k+1) else YL lo bx bw ((0:UInt64)-(h>>>63)) h w0 c λ v2 v1 v0 c'=>YD v2 v1 v0 c' e termination_by n.toNat-k.toNat decreasing_by exact ZI n k hk lemma YE16e (n:USize) (fx fw:(t:USize) -> t < n -> Word) (Yi fwN:Nat -> Word) (ha : ∀ t h,fx t h=Yi t.toNat) (he : ∀ t h,fw t h=fwN t.toNat) (lo:UInt64) (e:Int) (bx bw:UInt32) (hn:n.toNat < 2^62) (h5:∀ t,t < n.toNat -> mantOf (Yi t)*mantOf (fwN t)≠0 -> lo.toNat <= idxOf (Yi t)+idxOf (fwN t)/\idxOf (Yi t)+idxOf (fwN t) <= lo.toNat+16) : ∀ (d:Nat) (k:USize) (h w0 c:UInt64),n.toNat-k.toNat=d -> (h.toNat <= k.toNat\/2^64-k.toNat <= h.toNat) -> YE16 n fx fw lo e bx bw h w0 c k=YE n fx fw lo e bx bw ((0:UInt64)-(h>>>63)) h w0 c k:=by intro d induction d with | zero=> intro k h w0 c hd _ have h0:¬ k < n:=by rw [USize.lt_iff_toNat_lt]; omega rw [YE16,YE,dif_neg h0,dif_neg h0] | succ d ih=> intro k h w0 c hd hb have h0:k < n:=by rw [USize.lt_iff_toNat_lt]; omega have h8:(k+1).toNat=k.toNat+1:=by rw [Zc _ _ (by have:=USize.toNat_lt_size n; simp; omega),USize.toNat_one] rw [YE16,YE,dif_pos h0,dif_pos h0,ha k h0,he k h0] have hk:=h5 k.toNat (by omega) rw [YL16e lo _ _ h w0 c _ (by by_cases hm:mantOf (Yi k.toNat) * mantOf (fwN k.toNat) = 0; exact Or.inl hm; exact Or.inr (hk hm)) (by have:=h.toNat_lt; omega)] unfold YL16; dsimp only apply ih (k+1) _ _ _ (by omega) rw [h8]; apply sxb h _ _ k.toNat (smk _ _) ?_ hb (by omega) split <;> simp @[inline] def Ya2 (A B:Array Word) (k n r bk j:Nat) (ba bb:UInt32) (hk:k < 1048576) : Word := if h:r*k+k <= A.size/\r*k+k <= 4294967295/\((bk+k)*n <= B.size/\j < n /\ B.size <= 4294967295) then let lo:=Yp ba bb 0 let hi:=Yu ba bb 0 if (ba&&&0xFFFF)=255||(bb&&&0xFFFF)=255||hi < lo||hi-lo > 122 then Yan A B k n r bk j else let r':=if hi-lo <= 16 then YE16 k.toUSize (λ t ht=>A.uget ((r*k).toUSize+t) (by have:=Z0 A r k ⟨h.1,h.2.1⟩ t ht rw [this.1]; exact this.2)) (λ t ht=>B.uget ((bk*n+j).toUSize+t*n.toUSize) (by have:=Zbb B k n bk j h.2.2 hk t ht rw [this.1]; exact this.2)) lo ((lo.toNat:Int)-298) 0 0 0 0 0 0 else YE k.toUSize (λ t ht=>A.uget ((r*k).toUSize+t) (by have:=Z0 A r k ⟨h.1,h.2.1⟩ t ht rw [this.1]; exact this.2)) (λ t ht=>B.uget ((bk*n+j).toUSize+t*n.toUSize) (by have:=Zbb B k n bk j h.2.2 hk t ht rw [this.1]; exact this.2)) lo ((lo.toNat:Int)-298) 0 0 0 0 0 0 0 if r' < 0x100000000 then r'.toUInt32 else Yan A B k n r bk j else Yan A B k n r bk j lemma ZcZ (A B:Array Word) (k n r bk j:Nat) (hk:k < 1048576) : Ya2 A B k n r bk j (Yc A k r) (Yc B B.size 0) hk = dotOf k (λ t=>A[r*k+t]!) (λ t=>B[(bk+t)*n+j]!):=by have ZQa:∀ {L r i:Nat},L <= r -> r <= i+1 -> L-1 <= i:=by intros;omega have ZQb:∀ {m H i:Nat},m <= H -> i+1 <= max m 1 -> i <= H-1:=by intros;omega have ZQ:∀ {p u a b c d B:Nat} {x w:Word},p <= (a-1)+(b-1) -> (c-1)+(d-1) <= u -> u-p <= B -> (a <= YR x/\YM x <= c) -> (b <= YR w/\YM w <= d) -> mantOf x*mantOf w≠0 -> p <= idxOf x+idxOf w/\idxOf x+idxOf w <= p+B:= λ {p u a b c d B} {x w} wl wh d5 r1 r2 hm=>have k1:=(Zb x).2.2.2 (left_ne_zero_of_mul hm);have k2:=(Zb w).2.2.2 (right_ne_zero_of_mul hm);⟨wl.trans (Nat.add_le_add (ZQa r1.1 k1.1) (ZQa r2.1 k2.1)),(Nat.add_le_add (ZQb r1.2 k1.2) (ZQb r2.2 k2.2)).trans (wh.trans (Nat.sub_le_iff_le_add'.mp d5))⟩ unfold Ya2;split . rename_i hg;obtain ⟨Lx,Hx,h6,hd,hh,h0⟩:=Zp A k r hg.1 hg.2.1;obtain ⟨Lv,Hv,h4,hi,hf,h9⟩:=Zp B B.size 0 (by omega) (by omega);generalize Yc A k r=bx at h6 ⊢;generalize Yc B B.size 0=bv at h4 ⊢;obtain ⟨hb,h3⟩:=Zo bx Lx Hx h6 (by omega);obtain ⟨ha,h8⟩:=Zo bv Lv Hv h4 (by omega);obtain ⟨wl1, -⟩:=Zad bx bv 0;obtain ⟨wh1, -⟩:=Zae bx bv 0;dsimp only;split . exact Zam A B k n r bk j . rename_i hc;have c1:¬ (bx&&&0xFFFF)=255:=λ h=>hc (by simp [h]);have c2:¬ (bv&&&0xFFFF)=255:=λ h=>hc (by simp [h]);have c4:¬ Yu bx bv 0 < Yp bx bv 0:=λ h=>hc (by simp [h]);have c5:¬ Yu bx bv 0-Yp bx bv 0 > 122:=λ h=>hc (by simp [h]);have d1:Hx≠255:=λ h=>c1 (UInt32.toNat_inj.mp (by rw [h3,h]; rfl));have d2:Hv≠255:=λ h=>c2 (UInt32.toNat_inj.mp (by rw [h8,h]; rfl));have d4:(Yp bx bv 0).toNat <= (Yu bx bv 0).toNat:=by rw [UInt64.lt_iff_toNat_lt] at c4; omega have d5:(Yu bx bv 0).toNat-(Yp bx bv 0).toNat <= 122:=by rw [gt_iff_lt,UInt64.lt_iff_toNat_lt,UInt64.toNat_sub_of_le _ _ (UInt64.le_iff_toNat_le.mpr d4)] at c5 simp only [not_lt] at c5;exact c5 rw [hb,ha] at wl1;rw [h3,h8] at wh1;have h5 : ∀ t,t < k -> (bk+t)*n+j < B.size:=by intro t ht calc (bk+t)*n+j < (bk+t)*n+n:=by omega _=(bk+t+1)*n:=by ring _ <= (bk+k)*n:=Nat.mul_le_mul_right _ (by omega) _ <= B.size:=hg.2.2.1 have h2 : ∀ t,t < k -> B[(bk+t)*n+j]! = B[0*B.size+((bk+t)*n+j)]! := by simp have hkk:k.toUSize.toNat=k:=Za _ (by omega) by_cases h16:Yu bx bv 0 - Yp bx bv 0 <= 16 . rw [if_pos h16] have d7:(Yu bx bv 0).toNat-(Yp bx bv 0).toNat <= 16:=by rw [UInt64.le_iff_toNat_le,UInt64.toNat_sub_of_le _ _ (UInt64.le_iff_toNat_le.mpr d4)] at h16; exact h16 rw [YE16e k.toUSize _ _ (λ t=>A[r*k+t]!) (λ t=>B[(bk+t)*n+j]!) ?_ ?_ (Yp bx bv 0) _ 0 0 ?_ ?_ k.toUSize.toNat 0 0 0 0 (by simp) (by simp),show (0:UInt64)-((0:UInt64)>>>63)=0 from rfl] apply ZcY k _ _ (λ t=>A[r*k+t]!) (λ t=>B[(bk+t)*n+j]!) _ _ (Yp bx bv 0) hk . intro t ht;exact (Zb _).2.2.1 (by have:=(h0 t ht).2; omega) . intro t ht;rw [h2 t ht];exact (Zb _).2.2.1 (by have:=(h9 _ (h5 t ht)).2; omega) . intro t ht hm;rw [h2 t ht] at hm ⊢;exact ZQ wl1 wh1 d5 (h0 t ht) (h9 _ (h5 t ht)) hm . exact Zam A B k n r bk j . intro t ht;obtain ⟨e1,e2⟩:=Z0 A r k ⟨hg.1,hg.2.1⟩ t ht;show A[((r*k).toUSize+t).toNat]=_;rw [<- getElem!_pos A _ (by rw [e1]; exact e2)];simp only [e1] . intro t ht;obtain ⟨e1,e2⟩:=Zbb B k n bk j hg.2.2 hk t ht;show B[((bk*n+j).toUSize+t*n.toUSize).toNat]=_;rw [<- getElem!_pos B _ (by rw [e1]; exact e2)];simp only [e1] . intro t ht;obtain ⟨e1,e2⟩:=Z0 A r k ⟨hg.1,hg.2.1⟩ t ht;show A[((r*k).toUSize+t).toNat]=_;rw [<- getElem!_pos A _ (by rw [e1]; exact e2)];simp only [e1] . intro t ht;obtain ⟨e1,e2⟩:=Zbb B k n bk j hg.2.2 hk t ht;show B[((bk*n+j).toUSize+t*n.toUSize).toNat]=_;rw [<- getElem!_pos B _ (by rw [e1]; exact e2)];simp only [e1] . rw [hkk]; omega . intro t ht hm;rw [hkk] at ht;(try dsimp only at hm ⊢);rw [h2 t ht] at hm ⊢;exact ZQ wl1 wh1 d7 (h0 t ht) (h9 _ (h5 t ht)) hm . rw [if_neg h16] apply ZcY k _ _ (λ t=>A[r*k+t]!) (λ t=>B[(bk+t)*n+j]!) _ _ (Yp bx bv 0) hk . intro t ht;exact (Zb _).2.2.1 (by have:=(h0 t ht).2; omega) . intro t ht;rw [h2 t ht];exact (Zb _).2.2.1 (by have:=(h9 _ (h5 t ht)).2; omega) . intro t ht hm;rw [h2 t ht] at hm ⊢;exact ZQ wl1 wh1 d5 (h0 t ht) (h9 _ (h5 t ht)) hm . exact Zam A B k n r bk j . intro t ht;obtain ⟨e1,e2⟩:=Z0 A r k ⟨hg.1,hg.2.1⟩ t ht;show A[((r*k).toUSize+t).toNat]=_;rw [<- getElem!_pos A _ (by rw [e1]; exact e2)];simp only [e1] . intro t ht;obtain ⟨e1,e2⟩:=Zbb B k n bk j hg.2.2 hk t ht;show B[((bk*n+j).toUSize+t*n.toUSize).toNat]=_;rw [<- getElem!_pos B _ (by rw [e1]; exact e2)];simp only [e1] . exact Zam A B k n r bk j def Ya3 (batch m k n:Nat) (A B:Array Word):Array Word := if hk:k < 1048576 then let bb:=Yc B B.size 0 let BA:Array UInt32:=Array.ofFn (n:=batch*m) λ r=>Yc A k r.val YT (batch*m) n λ r j=>Ya2 A B k n r (r/m*k) j BA[r]! bb hk else gemmWith Yn batch m k n A B lemma Zc0:Ya3=gemmSpec:=by funext batch m k n A B;unfold Ya3 gemmSpec;split . rename_i hk rw [ZB _ _ _ (Nat.mul_assoc _ _ _)] congr 1 funext q have g1:∀ v:Nat,v/n=v/(m*n)*m+v/n%m:=by intro v; rw [Nat.mul_comm m n,<- Nat.div_div_eq_div_mul]; exact (Nat.div_add_mod' _ _).symm have g2:∀ v:Nat,v/n/m=v/(m*n):=by intro v; rw [Nat.div_div_eq_div_mul,Nat.mul_comm n m] rw [g2 q.val]; conv_lhs => rw [g1 q.val] obtain ⟨hi,hj,hb⟩:=Zt batch m n q.val q.isLt have hr:q.val/(m*n)*m+q.val/n%m < batch*m:=by calc q.val/(m*n)*m+q.val/n%m < q.val/(m*n)*m+m:=by omega _=(q.val/(m*n)+1)*m:=by ring _ <= batch*m:=Nat.mul_le_mul_right _ (by omega) rw [Ze (batch*m) (λ r=>Yc A k r) _ hr];exact ZcZ A B k n _ _ _ hk . simp only [Zi] section open ExactRuntime FloatLib.Floats.Formats.BinaryInterchange FloatLib.Floats FloatLib.Numerics open Model open RationalBinary (floorLog2 scaleByPowerOfTwo scaleByPowerOfTwo_snd_ne_zero) open FloatLib.Numerics (binaryRadix Radix.toReal) lemma bz (e:Int):bpow e=(2:ℝ)^e:=by simp [bpow,FloatLib.Floats.Formats.Flocq.bpow,binaryRadix,Radix.toReal] lemma cW (w:UInt32):toWord (NativeBinary32.ofUInt32 w)=w:=by simp only [toWord,NativeBinary32.ofUInt32,toNatBits,ofBits]; exact UInt32.ofNat_toNat lemma cU {a b:Int} {v:ℝ} (h1:bpow a<=v) (h2:v roundQuotientEven (scaleByPowerOfTwo n d x).1 (scaleByPowerOfTwo n d x).2= roundQuotientEven (scaleByPowerOfTwo n' d' x').1 (scaleByPowerOfTwo n' d' x').2:=λ x x' h=>by apply roundQuotientEven_eq_of_rat_eq _ _ _ _ (scaleByPowerOfTwo_snd_ne_zero _ _ _ hd) (scaleByPowerOfTwo_snd_ne_zero _ _ _ h0);rw [scaleByPowerOfTwo_real,scaleByPowerOfTwo_real]; simp only [scaledRatToReal];rwa [mul_assoc,<- bpow_add,mul_assoc,<- bpow_add,add_sub_cancel,add_sub_cancel] at h rw [roundRatScaled_false_eq_of_isIEEE f n d e hf hn hd,roundRatScaled_false_eq_of_isIEEE f n' d' e' hf h5 h0];simp only [];rw [hQ _ (e'+Int.ofNat (FloatFormat.subnormalAlignExp f)) (by rw [hv]; ring_nf),hQ _ (Int.ofNat f.fracWidth-floorLog2 n' d') (by rw [hv,show Int.ofNat f.fracWidth-floorLog2 n d-e=Int.ofNat f.fracWidth-floorLog2 n' d'-e' by omega]),hT] lemma Zbd (Q:ℚ) (s:Bool) (N D:Nat) (E:Int) (hD:0 0simp_all obtain rfl:Q=0:=by simp [hQ] simp [roundRatScaled_num_zero _ _ _ _ hD.ne']; rfl have hv:(0:ℚ)simp [neg_div] have h0:Q.num.natAbs≠0:=by simpa using (show Q≠0 by rw [hQ]; cases s<;>simp [hv.ne']) have hR:(0:ℝ)push_cast<;>simp [abs_of_pos hR] rw [show decide (Q<0)=s by rw [hQ]; cases s<;>simp [hv,not_lt.mpr hv.le]];cases s . exact cV _ hf _ _ _ _ _ _ h0 Q.den_nz hN hD.ne' h1 . rw [roundRatScaled_true_eq_neg_false _ _ _ _ hf Q.den_nz,roundRatScaled_true_eq_neg_false _ _ _ _ hf hD.ne',cV _ hf _ _ _ _ _ _ h0 Q.den_nz hN hD.ne' h1] lemma Zc1 (q u D r:Nat) (hu:2 <= u) (he:u%2=0) (hr:0 < r) (h0:r < D) : roundQuotientEven (q*D+r) (D*u)=roundQuotientEven (2*q+1) (2*u):=by have hD:0 < D:=by omega have e1:(q*D+r)/D=q:=by rw [Nat.mul_comm,Nat.mul_add_div hD,Nat.div_eq_of_lt h0,Nat.add_zero] have e2:(q*D+r)%D=r:=by rw [Nat.mul_comm,Nat.mul_add_mod,Nat.mod_eq_of_lt h0] have h1:(q*D+r)/(D*u)=q/u:=by rw [<- Nat.div_div_eq_div_mul,e1] have h2:(q*D+r)%(D*u)=r+D*(q%u):=by rw [Nat.mod_mul,e2,e1] have h3:(2*q+1)/(2*u)=q/u:=by rw [<- Nat.div_div_eq_div_mul]; congr 1; omega have h4:(2*q+1)%(2*u)=1+2*(q%u):=by rw [Nat.mod_mul,show (2*q+1)%2=1 by omega,show (2*q+1)/2=q by omega] unfold roundQuotientEven; simp only [h1,h2,h3,h4];generalize q%u=a at * by_cases hc:2*a+2 <= u . have:D*(2*a+2) <= D*u:=Nat.mul_le_mul_left _ hc have hl:2*(r+D*a) < D*u:=by grind have:2*(1+2*a) < 2*u:=by omega simp [hl,this] . have h5:u <= 2*a:=by omega have:D*u <= D*(2*a):=Nat.mul_le_mul_left _ h5 have hl:D*u < 2*(r+D*a):=by grind have:¬ 2*(r+D*a) < D*u:=by omega have:¬ 2*(1+2*a) < 2*u:=by omega have:2*u < 2*(1+2*a):=by omega simp [*] lemma Zbe (n d n' d':Nat) (x:Int) (hd:d≠0) (h0:d'≠0) (hv:(n':ℝ)/d'=n/d*bpow x) : roundQuotientEven (scaleByPowerOfTwo n d x).1 (scaleByPowerOfTwo n d x).2=roundQuotientEven n' d':=by apply roundQuotientEven_eq_of_rat_eq _ _ _ _ (scaleByPowerOfTwo_snd_ne_zero _ _ _ hd) h0;rw [scaleByPowerOfTwo_real,hv]; rfl lemma Zh (q D r m:Nat) (x y:Int) (hm:1 <= m) (hx:x = -(m:ℤ)-1) (hy:y = -(m:ℤ)) (hr:0 < r) (h0:r < D) : roundQuotientEven (scaleByPowerOfTwo (2*q+1) 1 x).1 (scaleByPowerOfTwo (2*q+1) 1 x).2 = roundQuotientEven (scaleByPowerOfTwo (D*q+r) D y).1 (scaleByPowerOfTwo (D*q+r) D y).2:=by subst hx hy have hD:D≠0:=by omega have v1:(((2*q+1:ℕ)):ℝ)/((2*2^m:ℕ):ℝ)=((2*q+1:ℕ):ℝ)/((1:ℕ):ℝ)*bpow (-(m:ℤ)-1):=by rw [bz,show (-(m:ℤ)-1) = -((m+1:ℕ):ℤ) by push_cast; ring,zpow_neg,zpow_natCast,pow_succ] push_cast; field_simp have v2:(((q*D+r:ℕ)):ℝ)/((D*2^m:ℕ):ℝ)=((D*q+r:ℕ):ℝ)/(D:ℝ)*bpow (-(m:ℤ)):=by rw [bz,zpow_neg,zpow_natCast]; push_cast; field_simp rw [Zbe _ _ _ _ _ one_ne_zero (by positivity) v1,Zbe _ _ _ _ _ hD (by positivity) v2];refine (Zc1 q (2^m) D r ?_ ?_ hr h0).symm . calc 2=2^1:=by norm_num _ <= 2^m:=Nat.pow_le_pow_right (by norm_num) hm . obtain ⟨k,rfl⟩ : ∃ k,m=k+1:=⟨m-1,by omega⟩;simp [pow_succ,Nat.mul_mod_left] lemma fl (q D r:Nat) (hq:1 <= q) (hr:0 < r) (h0:r < D) : floorLog2 (D*q+r) D=q.log2/\floorLog2 (2*q+1) 1=q.log2+1:=by have hD:D≠0:=by omega have k1:=Nat.log2_self_le (show q≠0 by omega) have k2:=Nat.lt_log2_self (n:=q) obtain ⟨b1,b2⟩:=floorLog2_bounds (D*q+r) D (by positivity) hD obtain ⟨b3,b4⟩:=floorLog2_bounds (2*q+1) 1 (by omega) one_ne_zero have hx:((D*q+r:ℕ):ℝ)/D=q+r/D:=by push_cast; field_simp have h1:(r:ℝ)/D < 1:=by rw [div_lt_one (by positivity)]; exact_mod_cast h0 have h2:(0:ℝ) < r/D:=div_pos (by exact_mod_cast hr) (by exact_mod_cast Nat.pos_of_ne_zero hD) have c1:(2:ℝ)^q.log2 <= q:=by exact_mod_cast k1 have c2:(q:ℝ)+1 <= 2^(q.log2+1):=by exact_mod_cast k2 constructor . refine cU b1 b2 (b:=(q.log2:ℤ)) ?_ ?_ . rw [bpow_natCast,hx]; linarith . rw [show (q.log2:ℤ)+1=((q.log2+1:ℕ):ℤ) by push_cast; ring,bpow_natCast,hx]; linarith . refine cU b3 b4 (b:=((q.log2+1:ℕ):ℤ)) ?_ ?_ |>.trans (by push_cast; ring) . rw [bpow_natCast]; push_cast; rw [pow_succ]; linarith . rw [show ((q.log2+1:ℕ):ℤ)+1=((q.log2+2:ℕ):ℤ) by push_cast; ring,bpow_natCast]; push_cast;rw [show q.log2+2=(q.log2+1)+1 by ring,pow_succ]; linarith lemma Zc3 (s:Bool) (N D:Nat) (E:Int) (hD:0 < D) (hq:2^24 <= N/D) : NativeBinary32.roundRatScaled s (2*(N/D)+(if N%D=0 then 0 else 1)) 1 (E-1) = NativeBinary32.roundRatScaled s N D E:=by rw [<- cW (NativeBinary32.roundRatScaled s N D E), <- cW (NativeBinary32.roundRatScaled s _ 1 _),NativeBinary32.ofUInt32_roundRatScaled,NativeBinary32.ofUInt32_roundRatScaled] congr 1 have hf:FloatFormat.binary32.isIEEE=true:=by decide have h2:=Nat.div_add_mod N D have h1:=Nat.mod_lt N hD generalize N/D=q at hq h2 ⊢ generalize N%D=r at h2 h1 ⊢ subst h2 have h3:D*q+r≠0:=by have:=Nat.mul_pos hD (show 0 < q by omega); omega suffices H:roundRatScaled FloatFormat.binary32 false (2*q+if r=0 then 0 else 1) 1 (E-1) = roundRatScaled FloatFormat.binary32 false (D*q+r) D E by cases s . exact H . rw [roundRatScaled_true_eq_neg_false _ _ _ _ hf one_ne_zero,roundRatScaled_true_eq_neg_false _ _ _ _ hf hD.ne',H] by_cases h0:r=0 . subst h0; simp;apply cV _ hf _ _ _ _ _ _ (by omega) one_ne_zero h3 hD.ne';simp only [scaledRatToReal,bz]; push_cast;rw [zpow_sub₀ (by norm_num:(2:ℝ)≠0)]; field_simp; ring . simp only [h0,ite_false];obtain ⟨h5,h4⟩:=fl q D r (by omega) (by omega) h1;have hk:24 <= q.log2:=(Nat.le_log2 (by omega)).2 hq;rw [roundRatScaled_false_eq_of_isIEEE _ _ _ _ hf (by omega) one_ne_zero,roundRatScaled_false_eq_of_isIEEE _ _ _ _ hf h3 hD.ne'] simp rw [h4,h5,show ((q.log2:ℕ):ℤ)+1+(E-1)=q.log2+E by ring] have hF:FloatFormat.binary32.fracWidth=23:=by decide have hA:FloatFormat.subnormalAlignExp FloatFormat.binary32=149:=by decide by_cases hS:E <= -151 . rw [Zh q D r ((-E-149).toNat) _ _ (by omega) ?_ ?_ (by omega) h1,Zh q D r (q.log2-23) _ _ (by omega) ?_ ?_ (by omega) h1] <;> simp [hA,hF] <;> omega . have:¬ ((q.log2:ℤ)+E < FloatFormat.binary32.minNormalExponent):=by rw [show FloatFormat.binary32.minNormalExponent = -126 by decide]; omega simp only [this,ite_false];rw [Zh q D r (q.log2-23) _ _ (by omega) ?_ ?_ (by omega) h1] <;> simp [hF] <;> omega end section open ExactRuntime FloatLib.Floats.Formats.BinaryInterchange FloatLib.Floats FloatLib.Floats.Formats.Flocq open Float.Model.UnpackedFloat open FloatLib.Numerics (binaryRadix Radix.toReal) lemma Zc4 (q:ℚ) (num den:Nat) (e:Int) (hq:0 < q) (h9:0 < den) (h8:(num:ℚ)/den=q*(4:ℚ)^(-e)) (h7:2^23 <= sqrtLower num den) : toWord (Model.ofModel Fmt (roundWithAccuracy (FloatFormat.toModel Fmt) .positive (sqrtLower num den) e (sqrtAccuracy num den)))=sqrtRational q:=by rw [sqrtRational_eq_math q];have h6:¬ q <= 0:=not_le.mpr hq;have h1:sqrtLower num den≠0:=by simp;omega have h0:=sqrtAccuracy_correct num den h9;have h2:e <= (FloatFormat.toModel Fmt).targetExponent (Float.Model.totalExponent (sqrtLower num den) e):=by change e <= max _ (-149) have hl:23 <= (sqrtLower num den).log2:=(Nat.le_log2 h1).mpr h7 have hb:((FloatFormat.toModel Fmt).mantissaBits:Int)=24:=by decide apply le_trans _ (le_max_left _ _) unfold Float.Model.totalExponent omega have he:=Model.cexp_accuracy_mul_bpow_eq_targetExponent Fmt (sqrtLower num den) e (sqrtAccuracy num den) (Real.sqrt ((num:ℝ)/den)) (by decide) h1 h0 have hs:=Model.scaledMantissa_accuracy_mul_bpow Fmt (sqrtLower num den) e (sqrtAccuracy num den) (Real.sqrt ((num:ℝ)/den)) (by decide) h1 h0 have hn:=Model.roundedMantissa_shiftToTargetExponent_eq_nearestEven Fmt (sqrtLower num den) e (sqrtAccuracy num den) (Real.sqrt ((num:ℝ)/den)) h0 h2 have h5:Real.sqrt ((num:ℝ)/den)*bpow binaryRadix e=Real.sqrt (q:ℝ):=by have h4:(4:ℝ)^(-e)=((2:ℝ)^(-e))^2:=by rw [show (4:ℝ)=2*2 by norm_num,mul_zpow,sq] have hv:(num:ℝ)/den=(q:ℝ)*((2:ℝ)^(-e))^2:=by have:=congrArg (λ x:ℚ=>(x:ℝ)) h8;push_cast at this;rw [this,h4] rw [hv,Real.sqrt_mul (by exact_mod_cast hq.le),Real.sqrt_sq (by positivity)];simp only [bpow,binaryRadix,Radix.toReal] push_cast;rw [mul_assoc, <- zpow_add₀ (by norm_num:(2:ℝ)≠0)];simp rw [h5] at he hs;have ha:(nearestEven (scaledMantissa binaryRadix (Model.fexpOf Fmt) (Real.sqrt (q:ℝ)))).toNat = (shiftToTargetExponent (FloatFormat.toModel Fmt) (sqrtLower num den) e (sqrtAccuracy num den)).1.roundedMantissa:=by rw [hs, <- hn];simp have h3:(shiftToTargetExponent (FloatFormat.toModel Fmt) (sqrtLower num den) e (sqrtAccuracy num den)).2=(FloatFormat.toModel Fmt).targetExponent (Float.Model.totalExponent (sqrtLower num den) e):=by rw [Model.shiftToTargetExponent_eq_of_le_targetExponent Fmt _ e _ h2] simp only [sqrtMathWord,h6,ite_false,he,ha];rw [Model.roundWithAccuracy_eq_finishRoundedMantissa];rw [h3] end @[inline] def Y2 (x:Array Word) (base n:Nat):Nat := (List.range n).foldl (λ b j => let w:=x[base+j]! if mantOf w=0 then b else min b (idxOf w)) 255 @[inline] def Y6 (x:Array Word) (base n b0:Nat):Array Nat := (List.range n).foldl (λ a j => let w:=x[base+j]! addLimbs64 a (mantOf w*mantOf w).toUInt64 (2*(idxOf w-b0))) (Array.replicate 18 0) @[inline] def Y7 (x:Array Word) (base n b0:Nat):Array Nat × Array Nat := (List.range n).foldl (λ pq j => let w:=x[base+j]! if signOf w then (pq.1,addLimbs64 pq.2 (mantOf w).toUInt64 (idxOf w-b0)) else (addLimbs64 pq.1 (mantOf w).toUInt64 (idxOf w-b0),pq.2)) (Array.replicate 18 0,Array.replicate 18 0) @[inline] def sqA (num den root:Nat):Nat:= if num=root*root*den then 0 else if 4*num < den*((2*root+1)*(2*root+1)) then 1 else if 4*num=den*((2*root+1)*(2*root+1)) then 2 else 3 @[inline] def sqW (num den root:Nat) (e:Int):Word:= let sh:Nat:=if root < 16777216 then 0 else 1 let x:Int:=e+sh+150 if 8388608 <= root/\root < 33554432/\0 < den/\1 <= x/\x <= 253 then let r:=FloatLib.Numerics.roundQuotientEven (4*root+sqA num den root) (if root < 16777216 then 4 else 8) if r=16777216 then Model.NativeBinary32.mkBits false (x+1).toNat 0 else Model.NativeBinary32.mkBits false x.toNat (r-8388608) else toWord (Model.ofModel Fmt (Float.Model.UnpackedFloat.roundWithAccuracy (FloatFormat.toModel Fmt) .positive root e (sqrtAccuracy num den))) @[inline] def YaD (num0 m:Nat) (h:Int) (fallback:Unit -> Word):Word := let t:Int:=(47-(num0.log2:Int)+m.log2+1)/2 let num:=if 0 <= t then num0<<<(2*t.toNat) else num0 let den:=if 0 <= t then m else m<<<(2*(-t).toNat) let root:=sqrtLower num den if 8388608 <= root then sqW num den root (h-t) else fallback () @[inline] def YF (b0 ie:Nat):Nat:=min (2*b0) (ie+149)/2*2 @[inline] def Y8 (x:Array Word) (n:Nat) (eps:Word) (r:Nat):Nat × Int × Word := let b0:=Y2 x (r*n) n let pq:=Y7 x (r*n) n b0 let S1:Int:=(limbValA pq.1:Int)-limbValA pq.2 let T:Int:=(n:Int)*limbValA (Y6 x (r*n) n b0)-S1*S1 let c:=YF b0 (idxOf eps) (b0,S1,YaD (T.toNat<<<(2*b0-c)+(n*n*mantOf eps)<<<(idxOf eps+149-c)) (n*n) (((c:Int)-298)/2) λ _ => sqrtRational (rowVariance n x r (rowMean n x r)+rationalWord eps)) section open ExactRuntime FloatLib.Floats.Formats.BinaryInterchange FloatLib.Floats open Float.Model.UnpackedFloat lemma iB (w:Word):idxOf w <= 254:=by have:=expOf_toNat_lt w; unfold idxOf; split_ifs <;> omega lemma lS (m k:Nat -> Nat) (hm : ∀ j,m j < 2^64) (hk : ∀ j,k j/32+1 < 18) (l:List Nat) (a:Array Nat) (ha:a.size=18) : (l.foldl (λ a j=>addLimbs64 a (m j).toUInt64 (k j)) a).size=18 /\ limbVal (l.foldl (λ a j=>addLimbs64 a (m j).toUInt64 (k j)) a).toList = limbVal a.toList+(l.map λ j=>m j*2^k j).sum:=by induction l generalizing a with | nil=>simp [ha] | cons j l ih => simp;obtain ⟨h1,h2⟩:=ih (addLimbs64 a (m j).toUInt64 (k j)) (by rw [addLimbs64_size]; exact ha);refine ⟨h1,?_⟩;rw [h2,addLimbs64_eq _ _ _ (hm j),addLimbs_val _ _ _ (by rw [ha]; exact hk j)]; ring lemma lP (x:Array Word) (base b0:Nat) (f:Array Nat × Array Nat -> Nat -> Array Nat × Array Nat) (hf : ∀ pq j,f pq j=if signOf x[base+j]! then (pq.1,addLimbs64 pq.2 (mantOf x[base+j]!).toUInt64 (idxOf x[base+j]! - b0)) else (addLimbs64 pq.1 (mantOf x[base+j]!).toUInt64 (idxOf x[base+j]! - b0),pq.2)) (l:List Nat) : ∀ p q,p.size=18 -> q.size=18 -> (l.foldl f (p,q)).1.size=18 /\ (l.foldl f (p,q)).2.size=18/\((limbVal (l.foldl f (p,q)).1.toList:Int) - limbVal (l.foldl f (p,q)).2.toList)=(limbVal p.toList:Int)-limbVal q.toList + (l.map λ j=>sv x[base+j]! * 2^(idxOf x[base+j]! - b0)).sum:=by induction l with | nil=>intro p q hp hq; simp [hp,hq] | cons j l ih => intro p q hp hq;simp only [List.foldl_cons,List.map_cons,List.sum_cons,hf];have hm:=mantOf_lt_24 x[base+j]!;have hi:=iB x[base+j]!;by_cases hs:signOf x[base+j]! = true . simp only [hs,ite_true];obtain ⟨h1,h2,h3⟩:=ih p (addLimbs64 q (mantOf x[base+j]!).toUInt64 (idxOf x[base+j]! - b0)) hp (by rw [addLimbs64_size]; exact hq) refine ⟨h1,h2,?_⟩;rw [h3,addLimbs64_eq _ _ _ (by omega),addLimbs_val _ _ _ (by rw [hq]; omega)];simp only [sv,hs,ite_true]; push_cast; ring . simp only [hs,Bool.false_eq_true,ite_false];obtain ⟨h1,h2,h3⟩:=ih (addLimbs64 p (mantOf x[base+j]!).toUInt64 (idxOf x[base+j]! - b0)) q (by rw [addLimbs64_size]; exact hp) hq refine ⟨h1,h2,?_⟩;rw [h3,addLimbs64_eq _ _ _ (by omega),addLimbs_val _ _ _ (by rw [hp]; omega)];simp only [sv,hs,Bool.false_eq_true,ite_false]; push_cast; ring lemma fS (f:Nat -> ℚ) (l:List Nat) (a:ℚ) : l.foldl (λ t j=>t+f j) a=a+(l.map f).sum:=by induction l generalizing a with | nil=>simp | cons j l ih=>simp [List.foldl_cons,ih,add_assoc] lemma sqA_acc (num den:Nat) : sqrtAccuracy num den=Float.Model.UnpackedFloat.accuracyOfFraction (sqA num den (sqrtLower num den)) 4:=by unfold sqrtAccuracy sqA; dsimp only; simp only [sq]; split_ifs <;> rfl lemma rqB (N d:Nat) : N/d <= FloatLib.Numerics.roundQuotientEven N d /\ FloatLib.Numerics.roundQuotientEven N d <= N/d+1:=by unfold FloatLib.Numerics.roundQuotientEven; dsimp only; split_ifs <;> omega lemma sqP (r:Nat) (k:Int) (h1:8388608 <= r) (h2:r < 16777216) (hk:-126 <= k) (hk2:k <= 127) : toWord (Model.ofModel Fmt (Model.finishRoundedMantissa (FloatFormat.toModel Fmt) .positive (r,k-23)))=Model.NativeBinary32.mkBits false (k+127).toNat (r-8388608):=by have hf:Fmt.fracWidth=23:=by decide have hp:Model.pow2 Fmt.fracWidth=8388608:=by decide have hp1:Model.pow2 (Fmt.fracWidth+1)=16777216:=by decide have hmin:FloatFormat.ieeeMinNormalExponent Fmt = -126:=by decide have hmax:Int.ofNat (FloatFormat.ieeeMaxNormalExponent Fmt) = 127:=by decide have hb:Int.ofNat Fmt.bias=127:=by decide have e1:=Model.finishRoundedMantissa_normalized Fmt .positive r k (by rw [hp]; exact h1) (by rw [hp1]; exact h2) (by rw [hmin]; exact hk) rw [show (k-23:Int)=k-(Fmt.fracWidth:Int) by rw [hf]; rfl,e1] have e2:=Model.ofModel_finite_normalized_eq_ofFields Fmt false r k (by rw [hp]; exact h1) (by rw [hp1]; exact h2) (by rw [hmin]; exact hk) (by rw [hmax]; exact hk2) erw [e2] rw [hb,hp] have e4:toWord (Model.NativeBinary32.ofUInt32 (Model.NativeBinary32.mkBits false (k+127).toNat (r-8388608)))=Model.NativeBinary32.mkBits false (k+127).toNat (r-8388608):=by simp only [toWord,Model.NativeBinary32.ofUInt32,Model.toNatBits,Model.ofBits]; exact UInt32.ofNat_toNat rw [Model.NativeBinary32.ofUInt32_mkBits] at e4; exact e4 lemma sqC (k:Int) (hk:-126 <= k) (hk2:k+1 <= 127) : toWord (Model.ofModel Fmt (Model.finishRoundedMantissa (FloatFormat.toModel Fmt) .positive (16777216,k-23)))=Model.NativeBinary32.mkBits false (k+1+127).toNat 0:=by have hf:Fmt.fracWidth=23:=by decide have hp:Model.pow2 Fmt.fracWidth=8388608:=by decide have hp1:Model.pow2 (Fmt.fracWidth+1)=16777216:=by decide have hmin:FloatFormat.ieeeMinNormalExponent Fmt = -126:=by decide have hmax:Int.ofNat (FloatFormat.ieeeMaxNormalExponent Fmt) = 127:=by decide have hb:Int.ofNat Fmt.bias=127:=by decide have e1:=Model.finishRoundedMantissa_normalized_carry Fmt .positive k (by rw [hmin]; exact hk) rw [show (k-23:Int)=k-(Fmt.fracWidth:Int) by rw [hf]; rfl,show (16777216:Nat)=Model.pow2 (Fmt.fracWidth+1) from hp1.symm,e1] have e2:=Model.ofModel_finite_normalized_eq_ofFields Fmt false (Model.pow2 Fmt.fracWidth) (k+1) le_rfl (by rw [hp,hp1]; decide) (by rw [hmin]; omega) (by rw [hmax]; exact hk2) erw [e2] rw [hb,Nat.sub_self] have e4:toWord (Model.NativeBinary32.ofUInt32 (Model.NativeBinary32.mkBits false (k+1+127).toNat 0))=Model.NativeBinary32.mkBits false (k+1+127).toNat 0:=by simp only [toWord,Model.NativeBinary32.ofUInt32,Model.toNatBits,Model.ofBits]; exact UInt32.ofNat_toNat rw [Model.NativeBinary32.ofUInt32_mkBits] at e4; exact e4 theorem sqW_eq (num den:Nat) (e:Int) : sqW num den (sqrtLower num den) e = toWord (Model.ofModel Fmt (Float.Model.UnpackedFloat.roundWithAccuracy (FloatFormat.toModel Fmt) .positive (sqrtLower num den) e (sqrtAccuracy num den))) := by have hA:=sqA_acc num den unfold sqW generalize sqrtLower num den=root at hA ⊢ have hmb:(FloatFormat.toModel Fmt).mantissaBits=24:=by decide have hme:(FloatFormat.toModel Fmt).minExponent = -149:=by decide by_cases hs:root < 16777216 · simp only [hs,ite_true,Nat.cast_zero,add_zero] split · rename_i hc obtain ⟨h23,h25,hd,hx1,hx2⟩:=hc have hlt:sqA num den root < 4:=by unfold sqA; split_ifs <;> omega generalize sqA num den root=a at hA hlt ⊢ rw [hA] have key:=Model.roundWithAccuracy_quotient_eq_finishRoundedMantissa (FloatFormat.toModel Fmt) .positive (4*root+a) 4 e (by norm_num) rw [show (4*root+a)/4=root by omega, show (4*root+a)%4=a by omega] at key have hne:root≠0:=by omega have hl1:=(Nat.le_log2 hne).mpr (show 2^23 <= root by omega) have hl2:=(Nat.log2_lt hne).mpr (show root < 2^24 by omega) have hsh:((FloatFormat.toModel Fmt).targetExponent (Float.Model.totalExponent root e) - e).toNat=0:=by simp only [Float.Model.Format.targetExponent,Float.Model.totalExponent,hmb,hme]; omega rw [key]; dsimp only; rw [hsh]; simp only [pow_zero,mul_one,Nat.cast_zero,add_zero] obtain ⟨b1,b2⟩:=rqB (4*root+a) 4 generalize FloatLib.Numerics.roundQuotientEven (4*root+a) 4=r at b1 b2 ⊢ split · rename_i hr; subst hr; rw [show e=(e+23)-23 by ring,sqC (e+23) (by omega) (by omega)]; congr 2; omega · rw [show e=(e+23)-23 by ring,sqP r (e+23) (by omega) (by omega) (by omega) (by omega)]; congr 2; omega · rfl · simp only [hs,ite_false,Nat.cast_one] split · rename_i hc obtain ⟨h23,h25,hd,hx1,hx2⟩:=hc have hlt:sqA num den root < 4:=by unfold sqA; split_ifs <;> omega generalize sqA num den root=a at hA hlt ⊢ rw [hA] have key:=Model.roundWithAccuracy_quotient_eq_finishRoundedMantissa (FloatFormat.toModel Fmt) .positive (4*root+a) 4 e (by norm_num) rw [show (4*root+a)/4=root by omega, show (4*root+a)%4=a by omega] at key have hne:root≠0:=by omega have hl1:=(Nat.le_log2 hne).mpr (show 2^24 <= root by omega) have hl2:=(Nat.log2_lt hne).mpr (show root < 2^25 by omega) have hsh:((FloatFormat.toModel Fmt).targetExponent (Float.Model.totalExponent root e) - e).toNat=1:=by simp only [Float.Model.Format.targetExponent,Float.Model.totalExponent,hmb,hme]; omega rw [key]; dsimp only; rw [hsh]; simp only [pow_one,Nat.cast_one] obtain ⟨b1,b2⟩:=rqB (4*root+a) (4*2) generalize FloatLib.Numerics.roundQuotientEven (4*root+a) (4*2)=r at b1 b2 ⊢ split · rename_i hr; subst hr; rw [show e+1=(e+24)-23 by ring,sqC (e+24) (by omega) (by omega)]; congr 2; omega · rw [show e+1=(e+24)-23 by ring,sqP r (e+24) (by omega) (by omega) (by omega) (by omega)]; congr 2; omega · rfl lemma Zbg (num0 m:Nat) (h:Int) (q:ℚ) (hq:0 < q) (hm:0 < m) (hv:(num0:ℚ)/m*4^h=q):YaD num0 m h (λ _=>sqrtRational q)=sqrtRational q:=by unfold YaD; simp only [sqW_eq] generalize (47-((num0.log2:Nat):Int)+(m.log2:Nat)+1)/2=t have e : ∀ k:Nat,(2:ℚ)^(2*k)=4^(k:ℤ):=λ k=>by rw [pow_mul,zpow_natCast]; norm_num by_cases h0:0 <= t <;> simp only [h0,ite_true,ite_false] <;> split_ifs with hr <;> try rfl all_goals refine Zc4 q _ _ _ hq (by first | exact hm | (rw [Nat.shiftLeft_eq]; exact Nat.mul_pos hm (by positivity))) ?_ (by rw [show (2:Nat)^23=8388608 by norm_num]; exact hr) all_goals rw [<- hv,show -(h-t)=t-h by ring,zpow_sub₀ (by norm_num)]; simp only [Nat.shiftLeft_eq] all_goals push_cast; rw [e,Int.toNat_of_nonneg (by omega)]; field_simp [zpow_neg] all_goals rw [mul_assoc, <- zpow_add₀ (by norm_num)]; simp lemma Zc7 (w:Word):(sv w:ℚ)^2=(mantOf w:ℚ)^2:=by unfold sv; split_ifs <;> push_cast <;> ring lemma Zbh (eps:Word) (he:0 < rationalWord eps) : rationalWord eps=(mantOf eps:ℚ)*2^((idxOf eps:ℤ)-149):=by have h:=he; simp only [rationalWord,decodeD_toRat] at h ⊢;unfold sv at h ⊢;split_ifs at h ⊢ with hs . have:(0:ℚ) <= 2^((idxOf eps:ℤ)-149):=by positivity push_cast at h; nlinarith [show (0:ℚ) <= mantOf eps by positivity] . push_cast; ring lemma Zbi (x:Array Word) (n r b0:Nat) (h1 : ∀ j < n,mantOf x[r*n+j]! ≠ 0 -> b0 <= idxOf x[r*n+j]!) : (limbValA (Y6 x (r*n) n b0):ℚ)*2^((2*b0:ℤ)-298) = ((List.range n).map λ j=>(rationalWord x[r*n+j]!)^2).sum:=by unfold Y6; simp only [];rw [limbValA_eq,(lS (λ j=>mantOf x[r*n+j]! * mantOf x[r*n+j]!) (λ j=>2*(idxOf x[r*n+j]! - b0)) (λ j=>by have:=mantOf_lt_24 x[r*n+j]!; nlinarith) (λ j=>by have:=iB x[r*n+j]!; omega) _ _ (by simp)).2] have h0:limbVal (Array.replicate 18 0).toList=0:=by decide rw [h0,zero_add,Nat.cast_list_sum,List.map_map, <- List.sum_map_mul_right] congr 1; apply List.map_congr_left; intro j hj have h2:=List.mem_range.1 hj simp only [Function.comp,rationalWord,decodeD_toRat] by_cases hm:mantOf x[r*n+j]! = 0 . simp [hm,sv] . have hb:=h1 j h2 hm have hx:((2:ℚ)^((idxOf x[r*n+j]! : ℤ)-149))^2 = (2:ℚ)^(2*(idxOf x[r*n+j]! - b0))*2^((2*b0:ℤ)-298):=by rw [<- zpow_natCast (2:ℚ) (2*(idxOf x[r*n+j]! - b0)), <- zpow_add₀ (by norm_num),<- zpow_natCast _ 2, <- zpow_mul] congr 1; push_cast [hb]; ring rw [mul_pow,Zc7,hx]; push_cast; ring lemma Zbj (x:Array Word) (n r b0:Nat) (h1 : ∀ j < n,mantOf x[r*n+j]! ≠ 0 -> b0 <= idxOf x[r*n+j]!) : (((limbValA (Y7 x (r*n) n b0).1:ℤ)-limbValA (Y7 x (r*n) n b0).2:ℤ):ℚ) * 2^((b0:ℤ)-149)=((List.range n).map λ j=>rationalWord x[r*n+j]!).sum:=by unfold Y7 rw [limbValA_eq,limbValA_eq,(lP x (r*n) b0 _ (λ _ _=>rfl) (List.range n) _ _ (by simp) (by simp)).2.2] have h0:limbVal (Array.replicate 18 0).toList=0:=by decide rw [h0]; push_cast; rw [zero_add,List.map_map, <- List.sum_map_mul_right] congr 1; apply List.map_congr_left; intro j hj simp only [Function.comp,rationalWord,decodeD_toRat]; push_cast by_cases hm:mantOf x[r*n+j]! = 0 . simp [hm,sv] . have hb:=h1 j (List.mem_range.1 hj) hm rw [mul_assoc, <- zpow_natCast, <- zpow_add₀ (by norm_num)]; congr 2; push_cast [hb]; ring lemma sm (f:Nat -> ℚ) (μ:ℚ) (l:List Nat) : (l.map λ j=>(f j-μ)^2).sum = (l.map λ j=>f j^2).sum-2*μ*(l.map f).sum+l.length*μ^2:=by induction l with | nil=>simp | cons j l ih=>simp only [List.map_cons,List.sum_cons,List.length_cons,ih]; push_cast; ring lemma Z2 (x:Array Word) (base n j:Nat) (hj:j < n) (hm:mantOf x[base+j]! ≠ 0) : Y2 x base n <= idxOf x[base+j]! := by suffices H : ∀ (l:List Nat) (b:Nat),l.foldl (λ b j => if mantOf x[base+j]! = 0 then b else min b (idxOf x[base+j]!)) b <= b /\ ∀ k ∈ l,mantOf x[base+k]! ≠ 0 -> l.foldl (λ b j => if mantOf x[base+j]! = 0 then b else min b (idxOf x[base+j]!)) b <= idxOf x[base+k]! from (H _ 255).2 j (List.mem_range.2 hj) hm intro l; induction l with | nil=>intro b; simp | cons a l ih => intro b; simp only [List.foldl_cons];obtain ⟨h1,h2⟩:=ih (if mantOf x[base+a]! = 0 then b else min b (idxOf x[base+a]!));refine ⟨le_trans h1 (by split_ifs <;> omega),λ k hk h0 => ?_⟩;rcases List.mem_cons.1 hk with rfl | hk . exact le_trans h1 (by simp [h0]) . exact h2 k hk h0 lemma Zc9 (b0 ie:Nat):YF b0 ie <= 2*b0/\YF b0 ie <= ie+149 /\ (4:ℚ)^(((YF b0 ie:ℤ)-298)/2)=2^((YF b0 ie:ℤ)-298):=by unfold YF;refine ⟨by omega,by omega,?_⟩;rw [show (4:ℚ)=2^(2:ℤ) by norm_num, <- zpow_mul]; congr 1; omega lemma Zbk (A n b0 ie me:Nat) (hn:0 < n) : ((A<<<(2*b0-YF b0 ie)+(n*me)<<<(ie+149-YF b0 ie):Nat):ℚ)/n * 4^(((YF b0 ie:ℤ)-298)/2) = (A:ℚ)*2^((2*b0:ℤ)-298)/n+(me:ℚ)*2^((ie:ℤ)-149):=by obtain ⟨h1,h2,h4⟩:=Zc9 b0 ie;generalize YF b0 ie=c at h1 h2 h4;rw [h4]; simp only [Nat.shiftLeft_eq]; push_cast;rw [<- zpow_natCast (2:ℚ) (2*b0-c), <- zpow_natCast (2:ℚ) (ie+149-c)];push_cast [h1,h2];have e1:(2:ℚ)^((2*b0:ℤ)-298)=2^((2*b0:ℤ)-c)*2^((c:ℤ)-298):=by rw [<- zpow_add₀ (by norm_num)]; congr 1; ring have e2:(2:ℚ)^((ie:ℤ)-149)=2^((ie:ℤ)+149-c)*2^((c:ℤ)-298):=by rw [<- zpow_add₀ (by norm_num)]; congr 1; ring rw [e1,e2]; field_simp lemma Zbl (n:Nat) (x:Array Word) (r:Nat) (μ:ℚ):0 <= rowVariance n x r μ:=by unfold rowVariance; rw [fS (λ j=>(rationalWord x[r*n+j]! - μ)^2),zero_add];exact div_nonneg (List.sum_nonneg λ a ha=>by obtain ⟨j,_,rfl⟩:=List.mem_map.1 ha; positivity) (Nat.cast_nonneg _) lemma Zdb (x:Array Word) (n:Nat) (eps:Word) (r:Nat) (hn:0 < n) (he:0 < rationalWord eps) : (Y8 x n eps r).2.2=sqrtRational (rowVariance n x r (rowMean n x r)+rationalWord eps):=by refine Zbg _ _ _ _ (add_pos_of_nonneg_of_pos (Zbl _ _ _ _) he) (Nat.mul_pos hn hn) ?_;have h1 : ∀ j < n,mantOf x[r*n+j]! ≠ 0 -> Y2 x (r*n) n <= idxOf x[r*n+j]! := λ j hj hm=>Z2 x (r*n) n j hj hm have hS:=Zbi x n r _ h1;have hV:=Zbj x n r _ h1;have h0:=Zbl n x r (rowMean n x r);rw [Zbh eps he];have hW:rowVariance n x r (rowMean n x r)=(((List.range n).map λ j=>(rationalWord x[r*n+j]!)^2).sum - 2*rowMean n x r*((List.range n).map λ j=>rationalWord x[r*n+j]!).sum + n*rowMean n x r^2)/n:=by unfold rowVariance; rw [fS (λ j=>(rationalWord x[r*n+j]! - rowMean n x r)^2),zero_add,sm,List.length_range] have hM:rowMean n x r=((List.range n).map λ j=>rationalWord x[r*n+j]!).sum/n:=by unfold rowMean; rw [fS (λ j=>rationalWord x[r*n+j]!),zero_add] generalize Y2 x (r*n) n=b0 at hS hV ⊢;generalize limbValA (Y6 x (r*n) n b0)=A at hS ⊢;generalize ((limbValA (Y7 x (r*n) n b0).1:ℤ)-limbValA (Y7 x (r*n) n b0).2)=S1 at hV ⊢;have hv:rowVariance n x r (rowMean n x r)=(((n:ℤ)*A-S1*S1:ℤ):ℚ)*((2:ℚ)^((2*b0:ℤ)-298)/(n*n)):=by rw [hW,hM, <- hS, <- hV,show (2:ℚ)^((2*b0:ℤ)-298)=(2^((b0:ℤ)-149))^2 by rw [<- zpow_natCast _ 2, <- zpow_mul]; congr 1; ring] push_cast; field_simp; ring have hT:0 <= (n:ℤ)*A-S1*S1:=by have:=h0; rw [hv] at this;exact_mod_cast nonneg_of_mul_nonneg_left this (div_pos (by positivity) (by exact_mod_cast Nat.mul_pos hn hn)) rw [Zbk _ (n*n) b0 (idxOf eps) (mantOf eps) (Nat.mul_pos hn hn),hv,show ((((n:ℤ)*A-S1*S1).toNat:ℕ):ℚ)=(((n:ℤ)*A-S1*S1:ℤ):ℚ) by exact_mod_cast Int.toNat_of_nonneg hT] push_cast; ring lemma Zdc (x:Array Word) (n:Nat) (eps:Word) (r:Nat) (hn:0 < n) : rowMean n x r=((Y8 x n eps r).2.1:ℚ)*2^(((Y8 x n eps r).1:Int)-149)/n:=by unfold rowMean Y8; simp only [];rw [fS (λ j=>rationalWord x[r*n+j]!),zero_add,<- Zbj x n r _ (λ j hj hm=>Z2 x (r*n) n j hj hm)] end @[inline] def YaF (w:Word) (b:Nat):Int:=sv w<<<(idxOf w-b) @[inline] def elL (n:Nat) (w gw bw:Word) (b0:Nat) (S1:Int) (dw:Word) (mean:Unit -> ℚ):Word := if sv dw <= 0 then roundRational ((rationalWord w-mean ())*rationalWord gw/rationalWord dw+rationalWord bw) else let c2:=min (b0+idxOf gw) (idxOf bw+idxOf dw) let P:=((n:Int)*YaF w b0-S1)*sv gw<<<(b0+idxOf gw-c2) + (n:Int)*sv bw*sv dw<<<(idxOf bw+idxOf dw-c2) Model.NativeBinary32.roundRatScaled (P < 0) P.natAbs (n*mantOf dw) ((c2:Int)-149-idxOf dw) section open ExactRuntime FloatLib.Floats.Formats.BinaryInterchange FloatLib.Floats lemma eD (d:Word) (h:¬sv d<=0):sv d=mantOf d/\0 < mantOf d:=by have hs:signOf d=false:=by by_contra c; simp at c; exact h (by simp [sv,c]) have:sv d=mantOf d:=by simp [sv,hs] exact ⟨this,by omega⟩ lemma eP (P:ℤ):(if decide (P<0)=true then -((P.natAbs:ℕ):ℚ) else (P.natAbs:ℚ))=P:=by rw [Nat.cast_natAbs]; split_ifs with c <;> simp at c . rw [abs_of_neg (by exact_mod_cast c)]; push_cast; ring . rw [abs_of_nonneg (by exact_mod_cast c)] lemma Zde (n:Nat) (w gw bw:Word) (b0:Nat) (S1:Int) (dw:Word) (mean:Unit -> ℚ) (hn:0 < n) (h0:mantOf w≠0 -> b0 <= idxOf w) (h1:mean ()=(S1:ℚ)*2^((b0:Int)-149)/n) : elL n w gw bw b0 S1 dw mean = roundRational ((rationalWord w-mean ())*rationalWord gw/rationalWord dw + rationalWord bw):=by unfold elL; split_ifs with h; · rfl obtain ⟨hv,hD⟩:=eD dw h refine (Zbd _ _ _ _ _ (Nat.mul_pos hn hD) (λ p=>by simp at p; omega) ?_).symm simp only [rationalWord,decodeD_toRat,h1]; rw [eP] generalize hc:min (b0+idxOf gw) (idxOf bw+idxOf dw)=c have k1:c<= b0+idxOf gw:=hc▸min_le_left _ _; have k2:c<= idxOf bw+idxOf dw:=hc▸min_le_right _ _ simp only [YaF,Int.shiftLeft_eq,hv]; push_cast have h2:(2:ℚ)≠0:=by simp have hx:(sv w:ℚ)*2^((idxOf w:ℤ)-149)=sv w*2^(idxOf w-b0)*2^((b0:ℤ)-149):=by by_cases m:mantOf w=0; · simp [sv,m] rw [mul_assoc,<- zpow_natCast,<- zpow_add₀ h2]; congr 2; push_cast [h0 m]; ring have hB:(2:ℚ)^((b0:ℤ)-149)*2^((idxOf gw:ℤ)-149)=2^((c:ℤ)-149-idxOf dw)*2^((idxOf dw:ℤ)-149)*2^(b0+idxOf gw-c):=by rw [<- zpow_natCast,<- zpow_add₀ h2,<- zpow_add₀ h2,<- zpow_add₀ h2]; congr 1; push_cast [k1]; ring have hI:(2:ℚ)^((idxOf bw:ℤ)-149)=2^((c:ℤ)-149-idxOf dw)*2^(idxOf bw+idxOf dw-c):=by rw [<- zpow_natCast,<- zpow_add₀ h2]; congr 1; push_cast [k2]; ring rw [hx,hI];field_simp; linear_combination (((n:ℚ)*sv w*2^(idxOf w-b0)-S1)*sv gw)*hB end @[inline] def p2 (k:Nat):Nat:=if k < 63 then ((1:UInt64)<< Bool | .ofNat s=>a < b*p2 s | .negSucc s=>a*p2 (s+1) < b @[inline] def ge2 (a b:Nat):Int -> Bool | .ofNat s=>a >= b*p2 s | .negSucc s=>a*p2 (s+1) >= b @[inline] def fl2 (a b:Nat):Int := let i:Int:=Int.ofNat (lg a)-Int.ofNat (lg b) let l:=if lt2 a b i then i-1 else i if ge2 a b (l+1) then l+1 else l @[inline] def sc2 (a b:Nat):Int -> Nat × Nat | .ofNat s=>(a*p2 s,b) | .negSucc s=>(a,b*p2 (s+1)) @[inline] def YN (s:Bool) (N D:Nat) (E:Int):UInt32 := if D==0 then 0x7fc00000 else if N==0 then if s then 0x80000000 else 0 else let r:=fl2 N D let t:=r+E if t > 127 then if s then 0xff800000 else 0x7f800000 else if t < -150 then if s then 0x80000000 else 0 else if t < -126 then let c:=sc2 N D (E+149) let f:=FloatLib.Numerics.roundQuotientEven c.1 c.2 if f==0 then if s then 0x80000000 else 0 else match Nat.decLe 8388608 f with | isTrue _=>Model.NativeBinary32.mkBits s 1 0 | isFalse _=>Model.NativeBinary32.mkBits s 0 f else let c:=sc2 N D (23-r) let m:=FloatLib.Numerics.roundQuotientEven c.1 c.2 let k:=m==16777216 let x:=if k then t+1 else t let y:=if k then 8388608 else m if x > 127 then if s then 0xff800000 else 0x7f800000 else Model.NativeBinary32.mkBits s (Int.toNat (x+127)) (y-8388608) @[inline] def Yap (sa:Bool) (a:Nat) (sb:Bool) (b:Nat):Bool × Nat := if sa==sb then (sa,a+b) else if b <= a then (sa,a-b) else (sb,b-a) @[inline] def Y3 (s1:Bool) (q1 r1:Nat) (s2:Bool) (B D:Nat):Bool × Nat × Nat := if s1==s2 then (s1,q1+B,r1) else if B <= q1 then (s1,q1-B,r1) else if r1=0 then (s2,B-q1,0) else (s2,B-q1-1,D-r1) @[inline] def Ya8 (s:Bool) (M:UInt64) (E:Int):UInt32 := let L:=Yj M let t:=(L.toNat:Int)+E if M=0\/L<24\/t < -126 then YN s M.toNat 1 E else let m:=(YK M L).toNat let k:=m==16777216 let x:=if k then t+1 else t let y:=if k then 8388608 else m if x > 127 then if s then 0xff800000 else 0x7f800000 else Model.NativeBinary32.mkBits s (Int.toNat (x+127)) (y-8388608) @[inline] def Ya9 (s:Bool) (M:Nat) (E:Int):UInt32:=if M>>>62=0 then Ya8 s M.toUInt64 E else YN s M 1 E @[inline] def Yba (n:Nat) (w gw bw:Word) (b0:Nat) (S1:Int) (dw:Word) (mean:Unit -> ℚ):Word := if sv dw <= 0 then roundRational ((rationalWord w-mean ())*rationalWord gw/rationalWord dw+rationalWord bw) else let c2:=min (b0+idxOf gw) (idxOf bw+idxOf dw) let c:=Yap (signOf w) (n*(mantOf w*p2 (idxOf w-b0))) (!(S1 < 0)) S1.natAbs let D:=n*mantOf dw let t1:=c.2*mantOf gw let k1:=p2 (b0+idxOf gw-c2) let ra:=t1%D*k1 let Q:=Y3 (c.1 != signOf gw) (t1/D*k1+ra/D) (ra%D) (signOf bw) (mantOf bw*p2 (idxOf bw+idxOf dw-c2)) D if 16777216 <= Q.2.1 then Ya9 Q.1 (2*Q.2.1+(if Q.2.2=0 then 0 else 1)) ((c2:Int)-150-idxOf dw) else let N:=Q.2.1*D+Q.2.2 YN (Q.1&&N != 0) N D ((c2:Int)-149-idxOf dw) lemma ZE (k:Nat):p2 k=2^k:=by unfold p2;split . rename_i h;have hk:k.toUInt64.toNat=k:=UInt64.toNat_ofNat_of_lt' (by unfold UInt64.size; omega);rw [UInt64.toNat_shiftLeft,hk,Nat.mod_eq_of_lt (by omega:k < 64),UInt64.toNat_one,Nat.one_shiftLeft] exact Nat.mod_eq_of_lt (Nat.pow_lt_pow_right (by norm_num) (by omega)) . rfl lemma Zdf (n:Nat):lg n=n.log2:=by unfold lg;dsimp only;split . rename_i h;by_cases h0:n.toUInt64=0 . have:n=0:=by rw [<- h,h0]; rfl subst this decide . rw [Zj _ h0,h] . rfl lemma Zdg (a b:Nat) (e:Int) : lt2 a b e=FloatLib.Numerics.RationalBinary.lessThanPowerOfTwo a b e:=by cases e <;> simp [lt2,FloatLib.Numerics.RationalBinary.lessThanPowerOfTwo,ZE,Nat.shiftLeft_eq] lemma Zdh (a b:Nat) (e:Int) : ge2 a b e=FloatLib.Numerics.RationalBinary.atLeastPowerOfTwo a b e:=by cases e <;> simp [ge2,FloatLib.Numerics.RationalBinary.atLeastPowerOfTwo,ZE,Nat.shiftLeft_eq] lemma Zdi:sc2=FloatLib.Numerics.RationalBinary.scaleByPowerOfTwo:=by funext a b e;cases e <;> simp [sc2,FloatLib.Numerics.RationalBinary.scaleByPowerOfTwo,ZE,Nat.shiftLeft_eq] lemma Zbo:fl2=FloatLib.Numerics.RationalBinary.floorLog2:=by funext a b;simp only [fl2,FloatLib.Numerics.RationalBinary.floorLog2,Zdf,Zdg,Zdh] lemma Zaq (s:Bool) (N D:Nat) (E:Int) : YN s N D E=Model.NativeBinary32.roundRatScaled s N D E:=by unfold YN;rw [Zbo,Zdi];rfl lemma Zdj (s:Bool) (M:UInt64) (E:Int):Ya8 s M E=YN s M.toNat 1 E:=by unfold Ya8;dsimp only;split . rfl . rename_i h simp only [not_or,UInt64.not_lt] at h obtain ⟨hM,hL,ht⟩:=h have hN:M.toNat≠0:=λ e=>hM (UInt64.toNat_inj.mp (by simpa using e)) have hr:=Zj M hM have h4:24 <= M.toNat.log2:=by rw [<- hr]; exact (UInt64.le_iff_toNat_le).mp hL obtain ⟨h0,_,_⟩:=Z7 M hM rw [if_pos (show Fmt.fracWidth <= M.toNat.log2 by show 23 <= _; omega)] at h0 rw [h0,FloatLib.Numerics.roundShiftRightEven_eq_roundQuotientEven,hr,show Fmt.fracWidth=23 from rfl] unfold YN rw [Zbo,Model.floorLog2_den_one _ hN] have h3:(23:Int)-(M.toNat.log2:Int)=Int.negSucc (M.toNat.log2-24):=by omega simp only [show ((1:Nat)==0)=false from rfl,show (M.toNat==0)=false by simpa using hN,h3,sc2,ZE,Bool.false_eq_true,ite_false,Nat.one_mul,show M.toNat.log2-24+1=M.toNat.log2-23 by omega] by_cases h1:(M.toNat.log2:Int)+E > 127 . have h2:¬ (((M.toNat.log2:Int)+E) <= 127):=by omega have hk:∀ b:Bool,(if b=true then (M.toNat.log2:Int)+E+1 else (M.toNat.log2:Int)+E) > 127:=by intro b; split <;> omega simp only [h1,hk,ite_true] . simp only [h1,ite_false,show ¬ ((M.toNat.log2:Int)+E < -150) by omega,show ¬ ((M.toNat.log2:Int)+E < -126) by omega] lemma Zdk (s:Bool) (M:Nat) (E:Int):Ya9 s M E=YN s M 1 E:=by unfold Ya9; split . rename_i h; rw [Zdj]; congr 1; rw [Nat.shiftRight_eq_div_pow] at h;have:=(Nat.div_eq_zero_iff_lt (Nat.two_pow_pos _)).mp h; simp [Nat.toUInt64]; omega . rfl def Yh (s:Bool) (m:Nat):Int:=if s then -(m:Int) else m lemma Zdl (sa:Bool) (a:Nat) (sb:Bool) (b:Nat) : Yh (Yap sa a sb b).1 (Yap sa a sb b).2=Yh sa a+Yh sb b:=by unfold Yap;by_cases h1:sa=sb . subst h1; cases sa <;> simp [Yh] <;> omega . rw [if_neg (by simpa using h1)];by_cases h2:b <= a . rw [if_pos h2]; cases sa <;> cases sb <;> simp_all [Yh,Nat.cast_sub h2] <;> omega . rw [if_neg h2] have h3:a <= b:=by omega cases sa <;> cases sb <;> simp_all [Yh,Nat.cast_sub h3] <;> omega lemma Zbp (s:Bool) (m:Nat):(Yh s m).natAbs=m:=by cases s <;> simp [Yh] lemma Zbq (s:Bool) (m:Nat):decide (Yh s m < 0)=(s&&m != 0):=by cases s . simp [Yh] . by_cases h:m=0 . simp [Yh,h] . have:(0:Int) < m:=by exact_mod_cast Nat.pos_of_ne_zero h simp only [Yh,ite_true,Left.neg_neg_iff,this,decide_true,Bool.true_and] simpa using h lemma ZF (w:Word):sv w=Yh (signOf w) (mantOf w):=rfl lemma Zdm (s:Bool) (a b:Nat):Yh s (a*b)=a*Yh s b:=by cases s <;> simp [Yh] lemma Z3 (s:Bool) (a b:Nat):Yh s (a*b)=Yh s a*b:=by cases s <;> simp [Yh] lemma Zbr (s t:Bool) (a b:Nat):Yh (s != t) (a*b)=Yh s a*Yh t b:=by cases s <;> cases t <;> simp [Yh] lemma Zdn (S:Int):Yh (!decide (S < 0)) S.natAbs = -S:=by unfold Yh; by_cases h:S < 0 <;> simp [h] <;> omega lemma Zdp (s1:Bool) (q1 r1:Nat) (s2:Bool) (B D:Nat) (hr:r1 < D) : Yh (Y3 s1 q1 r1 s2 B D).1 ((Y3 s1 q1 r1 s2 B D).2.1*D+(Y3 s1 q1 r1 s2 B D).2.2) = Yh s1 (q1*D+r1)+Yh s2 (B*D)/\(Y3 s1 q1 r1 s2 B D).2.2 < D:=by unfold Y3;by_cases h1:s1=s2 . subst h1; simp;refine ⟨?_,hr⟩; cases s1 <;> simp only [Yh] <;> simp <;> push_cast <;> ring . have e:s2 = !s1:=by cases s1 <;> cases s2 <;> simp_all subst e rw [if_neg (by cases s1 <;> simp)] by_cases h2:B <= q1 . rw [if_pos h2] refine ⟨?_,hr⟩ cases s1 <;> simp only [Yh] <;> simp <;> push_cast [Nat.cast_sub h2] <;> ring . rw [if_neg h2] by_cases h4:r1=0 . rw [if_pos h4] have h5:q1 <= B:=by omega refine ⟨?_,by dsimp only; omega⟩ cases s1 <;> simp only [Yh,h4] <;> simp <;> push_cast [Nat.cast_sub h5] <;> ring . rw [if_neg h4] have h5:q1+1 <= B:=by omega have h6:r1 <= D:=by omega refine ⟨?_,by dsimp only; omega⟩ cases s1 <;> simp only [Yh] <;> simp <;> push_cast [Nat.cast_sub h5,Nat.cast_sub h6,Nat.sub_sub] <;> ring lemma Zdq (t k D:Nat) : (t/D*k+t%D*k/D)*D+t%D*k%D=t*k:=by have h1:=Nat.div_add_mod (t%D*k) D;have h2:=Nat.div_add_mod t D calc (t/D*k+t%D*k/D)*D+t%D*k%D = t/D*k*D+(D*(t%D*k/D)+t%D*k%D):=by ring _=(D*(t/D)+t%D)*k:=by rw [h1]; ring _=t*k:=by rw [h2] lemma Zdr (n:Nat) (w gw bw:Word) (b0:Nat) (S1:Int) (dw:Word) (mean:Unit -> ℚ) (hn:0 < n) : Yba n w gw bw b0 S1 dw mean=elL n w gw bw b0 S1 dw mean:=by unfold Yba elL;split . rfl . rename_i hd have hs:signOf dw=false:=by by_contra c; simp at c; exact hd (by simp [sv,c]) have hm:0 < mantOf dw:=by by_contra c; exact hd (by simp [sv,hs]; omega) have h4:sv dw=mantOf dw:=by simp [sv,hs] simp only [Zdk] generalize min (b0+idxOf gw) (idxOf bw+idxOf dw)=c2 generalize h3:Yap (signOf w) (n*(mantOf w*p2 (idxOf w-b0))) (!decide (S1 < 0)) S1.natAbs=c have hc:(n:Int)*YaF w b0-S1=Yh c.1 c.2:=by rw [<- h3,Zdl,Zdm,Z3,Zdn,YaF,Int.shiftLeft_eq,ZF,ZE] push_cast; ring have hp : ∀ e,(2:Int)^e=((p2 e:Nat):Int):=λ e=>by rw [ZE]; push_cast; rfl rw [hc,h4,ZF gw,ZF bw,Int.shiftLeft_eq,Int.shiftLeft_eq,hp,hp] generalize p2 (b0+idxOf gw-c2)=k1 generalize p2 (idxOf bw+idxOf dw-c2)=k2 have hD:0 < n*mantOf dw:=Nat.mul_pos hn hm rw [show Yh c.1 c.2*(Yh (signOf gw) (mantOf gw)*(k1:Int)) + n*Yh (signOf bw) (mantOf bw)*(mantOf dw*(k2:Int)) = Yh (c.1 != signOf gw) (c.2*mantOf gw*k1)+Yh (signOf bw) (mantOf bw*k2*(n*mantOf dw)) by rw [Z3,Zbr,Z3,Z3]; push_cast; ring] generalize c.2*mantOf gw=t1 generalize mantOf bw*k2=B generalize n*mantOf dw=D at hD ⊢ obtain ⟨hv,hr⟩:=Zdp (c.1 != signOf gw) (t1/D*k1+t1%D*k1/D) (t1%D*k1%D) (signOf bw) B D (Nat.mod_lt _ hD) rw [Zdq] at hv;rw [<- hv,Zbp,Zbq];generalize Y3 (c.1 != signOf gw) (t1/D*k1+t1%D*k1/D) (t1%D*k1%D) (signOf bw) B D=Q at hr ⊢ split . rename_i hq;have h0:(Q.2.1*D+Q.2.2)/D=Q.2.1:=by rw [Nat.add_comm,Nat.add_mul_div_right _ _ hD,Nat.div_eq_of_lt hr,Nat.zero_add] have h2:Q.2.1*D+Q.2.2≠0:=by simp;omega have h1:=Zc3 Q.1 (Q.2.1*D+Q.2.2) D ((c2:Int)-149-idxOf dw) hD (by rw [h0]; exact hq) have h5:(Q.2.1*D+Q.2.2)%D=Q.2.2:=by rw [Nat.add_comm,Nat.add_mul_mod_self_right,Nat.mod_eq_of_lt hr] rw [h0,h5,show (c2:Int)-149-idxOf dw-1=(c2:Int)-150-idxOf dw by ring] at h1;rw [Zaq,h1,show (Q.2.1*D+Q.2.2 != 0)=true by simpa using h2,Bool.and_true] . rw [Zaq] @[inline] def elS (n:Nat) (w gw bw:Word) (b0:Nat) (S1:Int) (dw:Word) (mean:Unit -> ℚ):Word := if sv dw <= 0 then roundRational ((rationalWord w-mean ())*rationalWord gw/rationalWord dw+rationalWord bw) else let c2:=min (b0+idxOf gw) (idxOf bw+idxOf dw) let c:=Yap (signOf w) (n*(mantOf w*p2 (idxOf w-b0))) (!(S1 < 0)) S1.natAbs let D:=n*mantOf dw let r0:=c.2%D*mantOf gw let k1:=p2 (b0+idxOf gw-c2) let ra:=r0%D*k1 let Q:=Y3 (c.1 != signOf gw) ((c.2/D*mantOf gw+r0/D)*k1+ra/D) (ra%D) (signOf bw) (mantOf bw*p2 (idxOf bw+idxOf dw-c2)) D if 16777216 <= Q.2.1 then Ya9 Q.1 (2*Q.2.1+(if Q.2.2=0 then 0 else 1)) ((c2:Int)-150-idxOf dw) else let N:=Q.2.1*D+Q.2.2 YN (Q.1&&N != 0) N D ((c2:Int)-149-idxOf dw) lemma sdm (a m D:Nat):a*m/D=a/D*m+a%D*m/D/\a*m%D=a%D*m%D:=by rcases Nat.eq_zero_or_pos D with rfl|hD . simp . have e:a*m=a%D*m+D*(a/D*m):=by rw [<- Nat.mul_assoc, <- Nat.add_mul, Nat.mod_add_div] rw [e,Nat.add_mul_div_left _ _ hD,Nat.add_mul_mod_self_left];exact ⟨Nat.add_comm _ _,rfl⟩ lemma elS_eq (n:Nat) (w gw bw:Word) (b0:Nat) (S1:Int) (dw:Word) (mean:Unit -> ℚ): elS n w gw bw b0 S1 dw mean=Yba n w gw bw b0 S1 dw mean:=by unfold elS Yba;dsimp only generalize Yap (signOf w) (n*(mantOf w*p2 (idxOf w-b0))) (!decide (S1 < 0)) S1.natAbs=c generalize n*mantOf dw=D rw [(sdm c.2 (mantOf gw) D).1,(sdm c.2 (mantOf gw) D).2] lemma gO {α:Type} [Inhabited α] (n:Nat) (f:Nat -> α) (k:Nat) (hk:k < n) : (Array.ofFn (n:=n) λ i=>f i.val)[k]! = f k:=by simp_all @[inline] def u2a (h l t:UInt64):UInt64×UInt64:=let l':=l+t;(h+(if l' < l then 1 else 0),l') lemma u2a_v (h l t:UInt64) (hb:h.toNat*18446744073709551616+l.toNat+t.toNat < 340282366920938463463374607431768211456) : (u2a h l t).1.toNat*18446744073709551616+(u2a h l t).2.toNat=h.toNat*18446744073709551616+l.toNat+t.toNat:=by unfold u2a; dsimp only have hl:=l.toNat_lt; have ht:=t.toNat_lt; have hh:=h.toNat_lt by_cases c:l.toNat+t.toNat < 18446744073709551616 · have e:(l+t).toNat=l.toNat+t.toNat:=by rw [UInt64.toNat_add]; exact Nat.mod_eq_of_lt c have nc:¬ (l+t < l):=by rw [UInt64.lt_iff_toNat_lt, e]; omega simp only [nc, if_false, e]; rw [UInt64.toNat_add]; simp; omega · have e:(l+t).toNat=l.toNat+t.toNat-18446744073709551616:=by rw [UInt64.toNat_add]; omega have cc:l+t < l:=by rw [UInt64.lt_iff_toNat_lt, e]; omega simp only [cc, if_true, e]; rw [UInt64.toNat_add]; simp; omega lemma qsplit (m s:Nat) (hm:m < 2^24) (hs:s <= 36) : (if 2*s.toUInt64 < 64 then ((m.toUInt64*m.toUInt64)>>>1)>>>(63-2*s.toUInt64) else (m.toUInt64*m.toUInt64)<<<(2*s.toUInt64-64)).toNat*18446744073709551616+(if 2*s.toUInt64 < 64 then (m.toUInt64*m.toUInt64)<<<(2*s.toUInt64) else 0).toNat=m*m*2^(2*s):=by have eq:(m.toUInt64*m.toUInt64).toNat=m*m:=by rw [UInt64.toNat_mul, UInt64.toNat_ofNat_of_lt' (by unfold UInt64.size; omega)]; exact Nat.mod_eq_of_lt (by nlinarith) have es:(2*s.toUInt64).toNat=2*s:=by rw [UInt64.toNat_mul, UInt64.toNat_ofNat_of_lt' (by unfold UInt64.size; omega)]; simp; omega have hq:m*m < 2^48:=by nlinarith have h64:(64:UInt64).toNat=64:=rfl by_cases c:2*s < 64 · have c':2*s.toUInt64 < 64:=by rw [UInt64.lt_iff_toNat_lt, es, h64]; exact c simp only [c', if_true] have e63:(63-2*s.toUInt64).toNat=63-2*s:=by rw [UInt64.toNat_sub_of_le _ _ (by rw [UInt64.le_iff_toNat_le, es]; show 2*s <= 63; omega), es]; rfl rw [UInt64.toNat_shiftRight, UInt64.toNat_shiftRight, UInt64.toNat_shiftLeft, eq, es, e63] simp only [Nat.shiftRight_eq_div_pow, Nat.shiftLeft_eq, show (1:UInt64).toNat=1 from rfl] rw [Nat.mod_eq_of_lt (show 63-2*s < 64 by omega), Nat.mod_eq_of_lt c, Nat.div_div_eq_div_mul] have e1:m*m/(2^(1%64)*2^(63-2*s))=m*m*2^(2*s)/2^64:=by rw [show (2:Nat)^64=(2^(1%64)*2^(63-2*s))*2^(2*s) by rw [<- pow_add, <- pow_add]; congr 1; omega, Nat.mul_div_mul_right _ _ (by positivity)] rw [e1]; have:=Nat.div_add_mod (m*m*2^(2*s)) (2^64); rw [Nat.mul_comm] at this; norm_num at this ⊢; exact this · have c':¬ (2*s.toUInt64 < 64):=by rw [UInt64.lt_iff_toNat_lt, es, h64]; exact c simp only [c', if_false] have e2:(2*s.toUInt64-64).toNat=2*s-64:=by rw [UInt64.toNat_sub_of_le _ _ (by rw [UInt64.le_iff_toNat_le, es, h64]; omega), es, h64] rw [UInt64.toNat_shiftLeft, eq, e2, Nat.shiftLeft_eq, Nat.mod_eq_of_lt (show 2*s-64 < 64 by omega)] have hb:m*m*2^(2*s-64) < 2^64:=by calc m*m*2^(2*s-64) < 2^48*2^(2*s-64):=by apply Nat.mul_lt_mul_of_pos_right hq; positivity _ <= 2^48*2^8:=by apply Nat.mul_le_mul_left; apply Nat.pow_le_pow_right <;> omega _ < 2^64:=by norm_num rw [Nat.mod_eq_of_lt hb]; simp only [show (0:UInt64).toNat=0 from rfl, add_zero] rw [show (2:Nat)^(2*s)=2^(2*s-64)*2^64 by rw [<- pow_add]; congr 1; omega]; norm_num; ring def rsU (x:Array Word) (base n b0 j:Nat) (ph pl nh nl qh ql:UInt64) (ok:Bool):Bool×Nat×Nat×Nat:= if j < n then let w:=x[base+j]! let m:=(mantOf w).toUInt64 let s:=(idxOf w-b0).toUInt64 let t:=m<<>>1)>>>(63-2*s) else q<<<(2*s-64)) let ok':=ok&&(mantOf w=0||idxOf w-b0 <= 36) if signOf w then let p:=u2a nh nl t; rsU x base n b0 (j+1) ph pl p.1 p.2 qh' a.2 ok' else let p:=u2a ph pl t; rsU x base n b0 (j+1) p.1 p.2 nh nl qh' a.2 ok' else (ok&&n<256,ph.toNat<<<64+pl.toNat,nh.toNat<<<64+nl.toNat,qh.toNat<<<64+ql.toNat) termination_by n-j lemma rsU_ok (x:Array Word) (base n b0:Nat) : ∀ k j ph pl nh nl qh ql ok, n-j=k -> (rsU x base n b0 j ph pl nh nl qh ql ok).1=true -> ok=true /\ n < 256 /\ ∀ t,j <= t -> t < n -> (mantOf x[base+t]! = 0 \/ idxOf x[base+t]!-b0 <= 36):=by intro k; induction k with | zero=>intro j ph pl nh nl qh ql ok hk h; unfold rsU at h; rw [if_neg (by omega)] at h; simp at h; exact ⟨h.1,h.2,λ t h1 h2=>by omega⟩ | succ k ih=> intro j ph pl nh nl qh ql ok hk h; unfold rsU at h; rw [if_pos (by omega)] at h; dsimp only at h split at h all_goals (obtain ⟨o1,o2,o3⟩:=ih (j+1) _ _ _ _ _ _ _ (by omega) h; simp only [Bool.and_eq_true,Bool.or_eq_true,decide_eq_true_eq] at o1 refine ⟨o1.1,o2,λ t h1 h2=>?_⟩; rcases Nat.eq_or_lt_of_le h1 with rfl|h1 · exact o1.2 · exact o3 t (by omega) h2) lemma rsU_val (x:Array Word) (base n b0:Nat) : ∀ k j ph pl nh nl qh ql ok, n-j=k -> (∀ t,j <= t -> t < n -> (mantOf x[base+t]! = 0 \/ idxOf x[base+t]!-b0 <= 36)) -> ph.toNat*18446744073709551616+pl.toNat+((List.range' j (n-j)).map λ t=>if signOf x[base+t]! then 0 else mantOf x[base+t]!*2^(idxOf x[base+t]!-b0)).sum < 340282366920938463463374607431768211456 -> nh.toNat*18446744073709551616+nl.toNat+((List.range' j (n-j)).map λ t=>if signOf x[base+t]! then mantOf x[base+t]!*2^(idxOf x[base+t]!-b0) else 0).sum < 340282366920938463463374607431768211456 -> qh.toNat*18446744073709551616+ql.toNat+((List.range' j (n-j)).map λ t=>mantOf x[base+t]!*mantOf x[base+t]!*2^(2*(idxOf x[base+t]!-b0))).sum < 340282366920938463463374607431768211456 -> (rsU x base n b0 j ph pl nh nl qh ql ok).2.1=ph.toNat*18446744073709551616+pl.toNat+((List.range' j (n-j)).map λ t=>if signOf x[base+t]! then 0 else mantOf x[base+t]!*2^(idxOf x[base+t]!-b0)).sum /\ (rsU x base n b0 j ph pl nh nl qh ql ok).2.2.1=nh.toNat*18446744073709551616+nl.toNat+((List.range' j (n-j)).map λ t=>if signOf x[base+t]! then mantOf x[base+t]!*2^(idxOf x[base+t]!-b0) else 0).sum /\ (rsU x base n b0 j ph pl nh nl qh ql ok).2.2.2=qh.toNat*18446744073709551616+ql.toNat+((List.range' j (n-j)).map λ t=>mantOf x[base+t]!*mantOf x[base+t]!*2^(2*(idxOf x[base+t]!-b0))).sum:=by intro k; induction k with | zero=>intro j ph pl nh nl qh ql ok hk hg bP bN bQ; unfold rsU; rw [if_neg (by omega)]; simp [hk, Nat.shiftLeft_eq] | succ k ih=> intro j ph pl nh nl qh ql ok hk hg bP bN bQ have hj:j < n:=by omega have e2:n-(j+1)=k:=by omega rw [hk,List.range'_succ] at bP bN bQ ⊢ simp only [List.map_cons,List.sum_cons] at bP bN bQ ⊢ unfold rsU; rw [if_pos hj]; dsimp only have hgj:=hg j (le_refl _) hj have hg':(∀ t,j+1 <= t -> t < n -> (mantOf x[base+t]! = 0 \/ idxOf x[base+t]!-b0 <= 36)):=λ t h1 h2=>hg t (by omega) h2 generalize x[base+j]! = w at hgj bP bN bQ ⊢ have hm:=mantOf_lt_24 w have hi:=iB w have em:(mantOf w).toUInt64.toNat=mantOf w:=UInt64.toNat_ofNat_of_lt' (by unfold UInt64.size; omega) have es:(idxOf w-b0).toUInt64.toNat=idxOf w-b0:=UInt64.toNat_ofNat_of_lt' (by unfold UInt64.size; omega) have et:((mantOf w).toUInt64<<<(idxOf w-b0).toUInt64).toNat=mantOf w*2^(idxOf w-b0):=by rcases hgj with h0|h36 · rw [h0]; simp · rw [UInt64.toNat_shiftLeft,em,es,Nat.shiftLeft_eq,Nat.mod_eq_of_lt (show idxOf w-b0 < 64 by omega)] apply Nat.mod_eq_of_lt calc mantOf w*2^(idxOf w-b0) < 2^24*2^36:=Nat.mul_lt_mul_of_lt_of_le hm (Nat.pow_le_pow_right (by norm_num) h36) (by positivity) _ < 2^64:=by norm_num have eq2:(if 2*(idxOf w-b0).toUInt64 < 64 then (((mantOf w).toUInt64*(mantOf w).toUInt64)>>>1)>>>(63-2*(idxOf w-b0).toUInt64) else ((mantOf w).toUInt64*(mantOf w).toUInt64)<<<(2*(idxOf w-b0).toUInt64-64)).toNat*18446744073709551616+(if 2*(idxOf w-b0).toUInt64 < 64 then ((mantOf w).toUInt64*(mantOf w).toUInt64)<<<(2*(idxOf w-b0).toUInt64) else 0).toNat=mantOf w*mantOf w*2^(2*(idxOf w-b0)):=by rcases hgj with h0|h36 · rw [h0]; simp · exact qsplit _ _ hm h36 generalize ((mantOf w).toUInt64<<<(idxOf w-b0).toUInt64)=T at et ⊢ generalize (if 2*(idxOf w-b0).toUInt64 < 64 then ((mantOf w).toUInt64*(mantOf w).toUInt64)<<<(2*(idxOf w-b0).toUInt64) else 0)=LO at eq2 ⊢ generalize (if 2*(idxOf w-b0).toUInt64 < 64 then (((mantOf w).toUInt64*(mantOf w).toUInt64)>>>1)>>>(63-2*(idxOf w-b0).toUInt64) else ((mantOf w).toUInt64*(mantOf w).toUInt64)<<<(2*(idxOf w-b0).toUInt64-64))=HI at eq2 ⊢ have hLO:LO.toNat <= mantOf w*mantOf w*2^(2*(idxOf w-b0)):=by rw [<- eq2]; exact Nat.le_add_left _ _ have ea:=u2a_v qh ql LO (lt_of_le_of_lt (Nat.add_le_add_left (le_trans hLO (Nat.le_add_right _ _)) _) bQ) generalize u2a qh ql LO=A at ea ⊢ have k1:(A.1.toNat+HI.toNat)*18446744073709551616 < 18446744073709551616*18446744073709551616:=by calc (A.1.toNat+HI.toNat)*18446744073709551616 <= A.1.toNat*18446744073709551616+A.2.toNat+HI.toNat*18446744073709551616:=by rw [Nat.add_mul]; exact Nat.add_le_add_right (Nat.le_add_right _ _) _ _ = qh.toNat*18446744073709551616+ql.toNat+mantOf w*mantOf w*2^(2*(idxOf w-b0)):=by rw [ea, <- eq2]; ring _ <= qh.toNat*18446744073709551616+ql.toNat+(mantOf w*mantOf w*2^(2*(idxOf w-b0))+((List.map (fun t => mantOf x[base + t]! * mantOf x[base + t]! * 2 ^ (2 * (idxOf x[base + t]! - b0))) (List.range' (j + 1) k)).sum)):=Nat.add_le_add_left (Nat.le_add_right _ _) _ _ < 18446744073709551616*18446744073709551616:=bQ have eqh:(A.1+HI).toNat=A.1.toNat+HI.toNat:=by rw [UInt64.toNat_add]; exact Nat.mod_eq_of_lt (Nat.lt_of_mul_lt_mul_right k1) have eQ:(A.1.toNat+HI.toNat)*18446744073709551616+A.2.toNat=qh.toNat*18446744073709551616+ql.toNat+mantOf w*mantOf w*2^(2*(idxOf w-b0)):=by rw [Nat.add_mul]; linarith have bQ':(A.1+HI).toNat*18446744073709551616+A.2.toNat+((List.map (fun t => mantOf x[base + t]! * mantOf x[base + t]! * 2 ^ (2 * (idxOf x[base + t]! - b0))) (List.range' (j + 1) k)).sum) < 340282366920938463463374607431768211456:=by rw [eqh,eQ,Nat.add_assoc]; exact bQ by_cases hs:signOf w = true · simp only [hs,if_true,zero_add] at bP bN ⊢ have ep:=u2a_v nh nl T (lt_of_le_of_lt (Nat.add_le_add_left (by rw [et]; exact Nat.le_add_right _ _) _) bN) generalize u2a nh nl T=Pp at ep ⊢ obtain ⟨r1,r2,r3⟩:=ih (j+1) ph pl Pp.1 Pp.2 (A.1+HI) A.2 _ e2 hg' (by rw [e2]; exact bP) (by rw [e2,ep,et,Nat.add_assoc]; exact bN) (by rw [e2]; exact bQ') rw [e2] at r1 r2 r3; rw [r1,r2,r3]; refine ⟨rfl,by rw [ep,et]; ring,by rw [eqh]; linarith⟩ · simp only [hs,Bool.false_eq_true,if_false,zero_add] at bP bN ⊢ have ep:=u2a_v ph pl T (lt_of_le_of_lt (Nat.add_le_add_left (by rw [et]; exact Nat.le_add_right _ _) _) bP) generalize u2a ph pl T=Pp at ep ⊢ obtain ⟨r1,r2,r3⟩:=ih (j+1) Pp.1 Pp.2 nh nl (A.1+HI) A.2 _ e2 hg' (by rw [e2,ep,et,Nat.add_assoc]; exact bP) (by rw [e2]; exact bN) (by rw [e2]; exact bQ') rw [e2] at r1 r2 r3; rw [r1,r2,r3]; refine ⟨by rw [ep,et]; ring,rfl,by rw [eqh]; linarith⟩ lemma sumB (l:List Nat) (f:Nat -> Nat) (B:Nat) (h:∀ t ∈ l,f t <= B) : (l.map f).sum <= l.length*B:=by have:=List.sum_le_card_nsmul (l.map f) B (λ y hy=>by obtain ⟨t,ht,rfl⟩:=List.mem_map.1 hy; exact h t ht) simpa using this lemma sdif (l:List Nat) (f g:Nat -> Nat) (F:Nat -> Int) (h:∀ t,(f t:Int)-g t=F t) : ((l.map f).sum:Int)-(l.map g).sum=(l.map F).sum:=by induction l with | nil=>simp | cons a l ih=>simp only [List.map_cons,List.sum_cons]; push_cast; have:=h a; push_cast at ih; linarith lemma rsU_lim (x:Array Word) (base n b0:Nat) (h:(rsU x base n b0 0 0 0 0 0 0 0 true).1=true) : ((rsU x base n b0 0 0 0 0 0 0 0 true).2.1:Int)-(rsU x base n b0 0 0 0 0 0 0 0 true).2.2.1=(limbValA (Y7 x base n b0).1:Int)-limbValA (Y7 x base n b0).2 /\ (rsU x base n b0 0 0 0 0 0 0 0 true).2.2.2=limbValA (Y6 x base n b0):=by obtain ⟨-,hn,hg⟩:=rsU_ok x base n b0 _ 0 0 0 0 0 0 0 true rfl h have tP:∀ t ∈ List.range' 0 (n-0),mantOf x[base+t]!*2^(idxOf x[base+t]!-b0) <= 2^60:=by intro t ht; have h1:=List.mem_range'_1.1 ht; have hm:=mantOf_lt_24 x[base+t]! rcases hg t (by omega) (by omega) with h0|h36 · rw [h0]; simp · calc mantOf x[base+t]!*2^(idxOf x[base+t]!-b0) <= 2^24*2^36:=Nat.mul_le_mul (by omega) (Nat.pow_le_pow_right (by norm_num) h36) _ = 2^60:=by norm_num have tQ:∀ t ∈ List.range' 0 (n-0),mantOf x[base+t]!*mantOf x[base+t]!*2^(2*(idxOf x[base+t]!-b0)) <= 2^120:=by intro t ht; have h1:=List.mem_range'_1.1 ht; have hm:=mantOf_lt_24 x[base+t]! rcases hg t (by omega) (by omega) with h0|h36 · rw [h0]; simp · calc mantOf x[base+t]!*mantOf x[base+t]!*2^(2*(idxOf x[base+t]!-b0)) <= 2^24*2^24*2^72:=Nat.mul_le_mul (Nat.mul_le_mul (by omega) (by omega)) (Nat.pow_le_pow_right (by norm_num) (by omega)) _ = 2^120:=by norm_num have sP:=sumB _ (λ t=>if signOf x[base+t]! then 0 else mantOf x[base+t]!*2^(idxOf x[base+t]!-b0)) (2^60) (λ t ht=>by split <;> [exact Nat.zero_le _; exact tP t ht]) have sN:=sumB _ (λ t=>if signOf x[base+t]! then mantOf x[base+t]!*2^(idxOf x[base+t]!-b0) else 0) (2^60) (λ t ht=>by split <;> [exact tP t ht; exact Nat.zero_le _]) have sQ:=sumB _ (λ t=>mantOf x[base+t]!*mantOf x[base+t]!*2^(2*(idxOf x[base+t]!-b0))) (2^120) tQ simp only [List.length_range'] at sP sN sQ obtain ⟨v1,v2,v3⟩:=rsU_val x base n b0 _ 0 0 0 0 0 0 0 true rfl (λ t _ ht=>hg t (by omega) ht) (by simp only [show (0:UInt64).toNat=0 from rfl]; norm_num at sP ⊢; omega) (by simp only [show (0:UInt64).toNat=0 from rfl]; norm_num at sN ⊢; omega) (by simp only [show (0:UInt64).toNat=0 from rfl]; norm_num at sQ ⊢; omega) simp only [show (0:UInt64).toNat=0 from rfl,zero_mul,zero_add,Nat.sub_zero, <- List.range_eq_range'] at v1 v2 v3 constructor · rw [v1,v2]; unfold Y7 rw [limbValA_eq,limbValA_eq,(lP x base b0 _ (λ _ _=>rfl) (List.range n) _ _ (by simp) (by simp)).2.2] have h0:limbVal (Array.replicate 18 0).toList=0:=by decide rw [h0]; simp only [Nat.cast_zero,sub_zero,zero_add] exact sdif _ _ _ _ (λ t=>by simp only [sv]; split_ifs <;> push_cast <;> ring) · rw [v3]; unfold Y6 rw [limbValA_eq,(lS (λ j=>mantOf x[base+j]! * mantOf x[base+j]!) (λ j=>2*(idxOf x[base+j]! - b0)) (λ j=>by have:=mantOf_lt_24 x[base+j]!; nlinarith) (λ j=>by have:=iB x[base+j]!; omega) _ _ (by simp)).2] have h0:limbVal (Array.replicate 18 0).toList=0:=by decide rw [h0,zero_add] @[inline] def Y8f (x:Array Word) (n:Nat) (eps:Word) (r:Nat):Nat × Int × Word := let b0:=Y2 x (r*n) n let u:=rsU x (r*n) n b0 0 0 0 0 0 0 0 true let S1:Int:=if u.1 then (u.2.1:Int)-u.2.2.1 else (limbValA (Y7 x (r*n) n b0).1:Int)-limbValA (Y7 x (r*n) n b0).2 let T:Int:=(n:Int)*(if u.1 then u.2.2.2 else limbValA (Y6 x (r*n) n b0))-S1*S1 let c:=YF b0 (idxOf eps) (b0,S1,YaD (T.toNat<<<(2*b0-c)+(n*n*mantOf eps)<<<(idxOf eps+149-c)) (n*n) (((c:Int)-298)/2) λ _ => sqrtRational (rowVariance n x r (rowMean n x r)+rationalWord eps)) lemma Y8f_eq (x:Array Word) (n:Nat) (eps:Word) (r:Nat) : Y8f x n eps r=Y8 x n eps r:=by unfold Y8f Y8; dsimp only by_cases h:(rsU x (r*n) n (Y2 x (r*n) n) 0 0 0 0 0 0 0 true).1=true · obtain ⟨e1,e2⟩:=rsU_lim x (r*n) n (Y2 x (r*n) n) h simp only [h,if_true,e1,e2] · simp only [h,Bool.false_eq_true,if_false] section @[inline] def Ya7 (n:Nat) (w gw bw:Word) (b0:Nat) (S1:Int) (dw:Word) (mean:Unit -> ℚ):Word := if sv dw <= 0 then roundRational ((rationalWord w-mean ())*rationalWord gw/rationalWord dw+rationalWord bw) else let c2:=min (b0+idxOf gw) (idxOf bw+idxOf dw) let c:=Yap (signOf w) (n*(mantOf w*p2 (idxOf w-b0))) (!(S1 < 0)) S1.natAbs let D:=n*mantOf dw let r0:=c.2%D*mantOf gw let k1:=p2 (b0+idxOf gw-c2) let ra:=r0%D*k1 let Q:=Y3 (c.1 != signOf gw) ((c.2/D*mantOf gw+r0/D)*k1+ra/D) (ra%D) (signOf bw) (mantOf bw*p2 (idxOf bw+idxOf dw-c2)) D if 16777216 <= Q.2.1 then YN Q.1 (2*Q.2.1+(if Q.2.2=0 then 0 else 1)) 1 ((c2:Int)-150-idxOf dw) else let N:=Q.2.1*D+Q.2.2 YN (Q.1&&N != 0) N D ((c2:Int)-149-idxOf dw) lemma shm (w:UInt32) (m:UInt64) (k:Nat) (hk:k <= 38) (h:mantOf w=0\/(m.toNat <= idxOf w/\idxOf w-m.toNat <= k)) : (Yf w<<<(Yd w-m)).toNat=mantOf w*2^(idxOf w-m.toNat) /\ mantOf w*2^(idxOf w-m.toNat) < 2^(24+k):=by rcases h with h0 | ⟨h1,h2⟩ . have:Yf w=0:=UInt64.toNat_inj.mp (by rw [Zk,h0]; rfl);rw [this,h0]; simp . have hsub:(Yd w-m).toNat=idxOf w-m.toNat:=by rw [UInt64.toNat_sub_of_le _ _ (UInt64.le_iff_toNat_le.mpr (by rw [Zf]; exact h1)), Zf] have hm:=mantOf_lt_24 w;have hp:mantOf w*2^(idxOf w-m.toNat) < 2^(24+k) := calc _ < 2^24*2^(idxOf w-m.toNat):=Nat.mul_lt_mul_of_pos_right hm (Nat.two_pow_pos _) _ <= 2^24*2^k:=Nat.mul_le_mul_left _ (Nat.pow_le_pow_right (by norm_num) h2) _=2^(24+k):=by rw [pow_add] refine ⟨?_,hp⟩;rw [UInt64.toNat_shiftLeft,hsub,Zk,Nat.mod_eq_of_lt (show idxOf w-m.toNat < 64 by omega), Nat.shiftLeft_eq] exact Nat.mod_eq_of_lt (lt_of_lt_of_le hp (Nat.pow_le_pow_right (by norm_num) (by omega))) end section open ExactRuntime FloatLib.Floats.Formats.BinaryInterchange FloatLib.Floats open Float.Model.UnpackedFloat @[inline] def rqU (a b:UInt64):UInt64 := let q:=a/b let tw:=2*(a%b) if tw < b then q else if b < tw then q+1 else if q%2==0 then q else q+1 @[inline] def rrsG (s:Bool) (N D U V:UInt64) (fb:Unit -> Word):Word := let i:=Yj N-Yj D let R:=if N < D<<>>k=0):x < 2^k:=by rw [Nat.shiftRight_eq_div_pow] at h; exact (Nat.div_eq_zero_iff_lt (by positivity)).mp h end section open ExactRuntime FloatLib.Floats.Formats.BinaryInterchange FloatLib.Floats FloatLib.Numerics open Model open RationalBinary (floorLog2 scaleByPowerOfTwo scaleByPowerOfTwo_snd_ne_zero) open FloatLib.Numerics (binaryRadix Radix.toReal) lemma flr (P Dm r:Nat) (hD:Dm≠0) (hP:P≠0) (h1:2^r*Dm <= P) (h2:P < 2^(r+1)*Dm) : fl2 P Dm = (r:Int):=by rw [Zbo] obtain ⟨b1,b2⟩:=floorLog2_bounds P Dm hP hD have hDr:(0:ℝ) < Dm:=by exact_mod_cast Nat.pos_of_ne_zero hD apply cU b1 b2 . rw [bz,zpow_natCast,le_div_iff₀ hDr]; exact_mod_cast h1 . rw [bz,show ((r:Int)+1)=((r+1:Nat):Int) by push_cast; ring,zpow_natCast,div_lt_iff₀ hDr]; exact_mod_cast h2 lemma rqge (a b:Nat):a/b <= FloatLib.Numerics.roundQuotientEven a b:=by unfold FloatLib.Numerics.roundQuotientEven; dsimp only; split_ifs <;> omega lemma rrsC (s:Bool) (P Dm:Nat) (E:Int) (R:Nat) (hP:P≠0) (hDm:Dm≠0) (h1:2^R*Dm <= P) (h2:P < 2^(R+1)*Dm) (m:Nat) (hm:FloatLib.Numerics.roundQuotientEven (sc2 P Dm (23-(R:Int))).1 (sc2 P Dm (23-(R:Int))).2 = m) (ht:-126 <= (R:Int)+E) (hx:(R:Int)+E+(if m = 16777216 then 1 else 0) <= 127) : YN s P Dm E = Model.NativeBinary32.mkBits s (Int.toNat ((R:Int)+E+(if m = 16777216 then 1 else 0)+127)) ((if m = 16777216 then 8388608 else m)-8388608):=by unfold YN rw [if_neg (by simpa using hDm),if_neg (by simpa using hP)] dsimp only rw [flr P Dm R hDm hP h1 h2,hm] have hk:(if m = 16777216 then (1:Int) else 0) <= 1 ∧ 0 <= (if m = 16777216 then (1:Int) else 0):=by split <;> omega rw [if_neg (by omega),if_neg (by omega),if_neg (by omega)] by_cases hk2:m=16777216 . simp only [hk2,beq_self_eq_true,ite_true] at hx ⊢; rw [if_neg (by omega)] . have:(m==16777216)=false:=by simpa using hk2 simp only [hk2,this,ite_false,Bool.false_eq_true] at hx ⊢; rw [if_neg (by omega)]; simp lemma rqUe2 (a b:UInt64) (hb0:0 < b.toNat) (hb:b.toNat < 2^63) (hq:a.toNat/b.toNat < 2^63) : (rqU a b).toNat = FloatLib.Numerics.roundQuotientEven a.toNat b.toNat:=by unfold rqU FloatLib.Numerics.roundQuotientEven dsimp only have hq0:(a/b).toNat=a.toNat/b.toNat:=UInt64.toNat_div a b have hr:(a%b).toNat=a.toNat%b.toNat:=UInt64.toNat_mod a b have hrl:a.toNat%b.toNat < b.toNat:=Nat.mod_lt _ hb0 have htw:(2*(a%b)).toNat=2*(a.toNat%b.toNat):=by rw [UInt64.toNat_mul,hr]; simp; omega have hq1:(a/b+1).toNat=a.toNat/b.toNat+1:=by rw [UInt64.toNat_add,hq0]; simp; omega have hm2:((a/b)%2).toNat=(a.toNat/b.toNat)%2:=by rw [UInt64.toNat_mod,hq0]; rfl have e3:((a/b)%2==0)=true ↔ (a.toNat/b.toNat)%2=0:=by simp only [beq_iff_eq]; rw [<- hm2]; exact ⟨λ h=>by rw [h]; rfl,λ h=>UInt64.toNat_inj.mp (by rw [h]; rfl)⟩ by_cases c1:2*(a.toNat%b.toNat) < b.toNat . have:2*(a%b) < b:=by rw [UInt64.lt_iff_toNat_lt,htw]; exact c1 rw [if_pos this,if_pos c1,hq0] . have:¬ 2*(a%b) < b:=by rw [UInt64.lt_iff_toNat_lt,htw]; exact c1 rw [if_neg this,if_neg c1] by_cases c2:b.toNat < 2*(a.toNat%b.toNat) . have:b < 2*(a%b):=by rw [UInt64.lt_iff_toNat_lt,htw]; exact c2 rw [if_pos this,if_pos c2,hq1] . have:¬ b < 2*(a%b):=by rw [UInt64.lt_iff_toNat_lt,htw]; exact c2 rw [if_neg this,if_neg c2] by_cases c3:(a.toNat/b.toNat)%2=0 . rw [if_pos (e3.mpr c3),if_pos (by simpa using c3),hq0] . rw [if_neg (λ h=>c3 (e3.mp h)),if_neg (by simpa using c3),hq1] lemma p2le (a b:Nat) (h:a <= b):2^a <= 2^b:=Nat.pow_le_pow_right (by norm_num) h lemma rRe (N D:UInt64) (hD0:0 < D.toNat) (hND:D.toNat <= N.toNat) (hD:D.toNat < 2^40) : let R:=if N < D<<<(Yj N-Yj D) then Yj N-Yj D-1 else Yj N-Yj D R.toNat <= 63 ∧ 2^R.toNat*D.toNat <= N.toNat ∧ N.toNat < 2^(R.toNat+1)*D.toNat:=by intro R have hN0:N≠0:=λ h=>by rw [h] at hND; simp at hND; omega have hD0':D≠0:=λ h=>by rw [h] at hD0; simp at hD0 have hln:=Zj N hN0; have hld:=Zj D hD0' have bN:=(Nat.log2_eq_iff (show N.toNat≠0 by omega)).mp rfl have bD:=(Nat.log2_eq_iff (show D.toNat≠0 by omega)).mp rfl have hN64:=N.toNat_lt generalize N.toNat.log2=ln at bN hln generalize D.toNat.log2=ld at bD hld have hle:ld <= ln:=by have:2^ld < 2^(ln+1):=lt_of_le_of_lt (le_trans bD.1 hND) bN.2 have:=(Nat.pow_lt_pow_iff_right (by norm_num : 1 < 2)).mp this; omega have hl63:ln <= 63:=by by_contra h; have:2^64 <= 2^ln:=p2le _ _ (by omega) have:N.toNat < 2^64:=hN64; omega have hi:(Yj N-Yj D).toNat=ln-ld:=by rw [UInt64.toNat_sub_of_le _ _ (by rw [UInt64.le_iff_toNat_le,hln,hld]; exact hle),hln,hld] have e1:2^(ld+1)*2^(ln-ld)=2^(ln+1):=by rw [<- pow_add,show ld+1+(ln-ld)=ln+1 by omega] have h1:D.toNat*2^(ln-ld) < 2^(ln+1):=by rw [<- e1]; exact Nat.mul_lt_mul_of_pos_right bD.2 (by positivity) have h2:2^(ln+1) <= 2^64:=p2le _ _ (by omega) have hsh:(D<<<(Yj N-Yj D)).toNat=D.toNat*2^(ln-ld):=by rw [UInt64.toNat_shiftLeft,hi,Nat.mod_eq_of_lt (show ln-ld < 64 by omega),Nat.shiftLeft_eq] exact Nat.mod_eq_of_lt (lt_of_lt_of_le h1 h2) have e2:2^(ln-ld+1)*2^ld=2^(ln+1):=by rw [<- pow_add,show ln-ld+1+ld=ln+1 by omega] have up:N.toNat < 2^(ln-ld+1)*D.toNat:=by have:2^(ln-ld+1)*2^ld <= 2^(ln-ld+1)*D.toNat:=Nat.mul_le_mul_left _ bD.1 rw [e2] at this; omega by_cases c:N < D<<<(Yj N-Yj D) . have hR:R=Yj N-Yj D-1:=if_pos c rw [UInt64.lt_iff_toNat_lt,hsh] at c have hi1:1 <= ln-ld:=by by_contra h; have:ln-ld=0:=by omega rw [this] at c; simp at c; omega have hRn:R.toNat=ln-ld-1:=by rw [hR,UInt64.toNat_sub_of_le _ _ (by rw [UInt64.le_iff_toNat_le,hi]; simp; omega),hi]; simp rw [hRn] have e:ln-ld-1+1=ln-ld:=by omega have e3:2^(ln-ld-1)*2^(ld+1)=2^ln:=by rw [<- pow_add,show ln-ld-1+(ld+1)=ln by omega] have h3:2^(ln-ld-1)*D.toNat < 2^(ln-ld-1)*2^(ld+1):=Nat.mul_lt_mul_of_pos_left bD.2 (by positivity) rw [e3] at h3 refine ⟨by omega,by omega,by rw [e,Nat.mul_comm]; exact c⟩ . have hR:R=Yj N-Yj D:=if_neg c rw [UInt64.lt_iff_toNat_lt,hsh] at c rw [hR,hi] exact ⟨by omega,by rw [Nat.mul_comm]; omega,up⟩ lemma rrsGe (s:Bool) (N D U V:UInt64) (E:Int) (X:Word) (hD0:0 < D.toNat) (hND:D.toNat <= N.toNat) (hD:D.toNat < 2^40) (hU:U.toNat < 2^20) (hV:V.toNat < 2^20) (hE:E+127=(U.toNat:Int)-V.toNat) (hX:X=YN s N.toNat D.toNat E) : rrsG s N D U V (λ _=>X) = X:=by unfold rrsG; dsimp only obtain ⟨hR63,hr1,hr2⟩:=rRe N D hD0 hND hD generalize (if N < D<<<(Yj N-Yj D) then Yj N-Yj D-1 else Yj N-Yj D)=R at hR63 hr1 hr2 ⊢ have hN64:=N.toNat_lt have hab:∃ A B:Nat,(if R <= 23 then N<<<(23-R) else N).toNat=A ∧ (if R <= 23 then D else D<<<(R-23)).toNat=B ∧ sc2 N.toNat D.toNat (23-(R.toNat:Int))=(A,B) ∧ 0 < B ∧ B < 2^63 ∧ A/B < 2^24 ∧ 2^23*B <= A:=by by_cases hR:R <= 23 . have hRn:R.toNat <= 23:=by rw [UInt64.le_iff_toNat_le] at hR; simpa using hR have hsub:(23-R).toNat=23-R.toNat:=by rw [UInt64.toNat_sub_of_le _ _ hR]; simp have e1:2^(R.toNat+1)*2^(23-R.toNat)=2^24:=by rw [<- pow_add,show R.toNat+1+(23-R.toNat)=24 by omega] have e2:2^R.toNat*2^(23-R.toNat)=2^23:=by rw [<- pow_add,show R.toNat+(23-R.toNat)=23 by omega] have hA:N.toNat*2^(23-R.toNat) < D.toNat*2^24:=by have:=Nat.mul_lt_mul_of_pos_right hr2 (show 0 < 2^(23-R.toNat) by positivity) rw [Nat.mul_assoc,Nat.mul_comm (D.toNat),<- Nat.mul_assoc,e1] at this; linarith have hA2:2^23*D.toNat <= N.toNat*2^(23-R.toNat):=by have:=Nat.mul_le_mul_right (2^(23-R.toNat)) hr1 rw [Nat.mul_comm (2^R.toNat),Nat.mul_assoc,e2] at this; linarith have hD24:D.toNat*2^24 < 2^64:=by calc D.toNat*2^24 < 2^40*2^24:=Nat.mul_lt_mul_of_pos_right hD (by positivity) _ = 2^64:=by norm_num refine ⟨N.toNat*2^(23-R.toNat),D.toNat,?_,?_,?_,hD0,by omega,?_,hA2⟩ . rw [if_pos hR,UInt64.toNat_shiftLeft,hsub,Nat.mod_eq_of_lt (show 23-R.toNat < 64 by omega),Nat.shiftLeft_eq] exact Nat.mod_eq_of_lt (by omega) . rw [if_pos hR] . have e:(23:Int)-(R.toNat:Int)=Int.ofNat (23-R.toNat):=by rw [Int.ofNat_eq_coe]; omega rw [e]; simp [sc2,ZE] . exact (Nat.div_lt_iff_lt_mul hD0).mpr (by linarith) . have hRn:23 < R.toNat:=by rw [UInt64.le_iff_toNat_le] at hR; simp at hR; omega have hsub:(R-23).toNat=R.toNat-23:=by rw [UInt64.toNat_sub_of_le _ _ (by rw [UInt64.le_iff_toNat_le]; simp; omega)]; simp have e1:2^23*2^(R.toNat-23)=2^R.toNat:=by rw [<- pow_add,show 23+(R.toNat-23)=R.toNat by omega] have e2:2^24*2^(R.toNat-23)=2^(R.toNat+1):=by rw [<- pow_add,show 24+(R.toNat-23)=R.toNat+1 by omega] have hB1:2^23*(D.toNat*2^(R.toNat-23)) <= N.toNat:=by rw [<- Nat.mul_assoc,Nat.mul_comm (2^23),Nat.mul_assoc,e1,Nat.mul_comm]; exact hr1 have hB2:N.toNat < 2^24*(D.toNat*2^(R.toNat-23)):=by rw [<- Nat.mul_assoc,Nat.mul_comm (2^24),Nat.mul_assoc,e2,Nat.mul_comm]; exact hr2 have hBlt:D.toNat*2^(R.toNat-23) < 2^41:=by have:2^23*(D.toNat*2^(R.toNat-23)) < 2^23*2^41:=lt_of_le_of_lt hB1 (by norm_num; omega) exact Nat.lt_of_mul_lt_mul_left this refine ⟨N.toNat,D.toNat*2^(R.toNat-23),?_,?_,?_,by positivity,by omega,?_,hB1⟩ . rw [if_neg hR] . rw [if_neg hR,UInt64.toNat_shiftLeft,hsub,Nat.mod_eq_of_lt (show R.toNat-23 < 64 by omega),Nat.shiftLeft_eq] exact Nat.mod_eq_of_lt (by omega) . have e:(23:Int)-(R.toNat:Int)=Int.negSucc (R.toNat-24):=by omega rw [e]; simp only [sc2,ZE,Prod.mk.injEq,true_and]; rw [show R.toNat-24+1=R.toNat-23 by omega] . exact (Nat.div_lt_iff_lt_mul (by positivity)).mpr (by linarith) obtain ⟨A,B,ha,hb,hsc,hB0,hB,hq,hq2⟩:=hab have hm:=rqUe2 (if R <= 23 then N<<<(23-R) else N) (if R <= 23 then D else D<<<(R-23)) (by rw [hb]; exact hB0) (by rw [hb]; exact hB) (by rw [ha,hb]; omega) rw [ha,hb] at hm have hmge:2^23 <= (rqU (if R <= 23 then N<<<(23-R) else N) (if R <= 23 then D else D<<<(R-23))).toNat:=by rw [hm]; exact le_trans ((Nat.le_div_iff_mul_le hB0).mpr (by linarith)) (rqge A B) have hm24:(rqU (if R <= 23 then N<<<(23-R) else N) (if R <= 23 then D else D<<<(R-23))).toNat <= 2^24:=by rw [hm]; unfold FloatLib.Numerics.roundQuotientEven; dsimp only; split_ifs <;> omega generalize (rqU (if R <= 23 then N<<<(23-R) else N) (if R <= 23 then D else D<<<(R-23)))=mU at hm hmge hm24 ⊢ have hk:(if mU==16777216 then (1:UInt64) else 0).toNat=(if mU.toNat=16777216 then 1 else 0):=by by_cases h:mU.toNat=16777216 . have:mU=16777216:=UInt64.toNat_inj.mp (by rw [h]; rfl) simp [this] . have:¬ mU=16777216:=λ e=>h (by rw [e]; rfl) simp [this,h] have hk2:((if (if mU==16777216 then (1:UInt64) else 0)==1 then 8388608 else mU)-8388608).toNat=(if mU.toNat=16777216 then 8388608 else mU.toNat)-8388608:=by by_cases h:mU.toNat=16777216 . have:mU=16777216:=UInt64.toNat_inj.mp (by rw [h]; rfl) simp [this] . have:¬ mU=16777216:=λ e=>h (by rw [e]; rfl) simp only [this,h,beq_iff_eq,ite_false,show ¬ ((0:UInt64)=1) by decide] rw [UInt64.toNat_sub_of_le _ _ (by rw [UInt64.le_iff_toNat_le]; simp; omega)]; simp generalize (if mU==16777216 then (1:UInt64) else 0)=kk at hk hk2 ⊢ have hk1:(if mU.toNat=16777216 then 1 else 0) <= 1:=by split <;> omega have hRU:(R+U).toNat=R.toNat+U.toNat:=by rw [UInt64.toNat_add]; omega have hRUk:(R+U+kk).toNat=R.toNat+U.toNat+(if mU.toNat=16777216 then 1 else 0):=by rw [UInt64.toNat_add,hRU,hk]; omega by_cases hc:(decide (V < R+U) && decide (R+U+kk-V <= 254))=true . rw [if_pos hc] simp only [Bool.and_eq_true,decide_eq_true_eq] at hc obtain ⟨hc1,hc2⟩:=hc rw [UInt64.lt_iff_toNat_lt,hRU] at hc1 have hsub:(R+U+kk-V).toNat=R.toNat+U.toNat+(if mU.toNat=16777216 then 1 else 0)-V.toNat:=by rw [UInt64.toNat_sub_of_le _ _ (by rw [UInt64.le_iff_toNat_le,hRUk]; omega),hRUk] rw [UInt64.le_iff_toNat_le,hsub] at hc2 rw [hX,rrsC s N.toNat D.toNat E R.toNat (by omega) (by omega) hr1 hr2 mU.toNat (by rw [hsc]; exact hm.symm) (by omega) (by split <;> simp_all <;> omega),hsub,hk2] congr 1 split <;> simp_all <;> omega . rw [if_neg hc] lemma eok (w:Word) (h:(expOf w).toUInt64-1 < 254) : 1 <= (expOf w).toNat ∧ (expOf w).toNat <= 254:=by have h0:=expOf_toNat_lt w rw [UInt64.lt_iff_toNat_lt] at h by_cases hz:(expOf w).toNat=0 . have:(expOf w).toUInt64=0:=UInt64.toNat_inj.mp (by simp [UInt32.toNat_toUInt64,hz]) rw [this] at h; simp at h . rw [UInt64.toNat_sub_of_le _ _ (by rw [UInt64.le_iff_toNat_le]; simp [UInt32.toNat_toUInt64]; omega)] at h simp [UInt32.toNat_toUInt64] at h; omega lemma mok (w:Word) (h:1 <= (expOf w).toNat) : mantOf w = 2^23+(fracOf w).toNat ∧ idxOf w = (expOf w).toNat-1:=by have hne:expOf w ≠ 0:=λ e=>by rw [e] at h; simp at h unfold mantOf idxOf; rw [if_neg hne,if_neg hne]; exact ⟨rfl,rfl⟩ end section open ExactRuntime FloatLib.Floats.Formats.BinaryInterchange FloatLib.Floats @[inline] def Ya7G (n:Nat) (w gw bw:Word) (b0:Nat) (S1:Int) (dw:Word) (mean:Unit -> ℚ) (nU b0U:UInt64) (S1n:Bool) (S1a:UInt64):Word := let ed:=(expOf dw).toUInt64 if ed-1 < 254 && !signOf dw && 0 < nU && nU < 4096 && S1a < 0x1000000000000000 && expOf w != 255 && expOf gw != 255 && expOf bw != 255 then let iw:=Yd w let ig:=Yd gw let ib:=Yd bw let idd:=ed-1 let mw:=Yf w if mw == 0 || (b0U <= iw && iw-b0U <= 24) then let x:=nU*(mw<<<(iw-b0U)) let cs:Bool:=if signOf w == S1n then signOf w else if S1a <= x then signOf w else S1n let cv:=if signOf w == S1n then x+S1a else if S1a <= x then x-S1a else S1a-x let D:=nU*Yf dw let c2:=if b0U+ig <= ib+idd then b0U+ig else ib+idd let ks:=b0U+ig-c2 let bs:=ib+idd-c2 let q0:=cv/D let r0:=cv%D*Yf gw let qq:=q0*Yf gw+r0/D if ks <= 8 && qq < (1:UInt64)<<<(61-ks) && bs <= 37 then let ra:=(r0%D)<<Ya7 n w gw bw b0 S1 dw mean) else let N:=qi*D+qr if N == 0 then 0 else if N < D then Ya7 n w gw bw b0 S1 dw mean else rrsG qs N D (c2+1) (idd+23) (λ _=>Ya7 n w gw bw b0 S1 dw mean) else Ya7 n w gw bw b0 S1 dw mean else Ya7 n w gw bw b0 S1 dw mean else Ya7 n w gw bw b0 S1 dw mean end section open ExactRuntime FloatLib.Floats.Formats.BinaryInterchange FloatLib.Floats FloatLib.Numerics open Model open RationalBinary (floorLog2 scaleByPowerOfTwo scaleByPowerOfTwo_snd_ne_zero) open FloatLib.Numerics (binaryRadix Radix.toReal) lemma u64m2 (a b:UInt64) (h:a.toNat*b.toNat < 2^64):(a*b).toNat=a.toNat*b.toNat:=by rw [UInt64.toNat_mul,Nat.mod_eq_of_lt h] lemma u64a2 (a b:UInt64) (h:a.toNat+b.toNat < 2^64):(a+b).toNat=a.toNat+b.toNat:=by rw [UInt64.toNat_add,Nat.mod_eq_of_lt h] lemma u64s2 (a b:UInt64) (h:b.toNat <= a.toNat):(a-b).toNat=a.toNat-b.toNat:=by rw [UInt64.toNat_sub_of_le _ _ (UInt64.le_iff_toNat_le.mpr h)] lemma u64sh (a s:UInt64) (hs:s.toNat < 64) (h:a.toNat*2^s.toNat < 2^64):(a<<f (UInt64.le_iff_toNat_le.mp h) simp only [f,f',ite_false] by_cases g:rr.toNat=0 . have g':rr=0:=UInt64.toNat_inj.mp (by rw [g]; rfl) simp only [g,g',beq_self_eq_true,ite_true]; rw [u64s2 _ _ (by omega)]; simp . have g':(rr==0)=false:=by simp only [beq_eq_false_iff_ne]; intro h; apply g; rw [h]; rfl simp only [g,g',ite_false,Bool.false_eq_true] rw [u64s2 _ _ (by rw [u64s2 _ _ (by omega)]; simp; omega),u64s2 _ _ (by omega),u64s2 _ _ (by omega)]; simp lemma Ya7Ge (n:Nat) (w gw bw:Word) (b0:Nat) (S1:Int) (dw:Word) (mean:Unit -> ℚ) (nU b0U:UInt64) (S1n:Bool) (S1a:UInt64) (hn:0 < nU.toNat → nU.toNat=n) (hb:b0U.toNat=b0) (hb255:b0 < 256) (hs:S1n=!(decide (S1 < 0))) (ha:S1a.toNat < 2^60 → S1a.toNat=S1.natAbs) : Ya7G n w gw bw b0 S1 dw mean nU b0U S1n S1a = Ya7 n w gw bw b0 S1 dw mean:=by unfold Ya7G dsimp only by_cases c1:((expOf dw).toUInt64-1 < 254 && !signOf dw && 0 < nU && nU < 4096 && S1a < 0x1000000000000000 && expOf w != 255 && expOf gw != 255 && expOf bw != 255)=true . rw [if_pos c1] simp only [Bool.and_eq_true,Bool.not_eq_true',decide_eq_true_eq,bne_iff_ne,ne_eq] at c1 obtain ⟨⟨⟨⟨⟨⟨⟨c1a,c1b⟩,c1c⟩,c1d⟩,c1e⟩,c1f⟩,c1g⟩,c1h⟩:=c1 replace hn:=hn (by rw [UInt64.lt_iff_toNat_lt] at c1c; simpa using c1c) have hed:=eok dw c1a obtain ⟨hmd,hid⟩:=mok dw hed.1 have hfd:=fracOf_toNat_lt dw have hn0:0 < n:=by rw [<- hn]; rw [UInt64.lt_iff_toNat_lt] at c1c; simpa using c1c have hn1:n < 4096:=by rw [<- hn]; rw [UInt64.lt_iff_toNat_lt] at c1d; simpa using c1d have hSa:S1a.toNat < 2^60:=by rw [UInt64.lt_iff_toNat_lt] at c1e; simpa using c1e have hS1:=ha hSa have hsv:¬ (sv dw <= 0):=by unfold sv; rw [if_neg (by simp [c1b])]; push_cast; omega have hidd:((expOf dw).toUInt64-1).toNat=idxOf dw:=by rw [u64s2 _ _ (by simp [UInt32.toNat_toUInt64]; omega),hid]; simp [UInt32.toNat_toUInt64] by_cases c2:(Yf w == 0 || (b0U <= Yd w && Yd w-b0U <= 24))=true . rw [if_pos c2] have hm24:=mantOf_lt_24 w; have hg24:=mantOf_lt_24 gw; have hb24:=mantOf_lt_24 bw have hsh:mantOf w=0 ∨ (b0U.toNat <= idxOf w ∧ idxOf w-b0U.toNat <= 24):=by simp only [Bool.or_eq_true,beq_iff_eq,Bool.and_eq_true,decide_eq_true_eq] at c2 rcases c2 with h|⟨h1,h2⟩ . left; rw [<- Zk,h]; rfl . right; rw [UInt64.le_iff_toNat_le,Zf] at h1; refine ⟨h1,?_⟩ rw [UInt64.le_iff_toNat_le,u64s2 _ _ (by rw [Zf]; exact h1),Zf] at h2; simpa using h2 obtain ⟨hxs,hxs2⟩:=shm w b0U 24 (by norm_num) hsh rw [hb] at hxs hxs2 have hxb':n*(mantOf w*2^(idxOf w-b0)) < 2^60:=by have:=Nat.mul_lt_mul'' hn1 hxs2 calc n*(mantOf w*2^(idxOf w-b0)) < 4096*2^(24+24):=this _ = 2^60:=by norm_num have hxb:n*(mantOf w*p2 (idxOf w-b0)) < 2^60:=by rw [ZE]; exact hxb' have hx:(nU*(Yf w<<<(Yd w-b0U))).toNat=n*(mantOf w*p2 (idxOf w-b0)):=by rw [u64m2 _ _ (by rw [hn,hxs]; omega),hn,hxs,ZE] generalize nU*(Yf w<<<(Yd w-b0U))=x at hx ⊢ generalize (expOf dw).toUInt64-1=idd at hidd ⊢ have hiw:=iB w; have hig:=iB gw; have hib:=iB bw; have hidb:=iB dw have hyah:Yap (signOf w) (n*(mantOf w*p2 (idxOf w-b0))) (!(decide (S1 < 0))) S1.natAbs =((if (signOf w == S1n) = true then signOf w else if S1a ≤ x then signOf w else S1n), (if (signOf w == S1n) = true then x + S1a else if S1a ≤ x then x - S1a else S1a - x).toNat):=by unfold Yap; rw [<- hs,<- hS1,<- hx] by_cases e:signOf w = S1n . simp only [e,beq_self_eq_true,ite_true]; rw [u64a2 _ _ (by omega)] . have e':(signOf w == S1n)=false:=by simpa using e simp only [e',Bool.false_eq_true,ite_false] by_cases f:S1a ≤ x . have f':S1a.toNat ≤ x.toNat:=UInt64.le_iff_toNat_le.mp f simp only [f',f,ite_true]; rw [u64s2 _ _ f'] . have f':¬ S1a.toNat ≤ x.toNat:=λ h=>f (UInt64.le_iff_toNat_le.mpr h) simp only [f',f,ite_false]; rw [u64s2 _ _ (by omega)] have hcvb:(if (signOf w == S1n) = true then x + S1a else if S1a ≤ x then x - S1a else S1a - x).toNat < 2^61:=by have:=congrArg Prod.snd hyah; simp only [] at this; rw [<- this] unfold Yap; split_ifs <;> simp <;> omega generalize (if (signOf w == S1n) = true then x + S1a else if S1a ≤ x then x - S1a else S1a - x)=cv at hyah hcvb ⊢ generalize (if (signOf w == S1n) = true then signOf w else if S1a ≤ x then signOf w else S1n)=cs at hyah ⊢ have hDb:2^23 <= n*mantOf dw ∧ n*mantOf dw < 2^36:=by have u:=Nat.mul_lt_mul'' hn1 (mantOf_lt_24 dw) refine ⟨le_trans (show 2^23 <= mantOf dw by rw [hmd]; omega) (Nat.le_mul_of_pos_left _ hn0),lt_of_lt_of_eq u (by norm_num)⟩ have hD:(nU*Yf dw).toNat=n*mantOf dw:=by rw [u64m2 _ _ (by rw [hn,Zk]; omega),hn,Zk] generalize nU*Yf dw=D at hD ⊢ have hbg:(b0U+Yd gw).toNat=b0+idxOf gw:=by rw [u64a2 _ _ (by rw [hb,Zf]; omega),hb,Zf] have hbd:(Yd bw+idd).toNat=idxOf bw+idxOf dw:=by rw [u64a2 _ _ (by rw [Zf,hidd]; omega),Zf,hidd] have hc2:(if b0U+Yd gw ≤ Yd bw+idd then b0U+Yd gw else Yd bw+idd).toNat=min (b0+idxOf gw) (idxOf bw+idxOf dw):=by split <;> rename_i h <;> rw [UInt64.le_iff_toNat_le,hbg,hbd] at h . rw [hbg]; omega . rw [hbd]; omega have hks:(b0U+Yd gw-(if b0U+Yd gw ≤ Yd bw+idd then b0U+Yd gw else Yd bw+idd)).toNat=b0+idxOf gw-min (b0+idxOf gw) (idxOf bw+idxOf dw):=by rw [u64s2 _ _ (by rw [hc2,hbg]; omega),hbg,hc2] have hbs:(Yd bw+idd-(if b0U+Yd gw ≤ Yd bw+idd then b0U+Yd gw else Yd bw+idd)).toNat=idxOf bw+idxOf dw-min (b0+idxOf gw) (idxOf bw+idxOf dw):=by rw [u64s2 _ _ (by rw [hc2,hbd]; omega),hbd,hc2] generalize (if b0U+Yd gw ≤ Yd bw+idd then b0U+Yd gw else Yd bw+idd)=c2 at hc2 hks hbs ⊢ generalize b0U+Yd gw-c2=ks at hks ⊢ generalize Yd bw+idd-c2=bs at hbs ⊢ have hDp:0 < D.toNat:=by omega have hmg:=Zk gw; have hmb:=Zk bw have hq0:(cv/D).toNat=cv.toNat/D.toNat:=UInt64.toNat_div cv D have hq0b:cv.toNat/D.toNat < 2^38:=by apply (Nat.div_lt_iff_lt_mul hDp).mpr calc cv.toNat < 2^61:=hcvb _ = 2^38*2^23:=by norm_num _ <= 2^38*D.toNat:=Nat.mul_le_mul_left _ (by omega) have hr0:(cv%D).toNat=cv.toNat%D.toNat:=UInt64.toNat_mod cv D have hr0b:cv.toNat%D.toNat < 2^36:=lt_of_lt_of_le (Nat.mod_lt _ hDp) (by omega) have hA1:cv.toNat/D.toNat*mantOf gw < 2^62:=by calc cv.toNat/D.toNat*mantOf gw < 2^38*2^24:=Nat.mul_lt_mul'' hq0b hg24 _ = 2^62:=by norm_num have hA2:cv.toNat%D.toNat*mantOf gw < 2^60:=by calc cv.toNat%D.toNat*mantOf gw < 2^36*2^24:=Nat.mul_lt_mul'' hr0b hg24 _ = 2^60:=by norm_num have hA3:cv.toNat%D.toNat*mantOf gw/D.toNat < 2^24:=by apply (Nat.div_lt_iff_lt_mul hDp).mpr have:=Nat.mul_lt_mul'' (Nat.mod_lt cv.toNat hDp) hg24 linarith have hm1:(cv/D*Yf gw).toNat=cv.toNat/D.toNat*mantOf gw:=by rw [u64m2 _ _ (by rw [hq0,hmg]; omega),hq0,hmg] have hm2:(cv%D*Yf gw).toNat=cv.toNat%D.toNat*mantOf gw:=by rw [u64m2 _ _ (by rw [hr0,hmg]; omega),hr0,hmg] have hqq:(cv/D*Yf gw+cv%D*Yf gw/D).toNat=cv.toNat/D.toNat*mantOf gw+cv.toNat%D.toNat*mantOf gw/D.toNat:=by rw [u64a2 _ _ (by rw [hm1,UInt64.toNat_div,hm2]; omega),hm1,UInt64.toNat_div,hm2] generalize cv/D*Yf gw+cv%D*Yf gw/D=qq at hqq ⊢ by_cases c3:(decide (ks ≤ 8) && decide (qq < 1 <<< (61 - ks)) && decide (bs ≤ 37))=true . rw [if_pos c3] simp only [Bool.and_eq_true,decide_eq_true_eq] at c3 obtain ⟨⟨c3a,c3b⟩,c3c⟩:=c3 have hks8:ks.toNat ≤ 8:=by rw [UInt64.le_iff_toNat_le] at c3a; simpa using c3a have hbs37:bs.toNat ≤ 37:=by rw [UInt64.le_iff_toNat_le] at c3c; simpa using c3c have h61s:(61-ks).toNat=61-ks.toNat:=by rw [u64s2 _ _ (by simp; omega)]; simp have h61:((1:UInt64) <<< (61 - ks)).toNat = 2^(61-ks.toNat):=by rw [u64sh _ _ (by rw [h61s]; omega) (by rw [h61s,UInt64.toNat_one,one_mul]; exact Nat.pow_lt_pow_right (by norm_num : 1 < 2) (by omega)),h61s]; simp have hqqb:qq.toNat < 2^(61-ks.toNat):=by rw [UInt64.lt_iff_toNat_lt,h61] at c3b; exact c3b have e61:2^(61-ks.toNat)*2^ks.toNat=2^61:=by rw [<- pow_add,show 61-ks.toNat+ks.toNat=61 by omega] have hpk:2^ks.toNat <= 2^8:=Nat.pow_le_pow_right (by norm_num) hks8 have hrm:(cv % D * Yf gw % D).toNat=cv.toNat%D.toNat*mantOf gw%D.toNat:=by rw [UInt64.toNat_mod,hm2] have hrmb:cv.toNat%D.toNat*mantOf gw%D.toNat < 2^36:=lt_of_lt_of_le (Nat.mod_lt _ hDp) (by omega) have hrab:cv.toNat%D.toNat*mantOf gw%D.toNat*2^ks.toNat < 2^44:=by calc _ < 2^36*2^8:=Nat.mul_lt_mul_of_lt_of_le hrmb hpk (by positivity) _ = 2^44:=by norm_num have hra:((cv % D * Yf gw % D) <<< ks).toNat=cv.toNat%D.toNat*mantOf gw%D.toNat*2^ks.toNat:=by rw [u64sh _ _ (by omega) (by rw [hrm]; omega),hrm] generalize (cv % D * Yf gw % D) <<< ks=ra at hra ⊢ have hqsb:qq.toNat*2^ks.toNat < 2^61:=by rw [<- e61]; exact Nat.mul_lt_mul_of_pos_right hqqb (by positivity) have hqs:(qq <<< ks).toNat=qq.toNat*2^ks.toNat:=by rw [u64sh _ _ (by omega) (by omega)] have hrd:ra.toNat/D.toNat <= ra.toNat:=Nat.div_le_self _ _ have hqa:(qq <<< ks + ra / D).toNat=qq.toNat*2^ks.toNat+ra.toNat/D.toNat:=by rw [u64a2 _ _ (by rw [hqs,UInt64.toNat_div]; omega),hqs,UInt64.toNat_div] generalize qq <<< ks + ra / D=qa at hqa ⊢ have hrr:(ra % D).toNat=ra.toNat%D.toNat:=UInt64.toNat_mod ra D have hrrD:ra.toNat%D.toNat < D.toNat:=Nat.mod_lt _ hDp generalize ra % D=rr at hrr ⊢ have hpb:2^bs.toNat <= 2^37:=Nat.pow_le_pow_right (by norm_num) hbs37 have hBb:mantOf bw*2^bs.toNat < 2^61:=by calc _ < 2^24*2^37:=Nat.mul_lt_mul_of_lt_of_le hb24 hpb (by positivity) _ = 2^61:=by norm_num have hB:(Yf bw <<< bs).toNat=mantOf bw*2^bs.toNat:=by rw [u64sh _ _ (by omega) (by rw [hmb]; omega),hmb] generalize Yf bw <<< bs=B at hB ⊢ have hrab2:ra.toNat < 2^44:=by rw [hra]; exact hrab have hqab:qa.toNat < 2^62:=by rw [hqa]; have:=Nat.div_le_self ra.toNat D.toNat; omega have hY1:=Y1e (cs != signOf gw) (signOf bw) qa rr B D (by omega) (by omega) have hqib:(if (cs != signOf gw) == signOf bw then qa+B else if B ≤ qa then qa-B else if rr == 0 then B-qa else B-qa-1).toNat < 2^63:=by have:=congrArg (λ p=>p.2.1) hY1; simp only [] at this; rw [<- this] unfold Y3; split_ifs <;> simp <;> omega have hqrb:(if (cs != signOf gw) == signOf bw then rr else if B ≤ qa then rr else if rr == 0 then 0 else D-rr).toNat < D.toNat:=by have:=congrArg (λ p=>p.2.2) hY1; simp only [] at this; rw [<- this] unfold Y3; split_ifs <;> simp <;> omega generalize (if (cs != signOf gw) == signOf bw then (cs != signOf gw) else if B ≤ qa then (cs != signOf gw) else signOf bw)=qs at hY1 ⊢ generalize (if (cs != signOf gw) == signOf bw then qa+B else if B ≤ qa then qa-B else if rr == 0 then B-qa else B-qa-1)=qi at hY1 hqib ⊢ generalize (if (cs != signOf gw) == signOf bw then rr else if B ≤ qa then rr else if rr == 0 then 0 else D-rr)=qr at hY1 hqrb ⊢ have hY7:Ya7 n w gw bw b0 S1 dw mean=(if 16777216 ≤ qi.toNat then YN qs (2*qi.toNat+(if qr.toNat=0 then 0 else 1)) 1 ((c2.toNat:Int)-150-idxOf dw) else YN (qs&&qi.toNat*D.toNat+qr.toNat != 0) (qi.toNat*D.toNat+qr.toNat) D.toNat ((c2.toNat:Int)-149-idxOf dw)):=by unfold Ya7; rw [if_neg hsv]; dsimp only rw [hyah]; dsimp only rw [<- hD,ZE,ZE,<- hks,<- hbs,<- hc2,<- hqq,<- hra,<- hqa,<- hrr,<- hB,hY1] have hV:(idd+23).toNat=idxOf dw+23:=by rw [u64a2 _ _ (by rw [hidd]; simp; omega),hidd]; simp by_cases h16:16777216 ≤ qi.toNat . have h16':(16777216:UInt64) ≤ qi:=UInt64.le_iff_toNat_le.mpr (by simpa using h16) rw [if_pos h16'] have hM:(2*qi+(if qr == 0 then 0 else 1)).toNat=2*qi.toNat+(if qr.toNat=0 then 0 else 1):=by have h2q:(2*qi).toNat=2*qi.toNat:=by rw [UInt64.toNat_mul]; simp; omega by_cases e:qr.toNat=0 . have e':qr=0:=UInt64.toNat_inj.mp (by rw [e]; rfl) simp only [e',e,beq_self_eq_true,ite_true]; rw [u64a2 _ _ (by rw [h2q]; simp; omega),h2q]; simp . have e':(qr==0)=false:=by simp only [beq_eq_false_iff_ne]; intro h; apply e; rw [h]; rfl simp only [e',e,Bool.false_eq_true,ite_false]; rw [u64a2 _ _ (by rw [h2q]; simp; omega),h2q]; simp exact rrsGe qs (2*qi+(if qr == 0 then 0 else 1)) 1 c2 (idd+23) ((c2.toNat:Int)-150-idxOf dw) (Ya7 n w gw bw b0 S1 dw mean) (by simp) (by rw [hM]; simp; omega) (by simp) (by rw [hc2]; omega) (by rw [hV]; omega) (by rw [hV]; push_cast; omega) (by rw [hY7,if_pos h16,hM]; simp) . have h16':¬ (16777216:UInt64) ≤ qi:=λ h=>h16 (by rw [UInt64.le_iff_toNat_le] at h; simpa using h) rw [if_neg h16'] have hqi24:qi.toNat < 2^24:=by omega have hqD:qi.toNat*D.toNat < 2^60:=by calc qi.toNat*D.toNat < 2^24*2^36:=Nat.mul_lt_mul'' hqi24 (by omega) _ = 2^60:=by norm_num have hNv:(qi*D+qr).toNat=qi.toNat*D.toNat+qr.toNat:=by rw [u64a2 _ _ (by rw [u64m2 _ _ (by omega)]; omega),u64m2 _ _ (by omega)] by_cases hN0:qi.toNat*D.toNat+qr.toNat=0 . have:(qi*D+qr==0)=true:=by simp only [beq_iff_eq]; exact UInt64.toNat_inj.mp (by rw [hNv,hN0]; rfl) rw [if_pos this,hY7,if_neg h16,hN0] unfold YN; simp [show D.toNat ≠ 0 by omega] . have:¬(qi*D+qr==0)=true:=by simp only [beq_iff_eq]; intro h; apply hN0; rw [<- hNv,h]; rfl rw [if_neg this] by_cases hND:qi.toNat*D.toNat+qr.toNat < D.toNat . have:qi*D+qr < D:=by rw [UInt64.lt_iff_toNat_lt,hNv]; exact hND rw [if_pos this] . have:¬ qi*D+qr < D:=by rw [UInt64.lt_iff_toNat_lt,hNv]; exact hND rw [if_neg this] have hU:(c2+1).toNat=c2.toNat+1:=by rw [u64a2 _ _ (by rw [hc2]; simp; omega)]; simp exact rrsGe qs (qi*D+qr) D (c2+1) (idd+23) ((c2.toNat:Int)-149-idxOf dw) (Ya7 n w gw bw b0 S1 dw mean) hDp (by rw [hNv]; omega) (by omega) (by rw [hU,hc2]; omega) (by rw [hV]; omega) (by rw [hU,hV]; push_cast; omega) (by have e:(qi.toNat*D.toNat+qr.toNat != 0)=true:=by simpa using hN0 rw [hY7,if_neg h16,hNv,e,Bool.and_true]) . rw [if_neg c3] . rw [if_neg c2] . rw [if_neg c1] end section open ExactRuntime FloatLib.Floats.Formats.BinaryInterchange FloatLib.Floats lemma YTle (x:Array Word) (base n:Nat):Y2 x base n <= 255:=by unfold Y2 have:∀ (l:List Nat) (b:Nat),b <= 255 → l.foldl (λ b j=>let w:=x[base+j]!; if mantOf w=0 then b else min b (idxOf w)) b <= 255:=by intro l; induction l with | nil=>intro b h; simpa using h | cons j l ih=>intro b h; simp only [List.foldl_cons]; apply ih; split <;> omega exact this _ _ le_rfl end section lemma Ya7_eq (n:Nat) (w gw bw:Word) (b0:Nat) (S1:Int) (dw:Word) (mean:Unit -> ℚ): Ya7 n w gw bw b0 S1 dw mean=Yba n w gw bw b0 S1 dw mean:=by rw [<- elS_eq]; unfold Ya7 elS; simp only [Zdk] end def Ybc (rows n:Nat) (eps:Word) (x g b:Array Word):Array Word := if stableNormDomain rows n eps x g&&b.size==n&&b.all finiteWord then let st:=Array.ofFn (n:=rows) λ r=>Y8f x n eps r.val let aux:=Array.ofFn (n:=rows) λ r=> let s:=st[r.val]! let a:=s.2.1.natAbs ((!(s.2.1 < 0)),(if a>>>60 == 0 then a.toUInt64 else 0x1000000000000000),s.1.toUInt64) let nU:=if n < 4096 then n.toUInt64 else 0 YT rows n λ r j=>let s:=st[r]!;let u:=aux[r]!;Ya7G n x[r*n+j]! g[j]! b[j]! s.1 s.2.1 s.2.2 (λ _=>rowMean n x r) nU u.2.2 u.1 u.2.1 else layernormLegacyWith Yn rows n eps x g b lemma Zbs (rows n:Nat) (eps:Word) (x g:Array Word) (h:stableNormDomain rows n eps x g=true):0 < n/\0 < rationalWord eps:=by simp only [stableNormDomain,Bool.and_eq_true,decide_eq_true_eq] at h;exact ⟨h.1.1.1.1.1.1.2,h.2⟩ lemma Zdt:Ybc=layernormSpec:=by funext rows n eps x g b;unfold Ybc layernormSpec layernormWith;split . rename_i hd;have h0:stableNormDomain rows n eps x g=true:=by simp only [Bool.and_eq_true] at hd; exact hd.1.1 obtain ⟨hn,he⟩:=Zbs rows n eps x g h0;unfold layernormStable;rw [ZB _ _ _ rfl];dsimp only;congr 1;funext q;rw [Nat.div_add_mod'];have hr:q.val/n < rows:=Nat.div_lt_of_lt_mul (by simpa [Nat.mul_comm] using q.isLt);have hq:q.val/n*n+q.val%n=q.val:=Nat.div_add_mod' q.val n;rw [gO rows (λ r=>(let s:=(Array.ofFn (n:=rows) λ r=>Y8f x n eps r.val)[r]!;let a:=s.2.1.natAbs ((!(s.2.1 < 0)),(if a>>>60 == 0 then a.toUInt64 else 0x1000000000000000),s.1.toUInt64))) _ hr] dsimp only rw [gO rows (λ r=>Y8f x n eps r) _ hr,Y8f_eq] rw [Ya7Ge n _ _ _ _ _ _ _ _ _ _ _ (by intro h; split at h <;> simp_all [Nat.toUInt64_eq]; omega) (by have:=YTle x (q.val/n*n) n; unfold Y8; simp [Nat.toUInt64_eq]; omega) (by have:=YTle x (q.val/n*n) n; unfold Y8; simp; omega) rfl (by split . rename_i h0; intro h; simp only [beq_iff_eq] at h0; have:=sh0 _ _ h0; simp [Nat.toUInt64_eq]; omega . intro h; simp at h),Ya7_eq] rw [gO rows (λ r=>sqrtRational (rowVariance n x r (Array.ofFn (n:=rows) λ i=>rowMean n x i.val)[r]! + rationalWord eps)) _ hr, gO rows (λ r=>rowMean n x r) _ hr,Zdr _ _ _ _ _ _ _ _ hn, Zde _ _ _ _ _ _ _ _ hn (λ hm=>by have:=Z2 x (q.val/n*n) n (q.val%n) (Nat.mod_lt _ hn) (by rwa [hq]);rwa [hq] at this) (Zdc x n eps _ hn), Zdb x n eps _ hn he] . simp only [Zi] @[inline] def Yi (w:UInt32) (m:UInt64):Nat := ((Yf w<<<(Yd w-m))*(2:UInt64)+(w>>>31).toUInt64).toNat @[specialize] def Yaq (n:Nat) (f:Nat -> Word) (i:Nat) (acc:Array Word):Array Word := if i < n then Yaq n f (i+1) (acc.push (f i)) else acc termination_by n-i @[inline] def Ybd (n:Nat) (f:Nat -> Word):Array Word:=Yaq n f 0 (Array.mkEmpty n) lemma Zdz (n:Nat) (f:Nat -> Word) : ∀ k i (acc:Array Word),n-i=k -> (Yaq n f i acc).toList=acc.toList ++ (List.range' i (n-i)).map f:=by intro k;induction k with | zero=>intro i acc h; unfold Yaq; rw [if_neg (by omega)]; simp [h] | succ k ih => intro i acc h;unfold Yaq; rw [if_pos (by omega),ih (i+1) _ (by omega),show n-i=(n-(i+1))+1 by omega,List.range'_succ];simp lemma ZdA (n:Nat) (f:Nat -> Word):Ybd n f=Array.ofFn (n:=n) λ i=>f i.val:=by apply Array.ext';rw [Ybd,Zdz n f _ 0 _ rfl];apply List.ext_getElem <;> simp def Ybf (relu:Bool) (a b:Array Word):Array Word := Ybd a.size λ i=>act relu (YaX a[i]! b[i]!) lemma ZdC:Ybf=addReluSpec:=by funext relu a b;simp only [Ybf,ZdA,addReluSpec,ZcQ];congr 1; funext i; rw [getElem!_pos a i.val i.isLt]; rfl lemma u1 (n:USize) (h:¬n=0):(n-1).toNat < n.toNat:=by have:n.toNat≠0:=λ e=>h (USize.toNat_inj.mp (by rw [e]; rfl));rw [USize.toNat_sub_of_le _ _ (USize.le_iff_toNat_le.mpr (by simp; omega))]; simp; omega def kernels:Kernels where core:=kernels0.core dense:=⟨YaV,Ya3⟩ conv:=kernels0.conv elem:=⟨kernels0.elem.avgpool,kernels0.elem.maxpool,Ybf,kernels0.elem.scaleShift⟩ norm:=⟨kernels0.norm.rmsnorm,Ybc⟩ theorem correct:Obligation kernels:=by have h:kernels0=specKernels:=ZbZ;simp only [Obligation,kernels,h,specKernels,specDense,specConv,specElem,specNorm,ZcC,Zc0,ZdC,Zdt] end Submission