module Hacl.Spec.BignumQ.Mul open FStar.Mul open Lib.IntTypes module S = Spec.Ed25519 module Lemmas = Hacl.Spec.BignumQ.Lemmas include Hacl.Spec.BignumQ.Definitions #reset-options "--z3rlimit 50 --max_fuel 0 --max_ifuel 0" inline_for_extraction noextract let mask56 : x:uint64{v x == pow2 56 - 1} = assert_norm (pow2 56 - 1 == 0xffffffffffffff); u64 0xffffffffffffff inline_for_extraction noextract let mask40 : x:uint64{v x == pow2 40 - 1} = assert_norm (pow2 40 - 1 == 0xffffffffff); u64 0xffffffffff inline_for_extraction noextract val make_m: unit -> m:qelem5{qelem_fits5 m (1, 1, 1, 1, 1) /\ as_nat5 m == S.q} let make_m () = let m0 = u64 0x12631a5cf5d3ed in let m1 = u64 0xf9dea2f79cd658 in let m2 = u64 0x000000000014de in let m3 = u64 0x00000000000000 in let m4 = u64 0x00000010000000 in assert_norm (as_nat5 (m0, m1, m2, m3, m4) == S.q); (m0, m1, m2, m3, m4) inline_for_extraction noextract val make_mu: unit -> m:qelem5{qelem_fits5 m (1, 1, 1, 1, 1) /\ as_nat5 m == pow2 512 / S.q} let make_mu m = let m0 = u64 0x9ce5a30a2c131b in let m1 = u64 0x215d086329a7ed in let m2 = u64 0xffffffffeb2106 in let m3 = u64 0xffffffffffffff in let m4 = u64 0x00000fffffffff in assert_norm (as_nat5 (m0, m1, m2, m3, m4) == pow2 512 / S.q); (m0, m1, m2, m3, m4) inline_for_extraction noextract val choose: b:uint64 -> x:qelem5 -> y:qelem5 -> Pure qelem5 (requires v b == 0 \/ v b == 1) (ensures fun z -> if v b = 1 then z == x else z == y) let choose b (x0, x1, x2, x3, x4) (y0, y1, y2, y3, y4) = let mask = b -. u64 1 in let z0 = x0 ^. (mask &. (x0 ^. y0)) in Lemmas.lemma_choose_step b x0 y0; let z1 = x1 ^. (mask &. (x1 ^. y1)) in Lemmas.lemma_choose_step b x1 y1; let z2 = x2 ^. (mask &. (x2 ^. y2)) in Lemmas.lemma_choose_step b x2 y2; let z3 = x3 ^. (mask &. (x3 ^. y3)) in Lemmas.lemma_choose_step b x3 y3; let z4 = x4 ^. (mask &. (x4 ^. y4)) in Lemmas.lemma_choose_step b x4 y4; (z0, z1, z2, z3, z4) inline_for_extraction noextract val subm_step: x:uint64 -> y:uint64 -> Pure (uint64 & uint64) (requires v x < pow56 /\ v y <= pow56) (ensures fun (b, t) -> v b <= 1 /\ qelem_fits1 t 1 /\ v x - v y == v t - v b * pow56) let subm_step x y = let b = (x -. y) >>. 63ul in //assert (if v x >= v y then v b == 0 else v b == 1); let lshift56 = (b <<. 56ul) in //assert (if v x >= v y then v lshift56 == 0 else v lshift56 == pow56); //assert (v lshift56 == v b * pow56); //assert (v ((b <<. 56ul) +! x) == v b * pow56 + v x); let t = ((b <<. 56ul) +! x) -! y in b, t inline_for_extraction noextract val subm_conditional: x:qelem5 -> Pure qelem5 (requires qelem_fits5 x (1, 1, 1, 1, 1)) (ensures fun r -> qelem_fits5 r (1, 1, 1, 1, 1) /\ (if as_nat5 x >= S.q then as_nat5 r == as_nat5 x - S.q else as_nat5 r == as_nat5 x)) let subm_conditional (x0, x1, x2, x3, x4) = let (y0, y1, y2, y3, y4) = make_m () in let (b0, t0) = subm_step x0 y0 in assert (v x0 - v y0 == v t0 - v b0 * pow56); let (b1, t1) = subm_step x1 (y1 +! b0) in assert (v x1 - v y1 - v b0 == v t1 - v b1 * pow56); let (b2, t2) = subm_step x2 (y2 +! b1) in assert (v x2 - v y2 - v b1 == v t2 - v b2 * pow56); let (b3, t3) = subm_step x3 (y3 +! b2) in assert (v x3 - v y3 - v b2 == v t3 - v b3 * pow56); let (b4, t4) = subm_step x4 (y4 +! b3) in assert (v x4 - v y4 - v b3 == v t4 - v b4 * pow56); Lemmas.lemma_subm_conditional (v x0) (v x1) (v x2) (v x3) (v x4) (v y0) (v y1) (v y2) (v y3) (v y4) (v b0) (v b1) (v b2) (v b3) (v b4); assert ( as_nat5 (t0, t1, t2, t3, t4) - v b4 * pow56 * pow224 == as_nat5 (x0, x1, x2, x3, x4) - as_nat5 (y0, y1, y2, y3, y4)); //assert_norm (pow56 * pow224 = pow2 280); //assert (as_nat5 (t0, t1, t2, t3, t4) - v b4 * pow2 280 == as_nat5 (x0, x1, x2, x3, x4) - S.q); Lemmas.lemma_as_nat5 (x0, x1, x2, x3, x4); Lemmas.lemma_as_nat5 (t0, t1, t2, t3, t4); //assert (if v b4 = 0 then as_nat5 (x0, x1, x2, x3, x4) >= S.q else as_nat5 (x0, x1, x2, x3, x4) < S.q); assert (if as_nat5 (x0, x1, x2, x3, x4) >= S.q then v b4 == 0 else v b4 == 1); let (z0, z1, z2, z3, z4) = choose b4 (x0, x1, x2, x3, x4) (t0, t1, t2, t3, t4) in assert ( if as_nat5 (x0, x1, x2, x3, x4) >= S.q then as_nat5 (z0, z1, z2, z3, z4) == as_nat5 (t0, t1, t2, t3, t4) else as_nat5 (z0, z1, z2, z3, z4) == as_nat5 (x0, x1, x2, x3, x4)); assert ( if as_nat5 (x0, x1, x2, x3, x4) >= S.q then v b4 == 0 /\ as_nat5 (z0, z1, z2, z3, z4) == as_nat5 (t0, t1, t2, t3, t4) else v b4 == 1 /\ as_nat5 (z0, z1, z2, z3, z4) == as_nat5 (x0, x1, x2, x3, x4)); (z0, z1, z2, z3, z4) inline_for_extraction noextract val carry56: x:uint64 -> Pure (uint64 & uint64) (requires v x <= pow2 57) (ensures fun (t, c) -> v t < pow56 /\ v c <= 2 /\ v x == v c * pow56 + v t) let carry56 x = let carry = x >>. 56ul in FStar.Math.Lemmas.pow2_minus 57 56; let t = x &. mask56 in assert_norm (pow2 56 < pow2 64); mod_mask_lemma x 56ul; assert (v (mod_mask #U64 #SEC 56ul) == v mask56); assert (v t == v x % pow2 56); assert (v x == v carry * pow2 56 + v t); t, carry inline_for_extraction noextract val add_modq5: x:qelem5 -> y:qelem5 -> Pure qelem5 (requires qelem_fits5 x (1, 1, 1, 1, 1) /\ qelem_fits5 y (1, 1, 1, 1, 1) /\ as_nat5 x < S.q /\ as_nat5 y < S.q) (ensures fun z -> qelem_fits5 z (1, 1, 1, 1, 1) /\ as_nat5 z == (as_nat5 x + as_nat5 y) % S.q) let add_modq5 (x0, x1, x2, x3, x4) (y0, y1, y2, y3, y4) = assert_norm (pow56 - 1 + pow56 - 1 == pow2 57 - 2); let (t0, c0) = carry56 (x0 +! y0) in let (t1, c1) = carry56 (x1 +! y1 +! c0) in let (t2, c2) = carry56 (x2 +! y2 +! c1) in let (t3, c3) = carry56 (x3 +! y3 +! c2) in let t4 = x4 +! y4 +! c3 in assert (as_nat5 (t0, t1, t2, t3, t4) == as_nat5 (x0, x1, x2, x3, x4) + as_nat5 (y0, y1, y2, y3, y4)); let (o0, o1, o2, o3, o4) = subm_conditional (t0, t1, t2, t3, t4) in Lemmas.lemma_add_modq5 (x0, x1, x2, x3, x4) (y0, y1, y2, y3, y4) (t0, t1, t2, t3, t4); (o0, o1, o2, o3, o4) inline_for_extraction noextract val carry56_wide: x:uint128 -> Pure (uint128 & uint64) (requires v x < pow2 117) (ensures fun (c, t) -> v t < pow56 /\ v c < pow2 61 /\ v x - v c * pow56 == v t /\ v c == v x / pow56) let carry56_wide x = let carry = x >>. 56ul in let t = to_u64 x &. mask56 in assert_norm (pow2 56 < pow2 64); Math.Lemmas.lemma_div_lt_nat (v x) 117 56; mod_mask_lemma (to_u64 x) 56ul; assert (v (mod_mask #U64 #SEC 56ul) == v mask56); assert (v t == (v x % pow2 64) % pow2 56); FStar.Math.Lemmas.pow2_modulo_modulo_lemma_1 (v x) 56 64; assert (v t == v x % pow2 56); assert (v x == v carry * pow2 56 + v t); carry, t inline_for_extraction noextract val mul64_wide_5: (a:uint64) -> (b:uint64) -> Pure uint128 (requires qelem_fits1 a 1 /\ qelem_fits1 b 1) (ensures fun z -> v z == v a * v b /\ v z <= pow2 112 - pow2 57 + 1 /\ v z < pow2 112) let mul64_wide_5 a b = let lemma_smaller (a b:uint64) : Lemma (requires qelem_fits1 a 1 /\ qelem_fits1 b 1) (ensures v (mul64_wide a b) < pow2 112) = if v a = 0 || v b = 0 then () else calc (<) { v a * v b <: int; (<) { Math.Lemmas.lemma_mult_le_left (v a) (v b) (pow2 56) } v a * pow2 56; (<) { Math.Lemmas.lemma_mult_le_right (pow2 56) (v a) (pow2 56) } pow2 56 * pow2 56; (==) { assert_norm (pow2 56 * pow2 56 == pow2 112) } pow2 112; } in let lemma_le (a b:uint64) : Lemma (requires qelem_fits1 a 1 /\ qelem_fits1 b 1) (ensures v (mul64_wide a b) <= pow2 112 - pow2 57 + 1) = if v a = 0 || v b = 0 then () else assert_norm (pow2 112 - pow2 57 + 1 >= 0); calc (<=) { v a * v b <: int; (<=) { Math.Lemmas.lemma_mult_le_left (v a) (v b) (pow2 56 - 1) } v a * (pow2 56 - 1); (<=) { Math.Lemmas.lemma_mult_le_right (pow2 56 - 1) (v a) (pow2 56 - 1) } (pow2 56 - 1) * (pow2 56 - 1); (==) { assert_norm ((pow2 56 - 1) * (pow2 56 - 1) == pow2 112 - pow2 57 + 1) } pow2 112 - pow2 57 + 1; } in lemma_le a b; lemma_smaller a b; mul64_wide a b inline_for_extraction noextract val add2: (a:uint128) -> (b:uint128) -> Pure uint128 (requires v a < pow2 112 /\ v b < pow2 112) (ensures fun z -> v z == v a + v b /\ v z <= pow2 116) let add2 a b = assert_norm (pow2 112 + pow2 112 < pow2 128); assert_norm (pow2 112 + pow2 112 <= pow2 116); Math.Lemmas.small_mod (v a + v b) (pow2 128); a +. b inline_for_extraction noextract val add3: (a:uint128) -> (b:uint128) -> (c:uint128) -> Pure uint128 (requires v a < pow2 112 /\ v b < pow2 112 /\ v c < pow2 112 ) (ensures fun z -> v z == v a + v b + v c /\ v z <= pow2 116) let add3 a b c = assert_norm (pow2 112 + pow2 112 < pow2 128); assert_norm (pow2 112 + pow2 112 + pow2 112 < pow2 128); assert_norm (pow2 112 + pow2 112 + pow2 112 <= pow2 116); Math.Lemmas.small_mod (v a + v b) (pow2 128); Math.Lemmas.small_mod (v a + v b + v c) (pow2 128); a +. b +. c inline_for_extraction noextract val add4: (a:uint128) -> (b:uint128) -> (c:uint128) -> (d:uint128) -> Pure uint128 (requires v a < pow2 112 /\ v b < pow2 112 /\ v c < pow2 112 /\ v d < pow2 112) (ensures fun z -> v z == v a + v b + v c + v d /\ v z <= pow2 116) let add4 a b c d = assert_norm (pow2 112 + pow2 112 < pow2 128); assert_norm (pow2 112 + pow2 112 + pow2 112 < pow2 128); assert_norm (pow2 112 + pow2 112 + pow2 112 + pow2 112 < pow2 128); assert_norm (pow2 112 + pow2 112 + pow2 112 + pow2 112 <= pow2 116); Math.Lemmas.small_mod (v a + v b) (pow2 128); Math.Lemmas.small_mod (v a + v b + v c) (pow2 128); Math.Lemmas.small_mod (v a + v b + v c + v d) (pow2 128); a +. b +. c +. d inline_for_extraction noextract val add5: (a:uint128) -> (b:uint128) -> (c:uint128) -> (d:uint128) -> (e:uint128) -> Pure uint128 (requires v a < pow2 112 /\ v b < pow2 112 /\ v c < pow2 112 /\ v d < pow2 112 /\ v e < pow2 112) (ensures fun z -> v z == v a + v b + v c + v d + v e/\ v z <= pow2 116) let add5 a b c d e = assert_norm (pow2 112 + pow2 112 < pow2 128); assert_norm (pow2 112 + pow2 112 + pow2 112 < pow2 128); assert_norm (pow2 112 + pow2 112 + pow2 112 + pow2 112 < pow2 128); assert_norm (pow2 112 + pow2 112 + pow2 112 + pow2 112 + pow2 112 < pow2 128); assert_norm (pow2 112 + pow2 112 + pow2 112 + pow2 112 + pow2 112 <= pow2 116); Math.Lemmas.small_mod (v a + v b) (pow2 128); Math.Lemmas.small_mod (v a + v b + v c) (pow2 128); Math.Lemmas.small_mod (v a + v b + v c + v d) (pow2 128); Math.Lemmas.small_mod (v a + v b + v c + v d + v e) (pow2 128); a +. b +. c +. d +. e inline_for_extraction noextract val add_inner_carry: (a:uint128) -> (b:uint128) -> Pure uint128 (requires v a <= pow2 116 /\ v b < pow2 61) (ensures fun z -> v z == v a + v b /\ v z < pow2 117) let add_inner_carry a b = assert_norm (pow2 116 + pow2 61 < pow2 128); assert_norm (pow2 116 + pow2 61 < pow2 117); Math.Lemmas.small_mod (v a + v b) (pow2 128); a +. b inline_for_extraction noextract val mul_5: x:qelem5 -> y:qelem5 -> Pure qelem_wide5 (requires qelem_fits5 x (1, 1, 1, 1, 1) /\ qelem_fits5 y (1, 1, 1, 1, 1)) (ensures fun r -> qelem_wide_fits5 r (1, 1, 1, 1, 1, 1, 1, 1, 1, 1) /\ wide_as_nat5 r == as_nat5 x * as_nat5 y) let lemma_mult_distr_3 (a b c:nat) (n:nat) : Lemma ((a + b - c * pow2 56) * pow2 n == a * pow2 n + b * pow2 n - c * pow2 (n + 56)) = Math.Lemmas.distributivity_sub_left (a + b) (c * pow2 56) (pow2 n); Math.Lemmas.distributivity_add_left a b (pow2 n); Math.Lemmas.pow2_plus 56 n #set-options "--z3rlimit 200" let mul_5 (x0, x1, x2, x3, x4) (y0, y1, y2, y3, y4) = let xy00 = mul64_wide_5 x0 y0 in let xy01 = mul64_wide_5 x0 y1 in let xy02 = mul64_wide_5 x0 y2 in let xy03 = mul64_wide_5 x0 y3 in let xy04 = mul64_wide_5 x0 y4 in let xy10 = mul64_wide_5 x1 y0 in let xy11 = mul64_wide_5 x1 y1 in let xy12 = mul64_wide_5 x1 y2 in let xy13 = mul64_wide_5 x1 y3 in let xy14 = mul64_wide_5 x1 y4 in let xy20 = mul64_wide_5 x2 y0 in let xy21 = mul64_wide_5 x2 y1 in let xy22 = mul64_wide_5 x2 y2 in let xy23 = mul64_wide_5 x2 y3 in let xy24 = mul64_wide_5 x2 y4 in let xy30 = mul64_wide_5 x3 y0 in let xy31 = mul64_wide_5 x3 y1 in let xy32 = mul64_wide_5 x3 y2 in let xy33 = mul64_wide_5 x3 y3 in let xy34 = mul64_wide_5 x3 y4 in let xy40 = mul64_wide_5 x4 y0 in let xy41 = mul64_wide_5 x4 y1 in let xy42 = mul64_wide_5 x4 y2 in let xy43 = mul64_wide_5 x4 y3 in let xy44 = mul64_wide_5 x4 y4 in let z0 = xy00 in // < pow2 112 let z1 = add2 xy01 xy10 in // < pow2 113 let z2 = add3 xy02 xy11 xy20 in // < pow2 114 let z3 = add4 xy03 xy12 xy21 xy30 in // < pow2 115 let z4 = add5 xy04 xy13 xy22 xy31 xy40 in // < pow2 116 let z5 = add4 xy14 xy23 xy32 xy41 in let z6 = add3 xy24 xy33 xy42 in let z7 = add2 xy34 xy43 in let z8 = xy44 in //(z0, z1, z2, z3, z4, z5, z6, z7, z8) assert_norm (pow2 112 < pow2 117); assert_norm (pow2 112 <= pow2 116); let (c0, t0) = carry56_wide z0 in let (c1, t1) = carry56_wide (add_inner_carry z1 c0) in let (c2, t2) = carry56_wide (add_inner_carry z2 c1) in let (c3, t3) = carry56_wide (add_inner_carry z3 c2) in let (c4, t4) = carry56_wide (add_inner_carry z4 c3) in let (c5, t5) = carry56_wide (add_inner_carry z5 c4) in let (c6, t6) = carry56_wide (add_inner_carry z6 c5) in let (c7, t7) = carry56_wide (add_inner_carry z7 c6) in let (c8, t8) = carry56_wide (add_inner_carry z8 c7) in let t9 = to_u64 c8 in let lemma_t9_fits () : Lemma (v t9 < pow2 56) = // This proof was built from the bottom. We have as a constraint that v c8 has to be < pow2 112 to satisfy the postcondition. // We compute each time the maximal value such that this postcondition is satisfied calc (<) { v c0; (<) { Math.Lemmas.lemma_div_lt_nat (v z0) 112 56 } pow2 56; }; calc (<) { v c1; (<) { assert_norm (2*(pow2 112 - pow2 57 + 1) + pow2 56 <= pow2 113); Math.Lemmas.lemma_div_lt_nat (v z1 + v c0) 113 56 } pow2 57; }; calc (<) { v c2; (<) { assert_norm (3*(pow2 112 - pow2 57 + 1) + pow2 57 <= pow2 114); Math.Lemmas.lemma_div_lt_nat (v z2 + v c1) 114 56 } pow2 58; }; calc (<=) { v c3; (<=) { assert_norm (4*(pow2 112 - pow2 57 + 1) + pow2 58 <= 31153781151208965410895007785680895); assert_norm (31153781151208965410895007785680895 / pow56 == 432345564227567610); Math.Lemmas.lemma_div_le (v z3 + v c2) 31153781151208965410895007785680895 (pow2 56) } 432345564227567610; }; calc (<=) { v c4; (<=) { assert_norm (5*(pow2 112 - pow2 57 + 1) + 432345564227567610 <= 25961484292674137854422105494388735); // (pow2 59 - 2) * pow56 assert_norm (25961484292674137854422105494388735 / pow56 == 360287970189639675); Math.Lemmas.lemma_div_le (v z4 + v c3) 25961484292674137854422105494388735 (pow2 56) } 360287970189639675; }; calc (<=) { v c5; (<=) { assert_norm (4*(pow2 112 - pow2 57 + 1) + 360287970189639675 <= 20769187434139310297949203203096575); Math.Lemmas.lemma_div_le (v z5 + v c4) 20769187434139310297949203203096575 (pow2 56); assert_norm (20769187434139310297949203203096575 / pow2 56 == pow2 58 - 4) } pow2 58 - 4; }; calc (<=) { v c6; (<=) { assert_norm (3*(pow2 112 - pow2 57 + 1) + pow2 58 - 4 <= 15576890575604482741476300911804415); Math.Lemmas.lemma_div_le (v z6 + v c5) 15576890575604482741476300911804415 (pow2 56); assert_norm (15576890575604482741476300911804415 / pow2 56 == 216172782113783805) } 216172782113783805; }; calc (<=) { v c7; (<=) { assert_norm (2*(pow2 112 - pow2 57 + 1) + 216172782113783805 <= 10384593717069655185003398620512255); // (pow2 57 - 1) * pow2 56 - 1 Math.Lemmas.lemma_div_le (v z7 + v c6) 10384593717069655185003398620512255 (pow2 56); assert_norm (10384593717069655185003398620512255 / pow2 56 == pow2 57 - 2) } pow2 57 - 2; }; calc (<) { v c8; (<) { Math.Lemmas.lemma_div_lt_nat (v z8 + v c7) 112 56 } pow2 56; }; assert_norm (pow2 56 < pow2 64); Math.Lemmas.small_mod (v c8) (pow2 64) in lemma_t9_fits(); calc (==) { wide_as_nat5 (t0, t1, t2, t3, t4, t5, t6, t7, t8, t9) <: int; (==) { } v t0 + v t1 * pow56 + v t2 * pow112 + v t3 * pow168 + v t4 * pow224 + v t5 * pow280 + v t6 * pow336 + v t7 * pow392 + v t8 * pow448 + v t9 * pow504; (==) { assert_norm (pow2 61 < pow2 64); Math.Lemmas.small_mod (v c8) (pow2 64) } v z0 - v c0 * pow2 56 + (v z1 + v c0 - v c1 * pow2 56) * pow56 + (v z2 + v c1 - v c2 * pow2 56) * pow112 + (v z3 + v c2 - v c3 * pow2 56) * pow168 + (v z4 + v c3 - v c4 * pow2 56) * pow224 + (v z5 + v c4 - v c5 * pow2 56) * pow280 + (v z6 + v c5 - v c6 * pow2 56) * pow336 + (v z7 + v c6 - v c7 * pow2 56) * pow392 + (v z8 + v c7 - v c8 * pow2 56) * pow448 + v c8 * pow504; (==) { lemma_mult_distr_3 (v z1) (v c0) (v c1) 56; lemma_mult_distr_3 (v z2) (v c1) (v c2) 112; lemma_mult_distr_3 (v z3) (v c2) (v c3) 168; lemma_mult_distr_3 (v z4) (v c3) (v c4) 224; lemma_mult_distr_3 (v z5) (v c4) (v c5) 280; lemma_mult_distr_3 (v z6) (v c5) (v c6) 336; lemma_mult_distr_3 (v z7) (v c6) (v c7) 392; lemma_mult_distr_3 (v z8) (v c7) (v c8) 448 } v z0 + v z1 * pow56 + v z2 * pow112 + v z3 * pow168 + v z4 * pow224 + v z5 * pow280 + v z6 * pow336 + v z7 * pow392 + v z8 * pow448; (==) { calc (==) { v z1; (==) { } v x0 * v y1 + v x1 * v y0; }; calc (==) { v z2; (==) { } v x0 * v y2 + v x1 * v y1 + v x2 * v y0; }; calc (==) { v z3; (==) { } v x0 * v y3 + v x1 * v y2 + v x2 * v y1 + v x3 * v y0; }; calc (==) { v z4; (==) { } v x0 * v y4 + v x1 * v y3 + v x2 * v y2 + v x3 * v y1 + v x4 * v y0; }; calc (==) { v z5; (==) { } v x1 * v y4 + v x2 * v y3 + v x3 * v y2 + v x4 * v y1; }; calc (==) { v z6; (==) { } v x2 * v y4 + v x3 * v y3 + v x4 * v y2; }; calc (==) { v z7; (==) { } v x3 * v y4 + v x4 * v y3; }; calc (==) { v z8; (==) { } v x4 * v y4; } } v x0 * v y0 + (v x0 * v y1 + v x1 * v y0) * pow56 + (v x0 * v y2 + v x1 * v y1 + v x2 * v y0) * pow112 + (v x0 * v y3 + v x1 * v y2 + v x2 * v y1 + v x3 * v y0) * pow168 + (v x0 * v y4 + v x1 * v y3 + v x2 * v y2 + v x3 * v y1 + v x4 * v y0) * pow224 + (v x1 * v y4 + v x2 * v y3 + v x3 * v y2 + v x4 * v y1) * pow280 + (v x2 * v y4 + v x3 * v y3 + v x4 * v y2) * pow336 + (v x3 * v y4 + v x4 * v y3) * pow392 + (v x4 * v y4) * pow448; (==) { Lemmas.lemma_mul_qelem5 (v x0) (v x1) (v x2) (v x3) (v x4) (v y0) (v y1) (v y2) (v y3) (v y4) } (v x0 + v x1 * pow2 56 + v x2 * pow2 112 + v x3 * pow2 168 + v x4 * pow2 224) * (v y0 + v y1 * pow2 56 + v y2 * pow2 112 + v y3 * pow2 168 + v y4 * pow2 224); }; (t0, t1, t2, t3, t4, t5, t6, t7, t8, t9) inline_for_extraction noextract val low_mul_5: x:qelem5 -> y:qelem5 -> Pure qelem5 (requires qelem_fits5 x (1, 1, 1, 1, 1) /\ qelem_fits5 y (1, 1, 1, 1, 1)) (ensures fun r -> qelem_fits5 r (1, 1, 1, 1, 1) /\ as_nat5 r == (as_nat5 x * as_nat5 y) % pow2 264) let low_mul_5 (x0, x1, x2, x3, x4) (y0, y1, y2, y3, y4) = let xy00 = mul64_wide_5 x0 y0 in let xy01 = mul64_wide_5 x0 y1 in let xy02 = mul64_wide_5 x0 y2 in let xy03 = mul64_wide_5 x0 y3 in let xy04 = mul64_wide_5 x0 y4 in let xy10 = mul64_wide_5 x1 y0 in let xy11 = mul64_wide_5 x1 y1 in let xy12 = mul64_wide_5 x1 y2 in let xy13 = mul64_wide_5 x1 y3 in let xy20 = mul64_wide_5 x2 y0 in let xy21 = mul64_wide_5 x2 y1 in let xy22 = mul64_wide_5 x2 y2 in let xy30 = mul64_wide_5 x3 y0 in let xy31 = mul64_wide_5 x3 y1 in let xy40 = mul64_wide_5 x4 y0 in assert_norm (pow2 112 < pow2 117); let (c0, t0) = carry56_wide xy00 in let (c1, t1) = carry56_wide (add_inner_carry (add2 xy01 xy10) c0) in let (c2, t2) = carry56_wide (add_inner_carry (add3 xy02 xy11 xy20) c1) in let (c3, t3) = carry56_wide (add_inner_carry (add4 xy03 xy12 xy21 xy30) c2) in let t4 = to_u64 (add_inner_carry (add5 xy04 xy13 xy22 xy31 xy40) c3) &. mask40 in calc (==) { as_nat5 (t0, t1, t2, t3, t4) <: int; (==) { } v t0 + v t1 * pow56 + v t2 * pow112 + v t3 * pow168 + v t4 * pow224; (==) { } v xy00 - v c0 * pow2 56 + (v xy01 + v xy10 + v c0 - v c1 * pow2 56) * pow56 + (v xy02 + v xy11 + v xy20 + v c1 - v c2 * pow56) * pow112 + (v xy03 + v xy12 + v xy21 + v xy30 + v c2 - v c3 * pow56) * pow168 + v t4 * pow224; (==) { logand_mask (to_u64 (add_inner_carry (add5 xy04 xy13 xy22 xy31 xy40) c3)) mask40 40; Math.Lemmas.pow2_modulo_modulo_lemma_1 (v (add_inner_carry (add5 xy04 xy13 xy22 xy31 xy40) c3)) 40 64 } v x0 * v y0 + (v x0 * v y1 + v x1 * v y0) * pow56 + (v x0 * v y2 + v x1 * v y1 + v x2 * v y0) * pow112 + (v x0 * v y3 + v x1 * v y2 + v x2 * v y1 + v x3 * v y0 - v c3 * pow56) * pow168 + ((v x0 * v y4 + v x1 * v y3 + v x2 * v y2 + v x3 * v y1 + v x4 * v y0 + v c3) % pow2 40) * pow224; }; Lemmas.lemma_mul_5_low_264 (v x0) (v x1) (v x2) (v x3) (v x4) (v y0) (v y1) (v y2) (v y3) (v y4); (t0, t1, t2, t3, t4) inline_for_extraction noextract val div_2_24_step: x:uint64 -> y:uint64 -> Pure uint64 (requires v x < pow56 /\ v y < pow56) (ensures fun r -> v r < pow56 /\ v r == v x / pow2 24 + pow2 32 * (v y % pow2 24)) let div_2_24_step x y = let y' = (y &. u64 0xffffff) <<. 32ul in assert_norm (pow2 24 - 1 = 0xffffff); assert_norm (pow2 24 < pow2 64); mod_mask_lemma y 24ul; assert (v (mod_mask #U64 #SEC 24ul) == 0xffffff); assert (v (y &. u64 0xffffff) == v y % pow2 24); assert (v y' == (v y % pow2 24) * pow2 32); let x' = x >>. 24ul in FStar.Math.Lemmas.pow2_minus 56 24; assert (v x' < pow2 32); let z = x' |. y' in logor_disjoint x' y' 32; assert (v z == v x / pow2 24 + pow2 32 * (v y % pow2 24)); z inline_for_extraction noextract val div_248: x:qelem_wide5 -> Pure qelem5 (requires qelem_wide_fits5 x (1, 1, 1, 1, 1, 1, 1, 1, 1, 1) /\ wide_as_nat5 x < pow2 512) (ensures fun r -> qelem_fits5 r (1, 1, 1, 1, 1) /\ as_nat5 r == (wide_as_nat5 x) / pow2 248) let div_248 (x0, x1, x2, x3, x4, x5, x6, x7, x8, x9) = // x / pow2 248 == (x / pow2 224) / pow2 24 let z0 = div_2_24_step x4 x5 in let z1 = div_2_24_step x5 x6 in let z2 = div_2_24_step x6 x7 in let z3 = div_2_24_step x7 x8 in let z4 = div_2_24_step x8 x9 in assert (qelem_fits5 (z0, z1, z2, z3, z4) (1, 1, 1, 1, 1)); Lemmas.lemma_div248 (x0, x1, x2, x3, x4, x5, x6, x7, x8, x9); (z0, z1, z2, z3, z4) inline_for_extraction noextract val div_2_40_step: x:uint64 -> y:uint64 -> Pure uint64 (requires v x < pow56) (ensures fun z -> v z < pow56 /\ v z == v x / pow2 40 + pow2 16 * (v y % pow2 40)) let div_2_40_step x y = let y' = (y &. mask40) <<. 16ul in assert_norm (pow2 40 < pow2 64); mod_mask_lemma y 40ul; assert (v (mod_mask #U64 #SEC 40ul) == v mask40); assert (v y' == (v y % pow2 40) * pow2 16); let x' = x >>. 40ul in FStar.Math.Lemmas.pow2_minus 56 40; assert (v x' == v x / pow2 40); assert (v x' < pow2 16); let z = x' |. y' in logor_disjoint x' y' 16; z inline_for_extraction noextract val div_264: x:qelem_wide5 -> Pure qelem5 (requires qelem_wide_fits5 x (1, 1, 1, 1, 1, 1, 1, 1, 1, 1) /\ wide_as_nat5 x < pow2 528) (ensures fun z -> qelem_fits5 z (1, 1, 1, 1, 1) /\ as_nat5 z == (wide_as_nat5 x) / pow2 264) let div_264 (x0, x1, x2, x3, x4, x5, x6, x7, x8, x9) = // x / pow2 264 == (x / pow2 224) / pow2 40 let z0 = div_2_40_step x4 x5 in let z1 = div_2_40_step x5 x6 in let z2 = div_2_40_step x6 x7 in let z3 = div_2_40_step x7 x8 in let z4 = div_2_40_step x8 x9 in assert (qelem_fits5 (z0, z1, z2, z3, z4) (1, 1, 1, 1, 1)); Lemmas.lemma_div264 (x0, x1, x2, x3, x4, x5, x6, x7, x8, x9); (z0, z1, z2, z3, z4) inline_for_extraction noextract val mod_264: t:qelem_wide5 -> Pure qelem5 (requires qelem_wide_fits5 t (1, 1, 1, 1, 1, 1, 1, 1, 1, 1)) (ensures fun r -> qelem_fits5 r (1, 1, 1, 1, 1) /\ as_nat5 r == (wide_as_nat5 t) % pow2 264) let mod_264 (t0, t1, t2, t3, t4, t5, t6, t7, t8, t9) = Lemmas.lemma_mod_264 (t0, t1, t2, t3, t4, t5, t6, t7, t8, t9); (t0, t1, t2, t3, t4 &. mask40) inline_for_extraction noextract val subm_last_step: x:uint64 -> y:uint64 -> Pure (uint64 & uint64) (requires v x < pow2 40 /\ v y <= pow2 40) (ensures fun (b, t) -> v b <= 1 /\ v t < pow2 40 /\ v x - v y == v t - pow2 40 * v b) let subm_last_step x y = assert_norm (pow2 40 < pow2 63); let b = (x -. y) >>. 63ul in assert (if v x >= v y then v b == 0 else v b == 1); let t = ((b <<. 40ul) +! x) -! y in b, t #push-options "--z3rlimit 400 --max_fuel 0 --max_ifuel 0" inline_for_extraction noextract val sub_mod_264: x:qelem5 -> y:qelem5 -> Pure qelem5 (requires qelem_fits5 x (1, 1, 1, 1, 1) /\ qelem_fits5 y (1, 1, 1, 1, 1) /\ as_nat5 x < pow2 264 /\ as_nat5 y < pow2 264) (ensures fun z -> qelem_fits5 z (1, 1, 1, 1, 1) /\ (if as_nat5 x >= as_nat5 y then as_nat5 z == as_nat5 x - as_nat5 y else as_nat5 z == as_nat5 x - as_nat5 y + pow2 264)) let sub_mod_264 (x0, x1, x2, x3, x4) (y0, y1, y2, y3, y4) = let (c1, t0) = subm_step x0 y0 in assert (v x0 - v y0 == v t0 - v c1 * pow56); let (c2, t1) = subm_step x1 (y1 +! c1) in assert (v x1 - v y1 - v c1 == v t1 - v c2 * pow56); let (c3, t2) = subm_step x2 (y2 +! c2) in assert (v x2 - v y2 - v c2 == v t2 - v c3 * pow56); let (c4, t3) = subm_step x3 (y3 +! c3) in assert (v x3 - v y3 - v c3 == v t3 - v c4 * pow56); Lemmas.lemma_as_nat_pow264_x4 (x0, x1, x2, x3, x4); Lemmas.lemma_as_nat_pow264_x4 (y0, y1, y2, y3, y4); let (c5, t4) = subm_last_step x4 (y4 +! c4) in assert (v x4 - v y4 - v c4 == v t4 - pow2 40 * v c5); assert ( if v c5 = 0 then as_nat5 (x0, x1, x2, x3, x4) >= as_nat5 (y0, y1, y2, y3, y4) else as_nat5 (x0, x1, x2, x3, x4) < as_nat5 (y0, y1, y2, y3, y4)); assert_norm (pow2 40 < pow2 56); assert (qelem_fits5 (t0, t1, t2, t3, t4) (1, 1, 1, 1, 1)); assert (as_nat5 (t0, t1, t2, t3, t4) == v x0 - v y0 + v c1 * pow56 + (v x1 - v y1 - v c1 + v c2 * pow56) * pow56 + (v x2 - v y2 - v c2 + v c3 * pow56) * pow112 + (v x3 - v y3 - v c3 + v c4 * pow56) * pow168 + (v x4 - v y4 - v c4 + pow2 40 * v c5) * pow224); Lemmas.lemma_sub_mod_264_aux (v x0) (v x1) (v x2) (v x3) (v x4) (v y0) (v y1) (v y2) (v y3) (v y4) (v c1) (v c2) (v c3) (v c4) (v c5); assert (as_nat5 (t0, t1, t2, t3, t4) == as_nat5 (x0, x1, x2, x3, x4) - as_nat5 (y0, y1, y2, y3, y4) + v c5 * pow2 264); Lemmas.lemma_sub_mod_264 (x0, x1, x2, x3, x4) (y0, y1, y2, y3, y4) (t0, t1, t2, t3, t4) c5; (t0, t1, t2, t3, t4) #pop-options // A = t, L = make_m() // b = 2^8, k = 32, mu = b^{2*k} / L = make_mu() inline_for_extraction noextract val barrett_reduction5: t:qelem_wide5 -> Pure qelem5 (requires qelem_wide_fits5 t (1, 1, 1, 1, 1, 1, 1, 1, 1, 1) /\ wide_as_nat5 t < pow2 512) (ensures fun z -> qelem_fits5 z (1, 1, 1, 1, 1) /\ as_nat5 z == (wide_as_nat5 t) % S.q) let barrett_reduction5 (t0, t1, t2, t3, t4, t5, t6, t7, t8, t9) = let (m0, m1, m2, m3, m4) = make_m () in let (mu0, mu1, mu2, mu3, mu4) = make_mu () in let (q0, q1, q2, q3, q4) = div_248 (t0, t1, t2, t3, t4, t5, t6, t7, t8, t9) in assert (as_nat5 (q0, q1, q2, q3, q4) == wide_as_nat5 (t0, t1, t2, t3, t4, t5, t6, t7, t8, t9) / pow2 248); FStar.Math.Lemmas.lemma_div_lt_nat (wide_as_nat5 (t0, t1, t2, t3, t4, t5, t6, t7, t8, t9)) 512 248; assert (as_nat5 (q0, q1, q2, q3, q4) < pow2 264); let (qmu0', qmu1', qmu2', qmu3', qmu4', qmu5', qmu6', qmu7', qmu8', qmu9') = mul_5 (q0, q1, q2, q3, q4) (mu0, mu1, mu2, mu3, mu4) in FStar.Math.Lemmas.lemma_mult_le_right (pow2 512 / S.q) (as_nat5 (q0, q1, q2, q3, q4)) (pow2 264); assert (wide_as_nat5 (qmu0', qmu1', qmu2', qmu3', qmu4', qmu5', qmu6', qmu7', qmu8', qmu9') <= pow2 512 / S.q * pow2 264); assert_norm (pow2 512 / S.q * pow2 264 < pow2 528); let (qdiv0, qdiv1, qdiv2, qdiv3, qdiv4) = div_264 (qmu0', qmu1', qmu2', qmu3', qmu4', qmu5', qmu6', qmu7', qmu8', qmu9') in //u = qdiv == (A / b^{k-1}) * mu / b^{k+1} == ((A / 2^248) * mu) / 2^264 let (r0, r1, r2, r3, r4) = mod_264 (t0, t1, t2, t3, t4, t5, t6, t7, t8, t9) in //r == A mod b^{k+1} == A mod 2^264 let (qmul0, qmul1, qmul2, qmul3, qmul4) = low_mul_5 (qdiv0, qdiv1, qdiv2, qdiv3, qdiv4) (m0, m1, m2, m3, m4) in //v == qmul == u * L mod b^{k+1} == u * L mod 2^264 let (s0, s1, s2, s3, s4) = sub_mod_264 (r0, r1, r2, r3, r4) (qmul0, qmul1, qmul2, qmul3, qmul4) in //u == s == (r - v) mod b^{k+1} == (r - v) mod 2^264 let (o0, o1, o2, o3, o4) = subm_conditional (s0, s1, s2, s3, s4) in Lemmas.lemma_barrett_reduce' (wide_as_nat5 (t0, t1, t2, t3, t4, t5, t6, t7, t8, t9)); (o0, o1, o2, o3, o4) inline_for_extraction noextract val mul_modq5: x:qelem5 -> y:qelem5 -> Pure qelem5 (requires qelem_fits5 x (1, 1, 1, 1, 1) /\ qelem_fits5 y (1, 1, 1, 1, 1) /\ as_nat5 x < pow2 256 /\ as_nat5 y < pow2 256) (ensures fun r -> qelem_fits5 r (1, 1, 1, 1, 1) /\ as_nat5 r == (as_nat5 x * as_nat5 y) % S.q) let mul_modq5 (x0, x1, x2, x3, x4) (y0, y1, y2, y3, y4) = let (r0, r1, r2, r3, r4, r5, r6, r7, r8, r9) = mul_5 (x0, x1, x2, x3, x4) (y0, y1, y2, y3, y4) in Lemmas.lemma_mul_lt (as_nat5 (x0, x1, x2, x3, x4)) (pow2 256) (as_nat5 (y0, y1, y2, y3, y4)) (pow2 256); assert_norm (pow2 256 * pow2 256 = pow2 512); let (o0, o1, o2, o3, o4) = barrett_reduction5 (r0, r1, r2, r3, r4, r5, r6, r7, r8, r9) in (o0, o1, o2, o3, o4)