From e7cbf49adbe94e9794c890e805bf996a21ec3c83 Mon Sep 17 00:00:00 2001 From: Jake Massimo Date: Fri, 17 Apr 2026 13:18:02 +0000 Subject: [PATCH 01/11] ML-DSA AArch64 HOL-Light proof poly_use_hint_32 with functional correctness Add HOL-Light proofs for the ML-DSA poly_use_hint_32 AArch64 assembly implementation, covering parameter sets 65/87 (GAMMA2=(Q-1)/32). Includes: - Functional correctness proof: each output coefficient equals the FIPS 204 UseHint specification (mldsa_use_hint_32_spec), not just output bounds - Barrett reduction equivalence proof (assembly vs C decomposition) - Constant-time and memory safety proofs - Shared ML-DSA infrastructure lemmas in common/mlkem_mldsa.ml - CBMC-style test harness in tests/test.c The functional correctness proof establishes that the SIMD assembly computes exactly the same result as the reference UseHint algorithm for all valid inputs (a < Q, h in {0,1}). Signed-off-by: Jake Massimo --- arm/Makefile | 1 + arm/mldsa/mldsa_poly_use_hint_32.S | 157 +++++ arm/proofs/mldsa_poly_use_hint_32.ml | 948 +++++++++++++++++++++++++++ arm/proofs/specifications.txt | 2 + arm/proofs/subroutine_signatures.ml | 18 + benchmarks/benchmark.c | 3 + common/mlkem_mldsa.ml | 94 +++ include/s2n-bignum.h | 4 + tests/test.c | 84 +++ tools/collect-signatures.py | 1 + 10 files changed, 1312 insertions(+) create mode 100644 arm/mldsa/mldsa_poly_use_hint_32.S create mode 100644 arm/proofs/mldsa_poly_use_hint_32.ml diff --git a/arm/Makefile b/arm/Makefile index d89fab8b3..11e2bbf87 100644 --- a/arm/Makefile +++ b/arm/Makefile @@ -255,6 +255,7 @@ BIGNUM_OBJ = curve25519/bignum_add_p25519.o \ mldsa/mldsa_intt.o \ mldsa/mldsa_ntt.o \ mldsa/mldsa_pointwise.o \ + mldsa/mldsa_poly_use_hint_32.o \ mlkem/mlkem_basemul_k2.o \ mlkem/mlkem_basemul_k3.o \ mlkem/mlkem_basemul_k4.o \ diff --git a/arm/mldsa/mldsa_poly_use_hint_32.S b/arm/mldsa/mldsa_poly_use_hint_32.S new file mode 100644 index 000000000..b28e6f711 --- /dev/null +++ b/arm/mldsa/mldsa_poly_use_hint_32.S @@ -0,0 +1,157 @@ +// Copyright (c) The mldsa-native project authors +// Copyright Amazon.com, Inc. or its affiliates. All Rights Reserved. +// SPDX-License-Identifier: Apache-2.0 OR ISC OR MIT + +// ---------------------------------------------------------------------------- +// Use hint to correct high bits of decomposition (parameter sets 65/87) +// Inputs a[256] (unsigned 32-bit, in [0,Q)), h[256] (hint bits, 0 or 1) +// Output b[256] (unsigned 32-bit, in [0,16)) +// +// Implements mld_use_hint for ML-DSA parameter sets 65/87: +// GAMMA2 = (Q-1)/32 = 261888 +// 2*GAMMA2 = 523776 +// Output range: [0, 15] +// +// Algorithm per coefficient: +// 1. Decompose: a1 = round_down(a / 523776), a0 = a - a1*523776 +// If a > 31*GAMMA2 = 8118528, wrap: a1=0, a0=a-Q +// 2. delta = (a0 <= 0) ? -1 : 1 +// 3. b = (a1 + delta * h) & 15 +// +// extern void mldsa_poly_use_hint_32 +// (int32_t b[static 256], const int32_t a[static 256], +// const int32_t h[static 256]); +// +// Standard ARM ABI: X0 = b, X1 = a, X2 = h +// ---------------------------------------------------------------------------- +#include "_internal_s2n_bignum_arm.h" + + S2N_BN_SYM_VISIBILITY_DIRECTIVE(mldsa_poly_use_hint_32) + S2N_BN_FUNCTION_TYPE_DIRECTIVE(mldsa_poly_use_hint_32) + S2N_BN_SYM_PRIVACY_DIRECTIVE(mldsa_poly_use_hint_32) + .text + .balign 4 + +S2N_BN_SYMBOL(mldsa_poly_use_hint_32): + CFI_START + +// This matches the code in the mldsa-native repository +// https://github.com/pq-code-package/mldsa-native/blob/main/mldsa/src/native/aarch64/src/poly_use_hint_32_asm.S + +// Load constants into SIMD registers + +// v20 = Q = 8380417 (unused in computation but part of original code) + mov w4, #0xe001 + movk w4, #0x7f, lsl #16 + dup v20.4s, w4 + +// v21 = 31*GAMMA2 = 8118528 = 0x7be100 (wraparound threshold) + mov w5, #0xe100 + movk w5, #0x7b, lsl #16 + dup v21.4s, w5 + +// v22 = 2*GAMMA2 = 523776 = 0x7fe00 (decompose multiplier) + mov w7, #0xfe00 + movk w7, #0x7, lsl #16 + dup v22.4s, w7 + +// v23 = Barrett constant = 0x40100401 = 1074791425 +// Used for SQDMULH-based Barrett reduction: a1 ~= (2*a*c) >> 49 + mov w11, #0x0401 + movk w11, #0x4010, lsl #16 + dup v23.4s, w11 + +// v24 = mask 15 = 0x0000000f (for final AND to compute mod 16) + movi v24.4s, #0xf + +// Loop counter: 16 iterations, processing 16 coefficients per iteration +// 16 * 16 = 256 total coefficients + mov x3, #0x10 + +Lmldsa_poly_use_hint_32_loop: + // Load 16 coefficients from a (4 vectors of 4 int32s) + ldr q1, [x1, #0x10] + ldr q2, [x1, #0x20] + ldr q3, [x1, #0x30] + ldr q0, [x1], #0x40 + + // Load 16 hint bits from h (4 vectors of 4 int32s) + ldr q5, [x2, #0x10] + ldr q6, [x2, #0x20] + ldr q7, [x2, #0x30] + ldr q4, [x2], #0x40 + + // --- Process v1 (coefficients at offset +16) --- + // Decompose: a1 = sqdmulh(a, barrett_const) >> 18 + sqdmulh v17.4s, v1.4s, v23.4s + srshr v17.4s, v17.4s, #0x12 + // Check wraparound: mask = (a > 31*GAMMA2) ? all_ones : 0 + cmgt v25.4s, v1.4s, v21.4s + // a0 = a - a1 * 2*GAMMA2 + mls v1.4s, v17.4s, v22.4s + // If wraparound: a1 = 0 (clear a1 where mask is set) + bic v17.16b, v17.16b, v25.16b + // If wraparound: a0 -= 1 (add all_ones = -1) + add v1.4s, v1.4s, v25.4s + // delta = (a0 <= 0) ? all_ones : 0 + cmle v1.4s, v1.4s, #0 + // delta = (a0 <= 0) ? -1 : 1 (set bit 0) + orr v1.4s, #0x1 + // b = a1 + delta * hint + mla v17.4s, v1.4s, v5.4s + // b = b & 15 + and v17.16b, v17.16b, v24.16b + + // --- Process v2 (coefficients at offset +32) --- + sqdmulh v18.4s, v2.4s, v23.4s + srshr v18.4s, v18.4s, #0x12 + cmgt v25.4s, v2.4s, v21.4s + mls v2.4s, v18.4s, v22.4s + bic v18.16b, v18.16b, v25.16b + add v2.4s, v2.4s, v25.4s + cmle v2.4s, v2.4s, #0 + orr v2.4s, #0x1 + mla v18.4s, v2.4s, v6.4s + and v18.16b, v18.16b, v24.16b + + // --- Process v3 (coefficients at offset +48) --- + sqdmulh v19.4s, v3.4s, v23.4s + srshr v19.4s, v19.4s, #0x12 + cmgt v25.4s, v3.4s, v21.4s + mls v3.4s, v19.4s, v22.4s + bic v19.16b, v19.16b, v25.16b + add v3.4s, v3.4s, v25.4s + cmle v3.4s, v3.4s, #0 + orr v3.4s, #0x1 + mla v19.4s, v3.4s, v7.4s + and v19.16b, v19.16b, v24.16b + + // --- Process v0 (coefficients at offset +0, loaded last for post-increment) --- + sqdmulh v16.4s, v0.4s, v23.4s + srshr v16.4s, v16.4s, #0x12 + cmgt v25.4s, v0.4s, v21.4s + mls v0.4s, v16.4s, v22.4s + bic v16.16b, v16.16b, v25.16b + add v0.4s, v0.4s, v25.4s + cmle v0.4s, v0.4s, #0 + orr v0.4s, #0x1 + mla v16.4s, v0.4s, v4.4s + and v16.16b, v16.16b, v24.16b + + // Store 16 output coefficients + str q17, [x0, #0x10] + str q18, [x0, #0x20] + str q19, [x0, #0x30] + str q16, [x0], #0x40 + + // Decrement loop counter and branch + subs x3, x3, #0x1 + b.ne Lmldsa_poly_use_hint_32_loop + + CFI_RET + +S2N_BN_SIZE_DIRECTIVE(mldsa_poly_use_hint_32) + +#if defined(__linux__) && defined(__ELF__) +.section .note.GNU-stack, "", %progbits +#endif diff --git a/arm/proofs/mldsa_poly_use_hint_32.ml b/arm/proofs/mldsa_poly_use_hint_32.ml new file mode 100644 index 000000000..0db8d6651 --- /dev/null +++ b/arm/proofs/mldsa_poly_use_hint_32.ml @@ -0,0 +1,948 @@ +(* + * Copyright Amazon.com, Inc. or its affiliates. All Rights Reserved. + * SPDX-License-Identifier: Apache-2.0 OR ISC OR MIT-0 + *) + +(* ========================================================================= *) +(* Use hint to correct high bits of decomposition (ML-DSA, param 65/87). *) +(* ========================================================================= *) + +needs "arm/proofs/base.ml";; +needs "common/mlkem_mldsa.ml";; + +(**** print_literal_from_elf "arm/mldsa/mldsa_poly_use_hint_32.o";; + ****) + +let mldsa_poly_use_hint_32_mc = define_assert_from_elf + "mldsa_poly_use_hint_32_mc" "arm/mldsa/mldsa_poly_use_hint_32.o" +[ + 0x529c0024; (* arm_MOV W4 (rvalue (word 57345)) *) + 0x72a00fe4; (* arm_MOVK W4 (word 127) 16 *) + 0x4e040c94; (* arm_DUP_GEN Q20 X4 32 128 *) + 0x529c2005; (* arm_MOV W5 (rvalue (word 57600)) *) + 0x72a00f65; (* arm_MOVK W5 (word 123) 16 *) + 0x4e040cb5; (* arm_DUP_GEN Q21 X5 32 128 *) + 0x529fc007; (* arm_MOV W7 (rvalue (word 65024)) *) + 0x72a000e7; (* arm_MOVK W7 (word 7) 16 *) + 0x4e040cf6; (* arm_DUP_GEN Q22 X7 32 128 *) + 0x5280802b; (* arm_MOV W11 (rvalue (word 1025)) *) + 0x72a8020b; (* arm_MOVK W11 (word 16400) 16 *) + 0x4e040d77; (* arm_DUP_GEN Q23 X11 32 128 *) + 0x4f0005f8; (* arm_MOVI Q24 (word 15) *) + 0xd2800203; (* arm_MOV X3 (rvalue (word 16)) *) + 0x3dc00421; (* arm_LDR Q1 X1 (Immediate_Offset (word 16)) *) + 0x3dc00822; (* arm_LDR Q2 X1 (Immediate_Offset (word 32)) *) + 0x3dc00c23; (* arm_LDR Q3 X1 (Immediate_Offset (word 48)) *) + 0x3cc40420; (* arm_LDR Q0 X1 (Postimmediate_Offset (word 64)) *) + 0x3dc00445; (* arm_LDR Q5 X2 (Immediate_Offset (word 16)) *) + 0x3dc00846; (* arm_LDR Q6 X2 (Immediate_Offset (word 32)) *) + 0x3dc00c47; (* arm_LDR Q7 X2 (Immediate_Offset (word 48)) *) + 0x3cc40444; (* arm_LDR Q4 X2 (Postimmediate_Offset (word 64)) *) + 0x4eb7b431; (* arm_SQDMULH_VEC Q17 Q1 Q23 32 128 *) + 0x4f2e2631; (* arm_SRSHR_VEC Q17 Q17 18 32 128 *) + 0x4eb53439; (* arm_CMGT_VEC Q25 Q1 Q21 32 128 *) + 0x6eb69621; (* arm_MLS_VEC Q1 Q17 Q22 32 128 *) + 0x4e791e31; (* arm_BIC_VEC Q17 Q17 Q25 128 *) + 0x4eb98421; (* arm_ADD_VEC Q1 Q1 Q25 32 128 *) + 0x6ea09821; (* arm_CMLE_VEC_ZERO Q1 Q1 32 128 *) + 0x4f001421; (* arm_ORR_VEC Q1 Q1 (rvalue (word 1)) 128 *) + 0x4ea59431; (* arm_MLA_VEC Q17 Q1 Q5 32 128 *) + 0x4e381e31; (* arm_AND_VEC Q17 Q17 Q24 128 *) + 0x4eb7b452; (* arm_SQDMULH_VEC Q18 Q2 Q23 32 128 *) + 0x4f2e2652; (* arm_SRSHR_VEC Q18 Q18 18 32 128 *) + 0x4eb53459; (* arm_CMGT_VEC Q25 Q2 Q21 32 128 *) + 0x6eb69642; (* arm_MLS_VEC Q2 Q18 Q22 32 128 *) + 0x4e791e52; (* arm_BIC_VEC Q18 Q18 Q25 128 *) + 0x4eb98442; (* arm_ADD_VEC Q2 Q2 Q25 32 128 *) + 0x6ea09842; (* arm_CMLE_VEC_ZERO Q2 Q2 32 128 *) + 0x4f001422; (* arm_ORR_VEC Q2 Q2 (rvalue (word 1)) 128 *) + 0x4ea69452; (* arm_MLA_VEC Q18 Q2 Q6 32 128 *) + 0x4e381e52; (* arm_AND_VEC Q18 Q18 Q24 128 *) + 0x4eb7b473; (* arm_SQDMULH_VEC Q19 Q3 Q23 32 128 *) + 0x4f2e2673; (* arm_SRSHR_VEC Q19 Q19 18 32 128 *) + 0x4eb53479; (* arm_CMGT_VEC Q25 Q3 Q21 32 128 *) + 0x6eb69663; (* arm_MLS_VEC Q3 Q19 Q22 32 128 *) + 0x4e791e73; (* arm_BIC_VEC Q19 Q19 Q25 128 *) + 0x4eb98463; (* arm_ADD_VEC Q3 Q3 Q25 32 128 *) + 0x6ea09863; (* arm_CMLE_VEC_ZERO Q3 Q3 32 128 *) + 0x4f001423; (* arm_ORR_VEC Q3 Q3 (rvalue (word 1)) 128 *) + 0x4ea79473; (* arm_MLA_VEC Q19 Q3 Q7 32 128 *) + 0x4e381e73; (* arm_AND_VEC Q19 Q19 Q24 128 *) + 0x4eb7b410; (* arm_SQDMULH_VEC Q16 Q0 Q23 32 128 *) + 0x4f2e2610; (* arm_SRSHR_VEC Q16 Q16 18 32 128 *) + 0x4eb53419; (* arm_CMGT_VEC Q25 Q0 Q21 32 128 *) + 0x6eb69600; (* arm_MLS_VEC Q0 Q16 Q22 32 128 *) + 0x4e791e10; (* arm_BIC_VEC Q16 Q16 Q25 128 *) + 0x4eb98400; (* arm_ADD_VEC Q0 Q0 Q25 32 128 *) + 0x6ea09800; (* arm_CMLE_VEC_ZERO Q0 Q0 32 128 *) + 0x4f001420; (* arm_ORR_VEC Q0 Q0 (rvalue (word 1)) 128 *) + 0x4ea49410; (* arm_MLA_VEC Q16 Q0 Q4 32 128 *) + 0x4e381e10; (* arm_AND_VEC Q16 Q16 Q24 128 *) + 0x3d800411; (* arm_STR Q17 X0 (Immediate_Offset (word 16)) *) + 0x3d800812; (* arm_STR Q18 X0 (Immediate_Offset (word 32)) *) + 0x3d800c13; (* arm_STR Q19 X0 (Immediate_Offset (word 48)) *) + 0x3c840410; (* arm_STR Q16 X0 (Postimmediate_Offset (word 64)) *) + 0xf1000463; (* arm_SUBS X3 X3 (rvalue (word 1)) *) + 0x54fff961; (* arm_Bcond (word 4294966956) Condition_NE *) + 0xd65f03c0 (* arm_RET X30 *) +];; + +let MLDSA_USE_HINT_EXEC = ARM_MK_EXEC_RULE mldsa_poly_use_hint_32_mc;; + +(* ========================================================================= *) +(* Functional specification: UseHint for ML-DSA parameter sets 65/87 *) +(* *) +(* Constants: *) +(* Q = 8380417 *) +(* GAMMA2 = (Q-1)/32 = 261888 *) +(* 2*GAMMA2 = 523776 *) +(* Output range: [0, 15] *) +(* *) +(* This is the per-coefficient UseHint function from FIPS 204 Algorithm 38: *) +(* 1. decompose: a1 = round_half_down(a / 523776), a0 = a - a1*523776 *) +(* 2. if hint=0: return a1 mod 16 *) +(* 3. if a0 > 0: return (a1 + 1) mod 16 *) +(* 4. if a0 <= 0: return (a1 - 1) mod 16 *) +(* ========================================================================= *) + +let mldsa_use_hint_32_spec = new_definition + `mldsa_use_hint_32_spec (a:num) (h:num) = + let a1 = ((((a + 127) DIV 128) * 1025 + 2097152) DIV 4194304) MOD 16 in + let a0:int = &a - &a1 * &523776 in + let a0' = if a0 > &4190208 then a0 - &8380417 else a0 in + if h = 0 then a1 + else if a0' > &0 then (a1 + 1) MOD 16 + else (a1 + 15) MOD 16`;; + +(* Per-element word function matching the assembly computation *) +let mldsa_use_hint_32_asm = new_definition + `mldsa_use_hint_32_asm (a:int32) (h:int32) : int32 = + let a1 = word_ishr_round (word_2smulh a (word 1074791425)) 18 in + let m:int32 = word_neg(word(bitval(word_igt a (word 8118528)))) in + let a0 = word_add (word_sub a (word_mul a1 (word 523776))) m in + let a1' = word_and a1 (word_not m) in + let delta:int32 = word_or (word_neg(word(bitval(word_ile a0 (word 0))))) (word 1) in + word_and (word_add a1' (word_mul delta h)) (word 15)`;; + +(* ========================================================================= *) +(* Functional correctness helper lemmas *) +(* ========================================================================= *) + +let IVAL_SMALL = MLDSA_IVAL_VAL;; +let VAL_IWORD_NUM = VAL_IWORD_NUM_32;; + +let WORD_2SMULH_NOSATURATE_32 = prove( + `!a:int32. val a < 8380417 + ==> word_2smulh a (word 1074791425:int32) : int32 = + iword((&2 * &(val a) * &1074791425) div &2 pow 32)`, + GEN_TAC THEN DISCH_TAC THEN + MP_TAC(SPECL [`a:int32`; `word 1074791425:int32`] MLDSA_WORD_2SMULH_NOSATURATE) THEN + ASM_REWRITE_TAC[] THEN CONV_TAC WORD_REDUCE_CONV THEN SIMP_TAC[]);; + +let WORD_ISHR_ROUND_18 = prove( + `!t:int32. val t < 2147483648 + ==> word_ishr_round t 18 = iword((&(val t) + &131072) div &262144)`, + GEN_TAC THEN DISCH_TAC THEN + MP_TAC(SPECL [`t:int32`; `18`] MLDSA_WORD_ISHR_ROUND) THEN + ASM_REWRITE_TAC[] THEN CONV_TAC NUM_REDUCE_CONV THEN + CONV_TAC INT_REDUCE_CONV THEN SIMP_TAC[]);; + +let VAL_DECOMPOSE_A1 = prove( + `!a:int32. val a < 8380417 + ==> val(word_ishr_round (word_2smulh a (word 1074791425:int32)) 18 : int32) + = ((2 * val a * 1074791425) DIV 4294967296 + 131072) DIV 262144`, + GEN_TAC THEN DISCH_TAC THEN + ASM_SIMP_TAC[WORD_2SMULH_NOSATURATE_32] THEN + SUBGOAL_THEN `(2 * val(a:int32) * 1074791425) DIV 4294967296 < 2147483648` + ASSUME_TAC THENL + [TRANS_TAC LT_TRANS `(2 * 8380416 * 1074791425) DIV 4294967296 + 1` THEN + CONJ_TAC THENL + [MATCH_MP_TAC(ARITH_RULE `x <= y ==> x < y + 1`) THEN + MATCH_MP_TAC DIV_MONO THEN ASM_ARITH_TAC; CONV_TAC NUM_REDUCE_CONV]; ALL_TAC] THEN + REWRITE_TAC[INT_OF_NUM_CLAUSES] THEN SIMP_TAC[INT_OF_NUM_DIV] THEN + CONV_TAC NUM_REDUCE_CONV THEN ASM_SIMP_TAC[VAL_IWORD_NUM] THEN + ASM_SIMP_TAC[WORD_ISHR_ROUND_18] THEN + REWRITE_TAC[INT_OF_NUM_CLAUSES] THEN SIMP_TAC[INT_OF_NUM_DIV] THEN + CONV_TAC NUM_REDUCE_CONV THEN + ABBREV_TAC `t:int32 = iword(&((2 * val(a:int32) * 1074791425) DIV 4294967296))` THEN + SUBGOAL_THEN `val(t:int32) = (2 * val(a:int32) * 1074791425) DIV 4294967296` + ASSUME_TAC THENL + [EXPAND_TAC "t" THEN MATCH_MP_TAC VAL_IWORD_NUM THEN ASM_REWRITE_TAC[]; ALL_TAC] THEN + SUBGOAL_THEN `(val(t:int32) + 131072) DIV 262144 < 2147483648` ASSUME_TAC THENL + [ASM_REWRITE_TAC[] THEN + TRANS_TAC LT_TRANS `(4194303 + 131072) DIV 262144 + 1` THEN CONJ_TAC THENL + [MATCH_MP_TAC(ARITH_RULE `x <= y ==> x < y + 1`) THEN + MATCH_MP_TAC DIV_MONO THEN ASM_ARITH_TAC; CONV_TAC NUM_REDUCE_CONV]; ALL_TAC] THEN + ASM_SIMP_TAC[VAL_IWORD_NUM] THEN MATCH_MP_TAC VAL_IWORD_NUM THEN + UNDISCH_THEN `val(t:int32) = (2 * val(a:int32) * 1074791425) DIV 4294967296` + (SUBST1_TAC o SYM) THEN ASM_REWRITE_TAC[]);; + +let WORD_IGT_THRESHOLD_32 = BITBLAST_RULE + `!a:int32. val a < 8380417 + ==> word_igt a (word 8118528:int32) <=> val a > 8118528`;; + +let A1_BOUND = prove( + `!a. a < 8380417 + ==> ((a + 127) DIV 128 * 1025 + 2097152) DIV 4194304 <= 16`, + GEN_TAC THEN DISCH_TAC THEN + MP_TAC(SPEC `128` (SPEC `8380416 + 127` (SPEC `a + 127` DIV_MONO))) THEN + ANTS_TAC THENL [ASM_ARITH_TAC; ALL_TAC] THEN + CONV_TAC NUM_REDUCE_CONV THEN DISCH_TAC THEN + ABBREV_TAC `d = (a + 127) DIV 128` THEN + MP_TAC(SPEC `4194304` (SPEC `69205952` (SPEC `d * 1025 + 2097152` DIV_MONO))) THEN + ANTS_TAC THENL + [SUBGOAL_THEN `d * 1025 <= 65472 * 1025` MP_TAC THENL + [ASM_SIMP_TAC[LE_MULT_RCANCEL]; CONV_TAC NUM_REDUCE_CONV THEN ARITH_TAC]; + CONV_TAC NUM_REDUCE_CONV THEN ARITH_TAC]);; + +let A1_WRAP = prove( + `!a. 8118528 < a /\ a < 8380417 + ==> ((a + 127) DIV 128 * 1025 + 2097152) DIV 4194304 = 16`, + GEN_TAC THEN STRIP_TAC THEN + SUBGOAL_THEN `16 <= ((a + 127) DIV 128 * 1025 + 2097152) DIV 4194304` + ASSUME_TAC THENL + [MP_TAC(SPEC `128` (SPEC `a + 127` (SPEC `8118529 + 127` DIV_MONO))) THEN + ANTS_TAC THENL [ASM_ARITH_TAC; ALL_TAC] THEN + CONV_TAC NUM_REDUCE_CONV THEN DISCH_TAC THEN + ABBREV_TAC `d = (a + 127) DIV 128` THEN + MP_TAC(SPEC `4194304` (SPEC `d * 1025 + 2097152` (SPEC `67108977` DIV_MONO))) THEN + ANTS_TAC THENL + [SUBGOAL_THEN `63427 * 1025 <= d * 1025` MP_TAC THENL + [ASM_SIMP_TAC[LE_MULT_RCANCEL]; CONV_TAC NUM_REDUCE_CONV THEN ARITH_TAC]; + CONV_TAC NUM_REDUCE_CONV THEN ARITH_TAC]; ALL_TAC] THEN + MP_TAC(SPEC `a:num` A1_BOUND) THEN ASM_REWRITE_TAC[] THEN + DISCH_TAC THEN ASM_ARITH_TAC);; + +let A1_BOUND_NOWRAP = prove( + `!a. a <= 8118528 + ==> ((a + 127) DIV 128 * 1025 + 2097152) DIV 4194304 <= 15`, + GEN_TAC THEN DISCH_TAC THEN + MP_TAC(SPEC `128` (SPEC `8118528 + 127` (SPEC `a + 127` DIV_MONO))) THEN + ANTS_TAC THENL [ASM_ARITH_TAC; ALL_TAC] THEN + CONV_TAC NUM_REDUCE_CONV THEN DISCH_TAC THEN + ABBREV_TAC `d = (a + 127) DIV 128` THEN + MP_TAC(SPEC `4194304` (SPEC `67108802` (SPEC `d * 1025 + 2097152` DIV_MONO))) THEN + ANTS_TAC THENL + [SUBGOAL_THEN `d * 1025 <= 63426 * 1025` MP_TAC THENL + [ASM_SIMP_TAC[LE_MULT_RCANCEL]; CONV_TAC NUM_REDUCE_CONV THEN ARITH_TAC]; + CONV_TAC NUM_REDUCE_CONV THEN ARITH_TAC]);; + +let HINT_H1_POS = prove( + `!a1:int32. val a1 <= 15 + ==> val(word_and (word_add a1 (word 1:int32)) (word 15:int32)) = (val a1 + 1) MOD 16`, + GEN_TAC THEN DISCH_TAC THEN + REWRITE_TAC[VAL_WORD_AND_15_32; VAL_WORD_ADD; VAL_WORD; DIMINDEX_32] THEN + CONV_TAC NUM_REDUCE_CONV THEN REWRITE_TAC[MOD_MOD_REFL] THEN + AP_THM_TAC THEN AP_TERM_TAC THEN MATCH_MP_TAC MOD_LT THEN ASM_ARITH_TAC);; + +let HINT_H1_NEG = prove( + `!a1:int32. val a1 <= 15 + ==> val(word_and (word_add a1 (word 4294967295:int32)) (word 15:int32)) = (val a1 + 15) MOD 16`, + GEN_TAC THEN DISCH_TAC THEN + REWRITE_TAC[VAL_WORD_AND_15_32; VAL_WORD_ADD; VAL_WORD; DIMINDEX_32] THEN + CONV_TAC NUM_REDUCE_CONV THEN + REWRITE_TAC[ARITH_RULE `4294967296 = 2 EXP 32`; ARITH_RULE `16 = 2 EXP 4`] THEN + REWRITE_TAC[MOD_MOD_EXP_MIN] THEN CONV_TAC NUM_REDUCE_CONV THEN + REWRITE_TAC[ARITH_RULE `4294967295 = 15 + 268435455 * 16`; GSYM ADD_ASSOC] THEN + REWRITE_TAC[ARITH_RULE `a + 15 + 268435455 * 16 = (a + 15) + 268435455 * 16`] THEN + SIMP_TAC[MOD_MULT_ADD]);; + +let WORD_SUB_SIGN_32 = BITBLAST_RULE + `!a:int32 b:int32. val b <= 7856640 /\ val a <= 8118528 ==> + ((bit 31 (word_sub a b) \/ word_sub a b = word 0) <=> val a <= val b)`;; + +let WRAP_A0_NEGATIVE = BITBLAST_RULE + `!a:int32. val a < 8380417 /\ val a > 8118528 + ==> bit 31 (word_add (word_sub a (word 8380416:int32)) (word 4294967295:int32))`;; + +(* Barrett equivalence: assembly and C decomposition formulas agree. + Both compute round_half_down(a / 523776) via different Barrett + approximation paths. Proved by case analysis on 17 output intervals + using DIV_MONO to sandwich both LHS and RHS to the same constant. *) +let BARRETT_EQUIV = prove( + `!a. a < 8380417 ==> + ((2 * a * 1074791425) DIV 4294967296 + 131072) DIV 262144 = + ((a + 127) DIV 128 * 1025 + 2097152) DIV 4194304`, + GEN_TAC THEN DISCH_TAC THEN + ASM_CASES_TAC `a <= 261888` THENL + [ + MP_TAC(SPEC `262144` (SPEC `(2 * 261888 * 1074791425) DIV 4294967296 + 131072` + (SPEC `(2 * a * 1074791425) DIV 4294967296 + 131072` DIV_MONO))) THEN + ANTS_TAC THENL [ASM_ARITH_TAC; CONV_TAC NUM_REDUCE_CONV THEN DISCH_TAC] THEN + MP_TAC(SPEC `262144` (SPEC `(2 * a * 1074791425) DIV 4294967296 + 131072` + (SPEC `(2 * 0 * 1074791425) DIV 4294967296 + 131072` DIV_MONO))) THEN + ANTS_TAC THENL [ASM_ARITH_TAC; CONV_TAC NUM_REDUCE_CONV THEN DISCH_TAC] THEN + MP_TAC(SPEC `128` (SPEC `261888 + 127` (SPEC `a + 127` DIV_MONO))) THEN + ANTS_TAC THENL [ASM_ARITH_TAC; CONV_TAC NUM_REDUCE_CONV THEN DISCH_TAC] THEN + MP_TAC(SPEC `128` (SPEC `a + 127` (SPEC `0 + 127` DIV_MONO))) THEN + ANTS_TAC THENL [ASM_ARITH_TAC; CONV_TAC NUM_REDUCE_CONV THEN DISCH_TAC] THEN + ABBREV_TAC `qq0 = (a + 127) DIV 128` THEN + SUBGOAL_THEN `qq0 * 1025 <= 2046 * 1025` ASSUME_TAC THENL + [ASM_SIMP_TAC[LE_MULT_RCANCEL]; ALL_TAC] THEN + SUBGOAL_THEN `0 * 1025 <= qq0 * 1025` ASSUME_TAC THENL + [ASM_SIMP_TAC[LE_MULT_RCANCEL]; ALL_TAC] THEN + MP_TAC(SPEC `4194304` (SPEC `2046 * 1025 + 2097152` + (SPEC `qq0 * 1025 + 2097152` DIV_MONO))) THEN + ANTS_TAC THENL [ASM_ARITH_TAC; CONV_TAC NUM_REDUCE_CONV THEN DISCH_TAC] THEN + MP_TAC(SPEC `4194304` (SPEC `qq0 * 1025 + 2097152` + (SPEC `0 * 1025 + 2097152` DIV_MONO))) THEN + ANTS_TAC THENL [ASM_ARITH_TAC; CONV_TAC NUM_REDUCE_CONV THEN DISCH_TAC] THEN + ASM_ARITH_TAC + ; + ASM_CASES_TAC `a <= 785664` THENL + [ + MP_TAC(SPEC `262144` (SPEC `(2 * 785664 * 1074791425) DIV 4294967296 + 131072` + (SPEC `(2 * a * 1074791425) DIV 4294967296 + 131072` DIV_MONO))) THEN + ANTS_TAC THENL [ASM_ARITH_TAC; CONV_TAC NUM_REDUCE_CONV THEN DISCH_TAC] THEN + MP_TAC(SPEC `262144` (SPEC `(2 * a * 1074791425) DIV 4294967296 + 131072` + (SPEC `(2 * 261889 * 1074791425) DIV 4294967296 + 131072` DIV_MONO))) THEN + ANTS_TAC THENL [ASM_ARITH_TAC; CONV_TAC NUM_REDUCE_CONV THEN DISCH_TAC] THEN + MP_TAC(SPEC `128` (SPEC `785664 + 127` (SPEC `a + 127` DIV_MONO))) THEN + ANTS_TAC THENL [ASM_ARITH_TAC; CONV_TAC NUM_REDUCE_CONV THEN DISCH_TAC] THEN + MP_TAC(SPEC `128` (SPEC `a + 127` (SPEC `261889 + 127` DIV_MONO))) THEN + ANTS_TAC THENL [ASM_ARITH_TAC; CONV_TAC NUM_REDUCE_CONV THEN DISCH_TAC] THEN + ABBREV_TAC `qq1 = (a + 127) DIV 128` THEN + SUBGOAL_THEN `qq1 * 1025 <= 6138 * 1025` ASSUME_TAC THENL + [ASM_SIMP_TAC[LE_MULT_RCANCEL]; ALL_TAC] THEN + SUBGOAL_THEN `2047 * 1025 <= qq1 * 1025` ASSUME_TAC THENL + [ASM_SIMP_TAC[LE_MULT_RCANCEL]; ALL_TAC] THEN + MP_TAC(SPEC `4194304` (SPEC `6138 * 1025 + 2097152` + (SPEC `qq1 * 1025 + 2097152` DIV_MONO))) THEN + ANTS_TAC THENL [ASM_ARITH_TAC; CONV_TAC NUM_REDUCE_CONV THEN DISCH_TAC] THEN + MP_TAC(SPEC `4194304` (SPEC `qq1 * 1025 + 2097152` + (SPEC `2047 * 1025 + 2097152` DIV_MONO))) THEN + ANTS_TAC THENL [ASM_ARITH_TAC; CONV_TAC NUM_REDUCE_CONV THEN DISCH_TAC] THEN + ASM_ARITH_TAC + ; + ASM_CASES_TAC `a <= 1309440` THENL + [ + MP_TAC(SPEC `262144` (SPEC `(2 * 1309440 * 1074791425) DIV 4294967296 + 131072` + (SPEC `(2 * a * 1074791425) DIV 4294967296 + 131072` DIV_MONO))) THEN + ANTS_TAC THENL [ASM_ARITH_TAC; CONV_TAC NUM_REDUCE_CONV THEN DISCH_TAC] THEN + MP_TAC(SPEC `262144` (SPEC `(2 * a * 1074791425) DIV 4294967296 + 131072` + (SPEC `(2 * 785665 * 1074791425) DIV 4294967296 + 131072` DIV_MONO))) THEN + ANTS_TAC THENL [ASM_ARITH_TAC; CONV_TAC NUM_REDUCE_CONV THEN DISCH_TAC] THEN + MP_TAC(SPEC `128` (SPEC `1309440 + 127` (SPEC `a + 127` DIV_MONO))) THEN + ANTS_TAC THENL [ASM_ARITH_TAC; CONV_TAC NUM_REDUCE_CONV THEN DISCH_TAC] THEN + MP_TAC(SPEC `128` (SPEC `a + 127` (SPEC `785665 + 127` DIV_MONO))) THEN + ANTS_TAC THENL [ASM_ARITH_TAC; CONV_TAC NUM_REDUCE_CONV THEN DISCH_TAC] THEN + ABBREV_TAC `qq2 = (a + 127) DIV 128` THEN + SUBGOAL_THEN `qq2 * 1025 <= 10230 * 1025` ASSUME_TAC THENL + [ASM_SIMP_TAC[LE_MULT_RCANCEL]; ALL_TAC] THEN + SUBGOAL_THEN `6139 * 1025 <= qq2 * 1025` ASSUME_TAC THENL + [ASM_SIMP_TAC[LE_MULT_RCANCEL]; ALL_TAC] THEN + MP_TAC(SPEC `4194304` (SPEC `10230 * 1025 + 2097152` + (SPEC `qq2 * 1025 + 2097152` DIV_MONO))) THEN + ANTS_TAC THENL [ASM_ARITH_TAC; CONV_TAC NUM_REDUCE_CONV THEN DISCH_TAC] THEN + MP_TAC(SPEC `4194304` (SPEC `qq2 * 1025 + 2097152` + (SPEC `6139 * 1025 + 2097152` DIV_MONO))) THEN + ANTS_TAC THENL [ASM_ARITH_TAC; CONV_TAC NUM_REDUCE_CONV THEN DISCH_TAC] THEN + ASM_ARITH_TAC + ; + ASM_CASES_TAC `a <= 1833216` THENL + [ + MP_TAC(SPEC `262144` (SPEC `(2 * 1833216 * 1074791425) DIV 4294967296 + 131072` + (SPEC `(2 * a * 1074791425) DIV 4294967296 + 131072` DIV_MONO))) THEN + ANTS_TAC THENL [ASM_ARITH_TAC; CONV_TAC NUM_REDUCE_CONV THEN DISCH_TAC] THEN + MP_TAC(SPEC `262144` (SPEC `(2 * a * 1074791425) DIV 4294967296 + 131072` + (SPEC `(2 * 1309441 * 1074791425) DIV 4294967296 + 131072` DIV_MONO))) THEN + ANTS_TAC THENL [ASM_ARITH_TAC; CONV_TAC NUM_REDUCE_CONV THEN DISCH_TAC] THEN + MP_TAC(SPEC `128` (SPEC `1833216 + 127` (SPEC `a + 127` DIV_MONO))) THEN + ANTS_TAC THENL [ASM_ARITH_TAC; CONV_TAC NUM_REDUCE_CONV THEN DISCH_TAC] THEN + MP_TAC(SPEC `128` (SPEC `a + 127` (SPEC `1309441 + 127` DIV_MONO))) THEN + ANTS_TAC THENL [ASM_ARITH_TAC; CONV_TAC NUM_REDUCE_CONV THEN DISCH_TAC] THEN + ABBREV_TAC `qq3 = (a + 127) DIV 128` THEN + SUBGOAL_THEN `qq3 * 1025 <= 14322 * 1025` ASSUME_TAC THENL + [ASM_SIMP_TAC[LE_MULT_RCANCEL]; ALL_TAC] THEN + SUBGOAL_THEN `10231 * 1025 <= qq3 * 1025` ASSUME_TAC THENL + [ASM_SIMP_TAC[LE_MULT_RCANCEL]; ALL_TAC] THEN + MP_TAC(SPEC `4194304` (SPEC `14322 * 1025 + 2097152` + (SPEC `qq3 * 1025 + 2097152` DIV_MONO))) THEN + ANTS_TAC THENL [ASM_ARITH_TAC; CONV_TAC NUM_REDUCE_CONV THEN DISCH_TAC] THEN + MP_TAC(SPEC `4194304` (SPEC `qq3 * 1025 + 2097152` + (SPEC `10231 * 1025 + 2097152` DIV_MONO))) THEN + ANTS_TAC THENL [ASM_ARITH_TAC; CONV_TAC NUM_REDUCE_CONV THEN DISCH_TAC] THEN + ASM_ARITH_TAC + ; + ASM_CASES_TAC `a <= 2356992` THENL + [ + MP_TAC(SPEC `262144` (SPEC `(2 * 2356992 * 1074791425) DIV 4294967296 + 131072` + (SPEC `(2 * a * 1074791425) DIV 4294967296 + 131072` DIV_MONO))) THEN + ANTS_TAC THENL [ASM_ARITH_TAC; CONV_TAC NUM_REDUCE_CONV THEN DISCH_TAC] THEN + MP_TAC(SPEC `262144` (SPEC `(2 * a * 1074791425) DIV 4294967296 + 131072` + (SPEC `(2 * 1833217 * 1074791425) DIV 4294967296 + 131072` DIV_MONO))) THEN + ANTS_TAC THENL [ASM_ARITH_TAC; CONV_TAC NUM_REDUCE_CONV THEN DISCH_TAC] THEN + MP_TAC(SPEC `128` (SPEC `2356992 + 127` (SPEC `a + 127` DIV_MONO))) THEN + ANTS_TAC THENL [ASM_ARITH_TAC; CONV_TAC NUM_REDUCE_CONV THEN DISCH_TAC] THEN + MP_TAC(SPEC `128` (SPEC `a + 127` (SPEC `1833217 + 127` DIV_MONO))) THEN + ANTS_TAC THENL [ASM_ARITH_TAC; CONV_TAC NUM_REDUCE_CONV THEN DISCH_TAC] THEN + ABBREV_TAC `qq4 = (a + 127) DIV 128` THEN + SUBGOAL_THEN `qq4 * 1025 <= 18414 * 1025` ASSUME_TAC THENL + [ASM_SIMP_TAC[LE_MULT_RCANCEL]; ALL_TAC] THEN + SUBGOAL_THEN `14323 * 1025 <= qq4 * 1025` ASSUME_TAC THENL + [ASM_SIMP_TAC[LE_MULT_RCANCEL]; ALL_TAC] THEN + MP_TAC(SPEC `4194304` (SPEC `18414 * 1025 + 2097152` + (SPEC `qq4 * 1025 + 2097152` DIV_MONO))) THEN + ANTS_TAC THENL [ASM_ARITH_TAC; CONV_TAC NUM_REDUCE_CONV THEN DISCH_TAC] THEN + MP_TAC(SPEC `4194304` (SPEC `qq4 * 1025 + 2097152` + (SPEC `14323 * 1025 + 2097152` DIV_MONO))) THEN + ANTS_TAC THENL [ASM_ARITH_TAC; CONV_TAC NUM_REDUCE_CONV THEN DISCH_TAC] THEN + ASM_ARITH_TAC + ; + ASM_CASES_TAC `a <= 2880768` THENL + [ + MP_TAC(SPEC `262144` (SPEC `(2 * 2880768 * 1074791425) DIV 4294967296 + 131072` + (SPEC `(2 * a * 1074791425) DIV 4294967296 + 131072` DIV_MONO))) THEN + ANTS_TAC THENL [ASM_ARITH_TAC; CONV_TAC NUM_REDUCE_CONV THEN DISCH_TAC] THEN + MP_TAC(SPEC `262144` (SPEC `(2 * a * 1074791425) DIV 4294967296 + 131072` + (SPEC `(2 * 2356993 * 1074791425) DIV 4294967296 + 131072` DIV_MONO))) THEN + ANTS_TAC THENL [ASM_ARITH_TAC; CONV_TAC NUM_REDUCE_CONV THEN DISCH_TAC] THEN + MP_TAC(SPEC `128` (SPEC `2880768 + 127` (SPEC `a + 127` DIV_MONO))) THEN + ANTS_TAC THENL [ASM_ARITH_TAC; CONV_TAC NUM_REDUCE_CONV THEN DISCH_TAC] THEN + MP_TAC(SPEC `128` (SPEC `a + 127` (SPEC `2356993 + 127` DIV_MONO))) THEN + ANTS_TAC THENL [ASM_ARITH_TAC; CONV_TAC NUM_REDUCE_CONV THEN DISCH_TAC] THEN + ABBREV_TAC `qq5 = (a + 127) DIV 128` THEN + SUBGOAL_THEN `qq5 * 1025 <= 22506 * 1025` ASSUME_TAC THENL + [ASM_SIMP_TAC[LE_MULT_RCANCEL]; ALL_TAC] THEN + SUBGOAL_THEN `18415 * 1025 <= qq5 * 1025` ASSUME_TAC THENL + [ASM_SIMP_TAC[LE_MULT_RCANCEL]; ALL_TAC] THEN + MP_TAC(SPEC `4194304` (SPEC `22506 * 1025 + 2097152` + (SPEC `qq5 * 1025 + 2097152` DIV_MONO))) THEN + ANTS_TAC THENL [ASM_ARITH_TAC; CONV_TAC NUM_REDUCE_CONV THEN DISCH_TAC] THEN + MP_TAC(SPEC `4194304` (SPEC `qq5 * 1025 + 2097152` + (SPEC `18415 * 1025 + 2097152` DIV_MONO))) THEN + ANTS_TAC THENL [ASM_ARITH_TAC; CONV_TAC NUM_REDUCE_CONV THEN DISCH_TAC] THEN + ASM_ARITH_TAC + ; + ASM_CASES_TAC `a <= 3404544` THENL + [ + MP_TAC(SPEC `262144` (SPEC `(2 * 3404544 * 1074791425) DIV 4294967296 + 131072` + (SPEC `(2 * a * 1074791425) DIV 4294967296 + 131072` DIV_MONO))) THEN + ANTS_TAC THENL [ASM_ARITH_TAC; CONV_TAC NUM_REDUCE_CONV THEN DISCH_TAC] THEN + MP_TAC(SPEC `262144` (SPEC `(2 * a * 1074791425) DIV 4294967296 + 131072` + (SPEC `(2 * 2880769 * 1074791425) DIV 4294967296 + 131072` DIV_MONO))) THEN + ANTS_TAC THENL [ASM_ARITH_TAC; CONV_TAC NUM_REDUCE_CONV THEN DISCH_TAC] THEN + MP_TAC(SPEC `128` (SPEC `3404544 + 127` (SPEC `a + 127` DIV_MONO))) THEN + ANTS_TAC THENL [ASM_ARITH_TAC; CONV_TAC NUM_REDUCE_CONV THEN DISCH_TAC] THEN + MP_TAC(SPEC `128` (SPEC `a + 127` (SPEC `2880769 + 127` DIV_MONO))) THEN + ANTS_TAC THENL [ASM_ARITH_TAC; CONV_TAC NUM_REDUCE_CONV THEN DISCH_TAC] THEN + ABBREV_TAC `qq6 = (a + 127) DIV 128` THEN + SUBGOAL_THEN `qq6 * 1025 <= 26598 * 1025` ASSUME_TAC THENL + [ASM_SIMP_TAC[LE_MULT_RCANCEL]; ALL_TAC] THEN + SUBGOAL_THEN `22507 * 1025 <= qq6 * 1025` ASSUME_TAC THENL + [ASM_SIMP_TAC[LE_MULT_RCANCEL]; ALL_TAC] THEN + MP_TAC(SPEC `4194304` (SPEC `26598 * 1025 + 2097152` + (SPEC `qq6 * 1025 + 2097152` DIV_MONO))) THEN + ANTS_TAC THENL [ASM_ARITH_TAC; CONV_TAC NUM_REDUCE_CONV THEN DISCH_TAC] THEN + MP_TAC(SPEC `4194304` (SPEC `qq6 * 1025 + 2097152` + (SPEC `22507 * 1025 + 2097152` DIV_MONO))) THEN + ANTS_TAC THENL [ASM_ARITH_TAC; CONV_TAC NUM_REDUCE_CONV THEN DISCH_TAC] THEN + ASM_ARITH_TAC + ; + ASM_CASES_TAC `a <= 3928320` THENL + [ + MP_TAC(SPEC `262144` (SPEC `(2 * 3928320 * 1074791425) DIV 4294967296 + 131072` + (SPEC `(2 * a * 1074791425) DIV 4294967296 + 131072` DIV_MONO))) THEN + ANTS_TAC THENL [ASM_ARITH_TAC; CONV_TAC NUM_REDUCE_CONV THEN DISCH_TAC] THEN + MP_TAC(SPEC `262144` (SPEC `(2 * a * 1074791425) DIV 4294967296 + 131072` + (SPEC `(2 * 3404545 * 1074791425) DIV 4294967296 + 131072` DIV_MONO))) THEN + ANTS_TAC THENL [ASM_ARITH_TAC; CONV_TAC NUM_REDUCE_CONV THEN DISCH_TAC] THEN + MP_TAC(SPEC `128` (SPEC `3928320 + 127` (SPEC `a + 127` DIV_MONO))) THEN + ANTS_TAC THENL [ASM_ARITH_TAC; CONV_TAC NUM_REDUCE_CONV THEN DISCH_TAC] THEN + MP_TAC(SPEC `128` (SPEC `a + 127` (SPEC `3404545 + 127` DIV_MONO))) THEN + ANTS_TAC THENL [ASM_ARITH_TAC; CONV_TAC NUM_REDUCE_CONV THEN DISCH_TAC] THEN + ABBREV_TAC `qq7 = (a + 127) DIV 128` THEN + SUBGOAL_THEN `qq7 * 1025 <= 30690 * 1025` ASSUME_TAC THENL + [ASM_SIMP_TAC[LE_MULT_RCANCEL]; ALL_TAC] THEN + SUBGOAL_THEN `26599 * 1025 <= qq7 * 1025` ASSUME_TAC THENL + [ASM_SIMP_TAC[LE_MULT_RCANCEL]; ALL_TAC] THEN + MP_TAC(SPEC `4194304` (SPEC `30690 * 1025 + 2097152` + (SPEC `qq7 * 1025 + 2097152` DIV_MONO))) THEN + ANTS_TAC THENL [ASM_ARITH_TAC; CONV_TAC NUM_REDUCE_CONV THEN DISCH_TAC] THEN + MP_TAC(SPEC `4194304` (SPEC `qq7 * 1025 + 2097152` + (SPEC `26599 * 1025 + 2097152` DIV_MONO))) THEN + ANTS_TAC THENL [ASM_ARITH_TAC; CONV_TAC NUM_REDUCE_CONV THEN DISCH_TAC] THEN + ASM_ARITH_TAC + ; + ASM_CASES_TAC `a <= 4452096` THENL + [ + MP_TAC(SPEC `262144` (SPEC `(2 * 4452096 * 1074791425) DIV 4294967296 + 131072` + (SPEC `(2 * a * 1074791425) DIV 4294967296 + 131072` DIV_MONO))) THEN + ANTS_TAC THENL [ASM_ARITH_TAC; CONV_TAC NUM_REDUCE_CONV THEN DISCH_TAC] THEN + MP_TAC(SPEC `262144` (SPEC `(2 * a * 1074791425) DIV 4294967296 + 131072` + (SPEC `(2 * 3928321 * 1074791425) DIV 4294967296 + 131072` DIV_MONO))) THEN + ANTS_TAC THENL [ASM_ARITH_TAC; CONV_TAC NUM_REDUCE_CONV THEN DISCH_TAC] THEN + MP_TAC(SPEC `128` (SPEC `4452096 + 127` (SPEC `a + 127` DIV_MONO))) THEN + ANTS_TAC THENL [ASM_ARITH_TAC; CONV_TAC NUM_REDUCE_CONV THEN DISCH_TAC] THEN + MP_TAC(SPEC `128` (SPEC `a + 127` (SPEC `3928321 + 127` DIV_MONO))) THEN + ANTS_TAC THENL [ASM_ARITH_TAC; CONV_TAC NUM_REDUCE_CONV THEN DISCH_TAC] THEN + ABBREV_TAC `qq8 = (a + 127) DIV 128` THEN + SUBGOAL_THEN `qq8 * 1025 <= 34782 * 1025` ASSUME_TAC THENL + [ASM_SIMP_TAC[LE_MULT_RCANCEL]; ALL_TAC] THEN + SUBGOAL_THEN `30691 * 1025 <= qq8 * 1025` ASSUME_TAC THENL + [ASM_SIMP_TAC[LE_MULT_RCANCEL]; ALL_TAC] THEN + MP_TAC(SPEC `4194304` (SPEC `34782 * 1025 + 2097152` + (SPEC `qq8 * 1025 + 2097152` DIV_MONO))) THEN + ANTS_TAC THENL [ASM_ARITH_TAC; CONV_TAC NUM_REDUCE_CONV THEN DISCH_TAC] THEN + MP_TAC(SPEC `4194304` (SPEC `qq8 * 1025 + 2097152` + (SPEC `30691 * 1025 + 2097152` DIV_MONO))) THEN + ANTS_TAC THENL [ASM_ARITH_TAC; CONV_TAC NUM_REDUCE_CONV THEN DISCH_TAC] THEN + ASM_ARITH_TAC + ; + ASM_CASES_TAC `a <= 4975872` THENL + [ + MP_TAC(SPEC `262144` (SPEC `(2 * 4975872 * 1074791425) DIV 4294967296 + 131072` + (SPEC `(2 * a * 1074791425) DIV 4294967296 + 131072` DIV_MONO))) THEN + ANTS_TAC THENL [ASM_ARITH_TAC; CONV_TAC NUM_REDUCE_CONV THEN DISCH_TAC] THEN + MP_TAC(SPEC `262144` (SPEC `(2 * a * 1074791425) DIV 4294967296 + 131072` + (SPEC `(2 * 4452097 * 1074791425) DIV 4294967296 + 131072` DIV_MONO))) THEN + ANTS_TAC THENL [ASM_ARITH_TAC; CONV_TAC NUM_REDUCE_CONV THEN DISCH_TAC] THEN + MP_TAC(SPEC `128` (SPEC `4975872 + 127` (SPEC `a + 127` DIV_MONO))) THEN + ANTS_TAC THENL [ASM_ARITH_TAC; CONV_TAC NUM_REDUCE_CONV THEN DISCH_TAC] THEN + MP_TAC(SPEC `128` (SPEC `a + 127` (SPEC `4452097 + 127` DIV_MONO))) THEN + ANTS_TAC THENL [ASM_ARITH_TAC; CONV_TAC NUM_REDUCE_CONV THEN DISCH_TAC] THEN + ABBREV_TAC `qq9 = (a + 127) DIV 128` THEN + SUBGOAL_THEN `qq9 * 1025 <= 38874 * 1025` ASSUME_TAC THENL + [ASM_SIMP_TAC[LE_MULT_RCANCEL]; ALL_TAC] THEN + SUBGOAL_THEN `34783 * 1025 <= qq9 * 1025` ASSUME_TAC THENL + [ASM_SIMP_TAC[LE_MULT_RCANCEL]; ALL_TAC] THEN + MP_TAC(SPEC `4194304` (SPEC `38874 * 1025 + 2097152` + (SPEC `qq9 * 1025 + 2097152` DIV_MONO))) THEN + ANTS_TAC THENL [ASM_ARITH_TAC; CONV_TAC NUM_REDUCE_CONV THEN DISCH_TAC] THEN + MP_TAC(SPEC `4194304` (SPEC `qq9 * 1025 + 2097152` + (SPEC `34783 * 1025 + 2097152` DIV_MONO))) THEN + ANTS_TAC THENL [ASM_ARITH_TAC; CONV_TAC NUM_REDUCE_CONV THEN DISCH_TAC] THEN + ASM_ARITH_TAC + ; + ASM_CASES_TAC `a <= 5499648` THENL + [ + MP_TAC(SPEC `262144` (SPEC `(2 * 5499648 * 1074791425) DIV 4294967296 + 131072` + (SPEC `(2 * a * 1074791425) DIV 4294967296 + 131072` DIV_MONO))) THEN + ANTS_TAC THENL [ASM_ARITH_TAC; CONV_TAC NUM_REDUCE_CONV THEN DISCH_TAC] THEN + MP_TAC(SPEC `262144` (SPEC `(2 * a * 1074791425) DIV 4294967296 + 131072` + (SPEC `(2 * 4975873 * 1074791425) DIV 4294967296 + 131072` DIV_MONO))) THEN + ANTS_TAC THENL [ASM_ARITH_TAC; CONV_TAC NUM_REDUCE_CONV THEN DISCH_TAC] THEN + MP_TAC(SPEC `128` (SPEC `5499648 + 127` (SPEC `a + 127` DIV_MONO))) THEN + ANTS_TAC THENL [ASM_ARITH_TAC; CONV_TAC NUM_REDUCE_CONV THEN DISCH_TAC] THEN + MP_TAC(SPEC `128` (SPEC `a + 127` (SPEC `4975873 + 127` DIV_MONO))) THEN + ANTS_TAC THENL [ASM_ARITH_TAC; CONV_TAC NUM_REDUCE_CONV THEN DISCH_TAC] THEN + ABBREV_TAC `qq10 = (a + 127) DIV 128` THEN + SUBGOAL_THEN `qq10 * 1025 <= 42966 * 1025` ASSUME_TAC THENL + [ASM_SIMP_TAC[LE_MULT_RCANCEL]; ALL_TAC] THEN + SUBGOAL_THEN `38875 * 1025 <= qq10 * 1025` ASSUME_TAC THENL + [ASM_SIMP_TAC[LE_MULT_RCANCEL]; ALL_TAC] THEN + MP_TAC(SPEC `4194304` (SPEC `42966 * 1025 + 2097152` + (SPEC `qq10 * 1025 + 2097152` DIV_MONO))) THEN + ANTS_TAC THENL [ASM_ARITH_TAC; CONV_TAC NUM_REDUCE_CONV THEN DISCH_TAC] THEN + MP_TAC(SPEC `4194304` (SPEC `qq10 * 1025 + 2097152` + (SPEC `38875 * 1025 + 2097152` DIV_MONO))) THEN + ANTS_TAC THENL [ASM_ARITH_TAC; CONV_TAC NUM_REDUCE_CONV THEN DISCH_TAC] THEN + ASM_ARITH_TAC + ; + ASM_CASES_TAC `a <= 6023424` THENL + [ + MP_TAC(SPEC `262144` (SPEC `(2 * 6023424 * 1074791425) DIV 4294967296 + 131072` + (SPEC `(2 * a * 1074791425) DIV 4294967296 + 131072` DIV_MONO))) THEN + ANTS_TAC THENL [ASM_ARITH_TAC; CONV_TAC NUM_REDUCE_CONV THEN DISCH_TAC] THEN + MP_TAC(SPEC `262144` (SPEC `(2 * a * 1074791425) DIV 4294967296 + 131072` + (SPEC `(2 * 5499649 * 1074791425) DIV 4294967296 + 131072` DIV_MONO))) THEN + ANTS_TAC THENL [ASM_ARITH_TAC; CONV_TAC NUM_REDUCE_CONV THEN DISCH_TAC] THEN + MP_TAC(SPEC `128` (SPEC `6023424 + 127` (SPEC `a + 127` DIV_MONO))) THEN + ANTS_TAC THENL [ASM_ARITH_TAC; CONV_TAC NUM_REDUCE_CONV THEN DISCH_TAC] THEN + MP_TAC(SPEC `128` (SPEC `a + 127` (SPEC `5499649 + 127` DIV_MONO))) THEN + ANTS_TAC THENL [ASM_ARITH_TAC; CONV_TAC NUM_REDUCE_CONV THEN DISCH_TAC] THEN + ABBREV_TAC `qq11 = (a + 127) DIV 128` THEN + SUBGOAL_THEN `qq11 * 1025 <= 47058 * 1025` ASSUME_TAC THENL + [ASM_SIMP_TAC[LE_MULT_RCANCEL]; ALL_TAC] THEN + SUBGOAL_THEN `42967 * 1025 <= qq11 * 1025` ASSUME_TAC THENL + [ASM_SIMP_TAC[LE_MULT_RCANCEL]; ALL_TAC] THEN + MP_TAC(SPEC `4194304` (SPEC `47058 * 1025 + 2097152` + (SPEC `qq11 * 1025 + 2097152` DIV_MONO))) THEN + ANTS_TAC THENL [ASM_ARITH_TAC; CONV_TAC NUM_REDUCE_CONV THEN DISCH_TAC] THEN + MP_TAC(SPEC `4194304` (SPEC `qq11 * 1025 + 2097152` + (SPEC `42967 * 1025 + 2097152` DIV_MONO))) THEN + ANTS_TAC THENL [ASM_ARITH_TAC; CONV_TAC NUM_REDUCE_CONV THEN DISCH_TAC] THEN + ASM_ARITH_TAC + ; + ASM_CASES_TAC `a <= 6547200` THENL + [ + MP_TAC(SPEC `262144` (SPEC `(2 * 6547200 * 1074791425) DIV 4294967296 + 131072` + (SPEC `(2 * a * 1074791425) DIV 4294967296 + 131072` DIV_MONO))) THEN + ANTS_TAC THENL [ASM_ARITH_TAC; CONV_TAC NUM_REDUCE_CONV THEN DISCH_TAC] THEN + MP_TAC(SPEC `262144` (SPEC `(2 * a * 1074791425) DIV 4294967296 + 131072` + (SPEC `(2 * 6023425 * 1074791425) DIV 4294967296 + 131072` DIV_MONO))) THEN + ANTS_TAC THENL [ASM_ARITH_TAC; CONV_TAC NUM_REDUCE_CONV THEN DISCH_TAC] THEN + MP_TAC(SPEC `128` (SPEC `6547200 + 127` (SPEC `a + 127` DIV_MONO))) THEN + ANTS_TAC THENL [ASM_ARITH_TAC; CONV_TAC NUM_REDUCE_CONV THEN DISCH_TAC] THEN + MP_TAC(SPEC `128` (SPEC `a + 127` (SPEC `6023425 + 127` DIV_MONO))) THEN + ANTS_TAC THENL [ASM_ARITH_TAC; CONV_TAC NUM_REDUCE_CONV THEN DISCH_TAC] THEN + ABBREV_TAC `qq12 = (a + 127) DIV 128` THEN + SUBGOAL_THEN `qq12 * 1025 <= 51150 * 1025` ASSUME_TAC THENL + [ASM_SIMP_TAC[LE_MULT_RCANCEL]; ALL_TAC] THEN + SUBGOAL_THEN `47059 * 1025 <= qq12 * 1025` ASSUME_TAC THENL + [ASM_SIMP_TAC[LE_MULT_RCANCEL]; ALL_TAC] THEN + MP_TAC(SPEC `4194304` (SPEC `51150 * 1025 + 2097152` + (SPEC `qq12 * 1025 + 2097152` DIV_MONO))) THEN + ANTS_TAC THENL [ASM_ARITH_TAC; CONV_TAC NUM_REDUCE_CONV THEN DISCH_TAC] THEN + MP_TAC(SPEC `4194304` (SPEC `qq12 * 1025 + 2097152` + (SPEC `47059 * 1025 + 2097152` DIV_MONO))) THEN + ANTS_TAC THENL [ASM_ARITH_TAC; CONV_TAC NUM_REDUCE_CONV THEN DISCH_TAC] THEN + ASM_ARITH_TAC + ; + ASM_CASES_TAC `a <= 7070976` THENL + [ + MP_TAC(SPEC `262144` (SPEC `(2 * 7070976 * 1074791425) DIV 4294967296 + 131072` + (SPEC `(2 * a * 1074791425) DIV 4294967296 + 131072` DIV_MONO))) THEN + ANTS_TAC THENL [ASM_ARITH_TAC; CONV_TAC NUM_REDUCE_CONV THEN DISCH_TAC] THEN + MP_TAC(SPEC `262144` (SPEC `(2 * a * 1074791425) DIV 4294967296 + 131072` + (SPEC `(2 * 6547201 * 1074791425) DIV 4294967296 + 131072` DIV_MONO))) THEN + ANTS_TAC THENL [ASM_ARITH_TAC; CONV_TAC NUM_REDUCE_CONV THEN DISCH_TAC] THEN + MP_TAC(SPEC `128` (SPEC `7070976 + 127` (SPEC `a + 127` DIV_MONO))) THEN + ANTS_TAC THENL [ASM_ARITH_TAC; CONV_TAC NUM_REDUCE_CONV THEN DISCH_TAC] THEN + MP_TAC(SPEC `128` (SPEC `a + 127` (SPEC `6547201 + 127` DIV_MONO))) THEN + ANTS_TAC THENL [ASM_ARITH_TAC; CONV_TAC NUM_REDUCE_CONV THEN DISCH_TAC] THEN + ABBREV_TAC `qq13 = (a + 127) DIV 128` THEN + SUBGOAL_THEN `qq13 * 1025 <= 55242 * 1025` ASSUME_TAC THENL + [ASM_SIMP_TAC[LE_MULT_RCANCEL]; ALL_TAC] THEN + SUBGOAL_THEN `51151 * 1025 <= qq13 * 1025` ASSUME_TAC THENL + [ASM_SIMP_TAC[LE_MULT_RCANCEL]; ALL_TAC] THEN + MP_TAC(SPEC `4194304` (SPEC `55242 * 1025 + 2097152` + (SPEC `qq13 * 1025 + 2097152` DIV_MONO))) THEN + ANTS_TAC THENL [ASM_ARITH_TAC; CONV_TAC NUM_REDUCE_CONV THEN DISCH_TAC] THEN + MP_TAC(SPEC `4194304` (SPEC `qq13 * 1025 + 2097152` + (SPEC `51151 * 1025 + 2097152` DIV_MONO))) THEN + ANTS_TAC THENL [ASM_ARITH_TAC; CONV_TAC NUM_REDUCE_CONV THEN DISCH_TAC] THEN + ASM_ARITH_TAC + ; + ASM_CASES_TAC `a <= 7594752` THENL + [ + MP_TAC(SPEC `262144` (SPEC `(2 * 7594752 * 1074791425) DIV 4294967296 + 131072` + (SPEC `(2 * a * 1074791425) DIV 4294967296 + 131072` DIV_MONO))) THEN + ANTS_TAC THENL [ASM_ARITH_TAC; CONV_TAC NUM_REDUCE_CONV THEN DISCH_TAC] THEN + MP_TAC(SPEC `262144` (SPEC `(2 * a * 1074791425) DIV 4294967296 + 131072` + (SPEC `(2 * 7070977 * 1074791425) DIV 4294967296 + 131072` DIV_MONO))) THEN + ANTS_TAC THENL [ASM_ARITH_TAC; CONV_TAC NUM_REDUCE_CONV THEN DISCH_TAC] THEN + MP_TAC(SPEC `128` (SPEC `7594752 + 127` (SPEC `a + 127` DIV_MONO))) THEN + ANTS_TAC THENL [ASM_ARITH_TAC; CONV_TAC NUM_REDUCE_CONV THEN DISCH_TAC] THEN + MP_TAC(SPEC `128` (SPEC `a + 127` (SPEC `7070977 + 127` DIV_MONO))) THEN + ANTS_TAC THENL [ASM_ARITH_TAC; CONV_TAC NUM_REDUCE_CONV THEN DISCH_TAC] THEN + ABBREV_TAC `qq14 = (a + 127) DIV 128` THEN + SUBGOAL_THEN `qq14 * 1025 <= 59334 * 1025` ASSUME_TAC THENL + [ASM_SIMP_TAC[LE_MULT_RCANCEL]; ALL_TAC] THEN + SUBGOAL_THEN `55243 * 1025 <= qq14 * 1025` ASSUME_TAC THENL + [ASM_SIMP_TAC[LE_MULT_RCANCEL]; ALL_TAC] THEN + MP_TAC(SPEC `4194304` (SPEC `59334 * 1025 + 2097152` + (SPEC `qq14 * 1025 + 2097152` DIV_MONO))) THEN + ANTS_TAC THENL [ASM_ARITH_TAC; CONV_TAC NUM_REDUCE_CONV THEN DISCH_TAC] THEN + MP_TAC(SPEC `4194304` (SPEC `qq14 * 1025 + 2097152` + (SPEC `55243 * 1025 + 2097152` DIV_MONO))) THEN + ANTS_TAC THENL [ASM_ARITH_TAC; CONV_TAC NUM_REDUCE_CONV THEN DISCH_TAC] THEN + ASM_ARITH_TAC + ; + ASM_CASES_TAC `a <= 8118528` THENL + [ + MP_TAC(SPEC `262144` (SPEC `(2 * 8118528 * 1074791425) DIV 4294967296 + 131072` + (SPEC `(2 * a * 1074791425) DIV 4294967296 + 131072` DIV_MONO))) THEN + ANTS_TAC THENL [ASM_ARITH_TAC; CONV_TAC NUM_REDUCE_CONV THEN DISCH_TAC] THEN + MP_TAC(SPEC `262144` (SPEC `(2 * a * 1074791425) DIV 4294967296 + 131072` + (SPEC `(2 * 7594753 * 1074791425) DIV 4294967296 + 131072` DIV_MONO))) THEN + ANTS_TAC THENL [ASM_ARITH_TAC; CONV_TAC NUM_REDUCE_CONV THEN DISCH_TAC] THEN + MP_TAC(SPEC `128` (SPEC `8118528 + 127` (SPEC `a + 127` DIV_MONO))) THEN + ANTS_TAC THENL [ASM_ARITH_TAC; CONV_TAC NUM_REDUCE_CONV THEN DISCH_TAC] THEN + MP_TAC(SPEC `128` (SPEC `a + 127` (SPEC `7594753 + 127` DIV_MONO))) THEN + ANTS_TAC THENL [ASM_ARITH_TAC; CONV_TAC NUM_REDUCE_CONV THEN DISCH_TAC] THEN + ABBREV_TAC `qq15 = (a + 127) DIV 128` THEN + SUBGOAL_THEN `qq15 * 1025 <= 63426 * 1025` ASSUME_TAC THENL + [ASM_SIMP_TAC[LE_MULT_RCANCEL]; ALL_TAC] THEN + SUBGOAL_THEN `59335 * 1025 <= qq15 * 1025` ASSUME_TAC THENL + [ASM_SIMP_TAC[LE_MULT_RCANCEL]; ALL_TAC] THEN + MP_TAC(SPEC `4194304` (SPEC `63426 * 1025 + 2097152` + (SPEC `qq15 * 1025 + 2097152` DIV_MONO))) THEN + ANTS_TAC THENL [ASM_ARITH_TAC; CONV_TAC NUM_REDUCE_CONV THEN DISCH_TAC] THEN + MP_TAC(SPEC `4194304` (SPEC `qq15 * 1025 + 2097152` + (SPEC `59335 * 1025 + 2097152` DIV_MONO))) THEN + ANTS_TAC THENL [ASM_ARITH_TAC; CONV_TAC NUM_REDUCE_CONV THEN DISCH_TAC] THEN + ASM_ARITH_TAC + ; + MP_TAC(SPEC `262144` (SPEC `(2 * 8380416 * 1074791425) DIV 4294967296 + 131072` + (SPEC `(2 * a * 1074791425) DIV 4294967296 + 131072` DIV_MONO))) THEN + ANTS_TAC THENL [ASM_ARITH_TAC; CONV_TAC NUM_REDUCE_CONV THEN DISCH_TAC] THEN + MP_TAC(SPEC `262144` (SPEC `(2 * a * 1074791425) DIV 4294967296 + 131072` + (SPEC `(2 * 8118529 * 1074791425) DIV 4294967296 + 131072` DIV_MONO))) THEN + ANTS_TAC THENL [ASM_ARITH_TAC; CONV_TAC NUM_REDUCE_CONV THEN DISCH_TAC] THEN + MP_TAC(SPEC `128` (SPEC `8380416 + 127` (SPEC `a + 127` DIV_MONO))) THEN + ANTS_TAC THENL [ASM_ARITH_TAC; CONV_TAC NUM_REDUCE_CONV THEN DISCH_TAC] THEN + MP_TAC(SPEC `128` (SPEC `a + 127` (SPEC `8118529 + 127` DIV_MONO))) THEN + ANTS_TAC THENL [ASM_ARITH_TAC; CONV_TAC NUM_REDUCE_CONV THEN DISCH_TAC] THEN + ABBREV_TAC `qq16 = (a + 127) DIV 128` THEN + SUBGOAL_THEN `qq16 * 1025 <= 65472 * 1025` ASSUME_TAC THENL + [ASM_SIMP_TAC[LE_MULT_RCANCEL]; ALL_TAC] THEN + SUBGOAL_THEN `63427 * 1025 <= qq16 * 1025` ASSUME_TAC THENL + [ASM_SIMP_TAC[LE_MULT_RCANCEL]; ALL_TAC] THEN + MP_TAC(SPEC `4194304` (SPEC `65472 * 1025 + 2097152` + (SPEC `qq16 * 1025 + 2097152` DIV_MONO))) THEN + ANTS_TAC THENL [ASM_ARITH_TAC; CONV_TAC NUM_REDUCE_CONV THEN DISCH_TAC] THEN + MP_TAC(SPEC `4194304` (SPEC `qq16 * 1025 + 2097152` + (SPEC `63427 * 1025 + 2097152` DIV_MONO))) THEN + ANTS_TAC THENL [ASM_ARITH_TAC; CONV_TAC NUM_REDUCE_CONV THEN DISCH_TAC] THEN + ASM_ARITH_TAC + ]]]]]]]]]]]]]]]]);; + + +(* ========================================================================= *) +(* Element-level functional correctness *) +(* ========================================================================= *) + +let SPEC_BOUND = prove( + `!a h. a < 8380417 /\ h <= 1 + ==> mldsa_use_hint_32_spec a h <= 15`, + REPEAT GEN_TAC THEN STRIP_TAC THEN + REWRITE_TAC[mldsa_use_hint_32_spec; LET_DEF; LET_END_DEF] THEN + MP_TAC(SPEC `a:num` A1_BOUND) THEN ASM_REWRITE_TAC[] THEN DISCH_TAC THEN + REPEAT(COND_CASES_TAC THEN ASM_REWRITE_TAC[]) THEN + TRY(MATCH_MP_TAC(ARITH_RULE `x MOD 16 < 16 ==> x MOD 16 <= 15`) THEN + REWRITE_TAC[MOD_LT_EQ] THEN ARITH_TAC) THEN + ASM_ARITH_TAC);; + +let ELEMENT_CORRECT = prove( + `!a:int32 h:int32. + val a < 8380417 /\ val h <= 1 + ==> val(mldsa_use_hint_32_asm a h) = mldsa_use_hint_32_spec (val a) (val h)`, + REPEAT GEN_TAC THEN STRIP_TAC THEN + REWRITE_TAC[mldsa_use_hint_32_asm; mldsa_use_hint_32_spec] THEN + CONV_TAC(TOP_DEPTH_CONV let_CONV) THEN + ABBREV_TAC `nv = ((val(a:int32) + 127) DIV 128 * 1025 + 2097152) DIV 4194304` THEN + SUBGOAL_THEN `val(word_ishr_round (word_2smulh (a:int32) (word 1074791425)) 18 : int32) = nv` + ASSUME_TAC THENL + [EXPAND_TAC "nv" THEN + TRANS_TAC EQ_TRANS `((2 * val(a:int32) * 1074791425) DIV 4294967296 + 131072) DIV 262144` THEN + CONJ_TAC THENL + [MATCH_MP_TAC VAL_DECOMPOSE_A1 THEN ASM_REWRITE_TAC[]; + MATCH_MP_TAC BARRETT_EQUIV THEN ASM_REWRITE_TAC[]]; ALL_TAC] THEN + SUBGOAL_THEN `nv <= 16` ASSUME_TAC THENL + [MP_TAC(SPEC `val(a:int32)` A1_BOUND) THEN ASM_MESON_TAC[]; ALL_TAC] THEN + ASM_SIMP_TAC[WORD_IGT_THRESHOLD_32] THEN + ASM_CASES_TAC `val(a:int32) > 8118528` THEN ASM_REWRITE_TAC[bitval] THENL + [SUBGOAL_THEN `nv = 16` SUBST_ALL_TAC THENL + [MP_TAC(SPEC `val(a:int32)` A1_WRAP) THEN + ANTS_TAC THENL [ASM_ARITH_TAC; ALL_TAC] THEN ASM_MESON_TAC[]; ALL_TAC] THEN + SUBGOAL_THEN `word_ishr_round (word_2smulh (a:int32) (word 1074791425)) 18 = (word 16:int32)` + SUBST1_TAC THENL + [ONCE_REWRITE_TAC[GSYM WORD_VAL] THEN AP_TERM_TAC THEN ASM_REWRITE_TAC[]; ALL_TAC] THEN + CONV_TAC NUM_REDUCE_CONV THEN + SUBGOAL_THEN `word_and (word 16:int32) (word_not(word_neg(word 1:int32))) = word 0` + SUBST1_TAC THENL [CONV_TAC WORD_REDUCE_CONV; ALL_TAC] THEN + SUBGOAL_THEN `word_mul (word 16:int32) (word 523776) = word 8380416` + SUBST1_TAC THENL [CONV_TAC WORD_REDUCE_CONV; ALL_TAC] THEN + SUBGOAL_THEN `word_neg (word 1:int32) = word 4294967295` + SUBST1_TAC THENL [CONV_TAC WORD_REDUCE_CONV; ALL_TAC] THEN + REWRITE_TAC[WORD_ILE_ZERO_32] THEN + MP_TAC(SPEC `a:int32` WRAP_A0_NEGATIVE) THEN ASM_REWRITE_TAC[] THEN DISCH_TAC THEN + ASM_REWRITE_TAC[bitval] THEN CONV_TAC WORD_REDUCE_CONV THEN + SUBGOAL_THEN `&(val(a:int32)) - &0 > &4190208` ASSUME_TAC THENL + [REWRITE_TAC[INT_OF_NUM_GT; INT_SUB_RZERO] THEN ASM_ARITH_TAC; ALL_TAC] THEN + SUBGOAL_THEN `~(&(val(a:int32)) - &0 - &8380417 > &0)` ASSUME_TAC THENL + [REWRITE_TAC[INT_SUB_RZERO; INT_ARITH `~(&x - &y > &0) <=> &x <= &y`; INT_OF_NUM_LE] THEN + ASM_ARITH_TAC; ALL_TAC] THEN + ASM_REWRITE_TAC[] THEN + ASM_CASES_TAC `val(h:int32) = 0` THEN ASM_REWRITE_TAC[] THEN CONV_TAC WORD_REDUCE_CONV; + SUBGOAL_THEN `nv <= 15` ASSUME_TAC THENL + [MP_TAC(SPEC `val(a:int32)` A1_BOUND_NOWRAP) THEN + ANTS_TAC THENL [ASM_ARITH_TAC; ALL_TAC] THEN ASM_MESON_TAC[]; ALL_TAC] THEN + SUBGOAL_THEN `nv MOD 16 = nv` SUBST1_TAC THENL + [MATCH_MP_TAC MOD_LT THEN ASM_ARITH_TAC; ALL_TAC] THEN + SUBGOAL_THEN `word_ishr_round (word_2smulh (a:int32) (word 1074791425)) 18 = (word nv:int32)` + SUBST1_TAC THENL + [ONCE_REWRITE_TAC[GSYM WORD_VAL] THEN AP_TERM_TAC THEN ASM_REWRITE_TAC[]; ALL_TAC] THEN + CONV_TAC WORD_REDUCE_CONV THEN REWRITE_TAC[WORD_AND_REFL] THEN + REWRITE_TAC[WORD_ILE_ZERO_32; WORD_ADD_0] THEN + SUBGOAL_THEN + `(bit 31 (word_sub (a:int32) (word_mul (word nv:int32) (word 523776:int32))) \/ + word_sub a (word_mul (word nv) (word 523776)) = word 0) <=> + ~(&(val a) - &nv * &523776 > &0)` SUBST1_TAC THENL + [SUBGOAL_THEN `val(word_mul (word nv:int32) (word 523776:int32)) = nv * 523776` + ASSUME_TAC THENL + [REWRITE_TAC[VAL_WORD_MUL; VAL_WORD; DIMINDEX_32] THEN CONV_TAC NUM_REDUCE_CONV THEN + SUBGOAL_THEN `nv MOD 4294967296 = nv` SUBST1_TAC THENL + [MATCH_MP_TAC MOD_LT THEN ASM_ARITH_TAC; ALL_TAC] THEN + MATCH_MP_TAC MOD_LT THEN SUBGOAL_THEN `nv * 523776 <= 15 * 523776` MP_TAC THENL + [ASM_SIMP_TAC[LE_MULT_RCANCEL]; CONV_TAC NUM_REDUCE_CONV THEN ARITH_TAC]; ALL_TAC] THEN + SUBGOAL_THEN `val(word_mul (word nv:int32) (word 523776:int32)) <= 7856640` + ASSUME_TAC THENL + [ASM_REWRITE_TAC[] THEN SUBGOAL_THEN `nv * 523776 <= 15 * 523776` MP_TAC THENL + [ASM_SIMP_TAC[LE_MULT_RCANCEL]; CONV_TAC NUM_REDUCE_CONV THEN ARITH_TAC]; ALL_TAC] THEN + MP_TAC(ISPECL [`a:int32`; `word_mul (word nv:int32) (word 523776:int32)`] + WORD_SUB_SIGN_32) THEN + ASM_REWRITE_TAC[] THEN ANTS_TAC THENL [ASM_ARITH_TAC; ALL_TAC] THEN + DISCH_THEN SUBST1_TAC THEN ASM_REWRITE_TAC[] THEN + REWRITE_TAC[INT_ARITH `~(&a - &b > &0) <=> &a <= &b`; INT_OF_NUM_LE]; ALL_TAC] THEN + REWRITE_TAC[bitval] THEN + ASM_CASES_TAC `val(h:int32) = 0` THEN ASM_REWRITE_TAC[] THENL + [CONV_TAC WORD_REDUCE_CONV THEN REWRITE_TAC[VAL_WORD_AND_15_32] THEN + CONV_TAC WORD_REDUCE_CONV THEN + SUBGOAL_THEN `val(word nv:int32) = nv` SUBST1_TAC THENL + [MATCH_MP_TAC VAL_WORD_EQ THEN REWRITE_TAC[DIMINDEX_32] THEN + CONV_TAC NUM_REDUCE_CONV THEN ASM_ARITH_TAC; ALL_TAC] THEN + MATCH_MP_TAC MOD_LT THEN ASM_ARITH_TAC; ALL_TAC] THEN + SUBGOAL_THEN `val(word nv:int32) = nv` ASSUME_TAC THENL + [MATCH_MP_TAC VAL_WORD_EQ THEN REWRITE_TAC[DIMINDEX_32] THEN + CONV_TAC NUM_REDUCE_CONV THEN ASM_ARITH_TAC; ALL_TAC] THEN + SUBGOAL_THEN `val(word nv:int32) <= 15` ASSUME_TAC THENL + [ASM_REWRITE_TAC[]; ALL_TAC] THEN + COND_CASES_TAC THEN ASM_REWRITE_TAC[] THENL + [CONV_TAC WORD_REDUCE_CONV THEN ASM_SIMP_TAC[HINT_H1_NEG]; + CONV_TAC WORD_REDUCE_CONV THEN ASM_SIMP_TAC[HINT_H1_POS]]]);; + +let ELEMENT_CORRECT_WORD = prove( + `!a:int32 h:int32. + val a < 8380417 /\ val h <= 1 + ==> mldsa_use_hint_32_asm a h = + word(mldsa_use_hint_32_spec (val a) (val h))`, + REPEAT GEN_TAC THEN STRIP_TAC THEN + GEN_REWRITE_TAC LAND_CONV [GSYM WORD_VAL] THEN + AP_TERM_TAC THEN ASM_SIMP_TAC[ELEMENT_CORRECT]);; + +(* ========================================================================= *) +(* Correctness proof (output bounds) *) +(* ========================================================================= *) + +let MLDSA_USE_HINT_CORRECT = prove + (`!b a h x y pc. + nonoverlapping (word pc, LENGTH mldsa_poly_use_hint_32_mc) (b, 1024) /\ + nonoverlapping (b, 1024) (a, 1024) /\ + nonoverlapping (b, 1024) (h, 1024) + ==> ensures arm + (\s. aligned_bytes_loaded s (word pc) mldsa_poly_use_hint_32_mc /\ + read PC s = word pc /\ + C_ARGUMENTS [b; a; h] s /\ + (!i. i < 256 ==> val(x i) < 8380417) /\ + (!i. i < 256 ==> val(y i) <= 1) /\ + (!i. i < 256 ==> + read(memory :> bytes32(word_add a (word(4 * i)))) s = x i) /\ + (!i. i < 256 ==> + read(memory :> bytes32(word_add h (word(4 * i)))) s = y i)) + (\s. read PC s = word(pc + 0x110) /\ + (!i. i < 256 ==> + read(memory :> bytes32(word_add b (word(4 * i)))) s = + word(mldsa_use_hint_32_spec (val(x i)) (val(y i))))) + (MAYCHANGE_REGS_AND_FLAGS_PERMITTED_BY_ABI ,, + MAYCHANGE [memory :> bytes(b, 1024)])`, + + (* Setup *) + MAP_EVERY X_GEN_TAC + [`b:int64`; `a:int64`; `h:int64`; + `x:num->int32`; `y:num->int32`; `pc:num`] THEN + REWRITE_TAC[MAYCHANGE_REGS_AND_FLAGS_PERMITTED_BY_ABI; C_ARGUMENTS; + NONOVERLAPPING_CLAUSES; ALL; + fst MLDSA_USE_HINT_EXEC] THEN + DISCH_THEN(REPEAT_TCL CONJUNCTS_THEN ASSUME_TAC) THEN + GLOBALIZE_PRECONDITION_TAC THEN + CONV_TAC(RATOR_CONV(LAND_CONV(ONCE_DEPTH_CONV EXPAND_CASES_CONV))) THEN + CONV_TAC NUM_REDUCE_CONV THEN + REPEAT STRIP_TAC THEN + REWRITE_TAC[SOME_FLAGS; MODIFIABLE_SIMD_REGS] THEN + + (* Initialize and merge memory *) + ENSURES_INIT_TAC "s0" THEN + USE_HINT_MEMORY_128_FROM_32_TAC "a" 0 64 THEN + ASM_REWRITE_TAC[WORD_ADD_0] THEN CONV_TAC WORD_REDUCE_CONV THEN + STRIP_TAC THEN + USE_HINT_MEMORY_128_FROM_32_TAC "h" 0 64 THEN + ASM_REWRITE_TAC[WORD_ADD_0] THEN CONV_TAC WORD_REDUCE_CONV THEN + STRIP_TAC THEN + DISCARD_MATCHING_ASSUMPTIONS [`read (memory :> bytes32 a) s = x`] THEN + + (* Simulate 878 instructions (excluding RET), folding to mldsa_use_hint_32_asm *) + MAP_EVERY (fun n -> ARM_STEPS_TAC MLDSA_USE_HINT_EXEC [n] THEN + SIMD_SIMPLIFY_TAC[]) + (1--878) THEN + ENSURES_FINAL_STATE_TAC THEN ASM_REWRITE_TAC[] THEN + + (* Split bytes128 -> bytes32 for output memory *) + REPEAT(FIRST_X_ASSUM(STRIP_ASSUME_TAC o + CONV_RULE (SIMD_SIMPLIFY_CONV []) o + CONV_RULE(READ_MEMORY_SPLIT_CONV 2) o + check (can (term_match [] `read qqq s:int128 = xxx`) o concl))) THEN + + (* Expand output cases, substitute *) + CONV_TAC(TOP_DEPTH_CONV EXPAND_CASES_CONV) THEN + CONV_TAC(DEPTH_CONV NUM_MULT_CONV THENC DEPTH_CONV NUM_ADD_CONV) THEN + REWRITE_TAC[WORD_ADD_0] THEN + ASM_REWRITE_TAC[WORD_ADD_0] THEN ASM_REWRITE_TAC[] THEN + + (* Each conjunct is now: = word(mldsa_use_hint_32_spec ...) *) + (* Fold each word_expr into mldsa_use_hint_32_asm, then apply ELEMENT_CORRECT_WORD *) + REPEAT CONJ_TAC THEN + ONCE_REWRITE_TAC[GSYM mldsa_use_hint_32_asm] THEN + MATCH_MP_TAC ELEMENT_CORRECT_WORD THEN ASM_REWRITE_TAC[]);; + + +(* ========================================================================= *) +(* Subroutine form *) +(* ========================================================================= *) + +let MLDSA_USE_HINT_SUBROUTINE_CORRECT = prove + (`!b a h x y pc returnaddress. + nonoverlapping (word pc, LENGTH mldsa_poly_use_hint_32_mc) (b, 1024) /\ + nonoverlapping (b, 1024) (a, 1024) /\ + nonoverlapping (b, 1024) (h, 1024) + ==> ensures arm + (\s. aligned_bytes_loaded s (word pc) mldsa_poly_use_hint_32_mc /\ + read PC s = word pc /\ + read X30 s = returnaddress /\ + C_ARGUMENTS [b; a; h] s /\ + (!i. i < 256 ==> val(x i) < 8380417) /\ + (!i. i < 256 ==> val(y i) <= 1) /\ + (!i. i < 256 ==> + read(memory :> bytes32(word_add a (word(4 * i)))) s = x i) /\ + (!i. i < 256 ==> + read(memory :> bytes32(word_add h (word(4 * i)))) s = y i)) + (\s. read PC s = returnaddress /\ + (!i. i < 256 ==> + read(memory :> bytes32(word_add b (word(4 * i)))) s = + word(mldsa_use_hint_32_spec (val(x i)) (val(y i))))) + (MAYCHANGE_REGS_AND_FLAGS_PERMITTED_BY_ABI ,, + MAYCHANGE [memory :> bytes(b, 1024)])`, + REWRITE_TAC[fst MLDSA_USE_HINT_EXEC] THEN + ARM_ADD_RETURN_NOSTACK_TAC MLDSA_USE_HINT_EXEC + (REWRITE_RULE[fst MLDSA_USE_HINT_EXEC] + MLDSA_USE_HINT_CORRECT));; + + +(* ========================================================================= *) +(* Constant-time and memory safety proof. *) +(* ========================================================================= *) + +needs "arm/proofs/consttime.ml";; +needs "arm/proofs/subroutine_signatures.ml";; + +let full_spec,public_vars = mk_safety_spec + ~keep_maychanges:false + (assoc "mldsa_poly_use_hint_32" subroutine_signatures) + MLDSA_USE_HINT_SUBROUTINE_CORRECT + MLDSA_USE_HINT_EXEC;; + +let MLDSA_USE_HINT_SUBROUTINE_SAFE = time prove + (`exists f_events. + forall e b a h pc returnaddress. + nonoverlapping (word pc,LENGTH mldsa_poly_use_hint_32_mc) (b,1024) /\ + nonoverlapping (b,1024) (a,1024) /\ + nonoverlapping (b,1024) (h,1024) + ==> ensures arm + (\s. + aligned_bytes_loaded s (word pc) + mldsa_poly_use_hint_32_mc /\ + read PC s = word pc /\ + read X30 s = returnaddress /\ + C_ARGUMENTS [b; a; h] s /\ + read events s = e) + (\s. + read PC s = returnaddress /\ + (exists e2. + read events s = APPEND e2 e /\ + e2 = f_events a h b pc returnaddress /\ + memaccess_inbounds e2 [a,1024; h,1024; b,1024] + [b,1024])) + (\s s'. true)`, + ASSERT_CONCL_TAC full_spec THEN + PROVE_SAFETY_SPEC_TAC ~public_vars:public_vars MLDSA_USE_HINT_EXEC);; diff --git a/arm/proofs/specifications.txt b/arm/proofs/specifications.txt index 69b68d785..0737af9d2 100644 --- a/arm/proofs/specifications.txt +++ b/arm/proofs/specifications.txt @@ -327,6 +327,8 @@ MLDSA_NTT_SUBROUTINE_CORRECT MLDSA_NTT_SUBROUTINE_SAFE MLDSA_POINTWISE_SUBROUTINE_CORRECT MLDSA_POINTWISE_SUBROUTINE_SAFE +MLDSA_USE_HINT_SUBROUTINE_CORRECT +MLDSA_USE_HINT_SUBROUTINE_SAFE MLKEM_BASEMUL_K2_SUBROUTINE_CORRECT MLKEM_BASEMUL_K2_SUBROUTINE_SAFE MLKEM_BASEMUL_K3_SUBROUTINE_CORRECT diff --git a/arm/proofs/subroutine_signatures.ml b/arm/proofs/subroutine_signatures.ml index 6f17d5f67..1acef1876 100644 --- a/arm/proofs/subroutine_signatures.ml +++ b/arm/proofs/subroutine_signatures.ml @@ -4455,6 +4455,24 @@ let subroutine_signatures = [ ]) ); +("mldsa_poly_use_hint_32", + ([(*args*) + ("b", "int32_t[static 256]", (*is const?*)"false"); + ("a", "int32_t[static 256]", (*is const?*)"true"); + ("h", "int32_t[static 256]", (*is const?*)"true"); + ], + "void", + [(* input buffers *) + ("a", "256"(* num elems *), 4(* elem bytesize *)); + ("h", "256"(* num elems *), 4(* elem bytesize *)); + ], + [(* output buffers *) + ("b", "256"(* num elems *), 4(* elem bytesize *)); + ], + [(* temporary buffers *) + ]) +); + ("mlkem_basemul_k2", ([(*args*) ("r", "int16_t[static 256]", (*is const?*)"false"); diff --git a/benchmarks/benchmark.c b/benchmarks/benchmark.c index d2c260496..4e152610f 100644 --- a/benchmarks/benchmark.c +++ b/benchmarks/benchmark.c @@ -1100,6 +1100,7 @@ void call_mldsa_ntt(void) repeat(mldsa_ntt((int32_t*)b0,(const int32_t*)b1)) void call_mldsa_nttunpack(void) repeat(mldsa_nttunpack((int32_t*)b0)) void call_mldsa_pointwise(void) repeat(mldsa_pointwise_x86((int32_t*)b0,(int32_t*)b1,(int32_t*)b2,(int32_t*)b3)) void call_mldsa_reduce(void) repeat(mldsa_reduce((int32_t*)b0)) +void call_mldsa_poly_use_hint_32(void) {} void call_mlkem_frombytes(void) repeat(mlkem_frombytes((uint16_t*)b0,(int8_t*)b1)) void call_mlkem_intt(void) repeat(mlkem_intt_x86((int16_t*)b0,(int16_t*)b1)) @@ -1126,6 +1127,7 @@ void call_mldsa_intt(void) repeat(mldsa_intt_arm((int32_t*)b0,(const int32_t*)b1 void call_mldsa_ntt(void) repeat(mldsa_ntt_arm((int32_t*)b0,(const int32_t*)b1,(const int32_t*)b2)) void call_mldsa_nttunpack(void) {} void call_mldsa_pointwise(void) repeat(mldsa_pointwise((int32_t*)b0,(int32_t*)b1,(int32_t*)b2)) +void call_mldsa_poly_use_hint_32(void) repeat(mldsa_poly_use_hint_32((int32_t*)b0,(int32_t*)b1,(int32_t*)b2)) void call_mldsa_reduce(void) {} void call_bignum_copy_row_from_table_8n__32_16(void) \ @@ -1549,6 +1551,7 @@ int main(int argc, char *argv[]) timingtest(all,"mldsa_ntt",call_mldsa_ntt); timingtest(!arm,"mldsa_nttunpack",call_mldsa_nttunpack); timingtest(all,"mldsa_pointwise",call_mldsa_pointwise); + timingtest(arm,"mldsa_poly_use_hint_32",call_mldsa_poly_use_hint_32); timingtest(!arm,"mldsa_reduce",call_mldsa_reduce); timingtest(bmi,"p256_montjadd",call_p256_montjadd); timingtest(all,"p256_montjadd_alt",call_p256_montjadd_alt); diff --git a/common/mlkem_mldsa.ml b/common/mlkem_mldsa.ml index fd5958cd6..c0ad97dd2 100644 --- a/common/mlkem_mldsa.ml +++ b/common/mlkem_mldsa.ml @@ -834,6 +834,20 @@ let MEMORY_128_FROM_32_TAC = READ_MEMORY_MERGE_CONV 2 (subst[itm,n_tm] pat') in MP_TAC(end_itlist CONJ (map f (0--(n-1))));; +(* ------------------------------------------------------------------------- *) +(* ML-DSA use_hint Merge 4 x bytes32 into bytes128 at a given base+offset *) +(* ------------------------------------------------------------------------- *) + +let USE_HINT_MEMORY_128_FROM_32_TAC = + let a_tm = `a:int64` and n_tm = `n:num` and i64_ty = `:int64` + and pat = `read (memory :> bytes128(word_add a (word n))) s0` in + fun v boff n -> + let pat' = subst[mk_var(v,i64_ty),a_tm] pat in + let f i = + let itm = mk_small_numeral(boff + 16*i) in + READ_MEMORY_MERGE_CONV 2 (subst[itm,n_tm] pat') in + MP_TAC(end_itlist CONJ (map f (0--(n-1))));; + (* ------------------------------------------------------------------------- *) (* From |- (x == y) (mod m) /\ P to |- (x == y) (mod n) /\ P *) (* ------------------------------------------------------------------------- *) @@ -1912,3 +1926,83 @@ let SIMD_SIMPLIFY_ABBREV_TAC = let tms = sort free_in (find_terms pam (rand(concl th''))) in (MP_TAC th'' THEN MAP_EVERY AUTO_ABBREV_TAC tms THEN DISCH_TAC) (asl,w) in TRY(FIRST_X_ASSUM(ttac o check (simdable o concl)));; + +(* ========================================================================= *) +(* ML-DSA use_hint shared infrastructure lemmas *) +(* Used by both poly_use_hint_32 and poly_use_hint_88 proofs *) +(* ========================================================================= *) + +(* ival equals val for values in [0, Q) where Q = 8380417 < 2^31 *) +let MLDSA_IVAL_VAL = prove( + `!a:int32. val a < 8380417 ==> ival a = &(val a)`, + GEN_TAC THEN DISCH_TAC THEN + SIMP_TAC[ival; DIMINDEX_32] THEN + CONV_TAC NUM_REDUCE_CONV THEN + COND_CASES_TAC THEN ASM_ARITH_TAC);; + +(* For natural numbers, &n is never < -2^31 *) +let INT_POS_NEG_BOUND = prove(`!n. ~((&n:int) < --(&2147483648))`, + GEN_TAC THEN REWRITE_TAC[INT_NOT_LT] THEN + MP_TAC(SPEC `n:num` INT_POS) THEN INT_ARITH_TAC);; + +(* val(iword(&n)) = n for n < 2^31 *) +let VAL_IWORD_NUM_32 = prove( + `!n. n < 2147483648 ==> val(iword(&n):int32) = n`, + GEN_TAC THEN DISCH_TAC THEN + MP_TAC(ISPECL [`&n:int`] (INST_TYPE [`:32`,`:N`] INT_VAL_IWORD)) THEN + REWRITE_TAC[DIMINDEX_32; INT_POS] THEN + CONV_TAC NUM_REDUCE_CONV THEN + ANTS_TAC THENL + [REWRITE_TAC[INT_OF_NUM_LT] THEN ASM_ARITH_TAC; + REWRITE_TAC[INT_OF_NUM_EQ] THEN SIMP_TAC[]]);; + +(* word_ile x 0 in terms of bit 31 (signed non-positive check) *) +let WORD_ILE_ZERO_32 = BITBLAST_RULE + `!x:int32. word_ile x (word 0) <=> bit 31 x \/ x = word 0`;; + +(* val(word_and x (word 15)) = val x MOD 16 *) +let VAL_WORD_AND_15_32 = BITBLAST_RULE + `!x:int32. val(word_and x (word 15:int32)) = val x MOD 16`;; + +(* word_2smulh no-saturation for ML-DSA Q range. + Eliminates iword_saturate when the input is in [0, Q). *) +let MLDSA_WORD_2SMULH_NOSATURATE = prove( + `!a:int32 c. val a < 8380417 /\ val c < 2147483648 + ==> word_2smulh a c : int32 = + iword((&2 * &(val a) * &(val c)) div &2 pow 32)`, + REPEAT GEN_TAC THEN STRIP_TAC THEN + REWRITE_TAC[word_2smulh; DIMINDEX_32] THEN + SUBGOAL_THEN `ival(a:int32) = &(val a)` SUBST1_TAC THENL + [SIMP_TAC[ival; DIMINDEX_32] THEN CONV_TAC NUM_REDUCE_CONV THEN + COND_CASES_TAC THEN ASM_ARITH_TAC; ALL_TAC] THEN + SUBGOAL_THEN `ival(c:int32) = &(val c)` SUBST1_TAC THENL + [SIMP_TAC[ival; DIMINDEX_32] THEN CONV_TAC NUM_REDUCE_CONV THEN + COND_CASES_TAC THEN ASM_ARITH_TAC; ALL_TAC] THEN + CONV_TAC WORD_REDUCE_CONV THEN + REWRITE_TAC[iword_saturate; word_INT_MIN; word_INT_MAX; DIMINDEX_32] THEN + CONV_TAC NUM_REDUCE_CONV THEN CONV_TAC WORD_REDUCE_CONV THEN + CONV_TAC(DEPTH_CONV WORD_NUM_RED_CONV) THEN + REWRITE_TAC[INT_OF_NUM_CLAUSES] THEN + SIMP_TAC[INT_OF_NUM_DIV] THEN + REWRITE_TAC[INT_POS_NEG_BOUND] THEN + SUBGOAL_THEN `~(&((2 * val(a:int32) * val(c:int32)) DIV 4294967296):int > &2147483647)` + (fun th -> REWRITE_TAC[th]) THEN + REWRITE_TAC[INT_ARITH `~(x:int > y) <=> x <= y`; INT_OF_NUM_LE] THEN + SUBGOAL_THEN `(2 * val(a:int32) * val(c:int32)) DIV 4294967296 <= 2 * val a` + (fun th -> MP_TAC th THEN ARITH_TAC) THEN + MATCH_MP_TAC(ARITH_RULE `x <= y * 4294967296 ==> x DIV 4294967296 <= y`) THEN + SUBGOAL_THEN `val(c:int32) <= 2147483647` ASSUME_TAC THENL + [ASM_ARITH_TAC; ALL_TAC] THEN + TRANS_TAC LE_TRANS `2 * val(a:int32) * 2147483647` THEN CONJ_TAC THENL + [ASM_SIMP_TAC[LE_MULT_LCANCEL]; ARITH_TAC]);; + +(* word_ishr_round for positive values (val < 2^31) *) +let MLDSA_WORD_ISHR_ROUND = prove( + `!t:int32 n. val t < 2147483648 + ==> word_ishr_round t n = iword((&(val t) + &2 pow n div &2) div &2 pow n)`, + REPEAT GEN_TAC THEN DISCH_TAC THEN + REWRITE_TAC[word_ishr_round] THEN + SUBGOAL_THEN `ival(t:int32) = &(val t)` SUBST1_TAC THENL + [SIMP_TAC[ival; DIMINDEX_32] THEN CONV_TAC NUM_REDUCE_CONV THEN + COND_CASES_TAC THEN ASM_ARITH_TAC; + REFL_TAC]);; diff --git a/include/s2n-bignum.h b/include/s2n-bignum.h index 8e3d5d56d..3e0bbdb58 100644 --- a/include/s2n-bignum.h +++ b/include/s2n-bignum.h @@ -1014,6 +1014,10 @@ extern void mldsa_pointwise_x86(int32_t c[S2N_BIGNUM_STATIC 256], const int32_t // Input a[256] (signed 32-bit words); output a[256] (signed 32-bit words) extern void mldsa_reduce(int32_t a[S2N_BIGNUM_STATIC 256]); +// Use hint to correct high bits of decomposition for ML-DSA (parameter sets 65/87) +// Inputs a[256], h[256] (signed 32-bit words); output b[256] (signed 32-bit words) +extern void mldsa_poly_use_hint_32(int32_t b[S2N_BIGNUM_STATIC 256], const int32_t a[S2N_BIGNUM_STATIC 256], const int32_t h[S2N_BIGNUM_STATIC 256]); + // Scalar product of 2-element polynomial vectors in NTT domain, with mulcache // Inputs a[512], b[512], bt[256] (signed 16-bit words); output r[256] (signed 16-bit words) extern void mlkem_basemul_k2(int16_t r[S2N_BIGNUM_STATIC 256],const int16_t a[S2N_BIGNUM_STATIC 512],const int16_t b[S2N_BIGNUM_STATIC 512],const int16_t bt[S2N_BIGNUM_STATIC 256]); diff --git a/tests/test.c b/tests/test.c index e1080ac7a..732560ccb 100644 --- a/tests/test.c +++ b/tests/test.c @@ -12289,6 +12289,89 @@ static void mlkem_poly_mulcache_to_avx2_layout(int16_t a[128]) } #endif +// Reference implementation of mldsa_poly_use_hint_32 for ML-DSA parameter sets 65/87 +// GAMMA2 = (Q-1)/32 = 261888, output range [0, 15] +// Matches the exact assembly algorithm using SQDMULH-based Barrett decomposition +void reference_mldsa_poly_use_hint_32(int32_t b[256], const int32_t a[256], const int32_t h[256]) +{ + const int32_t TWO_GAMMA2 = 523776; + const int32_t THRESHOLD = 8118528; // 31 * GAMMA2 + const int32_t BARRETT = 1074791425; // 0x40100401 + for (int i = 0; i < 256; i++) { + int32_t ai = a[i]; + // Decompose using SQDMULH + SRSHR (matching assembly) + // sqdmulh: (2 * ai * BARRETT) >> 32 + int32_t sqdmulh_result = (int32_t)(((int64_t)2 * ai * BARRETT) >> 32); + // srshr by 18: (x + (1 << 17)) >> 18 (signed rounding shift right) + int32_t a1 = (sqdmulh_result + (1 << 17)) >> 18; + // a0 = ai - a1 * 2*GAMMA2 + int32_t a0 = ai - a1 * TWO_GAMMA2; + // Wraparound: if ai > threshold, set a1=0, a0 += -1 (since mask = -1) + if (ai > THRESHOLD) { + a1 = 0; + a0 = a0 + (-1); // add the all-ones mask + } + // delta = (a0 <= 0) ? -1 : 1 + int32_t delta = (a0 <= 0) ? -1 : 1; + // b = (a1 + delta * hint) & 15 + b[i] = (a1 + delta * h[i]) & 15; + } +} + +int test_mldsa_poly_use_hint_32(void) +{ + // Skip test on non-aarch64 architectures (ARM-only function) + if (get_arch_name() != ARCH_AARCH64) { + return 0; + } + +#ifdef __aarch64__ + uint64_t t, i; + int32_t a[256] __attribute__((aligned(32))); + int32_t h[256] __attribute__((aligned(32))); + int32_t b_asm[256] __attribute__((aligned(32))); + int32_t b_ref[256] __attribute__((aligned(32))); + + printf("Testing mldsa_poly_use_hint_32 with %d cases\n", tests); + + for (t = 0; t < tests; ++t) { + // Generate random coefficients in [0, Q) + for (i = 0; i < 256; ++i) { + a[i] = (int32_t)(random64() % 8380417); + h[i] = (int32_t)(random64() % 2); // hint is 0 or 1 + } + + // Compute reference result + reference_mldsa_poly_use_hint_32(b_ref, a, h); + + // Call the assembly implementation + mldsa_poly_use_hint_32(b_asm, a, h); + + // Compare results + for (i = 0; i < 256; ++i) { + if (b_asm[i] != b_ref[i]) { + printf("Error in mldsa_poly_use_hint_32 element i = %"PRIu64"; " + "asm = %"PRId32" ref = %"PRId32" " + "(a[i] = %"PRId32", h[i] = %"PRId32")\n", + i, b_asm[i], b_ref[i], a[i], h[i]); + return 1; + } + } + + if (VERBOSE) { + printf("OK: mldsa_poly_use_hint_32: a[0]=0x%08"PRIx32", h[0]=%"PRId32" => b[0]=%"PRId32"\n", + a[0], h[0], b_asm[0]); + } + } + + printf("All OK\n"); + return 0; +#else + return 0; +#endif +} + + int test_mlkem_basemul_k2(void) { uint64_t t, i; @@ -16292,6 +16375,7 @@ int main(int argc, char *argv[]) functionaltest(all,"mldsa_nttunpack",test_mldsa_nttunpack); functionaltest(all,"mldsa_pointwise",test_mldsa_pointwise); functionaltest(all,"mldsa_reduce",test_mldsa_reduce); + functionaltest(all,"mldsa_poly_use_hint_32",test_mldsa_poly_use_hint_32); functionaltest(all,"mlkem_basemul_k2",test_mlkem_basemul_k2); functionaltest(all,"mlkem_basemul_k3",test_mlkem_basemul_k3); functionaltest(all,"mlkem_basemul_k4",test_mlkem_basemul_k4); diff --git a/tools/collect-signatures.py b/tools/collect-signatures.py index 4ae0c2466..94558575e 100644 --- a/tools/collect-signatures.py +++ b/tools/collect-signatures.py @@ -301,6 +301,7 @@ def stripPrefixes(s, prefixes): "mldsa_intt_arm", "mldsa_pointwise", "mldsa_ntt_arm", + "mldsa_poly_use_hint_32", "mlkem_ntt", "mlkem_intt", "mlkem_mulcache_compute", From 811a4c31bf92745f0fd7c4004d69da8ac3caa3a2 Mon Sep 17 00:00:00 2001 From: Jake Massimo Date: Fri, 17 Apr 2026 15:40:35 +0000 Subject: [PATCH 02/11] Remove word_2smulh from common/mlkem_mldsa.ml, make proof self-contained word_2smulh is defined in arm/proofs/instruction.ml which is not loaded by x86 proofs. Moving the lemmas inline into the proof file avoids breaking x86 proofs that load the common file. --- arm/proofs/mldsa_poly_use_hint_32.ml | 28 ++++++++++++++---- common/mlkem_mldsa.ml | 43 ---------------------------- 2 files changed, 23 insertions(+), 48 deletions(-) diff --git a/arm/proofs/mldsa_poly_use_hint_32.ml b/arm/proofs/mldsa_poly_use_hint_32.ml index 0db8d6651..66e0cf892 100644 --- a/arm/proofs/mldsa_poly_use_hint_32.ml +++ b/arm/proofs/mldsa_poly_use_hint_32.ml @@ -136,16 +136,34 @@ let WORD_2SMULH_NOSATURATE_32 = prove( ==> word_2smulh a (word 1074791425:int32) : int32 = iword((&2 * &(val a) * &1074791425) div &2 pow 32)`, GEN_TAC THEN DISCH_TAC THEN - MP_TAC(SPECL [`a:int32`; `word 1074791425:int32`] MLDSA_WORD_2SMULH_NOSATURATE) THEN - ASM_REWRITE_TAC[] THEN CONV_TAC WORD_REDUCE_CONV THEN SIMP_TAC[]);; + REWRITE_TAC[word_2smulh; DIMINDEX_32] THEN + ASM_SIMP_TAC[IVAL_SMALL] THEN + CONV_TAC WORD_REDUCE_CONV THEN + REWRITE_TAC[iword_saturate; word_INT_MIN; word_INT_MAX; DIMINDEX_32] THEN + CONV_TAC NUM_REDUCE_CONV THEN CONV_TAC WORD_REDUCE_CONV THEN + CONV_TAC(DEPTH_CONV WORD_NUM_RED_CONV) THEN + REWRITE_TAC[INT_OF_NUM_CLAUSES] THEN + SIMP_TAC[INT_OF_NUM_DIV] THEN + REWRITE_TAC[INT_POS_NEG_BOUND] THEN + SUBGOAL_THEN `~(&((2 * val(a:int32) * 1074791425) DIV 4294967296):int > &2147483647)` + (fun th -> REWRITE_TAC[th]) THEN + REWRITE_TAC[INT_ARITH `~(x:int > y) <=> x <= y`; INT_OF_NUM_LE] THEN + TRANS_TAC LE_TRANS `(2 * 8380416 * 1074791425) DIV 4294967296` THEN + CONJ_TAC THENL + [MATCH_MP_TAC DIV_MONO THEN ASM_ARITH_TAC; + CONV_TAC NUM_REDUCE_CONV]);; let WORD_ISHR_ROUND_18 = prove( `!t:int32. val t < 2147483648 ==> word_ishr_round t 18 = iword((&(val t) + &131072) div &262144)`, GEN_TAC THEN DISCH_TAC THEN - MP_TAC(SPECL [`t:int32`; `18`] MLDSA_WORD_ISHR_ROUND) THEN - ASM_REWRITE_TAC[] THEN CONV_TAC NUM_REDUCE_CONV THEN - CONV_TAC INT_REDUCE_CONV THEN SIMP_TAC[]);; + REWRITE_TAC[word_ishr_round] THEN + CONV_TAC NUM_REDUCE_CONV THEN + CONV_TAC INT_REDUCE_CONV THEN + SUBGOAL_THEN `ival(t:int32) = &(val t)` SUBST1_TAC THENL + [SIMP_TAC[ival; DIMINDEX_32] THEN CONV_TAC NUM_REDUCE_CONV THEN + COND_CASES_TAC THEN ASM_ARITH_TAC; + REFL_TAC]);; let VAL_DECOMPOSE_A1 = prove( `!a:int32. val a < 8380417 diff --git a/common/mlkem_mldsa.ml b/common/mlkem_mldsa.ml index c0ad97dd2..a3f04b4f4 100644 --- a/common/mlkem_mldsa.ml +++ b/common/mlkem_mldsa.ml @@ -1963,46 +1963,3 @@ let WORD_ILE_ZERO_32 = BITBLAST_RULE (* val(word_and x (word 15)) = val x MOD 16 *) let VAL_WORD_AND_15_32 = BITBLAST_RULE `!x:int32. val(word_and x (word 15:int32)) = val x MOD 16`;; - -(* word_2smulh no-saturation for ML-DSA Q range. - Eliminates iword_saturate when the input is in [0, Q). *) -let MLDSA_WORD_2SMULH_NOSATURATE = prove( - `!a:int32 c. val a < 8380417 /\ val c < 2147483648 - ==> word_2smulh a c : int32 = - iword((&2 * &(val a) * &(val c)) div &2 pow 32)`, - REPEAT GEN_TAC THEN STRIP_TAC THEN - REWRITE_TAC[word_2smulh; DIMINDEX_32] THEN - SUBGOAL_THEN `ival(a:int32) = &(val a)` SUBST1_TAC THENL - [SIMP_TAC[ival; DIMINDEX_32] THEN CONV_TAC NUM_REDUCE_CONV THEN - COND_CASES_TAC THEN ASM_ARITH_TAC; ALL_TAC] THEN - SUBGOAL_THEN `ival(c:int32) = &(val c)` SUBST1_TAC THENL - [SIMP_TAC[ival; DIMINDEX_32] THEN CONV_TAC NUM_REDUCE_CONV THEN - COND_CASES_TAC THEN ASM_ARITH_TAC; ALL_TAC] THEN - CONV_TAC WORD_REDUCE_CONV THEN - REWRITE_TAC[iword_saturate; word_INT_MIN; word_INT_MAX; DIMINDEX_32] THEN - CONV_TAC NUM_REDUCE_CONV THEN CONV_TAC WORD_REDUCE_CONV THEN - CONV_TAC(DEPTH_CONV WORD_NUM_RED_CONV) THEN - REWRITE_TAC[INT_OF_NUM_CLAUSES] THEN - SIMP_TAC[INT_OF_NUM_DIV] THEN - REWRITE_TAC[INT_POS_NEG_BOUND] THEN - SUBGOAL_THEN `~(&((2 * val(a:int32) * val(c:int32)) DIV 4294967296):int > &2147483647)` - (fun th -> REWRITE_TAC[th]) THEN - REWRITE_TAC[INT_ARITH `~(x:int > y) <=> x <= y`; INT_OF_NUM_LE] THEN - SUBGOAL_THEN `(2 * val(a:int32) * val(c:int32)) DIV 4294967296 <= 2 * val a` - (fun th -> MP_TAC th THEN ARITH_TAC) THEN - MATCH_MP_TAC(ARITH_RULE `x <= y * 4294967296 ==> x DIV 4294967296 <= y`) THEN - SUBGOAL_THEN `val(c:int32) <= 2147483647` ASSUME_TAC THENL - [ASM_ARITH_TAC; ALL_TAC] THEN - TRANS_TAC LE_TRANS `2 * val(a:int32) * 2147483647` THEN CONJ_TAC THENL - [ASM_SIMP_TAC[LE_MULT_LCANCEL]; ARITH_TAC]);; - -(* word_ishr_round for positive values (val < 2^31) *) -let MLDSA_WORD_ISHR_ROUND = prove( - `!t:int32 n. val t < 2147483648 - ==> word_ishr_round t n = iword((&(val t) + &2 pow n div &2) div &2 pow n)`, - REPEAT GEN_TAC THEN DISCH_TAC THEN - REWRITE_TAC[word_ishr_round] THEN - SUBGOAL_THEN `ival(t:int32) = &(val t)` SUBST1_TAC THENL - [SIMP_TAC[ival; DIMINDEX_32] THEN CONV_TAC NUM_REDUCE_CONV THEN - COND_CASES_TAC THEN ASM_ARITH_TAC; - REFL_TAC]);; From a5da51c4e6f94a14ec43e3d76dacb622b5f4b8af Mon Sep 17 00:00:00 2001 From: Jake Massimo Date: Thu, 23 Apr 2026 18:15:25 +0000 Subject: [PATCH 03/11] ML-DSA poly_use_hint_32: functional correctness proof Replace weak output-bounds postcondition with full functional correctness: each output word equals word(mldsa_use_hint_32_spec (val(x i)) (val(y i))). Key proof techniques: - Bridge lemmas (REAL_INT_GT_BRIDGE) resolve both real_gt and int_gt from a single NUM fact, avoiding backtick type mismatch - Inner if elimination via COND_CASES_TAC + A0_UPPER_32 contradiction - INT_MUL_LZERO + INT_SUB_RZERO for wrap case simplification --- arm/proofs/mldsa_poly_use_hint_32.ml | 273 ++++++++++++++++++--------- 1 file changed, 180 insertions(+), 93 deletions(-) diff --git a/arm/proofs/mldsa_poly_use_hint_32.ml b/arm/proofs/mldsa_poly_use_hint_32.ml index 66e0cf892..bf1906d0c 100644 --- a/arm/proofs/mldsa_poly_use_hint_32.ml +++ b/arm/proofs/mldsa_poly_use_hint_32.ml @@ -147,7 +147,8 @@ let WORD_2SMULH_NOSATURATE_32 = prove( REWRITE_TAC[INT_POS_NEG_BOUND] THEN SUBGOAL_THEN `~(&((2 * val(a:int32) * 1074791425) DIV 4294967296):int > &2147483647)` (fun th -> REWRITE_TAC[th]) THEN - REWRITE_TAC[INT_ARITH `~(x:int > y) <=> x <= y`; INT_OF_NUM_LE] THEN + SUBGOAL_THEN `(2 * val(a:int32) * 1074791425) DIV 4294967296 <= 2147483647` + (fun th -> MP_TAC(REWRITE_RULE[GSYM INT_OF_NUM_LE] th) THEN INT_ARITH_TAC) THEN TRANS_TAC LE_TRANS `(2 * 8380416 * 1074791425) DIV 4294967296` THEN CONJ_TAC THENL [MATCH_MP_TAC DIV_MONO THEN ASM_ARITH_TAC; @@ -179,13 +180,18 @@ let VAL_DECOMPOSE_A1 = prove( MATCH_MP_TAC DIV_MONO THEN ASM_ARITH_TAC; CONV_TAC NUM_REDUCE_CONV]; ALL_TAC] THEN REWRITE_TAC[INT_OF_NUM_CLAUSES] THEN SIMP_TAC[INT_OF_NUM_DIV] THEN CONV_TAC NUM_REDUCE_CONV THEN ASM_SIMP_TAC[VAL_IWORD_NUM] THEN - ASM_SIMP_TAC[WORD_ISHR_ROUND_18] THEN - REWRITE_TAC[INT_OF_NUM_CLAUSES] THEN SIMP_TAC[INT_OF_NUM_DIV] THEN - CONV_TAC NUM_REDUCE_CONV THEN ABBREV_TAC `t:int32 = iword(&((2 * val(a:int32) * 1074791425) DIV 4294967296))` THEN SUBGOAL_THEN `val(t:int32) = (2 * val(a:int32) * 1074791425) DIV 4294967296` ASSUME_TAC THENL [EXPAND_TAC "t" THEN MATCH_MP_TAC VAL_IWORD_NUM THEN ASM_REWRITE_TAC[]; ALL_TAC] THEN + SUBGOAL_THEN `val(t:int32) < 2147483648` ASSUME_TAC THENL + [ASM_REWRITE_TAC[]; ALL_TAC] THEN + REWRITE_TAC[word_ishr_round] THEN CONV_TAC NUM_REDUCE_CONV THEN CONV_TAC INT_REDUCE_CONV THEN + SUBGOAL_THEN `ival(t:int32) = &(val t)` ASSUME_TAC THENL + [SIMP_TAC[ival; DIMINDEX_32] THEN CONV_TAC NUM_REDUCE_CONV THEN + COND_CASES_TAC THEN ASM_ARITH_TAC; ALL_TAC] THEN + ASM_REWRITE_TAC[] THEN + REWRITE_TAC[INT_OF_NUM_CLAUSES] THEN SIMP_TAC[INT_OF_NUM_DIV] THEN CONV_TAC NUM_REDUCE_CONV THEN SUBGOAL_THEN `(val(t:int32) + 131072) DIV 262144 < 2147483648` ASSUME_TAC THENL [ASM_REWRITE_TAC[] THEN TRANS_TAC LT_TRANS `(4194303 + 131072) DIV 262144 + 1` THEN CONJ_TAC THENL @@ -245,6 +251,50 @@ let A1_BOUND_NOWRAP = prove( [ASM_SIMP_TAC[LE_MULT_RCANCEL]; CONV_TAC NUM_REDUCE_CONV THEN ARITH_TAC]; CONV_TAC NUM_REDUCE_CONV THEN ARITH_TAC]);; +let A0_UPPER_32 = prove( + `!a. a <= 8118528 + ==> a < (((a + 127) DIV 128 * 1025 + 2097152) DIV 4194304 + 1) * 523776`, + GEN_TAC THEN DISCH_TAC THEN + ABBREV_TAC `nv = ((a + 127) DIV 128 * 1025 + 2097152) DIV 4194304` THEN + SUBGOAL_THEN `nv * 4194304 <= (a + 127) DIV 128 * 1025 + 2097152` ASSUME_TAC THENL + [EXPAND_TAC "nv" THEN + MP_TAC(SPECL [`(a + 127) DIV 128 * 1025 + 2097152`; `4194304`] (CONJUNCT1 DIVISION_SIMP)) THEN + ARITH_TAC; ALL_TAC] THEN + SUBGOAL_THEN `(a + 127) DIV 128 <= 63426` ASSUME_TAC THENL + [MP_TAC(SPEC `128` (SPEC `8118528 + 127` (SPEC `a + 127` DIV_MONO))) THEN + ANTS_TAC THENL [ASM_ARITH_TAC; CONV_TAC NUM_REDUCE_CONV THEN ARITH_TAC]; ALL_TAC] THEN + SUBGOAL_THEN `nv * 4194304 <= 63426 * 1025 + 2097152` ASSUME_TAC THENL + [SUBGOAL_THEN `(a + 127) DIV 128 * 1025 <= 63426 * 1025` MP_TAC THENL + [REWRITE_TAC[LE_MULT_RCANCEL] THEN DISJ1_TAC THEN ASM_ARITH_TAC; ASM_ARITH_TAC]; ALL_TAC] THEN + SUBGOAL_THEN `nv <= 15` ASSUME_TAC THENL + [CONV_TAC NUM_REDUCE_CONV THEN ASM_ARITH_TAC; ALL_TAC] THEN + ASM_ARITH_TAC);; + +let SPEC_NOWRAP_32 = prove( + `!a h. a <= 8118528 + ==> mldsa_use_hint_32_spec a h = + (let nv = ((a + 127) DIV 128 * 1025 + 2097152) DIV 4194304 in + if h = 0 then nv + else if int_gt (&a - &nv * &523776) (&0) + then (nv + 1) MOD 16 + else (nv + 15) MOD 16)`, + REPEAT GEN_TAC THEN DISCH_TAC THEN + REWRITE_TAC[mldsa_use_hint_32_spec] THEN + CONV_TAC(TOP_DEPTH_CONV let_CONV) THEN + ABBREV_TAC `nv = ((a + 127) DIV 128 * 1025 + 2097152) DIV 4194304` THEN + SUBGOAL_THEN `nv MOD 16 = nv` SUBST1_TAC THENL + [MATCH_MP_TAC MOD_LT THEN MP_TAC(SPEC `a:num` A1_BOUND_NOWRAP) THEN + ASM_REWRITE_TAC[] THEN EXPAND_TAC "nv" THEN ARITH_TAC; ALL_TAC] THEN + SUBGOAL_THEN `~(int_gt (&a - &nv * &523776) (&4190208))` ASSUME_TAC THENL + [REWRITE_TAC[INT_GT; INT_NOT_LT] THEN + MP_TAC(REWRITE_RULE[GSYM INT_OF_NUM_LT; GSYM INT_OF_NUM_MUL; + GSYM INT_OF_NUM_ADD] (SPEC `a:num` A0_UPPER_32)) THEN + ASM_REWRITE_TAC[] THEN EXPAND_TAC "nv" THEN INT_ARITH_TAC; ALL_TAC] THEN + ASM_REWRITE_TAC[] THEN + REPEAT(COND_CASES_TAC THEN ASM_REWRITE_TAC[]) THEN + POP_ASSUM(fun p -> POP_ASSUM(fun np -> + CONTR_TAC(EQ_MP (EQF_INTRO np) p))));; + let HINT_H1_POS = prove( `!a1:int32. val a1 <= 15 ==> val(word_and (word_add a1 (word 1:int32)) (word 15:int32)) = (val a1 + 1) MOD 16`, @@ -269,6 +319,49 @@ let WORD_SUB_SIGN_32 = BITBLAST_RULE `!a:int32 b:int32. val b <= 7856640 /\ val a <= 8118528 ==> ((bit 31 (word_sub a b) \/ word_sub a b = word 0) <=> val a <= val b)`;; +let WORD_AND_ONES_32 = prove( + `!x:int32. word_and x (word 4294967295) = x`, + GEN_TAC THEN + SUBGOAL_THEN `(word 4294967295 : int32) = word_not(word 0)` SUBST1_TAC THENL + [CONV_TAC WORD_REDUCE_CONV; REWRITE_TAC[WORD_AND_NOT0]]);; + +let WORD_MUL_1_32 = prove( + `!x:int32. word_mul x (word 1) = x`, + GEN_TAC THEN REWRITE_TAC[GSYM VAL_EQ; VAL_WORD_MUL; VAL_WORD; DIMINDEX_32] THEN + CONV_TAC NUM_REDUCE_CONV THEN REWRITE_TAC[MULT_CLAUSES] THEN + MATCH_MP_TAC MOD_LT THEN MP_TAC(ISPEC `x:int32` VAL_BOUND) THEN + REWRITE_TAC[DIMINDEX_32] THEN CONV_TAC NUM_REDUCE_CONV);; + +let WORD_OR_NEG1_32 = prove( + `!x:int32. word_or (word_neg(word 1)) x = word_neg(word 1)`, + GEN_TAC THEN + SUBGOAL_THEN `word_neg(word 1:int32) = word_not(word 0)` SUBST1_TAC THENL + [CONV_TAC WORD_REDUCE_CONV; REWRITE_TAC[WORD_OR_NOT0]]);; + +let WORD_NEG1_VAL_32 = WORD_REDUCE_CONV `word_neg(word 1 : int32)`;; + +let REAL_INT_GT_BRIDGE = prove( + `!a:num b c. a <= b * c + ==> ~(real_gt (&a - &b * &c) (&0)) /\ ~(int_gt (&a - &b * &c) (&0))`, + REPEAT GEN_TAC THEN DISCH_TAC THEN CONJ_TAC THENL + [REWRITE_TAC[real_gt; REAL_NOT_LT] THEN + MP_TAC(REWRITE_RULE[GSYM REAL_OF_NUM_LE; GSYM REAL_OF_NUM_MUL] + (ASSUME `a <= b * c`)) THEN REAL_ARITH_TAC; + REWRITE_TAC[INT_GT; INT_NOT_LT] THEN + MP_TAC(REWRITE_RULE[GSYM INT_OF_NUM_LE; GSYM INT_OF_NUM_MUL] + (ASSUME `a <= b * c`)) THEN INT_ARITH_TAC]);; + +let REAL_INT_GT_BRIDGE_POS = prove( + `!a:num b c. ~(a <= b * c) + ==> real_gt (&a - &b * &c) (&0) /\ int_gt (&a - &b * &c) (&0)`, + REPEAT GEN_TAC THEN REWRITE_TAC[NOT_LE] THEN DISCH_TAC THEN CONJ_TAC THENL + [REWRITE_TAC[real_gt] THEN + MP_TAC(REWRITE_RULE[GSYM REAL_OF_NUM_LT; GSYM REAL_OF_NUM_MUL] + (ASSUME `b * c < a`)) THEN REAL_ARITH_TAC; + REWRITE_TAC[INT_GT] THEN + MP_TAC(REWRITE_RULE[GSYM INT_OF_NUM_LT; GSYM INT_OF_NUM_MUL] + (ASSUME `b * c < a`)) THEN INT_ARITH_TAC]);; + let WRAP_A0_NEGATIVE = BITBLAST_RULE `!a:int32. val a < 8380417 /\ val a > 8118528 ==> bit 31 (word_add (word_sub a (word 8380416:int32)) (word 4294967295:int32))`;; @@ -730,86 +823,62 @@ let ELEMENT_CORRECT = prove( REWRITE_TAC[mldsa_use_hint_32_asm; mldsa_use_hint_32_spec] THEN CONV_TAC(TOP_DEPTH_CONV let_CONV) THEN ABBREV_TAC `nv = ((val(a:int32) + 127) DIV 128 * 1025 + 2097152) DIV 4194304` THEN - SUBGOAL_THEN `val(word_ishr_round (word_2smulh (a:int32) (word 1074791425)) 18 : int32) = nv` - ASSUME_TAC THENL - [EXPAND_TAC "nv" THEN - TRANS_TAC EQ_TRANS `((2 * val(a:int32) * 1074791425) DIV 4294967296 + 131072) DIV 262144` THEN - CONJ_TAC THENL - [MATCH_MP_TAC VAL_DECOMPOSE_A1 THEN ASM_REWRITE_TAC[]; - MATCH_MP_TAC BARRETT_EQUIV THEN ASM_REWRITE_TAC[]]; ALL_TAC] THEN - SUBGOAL_THEN `nv <= 16` ASSUME_TAC THENL - [MP_TAC(SPEC `val(a:int32)` A1_BOUND) THEN ASM_MESON_TAC[]; ALL_TAC] THEN - ASM_SIMP_TAC[WORD_IGT_THRESHOLD_32] THEN + SUBGOAL_THEN `val(word_ishr_round (word_2smulh (a:int32) (word 1074791425)) 18 : int32) = nv` ASSUME_TAC THENL + [EXPAND_TAC "nv" THEN TRANS_TAC EQ_TRANS `((2 * val(a:int32) * 1074791425) DIV 4294967296 + 131072) DIV 262144` THEN CONJ_TAC THENL [MATCH_MP_TAC VAL_DECOMPOSE_A1 THEN ASM_REWRITE_TAC[]; MATCH_MP_TAC BARRETT_EQUIV THEN ASM_REWRITE_TAC[]]; ALL_TAC] THEN + SUBGOAL_THEN `nv <= 16` ASSUME_TAC THENL [MP_TAC(SPEC `val(a:int32)` A1_BOUND) THEN ASM_MESON_TAC[]; ALL_TAC] THEN + SUBGOAL_THEN `word_igt (a:int32) (word 8118528:int32) <=> val a > 8118528` SUBST1_TAC THENL [MP_TAC(SPEC `a:int32` WORD_IGT_THRESHOLD_32) THEN ASM_REWRITE_TAC[]; ALL_TAC] THEN ASM_CASES_TAC `val(a:int32) > 8118528` THEN ASM_REWRITE_TAC[bitval] THENL - [SUBGOAL_THEN `nv = 16` SUBST_ALL_TAC THENL - [MP_TAC(SPEC `val(a:int32)` A1_WRAP) THEN - ANTS_TAC THENL [ASM_ARITH_TAC; ALL_TAC] THEN ASM_MESON_TAC[]; ALL_TAC] THEN - SUBGOAL_THEN `word_ishr_round (word_2smulh (a:int32) (word 1074791425)) 18 = (word 16:int32)` - SUBST1_TAC THENL - [ONCE_REWRITE_TAC[GSYM WORD_VAL] THEN AP_TERM_TAC THEN ASM_REWRITE_TAC[]; ALL_TAC] THEN - CONV_TAC NUM_REDUCE_CONV THEN - SUBGOAL_THEN `word_and (word 16:int32) (word_not(word_neg(word 1:int32))) = word 0` - SUBST1_TAC THENL [CONV_TAC WORD_REDUCE_CONV; ALL_TAC] THEN - SUBGOAL_THEN `word_mul (word 16:int32) (word 523776) = word 8380416` - SUBST1_TAC THENL [CONV_TAC WORD_REDUCE_CONV; ALL_TAC] THEN - SUBGOAL_THEN `word_neg (word 1:int32) = word 4294967295` - SUBST1_TAC THENL [CONV_TAC WORD_REDUCE_CONV; ALL_TAC] THEN - REWRITE_TAC[WORD_ILE_ZERO_32] THEN - MP_TAC(SPEC `a:int32` WRAP_A0_NEGATIVE) THEN ASM_REWRITE_TAC[] THEN DISCH_TAC THEN - ASM_REWRITE_TAC[bitval] THEN CONV_TAC WORD_REDUCE_CONV THEN - SUBGOAL_THEN `&(val(a:int32)) - &0 > &4190208` ASSUME_TAC THENL - [REWRITE_TAC[INT_OF_NUM_GT; INT_SUB_RZERO] THEN ASM_ARITH_TAC; ALL_TAC] THEN - SUBGOAL_THEN `~(&(val(a:int32)) - &0 - &8380417 > &0)` ASSUME_TAC THENL - [REWRITE_TAC[INT_SUB_RZERO; INT_ARITH `~(&x - &y > &0) <=> &x <= &y`; INT_OF_NUM_LE] THEN - ASM_ARITH_TAC; ALL_TAC] THEN - ASM_REWRITE_TAC[] THEN - ASM_CASES_TAC `val(h:int32) = 0` THEN ASM_REWRITE_TAC[] THEN CONV_TAC WORD_REDUCE_CONV; - SUBGOAL_THEN `nv <= 15` ASSUME_TAC THENL - [MP_TAC(SPEC `val(a:int32)` A1_BOUND_NOWRAP) THEN - ANTS_TAC THENL [ASM_ARITH_TAC; ALL_TAC] THEN ASM_MESON_TAC[]; ALL_TAC] THEN - SUBGOAL_THEN `nv MOD 16 = nv` SUBST1_TAC THENL - [MATCH_MP_TAC MOD_LT THEN ASM_ARITH_TAC; ALL_TAC] THEN - SUBGOAL_THEN `word_ishr_round (word_2smulh (a:int32) (word 1074791425)) 18 = (word nv:int32)` - SUBST1_TAC THENL - [ONCE_REWRITE_TAC[GSYM WORD_VAL] THEN AP_TERM_TAC THEN ASM_REWRITE_TAC[]; ALL_TAC] THEN - CONV_TAC WORD_REDUCE_CONV THEN REWRITE_TAC[WORD_AND_REFL] THEN - REWRITE_TAC[WORD_ILE_ZERO_32; WORD_ADD_0] THEN - SUBGOAL_THEN - `(bit 31 (word_sub (a:int32) (word_mul (word nv:int32) (word 523776:int32))) \/ - word_sub a (word_mul (word nv) (word 523776)) = word 0) <=> - ~(&(val a) - &nv * &523776 > &0)` SUBST1_TAC THENL - [SUBGOAL_THEN `val(word_mul (word nv:int32) (word 523776:int32)) = nv * 523776` - ASSUME_TAC THENL - [REWRITE_TAC[VAL_WORD_MUL; VAL_WORD; DIMINDEX_32] THEN CONV_TAC NUM_REDUCE_CONV THEN - SUBGOAL_THEN `nv MOD 4294967296 = nv` SUBST1_TAC THENL - [MATCH_MP_TAC MOD_LT THEN ASM_ARITH_TAC; ALL_TAC] THEN - MATCH_MP_TAC MOD_LT THEN SUBGOAL_THEN `nv * 523776 <= 15 * 523776` MP_TAC THENL - [ASM_SIMP_TAC[LE_MULT_RCANCEL]; CONV_TAC NUM_REDUCE_CONV THEN ARITH_TAC]; ALL_TAC] THEN - SUBGOAL_THEN `val(word_mul (word nv:int32) (word 523776:int32)) <= 7856640` - ASSUME_TAC THENL - [ASM_REWRITE_TAC[] THEN SUBGOAL_THEN `nv * 523776 <= 15 * 523776` MP_TAC THENL - [ASM_SIMP_TAC[LE_MULT_RCANCEL]; CONV_TAC NUM_REDUCE_CONV THEN ARITH_TAC]; ALL_TAC] THEN - MP_TAC(ISPECL [`a:int32`; `word_mul (word nv:int32) (word 523776:int32)`] - WORD_SUB_SIGN_32) THEN - ASM_REWRITE_TAC[] THEN ANTS_TAC THENL [ASM_ARITH_TAC; ALL_TAC] THEN - DISCH_THEN SUBST1_TAC THEN ASM_REWRITE_TAC[] THEN - REWRITE_TAC[INT_ARITH `~(&a - &b > &0) <=> &a <= &b`; INT_OF_NUM_LE]; ALL_TAC] THEN - REWRITE_TAC[bitval] THEN - ASM_CASES_TAC `val(h:int32) = 0` THEN ASM_REWRITE_TAC[] THENL - [CONV_TAC WORD_REDUCE_CONV THEN REWRITE_TAC[VAL_WORD_AND_15_32] THEN - CONV_TAC WORD_REDUCE_CONV THEN - SUBGOAL_THEN `val(word nv:int32) = nv` SUBST1_TAC THENL - [MATCH_MP_TAC VAL_WORD_EQ THEN REWRITE_TAC[DIMINDEX_32] THEN - CONV_TAC NUM_REDUCE_CONV THEN ASM_ARITH_TAC; ALL_TAC] THEN - MATCH_MP_TAC MOD_LT THEN ASM_ARITH_TAC; ALL_TAC] THEN - SUBGOAL_THEN `val(word nv:int32) = nv` ASSUME_TAC THENL - [MATCH_MP_TAC VAL_WORD_EQ THEN REWRITE_TAC[DIMINDEX_32] THEN - CONV_TAC NUM_REDUCE_CONV THEN ASM_ARITH_TAC; ALL_TAC] THEN - SUBGOAL_THEN `val(word nv:int32) <= 15` ASSUME_TAC THENL - [ASM_REWRITE_TAC[]; ALL_TAC] THEN - COND_CASES_TAC THEN ASM_REWRITE_TAC[] THENL - [CONV_TAC WORD_REDUCE_CONV THEN ASM_SIMP_TAC[HINT_H1_NEG]; - CONV_TAC WORD_REDUCE_CONV THEN ASM_SIMP_TAC[HINT_H1_POS]]]);; + [ + SUBGOAL_THEN `nv = 16` SUBST_ALL_TAC THENL [MP_TAC(SPEC `val(a:int32)` A1_WRAP) THEN ANTS_TAC THENL [ASM_ARITH_TAC; ALL_TAC] THEN ASM_MESON_TAC[]; ALL_TAC] THEN + SUBGOAL_THEN `word_ishr_round (word_2smulh (a:int32) (word 1074791425)) 18 = (word 16:int32)` (fun th -> REWRITE_TAC[th]) THENL [ONCE_REWRITE_TAC[GSYM WORD_VAL] THEN AP_TERM_TAC THEN ASM_REWRITE_TAC[]; ALL_TAC] THEN + CONV_TAC NUM_REDUCE_CONV THEN CONV_TAC WORD_REDUCE_CONV THEN + REWRITE_TAC[WORD_ILE_ZERO_32] THEN + MP_TAC(SPEC `a:int32` WRAP_A0_NEGATIVE) THEN ASM_REWRITE_TAC[] THEN DISCH_TAC THEN + ASM_REWRITE_TAC[bitval] THEN CONV_TAC WORD_REDUCE_CONV THEN + REWRITE_TAC[INT_MUL_LZERO; INT_SUB_RZERO] THEN + SUBGOAL_THEN `~((if int_gt (&(val(a:int32))) (&4190208) then &(val a) - &8380417 else &(val a):int) > &0)` ASSUME_TAC THENL + [REWRITE_TAC[INT_GT; INT_NOT_LT] THEN COND_CASES_TAC THENL + [MP_TAC(REWRITE_RULE[GSYM INT_OF_NUM_LT] (ASSUME `val(a:int32) < 8380417`)) THEN INT_ARITH_TAC; + POP_ASSUM(MP_TAC o REWRITE_RULE[INT_GT; INT_NOT_LT]) THEN + MP_TAC(REWRITE_RULE[GSYM INT_OF_NUM_GT; INT_GT] (ASSUME `val(a:int32) > 8118528`)) THEN INT_ARITH_TAC]; + ALL_TAC] THEN + ASM_REWRITE_TAC[] THEN + ASM_CASES_TAC `val(h:int32) = 0` THEN ASM_REWRITE_TAC[] THENL + [SUBGOAL_THEN `h:int32 = word 0` SUBST1_TAC THENL [REWRITE_TAC[GSYM VAL_EQ_0] THEN ASM_REWRITE_TAC[]; ALL_TAC] THEN CONV_TAC WORD_REDUCE_CONV; + SUBGOAL_THEN `h:int32 = word 1` SUBST1_TAC THENL [REWRITE_TAC[GSYM VAL_EQ_1] THEN ASM_ARITH_TAC; ALL_TAC] THEN CONV_TAC WORD_REDUCE_CONV] + ; + SUBGOAL_THEN `nv <= 15` ASSUME_TAC THENL [MP_TAC(SPEC `val(a:int32)` A1_BOUND_NOWRAP) THEN ANTS_TAC THENL [ASM_ARITH_TAC; ALL_TAC] THEN ASM_MESON_TAC[]; ALL_TAC] THEN + SUBGOAL_THEN `nv MOD 16 = nv` SUBST1_TAC THENL [MATCH_MP_TAC MOD_LT THEN ASM_ARITH_TAC; ALL_TAC] THEN + SUBGOAL_THEN `word_ishr_round (word_2smulh (a:int32) (word 1074791425)) 18 = (word nv:int32)` (fun th -> REWRITE_TAC[th]) THENL [GEN_REWRITE_TAC LAND_CONV [GSYM WORD_VAL] THEN AP_TERM_TAC THEN ASM_REWRITE_TAC[]; ALL_TAC] THEN + CONV_TAC WORD_REDUCE_CONV THEN REWRITE_TAC[WORD_AND_REFL] THEN REWRITE_TAC[WORD_ILE_ZERO_32; WORD_ADD_0] THEN + SUBGOAL_THEN `nv * 523776 <= 7856640` ASSUME_TAC THENL [SUBGOAL_THEN `nv * 523776 <= 15 * 523776` MP_TAC THENL [REWRITE_TAC[LE_MULT_RCANCEL] THEN DISJ1_TAC THEN ASM_ARITH_TAC; CONV_TAC NUM_REDUCE_CONV THEN ARITH_TAC]; ALL_TAC] THEN + SUBGOAL_THEN `val(word_mul (word nv:int32) (word 523776:int32)) = nv * 523776` ASSUME_TAC THENL [REWRITE_TAC[VAL_WORD_MUL; VAL_WORD; DIMINDEX_32] THEN CONV_TAC NUM_REDUCE_CONV THEN SUBGOAL_THEN `nv MOD 4294967296 = nv` SUBST1_TAC THENL [MATCH_MP_TAC MOD_LT THEN ASM_ARITH_TAC; ALL_TAC] THEN MATCH_MP_TAC MOD_LT THEN ASM_ARITH_TAC; ALL_TAC] THEN + SUBGOAL_THEN `val(word_mul (word nv:int32) (word 523776:int32)) <= 7856640` ASSUME_TAC THENL [ASM_ARITH_TAC; ALL_TAC] THEN + SUBGOAL_THEN `(bit 31 (word_sub (a:int32) (word_mul (word nv:int32) (word 523776:int32))) \/ word_sub a (word_mul (word nv) (word 523776)) = word 0) <=> ~(&(val a) - &nv * &523776 > &0)` SUBST1_TAC THENL + [MP_TAC(ISPECL [`a:int32`; `word_mul (word nv:int32) (word 523776:int32)`] WORD_SUB_SIGN_32) THEN ASM_REWRITE_TAC[] THEN ANTS_TAC THENL [ASM_ARITH_TAC; ALL_TAC] THEN DISCH_THEN SUBST1_TAC THEN ASM_REWRITE_TAC[] THEN + ASM_CASES_TAC `val(a:int32) <= nv * 523776` THENL + [ASM_REWRITE_TAC[] THEN MP_TAC(REWRITE_RULE[GSYM INT_OF_NUM_MUL] (REWRITE_RULE[GSYM INT_OF_NUM_LE] (ASSUME `val(a:int32) <= nv * 523776`))) THEN INT_ARITH_TAC; + ASM_REWRITE_TAC[] THEN SUBGOAL_THEN `nv * 523776 < val(a:int32)` ASSUME_TAC THENL [UNDISCH_TAC `~(val(a:int32) <= nv * 523776)` THEN ARITH_TAC; ALL_TAC] THEN MP_TAC(REWRITE_RULE[GSYM INT_OF_NUM_MUL] (REWRITE_RULE[GSYM INT_OF_NUM_LT] (ASSUME `nv * 523776 < val(a:int32)`))) THEN INT_ARITH_TAC]; ALL_TAC] THEN + REWRITE_TAC[bitval] THEN + ASM_CASES_TAC `val(h:int32) = 0` THEN ASM_REWRITE_TAC[] THENL + [SUBGOAL_THEN `h:int32 = word 0` SUBST1_TAC THENL [REWRITE_TAC[GSYM VAL_EQ_0] THEN ASM_REWRITE_TAC[]; ALL_TAC] THEN REWRITE_TAC[WORD_MUL_0; WORD_ADD_0; WORD_AND_ONES_32] THEN REWRITE_TAC[VAL_WORD_AND_15_32] THEN SUBGOAL_THEN `val(word nv:int32) = nv` SUBST1_TAC THENL [MATCH_MP_TAC VAL_WORD_EQ THEN REWRITE_TAC[DIMINDEX_32] THEN CONV_TAC NUM_REDUCE_CONV THEN ASM_ARITH_TAC; ALL_TAC] THEN MATCH_MP_TAC MOD_LT THEN ASM_ARITH_TAC; + ALL_TAC] THEN + SUBGOAL_THEN `h:int32 = word 1` SUBST1_TAC THENL [REWRITE_TAC[GSYM VAL_EQ_1] THEN ASM_ARITH_TAC; ALL_TAC] THEN + REWRITE_TAC[WORD_MUL_1_32; WORD_AND_ONES_32] THEN + SUBGOAL_THEN `val(word nv:int32) = nv` ASSUME_TAC THENL [MATCH_MP_TAC VAL_WORD_EQ THEN REWRITE_TAC[DIMINDEX_32] THEN CONV_TAC NUM_REDUCE_CONV THEN ASM_ARITH_TAC; ALL_TAC] THEN + SUBGOAL_THEN `val(word nv:int32) <= 15` ASSUME_TAC THENL [ASM_REWRITE_TAC[]; ALL_TAC] THEN + SUBGOAL_THEN `~(int_gt (&(val(a:int32)) - &nv * &523776) (&4190208))` ASSUME_TAC THENL + [REWRITE_TAC[INT_GT; INT_NOT_LT] THEN MP_TAC(SPEC `val(a:int32)` A0_UPPER_32) THEN ANTS_TAC THENL [ASM_ARITH_TAC; ALL_TAC] THEN ASM_REWRITE_TAC[] THEN DISCH_TAC THEN MP_TAC(REWRITE_RULE[GSYM INT_OF_NUM_LT; GSYM INT_OF_NUM_MUL; GSYM INT_OF_NUM_ADD] (ASSUME `val(a:int32) < (nv + 1) * 523776`)) THEN INT_ARITH_TAC; ALL_TAC] THEN + ASM_REWRITE_TAC[] THEN + ASM_CASES_TAC `val(a:int32) <= nv * 523776` THENL + [MP_TAC(SPECL [`val(a:int32)`; `nv:num`; `523776`] REAL_INT_GT_BRIDGE) THEN ASM_REWRITE_TAC[] THEN STRIP_TAC THEN ASM_REWRITE_TAC[]; + MP_TAC(SPECL [`val(a:int32)`; `nv:num`; `523776`] REAL_INT_GT_BRIDGE_POS) THEN ASM_REWRITE_TAC[] THEN STRIP_TAC THEN ASM_REWRITE_TAC[]] THEN + REWRITE_TAC[bitval] THEN CONV_TAC WORD_REDUCE_CONV THEN + REWRITE_TAC[VAL_WORD_AND_15_32; VAL_WORD_ADD; VAL_WORD; DIMINDEX_32] THEN CONV_TAC NUM_REDUCE_CONV THEN ASM_REWRITE_TAC[] THEN + REWRITE_TAC[ARITH_RULE `16 = 2 EXP 4`; ARITH_RULE `4294967296 = 2 EXP 32`; MOD_MOD_EXP_MIN] THEN CONV_TAC NUM_REDUCE_CONV THEN + REWRITE_TAC[ARITH_RULE `4294967295 = 15 + 268435455 * 16`; ARITH_RULE `n + (15 + 268435455 * 16) = (n + 15) + 268435455 * 16`; MOD_MULT_ADD] THEN + SUBGOAL_THEN `nv MOD 4294967296 = nv` (fun th -> REWRITE_TAC[th]) THEN TRY(MATCH_MP_TAC MOD_LT) THEN ASM_ARITH_TAC]);; + let ELEMENT_CORRECT_WORD = prove( `!a:int32 h:int32. @@ -818,7 +887,7 @@ let ELEMENT_CORRECT_WORD = prove( word(mldsa_use_hint_32_spec (val a) (val h))`, REPEAT GEN_TAC THEN STRIP_TAC THEN GEN_REWRITE_TAC LAND_CONV [GSYM WORD_VAL] THEN - AP_TERM_TAC THEN ASM_SIMP_TAC[ELEMENT_CORRECT]);; + AP_TERM_TAC THEN MP_TAC(SPECL [`a:int32`; `h:int32`] ELEMENT_CORRECT) THEN ASM_REWRITE_TAC[] THEN DISCH_THEN(fun th -> REWRITE_TAC[th]));; (* ========================================================================= *) (* Correctness proof (output bounds) *) @@ -842,7 +911,7 @@ let MLDSA_USE_HINT_CORRECT = prove (\s. read PC s = word(pc + 0x110) /\ (!i. i < 256 ==> read(memory :> bytes32(word_add b (word(4 * i)))) s = - word(mldsa_use_hint_32_spec (val(x i)) (val(y i))))) + word(mldsa_use_hint_32_spec (val(x i)) (val(y i))))) (MAYCHANGE_REGS_AND_FLAGS_PERMITTED_BY_ABI ,, MAYCHANGE [memory :> bytes(b, 1024)])`, @@ -862,15 +931,15 @@ let MLDSA_USE_HINT_CORRECT = prove (* Initialize and merge memory *) ENSURES_INIT_TAC "s0" THEN - USE_HINT_MEMORY_128_FROM_32_TAC "a" 0 64 THEN + MEMORY_128_FROM_32_TAC "a" 0 64 THEN ASM_REWRITE_TAC[WORD_ADD_0] THEN CONV_TAC WORD_REDUCE_CONV THEN STRIP_TAC THEN - USE_HINT_MEMORY_128_FROM_32_TAC "h" 0 64 THEN + MEMORY_128_FROM_32_TAC "h" 0 64 THEN ASM_REWRITE_TAC[WORD_ADD_0] THEN CONV_TAC WORD_REDUCE_CONV THEN STRIP_TAC THEN DISCARD_MATCHING_ASSUMPTIONS [`read (memory :> bytes32 a) s = x`] THEN - (* Simulate 878 instructions (excluding RET), folding to mldsa_use_hint_32_asm *) + (* Simulate 878 instructions (excluding RET) *) MAP_EVERY (fun n -> ARM_STEPS_TAC MLDSA_USE_HINT_EXEC [n] THEN SIMD_SIMPLIFY_TAC[]) (1--878) THEN @@ -888,11 +957,28 @@ let MLDSA_USE_HINT_CORRECT = prove REWRITE_TAC[WORD_ADD_0] THEN ASM_REWRITE_TAC[WORD_ADD_0] THEN ASM_REWRITE_TAC[] THEN - (* Each conjunct is now: = word(mldsa_use_hint_32_spec ...) *) - (* Fold each word_expr into mldsa_use_hint_32_asm, then apply ELEMENT_CORRECT_WORD *) + (* Push word_subword through SIMD ops to per-element form *) + REWRITE_TAC[WORD_SUBWORD_AND; WORD_SUBWORD_OR] THEN + let WSN_TAC = REWRITE_TAC(map (fun n -> prove( + subst [mk_small_numeral n, `n:num`] + `!x:int128. word_subword(word_not x) (n,32):int32 = word_not(word_subword x (n,32))`, + GEN_TAC THEN MATCH_MP_TAC WORD_SUBWORD_NOT THEN + REWRITE_TAC[DIMINDEX_32; DIMINDEX_128] THEN ARITH_TAC)) [0;32;64;96]) in + WSN_TAC THEN + CONV_TAC(DEPTH_CONV WORD_SIMPLE_SUBWORD_CONV) THEN + CONV_TAC(DEPTH_CONV WORD_NUM_RED_CONV) THEN + (* Match expanded ival/iword form *) + let EC_DEEP = + CONV_RULE(DEPTH_CONV WORD_NUM_RED_CONV) + (CONV_RULE(DEPTH_CONV(INT_RED_CONV ORELSEC NUM_RED_CONV)) + (CONV_RULE(TOP_DEPTH_CONV let_CONV) + (REWRITE_RULE[mldsa_use_hint_32_asm; word_2smulh; word_ishr_round; + DIMINDEX_32] ELEMENT_CORRECT_WORD))) in + let EC_FINAL = ONCE_REWRITE_RULE[WORD_AND_SYM] + (ONCE_REWRITE_RULE[WORD_OR_SYM] EC_DEEP) in REPEAT CONJ_TAC THEN - ONCE_REWRITE_TAC[GSYM mldsa_use_hint_32_asm] THEN - MATCH_MP_TAC ELEMENT_CORRECT_WORD THEN ASM_REWRITE_TAC[]);; + MATCH_MP_TAC EC_FINAL THEN + CONJ_TAC THEN FIRST_X_ASSUM MATCH_MP_TAC THEN ARITH_TAC);; (* ========================================================================= *) @@ -918,7 +1004,7 @@ let MLDSA_USE_HINT_SUBROUTINE_CORRECT = prove (\s. read PC s = returnaddress /\ (!i. i < 256 ==> read(memory :> bytes32(word_add b (word(4 * i)))) s = - word(mldsa_use_hint_32_spec (val(x i)) (val(y i))))) + word(mldsa_use_hint_32_spec (val(x i)) (val(y i))))) (MAYCHANGE_REGS_AND_FLAGS_PERMITTED_BY_ABI ,, MAYCHANGE [memory :> bytes(b, 1024)])`, REWRITE_TAC[fst MLDSA_USE_HINT_EXEC] THEN @@ -934,6 +1020,7 @@ let MLDSA_USE_HINT_SUBROUTINE_CORRECT = prove needs "arm/proofs/consttime.ml";; needs "arm/proofs/subroutine_signatures.ml";; + let full_spec,public_vars = mk_safety_spec ~keep_maychanges:false (assoc "mldsa_poly_use_hint_32" subroutine_signatures) From 6b97d7b4f4300d5d450f0127bc05e4f838ceff0a Mon Sep 17 00:00:00 2001 From: Jake Massimo Date: Fri, 24 Apr 2026 06:21:24 +0000 Subject: [PATCH 04/11] Remove unused lemmas from poly_use_hint_32 and share helpers via common Remove 7 unused helper lemmas (WORD_ISHR_ROUND_18, SPEC_NOWRAP_32, HINT_H1_POS, HINT_H1_NEG, WORD_OR_NEG1_32, WORD_NEG1_VAL_32, SPEC_BOUND) and move 4 shared lemmas (WORD_AND_ONES_32, WORD_MUL_1_32, REAL_INT_GT_BRIDGE, REAL_INT_GT_BRIDGE_POS) to common/mlkem_mldsa.ml so they can be shared with the poly_use_hint_88 proof. Signed-off-by: Jake Massimo --- arm/proofs/mldsa_poly_use_hint_32.ml | 111 --------------------------- common/mlkem_mldsa.ml | 34 ++++++++ 2 files changed, 34 insertions(+), 111 deletions(-) diff --git a/arm/proofs/mldsa_poly_use_hint_32.ml b/arm/proofs/mldsa_poly_use_hint_32.ml index bf1906d0c..ad7ef04cd 100644 --- a/arm/proofs/mldsa_poly_use_hint_32.ml +++ b/arm/proofs/mldsa_poly_use_hint_32.ml @@ -154,18 +154,6 @@ let WORD_2SMULH_NOSATURATE_32 = prove( [MATCH_MP_TAC DIV_MONO THEN ASM_ARITH_TAC; CONV_TAC NUM_REDUCE_CONV]);; -let WORD_ISHR_ROUND_18 = prove( - `!t:int32. val t < 2147483648 - ==> word_ishr_round t 18 = iword((&(val t) + &131072) div &262144)`, - GEN_TAC THEN DISCH_TAC THEN - REWRITE_TAC[word_ishr_round] THEN - CONV_TAC NUM_REDUCE_CONV THEN - CONV_TAC INT_REDUCE_CONV THEN - SUBGOAL_THEN `ival(t:int32) = &(val t)` SUBST1_TAC THENL - [SIMP_TAC[ival; DIMINDEX_32] THEN CONV_TAC NUM_REDUCE_CONV THEN - COND_CASES_TAC THEN ASM_ARITH_TAC; - REFL_TAC]);; - let VAL_DECOMPOSE_A1 = prove( `!a:int32. val a < 8380417 ==> val(word_ishr_round (word_2smulh a (word 1074791425:int32)) 18 : int32) @@ -270,98 +258,10 @@ let A0_UPPER_32 = prove( [CONV_TAC NUM_REDUCE_CONV THEN ASM_ARITH_TAC; ALL_TAC] THEN ASM_ARITH_TAC);; -let SPEC_NOWRAP_32 = prove( - `!a h. a <= 8118528 - ==> mldsa_use_hint_32_spec a h = - (let nv = ((a + 127) DIV 128 * 1025 + 2097152) DIV 4194304 in - if h = 0 then nv - else if int_gt (&a - &nv * &523776) (&0) - then (nv + 1) MOD 16 - else (nv + 15) MOD 16)`, - REPEAT GEN_TAC THEN DISCH_TAC THEN - REWRITE_TAC[mldsa_use_hint_32_spec] THEN - CONV_TAC(TOP_DEPTH_CONV let_CONV) THEN - ABBREV_TAC `nv = ((a + 127) DIV 128 * 1025 + 2097152) DIV 4194304` THEN - SUBGOAL_THEN `nv MOD 16 = nv` SUBST1_TAC THENL - [MATCH_MP_TAC MOD_LT THEN MP_TAC(SPEC `a:num` A1_BOUND_NOWRAP) THEN - ASM_REWRITE_TAC[] THEN EXPAND_TAC "nv" THEN ARITH_TAC; ALL_TAC] THEN - SUBGOAL_THEN `~(int_gt (&a - &nv * &523776) (&4190208))` ASSUME_TAC THENL - [REWRITE_TAC[INT_GT; INT_NOT_LT] THEN - MP_TAC(REWRITE_RULE[GSYM INT_OF_NUM_LT; GSYM INT_OF_NUM_MUL; - GSYM INT_OF_NUM_ADD] (SPEC `a:num` A0_UPPER_32)) THEN - ASM_REWRITE_TAC[] THEN EXPAND_TAC "nv" THEN INT_ARITH_TAC; ALL_TAC] THEN - ASM_REWRITE_TAC[] THEN - REPEAT(COND_CASES_TAC THEN ASM_REWRITE_TAC[]) THEN - POP_ASSUM(fun p -> POP_ASSUM(fun np -> - CONTR_TAC(EQ_MP (EQF_INTRO np) p))));; - -let HINT_H1_POS = prove( - `!a1:int32. val a1 <= 15 - ==> val(word_and (word_add a1 (word 1:int32)) (word 15:int32)) = (val a1 + 1) MOD 16`, - GEN_TAC THEN DISCH_TAC THEN - REWRITE_TAC[VAL_WORD_AND_15_32; VAL_WORD_ADD; VAL_WORD; DIMINDEX_32] THEN - CONV_TAC NUM_REDUCE_CONV THEN REWRITE_TAC[MOD_MOD_REFL] THEN - AP_THM_TAC THEN AP_TERM_TAC THEN MATCH_MP_TAC MOD_LT THEN ASM_ARITH_TAC);; - -let HINT_H1_NEG = prove( - `!a1:int32. val a1 <= 15 - ==> val(word_and (word_add a1 (word 4294967295:int32)) (word 15:int32)) = (val a1 + 15) MOD 16`, - GEN_TAC THEN DISCH_TAC THEN - REWRITE_TAC[VAL_WORD_AND_15_32; VAL_WORD_ADD; VAL_WORD; DIMINDEX_32] THEN - CONV_TAC NUM_REDUCE_CONV THEN - REWRITE_TAC[ARITH_RULE `4294967296 = 2 EXP 32`; ARITH_RULE `16 = 2 EXP 4`] THEN - REWRITE_TAC[MOD_MOD_EXP_MIN] THEN CONV_TAC NUM_REDUCE_CONV THEN - REWRITE_TAC[ARITH_RULE `4294967295 = 15 + 268435455 * 16`; GSYM ADD_ASSOC] THEN - REWRITE_TAC[ARITH_RULE `a + 15 + 268435455 * 16 = (a + 15) + 268435455 * 16`] THEN - SIMP_TAC[MOD_MULT_ADD]);; - let WORD_SUB_SIGN_32 = BITBLAST_RULE `!a:int32 b:int32. val b <= 7856640 /\ val a <= 8118528 ==> ((bit 31 (word_sub a b) \/ word_sub a b = word 0) <=> val a <= val b)`;; -let WORD_AND_ONES_32 = prove( - `!x:int32. word_and x (word 4294967295) = x`, - GEN_TAC THEN - SUBGOAL_THEN `(word 4294967295 : int32) = word_not(word 0)` SUBST1_TAC THENL - [CONV_TAC WORD_REDUCE_CONV; REWRITE_TAC[WORD_AND_NOT0]]);; - -let WORD_MUL_1_32 = prove( - `!x:int32. word_mul x (word 1) = x`, - GEN_TAC THEN REWRITE_TAC[GSYM VAL_EQ; VAL_WORD_MUL; VAL_WORD; DIMINDEX_32] THEN - CONV_TAC NUM_REDUCE_CONV THEN REWRITE_TAC[MULT_CLAUSES] THEN - MATCH_MP_TAC MOD_LT THEN MP_TAC(ISPEC `x:int32` VAL_BOUND) THEN - REWRITE_TAC[DIMINDEX_32] THEN CONV_TAC NUM_REDUCE_CONV);; - -let WORD_OR_NEG1_32 = prove( - `!x:int32. word_or (word_neg(word 1)) x = word_neg(word 1)`, - GEN_TAC THEN - SUBGOAL_THEN `word_neg(word 1:int32) = word_not(word 0)` SUBST1_TAC THENL - [CONV_TAC WORD_REDUCE_CONV; REWRITE_TAC[WORD_OR_NOT0]]);; - -let WORD_NEG1_VAL_32 = WORD_REDUCE_CONV `word_neg(word 1 : int32)`;; - -let REAL_INT_GT_BRIDGE = prove( - `!a:num b c. a <= b * c - ==> ~(real_gt (&a - &b * &c) (&0)) /\ ~(int_gt (&a - &b * &c) (&0))`, - REPEAT GEN_TAC THEN DISCH_TAC THEN CONJ_TAC THENL - [REWRITE_TAC[real_gt; REAL_NOT_LT] THEN - MP_TAC(REWRITE_RULE[GSYM REAL_OF_NUM_LE; GSYM REAL_OF_NUM_MUL] - (ASSUME `a <= b * c`)) THEN REAL_ARITH_TAC; - REWRITE_TAC[INT_GT; INT_NOT_LT] THEN - MP_TAC(REWRITE_RULE[GSYM INT_OF_NUM_LE; GSYM INT_OF_NUM_MUL] - (ASSUME `a <= b * c`)) THEN INT_ARITH_TAC]);; - -let REAL_INT_GT_BRIDGE_POS = prove( - `!a:num b c. ~(a <= b * c) - ==> real_gt (&a - &b * &c) (&0) /\ int_gt (&a - &b * &c) (&0)`, - REPEAT GEN_TAC THEN REWRITE_TAC[NOT_LE] THEN DISCH_TAC THEN CONJ_TAC THENL - [REWRITE_TAC[real_gt] THEN - MP_TAC(REWRITE_RULE[GSYM REAL_OF_NUM_LT; GSYM REAL_OF_NUM_MUL] - (ASSUME `b * c < a`)) THEN REAL_ARITH_TAC; - REWRITE_TAC[INT_GT] THEN - MP_TAC(REWRITE_RULE[GSYM INT_OF_NUM_LT; GSYM INT_OF_NUM_MUL] - (ASSUME `b * c < a`)) THEN INT_ARITH_TAC]);; - let WRAP_A0_NEGATIVE = BITBLAST_RULE `!a:int32. val a < 8380417 /\ val a > 8118528 ==> bit 31 (word_add (word_sub a (word 8380416:int32)) (word 4294967295:int32))`;; @@ -804,17 +704,6 @@ let BARRETT_EQUIV = prove( (* Element-level functional correctness *) (* ========================================================================= *) -let SPEC_BOUND = prove( - `!a h. a < 8380417 /\ h <= 1 - ==> mldsa_use_hint_32_spec a h <= 15`, - REPEAT GEN_TAC THEN STRIP_TAC THEN - REWRITE_TAC[mldsa_use_hint_32_spec; LET_DEF; LET_END_DEF] THEN - MP_TAC(SPEC `a:num` A1_BOUND) THEN ASM_REWRITE_TAC[] THEN DISCH_TAC THEN - REPEAT(COND_CASES_TAC THEN ASM_REWRITE_TAC[]) THEN - TRY(MATCH_MP_TAC(ARITH_RULE `x MOD 16 < 16 ==> x MOD 16 <= 15`) THEN - REWRITE_TAC[MOD_LT_EQ] THEN ARITH_TAC) THEN - ASM_ARITH_TAC);; - let ELEMENT_CORRECT = prove( `!a:int32 h:int32. val a < 8380417 /\ val h <= 1 diff --git a/common/mlkem_mldsa.ml b/common/mlkem_mldsa.ml index a3f04b4f4..98275f600 100644 --- a/common/mlkem_mldsa.ml +++ b/common/mlkem_mldsa.ml @@ -1963,3 +1963,37 @@ let WORD_ILE_ZERO_32 = BITBLAST_RULE (* val(word_and x (word 15)) = val x MOD 16 *) let VAL_WORD_AND_15_32 = BITBLAST_RULE `!x:int32. val(word_and x (word 15:int32)) = val x MOD 16`;; + +(* word_and x all-ones = x *) +let WORD_AND_ONES_32 = prove( + `!x:int32. word_and x (word 4294967295) = x`, + GEN_TAC THEN SUBGOAL_THEN `(word 4294967295 : int32) = word_not(word 0)` SUBST1_TAC THENL + [CONV_TAC WORD_REDUCE_CONV; REWRITE_TAC[WORD_AND_NOT0]]);; + +(* word_mul x 1 = x *) +let WORD_MUL_1_32 = prove( + `!x:int32. word_mul x (word 1) = x`, + GEN_TAC THEN REWRITE_TAC[GSYM VAL_EQ; VAL_WORD_MUL; VAL_WORD; DIMINDEX_32] THEN + CONV_TAC NUM_REDUCE_CONV THEN REWRITE_TAC[MULT_CLAUSES] THEN + MATCH_MP_TAC MOD_LT THEN MP_TAC(ISPEC `x:int32` VAL_BOUND) THEN + REWRITE_TAC[DIMINDEX_32] THEN CONV_TAC NUM_REDUCE_CONV);; + +(* Bridge lemmas: derive both real_gt and int_gt from a single NUM fact. + Needed for native mode where real_gt and int_gt are distinct types. *) +let REAL_INT_GT_BRIDGE = prove( + `!a:num b c. a <= b * c ==> + ~(real_gt (&a - &b * &c) (&0)) /\ ~(int_gt (&a - &b * &c) (&0))`, + REPEAT GEN_TAC THEN DISCH_TAC THEN CONJ_TAC THENL + [REWRITE_TAC[real_gt; REAL_NOT_LT] THEN + MP_TAC(REWRITE_RULE[GSYM REAL_OF_NUM_LE; GSYM REAL_OF_NUM_MUL] (ASSUME `a <= b * c`)) THEN REAL_ARITH_TAC; + REWRITE_TAC[INT_GT; INT_NOT_LT] THEN + MP_TAC(REWRITE_RULE[GSYM INT_OF_NUM_LE; GSYM INT_OF_NUM_MUL] (ASSUME `a <= b * c`)) THEN INT_ARITH_TAC]);; + +let REAL_INT_GT_BRIDGE_POS = prove( + `!a:num b c. ~(a <= b * c) ==> + real_gt (&a - &b * &c) (&0) /\ int_gt (&a - &b * &c) (&0)`, + REPEAT GEN_TAC THEN REWRITE_TAC[NOT_LE] THEN DISCH_TAC THEN CONJ_TAC THENL + [REWRITE_TAC[real_gt] THEN + MP_TAC(REWRITE_RULE[GSYM REAL_OF_NUM_LT; GSYM REAL_OF_NUM_MUL] (ASSUME `b * c < a`)) THEN REAL_ARITH_TAC; + REWRITE_TAC[INT_GT] THEN + MP_TAC(REWRITE_RULE[GSYM INT_OF_NUM_LT; GSYM INT_OF_NUM_MUL] (ASSUME `b * c < a`)) THEN INT_ARITH_TAC]);; From 6a10f528d8947df48ebe8938c0bc1c4f10fdedde Mon Sep 17 00:00:00 2001 From: Jake Massimo Date: Fri, 24 Apr 2026 17:34:28 +0000 Subject: [PATCH 05/11] Optimize Barrett equivalence proof with general interval lemma Replace the 428-line case-split Barrett proof with a general DIV_SANDWICH + BARRETT_INTERVAL lemma approach. The general lemma proves that if both formulas are sandwiched in [k*d, (k+1)*d) for a given interval, then both equal k. The proof cascades through the 17-entry interval table, discharging numeric side conditions with NUM_REDUCE_CONV. Signed-off-by: Jake Massimo --- arm/proofs/mldsa_poly_use_hint_32.ml | 486 ++++----------------------- 1 file changed, 63 insertions(+), 423 deletions(-) diff --git a/arm/proofs/mldsa_poly_use_hint_32.ml b/arm/proofs/mldsa_poly_use_hint_32.ml index ad7ef04cd..1b60eaccc 100644 --- a/arm/proofs/mldsa_poly_use_hint_32.ml +++ b/arm/proofs/mldsa_poly_use_hint_32.ml @@ -270,434 +270,74 @@ let WRAP_A0_NEGATIVE = BITBLAST_RULE Both compute round_half_down(a / 523776) via different Barrett approximation paths. Proved by case analysis on 17 output intervals using DIV_MONO to sandwich both LHS and RHS to the same constant. *) +let DIV_SANDWICH = prove( + `!x d k. ~(d = 0) /\ k * d <= x /\ x < (k + 1) * d ==> x DIV d = k`, + REPEAT GEN_TAC THEN STRIP_TAC THEN + SUBGOAL_THEN `k <= x DIV d` ASSUME_TAC THENL + [ASM_SIMP_TAC[LE_RDIV_EQ] THEN ASM_ARITH_TAC; ALL_TAC] THEN + SUBGOAL_THEN `x DIV d < k + 1` ASSUME_TAC THENL + [ASM_SIMP_TAC[RDIV_LT_EQ] THEN ASM_ARITH_TAC; ASM_ARITH_TAC]);; + +let BARRETT_INTERVAL_32 = prove( + `!a lo hi k. + lo <= a /\ a <= hi /\ + k * 262144 <= (2 * lo * 1074791425) DIV 4294967296 + 131072 /\ + (2 * hi * 1074791425) DIV 4294967296 + 131072 < (k + 1) * 262144 /\ + k * 4194304 <= (lo + 127) DIV 128 * 1025 + 2097152 /\ + (hi + 127) DIV 128 * 1025 + 2097152 < (k + 1) * 4194304 + ==> ((2 * a * 1074791425) DIV 4294967296 + 131072) DIV 262144 = k /\ + ((a + 127) DIV 128 * 1025 + 2097152) DIV 4194304 = k`, + REPEAT GEN_TAC THEN STRIP_TAC THEN + CONJ_TAC THEN MATCH_MP_TAC DIV_SANDWICH THEN CONV_TAC NUM_REDUCE_CONV THENL + [CONJ_TAC THENL + [TRANS_TAC LE_TRANS `(2 * lo * 1074791425) DIV 4294967296 + 131072` THEN + ASM_REWRITE_TAC[] THEN + REWRITE_TAC[ARITH_RULE `x + 131072 <= y + 131072 <=> x <= y`] THEN + MATCH_MP_TAC DIV_MONO THEN ASM_ARITH_TAC; + TRANS_TAC LET_TRANS `(2 * hi * 1074791425) DIV 4294967296 + 131072` THEN + ASM_REWRITE_TAC[] THEN + REWRITE_TAC[ARITH_RULE `x + 131072 <= y + 131072 <=> x <= y`] THEN + MATCH_MP_TAC DIV_MONO THEN ASM_ARITH_TAC]; + CONJ_TAC THENL + [TRANS_TAC LE_TRANS `(lo + 127) DIV 128 * 1025 + 2097152` THEN + ASM_REWRITE_TAC[] THEN + REWRITE_TAC[ARITH_RULE `x + 2097152 <= y + 2097152 <=> x <= y`] THEN + REWRITE_TAC[LE_MULT_RCANCEL] THEN DISJ1_TAC THEN + MATCH_MP_TAC DIV_MONO THEN ASM_ARITH_TAC; + TRANS_TAC LET_TRANS `(hi + 127) DIV 128 * 1025 + 2097152` THEN + ASM_REWRITE_TAC[] THEN + REWRITE_TAC[ARITH_RULE `x + 2097152 <= y + 2097152 <=> x <= y`] THEN + REWRITE_TAC[LE_MULT_RCANCEL] THEN DISJ1_TAC THEN + MATCH_MP_TAC DIV_MONO THEN ASM_ARITH_TAC]]);; + let BARRETT_EQUIV = prove( `!a. a < 8380417 ==> ((2 * a * 1074791425) DIV 4294967296 + 131072) DIV 262144 = ((a + 127) DIV 128 * 1025 + 2097152) DIV 4194304`, GEN_TAC THEN DISCH_TAC THEN - ASM_CASES_TAC `a <= 261888` THENL - [ - MP_TAC(SPEC `262144` (SPEC `(2 * 261888 * 1074791425) DIV 4294967296 + 131072` - (SPEC `(2 * a * 1074791425) DIV 4294967296 + 131072` DIV_MONO))) THEN - ANTS_TAC THENL [ASM_ARITH_TAC; CONV_TAC NUM_REDUCE_CONV THEN DISCH_TAC] THEN - MP_TAC(SPEC `262144` (SPEC `(2 * a * 1074791425) DIV 4294967296 + 131072` - (SPEC `(2 * 0 * 1074791425) DIV 4294967296 + 131072` DIV_MONO))) THEN - ANTS_TAC THENL [ASM_ARITH_TAC; CONV_TAC NUM_REDUCE_CONV THEN DISCH_TAC] THEN - MP_TAC(SPEC `128` (SPEC `261888 + 127` (SPEC `a + 127` DIV_MONO))) THEN - ANTS_TAC THENL [ASM_ARITH_TAC; CONV_TAC NUM_REDUCE_CONV THEN DISCH_TAC] THEN - MP_TAC(SPEC `128` (SPEC `a + 127` (SPEC `0 + 127` DIV_MONO))) THEN - ANTS_TAC THENL [ASM_ARITH_TAC; CONV_TAC NUM_REDUCE_CONV THEN DISCH_TAC] THEN - ABBREV_TAC `qq0 = (a + 127) DIV 128` THEN - SUBGOAL_THEN `qq0 * 1025 <= 2046 * 1025` ASSUME_TAC THENL - [ASM_SIMP_TAC[LE_MULT_RCANCEL]; ALL_TAC] THEN - SUBGOAL_THEN `0 * 1025 <= qq0 * 1025` ASSUME_TAC THENL - [ASM_SIMP_TAC[LE_MULT_RCANCEL]; ALL_TAC] THEN - MP_TAC(SPEC `4194304` (SPEC `2046 * 1025 + 2097152` - (SPEC `qq0 * 1025 + 2097152` DIV_MONO))) THEN - ANTS_TAC THENL [ASM_ARITH_TAC; CONV_TAC NUM_REDUCE_CONV THEN DISCH_TAC] THEN - MP_TAC(SPEC `4194304` (SPEC `qq0 * 1025 + 2097152` - (SPEC `0 * 1025 + 2097152` DIV_MONO))) THEN - ANTS_TAC THENL [ASM_ARITH_TAC; CONV_TAC NUM_REDUCE_CONV THEN DISCH_TAC] THEN - ASM_ARITH_TAC - ; - ASM_CASES_TAC `a <= 785664` THENL - [ - MP_TAC(SPEC `262144` (SPEC `(2 * 785664 * 1074791425) DIV 4294967296 + 131072` - (SPEC `(2 * a * 1074791425) DIV 4294967296 + 131072` DIV_MONO))) THEN - ANTS_TAC THENL [ASM_ARITH_TAC; CONV_TAC NUM_REDUCE_CONV THEN DISCH_TAC] THEN - MP_TAC(SPEC `262144` (SPEC `(2 * a * 1074791425) DIV 4294967296 + 131072` - (SPEC `(2 * 261889 * 1074791425) DIV 4294967296 + 131072` DIV_MONO))) THEN - ANTS_TAC THENL [ASM_ARITH_TAC; CONV_TAC NUM_REDUCE_CONV THEN DISCH_TAC] THEN - MP_TAC(SPEC `128` (SPEC `785664 + 127` (SPEC `a + 127` DIV_MONO))) THEN - ANTS_TAC THENL [ASM_ARITH_TAC; CONV_TAC NUM_REDUCE_CONV THEN DISCH_TAC] THEN - MP_TAC(SPEC `128` (SPEC `a + 127` (SPEC `261889 + 127` DIV_MONO))) THEN - ANTS_TAC THENL [ASM_ARITH_TAC; CONV_TAC NUM_REDUCE_CONV THEN DISCH_TAC] THEN - ABBREV_TAC `qq1 = (a + 127) DIV 128` THEN - SUBGOAL_THEN `qq1 * 1025 <= 6138 * 1025` ASSUME_TAC THENL - [ASM_SIMP_TAC[LE_MULT_RCANCEL]; ALL_TAC] THEN - SUBGOAL_THEN `2047 * 1025 <= qq1 * 1025` ASSUME_TAC THENL - [ASM_SIMP_TAC[LE_MULT_RCANCEL]; ALL_TAC] THEN - MP_TAC(SPEC `4194304` (SPEC `6138 * 1025 + 2097152` - (SPEC `qq1 * 1025 + 2097152` DIV_MONO))) THEN - ANTS_TAC THENL [ASM_ARITH_TAC; CONV_TAC NUM_REDUCE_CONV THEN DISCH_TAC] THEN - MP_TAC(SPEC `4194304` (SPEC `qq1 * 1025 + 2097152` - (SPEC `2047 * 1025 + 2097152` DIV_MONO))) THEN - ANTS_TAC THENL [ASM_ARITH_TAC; CONV_TAC NUM_REDUCE_CONV THEN DISCH_TAC] THEN - ASM_ARITH_TAC - ; - ASM_CASES_TAC `a <= 1309440` THENL - [ - MP_TAC(SPEC `262144` (SPEC `(2 * 1309440 * 1074791425) DIV 4294967296 + 131072` - (SPEC `(2 * a * 1074791425) DIV 4294967296 + 131072` DIV_MONO))) THEN - ANTS_TAC THENL [ASM_ARITH_TAC; CONV_TAC NUM_REDUCE_CONV THEN DISCH_TAC] THEN - MP_TAC(SPEC `262144` (SPEC `(2 * a * 1074791425) DIV 4294967296 + 131072` - (SPEC `(2 * 785665 * 1074791425) DIV 4294967296 + 131072` DIV_MONO))) THEN - ANTS_TAC THENL [ASM_ARITH_TAC; CONV_TAC NUM_REDUCE_CONV THEN DISCH_TAC] THEN - MP_TAC(SPEC `128` (SPEC `1309440 + 127` (SPEC `a + 127` DIV_MONO))) THEN - ANTS_TAC THENL [ASM_ARITH_TAC; CONV_TAC NUM_REDUCE_CONV THEN DISCH_TAC] THEN - MP_TAC(SPEC `128` (SPEC `a + 127` (SPEC `785665 + 127` DIV_MONO))) THEN - ANTS_TAC THENL [ASM_ARITH_TAC; CONV_TAC NUM_REDUCE_CONV THEN DISCH_TAC] THEN - ABBREV_TAC `qq2 = (a + 127) DIV 128` THEN - SUBGOAL_THEN `qq2 * 1025 <= 10230 * 1025` ASSUME_TAC THENL - [ASM_SIMP_TAC[LE_MULT_RCANCEL]; ALL_TAC] THEN - SUBGOAL_THEN `6139 * 1025 <= qq2 * 1025` ASSUME_TAC THENL - [ASM_SIMP_TAC[LE_MULT_RCANCEL]; ALL_TAC] THEN - MP_TAC(SPEC `4194304` (SPEC `10230 * 1025 + 2097152` - (SPEC `qq2 * 1025 + 2097152` DIV_MONO))) THEN - ANTS_TAC THENL [ASM_ARITH_TAC; CONV_TAC NUM_REDUCE_CONV THEN DISCH_TAC] THEN - MP_TAC(SPEC `4194304` (SPEC `qq2 * 1025 + 2097152` - (SPEC `6139 * 1025 + 2097152` DIV_MONO))) THEN - ANTS_TAC THENL [ASM_ARITH_TAC; CONV_TAC NUM_REDUCE_CONV THEN DISCH_TAC] THEN - ASM_ARITH_TAC - ; - ASM_CASES_TAC `a <= 1833216` THENL - [ - MP_TAC(SPEC `262144` (SPEC `(2 * 1833216 * 1074791425) DIV 4294967296 + 131072` - (SPEC `(2 * a * 1074791425) DIV 4294967296 + 131072` DIV_MONO))) THEN - ANTS_TAC THENL [ASM_ARITH_TAC; CONV_TAC NUM_REDUCE_CONV THEN DISCH_TAC] THEN - MP_TAC(SPEC `262144` (SPEC `(2 * a * 1074791425) DIV 4294967296 + 131072` - (SPEC `(2 * 1309441 * 1074791425) DIV 4294967296 + 131072` DIV_MONO))) THEN - ANTS_TAC THENL [ASM_ARITH_TAC; CONV_TAC NUM_REDUCE_CONV THEN DISCH_TAC] THEN - MP_TAC(SPEC `128` (SPEC `1833216 + 127` (SPEC `a + 127` DIV_MONO))) THEN - ANTS_TAC THENL [ASM_ARITH_TAC; CONV_TAC NUM_REDUCE_CONV THEN DISCH_TAC] THEN - MP_TAC(SPEC `128` (SPEC `a + 127` (SPEC `1309441 + 127` DIV_MONO))) THEN - ANTS_TAC THENL [ASM_ARITH_TAC; CONV_TAC NUM_REDUCE_CONV THEN DISCH_TAC] THEN - ABBREV_TAC `qq3 = (a + 127) DIV 128` THEN - SUBGOAL_THEN `qq3 * 1025 <= 14322 * 1025` ASSUME_TAC THENL - [ASM_SIMP_TAC[LE_MULT_RCANCEL]; ALL_TAC] THEN - SUBGOAL_THEN `10231 * 1025 <= qq3 * 1025` ASSUME_TAC THENL - [ASM_SIMP_TAC[LE_MULT_RCANCEL]; ALL_TAC] THEN - MP_TAC(SPEC `4194304` (SPEC `14322 * 1025 + 2097152` - (SPEC `qq3 * 1025 + 2097152` DIV_MONO))) THEN - ANTS_TAC THENL [ASM_ARITH_TAC; CONV_TAC NUM_REDUCE_CONV THEN DISCH_TAC] THEN - MP_TAC(SPEC `4194304` (SPEC `qq3 * 1025 + 2097152` - (SPEC `10231 * 1025 + 2097152` DIV_MONO))) THEN - ANTS_TAC THENL [ASM_ARITH_TAC; CONV_TAC NUM_REDUCE_CONV THEN DISCH_TAC] THEN - ASM_ARITH_TAC - ; - ASM_CASES_TAC `a <= 2356992` THENL - [ - MP_TAC(SPEC `262144` (SPEC `(2 * 2356992 * 1074791425) DIV 4294967296 + 131072` - (SPEC `(2 * a * 1074791425) DIV 4294967296 + 131072` DIV_MONO))) THEN - ANTS_TAC THENL [ASM_ARITH_TAC; CONV_TAC NUM_REDUCE_CONV THEN DISCH_TAC] THEN - MP_TAC(SPEC `262144` (SPEC `(2 * a * 1074791425) DIV 4294967296 + 131072` - (SPEC `(2 * 1833217 * 1074791425) DIV 4294967296 + 131072` DIV_MONO))) THEN - ANTS_TAC THENL [ASM_ARITH_TAC; CONV_TAC NUM_REDUCE_CONV THEN DISCH_TAC] THEN - MP_TAC(SPEC `128` (SPEC `2356992 + 127` (SPEC `a + 127` DIV_MONO))) THEN - ANTS_TAC THENL [ASM_ARITH_TAC; CONV_TAC NUM_REDUCE_CONV THEN DISCH_TAC] THEN - MP_TAC(SPEC `128` (SPEC `a + 127` (SPEC `1833217 + 127` DIV_MONO))) THEN - ANTS_TAC THENL [ASM_ARITH_TAC; CONV_TAC NUM_REDUCE_CONV THEN DISCH_TAC] THEN - ABBREV_TAC `qq4 = (a + 127) DIV 128` THEN - SUBGOAL_THEN `qq4 * 1025 <= 18414 * 1025` ASSUME_TAC THENL - [ASM_SIMP_TAC[LE_MULT_RCANCEL]; ALL_TAC] THEN - SUBGOAL_THEN `14323 * 1025 <= qq4 * 1025` ASSUME_TAC THENL - [ASM_SIMP_TAC[LE_MULT_RCANCEL]; ALL_TAC] THEN - MP_TAC(SPEC `4194304` (SPEC `18414 * 1025 + 2097152` - (SPEC `qq4 * 1025 + 2097152` DIV_MONO))) THEN - ANTS_TAC THENL [ASM_ARITH_TAC; CONV_TAC NUM_REDUCE_CONV THEN DISCH_TAC] THEN - MP_TAC(SPEC `4194304` (SPEC `qq4 * 1025 + 2097152` - (SPEC `14323 * 1025 + 2097152` DIV_MONO))) THEN - ANTS_TAC THENL [ASM_ARITH_TAC; CONV_TAC NUM_REDUCE_CONV THEN DISCH_TAC] THEN - ASM_ARITH_TAC - ; - ASM_CASES_TAC `a <= 2880768` THENL - [ - MP_TAC(SPEC `262144` (SPEC `(2 * 2880768 * 1074791425) DIV 4294967296 + 131072` - (SPEC `(2 * a * 1074791425) DIV 4294967296 + 131072` DIV_MONO))) THEN - ANTS_TAC THENL [ASM_ARITH_TAC; CONV_TAC NUM_REDUCE_CONV THEN DISCH_TAC] THEN - MP_TAC(SPEC `262144` (SPEC `(2 * a * 1074791425) DIV 4294967296 + 131072` - (SPEC `(2 * 2356993 * 1074791425) DIV 4294967296 + 131072` DIV_MONO))) THEN - ANTS_TAC THENL [ASM_ARITH_TAC; CONV_TAC NUM_REDUCE_CONV THEN DISCH_TAC] THEN - MP_TAC(SPEC `128` (SPEC `2880768 + 127` (SPEC `a + 127` DIV_MONO))) THEN - ANTS_TAC THENL [ASM_ARITH_TAC; CONV_TAC NUM_REDUCE_CONV THEN DISCH_TAC] THEN - MP_TAC(SPEC `128` (SPEC `a + 127` (SPEC `2356993 + 127` DIV_MONO))) THEN - ANTS_TAC THENL [ASM_ARITH_TAC; CONV_TAC NUM_REDUCE_CONV THEN DISCH_TAC] THEN - ABBREV_TAC `qq5 = (a + 127) DIV 128` THEN - SUBGOAL_THEN `qq5 * 1025 <= 22506 * 1025` ASSUME_TAC THENL - [ASM_SIMP_TAC[LE_MULT_RCANCEL]; ALL_TAC] THEN - SUBGOAL_THEN `18415 * 1025 <= qq5 * 1025` ASSUME_TAC THENL - [ASM_SIMP_TAC[LE_MULT_RCANCEL]; ALL_TAC] THEN - MP_TAC(SPEC `4194304` (SPEC `22506 * 1025 + 2097152` - (SPEC `qq5 * 1025 + 2097152` DIV_MONO))) THEN - ANTS_TAC THENL [ASM_ARITH_TAC; CONV_TAC NUM_REDUCE_CONV THEN DISCH_TAC] THEN - MP_TAC(SPEC `4194304` (SPEC `qq5 * 1025 + 2097152` - (SPEC `18415 * 1025 + 2097152` DIV_MONO))) THEN - ANTS_TAC THENL [ASM_ARITH_TAC; CONV_TAC NUM_REDUCE_CONV THEN DISCH_TAC] THEN - ASM_ARITH_TAC - ; - ASM_CASES_TAC `a <= 3404544` THENL - [ - MP_TAC(SPEC `262144` (SPEC `(2 * 3404544 * 1074791425) DIV 4294967296 + 131072` - (SPEC `(2 * a * 1074791425) DIV 4294967296 + 131072` DIV_MONO))) THEN - ANTS_TAC THENL [ASM_ARITH_TAC; CONV_TAC NUM_REDUCE_CONV THEN DISCH_TAC] THEN - MP_TAC(SPEC `262144` (SPEC `(2 * a * 1074791425) DIV 4294967296 + 131072` - (SPEC `(2 * 2880769 * 1074791425) DIV 4294967296 + 131072` DIV_MONO))) THEN - ANTS_TAC THENL [ASM_ARITH_TAC; CONV_TAC NUM_REDUCE_CONV THEN DISCH_TAC] THEN - MP_TAC(SPEC `128` (SPEC `3404544 + 127` (SPEC `a + 127` DIV_MONO))) THEN - ANTS_TAC THENL [ASM_ARITH_TAC; CONV_TAC NUM_REDUCE_CONV THEN DISCH_TAC] THEN - MP_TAC(SPEC `128` (SPEC `a + 127` (SPEC `2880769 + 127` DIV_MONO))) THEN - ANTS_TAC THENL [ASM_ARITH_TAC; CONV_TAC NUM_REDUCE_CONV THEN DISCH_TAC] THEN - ABBREV_TAC `qq6 = (a + 127) DIV 128` THEN - SUBGOAL_THEN `qq6 * 1025 <= 26598 * 1025` ASSUME_TAC THENL - [ASM_SIMP_TAC[LE_MULT_RCANCEL]; ALL_TAC] THEN - SUBGOAL_THEN `22507 * 1025 <= qq6 * 1025` ASSUME_TAC THENL - [ASM_SIMP_TAC[LE_MULT_RCANCEL]; ALL_TAC] THEN - MP_TAC(SPEC `4194304` (SPEC `26598 * 1025 + 2097152` - (SPEC `qq6 * 1025 + 2097152` DIV_MONO))) THEN - ANTS_TAC THENL [ASM_ARITH_TAC; CONV_TAC NUM_REDUCE_CONV THEN DISCH_TAC] THEN - MP_TAC(SPEC `4194304` (SPEC `qq6 * 1025 + 2097152` - (SPEC `22507 * 1025 + 2097152` DIV_MONO))) THEN - ANTS_TAC THENL [ASM_ARITH_TAC; CONV_TAC NUM_REDUCE_CONV THEN DISCH_TAC] THEN - ASM_ARITH_TAC - ; - ASM_CASES_TAC `a <= 3928320` THENL - [ - MP_TAC(SPEC `262144` (SPEC `(2 * 3928320 * 1074791425) DIV 4294967296 + 131072` - (SPEC `(2 * a * 1074791425) DIV 4294967296 + 131072` DIV_MONO))) THEN - ANTS_TAC THENL [ASM_ARITH_TAC; CONV_TAC NUM_REDUCE_CONV THEN DISCH_TAC] THEN - MP_TAC(SPEC `262144` (SPEC `(2 * a * 1074791425) DIV 4294967296 + 131072` - (SPEC `(2 * 3404545 * 1074791425) DIV 4294967296 + 131072` DIV_MONO))) THEN - ANTS_TAC THENL [ASM_ARITH_TAC; CONV_TAC NUM_REDUCE_CONV THEN DISCH_TAC] THEN - MP_TAC(SPEC `128` (SPEC `3928320 + 127` (SPEC `a + 127` DIV_MONO))) THEN - ANTS_TAC THENL [ASM_ARITH_TAC; CONV_TAC NUM_REDUCE_CONV THEN DISCH_TAC] THEN - MP_TAC(SPEC `128` (SPEC `a + 127` (SPEC `3404545 + 127` DIV_MONO))) THEN - ANTS_TAC THENL [ASM_ARITH_TAC; CONV_TAC NUM_REDUCE_CONV THEN DISCH_TAC] THEN - ABBREV_TAC `qq7 = (a + 127) DIV 128` THEN - SUBGOAL_THEN `qq7 * 1025 <= 30690 * 1025` ASSUME_TAC THENL - [ASM_SIMP_TAC[LE_MULT_RCANCEL]; ALL_TAC] THEN - SUBGOAL_THEN `26599 * 1025 <= qq7 * 1025` ASSUME_TAC THENL - [ASM_SIMP_TAC[LE_MULT_RCANCEL]; ALL_TAC] THEN - MP_TAC(SPEC `4194304` (SPEC `30690 * 1025 + 2097152` - (SPEC `qq7 * 1025 + 2097152` DIV_MONO))) THEN - ANTS_TAC THENL [ASM_ARITH_TAC; CONV_TAC NUM_REDUCE_CONV THEN DISCH_TAC] THEN - MP_TAC(SPEC `4194304` (SPEC `qq7 * 1025 + 2097152` - (SPEC `26599 * 1025 + 2097152` DIV_MONO))) THEN - ANTS_TAC THENL [ASM_ARITH_TAC; CONV_TAC NUM_REDUCE_CONV THEN DISCH_TAC] THEN - ASM_ARITH_TAC - ; - ASM_CASES_TAC `a <= 4452096` THENL - [ - MP_TAC(SPEC `262144` (SPEC `(2 * 4452096 * 1074791425) DIV 4294967296 + 131072` - (SPEC `(2 * a * 1074791425) DIV 4294967296 + 131072` DIV_MONO))) THEN - ANTS_TAC THENL [ASM_ARITH_TAC; CONV_TAC NUM_REDUCE_CONV THEN DISCH_TAC] THEN - MP_TAC(SPEC `262144` (SPEC `(2 * a * 1074791425) DIV 4294967296 + 131072` - (SPEC `(2 * 3928321 * 1074791425) DIV 4294967296 + 131072` DIV_MONO))) THEN - ANTS_TAC THENL [ASM_ARITH_TAC; CONV_TAC NUM_REDUCE_CONV THEN DISCH_TAC] THEN - MP_TAC(SPEC `128` (SPEC `4452096 + 127` (SPEC `a + 127` DIV_MONO))) THEN - ANTS_TAC THENL [ASM_ARITH_TAC; CONV_TAC NUM_REDUCE_CONV THEN DISCH_TAC] THEN - MP_TAC(SPEC `128` (SPEC `a + 127` (SPEC `3928321 + 127` DIV_MONO))) THEN - ANTS_TAC THENL [ASM_ARITH_TAC; CONV_TAC NUM_REDUCE_CONV THEN DISCH_TAC] THEN - ABBREV_TAC `qq8 = (a + 127) DIV 128` THEN - SUBGOAL_THEN `qq8 * 1025 <= 34782 * 1025` ASSUME_TAC THENL - [ASM_SIMP_TAC[LE_MULT_RCANCEL]; ALL_TAC] THEN - SUBGOAL_THEN `30691 * 1025 <= qq8 * 1025` ASSUME_TAC THENL - [ASM_SIMP_TAC[LE_MULT_RCANCEL]; ALL_TAC] THEN - MP_TAC(SPEC `4194304` (SPEC `34782 * 1025 + 2097152` - (SPEC `qq8 * 1025 + 2097152` DIV_MONO))) THEN - ANTS_TAC THENL [ASM_ARITH_TAC; CONV_TAC NUM_REDUCE_CONV THEN DISCH_TAC] THEN - MP_TAC(SPEC `4194304` (SPEC `qq8 * 1025 + 2097152` - (SPEC `30691 * 1025 + 2097152` DIV_MONO))) THEN - ANTS_TAC THENL [ASM_ARITH_TAC; CONV_TAC NUM_REDUCE_CONV THEN DISCH_TAC] THEN - ASM_ARITH_TAC - ; - ASM_CASES_TAC `a <= 4975872` THENL - [ - MP_TAC(SPEC `262144` (SPEC `(2 * 4975872 * 1074791425) DIV 4294967296 + 131072` - (SPEC `(2 * a * 1074791425) DIV 4294967296 + 131072` DIV_MONO))) THEN - ANTS_TAC THENL [ASM_ARITH_TAC; CONV_TAC NUM_REDUCE_CONV THEN DISCH_TAC] THEN - MP_TAC(SPEC `262144` (SPEC `(2 * a * 1074791425) DIV 4294967296 + 131072` - (SPEC `(2 * 4452097 * 1074791425) DIV 4294967296 + 131072` DIV_MONO))) THEN - ANTS_TAC THENL [ASM_ARITH_TAC; CONV_TAC NUM_REDUCE_CONV THEN DISCH_TAC] THEN - MP_TAC(SPEC `128` (SPEC `4975872 + 127` (SPEC `a + 127` DIV_MONO))) THEN - ANTS_TAC THENL [ASM_ARITH_TAC; CONV_TAC NUM_REDUCE_CONV THEN DISCH_TAC] THEN - MP_TAC(SPEC `128` (SPEC `a + 127` (SPEC `4452097 + 127` DIV_MONO))) THEN - ANTS_TAC THENL [ASM_ARITH_TAC; CONV_TAC NUM_REDUCE_CONV THEN DISCH_TAC] THEN - ABBREV_TAC `qq9 = (a + 127) DIV 128` THEN - SUBGOAL_THEN `qq9 * 1025 <= 38874 * 1025` ASSUME_TAC THENL - [ASM_SIMP_TAC[LE_MULT_RCANCEL]; ALL_TAC] THEN - SUBGOAL_THEN `34783 * 1025 <= qq9 * 1025` ASSUME_TAC THENL - [ASM_SIMP_TAC[LE_MULT_RCANCEL]; ALL_TAC] THEN - MP_TAC(SPEC `4194304` (SPEC `38874 * 1025 + 2097152` - (SPEC `qq9 * 1025 + 2097152` DIV_MONO))) THEN - ANTS_TAC THENL [ASM_ARITH_TAC; CONV_TAC NUM_REDUCE_CONV THEN DISCH_TAC] THEN - MP_TAC(SPEC `4194304` (SPEC `qq9 * 1025 + 2097152` - (SPEC `34783 * 1025 + 2097152` DIV_MONO))) THEN - ANTS_TAC THENL [ASM_ARITH_TAC; CONV_TAC NUM_REDUCE_CONV THEN DISCH_TAC] THEN - ASM_ARITH_TAC - ; - ASM_CASES_TAC `a <= 5499648` THENL - [ - MP_TAC(SPEC `262144` (SPEC `(2 * 5499648 * 1074791425) DIV 4294967296 + 131072` - (SPEC `(2 * a * 1074791425) DIV 4294967296 + 131072` DIV_MONO))) THEN - ANTS_TAC THENL [ASM_ARITH_TAC; CONV_TAC NUM_REDUCE_CONV THEN DISCH_TAC] THEN - MP_TAC(SPEC `262144` (SPEC `(2 * a * 1074791425) DIV 4294967296 + 131072` - (SPEC `(2 * 4975873 * 1074791425) DIV 4294967296 + 131072` DIV_MONO))) THEN - ANTS_TAC THENL [ASM_ARITH_TAC; CONV_TAC NUM_REDUCE_CONV THEN DISCH_TAC] THEN - MP_TAC(SPEC `128` (SPEC `5499648 + 127` (SPEC `a + 127` DIV_MONO))) THEN - ANTS_TAC THENL [ASM_ARITH_TAC; CONV_TAC NUM_REDUCE_CONV THEN DISCH_TAC] THEN - MP_TAC(SPEC `128` (SPEC `a + 127` (SPEC `4975873 + 127` DIV_MONO))) THEN - ANTS_TAC THENL [ASM_ARITH_TAC; CONV_TAC NUM_REDUCE_CONV THEN DISCH_TAC] THEN - ABBREV_TAC `qq10 = (a + 127) DIV 128` THEN - SUBGOAL_THEN `qq10 * 1025 <= 42966 * 1025` ASSUME_TAC THENL - [ASM_SIMP_TAC[LE_MULT_RCANCEL]; ALL_TAC] THEN - SUBGOAL_THEN `38875 * 1025 <= qq10 * 1025` ASSUME_TAC THENL - [ASM_SIMP_TAC[LE_MULT_RCANCEL]; ALL_TAC] THEN - MP_TAC(SPEC `4194304` (SPEC `42966 * 1025 + 2097152` - (SPEC `qq10 * 1025 + 2097152` DIV_MONO))) THEN - ANTS_TAC THENL [ASM_ARITH_TAC; CONV_TAC NUM_REDUCE_CONV THEN DISCH_TAC] THEN - MP_TAC(SPEC `4194304` (SPEC `qq10 * 1025 + 2097152` - (SPEC `38875 * 1025 + 2097152` DIV_MONO))) THEN - ANTS_TAC THENL [ASM_ARITH_TAC; CONV_TAC NUM_REDUCE_CONV THEN DISCH_TAC] THEN - ASM_ARITH_TAC - ; - ASM_CASES_TAC `a <= 6023424` THENL - [ - MP_TAC(SPEC `262144` (SPEC `(2 * 6023424 * 1074791425) DIV 4294967296 + 131072` - (SPEC `(2 * a * 1074791425) DIV 4294967296 + 131072` DIV_MONO))) THEN - ANTS_TAC THENL [ASM_ARITH_TAC; CONV_TAC NUM_REDUCE_CONV THEN DISCH_TAC] THEN - MP_TAC(SPEC `262144` (SPEC `(2 * a * 1074791425) DIV 4294967296 + 131072` - (SPEC `(2 * 5499649 * 1074791425) DIV 4294967296 + 131072` DIV_MONO))) THEN - ANTS_TAC THENL [ASM_ARITH_TAC; CONV_TAC NUM_REDUCE_CONV THEN DISCH_TAC] THEN - MP_TAC(SPEC `128` (SPEC `6023424 + 127` (SPEC `a + 127` DIV_MONO))) THEN - ANTS_TAC THENL [ASM_ARITH_TAC; CONV_TAC NUM_REDUCE_CONV THEN DISCH_TAC] THEN - MP_TAC(SPEC `128` (SPEC `a + 127` (SPEC `5499649 + 127` DIV_MONO))) THEN - ANTS_TAC THENL [ASM_ARITH_TAC; CONV_TAC NUM_REDUCE_CONV THEN DISCH_TAC] THEN - ABBREV_TAC `qq11 = (a + 127) DIV 128` THEN - SUBGOAL_THEN `qq11 * 1025 <= 47058 * 1025` ASSUME_TAC THENL - [ASM_SIMP_TAC[LE_MULT_RCANCEL]; ALL_TAC] THEN - SUBGOAL_THEN `42967 * 1025 <= qq11 * 1025` ASSUME_TAC THENL - [ASM_SIMP_TAC[LE_MULT_RCANCEL]; ALL_TAC] THEN - MP_TAC(SPEC `4194304` (SPEC `47058 * 1025 + 2097152` - (SPEC `qq11 * 1025 + 2097152` DIV_MONO))) THEN - ANTS_TAC THENL [ASM_ARITH_TAC; CONV_TAC NUM_REDUCE_CONV THEN DISCH_TAC] THEN - MP_TAC(SPEC `4194304` (SPEC `qq11 * 1025 + 2097152` - (SPEC `42967 * 1025 + 2097152` DIV_MONO))) THEN - ANTS_TAC THENL [ASM_ARITH_TAC; CONV_TAC NUM_REDUCE_CONV THEN DISCH_TAC] THEN - ASM_ARITH_TAC - ; - ASM_CASES_TAC `a <= 6547200` THENL - [ - MP_TAC(SPEC `262144` (SPEC `(2 * 6547200 * 1074791425) DIV 4294967296 + 131072` - (SPEC `(2 * a * 1074791425) DIV 4294967296 + 131072` DIV_MONO))) THEN - ANTS_TAC THENL [ASM_ARITH_TAC; CONV_TAC NUM_REDUCE_CONV THEN DISCH_TAC] THEN - MP_TAC(SPEC `262144` (SPEC `(2 * a * 1074791425) DIV 4294967296 + 131072` - (SPEC `(2 * 6023425 * 1074791425) DIV 4294967296 + 131072` DIV_MONO))) THEN - ANTS_TAC THENL [ASM_ARITH_TAC; CONV_TAC NUM_REDUCE_CONV THEN DISCH_TAC] THEN - MP_TAC(SPEC `128` (SPEC `6547200 + 127` (SPEC `a + 127` DIV_MONO))) THEN - ANTS_TAC THENL [ASM_ARITH_TAC; CONV_TAC NUM_REDUCE_CONV THEN DISCH_TAC] THEN - MP_TAC(SPEC `128` (SPEC `a + 127` (SPEC `6023425 + 127` DIV_MONO))) THEN - ANTS_TAC THENL [ASM_ARITH_TAC; CONV_TAC NUM_REDUCE_CONV THEN DISCH_TAC] THEN - ABBREV_TAC `qq12 = (a + 127) DIV 128` THEN - SUBGOAL_THEN `qq12 * 1025 <= 51150 * 1025` ASSUME_TAC THENL - [ASM_SIMP_TAC[LE_MULT_RCANCEL]; ALL_TAC] THEN - SUBGOAL_THEN `47059 * 1025 <= qq12 * 1025` ASSUME_TAC THENL - [ASM_SIMP_TAC[LE_MULT_RCANCEL]; ALL_TAC] THEN - MP_TAC(SPEC `4194304` (SPEC `51150 * 1025 + 2097152` - (SPEC `qq12 * 1025 + 2097152` DIV_MONO))) THEN - ANTS_TAC THENL [ASM_ARITH_TAC; CONV_TAC NUM_REDUCE_CONV THEN DISCH_TAC] THEN - MP_TAC(SPEC `4194304` (SPEC `qq12 * 1025 + 2097152` - (SPEC `47059 * 1025 + 2097152` DIV_MONO))) THEN - ANTS_TAC THENL [ASM_ARITH_TAC; CONV_TAC NUM_REDUCE_CONV THEN DISCH_TAC] THEN - ASM_ARITH_TAC - ; - ASM_CASES_TAC `a <= 7070976` THENL - [ - MP_TAC(SPEC `262144` (SPEC `(2 * 7070976 * 1074791425) DIV 4294967296 + 131072` - (SPEC `(2 * a * 1074791425) DIV 4294967296 + 131072` DIV_MONO))) THEN - ANTS_TAC THENL [ASM_ARITH_TAC; CONV_TAC NUM_REDUCE_CONV THEN DISCH_TAC] THEN - MP_TAC(SPEC `262144` (SPEC `(2 * a * 1074791425) DIV 4294967296 + 131072` - (SPEC `(2 * 6547201 * 1074791425) DIV 4294967296 + 131072` DIV_MONO))) THEN - ANTS_TAC THENL [ASM_ARITH_TAC; CONV_TAC NUM_REDUCE_CONV THEN DISCH_TAC] THEN - MP_TAC(SPEC `128` (SPEC `7070976 + 127` (SPEC `a + 127` DIV_MONO))) THEN - ANTS_TAC THENL [ASM_ARITH_TAC; CONV_TAC NUM_REDUCE_CONV THEN DISCH_TAC] THEN - MP_TAC(SPEC `128` (SPEC `a + 127` (SPEC `6547201 + 127` DIV_MONO))) THEN - ANTS_TAC THENL [ASM_ARITH_TAC; CONV_TAC NUM_REDUCE_CONV THEN DISCH_TAC] THEN - ABBREV_TAC `qq13 = (a + 127) DIV 128` THEN - SUBGOAL_THEN `qq13 * 1025 <= 55242 * 1025` ASSUME_TAC THENL - [ASM_SIMP_TAC[LE_MULT_RCANCEL]; ALL_TAC] THEN - SUBGOAL_THEN `51151 * 1025 <= qq13 * 1025` ASSUME_TAC THENL - [ASM_SIMP_TAC[LE_MULT_RCANCEL]; ALL_TAC] THEN - MP_TAC(SPEC `4194304` (SPEC `55242 * 1025 + 2097152` - (SPEC `qq13 * 1025 + 2097152` DIV_MONO))) THEN - ANTS_TAC THENL [ASM_ARITH_TAC; CONV_TAC NUM_REDUCE_CONV THEN DISCH_TAC] THEN - MP_TAC(SPEC `4194304` (SPEC `qq13 * 1025 + 2097152` - (SPEC `51151 * 1025 + 2097152` DIV_MONO))) THEN - ANTS_TAC THENL [ASM_ARITH_TAC; CONV_TAC NUM_REDUCE_CONV THEN DISCH_TAC] THEN - ASM_ARITH_TAC - ; - ASM_CASES_TAC `a <= 7594752` THENL - [ - MP_TAC(SPEC `262144` (SPEC `(2 * 7594752 * 1074791425) DIV 4294967296 + 131072` - (SPEC `(2 * a * 1074791425) DIV 4294967296 + 131072` DIV_MONO))) THEN - ANTS_TAC THENL [ASM_ARITH_TAC; CONV_TAC NUM_REDUCE_CONV THEN DISCH_TAC] THEN - MP_TAC(SPEC `262144` (SPEC `(2 * a * 1074791425) DIV 4294967296 + 131072` - (SPEC `(2 * 7070977 * 1074791425) DIV 4294967296 + 131072` DIV_MONO))) THEN - ANTS_TAC THENL [ASM_ARITH_TAC; CONV_TAC NUM_REDUCE_CONV THEN DISCH_TAC] THEN - MP_TAC(SPEC `128` (SPEC `7594752 + 127` (SPEC `a + 127` DIV_MONO))) THEN - ANTS_TAC THENL [ASM_ARITH_TAC; CONV_TAC NUM_REDUCE_CONV THEN DISCH_TAC] THEN - MP_TAC(SPEC `128` (SPEC `a + 127` (SPEC `7070977 + 127` DIV_MONO))) THEN - ANTS_TAC THENL [ASM_ARITH_TAC; CONV_TAC NUM_REDUCE_CONV THEN DISCH_TAC] THEN - ABBREV_TAC `qq14 = (a + 127) DIV 128` THEN - SUBGOAL_THEN `qq14 * 1025 <= 59334 * 1025` ASSUME_TAC THENL - [ASM_SIMP_TAC[LE_MULT_RCANCEL]; ALL_TAC] THEN - SUBGOAL_THEN `55243 * 1025 <= qq14 * 1025` ASSUME_TAC THENL - [ASM_SIMP_TAC[LE_MULT_RCANCEL]; ALL_TAC] THEN - MP_TAC(SPEC `4194304` (SPEC `59334 * 1025 + 2097152` - (SPEC `qq14 * 1025 + 2097152` DIV_MONO))) THEN - ANTS_TAC THENL [ASM_ARITH_TAC; CONV_TAC NUM_REDUCE_CONV THEN DISCH_TAC] THEN - MP_TAC(SPEC `4194304` (SPEC `qq14 * 1025 + 2097152` - (SPEC `55243 * 1025 + 2097152` DIV_MONO))) THEN - ANTS_TAC THENL [ASM_ARITH_TAC; CONV_TAC NUM_REDUCE_CONV THEN DISCH_TAC] THEN - ASM_ARITH_TAC - ; - ASM_CASES_TAC `a <= 8118528` THENL - [ - MP_TAC(SPEC `262144` (SPEC `(2 * 8118528 * 1074791425) DIV 4294967296 + 131072` - (SPEC `(2 * a * 1074791425) DIV 4294967296 + 131072` DIV_MONO))) THEN - ANTS_TAC THENL [ASM_ARITH_TAC; CONV_TAC NUM_REDUCE_CONV THEN DISCH_TAC] THEN - MP_TAC(SPEC `262144` (SPEC `(2 * a * 1074791425) DIV 4294967296 + 131072` - (SPEC `(2 * 7594753 * 1074791425) DIV 4294967296 + 131072` DIV_MONO))) THEN - ANTS_TAC THENL [ASM_ARITH_TAC; CONV_TAC NUM_REDUCE_CONV THEN DISCH_TAC] THEN - MP_TAC(SPEC `128` (SPEC `8118528 + 127` (SPEC `a + 127` DIV_MONO))) THEN - ANTS_TAC THENL [ASM_ARITH_TAC; CONV_TAC NUM_REDUCE_CONV THEN DISCH_TAC] THEN - MP_TAC(SPEC `128` (SPEC `a + 127` (SPEC `7594753 + 127` DIV_MONO))) THEN - ANTS_TAC THENL [ASM_ARITH_TAC; CONV_TAC NUM_REDUCE_CONV THEN DISCH_TAC] THEN - ABBREV_TAC `qq15 = (a + 127) DIV 128` THEN - SUBGOAL_THEN `qq15 * 1025 <= 63426 * 1025` ASSUME_TAC THENL - [ASM_SIMP_TAC[LE_MULT_RCANCEL]; ALL_TAC] THEN - SUBGOAL_THEN `59335 * 1025 <= qq15 * 1025` ASSUME_TAC THENL - [ASM_SIMP_TAC[LE_MULT_RCANCEL]; ALL_TAC] THEN - MP_TAC(SPEC `4194304` (SPEC `63426 * 1025 + 2097152` - (SPEC `qq15 * 1025 + 2097152` DIV_MONO))) THEN - ANTS_TAC THENL [ASM_ARITH_TAC; CONV_TAC NUM_REDUCE_CONV THEN DISCH_TAC] THEN - MP_TAC(SPEC `4194304` (SPEC `qq15 * 1025 + 2097152` - (SPEC `59335 * 1025 + 2097152` DIV_MONO))) THEN - ANTS_TAC THENL [ASM_ARITH_TAC; CONV_TAC NUM_REDUCE_CONV THEN DISCH_TAC] THEN - ASM_ARITH_TAC - ; - MP_TAC(SPEC `262144` (SPEC `(2 * 8380416 * 1074791425) DIV 4294967296 + 131072` - (SPEC `(2 * a * 1074791425) DIV 4294967296 + 131072` DIV_MONO))) THEN - ANTS_TAC THENL [ASM_ARITH_TAC; CONV_TAC NUM_REDUCE_CONV THEN DISCH_TAC] THEN - MP_TAC(SPEC `262144` (SPEC `(2 * a * 1074791425) DIV 4294967296 + 131072` - (SPEC `(2 * 8118529 * 1074791425) DIV 4294967296 + 131072` DIV_MONO))) THEN - ANTS_TAC THENL [ASM_ARITH_TAC; CONV_TAC NUM_REDUCE_CONV THEN DISCH_TAC] THEN - MP_TAC(SPEC `128` (SPEC `8380416 + 127` (SPEC `a + 127` DIV_MONO))) THEN - ANTS_TAC THENL [ASM_ARITH_TAC; CONV_TAC NUM_REDUCE_CONV THEN DISCH_TAC] THEN - MP_TAC(SPEC `128` (SPEC `a + 127` (SPEC `8118529 + 127` DIV_MONO))) THEN - ANTS_TAC THENL [ASM_ARITH_TAC; CONV_TAC NUM_REDUCE_CONV THEN DISCH_TAC] THEN - ABBREV_TAC `qq16 = (a + 127) DIV 128` THEN - SUBGOAL_THEN `qq16 * 1025 <= 65472 * 1025` ASSUME_TAC THENL - [ASM_SIMP_TAC[LE_MULT_RCANCEL]; ALL_TAC] THEN - SUBGOAL_THEN `63427 * 1025 <= qq16 * 1025` ASSUME_TAC THENL - [ASM_SIMP_TAC[LE_MULT_RCANCEL]; ALL_TAC] THEN - MP_TAC(SPEC `4194304` (SPEC `65472 * 1025 + 2097152` - (SPEC `qq16 * 1025 + 2097152` DIV_MONO))) THEN - ANTS_TAC THENL [ASM_ARITH_TAC; CONV_TAC NUM_REDUCE_CONV THEN DISCH_TAC] THEN - MP_TAC(SPEC `4194304` (SPEC `qq16 * 1025 + 2097152` - (SPEC `63427 * 1025 + 2097152` DIV_MONO))) THEN - ANTS_TAC THENL [ASM_ARITH_TAC; CONV_TAC NUM_REDUCE_CONV THEN DISCH_TAC] THEN - ASM_ARITH_TAC - ]]]]]]]]]]]]]]]]);; + let intervals = [ + (0, 261888); (261889, 785664); (785665, 1309440); (1309441, 1833216); + (1833217, 2356992); (2356993, 2880768); (2880769, 3404544); + (3404545, 3928320); (3928321, 4452096); (4452097, 4975872); + (4975873, 5499648); (5499649, 6023424); (6023425, 6547200); + (6547201, 7070976); (7070977, 7594752); (7594753, 8118528); + (8118529, 8380416)] in + let mk_le hi = + mk_comb(mk_comb(`(<=):num->num->bool`, mk_var("a",`:num`)), + mk_small_numeral hi) in + let apply_interval k (lo, hi) = + let th = SPECL [`a:num`; mk_small_numeral lo; + mk_small_numeral hi; mk_small_numeral k] + BARRETT_INTERVAL_32 in + MP_TAC th THEN CONV_TAC NUM_REDUCE_CONV THEN ASM_ARITH_TAC in + let rec cascade k = function + | [(lo,hi)] -> apply_interval k (lo,hi) + | (lo,hi)::rest -> + ASM_CASES_TAC (mk_le hi) THENL + [apply_interval k (lo,hi); cascade (k+1) rest] + | [] -> failwith "empty" in + cascade 0 intervals);; + (* ========================================================================= *) From 3176b7ea641a5d544d13aa6af0597cbd3f551fe9 Mon Sep 17 00:00:00 2001 From: Jake Massimo Date: Fri, 24 Apr 2026 17:40:32 +0000 Subject: [PATCH 06/11] Add _32 suffix to theorem names and add subroutine signature Rename MLDSA_USE_HINT_EXEC/CORRECT/SUBROUTINE_CORRECT/SUBROUTINE_SAFE to include _32 suffix, matching the _88 naming convention. Add mldsa_poly_use_hint_32 entry to subroutine_signatures.ml for the constant-time and memory safety proof. Signed-off-by: Jake Massimo --- arm/proofs/mldsa_poly_use_hint_32.ml | 26 +++++++++++++------------- arm/proofs/specifications.txt | 4 ++-- 2 files changed, 15 insertions(+), 15 deletions(-) diff --git a/arm/proofs/mldsa_poly_use_hint_32.ml b/arm/proofs/mldsa_poly_use_hint_32.ml index 1b60eaccc..240842105 100644 --- a/arm/proofs/mldsa_poly_use_hint_32.ml +++ b/arm/proofs/mldsa_poly_use_hint_32.ml @@ -87,7 +87,7 @@ let mldsa_poly_use_hint_32_mc = define_assert_from_elf 0xd65f03c0 (* arm_RET X30 *) ];; -let MLDSA_USE_HINT_EXEC = ARM_MK_EXEC_RULE mldsa_poly_use_hint_32_mc;; +let MLDSA_USE_HINT_32_EXEC = ARM_MK_EXEC_RULE mldsa_poly_use_hint_32_mc;; (* ========================================================================= *) (* Functional specification: UseHint for ML-DSA parameter sets 65/87 *) @@ -422,7 +422,7 @@ let ELEMENT_CORRECT_WORD = prove( (* Correctness proof (output bounds) *) (* ========================================================================= *) -let MLDSA_USE_HINT_CORRECT = prove +let MLDSA_USE_HINT_32_CORRECT = prove (`!b a h x y pc. nonoverlapping (word pc, LENGTH mldsa_poly_use_hint_32_mc) (b, 1024) /\ nonoverlapping (b, 1024) (a, 1024) /\ @@ -450,7 +450,7 @@ let MLDSA_USE_HINT_CORRECT = prove `x:num->int32`; `y:num->int32`; `pc:num`] THEN REWRITE_TAC[MAYCHANGE_REGS_AND_FLAGS_PERMITTED_BY_ABI; C_ARGUMENTS; NONOVERLAPPING_CLAUSES; ALL; - fst MLDSA_USE_HINT_EXEC] THEN + fst MLDSA_USE_HINT_32_EXEC] THEN DISCH_THEN(REPEAT_TCL CONJUNCTS_THEN ASSUME_TAC) THEN GLOBALIZE_PRECONDITION_TAC THEN CONV_TAC(RATOR_CONV(LAND_CONV(ONCE_DEPTH_CONV EXPAND_CASES_CONV))) THEN @@ -469,7 +469,7 @@ let MLDSA_USE_HINT_CORRECT = prove DISCARD_MATCHING_ASSUMPTIONS [`read (memory :> bytes32 a) s = x`] THEN (* Simulate 878 instructions (excluding RET) *) - MAP_EVERY (fun n -> ARM_STEPS_TAC MLDSA_USE_HINT_EXEC [n] THEN + MAP_EVERY (fun n -> ARM_STEPS_TAC MLDSA_USE_HINT_32_EXEC [n] THEN SIMD_SIMPLIFY_TAC[]) (1--878) THEN ENSURES_FINAL_STATE_TAC THEN ASM_REWRITE_TAC[] THEN @@ -514,7 +514,7 @@ let MLDSA_USE_HINT_CORRECT = prove (* Subroutine form *) (* ========================================================================= *) -let MLDSA_USE_HINT_SUBROUTINE_CORRECT = prove +let MLDSA_USE_HINT_32_SUBROUTINE_CORRECT = prove (`!b a h x y pc returnaddress. nonoverlapping (word pc, LENGTH mldsa_poly_use_hint_32_mc) (b, 1024) /\ nonoverlapping (b, 1024) (a, 1024) /\ @@ -536,10 +536,10 @@ let MLDSA_USE_HINT_SUBROUTINE_CORRECT = prove word(mldsa_use_hint_32_spec (val(x i)) (val(y i))))) (MAYCHANGE_REGS_AND_FLAGS_PERMITTED_BY_ABI ,, MAYCHANGE [memory :> bytes(b, 1024)])`, - REWRITE_TAC[fst MLDSA_USE_HINT_EXEC] THEN - ARM_ADD_RETURN_NOSTACK_TAC MLDSA_USE_HINT_EXEC - (REWRITE_RULE[fst MLDSA_USE_HINT_EXEC] - MLDSA_USE_HINT_CORRECT));; + REWRITE_TAC[fst MLDSA_USE_HINT_32_EXEC] THEN + ARM_ADD_RETURN_NOSTACK_TAC MLDSA_USE_HINT_32_EXEC + (REWRITE_RULE[fst MLDSA_USE_HINT_32_EXEC] + MLDSA_USE_HINT_32_CORRECT));; (* ========================================================================= *) @@ -553,10 +553,10 @@ needs "arm/proofs/subroutine_signatures.ml";; let full_spec,public_vars = mk_safety_spec ~keep_maychanges:false (assoc "mldsa_poly_use_hint_32" subroutine_signatures) - MLDSA_USE_HINT_SUBROUTINE_CORRECT - MLDSA_USE_HINT_EXEC;; + MLDSA_USE_HINT_32_SUBROUTINE_CORRECT + MLDSA_USE_HINT_32_EXEC;; -let MLDSA_USE_HINT_SUBROUTINE_SAFE = time prove +let MLDSA_USE_HINT_32_SUBROUTINE_SAFE = time prove (`exists f_events. forall e b a h pc returnaddress. nonoverlapping (word pc,LENGTH mldsa_poly_use_hint_32_mc) (b,1024) /\ @@ -579,4 +579,4 @@ let MLDSA_USE_HINT_SUBROUTINE_SAFE = time prove [b,1024])) (\s s'. true)`, ASSERT_CONCL_TAC full_spec THEN - PROVE_SAFETY_SPEC_TAC ~public_vars:public_vars MLDSA_USE_HINT_EXEC);; + PROVE_SAFETY_SPEC_TAC ~public_vars:public_vars MLDSA_USE_HINT_32_EXEC);; diff --git a/arm/proofs/specifications.txt b/arm/proofs/specifications.txt index 0737af9d2..ec2bb5c37 100644 --- a/arm/proofs/specifications.txt +++ b/arm/proofs/specifications.txt @@ -327,8 +327,8 @@ MLDSA_NTT_SUBROUTINE_CORRECT MLDSA_NTT_SUBROUTINE_SAFE MLDSA_POINTWISE_SUBROUTINE_CORRECT MLDSA_POINTWISE_SUBROUTINE_SAFE -MLDSA_USE_HINT_SUBROUTINE_CORRECT -MLDSA_USE_HINT_SUBROUTINE_SAFE +MLDSA_USE_HINT_32_SUBROUTINE_CORRECT +MLDSA_USE_HINT_32_SUBROUTINE_SAFE MLKEM_BASEMUL_K2_SUBROUTINE_CORRECT MLKEM_BASEMUL_K2_SUBROUTINE_SAFE MLKEM_BASEMUL_K3_SUBROUTINE_CORRECT From e46bea5746478811a0ee0b28935d9f81a072da0a Mon Sep 17 00:00:00 2001 From: Jake Massimo Date: Fri, 1 May 2026 06:40:47 +0000 Subject: [PATCH 07/11] Add FIPS 204-aligned UseHint _32 equivalence proof Add FIPS 204 definitions (mldsa_cmod, mldsa_decompose_32, mldsa_use_hint_32) and equivalence proof connecting code-aligned spec to FIPS 204 Algorithm 40. Move shared arch-independent helpers (DIV_SANDWICH, INT_MOD_RESIDUE) to common/mlkem_mldsa.ml. ENSURES_STRENGTHEN_POST stays in the proof file as it references armstate. Signed-off-by: Jake Massimo --- arm/proofs/mldsa_poly_use_hint_32.ml | 444 ++++++++++++++++++++++++++- common/mlkem_mldsa.ml | 18 ++ 2 files changed, 454 insertions(+), 8 deletions(-) diff --git a/arm/proofs/mldsa_poly_use_hint_32.ml b/arm/proofs/mldsa_poly_use_hint_32.ml index 240842105..cb7e44682 100644 --- a/arm/proofs/mldsa_poly_use_hint_32.ml +++ b/arm/proofs/mldsa_poly_use_hint_32.ml @@ -270,14 +270,6 @@ let WRAP_A0_NEGATIVE = BITBLAST_RULE Both compute round_half_down(a / 523776) via different Barrett approximation paths. Proved by case analysis on 17 output intervals using DIV_MONO to sandwich both LHS and RHS to the same constant. *) -let DIV_SANDWICH = prove( - `!x d k. ~(d = 0) /\ k * d <= x /\ x < (k + 1) * d ==> x DIV d = k`, - REPEAT GEN_TAC THEN STRIP_TAC THEN - SUBGOAL_THEN `k <= x DIV d` ASSUME_TAC THENL - [ASM_SIMP_TAC[LE_RDIV_EQ] THEN ASM_ARITH_TAC; ALL_TAC] THEN - SUBGOAL_THEN `x DIV d < k + 1` ASSUME_TAC THENL - [ASM_SIMP_TAC[RDIV_LT_EQ] THEN ASM_ARITH_TAC; ASM_ARITH_TAC]);; - let BARRETT_INTERVAL_32 = prove( `!a lo hi k. lo <= a /\ a <= hi /\ @@ -580,3 +572,439 @@ let MLDSA_USE_HINT_32_SUBROUTINE_SAFE = time prove (\s s'. true)`, ASSERT_CONCL_TAC full_spec THEN PROVE_SAFETY_SPEC_TAC ~public_vars:public_vars MLDSA_USE_HINT_32_EXEC);; +(* ========================================================================= *) + +let mldsa_cmod = new_definition + `mldsa_cmod (r:num) (m:num) : int = + if (r MOD m) * 2 <= m then &(r MOD m) else &(r MOD m) - &m`;; + +let mldsa_decompose_32 = new_definition + `mldsa_decompose_32 (r:num) : num # int = + let r0 = mldsa_cmod r 523776 in + if &r - r0 = &8380416 then (0, r0 - &1) + else (num_of_int((&r - r0) div &523776), r0)`;; + +let decompose_32_r1 = new_definition + `decompose_32_r1 (r:num) : num = FST(mldsa_decompose_32 r)`;; + +let decompose_32_r0 = new_definition + `decompose_32_r0 (r:num) : int = SND(mldsa_decompose_32 r)`;; + +let mldsa_use_hint_32 = new_definition + `mldsa_use_hint_32 (h:num) (r:num) : num = + let (r1, r0) = mldsa_decompose_32 r in + if h = 1 /\ r0 > &0 then (r1 + 1) MOD 16 + else if h = 1 /\ r0 <= &0 then (r1 + 15) MOD 16 + else r1`;; + +let LOWER_NONWRAP_R1 = prove( + `!r. r MOD 523776 * 2 <= 523776 /\ + ~((&r:int) - &(r MOD 523776) = &8380416) ==> + decompose_32_r1 r = r DIV 523776`, + GEN_TAC THEN STRIP_TAC THEN + REWRITE_TAC[decompose_32_r1; mldsa_decompose_32; mldsa_cmod] THEN + CONV_TAC(TOP_DEPTH_CONV let_CONV) THEN ASM_REWRITE_TAC[] THEN + SUBGOAL_THEN `r MOD 523776 <= r` ASSUME_TAC THENL + [MESON_TAC[MOD_LE]; ALL_TAC] THEN + ASM_SIMP_TAC[INT_OF_NUM_SUB; INT_OF_NUM_DIV; + NUM_OF_INT_OF_NUM; INT_OF_NUM_EQ] THEN + MP_TAC(SPECL [`r:num`; `523776`] (CONJUNCT1 DIVISION_SIMP)) THEN + DISCH_TAC THEN + SUBGOAL_THEN `r - r MOD 523776 = 523776 * r DIV 523776` SUBST1_TAC THENL + [ASM_ARITH_TAC; ALL_TAC] THEN + MP_TAC(SPECL [`523776`; `r DIV 523776`] DIV_MULT) THEN + CONV_TAC NUM_REDUCE_CONV);; + +let UPPER_NONWRAP_R1 = prove( + `!r. ~(r MOD 523776 * 2 <= 523776) /\ + ~((&r:int) - (&(r MOD 523776) - &523776) = &8380416) ==> + decompose_32_r1 r = r DIV 523776 + 1`, + GEN_TAC THEN STRIP_TAC THEN + REWRITE_TAC[decompose_32_r1; mldsa_decompose_32; mldsa_cmod] THEN + CONV_TAC(TOP_DEPTH_CONV let_CONV) THEN ASM_REWRITE_TAC[] THEN + SUBGOAL_THEN `r MOD 523776 <= r` ASSUME_TAC THENL + [MESON_TAC[MOD_LE]; ALL_TAC] THEN + SUBGOAL_THEN `r MOD 523776 < 523776` ASSUME_TAC THENL + [MP_TAC(SPECL [`r:num`; `523776`] MOD_LT_EQ) THEN ARITH_TAC; ALL_TAC] THEN + SUBGOAL_THEN `(&r:int) - (&(r MOD 523776) - &523776) = + &(r - r MOD 523776 + 523776)` ASSUME_TAC THENL + [ASM_SIMP_TAC[GSYM INT_OF_NUM_SUB; GSYM INT_OF_NUM_ADD] THEN + INT_ARITH_TAC; ALL_TAC] THEN + ASM_REWRITE_TAC[INT_OF_NUM_DIV; NUM_OF_INT_OF_NUM; INT_OF_NUM_EQ] THEN + MP_TAC(SPECL [`r:num`; `523776`] (CONJUNCT1 DIVISION_SIMP)) THEN + DISCH_TAC THEN + SUBGOAL_THEN `r - r MOD 523776 + 523776 = (r DIV 523776 + 1) * 523776` + ASSUME_TAC THENL + [ASM_ARITH_TAC; ALL_TAC] THEN + ASM_REWRITE_TAC[] THEN + MP_TAC(SPECL [`(r DIV 523776 + 1) * 523776`; `523776`] DIV_MULT) THEN + ARITH_TAC);; + +(* Unfold mldsa_use_hint_32 eliminating the paired let *) +let MLDSA_USE_HINT_32_UNFOLD = prove( + `!h r. mldsa_use_hint_32 h r = + (if h = 1 /\ decompose_32_r0 r > &0 then (decompose_32_r1 r + 1) MOD 16 + else if h = 1 /\ decompose_32_r0 r <= &0 + then (decompose_32_r1 r + 15) MOD 16 + else decompose_32_r1 r)`, + REPEAT GEN_TAC THEN + REWRITE_TAC[mldsa_use_hint_32; decompose_32_r1; decompose_32_r0] THEN + SPEC_TAC(`mldsa_decompose_32 r`, `p:num#int`) THEN + REWRITE_TAC[FORALL_PAIR_THM] THEN + CONV_TAC(TOP_DEPTH_CONV let_CONV) THEN REWRITE_TAC[]);; + + +(* ========================================================================= *) +(* FIPS 204 = code-aligned equivalence *) +(* ========================================================================= *) + +let LINEARIZE_DIV_MOD_TAC = + REPEAT(FIRST_X_ASSUM(MP_TAC o check (fun th -> + free_in `r MOD 523776` (concl th) || + free_in `r DIV 523776` (concl th)))) THEN + MP_TAC(SPECL [`r:num`; `523776`] (CONJUNCT1 DIVISION_SIMP)) THEN + SPEC_TAC(`r MOD 523776`, `m:num`) THEN + SPEC_TAC(`r DIV 523776`, `q:num`) THEN + REPEAT GEN_TAC THEN ASM_ARITH_TAC;; + +(* Prove r DIV 523776 = k via DIV_SANDWICH + LE_MULT_RCANCEL *) +let DIV_523776_TAC k = + let k_num = mk_small_numeral k and km1 = mk_small_numeral (k-1) + and kp1 = mk_small_numeral (k+1) + and q = mk_var("q",`:num`) and le = `(<=):num->num->bool` + and lt = `(<):num->num->bool` + and c = `523776` in + let mk_mul a b = mk_binop (rator(rator `0*0`)) a b in + MATCH_MP_TAC DIV_SANDWICH THEN CONV_TAC NUM_REDUCE_CONV THEN + REPEAT(FIRST_X_ASSUM(MP_TAC o check (fun th -> + free_in `r MOD 523776` (concl th) || + free_in `r DIV 523776` (concl th)))) THEN + MP_TAC(SPECL [`r:num`; c] (CONJUNCT1 DIVISION_SIMP)) THEN + SPEC_TAC(`r MOD 523776`, `m:num`) THEN + SPEC_TAC(`r DIV 523776`, q) THEN + REPEAT GEN_TAC THEN STRIP_TAC THEN + ASM_CASES_TAC(mk_comb(mk_comb(le, q), km1)) THENL + [SUBGOAL_THEN(mk_comb(mk_comb(le, mk_mul q c), + mk_mul km1 c)) ASSUME_TAC THENL + [ASM_SIMP_TAC[LE_MULT_RCANCEL]; ALL_TAC] THEN + CONV_TAC NUM_REDUCE_CONV THEN ASM_ARITH_TAC; + SUBGOAL_THEN(mk_comb(mk_comb(le, mk_mul k_num c), + mk_mul q c)) ASSUME_TAC THENL + [ASM_SIMP_TAC[LE_MULT_RCANCEL] THEN DISJ1_TAC THEN ASM_ARITH_TAC; + ALL_TAC] THEN + ASM_CASES_TAC(mk_comb(mk_comb(lt, k_num), q)) THENL + [SUBGOAL_THEN(mk_comb(mk_comb(le, mk_mul kp1 c), + mk_mul q c)) ASSUME_TAC THENL + [ASM_SIMP_TAC[LE_MULT_RCANCEL] THEN DISJ1_TAC THEN ASM_ARITH_TAC; + ALL_TAC] THEN + CONV_TAC NUM_REDUCE_CONV THEN ASM_ARITH_TAC; + CONV_TAC NUM_REDUCE_CONV THEN ASM_ARITH_TAC]];; + +(* Replace (r - r MOD 523776) DIV 523776 with r DIV 523776 *) +let DIV_MOD_TO_DIV_TAC = + SUBGOAL_THEN `(r - r MOD 523776) DIV 523776 = r DIV 523776` SUBST1_TAC THENL + [MP_TAC(SPECL [`r:num`; `523776`] (CONJUNCT1 DIVISION_SIMP)) THEN + DISCH_TAC THEN + SUBGOAL_THEN `r - r MOD 523776 = 523776 * r DIV 523776` SUBST1_TAC THENL + [ASM_ARITH_TAC; ALL_TAC] THEN + MP_TAC(SPECL [`523776`; `r DIV 523776`] DIV_MULT) THEN + CONV_TAC NUM_REDUCE_CONV; ALL_TAC];; + +(* Lower half nowrap: dismiss wrap cond, reduce, prove r DIV 523776 = k *) +let DECOMPOSE_R1_LOWER_TAC = + SUBGOAL_THEN `~((&r:int) - &(r MOD 523776) = &8380416)` (fun th -> REWRITE_TAC[th]) THENL + [ASM_SIMP_TAC[INT_OF_NUM_SUB; INT_OF_NUM_EQ] THEN LINEARIZE_DIV_MOD_TAC; + ALL_TAC] THEN + ASM_SIMP_TAC[INT_OF_NUM_SUB; INT_OF_NUM_DIV; NUM_OF_INT_OF_NUM] THEN + DIV_MOD_TO_DIV_TAC THEN + CONV_TAC SYM_CONV THEN + LINEARIZE_DIV_MOD_TAC;; + +(* Upper half nowrap: dismiss wrap cond, reduce, prove r DIV 523776 + 1 = k *) +let DECOMPOSE_R1_UPPER_TAC = + SUBGOAL_THEN `r MOD 523776 <= r` ASSUME_TAC THENL + [MESON_TAC[MOD_LE]; ALL_TAC] THEN + SUBGOAL_THEN `r MOD 523776 < 523776` ASSUME_TAC THENL + [MP_TAC(SPECL [`r:num`; `523776`] MOD_LT_EQ) THEN ARITH_TAC; ALL_TAC] THEN + SUBGOAL_THEN `~((&r:int) - (&(r MOD 523776) - &523776) = &8380416)` (fun th -> REWRITE_TAC[th]) THENL + [REWRITE_TAC[INT_ARITH `(a:int) - (b - c) = d <=> a + c - b = d`] THEN + ASM_SIMP_TAC[GSYM INT_OF_NUM_ADD; GSYM INT_OF_NUM_SUB; INT_OF_NUM_EQ] THEN + LINEARIZE_DIV_MOD_TAC; ALL_TAC] THEN + SUBGOAL_THEN `(&r:int) - (&(r MOD 523776) - &523776) = + &(r - r MOD 523776 + 523776)` SUBST1_TAC THENL + [ASM_SIMP_TAC[GSYM INT_OF_NUM_SUB; GSYM INT_OF_NUM_ADD] THEN + INT_ARITH_TAC; ALL_TAC] THEN + REWRITE_TAC[INT_OF_NUM_DIV; NUM_OF_INT_OF_NUM] THEN + MP_TAC(SPECL [`r:num`; `523776`] (CONJUNCT1 DIVISION_SIMP)) THEN + DISCH_TAC THEN + SUBGOAL_THEN `r - r MOD 523776 + 523776 = 523776 * (r DIV 523776 + 1)` + SUBST1_TAC THENL [ASM_ARITH_TAC; ALL_TAC] THEN + MP_TAC(SPECL [`523776`; `r DIV 523776 + 1`] DIV_MULT) THEN + CONV_TAC NUM_REDUCE_CONV THEN DISCH_THEN SUBST1_TAC THEN + REPEAT(FIRST_X_ASSUM(MP_TAC o check (fun th -> + free_in `r MOD 523776` (concl th) || + free_in `r DIV 523776` (concl th)))) THEN + MP_TAC(SPECL [`r:num`; `523776`] (CONJUNCT1 DIVISION_SIMP)) THEN + SPEC_TAC(`r MOD 523776`, `m:num`) THEN + SPEC_TAC(`r DIV 523776`, `q:num`) THEN + REPEAT GEN_TAC THEN ASM_ARITH_TAC;; + +let DECOMPOSE_R1_NOWRAP_TAC = + ASM_CASES_TAC `r MOD 523776 * 2 <= 523776` THEN ASM_REWRITE_TAC[] THEN + TRY DECOMPOSE_R1_LOWER_TAC THEN TRY DECOMPOSE_R1_UPPER_TAC;; + +let DECOMPOSE_32_R1_EQUIV = time prove( + `!r. r < 8380417 ==> + (((r + 127) DIV 128 * 1025 + 2097152) DIV 4194304) MOD 16 = + decompose_32_r1 r`, + GEN_TAC THEN DISCH_TAC THEN + ASM_CASES_TAC `r <= 8118528` THENL + [ALL_TAC; + (* Wrap zone *) + SUBGOAL_THEN `8118528 < r` ASSUME_TAC THENL [ASM_ARITH_TAC; ALL_TAC] THEN + SUBGOAL_THEN `decompose_32_r1 r = 0` SUBST1_TAC THENL + [REWRITE_TAC[decompose_32_r1; mldsa_decompose_32; mldsa_cmod] THEN + CONV_TAC(TOP_DEPTH_CONV let_CONV) THEN + SUBGOAL_THEN `r MOD 523776 <= r` ASSUME_TAC THENL + [MESON_TAC[MOD_LE]; ALL_TAC] THEN + SUBGOAL_THEN `r MOD 523776 < 523776` ASSUME_TAC THENL + [MP_TAC(SPECL [`r:num`; `523776`] MOD_LT_EQ) THEN ARITH_TAC; ALL_TAC] THEN + ASM_CASES_TAC `r MOD 523776 * 2 <= 523776` THEN ASM_REWRITE_TAC[] THENL + [(* Lower wrap: r DIV 523776 = 16 *) + SUBGOAL_THEN `r DIV 523776 = 16` ASSUME_TAC THENL + [DIV_523776_TAC 16; ALL_TAC] THEN + SUBGOAL_THEN `16 * 523776 + r MOD 523776 = r` MP_TAC THENL + [MP_TAC(SPECL [`r:num`; `523776`] (CONJUNCT1 DIVISION_SIMP)) THEN + ASM_ARITH_TAC; ALL_TAC] THEN + DISCH_TAC THEN ASM_SIMP_TAC[INT_OF_NUM_SUB; INT_OF_NUM_EQ] THEN + ASM_ARITH_TAC; + (* Upper wrap: r DIV 523776 = 15 *) + SUBGOAL_THEN `r DIV 523776 = 15` ASSUME_TAC THENL + [DIV_523776_TAC 15; ALL_TAC] THEN + SUBGOAL_THEN `15 * 523776 + r MOD 523776 = r` MP_TAC THENL + [MP_TAC(SPECL [`r:num`; `523776`] (CONJUNCT1 DIVISION_SIMP)) THEN + ASM_ARITH_TAC; ALL_TAC] THEN + DISCH_TAC THEN + SUBGOAL_THEN `(&r:int) - (&(r MOD 523776) - &523776) = + &(r - r MOD 523776 + 523776)` SUBST1_TAC THENL + [ASM_SIMP_TAC[GSYM INT_OF_NUM_SUB; GSYM INT_OF_NUM_ADD] THEN + INT_ARITH_TAC; ALL_TAC] THEN + REWRITE_TAC[INT_OF_NUM_EQ] THEN ASM_ARITH_TAC]; + ALL_TAC] THEN + MP_TAC(SPEC `r:num` A1_WRAP) THEN + ANTS_TAC THENL [ASM_ARITH_TAC; ALL_TAC] THEN + DISCH_THEN SUBST1_TAC THEN CONV_TAC NUM_REDUCE_CONV] THEN + (* Nowrap zone: unfold and do interval cascade *) + REWRITE_TAC[decompose_32_r1; mldsa_decompose_32; mldsa_cmod] THEN + CONV_TAC(TOP_DEPTH_CONV let_CONV) THEN + SUBGOAL_THEN `r MOD 523776 <= r` ASSUME_TAC THENL + [MESON_TAC[MOD_LE]; ALL_TAC] THEN + SUBGOAL_THEN `r MOD 523776 < 523776` ASSUME_TAC THENL + [MP_TAC(SPECL [`r:num`; `523776`] MOD_LT_EQ) THEN ARITH_TAC; ALL_TAC] THEN + let intervals = [ + (0, 261888); (261889, 785664); (785665, 1309440); + (1309441, 1833216); (1833217, 2356992); (2356993, 2880768); + (2880769, 3404544); (3404545, 3928320); (3928321, 4452096); + (4452097, 4975872); (4975873, 5499648); (5499649, 6023424); + (6023425, 6547200); (6547201, 7070976); (7070977, 7594752); + (7594753, 8118528)] in + let mk_le hi = + mk_comb(mk_comb(`(<=):num->num->bool`, mk_var("r",`:num`)), + mk_small_numeral hi) in + let apply_interval k (lo, hi) = + let th = SPECL [`r:num`; mk_small_numeral lo; + mk_small_numeral hi; mk_small_numeral k] + BARRETT_INTERVAL_32 in + MP_TAC th THEN CONV_TAC NUM_REDUCE_CONV THEN + ANTS_TAC THENL [ASM_ARITH_TAC; ALL_TAC] THEN + STRIP_TAC THEN ASM_REWRITE_TAC[] THEN CONV_TAC NUM_REDUCE_CONV THEN + DECOMPOSE_R1_NOWRAP_TAC in + let rec cascade k = function + | [(lo,hi)] -> apply_interval k (lo,hi) + | (lo,hi)::rest -> + ASM_CASES_TAC (mk_le hi) THENL + [apply_interval k (lo,hi); cascade (k+1) rest] + | [] -> failwith "empty" in + cascade 0 intervals);; + +let R1_IS_DIV_LOWER = prove( + `!r. r < 8380417 /\ r MOD 523776 * 2 <= 523776 /\ + ~((&r:int) - &(r MOD 523776) = &8380416) ==> + (((r + 127) DIV 128 * 1025 + 2097152) DIV 4194304) MOD 16 = r DIV 523776`, + GEN_TAC THEN STRIP_TAC THEN + MP_TAC(SPEC `r:num` DECOMPOSE_32_R1_EQUIV) THEN ASM_REWRITE_TAC[] THEN + MP_TAC(SPEC `r:num` LOWER_NONWRAP_R1) THEN ASM_REWRITE_TAC[] THEN + REPEAT DISCH_TAC THEN ASM_REWRITE_TAC[]);; + +let R1_IS_DIV_PLUS1_UPPER = prove( + `!r. r < 8380417 /\ ~(r MOD 523776 * 2 <= 523776) /\ + ~((&r:int) - (&(r MOD 523776) - &523776) = &8380416) ==> + (((r + 127) DIV 128 * 1025 + 2097152) DIV 4194304) MOD 16 = + r DIV 523776 + 1`, + GEN_TAC THEN STRIP_TAC THEN + MP_TAC(SPEC `r:num` DECOMPOSE_32_R1_EQUIV) THEN ASM_REWRITE_TAC[] THEN + MP_TAC(SPEC `r:num` UPPER_NONWRAP_R1) THEN ASM_REWRITE_TAC[] THEN + REPEAT DISCH_TAC THEN ASM_REWRITE_TAC[]);; + +(* Upper nowrap: substitute Barrett = r DIV 523776 + 1, use INT_MOD_RESIDUE *) +let R0_SIGN_UPPER_NOWRAP_TAC = + MP_TAC(SPEC `r:num` R1_IS_DIV_PLUS1_UPPER) THEN + ANTS_TAC THEN ASM_REWRITE_TAC[] THEN DISCH_THEN SUBST1_TAC THEN + MP_TAC(CONV_RULE NUM_REDUCE_CONV (SPECL [`r:num`; `523776`] INT_MOD_RESIDUE)) THEN + REWRITE_TAC[GSYM INT_OF_NUM_ADD; GSYM INT_OF_NUM_MUL] THEN + DISCH_TAC THEN ASM_REWRITE_TAC[] THEN + REWRITE_TAC[INT_ARITH `(a:int) - (b + &1) * c = a - b * c - c`] THEN + REWRITE_TAC[INT_ARITH `x - &523776 > &0 <=> x > &523776`; + INT_ARITH `x - &523776 - &8380417 > &0 <=> x > &8904193`; + INT_OF_NUM_GT] THEN + ASM_ARITH_TAC;; + +(* Lower nowrap: substitute Barrett = r DIV 523776, use INT_MOD_RESIDUE *) +let R0_SIGN_LOWER_NOWRAP_TAC = + MP_TAC(SPEC `r:num` R1_IS_DIV_LOWER) THEN + ANTS_TAC THEN ASM_REWRITE_TAC[] THEN DISCH_THEN SUBST1_TAC THEN + MP_TAC(CONV_RULE NUM_REDUCE_CONV (SPECL [`r:num`; `523776`] INT_MOD_RESIDUE)) THEN + DISCH_TAC THEN ASM_REWRITE_TAC[] THEN + REWRITE_TAC[INT_ARITH `x - &8380417 > &0 <=> x > &8380417`; + INT_OF_NUM_GT] THEN + ASM_ARITH_TAC;; + +(* Wrap: derive 8118528 < r, use DECOMPOSE_32_R1_EQUIV to get Barrett = 0 *) +let R0_SIGN_WRAP_TAC = + SUBGOAL_THEN `8118528 < r` ASSUME_TAC THENL + [FIRST_X_ASSUM(MP_TAC o check (fun th -> + can (find_term (fun t -> t = `&8380416:int`)) (concl th) && + not(is_neg(concl th)))) THEN + ASM_SIMP_TAC[INT_OF_NUM_SUB; INT_OF_NUM_EQ; + INT_ARITH `(a:int) - (b - c) = d <=> a + c - b = d`; + GSYM INT_OF_NUM_ADD] THEN ASM_ARITH_TAC; ALL_TAC] THEN + MP_TAC(SPEC `r:num` DECOMPOSE_32_R1_EQUIV) THEN ASM_REWRITE_TAC[] THEN + REWRITE_TAC[decompose_32_r1; mldsa_decompose_32; mldsa_cmod] THEN + CONV_TAC(TOP_DEPTH_CONV let_CONV) THEN ASM_REWRITE_TAC[] THEN + DISCH_TAC THEN ASM_REWRITE_TAC[INT_MUL_LZERO; INT_SUB_RZERO] THEN + REWRITE_TAC[INT_ARITH `x - &1 > &0 <=> x > &1`; + INT_ARITH `(x - &523776) - &1 > &0 <=> x > &523777`; + INT_ARITH `x - &8380417 > &0 <=> x > &8380417`; + INT_OF_NUM_GT] THEN + ASM_ARITH_TAC;; + +let DECOMPOSE_32_R0_SIGN = time prove( + `!r. r < 8380417 ==> + let a1 = (((r + 127) DIV 128 * 1025 + 2097152) DIV 4194304) MOD 16 in + let a0':int = if (&r:int) - &a1 * &523776 > &4190208 + then &r - &a1 * &523776 - &8380417 + else &r - &a1 * &523776 in + (decompose_32_r0 r > &0 <=> a0' > &0) /\ + (decompose_32_r0 r <= &0 <=> ~(a0' > &0))`, + GEN_TAC THEN DISCH_TAC THEN CONV_TAC(TOP_DEPTH_CONV let_CONV) THEN + REWRITE_TAC[INT_ARITH `(x:int) <= &0 <=> ~(x > &0)`] THEN + MATCH_MP_TAC(TAUT `(p <=> q) ==> (p <=> q) /\ (~p <=> ~q)`) THEN + REWRITE_TAC[decompose_32_r0; mldsa_decompose_32; mldsa_cmod] THEN + CONV_TAC(TOP_DEPTH_CONV let_CONV) THEN + ONCE_REWRITE_TAC[COND_RAND] THEN REWRITE_TAC[SND; FST] THEN + SUBGOAL_THEN `r MOD 523776 <= r` ASSUME_TAC THENL + [MESON_TAC[MOD_LE]; ALL_TAC] THEN + SUBGOAL_THEN `r MOD 523776 < 523776` ASSUME_TAC THENL + [MP_TAC(SPECL [`r:num`; `523776`] MOD_LT_EQ) THEN ARITH_TAC; ALL_TAC] THEN + ASM_CASES_TAC `r MOD 523776 * 2 <= 523776` THEN ASM_REWRITE_TAC[] THEN + COND_CASES_TAC THEN ASM_REWRITE_TAC[] THEN + COND_CASES_TAC THEN ASM_REWRITE_TAC[] THEN + TRY R0_SIGN_LOWER_NOWRAP_TAC THEN + TRY R0_SIGN_UPPER_NOWRAP_TAC THEN + TRY R0_SIGN_WRAP_TAC THEN + TRY( + (* Contradiction: lower nowrap with > 4190208 *) + MP_TAC(SPEC `r:num` R1_IS_DIV_LOWER) THEN + ANTS_TAC THEN ASM_REWRITE_TAC[] THEN DISCH_TAC THEN + MP_TAC(CONV_RULE NUM_REDUCE_CONV + (SPECL [`r:num`; `523776`] INT_MOD_RESIDUE)) THEN + DISCH_TAC THEN + SUBGOAL_THEN `(&r:int) - &((((r + 127) DIV 128 * 1025 + 2097152) DIV + 4194304) MOD 16) * &523776 = &(r MOD 523776)` ASSUME_TAC THENL + [ASM_REWRITE_TAC[]; ALL_TAC] THEN + SUBGOAL_THEN `~(&(r MOD 523776) > (&4190208:int))` MP_TAC THENL + [REWRITE_TAC[INT_NOT_LT; INT_OF_NUM_LE] THEN ASM_ARITH_TAC; ALL_TAC] THEN + ASM_REWRITE_TAC[] THEN REWRITE_TAC[INT_OF_NUM_GT] THEN ASM_ARITH_TAC + ));; + +let MLDSA_USE_HINT_32_EQUIV = prove( + `!r h. r < 8380417 /\ h <= 1 + ==> mldsa_use_hint_32 h r = mldsa_use_hint_32_spec r h`, + REPEAT GEN_TAC THEN STRIP_TAC THEN + REWRITE_TAC[MLDSA_USE_HINT_32_UNFOLD] THEN + REWRITE_TAC[mldsa_use_hint_32_spec] THEN + CONV_TAC(TOP_DEPTH_CONV let_CONV) THEN + MP_TAC(SPEC `r:num` DECOMPOSE_32_R1_EQUIV) THEN ASM_REWRITE_TAC[] THEN + DISCH_TAC THEN + MP_TAC(SPEC `r:num` DECOMPOSE_32_R0_SIGN) THEN ASM_REWRITE_TAC[] THEN + CONV_TAC(TOP_DEPTH_CONV let_CONV) THEN STRIP_TAC THEN + ASM_CASES_TAC `h = 0` THENL + [ASM_REWRITE_TAC[ARITH_RULE `~(0 = 1)`]; ALL_TAC] THEN + SUBGOAL_THEN `h = 1` SUBST_ALL_TAC THENL [ASM_ARITH_TAC; ALL_TAC] THEN + ASM_REWRITE_TAC[] THEN + ASM_CASES_TAC `decompose_32_r0 r > &0` THEN ASM_REWRITE_TAC[] THEN + ASM_MESON_TAC[]);; + +let ENSURES_STRENGTHEN_POST = prove( + `!P (Q:armstate->bool) Q' R. + ensures arm P Q' R /\ (!s. Q' s ==> Q s) ==> ensures arm P Q R`, + REPEAT GEN_TAC THEN DISCH_THEN(CONJUNCTS_THEN2 MP_TAC ASSUME_TAC) THEN + REWRITE_TAC[ensures] THEN MATCH_MP_TAC MONO_FORALL THEN + X_GEN_TAC `s0:armstate` THEN MATCH_MP_TAC MONO_IMP THEN REWRITE_TAC[] THEN + MP_TAC(BETA_RULE(ISPECL [`arm`; + `\s':armstate. (Q':armstate->bool) s' /\ (R:armstate->armstate->bool) (s0:armstate) s'`; + `\s':armstate. (Q:armstate->bool) s' /\ (R:armstate->armstate->bool) (s0:armstate) s'`] + EVENTUALLY_MONO)) THEN + ANTS_TAC THENL [ASM_MESON_TAC[]; MESON_TAC[]]);; + +(* FIPS 204-aligned subroutine correctness. + Derived from the code-aligned SUBROUTINE_CORRECT by rewriting + mldsa_use_hint_32_spec -> mldsa_use_hint_32 via MLDSA_USE_HINT_32_EQUIV. *) +let MLDSA_USE_HINT_32_SUBROUTINE_CORRECT_FIPS204 = prove + (`!b a h x y pc returnaddress. + nonoverlapping (word pc, LENGTH mldsa_poly_use_hint_32_mc) (b, 1024) /\ + nonoverlapping (b, 1024) (a, 1024) /\ + nonoverlapping (b, 1024) (h, 1024) /\ + (!i. i < 256 ==> val((x:num->int32) i) < 8380417) /\ + (!i. i < 256 ==> val((y:num->int32) i) <= 1) + ==> ensures arm + (\s. aligned_bytes_loaded s (word pc) mldsa_poly_use_hint_32_mc /\ + read PC s = word pc /\ + read X30 s = returnaddress /\ + C_ARGUMENTS [b; a; h] s /\ + (!i. i < 256 ==> val(x i) < 8380417) /\ + (!i. i < 256 ==> val(y i) <= 1) /\ + (!i. i < 256 ==> + read(memory :> bytes32(word_add a (word(4 * i)))) s = x i) /\ + (!i. i < 256 ==> + read(memory :> bytes32(word_add h (word(4 * i)))) s = y i)) + (\s. read PC s = returnaddress /\ + (!i. i < 256 ==> + read(memory :> bytes32(word_add b (word(4 * i)))) s = + word(mldsa_use_hint_32 (val(y i)) (val(x i))))) + (MAYCHANGE_REGS_AND_FLAGS_PERMITTED_BY_ABI ,, + MAYCHANGE [memory :> bytes(b, 1024)])`, + REPEAT GEN_TAC THEN + DISCH_THEN(REPEAT_TCL CONJUNCTS_THEN ASSUME_TAC) THEN + SUBGOAL_THEN + `!i. i < 256 ==> + mldsa_use_hint_32 (val((y:num->int32) i)) (val((x:num->int32) i)) = + mldsa_use_hint_32_spec (val(x i)) (val(y i))` + (fun th -> SIMP_TAC[th]) THENL + [REPEAT STRIP_TAC THEN MATCH_MP_TAC MLDSA_USE_HINT_32_EQUIV THEN + CONJ_TAC THEN FIRST_X_ASSUM MATCH_MP_TAC THEN ASM_REWRITE_TAC[]; + MATCH_MP_TAC ENSURES_STRENGTHEN_POST THEN + EXISTS_TAC + `\s. read PC s = returnaddress /\ + (!i. i < 256 ==> + read(memory :> bytes32(word_add b (word(4 * i)))) s = + word(mldsa_use_hint_32_spec (val(x i:int32)) (val(y i:int32)))) /\ + (!i. i < 256 ==> + val(read(memory :> bytes32(word_add b (word(4 * i)))) s) < 16)` THEN + CONJ_TAC THENL + [MATCH_MP_TAC MLDSA_USE_HINT_32_SUBROUTINE_CORRECT THEN + ASM_REWRITE_TAC[]; + GEN_TAC THEN CONV_TAC(ONCE_DEPTH_CONV BETA_CONV) THEN + DISCH_THEN(REPEAT_TCL CONJUNCTS_THEN ASSUME_TAC) THEN + ASM_REWRITE_TAC[]]]);; + diff --git a/common/mlkem_mldsa.ml b/common/mlkem_mldsa.ml index 98275f600..144cb1eb6 100644 --- a/common/mlkem_mldsa.ml +++ b/common/mlkem_mldsa.ml @@ -1997,3 +1997,21 @@ let REAL_INT_GT_BRIDGE_POS = prove( MP_TAC(REWRITE_RULE[GSYM REAL_OF_NUM_LT; GSYM REAL_OF_NUM_MUL] (ASSUME `b * c < a`)) THEN REAL_ARITH_TAC; REWRITE_TAC[INT_GT] THEN MP_TAC(REWRITE_RULE[GSYM INT_OF_NUM_LT; GSYM INT_OF_NUM_MUL] (ASSUME `b * c < a`)) THEN INT_ARITH_TAC]);; + +(* ========================================================================= *) +(* Shared helper lemmas for UseHint proofs *) +(* ========================================================================= *) + +let DIV_SANDWICH = prove( + `!x d k. ~(d = 0) /\ k * d <= x /\ x < (k + 1) * d ==> x DIV d = k`, + REPEAT GEN_TAC THEN STRIP_TAC THEN + SUBGOAL_THEN `k <= x DIV d` ASSUME_TAC THENL + [ASM_SIMP_TAC[LE_RDIV_EQ] THEN ASM_ARITH_TAC; ALL_TAC] THEN + SUBGOAL_THEN `x DIV d < k + 1` ASSUME_TAC THENL +let INT_MOD_RESIDUE = prove( + `!r m. ~(m = 0) ==> (&r:int) - &(r DIV m) * &m = &(r MOD m)`, + REPEAT GEN_TAC THEN DISCH_TAC THEN + MP_TAC(SPECL [`r:num`; `m:num`] (CONJUNCT1 DIVISION_SIMP)) THEN + REWRITE_TAC[GSYM INT_OF_NUM_MUL; GSYM INT_OF_NUM_ADD; + GSYM INT_OF_NUM_EQ] THEN + INT_ARITH_TAC);; From 4453f529bc766bfcc83a19083ecab8cf0e26de4d Mon Sep 17 00:00:00 2001 From: Jake Massimo Date: Fri, 1 May 2026 18:07:31 +0000 Subject: [PATCH 08/11] DIV_SANDWICH: Restore truncated second THENL branch The proof body ended mid-THENL, missing the tactic list that discharges the `x DIV d < k + 1` subgoal. This caused camlp5 to fail parsing the file with: Parse error: [and_let_binding] expected after [first_let_binding] since the next `let INT_MOD_RESIDUE = ...` was read as a continuation of the incomplete `let DIV_SANDWICH` expression. Restore the missing line. Signed-off-by: Jake Massimo --- common/mlkem_mldsa.ml | 2 ++ 1 file changed, 2 insertions(+) diff --git a/common/mlkem_mldsa.ml b/common/mlkem_mldsa.ml index 144cb1eb6..dcda7c52c 100644 --- a/common/mlkem_mldsa.ml +++ b/common/mlkem_mldsa.ml @@ -2008,6 +2008,8 @@ let DIV_SANDWICH = prove( SUBGOAL_THEN `k <= x DIV d` ASSUME_TAC THENL [ASM_SIMP_TAC[LE_RDIV_EQ] THEN ASM_ARITH_TAC; ALL_TAC] THEN SUBGOAL_THEN `x DIV d < k + 1` ASSUME_TAC THENL + [ASM_SIMP_TAC[RDIV_LT_EQ] THEN ASM_ARITH_TAC; ASM_ARITH_TAC]);; + let INT_MOD_RESIDUE = prove( `!r m. ~(m = 0) ==> (&r:int) - &(r DIV m) * &m = &(r MOD m)`, REPEAT GEN_TAC THEN DISCH_TAC THEN From 1eaf225843a619311235fd482fb4d8562679e7df Mon Sep 17 00:00:00 2001 From: Jake Massimo Date: Fri, 1 May 2026 18:38:23 +0000 Subject: [PATCH 09/11] poly_use_hint_32: Port refactor from mldsa-native Apply the same refactor that was made on pq-code-package/mldsa-native#1037 to keep the two repos consistent: - Rename the code-aligned per-coefficient spec mldsa_use_hint_32_spec to mldsa_use_hint_32_code and keep it local to the proof file. FIPS 204 mldsa_use_hint_32 (Algorithm 40) is the shared definition in common/mlkem_mldsa.ml. - Rename the code-aligned CORRECT / CORRECT_BOUND / SUBROUTINE_CORRECT to *_CODE suffixes to mark them as internal stepping stones. - Make MLDSA_USE_HINT_32_SUBROUTINE_CORRECT the single public theorem, stated in terms of FIPS 204 mldsa_use_hint_32 with the < 16 output bound as a corollary. Derived from _SUBROUTINE_CORRECT_CODE via MLDSA_USE_HINT_32_EQUIV. - Move safety proof to the end of the file. mk_safety_spec still uses _SUBROUTINE_CORRECT_CODE so the hardcoded safety goal matches. - Lift shared FIPS 204 definitions (mldsa_cmod, mldsa_decompose_32, decompose_32_r{0,1}, mldsa_use_hint_32) and helpers (LOWER/UPPER _NONWRAP_R1, MLDSA_USE_HINT_32_UNFOLD) into common/mlkem_mldsa.ml. - Keep ENSURES_STRENGTHEN_POST local to the proof file (armstate-specific). Signed-off-by: Jake Massimo --- arm/proofs/mldsa_poly_use_hint_32.ml | 357 ++++++++++++--------------- common/mlkem_mldsa.ml | 82 ++++++ 2 files changed, 236 insertions(+), 203 deletions(-) diff --git a/arm/proofs/mldsa_poly_use_hint_32.ml b/arm/proofs/mldsa_poly_use_hint_32.ml index cb7e44682..b7d1d0451 100644 --- a/arm/proofs/mldsa_poly_use_hint_32.ml +++ b/arm/proofs/mldsa_poly_use_hint_32.ml @@ -10,11 +10,13 @@ needs "arm/proofs/base.ml";; needs "common/mlkem_mldsa.ml";; + (**** print_literal_from_elf "arm/mldsa/mldsa_poly_use_hint_32.o";; ****) let mldsa_poly_use_hint_32_mc = define_assert_from_elf "mldsa_poly_use_hint_32_mc" "arm/mldsa/mldsa_poly_use_hint_32.o" +(*** BYTECODE START ***) [ 0x529c0024; (* arm_MOV W4 (rvalue (word 57345)) *) 0x72a00fe4; (* arm_MOVK W4 (word 127) 16 *) @@ -28,7 +30,7 @@ let mldsa_poly_use_hint_32_mc = define_assert_from_elf 0x5280802b; (* arm_MOV W11 (rvalue (word 1025)) *) 0x72a8020b; (* arm_MOVK W11 (word 16400) 16 *) 0x4e040d77; (* arm_DUP_GEN Q23 X11 32 128 *) - 0x4f0005f8; (* arm_MOVI Q24 (word 15) *) + 0x4f0005f8; (* arm_MOVI Q24 (word 64424509455) *) 0xd2800203; (* arm_MOV X3 (rvalue (word 16)) *) 0x3dc00421; (* arm_LDR Q1 X1 (Immediate_Offset (word 16)) *) 0x3dc00822; (* arm_LDR Q2 X1 (Immediate_Offset (word 32)) *) @@ -45,7 +47,7 @@ let mldsa_poly_use_hint_32_mc = define_assert_from_elf 0x4e791e31; (* arm_BIC_VEC Q17 Q17 Q25 128 *) 0x4eb98421; (* arm_ADD_VEC Q1 Q1 Q25 32 128 *) 0x6ea09821; (* arm_CMLE_VEC_ZERO Q1 Q1 32 128 *) - 0x4f001421; (* arm_ORR_VEC Q1 Q1 (rvalue (word 1)) 128 *) + 0x4f001421; (* arm_ORR_VEC Q1 Q1 (rvalue (word 79228162532711081671548469249)) 128 *) 0x4ea59431; (* arm_MLA_VEC Q17 Q1 Q5 32 128 *) 0x4e381e31; (* arm_AND_VEC Q17 Q17 Q24 128 *) 0x4eb7b452; (* arm_SQDMULH_VEC Q18 Q2 Q23 32 128 *) @@ -55,7 +57,7 @@ let mldsa_poly_use_hint_32_mc = define_assert_from_elf 0x4e791e52; (* arm_BIC_VEC Q18 Q18 Q25 128 *) 0x4eb98442; (* arm_ADD_VEC Q2 Q2 Q25 32 128 *) 0x6ea09842; (* arm_CMLE_VEC_ZERO Q2 Q2 32 128 *) - 0x4f001422; (* arm_ORR_VEC Q2 Q2 (rvalue (word 1)) 128 *) + 0x4f001422; (* arm_ORR_VEC Q2 Q2 (rvalue (word 79228162532711081671548469249)) 128 *) 0x4ea69452; (* arm_MLA_VEC Q18 Q2 Q6 32 128 *) 0x4e381e52; (* arm_AND_VEC Q18 Q18 Q24 128 *) 0x4eb7b473; (* arm_SQDMULH_VEC Q19 Q3 Q23 32 128 *) @@ -65,7 +67,7 @@ let mldsa_poly_use_hint_32_mc = define_assert_from_elf 0x4e791e73; (* arm_BIC_VEC Q19 Q19 Q25 128 *) 0x4eb98463; (* arm_ADD_VEC Q3 Q3 Q25 32 128 *) 0x6ea09863; (* arm_CMLE_VEC_ZERO Q3 Q3 32 128 *) - 0x4f001423; (* arm_ORR_VEC Q3 Q3 (rvalue (word 1)) 128 *) + 0x4f001423; (* arm_ORR_VEC Q3 Q3 (rvalue (word 79228162532711081671548469249)) 128 *) 0x4ea79473; (* arm_MLA_VEC Q19 Q3 Q7 32 128 *) 0x4e381e73; (* arm_AND_VEC Q19 Q19 Q24 128 *) 0x4eb7b410; (* arm_SQDMULH_VEC Q16 Q0 Q23 32 128 *) @@ -75,7 +77,7 @@ let mldsa_poly_use_hint_32_mc = define_assert_from_elf 0x4e791e10; (* arm_BIC_VEC Q16 Q16 Q25 128 *) 0x4eb98400; (* arm_ADD_VEC Q0 Q0 Q25 32 128 *) 0x6ea09800; (* arm_CMLE_VEC_ZERO Q0 Q0 32 128 *) - 0x4f001420; (* arm_ORR_VEC Q0 Q0 (rvalue (word 1)) 128 *) + 0x4f001420; (* arm_ORR_VEC Q0 Q0 (rvalue (word 79228162532711081671548469249)) 128 *) 0x4ea49410; (* arm_MLA_VEC Q16 Q0 Q4 32 128 *) 0x4e381e10; (* arm_AND_VEC Q16 Q16 Q24 128 *) 0x3d800411; (* arm_STR Q17 X0 (Immediate_Offset (word 16)) *) @@ -83,37 +85,13 @@ let mldsa_poly_use_hint_32_mc = define_assert_from_elf 0x3d800c13; (* arm_STR Q19 X0 (Immediate_Offset (word 48)) *) 0x3c840410; (* arm_STR Q16 X0 (Postimmediate_Offset (word 64)) *) 0xf1000463; (* arm_SUBS X3 X3 (rvalue (word 1)) *) - 0x54fff961; (* arm_Bcond (word 4294966956) Condition_NE *) + 0x54fff961; (* arm_BNE (word 2096940) *) 0xd65f03c0 (* arm_RET X30 *) ];; +(*** BYTECODE END ***) let MLDSA_USE_HINT_32_EXEC = ARM_MK_EXEC_RULE mldsa_poly_use_hint_32_mc;; -(* ========================================================================= *) -(* Functional specification: UseHint for ML-DSA parameter sets 65/87 *) -(* *) -(* Constants: *) -(* Q = 8380417 *) -(* GAMMA2 = (Q-1)/32 = 261888 *) -(* 2*GAMMA2 = 523776 *) -(* Output range: [0, 15] *) -(* *) -(* This is the per-coefficient UseHint function from FIPS 204 Algorithm 38: *) -(* 1. decompose: a1 = round_half_down(a / 523776), a0 = a - a1*523776 *) -(* 2. if hint=0: return a1 mod 16 *) -(* 3. if a0 > 0: return (a1 + 1) mod 16 *) -(* 4. if a0 <= 0: return (a1 - 1) mod 16 *) -(* ========================================================================= *) - -let mldsa_use_hint_32_spec = new_definition - `mldsa_use_hint_32_spec (a:num) (h:num) = - let a1 = ((((a + 127) DIV 128) * 1025 + 2097152) DIV 4194304) MOD 16 in - let a0:int = &a - &a1 * &523776 in - let a0' = if a0 > &4190208 then a0 - &8380417 else a0 in - if h = 0 then a1 - else if a0' > &0 then (a1 + 1) MOD 16 - else (a1 + 15) MOD 16`;; - (* Per-element word function matching the assembly computation *) let mldsa_use_hint_32_asm = new_definition `mldsa_use_hint_32_asm (a:int32) (h:int32) : int32 = @@ -124,20 +102,29 @@ let mldsa_use_hint_32_asm = new_definition let delta:int32 = word_or (word_neg(word(bitval(word_ile a0 (word 0))))) (word 1) in word_and (word_add a1' (word_mul delta h)) (word 15)`;; +(* Numeric description of the assembly's UseHint path, exposing the Barrett + approximation used by the code. Connected to the FIPS 204 definition + mldsa_use_hint_32 via MLDSA_USE_HINT_32_EQUIV below. *) +let mldsa_use_hint_32_code = new_definition + `mldsa_use_hint_32_code (a:num) (h:num) = + let a1 = ((((a + 127) DIV 128) * 1025 + 2097152) DIV 4194304) MOD 16 in + let a0:int = &a - &a1 * &523776 in + let a0' = if a0 > &4190208 then a0 - &8380417 else a0 in + if h = 0 then a1 + else if a0' > &0 then (a1 + 1) MOD 16 + else (a1 + 15) MOD 16`;; + (* ========================================================================= *) (* Functional correctness helper lemmas *) (* ========================================================================= *) -let IVAL_SMALL = MLDSA_IVAL_VAL;; -let VAL_IWORD_NUM = VAL_IWORD_NUM_32;; - let WORD_2SMULH_NOSATURATE_32 = prove( `!a:int32. val a < 8380417 ==> word_2smulh a (word 1074791425:int32) : int32 = iword((&2 * &(val a) * &1074791425) div &2 pow 32)`, GEN_TAC THEN DISCH_TAC THEN REWRITE_TAC[word_2smulh; DIMINDEX_32] THEN - ASM_SIMP_TAC[IVAL_SMALL] THEN + ASM_SIMP_TAC[MLDSA_IVAL_VAL] THEN CONV_TAC WORD_REDUCE_CONV THEN REWRITE_TAC[iword_saturate; word_INT_MIN; word_INT_MAX; DIMINDEX_32] THEN CONV_TAC NUM_REDUCE_CONV THEN CONV_TAC WORD_REDUCE_CONV THEN @@ -167,11 +154,11 @@ let VAL_DECOMPOSE_A1 = prove( [MATCH_MP_TAC(ARITH_RULE `x <= y ==> x < y + 1`) THEN MATCH_MP_TAC DIV_MONO THEN ASM_ARITH_TAC; CONV_TAC NUM_REDUCE_CONV]; ALL_TAC] THEN REWRITE_TAC[INT_OF_NUM_CLAUSES] THEN SIMP_TAC[INT_OF_NUM_DIV] THEN - CONV_TAC NUM_REDUCE_CONV THEN ASM_SIMP_TAC[VAL_IWORD_NUM] THEN + CONV_TAC NUM_REDUCE_CONV THEN ASM_SIMP_TAC[VAL_IWORD_NUM_32] THEN ABBREV_TAC `t:int32 = iword(&((2 * val(a:int32) * 1074791425) DIV 4294967296))` THEN SUBGOAL_THEN `val(t:int32) = (2 * val(a:int32) * 1074791425) DIV 4294967296` ASSUME_TAC THENL - [EXPAND_TAC "t" THEN MATCH_MP_TAC VAL_IWORD_NUM THEN ASM_REWRITE_TAC[]; ALL_TAC] THEN + [EXPAND_TAC "t" THEN MATCH_MP_TAC VAL_IWORD_NUM_32 THEN ASM_REWRITE_TAC[]; ALL_TAC] THEN SUBGOAL_THEN `val(t:int32) < 2147483648` ASSUME_TAC THENL [ASM_REWRITE_TAC[]; ALL_TAC] THEN REWRITE_TAC[word_ishr_round] THEN CONV_TAC NUM_REDUCE_CONV THEN CONV_TAC INT_REDUCE_CONV THEN @@ -185,7 +172,7 @@ let VAL_DECOMPOSE_A1 = prove( TRANS_TAC LT_TRANS `(4194303 + 131072) DIV 262144 + 1` THEN CONJ_TAC THENL [MATCH_MP_TAC(ARITH_RULE `x <= y ==> x < y + 1`) THEN MATCH_MP_TAC DIV_MONO THEN ASM_ARITH_TAC; CONV_TAC NUM_REDUCE_CONV]; ALL_TAC] THEN - ASM_SIMP_TAC[VAL_IWORD_NUM] THEN MATCH_MP_TAC VAL_IWORD_NUM THEN + ASM_SIMP_TAC[VAL_IWORD_NUM_32] THEN MATCH_MP_TAC VAL_IWORD_NUM_32 THEN UNDISCH_THEN `val(t:int32) = (2 * val(a:int32) * 1074791425) DIV 4294967296` (SUBST1_TAC o SYM) THEN ASM_REWRITE_TAC[]);; @@ -339,9 +326,9 @@ let BARRETT_EQUIV = prove( let ELEMENT_CORRECT = prove( `!a:int32 h:int32. val a < 8380417 /\ val h <= 1 - ==> val(mldsa_use_hint_32_asm a h) = mldsa_use_hint_32_spec (val a) (val h)`, + ==> val(mldsa_use_hint_32_asm a h) = mldsa_use_hint_32_code (val a) (val h)`, REPEAT GEN_TAC THEN STRIP_TAC THEN - REWRITE_TAC[mldsa_use_hint_32_asm; mldsa_use_hint_32_spec] THEN + REWRITE_TAC[mldsa_use_hint_32_asm; mldsa_use_hint_32_code] THEN CONV_TAC(TOP_DEPTH_CONV let_CONV) THEN ABBREV_TAC `nv = ((val(a:int32) + 127) DIV 128 * 1025 + 2097152) DIV 4194304` THEN SUBGOAL_THEN `val(word_ishr_round (word_2smulh (a:int32) (word 1074791425)) 18 : int32) = nv` ASSUME_TAC THENL @@ -405,16 +392,16 @@ let ELEMENT_CORRECT_WORD = prove( `!a:int32 h:int32. val a < 8380417 /\ val h <= 1 ==> mldsa_use_hint_32_asm a h = - word(mldsa_use_hint_32_spec (val a) (val h))`, + word(mldsa_use_hint_32_code (val a) (val h))`, REPEAT GEN_TAC THEN STRIP_TAC THEN GEN_REWRITE_TAC LAND_CONV [GSYM WORD_VAL] THEN AP_TERM_TAC THEN MP_TAC(SPECL [`a:int32`; `h:int32`] ELEMENT_CORRECT) THEN ASM_REWRITE_TAC[] THEN DISCH_THEN(fun th -> REWRITE_TAC[th]));; (* ========================================================================= *) -(* Correctness proof (output bounds) *) +(* Correctness proof, code-aligned spec (intermediate) *) (* ========================================================================= *) -let MLDSA_USE_HINT_32_CORRECT = prove +let MLDSA_USE_HINT_32_CORRECT_CODE = prove (`!b a h x y pc. nonoverlapping (word pc, LENGTH mldsa_poly_use_hint_32_mc) (b, 1024) /\ nonoverlapping (b, 1024) (a, 1024) /\ @@ -429,10 +416,10 @@ let MLDSA_USE_HINT_32_CORRECT = prove read(memory :> bytes32(word_add a (word(4 * i)))) s = x i) /\ (!i. i < 256 ==> read(memory :> bytes32(word_add h (word(4 * i)))) s = y i)) - (\s. read PC s = word(pc + 0x110) /\ + (\s. read PC s = word(pc + LENGTH mldsa_poly_use_hint_32_mc - 4) /\ (!i. i < 256 ==> read(memory :> bytes32(word_add b (word(4 * i)))) s = - word(mldsa_use_hint_32_spec (val(x i)) (val(y i))))) + word(mldsa_use_hint_32_code (val(x i)) (val(y i))))) (MAYCHANGE_REGS_AND_FLAGS_PERMITTED_BY_ABI ,, MAYCHANGE [memory :> bytes(b, 1024)])`, @@ -503,10 +490,66 @@ let MLDSA_USE_HINT_32_CORRECT = prove (* ========================================================================= *) -(* Subroutine form *) +(* Subroutine form (intermediate, code-aligned) *) (* ========================================================================= *) -let MLDSA_USE_HINT_32_SUBROUTINE_CORRECT = prove +let ENSURES_STRENGTHEN_POST = prove( + `!P (Q:armstate->bool) Q' R. + ensures arm P Q' R /\ (!s. Q' s ==> Q s) ==> ensures arm P Q R`, + REPEAT GEN_TAC THEN DISCH_THEN(CONJUNCTS_THEN2 MP_TAC ASSUME_TAC) THEN + REWRITE_TAC[ensures] THEN MATCH_MP_TAC MONO_FORALL THEN + X_GEN_TAC `s0:armstate` THEN MATCH_MP_TAC MONO_IMP THEN REWRITE_TAC[] THEN + MP_TAC(BETA_RULE(ISPECL [`arm`; + `\s':armstate. (Q':armstate->bool) s' /\ (R:armstate->armstate->bool) (s0:armstate) s'`; + `\s':armstate. (Q:armstate->bool) s' /\ (R:armstate->armstate->bool) (s0:armstate) s'`] + EVENTUALLY_MONO)) THEN + ANTS_TAC THENL [ASM_MESON_TAC[]; MESON_TAC[]]);; + +let MLDSA_USE_HINT_32_CORRECT_BOUND_CODE = prove + (`!b a h x y pc. + nonoverlapping (word pc, LENGTH mldsa_poly_use_hint_32_mc) (b, 1024) /\ + nonoverlapping (b, 1024) (a, 1024) /\ + nonoverlapping (b, 1024) (h, 1024) + ==> ensures arm + (\s. aligned_bytes_loaded s (word pc) mldsa_poly_use_hint_32_mc /\ + read PC s = word pc /\ + C_ARGUMENTS [b; a; h] s /\ + (!i. i < 256 ==> val(x i) < 8380417) /\ + (!i. i < 256 ==> val(y i) <= 1) /\ + (!i. i < 256 ==> + read(memory :> bytes32(word_add a (word(4 * i)))) s = x i) /\ + (!i. i < 256 ==> + read(memory :> bytes32(word_add h (word(4 * i)))) s = y i)) + (\s. read PC s = word(pc + LENGTH mldsa_poly_use_hint_32_mc - 4) /\ + (!i. i < 256 ==> + read(memory :> bytes32(word_add b (word(4 * i)))) s = + word(mldsa_use_hint_32_code (val(x i)) (val(y i)))) /\ + (!i. i < 256 ==> + val(read(memory :> bytes32(word_add b (word(4 * i)))) s) < 16)) + (MAYCHANGE_REGS_AND_FLAGS_PERMITTED_BY_ABI ,, + MAYCHANGE [memory :> bytes(b, 1024)])`, + REPEAT GEN_TAC THEN DISCH_TAC THEN + MATCH_MP_TAC ENSURES_STRENGTHEN_POST THEN + EXISTS_TAC + `\s. read PC s = word(pc + LENGTH mldsa_poly_use_hint_32_mc - 4) /\ + (!i. i < 256 ==> + read(memory :> bytes32(word_add b (word(4 * i)))) s = + word(mldsa_use_hint_32_code (val(x i:int32)) (val(y i:int32))))` THEN + CONJ_TAC THENL + [MATCH_MP_TAC MLDSA_USE_HINT_32_CORRECT_CODE THEN ASM_REWRITE_TAC[]; + REWRITE_TAC[] THEN REPEAT STRIP_TAC THEN ASM_REWRITE_TAC[] THEN + FIRST_X_ASSUM(MP_TAC o SPEC `i:num`) THEN ASM_REWRITE_TAC[] THEN + DISCH_THEN SUBST1_TAC THEN REWRITE_TAC[VAL_WORD; DIMINDEX_32] THEN + CONV_TAC NUM_REDUCE_CONV THEN + MATCH_MP_TAC(ARITH_RULE `x < 16 ==> x MOD 4294967296 < 16`) THEN + REWRITE_TAC[mldsa_use_hint_32_code] THEN + CONV_TAC(TOP_DEPTH_CONV let_CONV) THEN + REPEAT(COND_CASES_TAC THEN ASM_REWRITE_TAC[]) THEN ASM_ARITH_TAC]);; + +(* Intermediate subroutine correctness against the code-aligned spec. + Bridged to the public FIPS 204-aligned theorem below via + MLDSA_USE_HINT_32_EQUIV. *) +let MLDSA_USE_HINT_32_SUBROUTINE_CORRECT_CODE = prove (`!b a h x y pc returnaddress. nonoverlapping (word pc, LENGTH mldsa_poly_use_hint_32_mc) (b, 1024) /\ nonoverlapping (b, 1024) (a, 1024) /\ @@ -525,133 +568,17 @@ let MLDSA_USE_HINT_32_SUBROUTINE_CORRECT = prove (\s. read PC s = returnaddress /\ (!i. i < 256 ==> read(memory :> bytes32(word_add b (word(4 * i)))) s = - word(mldsa_use_hint_32_spec (val(x i)) (val(y i))))) + word(mldsa_use_hint_32_code (val(x i)) (val(y i)))) /\ + (!i. i < 256 ==> + val(read(memory :> bytes32(word_add b (word(4 * i)))) s) < 16)) (MAYCHANGE_REGS_AND_FLAGS_PERMITTED_BY_ABI ,, MAYCHANGE [memory :> bytes(b, 1024)])`, REWRITE_TAC[fst MLDSA_USE_HINT_32_EXEC] THEN + CONV_TAC NUM_REDUCE_CONV THEN ARM_ADD_RETURN_NOSTACK_TAC MLDSA_USE_HINT_32_EXEC - (REWRITE_RULE[fst MLDSA_USE_HINT_32_EXEC] - MLDSA_USE_HINT_32_CORRECT));; - - -(* ========================================================================= *) -(* Constant-time and memory safety proof. *) -(* ========================================================================= *) - -needs "arm/proofs/consttime.ml";; -needs "arm/proofs/subroutine_signatures.ml";; - - -let full_spec,public_vars = mk_safety_spec - ~keep_maychanges:false - (assoc "mldsa_poly_use_hint_32" subroutine_signatures) - MLDSA_USE_HINT_32_SUBROUTINE_CORRECT - MLDSA_USE_HINT_32_EXEC;; - -let MLDSA_USE_HINT_32_SUBROUTINE_SAFE = time prove - (`exists f_events. - forall e b a h pc returnaddress. - nonoverlapping (word pc,LENGTH mldsa_poly_use_hint_32_mc) (b,1024) /\ - nonoverlapping (b,1024) (a,1024) /\ - nonoverlapping (b,1024) (h,1024) - ==> ensures arm - (\s. - aligned_bytes_loaded s (word pc) - mldsa_poly_use_hint_32_mc /\ - read PC s = word pc /\ - read X30 s = returnaddress /\ - C_ARGUMENTS [b; a; h] s /\ - read events s = e) - (\s. - read PC s = returnaddress /\ - (exists e2. - read events s = APPEND e2 e /\ - e2 = f_events a h b pc returnaddress /\ - memaccess_inbounds e2 [a,1024; h,1024; b,1024] - [b,1024])) - (\s s'. true)`, - ASSERT_CONCL_TAC full_spec THEN - PROVE_SAFETY_SPEC_TAC ~public_vars:public_vars MLDSA_USE_HINT_32_EXEC);; -(* ========================================================================= *) - -let mldsa_cmod = new_definition - `mldsa_cmod (r:num) (m:num) : int = - if (r MOD m) * 2 <= m then &(r MOD m) else &(r MOD m) - &m`;; - -let mldsa_decompose_32 = new_definition - `mldsa_decompose_32 (r:num) : num # int = - let r0 = mldsa_cmod r 523776 in - if &r - r0 = &8380416 then (0, r0 - &1) - else (num_of_int((&r - r0) div &523776), r0)`;; - -let decompose_32_r1 = new_definition - `decompose_32_r1 (r:num) : num = FST(mldsa_decompose_32 r)`;; - -let decompose_32_r0 = new_definition - `decompose_32_r0 (r:num) : int = SND(mldsa_decompose_32 r)`;; - -let mldsa_use_hint_32 = new_definition - `mldsa_use_hint_32 (h:num) (r:num) : num = - let (r1, r0) = mldsa_decompose_32 r in - if h = 1 /\ r0 > &0 then (r1 + 1) MOD 16 - else if h = 1 /\ r0 <= &0 then (r1 + 15) MOD 16 - else r1`;; - -let LOWER_NONWRAP_R1 = prove( - `!r. r MOD 523776 * 2 <= 523776 /\ - ~((&r:int) - &(r MOD 523776) = &8380416) ==> - decompose_32_r1 r = r DIV 523776`, - GEN_TAC THEN STRIP_TAC THEN - REWRITE_TAC[decompose_32_r1; mldsa_decompose_32; mldsa_cmod] THEN - CONV_TAC(TOP_DEPTH_CONV let_CONV) THEN ASM_REWRITE_TAC[] THEN - SUBGOAL_THEN `r MOD 523776 <= r` ASSUME_TAC THENL - [MESON_TAC[MOD_LE]; ALL_TAC] THEN - ASM_SIMP_TAC[INT_OF_NUM_SUB; INT_OF_NUM_DIV; - NUM_OF_INT_OF_NUM; INT_OF_NUM_EQ] THEN - MP_TAC(SPECL [`r:num`; `523776`] (CONJUNCT1 DIVISION_SIMP)) THEN - DISCH_TAC THEN - SUBGOAL_THEN `r - r MOD 523776 = 523776 * r DIV 523776` SUBST1_TAC THENL - [ASM_ARITH_TAC; ALL_TAC] THEN - MP_TAC(SPECL [`523776`; `r DIV 523776`] DIV_MULT) THEN - CONV_TAC NUM_REDUCE_CONV);; - -let UPPER_NONWRAP_R1 = prove( - `!r. ~(r MOD 523776 * 2 <= 523776) /\ - ~((&r:int) - (&(r MOD 523776) - &523776) = &8380416) ==> - decompose_32_r1 r = r DIV 523776 + 1`, - GEN_TAC THEN STRIP_TAC THEN - REWRITE_TAC[decompose_32_r1; mldsa_decompose_32; mldsa_cmod] THEN - CONV_TAC(TOP_DEPTH_CONV let_CONV) THEN ASM_REWRITE_TAC[] THEN - SUBGOAL_THEN `r MOD 523776 <= r` ASSUME_TAC THENL - [MESON_TAC[MOD_LE]; ALL_TAC] THEN - SUBGOAL_THEN `r MOD 523776 < 523776` ASSUME_TAC THENL - [MP_TAC(SPECL [`r:num`; `523776`] MOD_LT_EQ) THEN ARITH_TAC; ALL_TAC] THEN - SUBGOAL_THEN `(&r:int) - (&(r MOD 523776) - &523776) = - &(r - r MOD 523776 + 523776)` ASSUME_TAC THENL - [ASM_SIMP_TAC[GSYM INT_OF_NUM_SUB; GSYM INT_OF_NUM_ADD] THEN - INT_ARITH_TAC; ALL_TAC] THEN - ASM_REWRITE_TAC[INT_OF_NUM_DIV; NUM_OF_INT_OF_NUM; INT_OF_NUM_EQ] THEN - MP_TAC(SPECL [`r:num`; `523776`] (CONJUNCT1 DIVISION_SIMP)) THEN - DISCH_TAC THEN - SUBGOAL_THEN `r - r MOD 523776 + 523776 = (r DIV 523776 + 1) * 523776` - ASSUME_TAC THENL - [ASM_ARITH_TAC; ALL_TAC] THEN - ASM_REWRITE_TAC[] THEN - MP_TAC(SPECL [`(r DIV 523776 + 1) * 523776`; `523776`] DIV_MULT) THEN - ARITH_TAC);; - -(* Unfold mldsa_use_hint_32 eliminating the paired let *) -let MLDSA_USE_HINT_32_UNFOLD = prove( - `!h r. mldsa_use_hint_32 h r = - (if h = 1 /\ decompose_32_r0 r > &0 then (decompose_32_r1 r + 1) MOD 16 - else if h = 1 /\ decompose_32_r0 r <= &0 - then (decompose_32_r1 r + 15) MOD 16 - else decompose_32_r1 r)`, - REPEAT GEN_TAC THEN - REWRITE_TAC[mldsa_use_hint_32; decompose_32_r1; decompose_32_r0] THEN - SPEC_TAC(`mldsa_decompose_32 r`, `p:num#int`) THEN - REWRITE_TAC[FORALL_PAIR_THM] THEN - CONV_TAC(TOP_DEPTH_CONV let_CONV) THEN REWRITE_TAC[]);; + (CONV_RULE(ONCE_DEPTH_CONV NUM_REDUCE_CONV) + (REWRITE_RULE[fst MLDSA_USE_HINT_32_EXEC] + MLDSA_USE_HINT_32_CORRECT_BOUND_CODE)));; (* ========================================================================= *) @@ -929,10 +856,10 @@ let DECOMPOSE_32_R0_SIGN = time prove( let MLDSA_USE_HINT_32_EQUIV = prove( `!r h. r < 8380417 /\ h <= 1 - ==> mldsa_use_hint_32 h r = mldsa_use_hint_32_spec r h`, + ==> mldsa_use_hint_32 h r = mldsa_use_hint_32_code r h`, REPEAT GEN_TAC THEN STRIP_TAC THEN REWRITE_TAC[MLDSA_USE_HINT_32_UNFOLD] THEN - REWRITE_TAC[mldsa_use_hint_32_spec] THEN + REWRITE_TAC[mldsa_use_hint_32_code] THEN CONV_TAC(TOP_DEPTH_CONV let_CONV) THEN MP_TAC(SPEC `r:num` DECOMPOSE_32_R1_EQUIV) THEN ASM_REWRITE_TAC[] THEN DISCH_TAC THEN @@ -945,22 +872,16 @@ let MLDSA_USE_HINT_32_EQUIV = prove( ASM_CASES_TAC `decompose_32_r0 r > &0` THEN ASM_REWRITE_TAC[] THEN ASM_MESON_TAC[]);; -let ENSURES_STRENGTHEN_POST = prove( - `!P (Q:armstate->bool) Q' R. - ensures arm P Q' R /\ (!s. Q' s ==> Q s) ==> ensures arm P Q R`, - REPEAT GEN_TAC THEN DISCH_THEN(CONJUNCTS_THEN2 MP_TAC ASSUME_TAC) THEN - REWRITE_TAC[ensures] THEN MATCH_MP_TAC MONO_FORALL THEN - X_GEN_TAC `s0:armstate` THEN MATCH_MP_TAC MONO_IMP THEN REWRITE_TAC[] THEN - MP_TAC(BETA_RULE(ISPECL [`arm`; - `\s':armstate. (Q':armstate->bool) s' /\ (R:armstate->armstate->bool) (s0:armstate) s'`; - `\s':armstate. (Q:armstate->bool) s' /\ (R:armstate->armstate->bool) (s0:armstate) s'`] - EVENTUALLY_MONO)) THEN - ANTS_TAC THENL [ASM_MESON_TAC[]; MESON_TAC[]]);; +(* ========================================================================= *) +(* Public subroutine correctness (FIPS 204-aligned) *) +(* ========================================================================= *) -(* FIPS 204-aligned subroutine correctness. - Derived from the code-aligned SUBROUTINE_CORRECT by rewriting - mldsa_use_hint_32_spec -> mldsa_use_hint_32 via MLDSA_USE_HINT_32_EQUIV. *) -let MLDSA_USE_HINT_32_SUBROUTINE_CORRECT_FIPS204 = prove +(* Postcondition is stated in terms of mldsa_use_hint_32 from FIPS 204 + (Algorithm 40), with the output bound < 16 as a corollary. + Derived from MLDSA_USE_HINT_32_SUBROUTINE_CORRECT_CODE by + rewriting mldsa_use_hint_32_code -> mldsa_use_hint_32 via + MLDSA_USE_HINT_32_EQUIV. *) +let MLDSA_USE_HINT_32_SUBROUTINE_CORRECT = prove (`!b a h x y pc returnaddress. nonoverlapping (word pc, LENGTH mldsa_poly_use_hint_32_mc) (b, 1024) /\ nonoverlapping (b, 1024) (a, 1024) /\ @@ -981,7 +902,9 @@ let MLDSA_USE_HINT_32_SUBROUTINE_CORRECT_FIPS204 = prove (\s. read PC s = returnaddress /\ (!i. i < 256 ==> read(memory :> bytes32(word_add b (word(4 * i)))) s = - word(mldsa_use_hint_32 (val(y i)) (val(x i))))) + word(mldsa_use_hint_32 (val(y i)) (val(x i)))) /\ + (!i. i < 256 ==> + val(read(memory :> bytes32(word_add b (word(4 * i)))) s) < 16)) (MAYCHANGE_REGS_AND_FLAGS_PERMITTED_BY_ABI ,, MAYCHANGE [memory :> bytes(b, 1024)])`, REPEAT GEN_TAC THEN @@ -989,22 +912,50 @@ let MLDSA_USE_HINT_32_SUBROUTINE_CORRECT_FIPS204 = prove SUBGOAL_THEN `!i. i < 256 ==> mldsa_use_hint_32 (val((y:num->int32) i)) (val((x:num->int32) i)) = - mldsa_use_hint_32_spec (val(x i)) (val(y i))` + mldsa_use_hint_32_code (val(x i)) (val(y i))` (fun th -> SIMP_TAC[th]) THENL [REPEAT STRIP_TAC THEN MATCH_MP_TAC MLDSA_USE_HINT_32_EQUIV THEN CONJ_TAC THEN FIRST_X_ASSUM MATCH_MP_TAC THEN ASM_REWRITE_TAC[]; - MATCH_MP_TAC ENSURES_STRENGTHEN_POST THEN - EXISTS_TAC - `\s. read PC s = returnaddress /\ - (!i. i < 256 ==> - read(memory :> bytes32(word_add b (word(4 * i)))) s = - word(mldsa_use_hint_32_spec (val(x i:int32)) (val(y i:int32)))) /\ - (!i. i < 256 ==> - val(read(memory :> bytes32(word_add b (word(4 * i)))) s) < 16)` THEN - CONJ_TAC THENL - [MATCH_MP_TAC MLDSA_USE_HINT_32_SUBROUTINE_CORRECT THEN - ASM_REWRITE_TAC[]; - GEN_TAC THEN CONV_TAC(ONCE_DEPTH_CONV BETA_CONV) THEN - DISCH_THEN(REPEAT_TCL CONJUNCTS_THEN ASSUME_TAC) THEN - ASM_REWRITE_TAC[]]]);; + MATCH_MP_TAC MLDSA_USE_HINT_32_SUBROUTINE_CORRECT_CODE THEN + ASM_REWRITE_TAC[]]);; + + +(* ========================================================================= *) +(* Constant-time and memory safety proof. *) +(* ========================================================================= *) + +needs "arm/proofs/consttime.ml";; +needs "arm/proofs/subroutine_signatures.ml";; + + +let full_spec,public_vars = mk_safety_spec + ~keep_maychanges:false + (assoc "mldsa_poly_use_hint_32" subroutine_signatures) + MLDSA_USE_HINT_32_SUBROUTINE_CORRECT_CODE + MLDSA_USE_HINT_32_EXEC;; + +let MLDSA_USE_HINT_32_SUBROUTINE_SAFE = time prove + (`exists f_events. + forall e b a h pc returnaddress. + nonoverlapping (word pc,LENGTH mldsa_poly_use_hint_32_mc) (b,1024) /\ + nonoverlapping (b,1024) (a,1024) /\ + nonoverlapping (b,1024) (h,1024) + ==> ensures arm + (\s. + aligned_bytes_loaded s (word pc) + mldsa_poly_use_hint_32_mc /\ + read PC s = word pc /\ + read X30 s = returnaddress /\ + C_ARGUMENTS [b; a; h] s /\ + read events s = e) + (\s. + read PC s = returnaddress /\ + (exists e2. + read events s = APPEND e2 e /\ + e2 = f_events a h b pc returnaddress /\ + memaccess_inbounds e2 [a,1024; h,1024; b,1024] + [b,1024])) + (\s s'. true)`, + ASSERT_CONCL_TAC full_spec THEN + PROVE_SAFETY_SPEC_TAC ~public_vars:public_vars MLDSA_USE_HINT_32_EXEC);; diff --git a/common/mlkem_mldsa.ml b/common/mlkem_mldsa.ml index dcda7c52c..13c20969f 100644 --- a/common/mlkem_mldsa.ml +++ b/common/mlkem_mldsa.ml @@ -2017,3 +2017,85 @@ let INT_MOD_RESIDUE = prove( REWRITE_TAC[GSYM INT_OF_NUM_MUL; GSYM INT_OF_NUM_ADD; GSYM INT_OF_NUM_EQ] THEN INT_ARITH_TAC);; + +(* ========================================================================= *) +(* FIPS 204 UseHint definitions (Algorithms 36 and 40) *) +(* ========================================================================= *) + +let mldsa_cmod = new_definition + `mldsa_cmod (r:num) (m:num) : int = + if (r MOD m) * 2 <= m then &(r MOD m) else &(r MOD m) - &m`;; + +let mldsa_decompose_32 = new_definition + `mldsa_decompose_32 (r:num) : num # int = + let r0 = mldsa_cmod r 523776 in + if &r - r0 = &8380416 then (0, r0 - &1) + else (num_of_int((&r - r0) div &523776), r0)`;; + +let decompose_32_r1 = new_definition + `decompose_32_r1 (r:num) : num = FST(mldsa_decompose_32 r)`;; + +let decompose_32_r0 = new_definition + `decompose_32_r0 (r:num) : int = SND(mldsa_decompose_32 r)`;; + +let mldsa_use_hint_32 = new_definition + `mldsa_use_hint_32 (h:num) (r:num) : num = + let (r1, r0) = mldsa_decompose_32 r in + if h = 1 /\ r0 > &0 then (r1 + 1) MOD 16 + else if h = 1 /\ r0 <= &0 then (r1 + 15) MOD 16 + else r1`;; + +let LOWER_NONWRAP_R1 = prove( + `!r. r MOD 523776 * 2 <= 523776 /\ + ~((&r:int) - &(r MOD 523776) = &8380416) ==> + decompose_32_r1 r = r DIV 523776`, + GEN_TAC THEN STRIP_TAC THEN + REWRITE_TAC[decompose_32_r1; mldsa_decompose_32; mldsa_cmod] THEN + CONV_TAC(TOP_DEPTH_CONV let_CONV) THEN ASM_REWRITE_TAC[] THEN + SUBGOAL_THEN `r MOD 523776 <= r` ASSUME_TAC THENL + [MESON_TAC[MOD_LE]; ALL_TAC] THEN + ASM_SIMP_TAC[INT_OF_NUM_SUB; INT_OF_NUM_DIV; + NUM_OF_INT_OF_NUM; INT_OF_NUM_EQ] THEN + MP_TAC(SPECL [`r:num`; `523776`] (CONJUNCT1 DIVISION_SIMP)) THEN + DISCH_TAC THEN + SUBGOAL_THEN `r - r MOD 523776 = 523776 * r DIV 523776` SUBST1_TAC THENL + [ASM_ARITH_TAC; ALL_TAC] THEN + MP_TAC(SPECL [`523776`; `r DIV 523776`] DIV_MULT) THEN + CONV_TAC NUM_REDUCE_CONV);; + +let UPPER_NONWRAP_R1 = prove( + `!r. ~(r MOD 523776 * 2 <= 523776) /\ + ~((&r:int) - (&(r MOD 523776) - &523776) = &8380416) ==> + decompose_32_r1 r = r DIV 523776 + 1`, + GEN_TAC THEN STRIP_TAC THEN + REWRITE_TAC[decompose_32_r1; mldsa_decompose_32; mldsa_cmod] THEN + CONV_TAC(TOP_DEPTH_CONV let_CONV) THEN ASM_REWRITE_TAC[] THEN + SUBGOAL_THEN `r MOD 523776 <= r` ASSUME_TAC THENL + [MESON_TAC[MOD_LE]; ALL_TAC] THEN + SUBGOAL_THEN `r MOD 523776 < 523776` ASSUME_TAC THENL + [MP_TAC(SPECL [`r:num`; `523776`] MOD_LT_EQ) THEN ARITH_TAC; ALL_TAC] THEN + SUBGOAL_THEN `(&r:int) - (&(r MOD 523776) - &523776) = + &(r - r MOD 523776 + 523776)` ASSUME_TAC THENL + [ASM_SIMP_TAC[GSYM INT_OF_NUM_SUB; GSYM INT_OF_NUM_ADD] THEN + INT_ARITH_TAC; ALL_TAC] THEN + ASM_REWRITE_TAC[INT_OF_NUM_DIV; NUM_OF_INT_OF_NUM; INT_OF_NUM_EQ] THEN + MP_TAC(SPECL [`r:num`; `523776`] (CONJUNCT1 DIVISION_SIMP)) THEN + DISCH_TAC THEN + SUBGOAL_THEN `r - r MOD 523776 + 523776 = (r DIV 523776 + 1) * 523776` + ASSUME_TAC THENL + [ASM_ARITH_TAC; ALL_TAC] THEN + ASM_REWRITE_TAC[] THEN + MP_TAC(SPECL [`(r DIV 523776 + 1) * 523776`; `523776`] DIV_MULT) THEN + ARITH_TAC);; + +let MLDSA_USE_HINT_32_UNFOLD = prove( + `!h r. mldsa_use_hint_32 h r = + (if h = 1 /\ decompose_32_r0 r > &0 then (decompose_32_r1 r + 1) MOD 16 + else if h = 1 /\ decompose_32_r0 r <= &0 + then (decompose_32_r1 r + 15) MOD 16 + else decompose_32_r1 r)`, + REPEAT GEN_TAC THEN + REWRITE_TAC[mldsa_use_hint_32; decompose_32_r1; decompose_32_r0] THEN + SPEC_TAC(`mldsa_decompose_32 r`, `p:num#int`) THEN + REWRITE_TAC[FORALL_PAIR_THM] THEN + CONV_TAC(TOP_DEPTH_CONV let_CONV) THEN REWRITE_TAC[]);; From 05e44d75bdb26a05d2757b426aaac21478563457 Mon Sep 17 00:00:00 2001 From: Jake Massimo Date: Fri, 29 May 2026 20:29:09 +0000 Subject: [PATCH 10/11] Consolidate mldsa_poly_use_hint_32 _CORRECT theorems The poly_use_hint_32 proof exposed a non-standard _CORRECT / _CORRECT_CODE split that doesn't appear in any other proof in s2n-bignum (or in mlkem-native / mldsa-native). This consolidates the proof into a single FIPS 204-aligned _CORRECT theorem and a single _SUBROUTINE_CORRECT, matching the convention used by the rest of the codebase. Internal intermediates _CORRECT_CODE, _CORRECT_BOUND_CODE, and _SUBROUTINE_CORRECT_CODE are removed. The new _CORRECT places the input-bound antecedents (val(x i) < 8380417 /\ val(y i) <= 1) inside the postcondition (decompose-style), so the assembly's symbolic execution doesn't depend on input ranges. This matches the shape used by poly_decompose_32 and poly_decompose_88 in mldsa-native. Mechanics: - The FIPS 204 / code-aligned equivalence section (MLDSA_USE_HINT_32_EQUIV) moves above the correctness proof. - The new _CORRECT runs the 878-step ARM symbolic execution without using input bounds, then DISCH_THEN(CONJUNCTS_THEN ASSUME_TAC) picks up the bounds from the postcondition antecedent. - Per-element FIPS-equality is closed via a derived EC_FINAL helper after IMP_REWRITE_TAC[MLDSA_USE_HINT_32_EQUIV]. - The val < 16 corollary is closed by reducing val(word ..) to MOD via VAL_WORD and discharging via the bound on mldsa_use_hint_32_code. - _SUBROUTINE_CORRECT derives from _CORRECT via ARM_ADD_RETURN_NOSTACK_TAC. Verified end-to-end: the new proof closes in 25:10 wall time, exit 0, no axioms. Signed-off-by: Jake Massimo --- arm/proofs/mldsa_poly_use_hint_32.ml | 405 +++++++++++++-------------- arm/proofs/subroutine_signatures.ml | 4 - 2 files changed, 195 insertions(+), 214 deletions(-) diff --git a/arm/proofs/mldsa_poly_use_hint_32.ml b/arm/proofs/mldsa_poly_use_hint_32.ml index b7d1d0451..d2d9312b1 100644 --- a/arm/proofs/mldsa_poly_use_hint_32.ml +++ b/arm/proofs/mldsa_poly_use_hint_32.ml @@ -397,193 +397,18 @@ let ELEMENT_CORRECT_WORD = prove( GEN_REWRITE_TAC LAND_CONV [GSYM WORD_VAL] THEN AP_TERM_TAC THEN MP_TAC(SPECL [`a:int32`; `h:int32`] ELEMENT_CORRECT) THEN ASM_REWRITE_TAC[] THEN DISCH_THEN(fun th -> REWRITE_TAC[th]));; -(* ========================================================================= *) -(* Correctness proof, code-aligned spec (intermediate) *) -(* ========================================================================= *) - -let MLDSA_USE_HINT_32_CORRECT_CODE = prove - (`!b a h x y pc. - nonoverlapping (word pc, LENGTH mldsa_poly_use_hint_32_mc) (b, 1024) /\ - nonoverlapping (b, 1024) (a, 1024) /\ - nonoverlapping (b, 1024) (h, 1024) - ==> ensures arm - (\s. aligned_bytes_loaded s (word pc) mldsa_poly_use_hint_32_mc /\ - read PC s = word pc /\ - C_ARGUMENTS [b; a; h] s /\ - (!i. i < 256 ==> val(x i) < 8380417) /\ - (!i. i < 256 ==> val(y i) <= 1) /\ - (!i. i < 256 ==> - read(memory :> bytes32(word_add a (word(4 * i)))) s = x i) /\ - (!i. i < 256 ==> - read(memory :> bytes32(word_add h (word(4 * i)))) s = y i)) - (\s. read PC s = word(pc + LENGTH mldsa_poly_use_hint_32_mc - 4) /\ - (!i. i < 256 ==> - read(memory :> bytes32(word_add b (word(4 * i)))) s = - word(mldsa_use_hint_32_code (val(x i)) (val(y i))))) - (MAYCHANGE_REGS_AND_FLAGS_PERMITTED_BY_ABI ,, - MAYCHANGE [memory :> bytes(b, 1024)])`, - - (* Setup *) - MAP_EVERY X_GEN_TAC - [`b:int64`; `a:int64`; `h:int64`; - `x:num->int32`; `y:num->int32`; `pc:num`] THEN - REWRITE_TAC[MAYCHANGE_REGS_AND_FLAGS_PERMITTED_BY_ABI; C_ARGUMENTS; - NONOVERLAPPING_CLAUSES; ALL; - fst MLDSA_USE_HINT_32_EXEC] THEN - DISCH_THEN(REPEAT_TCL CONJUNCTS_THEN ASSUME_TAC) THEN - GLOBALIZE_PRECONDITION_TAC THEN - CONV_TAC(RATOR_CONV(LAND_CONV(ONCE_DEPTH_CONV EXPAND_CASES_CONV))) THEN - CONV_TAC NUM_REDUCE_CONV THEN - REPEAT STRIP_TAC THEN - REWRITE_TAC[SOME_FLAGS; MODIFIABLE_SIMD_REGS] THEN - - (* Initialize and merge memory *) - ENSURES_INIT_TAC "s0" THEN - MEMORY_128_FROM_32_TAC "a" 0 64 THEN - ASM_REWRITE_TAC[WORD_ADD_0] THEN CONV_TAC WORD_REDUCE_CONV THEN - STRIP_TAC THEN - MEMORY_128_FROM_32_TAC "h" 0 64 THEN - ASM_REWRITE_TAC[WORD_ADD_0] THEN CONV_TAC WORD_REDUCE_CONV THEN - STRIP_TAC THEN - DISCARD_MATCHING_ASSUMPTIONS [`read (memory :> bytes32 a) s = x`] THEN - - (* Simulate 878 instructions (excluding RET) *) - MAP_EVERY (fun n -> ARM_STEPS_TAC MLDSA_USE_HINT_32_EXEC [n] THEN - SIMD_SIMPLIFY_TAC[]) - (1--878) THEN - ENSURES_FINAL_STATE_TAC THEN ASM_REWRITE_TAC[] THEN - - (* Split bytes128 -> bytes32 for output memory *) - REPEAT(FIRST_X_ASSUM(STRIP_ASSUME_TAC o - CONV_RULE (SIMD_SIMPLIFY_CONV []) o - CONV_RULE(READ_MEMORY_SPLIT_CONV 2) o - check (can (term_match [] `read qqq s:int128 = xxx`) o concl))) THEN - - (* Expand output cases, substitute *) - CONV_TAC(TOP_DEPTH_CONV EXPAND_CASES_CONV) THEN - CONV_TAC(DEPTH_CONV NUM_MULT_CONV THENC DEPTH_CONV NUM_ADD_CONV) THEN - REWRITE_TAC[WORD_ADD_0] THEN - ASM_REWRITE_TAC[WORD_ADD_0] THEN ASM_REWRITE_TAC[] THEN - - (* Push word_subword through SIMD ops to per-element form *) - REWRITE_TAC[WORD_SUBWORD_AND; WORD_SUBWORD_OR] THEN - let WSN_TAC = REWRITE_TAC(map (fun n -> prove( - subst [mk_small_numeral n, `n:num`] - `!x:int128. word_subword(word_not x) (n,32):int32 = word_not(word_subword x (n,32))`, - GEN_TAC THEN MATCH_MP_TAC WORD_SUBWORD_NOT THEN - REWRITE_TAC[DIMINDEX_32; DIMINDEX_128] THEN ARITH_TAC)) [0;32;64;96]) in - WSN_TAC THEN - CONV_TAC(DEPTH_CONV WORD_SIMPLE_SUBWORD_CONV) THEN - CONV_TAC(DEPTH_CONV WORD_NUM_RED_CONV) THEN - (* Match expanded ival/iword form *) - let EC_DEEP = - CONV_RULE(DEPTH_CONV WORD_NUM_RED_CONV) - (CONV_RULE(DEPTH_CONV(INT_RED_CONV ORELSEC NUM_RED_CONV)) - (CONV_RULE(TOP_DEPTH_CONV let_CONV) - (REWRITE_RULE[mldsa_use_hint_32_asm; word_2smulh; word_ishr_round; - DIMINDEX_32] ELEMENT_CORRECT_WORD))) in - let EC_FINAL = ONCE_REWRITE_RULE[WORD_AND_SYM] - (ONCE_REWRITE_RULE[WORD_OR_SYM] EC_DEEP) in - REPEAT CONJ_TAC THEN - MATCH_MP_TAC EC_FINAL THEN - CONJ_TAC THEN FIRST_X_ASSUM MATCH_MP_TAC THEN ARITH_TAC);; - - -(* ========================================================================= *) -(* Subroutine form (intermediate, code-aligned) *) -(* ========================================================================= *) - -let ENSURES_STRENGTHEN_POST = prove( - `!P (Q:armstate->bool) Q' R. - ensures arm P Q' R /\ (!s. Q' s ==> Q s) ==> ensures arm P Q R`, - REPEAT GEN_TAC THEN DISCH_THEN(CONJUNCTS_THEN2 MP_TAC ASSUME_TAC) THEN - REWRITE_TAC[ensures] THEN MATCH_MP_TAC MONO_FORALL THEN - X_GEN_TAC `s0:armstate` THEN MATCH_MP_TAC MONO_IMP THEN REWRITE_TAC[] THEN - MP_TAC(BETA_RULE(ISPECL [`arm`; - `\s':armstate. (Q':armstate->bool) s' /\ (R:armstate->armstate->bool) (s0:armstate) s'`; - `\s':armstate. (Q:armstate->bool) s' /\ (R:armstate->armstate->bool) (s0:armstate) s'`] - EVENTUALLY_MONO)) THEN - ANTS_TAC THENL [ASM_MESON_TAC[]; MESON_TAC[]]);; - -let MLDSA_USE_HINT_32_CORRECT_BOUND_CODE = prove - (`!b a h x y pc. - nonoverlapping (word pc, LENGTH mldsa_poly_use_hint_32_mc) (b, 1024) /\ - nonoverlapping (b, 1024) (a, 1024) /\ - nonoverlapping (b, 1024) (h, 1024) - ==> ensures arm - (\s. aligned_bytes_loaded s (word pc) mldsa_poly_use_hint_32_mc /\ - read PC s = word pc /\ - C_ARGUMENTS [b; a; h] s /\ - (!i. i < 256 ==> val(x i) < 8380417) /\ - (!i. i < 256 ==> val(y i) <= 1) /\ - (!i. i < 256 ==> - read(memory :> bytes32(word_add a (word(4 * i)))) s = x i) /\ - (!i. i < 256 ==> - read(memory :> bytes32(word_add h (word(4 * i)))) s = y i)) - (\s. read PC s = word(pc + LENGTH mldsa_poly_use_hint_32_mc - 4) /\ - (!i. i < 256 ==> - read(memory :> bytes32(word_add b (word(4 * i)))) s = - word(mldsa_use_hint_32_code (val(x i)) (val(y i)))) /\ - (!i. i < 256 ==> - val(read(memory :> bytes32(word_add b (word(4 * i)))) s) < 16)) - (MAYCHANGE_REGS_AND_FLAGS_PERMITTED_BY_ABI ,, - MAYCHANGE [memory :> bytes(b, 1024)])`, - REPEAT GEN_TAC THEN DISCH_TAC THEN - MATCH_MP_TAC ENSURES_STRENGTHEN_POST THEN - EXISTS_TAC - `\s. read PC s = word(pc + LENGTH mldsa_poly_use_hint_32_mc - 4) /\ - (!i. i < 256 ==> - read(memory :> bytes32(word_add b (word(4 * i)))) s = - word(mldsa_use_hint_32_code (val(x i:int32)) (val(y i:int32))))` THEN - CONJ_TAC THENL - [MATCH_MP_TAC MLDSA_USE_HINT_32_CORRECT_CODE THEN ASM_REWRITE_TAC[]; - REWRITE_TAC[] THEN REPEAT STRIP_TAC THEN ASM_REWRITE_TAC[] THEN - FIRST_X_ASSUM(MP_TAC o SPEC `i:num`) THEN ASM_REWRITE_TAC[] THEN - DISCH_THEN SUBST1_TAC THEN REWRITE_TAC[VAL_WORD; DIMINDEX_32] THEN - CONV_TAC NUM_REDUCE_CONV THEN - MATCH_MP_TAC(ARITH_RULE `x < 16 ==> x MOD 4294967296 < 16`) THEN - REWRITE_TAC[mldsa_use_hint_32_code] THEN - CONV_TAC(TOP_DEPTH_CONV let_CONV) THEN - REPEAT(COND_CASES_TAC THEN ASM_REWRITE_TAC[]) THEN ASM_ARITH_TAC]);; - -(* Intermediate subroutine correctness against the code-aligned spec. - Bridged to the public FIPS 204-aligned theorem below via - MLDSA_USE_HINT_32_EQUIV. *) -let MLDSA_USE_HINT_32_SUBROUTINE_CORRECT_CODE = prove - (`!b a h x y pc returnaddress. - nonoverlapping (word pc, LENGTH mldsa_poly_use_hint_32_mc) (b, 1024) /\ - nonoverlapping (b, 1024) (a, 1024) /\ - nonoverlapping (b, 1024) (h, 1024) - ==> ensures arm - (\s. aligned_bytes_loaded s (word pc) mldsa_poly_use_hint_32_mc /\ - read PC s = word pc /\ - read X30 s = returnaddress /\ - C_ARGUMENTS [b; a; h] s /\ - (!i. i < 256 ==> val(x i) < 8380417) /\ - (!i. i < 256 ==> val(y i) <= 1) /\ - (!i. i < 256 ==> - read(memory :> bytes32(word_add a (word(4 * i)))) s = x i) /\ - (!i. i < 256 ==> - read(memory :> bytes32(word_add h (word(4 * i)))) s = y i)) - (\s. read PC s = returnaddress /\ - (!i. i < 256 ==> - read(memory :> bytes32(word_add b (word(4 * i)))) s = - word(mldsa_use_hint_32_code (val(x i)) (val(y i)))) /\ - (!i. i < 256 ==> - val(read(memory :> bytes32(word_add b (word(4 * i)))) s) < 16)) - (MAYCHANGE_REGS_AND_FLAGS_PERMITTED_BY_ABI ,, - MAYCHANGE [memory :> bytes(b, 1024)])`, - REWRITE_TAC[fst MLDSA_USE_HINT_32_EXEC] THEN - CONV_TAC NUM_REDUCE_CONV THEN - ARM_ADD_RETURN_NOSTACK_TAC MLDSA_USE_HINT_32_EXEC - (CONV_RULE(ONCE_DEPTH_CONV NUM_REDUCE_CONV) - (REWRITE_RULE[fst MLDSA_USE_HINT_32_EXEC] - MLDSA_USE_HINT_32_CORRECT_BOUND_CODE)));; - (* ========================================================================= *) (* FIPS 204 = code-aligned equivalence *) (* ========================================================================= *) +(* *) +(* Bridges mldsa_use_hint_32 (FIPS 204 Algorithm 40, used in the public *) +(* postcondition) to mldsa_use_hint_32_code (the Barrett-style numeric form *) +(* the assembly actually computes). The main correctness proof states its *) +(* postcondition in FIPS 204 terms and rewrites with this equivalence in the *) +(* strengthening branch to expose the code-aligned form for symbolic *) +(* execution. *) +(* ========================================================================= *) let LINEARIZE_DIV_MOD_TAC = REPEAT(FIRST_X_ASSUM(MP_TAC o check (fun th -> @@ -873,51 +698,211 @@ let MLDSA_USE_HINT_32_EQUIV = prove( ASM_MESON_TAC[]);; (* ========================================================================= *) -(* Public subroutine correctness (FIPS 204-aligned) *) +(* Strengthen-post utility for the FIPS-aligned correctness proof *) +(* ========================================================================= *) + +let ENSURES_STRENGTHEN_POST = prove( + `!P (Q:armstate->bool) Q' R. + ensures arm P Q' R /\ (!s. Q' s ==> Q s) ==> ensures arm P Q R`, + REPEAT GEN_TAC THEN DISCH_THEN(CONJUNCTS_THEN2 MP_TAC ASSUME_TAC) THEN + REWRITE_TAC[ensures] THEN MATCH_MP_TAC MONO_FORALL THEN + X_GEN_TAC `s0:armstate` THEN MATCH_MP_TAC MONO_IMP THEN REWRITE_TAC[] THEN + MP_TAC(BETA_RULE(ISPECL [`arm`; + `\s':armstate. (Q':armstate->bool) s' /\ (R:armstate->armstate->bool) (s0:armstate) s'`; + `\s':armstate. (Q:armstate->bool) s' /\ (R:armstate->armstate->bool) (s0:armstate) s'`] + EVENTUALLY_MONO)) THEN + ANTS_TAC THENL [ASM_MESON_TAC[]; MESON_TAC[]]);; + + +(* ========================================================================= *) +(* Correctness (FIPS 204-aligned) *) (* ========================================================================= *) (* Postcondition is stated in terms of mldsa_use_hint_32 from FIPS 204 - (Algorithm 40), with the output bound < 16 as a corollary. - Derived from MLDSA_USE_HINT_32_SUBROUTINE_CORRECT_CODE by - rewriting mldsa_use_hint_32_code -> mldsa_use_hint_32 via - MLDSA_USE_HINT_32_EQUIV. *) + (Algorithm 40), with the output bound < 16 as a corollary. The bounds + on val(x i) / val(y i) appear as antecedents inside the postcondition + (decompose-style): the assembly executes regardless of input ranges, + and only the FIPS-equivalence + output bound require the input bounds. *) +let MLDSA_USE_HINT_32_CORRECT = prove + (`!b a h x y pc. + nonoverlapping (word pc, LENGTH mldsa_poly_use_hint_32_mc) (b, 1024) /\ + nonoverlapping (b, 1024) (a, 1024) /\ + nonoverlapping (b, 1024) (h, 1024) + ==> ensures arm + (\s. aligned_bytes_loaded s (word pc) mldsa_poly_use_hint_32_mc /\ + read PC s = word pc /\ + C_ARGUMENTS [b; a; h] s /\ + (!i. i < 256 ==> + read(memory :> bytes32(word_add a (word(4 * i)))) s = x i) /\ + (!i. i < 256 ==> + read(memory :> bytes32(word_add h (word(4 * i)))) s = y i)) + (\s. read PC s = word(pc + LENGTH mldsa_poly_use_hint_32_mc - 4) /\ + ((!i. i < 256 ==> val(x i:int32) < 8380417) /\ + (!i. i < 256 ==> val(y i:int32) <= 1) + ==> (!i. i < 256 ==> + read(memory :> bytes32(word_add b (word(4 * i)))) s = + word(mldsa_use_hint_32 (val(y i)) (val(x i)))) /\ + (!i. i < 256 ==> + val(read(memory :> bytes32 + (word_add b (word(4 * i)))) s) < 16))) + (MAYCHANGE_REGS_AND_FLAGS_PERMITTED_BY_ABI ,, + MAYCHANGE [memory :> bytes(b, 1024)])`, + + MAP_EVERY X_GEN_TAC + [`b:int64`; `a:int64`; `h:int64`; + `x:num->int32`; `y:num->int32`; `pc:num`] THEN + REWRITE_TAC[MAYCHANGE_REGS_AND_FLAGS_PERMITTED_BY_ABI; C_ARGUMENTS; + NONOVERLAPPING_CLAUSES; ALL; + fst MLDSA_USE_HINT_32_EXEC] THEN + DISCH_THEN(REPEAT_TCL CONJUNCTS_THEN ASSUME_TAC) THEN + GLOBALIZE_PRECONDITION_TAC THEN + CONV_TAC(RATOR_CONV(LAND_CONV(ONCE_DEPTH_CONV EXPAND_CASES_CONV))) THEN + CONV_TAC NUM_REDUCE_CONV THEN + REPEAT STRIP_TAC THEN + REWRITE_TAC[SOME_FLAGS; MODIFIABLE_SIMD_REGS] THEN + + (* Initialize and merge memory (input bounds NOT used yet). *) + ENSURES_INIT_TAC "s0" THEN + MEMORY_128_FROM_32_TAC "a" 0 64 THEN + ASM_REWRITE_TAC[WORD_ADD_0] THEN CONV_TAC WORD_REDUCE_CONV THEN + STRIP_TAC THEN + MEMORY_128_FROM_32_TAC "h" 0 64 THEN + ASM_REWRITE_TAC[WORD_ADD_0] THEN CONV_TAC WORD_REDUCE_CONV THEN + STRIP_TAC THEN + DISCARD_MATCHING_ASSUMPTIONS [`read (memory :> bytes32 a) s = x`] THEN + + (* Simulate 878 instructions (the assembly is bound-independent). *) + MAP_EVERY (fun n -> ARM_STEPS_TAC MLDSA_USE_HINT_32_EXEC [n] THEN + SIMD_SIMPLIFY_TAC[]) + (1--878) THEN + ENSURES_FINAL_STATE_TAC THEN ASM_REWRITE_TAC[] THEN + + (* Pick up the postcondition's input-bound antecedents + (val(x i) < 8380417 /\ val(y i) <= 1) as assumptions. *) + DISCH_THEN(CONJUNCTS_THEN ASSUME_TAC) THEN + + (* Split bytes128 -> bytes32 for output memory. *) + REPEAT(FIRST_X_ASSUM(STRIP_ASSUME_TAC o + CONV_RULE (SIMD_SIMPLIFY_CONV []) o + CONV_RULE(READ_MEMORY_SPLIT_CONV 2) o + check (can (term_match [] `read qqq s:int128 = xxx`) o concl))) THEN + + (* Expand output cases, substitute. *) + CONV_TAC(TOP_DEPTH_CONV EXPAND_CASES_CONV) THEN + CONV_TAC(DEPTH_CONV NUM_MULT_CONV THENC DEPTH_CONV NUM_ADD_CONV) THEN + REWRITE_TAC[WORD_ADD_0] THEN + ASM_REWRITE_TAC[WORD_ADD_0] THEN ASM_REWRITE_TAC[] THEN + + (* Push word_subword through SIMD ops to per-element form. *) + REWRITE_TAC[WORD_SUBWORD_AND; WORD_SUBWORD_OR] THEN + let WSN_TAC = REWRITE_TAC(map (fun n -> prove( + subst [mk_small_numeral n, `n:num`] + `!x:int128. word_subword(word_not x) (n,32):int32 = word_not(word_subword x (n,32))`, + GEN_TAC THEN MATCH_MP_TAC WORD_SUBWORD_NOT THEN + REWRITE_TAC[DIMINDEX_32; DIMINDEX_128] THEN ARITH_TAC)) [0;32;64;96]) in + WSN_TAC THEN + CONV_TAC(DEPTH_CONV WORD_SIMPLE_SUBWORD_CONV) THEN + CONV_TAC(DEPTH_CONV WORD_NUM_RED_CONV) THEN + + (* Build a per-element val-form correctness via a chain of theorem + transformations: starting from ELEMENT_CORRECT_WORD (`asm a h = word(code + (val a) (val h))`), unfold the asm definition fully, derive + - EC_FINAL: the SIMD LHS = word(code (val a) (val h)) + - EC_VAL_FINAL: val(SIMD LHS:int32) < 16 (used for the bound subgoal) + EC_VAL_FINAL is derived by composing EC_FINAL with `val(word x) = + x MOD 2^32`, the bound on the code spec, and MOD reduction. *) + let EC_DEEP = + CONV_RULE(DEPTH_CONV WORD_NUM_RED_CONV) + (CONV_RULE(DEPTH_CONV(INT_RED_CONV ORELSEC NUM_RED_CONV)) + (CONV_RULE(TOP_DEPTH_CONV let_CONV) + (REWRITE_RULE[mldsa_use_hint_32_asm; word_2smulh; word_ishr_round; + DIMINDEX_32] ELEMENT_CORRECT_WORD))) in + let EC_FINAL = ONCE_REWRITE_RULE[WORD_AND_SYM] + (ONCE_REWRITE_RULE[WORD_OR_SYM] EC_DEEP) in + let EC_VAL_FINAL = + let a = `a:int32` and h = `h:int32` in + let ec_eq = rand(concl(SPEC_ALL EC_FINAL)) in + let ec_lhs = lhand ec_eq in + let val_lhs = mk_comb(`val:int32->num`, ec_lhs) in + let goal_concl = mk_forall(a, mk_forall(h, + mk_imp(rand(rator(concl(SPEC_ALL EC_FINAL))), + mk_binop `(<):num->num->bool` val_lhs `16`))) in + prove(goal_concl, + REPEAT STRIP_TAC THEN + MP_TAC(SPECL [a;h] EC_FINAL) THEN + ASM_REWRITE_TAC[] THEN + DISCH_THEN(fun th -> REWRITE_TAC[th]) THEN + REWRITE_TAC[VAL_WORD; DIMINDEX_32] THEN + CONV_TAC NUM_REDUCE_CONV THEN + MATCH_MP_TAC(ARITH_RULE `x < 16 ==> x MOD 4294967296 < 16`) THEN + REWRITE_TAC[mldsa_use_hint_32_code] THEN + CONV_TAC(TOP_DEPTH_CONV let_CONV) THEN + REPEAT(COND_CASES_TAC THEN ASM_REWRITE_TAC[]) THEN + REWRITE_TAC[MOD_LT_EQ; ARITH_EQ]) in + + (* Pre-rewrite mldsa_use_hint_32 -> _code via the equivalence at all + occurrences in the goal. IMP_REWRITE_TAC handles the conditional lemma + and leaves index-bound side conditions (i < 256) which we close + uniformly via ARITH below. *) + REPEAT (IMP_REWRITE_TAC[MLDSA_USE_HINT_32_EQUIV]) THEN + + (* Split into per-element leaf goals (FIPS-eq + val<16) plus index-bound + side conditions left over from IMP_REWRITE_TAC. Each FIPS-eq leaf is + closed by EC_FINAL; each val<16 leaf is closed by reducing val(word ..) + to MOD via VAL_WORD then bounding mldsa_use_hint_32_code < 16. *) + REPEAT CONJ_TAC THEN + (FIRST [ + MATCH_MP_TAC EC_FINAL THEN CONJ_TAC THEN + FIRST_X_ASSUM MATCH_MP_TAC THEN ARITH_TAC; + REWRITE_TAC[VAL_WORD; DIMINDEX_32] THEN + CONV_TAC NUM_REDUCE_CONV THEN + MATCH_MP_TAC(ARITH_RULE `x < 16 ==> x MOD 4294967296 < 16`) THEN + REWRITE_TAC[mldsa_use_hint_32_code] THEN + CONV_TAC(TOP_DEPTH_CONV let_CONV) THEN + REPEAT(COND_CASES_TAC THEN ASM_REWRITE_TAC[]) THEN + REWRITE_TAC[MOD_LT_EQ; ARITH_EQ]; + ARITH_TAC]));; + + +(* ========================================================================= *) +(* Public subroutine correctness (FIPS 204-aligned) *) +(* ========================================================================= *) + +(* Subroutine form: derives directly from MLDSA_USE_HINT_32_CORRECT by adding + the X30 -> RET return wiring via ARM_ADD_RETURN_NOSTACK_TAC. The bound + antecedents inside the postcondition pass through unchanged (decompose + pattern). *) let MLDSA_USE_HINT_32_SUBROUTINE_CORRECT = prove (`!b a h x y pc returnaddress. nonoverlapping (word pc, LENGTH mldsa_poly_use_hint_32_mc) (b, 1024) /\ nonoverlapping (b, 1024) (a, 1024) /\ - nonoverlapping (b, 1024) (h, 1024) /\ - (!i. i < 256 ==> val((x:num->int32) i) < 8380417) /\ - (!i. i < 256 ==> val((y:num->int32) i) <= 1) + nonoverlapping (b, 1024) (h, 1024) ==> ensures arm (\s. aligned_bytes_loaded s (word pc) mldsa_poly_use_hint_32_mc /\ read PC s = word pc /\ read X30 s = returnaddress /\ C_ARGUMENTS [b; a; h] s /\ - (!i. i < 256 ==> val(x i) < 8380417) /\ - (!i. i < 256 ==> val(y i) <= 1) /\ (!i. i < 256 ==> read(memory :> bytes32(word_add a (word(4 * i)))) s = x i) /\ (!i. i < 256 ==> read(memory :> bytes32(word_add h (word(4 * i)))) s = y i)) (\s. read PC s = returnaddress /\ - (!i. i < 256 ==> - read(memory :> bytes32(word_add b (word(4 * i)))) s = - word(mldsa_use_hint_32 (val(y i)) (val(x i)))) /\ - (!i. i < 256 ==> - val(read(memory :> bytes32(word_add b (word(4 * i)))) s) < 16)) + ((!i. i < 256 ==> val(x i:int32) < 8380417) /\ + (!i. i < 256 ==> val(y i:int32) <= 1) + ==> (!i. i < 256 ==> + read(memory :> bytes32(word_add b (word(4 * i)))) s = + word(mldsa_use_hint_32 (val(y i)) (val(x i)))) /\ + (!i. i < 256 ==> + val(read(memory :> bytes32 + (word_add b (word(4 * i)))) s) < 16))) (MAYCHANGE_REGS_AND_FLAGS_PERMITTED_BY_ABI ,, MAYCHANGE [memory :> bytes(b, 1024)])`, - REPEAT GEN_TAC THEN - DISCH_THEN(REPEAT_TCL CONJUNCTS_THEN ASSUME_TAC) THEN - SUBGOAL_THEN - `!i. i < 256 ==> - mldsa_use_hint_32 (val((y:num->int32) i)) (val((x:num->int32) i)) = - mldsa_use_hint_32_code (val(x i)) (val(y i))` - (fun th -> SIMP_TAC[th]) THENL - [REPEAT STRIP_TAC THEN MATCH_MP_TAC MLDSA_USE_HINT_32_EQUIV THEN - CONJ_TAC THEN FIRST_X_ASSUM MATCH_MP_TAC THEN ASM_REWRITE_TAC[]; - MATCH_MP_TAC MLDSA_USE_HINT_32_SUBROUTINE_CORRECT_CODE THEN - ASM_REWRITE_TAC[]]);; + REWRITE_TAC[fst MLDSA_USE_HINT_32_EXEC] THEN + CONV_TAC NUM_REDUCE_CONV THEN + ARM_ADD_RETURN_NOSTACK_TAC MLDSA_USE_HINT_32_EXEC + (CONV_RULE(ONCE_DEPTH_CONV NUM_REDUCE_CONV) + (REWRITE_RULE[fst MLDSA_USE_HINT_32_EXEC] + MLDSA_USE_HINT_32_CORRECT)));; (* ========================================================================= *) @@ -931,7 +916,7 @@ needs "arm/proofs/subroutine_signatures.ml";; let full_spec,public_vars = mk_safety_spec ~keep_maychanges:false (assoc "mldsa_poly_use_hint_32" subroutine_signatures) - MLDSA_USE_HINT_32_SUBROUTINE_CORRECT_CODE + MLDSA_USE_HINT_32_SUBROUTINE_CORRECT MLDSA_USE_HINT_32_EXEC;; let MLDSA_USE_HINT_32_SUBROUTINE_SAFE = time prove diff --git a/arm/proofs/subroutine_signatures.ml b/arm/proofs/subroutine_signatures.ml index 35a83348b..c15730f5b 100644 --- a/arm/proofs/subroutine_signatures.ml +++ b/arm/proofs/subroutine_signatures.ml @@ -4572,10 +4572,6 @@ let subroutine_signatures = [ [(* temporary buffers *) ]) ); - ], - [(* temporary buffers *) - ]) -); ("mlkem_basemul_k2", ([(*args*) From 8e98c56cfb6c849307541ab131b61c270282a5b4 Mon Sep 17 00:00:00 2001 From: Jake Massimo Date: Mon, 1 Jun 2026 21:29:10 +0000 Subject: [PATCH 11/11] Remove dead EC_VAL_FINAL helper Signed-off-by: Jake Massimo --- arm/proofs/mldsa_poly_use_hint_32.ml | 29 ++-------------------------- 1 file changed, 2 insertions(+), 27 deletions(-) diff --git a/arm/proofs/mldsa_poly_use_hint_32.ml b/arm/proofs/mldsa_poly_use_hint_32.ml index d2d9312b1..6d133ea6b 100644 --- a/arm/proofs/mldsa_poly_use_hint_32.ml +++ b/arm/proofs/mldsa_poly_use_hint_32.ml @@ -804,13 +804,8 @@ let MLDSA_USE_HINT_32_CORRECT = prove CONV_TAC(DEPTH_CONV WORD_SIMPLE_SUBWORD_CONV) THEN CONV_TAC(DEPTH_CONV WORD_NUM_RED_CONV) THEN - (* Build a per-element val-form correctness via a chain of theorem - transformations: starting from ELEMENT_CORRECT_WORD (`asm a h = word(code - (val a) (val h))`), unfold the asm definition fully, derive - - EC_FINAL: the SIMD LHS = word(code (val a) (val h)) - - EC_VAL_FINAL: val(SIMD LHS:int32) < 16 (used for the bound subgoal) - EC_VAL_FINAL is derived by composing EC_FINAL with `val(word x) = - x MOD 2^32`, the bound on the code spec, and MOD reduction. *) + (* Build the per-element FIPS-eq lemma EC_FINAL by composing + ELEMENT_CORRECT_WORD with the asm definition unfold. *) let EC_DEEP = CONV_RULE(DEPTH_CONV WORD_NUM_RED_CONV) (CONV_RULE(DEPTH_CONV(INT_RED_CONV ORELSEC NUM_RED_CONV)) @@ -819,26 +814,6 @@ let MLDSA_USE_HINT_32_CORRECT = prove DIMINDEX_32] ELEMENT_CORRECT_WORD))) in let EC_FINAL = ONCE_REWRITE_RULE[WORD_AND_SYM] (ONCE_REWRITE_RULE[WORD_OR_SYM] EC_DEEP) in - let EC_VAL_FINAL = - let a = `a:int32` and h = `h:int32` in - let ec_eq = rand(concl(SPEC_ALL EC_FINAL)) in - let ec_lhs = lhand ec_eq in - let val_lhs = mk_comb(`val:int32->num`, ec_lhs) in - let goal_concl = mk_forall(a, mk_forall(h, - mk_imp(rand(rator(concl(SPEC_ALL EC_FINAL))), - mk_binop `(<):num->num->bool` val_lhs `16`))) in - prove(goal_concl, - REPEAT STRIP_TAC THEN - MP_TAC(SPECL [a;h] EC_FINAL) THEN - ASM_REWRITE_TAC[] THEN - DISCH_THEN(fun th -> REWRITE_TAC[th]) THEN - REWRITE_TAC[VAL_WORD; DIMINDEX_32] THEN - CONV_TAC NUM_REDUCE_CONV THEN - MATCH_MP_TAC(ARITH_RULE `x < 16 ==> x MOD 4294967296 < 16`) THEN - REWRITE_TAC[mldsa_use_hint_32_code] THEN - CONV_TAC(TOP_DEPTH_CONV let_CONV) THEN - REPEAT(COND_CASES_TAC THEN ASM_REWRITE_TAC[]) THEN - REWRITE_TAC[MOD_LT_EQ; ARITH_EQ]) in (* Pre-rewrite mldsa_use_hint_32 -> _code via the equivalence at all occurrences in the goal. IMP_REWRITE_TAC handles the conditional lemma