diff --git a/CompPoly.lean b/CompPoly.lean index 4c5463fe..ac30b812 100644 --- a/CompPoly.lean +++ b/CompPoly.lean @@ -99,6 +99,14 @@ import CompPoly.Fields.Binary.Tower.Support.LinearIndependentFin2 import CompPoly.Fields.Binary.Tower.Support.Preliminaries import CompPoly.Fields.Binary.Tower.TensorAlgebra import CompPoly.Fields.Goldilocks +import CompPoly.Fields.Goldilocks.Basic +import CompPoly.Fields.Goldilocks.Fast +import CompPoly.Fields.Goldilocks.Fast.Arithmetic +import CompPoly.Fields.Goldilocks.Fast.Field +import CompPoly.Fields.Goldilocks.Fast.Internal +import CompPoly.Fields.Goldilocks.Fast.Reduction +import CompPoly.Fields.Goldilocks.Fast.Theorems +import CompPoly.Fields.Goldilocks.FastExt import CompPoly.Fields.KoalaBear import CompPoly.Fields.KoalaBear.Basic import CompPoly.Fields.KoalaBear.Fast diff --git a/CompPoly/Fields/Goldilocks.lean b/CompPoly/Fields/Goldilocks.lean index c4d4e55a..2c30a1f6 100644 --- a/CompPoly/Fields/Goldilocks.lean +++ b/CompPoly/Fields/Goldilocks.lean @@ -1,26 +1,16 @@ /- Copyright (c) 2024 ArkLib Contributors. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. -Authors: Quang Dao +Authors: Quang Dao, Varun Thakore -/ -import CompPoly.Fields.PrattCertificate +import CompPoly.Fields.Goldilocks.Basic +import CompPoly.Fields.Goldilocks.Fast /-! - # Goldilocks prime field `2^{64} - 2^{32} + 1` +# Goldilocks Field - This is the field used in Plonky2/3. +Facade module for the Goldilocks field. It re-exports the canonical `ZMod` model +from `CompPoly.Fields.Goldilocks.Basic` and the native-word implementation from +`CompPoly.Fields.Goldilocks.Fast`. -/ - -namespace Goldilocks - -@[reducible] -def fieldSize : Nat := 2 ^ 64 - 2 ^ 32 + 1 - -abbrev Field := ZMod fieldSize - -theorem is_prime : Nat.Prime fieldSize := by - unfold fieldSize - pratt - -end Goldilocks diff --git a/CompPoly/Fields/Goldilocks/Basic.lean b/CompPoly/Fields/Goldilocks/Basic.lean new file mode 100644 index 00000000..0228e5f1 --- /dev/null +++ b/CompPoly/Fields/Goldilocks/Basic.lean @@ -0,0 +1,45 @@ +/- +Copyright (c) 2024 ArkLib Contributors. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Quang Dao, Varun Thakore +-/ + +import CompPoly.Fields.Basic +import CompPoly.Fields.PrattCertificate + +/-! +# Goldilocks Prime Field `2^{64} - 2^{32} + 1` + +This module defines the canonical `ZMod` model of the Goldilocks prime field. +-/ + +namespace Goldilocks +namespace Basic + +/-- The Goldilocks prime modulus, `2^64 - 2^32 + 1`. -/ +@[reducible] +def fieldSize : Nat := 2 ^ 64 - 2 ^ 32 + 1 + +/-- The canonical mathematical Goldilocks field, implemented as integers modulo +`fieldSize`. -/ +abbrev Field := ZMod fieldSize + +/-- The Goldilocks modulus is prime, verified by a Pratt certificate. -/ +theorem is_prime : Nat.Prime fieldSize := by + unfold fieldSize + pratt + +/-- Register primality of `fieldSize` for Mathlib instances such as `ZMod.instField`. -/ +instance : Fact (Nat.Prime fieldSize) := ⟨is_prime⟩ + +/-- The canonical Goldilocks carrier is a field because its modulus is prime. -/ +instance : _root_.Field Field := ZMod.instField fieldSize + +/-- Goldilocks has characteristic different from two. -/ +instance : NonBinaryField Field where + char_neq_2 := by + simpa [Field, fieldSize] using + (by decide : (2 : ZMod (2 ^ 64 - 2 ^ 32 + 1)) ≠ 0) + +end Basic +end Goldilocks diff --git a/CompPoly/Fields/Goldilocks/Fast.lean b/CompPoly/Fields/Goldilocks/Fast.lean new file mode 100644 index 00000000..f5588ee9 --- /dev/null +++ b/CompPoly/Fields/Goldilocks/Fast.lean @@ -0,0 +1,17 @@ +/- +Copyright (c) 2026 CompPoly Contributors. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Varun Thakore +-/ + +import CompPoly.Fields.Goldilocks.Fast.Field + +/-! +# Fast Goldilocks Field + +Public entry point for the native-word Goldilocks implementation. + +Importing this module provides the fast `UInt64`-backed `Goldilocks.Fast.Field`, +its arithmetic operations, correctness theorems relating it to +`Goldilocks.Basic.Field` and the transferred field instances. +-/ diff --git a/CompPoly/Fields/Goldilocks/Fast/Arithmetic.lean b/CompPoly/Fields/Goldilocks/Fast/Arithmetic.lean new file mode 100644 index 00000000..60c37ffc --- /dev/null +++ b/CompPoly/Fields/Goldilocks/Fast/Arithmetic.lean @@ -0,0 +1,243 @@ +/- +Copyright (c) 2026 CompPoly Contributors. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Varun Thakore +-/ + +import CompPoly.Fields.Goldilocks.Fast.Reduction + +/-! +# Fast Goldilocks Arithmetic + +This module defines the fast native-word Goldilocks carrier, conversions, +arithmetic operations, and notation instances. + +Fast field values are stored as canonical `UInt64` representatives below the +Goldilocks prime `p = 2^64 - 2^32 + 1`. Multiplication uses a 128-bit +intermediate represented as a pair of `UInt64` words `(lo, hi)` and reduces it +with the Goldilocks identity + +`2^64 ≡ 2^32 - 1 (mod p)`. +-/ + +namespace Goldilocks +namespace Fast + +/-- The fast native-word Goldilocks field carrier, stored as a canonical residue. -/ +abbrev Field : Type := { x : UInt64 // x.toNat < Goldilocks.Basic.fieldSize } + +/-- Fast representatives have decidable equality through their `UInt64` value. -/ +instance : DecidableEq Field := inferInstance + +/-- The raw canonical word backing a fast Goldilocks element. -/ +@[inline] +def raw (x : Field) : UInt64 := x.val + +/-- Reduce a native `UInt64` modulo Goldilocks. -/ +@[inline] +def reduceUInt64 (x : UInt64) : Field := + ⟨Reduction.reduceUInt64Raw x, Reduction.reduceUInt64Raw_lt x⟩ + +/-- One-word reduction preserves the represented canonical field element. -/ +@[simp] +theorem reduceUInt64_cast (x : UInt64) : + ((reduceUInt64 x).val.toNat : Goldilocks.Basic.Field) = + (x.toNat : Goldilocks.Basic.Field) := by + exact Reduction.reduceUInt64Raw_cast x + +/-- The zero fast Goldilocks element. -/ +@[inline] +def zero : Field := ⟨0, by decide⟩ + +/-- The one fast Goldilocks element. -/ +@[inline] +def one : Field := ⟨1, by decide⟩ + +/-- Build a fast element from a canonical natural representative. -/ +@[inline] +def ofCanonicalNat (n : Nat) (h : n < Goldilocks.Basic.fieldSize) : Field := + ⟨UInt64.ofNat n, by + have hn : n < UInt64.size := Nat.lt_trans h fieldSize_lt_uint64Size + rw [UInt64.toNat_ofNat'] + rw [Nat.mod_eq_of_lt] + · exact h + · simpa [UInt64.size] using hn⟩ + +/-- Convert a natural number into fast canonical representation. -/ +@[inline] +def ofNat (n : Nat) : Field := + ofCanonicalNat (n % Goldilocks.Basic.fieldSize) (Nat.mod_lt _ fieldSize_pos) + +/-- Convert a 64-bit word into fast canonical representation. -/ +@[inline] +def ofUInt64 (x : UInt64) : Field := + reduceUInt64 x + +/-- Convert from the canonical `ZMod` Goldilocks field into fast canonical form. -/ +@[inline] +def ofField (x : Goldilocks.Basic.Field) : Field := + ofCanonicalNat x.val (ZMod.val_lt x) + +/-- Convert an integer into fast canonical representation. -/ +@[inline] +def ofInt (z : Int) : Field := + ofField (z : Goldilocks.Basic.Field) + +/-- Convert a fast Goldilocks element to its canonical natural representative. -/ +@[inline] +def toNat (x : Field) : Nat := + x.val.toNat + +/-- Convert a fast Goldilocks element to the canonical `ZMod` Goldilocks field. -/ +@[inline] +def toField (x : Field) : Goldilocks.Basic.Field := + (toNat x : Goldilocks.Basic.Field) + +/-- Fast modular addition in canonical form. -/ +@[inline] +def add (x y : Field) : Field := + let lo := x.val + y.val + let carry := decide (lo < x.val) + ⟨Reduction.reduceAddWithCarryRaw lo carry, + Reduction.reduceAddWithCarryRaw_lt lo carry + (Reduction.addWithCarry_bound x.val y.val x.property y.property)⟩ + +/-- Fast modular negation in canonical form. -/ +@[inline] +def neg (x : Field) : Field := + ⟨Reduction.negRaw x.val, Reduction.negRaw_lt x.val x.property⟩ + +/-- Fast modular subtraction in canonical form. -/ +@[inline] +def sub (x y : Field) : Field := + ⟨Reduction.subRaw x.val y.val, Reduction.subRaw_lt x.val y.val x.property y.property⟩ + +/-- Fast modular multiplication in canonical form. -/ +@[inline] +def mul (x y : Field) : Field := + ⟨Reduction.reduceMulRaw x.val y.val, Reduction.reduceMulRaw_lt x.val y.val⟩ + +/-- Fast squaring. -/ +@[inline] +def square (x : Field) : Field := + mul x x + +/-- Repeated squaring: `squareN x n` computes `x^(2^n)`. -/ +@[inline] +def squareN (x : Field) : Nat → Field + | 0 => x + | n + 1 => square (squareN x n) + +/-- Exponentiation over the fast representation using binary exponentiation. -/ +@[inline] +def pow (x : Field) (n : Nat) : Field := + @npowBinRec Field ⟨one⟩ ⟨mul⟩ n x + +/-- Fermat exponent used for inversion in the Goldilocks prime field. -/ +@[inline] +def invExponent : Nat := Goldilocks.Basic.fieldSize - 2 + +/-- Fast modular inversion using an addition chain for `p - 2`. + +For Goldilocks, `p - 2 = 0xFFFFFFFEFFFFFFFF`. The chain builds +`x^(2^31 - 1)`, derives `x^(2^32 - 2)` and `x^(2^32 - 1)`, then combines them as + +`(2^32 - 2) * 2^32 + (2^32 - 1) = p - 2`. +-/ +@[noinline] +def inv (x : Field) : Field := + let t2 := mul (square x) x + let t4 := mul (squareN t2 2) t2 + let t8 := mul (squareN t4 4) t4 + let t16 := mul (squareN t8 8) t8 + let t31 := + mul (squareN t16 15) + (mul (squareN t8 7) + (mul (squareN t4 3) + (mul (square t2) x))) + let t32m2 := square t31 + let t32m1 := mul t32m2 x + mul (squareN t32m2 32) t32m1 + +/-- Division through inversion and fast multiplication. -/ +@[inline] +def div (x y : Field) : Field := + mul x (inv y) + +/-- Use fast zero for standard `0` notation. -/ +instance instZeroField : Zero Field where + zero := zero + +/-- Use fast one for standard `1` notation. -/ +instance instOneField : One Field where + one := one + +/-- Use fast addition for standard `+` notation. -/ +instance instAddField : Add Field where + add := add + +/-- Use fast negation for standard unary `-` notation. -/ +instance instNegField : Neg Field where + neg := neg + +/-- Use fast subtraction for standard `-` notation. -/ +instance instSubField : Sub Field where + sub := sub + +/-- Use fast multiplication for standard `*` notation. -/ +instance instMulField : Mul Field where + mul := mul + +/-- Use fast inversion for standard inverse notation. -/ +instance instInvField : Inv Field where + inv := inv + +/-- Use fast division for standard `/` notation. -/ +instance instDivField : Div Field where + div := div + +/-- Use `ofNat` for natural-number casts into fast Goldilocks. -/ +instance instNatCastField : NatCast Field where + natCast := ofNat + +/-- Interpret integer casts through the canonical Goldilocks field. -/ +instance instIntCastField : IntCast Field where + intCast := ofInt + +/-- Natural scalar multiplication is multiplication by the corresponding fast natural cast. -/ +instance instNatSMulField : SMul Nat Field where + smul n x := (n : Field) * x + +/-- Integer scalar multiplication is multiplication by the corresponding fast integer cast. -/ +instance instIntSMulField : SMul Int Field where + smul n x := (n : Field) * x + +/-- Use fast binary exponentiation for natural powers. -/ +instance instPowFieldNat : Pow Field Nat where + pow := pow + +/-- Use fast natural powers and inversion for integer powers. -/ +instance instPowFieldInt : Pow Field Int where + pow x n := + match n with + | Int.ofNat k => pow x k + | Int.negSucc k => pow (inv x) (k + 1) + +/-- Interpret nonnegative rational casts through the canonical Goldilocks field. -/ +instance instNNRatCastField : NNRatCast Field where + nnratCast q := ofField (q : Goldilocks.Basic.Field) + +/-- Interpret rational casts through the canonical Goldilocks field. -/ +instance instRatCastField : RatCast Field where + ratCast q := ofField (q : Goldilocks.Basic.Field) + +/-- Nonnegative rational scalar multiplication is transported through the canonical field. -/ +instance instNNRatSMulField : SMul ℚ≥0 Field where + smul q x := ofField (q • toField x) + +/-- Rational scalar multiplication is transported through the canonical field. -/ +instance instRatSMulField : SMul ℚ Field where + smul q x := ofField (q • toField x) + +end Fast +end Goldilocks diff --git a/CompPoly/Fields/Goldilocks/Fast/Field.lean b/CompPoly/Fields/Goldilocks/Fast/Field.lean new file mode 100644 index 00000000..9cf1b802 --- /dev/null +++ b/CompPoly/Fields/Goldilocks/Fast/Field.lean @@ -0,0 +1,71 @@ +/- +Copyright (c) 2026 CompPoly Contributors. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Varun Thakore +-/ + +import CompPoly.Fields.Goldilocks.Fast.Theorems +import Mathlib.Algebra.Field.TransferInstance + +/-! +# Field Structure for Fast Goldilocks Arithmetic + +This module transfers the canonical Goldilocks field structure to the fast +`UInt64` representation. +-/ + +namespace Goldilocks +namespace Fast + +/-- Ring equivalence between the fast representation and canonical Goldilocks. -/ +def ringEquiv : Field ≃+* Goldilocks.Basic.Field where + toFun := toField + invFun := ofField + left_inv := ofField_toField + right_inv := toField_ofField + map_add' := toField_add + map_mul' := toField_mul + +/-- Applying `ringEquiv` is the same as interpreting a fast value canonically. -/ +@[simp] +theorem ringEquiv_apply (x : Field) : ringEquiv x = toField x := rfl + +/-- Applying the inverse `ringEquiv` converts a canonical value into fast form. -/ +@[simp] +theorem ringEquiv_symm_apply (x : Goldilocks.Basic.Field) : ringEquiv.symm x = ofField x := rfl + +/-- Field instance transferred from canonical Goldilocks through `toField`. -/ +instance (priority := low) instField : _root_.Field Field := + toField_injective.field toField + toField_zero + toField_one + toField_add + toField_mul + toField_neg + toField_sub + toField_inv + toField_div + toField_nsmul + toField_zsmul + toField_nnqsmul + toField_qsmul + toField_npow + toField_zpow + toField_natCast + toField_intCast + toField_nnratCast + toField_ratCast + +/-- Commutative-ring instance inherited from the transferred field structure. -/ +instance (priority := low) instCommRing : CommRing Field := by + infer_instance + +/-- Fast Goldilocks is a non-binary field. -/ +instance (priority := low) instNonBinaryField : NonBinaryField Field where + char_neq_2 := by + intro h + have hv := congrArg Subtype.val h + exact (by decide : (2 : UInt64) ≠ 0) hv + +end Fast +end Goldilocks diff --git a/CompPoly/Fields/Goldilocks/Fast/Internal.lean b/CompPoly/Fields/Goldilocks/Fast/Internal.lean new file mode 100644 index 00000000..ca197fe8 --- /dev/null +++ b/CompPoly/Fields/Goldilocks/Fast/Internal.lean @@ -0,0 +1,488 @@ +/- +Copyright (c) 2026 CompPoly Contributors. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Varun Thakore +-/ + +import CompPoly.Fields.Goldilocks.Basic + +/-! +# Internal Lemmas for Fast Goldilocks Arithmetic + +This module contains low-level constants and `UInt64` facts used by the native-word +Goldilocks implementation. +-/ + +namespace Goldilocks +namespace Fast + +/-- Goldilocks modulus `2^64 - 2^32 + 1` as a native word. -/ +@[inline] +def modulus : UInt64 := 0xffffffff00000001 + +/-- Two's complement of the modulus: `2^64 - modulus = 2^32 - 1 = 0xFFFFFFFF`. -/ +@[inline] +def neg_modulus : UInt64 := 0xffffffff + +/-- The native `UInt64` modulus agrees with the mathematical Goldilocks modulus. -/ +@[simp] +theorem modulus_toNat : modulus.toNat = Goldilocks.Basic.fieldSize := by + decide + +/-- The native negated-modulus constant agrees with `2^32 - 1`. -/ +@[simp] +theorem neg_modulus_toNat : neg_modulus.toNat = 2 ^ 32 - 1 := by + decide + +/-- The Goldilocks modulus is positive. -/ +theorem fieldSize_pos : 0 < Goldilocks.Basic.fieldSize := by + decide + +/-- The Goldilocks modulus fits in a `UInt64`. -/ +theorem fieldSize_lt_uint64Size : Goldilocks.Basic.fieldSize < UInt64.size := by + decide + +/-- Every `UInt64` value is below twice the Goldilocks modulus. -/ +theorem uint64_toNat_lt_two_fieldSize (x : UInt64) : + x.toNat < 2 * Goldilocks.Basic.fieldSize := by + exact Nat.lt_trans (UInt64.toNat_lt_size x) (by decide) + +/-- The folding congruence used by the Goldilocks reducer. + +`2^64 ≡ 2^32 - 1 (mod p)`. +-/ +theorem uint64_cast_eq_neg_modulus : + (UInt64.size : Goldilocks.Basic.Field) = (neg_modulus.toNat : Goldilocks.Basic.Field) := by + decide + +/-- Multiplying by `2^32 - 1` after shifting by `2^32` is negation modulo Goldilocks. -/ +theorem pow32_mul_neg_modulus_cast : + ((2 ^ 32 : Nat) : Goldilocks.Basic.Field) * + (neg_modulus.toNat : Goldilocks.Basic.Field) = + -1 := by + decide + +/-- Right shifting a `UInt64` by 32 gives division by `2^32` on naturals. -/ +theorem shiftRight32_toNat (x : UInt64) : + (x >>> 32).toNat = x.toNat / 2 ^ 32 := by + rw [UInt64.toNat_shiftRight] + have h : (32 : UInt64).toNat % 64 = 32 := by + decide + rw [h, Nat.shiftRight_eq_div_pow] + +/-- Masking with `2^32 - 1` gives the low 32 bits on naturals. -/ +theorem and_neg_modulus_toNat (x : UInt64) : + (x &&& neg_modulus).toNat = x.toNat % 2 ^ 32 := by + rw [← UInt64.toNat_toBitVec (x &&& neg_modulus)] + rw [UInt64.toBitVec_and] + rw [BitVec.toNat_and] + rw [UInt64.toNat_toBitVec, UInt64.toNat_toBitVec] + rw [neg_modulus_toNat] + rw [Nat.and_two_pow_sub_one_eq_mod] + +/-- A `UInt64` subtraction with the Goldilocks borrow correction represents subtraction modulo `p`. + +The assumption says the subtrahend is a 32-bit limb, which is the case for +`hi >>> 32` in the 128-bit reducer. +-/ +theorem subBorrow_cast (a b : UInt64) (hb : b.toNat < 2 ^ 32) : + (((if a < b then a - b - neg_modulus else a - b).toNat) : Goldilocks.Basic.Field) = + (a.toNat : Goldilocks.Basic.Field) - (b.toNat : Goldilocks.Basic.Field) := by + by_cases h : a < b + · rw [if_pos h] + have hlt : a.toNat < b.toNat := by + simpa [UInt64.lt_iff_toNat_lt] using h + have hb_le_size : b.toNat ≤ UInt64.size := Nat.le_of_lt (UInt64.toNat_lt_size b) + have hsub_lt_size : UInt64.size - b.toNat + a.toNat < 2 ^ 64 := by + have hsize : UInt64.size = 2 ^ 64 := rfl + rw [hsize] at hb_le_size ⊢ + omega + have hsub_raw : (a - b).toNat = UInt64.size - b.toNat + a.toNat := by + rw [UInt64.toNat_sub] + exact Nat.mod_eq_of_lt hsub_lt_size + have hneg_le : neg_modulus ≤ a - b := by + rw [UInt64.le_iff_toNat_le] + rw [hsub_raw, neg_modulus_toNat] + have hsize : UInt64.size = 2 ^ 64 := rfl + rw [hsize] + omega + rw [UInt64.toNat_sub_of_le _ _ hneg_le] + rw [hsub_raw] + have hneg_le_nat : neg_modulus.toNat ≤ UInt64.size - b.toNat + a.toNat := by + rw [← hsub_raw] + rwa [UInt64.le_iff_toNat_le] at hneg_le + rw [Nat.cast_sub hneg_le_nat] + rw [Nat.cast_add] + rw [Nat.cast_sub hb_le_size] + rw [uint64_cast_eq_neg_modulus] + ring + · rw [if_neg h] + have hle : b ≤ a := by + rw [UInt64.le_iff_toNat_le] + rw [UInt64.lt_iff_toNat_lt] at h + exact Nat.le_of_not_gt h + have hle_nat : b.toNat ≤ a.toNat := by + rwa [UInt64.le_iff_toNat_le] at hle + rw [UInt64.toNat_sub_of_le _ _ hle] + rw [Nat.cast_sub hle_nat] + +/-- A bounded `UInt64` addition with the Goldilocks overflow correction represents +addition modulo `p`. -/ +theorem addOverflowBounded_cast (a b : UInt64) + (hbound : a.toNat + b.toNat < 2 * UInt64.size - neg_modulus.toNat) : + (((if a + b < a then a + b + neg_modulus else a + b).toNat) : + Goldilocks.Basic.Field) = + (a.toNat : Goldilocks.Basic.Field) + (b.toNat : Goldilocks.Basic.Field) := by + by_cases hsum : a.toNat + b.toNat < UInt64.size + · have hnot : ¬a + b < a := by + intro hlt + have hlt_nat : (a + b).toNat < a.toNat := by + simpa [UInt64.lt_iff_toNat_lt] using hlt + rw [UInt64.toNat_add, Nat.mod_eq_of_lt hsum] at hlt_nat + omega + rw [if_neg hnot] + rw [UInt64.toNat_add, Nat.mod_eq_of_lt hsum, Nat.cast_add] + · have hsize_le : UInt64.size ≤ a.toNat + b.toNat := Nat.le_of_not_gt hsum + have hlt : a + b < a := by + rw [UInt64.lt_iff_toNat_lt] + rw [UInt64.toNat_add] + rw [Nat.mod_eq_sub_mod hsize_le] + have hdiff_lt : a.toNat + b.toNat - UInt64.size < UInt64.size := by + have ha := UInt64.toNat_lt_size a + have hb := UInt64.toNat_lt_size b + omega + rw [Nat.mod_eq_of_lt hdiff_lt] + have hb := UInt64.toNat_lt_size b + omega + rw [if_pos hlt] + have hsum_mod : (a + b).toNat = a.toNat + b.toNat - UInt64.size := by + rw [UInt64.toNat_add] + rw [Nat.mod_eq_sub_mod hsize_le] + have hdiff_lt : a.toNat + b.toNat - UInt64.size < UInt64.size := by + have ha := UInt64.toNat_lt_size a + have hb := UInt64.toNat_lt_size b + omega + rw [Nat.mod_eq_of_lt hdiff_lt] + rw [UInt64.toNat_add] + rw [hsum_mod] + have hno_second : a.toNat + b.toNat - UInt64.size + neg_modulus.toNat < UInt64.size := by + omega + rw [Nat.mod_eq_of_lt hno_second] + rw [Nat.cast_add] + rw [Nat.cast_sub hsize_le] + rw [uint64_cast_eq_neg_modulus] + rw [Nat.cast_add] + ring + +/-- Multiplication by `2^32 - 1` does not overflow for a 32-bit limb. -/ +theorem mul_neg_modulus_toNat_of_lt (x : UInt64) (hx : x.toNat < 2 ^ 32) : + (x * neg_modulus).toNat = x.toNat * neg_modulus.toNat := by + rw [UInt64.toNat_mul] + rw [Nat.mod_eq_of_lt] + rw [neg_modulus_toNat] + omega + +/-- The product of a 32-bit limb by `2^32 - 1` leaves enough headroom for correction. -/ +theorem mul_neg_modulus_toNat_le (x : UInt64) (hx : x.toNat < 2 ^ 32) : + (x * neg_modulus).toNat ≤ UInt64.size - 2 * neg_modulus.toNat := by + rw [mul_neg_modulus_toNat_of_lt x hx] + rw [neg_modulus_toNat] + have hx_le : x.toNat ≤ 2 ^ 32 - 1 := by + omega + have hmul : x.toNat * (2 ^ 32 - 1) ≤ (2 ^ 32 - 1) * (2 ^ 32 - 1) := + Nat.mul_le_mul_right _ hx_le + have hconst : (2 ^ 32 - 1) * (2 ^ 32 - 1) ≤ UInt64.size - 2 * (2 ^ 32 - 1) := by + decide + exact Nat.le_trans hmul hconst + +/-- Splitting a high word into 32-bit limbs matches the Goldilocks folding congruence. -/ +theorem hi_split_cast (hi : UInt64) : + (hi.toNat : Goldilocks.Basic.Field) * (UInt64.size : Goldilocks.Basic.Field) = + ((hi &&& neg_modulus).toNat : Goldilocks.Basic.Field) * + (neg_modulus.toNat : Goldilocks.Basic.Field) - + ((hi >>> 32).toNat : Goldilocks.Basic.Field) := by + have hsplit_nat : hi.toNat = hi.toNat % 2 ^ 32 + 2 ^ 32 * (hi.toNat / 2 ^ 32) := by + rw [Nat.mod_add_div] + have hcast_split : + (hi.toNat : Goldilocks.Basic.Field) = + ((hi.toNat % 2 ^ 32 : Nat) : Goldilocks.Basic.Field) + + (((2 ^ 32 : Nat) : Goldilocks.Basic.Field) * + ((hi.toNat / 2 ^ 32 : Nat) : Goldilocks.Basic.Field)) := by + simpa [Nat.cast_add, Nat.cast_mul] using + congrArg (fun n : Nat => (n : Goldilocks.Basic.Field)) hsplit_nat + rw [hcast_split] + rw [and_neg_modulus_toNat, shiftRight32_toNat, uint64_cast_eq_neg_modulus] + rw [add_mul] + conv_lhs => + enter [2] + rw [mul_assoc] + rw [mul_comm ((hi.toNat / 2 ^ 32 : Nat) : Goldilocks.Basic.Field)] + rw [← mul_assoc] + rw [pow32_mul_neg_modulus_cast] + ring + +/-- A `UInt64` value decomposes into its low and high 32-bit limbs. -/ +theorem uint64_split32 (x : UInt64) : + x.toNat = (x &&& neg_modulus).toNat + 2 ^ 32 * (x >>> 32).toNat := by + rw [and_neg_modulus_toNat, shiftRight32_toNat] + rw [Nat.mod_add_div] + +/-- The low 32-bit limb of a `UInt64` is below `2^32`. -/ +theorem uint64_low32_lt (x : UInt64) : + (x &&& neg_modulus).toNat < 2 ^ 32 := by + rw [and_neg_modulus_toNat] + exact Nat.mod_lt _ (by decide) + +/-- The high 32-bit limb of a `UInt64` is below `2^32`. -/ +theorem uint64_high32_lt (x : UInt64) : + (x >>> 32).toNat < 2 ^ 32 := by + rw [shiftRight32_toNat] + have hx := UInt64.toNat_lt_size x + change x.toNat < 2 ^ 64 at hx + exact Nat.div_lt_of_lt_mul hx + +/-- Multiplying two 32-bit limbs does not overflow `UInt64`. -/ +theorem mul32_toNat (a b : UInt64) (ha : a.toNat < 2 ^ 32) (hb : b.toNat < 2 ^ 32) : + (a * b).toNat = a.toNat * b.toNat := by + rw [UInt64.toNat_mul] + rw [Nat.mod_eq_of_lt] + nlinarith + +/-- Algebraic decomposition of a product after splitting both factors into 32-bit limbs. -/ +theorem product_split32 (x y : UInt64) : + x.toNat * y.toNat = + (x &&& neg_modulus).toNat * (y &&& neg_modulus).toNat + + 2 ^ 32 * + ((x &&& neg_modulus).toNat * (y >>> 32).toNat + + (x >>> 32).toNat * (y &&& neg_modulus).toNat) + + 2 ^ 64 * ((x >>> 32).toNat * (y >>> 32).toNat) := by + rw [uint64_split32 x, uint64_split32 y] + ring_nf + +/-- Low word returned by a 64-by-64 product implementation. -/ +theorem wideMul_low_toNat (lo : UInt64) (x y : UInt64) (hlo : lo = x * y) : + lo.toNat = x.toNat * y.toNat % UInt64.size := by + rw [hlo, UInt64.toNat_mul] + +/-- Pure Nat carry formula for the high word of a 32-bit-limb 64-by-64 product. -/ +theorem wideMul_high_nat + (p00 p01 p10 p11 : Nat) + (_hp00 : p00 < 2 ^ 64) + (_hp01 : p01 < 2 ^ 64) + (_hp10 : p10 < 2 ^ 64) + (_hp11 : p11 < 2 ^ 64) : + let B := 2 ^ 32 + let carry := p00 / B + p01 % B + p10 % B + p11 + p01 / B + p10 / B + carry / B = + (p00 + B * (p01 + p10) + B ^ 2 * p11) / B ^ 2 := by + dsimp + let carry := p00 / 4294967296 + p01 % 4294967296 + p10 % 4294967296 + let q := p11 + p01 / 4294967296 + p10 / 4294967296 + carry / 4294967296 + have hN : + p00 + 4294967296 * (p01 + p10) + 18446744073709551616 * p11 = + p00 % 4294967296 + 4294967296 * (carry % 4294967296) + + 18446744073709551616 * q := by + have hp00d : p00 % 4294967296 + 4294967296 * (p00 / 4294967296) = p00 := + Nat.mod_add_div p00 4294967296 + have hp01d : p01 % 4294967296 + 4294967296 * (p01 / 4294967296) = p01 := + Nat.mod_add_div p01 4294967296 + have hp10d : p10 % 4294967296 + 4294967296 * (p10 / 4294967296) = p10 := + Nat.mod_add_div p10 4294967296 + have hcd : carry % 4294967296 + 4294967296 * (carry / 4294967296) = carry := + Nat.mod_add_div carry 4294967296 + subst q + subst carry + omega + rw [hN] + change q = + (p00 % 4294967296 + 4294967296 * (carry % 4294967296) + + 18446744073709551616 * q) / + 18446744073709551616 + rw [Nat.mul_comm 18446744073709551616 q] + rw [Nat.add_mul_div_right _ _ (show 0 < 18446744073709551616 by decide)] + rw [Nat.div_eq_of_lt] + · rw [Nat.zero_add] + · subst carry + have hmod0 : p00 % 4294967296 < 4294967296 := Nat.mod_lt _ (by decide) + have hmod1 : + (p00 / 4294967296 + p01 % 4294967296 + p10 % 4294967296) % + 4294967296 < + 4294967296 := Nat.mod_lt _ (by decide) + omega + +/-- High word returned by the 32-bit-limb `UInt64` multiplication algorithm. -/ +theorem wideMul_high_toNat + (x y hi : UInt64) + (hhi : + hi = + let xLo := x &&& neg_modulus + let xHi := x >>> 32 + let yLo := y &&& neg_modulus + let yHi := y >>> 32 + let p00 := xLo * yLo + let p01 := xLo * yHi + let p10 := xHi * yLo + let p11 := xHi * yHi + let carry := (p00 >>> 32) + (p01 &&& neg_modulus) + (p10 &&& neg_modulus) + p11 + (p01 >>> 32) + (p10 >>> 32) + (carry >>> 32)) : + hi.toNat = x.toNat * y.toNat / UInt64.size := by + let xLo := x &&& neg_modulus + let xHi := x >>> 32 + let yLo := y &&& neg_modulus + let yHi := y >>> 32 + let p00 := xLo * yLo + let p01 := xLo * yHi + let p10 := xHi * yLo + let p11 := xHi * yHi + let carry := (p00 >>> 32) + (p01 &&& neg_modulus) + (p10 &&& neg_modulus) + have hxLo_lt : xLo.toNat < 2 ^ 32 := by + subst xLo + exact uint64_low32_lt x + have hxHi_lt : xHi.toNat < 2 ^ 32 := by + subst xHi + exact uint64_high32_lt x + have hyLo_lt : yLo.toNat < 2 ^ 32 := by + subst yLo + exact uint64_low32_lt y + have hyHi_lt : yHi.toNat < 2 ^ 32 := by + subst yHi + exact uint64_high32_lt y + have hp00_nat : p00.toNat = xLo.toNat * yLo.toNat := by + subst p00 + exact mul32_toNat xLo yLo hxLo_lt hyLo_lt + have hp01_nat : p01.toNat = xLo.toNat * yHi.toNat := by + subst p01 + exact mul32_toNat xLo yHi hxLo_lt hyHi_lt + have hp10_nat : p10.toNat = xHi.toNat * yLo.toNat := by + subst p10 + exact mul32_toNat xHi yLo hxHi_lt hyLo_lt + have hp11_nat : p11.toNat = xHi.toNat * yHi.toNat := by + subst p11 + exact mul32_toNat xHi yHi hxHi_lt hyHi_lt + have hp00_lt : p00.toNat < 2 ^ 64 := by + rw [hp00_nat] + nlinarith [hxLo_lt, hyLo_lt] + have hp01_lt : p01.toNat < 2 ^ 64 := by + rw [hp01_nat] + nlinarith [hxLo_lt, hyHi_lt] + have hp10_lt : p10.toNat < 2 ^ 64 := by + rw [hp10_nat] + nlinarith [hxHi_lt, hyLo_lt] + have hp11_lt : p11.toNat < 2 ^ 64 := by + rw [hp11_nat] + nlinarith [hxHi_lt, hyHi_lt] + have hcarry_nat : + carry.toNat = p00.toNat / 2 ^ 32 + p01.toNat % 2 ^ 32 + p10.toNat % 2 ^ 32 := by + subst carry + rw [UInt64.toNat_add, UInt64.toNat_add] + rw [shiftRight32_toNat, and_neg_modulus_toNat, and_neg_modulus_toNat] + have hp00_hi_lt : p00.toNat / 2 ^ 32 < 2 ^ 32 := by + rw [Nat.div_lt_iff_lt_mul (by decide : 0 < 2 ^ 32)] + simpa [pow_add] using hp00_lt + have hp01_lo_lt : p01.toNat % 2 ^ 32 < 2 ^ 32 := Nat.mod_lt _ (by decide) + have hp10_lo_lt : p10.toNat % 2 ^ 32 < 2 ^ 32 := Nat.mod_lt _ (by decide) + have hsum01 : + p00.toNat / 2 ^ 32 + p01.toNat % 2 ^ 32 < 2 ^ 64 := by + omega + have hsum012 : + p00.toNat / 2 ^ 32 + p01.toNat % 2 ^ 32 + p10.toNat % 2 ^ 32 < + 2 ^ 64 := by + omega + rw [Nat.mod_eq_of_lt hsum01, Nat.mod_eq_of_lt hsum012] + have hwide := + wideMul_high_nat p00.toNat p01.toNat p10.toNat p11.toNat hp00_lt hp01_lt hp10_lt hp11_lt + have hwide' : + p11.toNat + p01.toNat / 2 ^ 32 + p10.toNat / 2 ^ 32 + + (p00.toNat / 2 ^ 32 + p01.toNat % 2 ^ 32 + p10.toNat % 2 ^ 32) / 2 ^ 32 = + (p00.toNat + 2 ^ 32 * (p01.toNat + p10.toNat) + (2 ^ 32) ^ 2 * p11.toNat) / + (2 ^ 32) ^ 2 := by + simpa using hwide + have hquot_lt : + p11.toNat + p01.toNat / 2 ^ 32 + p10.toNat / 2 ^ 32 + carry.toNat / 2 ^ 32 < + UInt64.size := by + rw [hcarry_nat] + rw [hwide'] + have hprod_bound : x.toNat * y.toNat < UInt64.size * UInt64.size := by + exact + mul_lt_mul'' (UInt64.toNat_lt_size x) (UInt64.toNat_lt_size y) (Nat.zero_le _) + (Nat.zero_le _) + have hsplit : + p00.toNat + 2 ^ 32 * (p01.toNat + p10.toNat) + (2 ^ 32) ^ 2 * p11.toNat = + x.toNat * y.toNat := by + rw [hp00_nat, hp01_nat, hp10_nat, hp11_nat] + subst p00 + subst p01 + subst p10 + subst p11 + subst xLo + subst xHi + subst yLo + subst yHi + simpa [pow_add, pow_mul] using (product_split32 x y).symm + rw [hsplit] + change x.toNat * y.toNat / UInt64.size < UInt64.size + rw [Nat.div_lt_iff_lt_mul (by decide : 0 < UInt64.size)] + exact hprod_bound + have hhi_nat : + hi.toNat = p11.toNat + p01.toNat / 2 ^ 32 + p10.toNat / 2 ^ 32 + carry.toNat / 2 ^ 32 := by + rw [hhi] + dsimp only + change (p11 + (p01 >>> 32) + (p10 >>> 32) + (carry >>> 32)).toNat = + p11.toNat + p01.toNat / 2 ^ 32 + p10.toNat / 2 ^ 32 + carry.toNat / 2 ^ 32 + rw [UInt64.toNat_add, UInt64.toNat_add, UInt64.toNat_add] + rw [shiftRight32_toNat, shiftRight32_toNat, shiftRight32_toNat] + have hsum01 : p11.toNat + p01.toNat / 2 ^ 32 < UInt64.size := by + have hle : p11.toNat + p01.toNat / 2 ^ 32 ≤ + p11.toNat + p01.toNat / 2 ^ 32 + p10.toNat / 2 ^ 32 + carry.toNat / 2 ^ 32 := by + omega + exact lt_of_le_of_lt hle hquot_lt + have hsum012 : + p11.toNat + p01.toNat / 2 ^ 32 + p10.toNat / 2 ^ 32 < UInt64.size := by + have hle : p11.toNat + p01.toNat / 2 ^ 32 + p10.toNat / 2 ^ 32 ≤ + p11.toNat + p01.toNat / 2 ^ 32 + p10.toNat / 2 ^ 32 + carry.toNat / 2 ^ 32 := by + omega + exact lt_of_le_of_lt hle hquot_lt + have hquot_lt_pow : + p11.toNat + p01.toNat / 2 ^ 32 + p10.toNat / 2 ^ 32 + carry.toNat / 2 ^ 32 < + 2 ^ 64 := by + simpa [UInt64.size] using hquot_lt + have hsum01_pow : p11.toNat + p01.toNat / 2 ^ 32 < 2 ^ 64 := by + simpa [UInt64.size] using hsum01 + have hsum012_pow : + p11.toNat + p01.toNat / 2 ^ 32 + p10.toNat / 2 ^ 32 < 2 ^ 64 := by + simpa [UInt64.size] using hsum012 + rw [Nat.mod_eq_of_lt hsum01_pow, Nat.mod_eq_of_lt hsum012_pow, + Nat.mod_eq_of_lt hquot_lt_pow] + rw [hhi_nat] + rw [hcarry_nat] + rw [hwide'] + have hsplit : + p00.toNat + 2 ^ 32 * (p01.toNat + p10.toNat) + (2 ^ 32) ^ 2 * p11.toNat = + x.toNat * y.toNat := by + rw [hp00_nat, hp01_nat, hp10_nat, hp11_nat] + subst p00 + subst p01 + subst p10 + subst p11 + subst xLo + subst xHi + subst yLo + subst yHi + simpa [pow_add, pow_mul] using (product_split32 x y).symm + rw [hsplit] + rfl + +/-- Combined semantic correctness of a 64-by-64 product represented by low and high words. -/ +theorem wideMul_cast + (x y lo hi : UInt64) + (hlo : lo = x * y) + (hhi : hi.toNat = x.toNat * y.toNat / UInt64.size) : + (lo.toNat : Goldilocks.Basic.Field) + + (hi.toNat : Goldilocks.Basic.Field) * (UInt64.size : Goldilocks.Basic.Field) = + (x.toNat : Goldilocks.Basic.Field) * (y.toNat : Goldilocks.Basic.Field) := by + rw [wideMul_low_toNat lo x y hlo, hhi] + rw [← Nat.cast_mul, ← Nat.cast_add, Nat.mul_comm (x.toNat * y.toNat / UInt64.size), + Nat.mod_add_div, Nat.cast_mul] + +end Fast +end Goldilocks diff --git a/CompPoly/Fields/Goldilocks/Fast/Reduction.lean b/CompPoly/Fields/Goldilocks/Fast/Reduction.lean new file mode 100644 index 00000000..95d0448d --- /dev/null +++ b/CompPoly/Fields/Goldilocks/Fast/Reduction.lean @@ -0,0 +1,478 @@ +/- +Copyright (c) 2026 CompPoly Contributors. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Varun Thakore +-/ + +import CompPoly.Fields.Goldilocks.Fast.Internal + +/-! +# Raw Reducers for Fast Goldilocks Arithmetic + +This module contains the raw `UInt64` arithmetic kernels and their correctness +lemmas. The public fast field API wraps these kernels in +`CompPoly.Fields.Goldilocks.Fast`. +-/ + +namespace Goldilocks +namespace Fast +namespace Reduction + +/-- Full 64-by-64 product as `(lo, hi)` words, computed from 32-bit limbs. -/ +@[inline] +def wideMul (x y : UInt64) : UInt64 × UInt64 := + let xLo := x &&& neg_modulus + let xHi := x >>> 32 + let yLo := y &&& neg_modulus + let yHi := y >>> 32 + let p00 := xLo * yLo + let p01 := xLo * yHi + let p10 := xHi * yLo + let p11 := xHi * yHi + let carry := (p00 >>> 32) + (p01 &&& neg_modulus) + (p10 &&& neg_modulus) + let hi := p11 + (p01 >>> 32) + (p10 >>> 32) + (carry >>> 32) + (x * y, hi) + +/-- Raw one-word reduction for a `UInt64` value. + +Since every `UInt64` is below `2^64 = p + 2^32 - 1`, one subtraction by `p` +is enough to canonicalize a native word. +-/ +@[inline] +def reduceUInt64Raw (x : UInt64) : UInt64 := + if x < modulus then x else x - modulus + +/-- The raw one-word reducer returns a canonical representative. -/ +theorem reduceUInt64Raw_lt (x : UInt64) : + (reduceUInt64Raw x).toNat < Goldilocks.Basic.fieldSize := by + unfold reduceUInt64Raw + by_cases hx : x < modulus + · rw [if_pos hx] + rw [UInt64.lt_iff_toNat_lt, modulus_toNat] at hx + exact hx + · rw [if_neg hx] + have hmod_le_x_nat : Goldilocks.Basic.fieldSize ≤ x.toNat := by + rw [UInt64.lt_iff_toNat_lt, modulus_toNat] at hx + exact Nat.le_of_not_gt hx + have hmod_le_x : modulus ≤ x := by + rw [UInt64.le_iff_toNat_le, modulus_toNat] + exact hmod_le_x_nat + rw [UInt64.toNat_sub_of_le _ _ hmod_le_x, modulus_toNat] + have hx_lt_two := uint64_toNat_lt_two_fieldSize x + omega + +/-- One-word reduction preserves the represented canonical field element. -/ +theorem reduceUInt64Raw_cast (x : UInt64) : + ((reduceUInt64Raw x).toNat : Goldilocks.Basic.Field) = + (x.toNat : Goldilocks.Basic.Field) := by + unfold reduceUInt64Raw + by_cases hx : x < modulus + · rw [if_pos hx] + · rw [if_neg hx] + have hmod_le_x : modulus ≤ x := by + rw [UInt64.le_iff_toNat_le, modulus_toNat] + rw [UInt64.lt_iff_toNat_lt, modulus_toNat] at hx + exact Nat.le_of_not_gt hx + rw [UInt64.toNat_sub_of_le _ _ hmod_le_x, modulus_toNat] + rw [Nat.cast_sub (by + rw [UInt64.le_iff_toNat_le, modulus_toNat] at hmod_le_x + exact hmod_le_x)] + simp + +/-- Raw reduction of a 128-bit integer represented by low and high words modulo Goldilocks. -/ +@[inline] +def reduceUInt128Raw (lo hi : UInt64) : UInt64 := + let hi_hi := hi >>> 32 + let hi_lo := hi &&& neg_modulus + + let borrow := lo < hi_hi + let t0 := lo - hi_hi + let t0 := if borrow then t0 - neg_modulus else t0 + + let t1 := hi_lo * neg_modulus + + let t2 := t0 + t1 + let overflow := t2 < t0 + let t2 := if overflow then t2 + neg_modulus else t2 + + reduceUInt64Raw t2 + +/-- The raw 128-bit reducer returns a canonical representative below the modulus. -/ +theorem reduceUInt128Raw_lt (lo hi : UInt64) : + (reduceUInt128Raw lo hi).toNat < Goldilocks.Basic.fieldSize := by + unfold reduceUInt128Raw + apply reduceUInt64Raw_lt + +/-- Semantic correctness of raw 128-bit Goldilocks reduction. -/ +theorem reduceUInt128Raw_cast (lo hi : UInt64) : + ((reduceUInt128Raw lo hi).toNat : Goldilocks.Basic.Field) = + (lo.toNat : Goldilocks.Basic.Field) + + (hi.toNat : Goldilocks.Basic.Field) * (UInt64.size : Goldilocks.Basic.Field) := by + let hi_hi := hi >>> 32 + let hi_lo := hi &&& neg_modulus + let t0 := if lo < hi_hi then lo - hi_hi - neg_modulus else lo - hi_hi + let t1 := hi_lo * neg_modulus + let t2 := if t0 + t1 < t0 then t0 + t1 + neg_modulus else t0 + t1 + change ((reduceUInt64Raw t2).toNat : Goldilocks.Basic.Field) = + (lo.toNat : Goldilocks.Basic.Field) + + (hi.toNat : Goldilocks.Basic.Field) * (UInt64.size : Goldilocks.Basic.Field) + have hred := reduceUInt64Raw_cast t2 + change ((reduceUInt64Raw t2).toNat : Goldilocks.Basic.Field) = + (t2.toNat : Goldilocks.Basic.Field) at hred + rw [hred] + have hhi_hi_lt : hi_hi.toNat < 2 ^ 32 := by + rw [show hi_hi = hi >>> 32 by rfl, shiftRight32_toNat] + have hhi := UInt64.toNat_lt_size hi + change hi.toNat < 2 ^ 64 at hhi + omega + have hhi_lo_lt : hi_lo.toNat < 2 ^ 32 := by + rw [show hi_lo = hi &&& neg_modulus by rfl, and_neg_modulus_toNat] + exact Nat.mod_lt _ (by decide) + have ht0_cast : + (t0.toNat : Goldilocks.Basic.Field) = + (lo.toNat : Goldilocks.Basic.Field) - (hi_hi.toNat : Goldilocks.Basic.Field) := by + rw [show t0 = if lo < hi_hi then lo - hi_hi - neg_modulus else lo - hi_hi by rfl] + exact subBorrow_cast lo hi_hi hhi_hi_lt + have ht1_cast : + (t1.toNat : Goldilocks.Basic.Field) = + (hi_lo.toNat : Goldilocks.Basic.Field) * + (neg_modulus.toNat : Goldilocks.Basic.Field) := by + rw [show t1 = hi_lo * neg_modulus by rfl] + rw [mul_neg_modulus_toNat_of_lt hi_lo hhi_lo_lt] + rw [Nat.cast_mul] + have ht2_bound : t0.toNat + t1.toNat < 2 * UInt64.size - neg_modulus.toNat := by + have ht0_lt := UInt64.toNat_lt_size t0 + have ht1_le : t1.toNat ≤ UInt64.size - 2 * neg_modulus.toNat := by + simpa [t1] using mul_neg_modulus_toNat_le hi_lo hhi_lo_lt + have htwice_neg_le_size : 2 * neg_modulus.toNat ≤ UInt64.size := by + decide + omega + have ht2_cast : + (t2.toNat : Goldilocks.Basic.Field) = + (t0.toNat : Goldilocks.Basic.Field) + (t1.toNat : Goldilocks.Basic.Field) := by + rw [show t2 = if t0 + t1 < t0 then t0 + t1 + neg_modulus else t0 + t1 by rfl] + exact addOverflowBounded_cast t0 t1 ht2_bound + rw [ht2_cast, ht0_cast, ht1_cast] + rw [hi_split_cast hi] + ring + +/-- Raw reduction of a 64-by-64 product modulo Goldilocks. -/ +@[inline] +def reduceMulRaw (x y : UInt64) : UInt64 := + let product := wideMul x y + reduceUInt128Raw product.1 product.2 + +/-- Product reduction returns a canonical representative below the modulus. -/ +theorem reduceMulRaw_lt (x y : UInt64) : + (reduceMulRaw x y).toNat < Goldilocks.Basic.fieldSize := by + unfold reduceMulRaw + apply reduceUInt128Raw_lt + +/-- Semantic correctness of native 64-by-64 product reduction. -/ +theorem reduceMulRaw_cast (x y : UInt64) : + ((reduceMulRaw x y).toNat : Goldilocks.Basic.Field) = + (x.toNat : Goldilocks.Basic.Field) * (y.toNat : Goldilocks.Basic.Field) := by + unfold reduceMulRaw + rw [reduceUInt128Raw_cast] + exact + wideMul_cast x y (wideMul x y).1 (wideMul x y).2 + (by unfold wideMul; rfl) + (by + unfold wideMul + exact wideMul_high_toNat x y _ rfl) + +/-- Raw one-step reduction for a 65-bit addition represented by low word and carry. -/ +@[inline] +def reduceAddWithCarryRaw (lo : UInt64) (carry : Bool) : UInt64 := + if carry then + lo + neg_modulus + else + reduceUInt64Raw lo + +/-- Addition reduction returns a canonical representative. -/ +theorem reduceAddWithCarryRaw_lt (lo : UInt64) (carry : Bool) + (h : + lo.toNat + (if carry then UInt64.size else 0) < 2 * Goldilocks.Basic.fieldSize) : + (reduceAddWithCarryRaw lo carry).toNat < Goldilocks.Basic.fieldSize := by + unfold reduceAddWithCarryRaw + cases carry + · simp only [Bool.false_eq_true, if_false] + exact reduceUInt64Raw_lt lo + · simp only [↓reduceIte] at h ⊢ + rw [UInt64.toNat_add] + have hsum_lt_field : lo.toNat + neg_modulus.toNat < Goldilocks.Basic.fieldSize := by + rw [neg_modulus_toNat, Goldilocks.Basic.fieldSize] + rw [Goldilocks.Basic.fieldSize, UInt64.size] at h + omega + have hsum_lt_size : lo.toNat + neg_modulus.toNat < UInt64.size := + Nat.lt_trans hsum_lt_field fieldSize_lt_uint64Size + rw [Nat.mod_eq_of_lt hsum_lt_size] + exact hsum_lt_field + +/-- Semantic correctness of addition reduction with carry. -/ +theorem reduceAddWithCarryRaw_cast (lo : UInt64) (carry : Bool) + (h : + lo.toNat + (if carry then UInt64.size else 0) < 2 * Goldilocks.Basic.fieldSize) : + ((reduceAddWithCarryRaw lo carry).toNat : Goldilocks.Basic.Field) = + (lo.toNat : Goldilocks.Basic.Field) + + (if carry then (UInt64.size : Goldilocks.Basic.Field) else 0) := by + unfold reduceAddWithCarryRaw + cases carry + · simp only [Bool.false_eq_true, if_false, add_zero] + exact reduceUInt64Raw_cast lo + · simp only [↓reduceIte] + change lo.toNat + UInt64.size < 2 * Goldilocks.Basic.fieldSize at h + rw [UInt64.toNat_add] + have hsum_lt_field : lo.toNat + neg_modulus.toNat < Goldilocks.Basic.fieldSize := by + rw [neg_modulus_toNat, Goldilocks.Basic.fieldSize] + rw [Goldilocks.Basic.fieldSize, UInt64.size] at h + omega + have hsum_lt_size : lo.toNat + neg_modulus.toNat < UInt64.size := + Nat.lt_trans hsum_lt_field fieldSize_lt_uint64Size + rw [Nat.mod_eq_of_lt hsum_lt_size] + rw [Nat.cast_add] + rw [uint64_cast_eq_neg_modulus] + +/-- The wrapped word and carry produced by adding two canonical representatives is bounded. -/ +theorem addWithCarry_bound (x y : UInt64) + (hx : x.toNat < Goldilocks.Basic.fieldSize) + (hy : y.toNat < Goldilocks.Basic.fieldSize) : + let lo := x + y + let carry := decide (lo < x) + lo.toNat + (if carry then UInt64.size else 0) < 2 * Goldilocks.Basic.fieldSize := by + intro lo carry + by_cases hcarry : carry + · simp only [hcarry] + have hlo_lt_x : lo.toNat < x.toNat := by + simpa [carry, UInt64.lt_iff_toNat_lt] using hcarry + have hsum_ge_size : UInt64.size ≤ x.toNat + y.toNat := by + by_contra hnot + have hsum_lt_size : x.toNat + y.toNat < UInt64.size := + Nat.lt_of_not_ge hnot + have hlo_eq : lo.toNat = x.toNat + y.toNat := by + rw [show lo = x + y by rfl, UInt64.toNat_add] + exact Nat.mod_eq_of_lt hsum_lt_size + omega + have hsum_lt_2size : x.toNat + y.toNat < 2 * UInt64.size := by + nlinarith [UInt64.toNat_lt_size x, UInt64.toNat_lt_size y] + have hlo_eq : lo.toNat = x.toNat + y.toNat - UInt64.size := by + rw [show lo = x + y by rfl, UInt64.toNat_add] + rw [Nat.mod_eq_sub_mod (show x.toNat + y.toNat ≥ UInt64.size by + exact hsum_ge_size)] + rw [Nat.mod_eq_of_lt] + omega + rw [hlo_eq] + change x.toNat + y.toNat - UInt64.size + UInt64.size < + 2 * Goldilocks.Basic.fieldSize + have hsum_lt_field : x.toNat + y.toNat < 2 * Goldilocks.Basic.fieldSize := by + omega + omega + · simp only [hcarry] + exact uint64_toNat_lt_two_fieldSize lo + +/-- The wrapped word and carry produced by native addition reconstruct the exact Nat sum. -/ +theorem addWithCarry_value (x y : UInt64) : + let lo := x + y + let carry := decide (lo < x) + lo.toNat + (if carry then UInt64.size else 0) = x.toNat + y.toNat := by + intro lo carry + by_cases hcarry : carry + · simp only [hcarry] + have hsum_ge_size : UInt64.size ≤ x.toNat + y.toNat := by + by_contra hnot + have hsum_lt_size : x.toNat + y.toNat < UInt64.size := + Nat.lt_of_not_ge hnot + have hlo_eq : lo.toNat = x.toNat + y.toNat := by + rw [show lo = x + y by rfl, UInt64.toNat_add] + exact Nat.mod_eq_of_lt hsum_lt_size + have hlo_lt_x : lo.toNat < x.toNat := by + simpa [carry, UInt64.lt_iff_toNat_lt] using hcarry + omega + have hsum_lt_2size : x.toNat + y.toNat < 2 * UInt64.size := by + nlinarith [UInt64.toNat_lt_size x, UInt64.toNat_lt_size y] + have hlo_eq : lo.toNat = x.toNat + y.toNat - UInt64.size := by + rw [show lo = x + y by rfl, UInt64.toNat_add] + rw [Nat.mod_eq_sub_mod (show x.toNat + y.toNat ≥ UInt64.size by + exact hsum_ge_size)] + rw [Nat.mod_eq_of_lt] + omega + rw [hlo_eq] + change x.toNat + y.toNat - UInt64.size + UInt64.size = + x.toNat + y.toNat + omega + · simp only [hcarry] + have hnot_lo_lt_x : ¬lo.toNat < x.toNat := by + intro hlo_lt_x + apply hcarry + simpa [carry, UInt64.lt_iff_toNat_lt] using hlo_lt_x + have hsum_lt_size : x.toNat + y.toNat < UInt64.size := by + by_contra hnot + have hsum_ge_size : UInt64.size ≤ x.toNat + y.toNat := + Nat.le_of_not_gt hnot + have hsum_lt_2size : x.toNat + y.toNat < 2 * UInt64.size := by + nlinarith [UInt64.toNat_lt_size x, UInt64.toNat_lt_size y] + have hlo_eq : lo.toNat = x.toNat + y.toNat - UInt64.size := by + rw [show lo = x + y by rfl, UInt64.toNat_add] + rw [Nat.mod_eq_sub_mod (show x.toNat + y.toNat ≥ UInt64.size by + exact hsum_ge_size)] + rw [Nat.mod_eq_of_lt] + omega + have hy_lt_size : y.toNat < UInt64.size := UInt64.toNat_lt_size y + omega + rw [show lo = x + y by rfl, UInt64.toNat_add] + exact Nat.mod_eq_of_lt hsum_lt_size + +/-- Raw modular negation in canonical form. -/ +@[inline] +def negRaw (x : UInt64) : UInt64 := + if x = 0 then 0 else modulus - x + +/-- Raw negation returns a canonical representative when given one. -/ +theorem negRaw_lt (x : UInt64) (hx : x.toNat < Goldilocks.Basic.fieldSize) : + (negRaw x).toNat < Goldilocks.Basic.fieldSize := by + unfold negRaw + by_cases hzero : x = 0 + · rw [if_pos hzero] + decide + · rw [if_neg hzero] + have hx_ne_nat : x.toNat ≠ 0 := by + intro hz + apply hzero + apply UInt64.toNat_inj.mp + rw [hz] + decide + have hx_pos : 0 < x.toNat := Nat.pos_of_ne_zero hx_ne_nat + have hx_le_mod : x ≤ modulus := by + rw [UInt64.le_iff_toNat_le, modulus_toNat] + exact Nat.le_of_lt hx + rw [UInt64.toNat_sub_of_le _ _ hx_le_mod, modulus_toNat] + omega + +/-- Raw negation agrees with canonical-field negation. -/ +theorem negRaw_cast (x : UInt64) (hx : x.toNat < Goldilocks.Basic.fieldSize) : + ((negRaw x).toNat : Goldilocks.Basic.Field) = + -((x.toNat : Goldilocks.Basic.Field)) := by + unfold negRaw + by_cases hzero : x = 0 + · rw [if_pos hzero] + have hxNat : x.toNat = 0 := by + simpa using congrArg UInt64.toNat hzero + rw [hxNat] + simp + · rw [if_neg hzero] + have hle : x ≤ modulus := by + rw [UInt64.le_iff_toNat_le, modulus_toNat] + exact Nat.le_of_lt hx + rw [UInt64.toNat_sub_of_le _ _ hle, modulus_toNat] + rw [Nat.cast_sub (by + rw [UInt64.le_iff_toNat_le, modulus_toNat] at hle + exact hle)] + rw [ZMod.natCast_self] + ring + +/-- Raw modular subtraction in canonical form. -/ +@[inline] +def subRaw (x y : UInt64) : UInt64 := + if y ≤ x then x - y else x - y - neg_modulus + +/-- Raw subtraction returns a canonical representative when given canonical operands. -/ +theorem subRaw_lt (x y : UInt64) + (hx : x.toNat < Goldilocks.Basic.fieldSize) + (hy : y.toNat < Goldilocks.Basic.fieldSize) : + (subRaw x y).toNat < Goldilocks.Basic.fieldSize := by + unfold subRaw + by_cases hxy : y ≤ x + · rw [if_pos hxy] + rw [UInt64.toNat_sub_of_le _ _ hxy] + have hy_le_x : y.toNat ≤ x.toNat := by + simpa [UInt64.le_iff_toNat_le] using hxy + omega + · rw [if_neg hxy] + have hx_lt_y : x.toNat < y.toNat := by + have hnot : ¬y.toNat ≤ x.toNat := by + intro hle + apply hxy + rw [UInt64.le_iff_toNat_le] + exact hle + exact Nat.lt_of_not_ge hnot + have hraw_lt_size : 2 ^ 64 - y.toNat + x.toNat < 2 ^ 64 := by + have hx_lt_size : x.toNat < 2 ^ 64 := by + simpa [UInt64.size] using UInt64.toNat_lt_size x + have hy_lt_size : y.toNat < 2 ^ 64 := by + simpa [UInt64.size] using UInt64.toNat_lt_size y + omega + have hraw_toNat : + (x - y).toNat = 2 ^ 64 - y.toNat + x.toNat := by + rw [UInt64.toNat_sub] + exact Nat.mod_eq_of_lt hraw_lt_size + have hneg_le_raw_nat : neg_modulus.toNat ≤ (x - y).toNat := by + rw [hraw_toNat, neg_modulus_toNat] + have hy_lt_field : y.toNat < 2 ^ 64 - 2 ^ 32 + 1 := by + simpa [Goldilocks.Basic.fieldSize] using hy + omega + have hneg_le_raw : neg_modulus ≤ x - y := by + rw [UInt64.le_iff_toNat_le] + exact hneg_le_raw_nat + rw [UInt64.toNat_sub_of_le _ _ hneg_le_raw, hraw_toNat, neg_modulus_toNat] + change 2 ^ 64 - y.toNat + x.toNat - (2 ^ 32 - 1) < + 2 ^ 64 - 2 ^ 32 + 1 + have hx_lt_field : x.toNat < 2 ^ 64 - 2 ^ 32 + 1 := by + simpa [Goldilocks.Basic.fieldSize] using hx + have hy_lt_field : y.toNat < 2 ^ 64 - 2 ^ 32 + 1 := by + simpa [Goldilocks.Basic.fieldSize] using hy + omega + +/-- Raw subtraction agrees with canonical-field subtraction for canonical operands. -/ +theorem subRaw_cast (x y : UInt64) + (_hx : x.toNat < Goldilocks.Basic.fieldSize) + (hy : y.toNat < Goldilocks.Basic.fieldSize) : + ((subRaw x y).toNat : Goldilocks.Basic.Field) = + (x.toNat : Goldilocks.Basic.Field) - (y.toNat : Goldilocks.Basic.Field) := by + unfold subRaw + by_cases hxy : y ≤ x + · rw [if_pos hxy] + rw [UInt64.toNat_sub_of_le _ _ hxy] + rw [Nat.cast_sub (by + rw [UInt64.le_iff_toNat_le] at hxy + exact hxy)] + · rw [if_neg hxy] + have hx_lt_y : x.toNat < y.toNat := by + have hnot : ¬y.toNat ≤ x.toNat := by + intro hle + apply hxy + rw [UInt64.le_iff_toNat_le] + exact hle + exact Nat.lt_of_not_ge hnot + have hraw_lt_size : 2 ^ 64 - y.toNat + x.toNat < 2 ^ 64 := by + have hx_lt_size : x.toNat < 2 ^ 64 := by + simpa [UInt64.size] using UInt64.toNat_lt_size x + have hy_lt_size : y.toNat < 2 ^ 64 := by + simpa [UInt64.size] using UInt64.toNat_lt_size y + omega + have hraw_toNat : + (x - y).toNat = 2 ^ 64 - y.toNat + x.toNat := by + rw [UInt64.toNat_sub] + exact Nat.mod_eq_of_lt hraw_lt_size + have hneg_le_raw_nat : neg_modulus.toNat ≤ (x - y).toNat := by + rw [hraw_toNat, neg_modulus_toNat] + have hy_lt_field : y.toNat < 2 ^ 64 - 2 ^ 32 + 1 := by + simpa [Goldilocks.Basic.fieldSize] using hy + omega + have hneg_le_raw : neg_modulus ≤ x - y := by + rw [UInt64.le_iff_toNat_le] + exact hneg_le_raw_nat + rw [UInt64.toNat_sub_of_le _ _ hneg_le_raw, hraw_toNat, neg_modulus_toNat] + change (((UInt64.size - y.toNat + x.toNat - neg_modulus.toNat : Nat) : + Goldilocks.Basic.Field) = + (x.toNat : Goldilocks.Basic.Field) - (y.toNat : Goldilocks.Basic.Field)) + have hneg_le_concrete : neg_modulus.toNat ≤ UInt64.size - y.toNat + x.toNat := by + simpa [UInt64.size, hraw_toNat] using hneg_le_raw_nat + rw [Nat.cast_sub hneg_le_concrete] + rw [Nat.cast_add] + rw [Nat.cast_sub (Nat.le_of_lt (UInt64.toNat_lt_size y))] + rw [uint64_cast_eq_neg_modulus] + ring + +end Reduction +end Fast +end Goldilocks diff --git a/CompPoly/Fields/Goldilocks/Fast/Theorems.lean b/CompPoly/Fields/Goldilocks/Fast/Theorems.lean new file mode 100644 index 00000000..f9c3a212 --- /dev/null +++ b/CompPoly/Fields/Goldilocks/Fast/Theorems.lean @@ -0,0 +1,321 @@ +/- +Copyright (c) 2026 CompPoly Contributors. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Varun Thakore +-/ + +import CompPoly.Fields.Goldilocks.Fast.Arithmetic +import Mathlib.FieldTheory.Finite.Basic + +/-! +# Correctness Theorems for Fast Goldilocks Arithmetic + +This module proves that the fast `UInt64` operations agree with the canonical +`ZMod` Goldilocks field. +-/ + +namespace Goldilocks +namespace Fast + +/-- Converting a canonical natural representative to fast form preserves its value. -/ +@[simp] +private theorem toField_ofCanonicalNat (n : Nat) (h : n < Goldilocks.Basic.fieldSize) : + toField (ofCanonicalNat n h) = (n : Goldilocks.Basic.Field) := by + unfold toField toNat ofCanonicalNat + have hn : n < UInt64.size := Nat.lt_trans h fieldSize_lt_uint64Size + rw [UInt64.toNat_ofNat'] + rw [Nat.mod_eq_of_lt (by simpa [UInt64.size] using hn)] + +/-- Converting a canonical natural representative to fast form and reading it back is +the identity. -/ +@[simp] +private theorem toNat_ofCanonicalNat (n : Nat) (h : n < Goldilocks.Basic.fieldSize) : + toNat (ofCanonicalNat n h) = n := by + unfold toNat ofCanonicalNat + have hn : n < UInt64.size := Nat.lt_trans h fieldSize_lt_uint64Size + rw [UInt64.toNat_ofNat'] + exact Nat.mod_eq_of_lt (by simpa [UInt64.size] using hn) + +/-- Converting a natural number to fast form agrees with the same natural cast in the +canonical field. -/ +@[simp] +theorem toField_ofNat (n : Nat) : + toField (ofNat n) = (n : Goldilocks.Basic.Field) := by + unfold ofNat + rw [toField_ofCanonicalNat] + rw [← ZMod.natCast_zmod_val (n : Goldilocks.Basic.Field)] + rw [ZMod.val_natCast] + +/-- Converting a `UInt64` to fast form agrees with casting its natural value into the +canonical field. -/ +@[simp] +theorem toField_ofUInt64 (x : UInt64) : + toField (ofUInt64 x) = (x.toNat : Goldilocks.Basic.Field) := by + unfold toField toNat ofUInt64 + exact reduceUInt64_cast x + +/-- Converting an integer to fast form agrees with casting it into the canonical field. -/ +@[simp] +theorem toField_ofInt (z : Int) : + toField (ofInt z) = (z : Goldilocks.Basic.Field) := by + unfold ofInt ofField + rw [toField_ofCanonicalNat] + exact ZMod.natCast_zmod_val (z : Goldilocks.Basic.Field) + +/-- Converting from the canonical field to fast form and back is the identity. -/ +@[simp] +theorem toField_ofField (x : Goldilocks.Basic.Field) : toField (ofField x) = x := by + unfold ofField + rw [toField_ofCanonicalNat] + exact ZMod.natCast_zmod_val x + +/-- Converting from fast form to the canonical field and back is the identity. -/ +@[simp] +theorem ofField_toField (x : Field) : ofField (toField x) = x := by + apply Subtype.ext + apply UInt64.toNat_inj.mp + change toNat (ofField (toField x)) = toNat x + unfold ofField toField + rw [toNat_ofCanonicalNat] + exact ZMod.val_natCast_of_lt x.property + +/-- The canonical-field interpretation distinguishes fast Goldilocks values. -/ +theorem toField_injective : Function.Injective toField := + Function.LeftInverse.injective ofField_toField + +/-- Fermat-style inversion in the canonical Goldilocks field. -/ +private lemma canonical_inv_eq_pow (a : Goldilocks.Basic.Field) (ha : a ≠ 0) : + a⁻¹ = a ^ (Goldilocks.Basic.fieldSize - 2) := by + have hcard : Fintype.card Goldilocks.Basic.Field = Goldilocks.Basic.fieldSize := + ZMod.card Goldilocks.Basic.fieldSize + have h1 : a ^ (Goldilocks.Basic.fieldSize - 1) = 1 := by + have h := FiniteField.pow_card_sub_one_eq_one a ha + rw [hcard] at h + exact h + have hmul : a * a ^ (Goldilocks.Basic.fieldSize - 2) = 1 := by + rw [← pow_succ'] + show a ^ (Goldilocks.Basic.fieldSize - 2 + 1) = 1 + have : Goldilocks.Basic.fieldSize - 2 + 1 = Goldilocks.Basic.fieldSize - 1 := by + unfold Goldilocks.Basic.fieldSize + omega + rw [this] + exact h1 + exact (eq_inv_of_mul_eq_one_left (by rwa [mul_comm])).symm + +/-- Fast zero maps to canonical zero. -/ +@[simp] +theorem toField_zero : toField (0 : Field) = 0 := by + decide + +/-- Fast one maps to canonical one. -/ +@[simp] +theorem toField_one : toField (1 : Field) = 1 := by + decide + +/-- Fast addition agrees with canonical-field addition. -/ +@[simp] +theorem toField_add (x y : Field) : toField (x + y) = toField x + toField y := by + change + (((add x y).val.toNat : Goldilocks.Basic.Field) = + (x.val.toNat : Goldilocks.Basic.Field) + (y.val.toNat : Goldilocks.Basic.Field)) + unfold add + rw [Reduction.reduceAddWithCarryRaw_cast _ _ + (Reduction.addWithCarry_bound x.val y.val x.property y.property)] + let lo := x.val + y.val + let carry := decide (lo < x.val) + have hvalue := Reduction.addWithCarry_value x.val y.val + change lo.toNat + (if carry then UInt64.size else 0) = x.val.toNat + y.val.toNat at hvalue + change + ((lo.toNat : Goldilocks.Basic.Field) + + (if carry then (UInt64.size : Goldilocks.Basic.Field) else 0) = + (x.val.toNat : Goldilocks.Basic.Field) + (y.val.toNat : Goldilocks.Basic.Field)) + by_cases hcarry : carry = true + · simp only [hcarry, if_true] at hvalue ⊢ + rw [← Nat.cast_add, hvalue, Nat.cast_add] + · simp only [hcarry, Bool.false_eq_true, if_false, add_zero] at hvalue ⊢ + rw [hvalue, Nat.cast_add] + +/-- Fast negation agrees with canonical-field negation. -/ +@[simp] +theorem toField_neg (x : Field) : toField (-x) = -toField x := by + change toField (neg x) = -(toField x) + unfold neg toField toNat + exact Reduction.negRaw_cast x.val x.property + +/-- Fast subtraction agrees with canonical-field subtraction. -/ +@[simp] +theorem toField_sub (x y : Field) : toField (x - y) = toField x - toField y := by + change toField (sub x y) = toField x - toField y + unfold sub toField toNat + exact Reduction.subRaw_cast x.val y.val x.property y.property + +/-- Fast multiplication agrees with canonical-field multiplication. -/ +@[simp] +theorem toField_mul (x y : Field) : toField (x * y) = toField x * toField y := by + change toField (mul x y) = toField x * toField y + unfold mul toField toNat + exact Reduction.reduceMulRaw_cast x.val y.val + +/-- The named fast multiplication function agrees with canonical-field multiplication. -/ +@[simp] +theorem toField_mul_def (x y : Field) : toField (mul x y) = toField x * toField y := + toField_mul x y + +/-- Fast squaring agrees with multiplying the canonical field value by itself. -/ +@[simp] +theorem toField_square (x : Field) : toField (square x) = toField x * toField x := by + change toField (x * x) = toField x * toField x + rw [toField_mul] + +/-- Repeated fast squaring agrees with raising to `2^n` in the canonical field. -/ +@[simp] +theorem toField_squareN (x : Field) (n : Nat) : + toField (squareN x n) = toField x ^ (2 ^ n) := by + induction n generalizing x with + | zero => + unfold squareN + simp + | succ n ih => + unfold squareN + rw [toField_square, ih] + rw [← pow_add] + congr 1 + rw [Nat.pow_succ] + omega + +/-- Fast multiplication is associative, proved by transporting to the canonical field. -/ +private theorem mul_assoc_field (x y z : Field) : (x * y) * z = x * (y * z) := by + apply toField_injective + rw [toField_mul, toField_mul, toField_mul, toField_mul] + ring + +/-- Binary exponentiation satisfies the expected successor equation. -/ +private theorem pow_succ (x : Field) (n : Nat) : pow x (n + 1) = pow x n * x := by + unfold pow + letI : Semigroup Field := { + mul := (· * ·) + mul_assoc := mul_assoc_field + } + exact npowBinRec_succ n x + +/-- Fast natural-power computation agrees with powers in the canonical field. -/ +@[simp] +theorem toField_pow (x : Field) (n : Nat) : toField (pow x n) = toField x ^ n := by + induction n with + | zero => + unfold pow + rw [npowBinRec_zero] + rw [toField_one] + simp + | succ n ih => + rw [pow_succ, toField_mul, ih, _root_.pow_succ] + +/-- The optimized inversion chain computes the Fermat inverse exponent. -/ +private theorem toField_inv_chain (x : Field) : + toField (inv x) = toField x ^ invExponent := by + unfold inv + simp only [toField_mul_def, toField_square, toField_squareN] + ring_nf + simp [invExponent, Goldilocks.Basic.fieldSize] + +/-- Fast inversion agrees with canonical inversion before notation is unfolded. -/ +private theorem toField_inv_raw (x : Field) : toField (inv x) = (toField x)⁻¹ := by + rw [toField_inv_chain] + by_cases hx : toField x = 0 + · rw [hx] + simp [invExponent, Goldilocks.Basic.fieldSize] + · simpa [invExponent] using (canonical_inv_eq_pow (toField x) hx).symm + +/-- Fast inversion agrees with inversion in the canonical field. -/ +@[simp] +theorem toField_inv (x : Field) : toField x⁻¹ = (toField x)⁻¹ := by + change toField (inv x) = (toField x)⁻¹ + exact toField_inv_raw x + +/-- Division is multiplication by inverse at the level of canonical interpretation. -/ +private theorem toField_div_mul_inv (x y : Field) : + toField (div x y) = toField x * toField (inv y) := by + unfold div + change toField (x * inv y) = toField x * toField (inv y) + exact toField_mul x (inv y) + +/-- Fast division agrees with division in the canonical field. -/ +@[simp] +theorem toField_div (x y : Field) : toField (x / y) = toField x / toField y := by + change toField (div x y) = toField x / toField y + rw [toField_div_mul_inv, toField_inv_raw y] + rfl + +/-- Natural casts in the fast field agree with natural casts in the canonical field. -/ +@[simp] +theorem toField_natCast (n : Nat) : toField (n : Field) = (n : Goldilocks.Basic.Field) := by + change toField (ofNat n) = (n : Goldilocks.Basic.Field) + rw [toField_ofNat] + +/-- Integer casts in the fast field agree with integer casts in the canonical field. -/ +@[simp] +theorem toField_intCast (n : Int) : toField (n : Field) = (n : Goldilocks.Basic.Field) := by + change toField (ofInt n) = (n : Goldilocks.Basic.Field) + rw [toField_ofInt] + +/-- Fast natural scalar multiplication agrees with canonical-field scalar multiplication. -/ +@[simp] +theorem toField_nsmul (n : Nat) (x : Field) : toField (n • x) = n • toField x := by + change toField ((n : Field) * x) = n • toField x + rw [toField_mul, toField_natCast] + rw [nsmul_eq_mul] + +/-- Fast integer scalar multiplication agrees with canonical-field scalar multiplication. -/ +@[simp] +theorem toField_zsmul (n : Int) (x : Field) : toField (n • x) = n • toField x := by + change toField ((n : Field) * x) = n • toField x + rw [toField_mul, toField_intCast] + rw [zsmul_eq_mul] + +/-- Standard fast natural powers agree with powers in the canonical field. -/ +@[simp] +theorem toField_npow (x : Field) (n : Nat) : toField (x ^ n) = toField x ^ n := by + change toField (pow x n) = toField x ^ n + rw [toField_pow] + +/-- Standard fast integer powers agree with integer powers in the canonical field. -/ +@[simp] +theorem toField_zpow (x : Field) (n : Int) : toField (x ^ n) = toField x ^ n := by + cases n with + | ofNat n => + change toField (pow x n) = toField x ^ (Int.ofNat n) + rw [toField_pow] + exact (zpow_natCast (toField x) n).symm + | negSucc n => + change toField (pow (inv x) (n + 1)) = toField x ^ (Int.negSucc n) + have hinv : toField (inv x) = (toField x)⁻¹ := toField_inv_raw x + rw [toField_pow, hinv, zpow_negSucc, inv_pow] + +/-- Nonnegative rational casts in the fast field agree with canonical-field casts. -/ +@[simp] +theorem toField_nnratCast (q : ℚ≥0) : toField (q : Field) = (q : Goldilocks.Basic.Field) := by + change toField (ofField (q : Goldilocks.Basic.Field)) = (q : Goldilocks.Basic.Field) + rw [toField_ofField] + +/-- Rational casts in the fast field agree with canonical-field casts. -/ +@[simp] +theorem toField_ratCast (q : ℚ) : toField (q : Field) = (q : Goldilocks.Basic.Field) := by + change toField (ofField (q : Goldilocks.Basic.Field)) = (q : Goldilocks.Basic.Field) + rw [toField_ofField] + +/-- Fast nonnegative rational scalar multiplication agrees with canonical-field scalar +multiplication. -/ +@[simp] +theorem toField_nnqsmul (q : ℚ≥0) (x : Field) : toField (q • x) = q • toField x := by + change toField (ofField (q • toField x)) = q • toField x + rw [toField_ofField] + +/-- Fast rational scalar multiplication agrees with canonical-field scalar multiplication. -/ +@[simp] +theorem toField_qsmul (q : ℚ) (x : Field) : toField (q • x) = q • toField x := by + change toField (ofField (q • toField x)) = q • toField x + rw [toField_ofField] + + +end Fast +end Goldilocks diff --git a/CompPoly/Fields/Goldilocks/FastExt.lean b/CompPoly/Fields/Goldilocks/FastExt.lean new file mode 100644 index 00000000..ac60d57f --- /dev/null +++ b/CompPoly/Fields/Goldilocks/FastExt.lean @@ -0,0 +1,106 @@ +/- +Copyright (c) 2026 CompPoly Contributors. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Varun Thakore +-/ + +import CompPoly.Fields.Goldilocks.Fast.Arithmetic + +/-! +# Extern-Backed Fast Goldilocks Operations + +This module provides opt-in extern-backed multiplication and inversion routines +for the fast Goldilocks representation. + +The verified implementation in `CompPoly.Fields.Goldilocks.Fast` remains the +default field implementation. The functions here move selected low-level +operations to external code for performance, so their arithmetic correctness +depends on the linked extern implementations. + +These declarations are a trusted native boundary: Lean checks that the wrappers +have the stated types, but it does not verify the C implementations behind the +`@[extern]` symbols. Use this module when native performance is needed and the +linked C code is accepted as part of the trusted computing base. +-/ + +namespace Goldilocks +namespace Fast +namespace Ext + +/-- High 64 bits of a 64-by-64 unsigned multiplication. + +Together with Lean's native wrapping multiplication, this gives the two words of +the full 128-bit product. + +This is an extern performance primitive. Its correctness is trusted from the +linked native implementation in `native/goldilocks_native.c`. +-/ +@[extern "lean_uint64_mul_hi"] +opaque mulHi (a b : UInt64) : UInt64 + +/-- Extern Goldilocks multiplication returning a canonical `UInt64` representative. + +This is an extern performance primitive. Lean does not verify that the native +routine implements Goldilocks multiplication correctly. The native symbol is +implemented in `native/goldilocks_native.c`. +-/ +@[extern "lean_goldilocks_mul"] +opaque goldilocksMul (a b : UInt64) : UInt64 + +/-- Multiplication using extern `UInt64.mulHi` for the high word and Lean reduction. -/ +@[inline] +def mulWithMulHi (x y : Field) : Field := + let lo := x.val * y.val + let hi := mulHi x.val y.val + ⟨Reduction.reduceUInt128Raw lo hi, Reduction.reduceUInt128Raw_lt lo hi⟩ + +/-- Multiplication using an extern Goldilocks multiplication primitive. + +The external function is expected to return a canonical representative; this +wrapper still passes the result through `reduceUInt64` to inhabit the fast field +type safely. +-/ +@[inline] +def mulNative (x y : Field) : Field := + reduceUInt64 (goldilocksMul x.val y.val) + +/-- Squaring using extern `UInt64.mulHi` for multiplication. -/ +@[inline] +def squareWithMulHi (x : Field) : Field := + mulWithMulHi x x + +/-- Squaring using the extern Goldilocks multiplication primitive. -/ +@[inline] +def squareNative (x : Field) : Field := + mulNative x x + +/-- Repeated squaring using extern-backed multiplication. -/ +@[inline] +def squareNNative (x : Field) : Nat → Field + | 0 => x + | n + 1 => squareNNative (squareNative x) n + +/-- Inversion using the Goldilocks `p - 2` addition chain and extern multiplication. -/ +@[noinline] +def invNative (x : Field) : Field := + let t2 := mulNative (squareNative x) x + let t4 := mulNative (squareNNative t2 2) t2 + let t8 := mulNative (squareNNative t4 4) t4 + let t16 := mulNative (squareNNative t8 8) t8 + let t31 := + mulNative (squareNNative t16 15) + (mulNative (squareNNative t8 7) + (mulNative (squareNNative t4 3) + (mulNative (squareNative t2) x))) + let t32m2 := squareNative t31 + let t32m1 := mulNative t32m2 x + mulNative (squareNNative t32m2 32) t32m1 + +/-- Division using extern-backed inversion and multiplication. -/ +@[inline] +def divNative (x y : Field) : Field := + mulNative x (invNative y) + +end Ext +end Fast +end Goldilocks diff --git a/CompPoly/Fields/Secp256k1.lean b/CompPoly/Fields/Secp256k1.lean index 3ee872ec..32da9567 100644 --- a/CompPoly/Fields/Secp256k1.lean +++ b/CompPoly/Fields/Secp256k1.lean @@ -1,151 +1,15 @@ /- Copyright (c) 2024 ArkLib Contributors. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. -Authors: Quang Dao +Authors: Quang Dao, Varun Thakore -/ -import CompPoly.Fields.PrattCertificate +import CompPoly.Fields.Secp256k1.Base.Basic +import CompPoly.Fields.Secp256k1.Scalar.Basic +import CompPoly.Fields.Secp256k1.Scalar.Fast /-! - # The Secp256k1 base and scalar prime fields - - We define the two primes underlying the Secp256k1 elliptic curve. - - The base prime is the prime on which the elliptic curve is defined. - - The scalar prime is the prime that divides the order of the curve. - - ## References - - `p` is the base prime, and `n` is the scalar prime in [Section 2.4.1](http://www.secg.org/sec2-v2.pdf). +# Secp256k1 Fields +Facade module for the secp256k1 base and scalar fields. -/ - -namespace Secp256k1 - --- Base field - -@[reducible] -def BASE_FIELD_CARD : Nat := 0xfffffffffffffffffffffffffffffffffffffffffffffffffffffffefffffc2f - -/- Alternative representation -/ -example : - BASE_FIELD_CARD = 2 ^ 256 - 2 ^ 32 - 2 ^ 9 - 2 ^ 8 - 2 ^ 7 - 2 ^ 6 - 2 ^ 4 - 1 := by - unfold BASE_FIELD_CARD; norm_num - -abbrev BaseField := ZMod BASE_FIELD_CARD - - -/- Pratt certificate for BASE_FIELD_CARD - -(3 (2 3 7 13441 205115282021455665897114700593932402728804164701536103180137503955397371) - (1 1 1 1 1) - (() () () () - (10 (2 3 5 29 31 7723 132896956044521568488119 255515944373312847190720520512484175977) - (1 1 1 2 1 1 1 1) - (() () () () () () - (6 (2 3 22149492674086928081353) - (1 1 1) - (() () - (5 (2 3 5323 173378833005251801) - (3 1 1 1) - (() () () - (6 (2 5 2621 24809 13331831) - (3 2 1 1 1) - (() () () () - (13 (2 5 971 1373) - (1 1 1 1) - (() () () ())) - )) - )) - )) - (3 (2 7 11 1627 2657 4423 41201 96557 7240687 107590001) - (3 2 1 1 1 1 1 1 1 1) - (() () () () () () () () () - (3 (2 5 7 29 53) - (4 4 1 1 1) - (() () () () ())) - )) - )) - ))) - --/ - -theorem BaseField_is_prime : Nat.Prime BASE_FIELD_CARD := by - unfold BASE_FIELD_CARD - refine PrattCertificate'.out (p := BASE_FIELD_CARD) ⟨3, (by reduce_mod_char), ?_⟩ - refine .split [2, 3, 7, 13441, - 205115282021455665897114700593932402728804164701536103180137503955397371] - (fun r hr => ?_) (by norm_num) - simp at hr - rcases hr with hr | hr | hr | hr | hr - all_goals rw [hr] - · exact .prime 2 1 _ (by pratt) (by reduce_mod_char; decide) (by norm_num) - · exact .prime 3 1 _ (by pratt) (by reduce_mod_char; decide) (by norm_num) - · exact .prime 7 1 _ (by pratt) (by reduce_mod_char; decide) (by norm_num) - · exact .prime 13441 1 _ (by pratt) (by reduce_mod_char; decide) (by norm_num) - · refine .prime 205115282021455665897114700593932402728804164701536103180137503955397371 1 _ ?_ - (by reduce_mod_char; decide) (by norm_num) - · refine PrattCertificate'.out ⟨10, (by reduce_mod_char), ?_⟩ - refine .split [2, 3, 5, 29 ^ 2, 31, 7723, 132896956044521568488119, - 255515944373312847190720520512484175977] (fun r hr => ?_) (by norm_num) - simp at hr - rcases hr with hr | hr | hr | hr | hr | hr | hr | hr - all_goals rw [hr] - · exact .prime 2 1 _ (by pratt) (by reduce_mod_char; decide) (by norm_num) - · exact .prime 3 1 _ (by pratt) (by reduce_mod_char; decide) (by norm_num) - · exact .prime 5 1 _ (by pratt) (by reduce_mod_char; decide) (by norm_num) - · exact .prime 29 2 _ (by pratt) (by reduce_mod_char; decide) (by norm_num) - · exact .prime 31 1 _ (by pratt) (by reduce_mod_char; decide) (by norm_num) - · exact .prime 7723 1 _ (by pratt) (by reduce_mod_char; decide) (by norm_num) - · exact .prime 132896956044521568488119 1 _ (by pratt) - (by reduce_mod_char; decide) (by norm_num) - · exact .prime 255515944373312847190720520512484175977 1 _ (by pratt) - (by reduce_mod_char; decide) (by norm_num) - -instance : Fact (Nat.Prime BASE_FIELD_CARD) := ⟨BaseField_is_prime⟩ - -instance : Field BaseField := ZMod.instField BASE_FIELD_CARD - - - --- Scalar field - -@[reducible] -def SCALAR_FIELD_CARD : Nat := 0xfffffffffffffffffffffffffffffffebaaedce6af48a03bbfd25e8cd0364141 - -abbrev ScalarField := ZMod SCALAR_FIELD_CARD - -theorem ScalarField_is_prime : Nat.Prime SCALAR_FIELD_CARD := by - unfold SCALAR_FIELD_CARD - refine PrattCertificate'.out (p := SCALAR_FIELD_CARD) ⟨7, (by reduce_mod_char), ?_⟩ - refine .split [2 ^ 6, 3, 149, 631, 107361793816595537, 174723607534414371449, - 341948486974166000522343609283189] (fun r hr => ?_) (by norm_num) - simp at hr - rcases hr with hr | hr | hr | hr | hr | hr | hr - all_goals rw [hr] - · exact .prime 2 6 _ (by pratt) (by reduce_mod_char; decide) (by norm_num) - · exact .prime 3 1 _ (by pratt) (by reduce_mod_char; decide) (by norm_num) - · exact .prime 149 1 _ (by pratt) (by reduce_mod_char; decide) (by norm_num) - · exact .prime 631 1 _ (by pratt) (by reduce_mod_char; decide) (by norm_num) - · exact .prime 107361793816595537 1 _ (by pratt) (by reduce_mod_char; decide) (by norm_num) - · exact .prime 174723607534414371449 1 _ (by pratt) (by reduce_mod_char; decide) (by norm_num) - · refine .prime 341948486974166000522343609283189 1 _ ?_ (by reduce_mod_char; decide) - (by norm_num) - · refine PrattCertificate'.out ⟨2, (by reduce_mod_char), ?_⟩ - refine .split [2 ^ 2, 3 ^ 3, 109, 29047611873442575647497758179] (fun r hr => ?_) - (by norm_num) - simp at hr - rcases hr with hr | hr | hr | hr - all_goals rw [hr] - · exact .prime 2 2 _ (by pratt) (by reduce_mod_char; decide) (by norm_num) - · exact .prime 3 3 _ (by pratt) (by reduce_mod_char; decide) (by norm_num) - · exact .prime 109 1 _ (by pratt) (by reduce_mod_char; decide) (by norm_num) - · exact .prime 29047611873442575647497758179 1 _ (by pratt) (by reduce_mod_char; decide) - (by norm_num) - -instance : Fact (Nat.Prime SCALAR_FIELD_CARD) := ⟨ScalarField_is_prime⟩ - -instance : Field ScalarField := ZMod.instField SCALAR_FIELD_CARD - -end Secp256k1 diff --git a/CompPoly/Fields/Secp256k1/Base/Basic.lean b/CompPoly/Fields/Secp256k1/Base/Basic.lean new file mode 100644 index 00000000..e688f8ea --- /dev/null +++ b/CompPoly/Fields/Secp256k1/Base/Basic.lean @@ -0,0 +1,70 @@ +/- +Copyright (c) 2024 ArkLib Contributors. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Varun Thakore +-/ + +import CompPoly.Fields.PrattCertificate + +/-! + # secp256k1 Base Field + + Canonical base field, its cardinality, and its primality certificate. + + Represented as `p` in https://www.secg.org/sec2-v2.pdf. +-/ + +namespace Secp256k1.Base.Basic + +/-- The secp256k1 base-field prime `2^256 - 2^32 - 977`. -/ +@[reducible] +def CARD : Nat := 0xfffffffffffffffffffffffffffffffffffffffffffffffffffffffefffffc2f + +/-- The special form of the base-field prime used by pseudo-Mersenne reduction. -/ +theorem card_eq_two_pow_256_sub : CARD = 2 ^ 256 - 2 ^ 32 - 977 := by + unfold CARD + norm_num + +/-- The canonical secp256k1 base field. -/ +abbrev Field := ZMod CARD + +/-- The secp256k1 base-field prime is prime. -/ +theorem card_is_prime : Nat.Prime CARD := by + unfold CARD + refine PrattCertificate'.out (p := CARD) ⟨3, (by reduce_mod_char), ?_⟩ + refine .split [2, 3, 7, 13441, + 205115282021455665897114700593932402728804164701536103180137503955397371] + (fun r hr => ?_) (by norm_num) + simp at hr + rcases hr with hr | hr | hr | hr | hr + all_goals rw [hr] + · exact .prime 2 1 _ (by pratt) (by reduce_mod_char; decide) (by norm_num) + · exact .prime 3 1 _ (by pratt) (by reduce_mod_char; decide) (by norm_num) + · exact .prime 7 1 _ (by pratt) (by reduce_mod_char; decide) (by norm_num) + · exact .prime 13441 1 _ (by pratt) (by reduce_mod_char; decide) (by norm_num) + · refine .prime 205115282021455665897114700593932402728804164701536103180137503955397371 1 _ ?_ + (by reduce_mod_char; decide) (by norm_num) + · refine PrattCertificate'.out ⟨10, (by reduce_mod_char), ?_⟩ + refine .split [2, 3, 5, 29 ^ 2, 31, 7723, 132896956044521568488119, + 255515944373312847190720520512484175977] (fun r hr => ?_) (by norm_num) + simp at hr + rcases hr with hr | hr | hr | hr | hr | hr | hr | hr + all_goals rw [hr] + · exact .prime 2 1 _ (by pratt) (by reduce_mod_char; decide) (by norm_num) + · exact .prime 3 1 _ (by pratt) (by reduce_mod_char; decide) (by norm_num) + · exact .prime 5 1 _ (by pratt) (by reduce_mod_char; decide) (by norm_num) + · exact .prime 29 2 _ (by pratt) (by reduce_mod_char; decide) (by norm_num) + · exact .prime 31 1 _ (by pratt) (by reduce_mod_char; decide) (by norm_num) + · exact .prime 7723 1 _ (by pratt) (by reduce_mod_char; decide) (by norm_num) + · exact .prime 132896956044521568488119 1 _ (by pratt) + (by reduce_mod_char; decide) (by norm_num) + · exact .prime 255515944373312847190720520512484175977 1 _ (by pratt) + (by reduce_mod_char; decide) (by norm_num) + +/-- Registers the primality of the base-field modulus for typeclass inference. -/ +instance card_prime_fact : Fact (Nat.Prime CARD) := ⟨card_is_prime⟩ + +/-- The canonical secp256k1 base field is a field. -/ +instance field : _root_.Field Field := ZMod.instField CARD + +end Secp256k1.Base.Basic diff --git a/CompPoly/Fields/Secp256k1/Scalar/Basic.lean b/CompPoly/Fields/Secp256k1/Scalar/Basic.lean new file mode 100644 index 00000000..7132da3d --- /dev/null +++ b/CompPoly/Fields/Secp256k1/Scalar/Basic.lean @@ -0,0 +1,61 @@ +/- +Copyright (c) 2024 ArkLib Contributors. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Varun Thakore +-/ + +import CompPoly.Fields.PrattCertificate + +/-! + # secp256k1 Scalar Field + + Canonical scalar field, its cardinality, and its primality certificate. + + Represented as `n` in https://www.secg.org/sec2-v2.pdf. +-/ + +namespace Secp256k1.Scalar.Basic + +/-- The prime order of the secp256k1 scalar field. -/ +@[reducible] +def CARD : Nat := 0xfffffffffffffffffffffffffffffffebaaedce6af48a03bbfd25e8cd0364141 + +/-- The canonical secp256k1 scalar field. -/ +abbrev Field := ZMod CARD + +/-- The secp256k1 scalar-field order is prime. -/ +theorem card_is_prime : Nat.Prime CARD := by + unfold CARD + refine PrattCertificate'.out (p := CARD) ⟨7, (by reduce_mod_char), ?_⟩ + refine .split [2 ^ 6, 3, 149, 631, 107361793816595537, 174723607534414371449, + 341948486974166000522343609283189] (fun r hr => ?_) (by norm_num) + simp at hr + rcases hr with hr | hr | hr | hr | hr | hr | hr + all_goals rw [hr] + · exact .prime 2 6 _ (by pratt) (by reduce_mod_char; decide) (by norm_num) + · exact .prime 3 1 _ (by pratt) (by reduce_mod_char; decide) (by norm_num) + · exact .prime 149 1 _ (by pratt) (by reduce_mod_char; decide) (by norm_num) + · exact .prime 631 1 _ (by pratt) (by reduce_mod_char; decide) (by norm_num) + · exact .prime 107361793816595537 1 _ (by pratt) (by reduce_mod_char; decide) (by norm_num) + · exact .prime 174723607534414371449 1 _ (by pratt) (by reduce_mod_char; decide) (by norm_num) + · refine .prime 341948486974166000522343609283189 1 _ ?_ (by reduce_mod_char; decide) + (by norm_num) + · refine PrattCertificate'.out ⟨2, (by reduce_mod_char), ?_⟩ + refine .split [2 ^ 2, 3 ^ 3, 109, 29047611873442575647497758179] (fun r hr => ?_) + (by norm_num) + simp at hr + rcases hr with hr | hr | hr | hr + all_goals rw [hr] + · exact .prime 2 2 _ (by pratt) (by reduce_mod_char; decide) (by norm_num) + · exact .prime 3 3 _ (by pratt) (by reduce_mod_char; decide) (by norm_num) + · exact .prime 109 1 _ (by pratt) (by reduce_mod_char; decide) (by norm_num) + · exact .prime 29047611873442575647497758179 1 _ (by pratt) (by reduce_mod_char; decide) + (by norm_num) + +/-- Registers the primality of the scalar-field modulus for typeclass inference. -/ +instance card_prime_fact : Fact (Nat.Prime CARD) := ⟨card_is_prime⟩ + +/-- The canonical secp256k1 scalar field is a field. -/ +instance field : _root_.Field Field := ZMod.instField CARD + +end Secp256k1.Scalar.Basic diff --git a/CompPoly/Fields/Secp256k1/Scalar/Fast.lean b/CompPoly/Fields/Secp256k1/Scalar/Fast.lean new file mode 100644 index 00000000..4e596aec --- /dev/null +++ b/CompPoly/Fields/Secp256k1/Scalar/Fast.lean @@ -0,0 +1,17 @@ +/- +Copyright (c) 2026 CompPoly Contributors. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Varun Thakore +-/ + +import CompPoly.Fields.Secp256k1.Scalar.Fast.Field + +/-! +# Fast secp256k1 Scalar Field + +Public entry point for the 4×UInt64 secp256k1 scalar implementation. + +Importing this module provides the fast `Secp256k1.Scalar.Fast.Field`, +conversion functions, verified arithmetic operations, correctness theorems relating it +to the canonical `Secp256k1.Scalar.Basic.Field`, and the ring equivalence. +-/ diff --git a/CompPoly/Fields/Secp256k1/Scalar/Fast/Arithmetic.lean b/CompPoly/Fields/Secp256k1/Scalar/Fast/Arithmetic.lean new file mode 100644 index 00000000..051542ac --- /dev/null +++ b/CompPoly/Fields/Secp256k1/Scalar/Fast/Arithmetic.lean @@ -0,0 +1,174 @@ +/- +Copyright (c) 2024 ArkLib Contributors. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Varun Thakore +-/ + +import CompPoly.Fields.Secp256k1.Scalar.Fast.Reduction + +/-! + # Arithmetic API for fast secp256k1 scalar field elements +-/ + +namespace Secp256k1.Scalar.Fast + +/-- The fast secp256k1 scalar carrier, represented by canonical 4×UInt64 limbs. -/ +abbrev Field : Type := { x : Repr // x.toNat < Secp256k1.Scalar.Basic.CARD } + +/-- Fast scalar equality is decidable by comparing its four limbs. -/ +instance : DecidableEq Field := inferInstance + +/-- Raw canonical limbs backing a fast scalar element. -/ +@[inline] def raw (x : Field) : Repr := x.val + +/-- Zero. -/ +@[inline] def zero : Field := ⟨Repr.zero, Repr.zero_lt⟩ + +/-- One. -/ +@[inline] def one : Field := ⟨Repr.one, Repr.one_lt⟩ + +/-- Construct from a natural number by reducing modulo the scalar order. -/ +@[inline] def ofNat (n : Nat) : Field := + ⟨Repr.ofNat n, Repr.ofNat_lt n⟩ + +/-- Convert from canonical `ZMod` scalar field to fast representation. -/ +@[inline] def ofField (x : Secp256k1.Scalar.Basic.Field) : Field := + ofNat x.val + +/-- Convert an integer into fast scalar representation. -/ +@[inline] def ofInt (z : Int) : Field := + ofField (z : Secp256k1.Scalar.Basic.Field) + +/-- Convert a fast scalar to its canonical natural representative. -/ +@[inline] def toNat (x : Field) : Nat := + x.val.toNat + +/-- Convert a fast scalar to the canonical `ZMod` scalar field. -/ +@[inline] def toField (x : Field) : Secp256k1.Scalar.Basic.Field := + (toNat x : Secp256k1.Scalar.Basic.Field) + +/-- Build a fast scalar from four limbs and a proof that they are canonical. -/ +@[inline] private def ofCanonicalLimbs (r : Limbs4) + (h : (Repr.ofLimbs r.1 r.2.1 r.2.2.1 r.2.2.2).toNat < + Secp256k1.Scalar.Basic.CARD) : Field := + ⟨Repr.ofLimbs r.1 r.2.1 r.2.2.1 r.2.2.2, h⟩ + +/-- Fast scalar addition. -/ +@[inline] def add (x y : Field) : Field := + ofCanonicalLimbs + (Reduction.addModRaw + x.val.d0 x.val.d1 x.val.d2 x.val.d3 y.val.d0 y.val.d1 y.val.d2 y.val.d3) + (Reduction.addModRaw_lt + x.val.d0 x.val.d1 x.val.d2 x.val.d3 y.val.d0 y.val.d1 y.val.d2 y.val.d3 + x.property y.property) + +/-- Fast scalar negation. -/ +@[inline] def neg (x : Field) : Field := + ofCanonicalLimbs + (Reduction.negRaw x.val.d0 x.val.d1 x.val.d2 x.val.d3) + (Reduction.negRaw_lt x.val.d0 x.val.d1 x.val.d2 x.val.d3 x.property) + +/-- Fast scalar subtraction. -/ +@[inline] def sub (x y : Field) : Field := + ofCanonicalLimbs + (Reduction.subModRaw + x.val.d0 x.val.d1 x.val.d2 x.val.d3 y.val.d0 y.val.d1 y.val.d2 y.val.d3) + (Reduction.subModRaw_lt + x.val.d0 x.val.d1 x.val.d2 x.val.d3 y.val.d0 y.val.d1 y.val.d2 y.val.d3 + x.property y.property) + +/-- Fast scalar multiplication. -/ +@[inline] def mul (x y : Field) : Field := + ofCanonicalLimbs + (Reduction.mulRaw + x.val.d0 x.val.d1 x.val.d2 x.val.d3 y.val.d0 y.val.d1 y.val.d2 y.val.d3) + (Reduction.mulRaw_lt + x.val.d0 x.val.d1 x.val.d2 x.val.d3 y.val.d0 y.val.d1 y.val.d2 y.val.d3) + +/-- Fast scalar squaring. -/ +@[inline] def square (x : Field) : Field := + ofCanonicalLimbs + (Reduction.squareRaw x.val.d0 x.val.d1 x.val.d2 x.val.d3) + (Reduction.squareRaw_lt x.val.d0 x.val.d1 x.val.d2 x.val.d3) + +/-- Exponentiation over the fast representation using binary exponentiation. -/ +@[inline] def pow (x : Field) (n : Nat) : Field := + @npowBinRec Field ⟨one⟩ ⟨mul⟩ n x + +/-- Scalar inversion by Fermat exponentiation over the UInt64 limb kernel. -/ +@[noinline] def invFermat (x : Field) : Field := + pow x (Secp256k1.Scalar.Basic.CARD - 2) + +/-- Default scalar inversion uses Fermat exponentiation. -/ +@[inline] def inv (x : Field) : Field := + invFermat x + +/-- Fast scalar division through inversion and multiplication. -/ +@[inline] def div (x y : Field) : Field := + mul x (inv y) + +/-- Fast scalar zero. -/ +instance instZeroField : Zero Field := ⟨zero⟩ + +/-- Fast scalar one. -/ +instance instOneField : One Field := ⟨one⟩ + +/-- Fast scalar addition. -/ +instance instAddField : Add Field := ⟨add⟩ + +/-- Fast scalar negation. -/ +instance instNegField : Neg Field := ⟨neg⟩ + +/-- Fast scalar subtraction. -/ +instance instSubField : Sub Field := ⟨sub⟩ + +/-- Fast scalar multiplication. -/ +instance instMulField : Mul Field := ⟨mul⟩ + +/-- Fast scalar inversion. -/ +instance instInvField : Inv Field := ⟨inv⟩ + +/-- Fast scalar division. -/ +instance instDivField : Div Field := ⟨div⟩ + +/-- Natural-number casts into the fast scalar field. -/ +instance instNatCastField : NatCast Field := ⟨ofNat⟩ + +/-- Integer casts into the fast scalar field. -/ +instance instIntCastField : IntCast Field := ⟨ofInt⟩ + +/-- Natural scalar multiplication is multiplication by the corresponding fast natural cast. -/ +instance instNatSMulField : SMul Nat Field where + smul n x := (n : Field) * x + +/-- Integer scalar multiplication is multiplication by the corresponding fast integer cast. -/ +instance instIntSMulField : SMul Int Field where + smul n x := (n : Field) * x + +/-- Natural powers use fast binary exponentiation. -/ +instance instPowFieldNat : Pow Field Nat := ⟨pow⟩ + +/-- Integer powers use fast natural powers and inversion. -/ +instance instPowFieldInt : Pow Field Int where + pow x n := + match n with + | Int.ofNat k => pow x k + | Int.negSucc k => pow (inv x) (k + 1) + +/-- Interpret nonnegative rational casts through the canonical scalar field. -/ +instance instNNRatCastField : NNRatCast Field where + nnratCast q := ofField (q : Secp256k1.Scalar.Basic.Field) + +/-- Interpret rational casts through the canonical scalar field. -/ +instance instRatCastField : RatCast Field where + ratCast q := ofField (q : Secp256k1.Scalar.Basic.Field) + +/-- Transport nonnegative rational scalar multiplication through the canonical scalar field. -/ +instance instNNRatSMulField : SMul ℚ≥0 Field where + smul q x := ofField (q • toField x) + +/-- Transport rational scalar multiplication through the canonical scalar field. -/ +instance instRatSMulField : SMul ℚ Field where + smul q x := ofField (q • toField x) + +end Secp256k1.Scalar.Fast diff --git a/CompPoly/Fields/Secp256k1/Scalar/Fast/Field.lean b/CompPoly/Fields/Secp256k1/Scalar/Fast/Field.lean new file mode 100644 index 00000000..f1d47bdf --- /dev/null +++ b/CompPoly/Fields/Secp256k1/Scalar/Fast/Field.lean @@ -0,0 +1,68 @@ +/- +Copyright (c) 2026 CompPoly Contributors. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Varun Thakore +-/ + +import CompPoly.Fields.Basic +import CompPoly.Fields.Secp256k1.Scalar.Fast.Theorems +import Mathlib.Algebra.Field.TransferInstance + +/-! +# Field Structure for Fast secp256k1 Scalar Arithmetic + +This module transfers the canonical secp256k1 scalar-field structure to the +fast four-limb representation and exposes the corresponding ring equivalence. +-/ + +namespace Secp256k1.Scalar.Fast + +/-- Ring equivalence between fast 4×`UInt64` scalars and canonical secp256k1 scalars. -/ +def ringEquiv : Field ≃+* Secp256k1.Scalar.Basic.Field where + toFun := toField + invFun := ofField + left_inv := ofField_toField + right_inv := toField_ofField + map_add' := toField_add + map_mul' := toField_mul + +/-- Applying `ringEquiv` interprets a fast scalar in the canonical scalar field. -/ +@[simp] +theorem ringEquiv_apply (x : Field) : ringEquiv x = toField x := rfl + +/-- Applying the inverse equivalence converts a canonical scalar to fast representation. -/ +@[simp] +theorem ringEquiv_symm_apply (x : Secp256k1.Scalar.Basic.Field) : + ringEquiv.symm x = ofField x := rfl + +/-- Field instance transferred from the canonical scalar field through `toField`. -/ +instance (priority := low) instField : _root_.Field Field := + toField_injective.field toField + toField_zero + toField_one + toField_add + toField_mul + toField_neg + toField_sub + toField_inv + toField_div + toField_nsmul + toField_zsmul + toField_nnqsmul + toField_qsmul + toField_npow + toField_zpow + toField_natCast + toField_intCast + toField_nnratCast + toField_ratCast + +/-- Fast secp256k1 scalar arithmetic is a non-binary field. -/ +instance (priority := low) instNonBinaryField : NonBinaryField Field where + char_neq_2 := by + intro h + have hv : (2 : Secp256k1.Scalar.Basic.Field) = 0 := by + simpa using congrArg toField h + exact (by decide : (2 : Secp256k1.Scalar.Basic.Field) ≠ 0) hv + +end Secp256k1.Scalar.Fast diff --git a/CompPoly/Fields/Secp256k1/Scalar/Fast/Internal.lean b/CompPoly/Fields/Secp256k1/Scalar/Fast/Internal.lean new file mode 100644 index 00000000..b4535d5d --- /dev/null +++ b/CompPoly/Fields/Secp256k1/Scalar/Fast/Internal.lean @@ -0,0 +1,1039 @@ +/- +Copyright (c) 2024 ArkLib Contributors. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Varun Thakore +-/ + +import CompPoly.Fields.Secp256k1.Scalar.Basic + +/-! + # Internal definitions for fast secp256k1 scalar arithmetic + + Low-level constants, the 4-limb representation, and raw limb helpers. +-/ + +namespace Secp256k1.Scalar.Fast + +/-- secp256k1 scalar order, limb 0. -/ +@[inline] def N_0 : UInt64 := 0xBFD25E8CD0364141 + +/-- secp256k1 scalar order, limb 1. -/ +@[inline] def N_1 : UInt64 := 0xBAAEDCE6AF48A03B + +/-- secp256k1 scalar order, limb 2. -/ +@[inline] def N_2 : UInt64 := 0xFFFFFFFFFFFFFFFE + +/-- secp256k1 scalar order, limb 3. -/ +@[inline] def N_3 : UInt64 := 0xFFFFFFFFFFFFFFFF + +/-- Limb 0 of `2^256 - n`. -/ +@[inline] def N_C_0 : UInt64 := 0x402DA1732FC9BEBF + +/-- Limb 1 of `2^256 - n`. -/ +@[inline] def N_C_1 : UInt64 := 0x4551231950B75FC4 + +/-- Limb 2 of `2^256 - n`. -/ +@[inline] def N_C_2 : UInt64 := 0x0000000000000001 + +/-- Radix weight of the second 64-bit limb. -/ +@[inline] def TWO64 : Nat := 0x10000000000000000 + +/-- Radix weight of the third 64-bit limb. -/ +@[inline] def TWO128 : Nat := 0x100000000000000000000000000000000 + +/-- Radix weight of the fourth 64-bit limb. -/ +@[inline] def TWO192 : Nat := 0x1000000000000000000000000000000000000000000000000 + +/-- Raw 4×64-bit secp256k1 scalar representation, little-endian. -/ +structure Repr where + d0 : UInt64 + d1 : UInt64 + d2 : UInt64 + d3 : UInt64 +deriving BEq, Inhabited, DecidableEq + +/-- Four little-endian 64-bit limbs. Used as the raw 256-bit kernel interface. -/ +abbrev Limbs4 := UInt64 × UInt64 × UInt64 × UInt64 + +/-- Four little-endian limbs and a carry or borrow word. -/ +abbrev Limbs4Carry := UInt64 × UInt64 × UInt64 × UInt64 × UInt64 + +/-- Eight little-endian 64-bit limbs. Used for raw 512-bit products. -/ +abbrev Limbs8 := UInt64 × UInt64 × UInt64 × UInt64 × UInt64 × UInt64 × UInt64 × UInt64 + +/-- Three accumulator words used by libsecp256k1's scalar multiplication macros. -/ +abbrev AccLimbs := UInt64 × UInt64 × UInt64 + +namespace Repr + +/-- Zero as raw limbs. -/ +@[inline] def zero : Repr := ⟨0, 0, 0, 0⟩ + +/-- One as raw limbs. -/ +@[inline] def one : Repr := ⟨1, 0, 0, 0⟩ + +/-- The scalar modulus as raw limbs. This is not canonical as a field element. -/ +@[inline] def modulus : Repr := ⟨N_0, N_1, N_2, N_3⟩ + +/-- Construct raw limbs. -/ +@[inline] def ofLimbs (d0 d1 d2 d3 : UInt64) : Repr := ⟨d0, d1, d2, d3⟩ + +/-- Convert raw little-endian limbs to a natural number. -/ +@[inline] def toNat (x : Repr) : Nat := + x.d0.toNat + x.d1.toNat * TWO64 + x.d2.toNat * TWO128 + x.d3.toNat * TWO192 + +/-- The four-limb natural interpretation uniquely determines a representation. -/ +theorem toNat_injective : Function.Injective toNat := by + intro a b h + have ha0 := a.d0.toNat_lt_size + have ha1 := a.d1.toNat_lt_size + have ha2 := a.d2.toNat_lt_size + have ha3 := a.d3.toNat_lt_size + have hb0 := b.d0.toNat_lt_size + have hb1 := b.d1.toNat_lt_size + have hb2 := b.d2.toNat_lt_size + have hb3 := b.d3.toNat_lt_size + norm_num [UInt64.size] at ha0 ha1 ha2 ha3 hb0 hb1 hb2 hb3 + unfold toNat TWO64 TWO128 TWO192 at h + have h0 : a.d0.toNat = b.d0.toNat := by omega + have h1 : a.d1.toNat = b.d1.toNat := by omega + have h2 : a.d2.toNat = b.d2.toNat := by omega + have h3 : a.d3.toNat = b.d3.toNat := by omega + cases a + cases b + simp only [mk.injEq] + exact ⟨UInt64.toNat.inj h0, UInt64.toNat.inj h1, + UInt64.toNat.inj h2, UInt64.toNat.inj h3⟩ + +/-- Reference raw constructor: reduce a natural number modulo the scalar order. -/ +def ofNat (n : Nat) : Repr := + let r := n % Secp256k1.Scalar.Basic.CARD + let d0 := (r % TWO64).toUInt64 + let r := r / TWO64 + let d1 := (r % TWO64).toUInt64 + let r := r / TWO64 + let d2 := (r % TWO64).toUInt64 + let r := r / TWO64 + let d3 := (r % TWO64).toUInt64 + ⟨d0, d1, d2, d3⟩ + +/-- Reconstructing `ofNat`'s four limbs yields the input reduced modulo the scalar order. -/ +@[simp] theorem toNat_ofNat (n : Nat) : + (ofNat n).toNat = n % Secp256k1.Scalar.Basic.CARD := by + unfold ofNat toNat TWO64 TWO128 TWO192 + simp + have hCard : 0 < Secp256k1.Scalar.Basic.CARD := by + norm_num [Secp256k1.Scalar.Basic.CARD] + have hr : n % Secp256k1.Scalar.Basic.CARD < 2 ^ 256 := by + apply Nat.lt_trans (Nat.mod_lt n hCard) + norm_num [Secp256k1.Scalar.Basic.CARD] + have hq : n % Secp256k1.Scalar.Basic.CARD / 18446744073709551616 / + 18446744073709551616 / 18446744073709551616 / 18446744073709551616 = 0 := by + omega + have h0 := Nat.mod_add_div (n % Secp256k1.Scalar.Basic.CARD) 18446744073709551616 + have h1 := Nat.mod_add_div (n % Secp256k1.Scalar.Basic.CARD / 18446744073709551616) + 18446744073709551616 + have h2 := Nat.mod_add_div + (n % Secp256k1.Scalar.Basic.CARD / 18446744073709551616 / 18446744073709551616) + 18446744073709551616 + have h3 := Nat.mod_add_div + (n % Secp256k1.Scalar.Basic.CARD / 18446744073709551616 / 18446744073709551616 / + 18446744073709551616) + 18446744073709551616 + omega + +/-- `ofNat` always produces a canonical scalar representative. -/ +theorem ofNat_lt (n : Nat) : + (ofNat n).toNat < Secp256k1.Scalar.Basic.CARD := by + rw [toNat_ofNat] + exact Nat.mod_lt _ (by norm_num [Secp256k1.Scalar.Basic.CARD]) + +/-- `ofNat` represents the input natural number in the canonical scalar field. -/ +theorem ofNat_cast (n : Nat) : + ((ofNat n).toNat : Secp256k1.Scalar.Basic.Field) = + (n : Secp256k1.Scalar.Basic.Field) := by + rw [toNat_ofNat] + simp + +/-- Reducing the natural interpretation of a canonical representation is identity. -/ +theorem ofNat_toNat (x : Repr) (hx : x.toNat < Secp256k1.Scalar.Basic.CARD) : + ofNat x.toNat = x := by + apply toNat_injective + rw [toNat_ofNat, Nat.mod_eq_of_lt hx] + +/-- The raw zero representation is canonical. -/ +theorem zero_lt : zero.toNat < Secp256k1.Scalar.Basic.CARD := by + change 0 < Secp256k1.Scalar.Basic.CARD + norm_num [Secp256k1.Scalar.Basic.CARD] + +/-- The raw one representation is canonical. -/ +theorem one_lt : one.toNat < Secp256k1.Scalar.Basic.CARD := by + change 1 < Secp256k1.Scalar.Basic.CARD + norm_num [Secp256k1.Scalar.Basic.CARD] + +/-- Every four-limb representation denotes a number below `2^256`. -/ +theorem toNat_lt_two256 (x : Repr) : x.toNat < 2 ^ 256 := by + have h0 := x.d0.toNat_lt_size + have h1 := x.d1.toNat_lt_size + have h2 := x.d2.toNat_lt_size + have h3 := x.d3.toNat_lt_size + norm_num [UInt64.size] at h0 h1 h2 h3 + unfold toNat TWO64 TWO128 TWO192 + norm_num + omega + +/-- The raw modulus limbs reconstruct the secp256k1 scalar order. -/ +@[simp] theorem modulus_toNat : modulus.toNat = Secp256k1.Scalar.Basic.CARD := by + norm_num [modulus, toNat, N_0, N_1, N_2, N_3, TWO64, TWO128, TWO192, + UInt64.toNat_ofNat, + Secp256k1.Scalar.Basic.CARD] + +/-- The complement limbs reconstruct `2^256` minus the scalar order. -/ +theorem complement_toNat : + (ofLimbs N_C_0 N_C_1 N_C_2 0).toNat = + 2 ^ 256 - Secp256k1.Scalar.Basic.CARD := by + norm_num [ofLimbs, toNat, N_C_0, N_C_1, N_C_2, TWO64, TWO128, TWO192, + UInt64.toNat_ofNat, + Secp256k1.Scalar.Basic.CARD] + +/-- True iff all limbs are zero. -/ +@[inline] def isZero (x : Repr) : Bool := + (x.d0 ||| x.d1 ||| x.d2 ||| x.d3) == 0 + +/-- True iff this scalar is one. -/ +@[inline] def isOne (x : Repr) : Bool := + ((x.d0 ^^^ 1) ||| x.d1 ||| x.d2 ||| x.d3) == 0 + +/-- True iff this scalar is even. -/ +@[inline] def isEven (x : Repr) : Bool := + x.d0 &&& 1 == 0 + +/-- `x >= n`, matching libsecp256k1's scalar overflow check. -/ +@[inline] def checkOverflow (x : Repr) : Bool := + if x.d3 < N_3 then false + else if x.d2 < N_2 then false + else if x.d2 > N_2 then true + else if x.d1 < N_1 then false + else if x.d1 > N_1 then true + else x.d0 >= N_0 + +end Repr + +/-- `d0..d3 >= n`, matching libsecp256k1's scalar overflow check. -/ +@[inline] def checkOverflowRaw (d0 d1 d2 d3 : UInt64) : Bool := + if d3 < N_3 then false + else if d2 < N_2 then false + else if d2 > N_2 then true + else if d1 < N_1 then false + else if d1 > N_1 then true + else d0 >= N_0 + +/-- The limbwise overflow check is equivalent to comparison with the scalar order. -/ +theorem checkOverflowRaw_eq_decide (d0 d1 d2 d3 : UInt64) : + checkOverflowRaw d0 d1 d2 d3 = + decide ((Repr.ofLimbs d0 d1 d2 d3).toNat >= Secp256k1.Scalar.Basic.CARD) := by + unfold checkOverflowRaw Repr.toNat Repr.ofLimbs N_0 N_1 N_2 N_3 TWO64 TWO128 TWO192 + have h0 := d0.toNat_lt_size + have h1 := d1.toNat_lt_size + have h2 := d2.toNat_lt_size + have h3 := d3.toNat_lt_size + norm_num [UInt64.size] at h0 h1 h2 h3 + simp only [UInt64.lt_iff_toNat_lt, UInt64.le_iff_toNat_le] + simp only [UInt64.toNat_ofNat] + split <;> rename_i h3cmp + · norm_num [Secp256k1.Scalar.Basic.CARD] at * + omega + · split <;> rename_i h2lo + · norm_num [Secp256k1.Scalar.Basic.CARD] at * + omega + · split <;> rename_i h2hi + · norm_num [Secp256k1.Scalar.Basic.CARD] at * + omega + · split <;> rename_i h1lo + · norm_num [Secp256k1.Scalar.Basic.CARD] at * + omega + · split <;> rename_i h1hi + · norm_num [Secp256k1.Scalar.Basic.CARD] at * + omega + · norm_num [Secp256k1.Scalar.Basic.CARD] at * + omega + +/-- True iff all four raw limbs are zero. -/ +@[inline] def isZeroRaw (d0 d1 d2 d3 : UInt64) : Bool := + (d0 ||| d1 ||| d2 ||| d3) == 0 + + +/-- Add two limbs plus an incoming carry bit. -/ +@[inline] def addCarry (x y carry : UInt64) : UInt64 × UInt64 := + let y' := y + carry + let c0 : UInt64 := if y' < y then 1 else 0 + let s := x + y' + let c1 : UInt64 := if s < x then 1 else 0 + (s, c0 + c1) + +/-- Exact value equation for one wrapped 64-bit addition and its overflow flag. -/ +private theorem addWord_value (a b : UInt64) : + (a + b).toNat + 2 ^ 64 * (if a + b < a then 1 else 0) = a.toNat + b.toNat := by + have ha := a.toNat_lt_size + have hb := b.toNat_lt_size + norm_num [UInt64.size] at ha hb + have hmod := Nat.mod_add_div (a.toNat + b.toNat) (2 ^ 64) + by_cases h : a + b < a + · have h' := h + rw [UInt64.lt_iff_toNat_lt, UInt64.toNat_add] at h' + rw [if_pos h, UInt64.toNat_add] + omega + · have h' := h + rw [UInt64.lt_iff_toNat_lt, UInt64.toNat_add] at h' + rw [if_neg h, UInt64.toNat_add] + omega + +/-- Addition value equation with overflow compared against the right operand. -/ +private theorem addWordRight_value (a b : UInt64) : + (a + b).toNat + 2 ^ 64 * (if a + b < b then 1 else 0) = a.toNat + b.toNat := by + have hab : a + b = b + a := by + apply UInt64.toNat.inj + simp only [UInt64.toNat_add, Nat.add_comm] + rw [hab] + simpa only [Nat.add_comm] using addWord_value b a + +/-- Addition value equation with its overflow flag stored as a machine word. -/ +private theorem addWordRightCarry_value (a b : UInt64) : + let carry : UInt64 := if a + b < b then 1 else 0 + (a + b).toNat + 2 ^ 64 * carry.toNat = a.toNat + b.toNat := by + by_cases h : a + b < b + · simpa [h] using addWordRight_value a b + · simpa [h] using addWordRight_value a b + +/-- Exact value equation for one wrapped 64-bit subtraction and its borrow flag. -/ +private theorem subWord_value (a b : UInt64) : + (a - b).toNat + b.toNat = a.toNat + 2 ^ 64 * (if a < b then 1 else 0) := by + have ha := a.toNat_lt_size + have hb := b.toNat_lt_size + norm_num [UInt64.size] at ha hb + have hmod := Nat.mod_add_div (2 ^ 64 - b.toNat + a.toNat) (2 ^ 64) + by_cases h : a < b + · have h' := h + rw [UInt64.lt_iff_toNat_lt] at h' + rw [if_pos h, UInt64.toNat_sub] + omega + · have h' := h + rw [UInt64.lt_iff_toNat_lt] at h' + rw [if_neg h, UInt64.toNat_sub] + omega + +/-- The value equation for `addCarry`. -/ +theorem addCarry_value (x y carry : UInt64) (_hcarry : carry.toNat ≤ 1) : + let r := addCarry x y carry + r.1.toNat + TWO64 * r.2.toNat = x.toNat + y.toNat + carry.toNat := by + let y' := y + carry + let c0 : UInt64 := if y' < y then 1 else 0 + let s := x + y' + let c1 : UInt64 := if s < x then 1 else 0 + change s.toNat + TWO64 * (c0 + c1).toNat = x.toNat + y.toNat + carry.toNat + have hc0val : c0.toNat = if y' < y then 1 else 0 := by + simp only [c0] + split <;> rfl + have hc1val : c1.toNat = if s < x then 1 else 0 := by + simp only [c1] + split <;> rfl + have hy : y'.toNat + TWO64 * c0.toNat = y.toNat + carry.toNat := by + rw [hc0val] + simpa [y', TWO64] using addWord_value y carry + have hs : s.toNat + TWO64 * c1.toNat = x.toNat + y'.toNat := by + rw [hc1val] + simpa [s, TWO64] using addWord_value x y' + have hc0 : c0.toNat ≤ 1 := by + rw [hc0val] + split <;> norm_num + have hc1 : c1.toNat ≤ 1 := by + rw [hc1val] + split <;> norm_num + have hsum : c0.toNat + c1.toNat < TWO64 := by + unfold TWO64 + omega + have hcarrySum : (c0 + c1).toNat = c0.toNat + c1.toNat := by + rw [UInt64.toNat_add] + exact Nat.mod_eq_of_lt hsum + rw [hcarrySum] + unfold TWO64 at hy hs ⊢ + omega + +/-- The outgoing word from `addCarry` is a bit. -/ +theorem addCarry_carry_le_one (x y carry : UInt64) (hcarry : carry.toNat ≤ 1) : + (addCarry x y carry).2.toNat ≤ 1 := by + have hx := x.toNat_lt_size + have hy := y.toNat_lt_size + norm_num [UInt64.size] at hx hy + have hvalue := addCarry_value x y carry hcarry + unfold TWO64 at hvalue + omega + +/-- `addCarry` represents exact addition split into a low word and one carry bit. -/ +theorem addCarry_spec (x y carry : UInt64) (hcarry : carry.toNat ≤ 1) : + let r := addCarry x y carry + r.1.toNat + TWO64 * r.2.toNat = x.toNat + y.toNat + carry.toNat ∧ + r.2.toNat ≤ 1 := by + exact ⟨addCarry_value x y carry hcarry, addCarry_carry_le_one x y carry hcarry⟩ + +/-- Subtract two limbs plus an incoming borrow bit. -/ +@[inline] def subBorrow (x y borrow : UInt64) : UInt64 × UInt64 := + let y' := y + borrow + let b0 : UInt64 := if y' < y then 1 else 0 + let s := x - y' + let b1 : UInt64 := if x < y' then 1 else 0 + (s, b0 + b1) + +/-- The value equation for `subBorrow`. -/ +theorem subBorrow_value (x y borrow : UInt64) (_hborrow : borrow.toNat ≤ 1) : + let r := subBorrow x y borrow + r.1.toNat + y.toNat + borrow.toNat = x.toNat + TWO64 * r.2.toNat := by + let y' := y + borrow + let b0 : UInt64 := if y' < y then 1 else 0 + let s := x - y' + let b1 : UInt64 := if x < y' then 1 else 0 + change s.toNat + y.toNat + borrow.toNat = x.toNat + TWO64 * (b0 + b1).toNat + have hb0val : b0.toNat = if y' < y then 1 else 0 := by + simp only [b0] + split <;> rfl + have hb1val : b1.toNat = if x < y' then 1 else 0 := by + simp only [b1] + split <;> rfl + have hy : y'.toNat + TWO64 * b0.toNat = y.toNat + borrow.toNat := by + rw [hb0val] + simpa [y', TWO64] using addWord_value y borrow + have hs : s.toNat + y'.toNat = x.toNat + TWO64 * b1.toNat := by + rw [hb1val] + simpa [s, TWO64] using subWord_value x y' + have hb0 : b0.toNat ≤ 1 := by + rw [hb0val] + split <;> norm_num + have hb1 : b1.toNat ≤ 1 := by + rw [hb1val] + split <;> norm_num + have hsum : b0.toNat + b1.toNat < TWO64 := by + unfold TWO64 + omega + have hborrowSum : (b0 + b1).toNat = b0.toNat + b1.toNat := by + rw [UInt64.toNat_add] + exact Nat.mod_eq_of_lt hsum + rw [hborrowSum] + unfold TWO64 at hy hs ⊢ + omega + +/-- The outgoing word from `subBorrow` is a bit. -/ +theorem subBorrow_borrow_le_one (x y borrow : UInt64) (hborrow : borrow.toNat ≤ 1) : + (subBorrow x y borrow).2.toNat ≤ 1 := by + have hs := (subBorrow x y borrow).1.toNat_lt_size + have hy := y.toNat_lt_size + have hx := x.toNat_lt_size + norm_num [UInt64.size] at hs hy hx + have hvalue := subBorrow_value x y borrow hborrow + unfold TWO64 at hvalue + omega + +/-- `subBorrow` represents exact subtraction with one outgoing borrow bit. -/ +theorem subBorrow_spec (x y borrow : UInt64) (hborrow : borrow.toNat ≤ 1) : + let r := subBorrow x y borrow + r.1.toNat + y.toNat + borrow.toNat = x.toNat + TWO64 * r.2.toNat ∧ + r.2.toNat ≤ 1 := by + exact ⟨subBorrow_value x y borrow hborrow, + subBorrow_borrow_le_one x y borrow hborrow⟩ + +/-- Append one radix-`2^64` limb to an exact addition identity. -/ +private theorem appendAddValue + (p c a lo c' x y w : Nat) + (hp : p + w * c = a) + (h : lo + 18446744073709551616 * c' = x + y + c) : + p + w * lo + (w * 18446744073709551616) * c' = a + w * (x + y) := by + have hpz : (p : Int) + w * c = a := by exact_mod_cast hp + have hz : (lo : Int) + 18446744073709551616 * c' = x + y + c := by + exact_mod_cast h + apply Nat.cast_injective (R := Int) + push_cast + calc + (p : Int) + w * lo + w * 18446744073709551616 * c' = + p + w * (lo + 18446744073709551616 * c') := by ring + _ = p + w * (x + y + c) := by rw [hz] + _ = (p + w * c) + w * (x + y) := by ring + _ = a + w * (x + y) := by rw [hpz] + +/-- Append one radix-`2^64` limb to an exact subtraction identity. -/ +private theorem appendSubValue + (r b a borrow lo y x nextBorrow w : Nat) + (hp : r + b = a + w * borrow) + (h : lo + y + borrow = x + 18446744073709551616 * nextBorrow) : + r + w * lo + (b + w * y) = + a + w * x + (w * 18446744073709551616) * nextBorrow := by + have hpz : (r : Int) + b = a + w * borrow := by exact_mod_cast hp + have hz : (lo : Int) + y + borrow = x + 18446744073709551616 * nextBorrow := by + exact_mod_cast h + apply Nat.cast_injective (R := Int) + push_cast + calc + (r : Int) + w * lo + (b + w * y) = + (r + b) + w * (lo + y) := by ring + _ = (a + w * borrow) + w * (lo + y) := by rw [hpz] + _ = a + w * (lo + y + borrow) := by ring + _ = a + w * (x + 18446744073709551616 * nextBorrow) := by rw [hz] + _ = a + w * x + w * 18446744073709551616 * nextBorrow := by ring + +/-- Low 64 bits of a 64×64 product. -/ +@[inline] def mul64Lo (a b : UInt64) : UInt64 := + a * b + +/-- High 64 bits of a 64×64 product using four 32×32-bit products. + + Every intermediate operation fits in `UInt64`. Together with `mul64Lo`, + this is the pure-Lean counterpart of libsecp256k1's 128-bit multiply. +-/ +@[inline] def mul64Hi (a b : UInt64) : UInt64 := + let mask : UInt64 := 0xffffffff + let a0 := a &&& mask + let a1 := a >>> 32 + let b0 := b &&& mask + let b1 := b >>> 32 + let w0 := a0 * b0 + let t := a1 * b0 + (w0 >>> 32) + let w1 := t &&& mask + let w2 := t >>> 32 + let w1 := w1 + a0 * b1 + a1 * b1 + w2 + (w1 >>> 32) + +/-- Split a word into its low and high 32-bit halves. -/ +private theorem split32 (x : UInt64) : + x.toNat = (x &&& 0xffffffff).toNat + 2 ^ 32 * (x >>> 32).toNat := by + rw [UInt64.toNat_and, UInt64.toNat_shiftRight] + simp only [UInt64.toNat_ofNat] + norm_num [Nat.shiftRight_eq_div_pow] + rw [show 4294967295 = 2 ^ 32 - 1 by norm_num, + Nat.and_two_pow_sub_one_eq_mod] + exact (Nat.mod_add_div x.toNat (2 ^ 32)).symm + +/-- Natural value of the low 32-bit half of a word. -/ +private theorem low32_value (x : UInt64) : + (x &&& 0xffffffff).toNat = x.toNat % 2 ^ 32 := by + rw [UInt64.toNat_and] + simp only [UInt64.toNat_ofNat] + norm_num + rw [show 4294967295 = 2 ^ 32 - 1 by norm_num, + Nat.and_two_pow_sub_one_eq_mod] + +/-- Natural value of the high 32-bit half of a word. -/ +private theorem high32_value (x : UInt64) : + (x >>> 32).toNat = x.toNat / 2 ^ 32 := by + rw [UInt64.toNat_shiftRight] + simp only [UInt64.toNat_ofNat] + norm_num [Nat.shiftRight_eq_div_pow] + +/-- The low and high words reconstruct the exact 64x64-bit product. -/ +theorem mul64_value (a b : UInt64) : + (mul64Lo a b).toNat + 2 ^ 64 * (mul64Hi a b).toNat = a.toNat * b.toNat := by + let mask : UInt64 := 0xffffffff + let a0 := a &&& mask + let a1 := a >>> 32 + let b0 := b &&& mask + let b1 := b >>> 32 + let w0 := a0 * b0 + let t := a1 * b0 + (w0 >>> 32) + let w1 := t &&& mask + let w2 := t >>> 32 + let w1' := w1 + a0 * b1 + change (a * b).toNat + 2 ^ 64 * (a1 * b1 + w2 + (w1' >>> 32)).toNat = _ + have ha := split32 a + have hb := split32 b + change a.toNat = a0.toNat + 2 ^ 32 * a1.toNat at ha + change b.toNat = b0.toNat + 2 ^ 32 * b1.toNat at hb + have ha0 : a0.toNat < 2 ^ 32 := by + change (a &&& 0xffffffff).toNat < _ + rw [low32_value] + exact Nat.mod_lt _ (by norm_num) + have hb0 : b0.toNat < 2 ^ 32 := by + change (b &&& 0xffffffff).toNat < _ + rw [low32_value] + exact Nat.mod_lt _ (by norm_num) + have ha1 : a1.toNat < 2 ^ 32 := by + change (a >>> 32).toNat < _ + rw [high32_value] + have h := a.toNat_lt_size + norm_num [UInt64.size] at h ⊢ + omega + have hb1 : b1.toNat < 2 ^ 32 := by + change (b >>> 32).toNat < _ + rw [high32_value] + have h := b.toNat_lt_size + norm_num [UInt64.size] at h ⊢ + omega + have hw0lt : a0.toNat * b0.toNat < 2 ^ 64 := by nlinarith + have hw0 : w0.toNat = a0.toNat * b0.toNat := by + change (a0 * b0).toNat = _ + rw [UInt64.toNat_mul, Nat.mod_eq_of_lt hw0lt] + have hw0hi : (w0 >>> 32).toNat = w0.toNat / 2 ^ 32 := high32_value w0 + have hw0lo : (w0 &&& mask).toNat = w0.toNat % 2 ^ 32 := by + simpa [mask] using low32_value w0 + have htlt : a1.toNat * b0.toNat + (w0 >>> 32).toNat < 2 ^ 64 := by + have hw0hibound : (w0 >>> 32).toNat < 2 ^ 32 := by + rw [hw0hi] + omega + nlinarith + have ht : t.toNat = a1.toNat * b0.toNat + (w0 >>> 32).toNat := by + change (a1 * b0 + (w0 >>> 32)).toNat = _ + rw [UInt64.toNat_add, UInt64.toNat_mul] + have hp : a1.toNat * b0.toNat < 2 ^ 64 := by nlinarith + rw [Nat.mod_eq_of_lt hp, Nat.mod_eq_of_lt htlt] + have hw1 : w1.toNat = t.toNat % 2 ^ 32 := by + change (t &&& 0xffffffff).toNat = _ + exact low32_value t + have hw2 : w2.toNat = t.toNat / 2 ^ 32 := by + change (t >>> 32).toNat = _ + exact high32_value t + have hw1lt : w1.toNat < 2 ^ 32 := by + rw [hw1] + exact Nat.mod_lt _ (by norm_num) + have hw1'lt : w1.toNat + a0.toNat * b1.toNat < 2 ^ 64 := by nlinarith + have hw1' : w1'.toNat = w1.toNat + a0.toNat * b1.toNat := by + change (w1 + a0 * b1).toNat = _ + rw [UInt64.toNat_add, UInt64.toNat_mul] + have hp : a0.toNat * b1.toNat < 2 ^ 64 := by nlinarith + rw [Nat.mod_eq_of_lt hp, Nat.mod_eq_of_lt hw1'lt] + have hw1'hi : (w1' >>> 32).toNat = w1'.toNat / 2 ^ 32 := high32_value w1' + have hw1'lo : (w1' &&& mask).toNat = w1'.toNat % 2 ^ 32 := by + simpa [mask] using low32_value w1' + have hw2lt : w2.toNat < 2 ^ 32 := by + rw [hw2] + omega + have hw1'hilt : (w1' >>> 32).toNat < 2 ^ 32 := by + rw [hw1'hi] + omega + have hhi1lt : a1.toNat * b1.toNat + w2.toNat < 2 ^ 64 := by nlinarith + have hhi2lt : a1.toNat * b1.toNat + w2.toNat + (w1' >>> 32).toNat < 2 ^ 64 := by + nlinarith + have hhi : (a1 * b1 + w2 + (w1' >>> 32)).toNat = + a1.toNat * b1.toNat + w2.toNat + (w1' >>> 32).toNat := by + rw [UInt64.toNat_add, UInt64.toNat_add, UInt64.toNat_mul] + have hp : a1.toNat * b1.toNat < 2 ^ 64 := by omega + rw [Nat.mod_eq_of_lt hp, Nat.mod_eq_of_lt hhi1lt, + Nat.mod_eq_of_lt hhi2lt] + have htSplit := Nat.mod_add_div t.toNat (2 ^ 32) + have hw1Split := Nat.mod_add_div w1'.toNat (2 ^ 32) + have hw0Split := Nat.mod_add_div w0.toNat (2 ^ 32) + rw [← hw1, ← hw2] at htSplit + rw [← hw1'lo, ← hw1'hi] at hw1Split + rw [← hw0lo, ← hw0hi] at hw0Split + let rem := (w0 &&& mask).toNat + 2 ^ 32 * (w1' &&& mask).toNat + have hremLt : rem < 2 ^ 64 := by + have h0lt : (w0 &&& mask).toNat < 2 ^ 32 := by + rw [hw0lo] + exact Nat.mod_lt _ (by norm_num) + have h1lt : (w1' &&& mask).toNat < 2 ^ 32 := by + rw [hw1'lo] + exact Nat.mod_lt _ (by norm_num) + dsimp [rem] + omega + have hproduct : a.toNat * b.toNat = rem + 2 ^ 64 * + (a1.toNat * b1.toNat + w2.toNat + (w1' >>> 32).toNat) := by + apply Nat.cast_injective (R := Int) + push_cast + have haz : (a.toNat : Int) = a0.toNat + 2 ^ 32 * a1.toNat := by exact_mod_cast ha + have hbz : (b.toNat : Int) = b0.toNat + 2 ^ 32 * b1.toNat := by exact_mod_cast hb + have hw0z : (w0.toNat : Int) = a0.toNat * b0.toNat := by exact_mod_cast hw0 + have htz : (t.toNat : Int) = a1.toNat * b0.toNat + (w0 >>> 32).toNat := by + exact_mod_cast ht + have hw1'z : (w1'.toNat : Int) = w1.toNat + a0.toNat * b1.toNat := by + exact_mod_cast hw1' + have hw0Splitz : ((w0 &&& mask).toNat : Int) + 2 ^ 32 * (w0 >>> 32).toNat = + w0.toNat := by exact_mod_cast hw0Split + have htSplitz : (w1.toNat : Int) + 2 ^ 32 * w2.toNat = t.toNat := by + exact_mod_cast htSplit + have hw1Splitz : ((w1' &&& mask).toNat : Int) + + 2 ^ 32 * (w1' >>> 32).toNat = w1'.toNat := by exact_mod_cast hw1Split + have htCombined : ((w0 >>> 32).toNat : Int) + a1.toNat * b0.toNat = + w1.toNat + 4294967296 * w2.toNat := by omega + have hw1Combined : (w1.toNat : Int) + a0.toNat * b1.toNat = + (w1' &&& mask).toNat + 4294967296 * (w1' >>> 32).toNat := by omega + dsimp [rem] + calc + (a.toNat : Int) * b.toNat = + (a0.toNat + 2 ^ 32 * a1.toNat) * (b0.toNat + 2 ^ 32 * b1.toNat) := by + rw [haz, hbz] + _ = a0.toNat * b0.toNat + 2 ^ 32 * + (a1.toNat * b0.toNat + a0.toNat * b1.toNat) + + 2 ^ 64 * (a1.toNat * b1.toNat) := by ring + _ = (w0 &&& mask).toNat + 2 ^ 32 * (w0 >>> 32).toNat + 2 ^ 32 * + (a1.toNat * b0.toNat + a0.toNat * b1.toNat) + + 2 ^ 64 * (a1.toNat * b1.toNat) := by + rw [← hw0z, ← hw0Splitz] + _ = (w0 &&& mask).toNat + 2 ^ 32 * + ((w0 >>> 32).toNat + a1.toNat * b0.toNat + a0.toNat * b1.toNat) + + 2 ^ 64 * (a1.toNat * b1.toNat) := by ring + _ = (w0 &&& mask).toNat + 2 ^ 32 * + (w1.toNat + 2 ^ 32 * w2.toNat + a0.toNat * b1.toNat) + + 2 ^ 64 * (a1.toNat * b1.toNat) := by + rw [htCombined] + norm_num + _ = (w0 &&& mask).toNat + 2 ^ 32 * + (w1.toNat + a0.toNat * b1.toNat + 2 ^ 32 * w2.toNat) + + 2 ^ 64 * (a1.toNat * b1.toNat) := by ring + _ = (w0 &&& mask).toNat + 2 ^ 32 * + ((w1' &&& mask).toNat + 2 ^ 32 * (w1' >>> 32).toNat + + 2 ^ 32 * w2.toNat) + 2 ^ 64 * (a1.toNat * b1.toNat) := by + rw [hw1Combined] + norm_num + _ = (w0 &&& mask).toNat + 2 ^ 32 * (w1' &&& mask).toNat + + 2 ^ 64 * (a1.toNat * b1.toNat + w2.toNat + (w1' >>> 32).toNat) := by ring + have hlo : (a * b).toNat = rem := by + rw [UInt64.toNat_mul, hproduct] + rw [Nat.add_mod, Nat.mul_mod_right] + simp only [Nat.add_zero, Nat.mod_eq_of_lt hremLt] + rw [hlo, hhi, ← hproduct] + + +/-- C macro `muladd`: add `a*b` to `(c0,c1,c2)`. -/ +@[inline] def mulAdd (c0 c1 c2 a b : UInt64) : AccLimbs := + let tl := mul64Lo a b + let th := mul64Hi a b + let c0' := c0 + tl + let th := th + if c0' < tl then 1 else 0 + let c1' := c1 + th + let c2' := c2 + if c1' < th then 1 else 0 + (c0', c1', c2') + +/-- C macro `muladd_fast`: add `a*b` to `(c0,c1)`, preserving `c2 = 0`. -/ +@[inline] def mulAddFast (c0 c1 c2 a b : UInt64) : AccLimbs := + let tl := mul64Lo a b + let th := mul64Hi a b + let c0' := c0 + tl + let th := th + if c0' < tl then 1 else 0 + let c1' := c1 + th + (c0', c1', c2) + +/-- C macro `sumadd`: add a word to `(c0,c1,c2)`. -/ +@[inline] def sumAdd (c0 c1 c2 a : UInt64) : AccLimbs := + let c0' := c0 + a + let over : UInt64 := if c0' < a then 1 else 0 + let c1' := c1 + over + let c2' := c2 + if c1' < over then 1 else 0 + (c0', c1', c2') + +/-- C macro `sumadd_fast`: add a word to `(c0,c1)`, preserving `c2 = 0`. -/ +@[inline] def sumAddFast (c0 c1 c2 a : UInt64) : AccLimbs := + let c0' := c0 + a + let c1' := c1 + if c0' < a then 1 else 0 + (c0', c1', c2) + +/-- C macro `extract`: output `c0` and shift `(c0,c1,c2)` down one limb. -/ +@[inline] def extract (c0 c1 c2 : UInt64) : UInt64 × UInt64 × UInt64 × UInt64 := + (c0, c1, c2, 0) + +/-- C macro `extract_fast`: output `c0` and shift `(c0,c1)` down one limb. -/ +@[inline] def extractFast (c0 c1 _c2 : UInt64) : UInt64 × UInt64 × UInt64 × UInt64 := + (c0, c1, 0, 0) + +/-- Natural-number value of libsecp256k1's three-word multiplication accumulator. -/ +def accToNat (c0 c1 c2 : UInt64) : Nat := + c0.toNat + 2 ^ 64 * c1.toNat + 2 ^ 128 * c2.toNat + +/-- A two-word accumulator is strictly smaller than `2^128`. -/ +theorem accToNat_lt_two128 (c0 c1 : UInt64) : accToNat c0 c1 0 < 2 ^ 128 := by + have h0 := c0.toNat_lt_size + have h1 := c1.toNat_lt_size + norm_num [UInt64.size, accToNat] at h0 h1 ⊢ + omega + +/-- A one-word accumulator is strictly smaller than `2^64`. -/ +theorem accToNat_lt_two64 (c0 : UInt64) : accToNat c0 0 0 < 2 ^ 64 := by + have h0 := c0.toNat_lt_size + norm_num [UInt64.size, accToNat] at h0 ⊢ + exact h0 + +/-- A product of two machine words is strictly smaller than `2^128`. -/ +theorem wordProduct_lt_two128 (a b : UInt64) : a.toNat * b.toNat < 2 ^ 128 := by + have ha := a.toNat_lt_size + have hb := b.toNat_lt_size + norm_num [UInt64.size] at ha hb ⊢ + nlinarith + +/-- `extract` emits the low word and shifts the accumulator down by one word. -/ +theorem extract_value (c0 c1 c2 : UInt64) : + let r := extract c0 c1 c2 + r.1.toNat + 2 ^ 64 * accToNat r.2.1 r.2.2.1 r.2.2.2 = + accToNat c0 c1 c2 := by + simp [extract, accToNat] + ring + +/-- `extractFast` emits the low word and shifts a two-word accumulator down. -/ +theorem extractFast_value (c0 c1 c2 : UInt64) (hc2 : c2 = 0) : + let r := extractFast c0 c1 c2 + r.1.toNat + 2 ^ 64 * accToNat r.2.1 r.2.2.1 r.2.2.2 = + accToNat c0 c1 c2 := by + subst c2 + simp [extractFast, accToNat] + +/-- `mulAdd` adds one full 64x64-bit product to the three-word accumulator. + The bound is the C macro's no-overflow invariant. -/ +theorem mulAdd_value (c0 c1 c2 a b : UInt64) + (hbound : accToNat c0 c1 c2 + a.toNat * b.toNat < 2 ^ 192) : + let r := mulAdd c0 c1 c2 a b + accToNat r.1 r.2.1 r.2.2 = accToNat c0 c1 c2 + a.toNat * b.toNat := by + let tl := mul64Lo a b + let th0 := mul64Hi a b + let c0' := c0 + tl + let carry0 : UInt64 := if c0' < tl then 1 else 0 + let th := th0 + carry0 + let c1' := c1 + th + let carry1 : UInt64 := if c1' < th then 1 else 0 + let c2' := c2 + carry1 + change accToNat c0' c1' c2' = _ + have hp := mul64_value a b + change tl.toNat + 2 ^ 64 * th0.toNat = a.toNat * b.toNat at hp + have h0raw := addWord_value tl c0 + have h0 : c0'.toNat + 2 ^ 64 * carry0.toNat = tl.toNat + c0.toNat := by + simpa [carry0, c0', add_comm] using addWordRightCarry_value c0 tl + have hcarry0 : carry0.toNat ≤ 1 := by + by_cases h : c0' < tl <;> simp [carry0, h] + have ha := a.toNat_lt_size + have hb := b.toNat_lt_size + have htl := tl.toNat_lt_size + have hth0 := th0.toNat_lt_size + have hc0 := c0.toNat_lt_size + have hc1 := c1.toNat_lt_size + have hc2 := c2.toNat_lt_size + norm_num [UInt64.size] at ha hb htl hth0 hc0 hc1 hc2 + have hprodMax : a.toNat * b.toNat ≤ + 340282366920938463426481119284349108225 := by nlinarith + have hth : th0.toNat + carry0.toNat < 2 ^ 64 := by + norm_num at hp hprodMax ⊢ + omega + have hthNat : th.toNat = th0.toNat + carry0.toNat := by + rw [UInt64.toNat_add, Nat.mod_eq_of_lt hth] + have h1raw := addWord_value th c1 + have h1 : c1'.toNat + 2 ^ 64 * carry1.toNat = th.toNat + c1.toNat := by + simpa [carry1, c1', add_comm] using addWordRightCarry_value c1 th + have hcarry1 : carry1.toNat ≤ 1 := by + by_cases h : c1' < th <;> simp [carry1, h] + have hc2sum : c2.toNat + carry1.toNat < 2 ^ 64 := by + unfold accToNat at hbound + norm_num at hbound hp h0 h1 hthNat ⊢ + omega + have hc2Nat : c2'.toNat = c2.toNat + carry1.toNat := by + rw [UInt64.toNat_add, Nat.mod_eq_of_lt hc2sum] + unfold accToNat + norm_num at hp h0 h1 hthNat hc2Nat ⊢ + omega + +/-- `mulAddFast` adds a product to a two-word accumulator. + Its preconditions are the `c2 = 0` and no-carry assertions of the C macro. -/ +theorem mulAddFast_value (c0 c1 c2 a b : UInt64) (hc2zero : c2 = 0) + (hbound : accToNat c0 c1 c2 + a.toNat * b.toNat < 2 ^ 128) : + let r := mulAddFast c0 c1 c2 a b + accToNat r.1 r.2.1 r.2.2 = accToNat c0 c1 c2 + a.toNat * b.toNat := by + subst c2 + let tl := mul64Lo a b + let th0 := mul64Hi a b + let c0' := c0 + tl + let carry0 : UInt64 := if c0' < tl then 1 else 0 + let th := th0 + carry0 + let c1' := c1 + th + change accToNat c0' c1' 0 = _ + have hp := mul64_value a b + change tl.toNat + 2 ^ 64 * th0.toNat = a.toNat * b.toNat at hp + have h0raw := addWord_value tl c0 + have h0 : c0'.toNat + 2 ^ 64 * carry0.toNat = tl.toNat + c0.toNat := by + simpa [carry0, c0', add_comm] using addWordRightCarry_value c0 tl + have hcarry0 : carry0.toNat ≤ 1 := by + by_cases h : c0' < tl <;> simp [carry0, h] + have ha := a.toNat_lt_size + have hb := b.toNat_lt_size + have hth0 := th0.toNat_lt_size + norm_num [UInt64.size] at ha hb hth0 + have hprodMax : a.toNat * b.toNat ≤ + 340282366920938463426481119284349108225 := by nlinarith + have hth : th0.toNat + carry0.toNat < 2 ^ 64 := by + norm_num at hp hprodMax ⊢ + omega + have hthNat : th.toNat = th0.toNat + carry0.toNat := by + rw [UInt64.toNat_add, Nat.mod_eq_of_lt hth] + have hc1sum : c1.toNat + th.toNat < 2 ^ 64 := by + unfold accToNat at hbound + norm_num at hbound hp h0 hthNat ⊢ + omega + have hc1Nat : c1'.toNat = c1.toNat + th.toNat := by + rw [UInt64.toNat_add, Nat.mod_eq_of_lt hc1sum] + unfold accToNat + norm_num at hp h0 hthNat hc1Nat ⊢ + omega + +/-- `sumAdd` adds one word to the three-word accumulator. + The bound is the C macro's no-overflow invariant. -/ +theorem sumAdd_value (c0 c1 c2 a : UInt64) + (hbound : accToNat c0 c1 c2 + a.toNat < 2 ^ 192) : + let r := sumAdd c0 c1 c2 a + accToNat r.1 r.2.1 r.2.2 = accToNat c0 c1 c2 + a.toNat := by + let c0' := c0 + a + let carry0 : UInt64 := if c0' < a then 1 else 0 + let c1' := c1 + carry0 + let carry1 : UInt64 := if c1' < carry0 then 1 else 0 + let c2' := c2 + carry1 + change accToNat c0' c1' c2' = _ + have h0raw := addWord_value a c0 + have h0 : c0'.toNat + 2 ^ 64 * carry0.toNat = a.toNat + c0.toNat := by + simpa [carry0, c0', add_comm] using addWordRightCarry_value c0 a + have h1raw := addWord_value carry0 c1 + have h1 : c1'.toNat + 2 ^ 64 * carry1.toNat = carry0.toNat + c1.toNat := by + simpa [carry1, c1', add_comm] using addWordRightCarry_value c1 carry0 + have hcarry1 : carry1.toNat ≤ 1 := by + by_cases h : c1' < carry0 <;> simp [carry1, h] + have hc2sum : c2.toNat + carry1.toNat < 2 ^ 64 := by + unfold accToNat at hbound + norm_num at hbound h0 h1 ⊢ + omega + have hc2Nat : c2'.toNat = c2.toNat + carry1.toNat := by + rw [UInt64.toNat_add, Nat.mod_eq_of_lt hc2sum] + unfold accToNat + norm_num at h0 h1 hc2Nat ⊢ + omega + +/-- `sumAddFast` adds one word to a two-word accumulator. + Its preconditions are the `c2 = 0` and no-carry assertions of the C macro. -/ +theorem sumAddFast_value (c0 c1 c2 a : UInt64) (hc2zero : c2 = 0) + (hbound : accToNat c0 c1 c2 + a.toNat < 2 ^ 128) : + let r := sumAddFast c0 c1 c2 a + accToNat r.1 r.2.1 r.2.2 = accToNat c0 c1 c2 + a.toNat := by + subst c2 + let c0' := c0 + a + let carry0 : UInt64 := if c0' < a then 1 else 0 + let c1' := c1 + carry0 + change accToNat c0' c1' 0 = _ + have h0raw := addWord_value a c0 + have h0 : c0'.toNat + 2 ^ 64 * carry0.toNat = a.toNat + c0.toNat := by + simpa [carry0, c0', add_comm] using addWordRightCarry_value c0 a + have hc1sum : c1.toNat + carry0.toNat < 2 ^ 64 := by + unfold accToNat at hbound + norm_num at hbound h0 ⊢ + omega + have hc1Nat : c1'.toNat = c1.toNat + carry0.toNat := by + rw [UInt64.toNat_add, Nat.mod_eq_of_lt hc1sum] + unfold accToNat + norm_num at h0 hc1Nat ⊢ + omega + +/-- Raw 256-bit limb addition. Returns four result limbs and a carry. -/ +@[inline] def addRaw (a0 a1 a2 a3 b0 b1 b2 b3 : UInt64) : Limbs4Carry := + let (d0, c) := addCarry a0 b0 0 + let (d1, c) := addCarry a1 b1 c + let (d2, c) := addCarry a2 b2 c + let (d3, c) := addCarry a3 b3 c + (d0, d1, d2, d3, c) + +/-- Raw 256-bit limb subtraction. Returns four result limbs and a borrow. -/ +@[inline] def subRaw (a0 a1 a2 a3 b0 b1 b2 b3 : UInt64) : Limbs4Carry := + let (d0, c) := subBorrow a0 b0 0 + let (d1, c) := subBorrow a1 b1 c + let (d2, c) := subBorrow a2 b2 c + let (d3, c) := subBorrow a3 b3 c + (d0, d1, d2, d3, c) + +/-- Exact natural-number value of four-limb addition and its carry word. -/ +theorem addRaw_value (a0 a1 a2 a3 b0 b1 b2 b3 : UInt64) : + let r := addRaw a0 a1 a2 a3 b0 b1 b2 b3 + (Repr.ofLimbs r.1 r.2.1 r.2.2.1 r.2.2.2.1).toNat + + 2 ^ 256 * r.2.2.2.2.toNat = + (Repr.ofLimbs a0 a1 a2 a3).toNat + (Repr.ofLimbs b0 b1 b2 b3).toNat := by + let r0 := addCarry a0 b0 0 + let r1 := addCarry a1 b1 r0.2 + let r2 := addCarry a2 b2 r1.2 + let r3 := addCarry a3 b3 r2.2 + change (Repr.ofLimbs r0.1 r1.1 r2.1 r3.1).toNat + 2 ^ 256 * r3.2.toNat = _ + have h0 := addCarry_value a0 b0 0 (by norm_num) + have hc0 := addCarry_carry_le_one a0 b0 0 (by norm_num) + have h1 := addCarry_value a1 b1 r0.2 hc0 + have hc1 := addCarry_carry_le_one a1 b1 r0.2 hc0 + have h2 := addCarry_value a2 b2 r1.2 hc1 + have hc2 := addCarry_carry_le_one a2 b2 r1.2 hc1 + have h3 := addCarry_value a3 b3 r2.2 hc2 + unfold TWO64 at h0 h1 h2 h3 + have h01 := appendAddValue r0.1.toNat r0.2.toNat + (a0.toNat + b0.toNat) r1.1.toNat r1.2.toNat a1.toNat b1.toNat + 18446744073709551616 (by simpa using h0) h1 + have h012 := appendAddValue + (r0.1.toNat + 18446744073709551616 * r1.1.toNat) r1.2.toNat + (a0.toNat + b0.toNat + 18446744073709551616 * (a1.toNat + b1.toNat)) + r2.1.toNat r2.2.toNat a2.toNat b2.toNat + 340282366920938463463374607431768211456 (by omega) h2 + have h0123 := appendAddValue + (r0.1.toNat + 18446744073709551616 * r1.1.toNat + + 340282366920938463463374607431768211456 * r2.1.toNat) r2.2.toNat + (a0.toNat + b0.toNat + 18446744073709551616 * (a1.toNat + b1.toNat) + + 340282366920938463463374607431768211456 * (a2.toNat + b2.toNat)) + r3.1.toNat r3.2.toNat a3.toNat b3.toNat + 6277101735386680763835789423207666416102355444464034512896 (by omega) h3 + unfold Repr.toNat Repr.ofLimbs TWO64 TWO128 TWO192 at * + norm_num at * + omega + +/-- The final carry returned by four-limb addition is a bit. -/ +theorem addRaw_carry_le_one (a0 a1 a2 a3 b0 b1 b2 b3 : UInt64) : + (addRaw a0 a1 a2 a3 b0 b1 b2 b3).2.2.2.2.toNat ≤ 1 := by + let r0 := addCarry a0 b0 0 + let r1 := addCarry a1 b1 r0.2 + let r2 := addCarry a2 b2 r1.2 + have hc0 := addCarry_carry_le_one a0 b0 0 (by norm_num) + have hc1 := addCarry_carry_le_one a1 b1 r0.2 hc0 + have hc2 := addCarry_carry_le_one a2 b2 r1.2 hc1 + exact addCarry_carry_le_one a3 b3 r2.2 hc2 + +/-- Exact natural-number value of four-limb subtraction and its borrow word. -/ +theorem subRaw_value (a0 a1 a2 a3 b0 b1 b2 b3 : UInt64) : + let r := subRaw a0 a1 a2 a3 b0 b1 b2 b3 + (Repr.ofLimbs r.1 r.2.1 r.2.2.1 r.2.2.2.1).toNat + + (Repr.ofLimbs b0 b1 b2 b3).toNat = + (Repr.ofLimbs a0 a1 a2 a3).toNat + 2 ^ 256 * r.2.2.2.2.toNat := by + let r0 := subBorrow a0 b0 0 + let r1 := subBorrow a1 b1 r0.2 + let r2 := subBorrow a2 b2 r1.2 + let r3 := subBorrow a3 b3 r2.2 + change (Repr.ofLimbs r0.1 r1.1 r2.1 r3.1).toNat + + (Repr.ofLimbs b0 b1 b2 b3).toNat = + (Repr.ofLimbs a0 a1 a2 a3).toNat + 2 ^ 256 * r3.2.toNat + have h0 := subBorrow_value a0 b0 0 (by norm_num) + have hc0 := subBorrow_borrow_le_one a0 b0 0 (by norm_num) + have h1 := subBorrow_value a1 b1 r0.2 hc0 + have hc1 := subBorrow_borrow_le_one a1 b1 r0.2 hc0 + have h2 := subBorrow_value a2 b2 r1.2 hc1 + have hc2 := subBorrow_borrow_le_one a2 b2 r1.2 hc1 + have h3 := subBorrow_value a3 b3 r2.2 hc2 + unfold TWO64 at h0 h1 h2 h3 + have h01 := appendSubValue r0.1.toNat b0.toNat a0.toNat r0.2.toNat + r1.1.toNat b1.toNat a1.toNat r1.2.toNat 18446744073709551616 + (by simpa using h0) h1 + have h012 := appendSubValue + (r0.1.toNat + 18446744073709551616 * r1.1.toNat) + (b0.toNat + 18446744073709551616 * b1.toNat) + (a0.toNat + 18446744073709551616 * a1.toNat) r1.2.toNat + r2.1.toNat b2.toNat a2.toNat r2.2.toNat + 340282366920938463463374607431768211456 (by omega) h2 + have h0123 := appendSubValue + (r0.1.toNat + 18446744073709551616 * r1.1.toNat + + 340282366920938463463374607431768211456 * r2.1.toNat) + (b0.toNat + 18446744073709551616 * b1.toNat + + 340282366920938463463374607431768211456 * b2.toNat) + (a0.toNat + 18446744073709551616 * a1.toNat + + 340282366920938463463374607431768211456 * a2.toNat) r2.2.toNat + r3.1.toNat b3.toNat a3.toNat r3.2.toNat + 6277101735386680763835789423207666416102355444464034512896 (by omega) h3 + unfold Repr.toNat Repr.ofLimbs TWO64 TWO128 TWO192 at * + norm_num at * + omega + +/-- The final borrow returned by four-limb subtraction is a bit. -/ +theorem subRaw_borrow_le_one (a0 a1 a2 a3 b0 b1 b2 b3 : UInt64) : + (subRaw a0 a1 a2 a3 b0 b1 b2 b3).2.2.2.2.toNat ≤ 1 := by + let r0 := subBorrow a0 b0 0 + let r1 := subBorrow a1 b1 r0.2 + let r2 := subBorrow a2 b2 r1.2 + have hc0 := subBorrow_borrow_le_one a0 b0 0 (by norm_num) + have hc1 := subBorrow_borrow_le_one a1 b1 r0.2 hc0 + have hc2 := subBorrow_borrow_le_one a2 b2 r1.2 hc1 + exact subBorrow_borrow_le_one a3 b3 r2.2 hc2 + +end Secp256k1.Scalar.Fast diff --git a/CompPoly/Fields/Secp256k1/Scalar/Fast/Reduction.lean b/CompPoly/Fields/Secp256k1/Scalar/Fast/Reduction.lean new file mode 100644 index 00000000..2f89a0d7 --- /dev/null +++ b/CompPoly/Fields/Secp256k1/Scalar/Fast/Reduction.lean @@ -0,0 +1,2344 @@ +/- +Copyright (c) 2024 ArkLib Contributors. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Varun Thakore +-/ + +import CompPoly.Fields.Secp256k1.Scalar.Fast.Internal + +/-! + # Reduction routines for fast secp256k1 scalar field arithmetic + + This module contains raw modular reduction helpers and theorem scaffolding + for the later ring-equivalence proof. +-/ + +namespace Secp256k1.Scalar.Fast +namespace Reduction + +/-- Split `2^257` at the largest exponent evaluated by default. -/ +@[simp] private theorem two_pow_257 : (2 : Nat) ^ 257 = 2 ^ 256 * 2 := by + rw [show 257 = 256 + 1 by omega, pow_add] + norm_num + +/-- Split `2^259` at the largest exponent evaluated by default. -/ +@[simp] private theorem two_pow_259 : (2 : Nat) ^ 259 = 2 ^ 256 * 2 ^ 3 := by + rw [show 259 = 256 + 3 by omega, pow_add] + +/-- Split `2^320` at the largest exponent evaluated by default. -/ +@[simp] private theorem two_pow_320 : (2 : Nat) ^ 320 = 2 ^ 256 * 2 ^ 64 := by + rw [show 320 = 256 + 64 by omega, pow_add] + +/-- Split `2^384` at the largest exponent evaluated by default. -/ +@[simp] private theorem two_pow_384 : (2 : Nat) ^ 384 = 2 ^ 256 * 2 ^ 128 := by + rw [show 384 = 256 + 128 by omega, pow_add] + +/-- Split `2^385` at the largest exponent evaluated by default. -/ +@[simp] private theorem two_pow_385 : (2 : Nat) ^ 385 = 2 ^ 256 * 2 ^ 129 := by + rw [show 385 = 256 + 129 by omega, pow_add] + +/-- Split `2^448` at the largest exponent evaluated by default. -/ +@[simp] private theorem two_pow_448 : (2 : Nat) ^ 448 = 2 ^ 256 * 2 ^ 192 := by + rw [show 448 = 256 + 192 by omega, pow_add] + +/-- Split `2^512` at the largest exponent evaluated by default. -/ +@[simp] private theorem two_pow_512 : (2 : Nat) ^ 512 = 2 ^ 256 * 2 ^ 256 := by + rw [show 512 = 256 + 256 by omega, pow_add] + +/-- Exact linear upper bound for multiplication by the low complement limb. -/ +private theorem mulNC0_bound (x : UInt64) : + x.toNat * N_C_0.toNat < 2 ^ 64 * N_C_0.toNat := by + have hx := x.toNat_lt_size + norm_num [UInt64.size, N_C_0, UInt64.toNat_ofNat] at hx ⊢ + omega + +/-- Exact linear upper bound for multiplication by the high complement limb. -/ +private theorem mulNC1_bound (x : UInt64) : + x.toNat * N_C_1.toNat < 2 ^ 64 * N_C_1.toNat := by + have hx := x.toNat_lt_size + norm_num [UInt64.size, N_C_1, UInt64.toNat_ofNat] at hx ⊢ + omega + +/-- Add `2^256 - n` if `overflow` is true, i.e. subtract `n` modulo `2^256`. + This mirrors `secp256k1_scalar_reduce`. -/ +@[inline] def reduceRaw (d0 d1 d2 d3 : UInt64) (overflow : Bool) : Limbs4 := + if overflow then + let (r0, c) := addCarry d0 N_C_0 0 + let (r1, c) := addCarry d1 N_C_1 c + let (r2, c) := addCarry d2 N_C_2 c + let (r3, _) := addCarry d3 0 c + (r0, r1, r2, r3) + else + (d0, d1, d2, d3) + +/-- Canonicalize an arbitrary four-limb scalar by conditionally subtracting the order. -/ +@[inline] def canonicalizeRaw (d0 d1 d2 d3 : UInt64) : Limbs4 := + reduceRaw d0 d1 d2 d3 (checkOverflowRaw d0 d1 d2 d3) + +/-- Exact value equation for the unconditional `reduceRaw` branch. -/ +private theorem reduceRaw_true_value (d0 d1 d2 d3 : UInt64) : + let r := reduceRaw d0 d1 d2 d3 true + ∃ c : Nat, c ≤ 1 ∧ + (Repr.ofLimbs r.1 r.2.1 r.2.2.1 r.2.2.2).toNat + 2 ^ 256 * c = + (Repr.ofLimbs d0 d1 d2 d3).toNat + + (2 ^ 256 - Secp256k1.Scalar.Basic.CARD) := by + let q := addRaw d0 d1 d2 d3 N_C_0 N_C_1 N_C_2 0 + refine ⟨q.2.2.2.2.toNat, + addRaw_carry_le_one d0 d1 d2 d3 N_C_0 N_C_1 N_C_2 0, ?_⟩ + have h := addRaw_value d0 d1 d2 d3 N_C_0 N_C_1 N_C_2 0 + rw [Repr.complement_toNat] at h + simpa [reduceRaw, q] using h + +/-- Reducing a value at least the scalar order subtracts the order once. -/ +theorem reduceRaw_true_of_ge (d0 d1 d2 d3 : UInt64) + (hge : Secp256k1.Scalar.Basic.CARD ≤ (Repr.ofLimbs d0 d1 d2 d3).toNat) : + let r := reduceRaw d0 d1 d2 d3 true + (Repr.ofLimbs r.1 r.2.1 r.2.2.1 r.2.2.2).toNat = + (Repr.ofLimbs d0 d1 d2 d3).toNat - Secp256k1.Scalar.Basic.CARD := by + obtain ⟨c, hc, hvalue⟩ := reduceRaw_true_value d0 d1 d2 d3 + let r := reduceRaw d0 d1 d2 d3 true + have hout := Repr.toNat_lt_two256 (Repr.ofLimbs r.1 r.2.1 r.2.2.1 r.2.2.2) + norm_num [Secp256k1.Scalar.Basic.CARD] at hvalue hout hge + have hvaluez : + ((Repr.ofLimbs r.1 r.2.1 r.2.2.1 r.2.2.2).toNat : Int) + + 115792089237316195423570985008687907853269984665640564039457584007913129639936 * c = + (Repr.ofLimbs d0 d1 d2 d3).toNat + + 432420386565659656852420866394968145599 := by exact_mod_cast hvalue + have houtz : ((Repr.ofLimbs r.1 r.2.1 r.2.2.1 r.2.2.2).toNat : Int) < + 115792089237316195423570985008687907853269984665640564039457584007913129639936 := by + exact_mod_cast hout + have hgez : (115792089237316195423570985008687907852837564279074904382605163141518161494337 : Int) ≤ + (Repr.ofLimbs d0 d1 d2 d3).toNat := by exact_mod_cast hge + have hcz : (c : Int) ≤ 1 := by exact_mod_cast hc + have heqz : + ((Repr.ofLimbs r.1 r.2.1 r.2.2.1 r.2.2.2).toNat : Int) + + 115792089237316195423570985008687907852837564279074904382605163141518161494337 = + (Repr.ofLimbs d0 d1 d2 d3).toNat := by + omega + have heq : + (Repr.ofLimbs r.1 r.2.1 r.2.2.1 r.2.2.2).toNat + + Secp256k1.Scalar.Basic.CARD = + (Repr.ofLimbs d0 d1 d2 d3).toNat := by + norm_num [Secp256k1.Scalar.Basic.CARD] + exact_mod_cast heqz + dsimp only + exact Nat.eq_sub_of_add_eq heq + +/-- Reducing a value below the scalar order adds `2^256 - n` without wrapping. -/ +theorem reduceRaw_true_of_lt (d0 d1 d2 d3 : UInt64) + (hlt : (Repr.ofLimbs d0 d1 d2 d3).toNat < Secp256k1.Scalar.Basic.CARD) : + let r := reduceRaw d0 d1 d2 d3 true + (Repr.ofLimbs r.1 r.2.1 r.2.2.1 r.2.2.2).toNat = + (Repr.ofLimbs d0 d1 d2 d3).toNat + + (2 ^ 256 - Secp256k1.Scalar.Basic.CARD) := by + obtain ⟨c, hc, hvalue⟩ := reduceRaw_true_value d0 d1 d2 d3 + let r := reduceRaw d0 d1 d2 d3 true + have hout := Repr.toNat_lt_two256 (Repr.ofLimbs r.1 r.2.1 r.2.2.1 r.2.2.2) + norm_num [Secp256k1.Scalar.Basic.CARD] at hvalue hout hlt ⊢ + omega + +/-- Canonicalizing arbitrary four-limb input produces a value below the scalar order. -/ +theorem canonicalizeRaw_lt (d0 d1 d2 d3 : UInt64) : + let r := canonicalizeRaw d0 d1 d2 d3 + (Repr.ofLimbs r.1 r.2.1 r.2.2.1 r.2.2.2).toNat < + Secp256k1.Scalar.Basic.CARD := by + let x := Repr.ofLimbs d0 d1 d2 d3 + have hcheck := checkOverflowRaw_eq_decide d0 d1 d2 d3 + change checkOverflowRaw d0 d1 d2 d3 = + decide (x.toNat >= Secp256k1.Scalar.Basic.CARD) at hcheck + by_cases hge : Secp256k1.Scalar.Basic.CARD <= x.toNat + · have hflag : checkOverflowRaw d0 d1 d2 d3 = true := by + rw [hcheck] + simp [hge] + simp only [canonicalizeRaw, hflag] + rw [reduceRaw_true_of_ge d0 d1 d2 d3 hge] + have hx := Repr.toNat_lt_two256 x + dsimp only [x] at hx hge ⊢ + norm_num [Secp256k1.Scalar.Basic.CARD] at hx hge ⊢ + omega + · have hlt : x.toNat < Secp256k1.Scalar.Basic.CARD := Nat.lt_of_not_ge hge + have hflag : checkOverflowRaw d0 d1 d2 d3 = false := by + rw [hcheck] + simp [hlt] + simpa [canonicalizeRaw, hflag, reduceRaw, x] using hlt + +/-- Canonicalization preserves the input's value in the scalar field. -/ +theorem canonicalizeRaw_cast (d0 d1 d2 d3 : UInt64) : + let r := canonicalizeRaw d0 d1 d2 d3 + ((Repr.ofLimbs r.1 r.2.1 r.2.2.1 r.2.2.2).toNat : + Secp256k1.Scalar.Basic.Field) = + ((Repr.ofLimbs d0 d1 d2 d3).toNat : Secp256k1.Scalar.Basic.Field) := by + let x := Repr.ofLimbs d0 d1 d2 d3 + have hcheck := checkOverflowRaw_eq_decide d0 d1 d2 d3 + change checkOverflowRaw d0 d1 d2 d3 = + decide (x.toNat >= Secp256k1.Scalar.Basic.CARD) at hcheck + by_cases hge : Secp256k1.Scalar.Basic.CARD <= x.toNat + · have hflag : checkOverflowRaw d0 d1 d2 d3 = true := by + rw [hcheck] + simp [hge] + simp only [canonicalizeRaw, hflag] + rw [reduceRaw_true_of_ge d0 d1 d2 d3 hge] + rw [Nat.cast_sub hge] + have hcard : + (Secp256k1.Scalar.Basic.CARD : Secp256k1.Scalar.Basic.Field) = 0 := + CharP.cast_eq_zero _ _ + rw [hcard, sub_zero] + · have hlt : x.toNat < Secp256k1.Scalar.Basic.CARD := Nat.lt_of_not_ge hge + have hflag : checkOverflowRaw d0 d1 d2 d3 = false := by + rw [hcheck] + simp [hlt] + simp [canonicalizeRaw, hflag, reduceRaw] + +/-- Addition modulo the scalar order. -/ +@[inline] def addModRaw (a0 a1 a2 a3 b0 b1 b2 b3 : UInt64) : Limbs4 := + let (s0, s1, s2, s3, carry) := addRaw a0 a1 a2 a3 b0 b1 b2 b3 + reduceRaw s0 s1 s2 s3 (carry != 0 || checkOverflowRaw s0 s1 s2 s3) + +/-- Correct a wrapped four-limb subtraction by adding the scalar order on borrow. -/ +@[inline] def finishSubRaw (s0 s1 s2 s3 borrow : UInt64) : Limbs4 := + if borrow == 0 then + (s0, s1, s2, s3) + else + let (r0, r1, r2, r3, _) := addRaw s0 s1 s2 s3 N_0 N_1 N_2 N_3 + (r0, r1, r2, r3) + +/-- A subtraction without a final borrow needs no modular correction. -/ +@[simp] theorem finishSubRaw_zero (s0 s1 s2 s3 : UInt64) : + finishSubRaw s0 s1 s2 s3 0 = (s0, s1, s2, s3) := by + simp only [finishSubRaw, beq_self_eq_true, if_true] + +/-- A subtraction with a nonzero final borrow is corrected by adding the modulus. -/ +theorem finishSubRaw_of_ne_zero (s0 s1 s2 s3 borrow : UInt64) + (hborrow : borrow ≠ 0) : + finishSubRaw s0 s1 s2 s3 borrow = + let r := addRaw s0 s1 s2 s3 N_0 N_1 N_2 N_3 + (r.1, r.2.1, r.2.2.1, r.2.2.2.1) := by + simp only [finishSubRaw, beq_iff_eq, hborrow, if_false] + +/-- Subtraction modulo the scalar order. -/ +@[inline] def subModRaw (a0 a1 a2 a3 b0 b1 b2 b3 : UInt64) : Limbs4 := + let (s0, s1, s2, s3, borrow) := subRaw a0 a1 a2 a3 b0 b1 b2 b3 + finishSubRaw s0 s1 s2 s3 borrow + +/-- Expose modular subtraction as raw subtraction followed by borrow correction. -/ +theorem subModRaw_eq_finish (a0 a1 a2 a3 b0 b1 b2 b3 : UInt64) : + subModRaw a0 a1 a2 a3 b0 b1 b2 b3 = + let s := subRaw a0 a1 a2 a3 b0 b1 b2 b3 + finishSubRaw s.1 s.2.1 s.2.2.1 s.2.2.2.1 s.2.2.2.2 := rfl + +/-- Negation modulo the scalar order. -/ +@[inline] def negRaw (a0 a1 a2 a3 : UInt64) : Limbs4 := + let nonzero : UInt64 := if isZeroRaw a0 a1 a2 a3 then 0 else 0xffffffffffffffff + let (d0, c) := addCarry (~~~a0) (N_0 + 1) 0 + let (d1, c) := addCarry (~~~a1) N_1 c + let (d2, c) := addCarry (~~~a2) N_2 c + let (d3, _) := addCarry (~~~a3) N_3 c + (d0 &&& nonzero, d1 &&& nonzero, d2 &&& nonzero, d3 &&& nonzero) + +/-- Add one product and emit one column using the fast two-word macros. -/ +@[inline] private def mulColumnFast + (c0 c1 c2 a b : UInt64) : Limbs4 := + let s := mulAddFast c0 c1 c2 a b + extractFast s.1 s.2.1 s.2.2 + +/-- Add two products and emit one multiplication column. -/ +@[inline] private def mulColumn2 + (c0 c1 c2 a0 b0 a1 b1 : UInt64) : Limbs4 := + let s0 := mulAdd c0 c1 c2 a0 b0 + let s1 := mulAdd s0.1 s0.2.1 s0.2.2 a1 b1 + extract s1.1 s1.2.1 s1.2.2 + +/-- Add three products and emit one multiplication column. -/ +@[inline] private def mulColumn3 + (c0 c1 c2 a0 b0 a1 b1 a2 b2 : UInt64) : Limbs4 := + let s0 := mulAdd c0 c1 c2 a0 b0 + let s1 := mulAdd s0.1 s0.2.1 s0.2.2 a1 b1 + let s2 := mulAdd s1.1 s1.2.1 s1.2.2 a2 b2 + extract s2.1 s2.2.1 s2.2.2 + +/-- Add four products and emit one multiplication column. -/ +@[inline] private def mulColumn4 + (c0 c1 c2 a0 b0 a1 b1 a2 b2 a3 b3 : UInt64) : Limbs4 := + let s0 := mulAdd c0 c1 c2 a0 b0 + let s1 := mulAdd s0.1 s0.2.1 s0.2.2 a1 b1 + let s2 := mulAdd s1.1 s1.2.1 s1.2.2 a2 b2 + let s3 := mulAdd s2.1 s2.2.1 s2.2.2 a3 b3 + extract s3.1 s3.2.1 s3.2.2 + +/-- C `secp256k1_scalar_mul_512`, non-asm path. -/ +@[inline] def mul512Raw (a0 a1 a2 a3 b0 b1 b2 b3 : UInt64) : Limbs8 := + let e0 := mulColumnFast 0 0 0 a0 b0 + let e1 := mulColumn2 e0.2.1 e0.2.2.1 e0.2.2.2 a0 b1 a1 b0 + let e2 := mulColumn3 e1.2.1 e1.2.2.1 e1.2.2.2 a0 b2 a1 b1 a2 b0 + let e3 := mulColumn4 e2.2.1 e2.2.2.1 e2.2.2.2 a0 b3 a1 b2 a2 b1 a3 b0 + let e4 := mulColumn3 e3.2.1 e3.2.2.1 e3.2.2.2 a1 b3 a2 b2 a3 b1 + let e5 := mulColumn2 e4.2.1 e4.2.2.1 e4.2.2.2 a2 b3 a3 b2 + let e6 := mulColumnFast e5.2.1 e5.2.2.1 e5.2.2.2 a3 b3 + (e0.1, e1.1, e2.1, e3.1, e4.1, e5.1, e6.1, e6.2.1) + +/-- Expose the seven column results without unfolding their accumulator kernels. -/ +private theorem mul512Raw_columns (a0 a1 a2 a3 b0 b1 b2 b3 : UInt64) : + mul512Raw a0 a1 a2 a3 b0 b1 b2 b3 = + let e0 := mulColumnFast 0 0 0 a0 b0 + let e1 := mulColumn2 e0.2.1 e0.2.2.1 e0.2.2.2 a0 b1 a1 b0 + let e2 := mulColumn3 e1.2.1 e1.2.2.1 e1.2.2.2 a0 b2 a1 b1 a2 b0 + let e3 := mulColumn4 e2.2.1 e2.2.2.1 e2.2.2.2 a0 b3 a1 b2 a2 b1 a3 b0 + let e4 := mulColumn3 e3.2.1 e3.2.2.1 e3.2.2.2 a1 b3 a2 b2 a3 b1 + let e5 := mulColumn2 e4.2.1 e4.2.2.1 e4.2.2.2 a2 b3 a3 b2 + let e6 := mulColumnFast e5.2.1 e5.2.2.1 e5.2.2.2 a3 b3 + (e0.1, e1.1, e2.1, e3.1, e4.1, e5.1, e6.1, e6.2.1) := rfl + +/-- Natural-number value of eight little-endian 64-bit limbs. -/ +private def limbs8ToNat (x : Limbs8) : Nat := + x.1.toNat + 2 ^ 64 * x.2.1.toNat + 2 ^ 128 * x.2.2.1.toNat + + 2 ^ 192 * x.2.2.2.1.toNat + 2 ^ 256 * x.2.2.2.2.1.toNat + + 2 ^ 320 * x.2.2.2.2.2.1.toNat + 2 ^ 384 * x.2.2.2.2.2.2.1.toNat + + 2 ^ 448 * x.2.2.2.2.2.2.2.toNat + +/-- Collapse two sequential accumulator additions into one value equation. -/ +private theorem addChain2 {base s1 s2 x y : Nat} + (h1 : s1 = base + x) (h2 : s2 = s1 + y) : + s2 = base + (x + y) := by + omega + +/-- Collapse three sequential accumulator additions into one value equation. -/ +private theorem addChain3 {base s1 s2 s3 x y z : Nat} + (h1 : s1 = base + x) (h2 : s2 = s1 + y) (h3 : s3 = s2 + z) : + s3 = base + (x + y + z) := by + omega + +/-- Collapse four sequential accumulator additions into one value equation. -/ +private theorem addChain4 {base s1 s2 s3 s4 w x y z : Nat} + (h1 : s1 = base + w) (h2 : s2 = s1 + x) + (h3 : s3 = s2 + y) (h4 : s4 = s3 + z) : + s4 = base + (w + x + y + z) := by + omega + +/-- Append one emitted radix-`2^64` column to an accumulated value equation. -/ +private theorem appendRadixColumn + {pref oldTail digit newAcc newTail rhs added shift : Nat} + (hprefix : pref + shift * oldTail = rhs) + (hacc : newAcc = oldTail + added) + (hextract : digit + 2 ^ 64 * newTail = newAcc) : + pref + shift * digit + (shift * 2 ^ 64) * newTail = + rhs + shift * added := by + calc + pref + shift * digit + (shift * 2 ^ 64) * newTail = + pref + shift * (digit + 2 ^ 64 * newTail) := by ring + _ = pref + shift * newAcc := by rw [hextract] + _ = pref + shift * (oldTail + added) := by rw [hacc] + _ = (pref + shift * oldTail) + shift * added := by ring + _ = rhs + shift * added := by rw [hprefix] + +/-- Append a column whose emitted-word equation already includes its additions. -/ +private theorem appendCompletedColumn + {pref oldTail digit newTail rhs added shift : Nat} + (hprefix : pref + shift * oldTail = rhs) + (hcolumn : digit + 2 ^ 64 * newTail = oldTail + added) : + pref + shift * digit + (shift * 2 ^ 64) * newTail = + rhs + shift * added := by + exact appendRadixColumn hprefix rfl hcolumn + +/-- A fast multiplication column preserves its exact accumulator value. -/ +private theorem mulColumnFast_value (c0 c1 c2 a b : UInt64) + (hc2 : c2 = 0) + (hbound : accToNat c0 c1 c2 + a.toNat * b.toNat < 2 ^ 128) : + let r := mulColumnFast c0 c1 c2 a b + r.1.toNat + 2 ^ 64 * accToNat r.2.1 r.2.2.1 r.2.2.2 = + accToNat c0 c1 c2 + a.toNat * b.toNat := by + let s := mulAddFast c0 c1 c2 a b + have hs : accToNat s.1 s.2.1 s.2.2 = + accToNat c0 c1 c2 + a.toNat * b.toNat := by + simpa [s] using mulAddFast_value c0 c1 c2 a b hc2 hbound + have hs2 : s.2.2 = 0 := by + simp [s, mulAddFast, hc2] + have he := extractFast_value s.1 s.2.1 s.2.2 hs2 + change (extractFast s.1 s.2.1 s.2.2).1.toNat + + 2 ^ 64 * accToNat (extractFast s.1 s.2.1 s.2.2).2.1 + (extractFast s.1 s.2.1 s.2.2).2.2.1 + (extractFast s.1 s.2.1 s.2.2).2.2.2 = _ + exact he.trans hs + +/-- A fast column leaves only one carry word. -/ +private theorem mulColumnFast_tail (c0 c1 c2 a b : UInt64) : + let r := mulColumnFast c0 c1 c2 a b + r.2.2.1 = 0 ∧ r.2.2.2 = 0 := by + simp [mulColumnFast, extractFast] + +/-- A two-product multiplication column preserves its exact accumulator value. -/ +private theorem mulColumn2_value (c0 c1 c2 a0 b0 a1 b1 : UInt64) + (hacc : accToNat c0 c1 c2 < 2 ^ 128) : + let r := mulColumn2 c0 c1 c2 a0 b0 a1 b1 + r.1.toNat + 2 ^ 64 * accToNat r.2.1 r.2.2.1 r.2.2.2 = + accToNat c0 c1 c2 + (a0.toNat * b0.toNat + a1.toNat * b1.toNat) := by + let s0 := mulAdd c0 c1 c2 a0 b0 + let s1 := mulAdd s0.1 s0.2.1 s0.2.2 a1 b1 + have hp0 := wordProduct_lt_two128 a0 b0 + have hp1 := wordProduct_lt_two128 a1 b1 + have hs0 : accToNat s0.1 s0.2.1 s0.2.2 = + accToNat c0 c1 c2 + a0.toNat * b0.toNat := by + simpa [s0] using mulAdd_value c0 c1 c2 a0 b0 (by omega) + have hs1 : accToNat s1.1 s1.2.1 s1.2.2 = + accToNat s0.1 s0.2.1 s0.2.2 + a1.toNat * b1.toNat := by + simpa [s1] using mulAdd_value s0.1 s0.2.1 s0.2.2 a1 b1 (by rw [hs0]; omega) + have he := extract_value s1.1 s1.2.1 s1.2.2 + change (extract s1.1 s1.2.1 s1.2.2).1.toNat + + 2 ^ 64 * accToNat (extract s1.1 s1.2.1 s1.2.2).2.1 + (extract s1.1 s1.2.1 s1.2.2).2.2.1 + (extract s1.1 s1.2.1 s1.2.2).2.2.2 = _ + exact he.trans (addChain2 hs0 hs1) + +/-- A two-product column shifts into a two-word carry. -/ +private theorem mulColumn2_tail (c0 c1 c2 a0 b0 a1 b1 : UInt64) : + let r := mulColumn2 c0 c1 c2 a0 b0 a1 b1 + r.2.2.2 = 0 := by + rfl + +/-- A three-product multiplication column preserves its exact accumulator value. -/ +private theorem mulColumn3_value (c0 c1 c2 a0 b0 a1 b1 a2 b2 : UInt64) + (hacc : accToNat c0 c1 c2 < 2 ^ 128) : + let r := mulColumn3 c0 c1 c2 a0 b0 a1 b1 a2 b2 + r.1.toNat + 2 ^ 64 * accToNat r.2.1 r.2.2.1 r.2.2.2 = + accToNat c0 c1 c2 + + (a0.toNat * b0.toNat + a1.toNat * b1.toNat + a2.toNat * b2.toNat) := by + let s0 := mulAdd c0 c1 c2 a0 b0 + let s1 := mulAdd s0.1 s0.2.1 s0.2.2 a1 b1 + let s2 := mulAdd s1.1 s1.2.1 s1.2.2 a2 b2 + have hp0 := wordProduct_lt_two128 a0 b0 + have hp1 := wordProduct_lt_two128 a1 b1 + have hp2 := wordProduct_lt_two128 a2 b2 + have hs0 : accToNat s0.1 s0.2.1 s0.2.2 = + accToNat c0 c1 c2 + a0.toNat * b0.toNat := by + simpa [s0] using mulAdd_value c0 c1 c2 a0 b0 (by omega) + have hs1 : accToNat s1.1 s1.2.1 s1.2.2 = + accToNat s0.1 s0.2.1 s0.2.2 + a1.toNat * b1.toNat := by + simpa [s1] using mulAdd_value s0.1 s0.2.1 s0.2.2 a1 b1 (by rw [hs0]; omega) + have hs2 : accToNat s2.1 s2.2.1 s2.2.2 = + accToNat s1.1 s1.2.1 s1.2.2 + a2.toNat * b2.toNat := by + simpa [s2] using mulAdd_value s1.1 s1.2.1 s1.2.2 a2 b2 + (by rw [hs1, hs0]; omega) + have he := extract_value s2.1 s2.2.1 s2.2.2 + change (extract s2.1 s2.2.1 s2.2.2).1.toNat + + 2 ^ 64 * accToNat (extract s2.1 s2.2.1 s2.2.2).2.1 + (extract s2.1 s2.2.1 s2.2.2).2.2.1 + (extract s2.1 s2.2.1 s2.2.2).2.2.2 = _ + exact he.trans (addChain3 hs0 hs1 hs2) + +/-- A three-product column shifts into a two-word carry. -/ +private theorem mulColumn3_tail (c0 c1 c2 a0 b0 a1 b1 a2 b2 : UInt64) : + let r := mulColumn3 c0 c1 c2 a0 b0 a1 b1 a2 b2 + r.2.2.2 = 0 := by + rfl + +/-- A four-product multiplication column preserves its exact accumulator value. -/ +private theorem mulColumn4_value (c0 c1 c2 a0 b0 a1 b1 a2 b2 a3 b3 : UInt64) + (hacc : accToNat c0 c1 c2 < 2 ^ 128) : + let r := mulColumn4 c0 c1 c2 a0 b0 a1 b1 a2 b2 a3 b3 + r.1.toNat + 2 ^ 64 * accToNat r.2.1 r.2.2.1 r.2.2.2 = + accToNat c0 c1 c2 + (a0.toNat * b0.toNat + a1.toNat * b1.toNat + + a2.toNat * b2.toNat + a3.toNat * b3.toNat) := by + let s0 := mulAdd c0 c1 c2 a0 b0 + let s1 := mulAdd s0.1 s0.2.1 s0.2.2 a1 b1 + let s2 := mulAdd s1.1 s1.2.1 s1.2.2 a2 b2 + let s3 := mulAdd s2.1 s2.2.1 s2.2.2 a3 b3 + have hp0 := wordProduct_lt_two128 a0 b0 + have hp1 := wordProduct_lt_two128 a1 b1 + have hp2 := wordProduct_lt_two128 a2 b2 + have hp3 := wordProduct_lt_two128 a3 b3 + have hs0 : accToNat s0.1 s0.2.1 s0.2.2 = + accToNat c0 c1 c2 + a0.toNat * b0.toNat := by + simpa [s0] using mulAdd_value c0 c1 c2 a0 b0 (by omega) + have hs1 : accToNat s1.1 s1.2.1 s1.2.2 = + accToNat s0.1 s0.2.1 s0.2.2 + a1.toNat * b1.toNat := by + simpa [s1] using mulAdd_value s0.1 s0.2.1 s0.2.2 a1 b1 (by rw [hs0]; omega) + have hs2 : accToNat s2.1 s2.2.1 s2.2.2 = + accToNat s1.1 s1.2.1 s1.2.2 + a2.toNat * b2.toNat := by + simpa [s2] using mulAdd_value s1.1 s1.2.1 s1.2.2 a2 b2 + (by rw [hs1, hs0]; omega) + have hs3 : accToNat s3.1 s3.2.1 s3.2.2 = + accToNat s2.1 s2.2.1 s2.2.2 + a3.toNat * b3.toNat := by + simpa [s3] using mulAdd_value s2.1 s2.2.1 s2.2.2 a3 b3 + (by rw [hs2, hs1, hs0]; omega) + have he := extract_value s3.1 s3.2.1 s3.2.2 + change (extract s3.1 s3.2.1 s3.2.2).1.toNat + + 2 ^ 64 * accToNat (extract s3.1 s3.2.1 s3.2.2).2.1 + (extract s3.1 s3.2.1 s3.2.2).2.2.1 + (extract s3.1 s3.2.1 s3.2.2).2.2.2 = _ + exact he.trans (addChain4 hs0 hs1 hs2 hs3) + +/-- A four-product column shifts into a two-word carry. -/ +private theorem mulColumn4_tail (c0 c1 c2 a0 b0 a1 b1 a2 b2 a3 b3 : UInt64) : + let r := mulColumn4 c0 c1 c2 a0 b0 a1 b1 a2 b2 a3 b3 + r.2.2.2 = 0 := by + rfl + +/-- The libsecp256k1 multiplication schedule emits the exact 512-bit product. -/ +theorem mul512Raw_value (a0 a1 a2 a3 b0 b1 b2 b3 : UInt64) : + limbs8ToNat (mul512Raw a0 a1 a2 a3 b0 b1 b2 b3) = + (Repr.ofLimbs a0 a1 a2 a3).toNat * + (Repr.ofLimbs b0 b1 b2 b3).toNat := by + let p00 := a0.toNat * b0.toNat + let p01 := a0.toNat * b1.toNat + let p10 := a1.toNat * b0.toNat + let p02 := a0.toNat * b2.toNat + let p11 := a1.toNat * b1.toNat + let p20 := a2.toNat * b0.toNat + let p03 := a0.toNat * b3.toNat + let p12 := a1.toNat * b2.toNat + let p21 := a2.toNat * b1.toNat + let p30 := a3.toNat * b0.toNat + let p13 := a1.toNat * b3.toNat + let p22 := a2.toNat * b2.toNat + let p31 := a3.toNat * b1.toNat + let p23 := a2.toNat * b3.toNat + let p32 := a3.toNat * b2.toNat + let p33 := a3.toNat * b3.toNat + generalize h_e0 : mulColumnFast 0 0 0 a0 b0 = e0 + have he0 : e0.1.toNat + 2 ^ 64 * accToNat e0.2.1 e0.2.2.1 e0.2.2.2 = p00 := by + have h := mulColumnFast_value 0 0 0 a0 b0 rfl + (by simpa [accToNat] using wordProduct_lt_two128 a0 b0) + rw [h_e0] at h + simpa only [p00, accToNat, UInt64.toNat_zero, Nat.mul_zero, Nat.add_zero, + Nat.zero_add] using h + have he0bound : accToNat e0.2.1 e0.2.2.1 e0.2.2.2 < 2 ^ 64 := by + have hz := mulColumnFast_tail 0 0 0 a0 b0 + rw [h_e0] at hz + simpa only [hz.1, hz.2] using accToNat_lt_two64 e0.2.1 + generalize h_e1 : mulColumn2 e0.2.1 e0.2.2.1 e0.2.2.2 a0 b1 a1 b0 = e1 + have he1 : e1.1.toNat + 2 ^ 64 * accToNat e1.2.1 e1.2.2.1 e1.2.2.2 = + accToNat e0.2.1 e0.2.2.1 e0.2.2.2 + (p01 + p10) := by + have h := mulColumn2_value e0.2.1 e0.2.2.1 e0.2.2.2 a0 b1 a1 b0 + (lt_trans he0bound (by norm_num)) + rw [h_e1] at h + simpa only [p01, p10] using h + have he1bound : accToNat e1.2.1 e1.2.2.1 e1.2.2.2 < 2 ^ 128 := by + have hz := mulColumn2_tail e0.2.1 e0.2.2.1 e0.2.2.2 a0 b1 a1 b0 + rw [h_e1] at hz + simpa only [hz] using accToNat_lt_two128 e1.2.1 e1.2.2.1 + generalize h_e2 : mulColumn3 e1.2.1 e1.2.2.1 e1.2.2.2 a0 b2 a1 b1 a2 b0 = e2 + have he2 : e2.1.toNat + 2 ^ 64 * accToNat e2.2.1 e2.2.2.1 e2.2.2.2 = + accToNat e1.2.1 e1.2.2.1 e1.2.2.2 + (p02 + p11 + p20) := by + have h := mulColumn3_value e1.2.1 e1.2.2.1 e1.2.2.2 + a0 b2 a1 b1 a2 b0 he1bound + rw [h_e2] at h + simpa only [p02, p11, p20] using h + have he2bound : accToNat e2.2.1 e2.2.2.1 e2.2.2.2 < 2 ^ 128 := by + have hz := mulColumn3_tail e1.2.1 e1.2.2.1 e1.2.2.2 a0 b2 a1 b1 a2 b0 + rw [h_e2] at hz + simpa only [hz] using accToNat_lt_two128 e2.2.1 e2.2.2.1 + generalize h_e3 : + mulColumn4 e2.2.1 e2.2.2.1 e2.2.2.2 a0 b3 a1 b2 a2 b1 a3 b0 = e3 + have he3 : e3.1.toNat + 2 ^ 64 * accToNat e3.2.1 e3.2.2.1 e3.2.2.2 = + accToNat e2.2.1 e2.2.2.1 e2.2.2.2 + (p03 + p12 + p21 + p30) := by + have h := mulColumn4_value e2.2.1 e2.2.2.1 e2.2.2.2 + a0 b3 a1 b2 a2 b1 a3 b0 he2bound + rw [h_e3] at h + simpa only [p03, p12, p21, p30] using h + have he3bound : accToNat e3.2.1 e3.2.2.1 e3.2.2.2 < 2 ^ 128 := by + have hz := mulColumn4_tail e2.2.1 e2.2.2.1 e2.2.2.2 + a0 b3 a1 b2 a2 b1 a3 b0 + rw [h_e3] at hz + simpa only [hz] using accToNat_lt_two128 e3.2.1 e3.2.2.1 + generalize h_e4 : mulColumn3 e3.2.1 e3.2.2.1 e3.2.2.2 a1 b3 a2 b2 a3 b1 = e4 + have he4 : e4.1.toNat + 2 ^ 64 * accToNat e4.2.1 e4.2.2.1 e4.2.2.2 = + accToNat e3.2.1 e3.2.2.1 e3.2.2.2 + (p13 + p22 + p31) := by + have h := mulColumn3_value e3.2.1 e3.2.2.1 e3.2.2.2 + a1 b3 a2 b2 a3 b1 he3bound + rw [h_e4] at h + simpa only [p13, p22, p31] using h + have he4bound : accToNat e4.2.1 e4.2.2.1 e4.2.2.2 < 2 ^ 128 := by + have hz := mulColumn3_tail e3.2.1 e3.2.2.1 e3.2.2.2 a1 b3 a2 b2 a3 b1 + rw [h_e4] at hz + simpa only [hz] using accToNat_lt_two128 e4.2.1 e4.2.2.1 + generalize h_e5 : mulColumn2 e4.2.1 e4.2.2.1 e4.2.2.2 a2 b3 a3 b2 = e5 + have he5 : e5.1.toNat + 2 ^ 64 * accToNat e5.2.1 e5.2.2.1 e5.2.2.2 = + accToNat e4.2.1 e4.2.2.1 e4.2.2.2 + (p23 + p32) := by + have h := mulColumn2_value e4.2.1 e4.2.2.1 e4.2.2.2 a2 b3 a3 b2 he4bound + rw [h_e5] at h + simpa only [p23, p32] using h + have hpartial1 : + e0.1.toNat + 2 ^ 64 * e1.1.toNat + + 2 ^ 128 * accToNat e1.2.1 e1.2.2.1 e1.2.2.2 = + p00 + 2 ^ 64 * (p01 + p10) := by + have h := appendCompletedColumn (shift := 2 ^ 64) he0 he1 + norm_num at h ⊢ + exact h + have hpartial2 : + e0.1.toNat + 2 ^ 64 * e1.1.toNat + 2 ^ 128 * e2.1.toNat + + 2 ^ 192 * accToNat e2.2.1 e2.2.2.1 e2.2.2.2 = + p00 + 2 ^ 64 * (p01 + p10) + 2 ^ 128 * (p02 + p11 + p20) := by + have h := appendCompletedColumn (shift := 2 ^ 128) hpartial1 he2 + norm_num at h ⊢ + exact h + have hpartial3 : + e0.1.toNat + 2 ^ 64 * e1.1.toNat + 2 ^ 128 * e2.1.toNat + + 2 ^ 192 * e3.1.toNat + + 2 ^ 256 * accToNat e3.2.1 e3.2.2.1 e3.2.2.2 = + p00 + 2 ^ 64 * (p01 + p10) + 2 ^ 128 * (p02 + p11 + p20) + + 2 ^ 192 * (p03 + p12 + p21 + p30) := by + have h := appendCompletedColumn (shift := 2 ^ 192) hpartial2 he3 + norm_num at h ⊢ + exact h + have hpartial4 : + e0.1.toNat + 2 ^ 64 * e1.1.toNat + 2 ^ 128 * e2.1.toNat + + 2 ^ 192 * e3.1.toNat + 2 ^ 256 * e4.1.toNat + + 2 ^ 320 * accToNat e4.2.1 e4.2.2.1 e4.2.2.2 = + p00 + 2 ^ 64 * (p01 + p10) + 2 ^ 128 * (p02 + p11 + p20) + + 2 ^ 192 * (p03 + p12 + p21 + p30) + + 2 ^ 256 * (p13 + p22 + p31) := by + have h := appendCompletedColumn (shift := 2 ^ 256) hpartial3 he4 + norm_num at h ⊢ + exact h + have hpartial : + e0.1.toNat + 2 ^ 64 * e1.1.toNat + 2 ^ 128 * e2.1.toNat + + 2 ^ 192 * e3.1.toNat + 2 ^ 256 * e4.1.toNat + 2 ^ 320 * e5.1.toNat + + 2 ^ 384 * accToNat e5.2.1 e5.2.2.1 e5.2.2.2 = + p00 + 2 ^ 64 * (p01 + p10) + 2 ^ 128 * (p02 + p11 + p20) + + 2 ^ 192 * (p03 + p12 + p21 + p30) + 2 ^ 256 * (p13 + p22 + p31) + + 2 ^ 320 * (p23 + p32) := by + have h := appendCompletedColumn (shift := 2 ^ 320) hpartial4 he5 + norm_num at h ⊢ + exact h + let av := (Repr.ofLimbs a0 a1 a2 a3).toNat + let bv := (Repr.ofLimbs b0 b1 b2 b3).toNat + have hexpand : av * bv = + p00 + 2 ^ 64 * (p01 + p10) + 2 ^ 128 * (p02 + p11 + p20) + + 2 ^ 192 * (p03 + p12 + p21 + p30) + 2 ^ 256 * (p13 + p22 + p31) + + 2 ^ 320 * (p23 + p32) + 2 ^ 384 * p33 := by + simp only [av, bv, Repr.toNat, Repr.ofLimbs, p00, p01, p10, p02, p11, p20, + p03, p12, p21, p30, p13, p22, p31, p23, p32, p33] + norm_num [TWO64, TWO128, TWO192] + ring + have hav := Repr.toNat_lt_two256 (Repr.ofLimbs a0 a1 a2 a3) + have hbv := Repr.toNat_lt_two256 (Repr.ofLimbs b0 b1 b2 b3) + have hab : av * bv < 2 ^ 512 := by + change av < 2 ^ 256 at hav + change bv < 2 ^ 256 at hbv + calc + av * bv < 2 ^ 256 * 2 ^ 256 := Nat.mul_lt_mul_of_lt_of_lt hav hbv + _ = 2 ^ 512 := two_pow_512.symm + have hlastBound : accToNat e5.2.1 e5.2.2.1 e5.2.2.2 + p33 < 2 ^ 128 := by + norm_num at hpartial hexpand hab ⊢ + omega + generalize h_e6 : mulColumnFast e5.2.1 e5.2.2.1 e5.2.2.2 a3 b3 = e6 + have he6 : e6.1.toNat + 2 ^ 64 * accToNat e6.2.1 e6.2.2.1 e6.2.2.2 = + accToNat e5.2.1 e5.2.2.1 e5.2.2.2 + p33 := by + have h := mulColumnFast_value e5.2.1 e5.2.2.1 e5.2.2.2 a3 b3 + (by + have hz := mulColumn2_tail e4.2.1 e4.2.2.1 e4.2.2.2 a2 b3 a3 b2 + rw [h_e5] at hz + exact hz) hlastBound + rw [h_e6] at h + simpa only [p33] using h + have hfull : + e0.1.toNat + 2 ^ 64 * e1.1.toNat + 2 ^ 128 * e2.1.toNat + + 2 ^ 192 * e3.1.toNat + 2 ^ 256 * e4.1.toNat + 2 ^ 320 * e5.1.toNat + + 2 ^ 384 * e6.1.toNat + + 2 ^ 448 * accToNat e6.2.1 e6.2.2.1 e6.2.2.2 = av * bv := by + have h := appendCompletedColumn (shift := 2 ^ 384) hpartial he6 + norm_num at h hexpand ⊢ + omega + have he6tail : accToNat e6.2.1 e6.2.2.1 e6.2.2.2 = e6.2.1.toNat := by + have hz := mulColumnFast_tail e5.2.1 e5.2.2.1 e5.2.2.2 a3 b3 + rw [h_e6] at hz + simp [accToNat, hz.1, hz.2] + rw [he6tail] at hfull + have hout : limbs8ToNat + (e0.1, e1.1, e2.1, e3.1, e4.1, e5.1, e6.1, e6.2.1) = av * bv := by + simpa only [limbs8ToNat] using hfull + have hcolumns : mul512Raw a0 a1 a2 a3 b0 b1 b2 b3 = + (e0.1, e1.1, e2.1, e3.1, e4.1, e5.1, e6.1, e6.2.1) := by + simpa only [h_e0, h_e1, h_e2, h_e3, h_e4, h_e5, h_e6] using + mul512Raw_columns a0 a1 a2 a3 b0 b1 b2 b3 + calc + limbs8ToNat (mul512Raw a0 a1 a2 a3 b0 b1 b2 b3) = + limbs8ToNat (e0.1, e1.1, e2.1, e3.1, e4.1, e5.1, e6.1, e6.2.1) := by + exact congrArg limbs8ToNat hcolumns + _ = av * bv := hout + +/-- Natural-number value of five little-endian 64-bit limbs. -/ +private def limbs5ToNat (x : Limbs4Carry) : Nat := + (Repr.ofLimbs x.1 x.2.1 x.2.2.1 x.2.2.2.1).toNat + + 2 ^ 256 * x.2.2.2.2.toNat + +/-- Final 258-to-256-bit reduction step from `secp256k1_scalar_reduce_512`. + Returns `(r, c)`, where `c` is the final carry word. -/ +@[inline] private def reduce258Raw + (p0 p1 p2 p3 p4 : UInt64) : Limbs4Carry := + let (c0, c1, c2) := mulAddFast p0 0 0 N_C_0 p4 + let (r0, c0, c1, c2) := extractFast c0 c1 c2 + let (c0, c1, c2) := sumAddFast c0 c1 c2 p1 + let (c0, c1, c2) := mulAddFast c0 c1 c2 N_C_1 p4 + let (r1, c0, c1, c2) := extractFast c0 c1 c2 + let (c0, c1, c2) := sumAddFast c0 c1 c2 p2 + let (c0, c1, c2) := sumAddFast c0 c1 c2 p4 + let (r2, c0, c1, c2) := extractFast c0 c1 c2 + let (c0, c1, _c2) := sumAddFast c0 c1 c2 p3 + (r0, r1, r2, c0, c1) + +/-- Exact value equation for the final multiply-by-complement fold. -/ +private theorem reduce258Raw_value (p0 p1 p2 p3 p4 : UInt64) + (hinput : limbs5ToNat (p0, p1, p2, p3, p4) < 2 ^ 259) : + limbs5ToNat (reduce258Raw p0 p1 p2 p3 p4) = + (Repr.ofLimbs p0 p1 p2 p3).toNat + + p4.toNat * (2 ^ 256 - Secp256k1.Scalar.Basic.CARD) := by + have hp0 := p0.toNat_lt_size + have hp1 := p1.toNat_lt_size + have hp2 := p2.toNat_lt_size + have hp3 := p3.toNat_lt_size + norm_num [UInt64.size] at hp0 hp1 hp2 hp3 + have hp4 : p4.toNat < 8 := by + unfold limbs5ToNat Repr.toNat Repr.ofLimbs TWO64 TWO128 TWO192 at hinput + norm_num at hinput ⊢ + omega + let q0 := p4.toNat * N_C_0.toNat + let q1 := p4.toNat * N_C_1.toNat + have hq0 : q0 < 8 * 2 ^ 64 := by + have hc := N_C_0.toNat_lt_size + norm_num [UInt64.size] at hc + dsimp [q0] + nlinarith + have hq1 : q1 < 8 * 2 ^ 64 := by + have hc := N_C_1.toNat_lt_size + norm_num [UInt64.size] at hc + dsimp [q1] + nlinarith + + let s0 := mulAddFast p0 0 0 N_C_0 p4 + have hs0 : accToNat s0.1 s0.2.1 s0.2.2 = p0.toNat + q0 := by + simpa [s0, q0, Nat.mul_comm, accToNat] using + mulAddFast_value p0 0 0 N_C_0 p4 rfl (by + have h : p0.toNat + q0 < 2 ^ 128 := by omega + simpa [accToNat, q0, Nat.mul_comm] using h) + let e0 := extractFast s0.1 s0.2.1 s0.2.2 + have he0 : e0.1.toNat + 2 ^ 64 * accToNat e0.2.1 e0.2.2.1 e0.2.2.2 = + accToNat s0.1 s0.2.1 s0.2.2 := by + apply extractFast_value + simp [s0, mulAddFast] + have he0bound : accToNat e0.2.1 e0.2.2.1 e0.2.2.2 < 2 ^ 64 := by + simpa [e0, extractFast] using accToNat_lt_two64 s0.2.1 + + let s1z := sumAddFast e0.2.1 e0.2.2.1 e0.2.2.2 p1 + have hs1z : accToNat s1z.1 s1z.2.1 s1z.2.2 = + accToNat e0.2.1 e0.2.2.1 e0.2.2.2 + p1.toNat := by + apply sumAddFast_value + · simp [e0, extractFast] + · omega + let s1 := mulAddFast s1z.1 s1z.2.1 s1z.2.2 N_C_1 p4 + have hs1 : accToNat s1.1 s1.2.1 s1.2.2 = + accToNat s1z.1 s1z.2.1 s1z.2.2 + q1 := by + simpa [s1, q1, Nat.mul_comm] using + mulAddFast_value s1z.1 s1z.2.1 s1z.2.2 N_C_1 p4 + (by simp [s1z, sumAddFast, e0, extractFast]) (by + rw [hs1z] + have h : accToNat e0.2.1 e0.2.2.1 e0.2.2.2 + p1.toNat + q1 < + 2 ^ 128 := by omega + simpa [q1, Nat.mul_comm] using h) + let e1 := extractFast s1.1 s1.2.1 s1.2.2 + have he1 : e1.1.toNat + 2 ^ 64 * accToNat e1.2.1 e1.2.2.1 e1.2.2.2 = + accToNat s1.1 s1.2.1 s1.2.2 := by + apply extractFast_value + simp [s1, mulAddFast, s1z, sumAddFast, e0, extractFast] + have he1bound : accToNat e1.2.1 e1.2.2.1 e1.2.2.2 < 2 ^ 64 := by + simpa [e1, extractFast] using accToNat_lt_two64 s1.2.1 + + let s2z := sumAddFast e1.2.1 e1.2.2.1 e1.2.2.2 p2 + have hs2z : accToNat s2z.1 s2z.2.1 s2z.2.2 = + accToNat e1.2.1 e1.2.2.1 e1.2.2.2 + p2.toNat := by + apply sumAddFast_value + · simp [e1, extractFast] + · omega + let s2 := sumAddFast s2z.1 s2z.2.1 s2z.2.2 p4 + have hs2 : accToNat s2.1 s2.2.1 s2.2.2 = + accToNat s2z.1 s2z.2.1 s2z.2.2 + p4.toNat := by + apply sumAddFast_value + · simp [s2z, sumAddFast, e1, extractFast] + · rw [hs2z] + omega + let e2 := extractFast s2.1 s2.2.1 s2.2.2 + have he2 : e2.1.toNat + 2 ^ 64 * accToNat e2.2.1 e2.2.2.1 e2.2.2.2 = + accToNat s2.1 s2.2.1 s2.2.2 := by + apply extractFast_value + simp [s2, sumAddFast, s2z, e1, extractFast] + have he2bound : accToNat e2.2.1 e2.2.2.1 e2.2.2.2 < 2 ^ 64 := by + simpa [e2, extractFast] using accToNat_lt_two64 s2.2.1 + + let s3 := sumAddFast e2.2.1 e2.2.2.1 e2.2.2.2 p3 + have hs3 : accToNat s3.1 s3.2.1 s3.2.2 = + accToNat e2.2.1 e2.2.2.1 e2.2.2.2 + p3.toNat := by + apply sumAddFast_value + · simp [e2, extractFast] + · omega + have hs3shape : s3.2.2 = 0 := by + simp [s3, sumAddFast, e2, extractFast] + change limbs5ToNat (e0.1, e1.1, e2.1, s3.1, s3.2.1) = _ + unfold limbs5ToNat Repr.toNat Repr.ofLimbs + have hcomp : 2 ^ 256 - Secp256k1.Scalar.Basic.CARD = + N_C_0.toNat + 2 ^ 64 * N_C_1.toNat + 2 ^ 128 := by + norm_num [N_C_0, N_C_1, Secp256k1.Scalar.Basic.CARD, UInt64.toNat_ofNat] + rw [hcomp] + norm_num [TWO64, TWO128, TWO192, accToNat] at he0 he1 he2 hs0 hs1z hs1 hs2z hs2 hs3 hs3shape ⊢ + dsimp [q0, q1] at hs0 hs1 + norm_num [N_C_0, N_C_1, UInt64.toNat_ofNat] at hs0 hs1 ⊢ + omega + +/-- The final fold is below twice `2^256`, so its high word is a carry bit. -/ +private theorem reduce258Raw_bound (p0 p1 p2 p3 p4 : UInt64) + (hinput : limbs5ToNat (p0, p1, p2, p3, p4) < 2 ^ 259) : + limbs5ToNat (reduce258Raw p0 p1 p2 p3 p4) < 2 ^ 257 := by + rw [reduce258Raw_value _ _ _ _ _ hinput] + have hp4 : p4.toNat < 8 := by + unfold limbs5ToNat Repr.toNat Repr.ofLimbs TWO64 TWO128 TWO192 at hinput + norm_num at hinput ⊢ + omega + have hlow := Repr.toNat_lt_two256 (Repr.ofLimbs p0 p1 p2 p3) + norm_num [Secp256k1.Scalar.Basic.CARD] at hlow hp4 ⊢ + omega + +/-- The carry returned by the final fold is either zero or one. -/ +private theorem reduce258Raw_carry_le_one (p0 p1 p2 p3 p4 : UInt64) + (hinput : limbs5ToNat (p0, p1, p2, p3, p4) < 2 ^ 259) : + (reduce258Raw p0 p1 p2 p3 p4).2.2.2.2.toNat ≤ 1 := by + have hbound := reduce258Raw_bound p0 p1 p2 p3 p4 hinput + unfold limbs5ToNat at hbound + norm_num at hbound ⊢ + omega + +/-- C `secp256k1_scalar_reduce_512`, non-asm path. -/ +private abbrev Limbs7 := + UInt64 × UInt64 × UInt64 × UInt64 × UInt64 × UInt64 × UInt64 + +/-- First libsecp256k1 reduction stage: fold the high 256 bits with + `2^256 - n`, producing at most 385 bits. -/ +@[inline] private def reduce512To385Raw + (l0 l1 l2 l3 n0 n1 n2 n3 : UInt64) : Limbs7 := + let (c0, c1, c2) := mulAddFast l0 0 0 n0 N_C_0 + let (m0, c0, c1, c2) := extractFast c0 c1 c2 + let (c0, c1, c2) := sumAddFast c0 c1 c2 l1 + let (c0, c1, c2) := mulAdd c0 c1 c2 n1 N_C_0 + let (c0, c1, c2) := mulAdd c0 c1 c2 n0 N_C_1 + let (m1, c0, c1, c2) := extract c0 c1 c2 + let (c0, c1, c2) := sumAdd c0 c1 c2 l2 + let (c0, c1, c2) := mulAdd c0 c1 c2 n2 N_C_0 + let (c0, c1, c2) := mulAdd c0 c1 c2 n1 N_C_1 + let (c0, c1, c2) := sumAdd c0 c1 c2 n0 + let (m2, c0, c1, c2) := extract c0 c1 c2 + let (c0, c1, c2) := sumAdd c0 c1 c2 l3 + let (c0, c1, c2) := mulAdd c0 c1 c2 n3 N_C_0 + let (c0, c1, c2) := mulAdd c0 c1 c2 n2 N_C_1 + let (c0, c1, c2) := sumAdd c0 c1 c2 n1 + let (m3, c0, c1, c2) := extract c0 c1 c2 + let (c0, c1, c2) := mulAdd c0 c1 c2 n3 N_C_1 + let (c0, c1, c2) := sumAdd c0 c1 c2 n2 + let (m4, c0, c1, c2) := extract c0 c1 c2 + let (c0, c1, c2) := sumAddFast c0 c1 c2 n3 + let (m5, c0, _, _) := extractFast c0 c1 c2 + let m6 := c0 + (m0, m1, m2, m3, m4, m5, m6) + +/-- Expose the six first-stage reduction columns without unfolding their kernels. -/ +private theorem reduce512To385Raw_columns + (l0 l1 l2 l3 n0 n1 n2 n3 : UInt64) : + reduce512To385Raw l0 l1 l2 l3 n0 n1 n2 n3 = + let s0 := mulAddFast l0 0 0 n0 N_C_0 + let e0 := extractFast s0.1 s0.2.1 s0.2.2 + let s1z := sumAddFast e0.2.1 e0.2.2.1 e0.2.2.2 l1 + let s1a := mulAdd s1z.1 s1z.2.1 s1z.2.2 n1 N_C_0 + let s1 := mulAdd s1a.1 s1a.2.1 s1a.2.2 n0 N_C_1 + let e1 := extract s1.1 s1.2.1 s1.2.2 + let s2z := sumAdd e1.2.1 e1.2.2.1 e1.2.2.2 l2 + let s2a := mulAdd s2z.1 s2z.2.1 s2z.2.2 n2 N_C_0 + let s2b := mulAdd s2a.1 s2a.2.1 s2a.2.2 n1 N_C_1 + let s2 := sumAdd s2b.1 s2b.2.1 s2b.2.2 n0 + let e2 := extract s2.1 s2.2.1 s2.2.2 + let s3z := sumAdd e2.2.1 e2.2.2.1 e2.2.2.2 l3 + let s3a := mulAdd s3z.1 s3z.2.1 s3z.2.2 n3 N_C_0 + let s3b := mulAdd s3a.1 s3a.2.1 s3a.2.2 n2 N_C_1 + let s3 := sumAdd s3b.1 s3b.2.1 s3b.2.2 n1 + let e3 := extract s3.1 s3.2.1 s3.2.2 + let s4a := mulAdd e3.2.1 e3.2.2.1 e3.2.2.2 n3 N_C_1 + let s4 := sumAdd s4a.1 s4a.2.1 s4a.2.2 n2 + let e4 := extract s4.1 s4.2.1 s4.2.2 + let s5 := sumAddFast e4.2.1 e4.2.2.1 e4.2.2.2 n3 + let e5 := extractFast s5.1 s5.2.1 s5.2.2 + (e0.1, e1.1, e2.1, e3.1, e4.1, e5.1, e5.2.1) := rfl + +/-- Natural-number value of seven little-endian 64-bit limbs. -/ +private def limbs7ToNat (x : Limbs7) : Nat := + x.1.toNat + 2 ^ 64 * x.2.1.toNat + 2 ^ 128 * x.2.2.1.toNat + + 2 ^ 192 * x.2.2.2.1.toNat + 2 ^ 256 * x.2.2.2.2.1.toNat + + 2 ^ 320 * x.2.2.2.2.2.1.toNat + 2 ^ 384 * x.2.2.2.2.2.2.toNat + +/-- Exact value equation for the first reduction stage. -/ +private theorem reduce512To385Raw_value + (l0 l1 l2 l3 n0 n1 n2 n3 : UInt64) : + limbs7ToNat (reduce512To385Raw l0 l1 l2 l3 n0 n1 n2 n3) = + (Repr.ofLimbs l0 l1 l2 l3).toNat + + (Repr.ofLimbs n0 n1 n2 n3).toNat * + (2 ^ 256 - Secp256k1.Scalar.Basic.CARD) := by + let q0 := n0.toNat * N_C_0.toNat + let q1 := n1.toNat * N_C_0.toNat + let q2 := n0.toNat * N_C_1.toNat + let q3 := n2.toNat * N_C_0.toNat + let q4 := n1.toNat * N_C_1.toNat + let q5 := n3.toNat * N_C_0.toNat + let q6 := n2.toNat * N_C_1.toNat + let q7 := n3.toNat * N_C_1.toNat + have hq0 : q0 < 2 ^ 64 * N_C_0.toNat := mulNC0_bound n0 + have hq1 : q1 < 2 ^ 64 * N_C_0.toNat := mulNC0_bound n1 + have hq2 : q2 < 2 ^ 64 * N_C_1.toNat := mulNC1_bound n0 + have hq3 : q3 < 2 ^ 64 * N_C_0.toNat := mulNC0_bound n2 + have hq4 : q4 < 2 ^ 64 * N_C_1.toNat := mulNC1_bound n1 + have hq5 : q5 < 2 ^ 64 * N_C_0.toNat := mulNC0_bound n3 + have hq6 : q6 < 2 ^ 64 * N_C_1.toNat := mulNC1_bound n2 + have hq7 : q7 < 2 ^ 64 * N_C_1.toNat := mulNC1_bound n3 + norm_num [N_C_0, N_C_1, UInt64.toNat_ofNat] at hq0 hq1 hq2 hq3 hq4 hq5 hq6 hq7 + have hl0 := l0.toNat_lt_size + have hl1 := l1.toNat_lt_size + have hl2 := l2.toNat_lt_size + have hl3 := l3.toNat_lt_size + have hn0 := n0.toNat_lt_size + have hn1 := n1.toNat_lt_size + have hn2 := n2.toNat_lt_size + have hn3 := n3.toNat_lt_size + norm_num [UInt64.size] at hl0 hl1 hl2 hl3 hn0 hn1 hn2 hn3 + + generalize h_s0 : mulAddFast l0 0 0 n0 N_C_0 = s0 + have hs0 : accToNat s0.1 s0.2.1 s0.2.2 = l0.toNat + q0 := by + rw [← h_s0] + apply mulAddFast_value + · rfl + · change l0.toNat + q0 < 2 ^ 128 + omega + generalize h_e0 : extractFast s0.1 s0.2.1 s0.2.2 = e0 + have he0 : e0.1.toNat + 2 ^ 64 * accToNat e0.2.1 e0.2.2.1 e0.2.2.2 = + accToNat s0.1 s0.2.1 s0.2.2 := by + have h := extractFast_value s0.1 s0.2.1 s0.2.2 (by + rw [← h_s0] + simp [mulAddFast]) + rw [h_e0] at h + exact h + have he0bound : accToNat e0.2.1 e0.2.2.1 e0.2.2.2 < 2 ^ 64 := by + rw [← h_e0] + simpa [extractFast] using accToNat_lt_two64 s0.2.1 + + generalize h_s1z : sumAddFast e0.2.1 e0.2.2.1 e0.2.2.2 l1 = s1z + have hs1z : accToNat s1z.1 s1z.2.1 s1z.2.2 = + accToNat e0.2.1 e0.2.2.1 e0.2.2.2 + l1.toNat := by + rw [← h_s1z] + apply sumAddFast_value + · rw [← h_e0] + simp [extractFast] + · omega + generalize h_s1a : mulAdd s1z.1 s1z.2.1 s1z.2.2 n1 N_C_0 = s1a + have hs1a : accToNat s1a.1 s1a.2.1 s1a.2.2 = + accToNat s1z.1 s1z.2.1 s1z.2.2 + q1 := by + rw [← h_s1a] + apply mulAdd_value + rw [hs1z] + change accToNat e0.2.1 e0.2.2.1 e0.2.2.2 + l1.toNat + q1 < 2 ^ 192 + omega + generalize h_s1 : mulAdd s1a.1 s1a.2.1 s1a.2.2 n0 N_C_1 = s1 + have hs1 : accToNat s1.1 s1.2.1 s1.2.2 = + accToNat s1a.1 s1a.2.1 s1a.2.2 + q2 := by + rw [← h_s1] + apply mulAdd_value + rw [hs1a, hs1z] + change accToNat e0.2.1 e0.2.2.1 e0.2.2.2 + l1.toNat + q1 + q2 < 2 ^ 192 + omega + generalize h_e1 : extract s1.1 s1.2.1 s1.2.2 = e1 + have he1 : e1.1.toNat + 2 ^ 64 * accToNat e1.2.1 e1.2.2.1 e1.2.2.2 = + accToNat s1.1 s1.2.1 s1.2.2 := by + have h := extract_value s1.1 s1.2.1 s1.2.2 + rw [h_e1] at h + exact h + have he1bound : accToNat e1.2.1 e1.2.2.1 e1.2.2.2 < 2 ^ 128 := by + rw [← h_e1] + simpa [extract] using accToNat_lt_two128 s1.2.1 s1.2.2 + + generalize h_s2z : sumAdd e1.2.1 e1.2.2.1 e1.2.2.2 l2 = s2z + have hs2z : accToNat s2z.1 s2z.2.1 s2z.2.2 = + accToNat e1.2.1 e1.2.2.1 e1.2.2.2 + l2.toNat := by + rw [← h_s2z] + apply sumAdd_value + omega + generalize h_s2a : mulAdd s2z.1 s2z.2.1 s2z.2.2 n2 N_C_0 = s2a + have hs2a : accToNat s2a.1 s2a.2.1 s2a.2.2 = + accToNat s2z.1 s2z.2.1 s2z.2.2 + q3 := by + rw [← h_s2a] + apply mulAdd_value + rw [hs2z] + change accToNat e1.2.1 e1.2.2.1 e1.2.2.2 + l2.toNat + q3 < 2 ^ 192 + omega + generalize h_s2b : mulAdd s2a.1 s2a.2.1 s2a.2.2 n1 N_C_1 = s2b + have hs2b : accToNat s2b.1 s2b.2.1 s2b.2.2 = + accToNat s2a.1 s2a.2.1 s2a.2.2 + q4 := by + rw [← h_s2b] + apply mulAdd_value + rw [hs2a, hs2z] + change accToNat e1.2.1 e1.2.2.1 e1.2.2.2 + l2.toNat + q3 + q4 < 2 ^ 192 + omega + generalize h_s2 : sumAdd s2b.1 s2b.2.1 s2b.2.2 n0 = s2 + have hs2 : accToNat s2.1 s2.2.1 s2.2.2 = + accToNat s2b.1 s2b.2.1 s2b.2.2 + n0.toNat := by + rw [← h_s2] + apply sumAdd_value + rw [hs2b, hs2a, hs2z] + omega + generalize h_e2 : extract s2.1 s2.2.1 s2.2.2 = e2 + have he2 : e2.1.toNat + 2 ^ 64 * accToNat e2.2.1 e2.2.2.1 e2.2.2.2 = + accToNat s2.1 s2.2.1 s2.2.2 := by + have h := extract_value s2.1 s2.2.1 s2.2.2 + rw [h_e2] at h + exact h + have he2bound : accToNat e2.2.1 e2.2.2.1 e2.2.2.2 < 2 ^ 128 := by + rw [← h_e2] + simpa [extract] using accToNat_lt_two128 s2.2.1 s2.2.2 + + generalize h_s3z : sumAdd e2.2.1 e2.2.2.1 e2.2.2.2 l3 = s3z + have hs3z : accToNat s3z.1 s3z.2.1 s3z.2.2 = + accToNat e2.2.1 e2.2.2.1 e2.2.2.2 + l3.toNat := by + rw [← h_s3z] + apply sumAdd_value + omega + generalize h_s3a : mulAdd s3z.1 s3z.2.1 s3z.2.2 n3 N_C_0 = s3a + have hs3a : accToNat s3a.1 s3a.2.1 s3a.2.2 = + accToNat s3z.1 s3z.2.1 s3z.2.2 + q5 := by + rw [← h_s3a] + apply mulAdd_value + rw [hs3z] + change accToNat e2.2.1 e2.2.2.1 e2.2.2.2 + l3.toNat + q5 < 2 ^ 192 + omega + generalize h_s3b : mulAdd s3a.1 s3a.2.1 s3a.2.2 n2 N_C_1 = s3b + have hs3b : accToNat s3b.1 s3b.2.1 s3b.2.2 = + accToNat s3a.1 s3a.2.1 s3a.2.2 + q6 := by + rw [← h_s3b] + apply mulAdd_value + rw [hs3a, hs3z] + change accToNat e2.2.1 e2.2.2.1 e2.2.2.2 + l3.toNat + q5 + q6 < 2 ^ 192 + omega + generalize h_s3 : sumAdd s3b.1 s3b.2.1 s3b.2.2 n1 = s3 + have hs3 : accToNat s3.1 s3.2.1 s3.2.2 = + accToNat s3b.1 s3b.2.1 s3b.2.2 + n1.toNat := by + rw [← h_s3] + apply sumAdd_value + rw [hs3b, hs3a, hs3z] + omega + generalize h_e3 : extract s3.1 s3.2.1 s3.2.2 = e3 + have he3 : e3.1.toNat + 2 ^ 64 * accToNat e3.2.1 e3.2.2.1 e3.2.2.2 = + accToNat s3.1 s3.2.1 s3.2.2 := by + have h := extract_value s3.1 s3.2.1 s3.2.2 + rw [h_e3] at h + exact h + have he3bound : accToNat e3.2.1 e3.2.2.1 e3.2.2.2 < 2 ^ 128 := by + rw [← h_e3] + simpa [extract] using accToNat_lt_two128 s3.2.1 s3.2.2 + + generalize h_s4a : mulAdd e3.2.1 e3.2.2.1 e3.2.2.2 n3 N_C_1 = s4a + have hs4a : accToNat s4a.1 s4a.2.1 s4a.2.2 = + accToNat e3.2.1 e3.2.2.1 e3.2.2.2 + q7 := by + rw [← h_s4a] + apply mulAdd_value + change accToNat e3.2.1 e3.2.2.1 e3.2.2.2 + q7 < 2 ^ 192 + omega + generalize h_s4 : sumAdd s4a.1 s4a.2.1 s4a.2.2 n2 = s4 + have hs4 : accToNat s4.1 s4.2.1 s4.2.2 = + accToNat s4a.1 s4a.2.1 s4a.2.2 + n2.toNat := by + rw [← h_s4] + apply sumAdd_value + rw [hs4a] + omega + generalize h_e4 : extract s4.1 s4.2.1 s4.2.2 = e4 + have he4 : e4.1.toNat + 2 ^ 64 * accToNat e4.2.1 e4.2.2.1 e4.2.2.2 = + accToNat s4.1 s4.2.1 s4.2.2 := by + have h := extract_value s4.1 s4.2.1 s4.2.2 + rw [h_e4] at h + exact h + + have hpartial0 : + e0.1.toNat + 2 ^ 64 * accToNat e0.2.1 e0.2.2.1 e0.2.2.2 = + l0.toNat + q0 := + he0.trans hs0 + have hcol1 : accToNat s1.1 s1.2.1 s1.2.2 = + accToNat e0.2.1 e0.2.2.1 e0.2.2.2 + (l1.toNat + q1 + q2) := + addChain3 hs1z hs1a hs1 + have hpartial1 : + e0.1.toNat + 2 ^ 64 * e1.1.toNat + + 2 ^ 128 * accToNat e1.2.1 e1.2.2.1 e1.2.2.2 = + l0.toNat + q0 + 2 ^ 64 * (l1.toNat + q1 + q2) := by + have h := appendRadixColumn (shift := 2 ^ 64) hpartial0 hcol1 he1 + norm_num at h ⊢ + exact h + have hcol2 : accToNat s2.1 s2.2.1 s2.2.2 = + accToNat e1.2.1 e1.2.2.1 e1.2.2.2 + + (l2.toNat + q3 + q4 + n0.toNat) := + addChain4 hs2z hs2a hs2b hs2 + have hpartial2 : + e0.1.toNat + 2 ^ 64 * e1.1.toNat + 2 ^ 128 * e2.1.toNat + + 2 ^ 192 * accToNat e2.2.1 e2.2.2.1 e2.2.2.2 = + l0.toNat + q0 + 2 ^ 64 * (l1.toNat + q1 + q2) + + 2 ^ 128 * (l2.toNat + q3 + q4 + n0.toNat) := by + have h := appendRadixColumn (shift := 2 ^ 128) hpartial1 hcol2 he2 + norm_num at h ⊢ + exact h + have hcol3 : accToNat s3.1 s3.2.1 s3.2.2 = + accToNat e2.2.1 e2.2.2.1 e2.2.2.2 + + (l3.toNat + q5 + q6 + n1.toNat) := + addChain4 hs3z hs3a hs3b hs3 + have hpartial3 : + e0.1.toNat + 2 ^ 64 * e1.1.toNat + 2 ^ 128 * e2.1.toNat + + 2 ^ 192 * e3.1.toNat + + 2 ^ 256 * accToNat e3.2.1 e3.2.2.1 e3.2.2.2 = + l0.toNat + q0 + 2 ^ 64 * (l1.toNat + q1 + q2) + + 2 ^ 128 * (l2.toNat + q3 + q4 + n0.toNat) + + 2 ^ 192 * (l3.toNat + q5 + q6 + n1.toNat) := by + have h := appendRadixColumn (shift := 2 ^ 192) hpartial2 hcol3 he3 + norm_num at h ⊢ + exact h + have hcol4 : accToNat s4.1 s4.2.1 s4.2.2 = + accToNat e3.2.1 e3.2.2.1 e3.2.2.2 + (q7 + n2.toNat) := + addChain2 hs4a hs4 + have hpartial : + e0.1.toNat + 2 ^ 64 * e1.1.toNat + 2 ^ 128 * e2.1.toNat + + 2 ^ 192 * e3.1.toNat + 2 ^ 256 * e4.1.toNat + + 2 ^ 320 * accToNat e4.2.1 e4.2.2.1 e4.2.2.2 = + l0.toNat + q0 + 2 ^ 64 * (l1.toNat + q1 + q2) + + 2 ^ 128 * (l2.toNat + q3 + q4 + n0.toNat) + + 2 ^ 192 * (l3.toNat + q5 + q6 + n1.toNat) + + 2 ^ 256 * (q7 + n2.toNat) := by + have h := appendRadixColumn (shift := 2 ^ 256) hpartial3 hcol4 he4 + norm_num at h ⊢ + exact h + let low := (Repr.ofLimbs l0 l1 l2 l3).toNat + let high := (Repr.ofLimbs n0 n1 n2 n3).toNat + let comp := 2 ^ 256 - Secp256k1.Scalar.Basic.CARD + have hexpand : low + high * comp = + l0.toNat + q0 + 2 ^ 64 * (l1.toNat + q1 + q2) + + 2 ^ 128 * (l2.toNat + q3 + q4 + n0.toNat) + + 2 ^ 192 * (l3.toNat + q5 + q6 + n1.toNat) + + 2 ^ 256 * (q7 + n2.toNat) + 2 ^ 320 * n3.toNat := by + simp only [low, high, comp, Repr.toNat, Repr.ofLimbs, q0, q1, q2, q3, q4, + q5, q6, q7] + norm_num [TWO64, TWO128, TWO192, N_C_0, N_C_1, UInt64.toNat_ofNat, + Secp256k1.Scalar.Basic.CARD] + ring + have hlow := Repr.toNat_lt_two256 (Repr.ofLimbs l0 l1 l2 l3) + have hhigh := Repr.toNat_lt_two256 (Repr.ofLimbs n0 n1 n2 n3) + have htotal : low + high * comp < 2 ^ 448 := by + change low < 2 ^ 256 at hlow + change high < 2 ^ 256 at hhigh + norm_num [comp, Secp256k1.Scalar.Basic.CARD] at hexpand ⊢ + omega + have hlastBound : accToNat e4.2.1 e4.2.2.1 e4.2.2.2 + n3.toNat < 2 ^ 128 := by + norm_num at hpartial hexpand htotal ⊢ + omega + generalize h_s5 : sumAddFast e4.2.1 e4.2.2.1 e4.2.2.2 n3 = s5 + have hs5 : accToNat s5.1 s5.2.1 s5.2.2 = + accToNat e4.2.1 e4.2.2.1 e4.2.2.2 + n3.toNat := by + rw [← h_s5] + apply sumAddFast_value + · rw [← h_e4] + simp [extract] + · exact hlastBound + generalize h_e5 : extractFast s5.1 s5.2.1 s5.2.2 = e5 + have he5 : e5.1.toNat + 2 ^ 64 * accToNat e5.2.1 e5.2.2.1 e5.2.2.2 = + accToNat s5.1 s5.2.1 s5.2.2 := by + have h := extractFast_value s5.1 s5.2.1 s5.2.2 (by + rw [← h_s5] + simp [sumAddFast] + rw [← h_e4] + simp [extract]) + rw [h_e5] at h + exact h + have he5tail : accToNat e5.2.1 e5.2.2.1 e5.2.2.2 = e5.2.1.toNat := by + rw [← h_e5] + simp [extractFast, accToNat] + have hout : limbs7ToNat + (e0.1, e1.1, e2.1, e3.1, e4.1, e5.1, e5.2.1) = low + high * comp := by + unfold limbs7ToNat + norm_num at hpartial hexpand hs5 he5 he5tail ⊢ + omega + have hcolumns : reduce512To385Raw l0 l1 l2 l3 n0 n1 n2 n3 = + (e0.1, e1.1, e2.1, e3.1, e4.1, e5.1, e5.2.1) := by + simpa only [h_s0, h_e0, h_s1z, h_s1a, h_s1, h_e1, h_s2z, h_s2a, + h_s2b, h_s2, h_e2, h_s3z, h_s3a, h_s3b, h_s3, h_e3, h_s4a, h_s4, + h_e4, h_s5, h_e5] using + reduce512To385Raw_columns l0 l1 l2 l3 n0 n1 n2 n3 + calc + limbs7ToNat (reduce512To385Raw l0 l1 l2 l3 n0 n1 n2 n3) = + limbs7ToNat (e0.1, e1.1, e2.1, e3.1, e4.1, e5.1, e5.2.1) := by + exact congrArg limbs7ToNat hcolumns + _ = low + high * comp := hout + +/-- The first reduction stage fits in the 385 bits assumed by the next stage. -/ +private theorem reduce512To385Raw_bound + (l0 l1 l2 l3 n0 n1 n2 n3 : UInt64) : + limbs7ToNat (reduce512To385Raw l0 l1 l2 l3 n0 n1 n2 n3) < 2 ^ 385 := by + rw [reduce512To385Raw_value] + have hlow := Repr.toNat_lt_two256 (Repr.ofLimbs l0 l1 l2 l3) + have hhigh := Repr.toNat_lt_two256 (Repr.ofLimbs n0 n1 n2 n3) + norm_num [Secp256k1.Scalar.Basic.CARD] at hlow hhigh ⊢ + omega + +/-- Second libsecp256k1 reduction stage: fold limbs four through six with + `2^256 - n`, producing at most 258 bits. -/ +@[inline] private def reduce385To258Raw + (m0 m1 m2 m3 m4 m5 m6 : UInt64) : Limbs4Carry := + let (c0, c1, c2) := mulAddFast m0 0 0 m4 N_C_0 + let (p0, c0, c1, c2) := extractFast c0 c1 c2 + let (c0, c1, c2) := sumAddFast c0 c1 c2 m1 + let (c0, c1, c2) := mulAdd c0 c1 c2 m5 N_C_0 + let (c0, c1, c2) := mulAdd c0 c1 c2 m4 N_C_1 + let (p1, c0, c1, c2) := extract c0 c1 c2 + let (c0, c1, c2) := sumAdd c0 c1 c2 m2 + let (c0, c1, c2) := mulAdd c0 c1 c2 m6 N_C_0 + let (c0, c1, c2) := mulAdd c0 c1 c2 m5 N_C_1 + let (c0, c1, c2) := sumAdd c0 c1 c2 m4 + let (p2, c0, c1, c2) := extract c0 c1 c2 + let (c0, c1, c2) := sumAddFast c0 c1 c2 m3 + let (c0, c1, c2) := mulAddFast c0 c1 c2 m6 N_C_1 + let (c0, c1, c2) := sumAddFast c0 c1 c2 m5 + let (p3, c0, _, _) := extractFast c0 c1 c2 + let p4 := c0 + m6 + (p0, p1, p2, p3, p4) + +/-- Expose the four second-stage reduction columns without unfolding their kernels. -/ +private theorem reduce385To258Raw_columns (m0 m1 m2 m3 m4 m5 m6 : UInt64) : + reduce385To258Raw m0 m1 m2 m3 m4 m5 m6 = + let s0 := mulAddFast m0 0 0 m4 N_C_0 + let e0 := extractFast s0.1 s0.2.1 s0.2.2 + let s1z := sumAddFast e0.2.1 e0.2.2.1 e0.2.2.2 m1 + let s1a := mulAdd s1z.1 s1z.2.1 s1z.2.2 m5 N_C_0 + let s1 := mulAdd s1a.1 s1a.2.1 s1a.2.2 m4 N_C_1 + let e1 := extract s1.1 s1.2.1 s1.2.2 + let s2z := sumAdd e1.2.1 e1.2.2.1 e1.2.2.2 m2 + let s2a := mulAdd s2z.1 s2z.2.1 s2z.2.2 m6 N_C_0 + let s2b := mulAdd s2a.1 s2a.2.1 s2a.2.2 m5 N_C_1 + let s2 := sumAdd s2b.1 s2b.2.1 s2b.2.2 m4 + let e2 := extract s2.1 s2.2.1 s2.2.2 + let s3z := sumAddFast e2.2.1 e2.2.2.1 e2.2.2.2 m3 + let s3a := mulAddFast s3z.1 s3z.2.1 s3z.2.2 m6 N_C_1 + let s3 := sumAddFast s3a.1 s3a.2.1 s3a.2.2 m5 + let e3 := extractFast s3.1 s3.2.1 s3.2.2 + (e0.1, e1.1, e2.1, e3.1, e3.2.1 + m6) := rfl + +/-- Exact value equation for the second reduction stage. -/ +private theorem reduce385To258Raw_value + (m0 m1 m2 m3 m4 m5 m6 : UInt64) + (hinput : limbs7ToNat (m0, m1, m2, m3, m4, m5, m6) < 2 ^ 385) : + limbs5ToNat (reduce385To258Raw m0 m1 m2 m3 m4 m5 m6) = + (Repr.ofLimbs m0 m1 m2 m3).toNat + + (m4.toNat + 2 ^ 64 * m5.toNat + 2 ^ 128 * m6.toNat) * + (2 ^ 256 - Secp256k1.Scalar.Basic.CARD) := by + let q0 := m4.toNat * N_C_0.toNat + let q1 := m5.toNat * N_C_0.toNat + let q2 := m4.toNat * N_C_1.toNat + let q3 := m6.toNat * N_C_0.toNat + let q4 := m5.toNat * N_C_1.toNat + let q5 := m6.toNat * N_C_1.toNat + have hq0 : q0 < 2 ^ 64 * N_C_0.toNat := mulNC0_bound m4 + have hq1 : q1 < 2 ^ 64 * N_C_0.toNat := mulNC0_bound m5 + have hq2 : q2 < 2 ^ 64 * N_C_1.toNat := mulNC1_bound m4 + have hq3 : q3 < 2 ^ 64 * N_C_0.toNat := mulNC0_bound m6 + have hq4 : q4 < 2 ^ 64 * N_C_1.toNat := mulNC1_bound m5 + have hq5 : q5 < 2 ^ 64 * N_C_1.toNat := mulNC1_bound m6 + norm_num [N_C_0, N_C_1, UInt64.toNat_ofNat] at hq0 hq1 hq2 hq3 hq4 hq5 + have hm0 := m0.toNat_lt_size + have hm1 := m1.toNat_lt_size + have hm2 := m2.toNat_lt_size + have hm3 := m3.toNat_lt_size + have hm4 := m4.toNat_lt_size + have hm5 := m5.toNat_lt_size + have hm6 := m6.toNat_lt_size + norm_num [UInt64.size] at hm0 hm1 hm2 hm3 hm4 hm5 hm6 + + generalize h_s0 : mulAddFast m0 0 0 m4 N_C_0 = s0 + have hs0 : accToNat s0.1 s0.2.1 s0.2.2 = m0.toNat + q0 := by + rw [← h_s0] + apply mulAddFast_value + · rfl + · change m0.toNat + q0 < 2 ^ 128 + omega + generalize h_e0 : extractFast s0.1 s0.2.1 s0.2.2 = e0 + have he0 : e0.1.toNat + 2 ^ 64 * accToNat e0.2.1 e0.2.2.1 e0.2.2.2 = + accToNat s0.1 s0.2.1 s0.2.2 := by + have h := extractFast_value s0.1 s0.2.1 s0.2.2 (by + rw [← h_s0] + simp [mulAddFast]) + rw [h_e0] at h + exact h + have he0bound : accToNat e0.2.1 e0.2.2.1 e0.2.2.2 < 2 ^ 64 := by + rw [← h_e0] + simpa [extractFast] using accToNat_lt_two64 s0.2.1 + + generalize h_s1z : sumAddFast e0.2.1 e0.2.2.1 e0.2.2.2 m1 = s1z + have hs1z : accToNat s1z.1 s1z.2.1 s1z.2.2 = + accToNat e0.2.1 e0.2.2.1 e0.2.2.2 + m1.toNat := by + rw [← h_s1z] + apply sumAddFast_value + · rw [← h_e0] + simp [extractFast] + · omega + generalize h_s1a : mulAdd s1z.1 s1z.2.1 s1z.2.2 m5 N_C_0 = s1a + have hs1a : accToNat s1a.1 s1a.2.1 s1a.2.2 = + accToNat s1z.1 s1z.2.1 s1z.2.2 + q1 := by + rw [← h_s1a] + apply mulAdd_value + rw [hs1z] + change accToNat e0.2.1 e0.2.2.1 e0.2.2.2 + m1.toNat + q1 < 2 ^ 192 + omega + generalize h_s1 : mulAdd s1a.1 s1a.2.1 s1a.2.2 m4 N_C_1 = s1 + have hs1 : accToNat s1.1 s1.2.1 s1.2.2 = + accToNat s1a.1 s1a.2.1 s1a.2.2 + q2 := by + rw [← h_s1] + apply mulAdd_value + rw [hs1a, hs1z] + change accToNat e0.2.1 e0.2.2.1 e0.2.2.2 + m1.toNat + q1 + q2 < 2 ^ 192 + omega + generalize h_e1 : extract s1.1 s1.2.1 s1.2.2 = e1 + have he1 : e1.1.toNat + 2 ^ 64 * accToNat e1.2.1 e1.2.2.1 e1.2.2.2 = + accToNat s1.1 s1.2.1 s1.2.2 := by + have h := extract_value s1.1 s1.2.1 s1.2.2 + rw [h_e1] at h + exact h + have he1bound : accToNat e1.2.1 e1.2.2.1 e1.2.2.2 < 2 ^ 128 := by + rw [← h_e1] + simpa [extract] using accToNat_lt_two128 s1.2.1 s1.2.2 + + generalize h_s2z : sumAdd e1.2.1 e1.2.2.1 e1.2.2.2 m2 = s2z + have hs2z : accToNat s2z.1 s2z.2.1 s2z.2.2 = + accToNat e1.2.1 e1.2.2.1 e1.2.2.2 + m2.toNat := by + rw [← h_s2z] + apply sumAdd_value + omega + generalize h_s2a : mulAdd s2z.1 s2z.2.1 s2z.2.2 m6 N_C_0 = s2a + have hs2a : accToNat s2a.1 s2a.2.1 s2a.2.2 = + accToNat s2z.1 s2z.2.1 s2z.2.2 + q3 := by + rw [← h_s2a] + apply mulAdd_value + rw [hs2z] + change accToNat e1.2.1 e1.2.2.1 e1.2.2.2 + m2.toNat + q3 < 2 ^ 192 + omega + generalize h_s2b : mulAdd s2a.1 s2a.2.1 s2a.2.2 m5 N_C_1 = s2b + have hs2b : accToNat s2b.1 s2b.2.1 s2b.2.2 = + accToNat s2a.1 s2a.2.1 s2a.2.2 + q4 := by + rw [← h_s2b] + apply mulAdd_value + rw [hs2a, hs2z] + change accToNat e1.2.1 e1.2.2.1 e1.2.2.2 + m2.toNat + q3 + q4 < 2 ^ 192 + omega + generalize h_s2 : sumAdd s2b.1 s2b.2.1 s2b.2.2 m4 = s2 + have hs2 : accToNat s2.1 s2.2.1 s2.2.2 = + accToNat s2b.1 s2b.2.1 s2b.2.2 + m4.toNat := by + rw [← h_s2] + apply sumAdd_value + rw [hs2b, hs2a, hs2z] + omega + generalize h_e2 : extract s2.1 s2.2.1 s2.2.2 = e2 + have he2 : e2.1.toNat + 2 ^ 64 * accToNat e2.2.1 e2.2.2.1 e2.2.2.2 = + accToNat s2.1 s2.2.1 s2.2.2 := by + have h := extract_value s2.1 s2.2.1 s2.2.2 + rw [h_e2] at h + exact h + + have hpartial0 : + e0.1.toNat + 2 ^ 64 * accToNat e0.2.1 e0.2.2.1 e0.2.2.2 = + m0.toNat + q0 := + he0.trans hs0 + have hcol1 : accToNat s1.1 s1.2.1 s1.2.2 = + accToNat e0.2.1 e0.2.2.1 e0.2.2.2 + (m1.toNat + q1 + q2) := + addChain3 hs1z hs1a hs1 + have hpartial1 : + e0.1.toNat + 2 ^ 64 * e1.1.toNat + + 2 ^ 128 * accToNat e1.2.1 e1.2.2.1 e1.2.2.2 = + m0.toNat + q0 + 2 ^ 64 * (m1.toNat + q1 + q2) := by + have h := appendRadixColumn (shift := 2 ^ 64) hpartial0 hcol1 he1 + norm_num at h ⊢ + exact h + have hcol2 : accToNat s2.1 s2.2.1 s2.2.2 = + accToNat e1.2.1 e1.2.2.1 e1.2.2.2 + + (m2.toNat + q3 + q4 + m4.toNat) := + addChain4 hs2z hs2a hs2b hs2 + have hpartial : + e0.1.toNat + 2 ^ 64 * e1.1.toNat + 2 ^ 128 * e2.1.toNat + + 2 ^ 192 * accToNat e2.2.1 e2.2.2.1 e2.2.2.2 = + m0.toNat + q0 + 2 ^ 64 * (m1.toNat + q1 + q2) + + 2 ^ 128 * (m2.toNat + q3 + q4 + m4.toNat) := by + have h := appendRadixColumn (shift := 2 ^ 128) hpartial1 hcol2 he2 + norm_num at h ⊢ + exact h + let low := (Repr.ofLimbs m0 m1 m2 m3).toNat + let high := m4.toNat + 2 ^ 64 * m5.toNat + 2 ^ 128 * m6.toNat + let comp := 2 ^ 256 - Secp256k1.Scalar.Basic.CARD + have hexpand : low + high * comp = + m0.toNat + q0 + 2 ^ 64 * (m1.toNat + q1 + q2) + + 2 ^ 128 * (m2.toNat + q3 + q4 + m4.toNat) + + 2 ^ 192 * (m3.toNat + q5 + m5.toNat) + 2 ^ 256 * m6.toNat := by + simp only [low, high, comp, Repr.toNat, Repr.ofLimbs, q0, q1, q2, q3, q4, q5] + norm_num [TWO64, TWO128, TWO192, N_C_0, N_C_1, UInt64.toNat_ofNat, + Secp256k1.Scalar.Basic.CARD] + ring + have hhigh : high < 2 ^ 129 := by + unfold limbs7ToNat at hinput + dsimp [high] + norm_num at hinput ⊢ + omega + have hlow := Repr.toNat_lt_two256 (Repr.ofLimbs m0 m1 m2 m3) + have htarget : low + high * comp < 2 ^ 259 := by + change low < 2 ^ 256 at hlow + norm_num [comp, Secp256k1.Scalar.Basic.CARD] at hlow hhigh ⊢ + omega + have htail : + accToNat e2.2.1 e2.2.2.1 e2.2.2.2 + m3.toNat + q5 + m5.toNat + + 2 ^ 64 * m6.toNat < 2 ^ 67 := by + clear hq0 hq1 hq2 hq3 hq4 hq5 hm0 hm1 hm2 hm3 hm4 hm5 hm6 + clear he0bound he1bound hs0 he0 hs1z hs1a hs1 he1 hs2z hs2a hs2b hs2 he2 + clear hinput hhigh hlow + norm_num at hpartial hexpand htarget ⊢ + omega + + generalize h_s3z : sumAddFast e2.2.1 e2.2.2.1 e2.2.2.2 m3 = s3z + have hs3z : accToNat s3z.1 s3z.2.1 s3z.2.2 = + accToNat e2.2.1 e2.2.2.1 e2.2.2.2 + m3.toNat := by + rw [← h_s3z] + apply sumAddFast_value + · rw [← h_e2] + simp [extract] + · omega + generalize h_s3a : mulAddFast s3z.1 s3z.2.1 s3z.2.2 m6 N_C_1 = s3a + have hs3a : accToNat s3a.1 s3a.2.1 s3a.2.2 = + accToNat s3z.1 s3z.2.1 s3z.2.2 + q5 := by + rw [← h_s3a] + apply mulAddFast_value + · rw [← h_s3z] + simp [sumAddFast] + rw [← h_e2] + simp [extract] + · rw [hs3z] + omega + generalize h_s3 : sumAddFast s3a.1 s3a.2.1 s3a.2.2 m5 = s3 + have hs3 : accToNat s3.1 s3.2.1 s3.2.2 = + accToNat s3a.1 s3a.2.1 s3a.2.2 + m5.toNat := by + rw [← h_s3] + apply sumAddFast_value + · rw [← h_s3a] + simp [mulAddFast] + rw [← h_s3z] + simp [sumAddFast] + rw [← h_e2] + simp [extract] + · rw [hs3a, hs3z] + omega + generalize h_e3 : extractFast s3.1 s3.2.1 s3.2.2 = e3 + have he3 : e3.1.toNat + 2 ^ 64 * accToNat e3.2.1 e3.2.2.1 e3.2.2.2 = + accToNat s3.1 s3.2.1 s3.2.2 := by + have h := extractFast_value s3.1 s3.2.1 s3.2.2 (by + rw [← h_s3] + simp [sumAddFast] + rw [← h_s3a] + simp [mulAddFast] + rw [← h_s3z] + simp [sumAddFast] + rw [← h_e2] + simp [extract]) + rw [h_e3] at h + exact h + have he3tail : accToNat e3.2.1 e3.2.2.1 e3.2.2.2 = e3.2.1.toNat := by + rw [← h_e3] + simp [extractFast, accToNat] + have hp4bound : e3.2.1.toNat + m6.toNat < 2 ^ 64 := by + norm_num at htail hs3z hs3a hs3 he3 he3tail ⊢ + omega + have hp4 : (e3.2.1 + m6).toNat = e3.2.1.toNat + m6.toNat := by + rw [UInt64.toNat_add, Nat.mod_eq_of_lt hp4bound] + have hcol3 : e3.1.toNat + 2 ^ 64 * accToNat e3.2.1 e3.2.2.1 e3.2.2.2 = + accToNat e2.2.1 e2.2.2.1 e2.2.2.2 + (m3.toNat + q5 + m5.toNat) := + he3.trans (addChain3 hs3z hs3a hs3) + have hpartial3 : + e0.1.toNat + 2 ^ 64 * e1.1.toNat + 2 ^ 128 * e2.1.toNat + + 2 ^ 192 * e3.1.toNat + + 2 ^ 256 * accToNat e3.2.1 e3.2.2.1 e3.2.2.2 = + m0.toNat + q0 + 2 ^ 64 * (m1.toNat + q1 + q2) + + 2 ^ 128 * (m2.toNat + q3 + q4 + m4.toNat) + + 2 ^ 192 * (m3.toNat + q5 + m5.toNat) := by + have h := appendCompletedColumn (shift := 2 ^ 192) hpartial hcol3 + norm_num at h ⊢ + exact h + have hout : limbs5ToNat (e0.1, e1.1, e2.1, e3.1, e3.2.1 + m6) = + low + high * comp := by + change e0.1.toNat + e1.1.toNat * TWO64 + e2.1.toNat * TWO128 + + e3.1.toNat * TWO192 + 2 ^ 256 * (e3.2.1 + m6).toNat = low + high * comp + rw [hp4] + calc + e0.1.toNat + e1.1.toNat * TWO64 + e2.1.toNat * TWO128 + + e3.1.toNat * TWO192 + + 2 ^ 256 * (e3.2.1.toNat + m6.toNat) = + (e0.1.toNat + 2 ^ 64 * e1.1.toNat + 2 ^ 128 * e2.1.toNat + + 2 ^ 192 * e3.1.toNat + + 2 ^ 256 * accToNat e3.2.1 e3.2.2.1 e3.2.2.2) + + 2 ^ 256 * m6.toNat := by + rw [he3tail] + norm_num [TWO64, TWO128, TWO192] + ring + _ = (m0.toNat + q0 + 2 ^ 64 * (m1.toNat + q1 + q2) + + 2 ^ 128 * (m2.toNat + q3 + q4 + m4.toNat) + + 2 ^ 192 * (m3.toNat + q5 + m5.toNat)) + 2 ^ 256 * m6.toNat := by + rw [hpartial3] + _ = low + high * comp := hexpand.symm + have hcolumns : reduce385To258Raw m0 m1 m2 m3 m4 m5 m6 = + (e0.1, e1.1, e2.1, e3.1, e3.2.1 + m6) := by + simpa only [h_s0, h_e0, h_s1z, h_s1a, h_s1, h_e1, h_s2z, h_s2a, + h_s2b, h_s2, h_e2, h_s3z, h_s3a, h_s3, h_e3] using + reduce385To258Raw_columns m0 m1 m2 m3 m4 m5 m6 + calc + limbs5ToNat (reduce385To258Raw m0 m1 m2 m3 m4 m5 m6) = + limbs5ToNat (e0.1, e1.1, e2.1, e3.1, e3.2.1 + m6) := by + exact congrArg limbs5ToNat hcolumns + _ = low + high * comp := hout + +/-- The second reduction stage fits in 258 bits. -/ +private theorem reduce385To258Raw_bound + (m0 m1 m2 m3 m4 m5 m6 : UInt64) + (hinput : limbs7ToNat (m0, m1, m2, m3, m4, m5, m6) < 2 ^ 385) : + limbs5ToNat (reduce385To258Raw m0 m1 m2 m3 m4 m5 m6) < 2 ^ 259 := by + rw [reduce385To258Raw_value _ _ _ _ _ _ _ hinput] + let low := (Repr.ofLimbs m0 m1 m2 m3).toNat + let high := m4.toNat + 2 ^ 64 * m5.toNat + 2 ^ 128 * m6.toNat + have hhigh : high < 2 ^ 129 := by + unfold limbs7ToNat at hinput + dsimp [high] + norm_num at hinput ⊢ + omega + have hlow := Repr.toNat_lt_two256 (Repr.ofLimbs m0 m1 m2 m3) + change low < 2 ^ 256 at hlow + norm_num [Secp256k1.Scalar.Basic.CARD] at hlow hhigh ⊢ + omega + +/-- C `secp256k1_scalar_reduce_512`, non-asm path. -/ +@[inline] def reduce512Raw (l0 l1 l2 l3 l4 l5 l6 l7 : UInt64) : Limbs4 := + let (m0, m1, m2, m3, m4, m5, m6) := + reduce512To385Raw l0 l1 l2 l3 l4 l5 l6 l7 + let (p0, p1, p2, p3, p4) := reduce385To258Raw m0 m1 m2 m3 m4 m5 m6 + let (r0, r1, r2, r3, carry) := reduce258Raw p0 p1 p2 p3 p4 + reduceRaw r0 r1 r2 r3 (carry != 0 || checkOverflowRaw r0 r1 r2 r3) + +/-- Adding one scalar order does not change a natural number's scalar-field cast. -/ +private theorem cast_eq_of_add_card_eq (r x : Nat) + (h : r + Secp256k1.Scalar.Basic.CARD = x) : + (r : Secp256k1.Scalar.Basic.Field) = (x : Secp256k1.Scalar.Basic.Field) := by + apply ZMod.val_injective + simp only [ZMod.val_natCast] + rw [← h, Nat.add_mod] + simp + +/-- Replacing one factor `2^256` by `2^256 - n` preserves the scalar-field cast. -/ +private theorem foldComplement_cast (low high : Nat) : + ((low + high * (2 ^ 256 - Secp256k1.Scalar.Basic.CARD) : Nat) : + Secp256k1.Scalar.Basic.Field) = + ((low + 2 ^ 256 * high : Nat) : Secp256k1.Scalar.Basic.Field) := by + have hcard : (Secp256k1.Scalar.Basic.CARD : Secp256k1.Scalar.Basic.Field) = 0 := + CharP.cast_eq_zero _ _ + rw [Nat.cast_add, Nat.cast_add, Nat.cast_mul, Nat.cast_mul] + rw [Nat.cast_sub (by norm_num [Secp256k1.Scalar.Basic.CARD])] + rw [hcard] + ring + +/-- The scalar order is strictly below the 256-bit radix. -/ +private theorem card_lt_two256 : Secp256k1.Scalar.Basic.CARD < 2 ^ 256 := by + norm_num [Secp256k1.Scalar.Basic.CARD] + +/-- The scalar-order complement fills the gap to the 256-bit radix. -/ +private theorem complement_add_card : + (2 ^ 256 - Secp256k1.Scalar.Basic.CARD) + + Secp256k1.Scalar.Basic.CARD = 2 ^ 256 := + Nat.sub_add_cancel (Nat.le_of_lt card_lt_two256) + +/-- Final conditional subtraction when the folded value has no high carry. -/ +private theorem finishReduceRaw_zero_spec (q0 q1 q2 q3 : UInt64) + (htwo : limbs5ToNat (q0, q1, q2, q3, 0) < + 2 * Secp256k1.Scalar.Basic.CARD) : + let r := reduceRaw q0 q1 q2 q3 (checkOverflowRaw q0 q1 q2 q3) + (Repr.ofLimbs r.1 r.2.1 r.2.2.1 r.2.2.2).toNat < + Secp256k1.Scalar.Basic.CARD ∧ + ((Repr.ofLimbs r.1 r.2.1 r.2.2.1 r.2.2.2).toNat : + Secp256k1.Scalar.Basic.Field) = + (limbs5ToNat (q0, q1, q2, q3, 0) : + Secp256k1.Scalar.Basic.Field) := by + let low := (Repr.ofLimbs q0 q1 q2 q3).toNat + have hqLow : limbs5ToNat (q0, q1, q2, q3, 0) = low := by + unfold limbs5ToNat low + norm_num + have hcheck := checkOverflowRaw_eq_decide q0 q1 q2 q3 + change checkOverflowRaw q0 q1 q2 q3 = + decide (low ≥ Secp256k1.Scalar.Basic.CARD) at hcheck + by_cases hge : Secp256k1.Scalar.Basic.CARD ≤ low + · have hcheckTrue : checkOverflowRaw q0 q1 q2 q3 = true := by + rw [hcheck] + simp [hge] + have hreduce := reduceRaw_true_of_ge q0 q1 q2 q3 hge + rw [hcheckTrue] + dsimp only + rw [hreduce] + constructor + · rw [hqLow] at htwo + omega + · apply cast_eq_of_add_card_eq + rw [hqLow] + exact Nat.sub_add_cancel hge + · have hlt : low < Secp256k1.Scalar.Basic.CARD := Nat.lt_of_not_ge hge + have hcheckFalse : checkOverflowRaw q0 q1 q2 q3 = false := by + rw [hcheck] + simp [hlt] + simp [hcheckFalse, reduceRaw] + exact ⟨hlt, by rw [hqLow]⟩ + +/-- With one high carry, the reduced value plus the order is the folded input. -/ +private theorem finishReduceRaw_carry_value (q0 q1 q2 q3 carry : UInt64) + (hc : carry ≠ 0) (hcarry : carry.toNat ≤ 1) + (htwo : limbs5ToNat (q0, q1, q2, q3, carry) < + 2 * Secp256k1.Scalar.Basic.CARD) : + let r := reduceRaw q0 q1 q2 q3 true + (Repr.ofLimbs r.1 r.2.1 r.2.2.1 r.2.2.2).toNat + + Secp256k1.Scalar.Basic.CARD = + limbs5ToNat (q0, q1, q2, q3, carry) := by + let low := (Repr.ofLimbs q0 q1 q2 q3).toNat + have hdecomp : limbs5ToNat (q0, q1, q2, q3, carry) = + low + 2 ^ 256 * carry.toNat := rfl + have hcarryNat : carry.toNat = 1 := by + have hne : carry.toNat ≠ 0 := by + intro hz + apply hc + apply UInt64.toNat.inj + simpa using hz + omega + have hlowLt : low < Secp256k1.Scalar.Basic.CARD := by + rw [hdecomp, hcarryNat] at htwo + norm_num only [Nat.mul_one] at htwo + by_contra hnot + have hge : Secp256k1.Scalar.Basic.CARD ≤ low := Nat.le_of_not_gt hnot + have hcard := card_lt_two256 + have htwice : 2 * Secp256k1.Scalar.Basic.CARD < + Secp256k1.Scalar.Basic.CARD + 2 ^ 256 := by omega + have hsum : Secp256k1.Scalar.Basic.CARD + 2 ^ 256 ≤ low + 2 ^ 256 := + Nat.add_le_add_right hge _ + have hcontra : 2 * Secp256k1.Scalar.Basic.CARD < + 2 * Secp256k1.Scalar.Basic.CARD := + lt_of_lt_of_le (lt_of_lt_of_le htwice hsum) (Nat.le_of_lt htwo) + exact (Nat.lt_irrefl _ hcontra) + have hreduce := reduceRaw_true_of_lt q0 q1 q2 q3 hlowLt + have harith : + ((Repr.ofLimbs q0 q1 q2 q3).toNat + + (2 ^ 256 - Secp256k1.Scalar.Basic.CARD)) + + Secp256k1.Scalar.Basic.CARD = + limbs5ToNat (q0, q1, q2, q3, carry) := by + change (low + (2 ^ 256 - Secp256k1.Scalar.Basic.CARD)) + + Secp256k1.Scalar.Basic.CARD = limbs5ToNat (q0, q1, q2, q3, carry) + rw [Nat.add_assoc, complement_add_card, hdecomp, hcarryNat] + norm_num + exact (congrArg (fun x => x + Secp256k1.Scalar.Basic.CARD) hreduce).trans harith + +/-- Final conditional subtraction when the folded value has one high carry. -/ +private theorem finishReduceRaw_carry_spec (q0 q1 q2 q3 carry : UInt64) + (hc : carry ≠ 0) (hcarry : carry.toNat ≤ 1) + (htwo : limbs5ToNat (q0, q1, q2, q3, carry) < + 2 * Secp256k1.Scalar.Basic.CARD) : + let r := reduceRaw q0 q1 q2 q3 true + (Repr.ofLimbs r.1 r.2.1 r.2.2.1 r.2.2.2).toNat < + Secp256k1.Scalar.Basic.CARD ∧ + ((Repr.ofLimbs r.1 r.2.1 r.2.2.1 r.2.2.2).toNat : + Secp256k1.Scalar.Basic.Field) = + (limbs5ToNat (q0, q1, q2, q3, carry) : + Secp256k1.Scalar.Basic.Field) := by + have hv := finishReduceRaw_carry_value q0 q1 q2 q3 carry hc hcarry htwo + constructor + · dsimp only at hv ⊢ + omega + · exact cast_eq_of_add_card_eq _ _ hv + +/-- Final conditional subtraction for a folded value below twice the scalar order. -/ +private theorem finishReduceRaw_spec (q0 q1 q2 q3 carry : UInt64) + (hcarry : carry.toNat ≤ 1) + (htwo : limbs5ToNat (q0, q1, q2, q3, carry) < + 2 * Secp256k1.Scalar.Basic.CARD) : + let r := reduceRaw q0 q1 q2 q3 + (carry != 0 || checkOverflowRaw q0 q1 q2 q3) + (Repr.ofLimbs r.1 r.2.1 r.2.2.1 r.2.2.2).toNat < + Secp256k1.Scalar.Basic.CARD ∧ + ((Repr.ofLimbs r.1 r.2.1 r.2.2.1 r.2.2.2).toNat : + Secp256k1.Scalar.Basic.Field) = + (limbs5ToNat (q0, q1, q2, q3, carry) : + Secp256k1.Scalar.Basic.Field) := by + by_cases hc : carry = 0 + · subst carry + have hflag : (((0 : UInt64) != 0) || checkOverflowRaw q0 q1 q2 q3) = + checkOverflowRaw q0 q1 q2 q3 := by simp + rw [hflag] + exact finishReduceRaw_zero_spec q0 q1 q2 q3 htwo + · have h := finishReduceRaw_carry_spec q0 q1 q2 q3 carry hc hcarry htwo + have hflag : ((carry != 0) || checkOverflowRaw q0 q1 q2 q3) = true := by + simp [hc] + rw [hflag] + exact h + +/-- The complete libsecp256k1 reducer returns a canonical scalar with the same + scalar-field value as its eight-limb input. -/ +private theorem reduce512Raw_spec (l0 l1 l2 l3 l4 l5 l6 l7 : UInt64) : + let r := reduce512Raw l0 l1 l2 l3 l4 l5 l6 l7 + (Repr.ofLimbs r.1 r.2.1 r.2.2.1 r.2.2.2).toNat < + Secp256k1.Scalar.Basic.CARD ∧ + ((Repr.ofLimbs r.1 r.2.1 r.2.2.1 r.2.2.2).toNat : + Secp256k1.Scalar.Basic.Field) = + (limbs8ToNat (l0, l1, l2, l3, l4, l5, l6, l7) : + Secp256k1.Scalar.Basic.Field) := by + generalize hmEq : reduce512To385Raw l0 l1 l2 l3 l4 l5 l6 l7 = m + have hmValue := reduce512To385Raw_value l0 l1 l2 l3 l4 l5 l6 l7 + have hmBound := reduce512To385Raw_bound l0 l1 l2 l3 l4 l5 l6 l7 + rw [hmEq] at hmValue hmBound + change limbs7ToNat m = _ at hmValue + change limbs7ToNat m < 2 ^ 385 at hmBound + rcases m with ⟨m0, m1, m2, m3, m4, m5, m6⟩ + generalize hpEq : reduce385To258Raw m0 m1 m2 m3 m4 m5 m6 = p + have hpValue := reduce385To258Raw_value m0 m1 m2 m3 m4 m5 m6 hmBound + have hpBound := reduce385To258Raw_bound m0 m1 m2 m3 m4 m5 m6 hmBound + rw [hpEq] at hpValue hpBound + change limbs5ToNat p = _ at hpValue + change limbs5ToNat p < 2 ^ 259 at hpBound + rcases p with ⟨p0, p1, p2, p3, p4⟩ + generalize hqEq : reduce258Raw p0 p1 p2 p3 p4 = q + have hqValue := reduce258Raw_value p0 p1 p2 p3 p4 hpBound + have hqBound := reduce258Raw_bound p0 p1 p2 p3 p4 hpBound + have hqCarry := reduce258Raw_carry_le_one p0 p1 p2 p3 p4 hpBound + rw [hqEq] at hqValue hqBound hqCarry + change limbs5ToNat q = _ at hqValue + change limbs5ToNat q < 2 ^ 257 at hqBound + rcases q with ⟨q0, q1, q2, q3, carry⟩ + let lowL := (Repr.ofLimbs l0 l1 l2 l3).toNat + let highL := (Repr.ofLimbs l4 l5 l6 l7).toNat + let lowM := (Repr.ofLimbs m0 m1 m2 m3).toNat + let highM := m4.toNat + 2 ^ 64 * m5.toNat + 2 ^ 128 * m6.toNat + let lowP := (Repr.ofLimbs p0 p1 p2 p3).toNat + let lowQ := (Repr.ofLimbs q0 q1 q2 q3).toNat + have hinputDecomp : + limbs8ToNat (l0, l1, l2, l3, l4, l5, l6, l7) = lowL + 2 ^ 256 * highL := by + unfold limbs8ToNat lowL highL Repr.toNat Repr.ofLimbs TWO64 TWO128 TWO192 + norm_num + ring + have hmDecomp : + limbs7ToNat (m0, m1, m2, m3, m4, m5, m6) = lowM + 2 ^ 256 * highM := by + unfold limbs7ToNat lowM highM Repr.toNat Repr.ofLimbs TWO64 TWO128 TWO192 + norm_num + ring + have hpDecomp : limbs5ToNat (p0, p1, p2, p3, p4) = lowP + 2 ^ 256 * p4.toNat := by + rfl + have hqDecomp : limbs5ToNat (q0, q1, q2, q3, carry) = + lowQ + 2 ^ 256 * carry.toNat := by + rfl + have hmCast : + (limbs7ToNat (m0, m1, m2, m3, m4, m5, m6) : + Secp256k1.Scalar.Basic.Field) = + (limbs8ToNat (l0, l1, l2, l3, l4, l5, l6, l7) : + Secp256k1.Scalar.Basic.Field) := by + rw [hmValue, hinputDecomp] + exact foldComplement_cast lowL highL + have hpCast : + (limbs5ToNat (p0, p1, p2, p3, p4) : Secp256k1.Scalar.Basic.Field) = + (limbs7ToNat (m0, m1, m2, m3, m4, m5, m6) : + Secp256k1.Scalar.Basic.Field) := by + rw [hpValue, hmDecomp] + exact foldComplement_cast lowM highM + have hqCast : + (limbs5ToNat (q0, q1, q2, q3, carry) : Secp256k1.Scalar.Basic.Field) = + (limbs5ToNat (p0, p1, p2, p3, p4) : Secp256k1.Scalar.Basic.Field) := by + rw [hqValue, hpDecomp] + exact foldComplement_cast lowP p4.toNat + have hp4 : p4.toNat < 8 := by + unfold limbs5ToNat Repr.toNat Repr.ofLimbs TWO64 TWO128 TWO192 at hpBound + norm_num at hpBound ⊢ + omega + have hlowP := Repr.toNat_lt_two256 (Repr.ofLimbs p0 p1 p2 p3) + have hqTwoCard : limbs5ToNat (q0, q1, q2, q3, carry) < + 2 * Secp256k1.Scalar.Basic.CARD := by + rw [hqValue] + change lowP < 2 ^ 256 at hlowP + norm_num [Secp256k1.Scalar.Basic.CARD] at hlowP hp4 ⊢ + omega + have hfinish := finishReduceRaw_spec q0 q1 q2 q3 carry hqCarry hqTwoCard + have hfinalCast : + (limbs5ToNat (q0, q1, q2, q3, carry) : Secp256k1.Scalar.Basic.Field) = + (limbs8ToNat (l0, l1, l2, l3, l4, l5, l6, l7) : + Secp256k1.Scalar.Basic.Field) := hqCast.trans (hpCast.trans hmCast) + unfold reduce512Raw + simp only [hmEq, hpEq, hqEq] + exact ⟨hfinish.1, hfinish.2.trans hfinalCast⟩ + +/-- Reference multiplication modulo the scalar order. + + This mirrors `secp256k1_scalar_mul`: first compute the 512-bit product with + `mul512Raw`, then reduce it with `reduce512Raw`. +-/ +@[inline] def mulRaw (a0 a1 a2 a3 b0 b1 b2 b3 : UInt64) : Limbs4 := + let (l0, l1, l2, l3, l4, l5, l6, l7) := mul512Raw a0 a1 a2 a3 b0 b1 b2 b3 + reduce512Raw l0 l1 l2 l3 l4 l5 l6 l7 + +/-- Reference squaring modulo the scalar order. -/ +@[inline] def squareRaw (a0 a1 a2 a3 : UInt64) : Limbs4 := + mulRaw a0 a1 a2 a3 a0 a1 a2 a3 + +/-- Adding the scalar order to a 256-bit value at the wrap threshold produces + an exact `2^256` carry. -/ +private theorem addModulusRaw_value_of_ge (d0 d1 d2 d3 : UInt64) + (hge : 2 ^ 256 ≤ + (Repr.ofLimbs d0 d1 d2 d3).toNat + Secp256k1.Scalar.Basic.CARD) : + let r := addRaw d0 d1 d2 d3 N_0 N_1 N_2 N_3 + (Repr.ofLimbs r.1 r.2.1 r.2.2.1 r.2.2.2.1).toNat + 2 ^ 256 = + (Repr.ofLimbs d0 d1 d2 d3).toNat + Secp256k1.Scalar.Basic.CARD := by + let r := addRaw d0 d1 d2 d3 N_0 N_1 N_2 N_3 + have hvalue := addRaw_value d0 d1 d2 d3 N_0 N_1 N_2 N_3 + have hc := addRaw_carry_le_one d0 d1 d2 d3 N_0 N_1 N_2 N_3 + have hout := Repr.toNat_lt_two256 + (Repr.ofLimbs r.1 r.2.1 r.2.2.1 r.2.2.2.1) + change (Repr.ofLimbs r.1 r.2.1 r.2.2.1 r.2.2.2.1).toNat + + 2 ^ 256 * r.2.2.2.2.toNat = + (Repr.ofLimbs d0 d1 d2 d3).toNat + Repr.modulus.toNat at hvalue + rw [Repr.modulus_toNat] at hvalue + change r.2.2.2.2.toNat ≤ 1 at hc + norm_num [Secp256k1.Scalar.Basic.CARD] at hvalue hout hge ⊢ + have hvaluez : + ((Repr.ofLimbs r.1 r.2.1 r.2.2.1 r.2.2.2.1).toNat : Int) + + 115792089237316195423570985008687907853269984665640564039457584007913129639936 * + r.2.2.2.2.toNat = + (Repr.ofLimbs d0 d1 d2 d3).toNat + + 115792089237316195423570985008687907852837564279074904382605163141518161494337 := by + exact_mod_cast hvalue + have houtz : ((Repr.ofLimbs r.1 r.2.1 r.2.2.1 r.2.2.2.1).toNat : Int) < + 115792089237316195423570985008687907853269984665640564039457584007913129639936 := by + exact_mod_cast hout + have hgez : (115792089237316195423570985008687907853269984665640564039457584007913129639936 : Int) ≤ + (Repr.ofLimbs d0 d1 d2 d3).toNat + + 115792089237316195423570985008687907852837564279074904382605163141518161494337 := by + exact_mod_cast hge + have hcz : (r.2.2.2.2.toNat : Int) ≤ 1 := by exact_mod_cast hc + have hz : + ((Repr.ofLimbs r.1 r.2.1 r.2.2.1 r.2.2.2.1).toNat : Int) + + 115792089237316195423570985008687907853269984665640564039457584007913129639936 = + (Repr.ofLimbs d0 d1 d2 d3).toNat + + 115792089237316195423570985008687907852837564279074904382605163141518161494337 := by + omega + exact_mod_cast hz + +/-- Modular addition returns a canonical scalar representative. -/ +theorem addModRaw_lt (a0 a1 a2 a3 b0 b1 b2 b3 : UInt64) + (ha : (Repr.ofLimbs a0 a1 a2 a3).toNat < Secp256k1.Scalar.Basic.CARD) + (hb : (Repr.ofLimbs b0 b1 b2 b3).toNat < Secp256k1.Scalar.Basic.CARD) : + let r := addModRaw a0 a1 a2 a3 b0 b1 b2 b3 + (Repr.ofLimbs r.1 r.2.1 r.2.2.1 r.2.2.2).toNat < + Secp256k1.Scalar.Basic.CARD := by + let s := addRaw a0 a1 a2 a3 b0 b1 b2 b3 + let x := Repr.ofLimbs s.1 s.2.1 s.2.2.1 s.2.2.2.1 + change + let r := reduceRaw s.1 s.2.1 s.2.2.1 s.2.2.2.1 + (s.2.2.2.2 != 0 || checkOverflowRaw s.1 s.2.1 s.2.2.1 s.2.2.2.1) + (Repr.ofLimbs r.1 r.2.1 r.2.2.1 r.2.2.2).toNat < Secp256k1.Scalar.Basic.CARD + have hsum := addRaw_value a0 a1 a2 a3 b0 b1 b2 b3 + have hc := addRaw_carry_le_one a0 a1 a2 a3 b0 b1 b2 b3 + change x.toNat + 2 ^ 256 * s.2.2.2.2.toNat = + (Repr.ofLimbs a0 a1 a2 a3).toNat + + (Repr.ofLimbs b0 b1 b2 b3).toNat at hsum + change s.2.2.2.2.toNat ≤ 1 at hc + have hcheck := checkOverflowRaw_eq_decide s.1 s.2.1 s.2.2.1 s.2.2.2.1 + change checkOverflowRaw s.1 s.2.1 s.2.2.1 s.2.2.2.1 = + decide (x.toNat ≥ Secp256k1.Scalar.Basic.CARD) at hcheck + by_cases hcarry : s.2.2.2.2 = 0 + · have hcarryBool : (s.2.2.2.2 != 0) = false := by simp [hcarry] + have hsum0 : x.toNat = + (Repr.ofLimbs a0 a1 a2 a3).toNat + + (Repr.ofLimbs b0 b1 b2 b3).toNat := by + rw [hcarry] at hsum + norm_num at hsum + exact hsum + by_cases hge : Secp256k1.Scalar.Basic.CARD ≤ x.toNat + · have hcheckTrue : checkOverflowRaw s.1 s.2.1 s.2.2.1 s.2.2.2.1 = true := by + rw [hcheck] + simp [hge] + have hreduce := reduceRaw_true_of_ge s.1 s.2.1 s.2.2.1 s.2.2.2.1 hge + simp only [hcarryBool, Bool.false_or, hcheckTrue] + rw [hreduce] + apply (Nat.sub_lt_iff_lt_add hge).2 + omega + · have hlt : x.toNat < Secp256k1.Scalar.Basic.CARD := Nat.lt_of_not_ge hge + have hcheckFalse : checkOverflowRaw s.1 s.2.1 s.2.2.1 s.2.2.2.1 = false := by + rw [hcheck] + simp [hlt] + simp only [hcarryBool, Bool.false_or, hcheckFalse, reduceRaw] + exact hlt + · have hcarryBool : (s.2.2.2.2 != 0) = true := by simp [hcarry] + have hnatne : s.2.2.2.2.toNat ≠ 0 := by + intro hzero + apply hcarry + apply UInt64.toNat.inj + simpa using hzero + have hcarryNat : s.2.2.2.2.toNat = 1 := by + have hpos : 0 < s.2.2.2.2.toNat := Nat.pos_of_ne_zero hnatne + omega + have hslt : x.toNat < Secp256k1.Scalar.Basic.CARD := by + norm_num [Secp256k1.Scalar.Basic.CARD] at hsum ha hb ⊢ + omega + have hreduce := reduceRaw_true_of_lt s.1 s.2.1 s.2.2.1 s.2.2.2.1 hslt + simp only [hcarryBool, Bool.true_or] + rw [hreduce] + have hcomp : 2 ^ 256 - Secp256k1.Scalar.Basic.CARD = + 432420386565659656852420866394968145599 := by + norm_num [Secp256k1.Scalar.Basic.CARD] + rw [hcomp] + rw [hcarryNat] at hsum + norm_num [Secp256k1.Scalar.Basic.CARD] at hsum ha hb ⊢ + have hsumz : + (x.toNat : Int) + + 115792089237316195423570985008687907853269984665640564039457584007913129639936 = + (Repr.ofLimbs a0 a1 a2 a3).toNat + + (Repr.ofLimbs b0 b1 b2 b3).toNat := by exact_mod_cast hsum + have haz : ((Repr.ofLimbs a0 a1 a2 a3).toNat : Int) < + 115792089237316195423570985008687907852837564279074904382605163141518161494337 := by + exact_mod_cast ha + have hbz : ((Repr.ofLimbs b0 b1 b2 b3).toNat : Int) < + 115792089237316195423570985008687907852837564279074904382605163141518161494337 := by + exact_mod_cast hb + have hz : (x.toNat : Int) + 432420386565659656852420866394968145599 < + 115792089237316195423570985008687907852837564279074904382605163141518161494337 := by + omega + exact_mod_cast hz + +/-- Modular addition agrees with addition in the canonical scalar field. -/ +theorem addModRaw_cast (a0 a1 a2 a3 b0 b1 b2 b3 : UInt64) + (ha : (Repr.ofLimbs a0 a1 a2 a3).toNat < Secp256k1.Scalar.Basic.CARD) + (hb : (Repr.ofLimbs b0 b1 b2 b3).toNat < Secp256k1.Scalar.Basic.CARD) : + let r := addModRaw a0 a1 a2 a3 b0 b1 b2 b3 + ((Repr.ofLimbs r.1 r.2.1 r.2.2.1 r.2.2.2).toNat : + Secp256k1.Scalar.Basic.Field) = + ((Repr.ofLimbs a0 a1 a2 a3).toNat : Secp256k1.Scalar.Basic.Field) + + ((Repr.ofLimbs b0 b1 b2 b3).toNat : Secp256k1.Scalar.Basic.Field) := by + let s := addRaw a0 a1 a2 a3 b0 b1 b2 b3 + let x := Repr.ofLimbs s.1 s.2.1 s.2.2.1 s.2.2.2.1 + change + let r := reduceRaw s.1 s.2.1 s.2.2.1 s.2.2.2.1 + (s.2.2.2.2 != 0 || checkOverflowRaw s.1 s.2.1 s.2.2.1 s.2.2.2.1) + ((Repr.ofLimbs r.1 r.2.1 r.2.2.1 r.2.2.2).toNat : Secp256k1.Scalar.Basic.Field) = _ + have hsum := addRaw_value a0 a1 a2 a3 b0 b1 b2 b3 + have hc := addRaw_carry_le_one a0 a1 a2 a3 b0 b1 b2 b3 + change x.toNat + 2 ^ 256 * s.2.2.2.2.toNat = + (Repr.ofLimbs a0 a1 a2 a3).toNat + + (Repr.ofLimbs b0 b1 b2 b3).toNat at hsum + change s.2.2.2.2.toNat ≤ 1 at hc + have hcheck := checkOverflowRaw_eq_decide s.1 s.2.1 s.2.2.1 s.2.2.2.1 + change checkOverflowRaw s.1 s.2.1 s.2.2.1 s.2.2.2.1 = + decide (x.toNat ≥ Secp256k1.Scalar.Basic.CARD) at hcheck + rw [← Nat.cast_add] + by_cases hcarry : s.2.2.2.2 = 0 + · have hcarryBool : (s.2.2.2.2 != 0) = false := by simp [hcarry] + have hsum0 : x.toNat = + (Repr.ofLimbs a0 a1 a2 a3).toNat + + (Repr.ofLimbs b0 b1 b2 b3).toNat := by + rw [hcarry] at hsum + norm_num at hsum + exact hsum + by_cases hge : Secp256k1.Scalar.Basic.CARD ≤ x.toNat + · have hcheckTrue : checkOverflowRaw s.1 s.2.1 s.2.2.1 s.2.2.2.1 = true := by + rw [hcheck] + simp [hge] + have hreduce := reduceRaw_true_of_ge s.1 s.2.1 s.2.2.1 s.2.2.2.1 hge + simp only [hcarryBool, Bool.false_or, hcheckTrue] + rw [hreduce] + apply cast_eq_of_add_card_eq + rw [Nat.sub_add_cancel hge, hsum0] + · have hlt : x.toNat < Secp256k1.Scalar.Basic.CARD := Nat.lt_of_not_ge hge + have hcheckFalse : checkOverflowRaw s.1 s.2.1 s.2.2.1 s.2.2.2.1 = false := by + rw [hcheck] + simp [hlt] + simp [hcarryBool, hcheckFalse, reduceRaw] + rw [hsum0] + exact Nat.cast_add _ _ + · have hcarryBool : (s.2.2.2.2 != 0) = true := by simp [hcarry] + have hnatne : s.2.2.2.2.toNat ≠ 0 := by + intro hzero + apply hcarry + apply UInt64.toNat.inj + simpa using hzero + have hcarryNat : s.2.2.2.2.toNat = 1 := by + have hpos : 0 < s.2.2.2.2.toNat := Nat.pos_of_ne_zero hnatne + omega + have hslt : x.toNat < Secp256k1.Scalar.Basic.CARD := by + rw [hcarryNat] at hsum + norm_num [Secp256k1.Scalar.Basic.CARD] at hsum ha hb ⊢ + omega + have hreduce := reduceRaw_true_of_lt s.1 s.2.1 s.2.2.1 s.2.2.2.1 hslt + simp only [hcarryBool, Bool.true_or] + rw [hreduce] + apply cast_eq_of_add_card_eq + rw [hcarryNat] at hsum + norm_num [Secp256k1.Scalar.Basic.CARD] at hsum ⊢ + have hsumz : + (x.toNat : Int) + + 115792089237316195423570985008687907853269984665640564039457584007913129639936 = + (Repr.ofLimbs a0 a1 a2 a3).toNat + + (Repr.ofLimbs b0 b1 b2 b3).toNat := by exact_mod_cast hsum + have hz : + (x.toNat + 432420386565659656852420866394968145599 : Int) + + 115792089237316195423570985008687907852837564279074904382605163141518161494337 = + (Repr.ofLimbs a0 a1 a2 a3).toNat + + (Repr.ofLimbs b0 b1 b2 b3).toNat := by + omega + exact_mod_cast hz + +/-- Modular subtraction returns a canonical scalar representative. -/ +theorem subModRaw_lt (a0 a1 a2 a3 b0 b1 b2 b3 : UInt64) + (ha : (Repr.ofLimbs a0 a1 a2 a3).toNat < Secp256k1.Scalar.Basic.CARD) + (hb : (Repr.ofLimbs b0 b1 b2 b3).toNat < Secp256k1.Scalar.Basic.CARD) : + let r := subModRaw a0 a1 a2 a3 b0 b1 b2 b3 + (Repr.ofLimbs r.1 r.2.1 r.2.2.1 r.2.2.2).toNat < + Secp256k1.Scalar.Basic.CARD := by + let s := subRaw a0 a1 a2 a3 b0 b1 b2 b3 + let x := Repr.ofLimbs s.1 s.2.1 s.2.2.1 s.2.2.2.1 + rw [subModRaw_eq_finish] + rw [show subRaw a0 a1 a2 a3 b0 b1 b2 b3 = s from rfl] + simp only + have hdiff := subRaw_value a0 a1 a2 a3 b0 b1 b2 b3 + have hc := subRaw_borrow_le_one a0 a1 a2 a3 b0 b1 b2 b3 + change x.toNat + (Repr.ofLimbs b0 b1 b2 b3).toNat = + (Repr.ofLimbs a0 a1 a2 a3).toNat + 2 ^ 256 * s.2.2.2.2.toNat at hdiff + change s.2.2.2.2.toNat ≤ 1 at hc + by_cases hborrow : s.2.2.2.2 = 0 + · rw [hborrow, finishSubRaw_zero] + rw [hborrow] at hdiff + norm_num at hdiff + have hxlt : x.toNat < Secp256k1.Scalar.Basic.CARD := by omega + simpa [x] using hxlt + · rw [finishSubRaw_of_ne_zero _ _ _ _ _ hborrow] + have hnatne : s.2.2.2.2.toNat ≠ 0 := by + intro hzero + apply hborrow + apply UInt64.toNat.inj + simpa using hzero + have hborrowNat : s.2.2.2.2.toNat = 1 := by + have hpos : 0 < s.2.2.2.2.toNat := Nat.pos_of_ne_zero hnatne + omega + rw [hborrowNat] at hdiff + have hge : 2 ^ 256 ≤ x.toNat + Secp256k1.Scalar.Basic.CARD := by + norm_num [Secp256k1.Scalar.Basic.CARD] at hdiff hb ⊢ + omega + have hresult := addModulusRaw_value_of_ge s.1 s.2.1 s.2.2.1 s.2.2.2.1 hge + let r := addRaw s.1 s.2.1 s.2.2.1 s.2.2.2.1 N_0 N_1 N_2 N_3 + change (Repr.ofLimbs r.1 r.2.1 r.2.2.1 r.2.2.2.1).toNat + 2 ^ 256 = + x.toNat + Secp256k1.Scalar.Basic.CARD at hresult + have hresultz : + ((Repr.ofLimbs r.1 r.2.1 r.2.2.1 r.2.2.2.1).toNat : Int) + + 115792089237316195423570985008687907853269984665640564039457584007913129639936 = + x.toNat + + 115792089237316195423570985008687907852837564279074904382605163141518161494337 := by + norm_num [Secp256k1.Scalar.Basic.CARD] at hresult + exact_mod_cast hresult + have hdiffz : (x.toNat : Int) + (Repr.ofLimbs b0 b1 b2 b3).toNat = + (Repr.ofLimbs a0 a1 a2 a3).toNat + + 115792089237316195423570985008687907853269984665640564039457584007913129639936 := by + norm_num at hdiff + exact_mod_cast hdiff + have haz : ((Repr.ofLimbs a0 a1 a2 a3).toNat : Int) < + 115792089237316195423570985008687907852837564279074904382605163141518161494337 := by + norm_num [Secp256k1.Scalar.Basic.CARD] at ha + exact_mod_cast ha + have hxbound := Repr.toNat_lt_two256 x + have hxboundz : (x.toNat : Int) < + 115792089237316195423570985008687907853269984665640564039457584007913129639936 := by + norm_num at hxbound + exact_mod_cast hxbound + have hz : ((Repr.ofLimbs r.1 r.2.1 r.2.2.1 r.2.2.2.1).toNat : Int) < + 115792089237316195423570985008687907852837564279074904382605163141518161494337 := by + omega + exact_mod_cast hz + +/-- Modular subtraction agrees with subtraction in the canonical scalar field. -/ +theorem subModRaw_cast (a0 a1 a2 a3 b0 b1 b2 b3 : UInt64) + (ha : (Repr.ofLimbs a0 a1 a2 a3).toNat < Secp256k1.Scalar.Basic.CARD) + (hb : (Repr.ofLimbs b0 b1 b2 b3).toNat < Secp256k1.Scalar.Basic.CARD) : + let r := subModRaw a0 a1 a2 a3 b0 b1 b2 b3 + ((Repr.ofLimbs r.1 r.2.1 r.2.2.1 r.2.2.2).toNat : + Secp256k1.Scalar.Basic.Field) = + ((Repr.ofLimbs a0 a1 a2 a3).toNat : Secp256k1.Scalar.Basic.Field) - + ((Repr.ofLimbs b0 b1 b2 b3).toNat : Secp256k1.Scalar.Basic.Field) := by + let s := subRaw a0 a1 a2 a3 b0 b1 b2 b3 + let x := Repr.ofLimbs s.1 s.2.1 s.2.2.1 s.2.2.2.1 + rw [subModRaw_eq_finish] + rw [show subRaw a0 a1 a2 a3 b0 b1 b2 b3 = s from rfl] + simp only + have _ := ha + have hdiff := subRaw_value a0 a1 a2 a3 b0 b1 b2 b3 + have hc := subRaw_borrow_le_one a0 a1 a2 a3 b0 b1 b2 b3 + change x.toNat + (Repr.ofLimbs b0 b1 b2 b3).toNat = + (Repr.ofLimbs a0 a1 a2 a3).toNat + 2 ^ 256 * s.2.2.2.2.toNat at hdiff + change s.2.2.2.2.toNat ≤ 1 at hc + by_cases hborrow : s.2.2.2.2 = 0 + · rw [hborrow, finishSubRaw_zero] + rw [hborrow] at hdiff + norm_num at hdiff + have hz := congrArg (fun n : Nat => (n : Secp256k1.Scalar.Basic.Field)) hdiff + push_cast at hz + calc + (x.toNat : Secp256k1.Scalar.Basic.Field) = + (x.toNat : Secp256k1.Scalar.Basic.Field) + + ((Repr.ofLimbs b0 b1 b2 b3).toNat : Secp256k1.Scalar.Basic.Field) - + ((Repr.ofLimbs b0 b1 b2 b3).toNat : Secp256k1.Scalar.Basic.Field) := by ring + _ = ((Repr.ofLimbs a0 a1 a2 a3).toNat : Secp256k1.Scalar.Basic.Field) - + ((Repr.ofLimbs b0 b1 b2 b3).toNat : Secp256k1.Scalar.Basic.Field) := by rw [hz] + · rw [finishSubRaw_of_ne_zero _ _ _ _ _ hborrow] + have hnatne : s.2.2.2.2.toNat ≠ 0 := by + intro hzero + apply hborrow + apply UInt64.toNat.inj + simpa using hzero + have hborrowNat : s.2.2.2.2.toNat = 1 := by + have hpos : 0 < s.2.2.2.2.toNat := Nat.pos_of_ne_zero hnatne + omega + rw [hborrowNat] at hdiff + have hge : 2 ^ 256 ≤ x.toNat + Secp256k1.Scalar.Basic.CARD := by + norm_num [Secp256k1.Scalar.Basic.CARD] at hdiff hb ⊢ + omega + have hresult := addModulusRaw_value_of_ge s.1 s.2.1 s.2.2.1 s.2.2.2.1 hge + let r := addRaw s.1 s.2.1 s.2.2.1 s.2.2.2.1 N_0 N_1 N_2 N_3 + change (Repr.ofLimbs r.1 r.2.1 r.2.2.1 r.2.2.2.1).toNat + 2 ^ 256 = + x.toNat + Secp256k1.Scalar.Basic.CARD at hresult + have hresultz : + ((Repr.ofLimbs r.1 r.2.1 r.2.2.1 r.2.2.2.1).toNat : Int) + + 115792089237316195423570985008687907853269984665640564039457584007913129639936 = + x.toNat + + 115792089237316195423570985008687907852837564279074904382605163141518161494337 := by + norm_num [Secp256k1.Scalar.Basic.CARD] at hresult + exact_mod_cast hresult + have hdiffz : (x.toNat : Int) + (Repr.ofLimbs b0 b1 b2 b3).toNat = + (Repr.ofLimbs a0 a1 a2 a3).toNat + + 115792089237316195423570985008687907853269984665640564039457584007913129639936 := by + norm_num at hdiff + exact_mod_cast hdiff + have heqz : + ((Repr.ofLimbs r.1 r.2.1 r.2.2.1 r.2.2.2.1).toNat : Int) + + (Repr.ofLimbs b0 b1 b2 b3).toNat = + (Repr.ofLimbs a0 a1 a2 a3).toNat + + 115792089237316195423570985008687907852837564279074904382605163141518161494337 := by + omega + have heq : + (Repr.ofLimbs r.1 r.2.1 r.2.2.1 r.2.2.2.1).toNat + + (Repr.ofLimbs b0 b1 b2 b3).toNat = + (Repr.ofLimbs a0 a1 a2 a3).toNat + Secp256k1.Scalar.Basic.CARD := by + norm_num [Secp256k1.Scalar.Basic.CARD] + exact_mod_cast heqz + have hz := congrArg (fun n : Nat => (n : Secp256k1.Scalar.Basic.Field)) heq + simp only [Nat.cast_add] at hz + have hcard : (Secp256k1.Scalar.Basic.CARD : Secp256k1.Scalar.Basic.Field) = 0 := by + exact CharP.cast_eq_zero _ _ + rw [hcard, add_zero] at hz + change + ((Repr.ofLimbs r.1 r.2.1 r.2.2.1 r.2.2.2.1).toNat : Secp256k1.Scalar.Basic.Field) = _ + calc + ((Repr.ofLimbs r.1 r.2.1 r.2.2.1 r.2.2.2.1).toNat : Secp256k1.Scalar.Basic.Field) = + ((Repr.ofLimbs r.1 r.2.1 r.2.2.1 r.2.2.2.1).toNat : Secp256k1.Scalar.Basic.Field) + + ((Repr.ofLimbs b0 b1 b2 b3).toNat : Secp256k1.Scalar.Basic.Field) - + ((Repr.ofLimbs b0 b1 b2 b3).toNat : Secp256k1.Scalar.Basic.Field) := by ring + _ = ((Repr.ofLimbs a0 a1 a2 a3).toNat : Secp256k1.Scalar.Basic.Field) - + ((Repr.ofLimbs b0 b1 b2 b3).toNat : Secp256k1.Scalar.Basic.Field) := by rw [hz] + +/-- The raw zero test is exact on four limbs. -/ +private theorem isZeroRaw_eq_true_iff (a0 a1 a2 a3 : UInt64) : + isZeroRaw a0 a1 a2 a3 = true ↔ a0 = 0 ∧ a1 = 0 ∧ a2 = 0 ∧ a3 = 0 := by + unfold isZeroRaw + bv_decide + +/-- Complementing every limb complements the complete 256-bit value. -/ +private theorem notRepr_toNat (a0 a1 a2 a3 : UInt64) : + (Repr.ofLimbs (~~~a0) (~~~a1) (~~~a2) (~~~a3)).toNat = + 2 ^ 256 - 1 - (Repr.ofLimbs a0 a1 a2 a3).toNat := by + have h0 : (~~~a0).toNat = 2 ^ 64 - 1 - a0.toNat := BitVec.toNat_not + have h1 : (~~~a1).toNat = 2 ^ 64 - 1 - a1.toNat := BitVec.toNat_not + have h2 : (~~~a2).toNat = 2 ^ 64 - 1 - a2.toNat := BitVec.toNat_not + have h3 : (~~~a3).toNat = 2 ^ 64 - 1 - a3.toNat := BitVec.toNat_not + have ha0 := a0.toNat_lt_size + have ha1 := a1.toNat_lt_size + have ha2 := a2.toNat_lt_size + have ha3 := a3.toNat_lt_size + norm_num [UInt64.size] at ha0 ha1 ha2 ha3 + unfold Repr.toNat Repr.ofLimbs TWO64 TWO128 TWO192 + norm_num at h0 h1 h2 h3 ⊢ + omega + +/-- The incremented modulus limbs denote the scalar order plus one. -/ +private theorem incrementedModulus_toNat : + (Repr.ofLimbs (N_0 + 1) N_1 N_2 N_3).toNat = + Secp256k1.Scalar.Basic.CARD + 1 := by + norm_num [Repr.toNat, Repr.ofLimbs, N_0, N_1, N_2, N_3, TWO64, TWO128, TWO192, + UInt64.toNat_ofNat, Secp256k1.Scalar.Basic.CARD] + +/-- Masking a word by 64 one-bits leaves it unchanged. -/ +private theorem and_max_eq (x : UInt64) : x &&& 0xffffffffffffffff = x := by + bv_decide + +/-- The nonzero libsecp256k1 negation path sums with its input to the order. -/ +private theorem negRaw_nonzero_value (a0 a1 a2 a3 : UInt64) + (ha : (Repr.ofLimbs a0 a1 a2 a3).toNat < Secp256k1.Scalar.Basic.CARD) + (hzero : isZeroRaw a0 a1 a2 a3 = false) : + let r := negRaw a0 a1 a2 a3 + (Repr.ofLimbs r.1 r.2.1 r.2.2.1 r.2.2.2).toNat + + (Repr.ofLimbs a0 a1 a2 a3).toNat = Secp256k1.Scalar.Basic.CARD := by + let q := addRaw (~~~a0) (~~~a1) (~~~a2) (~~~a3) (N_0 + 1) N_1 N_2 N_3 + have hvalue := addRaw_value (~~~a0) (~~~a1) (~~~a2) (~~~a3) + (N_0 + 1) N_1 N_2 N_3 + have hc := addRaw_carry_le_one (~~~a0) (~~~a1) (~~~a2) (~~~a3) + (N_0 + 1) N_1 N_2 N_3 + change + (Repr.ofLimbs q.1 q.2.1 q.2.2.1 q.2.2.2.1).toNat + + 2 ^ 256 * q.2.2.2.2.toNat = + (Repr.ofLimbs (~~~a0) (~~~a1) (~~~a2) (~~~a3)).toNat + + (Repr.ofLimbs (N_0 + 1) N_1 N_2 N_3).toNat at hvalue + change q.2.2.2.2.toNat ≤ 1 at hc + rw [notRepr_toNat, incrementedModulus_toNat] at hvalue + have hapos : 0 < (Repr.ofLimbs a0 a1 a2 a3).toNat := by + by_contra h + have hnat : (Repr.ofLimbs a0 a1 a2 a3).toNat = 0 := Nat.eq_zero_of_not_pos h + have hrepr : Repr.ofLimbs a0 a1 a2 a3 = Repr.zero := Repr.toNat_injective hnat + have hz : isZeroRaw a0 a1 a2 a3 = true := by + cases hrepr + rfl + simp [hz] at hzero + have hout := Repr.toNat_lt_two256 + (Repr.ofLimbs q.1 q.2.1 q.2.2.1 q.2.2.2.1) + have hvalue' : + (Repr.ofLimbs q.1 q.2.1 q.2.2.1 q.2.2.2.1).toNat + + 2 ^ 256 * q.2.2.2.2.toNat + (Repr.ofLimbs a0 a1 a2 a3).toNat = + 2 ^ 256 + Secp256k1.Scalar.Basic.CARD := by + norm_num [Secp256k1.Scalar.Basic.CARD] at hvalue ha ⊢ + omega + have hvaluez : + ((Repr.ofLimbs q.1 q.2.1 q.2.2.1 q.2.2.2.1).toNat : Int) + + 115792089237316195423570985008687907853269984665640564039457584007913129639936 * + q.2.2.2.2.toNat + (Repr.ofLimbs a0 a1 a2 a3).toNat = + 115792089237316195423570985008687907853269984665640564039457584007913129639936 + + 115792089237316195423570985008687907852837564279074904382605163141518161494337 := by + norm_num [Secp256k1.Scalar.Basic.CARD] at hvalue' + exact_mod_cast hvalue' + have houtz : ((Repr.ofLimbs q.1 q.2.1 q.2.2.1 q.2.2.2.1).toNat : Int) < + 115792089237316195423570985008687907853269984665640564039457584007913129639936 := by + norm_num at hout + exact_mod_cast hout + have hcz : (q.2.2.2.2.toNat : Int) ≤ 1 := by exact_mod_cast hc + have haposz : (0 : Int) < (Repr.ofLimbs a0 a1 a2 a3).toNat := by exact_mod_cast hapos + have haz : ((Repr.ofLimbs a0 a1 a2 a3).toNat : Int) < + 115792089237316195423570985008687907852837564279074904382605163141518161494337 := by + norm_num [Secp256k1.Scalar.Basic.CARD] at ha + exact_mod_cast ha + have heqz : + ((Repr.ofLimbs q.1 q.2.1 q.2.2.1 q.2.2.2.1).toNat : Int) + + (Repr.ofLimbs a0 a1 a2 a3).toNat = + 115792089237316195423570985008687907852837564279074904382605163141518161494337 := by + omega + have heq : + (Repr.ofLimbs q.1 q.2.1 q.2.2.1 q.2.2.2.1).toNat + + (Repr.ofLimbs a0 a1 a2 a3).toNat = Secp256k1.Scalar.Basic.CARD := by + norm_num [Secp256k1.Scalar.Basic.CARD] + exact_mod_cast heqz + have hneg : negRaw a0 a1 a2 a3 = + (q.1, q.2.1, q.2.2.1, q.2.2.2.1) := by + unfold negRaw + rw [hzero] + simp only [Bool.false_eq_true, if_false] + change + (q.1 &&& 0xffffffffffffffff, q.2.1 &&& 0xffffffffffffffff, + q.2.2.1 &&& 0xffffffffffffffff, q.2.2.2.1 &&& 0xffffffffffffffff) = + (q.1, q.2.1, q.2.2.1, q.2.2.2.1) + simp only [and_max_eq] + rw [hneg] + exact heq + +/-- Modular negation returns a canonical scalar representative. -/ +theorem negRaw_lt (a0 a1 a2 a3 : UInt64) + (ha : (Repr.ofLimbs a0 a1 a2 a3).toNat < Secp256k1.Scalar.Basic.CARD) : + let r := negRaw a0 a1 a2 a3 + (Repr.ofLimbs r.1 r.2.1 r.2.2.1 r.2.2.2).toNat < + Secp256k1.Scalar.Basic.CARD := by + by_cases hzero : isZeroRaw a0 a1 a2 a3 = true + · obtain ⟨rfl, rfl, rfl, rfl⟩ := (isZeroRaw_eq_true_iff a0 a1 a2 a3).mp hzero + norm_num [negRaw, isZeroRaw, Secp256k1.Scalar.Basic.CARD, + Repr.toNat, Repr.ofLimbs, addCarry] + · have hzeroFalse := Bool.eq_false_of_not_eq_true hzero + have hvalue := negRaw_nonzero_value a0 a1 a2 a3 ha hzeroFalse + have hapos : 0 < (Repr.ofLimbs a0 a1 a2 a3).toNat := by + by_contra h + have hnat := Nat.eq_zero_of_not_pos h + have hrepr : Repr.ofLimbs a0 a1 a2 a3 = Repr.zero := Repr.toNat_injective hnat + apply hzero + cases hrepr + rfl + omega + +/-- Modular negation agrees with negation in the canonical scalar field. -/ +theorem negRaw_cast (a0 a1 a2 a3 : UInt64) + (ha : (Repr.ofLimbs a0 a1 a2 a3).toNat < Secp256k1.Scalar.Basic.CARD) : + let r := negRaw a0 a1 a2 a3 + ((Repr.ofLimbs r.1 r.2.1 r.2.2.1 r.2.2.2).toNat : + Secp256k1.Scalar.Basic.Field) = + -((Repr.ofLimbs a0 a1 a2 a3).toNat : Secp256k1.Scalar.Basic.Field) := by + by_cases hzero : isZeroRaw a0 a1 a2 a3 = true + · obtain ⟨rfl, rfl, rfl, rfl⟩ := (isZeroRaw_eq_true_iff a0 a1 a2 a3).mp hzero + norm_num [negRaw, isZeroRaw, Repr.toNat, Repr.ofLimbs, addCarry] + · have hvalue := negRaw_nonzero_value a0 a1 a2 a3 ha + (Bool.eq_false_of_not_eq_true hzero) + have hz := congrArg (fun n : Nat => (n : Secp256k1.Scalar.Basic.Field)) hvalue + simp only [Nat.cast_add] at hz + have hcard : (Secp256k1.Scalar.Basic.CARD : Secp256k1.Scalar.Basic.Field) = 0 := by + exact CharP.cast_eq_zero _ _ + rw [hcard] at hz + calc + _ = _ + ((Repr.ofLimbs a0 a1 a2 a3).toNat : Secp256k1.Scalar.Basic.Field) - + ((Repr.ofLimbs a0 a1 a2 a3).toNat : Secp256k1.Scalar.Basic.Field) := by ring + _ = -((Repr.ofLimbs a0 a1 a2 a3).toNat : Secp256k1.Scalar.Basic.Field) := by rw [hz]; ring + +/-- Modular multiplication returns a canonical scalar representative. -/ +theorem mulRaw_lt (a0 a1 a2 a3 b0 b1 b2 b3 : UInt64) + : let r := mulRaw a0 a1 a2 a3 b0 b1 b2 b3 + (Repr.ofLimbs r.1 r.2.1 r.2.2.1 r.2.2.2).toNat < + Secp256k1.Scalar.Basic.CARD := by + generalize hlEq : mul512Raw a0 a1 a2 a3 b0 b1 b2 b3 = l + rcases l with ⟨l0, l1, l2, l3, l4, l5, l6, l7⟩ + unfold mulRaw + rw [hlEq] + exact (reduce512Raw_spec l0 l1 l2 l3 l4 l5 l6 l7).1 + +/-- Modular multiplication agrees with multiplication in the canonical scalar field. -/ +theorem mulRaw_cast (a0 a1 a2 a3 b0 b1 b2 b3 : UInt64) + : let r := mulRaw a0 a1 a2 a3 b0 b1 b2 b3 + ((Repr.ofLimbs r.1 r.2.1 r.2.2.1 r.2.2.2).toNat : + Secp256k1.Scalar.Basic.Field) = + ((Repr.ofLimbs a0 a1 a2 a3).toNat : Secp256k1.Scalar.Basic.Field) * + ((Repr.ofLimbs b0 b1 b2 b3).toNat : Secp256k1.Scalar.Basic.Field) := by + generalize hlEq : mul512Raw a0 a1 a2 a3 b0 b1 b2 b3 = l + have hl := mul512Raw_value a0 a1 a2 a3 b0 b1 b2 b3 + rw [hlEq] at hl + rcases l with ⟨l0, l1, l2, l3, l4, l5, l6, l7⟩ + have hr := (reduce512Raw_spec l0 l1 l2 l3 l4 l5 l6 l7).2 + rw [hl] at hr + unfold mulRaw + rw [hlEq] + simpa only [Nat.cast_mul] using hr + +/-- Modular squaring returns a canonical scalar representative. -/ +theorem squareRaw_lt (a0 a1 a2 a3 : UInt64) : + let r := squareRaw a0 a1 a2 a3 + (Repr.ofLimbs r.1 r.2.1 r.2.2.1 r.2.2.2).toNat < + Secp256k1.Scalar.Basic.CARD := by + simpa only [squareRaw] using mulRaw_lt a0 a1 a2 a3 a0 a1 a2 a3 + +/-- Modular squaring agrees with squaring in the canonical scalar field. -/ +theorem squareRaw_cast (a0 a1 a2 a3 : UInt64) : + let r := squareRaw a0 a1 a2 a3 + ((Repr.ofLimbs r.1 r.2.1 r.2.2.1 r.2.2.2).toNat : + Secp256k1.Scalar.Basic.Field) = + ((Repr.ofLimbs a0 a1 a2 a3).toNat : Secp256k1.Scalar.Basic.Field) ^ 2 := by + simpa only [squareRaw, pow_two] using mulRaw_cast a0 a1 a2 a3 a0 a1 a2 a3 + +end Reduction +end Secp256k1.Scalar.Fast diff --git a/CompPoly/Fields/Secp256k1/Scalar/Fast/Theorems.lean b/CompPoly/Fields/Secp256k1/Scalar/Fast/Theorems.lean new file mode 100644 index 00000000..8c2ae922 --- /dev/null +++ b/CompPoly/Fields/Secp256k1/Scalar/Fast/Theorems.lean @@ -0,0 +1,249 @@ +/- +Copyright (c) 2026 CompPoly Contributors. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Varun Thakore +-/ + +import CompPoly.Fields.Secp256k1.Scalar.Fast.Arithmetic +import Mathlib.FieldTheory.Finite.Basic + +/-! +# Correctness Theorems for Fast secp256k1 Scalar Field Arithmetic + +This module proves that conversion to the canonical scalar field preserves the +fast representation's constructors, arithmetic operations, powers, casts, and +scalar actions. These theorems support the field transfer and ring equivalence. +-/ + +namespace Secp256k1.Scalar.Fast + +/-- Converting `ofNat n` to the canonical scalar field gives the canonical cast of `n`. -/ +@[simp] +theorem toField_ofNat (n : Nat) : + toField (ofNat n) = (n : Secp256k1.Scalar.Basic.Field) := by + unfold toField toNat ofNat + exact Repr.ofNat_cast n + +/-- Converting a canonical scalar to fast representation and back is the identity. -/ +@[simp] +theorem toField_ofField (x : Secp256k1.Scalar.Basic.Field) : + toField (ofField x) = x := by + unfold ofField ofNat toField toNat + rw [Repr.ofNat_cast] + exact ZMod.natCast_zmod_val x + +/-- Converting a fast scalar to the canonical field and back is the identity. -/ +@[simp] +theorem ofField_toField (x : Field) : ofField (toField x) = x := by + apply Subtype.ext + change Repr.ofNat ((x.val.toNat : Secp256k1.Scalar.Basic.Field).val) = x.val + rw [ZMod.val_natCast_of_lt x.property] + exact Repr.ofNat_toNat x.val x.property + +/-- Canonical interpretation is injective on fast scalar values. -/ +theorem toField_injective : Function.Injective toField := + Function.LeftInverse.injective ofField_toField + +/-- Fast zero maps to canonical zero. -/ +@[simp] +theorem toField_zero : toField (0 : Field) = 0 := by + rfl + +/-- Fast one maps to canonical one. -/ +@[simp] +theorem toField_one : toField (1 : Field) = 1 := by + rfl + +/-- Fast addition agrees with canonical scalar-field addition. -/ +@[simp] +theorem toField_add (x y : Field) : + toField (x + y) = toField x + toField y := by + change toField (add x y) = toField x + toField y + unfold add toField toNat + exact Reduction.addModRaw_cast + x.val.d0 x.val.d1 x.val.d2 x.val.d3 y.val.d0 y.val.d1 y.val.d2 y.val.d3 + x.property y.property + +/-- Fast negation agrees with canonical scalar-field negation. -/ +@[simp] +theorem toField_neg (x : Field) : + toField (-x) = -toField x := by + change toField (neg x) = -toField x + unfold neg toField toNat + exact Reduction.negRaw_cast x.val.d0 x.val.d1 x.val.d2 x.val.d3 x.property + +/-- Fast subtraction agrees with canonical scalar-field subtraction. -/ +@[simp] +theorem toField_sub (x y : Field) : + toField (x - y) = toField x - toField y := by + change toField (sub x y) = toField x - toField y + unfold sub toField toNat + exact Reduction.subModRaw_cast + x.val.d0 x.val.d1 x.val.d2 x.val.d3 y.val.d0 y.val.d1 y.val.d2 y.val.d3 + x.property y.property + +/-- Fast multiplication agrees with canonical scalar-field multiplication. -/ +@[simp] +theorem toField_mul (x y : Field) : + toField (x * y) = toField x * toField y := by + change toField (mul x y) = toField x * toField y + unfold mul toField toNat + exact Reduction.mulRaw_cast + x.val.d0 x.val.d1 x.val.d2 x.val.d3 y.val.d0 y.val.d1 y.val.d2 y.val.d3 + +/-- Fast squaring agrees with canonical multiplication by the same value. -/ +@[simp] +theorem toField_square (x : Field) : + toField (square x) = toField x * toField x := by + unfold square toField toNat + simpa only [pow_two] using + Reduction.squareRaw_cast x.val.d0 x.val.d1 x.val.d2 x.val.d3 + +/-- Fast binary exponentiation agrees with canonical natural exponentiation. -/ +@[simp] +theorem toField_pow (x : Field) (n : Nat) : + toField (pow x n) = toField x ^ n := by + letI : Semigroup Field := { + mul_assoc := by + intro a b c + apply toField_injective + rw [toField_mul (a * b) c, toField_mul a b, + toField_mul a (b * c), toField_mul b c] + exact mul_assoc (toField a) (toField b) (toField c) } + induction n with + | zero => + change toField (@npowBinRec Field ⟨one⟩ ⟨mul⟩ 0 x) = _ + rw [npowBinRec_zero, toField_one, pow_zero] + | succ n ih => + change toField (@npowBinRec Field ⟨one⟩ ⟨mul⟩ (n + 1) x) = _ + rw [npowBinRec_succ] + change toField (pow x n * x) = _ + rw [toField_mul, ih, pow_succ] + +/-- Fermat inversion in the canonical secp256k1 scalar field. -/ +private theorem pow_card_sub_two_eq_inv (a : Secp256k1.Scalar.Basic.Field) : + a ^ (Secp256k1.Scalar.Basic.CARD - 2) = a⁻¹ := by + by_cases ha : a = 0 + · subst a + norm_num [Secp256k1.Scalar.Basic.CARD] + · have hfermat := ZMod.pow_card_sub_one_eq_one ha + have hexp : Secp256k1.Scalar.Basic.CARD - 2 + 1 = + Secp256k1.Scalar.Basic.CARD - 1 := by + norm_num [Secp256k1.Scalar.Basic.CARD] + calc + a ^ (Secp256k1.Scalar.Basic.CARD - 2) = + a ^ (Secp256k1.Scalar.Basic.CARD - 2) * (a * a⁻¹) := by + rw [mul_inv_cancel₀ ha, mul_one] + _ = (a ^ (Secp256k1.Scalar.Basic.CARD - 2) * a) * a⁻¹ := by ring + _ = a ^ (Secp256k1.Scalar.Basic.CARD - 2 + 1) * a⁻¹ := by + rw [pow_succ] + _ = a ^ (Secp256k1.Scalar.Basic.CARD - 1) * a⁻¹ := by rw [hexp] + _ = a⁻¹ := by rw [hfermat, one_mul] + +/-- Fermat inversion agrees with inversion in the canonical scalar field. -/ +@[simp] theorem toField_invFermat (x : Field) : + toField (invFermat x) = (toField x)⁻¹ := by + unfold invFermat + rw [toField_pow, pow_card_sub_two_eq_inv] + +/-- Default fast inversion agrees with inversion in the canonical scalar field. -/ +@[simp] theorem toField_inv (x : Field) : + toField x⁻¹ = (toField x)⁻¹ := by + change toField (inv x) = (toField x)⁻¹ + unfold inv + exact toField_invFermat x + +/-- Fast division agrees with division in the canonical scalar field. -/ +@[simp] +theorem toField_div (x y : Field) : + toField (x / y) = toField x / toField y := by + change toField (div x y) = toField x / toField y + unfold div + calc + toField (mul x (inv y)) = toField x * toField (inv y) := + toField_mul x (inv y) + _ = toField x * (toField y)⁻¹ := + congrArg (fun z => toField x * z) (toField_inv y) + _ = toField x / toField y := by rw [div_eq_mul_inv] + +/-- Natural casts into the fast field agree with canonical scalar-field casts. -/ +@[simp] +theorem toField_natCast (n : Nat) : + toField (n : Field) = (n : Secp256k1.Scalar.Basic.Field) := by + change toField (ofNat n) = (n : Secp256k1.Scalar.Basic.Field) + rw [toField_ofNat] + +/-- Integer casts into the fast field agree with canonical scalar-field casts. -/ +@[simp] +theorem toField_intCast (z : Int) : + toField (z : Field) = (z : Secp256k1.Scalar.Basic.Field) := by + change toField (ofInt z) = (z : Secp256k1.Scalar.Basic.Field) + unfold ofInt + rw [toField_ofField] + +/-- Fast natural scalar multiplication agrees with canonical scalar multiplication. -/ +@[simp] +theorem toField_nsmul (n : Nat) (x : Field) : + toField (n • x) = n • toField x := by + change toField ((n : Field) * x) = n • toField x + rw [toField_mul, toField_natCast, nsmul_eq_mul] + +/-- Fast integer scalar multiplication agrees with canonical scalar multiplication. -/ +@[simp] +theorem toField_zsmul (n : Int) (x : Field) : + toField (n • x) = n • toField x := by + change toField ((n : Field) * x) = n • toField x + rw [toField_mul, toField_intCast, zsmul_eq_mul] + +/-- Standard natural powers agree with powers in the canonical scalar field. -/ +@[simp] +theorem toField_npow (x : Field) (n : Nat) : + toField (x ^ n) = toField x ^ n := by + change toField (pow x n) = toField x ^ n + exact toField_pow x n + +/-- Standard integer powers agree with powers in the canonical scalar field. -/ +@[simp] +theorem toField_zpow (x : Field) (n : Int) : + toField (x ^ n) = toField x ^ n := by + cases n with + | ofNat n => + change toField (pow x n) = toField x ^ (Int.ofNat n) + rw [toField_pow] + exact (zpow_natCast (toField x) n).symm + | negSucc n => + change toField (pow (inv x) (n + 1)) = toField x ^ (Int.negSucc n) + have hinv : toField (inv x) = (toField x)⁻¹ := by + change toField x⁻¹ = (toField x)⁻¹ + exact toField_inv x + rw [toField_pow, hinv, zpow_negSucc, inv_pow] + +/-- Nonnegative rational casts agree with canonical scalar-field casts. -/ +@[simp] +theorem toField_nnratCast (q : ℚ≥0) : + toField (q : Field) = (q : Secp256k1.Scalar.Basic.Field) := by + change toField (ofField (q : Secp256k1.Scalar.Basic.Field)) = _ + exact toField_ofField _ + +/-- Rational casts agree with canonical scalar-field casts. -/ +@[simp] +theorem toField_ratCast (q : ℚ) : + toField (q : Field) = (q : Secp256k1.Scalar.Basic.Field) := by + change toField (ofField (q : Secp256k1.Scalar.Basic.Field)) = _ + exact toField_ofField _ + +/-- Fast nonnegative rational scalar multiplication agrees with the canonical operation. -/ +@[simp] +theorem toField_nnqsmul (q : ℚ≥0) (x : Field) : + toField (q • x) = q • toField x := by + change toField (ofField (q • toField x)) = q • toField x + exact toField_ofField _ + +/-- Fast rational scalar multiplication agrees with the canonical operation. -/ +@[simp] +theorem toField_qsmul (q : ℚ) (x : Field) : + toField (q • x) = q • toField x := by + change toField (ofField (q • toField x)) = q • toField x + exact toField_ofField _ + +end Secp256k1.Scalar.Fast diff --git a/lakefile.lean b/lakefile.lean index d54c9d27..83082b31 100644 --- a/lakefile.lean +++ b/lakefile.lean @@ -8,11 +8,36 @@ package CompPoly where require "leanprover-community" / mathlib @ git "v4.31.0" +def nativeDir : FilePath := __dir__ / "native" + +def nativeBuildDir : FilePath := __dir__ / ".lake" / "build" / "native" + +def nativeLib (name src : String) (extraCcArgs : Array String := #[]) : FetchM (Job FilePath) := do + let srcFile := nativeDir / src + let oFile := nativeBuildDir / s!"{name}.o" + let libFile := nativeBuildDir / s!"lib{name}.a" + let srcJob ← inputTextFile srcFile + buildFileAfterDep libFile srcJob fun _srcTrace => do + compileO oFile srcFile (#["-O3", "-I", (← getLeanIncludeDir).toString] ++ extraCcArgs) + createParentDirs libFile + removeFileIfExists libFile + proc { + cmd := (← getLeanAr).toString + args := #["rcs", libFile.toString, oFile.toString] + } + +extern_lib liblean_goldilocks_native _pkg := nativeLib "goldilocks_native" "goldilocks_native.c" + +def nativeLinkArgs (name : String) : Array String := + #["-L", nativeBuildDir.toString, s!"-l{name}"] + @[default_target] -lean_lib CompPoly +lean_lib CompPoly where + moreLinkArgs := nativeLinkArgs "goldilocks_native" lean_lib CompPolyTests where srcDir := "tests" + moreLinkArgs := nativeLinkArgs "goldilocks_native" lean_lib CompPolyBenchLib where srcDir := "bench" @@ -20,3 +45,8 @@ lean_lib CompPolyBenchLib where lean_exe CompPolyBench where srcDir := "bench" + +lean_exe CompPolyGoldilocksFastExtTests where + srcDir := "tests" + root := `CompPolyTests.Fields.Goldilocks.FastExt + moreLinkArgs := nativeLinkArgs "goldilocks_native" diff --git a/native/goldilocks_native.c b/native/goldilocks_native.c new file mode 100644 index 00000000..e899d1c5 --- /dev/null +++ b/native/goldilocks_native.c @@ -0,0 +1,44 @@ +#include +#include + +/* + * Native performance primitives for Goldilocks fast arithmetic. + * + * These functions are called from Lean through @[extern] declarations in + * CompPoly/Fields/Goldilocks/FastExt.lean. Lean verifies only the types of the + * extern declarations, not the arithmetic performed here. This file is + * therefore part of the trusted native boundary for the extern-backed API. + * + * The verified Lean implementation remains the default field implementation; + * this native code is used only by the opt-in FastExt module. + */ + +// Return the high 64 bits of a 64-by-64 unsigned multiplication. +LEAN_EXPORT uint64_t lean_uint64_mul_hi(uint64_t a, uint64_t b) { + return (uint64_t)(((unsigned __int128)a * b) >> 64); +} + +static const uint64_t GOLDILOCKS_NEG_MODULUS = 0x00000000FFFFFFFFULL; + +static inline uint64_t goldilocks_add_no_canonicalize(uint64_t x, uint64_t y) { + uint64_t res = x + y; + return res + (res < x ? GOLDILOCKS_NEG_MODULUS : 0); +} + +// Goldilocks multiplication modulo p = 2^64 - 2^32 + 1. +LEAN_EXPORT uint64_t lean_goldilocks_mul(uint64_t a, uint64_t b) { + unsigned __int128 prod = (unsigned __int128)a * b; + uint64_t lo = (uint64_t)prod; + uint64_t hi = (uint64_t)(prod >> 64); + + uint64_t hi_hi = hi >> 32; + uint64_t hi_lo = hi & GOLDILOCKS_NEG_MODULUS; + + uint64_t t0 = lo - hi_hi; + if (lo < hi_hi) { + t0 -= GOLDILOCKS_NEG_MODULUS; + } + + uint64_t t1 = hi_lo * GOLDILOCKS_NEG_MODULUS; + return goldilocks_add_no_canonicalize(t0, t1); +} diff --git a/tests/CompPolyTests.lean b/tests/CompPolyTests.lean index 0321cad5..af7a2885 100644 --- a/tests/CompPolyTests.lean +++ b/tests/CompPolyTests.lean @@ -23,8 +23,10 @@ import CompPolyTests.Bivariate.WeightedDegree import CompPolyTests.Data.MvPolynomial.Notation import CompPolyTests.Fields.Binary.AdditiveNTT.NovelPolynomialBasis import CompPolyTests.Fields.Binary.BF128Ghash.Prelude +import CompPolyTests.Fields.Goldilocks.Fast import CompPolyTests.Fields.KoalaBear.Fast import CompPolyTests.Fields.PrattCertificate +import CompPolyTests.Fields.Secp256k1.Scalar.Fast import CompPolyTests.LinearAlgebra.Dense import CompPolyTests.Multilinear.Equiv import CompPolyTests.Multivariate.CMvMonomial diff --git a/tests/CompPolyTests/Fields/Goldilocks/Fast.lean b/tests/CompPolyTests/Fields/Goldilocks/Fast.lean new file mode 100644 index 00000000..79e976ca --- /dev/null +++ b/tests/CompPolyTests/Fields/Goldilocks/Fast.lean @@ -0,0 +1,46 @@ +/- +Copyright (c) 2026 CompPoly Contributors. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Varun Thakore +-/ + +import CompPoly.Fields.Goldilocks.Fast + +/-! +# Fast Goldilocks Field Tests + +Regression checks for the verified `UInt64` fast representation. + +Run this file with: +`lake build CompPolyTests.Fields.Goldilocks.Fast` +-/ + +namespace Goldilocks.Fast + +private def p : Nat := Goldilocks.Basic.fieldSize + +#guard raw (0 : Field) = 0 +#guard raw (1 : Field) = 1 +#guard toNat (ofNat 73) = 73 +#guard toNat (ofNat p) = 0 +#guard toNat (ofNat (p + 73)) = 73 +#guard toNat (ofUInt64 (UInt64.ofNat (UInt64.size - 1))) = 4294967294 +#guard toNat ((ofNat (p - 1)) + (4 : Field)) = 3 +#guard toNat ((ofNat (p - 1)) + (ofNat (p - 1))) = p - 2 +#guard toNat ((17 : Field) - (6 : Field)) = 11 +#guard toNat ((6 : Field) - (17 : Field)) = p - 11 +#guard toNat (-(0 : Field)) = 0 +#guard toNat (-(1 : Field)) = p - 1 +#guard toNat ((ofNat (p - 1)) * (ofNat (p - 1))) = 1 +#guard toField (square (54321 : Field)) = ((54321 : Goldilocks.Basic.Field) ^ 2) +#guard toNat ((73 : Field) ^ 0) = 1 +#guard toNat ((73 : Field) ^ 1) = 73 +#guard toField ((987654321 : Field) ^ 19) = ((987654321 : Goldilocks.Basic.Field) ^ 19) +#guard toField ((987654321 : Field) ^ 511) = ((987654321 : Goldilocks.Basic.Field) ^ 511) +#guard toNat ((0 : Field)⁻¹) = 0 +#guard toNat ((73 : Field)⁻¹ * (73 : Field)) = 1 +#guard toNat ((73 : Field) / (73 : Field)) = 1 +#guard toField ((73 : Field)⁻¹) = ((73 : Goldilocks.Basic.Field)⁻¹) +#guard toField ((73 : Field) ^ (-5 : Int)) = ((73 : Goldilocks.Basic.Field) ^ (-5 : Int)) + +end Goldilocks.Fast diff --git a/tests/CompPolyTests/Fields/Goldilocks/FastExt.lean b/tests/CompPolyTests/Fields/Goldilocks/FastExt.lean new file mode 100644 index 00000000..6ec24580 --- /dev/null +++ b/tests/CompPolyTests/Fields/Goldilocks/FastExt.lean @@ -0,0 +1,71 @@ +/- +Copyright (c) 2026 CompPoly Contributors. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Varun Thakore +-/ + +import CompPoly.Fields.Goldilocks.Fast +import CompPoly.Fields.Goldilocks.FastExt + +/-! +# Extern-Backed Fast Goldilocks Tests + +Runtime regression checks for `Goldilocks.Fast.Ext`. These tests compare the +extern-backed operations against the verified `Goldilocks.Fast` implementation. + +The checks live in an executable rather than `#guard`s because Lean's module +interpreter cannot call project-local C externs during elaboration. + +Run this file with: +`lake exe CompPolyGoldilocksFastExtTests` +-/ + +namespace CompPolyTests.Fields.Goldilocks.FastExt + +private def check (name : String) (ok : Bool) : IO Bool := do + if ok then + return true + else + IO.eprintln s!"failed: {name}" + return false + +private def a : Goldilocks.Fast.Field := 987654321 + +private def b : Goldilocks.Fast.Field := 54321 + +private def c : Goldilocks.Fast.Field := 73 + +private def nearTop : Goldilocks.Fast.Field := + Goldilocks.Fast.ofNat (Goldilocks.Basic.fieldSize - 1) + +private def maxUInt64 : Goldilocks.Fast.Field := + Goldilocks.Fast.ofUInt64 (UInt64.ofNat (UInt64.size - 1)) + +private def runChecks : IO Bool := do + let ok1 ← check "mulWithMulHi" (Goldilocks.Fast.Ext.mulWithMulHi a b = a * b) + let ok2 ← check "mulNative" (Goldilocks.Fast.Ext.mulNative a b = a * b) + let ok3 ← + check "squareWithMulHi" (Goldilocks.Fast.Ext.squareWithMulHi a = Goldilocks.Fast.square a) + let ok4 ← + check "squareNative" (Goldilocks.Fast.Ext.squareNative a = Goldilocks.Fast.square a) + let ok5 ← + check "squareNNative" (Goldilocks.Fast.Ext.squareNNative a 8 = Goldilocks.Fast.squareN a 8) + let ok6 ← check "invNative" (Goldilocks.Fast.Ext.invNative c = c⁻¹) + let ok7 ← check "divNative" (Goldilocks.Fast.Ext.divNative a c = a / c) + let ok8 ← + check "mulNative near modulus" + (Goldilocks.Fast.Ext.mulNative nearTop nearTop = nearTop * nearTop) + let ok9 ← + check "mulNative max UInt64" (Goldilocks.Fast.Ext.mulNative maxUInt64 a = maxUInt64 * a) + let ok10 ← + check "divNative nontrivial" (Goldilocks.Fast.Ext.divNative b c = b / c) + return ok1 && ok2 && ok3 && ok4 && ok5 && ok6 && ok7 && ok8 && ok9 && ok10 + +end CompPolyTests.Fields.Goldilocks.FastExt + +/-- Run the extern-backed Goldilocks regression checks. -/ +def main : IO UInt32 := do + if ← CompPolyTests.Fields.Goldilocks.FastExt.runChecks then + return 0 + else + return 1 diff --git a/tests/CompPolyTests/Fields/Secp256k1/Scalar/Fast.lean b/tests/CompPolyTests/Fields/Secp256k1/Scalar/Fast.lean new file mode 100644 index 00000000..71c5597d --- /dev/null +++ b/tests/CompPolyTests/Fields/Secp256k1/Scalar/Fast.lean @@ -0,0 +1,55 @@ +/- +Copyright (c) 2026 CompPoly Contributors. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Varun Thakore +-/ + +import CompPoly.Fields.Secp256k1.Scalar.Fast + +/-! +# Fast secp256k1 Scalar Tests + +Regression checks for the pure-Lean 4x64 scalar implementation. +-/ + +namespace Secp256k1.Scalar.Fast + +private def n : Nat := Secp256k1.Scalar.Basic.CARD + +#synth CommRing Field +#synth _root_.Field Field +#synth NonBinaryField Field + +#guard mul64Hi 0xffffffffffffffff 0xffffffffffffffff = 0xfffffffffffffffe +#guard mul64Hi 0x123456789abcdef0 0xfedcba9876543210 = 0x121fa00ad77d7422 + +#guard toNat (0 : Field) = 0 +#guard toNat (1 : Field) = 1 +#guard toNat (ofNat n) = 0 +#guard toNat (ofNat (n + 17)) = 17 +#guard toNat (ofNat (n - 1) + 1) = 0 +#guard toNat (ofNat (n - 1) + ofNat (n - 1)) = n - 2 +#guard toNat ((17 : Field) - (6 : Field)) = 11 +#guard toNat ((6 : Field) - (17 : Field)) = n - 11 +#guard toNat (-(0 : Field)) = 0 +#guard toNat (-(1 : Field)) = n - 1 +#guard toNat (ofNat (n - 1) * ofNat (n - 1)) = 1 +#guard toField ((0x123456789abcdef : Field) * (0xfedcba987654321 : Field)) = + (0x123456789abcdef : Secp256k1.Scalar.Basic.Field) * + (0xfedcba987654321 : Secp256k1.Scalar.Basic.Field) +#guard toField (square (0xdeadbeef01234567 : Field)) = + (0xdeadbeef01234567 : Secp256k1.Scalar.Basic.Field) ^ 2 +#guard toNat ((73 : Field) ^ 0) = 1 +#guard toNat ((73 : Field) ^ 1) = 73 +#guard toField ((987654321 : Field) ^ 19) = + (987654321 : Secp256k1.Scalar.Basic.Field) ^ 19 +#guard toNat ((0 : Field)⁻¹) = 0 +#guard toNat ((1 : Field)⁻¹) = 1 +#guard toNat (invFermat 73 * 73) = 1 +#guard toNat ((73 : Field) * (73 : Field)⁻¹) = 1 +#guard toNat ((ofNat (n - 1))⁻¹) = n - 1 +#guard toNat ((987654321 : Field) * (987654321 : Field)⁻¹) = 1 +#guard toField ((73 : Field) / (19 : Field)) = + (73 : Secp256k1.Scalar.Basic.Field) / (19 : Secp256k1.Scalar.Basic.Field) + +end Secp256k1.Scalar.Fast