diff --git a/.github/workflows/ln-formal.yml b/.github/workflows/ln-formal.yml
new file mode 100644
index 000000000..008eeba95
--- /dev/null
+++ b/.github/workflows/ln-formal.yml
@@ -0,0 +1,125 @@
+name: Ln.sol Formal Check
+
+on:
+  push:
+    branches:
+      - master
+    paths:
+      - src/vendor/Ln.sol
+      - src/wrappers/LnWrapper.sol
+      - formal/ln/**
+      - formal/python/**
+      - test/0.8.34/Ln.t.sol
+      - test/0.8.25/formal-model/FormalModelFFI.t.sol
+      - test/0.8.25/formal-model/LnModel.t.sol
+      - .github/workflows/ln-formal.yml
+  pull_request:
+    paths:
+      - src/vendor/Ln.sol
+      - src/wrappers/LnWrapper.sol
+      - formal/ln/**
+      - formal/python/**
+      - test/0.8.34/Ln.t.sol
+      - test/0.8.25/formal-model/FormalModelFFI.t.sol
+      - test/0.8.25/formal-model/LnModel.t.sol
+      - .github/workflows/ln-formal.yml
+
+jobs:
+  ln-formal:
+    runs-on: ubuntu-latest
+    steps:
+      - uses: actions/checkout@v4
+        with:
+          submodules: recursive
+
+      - name: Install Foundry
+        uses: foundry-rs/foundry-toolchain@v1
+
+      - name: Install Python
+        uses: actions/setup-python@v5
+        with:
+          python-version: "3.11"
+
+      - name: Install pinned Lean toolchain
+        run: |
+          curl https://raw.githubusercontent.com/leanprover/elan/917c18d0ad52f649c2603dc8b973f5b9fa5f8f43/elan-init.sh -sSf | sh -s -- -y --default-toolchain none
+          echo "$HOME/.elan/bin" >> "$GITHUB_PATH"
+          LEAN_TOOLCHAIN="$(cat formal/ln/LnProof/lean-toolchain)"
+          "$HOME/.elan/bin/elan" toolchain install "$LEAN_TOOLCHAIN"
+          "$HOME/.elan/bin/elan" default "$LEAN_TOOLCHAIN"
+
+      - name: Install solc 0.8.34
+        run: forge build -- src/chains/Mainnet/TakerSubmitted.sol
+        env:
+          FOUNDRY_SOLC_VERSION: 0.8.34
+
+      - name: Check floor-specification witness and helper mirror
+        run: python3 -W error -m formal.python.ln.check_ln_counterexample
+
+      - name: Check monotonicity certificate
+        run: python3 -W error -m formal.python.ln.check_ln_monotone
+
+      - name: Generate Lean model from Ln.sol via Yul IR
+        run: |
+          forge inspect src/wrappers/LnWrapper.sol:LnWrapper ir | \
+            python3 -W error -m formal.python.ln.generate_ln_model \
+              --yul - \
+              --output formal/ln/LnProof/LnProof/GeneratedLnModel.lean
+
+      - name: Generate certificate coefficient literals
+        run: python3 -W error formal/python/ln/gen_cert_literals.py
+
+      - name: Build Ln proof and model evaluator
+        working-directory: formal/ln/LnProof
+        run: lake build && lake build ln-model
+
+      - name: Check proof axioms
+        working-directory: formal/ln/LnProof
+        run: |
+          printf '%s\n' \
+            'import LnProof.TopMono' \
+            'import LnProof.FloorSpec' \
+            'import LnProof.ExpLogCutSpec' \
+            '#print axioms LnGeneratedModel.model_ln_wad_one_wad' \
+            '#print axioms LnGeneratedModel.model_ln_wad_to_wad_one_wad' \
+            '#print axioms LnGeneratedModel.model_ln_wad_one_wad_mono' \
+            '#print axioms LnGeneratedModel.model_ln_wad_seam_mono' \
+            '#print axioms LnGeneratedModel.model_ln_wad_to_wad_seam_mono' \
+            '#print axioms LnGeneratedModel.model_ln_wad_mono' \
+            '#print axioms LnGeneratedModel.model_ln_wad_to_wad_mono' \
+            '#print axioms LnFloorCert.model_ln_wad_floor' \
+            '#print axioms LnFloorCert.model_ln_wad_to_wad_floor' \
+            '#print axioms LnFloorCert.model_ln_wad_negative_iff' \
+            '#print axioms LnFloorCert.model_ln_wad_to_wad_negative_iff' \
+            '#print axioms LnFloorCert.FloorSpecA_iff_cutLeLogWadRay' \
+            '#print axioms LnFloorCert.FloorSpecB_iff_cutLogWadRayLtWithMargin' \
+            '#print axioms LnFloorCert.FloorSpec_iff_cutLnWadRayBracket' \
+            '#print axioms LnFloorCert.FloorSpecToWad_iff_cutLnWadSpec' \
+            '#print axioms LnFloorCert.model_ln_wad_cut_spec' \
+            '#print axioms LnFloorCert.model_ln_wad_to_wad_cut_spec' \
+            | lake env lean --stdin > actual_axioms.txt 2>&1
+          diff -u --label expected --label actual - actual_axioms.txt <<'EXPECTED'
+          'LnGeneratedModel.model_ln_wad_one_wad' does not depend on any axioms
+          'LnGeneratedModel.model_ln_wad_to_wad_one_wad' does not depend on any axioms
+          'LnGeneratedModel.model_ln_wad_one_wad_mono' does not depend on any axioms
+          'LnGeneratedModel.model_ln_wad_seam_mono' does not depend on any axioms
+          'LnGeneratedModel.model_ln_wad_to_wad_seam_mono' does not depend on any axioms
+          'LnGeneratedModel.model_ln_wad_mono' depends on axioms: [propext, Classical.choice, Quot.sound]
+          'LnGeneratedModel.model_ln_wad_to_wad_mono' depends on axioms: [propext, Classical.choice, Quot.sound]
+          'LnFloorCert.model_ln_wad_floor' depends on axioms: [propext, Classical.choice, Quot.sound]
+          'LnFloorCert.model_ln_wad_to_wad_floor' depends on axioms: [propext, Classical.choice, Quot.sound]
+          'LnFloorCert.model_ln_wad_negative_iff' depends on axioms: [propext, Classical.choice, Quot.sound]
+          'LnFloorCert.model_ln_wad_to_wad_negative_iff' depends on axioms: [propext, Classical.choice, Quot.sound]
+          'LnFloorCert.FloorSpecA_iff_cutLeLogWadRay' depends on axioms: [propext]
+          'LnFloorCert.FloorSpecB_iff_cutLogWadRayLtWithMargin' depends on axioms: [propext, Quot.sound]
+          'LnFloorCert.FloorSpec_iff_cutLnWadRayBracket' depends on axioms: [propext, Quot.sound]
+          'LnFloorCert.FloorSpecToWad_iff_cutLnWadSpec' depends on axioms: [propext, Quot.sound]
+          'LnFloorCert.model_ln_wad_cut_spec' depends on axioms: [propext, Classical.choice, Quot.sound]
+          'LnFloorCert.model_ln_wad_to_wad_cut_spec' depends on axioms: [propext, Classical.choice, Quot.sound]
+          EXPECTED
+
+      - name: Fuzz-test Lean model against Solidity
+        run: |
+          FOUNDRY_PROFILE=formal-model forge test \
+            --skip 'src/*' --skip 'test/unit/*' --skip 'test/integration/*' --skip 'test/0.8.28/*' \
+            --match-contract LnModelTest
diff --git a/formal/ln/LnProof/.gitignore b/formal/ln/LnProof/.gitignore
new file mode 100644
index 000000000..97f0e0e93
--- /dev/null
+++ b/formal/ln/LnProof/.gitignore
@@ -0,0 +1,12 @@
+/.lake/
+/actual_axioms.txt
+
+# Auto-generated; rebuild with:
+#   forge inspect src/wrappers/LnWrapper.sol:LnWrapper ir | \
+#     python3 -m formal.python.ln.generate_ln_model --yul - \
+#       --output formal/ln/LnProof/LnProof/GeneratedLnModel.lean
+/LnProof/GeneratedLnModel.lean
+
+# Auto-generated; rebuild with:
+#   python3 formal/python/ln/gen_cert_literals.py
+/LnProof/FloorCertLit.lean
diff --git a/formal/ln/LnProof/LnProof.lean b/formal/ln/LnProof/LnProof.lean
new file mode 100644
index 000000000..83a1aaa4d
--- /dev/null
+++ b/formal/ln/LnProof/LnProof.lean
@@ -0,0 +1,7 @@
+-- This module serves as the root of the `LnProof` library.
+-- Import modules here that should be built as part of the library.
+import LnProof.GeneratedLnModel
+import LnProof.LnMono
+import LnProof.TopMono
+import LnProof.FloorSpec
+import LnProof.ExpLogCutSpec
diff --git a/formal/ln/LnProof/LnProof/Bridge.lean b/formal/ln/LnProof/LnProof/Bridge.lean
new file mode 100644
index 000000000..acbda29bb
--- /dev/null
+++ b/formal/ln/LnProof/LnProof/Bridge.lean
@@ -0,0 +1,136 @@
+import LnProof.GeneratedLnModel
+
+/-!
+# Two's-complement transport lemmas
+
+`toInt` is the signed view of a uint256 word; each lemma here transports one
+modeled EVM opcode to plain `Int` arithmetic under explicit range hypotheses
+(no overflow, divisor nonzero, ...). Everything downstream reasons in `Int`.
+-/
+
+namespace LnGeneratedModel
+
+def toInt (w : Nat) : Int :=
+  if w < 2 ^ 255 then (w : Int) else (w : Int) - 2 ^ 256
+
+def ofInt (x : Int) : Nat := (x % (2 ^ 256 : Int)).toNat
+
+/-- `omega` needs numeral divisors for `Int.emod`; these rewrite the powers. -/
+theorem ipow256 :
+    (2 : Int) ^ 256 =
+      115792089237316195423570985008687907853269984665640564039457584007913129639936 := by
+  rfl
+
+theorem ipow255 :
+    (2 : Int) ^ 255 =
+      57896044618658097711785492504343953926634992332820282019728792003956564819968 := by
+  rfl
+
+theorem word_mod_eq : WORD_MOD = 2 ^ 256 := rfl
+
+theorem u256_eq (w : Nat) : u256 w = w % 2 ^ 256 := rfl
+
+theorem u256_of_lt {w : Nat} (h : w < 2 ^ 256) : u256 w = w := by
+  simp [u256_eq, Nat.mod_eq_of_lt h]
+
+theorem toInt_lt {w : Nat} (h : w < 2 ^ 256) : toInt w < 2 ^ 255 := by
+  unfold toInt; simp only [ipow255, ipow256]; split <;> omega
+
+theorem toInt_ge {w : Nat} (h : w < 2 ^ 256) : -(2 ^ 255) ≤ toInt w := by
+  unfold toInt; simp only [ipow255, ipow256]; split <;> omega
+
+theorem toInt_of_lt {w : Nat} (h : w < 2 ^ 255) : toInt w = (w : Int) := by
+  unfold toInt; split <;> omega
+
+theorem ofInt_lt (x : Int) : ofInt x < 2 ^ 256 := by
+  unfold ofInt; simp only [ipow256]; omega
+
+theorem toInt_ofInt {x : Int} (h1 : -(2 ^ 255) ≤ x) (h2 : x < 2 ^ 255) :
+    toInt (ofInt x) = x := by
+  unfold toInt ofInt
+  simp only [ipow255, ipow256] at *
+  split <;> omega
+
+theorem ofInt_toInt {w : Nat} (h : w < 2 ^ 256) : ofInt (toInt w) = w := by
+  unfold toInt ofInt
+  simp only [ipow256] at *
+  split <;> omega
+
+/-- `sle` (the comparison used by the seam theorems) agrees with `Int`
+ordering of the signed views. -/
+def sleInt (a b : Nat) : Bool :=
+  decide ((a + 2 ^ 255) % WORD_MOD ≤ (b + 2 ^ 255) % WORD_MOD)
+
+theorem sleInt_iff {a b : Nat} (ha : a < 2 ^ 256) (hb : b < 2 ^ 256) :
+    sleInt a b = true ↔ toInt a ≤ toInt b := by
+  unfold sleInt toInt
+  simp only [word_mod_eq, decide_eq_true_eq, ipow256]
+  split <;> split <;> omega
+
+/-! ## Opcode transports -/
+
+/-- Master wrap lemma: a Nat congruent to `x` mod `2^256` decodes to `x` when
+`x` is in signed range. -/
+theorem toInt_wrap {n : Nat} {x : Int}
+    (key : (n : Int) % (2 ^ 256 : Int) = x % (2 ^ 256 : Int))
+    (h1 : -(2 ^ 255) ≤ x) (h2 : x < 2 ^ 255) :
+    toInt (n % 2 ^ 256) = x := by
+  unfold toInt
+  simp only [ipow255, ipow256] at *
+  split <;> omega
+
+theorem toInt_mod_cong {w : Nat} (_h : w < 2 ^ 256) :
+    (w : Int) % (2 ^ 256 : Int) = toInt w % (2 ^ 256 : Int) := by
+  unfold toInt
+  simp only [ipow256] at *
+  split <;> omega
+
+theorem evmAdd_eq (a b : Nat) : evmAdd a b = (a + b) % 2 ^ 256 := by
+  unfold evmAdd u256; simp only [word_mod_eq]; omega
+
+theorem evmSub_eq {a b : Nat} (ha : a < 2 ^ 256) (hb : b < 2 ^ 256) :
+    evmSub a b = (a + 2 ^ 256 - b) % 2 ^ 256 := by
+  unfold evmSub u256; simp only [word_mod_eq]
+  rw [Nat.mod_eq_of_lt ha, Nat.mod_eq_of_lt hb]
+
+theorem evmMul_eq {a b : Nat} (ha : a < 2 ^ 256) (hb : b < 2 ^ 256) :
+    evmMul a b = (a * b) % 2 ^ 256 := by
+  unfold evmMul u256; simp only [word_mod_eq]
+  rw [Nat.mod_eq_of_lt ha, Nat.mod_eq_of_lt hb]
+
+theorem evmAdd_lt (a b : Nat) : evmAdd a b < 2 ^ 256 := by
+  unfold evmAdd u256; simp only [word_mod_eq]; omega
+
+theorem evmSub_lt (a b : Nat) : evmSub a b < 2 ^ 256 := by
+  unfold evmSub u256; simp only [word_mod_eq]; omega
+
+theorem evmMul_lt (a b : Nat) : evmMul a b < 2 ^ 256 := by
+  unfold evmMul u256; simp only [word_mod_eq]; omega
+
+theorem evmAdd_transport {a b : Nat} (ha : a < 2 ^ 256) (hb : b < 2 ^ 256)
+    (h1 : -(2 ^ 255) ≤ toInt a + toInt b) (h2 : toInt a + toInt b < 2 ^ 255) :
+    toInt (evmAdd a b) = toInt a + toInt b := by
+  rw [evmAdd_eq a b]
+  refine toInt_wrap ?_ h1 h2
+  have hc : ((a + b : Nat) : Int) = (a : Int) + (b : Int) := by omega
+  rw [hc, Int.add_emod, toInt_mod_cong ha, toInt_mod_cong hb, ← Int.add_emod]
+
+theorem evmSub_transport {a b : Nat} (ha : a < 2 ^ 256) (hb : b < 2 ^ 256)
+    (h1 : -(2 ^ 255) ≤ toInt a - toInt b) (h2 : toInt a - toInt b < 2 ^ 255) :
+    toInt (evmSub a b) = toInt a - toInt b := by
+  rw [evmSub_eq ha hb]
+  refine toInt_wrap ?_ h1 h2
+  have hc : ((a + 2 ^ 256 - b : Nat) : Int) = (a : Int) - (b : Int) + 2 ^ 256 := by
+    simp only [ipow256]; omega
+  rw [hc, Int.add_emod_right, Int.sub_emod, toInt_mod_cong ha, toInt_mod_cong hb,
+    ← Int.sub_emod]
+
+theorem evmMul_transport {a b : Nat} (ha : a < 2 ^ 256) (hb : b < 2 ^ 256)
+    (h1 : -(2 ^ 255) ≤ toInt a * toInt b) (h2 : toInt a * toInt b < 2 ^ 255) :
+    toInt (evmMul a b) = toInt a * toInt b := by
+  rw [evmMul_eq ha hb]
+  refine toInt_wrap ?_ h1 h2
+  have hc : ((a * b : Nat) : Int) = (a : Int) * (b : Int) := by exact_mod_cast rfl
+  rw [hc, Int.mul_emod, toInt_mod_cong ha, toInt_mod_cong hb, ← Int.mul_emod]
+
+end LnGeneratedModel
diff --git a/formal/ln/LnProof/LnProof/BridgeDiv.lean b/formal/ln/LnProof/LnProof/BridgeDiv.lean
new file mode 100644
index 000000000..851b0548a
--- /dev/null
+++ b/formal/ln/LnProof/LnProof/BridgeDiv.lean
@@ -0,0 +1,278 @@
+import LnProof.Bridge
+
+/-!
+# Shift and division transports
+
+Floor sandwiches for the arithmetic/logical shifts at the literal shift
+amounts the model uses, the `evmSdiv` ↔ `Int.tdiv` transport, and the
+cross-multiplied monotonicity of truncated division.
+-/
+
+namespace LnGeneratedModel
+
+/-! ## `evmSar` floor sandwiches (one instance per literal shift amount) -/
+
+section Sar
+
+/-- Helper macro-by-hand: each instance proves
+`toInt (evmSar s w) * 2^s ≤ toInt w < toInt (evmSar s w) * 2^s + 2^s`
+together with the result being a valid word. -/
+
+theorem evmSar_sandwich_72 {w : Nat} (h : w < 2 ^ 256) :
+    evmSar 72 w < 2 ^ 256 ∧
+      toInt (evmSar 72 w) * 4722366482869645213696 ≤ toInt w ∧
+      toInt w < toInt (evmSar 72 w) * 4722366482869645213696 + 4722366482869645213696 := by
+  unfold evmSar u256 toInt
+  simp only [word_mod_eq, ipow256, Nat.reducePow, Nat.reduceMod]
+  repeat' split
+  all_goals omega
+
+theorem evmSar_sandwich_88 {w : Nat} (h : w < 2 ^ 256) :
+    evmSar 88 w < 2 ^ 256 ∧
+      toInt (evmSar 88 w) * 309485009821345068724781056 ≤ toInt w ∧
+      toInt w < toInt (evmSar 88 w) * 309485009821345068724781056 + 309485009821345068724781056 := by
+  unfold evmSar u256 toInt
+  simp only [word_mod_eq, ipow256, Nat.reducePow, Nat.reduceMod]
+  repeat' split
+  all_goals omega
+
+theorem evmSar_sandwich_90 {w : Nat} (h : w < 2 ^ 256) :
+    evmSar 90 w < 2 ^ 256 ∧
+      toInt (evmSar 90 w) * 1237940039285380274899124224 ≤ toInt w ∧
+      toInt w < toInt (evmSar 90 w) * 1237940039285380274899124224 + 1237940039285380274899124224 := by
+  unfold evmSar u256 toInt
+  simp only [word_mod_eq, ipow256, Nat.reducePow, Nat.reduceMod]
+  repeat' split
+  all_goals omega
+
+theorem evmSar_sandwich_95 {w : Nat} (h : w < 2 ^ 256) :
+    evmSar 95 w < 2 ^ 256 ∧
+      toInt (evmSar 95 w) * 39614081257132168796771975168 ≤ toInt w ∧
+      toInt w < toInt (evmSar 95 w) * 39614081257132168796771975168 + 39614081257132168796771975168 := by
+  unfold evmSar u256 toInt
+  simp only [word_mod_eq, ipow256, Nat.reducePow, Nat.reduceMod]
+  repeat' split
+  all_goals omega
+
+theorem evmSar_sandwich_87 {w : Nat} (h : w < 2 ^ 256) :
+    evmSar 87 w < 2 ^ 256 ∧
+      toInt (evmSar 87 w) * 154742504910672534362390528 ≤ toInt w ∧
+      toInt w < toInt (evmSar 87 w) * 154742504910672534362390528 + 154742504910672534362390528 := by
+  unfold evmSar u256 toInt
+  simp only [word_mod_eq, ipow256, Nat.reducePow, Nat.reduceMod]
+  repeat' split
+  all_goals omega
+
+theorem evmSar_sandwich_97 {w : Nat} (h : w < 2 ^ 256) :
+    evmSar 97 w < 2 ^ 256 ∧
+      toInt (evmSar 97 w) * 158456325028528675187087900672 ≤ toInt w ∧
+      toInt w < toInt (evmSar 97 w) * 158456325028528675187087900672 + 158456325028528675187087900672 := by
+  unfold evmSar u256 toInt
+  simp only [word_mod_eq, ipow256, Nat.reducePow, Nat.reduceMod]
+  repeat' split
+  all_goals omega
+
+theorem evmSar_sandwich_113 {w : Nat} (h : w < 2 ^ 256) :
+    evmSar 113 w < 2 ^ 256 ∧
+      toInt (evmSar 113 w) * 10384593717069655257060992658440192 ≤ toInt w ∧
+      toInt w < toInt (evmSar 113 w) * 10384593717069655257060992658440192 + 10384593717069655257060992658440192 := by
+  unfold evmSar u256 toInt
+  simp only [word_mod_eq, ipow256, Nat.reducePow, Nat.reduceMod]
+  repeat' split
+  all_goals omega
+
+end Sar
+
+/-! ## `evmShr` for nonnegative operands at literal shifts -/
+
+theorem evmShr_eq_div_84 {w : Nat} (h : w < 2 ^ 256) : evmShr 84 w = w / 2 ^ 84 := by
+  unfold evmShr u256
+  simp only [word_mod_eq, Nat.reducePow, Nat.reduceMod]
+  split <;> omega
+
+theorem evmShr_eq_div_104 {w : Nat} (h : w < 2 ^ 256) : evmShr 104 w = w / 2 ^ 104 := by
+  unfold evmShr u256
+  simp only [word_mod_eq, Nat.reducePow, Nat.reduceMod]
+  split <;> omega
+
+theorem evmShr_eq_div_160 {w : Nat} (h : w < 2 ^ 256) : evmShr 160 w = w / 2 ^ 160 := by
+  unfold evmShr u256
+  simp only [word_mod_eq, Nat.reducePow, Nat.reduceMod]
+  split <;> omega
+
+theorem evmShr_lt {s : Nat} {w : Nat} (_h : w < 2 ^ 256) : evmShr s w < 2 ^ 256 := by
+  unfold evmShr u256
+  simp only [word_mod_eq]
+  split
+  · exact Nat.lt_of_le_of_lt (Nat.div_le_self _ _) (by omega)
+  · omega
+
+theorem evmShl_lt (s w : Nat) : evmShl s w < 2 ^ 256 := by
+  unfold evmShl u256
+  simp only [word_mod_eq]
+  split <;> omega
+
+theorem evmSdiv_lt (a b : Nat) : evmSdiv a b < 2 ^ 256 := by
+  unfold evmSdiv u256
+  simp only [word_mod_eq]
+  repeat' split
+  all_goals omega
+
+/-! ## `evmShl` transports -/
+
+/-- Unwrapped left shift when the product genuinely fits (variable shift,
+used by the clz normalization). -/
+theorem evmShl_eq {s : Nat} (hs : s < 256) {w : Nat} (h : w * 2 ^ s < 2 ^ 256) :
+    evmShl s w = w * 2 ^ s := by
+  unfold evmShl u256
+  simp only [word_mod_eq]
+  have hs2 : s % 2 ^ 256 = s := Nat.mod_eq_of_lt (by omega)
+  have hpos : 0 < 2 ^ s := Nat.two_pow_pos s
+  have hw : w < 2 ^ 256 := by
+    have h1 : w * 1 ≤ w * 2 ^ s := Nat.mul_le_mul_left w hpos
+    omega
+  rw [hs2, if_pos hs, Nat.mod_eq_of_lt hw, Nat.mod_eq_of_lt h]
+
+/-- Signed left shift by 100 (the `z` numerator). -/
+theorem evmShl_transport_100 {w : Nat} (hw : w < 2 ^ 256)
+    (h1 : -(2 ^ 255) ≤ toInt w * 1267650600228229401496703205376) (h2 : toInt w * 1267650600228229401496703205376 < 2 ^ 255) :
+    toInt (evmShl 100 w) = toInt w * 1267650600228229401496703205376 := by
+  have he : evmShl 100 w = (w * 2 ^ 100) % 2 ^ 256 := by
+    unfold evmShl u256
+    simp only [word_mod_eq, Nat.reducePow, Nat.reduceMod]
+    split <;> omega
+  rw [he]
+  refine toInt_wrap ?_ h1 h2
+  have hc : ((w * 2 ^ 100 : Nat) : Int) = (w : Int) * 1267650600228229401496703205376 := by
+    omega
+  rw [hc, Int.mul_emod, toInt_mod_cong hw, ← Int.mul_emod]
+
+/-! ## `evmSdiv` characterization -/
+
+/-- Decoding helpers for `evmSdiv` results. -/
+theorem toInt_u256_of_small {q : Nat} (h : q < 2 ^ 255) : toInt (u256 q) = (q : Int) := by
+  unfold toInt u256
+  simp only [word_mod_eq, ipow256] at *
+  split <;> omega
+
+theorem toInt_u256_neg {q : Nat} (h : q ≤ 2 ^ 255) :
+    toInt (u256 (WORD_MOD - q)) = -(q : Int) := by
+  unfold toInt u256
+  simp only [word_mod_eq, ipow256] at *
+  split <;> omega
+
+/-- Sign-pinned semantics of `evmSdiv`: one lemma per sign pattern, with the
+quotient expressed over `Int.toNat` magnitudes so that division terms unify
+syntactically downstream. -/
+theorem evmSdiv_pos_pos {a b : Nat} (ha : a < 2 ^ 256) (hb : b < 2 ^ 256)
+    (h1 : 0 ≤ toInt a) (h2 : 0 < toInt b) :
+    toInt (evmSdiv a b) = (((toInt a).toNat / (toInt b).toNat : Nat) : Int) := by
+  have hna : ¬ 2 ^ 255 ≤ a := by
+    unfold toInt at h1; simp only [ipow256] at *; split at h1 <;> omega
+  have hnb : ¬ 2 ^ 255 ≤ b := by
+    unfold toInt at h2; simp only [ipow256] at *; split at h2 <;> omega
+  have hb0 : ¬ b = 0 := by
+    unfold toInt at h2; split at h2 <;> omega
+  have ea : (toInt a).toNat = a := by
+    unfold toInt; simp only [ipow256] at *; split <;> omega
+  have eb : (toInt b).toNat = b := by
+    unfold toInt; simp only [ipow256] at *; split <;> omega
+  unfold evmSdiv
+  simp only [u256_of_lt ha, u256_of_lt hb, decide_eq_false hna, decide_eq_false hnb,
+    Bool.false_eq_true, 
+    if_true, if_false, if_neg hb0, ea, eb]
+  have hq : a / b < 2 ^ 255 := by
+    have := Nat.div_le_self a b
+    omega
+  rw [toInt_u256_of_small hq]
+
+theorem evmSdiv_neg_pos {a b : Nat} (ha : a < 2 ^ 256) (hb : b < 2 ^ 256)
+    (h1 : toInt a < 0) (hmin : -(2 ^ 255) < toInt a) (h2 : 0 < toInt b) :
+    toInt (evmSdiv a b) = -(((- toInt a).toNat / (toInt b).toNat : Nat) : Int) := by
+  have hna : 2 ^ 255 ≤ a := by
+    unfold toInt at h1; simp only [ipow255, ipow256] at *; split at h1 <;> omega
+  have hnb : ¬ 2 ^ 255 ≤ b := by
+    unfold toInt at h2; simp only [ipow255, ipow256] at *; split at h2 <;> omega
+  have hb0 : ¬ b = 0 := by
+    unfold toInt at h2; split at h2 <;> omega
+  have ea : (- toInt a).toNat = WORD_MOD - a := by
+    unfold toInt; simp only [word_mod_eq, ipow255, ipow256] at *; split <;> omega
+  have eb : (toInt b).toNat = b := by
+    unfold toInt; simp only [ipow255, ipow256] at *; split <;> omega
+  unfold evmSdiv
+  simp only [u256_of_lt ha, u256_of_lt hb, decide_eq_true hna, decide_eq_false hnb,
+    Bool.false_eq_true, Bool.true_eq_false, 
+    if_true, if_false, if_neg hb0, ea, eb]
+  have hq : (WORD_MOD - a) / b ≤ 2 ^ 255 := by
+    have h3 : WORD_MOD - a ≤ 2 ^ 255 := by
+      unfold toInt at hmin; simp only [word_mod_eq, ipow255, ipow256] at *
+      split at hmin <;> omega
+    have := Nat.div_le_self (WORD_MOD - a) b
+    omega
+  rw [toInt_u256_neg hq]
+
+theorem evmSdiv_pos_neg {a b : Nat} (ha : a < 2 ^ 256) (hb : b < 2 ^ 256)
+    (h1 : 0 ≤ toInt a) (h2 : toInt b < 0) :
+    toInt (evmSdiv a b) = -(((toInt a).toNat / (- toInt b).toNat : Nat) : Int) := by
+  have hna : ¬ 2 ^ 255 ≤ a := by
+    unfold toInt at h1; simp only [ipow256] at *; split at h1 <;> omega
+  have hnb : 2 ^ 255 ≤ b := by
+    unfold toInt at h2; simp only [ipow256] at *; split at h2 <;> omega
+  have hb0 : ¬ b = 0 := by
+    intro h; subst h; simp only [] at hnb; omega
+  have ea : (toInt a).toNat = a := by
+    unfold toInt; simp only [ipow256] at *; split <;> omega
+  have eb : (- toInt b).toNat = WORD_MOD - b := by
+    unfold toInt; simp only [word_mod_eq, ipow256] at *; split <;> omega
+  unfold evmSdiv
+  simp only [u256_of_lt ha, u256_of_lt hb, decide_eq_false hna, decide_eq_true hnb,
+    Bool.false_eq_true, 
+    if_true, if_false, if_neg hb0, ea, eb]
+  have hq : a / (WORD_MOD - b) ≤ 2 ^ 255 := by
+    have h3 : a < 2 ^ 255 := by
+      unfold toInt at h1; simp only [ipow256] at *; split at h1 <;> omega
+    have := Nat.div_le_self a (WORD_MOD - b)
+    omega
+  rw [toInt_u256_neg hq]
+
+theorem evmSdiv_neg_neg {a b : Nat} (ha : a < 2 ^ 256) (hb : b < 2 ^ 256)
+    (h1 : toInt a < 0) (hmin : -(2 ^ 255) < toInt a) (h2 : toInt b < 0) :
+    toInt (evmSdiv a b) = (((- toInt a).toNat / (- toInt b).toNat : Nat) : Int) := by
+  have hna : 2 ^ 255 ≤ a := by
+    unfold toInt at h1; simp only [ipow255, ipow256] at *; split at h1 <;> omega
+  have hnb : 2 ^ 255 ≤ b := by
+    unfold toInt at h2; simp only [ipow255, ipow256] at *; split at h2 <;> omega
+  have hb0 : ¬ b = 0 := by
+    intro h; subst h; simp only [] at hnb; omega
+  have ea : (- toInt a).toNat = WORD_MOD - a := by
+    unfold toInt; simp only [word_mod_eq, ipow255, ipow256] at *; split <;> omega
+  have eb : (- toInt b).toNat = WORD_MOD - b := by
+    unfold toInt; simp only [word_mod_eq, ipow255, ipow256] at *; split <;> omega
+  unfold evmSdiv
+  simp only [u256_of_lt ha, u256_of_lt hb, decide_eq_true hna, decide_eq_true hnb,
+    
+    if_true, if_neg hb0, ea, eb]
+  have hq : (WORD_MOD - a) / (WORD_MOD - b) < 2 ^ 255 := by
+    have h3 : WORD_MOD - a ≤ 2 ^ 255 := by
+      unfold toInt at hmin; simp only [word_mod_eq, ipow255, ipow256] at *
+      split at hmin <;> omega
+    have := Nat.div_le_self (WORD_MOD - a) (WORD_MOD - b)
+    have h4 : ¬ WORD_MOD - a = 2 ^ 255 ∨ True := Or.inr trivial
+    simp only [word_mod_eq, ipow255] at *
+    omega
+  rw [toInt_u256_of_small hq]
+
+/-- Cross-multiplied monotonicity of Nat division. -/
+theorem nat_div_cross_mono {a b c d : Nat} (hb : 0 < b) (hd : 0 < d)
+    (h : a * d ≤ c * b) : a / b ≤ c / d := by
+  rw [Nat.le_div_iff_mul_le hd]
+  have h1 : a / b * b ≤ a := Nat.div_mul_le_self a b
+  have h2 : a / b * b * d ≤ a * d := Nat.mul_le_mul_right d h1
+  have h3 : a / b * b * d ≤ c * b := Nat.le_trans h2 h
+  have h4 : a / b * d * b ≤ c * b := by
+    have : a / b * b * d = a / b * d * b := by
+      rw [Nat.mul_assoc, Nat.mul_comm b d, ← Nat.mul_assoc]
+    omega
+  exact Nat.le_of_mul_le_mul_right h4 hb
+
+end LnGeneratedModel
diff --git a/formal/ln/LnProof/LnProof/Certs.lean b/formal/ln/LnProof/LnProof/Certs.lean
new file mode 100644
index 000000000..95c6d9e52
--- /dev/null
+++ b/formal/ln/LnProof/LnProof/Certs.lean
@@ -0,0 +1,101 @@
+import LnProof.Stages
+import LnProof.Poly
+
+/-!
+# Decidable certificates
+
+The analytic legs of the within-octave step inequality, reduced to polynomial
+nonnegativity over `[0, Uc]` and checked by the kernel through the adaptive
+bisection checker. `G1`/`G2` encode the cross-multiplied worst-case step
+inequalities (worst `|z| = Zc`, worst truncation slops); `certP`/`certQ` give
+the polynomial-side sign facts.
+-/
+
+namespace LnGeneratedModel
+
+open LnPoly
+
+def UcI : Int := 2332259347626381040680638252
+def ZcI : Int := 217494458298375249691265569570
+
+/-- `-QQ(v)` -/
+def nQQp : List Int := polyNeg QQc
+/-- `PP(v+1)` -/
+def PPs : List Int := polyCompAdd1 PPc
+/-- `-QQ(v+1)` -/
+def nQQs : List Int := polyNeg (polyCompAdd1 QQc)
+/-- `-QQ(v+1) + SLOPQc` -/
+def nQQsS : List Int := polyAdd nQQs [SLOPQc]
+/-- `PP(v+1) - SLOPPc` -/
+def PPsS : List Int := polyAdd PPs [-SLOPPc]
+
+/-- Coefficient of `w` in the positive-branch step inequality. -/
+def Bpoly : List Int := polySub (polyMul PPc nQQsS) (polyMul PPsS nQQp)
+def RHS0 : List Int := polyMul PPc nQQsS
+def G1 : List Int := polyAdd RHS0 (polyScale (-ZcI) Bpoly)
+def RHS02 : List Int := polyMul PPsS nQQp
+def G2 : List Int := polyAdd RHS02 (polyScale (-ZcI) Bpoly)
+
+def certP : List Int := polyAdd PPc [-SLOPPc]
+def certQ : List Int := polyAdd (polyNeg QQc) [-SLOPQc]
+
+theorem certP_check : checkNonneg certP 0 UcI 40 = true := by decide
+theorem certQ_check : checkNonneg certQ 0 UcI 40 = true := by decide
+theorem G1_check : checkNonneg G1 0 (UcI - 1) 40 = true := by decide
+theorem G2_check : checkNonneg G2 0 (UcI - 1) 40 = true := by decide
+
+/-! ## Unpacked corollaries -/
+
+theorem certP_all {v : Int} (h0 : 0 ≤ v) (h1 : v ≤ UcI) :
+    SLOPPc ≤ evalPoly PPc v := by
+  have h := checkNonneg_sound certP 40 0 UcI (by omega) certP_check v h0 h1
+  unfold certP at h
+  rw [evalPoly_polyAdd, evalPoly_singleton] at h
+  omega
+
+theorem certQ_all {v : Int} (h0 : 0 ≤ v) (h1 : v ≤ UcI) :
+    SLOPQc ≤ -evalPoly QQc v := by
+  have h := checkNonneg_sound certQ 40 0 UcI (by omega) certQ_check v h0 h1
+  unfold certQ at h
+  rw [evalPoly_polyAdd, evalPoly_singleton, evalPoly_polyNeg] at h
+  omega
+
+theorem G1_unpack (v : Int) :
+    evalPoly G1 v =
+      evalPoly PPc v * (-evalPoly QQc (v + 1) + SLOPQc) +
+        -ZcI *
+          (evalPoly PPc v * (-evalPoly QQc (v + 1) + SLOPQc) -
+            (evalPoly PPc (v + 1) + -SLOPPc) * -evalPoly QQc v) := by
+  unfold G1 RHS0 Bpoly PPsS nQQsS nQQs PPs nQQp
+  simp only [evalPoly_polyAdd, evalPoly_polyScale, evalPoly_polySub,
+    evalPoly_polyMul, evalPoly_polyNeg, evalPoly_polyCompAdd1, evalPoly_singleton]
+
+theorem G2_unpack (v : Int) :
+    evalPoly G2 v =
+      (evalPoly PPc (v + 1) + -SLOPPc) * -evalPoly QQc v +
+        -ZcI *
+          (evalPoly PPc v * (-evalPoly QQc (v + 1) + SLOPQc) -
+            (evalPoly PPc (v + 1) + -SLOPPc) * -evalPoly QQc v) := by
+  unfold G2 RHS02 Bpoly PPsS nQQsS nQQs PPs nQQp
+  simp only [evalPoly_polyAdd, evalPoly_polyScale, evalPoly_polySub,
+    evalPoly_polyMul, evalPoly_polyNeg, evalPoly_polyCompAdd1, evalPoly_singleton]
+
+theorem G1_all {v : Int} (h0 : 0 ≤ v) (h1 : v ≤ UcI - 1) :
+    0 ≤ evalPoly PPc v * (-evalPoly QQc (v + 1) + SLOPQc) +
+        -ZcI *
+          (evalPoly PPc v * (-evalPoly QQc (v + 1) + SLOPQc) -
+            (evalPoly PPc (v + 1) + -SLOPPc) * -evalPoly QQc v) := by
+  have h := checkNonneg_sound G1 40 0 (UcI - 1) (by omega) G1_check v h0 h1
+  rw [G1_unpack] at h
+  exact h
+
+theorem G2_all {v : Int} (h0 : 0 ≤ v) (h1 : v ≤ UcI - 1) :
+    0 ≤ (evalPoly PPc (v + 1) + -SLOPPc) * -evalPoly QQc v +
+        -ZcI *
+          (evalPoly PPc v * (-evalPoly QQc (v + 1) + SLOPQc) -
+            (evalPoly PPc (v + 1) + -SLOPPc) * -evalPoly QQc v) := by
+  have h := checkNonneg_sound G2 40 0 (UcI - 1) (by omega) G2_check v h0 h1
+  rw [G2_unpack] at h
+  exact h
+
+end LnGeneratedModel
diff --git a/formal/ln/LnProof/LnProof/ExpLogCutSpec.lean b/formal/ln/LnProof/LnProof/ExpLogCutSpec.lean
new file mode 100644
index 000000000..660df4930
--- /dev/null
+++ b/formal/ln/LnProof/LnProof/ExpLogCutSpec.lean
@@ -0,0 +1,110 @@
+import LnProof.FloorSpec
+
+/-!
+# Exponential/logarithm cut specification
+
+This module makes the semantic target of the floor proof explicit without
+importing `Real` or Mathlib.  The target is an arithmetized cut specification:
+`CutExpLe p q y w` and `CutRatioLeExp y w p q` are the two rational
+comparisons exposed by `ExpSum.capUB`/`ExpSum.capLB`, and the logarithm
+predicates below define log comparisons as inverse exponential-cut
+comparisons.
+
+No theorem in this file mentions a real-valued `exp` or `log`; proving
+equivalence with those functions is a separate real-analysis bridge.  The
+theorems here show that the existing floor specifications are exactly these
+cut-log predicates.
+-/
+
+namespace LnFloorCert
+
+open LnGeneratedModel LnExp LnFloor
+
+/-- Cut statement for `exp(p/q) <= y/w`: every exact Taylor partial sum is
+bounded by the target rational. -/
+def CutExpLe (p q y w : Nat) : Prop := capUB p q y w
+
+/-- Cut statement for `y/w <= exp(p/q)`: one exact Taylor partial sum reaches
+the target rational. -/
+def CutRatioLeExp (y w p q : Nat) : Prop := capLB p q y w
+
+/-- Cut-log lower-bound comparison for the wad input at ray scale.
+
+`CutLeLogWadRay r x` is the real-free counterpart of
+`r <= 10^27 * log(x / 10^18)`.  For negative `r`, the comparison is encoded
+through the reciprocal exponential inequality. -/
+def CutLeLogWadRay (r : Int) (x : Nat) : Prop :=
+  if 0 <= r then
+    CutExpLe (r.toNat * 2 ^ 99) QS x (10 ^ 18)
+  else
+    CutRatioLeExp (10 ^ 18) x ((-r).toNat * 2 ^ 99) QS
+
+/-- Cut-log strict upper-bound comparison for the wad input at ray scale.
+
+`CutLogWadRayLtWithMargin x b` is the real-free counterpart of
+`10^27 * log(x / 10^18) < b`.  The positive-exponent branch proves a lower
+cut against `(x / 10^18) / (1 - 10^-30)`, while the reciprocal branch proves
+an upper cut against `(10^18 / x) * (1 - 10^-30)`.  This strictness margin
+turns the non-strict cut inequalities into a strict logarithm comparison
+under the external real-analysis interpretation. -/
+def CutLogWadRayLtWithMargin (x : Nat) (b : Int) : Prop :=
+  if 1 <= b then
+    CutRatioLeExp (x * 10 ^ 31) (10 ^ 18 * (10 ^ 31 - 10)) (b.toNat * 2 ^ 99) QS
+  else
+    CutExpLe ((-b).toNat * 2 ^ 99) QS (10 ^ 18 * (10 ^ 31 - 10)) (x * 10 ^ 31)
+
+/-- The complete ray-scale cut-log floor bracket. -/
+def CutLnWadRayBracket (r : Int) (x : Nat) : Prop :=
+  CutLeLogWadRay r x ∧ CutLogWadRayLtWithMargin x (r + 2)
+
+/-- The wad-scale wrapper spec: a ray-scale cut-log bracket plus exact signed
+floor division by `10^9`. -/
+def CutLnWadSpec (ray wad : Int) (x : Nat) : Prop :=
+  CutLnWadRayBracket ray x ∧ wad * 1000000000 <= ray ∧ ray < (wad + 1) * 1000000000
+
+/-- `FloorSpecA` is exactly the lower cut-log comparison. -/
+theorem FloorSpecA_iff_cutLeLogWadRay {r : Int} {x : Nat} :
+    FloorSpecA r x ↔ CutLeLogWadRay r x := by
+  unfold FloorSpecA CutLeLogWadRay CutExpLe CutRatioLeExp
+  by_cases hr : 0 <= r <;> simp [hr]
+
+/-- `FloorSpecB` is exactly the strict-margin upper cut-log comparison. -/
+theorem FloorSpecB_iff_cutLogWadRayLtWithMargin {r : Int} {x : Nat} :
+    FloorSpecB r x ↔ CutLogWadRayLtWithMargin x (r + 2) := by
+  unfold FloorSpecB CutLogWadRayLtWithMargin CutExpLe CutRatioLeExp
+  by_cases hr : -1 <= r
+  · have hb : 1 <= r + 2 := by omega
+    simp [hr, hb]
+  · have hb : ¬1 <= r + 2 := by omega
+    simp [hr, hb]
+
+/-- The paired floor specification is exactly the ray-scale cut-log bracket. -/
+theorem FloorSpec_iff_cutLnWadRayBracket {r : Int} {x : Nat} :
+    FloorSpecA r x ∧ FloorSpecB r x ↔ CutLnWadRayBracket r x := by
+  unfold CutLnWadRayBracket
+  rw [FloorSpecA_iff_cutLeLogWadRay, FloorSpecB_iff_cutLogWadRayLtWithMargin]
+
+/-- The wad wrapper floor specification is exactly the wad-scale cut spec. -/
+theorem FloorSpecToWad_iff_cutLnWadSpec {ray wad : Int} {x : Nat} :
+    FloorSpecToWad ray wad x ↔ CutLnWadSpec ray wad x := by
+  unfold FloorSpecToWad CutLnWadSpec
+  constructor
+  · intro h
+    obtain ⟨ha, hb, hlo, hhi⟩ := h
+    exact ⟨FloorSpec_iff_cutLnWadRayBracket.mp ⟨ha, hb⟩, hlo, hhi⟩
+  · intro h
+    obtain ⟨hbr, hlo, hhi⟩ := h
+    obtain ⟨ha, hb⟩ := FloorSpec_iff_cutLnWadRayBracket.mpr hbr
+    exact ⟨ha, hb, hlo, hhi⟩
+
+/-- The ray-scale model satisfies the explicit cut-log bracket. -/
+theorem model_ln_wad_cut_spec {x : Nat} (h1 : 1 <= x) (h2 : x < 2 ^ 255) :
+    CutLnWadRayBracket (toInt (model_ln_wad_evm x)) x := by
+  exact FloorSpec_iff_cutLnWadRayBracket.mp (model_ln_wad_floor h1 h2)
+
+/-- The wad-scale wrapper model satisfies the explicit cut-log wrapper spec. -/
+theorem model_ln_wad_to_wad_cut_spec {x : Nat} (h1 : 1 <= x) (h2 : x < 2 ^ 255) :
+    CutLnWadSpec (toInt (model_ln_wad_evm x)) (toInt (model_ln_wad_to_wad_evm x)) x := by
+  exact FloorSpecToWad_iff_cutLnWadSpec.mp (model_ln_wad_to_wad_floor h1 h2)
+
+end LnFloorCert
diff --git a/formal/ln/LnProof/LnProof/ExpSum.lean b/formal/ln/LnProof/LnProof/ExpSum.lean
new file mode 100644
index 000000000..eeee07ebc
--- /dev/null
+++ b/formal/ln/LnProof/LnProof/ExpSum.lean
@@ -0,0 +1,857 @@
+import Init
+
+/-!
+# Exponential partial sums over scaled integers
+
+`S_N(p/q) = Σ_{j ≤ N} (p/q)^j / j!` is represented exactly by the integer
+`expNum N p q = Σ_{j ≤ N} (N!/j!) p^j q^(N-j)`, so that
+`S_N(p/q) = expNum N p q / (N! q^N)`. Arguments are nonnegative rationals
+given as `Nat` pairs. For `t ≥ 0` the partial sums increase to `e^t`, which
+is how the floor specification of `lnWad` is arithmetized: an upper bound
+on `e^t` is `∀ N` a bound on `S_N`, a lower bound is witnessed by a single
+`S_N`.
+
+Everything here is `Nat` arithmetic: monotonicity in `N` and in the
+argument, a geometric tail bound (turning one evaluated partial sum into a
+bound for all `N`), and the binomial subset-product inequalities standing
+in for `e^(a+b) = e^a * e^b`.
+-/
+
+namespace LnExp
+
+def fact : Nat → Nat
+  | 0 => 1
+  | n + 1 => (n + 1) * fact n
+
+theorem fact_pos (n : Nat) : 0 < fact n := by
+  induction n with
+  | zero => decide
+  | succ k ih => simp only [fact]; exact Nat.mul_pos (Nat.succ_pos k) ih
+
+/-- `expNum N p q = Σ_{j ≤ N} (N!/j!) p^j q^(N-j)`, by the recursion
+`E_{N+1} = (N+1) q E_N + p^(N+1)`. -/
+def expNum : Nat → Nat → Nat → Nat
+  | 0, _, _ => 1
+  | n + 1, p, q => (n + 1) * q * expNum n p q + p ^ (n + 1)
+
+theorem expNum_pos {p q : Nat} (hq : 0 < q) : ∀ n, 0 < expNum n p q := by
+  intro n
+  induction n with
+  | zero => simp only [expNum]; omega
+  | succ k ih =>
+    simp only [expNum]
+    have h1 : 0 < (k + 1) * q * expNum k p q :=
+      Nat.mul_pos (Nat.mul_pos (Nat.succ_pos k) hq) ih
+    omega
+
+/-- Comparison helpers: `S_N(p/q) ≤ y/w` and `S_N(p/q) ≥ y/w` as integer
+inequalities (`q, w` positive at use sites). -/
+def sumLE (n p q y w : Nat) : Prop := expNum n p q * w ≤ y * (fact n * q ^ n)
+def sumGE (n p q y w : Nat) : Prop := y * (fact n * q ^ n) ≤ expNum n p q * w
+
+instance (n p q y w : Nat) : Decidable (sumLE n p q y w) := by
+  unfold sumLE; infer_instance
+instance (n p q y w : Nat) : Decidable (sumGE n p q y w) := by
+  unfold sumGE; infer_instance
+
+/-! ## Finite sums -/
+
+/-- `tsum n f = f 0 + f 1 + ... + f n`. -/
+def tsum : Nat → (Nat → Nat) → Nat
+  | 0, f => f 0
+  | n + 1, f => tsum n f + f (n + 1)
+
+theorem tsum_le_tsum {f g : Nat → Nat} {n : Nat} (h : ∀ i, i ≤ n → f i ≤ g i) :
+    tsum n f ≤ tsum n g := by
+  induction n with
+  | zero => exact h 0 (Nat.le_refl 0)
+  | succ k ih =>
+    simp only [tsum]
+    have h1 := ih (fun i hi => h i (Nat.le_succ_of_le hi))
+    have h2 := h (k + 1) (Nat.le_refl _)
+    omega
+
+theorem tsum_congr {f g : Nat → Nat} {n : Nat} (h : ∀ i, i ≤ n → f i = g i) :
+    tsum n f = tsum n g := by
+  induction n with
+  | zero => exact h 0 (Nat.le_refl 0)
+  | succ k ih =>
+    simp only [tsum]
+    rw [ih (fun i hi => h i (Nat.le_succ_of_le hi)), h (k + 1) (Nat.le_refl _)]
+
+theorem tsum_mul_const {f : Nat → Nat} {n c : Nat} :
+    tsum n f * c = tsum n (fun i => f i * c) := by
+  induction n with
+  | zero => rfl
+  | succ k ih => simp only [tsum, Nat.add_mul, ih]
+
+theorem const_mul_tsum {f : Nat → Nat} {n c : Nat} :
+    c * tsum n f = tsum n (fun i => c * f i) := by
+  induction n with
+  | zero => rfl
+  | succ k ih => simp only [tsum, Nat.mul_add, ih]
+
+theorem tsum_add {f g : Nat → Nat} {n : Nat} :
+    tsum n (fun i => f i + g i) = tsum n f + tsum n g := by
+  induction n with
+  | zero => rfl
+  | succ k ih => simp only [tsum, ih]; omega
+
+theorem first_le_tsum (f : Nat → Nat) (n : Nat) : f 0 ≤ tsum n f := by
+  induction n with
+  | zero => exact Nat.le_refl _
+  | succ k ih => simp only [tsum]; omega
+
+theorem tsum_prefix_le {f : Nat → Nat} {n m : Nat} (h : n ≤ m) :
+    tsum n f ≤ tsum m f := by
+  induction m with
+  | zero => cases Nat.le_zero.mp h; exact Nat.le_refl _
+  | succ k ih =>
+    rcases Nat.lt_or_ge n (k + 1) with hlt | hge
+    · have := ih (by omega)
+      simp only [tsum]
+      omega
+    · have he : n = k + 1 := by omega
+      rw [he]
+      exact Nat.le_refl _
+
+/-- Sum transpose: diagonal-major to column-major over the triangle
+`{(i, j) : i + j ≤ c}`. -/
+theorem tri_transpose (T : Nat → Nat → Nat) (c : Nat) :
+    tsum c (fun n => tsum n (fun i => T i (n - i))) =
+      tsum c (fun i => tsum (c - i) (fun j => T i j)) := by
+  induction c with
+  | zero => rfl
+  | succ k ih =>
+    -- peel the diagonal n = k+1 on the left, the last entries on the right
+    have hr : tsum (k + 1) (fun i => tsum (k + 1 - i) (fun j => T i j)) =
+        tsum k (fun i => tsum (k - i) (fun j => T i j)) +
+          tsum (k + 1) (fun i => T i (k + 1 - i)) := by
+      have hsplit : ∀ i, i ≤ k →
+          tsum (k + 1 - i) (fun j => T i j) =
+            tsum (k - i) (fun j => T i j) + T i (k + 1 - i) := by
+        intro i hi
+        have he : k + 1 - i = (k - i) + 1 := by omega
+        rw [he]
+        rfl
+      calc tsum (k + 1) (fun i => tsum (k + 1 - i) (fun j => T i j))
+          = tsum k (fun i => tsum (k + 1 - i) (fun j => T i j)) +
+              tsum 0 (fun j => T (k + 1) j) := by
+            show tsum k _ + tsum (k + 1 - (k + 1)) _ = _
+            rw [Nat.sub_self]
+        _ = tsum k (fun i => tsum (k - i) (fun j => T i j) + T i (k + 1 - i)) +
+              T (k + 1) 0 := by
+            rw [tsum_congr (fun i hi => hsplit i hi)]
+            rfl
+        _ = tsum k (fun i => tsum (k - i) (fun j => T i j)) +
+              tsum k (fun i => T i (k + 1 - i)) + T (k + 1) 0 := by
+            rw [tsum_add]
+        _ = tsum k (fun i => tsum (k - i) (fun j => T i j)) +
+              tsum (k + 1) (fun i => T i (k + 1 - i)) := by
+            have : tsum (k + 1) (fun i => T i (k + 1 - i)) =
+                tsum k (fun i => T i (k + 1 - i)) + T (k + 1) 0 := by
+              have he : k + 1 - (k + 1) = 0 := by omega
+              simp only [tsum, he]
+            omega
+    simp only [tsum] at *
+    omega
+
+/-- Box-into-triangle: summing a nonnegative term over `[0,N] × [0,M]` is at
+most the sum over the triangle `{i + j ≤ N + M}`. -/
+theorem box_le_tri (T : Nat → Nat → Nat) (N M : Nat) :
+    tsum N (fun i => tsum M (fun j => T i j)) ≤
+      tsum (N + M) (fun n => tsum n (fun i => T i (n - i))) := by
+  rw [tri_transpose]
+  calc tsum N (fun i => tsum M (fun j => T i j))
+      ≤ tsum N (fun i => tsum (N + M - i) (fun j => T i j)) :=
+        tsum_le_tsum (fun i hi => tsum_prefix_le (by omega))
+    _ ≤ tsum (N + M) (fun i => tsum (N + M - i) (fun j => T i j)) :=
+        tsum_prefix_le (by omega)
+
+/-- Triangle-into-box: the triangle `{i + j ≤ K}` sits inside `[0,K] × [0,K]`. -/
+theorem tri_le_box (T : Nat → Nat → Nat) (K : Nat) :
+    tsum K (fun n => tsum n (fun i => T i (n - i))) ≤
+      tsum K (fun i => tsum K (fun j => T i j)) := by
+  rw [tri_transpose]
+  exact tsum_le_tsum (fun i hi => tsum_prefix_le (by omega))
+
+/-! ## Coefficients -/
+
+/-- Rising product: `ffacAux j d = (j+1)(j+2)...(j+d) = (j+d)!/j!`. -/
+def ffacAux (j : Nat) : Nat → Nat
+  | 0 => 1
+  | d + 1 => (j + d + 1) * ffacAux j d
+
+theorem ffacAux_mul_fact (j : Nat) : ∀ d, ffacAux j d * fact j = fact (j + d) := by
+  intro d
+  induction d with
+  | zero => simp only [ffacAux, Nat.one_mul, Nat.add_zero]
+  | succ k ih =>
+    simp only [ffacAux]
+    calc (j + k + 1) * ffacAux j k * fact j
+        = (j + k + 1) * (ffacAux j k * fact j) := by rw [Nat.mul_assoc]
+      _ = (j + k + 1) * fact (j + k) := by rw [ih]
+      _ = fact (j + k + 1) := rfl
+
+/-- Front peel: `tsum (n+1) f = f 0 + Σ_{i ≤ n} f (i+1)`. -/
+theorem tsum_shift (f : Nat → Nat) (n : Nat) :
+    tsum (n + 1) f = f 0 + tsum n (fun i => f (i + 1)) := by
+  induction n with
+  | zero => rfl
+  | succ m ih =>
+    have h1 : tsum (m + 2) f = tsum (m + 1) f + f (m + 2) := rfl
+    have h2 : tsum (m + 1) (fun i => f (i + 1)) =
+        tsum m (fun i => f (i + 1)) + f (m + 2) := rfl
+    rw [h1, ih, h2]
+    omega
+
+/-- Pascal-recursive binomial coefficient. -/
+def cho : Nat → Nat → Nat
+  | _, 0 => 1
+  | 0, _ + 1 => 0
+  | n + 1, i + 1 => cho n i + cho n (i + 1)
+
+theorem cho_eq_zero_of_lt : ∀ {n i : Nat}, n < i → cho n i = 0 := by
+  intro n
+  induction n with
+  | zero => intro i h; match i, h with | i + 1, _ => rfl
+  | succ k ih =>
+    intro i h
+    match i, h with
+    | i + 1, h =>
+      show cho k i + cho k (i + 1) = 0
+      rw [ih (by omega), ih (by omega)]
+
+theorem cho_self : ∀ n, cho n n = 1 := by
+  intro n
+  induction n with
+  | zero => rfl
+  | succ k ih =>
+    show cho k k + cho k (k + 1) = 1
+    rw [ih, cho_eq_zero_of_lt (Nat.lt_succ_self k)]
+
+theorem cho_fact : ∀ n i, i ≤ n → cho n i * (fact i * fact (n - i)) = fact n := by
+  intro n
+  induction n with
+  | zero => intro i h; cases Nat.le_zero.mp h; rfl
+  | succ k ih =>
+    intro i h
+    match i with
+    | 0 =>
+      show 1 * (1 * fact (k + 1)) = fact (k + 1)
+      omega
+    | i + 1 =>
+      show (cho k i + cho k (i + 1)) * (fact (i + 1) * fact (k + 1 - (i + 1))) =
+        fact (k + 1)
+      have hf1 : fact (i + 1) = (i + 1) * fact i := rfl
+      rcases Nat.lt_or_ge k (i + 1) with hlt | hge
+      · -- top of the column: i = k, the second binomial vanishes
+        have he : i = k := by omega
+        rw [he, cho_self, show cho k (k + 1) = 0 from cho_eq_zero_of_lt (Nat.lt_succ_self k),
+          Nat.sub_self]
+        show (1 + 0) * (fact (k + 1) * 1) = fact (k + 1)
+        omega
+      · have h1 := ih i (by omega)
+        have h2 := ih (i + 1) hge
+        have hs1 : k + 1 - (i + 1) = k - i := by omega
+        have hs2 : k - i = (k - (i + 1)) + 1 := by omega
+        -- cho k i * ((i+1)! * (k-i)!) = (i+1) * k!
+        have e1 : cho k i * (fact (i + 1) * fact (k - i)) = (i + 1) * fact k := by
+          rw [hf1, ← h1]
+          simp only [Nat.mul_assoc, Nat.mul_comm, Nat.mul_left_comm]
+        -- cho k (i+1) * ((i+1)! * (k-i)!) = (k-i) * k!
+        have e2 : cho k (i + 1) * (fact (i + 1) * fact (k - i)) = (k - i) * fact k := by
+          rw [hs2, show fact ((k - (i + 1)) + 1) = ((k - (i + 1)) + 1) * fact (k - (i + 1))
+            from rfl, ← h2]
+          simp only [Nat.mul_left_comm]
+        rw [hs1, Nat.add_mul, e1, e2, ← Nat.add_mul]
+        have hc : i + 1 + (k - i) = k + 1 := by omega
+        rw [hc]
+        rfl
+
+/-- Binomial theorem. -/
+theorem add_pow (a b n : Nat) :
+    (a + b) ^ n = tsum n (fun i => cho n i * a ^ i * b ^ (n - i)) := by
+  induction n with
+  | zero =>
+    show 1 = cho 0 0 * a ^ 0 * b ^ 0
+    rfl
+  | succ k ih =>
+    have step : (a + b) ^ (k + 1) =
+        tsum k (fun i => cho k i * a ^ (i + 1) * b ^ (k - i)) +
+          tsum k (fun i => cho k i * a ^ i * b ^ (k + 1 - i)) := by
+      have hx : (a + b) ^ (k + 1) = (a + b) ^ k * a + (a + b) ^ k * b := by
+        rw [Nat.pow_succ, Nat.mul_add]
+      rw [hx, ih, tsum_mul_const, tsum_mul_const]
+      congr 1
+      · refine tsum_congr (fun i hi => ?_)
+        rw [Nat.pow_succ]
+        simp only [Nat.mul_assoc, Nat.mul_comm, Nat.mul_left_comm]
+      · refine tsum_congr (fun i hi => ?_)
+        rw [show k + 1 - i = (k - i) + 1 by omega, Nat.pow_succ]
+        simp only [Nat.mul_assoc, Nat.mul_comm, Nat.mul_left_comm]
+    rw [step]
+    have peel : tsum (k + 1) (fun i => cho (k + 1) i * a ^ i * b ^ (k + 1 - i)) =
+        b ^ (k + 1) +
+          tsum k (fun i => cho (k + 1) (i + 1) * a ^ (i + 1) * b ^ (k - i)) := by
+      rw [tsum_shift]
+      congr 1
+      · show cho (k + 1) 0 * a ^ 0 * b ^ (k + 1) = b ^ (k + 1)
+        show 1 * 1 * b ^ (k + 1) = b ^ (k + 1)
+        omega
+      · exact tsum_congr (fun i hi => by rw [show k + 1 - (i + 1) = k - i by omega])
+    rw [peel]
+    have pascal : tsum k (fun i => cho (k + 1) (i + 1) * a ^ (i + 1) * b ^ (k - i)) =
+        tsum k (fun i => cho k i * a ^ (i + 1) * b ^ (k - i)) +
+          tsum k (fun i => cho k (i + 1) * a ^ (i + 1) * b ^ (k - i)) := by
+      rw [← tsum_add]
+      refine tsum_congr (fun i hi => ?_)
+      show (cho k i + cho k (i + 1)) * _ * _ = _
+      rw [Nat.add_mul, Nat.add_mul]
+    rw [pascal]
+    -- the b-branch of `step` equals b^(k+1) plus the shifted Pascal remainder
+    have hb : tsum k (fun i => cho k i * a ^ i * b ^ (k + 1 - i)) =
+        b ^ (k + 1) + tsum k (fun i => cho k (i + 1) * a ^ (i + 1) * b ^ (k - i)) := by
+      cases k with
+      | zero =>
+        show cho 0 0 * a ^ 0 * b ^ 1 = b ^ 1 + cho 0 1 * a ^ 1 * b ^ 0
+        show 1 * 1 * b ^ 1 = b ^ 1 + 0 * a ^ 1 * b ^ 0
+        omega
+      | succ m =>
+        rw [tsum_shift]
+        have hcong : tsum m
+            (fun i => cho (m + 1) (i + 1) * a ^ (i + 1) * b ^ (m + 1 + 1 - (i + 1))) =
+            tsum m (fun i => cho (m + 1) (i + 1) * a ^ (i + 1) * b ^ (m + 1 - i)) :=
+          tsum_congr (fun i hi => by
+            rw [show m + 1 + 1 - (i + 1) = m + 1 - i by omega])
+        have hext : tsum (m + 1)
+            (fun i => cho (m + 1) (i + 1) * a ^ (i + 1) * b ^ (m + 1 - i)) =
+            tsum m (fun i => cho (m + 1) (i + 1) * a ^ (i + 1) * b ^ (m + 1 - i)) +
+              cho (m + 1) (m + 2) * a ^ (m + 2) * b ^ (m + 1 - (m + 1)) := rfl
+        have hz : cho (m + 1) (m + 2) = 0 := cho_eq_zero_of_lt (by omega)
+        rw [hz, Nat.zero_mul, Nat.zero_mul, Nat.add_zero] at hext
+        show 1 * 1 * b ^ (m + 2) +
+            tsum m (fun i => cho (m + 1) (i + 1) * a ^ (i + 1) *
+              b ^ (m + 1 + 1 - (i + 1))) =
+          b ^ (m + 2) +
+            tsum (m + 1) (fun i => cho (m + 1) (i + 1) * a ^ (i + 1) * b ^ (m + 1 - i))
+        rw [hcong, hext]
+        omega
+    rw [hb]
+    omega
+
+/-! ## `expNum` as a sum, and the product inequalities -/
+
+theorem expNum_eq_tsum (n p q : Nat) :
+    expNum n p q = tsum n (fun j => ffacAux j (n - j) * p ^ j * q ^ (n - j)) := by
+  induction n with
+  | zero => rfl
+  | succ k ih =>
+    show (k + 1) * q * expNum k p q + p ^ (k + 1) = _
+    rw [ih, const_mul_tsum]
+    have hsum : tsum k (fun j => (k + 1) * q *
+        (ffacAux j (k - j) * p ^ j * q ^ (k - j))) =
+        tsum k (fun j => ffacAux j (k + 1 - j) * p ^ j * q ^ (k + 1 - j)) := by
+      refine tsum_congr (fun j hj => ?_)
+      have h1 : k + 1 - j = (k - j) + 1 := by omega
+      rw [h1]
+      have h2 : ffacAux j (k - j + 1) = (j + (k - j) + 1) * ffacAux j (k - j) := rfl
+      rw [h2, show j + (k - j) + 1 = k + 1 by omega, Nat.pow_succ]
+      simp only [Nat.mul_assoc, Nat.mul_comm, Nat.mul_left_comm]
+    rw [hsum]
+    have hlast : tsum (k + 1) (fun j => ffacAux j (k + 1 - j) * p ^ j * q ^ (k + 1 - j)) =
+        tsum k (fun j => ffacAux j (k + 1 - j) * p ^ j * q ^ (k + 1 - j)) +
+          ffacAux (k + 1) (k + 1 - (k + 1)) * p ^ (k + 1) * q ^ (k + 1 - (k + 1)) := rfl
+    rw [hlast, Nat.sub_self]
+    show _ = _ + 1 * p ^ (k + 1) * 1
+    omega
+
+theorem mul_pos' {a b : Nat} (ha : 0 < a) (hb : 0 < b) : 0 < a * b :=
+  Nat.mul_pos ha hb
+
+/-- The convolution coefficient identity behind both product inequalities. -/
+theorem coef_eq {N M i j : Nat} (hi : i ≤ N) (hj : j ≤ M) :
+    ffacAux i (N - i) * ffacAux j (M - j) * fact (N + M) =
+      fact N * fact M * (ffacAux (i + j) (N + M - (i + j)) * cho (i + j) i) := by
+  refine Nat.eq_of_mul_eq_mul_right (mul_pos' (fact_pos i) (fact_pos j)) ?_
+  have hL : ffacAux i (N - i) * ffacAux j (M - j) * fact (N + M) * (fact i * fact j) =
+      (ffacAux i (N - i) * fact i) * ((ffacAux j (M - j) * fact j) * fact (N + M)) := by
+    simp only [Nat.mul_assoc, Nat.mul_comm, Nat.mul_left_comm]
+  rw [hL, ffacAux_mul_fact, ffacAux_mul_fact,
+    show i + (N - i) = N by omega, show j + (M - j) = M by omega]
+  have hR : fact N * fact M * (ffacAux (i + j) (N + M - (i + j)) * cho (i + j) i) *
+      (fact i * fact j) =
+      fact N * (fact M * (ffacAux (i + j) (N + M - (i + j)) *
+        (cho (i + j) i * (fact i * fact j)))) := by
+    simp only [Nat.mul_assoc, Nat.mul_comm, Nat.mul_left_comm]
+  rw [hR, show fact j = fact (i + j - i) by rw [show i + j - i = j by omega],
+    cho_fact (i + j) i (by omega), ffacAux_mul_fact,
+    show i + j + (N + M - (i + j)) = N + M by omega]
+
+theorem tsum_mul_tsum (f g : Nat → Nat) (N M c : Nat) :
+    tsum N f * tsum M g * c =
+      tsum N (fun i => tsum M (fun j => f i * (g j * c))) := by
+  calc tsum N f * tsum M g * c
+      = tsum N (fun i => f i * (tsum M g * c)) := by
+        rw [Nat.mul_assoc, tsum_mul_const]
+    _ = tsum N (fun i => tsum M (fun j => f i * (g j * c))) := by
+        refine tsum_congr (fun i hi => ?_)
+        rw [tsum_mul_const, const_mul_tsum]
+
+/-- Box form of a product of two partial sums (times a constant). -/
+theorem expNum_mul_box (N M p1 p2 q c : Nat) :
+    expNum N p1 q * expNum M p2 q * c =
+      tsum N (fun i => tsum M (fun j =>
+        ffacAux i (N - i) * ffacAux j (M - j) * c *
+          (p1 ^ i * (p2 ^ j * (q ^ (N - i) * q ^ (M - j)))))) := by
+  rw [expNum_eq_tsum, expNum_eq_tsum, tsum_mul_tsum]
+  refine tsum_congr (fun i hi => tsum_congr (fun j hj => ?_))
+  simp only [Nat.mul_assoc, Nat.mul_comm, Nat.mul_left_comm]
+
+/-- Second convolution coefficient identity (triangle side, equal scales). -/
+theorem coef_eq2 {K n i : Nat} (hn : n ≤ K) (hi : i ≤ n) :
+    ffacAux n (K - n) * cho n i * fact K =
+      ffacAux i (K - i) * ffacAux (n - i) (K - (n - i)) := by
+  refine Nat.eq_of_mul_eq_mul_right (mul_pos' (fact_pos i) (fact_pos (n - i))) ?_
+  have hL : ffacAux n (K - n) * cho n i * fact K * (fact i * fact (n - i)) =
+      ffacAux n (K - n) * ((cho n i * (fact i * fact (n - i))) * fact K) := by
+    simp only [Nat.mul_assoc, Nat.mul_comm, Nat.mul_left_comm]
+  rw [hL, cho_fact n i hi]
+  have hL2 : ffacAux n (K - n) * (fact n * fact K) =
+      (ffacAux n (K - n) * fact n) * fact K := by
+    rw [Nat.mul_assoc]
+  rw [hL2, ffacAux_mul_fact, show n + (K - n) = K by omega]
+  have hR : ffacAux i (K - i) * ffacAux (n - i) (K - (n - i)) * (fact i * fact (n - i)) =
+      (ffacAux i (K - i) * fact i) * (ffacAux (n - i) (K - (n - i)) * fact (n - i)) := by
+    simp only [Nat.mul_assoc, Nat.mul_comm, Nat.mul_left_comm]
+  rw [hR, ffacAux_mul_fact, ffacAux_mul_fact, show i + (K - i) = K by omega,
+    show n - i + (K - (n - i)) = K by omega]
+
+/-- Triangle form of a partial sum at a sum argument (times a constant). -/
+theorem expNum_add_tri (C p1 p2 q c : Nat) :
+    expNum C (p1 + p2) q * c =
+      tsum C (fun n => tsum n (fun i =>
+        ffacAux (i + (n - i)) (C - (i + (n - i))) * cho (i + (n - i)) i * c *
+          (p1 ^ i * (p2 ^ (n - i) * q ^ (C - (i + (n - i))))))) := by
+  rw [expNum_eq_tsum, tsum_mul_const]
+  refine tsum_congr (fun n hn => ?_)
+  show ffacAux n (C - n) * (p1 + p2) ^ n * q ^ (C - n) * c = _
+  rw [add_pow, const_mul_tsum, tsum_mul_const, tsum_mul_const]
+  refine tsum_congr (fun i hi => ?_)
+  rw [show i + (n - i) = n by omega]
+  simp only [Nat.mul_assoc, Nat.mul_comm, Nat.mul_left_comm]
+
+/-- `S_N(p1/q) S_M(p2/q) ≤ S_{N+M}((p1+p2)/q)`, integer-scaled. -/
+theorem prod_le_sum (N M p1 p2 q : Nat) :
+    expNum N p1 q * expNum M p2 q * fact (N + M) ≤
+      expNum (N + M) (p1 + p2) q * (fact N * fact M) := by
+  rw [expNum_mul_box N M p1 p2 q (fact (N + M)),
+    expNum_add_tri (N + M) p1 p2 q (fact N * fact M)]
+  refine Nat.le_trans (tsum_le_tsum fun i hi => tsum_le_tsum fun j hj =>
+    Nat.le_of_eq ?_)
+    (box_le_tri (fun i j =>
+      ffacAux (i + j) (N + M - (i + j)) * cho (i + j) i * (fact N * fact M) *
+        (p1 ^ i * (p2 ^ j * q ^ (N + M - (i + j))))) N M)
+  have hq : q ^ (N - i) * q ^ (M - j) = q ^ (N + M - (i + j)) := by
+    rw [← Nat.pow_add]
+    congr 1
+    omega
+  rw [hq, coef_eq hi hj]
+  simp only [Nat.mul_assoc, Nat.mul_comm, Nat.mul_left_comm]
+
+/-- `S_K((p1+p2)/q) ≤ S_K(p1/q) S_K(p2/q)`, integer-scaled. -/
+theorem sum_le_prod (K p1 p2 q : Nat) :
+    expNum K (p1 + p2) q * (fact K * q ^ K) ≤ expNum K p1 q * expNum K p2 q := by
+  rw [expNum_add_tri K p1 p2 q (fact K * q ^ K),
+    show expNum K p1 q * expNum K p2 q = expNum K p1 q * expNum K p2 q * 1 from
+      (Nat.mul_one _).symm,
+    expNum_mul_box K K p1 p2 q 1]
+  refine Nat.le_trans (Nat.le_of_eq ?_)
+    (tri_le_box (fun i j =>
+      ffacAux i (K - i) * ffacAux j (K - j) * 1 *
+        (p1 ^ i * (p2 ^ j * (q ^ (K - i) * q ^ (K - j))))) K)
+  refine tsum_congr (fun n hn => tsum_congr (fun i hi => ?_))
+  rw [show i + (n - i) = n by omega,
+    show ffacAux i (K - i) * ffacAux (n - i) (K - (n - i)) =
+      ffacAux n (K - n) * cho n i * fact K from (coef_eq2 hn hi).symm,
+    show q ^ (K - i) * q ^ (K - (n - i)) = q ^ K * q ^ (K - n) from by
+      rw [← Nat.pow_add, ← Nat.pow_add]
+      congr 1
+      omega]
+  simp only [Nat.mul_assoc, Nat.mul_comm, Nat.mul_left_comm, Nat.mul_one]
+
+/-! ## Monotonicity and the tail bound -/
+
+/-- Cross-scale fraction transitivity: `a/b ≤ c/d ≤ e/f → a/b ≤ e/f`. -/
+theorem div_le_trans {a b c d e f : Nat} (hd : 0 < d)
+    (h1 : a * d ≤ c * b) (h2 : c * f ≤ e * d) : a * f ≤ e * b := by
+  refine Nat.le_of_mul_le_mul_right ?_ hd
+  calc a * f * d = a * d * f := by
+        simp only [Nat.mul_comm, Nat.mul_left_comm]
+    _ ≤ c * b * f := Nat.mul_le_mul_right f h1
+    _ = c * f * b := by simp only [Nat.mul_comm, Nat.mul_left_comm]
+    _ ≤ e * d * b := Nat.mul_le_mul_right b h2
+    _ = e * b * d := by simp only [Nat.mul_comm, Nat.mul_left_comm]
+
+theorem expNum_step_le (n p q : Nat) :
+    (n + 1) * q * expNum n p q ≤ expNum (n + 1) p q := by
+  show _ ≤ (n + 1) * q * expNum n p q + p ^ (n + 1)
+  omega
+
+/-- `S_n ≤ S_m` for `n ≤ m`, cross-scaled. -/
+theorem expNum_mono_N {p q : Nat} {n m : Nat} (h : n ≤ m) :
+    expNum n p q * (fact m * q ^ m) ≤ expNum m p q * (fact n * q ^ n) := by
+  have key : ∀ d, expNum n p q * (fact (n + d) * q ^ (n + d)) ≤
+      expNum (n + d) p q * (fact n * q ^ n) := by
+    intro d
+    induction d with
+    | zero => exact Nat.le_refl _
+    | succ k ih =>
+      have hf : fact (n + (k + 1)) = (n + k + 1) * fact (n + k) := rfl
+      have hp : q ^ (n + (k + 1)) = q ^ (n + k) * q := by
+        rw [show n + (k + 1) = (n + k) + 1 by omega, Nat.pow_succ]
+      have e1 : expNum n p q * (fact (n + (k + 1)) * q ^ (n + (k + 1))) =
+          (n + k + 1) * q * (expNum n p q * (fact (n + k) * q ^ (n + k))) := by
+        rw [hf, hp]
+        simp only [Nat.mul_assoc, Nat.mul_comm, Nat.mul_left_comm]
+      rw [e1]
+      have step1 : (n + k + 1) * q * (expNum n p q * (fact (n + k) * q ^ (n + k))) ≤
+          (n + k + 1) * q * (expNum (n + k) p q * (fact n * q ^ n)) :=
+        Nat.mul_le_mul_left _ ih
+      have e2 : (n + k + 1) * q * (expNum (n + k) p q * (fact n * q ^ n)) =
+          (n + k + 1) * q * expNum (n + k) p q * (fact n * q ^ n) := by
+        simp only [Nat.mul_assoc]
+      have step2 : (n + k + 1) * q * expNum (n + k) p q * (fact n * q ^ n) ≤
+          expNum (n + k + 1) p q * (fact n * q ^ n) :=
+        Nat.mul_le_mul_right _ (expNum_step_le (n + k) p q)
+      rw [show n + (k + 1) = n + k + 1 from rfl]
+      omega
+  have hkey := key (m - n)
+  rw [show n + (m - n) = m by omega] at hkey
+  exact hkey
+
+/-- Argument monotonicity: `p/q ≤ p'/q'` gives `S_n(p/q) ≤ S_n(p'/q')`. -/
+theorem expNum_arg_mono {p q p' q' : Nat} (h : p * q' ≤ p' * q) (n : Nat) :
+    expNum n p q * q' ^ n ≤ expNum n p' q' * q ^ n := by
+  induction n with
+  | zero => exact Nat.le_refl _
+  | succ k ih =>
+    show ((k + 1) * q * expNum k p q + p ^ (k + 1)) * q' ^ (k + 1) ≤
+      ((k + 1) * q' * expNum k p' q' + p' ^ (k + 1)) * q ^ (k + 1)
+    rw [Nat.add_mul ((k + 1) * q * expNum k p q) (p ^ (k + 1)) (q' ^ (k + 1)),
+      Nat.add_mul ((k + 1) * q' * expNum k p' q') (p' ^ (k + 1)) (q ^ (k + 1))]
+    have h1 : (k + 1) * q * expNum k p q * q' ^ (k + 1) ≤
+        (k + 1) * q' * expNum k p' q' * q ^ (k + 1) := by
+      have e1 : (k + 1) * q * expNum k p q * q' ^ (k + 1) =
+          (k + 1) * (q * q') * (expNum k p q * q' ^ k) := by
+        rw [Nat.pow_succ]
+        simp only [Nat.mul_assoc, Nat.mul_comm, Nat.mul_left_comm]
+      have e2 : (k + 1) * q' * expNum k p' q' * q ^ (k + 1) =
+          (k + 1) * (q * q') * (expNum k p' q' * q ^ k) := by
+        rw [Nat.pow_succ]
+        simp only [Nat.mul_assoc, Nat.mul_comm, Nat.mul_left_comm]
+      rw [e1, e2]
+      exact Nat.mul_le_mul_left _ ih
+    have h2 : p ^ (k + 1) * q' ^ (k + 1) ≤ p' ^ (k + 1) * q ^ (k + 1) := by
+      rw [← Nat.mul_pow, ← Nat.mul_pow]
+      exact Nat.pow_le_pow_left h (k + 1)
+    omega
+
+theorem expNum_zero_arg (n q : Nat) : expNum n 0 q = fact n * q ^ n := by
+  induction n with
+  | zero => rfl
+  | succ k ih =>
+    show (k + 1) * q * expNum k 0 q + 0 ^ (k + 1) = fact (k + 1) * q ^ (k + 1)
+    rw [ih, show (0 : Nat) ^ (k + 1) = 0 by rw [Nat.zero_pow (by omega)],
+      show fact (k + 1) = (k + 1) * fact k from rfl, Nat.pow_succ]
+    simp only [Nat.mul_assoc, Nat.mul_comm, Nat.mul_left_comm]
+    omega
+
+/-- One step of the decreasing tail potential
+`B_M = (E_M (M+1) q + 2 p^(M+1)) / ((M+1)! q^(M+1))`, for `2p ≤ (M+2)q`. -/
+theorem tail_potential_step {p q M : Nat} (hM : 2 * p ≤ (M + 2) * q) :
+    expNum (M + 1) p q * ((M + 2) * q) + 2 * p ^ (M + 2) ≤
+      (expNum M p q * ((M + 1) * q) + 2 * p ^ (M + 1)) * ((M + 2) * q) := by
+  have hE : expNum (M + 1) p q = (M + 1) * q * expNum M p q + p ^ (M + 1) := rfl
+  have hp2 : p ^ (M + 2) = p * p ^ (M + 1) := by
+    rw [show M + 2 = (M + 1) + 1 by omega, Nat.pow_succ, Nat.mul_comm]
+  have hkey : 2 * (p * p ^ (M + 1)) ≤ (M + 2) * q * p ^ (M + 1) := by
+    rw [← Nat.mul_assoc]
+    exact Nat.mul_le_mul_right _ hM
+  have eL : expNum (M + 1) p q * ((M + 2) * q) + 2 * p ^ (M + 2) =
+      expNum M p q * ((M + 1) * q) * ((M + 2) * q) +
+        (M + 2) * q * p ^ (M + 1) + 2 * (p * p ^ (M + 1)) := by
+    rw [hE, hp2, Nat.add_mul ((M + 1) * q * expNum M p q) (p ^ (M + 1)) ((M + 2) * q)]
+    have a1 : (M + 1) * q * expNum M p q * ((M + 2) * q) =
+        expNum M p q * ((M + 1) * q) * ((M + 2) * q) := by
+      simp only [Nat.mul_assoc, Nat.mul_comm, Nat.mul_left_comm]
+    have a2 : p ^ (M + 1) * ((M + 2) * q) = (M + 2) * q * p ^ (M + 1) := by
+      simp only [Nat.mul_comm, Nat.mul_left_comm]
+    omega
+  have eR : (expNum M p q * ((M + 1) * q) + 2 * p ^ (M + 1)) * ((M + 2) * q) =
+      expNum M p q * ((M + 1) * q) * ((M + 2) * q) +
+        2 * ((M + 2) * q * p ^ (M + 1)) := by
+    rw [Nat.add_mul (expNum M p q * ((M + 1) * q)) (2 * p ^ (M + 1)) ((M + 2) * q)]
+    have a3 : 2 * p ^ (M + 1) * ((M + 2) * q) = 2 * ((M + 2) * q * p ^ (M + 1)) := by
+      simp only [Nat.mul_comm, Nat.mul_left_comm]
+    omega
+  omega
+
+/-- All partial sums beyond `K` stay under the `K`-th tail potential:
+`S_M ≤ B_K` for `M ≥ K` when `2p ≤ (K+2)q`. -/
+theorem tail_bound {p q K : Nat} (hq : 0 < q) (hK : 2 * p ≤ (K + 2) * q) :
+    ∀ M, expNum M p q * (fact (K + 1) * q ^ (K + 1)) ≤
+      (expNum K p q * ((K + 1) * q) + 2 * p ^ (K + 1)) * (fact M * q ^ M) := by
+  -- denominators are positive
+  have hden : ∀ j, 0 < fact j * q ^ j := fun j =>
+    mul_pos' (fact_pos j) (Nat.pow_pos hq)
+  -- B_(K+d) ≤ B_K by chaining the potential step
+  have hB : ∀ d,
+      (expNum (K + d) p q * ((K + d + 1) * q) + 2 * p ^ (K + d + 1)) *
+          (fact (K + 1) * q ^ (K + 1)) ≤
+        (expNum K p q * ((K + 1) * q) + 2 * p ^ (K + 1)) *
+          (fact (K + d + 1) * q ^ (K + d + 1)) := by
+    intro d
+    induction d with
+    | zero => exact Nat.le_refl _
+    | succ e ih =>
+      have hstep := tail_potential_step (p := p) (q := q) (M := K + e)
+        (by have : (K + 2) * q ≤ (K + e + 2) * q := Nat.mul_le_mul_right q (by omega)
+            omega)
+      -- B_(K+e+1) ≤ B_(K+e) cross-scaled, then transitivity with ih
+      have hcross : (expNum (K + e + 1) p q * ((K + e + 2) * q) + 2 * p ^ (K + e + 2)) *
+          (fact (K + e + 1) * q ^ (K + e + 1)) ≤
+          (expNum (K + e) p q * ((K + e + 1) * q) + 2 * p ^ (K + e + 1)) *
+            (fact (K + e + 2) * q ^ (K + e + 2)) := by
+        have hf : fact (K + e + 2) = (K + e + 2) * fact (K + e + 1) := rfl
+        have hp : q ^ (K + e + 2) = q ^ (K + e + 1) * q := by
+          rw [show K + e + 2 = (K + e + 1) + 1 by omega, Nat.pow_succ]
+        rw [hf, hp]
+        have e1 : (expNum (K + e) p q * ((K + e + 1) * q) + 2 * p ^ (K + e + 1)) *
+            ((K + e + 2) * fact (K + e + 1) * (q ^ (K + e + 1) * q)) =
+            ((expNum (K + e) p q * ((K + e + 1) * q) + 2 * p ^ (K + e + 1)) *
+              ((K + e + 2) * q)) * (fact (K + e + 1) * q ^ (K + e + 1)) := by
+          simp only [Nat.mul_assoc, Nat.mul_comm, Nat.mul_left_comm]
+        rw [e1]
+        exact Nat.mul_le_mul_right _ (by
+          rw [show K + e + 1 + 1 = K + e + 2 by omega] at hstep
+          exact hstep)
+      rw [show K + (e + 1) = K + e + 1 by omega]
+      exact div_le_trans (hden (K + e + 1)) hcross ih
+  intro M
+  rcases Nat.lt_or_ge M K with hlt | hge
+  · -- below K: S_M ≤ S_K ≤ B_K
+    have hmono := expNum_mono_N (p := p) (q := q) (Nat.le_of_lt hlt)
+    have hSK : expNum K p q * (fact (K + 1) * q ^ (K + 1)) ≤
+        (expNum K p q * ((K + 1) * q) + 2 * p ^ (K + 1)) * (fact K * q ^ K) := by
+      have e1 : expNum K p q * (fact (K + 1) * q ^ (K + 1)) =
+          expNum K p q * ((K + 1) * q) * (fact K * q ^ K) := by
+        rw [show fact (K + 1) = (K + 1) * fact K from rfl, Nat.pow_succ]
+        simp only [Nat.mul_assoc, Nat.mul_comm, Nat.mul_left_comm]
+      rw [e1]
+      exact Nat.mul_le_mul_right _ (by omega)
+    exact div_le_trans (hden K) hmono hSK
+  · -- at or above K: S_M ≤ B_M ≤ B_K
+    have hSM : expNum M p q * (fact (M + 1) * q ^ (M + 1)) ≤
+        (expNum M p q * ((M + 1) * q) + 2 * p ^ (M + 1)) * (fact M * q ^ M) := by
+      have e1 : expNum M p q * (fact (M + 1) * q ^ (M + 1)) =
+          expNum M p q * ((M + 1) * q) * (fact M * q ^ M) := by
+        rw [show fact (M + 1) = (M + 1) * fact M from rfl, Nat.pow_succ]
+        simp only [Nat.mul_assoc, Nat.mul_comm, Nat.mul_left_comm]
+      rw [e1]
+      exact Nat.mul_le_mul_right _ (by omega)
+    have hBM := hB (M - K)
+    rw [show K + (M - K) = M by omega] at hBM
+    exact div_le_trans (hden (M + 1)) hSM hBM
+
+/-! ## Exponential caps
+
+`capUB p q y w` says `e^(p/q) ≤ y/w` (every partial sum is bounded);
+`capLB p q y w` says `e^(p/q) ≥ y/w` (some partial sum already reaches it).
+These four-`Nat` relations are the interface the floor-specification
+assembly uses; the lemmas below are the surrogates for
+`e^(a+b) = e^a e^b` and monotonicity.
+-/
+
+def capUB (p q y w : Nat) : Prop := ∀ n, expNum n p q * w ≤ y * (fact n * q ^ n)
+
+def capLB (p q y w : Nat) : Prop := ∃ n, y * (fact n * q ^ n) ≤ expNum n p q * w
+
+theorem capUB_mul {p1 p2 q y1 w1 y2 w2 : Nat} (hq : 0 < q)
+    (h1 : capUB p1 q y1 w1) (h2 : capUB p2 q y2 w2) :
+    capUB (p1 + p2) q (y1 * y2) (w1 * w2) := by
+  intro n
+  have hd : 0 < fact n * q ^ n := mul_pos' (fact_pos n) (Nat.pow_pos hq)
+  refine Nat.le_of_mul_le_mul_right ?_ hd
+  calc expNum n (p1 + p2) q * (w1 * w2) * (fact n * q ^ n)
+      = expNum n (p1 + p2) q * (fact n * q ^ n) * (w1 * w2) := by
+        simp only [Nat.mul_assoc, Nat.mul_comm, Nat.mul_left_comm]
+    _ ≤ expNum n p1 q * expNum n p2 q * (w1 * w2) :=
+        Nat.mul_le_mul_right _ (sum_le_prod n p1 p2 q)
+    _ = (expNum n p1 q * w1) * (expNum n p2 q * w2) := by
+        simp only [Nat.mul_assoc, Nat.mul_comm, Nat.mul_left_comm]
+    _ ≤ (y1 * (fact n * q ^ n)) * (y2 * (fact n * q ^ n)) :=
+        Nat.mul_le_mul (h1 n) (h2 n)
+    _ = y1 * y2 * (fact n * q ^ n) * (fact n * q ^ n) := by
+        simp only [Nat.mul_assoc, Nat.mul_comm, Nat.mul_left_comm]
+
+theorem capLB_mul {p1 p2 q y1 w1 y2 w2 : Nat}
+    (h1 : capLB p1 q y1 w1) (h2 : capLB p2 q y2 w2) :
+    capLB (p1 + p2) q (y1 * y2) (w1 * w2) := by
+  obtain ⟨n1, e1⟩ := h1
+  obtain ⟨n2, e2⟩ := h2
+  refine ⟨n1 + n2, ?_⟩
+  have hd : 0 < fact n1 * fact n2 := mul_pos' (fact_pos n1) (fact_pos n2)
+  refine Nat.le_of_mul_le_mul_right ?_ hd
+  calc y1 * y2 * (fact (n1 + n2) * q ^ (n1 + n2)) * (fact n1 * fact n2)
+      = (y1 * (fact n1 * q ^ n1)) * (y2 * (fact n2 * q ^ n2)) * fact (n1 + n2) := by
+        rw [show q ^ (n1 + n2) = q ^ n1 * q ^ n2 from Nat.pow_add q n1 n2]
+        simp only [Nat.mul_assoc, Nat.mul_comm, Nat.mul_left_comm]
+    _ ≤ (expNum n1 p1 q * w1) * (expNum n2 p2 q * w2) * fact (n1 + n2) :=
+        Nat.mul_le_mul_right _ (Nat.mul_le_mul e1 e2)
+    _ = expNum n1 p1 q * expNum n2 p2 q * fact (n1 + n2) * (w1 * w2) := by
+        simp only [Nat.mul_assoc, Nat.mul_comm, Nat.mul_left_comm]
+    _ ≤ expNum (n1 + n2) (p1 + p2) q * (fact n1 * fact n2) * (w1 * w2) :=
+        Nat.mul_le_mul_right _ (prod_le_sum n1 n2 p1 p2 q)
+    _ = expNum (n1 + n2) (p1 + p2) q * (w1 * w2) * (fact n1 * fact n2) := by
+        simp only [Nat.mul_assoc, Nat.mul_comm]
+
+/-- Quotient mover: from `e^(a+b) ≤ C/W` and `e^b ≥ G/V`, get `e^a ≤ CV/(WG)`. -/
+theorem capUB_cancel {pa pb q C W G V : Nat} (hq : 0 < q)
+    (hsum : capUB (pa + pb) q C W) (hb : capLB pb q G V) :
+    capUB pa q (C * V) (W * G) := by
+  intro n
+  obtain ⟨m, hm⟩ := hb
+  have hd : 0 < fact m * q ^ m * fact (n + m) :=
+    mul_pos' (mul_pos' (fact_pos m) (Nat.pow_pos hq)) (fact_pos (n + m))
+  refine Nat.le_of_mul_le_mul_right ?_ hd
+  calc expNum n pa q * (W * G) * (fact m * q ^ m * fact (n + m))
+      = (G * (fact m * q ^ m)) * (expNum n pa q * W * fact (n + m)) := by
+        simp only [Nat.mul_assoc, Nat.mul_comm, Nat.mul_left_comm]
+    _ ≤ (expNum m pb q * V) * (expNum n pa q * W * fact (n + m)) :=
+        Nat.mul_le_mul_right _ hm
+    _ = (expNum n pa q * expNum m pb q * fact (n + m)) * (W * V) := by
+        simp only [Nat.mul_assoc, Nat.mul_comm, Nat.mul_left_comm]
+    _ ≤ (expNum (n + m) (pa + pb) q * (fact n * fact m)) * (W * V) :=
+        Nat.mul_le_mul_right _ (prod_le_sum n m pa pb q)
+    _ = (expNum (n + m) (pa + pb) q * W) * (fact n * fact m * V) := by
+        simp only [Nat.mul_assoc, Nat.mul_comm, Nat.mul_left_comm]
+    _ ≤ (C * (fact (n + m) * q ^ (n + m))) * (fact n * fact m * V) :=
+        Nat.mul_le_mul_right _ (hsum (n + m))
+    _ = C * V * (fact n * q ^ n) * (fact m * q ^ m * fact (n + m)) := by
+        rw [show q ^ (n + m) = q ^ n * q ^ m from Nat.pow_add q n m]
+        simp only [Nat.mul_assoc, Nat.mul_comm, Nat.mul_left_comm]
+
+theorem capUB_one (q : Nat) : capUB 0 q 1 1 := by
+  intro n
+  rw [expNum_zero_arg]
+  omega
+
+theorem capLB_one (q : Nat) : capLB 0 q 1 1 :=
+  ⟨0, by rw [expNum_zero_arg]; omega⟩
+
+theorem capUB_pow {p q y w : Nat} (hq : 0 < q) (h : capUB p q y w) :
+    ∀ k, capUB (k * p) q (y ^ k) (w ^ k) := by
+  intro k
+  induction k with
+  | zero =>
+    show capUB (0 * p) q (y ^ 0) (w ^ 0)
+    rw [Nat.zero_mul]
+    exact capUB_one q
+  | succ j ih =>
+    have := capUB_mul hq ih h
+    rw [(Nat.succ_mul j p).symm] at this
+    rw [Nat.pow_succ, Nat.pow_succ]
+    exact this
+
+theorem capLB_pow {p q y w : Nat} (h : capLB p q y w) :
+    ∀ k, capLB (k * p) q (y ^ k) (w ^ k) := by
+  intro k
+  induction k with
+  | zero =>
+    show capLB (0 * p) q (y ^ 0) (w ^ 0)
+    rw [Nat.zero_mul]
+    exact capLB_one q
+  | succ j ih =>
+    have := capLB_mul ih h
+    rw [(Nat.succ_mul j p).symm] at this
+    rw [Nat.pow_succ, Nat.pow_succ]
+    exact this
+
+/-- Transport an upper cap down a smaller argument: `p/q ≤ p'/q'`. -/
+theorem capUB_arg {p q p' q' y w : Nat} (hq' : 0 < q') (h : p * q' ≤ p' * q)
+    (hub : capUB p' q' y w) : capUB p q y w := by
+  intro n
+  have hd : 0 < q' ^ n := Nat.pow_pos hq'
+  refine Nat.le_of_mul_le_mul_right ?_ hd
+  calc expNum n p q * w * q' ^ n
+      = (expNum n p q * q' ^ n) * w := by
+        simp only [Nat.mul_comm, Nat.mul_left_comm]
+    _ ≤ (expNum n p' q' * q ^ n) * w :=
+        Nat.mul_le_mul_right _ (expNum_arg_mono h n)
+    _ = (expNum n p' q' * w) * q ^ n := by
+        simp only [Nat.mul_comm, Nat.mul_left_comm]
+    _ ≤ (y * (fact n * q' ^ n)) * q ^ n :=
+        Nat.mul_le_mul_right _ (hub n)
+    _ = y * (fact n * q ^ n) * q' ^ n := by
+        simp only [Nat.mul_comm, Nat.mul_left_comm]
+
+/-- Transport a lower cap up a larger argument: `p'/q' ≤ p/q`. -/
+theorem capLB_arg {p q p' q' y w : Nat} (hq' : 0 < q') (h : p' * q ≤ p * q')
+    (hlb : capLB p' q' y w) : capLB p q y w := by
+  obtain ⟨n, hn⟩ := hlb
+  refine ⟨n, ?_⟩
+  have hd : 0 < q' ^ n := Nat.pow_pos hq'
+  refine Nat.le_of_mul_le_mul_right ?_ hd
+  calc y * (fact n * q ^ n) * q' ^ n
+      = (y * (fact n * q' ^ n)) * q ^ n := by
+        simp only [Nat.mul_comm, Nat.mul_left_comm]
+    _ ≤ (expNum n p' q' * w) * q ^ n :=
+        Nat.mul_le_mul_right _ hn
+    _ = (expNum n p' q' * q ^ n) * w := by
+        simp only [Nat.mul_comm, Nat.mul_left_comm]
+    _ ≤ (expNum n p q * q' ^ n) * w :=
+        Nat.mul_le_mul_right _ (expNum_arg_mono h n)
+    _ = expNum n p q * w * q' ^ n := by
+        simp only [Nat.mul_comm, Nat.mul_left_comm]
+
+/-- Weaken an upper cap to a looser target: `y/w ≤ y'/w'`. -/
+theorem capUB_weaken {p q y w y' w' : Nat} (hw : 0 < w)
+    (h : capUB p q y w) (hyy : y * w' ≤ y' * w) : capUB p q y' w' := by
+  intro n
+  refine Nat.le_of_mul_le_mul_right ?_ hw
+  calc expNum n p q * w' * w = expNum n p q * w * w' := by
+        simp only [Nat.mul_comm, Nat.mul_left_comm]
+    _ ≤ y * (fact n * q ^ n) * w' := Nat.mul_le_mul_right _ (h n)
+    _ = y * w' * (fact n * q ^ n) := by
+        simp only [Nat.mul_assoc, Nat.mul_comm, Nat.mul_left_comm]
+    _ ≤ y' * w * (fact n * q ^ n) := Nat.mul_le_mul_right _ hyy
+    _ = y' * (fact n * q ^ n) * w := by
+        simp only [Nat.mul_assoc, Nat.mul_comm]
+
+/-- Strengthen a lower cap to a looser target: `y'/w' ≤ y/w`. -/
+theorem capLB_weaken {p q y w y' w' : Nat} (hw : 0 < w)
+    (h : capLB p q y w) (hyy : y' * w ≤ y * w') : capLB p q y' w' := by
+  obtain ⟨n, hn⟩ := h
+  refine ⟨n, ?_⟩
+  refine Nat.le_of_mul_le_mul_right ?_ hw
+  calc y' * (fact n * q ^ n) * w = y' * w * (fact n * q ^ n) := by
+        simp only [Nat.mul_assoc, Nat.mul_comm]
+    _ ≤ y * w' * (fact n * q ^ n) := Nat.mul_le_mul_right _ hyy
+    _ = y * (fact n * q ^ n) * w' := by
+        simp only [Nat.mul_assoc, Nat.mul_comm, Nat.mul_left_comm]
+    _ ≤ expNum n p q * w * w' := Nat.mul_le_mul_right _ hn
+    _ = expNum n p q * w' * w := by
+        simp only [Nat.mul_comm, Nat.mul_left_comm]
+
+/-- Turn one evaluated partial sum plus the geometric tail into a full upper
+cap: with `2p ≤ (K+2)q` and
+`(E_K (K+1) q + 2 p^(K+1)) w ≤ y (K+1)! q^(K+1)`, conclude `e^(p/q) ≤ y/w`. -/
+theorem capUB_of_partial {p q K y w : Nat} (hq : 0 < q) (hK : 2 * p ≤ (K + 2) * q)
+    (h : (expNum K p q * ((K + 1) * q) + 2 * p ^ (K + 1)) * w ≤
+      y * (fact (K + 1) * q ^ (K + 1))) : capUB p q y w := by
+  intro M
+  exact div_le_trans (mul_pos' (fact_pos (K + 1)) (Nat.pow_pos hq))
+    (tail_bound hq hK M) h
+
+end LnExp
diff --git a/formal/ln/LnProof/LnProof/FloorAssembly.lean b/formal/ln/LnProof/LnProof/FloorAssembly.lean
new file mode 100644
index 000000000..9175c6dba
--- /dev/null
+++ b/formal/ln/LnProof/LnProof/FloorAssembly.lean
@@ -0,0 +1,2079 @@
+import LnProof.FloorCaps
+import LnProof.FloorBudget
+import LnProof.FloorModel
+import LnProof.FloorWindow
+
+/-!
+# Floor-spec assembly: scale identities
+
+`model_floor_bracket` brackets the model output `r` against the pre-shift
+accumulator `V = X1·5^27 + ln2k + BIAS` at scale `2^72`. The caps live at
+scale `QS = 10^27·2^99`, reached by multiplying `V` by `2^27`. This file
+provides the exact decomposition of `V·2^27` into the three cap exponents
+on each `clz` side.
+-/
+
+namespace LnFloorCert
+open LnGeneratedModel LnPoly LnExp LnFloor
+
+/-- `V·2^27` splits into the three cap exponents (positive binade shift). -/
+theorem v_scale_pos (X1v : Int) (c : Nat) (hc : c ≤ 160) :
+    (X1v * 7450580596923828125 + ln2kInt c +
+        116873961749927929127912020551506849476088469858172) * 2 ^ 27 =
+      X1v * 1000000000000000000000000000 +
+        ((160 - c : Nat) : Int) * ((LN2c : Int) * 2 ^ 27) +
+        116873961749927929127912020551506849476088469858172 * 2 ^ 27 := by
+  have hl : ln2kInt c = (LN2c : Int) * ((160 - c : Nat) : Int) := by
+    unfold ln2kInt
+    rw [if_pos hc]
+  rw [hl, Int.add_mul, Int.add_mul, Int.mul_assoc,
+    show (7450580596923828125 : Int) * 2 ^ 27 =
+      1000000000000000000000000000 from by decide]
+  have e : (LN2c : Int) * ((160 - c : Nat) : Int) * 2 ^ 27 =
+      ((160 - c : Nat) : Int) * ((LN2c : Int) * 2 ^ 27) := by
+    simp only [Int.mul_assoc, Int.mul_comm, Int.mul_left_comm]
+  rw [e]
+
+/-- `V·2^27` splits with the `ln 2` term on the other side (negative shift). -/
+theorem v_scale_neg (X1v : Int) (c : Nat) (hc : 160 < c) :
+    (X1v * 7450580596923828125 + ln2kInt c +
+        116873961749927929127912020551506849476088469858172) * 2 ^ 27 +
+        ((c - 160 : Nat) : Int) * ((LN2c : Int) * 2 ^ 27) =
+      X1v * 1000000000000000000000000000 +
+        116873961749927929127912020551506849476088469858172 * 2 ^ 27 := by
+  have hl : ln2kInt c = -((LN2c : Int) * ((c - 160 : Nat) : Int)) := by
+    unfold ln2kInt
+    rw [if_neg (by omega)]
+  rw [hl, Int.add_mul, Int.add_mul, Int.mul_assoc,
+    show (7450580596923828125 : Int) * 2 ^ 27 =
+      1000000000000000000000000000 from by decide]
+  have e : -((LN2c : Int) * ((c - 160 : Nat) : Int)) * 2 ^ 27 +
+      ((c - 160 : Nat) : Int) * ((LN2c : Int) * 2 ^ 27) = 0 := by
+    have e1 : (LN2c : Int) * ((c - 160 : Nat) : Int) * 2 ^ 27 =
+        ((c - 160 : Nat) : Int) * ((LN2c : Int) * 2 ^ 27) := by
+      simp only [Int.mul_assoc, Int.mul_comm, Int.mul_left_comm]
+    rw [Int.neg_mul, e1]
+    omega
+  generalize hgA : X1v * 1000000000000000000000000000 = A at *
+  generalize hgL : -((LN2c : Int) * ((c - 160 : Nat) : Int)) * 2 ^ 27 = L1 at *
+  generalize hgL2 : ((c - 160 : Nat) : Int) * ((LN2c : Int) * 2 ^ 27) = L2 at *
+  omega
+
+/-! ## Master chains: caps at the model output -/
+
+/-- Upper master chain, `m ≥ S` branch, nonnegative binade shift:
+`e^(r/10^27) ≤ x/10^18` as a `capUB`, assembled from the `X1` cap, the
+`2^k` cap, the bias cap, and the budget. -/
+theorem up_ge_pos {m c x : Nat} {r : Int} (h1 : Sc ≤ m) (h2 : m < MHI)
+    (hc1 : 1 ≤ c) (hc : c ≤ 160)
+    (hr : r * 2 ^ 72 ≤ toInt (x1W (zWord m)) * 7450580596923828125 + ln2kInt c +
+      116873961749927929127912020551506849476088469858172)
+    (hr0 : 0 ≤ r)
+    (hmx : m * 2 ^ (160 - c) ≤ x) :
+    capUB (r.toNat * 2 ^ 99) QS x (10 ^ 18) := by
+  have cap1 := x1capGeUpF h1 h2
+  have cap2 := capUB_pow QS_pos cap2U (160 - c)
+  have cap12 := capUB_mul QS_pos cap1 cap2
+  have cap123 := capUB_mul QS_pos cap12 capBU
+  -- the exponent sum dominates r·2^99
+  have hX1 := x1_nonneg_geF h1 h2
+  have hVs := v_scale_pos (toInt (x1W (zWord m))) c hc
+  have hple : r.toNat * 2 ^ 99 ≤
+      (toInt (x1W (zWord m))).toNat * 1000000000000000000000000000 +
+        (160 - c) * (LN2c * 2 ^ 27) + BIASc * 2 ^ 27 := by
+    have hsc : r * 2 ^ 72 * 2 ^ 27 ≤ (toInt (x1W (zWord m)) * 7450580596923828125 +
+        ln2kInt c + 116873961749927929127912020551506849476088469858172) * 2 ^ 27 :=
+      mul_le_mul_right_nonneg hr (by omega)
+    rw [hVs] at hsc
+    have hX1n : ((toInt (x1W (zWord m))).toNat : Int) = toInt (x1W (zWord m)) :=
+      Int.toNat_of_nonneg hX1
+    have hBc : ((BIASc * 2 ^ 27 : Nat) : Int) =
+        116873961749927929127912020551506849476088469858172 * 2 ^ 27 := by
+      decide +kernel
+    have hLc : (((160 - c) * (LN2c * 2 ^ 27) : Nat) : Int) =
+        ((160 - c : Nat) : Int) * ((LN2c : Int) * 2 ^ 27) := by
+      simp only [Int.natCast_mul]
+      rfl
+    have e99 : r * 2 ^ 72 * 2 ^ 27 = r * 2 ^ 99 := by
+      rw [Int.mul_assoc, show ((2 : Int) ^ 72 * 2 ^ 27) = 2 ^ 99 from by decide]
+    rw [e99] at hsc
+    generalize hgA : toInt (x1W (zWord m)) * 1000000000000000000000000000 = A at hsc
+    generalize hgB : ((160 - c : Nat) : Int) * ((LN2c : Int) * 2 ^ 27) = B at hsc hLc
+    generalize hgC : (160 - c) * (LN2c * 2 ^ 27) = Cn at hLc ⊢
+    generalize hgD : (toInt (x1W (zWord m))).toNat * 1000000000000000000000000000 = D at ⊢
+    have hAD : (D : Int) = A := by
+      rw [← hgA, ← hgD, Int.natCast_mul, hX1n]
+      rfl
+    generalize hgE : (BIASc * 2 ^ 27 : Nat) = E at hBc ⊢
+    clear hX1n hVs hX1 cap1 cap2 cap12 cap123 hr h1 h2 hmx hc hc1
+    omega
+  have hmul : r.toNat * 2 ^ 99 * QS ≤
+      ((toInt (x1W (zWord m))).toNat * 1000000000000000000000000000 +
+        (160 - c) * (LN2c * 2 ^ 27) + BIASc * 2 ^ 27) * QS :=
+    Nat.mul_le_mul_right _ hple
+  have capR := capUB_arg QS_pos hmul cap123
+  -- weaken to the x target through the budget
+  refine capUB_weaken ?_ capR ?_
+  · -- 0 < w
+    have h1' : 0 < (560227709747861399187319382270000000000000000000000000000000 : Nat) *
+        ((10 ^ 40 : Nat) ^ (160 - c)) := Nat.mul_pos (by decide) (Nat.pow_pos (by decide))
+    exact Nat.mul_pos h1' (by decide)
+  · -- y·w' ≤ y'·w
+    have hb := budgetU_le (k := 160 - c) (by omega)
+    have hbm : m * (Sc * ((10 ^ 31 + 3401) * (2 * (10 ^ 40 + 1)) ^ (160 - c) *
+        (10 ^ 31 - 3402) * 10 ^ 18)) ≤
+        m * (Sc * (2 ^ (160 - c) * (10 ^ 40 : Nat) ^ (160 - c) * 10 ^ 80)) :=
+      Nat.mul_le_mul_left _ (Nat.mul_le_mul_left _ hb)
+    have hxm : m * 2 ^ (160 - c) * (Sc * ((10 ^ 40 : Nat) ^ (160 - c) * 10 ^ 80)) ≤
+        x * (Sc * ((10 ^ 40 : Nat) ^ (160 - c) * 10 ^ 80)) :=
+      Nat.mul_le_mul_right _ hmx
+    have e1 : m * (10 ^ 31 + 3401) * (2 * (10 ^ 40 + 1)) ^ (160 - c) *
+        (Sc * (10 ^ 31 - 3402)) * 10 ^ 18 =
+        m * (Sc * ((10 ^ 31 + 3401) * (2 * (10 ^ 40 + 1)) ^ (160 - c) *
+          (10 ^ 31 - 3402) * 10 ^ 18)) := by
+      simp only [Nat.mul_assoc, Nat.mul_comm, Nat.mul_left_comm]
+    have e2 : m * (Sc * (2 ^ (160 - c) * (10 ^ 40 : Nat) ^ (160 - c) * 10 ^ 80)) =
+        m * 2 ^ (160 - c) * (Sc * ((10 ^ 40 : Nat) ^ (160 - c) * 10 ^ 80)) := by
+      simp only [Nat.mul_assoc, Nat.mul_comm, Nat.mul_left_comm]
+    have e3 : x * (560227709747861399187319382270000000000000000000000000000000 *
+        (10 ^ 40 : Nat) ^ (160 - c) * (10 ^ 18 * 10 ^ 31)) =
+        x * (Sc * ((10 ^ 40 : Nat) ^ (160 - c) * 10 ^ 80)) := by
+      rw [show (560227709747861399187319382270000000000000000000000000000000 : Nat) =
+        Sc * 10 ^ 31 from by decide]
+      simp only [Nat.mul_assoc, Nat.mul_comm, Nat.mul_left_comm]
+      have e3' : ∀ P : Nat, (10 : Nat) ^ 18 * ((10 : Nat) ^ 31 * ((10 : Nat) ^ 31 * P)) =
+          (10 : Nat) ^ 80 * P := by
+        intro P
+        rw [← Nat.mul_assoc, ← Nat.mul_assoc,
+          show ((10 : Nat) ^ 18 * 10 ^ 31 * 10 ^ 31) = 10 ^ 80 from by decide]
+      rw [e3' ((10 ^ 40 : Nat) ^ (160 - c))]
+    generalize hgY : m * (10 ^ 31 + 3401) * (2 * (10 ^ 40 + 1)) ^ (160 - c) *
+      (Sc * (10 ^ 31 - 3402)) * 10 ^ 18 = Y at e1 ⊢
+    generalize hg1 : m * (Sc * ((10 ^ 31 + 3401) * (2 * (10 ^ 40 + 1)) ^ (160 - c) *
+      (10 ^ 31 - 3402) * 10 ^ 18)) = T1 at hbm e1
+    generalize hg2 : m * (Sc * (2 ^ (160 - c) * (10 ^ 40 : Nat) ^ (160 - c) * 10 ^ 80)) =
+      T2 at hbm e2
+    generalize hg3 : m * 2 ^ (160 - c) * (Sc * ((10 ^ 40 : Nat) ^ (160 - c) * 10 ^ 80)) =
+      T3 at hxm e2
+    generalize hg4 : x * (Sc * ((10 ^ 40 : Nat) ^ (160 - c) * 10 ^ 80)) = T4 at hxm e3
+    generalize hg5 : x * (560227709747861399187319382270000000000000000000000000000000 *
+      (10 ^ 40 : Nat) ^ (160 - c) * (10 ^ 18 * 10 ^ 31)) = W4 at e3 ⊢
+    omega
+
+/-- The lower budget folds from the worst-case mantissa to any `m ≥ 2^103`:
+`(m+1)·2^k·(10^40)^k·10^137 ≤ m·(lower-cap product)`. -/
+theorem budgetL_fold {m k : Nat} (hm : 2 ^ 95 ≤ m) (hk : k ≤ 159) :
+    (m + 1) * (2 ^ k * (10 ^ 40 : Nat) ^ k * 10 ^ 142) ≤
+      m * ((10 ^ 31 - 3401) * (2 * (10 ^ 40 - 1)) ^ k * (10 ^ 31 - 3404) *
+        (10 ^ 31 + 9990) * (10 ^ 31 - 10) * 10 ^ 18) := by
+  have hb := budgetL_le (k := k) hk
+  -- (m+1)·2^103 ≤ m·(2^103+1) since 2^103 ≤ m
+  have hcross : (m + 1) * 2 ^ 95 ≤ m * (2 ^ 95 + 1) := by
+    have e1 : (m + 1) * 2 ^ 95 = m * 2 ^ 95 + 2 ^ 95 := by
+      rw [Nat.add_mul, Nat.one_mul]
+    have e2 : m * (2 ^ 95 + 1) = m * 2 ^ 95 + m := by
+      rw [Nat.mul_add, Nat.mul_one]
+    omega
+  refine Nat.le_of_mul_le_mul_left ?_ (show 0 < 2 ^ 95 by decide)
+  calc 2 ^ 95 * ((m + 1) * (2 ^ k * (10 ^ 40 : Nat) ^ k * 10 ^ 142))
+      = ((m + 1) * 2 ^ 95) * (2 ^ k * (10 ^ 40 : Nat) ^ k * 10 ^ 142) := by
+        simp only [Nat.mul_assoc, Nat.mul_left_comm]
+    _ ≤ (m * (2 ^ 95 + 1)) * (2 ^ k * (10 ^ 40 : Nat) ^ k * 10 ^ 142) :=
+        Nat.mul_le_mul_right _ hcross
+    _ = m * ((2 ^ 95 + 1) * (2 ^ k * (10 ^ 40 : Nat) ^ k * 10 ^ 142)) := by
+        simp only [Nat.mul_assoc]
+    _ = m * ((2 ^ 95 + 1) * 2 ^ k * (10 ^ 40 : Nat) ^ k * 10 ^ 142) := by
+        simp only [Nat.mul_assoc]
+    _ ≤ m * (2 ^ 95 * (10 ^ 31 - 3401) * (2 * (10 ^ 40 - 1)) ^ k * (10 ^ 31 - 3404) *
+          (10 ^ 31 + 9990) * (10 ^ 31 - 10) * 10 ^ 18) :=
+        Nat.mul_le_mul_left _ hb
+    _ = 2 ^ 95 * (m * ((10 ^ 31 - 3401) * (2 * (10 ^ 40 - 1)) ^ k * (10 ^ 31 - 3404) *
+          (10 ^ 31 + 9990) * (10 ^ 31 - 10) * 10 ^ 18)) := by
+        simp only [Nat.mul_assoc, Nat.mul_comm, Nat.mul_left_comm]
+
+/-- Lower master chain, `m ≥ S` branch, nonnegative binade shift:
+`x/10^18 < e^((r+2)/10^27)` as a `capLB` with one part in `10^30` of
+strictness slack. -/
+theorem lo_ge_pos {m c x : Nat} {r : Int} (h1 : Sc ≤ m) (h2 : m < MHI)
+    (hc1 : 1 ≤ c) (hc : c ≤ 160)
+    (hr : toInt (x1W (zWord m)) * 7450580596923828125 + ln2kInt c +
+      116873961749927929127912020551506849476088469858172 < (r + 1) * 2 ^ 72)
+    (hr0 : -1 ≤ r)
+    (hxm : x < (m + 1) * 2 ^ (160 - c)) :
+    capLB ((r + 2).toNat * 2 ^ 99) QS (x * 10 ^ 31) (10 ^ 18 * (10 ^ 31 - 10)) := by
+  have cap1 := x1capGeLoF h1 h2
+  have cap2 := capLB_pow cap2L (160 - c)
+  have cap12 := capLB_mul cap1 cap2
+  have cap123 := capLB_mul cap12 capBL
+  have cap1234 := capLB_mul cap123 capEL
+  -- (r+2)·2^99 dominates the exponent sum
+  have hX1 := x1_nonneg_geF h1 h2
+  have hVs := v_scale_pos (toInt (x1W (zWord m))) c hc
+  have hple : (toInt (x1W (zWord m))).toNat * 1000000000000000000000000000 +
+      (160 - c) * (LN2c * 2 ^ 27) + BIASc * 2 ^ 27 + 2 ^ 99 ≤
+      (r + 2).toNat * 2 ^ 99 := by
+    have hsc : (toInt (x1W (zWord m)) * 7450580596923828125 + ln2kInt c +
+        116873961749927929127912020551506849476088469858172) * 2 ^ 27 ≤
+        ((r + 1) * 2 ^ 72 - 1) * 2 ^ 27 :=
+      mul_le_mul_right_nonneg (by omega) (by omega)
+    rw [hVs] at hsc
+    have hX1n : ((toInt (x1W (zWord m))).toNat : Int) = toInt (x1W (zWord m)) :=
+      Int.toNat_of_nonneg hX1
+    have hBc : ((BIASc * 2 ^ 27 : Nat) : Int) =
+        116873961749927929127912020551506849476088469858172 * 2 ^ 27 := by
+      decide +kernel
+    have hLc : (((160 - c) * (LN2c * 2 ^ 27) : Nat) : Int) =
+        ((160 - c : Nat) : Int) * ((LN2c : Int) * 2 ^ 27) := by
+      simp only [Int.natCast_mul]
+      rfl
+    have er : ((r + 1) * 2 ^ 72 - 1) * 2 ^ 27 = (r + 1) * 2 ^ 99 - 2 ^ 27 := by
+      rw [Int.sub_mul, Int.mul_assoc, show ((2 : Int) ^ 72 * 2 ^ 27) = 2 ^ 99 from
+        by decide]
+      omega
+    rw [er] at hsc
+    generalize hgA : toInt (x1W (zWord m)) * 1000000000000000000000000000 = A at hsc
+    generalize hgB : ((160 - c : Nat) : Int) * ((LN2c : Int) * 2 ^ 27) = B at hsc hLc
+    generalize hgC : (160 - c) * (LN2c * 2 ^ 27) = Cn at hLc ⊢
+    generalize hgD : (toInt (x1W (zWord m))).toNat * 1000000000000000000000000000 = D at ⊢
+    have hAD : (D : Int) = A := by
+      rw [← hgA, ← hgD, Int.natCast_mul, hX1n]
+      rfl
+    generalize hgE : (BIASc * 2 ^ 27 : Nat) = E at hBc ⊢
+    clear hX1n hVs hX1 cap1 cap2 cap12 cap123 cap1234 hr h1 h2 hxm hc hc1
+    omega
+  have hmul : ((toInt (x1W (zWord m))).toNat * 1000000000000000000000000000 +
+      (160 - c) * (LN2c * 2 ^ 27) + BIASc * 2 ^ 27 + 2 ^ 99) * QS ≤
+      (r + 2).toNat * 2 ^ 99 * QS :=
+    Nat.mul_le_mul_right _ hple
+  have capR := capLB_arg QS_pos hmul cap1234
+  -- weaken to the strict x target
+  refine capLB_weaken ?_ capR ?_
+  · have h1' : 0 < (560227709747861399187319382270000000000000000000000000000000 : Nat) *
+        ((10 ^ 40 : Nat) ^ (160 - c)) := Nat.mul_pos (by decide) (Nat.pow_pos (by decide))
+    have h2' : 0 < (560227709747861399187319382270000000000000000000000000000000 : Nat) *
+        ((10 ^ 40 : Nat) ^ (160 - c)) * (10 ^ 18 * 10 ^ 31) :=
+      Nat.mul_pos h1' (by decide)
+    exact Nat.mul_pos h2' (by decide)
+  · -- x·10^30·W ≤ Y·(10^18·(10^30−1))
+    have hMLO : 2 ^ 95 ≤ m := by
+      simp only [Sc] at h1
+      omega
+    have hb := budgetL_fold (k := 160 - c) hMLO (by omega)
+    have hx1 : x + 1 ≤ (m + 1) * 2 ^ (160 - c) := by omega
+    have hxw : (x + 1) * (Sc * ((10 ^ 40 : Nat) ^ (160 - c) * 10 ^ 142)) ≤
+        (m + 1) * 2 ^ (160 - c) * (Sc * ((10 ^ 40 : Nat) ^ (160 - c) * 10 ^ 142)) :=
+      Nat.mul_le_mul_right _ hx1
+    have hfold : (m + 1) * 2 ^ (160 - c) * (Sc * ((10 ^ 40 : Nat) ^ (160 - c) *
+        10 ^ 142)) ≤
+        m * ((10 ^ 31 - 3401) * (2 * (10 ^ 40 - 1)) ^ (160 - c) * (10 ^ 31 - 3404) *
+          (10 ^ 31 + 9990) * (10 ^ 31 - 10) * 10 ^ 18) * Sc := by
+      have h := Nat.mul_le_mul_left Sc hb
+      have e1 : Sc * ((m + 1) * (2 ^ (160 - c) * (10 ^ 40 : Nat) ^ (160 - c) *
+          10 ^ 142)) =
+          (m + 1) * 2 ^ (160 - c) * (Sc * ((10 ^ 40 : Nat) ^ (160 - c) * 10 ^ 142)) := by
+        simp only [Nat.mul_assoc, Nat.mul_comm, Nat.mul_left_comm]
+      have e2 : Sc * (m * ((10 ^ 31 - 3401) * (2 * (10 ^ 40 - 1)) ^ (160 - c) *
+          (10 ^ 31 - 3404) * (10 ^ 31 + 9990) * (10 ^ 31 - 10) * 10 ^ 18)) =
+          m * ((10 ^ 31 - 3401) * (2 * (10 ^ 40 - 1)) ^ (160 - c) * (10 ^ 31 - 3404) *
+            (10 ^ 31 + 9990) * (10 ^ 31 - 10) * 10 ^ 18) * Sc := by
+        simp only [Nat.mul_assoc, Nat.mul_comm, Nat.mul_left_comm]
+      rw [e1] at h
+      rw [e2] at h
+      exact h
+    -- assemble: LHS = (x+1-free form) and the W/Y bookkeeping
+    have eL : x * 10 ^ 31 * (560227709747861399187319382270000000000000000000000000000000 *
+        (10 ^ 40 : Nat) ^ (160 - c) * (10 ^ 18 * 10 ^ 31) * 10 ^ 31) ≤
+        (x + 1) * (Sc * ((10 ^ 40 : Nat) ^ (160 - c) * 10 ^ 142)) := by
+      rw [show (560227709747861399187319382270000000000000000000000000000000 : Nat) =
+        Sc * 10 ^ 31 from by decide]
+      have eAC : x * 10 ^ 31 * (Sc * 10 ^ 31 * (10 ^ 40 : Nat) ^ (160 - c) *
+          (10 ^ 18 * 10 ^ 31) * 10 ^ 31) =
+          x * (Sc * ((10 ^ 40 : Nat) ^ (160 - c) * ((10 : Nat) ^ 31 * (10 ^ 31 *
+            (10 ^ 18 * 10 ^ 31 * 10 ^ 31))))) := by
+        simp only [Nat.mul_assoc, Nat.mul_comm, Nat.mul_left_comm]
+      rw [eAC, show ((10 : Nat) ^ 31 * (10 ^ 31 * (10 ^ 18 * 10 ^ 31 * 10 ^ 31))) =
+        10 ^ 142 from by decide]
+      have : x * (Sc * ((10 ^ 40 : Nat) ^ (160 - c) * 10 ^ 142)) ≤
+          (x + 1) * (Sc * ((10 ^ 40 : Nat) ^ (160 - c) * 10 ^ 142)) :=
+        Nat.mul_le_mul_right _ (by omega)
+      exact this
+    have eR : m * ((10 ^ 31 - 3401) * (2 * (10 ^ 40 - 1)) ^ (160 - c) * (10 ^ 31 - 3404) *
+        (10 ^ 31 + 9990) * (10 ^ 31 - 10) * 10 ^ 18) * Sc =
+        m * 9999999999999999999999999996599 * (2 * (10 ^ 40 - 1)) ^ (160 - c) *
+          (Sc * (10 ^ 31 - 3404)) * (10 ^ 31 + 9990) * (10 ^ 18 * (10 ^ 31 - 10)) := by
+      rw [show (9999999999999999999999999996599 : Nat) = 10 ^ 31 - 3401 from by decide]
+      simp only [Nat.mul_assoc, Nat.mul_comm, Nat.mul_left_comm]
+    generalize hT1 : x * 10 ^ 31 *
+      (560227709747861399187319382270000000000000000000000000000000 *
+        (10 ^ 40 : Nat) ^ (160 - c) * (10 ^ 18 * 10 ^ 31) * 10 ^ 31) = T1 at eL ⊢
+    generalize hT2 : (x + 1) * (Sc * ((10 ^ 40 : Nat) ^ (160 - c) * 10 ^ 142)) = T2
+      at eL hxw
+    generalize hT3 : (m + 1) * 2 ^ (160 - c) * (Sc * ((10 ^ 40 : Nat) ^ (160 - c) *
+      10 ^ 142)) = T3 at hxw hfold
+    generalize hT4 : m * ((10 ^ 31 - 3401) * (2 * (10 ^ 40 - 1)) ^ (160 - c) *
+      (10 ^ 31 - 3404) * (10 ^ 31 + 9990) * (10 ^ 31 - 10) * 10 ^ 18) * Sc = T4
+      at hfold eR
+    generalize hT5 : m * 9999999999999999999999999996599 *
+      (2 * (10 ^ 40 - 1)) ^ (160 - c) * (Sc * (10 ^ 31 - 3404)) * (10 ^ 31 + 9990) *
+      (10 ^ 18 * (10 ^ 31 - 10)) = T5 at eR ⊢
+    omega
+
+/-- Upper master chain, `m ≥ S` branch, negative binade shift
+(`c > 160`, exact mantissa `m = x·2^(c-160)`). -/
+theorem up_ge_neg {m c x : Nat} {r : Int} (h1 : Sc ≤ m) (h2 : m < MHI)
+    (hc : 160 < c) (hc2 : c ≤ 255)
+    (hr : r * 2 ^ 72 ≤ toInt (x1W (zWord m)) * 7450580596923828125 + ln2kInt c +
+      116873961749927929127912020551506849476088469858172)
+    (hr0 : 0 ≤ r)
+    (hmx : m = x * 2 ^ (c - 160)) :
+    capUB (r.toNat * 2 ^ 99) QS x (10 ^ 18) := by
+  have cap1 := x1capGeUpF h1 h2
+  have cap1B := capUB_mul QS_pos cap1 capBU
+  have hX1 := x1_nonneg_geF h1 h2
+  have hVs := v_scale_neg (toInt (x1W (zWord m))) c hc
+  -- the Nat split: X1·E + BIAS = pa + j·L with pa ≥ r·2^99
+  have hsplit : (toInt (x1W (zWord m))).toNat * 1000000000000000000000000000 +
+      BIASc * 2 ^ 27 =
+      ((toInt (x1W (zWord m))).toNat * 1000000000000000000000000000 +
+        BIASc * 2 ^ 27 - (c - 160) * (LN2c * 2 ^ 27)) +
+        (c - 160) * (LN2c * 2 ^ 27) := by
+    -- j·L ≤ X1·E + BIAS since V ≥ r ≥ 0
+    have hX1n : ((toInt (x1W (zWord m))).toNat : Int) = toInt (x1W (zWord m)) :=
+      Int.toNat_of_nonneg hX1
+    have hBc : ((BIASc * 2 ^ 27 : Nat) : Int) =
+        116873961749927929127912020551506849476088469858172 * 2 ^ 27 := by
+      decide +kernel
+    have hLc : (((c - 160) * (LN2c * 2 ^ 27) : Nat) : Int) =
+        ((c - 160 : Nat) : Int) * ((LN2c : Int) * 2 ^ 27) := by
+      simp only [Int.natCast_mul]
+      rfl
+    have hV0 : 0 ≤ (toInt (x1W (zWord m)) * 7450580596923828125 + ln2kInt c +
+        116873961749927929127912020551506849476088469858172) * 2 ^ 27 := by
+      have hm := mul_le_mul_right_nonneg hr (show (0 : Int) ≤ 2 ^ 27 by omega)
+      have h0 : 0 ≤ r * 2 ^ 72 * 2 ^ 27 :=
+        Int.mul_nonneg (Int.mul_nonneg hr0 (by omega)) (by omega)
+      generalize hgV' : (toInt (x1W (zWord m)) * 7450580596923828125 + ln2kInt c +
+        116873961749927929127912020551506849476088469858172) * 2 ^ 27 = V27 at hm ⊢
+      generalize hgR : r * 2 ^ 72 * 2 ^ 27 = R27 at hm h0
+      clear cap1 cap1B hX1 hVs hX1n hBc hLc h1 h2 hmx hc hc2 hr hr0
+      omega
+    generalize hgV : (toInt (x1W (zWord m)) * 7450580596923828125 + ln2kInt c +
+      116873961749927929127912020551506849476088469858172) * 2 ^ 27 = V27 at hV0 hVs
+    generalize hgA : toInt (x1W (zWord m)) * 1000000000000000000000000000 = A at hVs
+    generalize hgB : ((c - 160 : Nat) : Int) * ((LN2c : Int) * 2 ^ 27) = B at hVs hLc
+    generalize hgC : (c - 160) * (LN2c * 2 ^ 27) = Cn at hLc ⊢
+    generalize hgD : (toInt (x1W (zWord m))).toNat * 1000000000000000000000000000 = D at ⊢
+    have hAD : (D : Int) = A := by
+      rw [← hgA, ← hgD, Int.natCast_mul, hX1n]
+      rfl
+    generalize hgE : (BIASc * 2 ^ 27 : Nat) = E at hBc ⊢
+    clear hX1n hX1 cap1 cap1B hr h1 h2 hc hc2 hmx
+    omega
+  rw [hsplit] at cap1B
+  have capV := capUB_cancel QS_pos cap1B (capLB_pow cap2L (c - 160))
+  -- bring the exponent down to r·2^99
+  have hple : r.toNat * 2 ^ 99 ≤
+      (toInt (x1W (zWord m))).toNat * 1000000000000000000000000000 +
+        BIASc * 2 ^ 27 - (c - 160) * (LN2c * 2 ^ 27) := by
+    have hsc : r * 2 ^ 72 * 2 ^ 27 + ((c - 160 : Nat) : Int) * ((LN2c : Int) * 2 ^ 27) ≤
+        toInt (x1W (zWord m)) * 1000000000000000000000000000 +
+          116873961749927929127912020551506849476088469858172 * 2 ^ 27 := by
+      have h := mul_le_mul_right_nonneg hr (show (0 : Int) ≤ 2 ^ 27 by omega)
+      generalize hgL : ((c - 160 : Nat) : Int) * ((LN2c : Int) * 2 ^ 27) = L at hVs ⊢
+      generalize hgA : toInt (x1W (zWord m)) * 1000000000000000000000000000 = A at hVs ⊢
+      generalize hgV : (toInt (x1W (zWord m)) * 7450580596923828125 + ln2kInt c +
+        116873961749927929127912020551506849476088469858172) * 2 ^ 27 = V27 at hVs h
+      omega
+    have hX1n : ((toInt (x1W (zWord m))).toNat : Int) = toInt (x1W (zWord m)) :=
+      Int.toNat_of_nonneg hX1
+    have hBc : ((BIASc * 2 ^ 27 : Nat) : Int) =
+        116873961749927929127912020551506849476088469858172 * 2 ^ 27 := by
+      decide +kernel
+    have hLc : (((c - 160) * (LN2c * 2 ^ 27) : Nat) : Int) =
+        ((c - 160 : Nat) : Int) * ((LN2c : Int) * 2 ^ 27) := by
+      simp only [Int.natCast_mul]
+      rfl
+    have e99 : r * 2 ^ 72 * 2 ^ 27 = r * 2 ^ 99 := by
+      rw [Int.mul_assoc, show ((2 : Int) ^ 72 * 2 ^ 27) = 2 ^ 99 from by decide]
+    rw [e99] at hsc
+    generalize hgB : ((c - 160 : Nat) : Int) * ((LN2c : Int) * 2 ^ 27) = B at hsc hLc
+    generalize hgC : (c - 160) * (LN2c * 2 ^ 27) = Cn at hLc ⊢
+    generalize hgA : toInt (x1W (zWord m)) * 1000000000000000000000000000 = A at hsc
+    generalize hgD : (toInt (x1W (zWord m))).toNat * 1000000000000000000000000000 = D at ⊢
+    have hAD : (D : Int) = A := by
+      rw [← hgA, ← hgD, Int.natCast_mul, hX1n]
+      rfl
+    generalize hgE : (BIASc * 2 ^ 27 : Nat) = E at hBc ⊢
+    clear hX1n hVs hX1 cap1 cap1B capV hr h1 h2 hc hc2 hmx hsplit
+    omega
+  have hmul : r.toNat * 2 ^ 99 * QS ≤
+      ((toInt (x1W (zWord m))).toNat * 1000000000000000000000000000 +
+        BIASc * 2 ^ 27 - (c - 160) * (LN2c * 2 ^ 27)) * QS :=
+    Nat.mul_le_mul_right _ hple
+  have capR := capUB_arg QS_pos hmul capV
+  refine capUB_weaken ?_ capR ?_
+  · have h1' : 0 < (560227709747861399187319382270000000000000000000000000000000 : Nat) *
+        (10 ^ 18 * 10 ^ 31) := by decide
+    exact Nat.mul_pos h1' (Nat.pow_pos (by decide))
+  · -- m = x·2^j folding through budgetUn
+    have hb := budgetUn_le (j := c - 160) (by omega)
+    have hbf : x * 2 ^ (c - 160) * ((10 ^ 31 + 3401) * (10 ^ 31 - 3402) *
+        (10 ^ 40 : Nat) ^ (c - 160) * 10 ^ 18 * Sc) ≤
+        x * (10 ^ 80 * (2 * (10 ^ 40 - 1)) ^ (c - 160) * Sc) := by
+      have h := Nat.mul_le_mul_left (x * Sc) hb
+      have e1 : x * Sc * ((10 ^ 31 + 3401) * (10 ^ 31 - 3402) *
+          (10 ^ 40 : Nat) ^ (c - 160) * 2 ^ (c - 160) * 10 ^ 18) =
+          x * 2 ^ (c - 160) * ((10 ^ 31 + 3401) * (10 ^ 31 - 3402) *
+            (10 ^ 40 : Nat) ^ (c - 160) * 10 ^ 18 * Sc) := by
+        simp only [Nat.mul_assoc, Nat.mul_comm, Nat.mul_left_comm]
+      have e2 : x * Sc * (10 ^ 80 * (2 * (10 ^ 40 - 1)) ^ (c - 160)) =
+          x * (10 ^ 80 * (2 * (10 ^ 40 - 1)) ^ (c - 160) * Sc) := by
+        simp only [Nat.mul_assoc, Nat.mul_comm]
+      rw [e1] at h
+      rw [e2] at h
+      exact h
+    have eY : m * 10000000000000000000000000003401 * (Sc * (10 ^ 31 - 3402)) *
+        ((10 ^ 40 : Nat) ^ (c - 160)) * 10 ^ 18 =
+        x * 2 ^ (c - 160) * ((10 ^ 31 + 3401) * (10 ^ 31 - 3402) *
+          (10 ^ 40 : Nat) ^ (c - 160) * 10 ^ 18 * Sc) := by
+      rw [hmx, show (10000000000000000000000000003401 : Nat) = 10 ^ 31 + 3401 from by decide]
+      simp only [Nat.mul_assoc, Nat.mul_comm, Nat.mul_left_comm]
+    have eW : x * (560227709747861399187319382270000000000000000000000000000000 *
+        (10 ^ 18 * 10 ^ 31) * (2 * (10 ^ 40 - 1)) ^ (c - 160)) =
+        x * (10 ^ 80 * (2 * (10 ^ 40 - 1)) ^ (c - 160) * Sc) := by
+      rw [show (560227709747861399187319382270000000000000000000000000000000 : Nat) =
+        Sc * 10 ^ 31 from by decide]
+      have e' : ∀ P : Nat, (10 : Nat) ^ 18 * ((10 : Nat) ^ 31 * ((10 : Nat) ^ 31 * P)) =
+          (10 : Nat) ^ 80 * P := by
+        intro P
+        rw [← Nat.mul_assoc, ← Nat.mul_assoc,
+          show ((10 : Nat) ^ 18 * 10 ^ 31 * 10 ^ 31) = 10 ^ 80 from by decide]
+      simp only [Nat.mul_assoc, Nat.mul_comm, Nat.mul_left_comm]
+      rw [e' ((2 * (10 ^ 40 - 1)) ^ (c - 160))]
+    generalize hT1 : m * 10000000000000000000000000003401 * (Sc * (10 ^ 31 - 3402)) *
+      ((10 ^ 40 : Nat) ^ (c - 160)) * 10 ^ 18 = T1 at eY ⊢
+    generalize hT2 : x * 2 ^ (c - 160) * ((10 ^ 31 + 3401) * (10 ^ 31 - 3402) *
+      (10 ^ 40 : Nat) ^ (c - 160) * 10 ^ 18 * Sc) = T2 at eY hbf
+    generalize hT3 : x * (10 ^ 80 * (2 * (10 ^ 40 - 1)) ^ (c - 160) * Sc) = T3 at hbf eW
+    generalize hT4 : x * (560227709747861399187319382270000000000000000000000000000000 *
+      (10 ^ 18 * 10 ^ 31) * (2 * (10 ^ 40 - 1)) ^ (c - 160)) = T4 at eW ⊢
+    omega
+
+/-- Lower master chain, `m ≥ S` branch, negative binade shift. -/
+theorem lo_ge_neg {m c x : Nat} {r : Int} (h1 : Sc ≤ m) (h2 : m < MHI)
+    (hc : 160 < c) (hc2 : c ≤ 255)
+    (hr : toInt (x1W (zWord m)) * 7450580596923828125 + ln2kInt c +
+      116873961749927929127912020551506849476088469858172 < (r + 1) * 2 ^ 72)
+    (hrlo : r * 2 ^ 72 ≤ toInt (x1W (zWord m)) * 7450580596923828125 + ln2kInt c +
+      116873961749927929127912020551506849476088469858172)
+    (hr0 : -1 ≤ r)
+    (hmx : m = x * 2 ^ (c - 160)) :
+    capLB ((r + 2).toNat * 2 ^ 99) QS (x * 10 ^ 31) (10 ^ 18 * (10 ^ 31 - 10)) := by
+  have cap1 := x1capGeLoF h1 h2
+  have cap1B := capLB_mul cap1 capBL
+  have cap1BE := capLB_mul cap1B capEL
+  have hX1 := x1_nonneg_geF h1 h2
+  have hVs := v_scale_neg (toInt (x1W (zWord m))) c hc
+  have hVnn : -(2 ^ 99) ≤ (toInt (x1W (zWord m)) * 7450580596923828125 + ln2kInt c +
+      116873961749927929127912020551506849476088469858172) * 2 ^ 27 := by
+    have h0 : -(2 ^ 72) ≤ r * 2 ^ 72 := by
+      have := mul_le_mul_right_nonneg (show (-1 : Int) ≤ r from hr0)
+        (show (0 : Int) ≤ 2 ^ 72 by omega)
+      generalize hgT : r * 2 ^ 72 = T at this ⊢
+      omega
+    have hg : -(2 ^ 72) ≤ toInt (x1W (zWord m)) * 7450580596923828125 + ln2kInt c +
+        116873961749927929127912020551506849476088469858172 := by
+      generalize hgV : toInt (x1W (zWord m)) * 7450580596923828125 + ln2kInt c +
+        116873961749927929127912020551506849476088469858172 = V at hrlo ⊢
+      omega
+    have := mul_le_mul_right_nonneg hg (show (0 : Int) ≤ 2 ^ 27 by omega)
+    generalize hgV : (toInt (x1W (zWord m)) * 7450580596923828125 + ln2kInt c +
+      116873961749927929127912020551506849476088469858172) * 2 ^ 27 = V27 at this ⊢
+    have e : (-(2 ^ 72) : Int) * 2 ^ 27 = -(2 ^ 99) := by decide
+    omega
+  have hsplit : (toInt (x1W (zWord m))).toNat * 1000000000000000000000000000 +
+      BIASc * 2 ^ 27 + 2 ^ 99 =
+      ((toInt (x1W (zWord m))).toNat * 1000000000000000000000000000 +
+        BIASc * 2 ^ 27 + 2 ^ 99 - (c - 160) * (LN2c * 2 ^ 27)) +
+        (c - 160) * (LN2c * 2 ^ 27) := by
+    have hX1n : ((toInt (x1W (zWord m))).toNat : Int) = toInt (x1W (zWord m)) :=
+      Int.toNat_of_nonneg hX1
+    have hBc : ((BIASc * 2 ^ 27 : Nat) : Int) =
+        116873961749927929127912020551506849476088469858172 * 2 ^ 27 := by
+      decide +kernel
+    have hLc : (((c - 160) * (LN2c * 2 ^ 27) : Nat) : Int) =
+        ((c - 160 : Nat) : Int) * ((LN2c : Int) * 2 ^ 27) := by
+      simp only [Int.natCast_mul]
+      rfl
+    generalize hgV : (toInt (x1W (zWord m)) * 7450580596923828125 + ln2kInt c +
+      116873961749927929127912020551506849476088469858172) * 2 ^ 27 = V27 at hVnn hVs
+    generalize hgA : toInt (x1W (zWord m)) * 1000000000000000000000000000 = A at hVs
+    generalize hgB : ((c - 160 : Nat) : Int) * ((LN2c : Int) * 2 ^ 27) = B at hVs hLc
+    generalize hgC : (c - 160) * (LN2c * 2 ^ 27) = Cn at hLc ⊢
+    generalize hgD : (toInt (x1W (zWord m))).toNat * 1000000000000000000000000000 = D at ⊢
+    have hAD : (D : Int) = A := by
+      rw [← hgA, ← hgD, Int.natCast_mul, hX1n]
+      rfl
+    generalize hgE : (BIASc * 2 ^ 27 : Nat) = E at hBc ⊢
+    clear hX1n hX1 cap1 cap1B cap1BE hr h1 h2 hc hc2 hmx
+    omega
+  rw [hsplit] at cap1BE
+  have capV := capLB_cancel QS_pos cap1BE (capUB_pow QS_pos cap2U (c - 160))
+  have hple : (toInt (x1W (zWord m))).toNat * 1000000000000000000000000000 +
+      BIASc * 2 ^ 27 + 2 ^ 99 - (c - 160) * (LN2c * 2 ^ 27) ≤
+      (r + 2).toNat * 2 ^ 99 := by
+    have hsc : (toInt (x1W (zWord m)) * 7450580596923828125 + ln2kInt c +
+        116873961749927929127912020551506849476088469858172) * 2 ^ 27 ≤
+        ((r + 1) * 2 ^ 72 - 1) * 2 ^ 27 :=
+      mul_le_mul_right_nonneg (by omega) (by omega)
+    have er : ((r + 1) * 2 ^ 72 - 1) * 2 ^ 27 = (r + 1) * 2 ^ 99 - 2 ^ 27 := by
+      rw [Int.sub_mul, Int.mul_assoc, show ((2 : Int) ^ 72 * 2 ^ 27) = 2 ^ 99 from
+        by decide]
+      omega
+    rw [er] at hsc
+    have hX1n : ((toInt (x1W (zWord m))).toNat : Int) = toInt (x1W (zWord m)) :=
+      Int.toNat_of_nonneg hX1
+    have hBc : ((BIASc * 2 ^ 27 : Nat) : Int) =
+        116873961749927929127912020551506849476088469858172 * 2 ^ 27 := by
+      decide +kernel
+    have hLc : (((c - 160) * (LN2c * 2 ^ 27) : Nat) : Int) =
+        ((c - 160 : Nat) : Int) * ((LN2c : Int) * 2 ^ 27) := by
+      simp only [Int.natCast_mul]
+      rfl
+    generalize hgV : (toInt (x1W (zWord m)) * 7450580596923828125 + ln2kInt c +
+      116873961749927929127912020551506849476088469858172) * 2 ^ 27 = V27 at hsc hVs hVnn
+    generalize hgA : toInt (x1W (zWord m)) * 1000000000000000000000000000 = A at hVs
+    generalize hgB : ((c - 160 : Nat) : Int) * ((LN2c : Int) * 2 ^ 27) = B at hVs hLc
+    generalize hgC : (c - 160) * (LN2c * 2 ^ 27) = Cn at hLc ⊢
+    generalize hgD : (toInt (x1W (zWord m))).toNat * 1000000000000000000000000000 = D at ⊢
+    have hAD : (D : Int) = A := by
+      rw [← hgA, ← hgD, Int.natCast_mul, hX1n]
+      rfl
+    generalize hgE : (BIASc * 2 ^ 27 : Nat) = E at hBc ⊢
+    clear hX1n hX1 cap1 cap1B cap1BE capV hr h1 h2 hc hc2 hmx hsplit
+    omega
+  have hmul : ((toInt (x1W (zWord m))).toNat * 1000000000000000000000000000 +
+      BIASc * 2 ^ 27 + 2 ^ 99 - (c - 160) * (LN2c * 2 ^ 27)) * QS ≤
+      (r + 2).toNat * 2 ^ 99 * QS :=
+    Nat.mul_le_mul_right _ hple
+  have capR := capLB_arg QS_pos hmul capV
+  refine capLB_weaken ?_ capR ?_
+  · have h1' : 0 < (560227709747861399187319382270000000000000000000000000000000 : Nat) *
+        (10 ^ 18 * 10 ^ 31) * 10 ^ 31 := by decide
+    exact Nat.mul_pos h1' (Nat.pow_pos (by decide))
+  · -- x·10^30·W ≤ Y·(10^18·(10^30−1)) with exact mantissa
+    have hb := budgetLn_le (j := c - 160) (by omega)
+    have hbf := Nat.mul_le_mul_left (x * Sc) hb
+    have eL : x * 10 ^ 31 *
+        (560227709747861399187319382270000000000000000000000000000000 *
+          (10 ^ 18 * 10 ^ 31) * 10 ^ 31 * (2 * (10 ^ 40 + 1)) ^ (c - 160)) =
+        x * Sc * ((10 : Nat) ^ 142 * (2 * (10 ^ 40 + 1)) ^ (c - 160)) := by
+      rw [show (560227709747861399187319382270000000000000000000000000000000 : Nat) =
+        Sc * 10 ^ 31 from by decide]
+      have e' : ∀ P : Nat, (10 : Nat) ^ 18 * ((10 : Nat) ^ 31 * ((10 : Nat) ^ 31 *
+          ((10 : Nat) ^ 31 * ((10 : Nat) ^ 31 * P)))) = (10 : Nat) ^ 142 * P := by
+        intro P
+        rw [← Nat.mul_assoc, ← Nat.mul_assoc, ← Nat.mul_assoc, ← Nat.mul_assoc,
+          show ((10 : Nat) ^ 18 * 10 ^ 31 * 10 ^ 31 * 10 ^ 31 * 10 ^ 31) = 10 ^ 142
+            from by decide]
+      simp only [Nat.mul_assoc, Nat.mul_comm, Nat.mul_left_comm]
+      rw [e' ((2 * (10 ^ 40 + 1)) ^ (c - 160))]
+    have eR : m * 9999999999999999999999999996599 * (Sc * (10 ^ 31 - 3404)) *
+        (10 ^ 31 + 9990) * ((10 ^ 40 : Nat) ^ (c - 160)) * (10 ^ 18 * (10 ^ 31 - 10)) =
+        x * Sc * (2 ^ (c - 160) * (10 ^ 40 : Nat) ^ (c - 160) * (10 ^ 31 - 3401) *
+          (10 ^ 31 - 3404) * (10 ^ 31 + 9990) * (10 ^ 31 - 10) * 10 ^ 18) := by
+      rw [hmx, show (9999999999999999999999999996599 : Nat) = 10 ^ 31 - 3401 from by decide]
+      simp only [Nat.mul_assoc, Nat.mul_comm, Nat.mul_left_comm]
+    generalize hT1 : x * 10 ^ 31 *
+      (560227709747861399187319382270000000000000000000000000000000 *
+        (10 ^ 18 * 10 ^ 31) * 10 ^ 31 * (2 * (10 ^ 40 + 1)) ^ (c - 160)) = T1 at eL ⊢
+    generalize hT2 : x * Sc * ((10 : Nat) ^ 142 * (2 * (10 ^ 40 + 1)) ^ (c - 160)) = T2
+      at eL hbf
+    generalize hT3 : x * Sc * (2 ^ (c - 160) * (10 ^ 40 : Nat) ^ (c - 160) *
+      (10 ^ 31 - 3401) * (10 ^ 31 - 3404) * (10 ^ 31 + 9990) * (10 ^ 31 - 10) * 10 ^ 18) = T3
+      at eR hbf
+    generalize hT4 : m * 9999999999999999999999999996599 * (Sc * (10 ^ 31 - 3404)) *
+      (10 ^ 31 + 9990) * ((10 ^ 40 : Nat) ^ (c - 160)) * (10 ^ 18 * (10 ^ 31 - 10)) = T4
+      at eR ⊢
+    omega
+
+/-- Upper master chain, `m < S` branch, nonnegative binade shift. -/
+theorem up_lt_pos {m c x : Nat} {r : Int} (h1 : MLO ≤ m) (h2 : m < Sc)
+    (hc1 : 1 ≤ c) (hc : c ≤ 160)
+    (hr : r * 2 ^ 72 ≤ toInt (x1W (zWord m)) * 7450580596923828125 + ln2kInt c +
+      116873961749927929127912020551506849476088469858172)
+    (hr0 : 0 ≤ r)
+    (hmx : m * 2 ^ (160 - c) ≤ x) :
+    capUB (r.toNat * 2 ^ 99) QS x (10 ^ 18) := by
+  have cap1 := x1capLtUpF h1 h2
+  have hsum := capUB_mul QS_pos (capUB_pow QS_pos cap2U (160 - c)) capBU
+  have hX1 := x1_nonpos_ltF h1 h2
+  have hVs := v_scale_pos (toInt (x1W (zWord m))) c hc
+  -- split: kL + B = pa + |X1|·E with pa = V·2^27 ≥ 0
+  have hsplit : (160 - c) * (LN2c * 2 ^ 27) + BIASc * 2 ^ 27 =
+      ((160 - c) * (LN2c * 2 ^ 27) + BIASc * 2 ^ 27 -
+        (-toInt (x1W (zWord m))).toNat * 1000000000000000000000000000) +
+        (-toInt (x1W (zWord m))).toNat * 1000000000000000000000000000 := by
+    have hX1n : (((-toInt (x1W (zWord m))).toNat : Nat) : Int) = -toInt (x1W (zWord m)) :=
+      Int.toNat_of_nonneg (by omega)
+    have hBc : ((BIASc * 2 ^ 27 : Nat) : Int) =
+        116873961749927929127912020551506849476088469858172 * 2 ^ 27 := by
+      decide +kernel
+    have hLc : (((160 - c) * (LN2c * 2 ^ 27) : Nat) : Int) =
+        ((160 - c : Nat) : Int) * ((LN2c : Int) * 2 ^ 27) := by
+      simp only [Int.natCast_mul]
+      rfl
+    have hV0 : 0 ≤ (toInt (x1W (zWord m)) * 7450580596923828125 + ln2kInt c +
+        116873961749927929127912020551506849476088469858172) * 2 ^ 27 := by
+      have hm := mul_le_mul_right_nonneg hr (show (0 : Int) ≤ 2 ^ 27 by omega)
+      have h0 : 0 ≤ r * 2 ^ 72 * 2 ^ 27 :=
+        Int.mul_nonneg (Int.mul_nonneg hr0 (by omega)) (by omega)
+      generalize hgV' : (toInt (x1W (zWord m)) * 7450580596923828125 + ln2kInt c +
+        116873961749927929127912020551506849476088469858172) * 2 ^ 27 = V27 at hm ⊢
+      generalize hgR : r * 2 ^ 72 * 2 ^ 27 = R27 at hm h0
+      clear cap1 hsum hX1 hVs hX1n hBc hLc h1 h2 hmx hc hc1 hr hr0
+      omega
+    generalize hgV : (toInt (x1W (zWord m)) * 7450580596923828125 + ln2kInt c +
+      116873961749927929127912020551506849476088469858172) * 2 ^ 27 = V27 at hV0 hVs
+    generalize hgA : toInt (x1W (zWord m)) * 1000000000000000000000000000 = A at hVs
+    generalize hgB : ((160 - c : Nat) : Int) * ((LN2c : Int) * 2 ^ 27) = B at hVs hLc
+    generalize hgC : (160 - c) * (LN2c * 2 ^ 27) = Cn at hLc ⊢
+    generalize hgD : (-toInt (x1W (zWord m))).toNat * 1000000000000000000000000000 = D at ⊢
+    have hAD : (D : Int) = -A := by
+      rw [← hgA, ← hgD, Int.natCast_mul, hX1n]
+      rw [show (-toInt (x1W (zWord m))) * ((1000000000000000000000000000 : Nat) : Int) =
+        -(toInt (x1W (zWord m)) * ((1000000000000000000000000000 : Nat) : Int)) from by
+          rw [Int.neg_mul]]
+      rfl
+    generalize hgE : (BIASc * 2 ^ 27 : Nat) = E at hBc ⊢
+    clear hX1n hX1 cap1 hsum hr h1 h2 hc hc1 hmx
+    omega
+  rw [hsplit] at hsum
+  have capV := capUB_cancel QS_pos hsum cap1
+  have hple : r.toNat * 2 ^ 99 ≤
+      (160 - c) * (LN2c * 2 ^ 27) + BIASc * 2 ^ 27 -
+        (-toInt (x1W (zWord m))).toNat * 1000000000000000000000000000 := by
+    have hsc : r * 2 ^ 72 * 2 ^ 27 ≤ (toInt (x1W (zWord m)) * 7450580596923828125 +
+        ln2kInt c + 116873961749927929127912020551506849476088469858172) * 2 ^ 27 :=
+      mul_le_mul_right_nonneg hr (by omega)
+    have e99 : r * 2 ^ 72 * 2 ^ 27 = r * 2 ^ 99 := by
+      rw [Int.mul_assoc, show ((2 : Int) ^ 72 * 2 ^ 27) = 2 ^ 99 from by decide]
+    rw [e99] at hsc
+    have hX1n : (((-toInt (x1W (zWord m))).toNat : Nat) : Int) = -toInt (x1W (zWord m)) :=
+      Int.toNat_of_nonneg (by omega)
+    have hBc : ((BIASc * 2 ^ 27 : Nat) : Int) =
+        116873961749927929127912020551506849476088469858172 * 2 ^ 27 := by
+      decide +kernel
+    have hLc : (((160 - c) * (LN2c * 2 ^ 27) : Nat) : Int) =
+        ((160 - c : Nat) : Int) * ((LN2c : Int) * 2 ^ 27) := by
+      simp only [Int.natCast_mul]
+      rfl
+    generalize hgV : (toInt (x1W (zWord m)) * 7450580596923828125 + ln2kInt c +
+      116873961749927929127912020551506849476088469858172) * 2 ^ 27 = V27 at hsc hVs
+    generalize hgA : toInt (x1W (zWord m)) * 1000000000000000000000000000 = A at hVs
+    generalize hgB : ((160 - c : Nat) : Int) * ((LN2c : Int) * 2 ^ 27) = B at hVs hLc
+    generalize hgC : (160 - c) * (LN2c * 2 ^ 27) = Cn at hLc ⊢
+    generalize hgD : (-toInt (x1W (zWord m))).toNat * 1000000000000000000000000000 = D at ⊢
+    have hAD : (D : Int) = -A := by
+      rw [← hgA, ← hgD, Int.natCast_mul, hX1n]
+      rw [show (-toInt (x1W (zWord m))) * ((1000000000000000000000000000 : Nat) : Int) =
+        -(toInt (x1W (zWord m)) * ((1000000000000000000000000000 : Nat) : Int)) from by
+          rw [Int.neg_mul]]
+      rfl
+    generalize hgE : (BIASc * 2 ^ 27 : Nat) = E at hBc ⊢
+    clear hX1n hX1 cap1 hsum capV hr h1 h2 hc hc1 hmx hsplit
+    omega
+  have hmul : r.toNat * 2 ^ 99 * QS ≤
+      ((160 - c) * (LN2c * 2 ^ 27) + BIASc * 2 ^ 27 -
+        (-toInt (x1W (zWord m))).toNat * 1000000000000000000000000000) * QS :=
+    Nat.mul_le_mul_right _ hple
+  have capR := capUB_arg QS_pos hmul capV
+  refine capUB_weaken ?_ capR ?_
+  · have h1' : 0 < (10 ^ 40 : Nat) ^ (160 - c) * (10 ^ 18 * 10 ^ 31) :=
+      Nat.mul_pos (Nat.pow_pos (by decide)) (by decide)
+    exact Nat.mul_pos h1' (by decide)
+  · have hb := budgetU_le (k := 160 - c) (by omega)
+    have hbm : m * (Sc * ((10 ^ 31 + 3401) * (2 * (10 ^ 40 + 1)) ^ (160 - c) *
+        (10 ^ 31 - 3402) * 10 ^ 18)) ≤
+        m * (Sc * (2 ^ (160 - c) * (10 ^ 40 : Nat) ^ (160 - c) * 10 ^ 80)) :=
+      Nat.mul_le_mul_left _ (Nat.mul_le_mul_left _ hb)
+    have hxm : m * 2 ^ (160 - c) * (Sc * ((10 ^ 40 : Nat) ^ (160 - c) * 10 ^ 80)) ≤
+        x * (Sc * ((10 ^ 40 : Nat) ^ (160 - c) * 10 ^ 80)) :=
+      Nat.mul_le_mul_right _ hmx
+    have e1 : (2 * (10 ^ 40 + 1)) ^ (160 - c) * (Sc * (10 ^ 31 - 3402)) *
+        (m * 10000000000000000000000000003401) * 10 ^ 18 =
+        m * (Sc * ((10 ^ 31 + 3401) * (2 * (10 ^ 40 + 1)) ^ (160 - c) *
+          (10 ^ 31 - 3402) * 10 ^ 18)) := by
+      rw [show (10000000000000000000000000003401 : Nat) = 10 ^ 31 + 3401 from by decide]
+      simp only [Nat.mul_assoc, Nat.mul_comm, Nat.mul_left_comm]
+    have e2 : m * (Sc * (2 ^ (160 - c) * (10 ^ 40 : Nat) ^ (160 - c) * 10 ^ 80)) =
+        m * 2 ^ (160 - c) * (Sc * ((10 ^ 40 : Nat) ^ (160 - c) * 10 ^ 80)) := by
+      simp only [Nat.mul_assoc, Nat.mul_comm, Nat.mul_left_comm]
+    have e3 : x * ((10 ^ 40 : Nat) ^ (160 - c) * (10 ^ 18 * 10 ^ 31) *
+        560227709747861399187319382270000000000000000000000000000000) =
+        x * (Sc * ((10 ^ 40 : Nat) ^ (160 - c) * 10 ^ 80)) := by
+      rw [show (560227709747861399187319382270000000000000000000000000000000 : Nat) =
+        Sc * 10 ^ 31 from by decide]
+      have e' : ∀ P : Nat, (10 : Nat) ^ 18 * ((10 : Nat) ^ 31 * ((10 : Nat) ^ 31 * P)) =
+          (10 : Nat) ^ 80 * P := by
+        intro P
+        rw [← Nat.mul_assoc, ← Nat.mul_assoc,
+          show ((10 : Nat) ^ 18 * 10 ^ 31 * 10 ^ 31) = 10 ^ 80 from by decide]
+      simp only [Nat.mul_assoc, Nat.mul_comm, Nat.mul_left_comm]
+      rw [e' ((10 ^ 40 : Nat) ^ (160 - c))]
+    generalize hgY : (2 * (10 ^ 40 + 1)) ^ (160 - c) * (Sc * (10 ^ 31 - 3402)) *
+      (m * 10000000000000000000000000003401) * 10 ^ 18 = Y at e1 ⊢
+    generalize hg1 : m * (Sc * ((10 ^ 31 + 3401) * (2 * (10 ^ 40 + 1)) ^ (160 - c) *
+      (10 ^ 31 - 3402) * 10 ^ 18)) = T1 at hbm e1
+    generalize hg2 : m * (Sc * (2 ^ (160 - c) * (10 ^ 40 : Nat) ^ (160 - c) * 10 ^ 80)) =
+      T2 at hbm e2
+    generalize hg3 : m * 2 ^ (160 - c) * (Sc * ((10 ^ 40 : Nat) ^ (160 - c) * 10 ^ 80)) =
+      T3 at hxm e2
+    generalize hg4 : x * (Sc * ((10 ^ 40 : Nat) ^ (160 - c) * 10 ^ 80)) = T4 at hxm e3
+    generalize hg5 : x * ((10 ^ 40 : Nat) ^ (160 - c) * (10 ^ 18 * 10 ^ 31) *
+      560227709747861399187319382270000000000000000000000000000000) = W4 at e3 ⊢
+    omega
+
+/-- Lower master chain, `m < S` branch, nonnegative binade shift. -/
+theorem lo_lt_pos {m c x : Nat} {r : Int} (h1 : MLO ≤ m) (h2 : m < Sc)
+    (hc1 : 1 ≤ c) (hc : c ≤ 160)
+    (hr : toInt (x1W (zWord m)) * 7450580596923828125 + ln2kInt c +
+      116873961749927929127912020551506849476088469858172 < (r + 1) * 2 ^ 72)
+    (hrlo : r * 2 ^ 72 ≤ toInt (x1W (zWord m)) * 7450580596923828125 + ln2kInt c +
+      116873961749927929127912020551506849476088469858172)
+    (hr0 : -1 ≤ r)
+    (hxm : x < (m + 1) * 2 ^ (160 - c)) :
+    capLB ((r + 2).toNat * 2 ^ 99) QS (x * 10 ^ 31) (10 ^ 18 * (10 ^ 31 - 10)) := by
+  have cap1 := x1capLtLoF h1 h2
+  have hsum := capLB_mul (capLB_mul (capLB_pow cap2L (160 - c)) capBL) capEL
+  have hX1 := x1_nonpos_ltF h1 h2
+  have hVs := v_scale_pos (toInt (x1W (zWord m))) c hc
+  have hVnn : -(2 ^ 99) ≤ (toInt (x1W (zWord m)) * 7450580596923828125 + ln2kInt c +
+      116873961749927929127912020551506849476088469858172) * 2 ^ 27 := by
+    have h0 : -(2 ^ 72) ≤ r * 2 ^ 72 := by
+      have := mul_le_mul_right_nonneg (show (-1 : Int) ≤ r from hr0)
+        (show (0 : Int) ≤ 2 ^ 72 by omega)
+      generalize hgT : r * 2 ^ 72 = T at this ⊢
+      omega
+    have hg : -(2 ^ 72) ≤ toInt (x1W (zWord m)) * 7450580596923828125 + ln2kInt c +
+        116873961749927929127912020551506849476088469858172 := by
+      generalize hgV : toInt (x1W (zWord m)) * 7450580596923828125 + ln2kInt c +
+        116873961749927929127912020551506849476088469858172 = V at hrlo ⊢
+      omega
+    have := mul_le_mul_right_nonneg hg (show (0 : Int) ≤ 2 ^ 27 by omega)
+    generalize hgV : (toInt (x1W (zWord m)) * 7450580596923828125 + ln2kInt c +
+      116873961749927929127912020551506849476088469858172) * 2 ^ 27 = V27 at this ⊢
+    have e : (-(2 ^ 72) : Int) * 2 ^ 27 = -(2 ^ 99) := by decide
+    omega
+  have hsplit : (160 - c) * (LN2c * 2 ^ 27) + BIASc * 2 ^ 27 + 2 ^ 99 =
+      ((160 - c) * (LN2c * 2 ^ 27) + BIASc * 2 ^ 27 + 2 ^ 99 -
+        (-toInt (x1W (zWord m))).toNat * 1000000000000000000000000000) +
+        (-toInt (x1W (zWord m))).toNat * 1000000000000000000000000000 := by
+    have hX1n : (((-toInt (x1W (zWord m))).toNat : Nat) : Int) = -toInt (x1W (zWord m)) :=
+      Int.toNat_of_nonneg (by omega)
+    have hBc : ((BIASc * 2 ^ 27 : Nat) : Int) =
+        116873961749927929127912020551506849476088469858172 * 2 ^ 27 := by
+      decide +kernel
+    have hLc : (((160 - c) * (LN2c * 2 ^ 27) : Nat) : Int) =
+        ((160 - c : Nat) : Int) * ((LN2c : Int) * 2 ^ 27) := by
+      simp only [Int.natCast_mul]
+      rfl
+    generalize hgV : (toInt (x1W (zWord m)) * 7450580596923828125 + ln2kInt c +
+      116873961749927929127912020551506849476088469858172) * 2 ^ 27 = V27 at hVnn hVs
+    generalize hgA : toInt (x1W (zWord m)) * 1000000000000000000000000000 = A at hVs
+    generalize hgB : ((160 - c : Nat) : Int) * ((LN2c : Int) * 2 ^ 27) = B at hVs hLc
+    generalize hgC : (160 - c) * (LN2c * 2 ^ 27) = Cn at hLc ⊢
+    generalize hgD : (-toInt (x1W (zWord m))).toNat * 1000000000000000000000000000 = D at ⊢
+    have hAD : (D : Int) = -A := by
+      rw [← hgA, ← hgD, Int.natCast_mul, hX1n]
+      rw [show (-toInt (x1W (zWord m))) * ((1000000000000000000000000000 : Nat) : Int) =
+        -(toInt (x1W (zWord m)) * ((1000000000000000000000000000 : Nat) : Int)) from by
+          rw [Int.neg_mul]]
+      rfl
+    generalize hgE : (BIASc * 2 ^ 27 : Nat) = E at hBc ⊢
+    clear hX1n hX1 cap1 hsum hr h1 h2 hc hc1 hxm hrlo
+    omega
+  rw [hsplit] at hsum
+  have capV := capLB_cancel QS_pos hsum cap1
+  have hple : (160 - c) * (LN2c * 2 ^ 27) + BIASc * 2 ^ 27 + 2 ^ 99 -
+      (-toInt (x1W (zWord m))).toNat * 1000000000000000000000000000 ≤
+      (r + 2).toNat * 2 ^ 99 := by
+    have hsc : (toInt (x1W (zWord m)) * 7450580596923828125 + ln2kInt c +
+        116873961749927929127912020551506849476088469858172) * 2 ^ 27 ≤
+        ((r + 1) * 2 ^ 72 - 1) * 2 ^ 27 :=
+      mul_le_mul_right_nonneg (by omega) (by omega)
+    have er : ((r + 1) * 2 ^ 72 - 1) * 2 ^ 27 = (r + 1) * 2 ^ 99 - 2 ^ 27 := by
+      rw [Int.sub_mul, Int.mul_assoc, show ((2 : Int) ^ 72 * 2 ^ 27) = 2 ^ 99 from
+        by decide]
+      omega
+    rw [er] at hsc
+    have hX1n : (((-toInt (x1W (zWord m))).toNat : Nat) : Int) = -toInt (x1W (zWord m)) :=
+      Int.toNat_of_nonneg (by omega)
+    have hBc : ((BIASc * 2 ^ 27 : Nat) : Int) =
+        116873961749927929127912020551506849476088469858172 * 2 ^ 27 := by
+      decide +kernel
+    have hLc : (((160 - c) * (LN2c * 2 ^ 27) : Nat) : Int) =
+        ((160 - c : Nat) : Int) * ((LN2c : Int) * 2 ^ 27) := by
+      simp only [Int.natCast_mul]
+      rfl
+    generalize hgV : (toInt (x1W (zWord m)) * 7450580596923828125 + ln2kInt c +
+      116873961749927929127912020551506849476088469858172) * 2 ^ 27 = V27 at hsc hVs hVnn
+    generalize hgA : toInt (x1W (zWord m)) * 1000000000000000000000000000 = A at hVs
+    generalize hgB : ((160 - c : Nat) : Int) * ((LN2c : Int) * 2 ^ 27) = B at hVs hLc
+    generalize hgC : (160 - c) * (LN2c * 2 ^ 27) = Cn at hLc ⊢
+    generalize hgD : (-toInt (x1W (zWord m))).toNat * 1000000000000000000000000000 = D at ⊢
+    have hAD : (D : Int) = -A := by
+      rw [← hgA, ← hgD, Int.natCast_mul, hX1n]
+      rw [show (-toInt (x1W (zWord m))) * ((1000000000000000000000000000 : Nat) : Int) =
+        -(toInt (x1W (zWord m)) * ((1000000000000000000000000000 : Nat) : Int)) from by
+          rw [Int.neg_mul]]
+      rfl
+    generalize hgE : (BIASc * 2 ^ 27 : Nat) = E at hBc ⊢
+    clear hX1n hX1 cap1 hsum capV hr h1 h2 hc hc1 hxm hsplit hrlo
+    omega
+  have hmul : ((160 - c) * (LN2c * 2 ^ 27) + BIASc * 2 ^ 27 + 2 ^ 99 -
+      (-toInt (x1W (zWord m))).toNat * 1000000000000000000000000000) * QS ≤
+      (r + 2).toNat * 2 ^ 99 * QS :=
+    Nat.mul_le_mul_right _ hple
+  have capR := capLB_arg QS_pos hmul capV
+  refine capLB_weaken ?_ capR ?_
+  · have h1' : 0 < (10 ^ 40 : Nat) ^ (160 - c) * (10 ^ 18 * 10 ^ 31) * 10 ^ 31 :=
+      Nat.mul_pos (Nat.mul_pos (Nat.pow_pos (by decide)) (by decide)) (by decide)
+    exact Nat.mul_pos h1' (by decide)
+  · have hMLO : 2 ^ 95 ≤ m := by
+      simp only [MLO] at h1
+      omega
+    have hb := budgetL_fold (k := 160 - c) hMLO (by omega)
+    have hx1 : x + 1 ≤ (m + 1) * 2 ^ (160 - c) := by omega
+    have hxw : (x + 1) * (Sc * ((10 ^ 40 : Nat) ^ (160 - c) * 10 ^ 142)) ≤
+        (m + 1) * 2 ^ (160 - c) * (Sc * ((10 ^ 40 : Nat) ^ (160 - c) * 10 ^ 142)) :=
+      Nat.mul_le_mul_right _ hx1
+    have hfold : (m + 1) * 2 ^ (160 - c) * (Sc * ((10 ^ 40 : Nat) ^ (160 - c) *
+        10 ^ 142)) ≤
+        m * ((10 ^ 31 - 3401) * (2 * (10 ^ 40 - 1)) ^ (160 - c) * (10 ^ 31 - 3404) *
+          (10 ^ 31 + 9990) * (10 ^ 31 - 10) * 10 ^ 18) * Sc := by
+      have h := Nat.mul_le_mul_left Sc hb
+      have e1 : Sc * ((m + 1) * (2 ^ (160 - c) * (10 ^ 40 : Nat) ^ (160 - c) *
+          10 ^ 142)) =
+          (m + 1) * 2 ^ (160 - c) * (Sc * ((10 ^ 40 : Nat) ^ (160 - c) * 10 ^ 142)) := by
+        simp only [Nat.mul_assoc, Nat.mul_comm, Nat.mul_left_comm]
+      have e2 : Sc * (m * ((10 ^ 31 - 3401) * (2 * (10 ^ 40 - 1)) ^ (160 - c) *
+          (10 ^ 31 - 3404) * (10 ^ 31 + 9990) * (10 ^ 31 - 10) * 10 ^ 18)) =
+          m * ((10 ^ 31 - 3401) * (2 * (10 ^ 40 - 1)) ^ (160 - c) * (10 ^ 31 - 3404) *
+            (10 ^ 31 + 9990) * (10 ^ 31 - 10) * 10 ^ 18) * Sc := by
+        simp only [Nat.mul_assoc, Nat.mul_comm, Nat.mul_left_comm]
+      rw [e1] at h
+      rw [e2] at h
+      exact h
+    have eL : x * 10 ^ 31 * ((10 ^ 40 : Nat) ^ (160 - c) * (10 ^ 18 * 10 ^ 31) *
+        10 ^ 31 * 560227709747861399187319382270000000000000000000000000000000) ≤
+        (x + 1) * (Sc * ((10 ^ 40 : Nat) ^ (160 - c) * 10 ^ 142)) := by
+      rw [show (560227709747861399187319382270000000000000000000000000000000 : Nat) =
+        Sc * 10 ^ 31 from by decide]
+      have eAC : x * 10 ^ 31 * ((10 ^ 40 : Nat) ^ (160 - c) * (10 ^ 18 * 10 ^ 31) *
+          10 ^ 31 * (Sc * 10 ^ 31)) =
+          x * (Sc * ((10 ^ 40 : Nat) ^ (160 - c) * ((10 : Nat) ^ 18 * ((10 : Nat) ^ 31 *
+            ((10 : Nat) ^ 31 * ((10 : Nat) ^ 31 * (10 : Nat) ^ 31)))))) := by
+        simp only [Nat.mul_assoc, Nat.mul_comm, Nat.mul_left_comm]
+      rw [eAC, show ((10 : Nat) ^ 18 * ((10 : Nat) ^ 31 * ((10 : Nat) ^ 31 *
+        ((10 : Nat) ^ 31 * (10 : Nat) ^ 31)))) = 10 ^ 142 from by decide]
+      have : x * (Sc * ((10 ^ 40 : Nat) ^ (160 - c) * 10 ^ 142)) ≤
+          (x + 1) * (Sc * ((10 ^ 40 : Nat) ^ (160 - c) * 10 ^ 142)) :=
+        Nat.mul_le_mul_right _ (by omega)
+      exact this
+    have eR : (2 * (10 ^ 40 - 1)) ^ (160 - c) * (Sc * (10 ^ 31 - 3404)) *
+        (10 ^ 31 + 9990) * (m * 9999999999999999999999999996599) *
+        (10 ^ 18 * (10 ^ 31 - 10)) =
+        m * ((10 ^ 31 - 3401) * (2 * (10 ^ 40 - 1)) ^ (160 - c) * (10 ^ 31 - 3404) *
+          (10 ^ 31 + 9990) * (10 ^ 31 - 10) * 10 ^ 18) * Sc := by
+      rw [show (9999999999999999999999999996599 : Nat) = 10 ^ 31 - 3401 from by decide]
+      simp only [Nat.mul_assoc, Nat.mul_comm, Nat.mul_left_comm]
+    generalize hT1 : x * 10 ^ 31 * ((10 ^ 40 : Nat) ^ (160 - c) * (10 ^ 18 * 10 ^ 31) *
+      10 ^ 31 * 560227709747861399187319382270000000000000000000000000000000) = T1
+      at eL ⊢
+    generalize hT2 : (x + 1) * (Sc * ((10 ^ 40 : Nat) ^ (160 - c) * 10 ^ 142)) = T2
+      at eL hxw
+    generalize hT3 : (m + 1) * 2 ^ (160 - c) * (Sc * ((10 ^ 40 : Nat) ^ (160 - c) *
+      10 ^ 142)) = T3 at hxw hfold
+    generalize hT4 : m * ((10 ^ 31 - 3401) * (2 * (10 ^ 40 - 1)) ^ (160 - c) *
+      (10 ^ 31 - 3404) * (10 ^ 31 + 9990) * (10 ^ 31 - 10) * 10 ^ 18) * Sc = T4
+      at hfold eR
+    generalize hT5 : (2 * (10 ^ 40 - 1)) ^ (160 - c) * (Sc * (10 ^ 31 - 3404)) *
+      (10 ^ 31 + 9990) * (m * 9999999999999999999999999996599) *
+      (10 ^ 18 * (10 ^ 31 - 10)) = T5 at eR ⊢
+    omega
+
+/-- Upper master chain, `m < S` branch, negative binade shift
+(exact mantissa). -/
+theorem up_lt_neg {m c x : Nat} {r : Int} (h1 : MLO ≤ m) (h2 : m < Sc)
+    (hc : 160 < c) (hc2 : c ≤ 255)
+    (hr : r * 2 ^ 72 ≤ toInt (x1W (zWord m)) * 7450580596923828125 + ln2kInt c +
+      116873961749927929127912020551506849476088469858172)
+    (hr0 : 0 ≤ r)
+    (hmx : m = x * 2 ^ (c - 160)) :
+    capUB (r.toNat * 2 ^ 99) QS x (10 ^ 18) := by
+  have cap1 := x1capLtUpF h1 h2
+  have hb := capLB_mul cap1 (capLB_pow cap2L (c - 160))
+  have hX1 := x1_nonpos_ltF h1 h2
+  have hVs := v_scale_neg (toInt (x1W (zWord m))) c hc
+  -- split: B = pa + (|X1|·E + j·L) with pa = V·2^27 ≥ 0
+  have hsplit : BIASc * 2 ^ 27 =
+      (BIASc * 2 ^ 27 - ((-toInt (x1W (zWord m))).toNat * 1000000000000000000000000000 +
+        (c - 160) * (LN2c * 2 ^ 27))) +
+        ((-toInt (x1W (zWord m))).toNat * 1000000000000000000000000000 +
+          (c - 160) * (LN2c * 2 ^ 27)) := by
+    have hX1n : (((-toInt (x1W (zWord m))).toNat : Nat) : Int) = -toInt (x1W (zWord m)) :=
+      Int.toNat_of_nonneg (by omega)
+    have hBc : ((BIASc * 2 ^ 27 : Nat) : Int) =
+        116873961749927929127912020551506849476088469858172 * 2 ^ 27 := by
+      decide +kernel
+    have hLc : (((c - 160) * (LN2c * 2 ^ 27) : Nat) : Int) =
+        ((c - 160 : Nat) : Int) * ((LN2c : Int) * 2 ^ 27) := by
+      simp only [Int.natCast_mul]
+      rfl
+    have hV0 : 0 ≤ (toInt (x1W (zWord m)) * 7450580596923828125 + ln2kInt c +
+        116873961749927929127912020551506849476088469858172) * 2 ^ 27 := by
+      have hm := mul_le_mul_right_nonneg hr (show (0 : Int) ≤ 2 ^ 27 by omega)
+      have h0 : 0 ≤ r * 2 ^ 72 * 2 ^ 27 :=
+        Int.mul_nonneg (Int.mul_nonneg hr0 (by omega)) (by omega)
+      generalize hgV' : (toInt (x1W (zWord m)) * 7450580596923828125 + ln2kInt c +
+        116873961749927929127912020551506849476088469858172) * 2 ^ 27 = V27 at hm ⊢
+      generalize hgR : r * 2 ^ 72 * 2 ^ 27 = R27 at hm h0
+      clear cap1 hb hX1 hVs hX1n hBc hLc h1 h2 hmx hc hc2 hr hr0
+      omega
+    generalize hgV : (toInt (x1W (zWord m)) * 7450580596923828125 + ln2kInt c +
+      116873961749927929127912020551506849476088469858172) * 2 ^ 27 = V27 at hV0 hVs
+    generalize hgA : toInt (x1W (zWord m)) * 1000000000000000000000000000 = A at hVs
+    generalize hgB : ((c - 160 : Nat) : Int) * ((LN2c : Int) * 2 ^ 27) = B at hVs hLc
+    generalize hgC : (c - 160) * (LN2c * 2 ^ 27) = Cn at hLc ⊢
+    generalize hgD : (-toInt (x1W (zWord m))).toNat * 1000000000000000000000000000 = D at ⊢
+    have hAD : (D : Int) = -A := by
+      rw [← hgA, ← hgD, Int.natCast_mul, hX1n]
+      rw [show (-toInt (x1W (zWord m))) * ((1000000000000000000000000000 : Nat) : Int) =
+        -(toInt (x1W (zWord m)) * ((1000000000000000000000000000 : Nat) : Int)) from by
+          rw [Int.neg_mul]]
+      rfl
+    generalize hgE : (BIASc * 2 ^ 27 : Nat) = E at hBc ⊢
+    clear hX1n hX1 cap1 hb hr h1 h2 hc hc2 hmx
+    omega
+  have hsumB : capUB (BIASc * 2 ^ 27) QS (Sc * (10 ^ 31 - 3402)) (10 ^ 18 * 10 ^ 31) :=
+    capBU
+  rw [hsplit] at hsumB
+  have capV := capUB_cancel QS_pos hsumB hb
+  have hple : r.toNat * 2 ^ 99 ≤
+      BIASc * 2 ^ 27 - ((-toInt (x1W (zWord m))).toNat * 1000000000000000000000000000 +
+        (c - 160) * (LN2c * 2 ^ 27)) := by
+    have hsc : r * 2 ^ 72 * 2 ^ 27 ≤ (toInt (x1W (zWord m)) * 7450580596923828125 +
+        ln2kInt c + 116873961749927929127912020551506849476088469858172) * 2 ^ 27 :=
+      mul_le_mul_right_nonneg hr (by omega)
+    have e99 : r * 2 ^ 72 * 2 ^ 27 = r * 2 ^ 99 := by
+      rw [Int.mul_assoc, show ((2 : Int) ^ 72 * 2 ^ 27) = 2 ^ 99 from by decide]
+    rw [e99] at hsc
+    have hX1n : (((-toInt (x1W (zWord m))).toNat : Nat) : Int) = -toInt (x1W (zWord m)) :=
+      Int.toNat_of_nonneg (by omega)
+    have hBc : ((BIASc * 2 ^ 27 : Nat) : Int) =
+        116873961749927929127912020551506849476088469858172 * 2 ^ 27 := by
+      decide +kernel
+    have hLc : (((c - 160) * (LN2c * 2 ^ 27) : Nat) : Int) =
+        ((c - 160 : Nat) : Int) * ((LN2c : Int) * 2 ^ 27) := by
+      simp only [Int.natCast_mul]
+      rfl
+    generalize hgV : (toInt (x1W (zWord m)) * 7450580596923828125 + ln2kInt c +
+      116873961749927929127912020551506849476088469858172) * 2 ^ 27 = V27 at hsc hVs
+    generalize hgA : toInt (x1W (zWord m)) * 1000000000000000000000000000 = A at hVs
+    generalize hgB : ((c - 160 : Nat) : Int) * ((LN2c : Int) * 2 ^ 27) = B at hVs hLc
+    generalize hgC : (c - 160) * (LN2c * 2 ^ 27) = Cn at hLc ⊢
+    generalize hgD : (-toInt (x1W (zWord m))).toNat * 1000000000000000000000000000 = D at ⊢
+    have hAD : (D : Int) = -A := by
+      rw [← hgA, ← hgD, Int.natCast_mul, hX1n]
+      rw [show (-toInt (x1W (zWord m))) * ((1000000000000000000000000000 : Nat) : Int) =
+        -(toInt (x1W (zWord m)) * ((1000000000000000000000000000 : Nat) : Int)) from by
+          rw [Int.neg_mul]]
+      rfl
+    generalize hgE : (BIASc * 2 ^ 27 : Nat) = E at hBc ⊢
+    clear hX1n hX1 cap1 hb capV hr h1 h2 hc hc2 hmx hsplit
+    omega
+  have hmul : r.toNat * 2 ^ 99 * QS ≤
+      (BIASc * 2 ^ 27 - ((-toInt (x1W (zWord m))).toNat * 1000000000000000000000000000 +
+        (c - 160) * (LN2c * 2 ^ 27))) * QS :=
+    Nat.mul_le_mul_right _ hple
+  have capR := capUB_arg QS_pos hmul capV
+  refine capUB_weaken ?_ capR ?_
+  · have h1' : 0 < (10 ^ 18 * 10 ^ 31 : Nat) *
+        (560227709747861399187319382270000000000000000000000000000000 *
+          (2 * (10 ^ 40 - 1)) ^ (c - 160)) :=
+      Nat.mul_pos (by decide) (Nat.mul_pos (by decide) (Nat.pow_pos (by decide)))
+    exact h1'
+  · have hbg := budgetUn_le (j := c - 160) (by omega)
+    have hbf := Nat.mul_le_mul_left (x * Sc) hbg
+    have eY : Sc * (10 ^ 31 - 3402) * (m * 10000000000000000000000000003401 *
+        (10 ^ 40 : Nat) ^ (c - 160)) * 10 ^ 18 =
+        x * Sc * ((10 ^ 31 + 3401) * (10 ^ 31 - 3402) * (10 ^ 40 : Nat) ^ (c - 160) *
+          2 ^ (c - 160) * 10 ^ 18) := by
+      rw [hmx, show (10000000000000000000000000003401 : Nat) = 10 ^ 31 + 3401 from by decide]
+      simp only [Nat.mul_assoc, Nat.mul_comm, Nat.mul_left_comm]
+    have eW : x * (10 ^ 18 * 10 ^ 31 *
+        (560227709747861399187319382270000000000000000000000000000000 *
+          (2 * (10 ^ 40 - 1)) ^ (c - 160))) =
+        x * Sc * (10 ^ 80 * (2 * (10 ^ 40 - 1)) ^ (c - 160)) := by
+      rw [show (560227709747861399187319382270000000000000000000000000000000 : Nat) =
+        Sc * 10 ^ 31 from by decide]
+      have e' : ∀ P : Nat, (10 : Nat) ^ 18 * ((10 : Nat) ^ 31 * ((10 : Nat) ^ 31 * P)) =
+          (10 : Nat) ^ 80 * P := by
+        intro P
+        rw [← Nat.mul_assoc, ← Nat.mul_assoc,
+          show ((10 : Nat) ^ 18 * 10 ^ 31 * 10 ^ 31) = 10 ^ 80 from by decide]
+      simp only [Nat.mul_assoc, Nat.mul_left_comm]
+      rw [e' ((2 * (10 ^ 40 - 1)) ^ (c - 160))]
+    generalize hT1 : Sc * (10 ^ 31 - 3402) * (m * 10000000000000000000000000003401 *
+      (10 ^ 40 : Nat) ^ (c - 160)) * 10 ^ 18 = T1 at eY ⊢
+    generalize hT2 : x * Sc * ((10 ^ 31 + 3401) * (10 ^ 31 - 3402) *
+      (10 ^ 40 : Nat) ^ (c - 160) * 2 ^ (c - 160) * 10 ^ 18) = T2 at eY hbf
+    generalize hT3 : x * Sc * (10 ^ 80 * (2 * (10 ^ 40 - 1)) ^ (c - 160)) = T3 at hbf eW
+    generalize hT4 : x * (10 ^ 18 * 10 ^ 31 *
+      (560227709747861399187319382270000000000000000000000000000000 *
+        (2 * (10 ^ 40 - 1)) ^ (c - 160))) = T4 at eW ⊢
+    omega
+
+/-- Lower master chain, `m < S` branch, negative binade shift
+(exact mantissa). -/
+theorem lo_lt_neg {m c x : Nat} {r : Int} (h1 : MLO ≤ m) (h2 : m < Sc)
+    (hc : 160 < c) (hc2 : c ≤ 255)
+    (hr : toInt (x1W (zWord m)) * 7450580596923828125 + ln2kInt c +
+      116873961749927929127912020551506849476088469858172 < (r + 1) * 2 ^ 72)
+    (hrlo : r * 2 ^ 72 ≤ toInt (x1W (zWord m)) * 7450580596923828125 + ln2kInt c +
+      116873961749927929127912020551506849476088469858172)
+    (hr0 : -1 ≤ r)
+    (hmx : m = x * 2 ^ (c - 160)) :
+    capLB ((r + 2).toNat * 2 ^ 99) QS (x * 10 ^ 31) (10 ^ 18 * (10 ^ 31 - 10)) := by
+  have cap1 := x1capLtLoF h1 h2
+  have hb := capUB_mul QS_pos cap1 (capUB_pow QS_pos cap2U (c - 160))
+  have hsum := capLB_mul capBL capEL
+  have hX1 := x1_nonpos_ltF h1 h2
+  have hVs := v_scale_neg (toInt (x1W (zWord m))) c hc
+  have hVnn : -(2 ^ 99) ≤ (toInt (x1W (zWord m)) * 7450580596923828125 + ln2kInt c +
+      116873961749927929127912020551506849476088469858172) * 2 ^ 27 := by
+    have h0 : -(2 ^ 72) ≤ r * 2 ^ 72 := by
+      have := mul_le_mul_right_nonneg (show (-1 : Int) ≤ r from hr0)
+        (show (0 : Int) ≤ 2 ^ 72 by omega)
+      generalize hgT : r * 2 ^ 72 = T at this ⊢
+      omega
+    have hg : -(2 ^ 72) ≤ toInt (x1W (zWord m)) * 7450580596923828125 + ln2kInt c +
+        116873961749927929127912020551506849476088469858172 := by
+      generalize hgV : toInt (x1W (zWord m)) * 7450580596923828125 + ln2kInt c +
+        116873961749927929127912020551506849476088469858172 = V at hrlo ⊢
+      omega
+    have := mul_le_mul_right_nonneg hg (show (0 : Int) ≤ 2 ^ 27 by omega)
+    generalize hgV : (toInt (x1W (zWord m)) * 7450580596923828125 + ln2kInt c +
+      116873961749927929127912020551506849476088469858172) * 2 ^ 27 = V27 at this ⊢
+    have e : (-(2 ^ 72) : Int) * 2 ^ 27 = -(2 ^ 99) := by decide
+    omega
+  have hsplit : BIASc * 2 ^ 27 + 2 ^ 99 =
+      (BIASc * 2 ^ 27 + 2 ^ 99 -
+        ((-toInt (x1W (zWord m))).toNat * 1000000000000000000000000000 +
+          (c - 160) * (LN2c * 2 ^ 27))) +
+        ((-toInt (x1W (zWord m))).toNat * 1000000000000000000000000000 +
+          (c - 160) * (LN2c * 2 ^ 27)) := by
+    have hX1n : (((-toInt (x1W (zWord m))).toNat : Nat) : Int) = -toInt (x1W (zWord m)) :=
+      Int.toNat_of_nonneg (by omega)
+    have hBc : ((BIASc * 2 ^ 27 : Nat) : Int) =
+        116873961749927929127912020551506849476088469858172 * 2 ^ 27 := by
+      decide +kernel
+    have hLc : (((c - 160) * (LN2c * 2 ^ 27) : Nat) : Int) =
+        ((c - 160 : Nat) : Int) * ((LN2c : Int) * 2 ^ 27) := by
+      simp only [Int.natCast_mul]
+      rfl
+    generalize hgV : (toInt (x1W (zWord m)) * 7450580596923828125 + ln2kInt c +
+      116873961749927929127912020551506849476088469858172) * 2 ^ 27 = V27 at hVnn hVs
+    generalize hgA : toInt (x1W (zWord m)) * 1000000000000000000000000000 = A at hVs
+    generalize hgB : ((c - 160 : Nat) : Int) * ((LN2c : Int) * 2 ^ 27) = B at hVs hLc
+    generalize hgC : (c - 160) * (LN2c * 2 ^ 27) = Cn at hLc ⊢
+    generalize hgD : (-toInt (x1W (zWord m))).toNat * 1000000000000000000000000000 = D at ⊢
+    have hAD : (D : Int) = -A := by
+      rw [← hgA, ← hgD, Int.natCast_mul, hX1n]
+      rw [show (-toInt (x1W (zWord m))) * ((1000000000000000000000000000 : Nat) : Int) =
+        -(toInt (x1W (zWord m)) * ((1000000000000000000000000000 : Nat) : Int)) from by
+          rw [Int.neg_mul]]
+      rfl
+    generalize hgE : (BIASc * 2 ^ 27 : Nat) = E at hBc ⊢
+    clear hX1n hX1 cap1 hb hsum hr h1 h2 hc hc2 hmx hrlo
+    omega
+  rw [hsplit] at hsum
+  have capV := capLB_cancel QS_pos hsum hb
+  have hple : BIASc * 2 ^ 27 + 2 ^ 99 -
+      ((-toInt (x1W (zWord m))).toNat * 1000000000000000000000000000 +
+        (c - 160) * (LN2c * 2 ^ 27)) ≤
+      (r + 2).toNat * 2 ^ 99 := by
+    have hsc : (toInt (x1W (zWord m)) * 7450580596923828125 + ln2kInt c +
+        116873961749927929127912020551506849476088469858172) * 2 ^ 27 ≤
+        ((r + 1) * 2 ^ 72 - 1) * 2 ^ 27 :=
+      mul_le_mul_right_nonneg (by omega) (by omega)
+    have er : ((r + 1) * 2 ^ 72 - 1) * 2 ^ 27 = (r + 1) * 2 ^ 99 - 2 ^ 27 := by
+      rw [Int.sub_mul, Int.mul_assoc, show ((2 : Int) ^ 72 * 2 ^ 27) = 2 ^ 99 from
+        by decide]
+      omega
+    rw [er] at hsc
+    have hX1n : (((-toInt (x1W (zWord m))).toNat : Nat) : Int) = -toInt (x1W (zWord m)) :=
+      Int.toNat_of_nonneg (by omega)
+    have hBc : ((BIASc * 2 ^ 27 : Nat) : Int) =
+        116873961749927929127912020551506849476088469858172 * 2 ^ 27 := by
+      decide +kernel
+    have hLc : (((c - 160) * (LN2c * 2 ^ 27) : Nat) : Int) =
+        ((c - 160 : Nat) : Int) * ((LN2c : Int) * 2 ^ 27) := by
+      simp only [Int.natCast_mul]
+      rfl
+    generalize hgV : (toInt (x1W (zWord m)) * 7450580596923828125 + ln2kInt c +
+      116873961749927929127912020551506849476088469858172) * 2 ^ 27 = V27 at hsc hVs hVnn
+    generalize hgA : toInt (x1W (zWord m)) * 1000000000000000000000000000 = A at hVs
+    generalize hgB : ((c - 160 : Nat) : Int) * ((LN2c : Int) * 2 ^ 27) = B at hVs hLc
+    generalize hgC : (c - 160) * (LN2c * 2 ^ 27) = Cn at hLc ⊢
+    generalize hgD : (-toInt (x1W (zWord m))).toNat * 1000000000000000000000000000 = D at ⊢
+    have hAD : (D : Int) = -A := by
+      rw [← hgA, ← hgD, Int.natCast_mul, hX1n]
+      rw [show (-toInt (x1W (zWord m))) * ((1000000000000000000000000000 : Nat) : Int) =
+        -(toInt (x1W (zWord m)) * ((1000000000000000000000000000 : Nat) : Int)) from by
+          rw [Int.neg_mul]]
+      rfl
+    generalize hgE : (BIASc * 2 ^ 27 : Nat) = E at hBc ⊢
+    clear hX1n hX1 cap1 hb hsum capV hr h1 h2 hc hc2 hmx hsplit hrlo
+    omega
+  have hmul : (BIASc * 2 ^ 27 + 2 ^ 99 -
+      ((-toInt (x1W (zWord m))).toNat * 1000000000000000000000000000 +
+        (c - 160) * (LN2c * 2 ^ 27))) * QS ≤
+      (r + 2).toNat * 2 ^ 99 * QS :=
+    Nat.mul_le_mul_right _ hple
+  have capR := capLB_arg QS_pos hmul capV
+  refine capLB_weaken ?_ capR ?_
+  · have h1' : 0 < (10 ^ 18 * 10 ^ 31 * 10 ^ 31 : Nat) *
+        (560227709747861399187319382270000000000000000000000000000000 *
+          (2 * (10 ^ 40 + 1)) ^ (c - 160)) :=
+      Nat.mul_pos (by decide) (Nat.mul_pos (by decide) (Nat.pow_pos (by decide)))
+    exact h1'
+  · have hbg := budgetLn_le (j := c - 160) (by omega)
+    have hbf := Nat.mul_le_mul_left (x * Sc) hbg
+    have eL : x * 10 ^ 31 * (10 ^ 18 * 10 ^ 31 * 10 ^ 31 *
+        (560227709747861399187319382270000000000000000000000000000000 *
+          (2 * (10 ^ 40 + 1)) ^ (c - 160))) =
+        x * Sc * ((10 : Nat) ^ 142 * (2 * (10 ^ 40 + 1)) ^ (c - 160)) := by
+      rw [show (560227709747861399187319382270000000000000000000000000000000 : Nat) =
+        Sc * 10 ^ 31 from by decide]
+      have e' : ∀ P : Nat, (10 : Nat) ^ 18 * ((10 : Nat) ^ 31 * ((10 : Nat) ^ 31 *
+          ((10 : Nat) ^ 31 * ((10 : Nat) ^ 31 * P)))) = (10 : Nat) ^ 142 * P := by
+        intro P
+        rw [← Nat.mul_assoc, ← Nat.mul_assoc, ← Nat.mul_assoc, ← Nat.mul_assoc,
+          show ((10 : Nat) ^ 18 * 10 ^ 31 * 10 ^ 31 * 10 ^ 31 * 10 ^ 31) = 10 ^ 142
+            from by decide]
+      have eAC : x * 10 ^ 31 * (10 ^ 18 * 10 ^ 31 * 10 ^ 31 * (Sc * 10 ^ 31 *
+          (2 * (10 ^ 40 + 1)) ^ (c - 160))) =
+          x * (Sc * ((10 : Nat) ^ 18 * ((10 : Nat) ^ 31 * ((10 : Nat) ^ 31 *
+            ((10 : Nat) ^ 31 * ((10 : Nat) ^ 31 *
+              (2 * (10 ^ 40 + 1)) ^ (c - 160))))))) := by
+        simp only [Nat.mul_assoc, Nat.mul_comm, Nat.mul_left_comm]
+      rw [eAC, e' ((2 * (10 ^ 40 + 1)) ^ (c - 160))]
+      simp only [Nat.mul_assoc]
+    have eR : Sc * (10 ^ 31 - 3404) * (10 ^ 31 + 9990) *
+        (m * 9999999999999999999999999996599 * (10 ^ 40 : Nat) ^ (c - 160)) *
+        (10 ^ 18 * (10 ^ 31 - 10)) =
+        x * Sc * (2 ^ (c - 160) * (10 ^ 40 : Nat) ^ (c - 160) * (10 ^ 31 - 3401) *
+          (10 ^ 31 - 3404) * (10 ^ 31 + 9990) * (10 ^ 31 - 10) * 10 ^ 18) := by
+      rw [hmx, show (9999999999999999999999999996599 : Nat) = 10 ^ 31 - 3401 from by decide]
+      simp only [Nat.mul_assoc, Nat.mul_comm, Nat.mul_left_comm]
+    generalize hT1 : x * 10 ^ 31 * (10 ^ 18 * 10 ^ 31 * 10 ^ 31 *
+      (560227709747861399187319382270000000000000000000000000000000 *
+        (2 * (10 ^ 40 + 1)) ^ (c - 160))) = T1 at eL ⊢
+    generalize hT2 : x * Sc * ((10 : Nat) ^ 142 * (2 * (10 ^ 40 + 1)) ^ (c - 160)) = T2
+      at eL hbf
+    generalize hT3 : x * Sc * (2 ^ (c - 160) * (10 ^ 40 : Nat) ^ (c - 160) *
+      (10 ^ 31 - 3401) * (10 ^ 31 - 3404) * (10 ^ 31 + 9990) * (10 ^ 31 - 10) * 10 ^ 18) = T3
+      at eR hbf
+    generalize hT4 : Sc * (10 ^ 31 - 3404) * (10 ^ 31 + 9990) *
+      (m * 9999999999999999999999999996599 * (10 ^ 40 : Nat) ^ (c - 160)) *
+      (10 ^ 18 * (10 ^ 31 - 10)) = T4 at eR ⊢
+    omega
+
+/-- A-atom master for negative outputs, `m < S` branch, `k ≥ 0`:
+`e^(|r|/10^27) ≥ 10^18/x`. -/
+theorem an_lt_pos {m c x : Nat} {r : Int} (h1 : MLO ≤ m) (h2 : m < Sc)
+    (hc1 : 1 ≤ c) (hc : c ≤ 160)
+    (hrlo : r * 2 ^ 72 ≤ toInt (x1W (zWord m)) * 7450580596923828125 + ln2kInt c +
+      116873961749927929127912020551506849476088469858172)
+    (hr : toInt (x1W (zWord m)) * 7450580596923828125 + ln2kInt c +
+      116873961749927929127912020551506849476088469858172 < (r + 1) * 2 ^ 72)
+    (hrneg : r < 0)
+    (hmx : m * 2 ^ (160 - c) ≤ x) :
+    capLB ((-r).toNat * 2 ^ 99) QS (10 ^ 18) x := by
+  have cap1 := x1capLtUpF h1 h2
+  have hb := capUB_mul QS_pos (capUB_pow QS_pos cap2U (160 - c)) capBU
+  have hX1 := x1_nonpos_ltF h1 h2
+  have hVs := v_scale_pos (toInt (x1W (zWord m))) c hc
+  -- split: |X1|·E = pa + (kL + B) with pa = -V·2^27 ≥ 0
+  have hsplit : (-toInt (x1W (zWord m))).toNat * 1000000000000000000000000000 =
+      ((-toInt (x1W (zWord m))).toNat * 1000000000000000000000000000 -
+        ((160 - c) * (LN2c * 2 ^ 27) + BIASc * 2 ^ 27)) +
+        ((160 - c) * (LN2c * 2 ^ 27) + BIASc * 2 ^ 27) := by
+    have hX1n : (((-toInt (x1W (zWord m))).toNat : Nat) : Int) = -toInt (x1W (zWord m)) :=
+      Int.toNat_of_nonneg (by omega)
+    have hBc : ((BIASc * 2 ^ 27 : Nat) : Int) =
+        116873961749927929127912020551506849476088469858172 * 2 ^ 27 := by
+      decide +kernel
+    have hLc : (((160 - c) * (LN2c * 2 ^ 27) : Nat) : Int) =
+        ((160 - c : Nat) : Int) * ((LN2c : Int) * 2 ^ 27) := by
+      simp only [Int.natCast_mul]
+      rfl
+    have hV0 : (toInt (x1W (zWord m)) * 7450580596923828125 + ln2kInt c +
+        116873961749927929127912020551506849476088469858172) * 2 ^ 27 ≤ 0 := by
+      have hm := mul_le_mul_right_nonneg (show toInt (x1W (zWord m)) *
+        7450580596923828125 + ln2kInt c +
+        116873961749927929127912020551506849476088469858172 ≤ 0 from by
+          generalize hgV' : toInt (x1W (zWord m)) * 7450580596923828125 + ln2kInt c +
+            116873961749927929127912020551506849476088469858172 = V at hr ⊢
+          generalize hgR : (r + 1) * 2 ^ 72 = R at hr
+          have : R ≤ 0 := by
+            rw [← hgR]
+            have : r + 1 ≤ 0 := by omega
+            have := mul_le_mul_right_nonneg this (show (0 : Int) ≤ 2 ^ 72 by omega)
+            generalize hgT : (r + 1) * 2 ^ 72 = T at this ⊢
+            omega
+          omega) (show (0 : Int) ≤ 2 ^ 27 by omega)
+      generalize hgV' : (toInt (x1W (zWord m)) * 7450580596923828125 + ln2kInt c +
+        116873961749927929127912020551506849476088469858172) * 2 ^ 27 = V27 at hm ⊢
+      clear cap1 hb hX1 hVs hrlo hr h1 h2 hmx hX1n hBc hLc
+      omega
+    generalize hgV : (toInt (x1W (zWord m)) * 7450580596923828125 + ln2kInt c +
+      116873961749927929127912020551506849476088469858172) * 2 ^ 27 = V27 at hV0 hVs
+    generalize hgA : toInt (x1W (zWord m)) * 1000000000000000000000000000 = A at hVs
+    generalize hgB : ((160 - c : Nat) : Int) * ((LN2c : Int) * 2 ^ 27) = B at hVs hLc
+    generalize hgC : (160 - c) * (LN2c * 2 ^ 27) = Cn at hLc ⊢
+    generalize hgD : (-toInt (x1W (zWord m))).toNat * 1000000000000000000000000000 = D at ⊢
+    have hAD : (D : Int) = -A := by
+      rw [← hgA, ← hgD, Int.natCast_mul, hX1n]
+      rw [show (-toInt (x1W (zWord m))) * ((1000000000000000000000000000 : Nat) : Int) =
+        -(toInt (x1W (zWord m)) * ((1000000000000000000000000000 : Nat) : Int)) from by
+          rw [Int.neg_mul]]
+      rfl
+    generalize hgE : (BIASc * 2 ^ 27 : Nat) = E at hBc ⊢
+    clear hX1n hX1 cap1 hb hr h1 h2 hc hc1 hmx hrlo hrneg
+    omega
+  rw [hsplit] at cap1
+  have capV := capLB_cancel QS_pos cap1 hb
+  have hple : (-toInt (x1W (zWord m))).toNat * 1000000000000000000000000000 -
+      ((160 - c) * (LN2c * 2 ^ 27) + BIASc * 2 ^ 27) ≤ (-r).toNat * 2 ^ 99 := by
+    have hsc : (-r) * 2 ^ 72 * 2 ^ 27 ≥ -(toInt (x1W (zWord m)) * 7450580596923828125 +
+        ln2kInt c + 116873961749927929127912020551506849476088469858172) * 2 ^ 27 := by
+      have h := mul_le_mul_right_nonneg hrlo (show (0 : Int) ≤ 2 ^ 27 by omega)
+      generalize hgV' : (toInt (x1W (zWord m)) * 7450580596923828125 + ln2kInt c +
+        116873961749927929127912020551506849476088469858172) = V at h ⊢
+      generalize hgR : r * 2 ^ 72 * 2 ^ 27 = R at h
+      have e1 : (-r) * 2 ^ 72 * 2 ^ 27 = -(r * 2 ^ 72 * 2 ^ 27) := by
+        rw [Int.neg_mul, Int.neg_mul]
+      have e2 : -V * 2 ^ 27 = -(V * 2 ^ 27) := Int.neg_mul _ _
+      generalize hgV2 : V * 2 ^ 27 = V27 at h e2 ⊢
+      omega
+    have e99 : (-r) * 2 ^ 72 * 2 ^ 27 = (-r) * 2 ^ 99 := by
+      rw [Int.mul_assoc, show ((2 : Int) ^ 72 * 2 ^ 27) = 2 ^ 99 from by decide]
+    rw [e99] at hsc
+    have hX1n : (((-toInt (x1W (zWord m))).toNat : Nat) : Int) = -toInt (x1W (zWord m)) :=
+      Int.toNat_of_nonneg (by omega)
+    have hBc : ((BIASc * 2 ^ 27 : Nat) : Int) =
+        116873961749927929127912020551506849476088469858172 * 2 ^ 27 := by
+      decide +kernel
+    have hLc : (((160 - c) * (LN2c * 2 ^ 27) : Nat) : Int) =
+        ((160 - c : Nat) : Int) * ((LN2c : Int) * 2 ^ 27) := by
+      simp only [Int.natCast_mul]
+      rfl
+    have hnegV : -(toInt (x1W (zWord m)) * 7450580596923828125 + ln2kInt c +
+        116873961749927929127912020551506849476088469858172) * 2 ^ 27 =
+        -((toInt (x1W (zWord m)) * 7450580596923828125 + ln2kInt c +
+          116873961749927929127912020551506849476088469858172) * 2 ^ 27) :=
+      Int.neg_mul _ _
+    rw [hnegV] at hsc
+    generalize hgV : (toInt (x1W (zWord m)) * 7450580596923828125 + ln2kInt c +
+      116873961749927929127912020551506849476088469858172) * 2 ^ 27 = V27 at hsc hVs
+    generalize hgA : toInt (x1W (zWord m)) * 1000000000000000000000000000 = A at hVs
+    generalize hgB : ((160 - c : Nat) : Int) * ((LN2c : Int) * 2 ^ 27) = B at hVs hLc
+    generalize hgC : (160 - c) * (LN2c * 2 ^ 27) = Cn at hLc ⊢
+    generalize hgD : (-toInt (x1W (zWord m))).toNat * 1000000000000000000000000000 = D at ⊢
+    have hAD : (D : Int) = -A := by
+      rw [← hgA, ← hgD, Int.natCast_mul, hX1n]
+      rw [show (-toInt (x1W (zWord m))) * ((1000000000000000000000000000 : Nat) : Int) =
+        -(toInt (x1W (zWord m)) * ((1000000000000000000000000000 : Nat) : Int)) from by
+          rw [Int.neg_mul]]
+      rfl
+    generalize hgE : (BIASc * 2 ^ 27 : Nat) = E at hBc ⊢
+    clear hX1n hX1 cap1 hb capV hr h1 h2 hc hc1 hmx hsplit hrlo
+    omega
+  have hmul : ((-toInt (x1W (zWord m))).toNat * 1000000000000000000000000000 -
+      ((160 - c) * (LN2c * 2 ^ 27) + BIASc * 2 ^ 27)) * QS ≤
+      (-r).toNat * 2 ^ 99 * QS :=
+    Nat.mul_le_mul_right _ hple
+  have capR := capLB_arg QS_pos hmul capV
+  refine capLB_weaken ?_ capR ?_
+  · have h1' : 0 < m * 10000000000000000000000000003401 := by
+      have : 0 < m := by simp only [MLO] at h1; omega
+      exact Nat.mul_pos this (by decide)
+    exact Nat.mul_pos h1' (Nat.mul_pos (Nat.pow_pos (by decide)) (by decide))
+  · have hbg := budgetU_le (k := 160 - c) (by omega)
+    have hbm : m * (Sc * ((10 ^ 31 + 3401) * (2 * (10 ^ 40 + 1)) ^ (160 - c) *
+        (10 ^ 31 - 3402) * 10 ^ 18)) ≤
+        m * (Sc * (2 ^ (160 - c) * (10 ^ 40 : Nat) ^ (160 - c) * 10 ^ 80)) :=
+      Nat.mul_le_mul_left _ (Nat.mul_le_mul_left _ hbg)
+    have hxm : m * 2 ^ (160 - c) * (Sc * ((10 ^ 40 : Nat) ^ (160 - c) * 10 ^ 80)) ≤
+        x * (Sc * ((10 ^ 40 : Nat) ^ (160 - c) * 10 ^ 80)) :=
+      Nat.mul_le_mul_right _ hmx
+    have e1 : 10 ^ 18 * (m * 10000000000000000000000000003401 *
+        ((2 * (10 ^ 40 + 1)) ^ (160 - c) * (Sc * (10 ^ 31 - 3402)))) =
+        m * (Sc * ((10 ^ 31 + 3401) * (2 * (10 ^ 40 + 1)) ^ (160 - c) *
+          (10 ^ 31 - 3402) * 10 ^ 18)) := by
+      rw [show (10000000000000000000000000003401 : Nat) = 10 ^ 31 + 3401 from by decide]
+      simp only [Nat.mul_assoc, Nat.mul_comm, Nat.mul_left_comm]
+    have e2 : m * (Sc * (2 ^ (160 - c) * (10 ^ 40 : Nat) ^ (160 - c) * 10 ^ 80)) =
+        m * 2 ^ (160 - c) * (Sc * ((10 ^ 40 : Nat) ^ (160 - c) * 10 ^ 80)) := by
+      simp only [Nat.mul_assoc, Nat.mul_comm, Nat.mul_left_comm]
+    have e3 : 560227709747861399187319382270000000000000000000000000000000 *
+        ((10 ^ 40 : Nat) ^ (160 - c) * (10 ^ 18 * 10 ^ 31)) * x =
+        x * (Sc * ((10 ^ 40 : Nat) ^ (160 - c) * 10 ^ 80)) := by
+      rw [show (560227709747861399187319382270000000000000000000000000000000 : Nat) =
+        Sc * 10 ^ 31 from by decide]
+      have e' : ∀ P : Nat, (10 : Nat) ^ 18 * ((10 : Nat) ^ 31 * ((10 : Nat) ^ 31 * P)) =
+          (10 : Nat) ^ 80 * P := by
+        intro P
+        rw [← Nat.mul_assoc, ← Nat.mul_assoc,
+          show ((10 : Nat) ^ 18 * 10 ^ 31 * 10 ^ 31) = 10 ^ 80 from by decide]
+      simp only [Nat.mul_assoc, Nat.mul_comm, Nat.mul_left_comm]
+      rw [e' ((10 ^ 40 : Nat) ^ (160 - c))]
+    generalize hT1 : 10 ^ 18 * (m * 10000000000000000000000000003401 *
+      ((2 * (10 ^ 40 + 1)) ^ (160 - c) * (Sc * (10 ^ 31 - 3402)))) = T1 at e1 ⊢
+    generalize hT2 : m * (Sc * ((10 ^ 31 + 3401) * (2 * (10 ^ 40 + 1)) ^ (160 - c) *
+      (10 ^ 31 - 3402) * 10 ^ 18)) = T2 at hbm e1
+    generalize hT3 : m * (Sc * (2 ^ (160 - c) * (10 ^ 40 : Nat) ^ (160 - c) * 10 ^ 80)) =
+      T3 at hbm e2
+    generalize hT4 : m * 2 ^ (160 - c) * (Sc * ((10 ^ 40 : Nat) ^ (160 - c) * 10 ^ 80)) =
+      T4 at hxm e2
+    generalize hT5 : x * (Sc * ((10 ^ 40 : Nat) ^ (160 - c) * 10 ^ 80)) = T5 at hxm e3
+    generalize hT6 : 560227709747861399187319382270000000000000000000000000000000 *
+      ((10 ^ 40 : Nat) ^ (160 - c) * (10 ^ 18 * 10 ^ 31)) * x = T6 at e3 ⊢
+    omega
+
+/-- A-atom master for negative outputs, `m ≥ S` branch, negative shift
+(exact mantissa). -/
+theorem an_ge_neg {m c x : Nat} {r : Int} (h1 : Sc ≤ m) (h2 : m < MHI)
+    (hc : 160 < c) (hc2 : c ≤ 255)
+    (hrlo : r * 2 ^ 72 ≤ toInt (x1W (zWord m)) * 7450580596923828125 + ln2kInt c +
+      116873961749927929127912020551506849476088469858172)
+    (hr : toInt (x1W (zWord m)) * 7450580596923828125 + ln2kInt c +
+      116873961749927929127912020551506849476088469858172 < (r + 1) * 2 ^ 72)
+    (hrneg : r < 0)
+    (hmx : m = x * 2 ^ (c - 160)) :
+    capLB ((-r).toNat * 2 ^ 99) QS (10 ^ 18) x := by
+  have cap1 := x1capGeUpF h1 h2
+  have hb := capUB_mul QS_pos cap1 capBU
+  have hsum := capLB_pow cap2L (c - 160)
+  have hX1 := x1_nonneg_geF h1 h2
+  have hVs := v_scale_neg (toInt (x1W (zWord m))) c hc
+  -- split: jL = pa + (X1·E + B) with pa = -V·2^27 ≥ 0
+  have hsplit : (c - 160) * (LN2c * 2 ^ 27) =
+      ((c - 160) * (LN2c * 2 ^ 27) -
+        ((toInt (x1W (zWord m))).toNat * 1000000000000000000000000000 +
+          BIASc * 2 ^ 27)) +
+        ((toInt (x1W (zWord m))).toNat * 1000000000000000000000000000 +
+          BIASc * 2 ^ 27) := by
+    have hX1n : ((toInt (x1W (zWord m))).toNat : Int) = toInt (x1W (zWord m)) :=
+      Int.toNat_of_nonneg hX1
+    have hBc : ((BIASc * 2 ^ 27 : Nat) : Int) =
+        116873961749927929127912020551506849476088469858172 * 2 ^ 27 := by
+      decide +kernel
+    have hLc : (((c - 160) * (LN2c * 2 ^ 27) : Nat) : Int) =
+        ((c - 160 : Nat) : Int) * ((LN2c : Int) * 2 ^ 27) := by
+      simp only [Int.natCast_mul]
+      rfl
+    have hV0 : (toInt (x1W (zWord m)) * 7450580596923828125 + ln2kInt c +
+        116873961749927929127912020551506849476088469858172) * 2 ^ 27 ≤ 0 := by
+      have hVle : toInt (x1W (zWord m)) * 7450580596923828125 + ln2kInt c +
+          116873961749927929127912020551506849476088469858172 ≤ 0 := by
+        have hR : (r + 1) * 2 ^ 72 ≤ 0 := by
+          have hle : r + 1 ≤ 0 := by omega
+          have := mul_le_mul_right_nonneg hle (show (0 : Int) ≤ 2 ^ 72 by omega)
+          generalize hgT : (r + 1) * 2 ^ 72 = T at this ⊢
+          omega
+        generalize hgV' : toInt (x1W (zWord m)) * 7450580596923828125 + ln2kInt c +
+          116873961749927929127912020551506849476088469858172 = V at hr ⊢
+        clear cap1 hb hsum hX1 hVs hrlo h1 h2 hmx hX1n hBc hLc
+        omega
+      have := mul_le_mul_right_nonneg hVle (show (0 : Int) ≤ 2 ^ 27 by omega)
+      generalize hgV' : (toInt (x1W (zWord m)) * 7450580596923828125 + ln2kInt c +
+        116873961749927929127912020551506849476088469858172) * 2 ^ 27 = V27 at this ⊢
+      clear cap1 hb hsum hX1 hVs hrlo hr h1 h2 hmx hX1n hBc hLc
+      omega
+    generalize hgV : (toInt (x1W (zWord m)) * 7450580596923828125 + ln2kInt c +
+      116873961749927929127912020551506849476088469858172) * 2 ^ 27 = V27 at hV0 hVs
+    generalize hgA : toInt (x1W (zWord m)) * 1000000000000000000000000000 = A at hVs
+    generalize hgB : ((c - 160 : Nat) : Int) * ((LN2c : Int) * 2 ^ 27) = B at hVs hLc
+    generalize hgC : (c - 160) * (LN2c * 2 ^ 27) = Cn at hLc ⊢
+    generalize hgD : (toInt (x1W (zWord m))).toNat * 1000000000000000000000000000 = D at ⊢
+    have hAD : (D : Int) = A := by
+      rw [← hgA, ← hgD, Int.natCast_mul, hX1n]
+      rfl
+    generalize hgE : (BIASc * 2 ^ 27 : Nat) = E at hBc ⊢
+    clear hX1n hX1 cap1 hb hsum hr h1 h2 hc hc2 hmx hrlo hrneg
+    omega
+  rw [hsplit] at hsum
+  have capV := capLB_cancel QS_pos hsum hb
+  have hple : (c - 160) * (LN2c * 2 ^ 27) -
+      ((toInt (x1W (zWord m))).toNat * 1000000000000000000000000000 +
+        BIASc * 2 ^ 27) ≤ (-r).toNat * 2 ^ 99 := by
+    have hsc := mul_le_mul_right_nonneg hrlo (show (0 : Int) ≤ 2 ^ 27 by omega)
+    have hX1n : ((toInt (x1W (zWord m))).toNat : Int) = toInt (x1W (zWord m)) :=
+      Int.toNat_of_nonneg hX1
+    have hBc : ((BIASc * 2 ^ 27 : Nat) : Int) =
+        116873961749927929127912020551506849476088469858172 * 2 ^ 27 := by
+      decide +kernel
+    have hLc : (((c - 160) * (LN2c * 2 ^ 27) : Nat) : Int) =
+        ((c - 160 : Nat) : Int) * ((LN2c : Int) * 2 ^ 27) := by
+      simp only [Int.natCast_mul]
+      rfl
+    have er : r * 2 ^ 72 * 2 ^ 27 = r * 2 ^ 99 := by
+      rw [Int.mul_assoc, show ((2 : Int) ^ 72 * 2 ^ 27) = 2 ^ 99 from by decide]
+    rw [er] at hsc
+    generalize hgV : (toInt (x1W (zWord m)) * 7450580596923828125 + ln2kInt c +
+      116873961749927929127912020551506849476088469858172) * 2 ^ 27 = V27 at hsc hVs
+    generalize hgA : toInt (x1W (zWord m)) * 1000000000000000000000000000 = A at hVs
+    generalize hgB : ((c - 160 : Nat) : Int) * ((LN2c : Int) * 2 ^ 27) = B at hVs hLc
+    generalize hgC : (c - 160) * (LN2c * 2 ^ 27) = Cn at hLc ⊢
+    generalize hgD : (toInt (x1W (zWord m))).toNat * 1000000000000000000000000000 = D at ⊢
+    have hAD : (D : Int) = A := by
+      rw [← hgA, ← hgD, Int.natCast_mul, hX1n]
+      rfl
+    generalize hgE : (BIASc * 2 ^ 27 : Nat) = E at hBc ⊢
+    clear hX1n hX1 cap1 hb hsum capV hr h1 h2 hc hc2 hmx hsplit hrlo
+    omega
+  have hmul : ((c - 160) * (LN2c * 2 ^ 27) -
+      ((toInt (x1W (zWord m))).toNat * 1000000000000000000000000000 +
+        BIASc * 2 ^ 27)) * QS ≤ (-r).toNat * 2 ^ 99 * QS :=
+    Nat.mul_le_mul_right _ hple
+  have capR := capLB_arg QS_pos hmul capV
+  refine capLB_weaken ?_ capR ?_
+  · have hm0 : 0 < m := by simp only [Sc] at h1; omega
+    have hScp : 0 < Sc := by simp only [Sc]; omega
+    exact Nat.mul_pos (Nat.pow_pos (by omega))
+      (Nat.mul_pos (Nat.mul_pos hm0 (by omega)) (Nat.mul_pos hScp (by omega)))
+  · have hbg := budgetUn_le (j := c - 160) (by omega)
+    have hbf := Nat.mul_le_mul_left (x * Sc) hbg
+    have eL : 10 ^ 18 * ((10 ^ 40 : Nat) ^ (c - 160) *
+        (m * 10000000000000000000000000003401 * (Sc * (10 ^ 31 - 3402)))) =
+        x * Sc * ((10 ^ 31 + 3401) * (10 ^ 31 - 3402) * (10 ^ 40 : Nat) ^ (c - 160) *
+          2 ^ (c - 160) * 10 ^ 18) := by
+      rw [hmx, show (10000000000000000000000000003401 : Nat) = 10 ^ 31 + 3401 from by decide]
+      simp only [Nat.mul_assoc, Nat.mul_comm, Nat.mul_left_comm]
+    have eR : (2 * (10 ^ 40 - 1)) ^ (c - 160) *
+        (560227709747861399187319382270000000000000000000000000000000 *
+          (10 ^ 18 * 10 ^ 31)) * x =
+        x * Sc * (10 ^ 80 * (2 * (10 ^ 40 - 1)) ^ (c - 160)) := by
+      rw [show (560227709747861399187319382270000000000000000000000000000000 : Nat) =
+        Sc * 10 ^ 31 from by decide]
+      have e' : ∀ P : Nat, (10 : Nat) ^ 18 * ((10 : Nat) ^ 31 * ((10 : Nat) ^ 31 * P)) =
+          (10 : Nat) ^ 80 * P := by
+        intro P
+        rw [← Nat.mul_assoc, ← Nat.mul_assoc,
+          show ((10 : Nat) ^ 18 * 10 ^ 31 * 10 ^ 31) = 10 ^ 80 from by decide]
+      simp only [Nat.mul_assoc, Nat.mul_comm, Nat.mul_left_comm]
+      rw [e' ((2 * (10 ^ 40 - 1)) ^ (c - 160))]
+    generalize hT1 : 10 ^ 18 * ((10 ^ 40 : Nat) ^ (c - 160) *
+      (m * 10000000000000000000000000003401 * (Sc * (10 ^ 31 - 3402)))) = T1 at eL ⊢
+    generalize hT2 : x * Sc * ((10 ^ 31 + 3401) * (10 ^ 31 - 3402) *
+      (10 ^ 40 : Nat) ^ (c - 160) * 2 ^ (c - 160) * 10 ^ 18) = T2 at eL hbf
+    generalize hT3 : x * Sc * (10 ^ 80 * (2 * (10 ^ 40 - 1)) ^ (c - 160)) = T3 at hbf eR
+    generalize hT4 : (2 * (10 ^ 40 - 1)) ^ (c - 160) *
+      (560227709747861399187319382270000000000000000000000000000000 *
+        (10 ^ 18 * 10 ^ 31)) * x = T4 at eR ⊢
+    omega
+
+/-- A-atom master for negative outputs, `m < S` branch, negative shift
+(exact mantissa). -/
+theorem an_lt_neg {m c x : Nat} {r : Int} (h1 : MLO ≤ m) (h2 : m < Sc)
+    (hc : 160 < c) (hc2 : c ≤ 255)
+    (hrlo : r * 2 ^ 72 ≤ toInt (x1W (zWord m)) * 7450580596923828125 + ln2kInt c +
+      116873961749927929127912020551506849476088469858172)
+    (hr : toInt (x1W (zWord m)) * 7450580596923828125 + ln2kInt c +
+      116873961749927929127912020551506849476088469858172 < (r + 1) * 2 ^ 72)
+    (hrneg : r < 0)
+    (hmx : m = x * 2 ^ (c - 160)) :
+    capLB ((-r).toNat * 2 ^ 99) QS (10 ^ 18) x := by
+  have cap1 := x1capLtUpF h1 h2
+  have hsum := capLB_mul cap1 (capLB_pow cap2L (c - 160))
+  have hX1 := x1_nonpos_ltF h1 h2
+  have hVs := v_scale_neg (toInt (x1W (zWord m))) c hc
+  have hsplit : (-toInt (x1W (zWord m))).toNat * 1000000000000000000000000000 +
+      (c - 160) * (LN2c * 2 ^ 27) =
+      ((-toInt (x1W (zWord m))).toNat * 1000000000000000000000000000 +
+        (c - 160) * (LN2c * 2 ^ 27) - BIASc * 2 ^ 27) + BIASc * 2 ^ 27 := by
+    have hX1n : (((-toInt (x1W (zWord m))).toNat : Nat) : Int) = -toInt (x1W (zWord m)) :=
+      Int.toNat_of_nonneg (by omega)
+    have hBc : ((BIASc * 2 ^ 27 : Nat) : Int) =
+        116873961749927929127912020551506849476088469858172 * 2 ^ 27 := by
+      decide +kernel
+    have hLc : (((c - 160) * (LN2c * 2 ^ 27) : Nat) : Int) =
+        ((c - 160 : Nat) : Int) * ((LN2c : Int) * 2 ^ 27) := by
+      simp only [Int.natCast_mul]
+      rfl
+    have hV0 : (toInt (x1W (zWord m)) * 7450580596923828125 + ln2kInt c +
+        116873961749927929127912020551506849476088469858172) * 2 ^ 27 ≤ 0 := by
+      have hVle : toInt (x1W (zWord m)) * 7450580596923828125 + ln2kInt c +
+          116873961749927929127912020551506849476088469858172 ≤ 0 := by
+        have hR : (r + 1) * 2 ^ 72 ≤ 0 := by
+          have hle : r + 1 ≤ 0 := by omega
+          have := mul_le_mul_right_nonneg hle (show (0 : Int) ≤ 2 ^ 72 by omega)
+          generalize hgT : (r + 1) * 2 ^ 72 = T at this ⊢
+          omega
+        generalize hgV' : toInt (x1W (zWord m)) * 7450580596923828125 + ln2kInt c +
+          116873961749927929127912020551506849476088469858172 = V at hr ⊢
+        clear cap1 hsum hX1 hVs hrlo h1 h2 hmx hX1n hBc hLc
+        omega
+      have := mul_le_mul_right_nonneg hVle (show (0 : Int) ≤ 2 ^ 27 by omega)
+      generalize hgV' : (toInt (x1W (zWord m)) * 7450580596923828125 + ln2kInt c +
+        116873961749927929127912020551506849476088469858172) * 2 ^ 27 = V27 at this ⊢
+      clear cap1 hsum hX1 hVs hrlo hr h1 h2 hmx hX1n hBc hLc
+      omega
+    generalize hgV : (toInt (x1W (zWord m)) * 7450580596923828125 + ln2kInt c +
+      116873961749927929127912020551506849476088469858172) * 2 ^ 27 = V27 at hV0 hVs
+    generalize hgA : toInt (x1W (zWord m)) * 1000000000000000000000000000 = A at hVs
+    generalize hgB : ((c - 160 : Nat) : Int) * ((LN2c : Int) * 2 ^ 27) = B at hVs hLc
+    generalize hgC : (c - 160) * (LN2c * 2 ^ 27) = Cn at hLc ⊢
+    generalize hgD : (-toInt (x1W (zWord m))).toNat * 1000000000000000000000000000 = D at ⊢
+    have hAD : (D : Int) = -A := by
+      rw [← hgA, ← hgD, Int.natCast_mul, hX1n]
+      rw [show (-toInt (x1W (zWord m))) * ((1000000000000000000000000000 : Nat) : Int) =
+        -(toInt (x1W (zWord m)) * ((1000000000000000000000000000 : Nat) : Int)) from by
+          rw [Int.neg_mul]]
+      rfl
+    generalize hgE : (BIASc * 2 ^ 27 : Nat) = E at hBc ⊢
+    clear hX1n hX1 cap1 hsum hr h1 h2 hc hc2 hmx hrlo hrneg
+    omega
+  rw [hsplit] at hsum
+  have capV := capLB_cancel QS_pos hsum capBU
+  have hple : (-toInt (x1W (zWord m))).toNat * 1000000000000000000000000000 +
+      (c - 160) * (LN2c * 2 ^ 27) - BIASc * 2 ^ 27 ≤ (-r).toNat * 2 ^ 99 := by
+    have hsc := mul_le_mul_right_nonneg hrlo (show (0 : Int) ≤ 2 ^ 27 by omega)
+    have hX1n : (((-toInt (x1W (zWord m))).toNat : Nat) : Int) = -toInt (x1W (zWord m)) :=
+      Int.toNat_of_nonneg (by omega)
+    have hBc : ((BIASc * 2 ^ 27 : Nat) : Int) =
+        116873961749927929127912020551506849476088469858172 * 2 ^ 27 := by
+      decide +kernel
+    have hLc : (((c - 160) * (LN2c * 2 ^ 27) : Nat) : Int) =
+        ((c - 160 : Nat) : Int) * ((LN2c : Int) * 2 ^ 27) := by
+      simp only [Int.natCast_mul]
+      rfl
+    have er : r * 2 ^ 72 * 2 ^ 27 = r * 2 ^ 99 := by
+      rw [Int.mul_assoc, show ((2 : Int) ^ 72 * 2 ^ 27) = 2 ^ 99 from by decide]
+    rw [er] at hsc
+    generalize hgV : (toInt (x1W (zWord m)) * 7450580596923828125 + ln2kInt c +
+      116873961749927929127912020551506849476088469858172) * 2 ^ 27 = V27 at hsc hVs
+    generalize hgA : toInt (x1W (zWord m)) * 1000000000000000000000000000 = A at hVs
+    generalize hgB : ((c - 160 : Nat) : Int) * ((LN2c : Int) * 2 ^ 27) = B at hVs hLc
+    generalize hgC : (c - 160) * (LN2c * 2 ^ 27) = Cn at hLc ⊢
+    generalize hgD : (-toInt (x1W (zWord m))).toNat * 1000000000000000000000000000 = D at ⊢
+    have hAD : (D : Int) = -A := by
+      rw [← hgA, ← hgD, Int.natCast_mul, hX1n]
+      rw [show (-toInt (x1W (zWord m))) * ((1000000000000000000000000000 : Nat) : Int) =
+        -(toInt (x1W (zWord m)) * ((1000000000000000000000000000 : Nat) : Int)) from by
+          rw [Int.neg_mul]]
+      rfl
+    generalize hgE : (BIASc * 2 ^ 27 : Nat) = E at hBc ⊢
+    clear hX1n hX1 cap1 hsum capV hr h1 h2 hc hc2 hmx hsplit hrlo
+    omega
+  have hmul : ((-toInt (x1W (zWord m))).toNat * 1000000000000000000000000000 +
+      (c - 160) * (LN2c * 2 ^ 27) - BIASc * 2 ^ 27) * QS ≤
+      (-r).toNat * 2 ^ 99 * QS :=
+    Nat.mul_le_mul_right _ hple
+  have capR := capLB_arg QS_pos hmul capV
+  refine capLB_weaken ?_ capR ?_
+  · have hm0 : 0 < m := by simp only [MLO] at h1; omega
+    have hScp : 0 < Sc := by simp only [Sc]; omega
+    exact Nat.mul_pos (Nat.mul_pos (Nat.mul_pos hm0 (by omega)) (Nat.pow_pos (by omega)))
+      (Nat.mul_pos hScp (by omega))
+  · have hbg := budgetUn_le (j := c - 160) (by omega)
+    have hbf := Nat.mul_le_mul_left (x * Sc) hbg
+    have eL : 10 ^ 18 * (m * 10000000000000000000000000003401 *
+        (10 ^ 40 : Nat) ^ (c - 160) * (Sc * (10 ^ 31 - 3402))) =
+        x * Sc * ((10 ^ 31 + 3401) * (10 ^ 31 - 3402) * (10 ^ 40 : Nat) ^ (c - 160) *
+          2 ^ (c - 160) * 10 ^ 18) := by
+      rw [hmx, show (10000000000000000000000000003401 : Nat) = 10 ^ 31 + 3401 from by decide]
+      simp only [Nat.mul_assoc, Nat.mul_comm, Nat.mul_left_comm]
+    have eR : 560227709747861399187319382270000000000000000000000000000000 *
+        (2 * (10 ^ 40 - 1)) ^ (c - 160) * (10 ^ 18 * 10 ^ 31) * x =
+        x * Sc * (10 ^ 80 * (2 * (10 ^ 40 - 1)) ^ (c - 160)) := by
+      rw [show (560227709747861399187319382270000000000000000000000000000000 : Nat) =
+        Sc * 10 ^ 31 from by decide]
+      have e' : ∀ P : Nat, (10 : Nat) ^ 18 * ((10 : Nat) ^ 31 * ((10 : Nat) ^ 31 * P)) =
+          (10 : Nat) ^ 80 * P := by
+        intro P
+        rw [← Nat.mul_assoc, ← Nat.mul_assoc,
+          show ((10 : Nat) ^ 18 * 10 ^ 31 * 10 ^ 31) = 10 ^ 80 from by decide]
+      simp only [Nat.mul_assoc, Nat.mul_comm, Nat.mul_left_comm]
+      rw [e' ((2 * (10 ^ 40 - 1)) ^ (c - 160))]
+    generalize hT1 : 10 ^ 18 * (m * 10000000000000000000000000003401 *
+      (10 ^ 40 : Nat) ^ (c - 160) * (Sc * (10 ^ 31 - 3402))) = T1 at eL ⊢
+    generalize hT2 : x * Sc * ((10 ^ 31 + 3401) * (10 ^ 31 - 3402) *
+      (10 ^ 40 : Nat) ^ (c - 160) * 2 ^ (c - 160) * 10 ^ 18) = T2 at eL hbf
+    generalize hT3 : x * Sc * (10 ^ 80 * (2 * (10 ^ 40 - 1)) ^ (c - 160)) = T3 at hbf eR
+    generalize hT4 : 560227709747861399187319382270000000000000000000000000000000 *
+      (2 * (10 ^ 40 - 1)) ^ (c - 160) * (10 ^ 18 * 10 ^ 31) * x = T4 at eR ⊢
+    omega
+
+/-- The reciprocal strict budget folds from the worst-case mantissa. -/
+theorem budgetB_fold {m k : Nat} (hm : 2 ^ 95 ≤ m) (hk : k ≤ 159) :
+    (m + 1) * 2 ^ k * ((10 : Nat) ^ 31 * (10 ^ 40 : Nat) ^ k * (10 ^ 18 * 10 ^ 31) *
+      10 ^ 31 * 10 ^ 31) ≤
+    m * (10 ^ 18 * (10 ^ 31 - 10) * (10 ^ 31 - 3401) * (2 * (10 ^ 40 - 1)) ^ k *
+      (10 ^ 31 - 3404) * (10 ^ 31 + 9990)) := by
+  have hb := budgetB_le (k := k) hk
+  have hcross : (m + 1) * 2 ^ 95 ≤ m * (2 ^ 95 + 1) := by
+    have e1 : (m + 1) * 2 ^ 95 = m * 2 ^ 95 + 2 ^ 95 := by
+      rw [Nat.add_mul, Nat.one_mul]
+    have e2 : m * (2 ^ 95 + 1) = m * 2 ^ 95 + m := by
+      rw [Nat.mul_add, Nat.mul_one]
+    omega
+  refine Nat.le_of_mul_le_mul_left ?_ (show 0 < 2 ^ 95 by decide)
+  calc 2 ^ 95 * ((m + 1) * 2 ^ k * ((10 : Nat) ^ 31 * (10 ^ 40 : Nat) ^ k *
+        (10 ^ 18 * 10 ^ 31) * 10 ^ 31 * 10 ^ 31))
+      = ((m + 1) * 2 ^ 95) * (2 ^ k * ((10 : Nat) ^ 31 * (10 ^ 40 : Nat) ^ k *
+          (10 ^ 18 * 10 ^ 31) * 10 ^ 31 * 10 ^ 31)) := by
+        simp only [Nat.mul_assoc, Nat.mul_comm, Nat.mul_left_comm]
+    _ ≤ (m * (2 ^ 95 + 1)) * (2 ^ k * ((10 : Nat) ^ 31 * (10 ^ 40 : Nat) ^ k *
+          (10 ^ 18 * 10 ^ 31) * 10 ^ 31 * 10 ^ 31)) :=
+        Nat.mul_le_mul_right _ hcross
+    _ = m * ((10 : Nat) ^ 31 * (10 ^ 40 : Nat) ^ k * (10 ^ 18 * 10 ^ 31) * 10 ^ 31 *
+          ((2 ^ 95 + 1) * 2 ^ k) * 10 ^ 31) := by
+        simp only [Nat.mul_assoc, Nat.mul_comm, Nat.mul_left_comm]
+    _ ≤ m * (10 ^ 18 * (10 ^ 31 - 10) * 2 ^ 95 * (10 ^ 31 - 3401) *
+          (2 * (10 ^ 40 - 1)) ^ k * (10 ^ 31 - 3404) * (10 ^ 31 + 9990)) :=
+        Nat.mul_le_mul_left _ hb
+    _ = 2 ^ 95 * (m * (10 ^ 18 * (10 ^ 31 - 10) * (10 ^ 31 - 3401) *
+          (2 * (10 ^ 40 - 1)) ^ k * (10 ^ 31 - 3404) * (10 ^ 31 + 9990))) := by
+        simp only [Nat.mul_assoc, Nat.mul_comm, Nat.mul_left_comm]
+
+/-- B-atom master for `r + 2 ≤ 0`, `m < S` branch, `k ≥ 0`. -/
+theorem bn_lt_pos {m c x : Nat} {r : Int} (h1 : MLO ≤ m) (h2 : m < Sc)
+    (hc1 : 1 ≤ c) (hc : c ≤ 160)
+    (hr : toInt (x1W (zWord m)) * 7450580596923828125 + ln2kInt c +
+      116873961749927929127912020551506849476088469858172 < (r + 1) * 2 ^ 72)
+    (hrneg : r + 2 ≤ 0)
+    (hxm : x < (m + 1) * 2 ^ (160 - c)) :
+    capUB ((-(r + 2)).toNat * 2 ^ 99) QS (10 ^ 18 * (10 ^ 31 - 10)) (x * 10 ^ 31) := by
+  have cap1 := x1capLtLoF h1 h2
+  have hb := capLB_mul (capLB_mul (capLB_pow cap2L (160 - c)) capBL) capEL
+  have hX1 := x1_nonpos_ltF h1 h2
+  have hVs := v_scale_pos (toInt (x1W (zWord m))) c hc
+  -- the exponent gap: -V·2^27 ≥ (|r+2|+1)·2^99 + 2^27
+  have hgap : (toInt (x1W (zWord m)) * 7450580596923828125 + ln2kInt c +
+      116873961749927929127912020551506849476088469858172) * 2 ^ 27 ≤
+      (r + 1) * 2 ^ 99 - 2 ^ 27 := by
+    have hsc := mul_le_mul_right_nonneg
+      (show toInt (x1W (zWord m)) * 7450580596923828125 + ln2kInt c +
+        116873961749927929127912020551506849476088469858172 ≤ (r + 1) * 2 ^ 72 - 1
+        from by omega) (show (0 : Int) ≤ 2 ^ 27 by omega)
+    have er : ((r + 1) * 2 ^ 72 - 1) * 2 ^ 27 = (r + 1) * 2 ^ 99 - 2 ^ 27 := by
+      rw [Int.sub_mul, Int.mul_assoc, show ((2 : Int) ^ 72 * 2 ^ 27) = 2 ^ 99 from
+        by decide]
+      omega
+    rw [er] at hsc
+    exact hsc
+  have hsplit : (-toInt (x1W (zWord m))).toNat * 1000000000000000000000000000 =
+      ((-toInt (x1W (zWord m))).toNat * 1000000000000000000000000000 -
+        ((160 - c) * (LN2c * 2 ^ 27) + BIASc * 2 ^ 27 + 2 ^ 99)) +
+        ((160 - c) * (LN2c * 2 ^ 27) + BIASc * 2 ^ 27 + 2 ^ 99) := by
+    have hX1n : (((-toInt (x1W (zWord m))).toNat : Nat) : Int) = -toInt (x1W (zWord m)) :=
+      Int.toNat_of_nonneg (by omega)
+    have hBc : ((BIASc * 2 ^ 27 : Nat) : Int) =
+        116873961749927929127912020551506849476088469858172 * 2 ^ 27 := by
+      decide +kernel
+    have hLc : (((160 - c) * (LN2c * 2 ^ 27) : Nat) : Int) =
+        ((160 - c : Nat) : Int) * ((LN2c : Int) * 2 ^ 27) := by
+      simp only [Int.natCast_mul]
+      rfl
+    have hr99 : (r + 1) * 2 ^ 99 ≤ -(2 ^ 99) := by
+      have hle : r + 1 ≤ -1 := by omega
+      have := mul_le_mul_right_nonneg hle (show (0 : Int) ≤ 2 ^ 99 by omega)
+      generalize hgT : (r + 1) * 2 ^ 99 = T at this ⊢
+      omega
+    generalize hgV : (toInt (x1W (zWord m)) * 7450580596923828125 + ln2kInt c +
+      116873961749927929127912020551506849476088469858172) * 2 ^ 27 = V27 at hgap hVs
+    generalize hgA : toInt (x1W (zWord m)) * 1000000000000000000000000000 = A at hVs
+    generalize hgB : ((160 - c : Nat) : Int) * ((LN2c : Int) * 2 ^ 27) = B at hVs hLc
+    generalize hgC : (160 - c) * (LN2c * 2 ^ 27) = Cn at hLc ⊢
+    generalize hgD : (-toInt (x1W (zWord m))).toNat * 1000000000000000000000000000 = D at ⊢
+    have hAD : (D : Int) = -A := by
+      rw [← hgA, ← hgD, Int.natCast_mul, hX1n]
+      rw [show (-toInt (x1W (zWord m))) * ((1000000000000000000000000000 : Nat) : Int) =
+        -(toInt (x1W (zWord m)) * ((1000000000000000000000000000 : Nat) : Int)) from by
+          rw [Int.neg_mul]]
+      rfl
+    generalize hgE : (BIASc * 2 ^ 27 : Nat) = E at hBc ⊢
+    generalize hgR : (r + 1) * 2 ^ 99 = R99 at hgap hr99
+    clear hX1n hX1 cap1 hb hr h1 h2 hc hc1 hxm hrneg
+    omega
+  rw [hsplit] at cap1
+  have capV := capUB_cancel QS_pos cap1 hb
+  have hple : (-(r + 2)).toNat * 2 ^ 99 ≤
+      (-toInt (x1W (zWord m))).toNat * 1000000000000000000000000000 -
+        ((160 - c) * (LN2c * 2 ^ 27) + BIASc * 2 ^ 27 + 2 ^ 99) := by
+    have hX1n : (((-toInt (x1W (zWord m))).toNat : Nat) : Int) = -toInt (x1W (zWord m)) :=
+      Int.toNat_of_nonneg (by omega)
+    have hBc : ((BIASc * 2 ^ 27 : Nat) : Int) =
+        116873961749927929127912020551506849476088469858172 * 2 ^ 27 := by
+      decide +kernel
+    have hLc : (((160 - c) * (LN2c * 2 ^ 27) : Nat) : Int) =
+        ((160 - c : Nat) : Int) * ((LN2c : Int) * 2 ^ 27) := by
+      simp only [Int.natCast_mul]
+      rfl
+    generalize hgV : (toInt (x1W (zWord m)) * 7450580596923828125 + ln2kInt c +
+      116873961749927929127912020551506849476088469858172) * 2 ^ 27 = V27 at hgap hVs
+    generalize hgA : toInt (x1W (zWord m)) * 1000000000000000000000000000 = A at hVs
+    generalize hgB : ((160 - c : Nat) : Int) * ((LN2c : Int) * 2 ^ 27) = B at hVs hLc
+    generalize hgC : (160 - c) * (LN2c * 2 ^ 27) = Cn at hLc ⊢
+    generalize hgD : (-toInt (x1W (zWord m))).toNat * 1000000000000000000000000000 = D at ⊢
+    have hAD : (D : Int) = -A := by
+      rw [← hgA, ← hgD, Int.natCast_mul, hX1n]
+      rw [show (-toInt (x1W (zWord m))) * ((1000000000000000000000000000 : Nat) : Int) =
+        -(toInt (x1W (zWord m)) * ((1000000000000000000000000000 : Nat) : Int)) from by
+          rw [Int.neg_mul]]
+      rfl
+    generalize hgE : (BIASc * 2 ^ 27 : Nat) = E at hBc ⊢
+    have hr99 : (r + 1) * 2 ^ 99 = r * 2 ^ 99 + 2 ^ 99 := by
+      rw [Int.add_mul, Int.one_mul]
+    generalize hgR : (r + 1) * 2 ^ 99 = R99 at hgap hr99
+    generalize hgr : r * 2 ^ 99 = R at hr99
+    clear hX1n hX1 cap1 hb capV hr h1 h2 hc hc1 hxm hsplit
+    omega
+  have hmul : (-(r + 2)).toNat * 2 ^ 99 * QS ≤
+      ((-toInt (x1W (zWord m))).toNat * 1000000000000000000000000000 -
+        ((160 - c) * (LN2c * 2 ^ 27) + BIASc * 2 ^ 27 + 2 ^ 99)) * QS :=
+    Nat.mul_le_mul_right _ hple
+  have capR := capUB_arg QS_pos hmul capV
+  refine capUB_weaken ?_ capR ?_
+  · have hm0 : 0 < m := by simp only [MLO] at h1; omega
+    exact Nat.mul_pos (Nat.mul_pos hm0 (by omega))
+      (Nat.mul_pos (Nat.mul_pos (Nat.pow_pos (by omega)) (by omega)) (by omega))
+  · have hMLO : 2 ^ 95 ≤ m := by
+      simp only [MLO] at h1
+      omega
+    have hbf := budgetB_fold (k := 160 - c) hMLO (by omega)
+    have hScf := Nat.mul_le_mul_left Sc hbf
+    have hx1 : x + 1 ≤ (m + 1) * 2 ^ (160 - c) := by omega
+    have hxw : (x + 1) * (Sc * ((10 : Nat) ^ 31 * (10 ^ 40 : Nat) ^ (160 - c) *
+        (10 ^ 18 * 10 ^ 31) * 10 ^ 31 * 10 ^ 31)) ≤
+        (m + 1) * 2 ^ (160 - c) * (Sc * ((10 : Nat) ^ 31 * (10 ^ 40 : Nat) ^ (160 - c) *
+          (10 ^ 18 * 10 ^ 31) * 10 ^ 31 * 10 ^ 31)) :=
+      Nat.mul_le_mul_right _ hx1
+    have eSc1 : Sc * ((m + 1) * 2 ^ (160 - c) * ((10 : Nat) ^ 31 *
+        (10 ^ 40 : Nat) ^ (160 - c) * (10 ^ 18 * 10 ^ 31) * 10 ^ 31 * 10 ^ 31)) =
+        (m + 1) * 2 ^ (160 - c) * (Sc * ((10 : Nat) ^ 31 * (10 ^ 40 : Nat) ^ (160 - c) *
+          (10 ^ 18 * 10 ^ 31) * 10 ^ 31 * 10 ^ 31)) := by
+      simp only [Nat.mul_assoc, Nat.mul_comm, Nat.mul_left_comm]
+    have eSc2 : Sc * (m * (10 ^ 18 * (10 ^ 31 - 10) * (10 ^ 31 - 3401) *
+        (2 * (10 ^ 40 - 1)) ^ (160 - c) * (10 ^ 31 - 3404) * (10 ^ 31 + 9990))) =
+        m * (Sc * (10 ^ 18 * (10 ^ 31 - 10) * (10 ^ 31 - 3401) *
+          (2 * (10 ^ 40 - 1)) ^ (160 - c) * (10 ^ 31 - 3404) * (10 ^ 31 + 9990))) := by
+      simp only [Nat.mul_assoc, Nat.mul_left_comm]
+    rw [eSc1, eSc2] at hScf
+    have eL : 560227709747861399187319382270000000000000000000000000000000 *
+        ((10 ^ 40 : Nat) ^ (160 - c) * (10 ^ 18 * 10 ^ 31) * 10 ^ 31) * (x * 10 ^ 31) ≤
+        (x + 1) * (Sc * ((10 : Nat) ^ 31 * (10 ^ 40 : Nat) ^ (160 - c) *
+          (10 ^ 18 * 10 ^ 31) * 10 ^ 31 * 10 ^ 31)) := by
+      rw [show (560227709747861399187319382270000000000000000000000000000000 : Nat) =
+        Sc * 10 ^ 31 from by decide]
+      have eAC : Sc * 10 ^ 31 * ((10 ^ 40 : Nat) ^ (160 - c) * (10 ^ 18 * 10 ^ 31) *
+          10 ^ 31) * (x * 10 ^ 31) =
+          x * (Sc * ((10 : Nat) ^ 31 * (10 ^ 40 : Nat) ^ (160 - c) *
+            (10 ^ 18 * 10 ^ 31) * 10 ^ 31 * 10 ^ 31)) := by
+        simp only [Nat.mul_assoc, Nat.mul_comm, Nat.mul_left_comm]
+      rw [eAC]
+      exact Nat.mul_le_mul_right _ (by omega)
+    have eR : m * (Sc * (10 ^ 18 * (10 ^ 31 - 10) * (10 ^ 31 - 3401) *
+        (2 * (10 ^ 40 - 1)) ^ (160 - c) * (10 ^ 31 - 3404) * (10 ^ 31 + 9990))) =
+        10 ^ 18 * (10 ^ 31 - 10) * (m * 9999999999999999999999999996599 *
+          ((2 * (10 ^ 40 - 1)) ^ (160 - c) * (Sc * (10 ^ 31 - 3404)) * (10 ^ 31 + 9990))) := by
+      rw [show (9999999999999999999999999996599 : Nat) = 10 ^ 31 - 3401 from by decide]
+      simp only [Nat.mul_assoc, Nat.mul_left_comm]
+    generalize hT1 : 560227709747861399187319382270000000000000000000000000000000 *
+      ((10 ^ 40 : Nat) ^ (160 - c) * (10 ^ 18 * 10 ^ 31) * 10 ^ 31) * (x * 10 ^ 31) = T1
+      at eL ⊢
+    generalize hT2 : (x + 1) * (Sc * ((10 : Nat) ^ 31 * (10 ^ 40 : Nat) ^ (160 - c) *
+      (10 ^ 18 * 10 ^ 31) * 10 ^ 31 * 10 ^ 31)) = T2 at eL hxw
+    generalize hT3 : (m + 1) * 2 ^ (160 - c) * (Sc * ((10 : Nat) ^ 31 *
+      (10 ^ 40 : Nat) ^ (160 - c) * (10 ^ 18 * 10 ^ 31) * 10 ^ 31 * 10 ^ 31)) = T3
+      at hxw hScf
+    generalize hT4 : m * (Sc * (10 ^ 18 * (10 ^ 31 - 10) * (10 ^ 31 - 3401) *
+      (2 * (10 ^ 40 - 1)) ^ (160 - c) * (10 ^ 31 - 3404) * (10 ^ 31 + 9990))) = T4
+      at hScf eR
+    generalize hT5 : 10 ^ 18 * (10 ^ 31 - 10) * (m * 9999999999999999999999999996599 *
+      ((2 * (10 ^ 40 - 1)) ^ (160 - c) * (Sc * (10 ^ 31 - 3404)) * (10 ^ 31 + 9990))) = T5
+      at eR ⊢
+    omega
+
+/-- B-atom master for `r + 2 ≤ 0`, `m ≥ S` branch, negative shift
+(exact mantissa). -/
+theorem bn_ge_neg {m c x : Nat} {r : Int} (h1 : Sc ≤ m) (h2 : m < MHI)
+    (hc : 160 < c) (hc2 : c ≤ 255)
+    (hr : toInt (x1W (zWord m)) * 7450580596923828125 + ln2kInt c +
+      116873961749927929127912020551506849476088469858172 < (r + 1) * 2 ^ 72)
+    (hrneg : r + 2 ≤ 0)
+    (hmx : m = x * 2 ^ (c - 160)) :
+    capUB ((-(r + 2)).toNat * 2 ^ 99) QS (10 ^ 18 * (10 ^ 31 - 10)) (x * 10 ^ 31) := by
+  have cap1 := x1capGeLoF h1 h2
+  have hb := capLB_mul (capLB_mul cap1 capBL) capEL
+  have hsum := capUB_pow QS_pos cap2U (c - 160)
+  have hX1 := x1_nonneg_geF h1 h2
+  have hVs := v_scale_neg (toInt (x1W (zWord m))) c hc
+  have hgap : (toInt (x1W (zWord m)) * 7450580596923828125 + ln2kInt c +
+      116873961749927929127912020551506849476088469858172) * 2 ^ 27 ≤
+      (r + 1) * 2 ^ 99 - 2 ^ 27 := by
+    have hsc := mul_le_mul_right_nonneg
+      (show toInt (x1W (zWord m)) * 7450580596923828125 + ln2kInt c +
+        116873961749927929127912020551506849476088469858172 ≤ (r + 1) * 2 ^ 72 - 1
+        from by omega) (show (0 : Int) ≤ 2 ^ 27 by omega)
+    have er : ((r + 1) * 2 ^ 72 - 1) * 2 ^ 27 = (r + 1) * 2 ^ 99 - 2 ^ 27 := by
+      rw [Int.sub_mul, Int.mul_assoc, show ((2 : Int) ^ 72 * 2 ^ 27) = 2 ^ 99 from
+        by decide]
+      omega
+    rw [er] at hsc
+    exact hsc
+  have hsplit : (c - 160) * (LN2c * 2 ^ 27) =
+      ((c - 160) * (LN2c * 2 ^ 27) -
+        ((toInt (x1W (zWord m))).toNat * 1000000000000000000000000000 +
+          BIASc * 2 ^ 27 + 2 ^ 99)) +
+        ((toInt (x1W (zWord m))).toNat * 1000000000000000000000000000 +
+          BIASc * 2 ^ 27 + 2 ^ 99) := by
+    have hX1n : ((toInt (x1W (zWord m))).toNat : Int) = toInt (x1W (zWord m)) :=
+      Int.toNat_of_nonneg hX1
+    have hBc : ((BIASc * 2 ^ 27 : Nat) : Int) =
+        116873961749927929127912020551506849476088469858172 * 2 ^ 27 := by
+      decide +kernel
+    have hLc : (((c - 160) * (LN2c * 2 ^ 27) : Nat) : Int) =
+        ((c - 160 : Nat) : Int) * ((LN2c : Int) * 2 ^ 27) := by
+      simp only [Int.natCast_mul]
+      rfl
+    have hr99 : (r + 1) * 2 ^ 99 ≤ -(2 ^ 99) := by
+      have hle : r + 1 ≤ -1 := by omega
+      have := mul_le_mul_right_nonneg hle (show (0 : Int) ≤ 2 ^ 99 by omega)
+      generalize hgT : (r + 1) * 2 ^ 99 = T at this ⊢
+      omega
+    generalize hgV : (toInt (x1W (zWord m)) * 7450580596923828125 + ln2kInt c +
+      116873961749927929127912020551506849476088469858172) * 2 ^ 27 = V27 at hgap hVs
+    generalize hgA : toInt (x1W (zWord m)) * 1000000000000000000000000000 = A at hVs
+    generalize hgB : ((c - 160 : Nat) : Int) * ((LN2c : Int) * 2 ^ 27) = B at hVs hLc
+    generalize hgC : (c - 160) * (LN2c * 2 ^ 27) = Cn at hLc ⊢
+    generalize hgD : (toInt (x1W (zWord m))).toNat * 1000000000000000000000000000 = D at ⊢
+    have hAD : (D : Int) = A := by
+      rw [← hgA, ← hgD, Int.natCast_mul, hX1n]
+      rfl
+    generalize hgE : (BIASc * 2 ^ 27 : Nat) = E at hBc ⊢
+    generalize hgR : (r + 1) * 2 ^ 99 = R99 at hgap hr99
+    clear hX1n hX1 cap1 hb hsum hr h1 h2 hc hc2 hmx hrneg
+    omega
+  rw [hsplit] at hsum
+  have capV := capUB_cancel QS_pos hsum hb
+  have hple : (-(r + 2)).toNat * 2 ^ 99 ≤
+      (c - 160) * (LN2c * 2 ^ 27) -
+        ((toInt (x1W (zWord m))).toNat * 1000000000000000000000000000 +
+          BIASc * 2 ^ 27 + 2 ^ 99) := by
+    have hX1n : ((toInt (x1W (zWord m))).toNat : Int) = toInt (x1W (zWord m)) :=
+      Int.toNat_of_nonneg hX1
+    have hBc : ((BIASc * 2 ^ 27 : Nat) : Int) =
+        116873961749927929127912020551506849476088469858172 * 2 ^ 27 := by
+      decide +kernel
+    have hLc : (((c - 160) * (LN2c * 2 ^ 27) : Nat) : Int) =
+        ((c - 160 : Nat) : Int) * ((LN2c : Int) * 2 ^ 27) := by
+      simp only [Int.natCast_mul]
+      rfl
+    generalize hgV : (toInt (x1W (zWord m)) * 7450580596923828125 + ln2kInt c +
+      116873961749927929127912020551506849476088469858172) * 2 ^ 27 = V27 at hgap hVs
+    generalize hgA : toInt (x1W (zWord m)) * 1000000000000000000000000000 = A at hVs
+    generalize hgB : ((c - 160 : Nat) : Int) * ((LN2c : Int) * 2 ^ 27) = B at hVs hLc
+    generalize hgC : (c - 160) * (LN2c * 2 ^ 27) = Cn at hLc ⊢
+    generalize hgD : (toInt (x1W (zWord m))).toNat * 1000000000000000000000000000 = D at ⊢
+    have hAD : (D : Int) = A := by
+      rw [← hgA, ← hgD, Int.natCast_mul, hX1n]
+      rfl
+    generalize hgE : (BIASc * 2 ^ 27 : Nat) = E at hBc ⊢
+    have hr99 : (r + 1) * 2 ^ 99 = r * 2 ^ 99 + 2 ^ 99 := by
+      rw [Int.add_mul, Int.one_mul]
+    generalize hgR : (r + 1) * 2 ^ 99 = R99 at hgap hr99
+    generalize hgr : r * 2 ^ 99 = R at hr99
+    clear hX1n hX1 cap1 hb hsum capV hr h1 h2 hc hc2 hmx hsplit
+    omega
+  have hmul : (-(r + 2)).toNat * 2 ^ 99 * QS ≤
+      ((c - 160) * (LN2c * 2 ^ 27) -
+        ((toInt (x1W (zWord m))).toNat * 1000000000000000000000000000 +
+          BIASc * 2 ^ 27 + 2 ^ 99)) * QS :=
+    Nat.mul_le_mul_right _ hple
+  have capR := capUB_arg QS_pos hmul capV
+  refine capUB_weaken ?_ capR ?_
+  · have hm0 : 0 < m := by simp only [Sc] at h1; omega
+    have hScp : 0 < Sc := by simp only [Sc]; omega
+    exact Nat.mul_pos (Nat.pow_pos (by omega))
+      (Nat.mul_pos (Nat.mul_pos (Nat.mul_pos hm0 (by omega))
+        (Nat.mul_pos hScp (by omega))) (by omega))
+  · have hbg := budgetBn_le (j := c - 160) (by omega)
+    have hbf := Nat.mul_le_mul_left (x * Sc) hbg
+    have eL : (2 * (10 ^ 40 + 1)) ^ (c - 160) *
+        (560227709747861399187319382270000000000000000000000000000000 *
+          (10 ^ 18 * 10 ^ 31) * 10 ^ 31) * (x * 10 ^ 31) =
+        x * Sc * ((2 * (10 ^ 40 + 1)) ^ (c - 160) * (10 : Nat) ^ 31 *
+          (10 ^ 18 * 10 ^ 31) * 10 ^ 31 * 10 ^ 31) := by
+      rw [show (560227709747861399187319382270000000000000000000000000000000 : Nat) =
+        Sc * 10 ^ 31 from by decide]
+      simp only [Nat.mul_assoc, Nat.mul_comm, Nat.mul_left_comm]
+    have eR : 10 ^ 18 * (10 ^ 31 - 10) * ((10 ^ 40 : Nat) ^ (c - 160) *
+        (m * 9999999999999999999999999996599 * (Sc * (10 ^ 31 - 3404)) *
+          (10 ^ 31 + 9990))) =
+        x * Sc * (10 ^ 18 * (10 ^ 31 - 10) * (10 ^ 40 : Nat) ^ (c - 160) * 2 ^ (c - 160) *
+          (10 ^ 31 - 3401) * (10 ^ 31 - 3404) * (10 ^ 31 + 9990)) := by
+      rw [hmx, show (9999999999999999999999999996599 : Nat) = 10 ^ 31 - 3401 from by decide]
+      simp only [Nat.mul_assoc, Nat.mul_comm, Nat.mul_left_comm]
+    generalize hT1 : (2 * (10 ^ 40 + 1)) ^ (c - 160) *
+      (560227709747861399187319382270000000000000000000000000000000 *
+        (10 ^ 18 * 10 ^ 31) * 10 ^ 31) * (x * 10 ^ 31) = T1 at eL ⊢
+    generalize hT2 : x * Sc * ((2 * (10 ^ 40 + 1)) ^ (c - 160) * (10 : Nat) ^ 31 *
+      (10 ^ 18 * 10 ^ 31) * 10 ^ 31 * 10 ^ 31) = T2 at eL hbf
+    generalize hT3 : x * Sc * (10 ^ 18 * (10 ^ 31 - 10) * (10 ^ 40 : Nat) ^ (c - 160) *
+      2 ^ (c - 160) * (10 ^ 31 - 3401) * (10 ^ 31 - 3404) * (10 ^ 31 + 9990)) = T3 at eR hbf
+    generalize hT4 : 10 ^ 18 * (10 ^ 31 - 10) * ((10 ^ 40 : Nat) ^ (c - 160) *
+      (m * 9999999999999999999999999996599 * (Sc * (10 ^ 31 - 3404)) *
+        (10 ^ 31 + 9990))) = T4 at eR ⊢
+    omega
+
+/-- B-atom master for `r + 2 ≤ 0`, `m < S` branch, negative shift
+(exact mantissa). -/
+theorem bn_lt_neg {m c x : Nat} {r : Int} (h1 : MLO ≤ m) (h2 : m < Sc)
+    (hc : 160 < c) (hc2 : c ≤ 255)
+    (hr : toInt (x1W (zWord m)) * 7450580596923828125 + ln2kInt c +
+      116873961749927929127912020551506849476088469858172 < (r + 1) * 2 ^ 72)
+    (hrneg : r + 2 ≤ 0)
+    (hmx : m = x * 2 ^ (c - 160)) :
+    capUB ((-(r + 2)).toNat * 2 ^ 99) QS (10 ^ 18 * (10 ^ 31 - 10)) (x * 10 ^ 31) := by
+  have cap1 := x1capLtLoF h1 h2
+  have hsum := capUB_mul QS_pos cap1 (capUB_pow QS_pos cap2U (c - 160))
+  have hb := capLB_mul capBL capEL
+  have hX1 := x1_nonpos_ltF h1 h2
+  have hVs := v_scale_neg (toInt (x1W (zWord m))) c hc
+  have hgap : (toInt (x1W (zWord m)) * 7450580596923828125 + ln2kInt c +
+      116873961749927929127912020551506849476088469858172) * 2 ^ 27 ≤
+      (r + 1) * 2 ^ 99 - 2 ^ 27 := by
+    have hsc := mul_le_mul_right_nonneg
+      (show toInt (x1W (zWord m)) * 7450580596923828125 + ln2kInt c +
+        116873961749927929127912020551506849476088469858172 ≤ (r + 1) * 2 ^ 72 - 1
+        from by omega) (show (0 : Int) ≤ 2 ^ 27 by omega)
+    have er : ((r + 1) * 2 ^ 72 - 1) * 2 ^ 27 = (r + 1) * 2 ^ 99 - 2 ^ 27 := by
+      rw [Int.sub_mul, Int.mul_assoc, show ((2 : Int) ^ 72 * 2 ^ 27) = 2 ^ 99 from
+        by decide]
+      omega
+    rw [er] at hsc
+    exact hsc
+  have hsplit : (-toInt (x1W (zWord m))).toNat * 1000000000000000000000000000 +
+      (c - 160) * (LN2c * 2 ^ 27) =
+      ((-toInt (x1W (zWord m))).toNat * 1000000000000000000000000000 +
+        (c - 160) * (LN2c * 2 ^ 27) - (BIASc * 2 ^ 27 + 2 ^ 99)) +
+        (BIASc * 2 ^ 27 + 2 ^ 99) := by
+    have hX1n : (((-toInt (x1W (zWord m))).toNat : Nat) : Int) = -toInt (x1W (zWord m)) :=
+      Int.toNat_of_nonneg (by omega)
+    have hBc : ((BIASc * 2 ^ 27 : Nat) : Int) =
+        116873961749927929127912020551506849476088469858172 * 2 ^ 27 := by
+      decide +kernel
+    have hLc : (((c - 160) * (LN2c * 2 ^ 27) : Nat) : Int) =
+        ((c - 160 : Nat) : Int) * ((LN2c : Int) * 2 ^ 27) := by
+      simp only [Int.natCast_mul]
+      rfl
+    have hr99 : (r + 1) * 2 ^ 99 ≤ -(2 ^ 99) := by
+      have hle : r + 1 ≤ -1 := by omega
+      have := mul_le_mul_right_nonneg hle (show (0 : Int) ≤ 2 ^ 99 by omega)
+      generalize hgT : (r + 1) * 2 ^ 99 = T at this ⊢
+      omega
+    generalize hgV : (toInt (x1W (zWord m)) * 7450580596923828125 + ln2kInt c +
+      116873961749927929127912020551506849476088469858172) * 2 ^ 27 = V27 at hgap hVs
+    generalize hgA : toInt (x1W (zWord m)) * 1000000000000000000000000000 = A at hVs
+    generalize hgB : ((c - 160 : Nat) : Int) * ((LN2c : Int) * 2 ^ 27) = B at hVs hLc
+    generalize hgC : (c - 160) * (LN2c * 2 ^ 27) = Cn at hLc ⊢
+    generalize hgD : (-toInt (x1W (zWord m))).toNat * 1000000000000000000000000000 = D at ⊢
+    have hAD : (D : Int) = -A := by
+      rw [← hgA, ← hgD, Int.natCast_mul, hX1n]
+      rw [show (-toInt (x1W (zWord m))) * ((1000000000000000000000000000 : Nat) : Int) =
+        -(toInt (x1W (zWord m)) * ((1000000000000000000000000000 : Nat) : Int)) from by
+          rw [Int.neg_mul]]
+      rfl
+    generalize hgE : (BIASc * 2 ^ 27 : Nat) = E at hBc ⊢
+    generalize hgR : (r + 1) * 2 ^ 99 = R99 at hgap hr99
+    clear hX1n hX1 cap1 hsum hb hr h1 h2 hc hc2 hmx hrneg
+    omega
+  rw [hsplit] at hsum
+  have capV := capUB_cancel QS_pos hsum hb
+  have hple : (-(r + 2)).toNat * 2 ^ 99 ≤
+      (-toInt (x1W (zWord m))).toNat * 1000000000000000000000000000 +
+        (c - 160) * (LN2c * 2 ^ 27) - (BIASc * 2 ^ 27 + 2 ^ 99) := by
+    have hX1n : (((-toInt (x1W (zWord m))).toNat : Nat) : Int) = -toInt (x1W (zWord m)) :=
+      Int.toNat_of_nonneg (by omega)
+    have hBc : ((BIASc * 2 ^ 27 : Nat) : Int) =
+        116873961749927929127912020551506849476088469858172 * 2 ^ 27 := by
+      decide +kernel
+    have hLc : (((c - 160) * (LN2c * 2 ^ 27) : Nat) : Int) =
+        ((c - 160 : Nat) : Int) * ((LN2c : Int) * 2 ^ 27) := by
+      simp only [Int.natCast_mul]
+      rfl
+    generalize hgV : (toInt (x1W (zWord m)) * 7450580596923828125 + ln2kInt c +
+      116873961749927929127912020551506849476088469858172) * 2 ^ 27 = V27 at hgap hVs
+    generalize hgA : toInt (x1W (zWord m)) * 1000000000000000000000000000 = A at hVs
+    generalize hgB : ((c - 160 : Nat) : Int) * ((LN2c : Int) * 2 ^ 27) = B at hVs hLc
+    generalize hgC : (c - 160) * (LN2c * 2 ^ 27) = Cn at hLc ⊢
+    generalize hgD : (-toInt (x1W (zWord m))).toNat * 1000000000000000000000000000 = D at ⊢
+    have hAD : (D : Int) = -A := by
+      rw [← hgA, ← hgD, Int.natCast_mul, hX1n]
+      rw [show (-toInt (x1W (zWord m))) * ((1000000000000000000000000000 : Nat) : Int) =
+        -(toInt (x1W (zWord m)) * ((1000000000000000000000000000 : Nat) : Int)) from by
+          rw [Int.neg_mul]]
+      rfl
+    generalize hgE : (BIASc * 2 ^ 27 : Nat) = E at hBc ⊢
+    have hr99 : (r + 1) * 2 ^ 99 = r * 2 ^ 99 + 2 ^ 99 := by
+      rw [Int.add_mul, Int.one_mul]
+    generalize hgR : (r + 1) * 2 ^ 99 = R99 at hgap hr99
+    generalize hgr : r * 2 ^ 99 = R at hr99
+    clear hX1n hX1 cap1 hsum hb capV hr h1 h2 hc hc2 hmx hsplit
+    omega
+  have hmul : (-(r + 2)).toNat * 2 ^ 99 * QS ≤
+      ((-toInt (x1W (zWord m))).toNat * 1000000000000000000000000000 +
+        (c - 160) * (LN2c * 2 ^ 27) - (BIASc * 2 ^ 27 + 2 ^ 99)) * QS :=
+    Nat.mul_le_mul_right _ hple
+  have capR := capUB_arg QS_pos hmul capV
+  refine capUB_weaken ?_ capR ?_
+  · have hm0 : 0 < m := by simp only [MLO] at h1; omega
+    have hScp : 0 < Sc := by simp only [Sc]; omega
+    exact Nat.mul_pos
+      (Nat.mul_pos (Nat.mul_pos hm0 (by omega)) (Nat.pow_pos (by omega)))
+      (Nat.mul_pos (Nat.mul_pos hScp (by omega)) (by omega))
+  · have hbg := budgetBn_le (j := c - 160) (by omega)
+    have hbf := Nat.mul_le_mul_left (x * Sc) hbg
+    have eL : 560227709747861399187319382270000000000000000000000000000000 *
+        (2 * (10 ^ 40 + 1)) ^ (c - 160) * ((10 ^ 18 * 10 ^ 31) * 10 ^ 31) *
+        (x * 10 ^ 31) =
+        x * Sc * ((2 * (10 ^ 40 + 1)) ^ (c - 160) * (10 : Nat) ^ 31 *
+          (10 ^ 18 * 10 ^ 31) * 10 ^ 31 * 10 ^ 31) := by
+      rw [show (560227709747861399187319382270000000000000000000000000000000 : Nat) =
+        Sc * 10 ^ 31 from by decide]
+      simp only [Nat.mul_assoc, Nat.mul_comm, Nat.mul_left_comm]
+    have eR : 10 ^ 18 * (10 ^ 31 - 10) * (m * 9999999999999999999999999996599 *
+        (10 ^ 40 : Nat) ^ (c - 160) * (Sc * (10 ^ 31 - 3404) * (10 ^ 31 + 9990))) =
+        x * Sc * (10 ^ 18 * (10 ^ 31 - 10) * (10 ^ 40 : Nat) ^ (c - 160) * 2 ^ (c - 160) *
+          (10 ^ 31 - 3401) * (10 ^ 31 - 3404) * (10 ^ 31 + 9990)) := by
+      rw [hmx, show (9999999999999999999999999996599 : Nat) = 10 ^ 31 - 3401 from by decide]
+      simp only [Nat.mul_assoc, Nat.mul_comm, Nat.mul_left_comm]
+    generalize hT1 : 560227709747861399187319382270000000000000000000000000000000 *
+      (2 * (10 ^ 40 + 1)) ^ (c - 160) * ((10 ^ 18 * 10 ^ 31) * 10 ^ 31) *
+      (x * 10 ^ 31) = T1 at eL ⊢
+    generalize hT2 : x * Sc * ((2 * (10 ^ 40 + 1)) ^ (c - 160) * (10 : Nat) ^ 31 *
+      (10 ^ 18 * 10 ^ 31) * 10 ^ 31 * 10 ^ 31) = T2 at eL hbf
+    generalize hT3 : x * Sc * (10 ^ 18 * (10 ^ 31 - 10) * (10 ^ 40 : Nat) ^ (c - 160) *
+      2 ^ (c - 160) * (10 ^ 31 - 3401) * (10 ^ 31 - 3404) * (10 ^ 31 + 9990)) = T3 at eR hbf
+    generalize hT4 : 10 ^ 18 * (10 ^ 31 - 10) * (m * 9999999999999999999999999996599 *
+      (10 ^ 40 : Nat) ^ (c - 160) * (Sc * (10 ^ 31 - 3404) * (10 ^ 31 + 9990))) = T4
+      at eR ⊢
+    omega
+
+end LnFloorCert
diff --git a/formal/ln/LnProof/LnProof/FloorBracket.lean b/formal/ln/LnProof/LnProof/FloorBracket.lean
new file mode 100644
index 000000000..1aa6e5557
--- /dev/null
+++ b/formal/ln/LnProof/LnProof/FloorBracket.lean
@@ -0,0 +1,2616 @@
+import LnProof.ZOctave
+import LnProof.FloorCertAux
+
+/-!
+# Pipeline brackets against the certificate rationals
+
+For each mantissa `m`, the pipeline value `X1 = toInt (x1W (zWord m))`
+is trapped between the certificate bracket rationals: on `m ≥ S`,
+`geTN2b/geTD2b ≤ X1/2^99 ≤ geTN/geTD`, and on `m ≤ S` the mirrored
+brackets hold for `-X1`. The chains run through the exact division
+brackets of `z` and `u`, the Stages sandwiches for the Horner stages, and
+divided-difference monotonicity of the homogenized `p`/`q` polynomials.
+-/
+
+set_option maxRecDepth 4096
+-- The bracket polynomials carry powers of two up to 2^486 as opaque integer
+-- factors; raise the elaboration evaluation threshold so they are evaluated
+-- rather than left symbolic (the default threshold is 256).
+set_option exponentiation.threshold 512
+
+namespace LnFloorCert
+
+open LnGeneratedModel LnPoly
+
+/-- `z`-magnitude division bracket on the `m ≥ S` branch:
+`q = ⌊(m-S) 2^100 / (m+S)⌋` and `toInt (zWord m) = -q`. -/
+theorem z_bracket_ge {m : Nat} (hS : Sc ≤ m) (h2 : m < MHI) :
+    ∃ q : Nat,
+      toInt (zWord m) = -(q : Int) ∧
+      (q : Int) * ((m : Int) + Sc) ≤ ((m : Int) - Sc) * 2 ^ 100 ∧
+      ((m : Int) - Sc) * 2 ^ 100 < ((q : Int) + 1) * ((m : Int) + Sc) := by
+  have h1 : MLO ≤ m := by simp only [MLO]; simp only [Sc] at hS ⊢; omega
+  obtain ⟨e2, e3⟩ := zWord_transport h1 h2
+  simp only [MLO, MHI] at h1 h2
+  have hden : (0 : Int) < toInt (evmAdd m Sc) := by
+    rw [e3]; simp only [Sc]; omega
+  have hSpos : (0 : Nat) < Sc := by simp only [Sc]; omega
+  rcases Nat.eq_or_lt_of_le hS with heq | hlt
+  · -- m = Sc: z = 0
+    refine ⟨0, ?_, ?_, ?_⟩
+    · have hz : toInt (evmShl 100 (evmSub Sc m)) = 0 := by
+        rw [e2, show ((Sc : Int) - m) = 0 by omega, Int.zero_mul]
+      unfold zWord
+      rw [evmSdiv_pos_pos (evmShl_lt _ _) (evmAdd_lt _ _) (by omega) hden, hz]
+      simp [Int.toNat_zero, Nat.zero_div]
+    · rw [show ((m : Int) - Sc) = 0 by omega]
+      omega
+    · rw [show ((m : Int) - Sc) = 0 by omega]
+      omega
+  · -- m > Sc
+    have hND : 0 < m + Sc := by omega
+    refine ⟨(m - Sc) * 2 ^ 100 / (m + Sc), ?_, ?_, ?_⟩
+    · have hneg : toInt (evmShl 100 (evmSub Sc m)) < 0 := by
+        rw [e2]
+        have h := mul_le_mul_right_nonneg
+          (show ((Sc : Int) - m) ≤ -1 by omega)
+          (by omega : (0 : Int) ≤ 1267650600228229401496703205376)
+        omega
+      unfold zWord
+      rw [evmSdiv_neg_pos (evmShl_lt _ _) (evmAdd_lt _ _) hneg
+        (by rw [e2]; simp only [Sc, ipow255] at *; omega) hden]
+      have hnum : (-toInt (evmShl 100 (evmSub Sc m))).toNat =
+          (m - Sc) * 2 ^ 100 := by
+        rw [e2]
+        have : -(((Sc : Int) - m) * 1267650600228229401496703205376) =
+            (((m - Sc) * 2 ^ 100 : Nat) : Int) := by
+          rw [show ((Sc : Int) - m) = -(((m - Sc : Nat) : Int)) by omega, Int.neg_mul]
+          omega
+        omega
+      have hdenn : (toInt (evmAdd m Sc)).toNat = m + Sc := by
+        rw [e3]; omega
+      rw [hnum, hdenn]
+    · have hdm := Nat.div_add_mod ((m - Sc) * 2 ^ 100) (m + Sc)
+      have hml := Nat.mod_lt ((m - Sc) * 2 ^ 100) hND
+      generalize hq : (m - Sc) * 2 ^ 100 / (m + Sc) = q at *
+      generalize hr : (m - Sc) * 2 ^ 100 % (m + Sc) = r at *
+      have e : (q : Int) * ((m : Int) + Sc) = (((m + Sc) * q : Nat) : Int) := by
+        rw [Int.natCast_mul]
+        have : ((m + Sc : Nat) : Int) = (m : Int) + Sc := by omega
+        rw [this, Int.mul_comm]
+      rw [e]
+      omega
+    · have hdm := Nat.div_add_mod ((m - Sc) * 2 ^ 100) (m + Sc)
+      have hml := Nat.mod_lt ((m - Sc) * 2 ^ 100) hND
+      generalize hq : (m - Sc) * 2 ^ 100 / (m + Sc) = q at *
+      generalize hr : (m - Sc) * 2 ^ 100 % (m + Sc) = r at *
+      have e : ((q : Int) + 1) * ((m : Int) + Sc) =
+          (((m + Sc) * q : Nat) : Int) + ((m : Int) + Sc) := by
+        rw [Int.add_mul, Int.one_mul, Int.natCast_mul]
+        have : ((m + Sc : Nat) : Int) = (m : Int) + Sc := by omega
+        rw [this, Int.mul_comm]
+      rw [e]
+      omega
+
+/-- `z` division bracket on the `m ≤ S` branch: `toInt (zWord m) = q`. -/
+theorem z_bracket_lt {m : Nat} (h1 : MLO ≤ m) (hS : m ≤ Sc) :
+    ∃ q : Nat,
+      toInt (zWord m) = (q : Int) ∧
+      (q : Int) * ((m : Int) + Sc) ≤ ((Sc : Int) - m) * 2 ^ 100 ∧
+      ((Sc : Int) - m) * 2 ^ 100 < ((q : Int) + 1) * ((m : Int) + Sc) := by
+  have h2 : m < MHI := by simp only [MHI]; simp only [Sc] at hS; omega
+  obtain ⟨e2, e3⟩ := zWord_transport h1 h2
+  simp only [MLO, MHI] at h1 h2
+  have hden : (0 : Int) < toInt (evmAdd m Sc) := by
+    rw [e3]; simp only [Sc]; omega
+  have hND : 0 < m + Sc := by simp only [Sc]; omega
+  have hpos : (0 : Int) ≤ toInt (evmShl 100 (evmSub Sc m)) := by
+    rw [e2]
+    exact Int.mul_nonneg (by omega) (by omega)
+  refine ⟨(Sc - m) * 2 ^ 100 / (m + Sc), ?_, ?_, ?_⟩
+  · unfold zWord
+    rw [evmSdiv_pos_pos (evmShl_lt _ _) (evmAdd_lt _ _) hpos hden]
+    have hnum : (toInt (evmShl 100 (evmSub Sc m))).toNat = (Sc - m) * 2 ^ 100 := by
+      rw [e2]
+      have : ((Sc : Int) - m) * 1267650600228229401496703205376 =
+          (((Sc - m) * 2 ^ 100 : Nat) : Int) := by
+        rw [show ((Sc : Int) - m) = (((Sc - m : Nat)) : Int) by omega]
+        omega
+      omega
+    have hdenn : (toInt (evmAdd m Sc)).toNat = m + Sc := by
+      rw [e3]; omega
+    rw [hnum, hdenn]
+  · have hdm := Nat.div_add_mod ((Sc - m) * 2 ^ 100) (m + Sc)
+    have hml := Nat.mod_lt ((Sc - m) * 2 ^ 100) hND
+    generalize hq : (Sc - m) * 2 ^ 100 / (m + Sc) = q at *
+    generalize hr : (Sc - m) * 2 ^ 100 % (m + Sc) = r at *
+    have e : (q : Int) * ((m : Int) + Sc) = (((m + Sc) * q : Nat) : Int) := by
+      rw [Int.natCast_mul]
+      have : ((m + Sc : Nat) : Int) = (m : Int) + Sc := by omega
+      rw [this, Int.mul_comm]
+    rw [e]
+    omega
+  · have hdm := Nat.div_add_mod ((Sc - m) * 2 ^ 100) (m + Sc)
+    have hml := Nat.mod_lt ((Sc - m) * 2 ^ 100) hND
+    generalize hq : (Sc - m) * 2 ^ 100 / (m + Sc) = q at *
+    generalize hr : (Sc - m) * 2 ^ 100 % (m + Sc) = r at *
+    have e : ((q : Int) + 1) * ((m : Int) + Sc) =
+        (((m + Sc) * q : Nat) : Int) + ((m : Int) + Sc) := by
+      rw [Int.add_mul, Int.one_mul, Int.natCast_mul]
+      have : ((m + Sc : Nat) : Int) = (m : Int) + Sc := by omega
+      rw [this, Int.mul_comm]
+    rw [e]
+    omega
+
+/-- Square monotonicity over nonnegative integers. -/
+theorem sq_le_sq' {a b : Int} (h0 : 0 ≤ a) (h : a ≤ b) : a * a ≤ b * b := by
+  calc a * a ≤ a * b := mul_le_mul_left_nonneg h h0
+    _ ≤ b * b := mul_le_mul_right_nonneg h (by omega)
+
+theorem lt_of_mul_lt_mul_right' {a b c : Int} (h : a * c < b * c) (hc : 0 < c) :
+    a < b := by
+  rcases Int.lt_or_le a b with h1 | h1
+  · exact h1
+  · exfalso
+    have := mul_le_mul_right_nonneg h1 (by omega : (0 : Int) ≤ c)
+    omega
+
+theorem ipow_num :
+    (2 : Int) ^ 99 = 633825300114114700748351602688 ∧
+    (2 : Int) ^ 100 = 1267650600228229401496703205376 ∧
+    (2 : Int) ^ 101 = 2535301200456458802993406410752 ∧
+    (2 : Int) ^ 104 = 20282409603651670423947251286016 ∧
+    (2 : Int) ^ 96 = 79228162514264337593543950336 ∧
+    (2 : Int) ^ 200 = 1606938044258990275541962092341162602522202993782792835301376 := by
+  refine ⟨by decide, by decide, by decide, by decide, by decide, by decide⟩
+
+/-- The certificate's `wlo` numerator sits strictly below `8 u B²`:
+`d² 2^99 - d B - 8 B² < 8 u B²`, given the `z` and `u` division brackets. -/
+theorem wlo_lt_un {d q u B : Nat} (hd : 46 ≤ d)
+    (hB : 0 < B) (hBmax : B ≤ 34683664033617306847215100133375)
+    (hq2 : (d : Int) * 2 ^ 100 < ((q : Int) + 1) * B)
+    (hu : (q : Int) * q ≤ (u : Int) * 2 ^ 104 + 2 ^ 104 - 1) :
+    ((d : Int) * d) * 2 ^ 99 - (d : Int) * B - 8 * ((B : Int) * B) <
+      8 * ((u : Int) * ((B : Int) * B)) := by
+  have hAB : (B : Int) ≤ (d : Int) * 2 ^ 100 := by
+    have : (46 : Int) * 2 ^ 100 ≤ (d : Int) * 2 ^ 100 :=
+      mul_le_mul_right_nonneg (by omega) (by omega)
+    obtain ⟨-, h100, -⟩ := ipow_num
+    rw [h100] at this ⊢
+    omega
+  have s3 : (d : Int) * 2 ^ 100 - B ≤ (q : Int) * B := by
+    have e : ((q : Int) + 1) * B = (q : Int) * B + B := by
+      rw [Int.add_mul, Int.one_mul]
+    omega
+  have s4 : ((d : Int) * 2 ^ 100 - B) * ((d : Int) * 2 ^ 100 - B) ≤
+      ((q : Int) * B) * ((q : Int) * B) := sq_le_sq' (by omega) s3
+  have e1 : ((d : Int) * 2 ^ 100 - B) * ((d : Int) * 2 ^ 100 - B) =
+      (d : Int) * 2 ^ 100 * ((d : Int) * 2 ^ 100) -
+        B * ((d : Int) * 2 ^ 100) - ((d : Int) * 2 ^ 100 * B - B * B) := by
+    rw [Int.mul_sub, Int.sub_mul, Int.sub_mul]
+  have e2 : (d : Int) * 2 ^ 100 * ((d : Int) * 2 ^ 100) =
+      ((d : Int) * d) * 2 ^ 200 := by
+    have h : (d : Int) * 2 ^ 100 * ((d : Int) * 2 ^ 100) =
+        ((d : Int) * d) * ((2 : Int) ^ 100 * 2 ^ 100) := by
+      simp only [Int.mul_assoc, Int.mul_comm, Int.mul_left_comm]
+    rw [h, show ((2 : Int) ^ 100 * 2 ^ 100) = 2 ^ 200 from by decide]
+  have e3 : (d : Int) * 2 ^ 100 * B = ((d : Int) * B) * 2 ^ 100 := by
+    simp only [Int.mul_assoc, Int.mul_comm, Int.mul_left_comm]
+  have e3' : (B : Int) * ((d : Int) * 2 ^ 100) = ((d : Int) * B) * 2 ^ 100 := by
+    simp only [Int.mul_assoc, Int.mul_left_comm]
+  have e5 : ((q : Int) * B) * ((q : Int) * B) = ((q : Int) * q) * ((B : Int) * B) := by
+    simp only [Int.mul_assoc, Int.mul_comm, Int.mul_left_comm]
+  have s6 : ((q : Int) * q) * ((B : Int) * B) ≤
+      ((u : Int) * 2 ^ 104 + 2 ^ 104 - 1) * ((B : Int) * B) :=
+    mul_le_mul_right_nonneg hu (Int.mul_nonneg (by omega) (by omega))
+  have e6 : ((u : Int) * 2 ^ 104 + 2 ^ 104 - 1) * ((B : Int) * B) =
+      ((u : Int) * ((B : Int) * B)) * 2 ^ 104 +
+        ((B : Int) * B) * 2 ^ 104 - (B : Int) * B := by
+    rw [Int.sub_mul, Int.add_mul, Int.one_mul]
+    have h1 : (u : Int) * 2 ^ 104 * ((B : Int) * B) =
+        (u : Int) * ((B : Int) * B) * 2 ^ 104 := by
+      simp only [Int.mul_assoc, Int.mul_comm, Int.mul_left_comm]
+    have h2 : (2 : Int) ^ 104 * ((B : Int) * B) = ((B : Int) * B) * 2 ^ 104 := by
+      rw [Int.mul_comm]
+    omega
+  have hBB : (0 : Int) < (B : Int) * B := Int.mul_pos (by omega) (by omega)
+  have key : (((d : Int) * d) * 2 ^ 99 - (d : Int) * B - 8 * ((B : Int) * B)) * 2 ^ 104 <
+      (8 * ((u : Int) * ((B : Int) * B))) * 2 ^ 104 := by
+    have lhs : (((d : Int) * d) * 2 ^ 99 - (d : Int) * B - 8 * ((B : Int) * B)) * 2 ^ 104 =
+        ((d : Int) * d) * (2 ^ 99 * 2 ^ 104) - ((d : Int) * B) * 2 ^ 104 -
+          8 * (((B : Int) * B) * 2 ^ 104) := by
+      rw [Int.sub_mul, Int.sub_mul]
+      have b1 : ((d : Int) * d) * 2 ^ 99 * 2 ^ 104 = ((d : Int) * d) * (2 ^ 99 * 2 ^ 104) := by
+        rw [Int.mul_assoc]
+      have b2 : 8 * ((B : Int) * B) * 2 ^ 104 = 8 * (((B : Int) * B) * 2 ^ 104) := by
+        rw [Int.mul_assoc]
+      omega
+    have rhs : (8 * ((u : Int) * ((B : Int) * B))) * 2 ^ 104 =
+        8 * (((u : Int) * ((B : Int) * B)) * 2 ^ 104) := by
+      rw [Int.mul_assoc]
+    rw [lhs, rhs]
+    obtain ⟨h99, h100, h101, h104, h96, h200⟩ := ipow_num
+    rw [show ((2 : Int) ^ 99 * 2 ^ 104) =
+      8 * 1606938044258990275541962092341162602522202993782792835301376 from by decide]
+    rw [h104, h200] at *
+    -- generalize every variable product, then close linearly
+    generalize ((d : Int) * 2 ^ 100 - B) * ((d : Int) * 2 ^ 100 - B) = SQ at *
+    generalize (d : Int) * 2 ^ 100 * ((d : Int) * 2 ^ 100) = X2 at *
+    generalize (B : Int) * ((d : Int) * 2 ^ 100) = X4 at *
+    generalize (d : Int) * 2 ^ 100 * (B : Int) = X3 at *
+    generalize hg1 : ((q : Int) * B) = QB at *
+    generalize QB * QB = QB2 at *
+    generalize (q : Int) * q = QQ at *
+    generalize (d : Int) * d = DD at *
+    generalize (B : Int) * B = BB at *
+    generalize (u : Int) * BB = UB at *
+    generalize ((u : Int) * 20282409603651670423947251286016 +
+      20282409603651670423947251286016 - 1) * BB = R6 at *
+    generalize QQ * BB = QQBB at *
+    generalize (d : Int) * B = DB at *
+    clear hq2 hu hAB s3 hg1
+    omega
+  exact lt_of_mul_lt_mul_right' key (by decide)
+
+/-- `u B² ≤ 2^96 d²` from the division brackets. -/
+theorem un_le_dsq {d q u B : Nat} (hB : 0 < B)
+    (hq1 : (q : Int) * B ≤ (d : Int) * 2 ^ 100)
+    (hu : (u : Int) * 2 ^ 104 ≤ (q : Int) * q) :
+    (u : Int) * ((B : Int) * B) ≤ 2 ^ 96 * ((d : Int) * d) := by
+  have s1 : ((q : Int) * B) * ((q : Int) * B) ≤
+      ((d : Int) * 2 ^ 100) * ((d : Int) * 2 ^ 100) :=
+    sq_le_sq' (Int.mul_nonneg (by omega) (by omega)) hq1
+  have e1 : ((q : Int) * B) * ((q : Int) * B) = ((q : Int) * q) * ((B : Int) * B) := by
+    simp only [Int.mul_assoc, Int.mul_comm, Int.mul_left_comm]
+  have e2 : ((d : Int) * 2 ^ 100) * ((d : Int) * 2 ^ 100) =
+      ((d : Int) * d) * 2 ^ 200 := by
+    have h : ((d : Int) * 2 ^ 100) * ((d : Int) * 2 ^ 100) =
+        ((d : Int) * d) * ((2 : Int) ^ 100 * 2 ^ 100) := by
+      simp only [Int.mul_assoc, Int.mul_comm, Int.mul_left_comm]
+    rw [h, show ((2 : Int) ^ 100 * 2 ^ 100) = 2 ^ 200 from by decide]
+  have s2 : ((u : Int) * 2 ^ 104) * ((B : Int) * B) ≤
+      ((q : Int) * q) * ((B : Int) * B) :=
+    mul_le_mul_right_nonneg hu (Int.mul_nonneg (by omega) (by omega))
+  have e3 : ((u : Int) * 2 ^ 104) * ((B : Int) * B) =
+      ((u : Int) * ((B : Int) * B)) * 2 ^ 104 := by
+    simp only [Int.mul_assoc, Int.mul_comm, Int.mul_left_comm]
+  have key : ((u : Int) * ((B : Int) * B)) * 2 ^ 104 ≤
+      (2 ^ 96 * ((d : Int) * d)) * 2 ^ 104 := by
+    have e4 : (2 ^ 96 * ((d : Int) * d)) * 2 ^ 104 = ((d : Int) * d) * 2 ^ 200 := by
+      have h : (2 ^ 96 * ((d : Int) * d)) * 2 ^ 104 =
+          ((d : Int) * d) * ((2 : Int) ^ 96 * 2 ^ 104) := by
+        simp only [Int.mul_assoc, Int.mul_comm]
+      rw [h, show ((2 : Int) ^ 96 * 2 ^ 104) = 2 ^ 200 from by decide]
+    clear hq1 hu
+    generalize (q : Int) * (B : Int) = QB at *
+    generalize (q : Int) * (q : Int) = QQ at *
+    generalize (d : Int) * (d : Int) = DD at *
+    generalize (B : Int) * (B : Int) = BB at *
+    generalize (u : Int) * BB = UB at *
+    omega
+  exact Int.le_of_mul_le_mul_right key (by decide)
+
+/-! ## Divided-difference dominance for the homogenized stage polynomials
+
+`homEvalI PPc · D` is decreasing and `homEvalI QQc · D` is increasing on
+`|n| 2^96 ≤ Uc D`: the divided difference is dominated by its linear
+coefficient (`-P1c 2^271` resp. `Q1c 2^291`), with every higher term
+crudely bounded through the box radius. -/
+
+/-- Unfolded quartic form of `homEvalI PPc`. -/
+theorem homEvalI_PPc_eq (n D : Int) :
+    homEvalI PPc n D =
+      (8203564106909714963200842018502018851024462725819431901516251320229929630934299039494945066816553616430456446611805193566972803059892092928 : Int) * D ^ 4 +
+        n * (-(211724653123857194763950383720687822670307458715746667734762451892717657012841722322962591250252321890880192512 : Int) * D ^ 3 +
+          n * ((1798175745614395766239082622521528960720477616324792863638563111730471590055378944 : Int) * D ^ 2 +
+            n * (-(5562590447406762316237749022682109217671325297934336 : Int) * D ^ 1 +
+              n * ((4542704643877621417440 : Int) * D ^ 0 + n * 0)))) := rfl
+
+/-- Unfolded quintic form of `homEvalI QQc`. -/
+theorem homEvalI_QQc_eq (n D : Int) :
+    homEvalI QQc n D =
+      (-(2202127471863542086976841246820549867195347718960342176144462014556523185327760268707187588705852038374958668534379582118318610928980329275922055168 : Int)) * D ^ 5 +
+        n * ((66099322585698201304896817119133314370855648754593283446756353822335972946493244703677923116935407234039976856169480192 : Int) * D ^ 4 +
+          n * (-(690627211385037298547738551962892852267586075469791719173459072596031701017399264062472192 : Int) * D ^ 3 +
+            n * ((2925363287404360843667081098480704995728827760271876675338240 : Int) * D ^ 2 +
+              n * (-(4299840983308505679614339668444 : Int) * D ^ 1 +
+                n * ((1 : Int) * D ^ 0 + n * 0))))) := rfl
+
+/-- `a² ≤ b²` whenever `-b ≤ a ≤ b`. -/
+theorem sq_le_of_abs_le {a b : Int} (h1 : -b ≤ a) (h2 : a ≤ b) : a * a ≤ b * b := by
+  rcases Int.le_total 0 a with h0 | h0
+  · exact sq_le_sq' h0 h2
+  · have := sq_le_sq' (a := -a) (b := b) (by omega) (by omega)
+    have e : (-a) * (-a) = a * a := by
+      rw [Int.neg_mul, Int.mul_neg]
+      omega
+    omega
+
+/-- Nested-Horner quartic distributes onto power-products. -/
+theorem quartic_expand (c1 c2 c3 c4 n E3 E2 E1 : Int) :
+    n * (c1 * E3 + n * (c2 * E2 + n * (c3 * E1 + n * c4))) =
+      c1 * n * E3 + c2 * (n * n) * E2 + c3 * (n * n * n) * E1 +
+        c4 * (n * n * n * n) := by
+  have a0 : n * (c3 * E1 + n * c4) = n * (c3 * E1) + n * (n * c4) :=
+    Int.mul_add n (c3 * E1) (n * c4)
+  have a0' : n * (c2 * E2 + n * (c3 * E1 + n * c4)) =
+      n * (c2 * E2) + n * (n * (c3 * E1) + n * (n * c4)) := by
+    rw [Int.mul_add n (c2 * E2) (n * (c3 * E1 + n * c4)), a0]
+  have a0'' : n * (n * (c3 * E1) + n * (n * c4)) =
+      n * (n * (c3 * E1)) + n * (n * (n * c4)) :=
+    Int.mul_add n (n * (c3 * E1)) (n * (n * c4))
+  rw [Int.mul_add n (c1 * E3) _, a0', a0'']
+  have a0''' : n * (n * (c2 * E2) + (n * (n * (c3 * E1)) + n * (n * (n * c4)))) =
+      n * (n * (c2 * E2)) + (n * (n * (n * (c3 * E1))) + n * (n * (n * (n * c4)))) := by
+    rw [Int.mul_add n (n * (c2 * E2)) _, Int.mul_add n (n * (n * (c3 * E1))) _]
+  have a1 : n * (c1 * E3) = c1 * n * E3 := by
+    simp only [Int.mul_comm, Int.mul_left_comm]
+  have a2 : n * (n * (c2 * E2)) = c2 * (n * n) * E2 := by
+    simp only [Int.mul_comm, Int.mul_left_comm]
+  have a3 : n * (n * (n * (c3 * E1))) = c3 * (n * n * n) * E1 := by
+    simp only [Int.mul_comm, Int.mul_left_comm]
+  have a4 : n * (n * (n * (n * c4))) = c4 * (n * n * n * n) := by
+    simp only [Int.mul_comm, Int.mul_left_comm]
+  omega
+
+theorem df2 (x y : Int) : x * x - y * y = (x - y) * (x + y) := by
+  rw [Int.sub_mul, Int.mul_add, Int.mul_add]
+  have : y * x = x * y := Int.mul_comm y x
+  omega
+
+theorem df3 (x y : Int) :
+    x * x * x - y * y * y = (x - y) * (x * x + x * y + y * y) := by
+  rw [Int.sub_mul, Int.mul_add, Int.mul_add, Int.mul_add, Int.mul_add]
+  have a1 : y * (x * x) = x * (x * y) := by
+    simp only [Int.mul_comm, Int.mul_left_comm]
+  have a2 : x * (x * x) = x * x * x := by
+    simp only [Int.mul_comm]
+  have a3 : y * (x * y) = y * y * x := by
+    simp only [Int.mul_comm, Int.mul_left_comm]
+  have a4 : x * (y * y) = y * y * x := by
+    simp only [Int.mul_comm]
+  have a5 : y * (y * y) = y * y * y := by
+    simp only [Int.mul_comm]
+  have a6 : x * (x * y) = x * (x * y) := rfl
+  omega
+
+theorem df4 (x y : Int) :
+    x * x * x * x - y * y * y * y =
+      (x - y) * ((x + y) * (x * x + y * y)) := by
+  have h1 : x * x * x * x = (x * x) * (x * x) := by
+    simp only [Int.mul_assoc]
+  have h2 : y * y * y * y = (y * y) * (y * y) := by
+    simp only [Int.mul_assoc]
+  have h3 := df2 (x * x) (y * y)
+  have h4 := df2 x y
+  -- (x² - y²)(x² + y²) = ((x-y)(x+y))(x² + y²)
+  rw [h1, h2, h3, h4, Int.mul_assoc]
+
+theorem sq_nonneg' (a : Int) : 0 ≤ a * a := by
+  rcases Int.le_total 0 a with h | h
+  · exact Int.mul_nonneg h h
+  · have h2 := Int.mul_nonneg (a := -a) (b := -a) (by omega) (by omega)
+    have e : (-a) * (-a) = a * a := by
+      rw [Int.neg_mul, Int.mul_neg]
+      omega
+    omega
+
+/-- Interval bound for a product: `|a| ≤ A`, `0 ≤ b ≤ B` give `|ab| ≤ AB`. -/
+theorem mul_bound {a A b B : Int} (ha1 : -A ≤ a) (ha2 : a ≤ A)
+    (hb0 : 0 ≤ b) (hb : b ≤ B) : -(A * B) ≤ a * b ∧ a * b ≤ A * B := by
+  have hA : 0 ≤ A := by omega
+  have hB : 0 ≤ B := by omega
+  constructor
+  · rcases Int.le_total 0 a with h | h
+    · have h1 : 0 ≤ a * b := Int.mul_nonneg h hb0
+      have h2 : 0 ≤ A * B := Int.mul_nonneg hA hB
+      omega
+    · have h1 : a * B ≤ a * b := mul_le_mul_left_nonpos hb h
+      have h2 : (-A) * B ≤ a * B := mul_le_mul_right_nonneg ha1 hB
+      have e : (-A) * B = -(A * B) := Int.neg_mul A B
+      omega
+  · rcases Int.le_total 0 a with h | h
+    · have h1 : a * b ≤ a * B := mul_le_mul_left_nonneg hb h
+      have h2 : a * B ≤ A * B := mul_le_mul_right_nonneg ha2 hB
+      omega
+    · have h1 : a * b ≤ 0 := Int.mul_nonpos_of_nonpos_of_nonneg h hb0
+      have h2 : 0 ≤ A * B := Int.mul_nonneg hA hB
+      omega
+
+/-- Two-sided interval bound for a product of two signed factors. -/
+theorem mul_bound2 {a b A : Int} (ha1 : -A ≤ a) (ha2 : a ≤ A)
+    (hb1 : -A ≤ b) (hb2 : b ≤ A) : -(A * A) ≤ a * b ∧ a * b ≤ A * A := by
+  rcases Int.le_total 0 b with h | h
+  · exact mul_bound ha1 ha2 h hb2
+  · have h1 := mul_bound (a := a) (A := A) (b := -b) (B := A) ha1 ha2 (by omega) (by omega)
+    have e : a * (-b) = -(a * b) := Int.mul_neg a b
+    omega
+
+/-- `homEvalI PPc · D` is decreasing for `|n| ≤ Uc D`. -/
+theorem homEvalI_PPc_anti {n1 n2 D : Int} (hD : 0 < D) (h21 : n2 ≤ n1)
+    (hb1 : n1 ≤ 2333000000000000000000000000 * D)
+    (hb2 : -(2333000000000000000000000000 * D) ≤ n2) :
+    homEvalI PPc n1 D ≤ homEvalI PPc n2 D := by
+  rw [homEvalI_PPc_eq, homEvalI_PPc_eq]
+  simp only [Int.pow_zero, Int.pow_one, Int.mul_one, Int.mul_zero, Int.add_zero]
+  rw [quartic_expand, quartic_expand]
+  have hb1' : -(2333000000000000000000000000 * D) ≤ n1 := by omega
+  have hb2' : n2 ≤ 2333000000000000000000000000 * D := by omega
+  have hUD : (0 : Int) ≤ 2333000000000000000000000000 * D :=
+    Int.mul_nonneg (by omega) (by omega)
+  -- squares and cross products
+  have hUDsq : (2333000000000000000000000000 * D) * (2333000000000000000000000000 * D) =
+      5442889000000000000000000000000000000000000000000000000 * (D * D) := by
+    have h : (2333000000000000000000000000 * D) * (2333000000000000000000000000 * D) =
+        ((2333000000000000000000000000 : Int) * 2333000000000000000000000000) * (D * D) := by
+      simp only [Int.mul_assoc, Int.mul_comm, Int.mul_left_comm]
+    rw [h, show ((2333000000000000000000000000 : Int) * 2333000000000000000000000000) =
+      5442889000000000000000000000000000000000000000000000000 from by decide]
+  have hsq1 := sq_le_of_abs_le hb1' hb1
+  have hsq2 := sq_le_of_abs_le hb2 hb2'
+  have hcross := mul_bound2 hb1' hb1 hb2 hb2'
+  rw [hUDsq] at hsq1 hsq2 hcross
+  -- H3 facts
+  have hH3nn : 0 ≤ n1 * n1 + n1 * n2 + n2 * n2 := by
+    have hid : (n1 + n2) * (n1 + n2) = n1 * n1 + n1 * n2 + (n1 * n2 + n2 * n2) := by
+      rw [Int.add_mul, Int.mul_add, Int.mul_add]
+      have : n2 * n1 = n1 * n2 := Int.mul_comm n2 n1
+      omega
+    have s1 := sq_nonneg' (n1 + n2)
+    have s2 := sq_nonneg' n1
+    have s3 := sq_nonneg' n2
+    omega
+  -- sum-of-squares bound for H4
+  have hss_nn : 0 ≤ n1 * n1 + n2 * n2 := by
+    have s2 := sq_nonneg' n1
+    have s3 := sq_nonneg' n2
+    omega
+  have hss_ub : n1 * n1 + n2 * n2 ≤
+      10885778000000000000000000000000000000000000000000000000 * (D * D) := by
+    omega
+  have hsum_ub : n1 + n2 ≤ 4666000000000000000000000000 * D := by omega
+  have hsum_lb : -(4666000000000000000000000000 * D) ≤ n1 + n2 := by omega
+  have hH4 := mul_bound (a := n1 + n2) (A := 4666000000000000000000000000 * D)
+    (b := n1 * n1 + n2 * n2)
+    (B := 10885778000000000000000000000000000000000000000000000000 * (D * D))
+    hsum_lb hsum_ub hss_nn hss_ub
+  have hH4ub : (4666000000000000000000000000 * D) *
+      (10885778000000000000000000000000000000000000000000000000 * (D * D)) =
+      50793040148000000000000000000000000000000000000000000000000000000000000000000000000 *
+        (D * (D * D)) := by
+    have h : (4666000000000000000000000000 * D) *
+        (10885778000000000000000000000000000000000000000000000000 * (D * D)) =
+        ((4666000000000000000000000000 : Int) *
+          10885778000000000000000000000000000000000000000000000000) * (D * (D * D)) := by
+      simp only [Int.mul_assoc, Int.mul_comm, Int.mul_left_comm]
+    rw [h, show ((4666000000000000000000000000 : Int) *
+      10885778000000000000000000000000000000000000000000000000) =
+      50793040148000000000000000000000000000000000000000000000000000000000000000000000000
+      from by decide]
+  rw [hH4ub] at hH4
+  -- powers as products
+  have p2 : D ^ 2 = D * D := by
+    have h := Int.pow_succ D 1
+    rw [Int.pow_one] at h
+    exact h
+  have p3 : D ^ 3 = D * D * D := by
+    have h := Int.pow_succ D 2
+    rw [p2] at h
+    exact h
+  rw [p2, p3]
+  have hDDD : (0 : Int) ≤ D * D * D :=
+    Int.le_of_lt (Int.mul_pos (Int.mul_pos hD hD) hD)
+  have hAC : D * (D * D) = D * D * D := by
+    rw [Int.mul_assoc]
+  rw [hAC] at hH4
+  -- column-difference identities
+  have hd2 := df2 n1 n2
+  have hd3 := df3 n1 n2
+  have hd4 := df4 n1 n2
+  have hmono : 0 ≤ n1 - n2 := by omega
+  -- T1: exact column difference
+  have hT1 : (-(211724653123857194763950383720687822670307458715746667734762451892717657012841722322962591250252321890880192512 : Int)) * n1 * (D * D * D) - (-(211724653123857194763950383720687822670307458715746667734762451892717657012841722322962591250252321890880192512 : Int)) * n2 * (D * D * D) =
+      (n1 - n2) * (-(211724653123857194763950383720687822670307458715746667734762451892717657012841722322962591250252321890880192512 : Int)) * (D * D * D) := by
+    rw [← Int.sub_mul, ← Int.mul_sub]
+    have : (-(211724653123857194763950383720687822670307458715746667734762451892717657012841722322962591250252321890880192512 : Int)) * (n1 - n2) = (n1 - n2) * (-(211724653123857194763950383720687822670307458715746667734762451892717657012841722322962591250252321890880192512 : Int)) := Int.mul_comm _ _
+    rw [this]
+  -- T2
+  have hT2 : (1798175745614395766239082622521528960720477616324792863638563111730471590055378944 : Int) * (n1 * n1) * (D * D) - (1798175745614395766239082622521528960720477616324792863638563111730471590055378944 : Int) * (n2 * n2) * (D * D) ≤
+      (n1 - n2) * (8390288029036770645271559516685454130721748557771483501737535479334380439198398152704000000000000000000000000 : Int) * (D * D * D) := by
+    have e1 : (1798175745614395766239082622521528960720477616324792863638563111730471590055378944 : Int) * (n1 * n1) * (D * D) - (1798175745614395766239082622521528960720477616324792863638563111730471590055378944 : Int) * (n2 * n2) * (D * D) =
+        ((1798175745614395766239082622521528960720477616324792863638563111730471590055378944 : Int) * (n1 - n2) * (D * D)) * (n1 + n2) := by
+      rw [← Int.sub_mul, ← Int.mul_sub, hd2]
+      simp only [Int.mul_assoc, Int.mul_comm, Int.mul_left_comm]
+    rw [e1]
+    have hf : (0 : Int) ≤ (1798175745614395766239082622521528960720477616324792863638563111730471590055378944 : Int) * (n1 - n2) * (D * D) :=
+      Int.mul_nonneg (Int.mul_nonneg (by decide) hmono)
+        (Int.mul_nonneg (by omega) (by omega))
+    have step := mul_le_mul_left_nonneg hsum_ub hf
+    have e2 : ((1798175745614395766239082622521528960720477616324792863638563111730471590055378944 : Int) * (n1 - n2) * (D * D)) * (4666000000000000000000000000 * D) =
+        (n1 - n2) * (8390288029036770645271559516685454130721748557771483501737535479334380439198398152704000000000000000000000000 : Int) * (D * D * D) := by
+      have h : ((1798175745614395766239082622521528960720477616324792863638563111730471590055378944 : Int) * (n1 - n2) * (D * D)) * (4666000000000000000000000000 * D) =
+          (n1 - n2) * ((1798175745614395766239082622521528960720477616324792863638563111730471590055378944 : Int) * 4666000000000000000000000000) * (D * D * D) := by
+        simp only [Int.mul_assoc, Int.mul_comm, Int.mul_left_comm]
+      rw [h, show ((1798175745614395766239082622521528960720477616324792863638563111730471590055378944 : Int) * 4666000000000000000000000000) = (8390288029036770645271559516685454130721748557771483501737535479334380439198398152704000000000000000000000000 : Int) from by decide]
+    omega
+  -- T3 (nonpositive)
+  have hT3 : (-(5562590447406762316237749022682109217671325297934336 : Int)) * (n1 * n1 * n1) * D - (-(5562590447406762316237749022682109217671325297934336 : Int)) * (n2 * n2 * n2) * D ≤ 0 := by
+    have e1 : (-(5562590447406762316237749022682109217671325297934336 : Int)) * (n1 * n1 * n1) * D - (-(5562590447406762316237749022682109217671325297934336 : Int)) * (n2 * n2 * n2) * D =
+        (-(5562590447406762316237749022682109217671325297934336 : Int)) * ((n1 - n2) * ((n1 * n1 + n1 * n2 + n2 * n2) * D)) := by
+      rw [← Int.sub_mul, ← Int.mul_sub, hd3]
+      simp only [Int.mul_assoc, Int.mul_comm]
+    rw [e1]
+    refine Int.mul_nonpos_of_nonpos_of_nonneg (by decide) ?_
+    exact Int.mul_nonneg hmono (Int.mul_nonneg hH3nn (by omega))
+  -- T4
+  have hT4 : (4542704643877621417440 : Int) * (n1 * n1 * n1 * n1) - (4542704643877621417440 : Int) * (n2 * n2 * n2 * n2) ≤
+      (n1 - n2) * (230737779356982067054774587381120000000000000000000000000000000000000000000000000000000000000000000000000 : Int) * (D * D * D) := by
+    have e1 : (4542704643877621417440 : Int) * (n1 * n1 * n1 * n1) - (4542704643877621417440 : Int) * (n2 * n2 * n2 * n2) =
+        ((4542704643877621417440 : Int) * (n1 - n2)) * ((n1 + n2) * (n1 * n1 + n2 * n2)) := by
+      rw [← Int.mul_sub, hd4]
+      simp only [Int.mul_assoc, Int.mul_comm]
+    rw [e1]
+    have hf : (0 : Int) ≤ (4542704643877621417440 : Int) * (n1 - n2) :=
+      Int.mul_nonneg (by decide) hmono
+    have step := mul_le_mul_left_nonneg hH4.2 hf
+    have e2 : ((4542704643877621417440 : Int) * (n1 - n2)) *
+        (50793040148000000000000000000000000000000000000000000000000000000000000000000000000 *
+          (D * D * D)) =
+        (n1 - n2) * (230737779356982067054774587381120000000000000000000000000000000000000000000000000000000000000000000000000 : Int) * (D * D * D) := by
+      have h : ((4542704643877621417440 : Int) * (n1 - n2)) *
+          (50793040148000000000000000000000000000000000000000000000000000000000000000000000000 *
+            (D * D * D)) =
+          (n1 - n2) * ((4542704643877621417440 : Int) *
+            50793040148000000000000000000000000000000000000000000000000000000000000000000000000) *
+            (D * D * D) := by
+        simp only [Int.mul_assoc, Int.mul_comm, Int.mul_left_comm]
+      rw [h, show ((4542704643877621417440 : Int) *
+        50793040148000000000000000000000000000000000000000000000000000000000000000000000000) =
+        (230737779356982067054774587381120000000000000000000000000000000000000000000000000000000000000000000000000 : Int) from by decide]
+    omega
+  -- sum of the bounds is nonpositive
+  have hsum : (n1 - n2) * (-(211724653123857194763950383720687822670307458715746667734762451892717657012841722322962591250252321890880192512 : Int)) * (D * D * D) +
+      (n1 - n2) * (8390288029036770645271559516685454130721748557771483501737535479334380439198398152704000000000000000000000000 : Int) * (D * D * D) +
+      (n1 - n2) * (230737779356982067054774587381120000000000000000000000000000000000000000000000000000000000000000000000000 : Int) * (D * D * D) ≤ 0 := by
+    have e1 : (n1 - n2) * (-(211724653123857194763950383720687822670307458715746667734762451892717657012841722322962591250252321890880192512 : Int)) * (D * D * D) +
+        (n1 - n2) * (8390288029036770645271559516685454130721748557771483501737535479334380439198398152704000000000000000000000000 : Int) * (D * D * D) +
+        (n1 - n2) * (230737779356982067054774587381120000000000000000000000000000000000000000000000000000000000000000000000000 : Int) * (D * D * D) =
+        (n1 - n2) * (-(203334134357041067136611769429414987419585710157975184233024916413383276573643324170258591250252321890880192512 : Int)) * (D * D * D) := by
+      have h : (n1 - n2) * (-(211724653123857194763950383720687822670307458715746667734762451892717657012841722322962591250252321890880192512 : Int)) * (D * D * D) +
+          (n1 - n2) * (8390288029036770645271559516685454130721748557771483501737535479334380439198398152704000000000000000000000000 : Int) * (D * D * D) +
+          (n1 - n2) * (230737779356982067054774587381120000000000000000000000000000000000000000000000000000000000000000000000000 : Int) * (D * D * D) =
+          (n1 - n2) * ((-(211724653123857194763950383720687822670307458715746667734762451892717657012841722322962591250252321890880192512 : Int)) + (8390288029036770645271559516685454130721748557771483501737535479334380439198398152704000000000000000000000000 : Int) + (230737779356982067054774587381120000000000000000000000000000000000000000000000000000000000000000000000000 : Int)) * (D * D * D) := by
+        rw [Int.mul_add, Int.mul_add, Int.add_mul, Int.add_mul]
+      rw [h, show ((-(211724653123857194763950383720687822670307458715746667734762451892717657012841722322962591250252321890880192512 : Int)) + (8390288029036770645271559516685454130721748557771483501737535479334380439198398152704000000000000000000000000 : Int) + (230737779356982067054774587381120000000000000000000000000000000000000000000000000000000000000000000000000 : Int)) = -(203334134357041067136611769429414987419585710157975184233024916413383276573643324170258591250252321890880192512 : Int) from by decide]
+    rw [e1]
+    have h1 : (n1 - n2) * (-(203334134357041067136611769429414987419585710157975184233024916413383276573643324170258591250252321890880192512 : Int)) ≤ 0 :=
+      Int.mul_nonpos_of_nonneg_of_nonpos hmono (by decide)
+    exact Int.mul_nonpos_of_nonpos_of_nonneg h1 hDDD
+  -- conclude
+  generalize (-(211724653123857194763950383720687822670307458715746667734762451892717657012841722322962591250252321890880192512 : Int)) * n1 * (D * D * D) = a1 at *
+  generalize (-(211724653123857194763950383720687822670307458715746667734762451892717657012841722322962591250252321890880192512 : Int)) * n2 * (D * D * D) = a2 at *
+  generalize (1798175745614395766239082622521528960720477616324792863638563111730471590055378944 : Int) * (n1 * n1) * (D * D) = b1 at *
+  generalize (1798175745614395766239082622521528960720477616324792863638563111730471590055378944 : Int) * (n2 * n2) * (D * D) = b2 at *
+  generalize (-(5562590447406762316237749022682109217671325297934336 : Int)) * (n1 * n1 * n1) * D = c1v at *
+  generalize (-(5562590447406762316237749022682109217671325297934336 : Int)) * (n2 * n2 * n2) * D = c2v at *
+  generalize (4542704643877621417440 : Int) * (n1 * n1 * n1 * n1) = d1v at *
+  generalize (4542704643877621417440 : Int) * (n2 * n2 * n2 * n2) = d2v at *
+  generalize (n1 - n2) * (-(211724653123857194763950383720687822670307458715746667734762451892717657012841722322962591250252321890880192512 : Int)) * (D * D * D) = g1 at *
+  generalize (n1 - n2) * (8390288029036770645271559516685454130721748557771483501737535479334380439198398152704000000000000000000000000 : Int) * (D * D * D) = g2 at *
+  generalize (n1 - n2) * (230737779356982067054774587381120000000000000000000000000000000000000000000000000000000000000000000000000 : Int) * (D * D * D) = g4 at *
+  omega
+
+/-- Nested-Horner quintic distributes onto power-products. -/
+theorem quintic_expand (c1 c2 c3 c4 c5 n E4 E3 E2 E1 : Int) :
+    n * (c1 * E4 + n * (c2 * E3 + n * (c3 * E2 + n * (c4 * E1 + n * c5)))) =
+      c1 * n * E4 + (c2 * (n * n) * E3 + c3 * (n * n * n) * E2 +
+        c4 * (n * n * n * n) * E1 + c5 * (n * n * n * n * n)) := by
+  rw [Int.mul_add n (c1 * E4) _]
+  have h := quartic_expand c2 c3 c4 c5 n E3 E2 E1
+  rw [show n * (c2 * E3 + n * (c3 * E2 + n * (c4 * E1 + n * c5))) =
+    c2 * n * E3 + c3 * (n * n) * E2 + c4 * (n * n * n) * E1 +
+      c5 * (n * n * n * n) from h]
+  rw [Int.mul_add n (c2 * n * E3 + c3 * (n * n) * E2 + c4 * (n * n * n) * E1)
+      (c5 * (n * n * n * n)),
+    Int.mul_add n (c2 * n * E3 + c3 * (n * n) * E2) (c4 * (n * n * n) * E1),
+    Int.mul_add n (c2 * n * E3) (c3 * (n * n) * E2)]
+  have a1 : n * (c1 * E4) = c1 * n * E4 := by
+    simp only [Int.mul_comm, Int.mul_left_comm]
+  have a2 : n * (c2 * n * E3) = c2 * (n * n) * E3 := by
+    simp only [Int.mul_comm, Int.mul_left_comm]
+  have a3 : n * (c3 * (n * n) * E2) = c3 * (n * n * n) * E2 := by
+    simp only [Int.mul_comm, Int.mul_left_comm]
+  have a4 : n * (c4 * (n * n * n) * E1) = c4 * (n * n * n * n) * E1 := by
+    simp only [Int.mul_comm, Int.mul_left_comm]
+  have a5 : n * (c5 * (n * n * n * n)) = c5 * (n * n * n * n * n) := by
+    simp only [Int.mul_comm, Int.mul_left_comm]
+  omega
+
+/-- Fifth-power difference, asymmetric factorization. -/
+theorem df5 (x y : Int) :
+    x * x * x * x * x - y * y * y * y * y =
+      (x - y) * (x * ((x + y) * (x * x + y * y)) + y * y * y * y) := by
+  have h4 := df4 x y
+  have e1 : x * x * x * x * x - y * y * y * y * y =
+      x * (x * x * x * x - y * y * y * y) + (x - y) * (y * y * y * y) := by
+    rw [Int.mul_sub, Int.sub_mul]
+    have a1 : x * (x * x * x * x) = x * x * x * x * x := by
+      simp only [Int.mul_comm]
+    have a2 : x * (y * y * y * y) = x * (y * y * y * y) := rfl
+    have a3 : y * (y * y * y * y) = y * y * y * y * y := by
+      simp only [Int.mul_comm]
+    omega
+  rw [e1, h4]
+  have e2 : x * ((x - y) * ((x + y) * (x * x + y * y))) =
+      (x - y) * (x * ((x + y) * (x * x + y * y))) := by
+    simp only [Int.mul_assoc, Int.mul_comm]
+  rw [e2, ← Int.mul_add]
+
+theorem mul_le_mul_right_nonpos {a b c : Int} (h : a ≤ b) (hc : c ≤ 0) :
+    b * c ≤ a * c := by
+  have h1 := mul_le_mul_right_nonneg h (by omega : (0 : Int) ≤ -c)
+  have e1 : a * (-c) = -(a * c) := Int.mul_neg a c
+  have e2 : b * (-c) = -(b * c) := Int.mul_neg b c
+  omega
+
+/-- `homEvalI QQc · D` is increasing for `|n| ≤ Uc D`. -/
+theorem homEvalI_QQc_mono {n1 n2 D : Int} (hD : 0 < D) (h21 : n2 ≤ n1)
+    (hb1 : n1 ≤ 2333000000000000000000000000 * D)
+    (hb2 : -(2333000000000000000000000000 * D) ≤ n2) :
+    homEvalI QQc n2 D ≤ homEvalI QQc n1 D := by
+  rw [homEvalI_QQc_eq, homEvalI_QQc_eq]
+  simp only [Int.pow_zero, Int.pow_one, Int.mul_one, Int.mul_zero, Int.add_zero]
+  have qe1 := quintic_expand
+    (66099322585698201304896817119133314370855648754593283446756353822335972946493244703677923116935407234039976856169480192 : Int)
+    (-(690627211385037298547738551962892852267586075469791719173459072596031701017399264062472192 : Int))
+    (2925363287404360843667081098480704995728827760271876675338240 : Int)
+    (-(4299840983308505679614339668444 : Int)) 1 n1 (D ^ 4) (D ^ 3) (D ^ 2) D
+  have qe2 := quintic_expand
+    (66099322585698201304896817119133314370855648754593283446756353822335972946493244703677923116935407234039976856169480192 : Int)
+    (-(690627211385037298547738551962892852267586075469791719173459072596031701017399264062472192 : Int))
+    (2925363287404360843667081098480704995728827760271876675338240 : Int)
+    (-(4299840983308505679614339668444 : Int)) 1 n2 (D ^ 4) (D ^ 3) (D ^ 2) D
+  simp only [Int.mul_one, Int.one_mul] at qe1 qe2
+  rw [qe1, qe2]
+  have hb1' : -(2333000000000000000000000000 * D) ≤ n1 := by omega
+  have hb2' : n2 ≤ 2333000000000000000000000000 * D := by omega
+  have hUDsq : (2333000000000000000000000000 * D) * (2333000000000000000000000000 * D) =
+      (5442889000000000000000000000000000000000000000000000000 : Int) * (D * D) := by
+    have h : (2333000000000000000000000000 * D) * (2333000000000000000000000000 * D) =
+        ((2333000000000000000000000000 : Int) * 2333000000000000000000000000) * (D * D) := by
+      simp only [Int.mul_assoc, Int.mul_comm, Int.mul_left_comm]
+    rw [h, show ((2333000000000000000000000000 : Int) * 2333000000000000000000000000) =
+      (5442889000000000000000000000000000000000000000000000000 : Int) from by decide]
+  have hsq1 := sq_le_of_abs_le hb1' hb1
+  have hsq2 := sq_le_of_abs_le hb2 hb2'
+  rw [hUDsq] at hsq1 hsq2
+  have hH3nn : 0 ≤ n1 * n1 + n1 * n2 + n2 * n2 := by
+    have hid : (n1 + n2) * (n1 + n2) = n1 * n1 + n1 * n2 + (n1 * n2 + n2 * n2) := by
+      rw [Int.add_mul, Int.mul_add, Int.mul_add]
+      have : n2 * n1 = n1 * n2 := Int.mul_comm n2 n1
+      omega
+    have s1 := sq_nonneg' (n1 + n2)
+    have s2 := sq_nonneg' n1
+    have s3 := sq_nonneg' n2
+    omega
+  have hss_nn : 0 ≤ n1 * n1 + n2 * n2 := by
+    have s2 := sq_nonneg' n1
+    have s3 := sq_nonneg' n2
+    omega
+  have hss_ub : n1 * n1 + n2 * n2 ≤ (10885778000000000000000000000000000000000000000000000000 : Int) * (D * D) := by omega
+  have hsum_ub : n1 + n2 ≤ (4666000000000000000000000000 : Int) * D := by omega
+  have hsum_lb : -((4666000000000000000000000000 : Int) * D) ≤ n1 + n2 := by omega
+  have hmono : 0 ≤ n1 - n2 := by omega
+  have hUD : (0 : Int) ≤ 2333000000000000000000000000 * D :=
+    Int.mul_nonneg (by omega) (by omega)
+  have hDD : (0 : Int) ≤ D * D := Int.mul_nonneg (by omega) (by omega)
+  have hDDD : (0 : Int) ≤ D * D * D := Int.mul_nonneg hDD (by omega)
+  have hDDDD : (0 : Int) ≤ D * D * D * D := Int.mul_nonneg hDDD (by omega)
+  have p2 : D ^ 2 = D * D := by
+    have h := Int.pow_succ D 1
+    rw [Int.pow_one] at h
+    exact h
+  have p3 : D ^ 3 = D * D * D := by
+    have h := Int.pow_succ D 2
+    rw [p2] at h
+    exact h
+  have p4 : D ^ 4 = D * D * D * D := by
+    have h := Int.pow_succ D 3
+    rw [p3] at h
+    exact h
+  rw [p2, p3, p4]
+  -- H4 interval (for the q4 column)
+  have hH4 := mul_bound (a := n1 + n2) (A := (4666000000000000000000000000 : Int) * D)
+    (b := n1 * n1 + n2 * n2) (B := (10885778000000000000000000000000000000000000000000000000 : Int) * (D * D)) hsum_lb hsum_ub hss_nn hss_ub
+  have hH4m : ((4666000000000000000000000000 : Int) * D) * ((10885778000000000000000000000000000000000000000000000000 : Int) * (D * D)) =
+      (50793040148000000000000000000000000000000000000000000000000000000000000000000000000 : Int) *
+        (D * D * D) := by
+    have h : ((4666000000000000000000000000 : Int) * D) * ((10885778000000000000000000000000000000000000000000000000 : Int) * (D * D)) =
+        ((4666000000000000000000000000 : Int) * (10885778000000000000000000000000000000000000000000000000 : Int)) * (D * D * D) := by
+      simp only [Int.mul_assoc, Int.mul_comm, Int.mul_left_comm]
+    rw [h, show ((4666000000000000000000000000 : Int) * (10885778000000000000000000000000000000000000000000000000 : Int)) =
+      (50793040148000000000000000000000000000000000000000000000000000000000000000000000000 : Int)
+      from by decide]
+  rw [hH4m] at hH4
+  -- column differences from below
+  have hd2 := df2 n1 n2
+  have hd3 := df3 n1 n2
+  have hd4 := df4 n1 n2
+  have hd5 := df5 n1 n2
+  -- T2 lower bound
+  have hT2 : (-(690627211385037298547738551962892852267586075469791719173459072596031701017399264062472192 : Int)) * (n1 * n1) * (D * D * D) -
+      (-(690627211385037298547738551962892852267586075469791719173459072596031701017399264062472192 : Int)) * (n2 * n2) * (D * D * D) ≥
+      -((n1 - n2) * (3222466568322584035023748083458858048680556628142048161663360032733083916947184966115495247872000000000000000000000000 : Int) * (D * D * D * D)) := by
+    have e1 : (-(690627211385037298547738551962892852267586075469791719173459072596031701017399264062472192 : Int)) * (n1 * n1) * (D * D * D) -
+        (-(690627211385037298547738551962892852267586075469791719173459072596031701017399264062472192 : Int)) * (n2 * n2) * (D * D * D) =
+        ((-(690627211385037298547738551962892852267586075469791719173459072596031701017399264062472192 : Int)) * (n1 - n2) * (D * D * D)) * (n1 + n2) := by
+      rw [← Int.sub_mul, ← Int.mul_sub, hd2]
+      simp only [Int.mul_assoc, Int.mul_comm, Int.mul_left_comm]
+    rw [e1]
+    have hf : (-(690627211385037298547738551962892852267586075469791719173459072596031701017399264062472192 : Int)) * (n1 - n2) * (D * D * D) ≤ 0 := by
+      refine Int.mul_nonpos_of_nonpos_of_nonneg ?_ hDDD
+      exact Int.mul_nonpos_of_nonpos_of_nonneg (by decide) hmono
+    have step := mul_le_mul_left_nonpos hsum_ub hf
+    have e2 : (-(690627211385037298547738551962892852267586075469791719173459072596031701017399264062472192 : Int)) * (n1 - n2) * (D * D * D) * ((4666000000000000000000000000 : Int) * D) =
+        -((n1 - n2) * (3222466568322584035023748083458858048680556628142048161663360032733083916947184966115495247872000000000000000000000000 : Int) * (D * D * D * D)) := by
+      have h : (-(690627211385037298547738551962892852267586075469791719173459072596031701017399264062472192 : Int)) * (n1 - n2) * (D * D * D) * ((4666000000000000000000000000 : Int) * D) =
+          (n1 - n2) * ((-(690627211385037298547738551962892852267586075469791719173459072596031701017399264062472192 : Int)) * 4666000000000000000000000000) * (D * D * D * D) := by
+        simp only [Int.mul_assoc, Int.mul_comm, Int.mul_left_comm]
+      rw [h, show ((-(690627211385037298547738551962892852267586075469791719173459072596031701017399264062472192 : Int)) * 4666000000000000000000000000) = -(3222466568322584035023748083458858048680556628142048161663360032733083916947184966115495247872000000000000000000000000 : Int) from by decide]
+      rw [Int.mul_neg, Int.neg_mul]
+    omega
+  -- T3 nonnegative
+  have hT3 : ((2925363287404360843667081098480704995728827760271876675338240 : Int)) * (n1 * n1 * n1) * (D * D) - ((2925363287404360843667081098480704995728827760271876675338240 : Int)) * (n2 * n2 * n2) * (D * D) ≥ 0 := by
+    have e1 : ((2925363287404360843667081098480704995728827760271876675338240 : Int)) * (n1 * n1 * n1) * (D * D) - ((2925363287404360843667081098480704995728827760271876675338240 : Int)) * (n2 * n2 * n2) * (D * D) =
+        ((2925363287404360843667081098480704995728827760271876675338240 : Int)) * ((n1 - n2) * ((n1 * n1 + n1 * n2 + n2 * n2) * (D * D))) := by
+      rw [← Int.sub_mul, ← Int.mul_sub, hd3]
+      simp only [Int.mul_assoc, Int.mul_comm, Int.mul_left_comm]
+    rw [e1]
+    refine Int.mul_nonneg (by decide) ?_
+    exact Int.mul_nonneg hmono (Int.mul_nonneg hH3nn hDD)
+  -- T4 lower bound
+  have hT4 : (-(4299840983308505679614339668444 : Int)) * (n1 * n1 * n1 * n1) * D - (-(4299840983308505679614339668444 : Int)) * (n2 * n2 * n2 * n2) * D ≥
+      -((n1 - n2) * (218401995695204726854537179935785100689712000000000000000000000000000000000000000000000000000000000000000000000000 : Int) * (D * D * D * D)) := by
+    have e1 : (-(4299840983308505679614339668444 : Int)) * (n1 * n1 * n1 * n1) * D - (-(4299840983308505679614339668444 : Int)) * (n2 * n2 * n2 * n2) * D =
+        ((-(4299840983308505679614339668444 : Int)) * (n1 - n2) * D) * ((n1 + n2) * (n1 * n1 + n2 * n2)) := by
+      rw [← Int.sub_mul, ← Int.mul_sub, hd4]
+      simp only [Int.mul_assoc, Int.mul_comm, Int.mul_left_comm]
+    rw [e1]
+    have hf : (-(4299840983308505679614339668444 : Int)) * (n1 - n2) * D ≤ 0 := by
+      refine Int.mul_nonpos_of_nonpos_of_nonneg ?_ (by omega)
+      exact Int.mul_nonpos_of_nonpos_of_nonneg (by decide) hmono
+    have step := mul_le_mul_left_nonpos hH4.2 hf
+    have e2 : (-(4299840983308505679614339668444 : Int)) * (n1 - n2) * D * ((50793040148000000000000000000000000000000000000000000000000000000000000000000000000 : Int) * (D * D * D)) =
+        -((n1 - n2) * (218401995695204726854537179935785100689712000000000000000000000000000000000000000000000000000000000000000000000000 : Int) * (D * D * D * D)) := by
+      have h : (-(4299840983308505679614339668444 : Int)) * (n1 - n2) * D * ((50793040148000000000000000000000000000000000000000000000000000000000000000000000000 : Int) * (D * D * D)) =
+          (n1 - n2) * ((-(4299840983308505679614339668444 : Int)) * (50793040148000000000000000000000000000000000000000000000000000000000000000000000000 : Int)) * (D * D * D * D) := by
+        simp only [Int.mul_assoc, Int.mul_comm, Int.mul_left_comm]
+      rw [h, show ((-(4299840983308505679614339668444 : Int)) * (50793040148000000000000000000000000000000000000000000000000000000000000000000000000 : Int)) = -(218401995695204726854537179935785100689712000000000000000000000000000000000000000000000000000000000000000000000000 : Int) from by decide, Int.mul_neg, Int.neg_mul]
+    omega
+  -- T5 lower bound via the asymmetric quintic factor
+  have hT5 : n1 * n1 * n1 * n1 * n1 - n2 * n2 * n2 * n2 * n2 ≥
+      -((n1 - n2) * (118500162665284000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000 : Int) * (D * D * D * D)) := by
+    rw [hd5]
+    -- inner = (n1+n2)(n1²+n2²) is bounded by hH4; n1 inner ≥ -(UD)·4U³DDD
+    have hxin : n1 * ((n1 + n2) * (n1 * n1 + n2 * n2)) ≥
+        -(((2333000000000000000000000000 : Int) * D) * ((50793040148000000000000000000000000000000000000000000000000000000000000000000000000 : Int) * (D * D * D))) := by
+      rcases Int.le_total 0 ((n1 + n2) * (n1 * n1 + n2 * n2)) with h | h
+      · have s1 : n1 * ((n1 + n2) * (n1 * n1 + n2 * n2)) ≥
+            (-((2333000000000000000000000000 : Int) * D)) * ((n1 + n2) * (n1 * n1 + n2 * n2)) :=
+          mul_le_mul_right_nonneg hb1' h
+        have s2 : (-((2333000000000000000000000000 : Int) * D)) * ((n1 + n2) * (n1 * n1 + n2 * n2)) ≥
+            (-((2333000000000000000000000000 : Int) * D)) * ((50793040148000000000000000000000000000000000000000000000000000000000000000000000000 : Int) * (D * D * D)) := by
+          refine mul_le_mul_left_nonpos hH4.2 (by omega)
+        have e : (-((2333000000000000000000000000 : Int) * D)) * ((50793040148000000000000000000000000000000000000000000000000000000000000000000000000 : Int) * (D * D * D)) =
+            -(((2333000000000000000000000000 : Int) * D) * ((50793040148000000000000000000000000000000000000000000000000000000000000000000000000 : Int) * (D * D * D))) := Int.neg_mul _ _
+        omega
+      · have s1 : n1 * ((n1 + n2) * (n1 * n1 + n2 * n2)) ≥
+            ((2333000000000000000000000000 : Int) * D) * ((n1 + n2) * (n1 * n1 + n2 * n2)) :=
+          mul_le_mul_right_nonpos hb1 h
+        have s2 : ((2333000000000000000000000000 : Int) * D) * ((n1 + n2) * (n1 * n1 + n2 * n2)) ≥
+            ((2333000000000000000000000000 : Int) * D) * (-((50793040148000000000000000000000000000000000000000000000000000000000000000000000000 : Int) * (D * D * D))) :=
+          mul_le_mul_left_nonneg hH4.1 hUD
+        have e : ((2333000000000000000000000000 : Int) * D) * (-((50793040148000000000000000000000000000000000000000000000000000000000000000000000000 : Int) * (D * D * D))) =
+            -(((2333000000000000000000000000 : Int) * D) * ((50793040148000000000000000000000000000000000000000000000000000000000000000000000000 : Int) * (D * D * D))) := Int.mul_neg _ _
+        omega
+    have hy4 : 0 ≤ n2 * n2 * n2 * n2 := by
+      have h : n2 * n2 * n2 * n2 = (n2 * n2) * (n2 * n2) := by
+        simp only [Int.mul_assoc]
+      rw [h]
+      exact sq_nonneg' (n2 * n2)
+    have hmerge : ((2333000000000000000000000000 : Int) * D) * ((50793040148000000000000000000000000000000000000000000000000000000000000000000000000 : Int) * (D * D * D)) =
+        (118500162665284000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000 : Int) * (D * D * D * D) := by
+      have h : ((2333000000000000000000000000 : Int) * D) * ((50793040148000000000000000000000000000000000000000000000000000000000000000000000000 : Int) * (D * D * D)) =
+          ((2333000000000000000000000000 : Int) * (50793040148000000000000000000000000000000000000000000000000000000000000000000000000 : Int)) * (D * D * D * D) := by
+        simp only [Int.mul_assoc, Int.mul_comm, Int.mul_left_comm]
+      rw [h, show ((2333000000000000000000000000 : Int) * (50793040148000000000000000000000000000000000000000000000000000000000000000000000000 : Int)) = (118500162665284000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000 : Int) from by decide]
+    have hkey : n1 * ((n1 + n2) * (n1 * n1 + n2 * n2)) + n2 * n2 * n2 * n2 ≥
+        -((118500162665284000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000 : Int) * (D * D * D * D)) := by
+      rw [← hmerge]
+      omega
+    have step : (n1 - n2) * (n1 * ((n1 + n2) * (n1 * n1 + n2 * n2)) + n2 * n2 * n2 * n2) ≥
+        (n1 - n2) * (-((118500162665284000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000 : Int) * (D * D * D * D))) :=
+      mul_le_mul_left_nonneg hkey hmono
+    have e : (n1 - n2) * (-((118500162665284000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000 : Int) * (D * D * D * D))) =
+        -((n1 - n2) * (118500162665284000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000 : Int) * (D * D * D * D)) := by
+      rw [Int.mul_neg]
+      have h : (n1 - n2) * (118500162665284000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000 : Int) * (D * D * D * D) =
+          (n1 - n2) * ((118500162665284000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000 : Int) * (D * D * D * D)) := by
+        rw [Int.mul_assoc]
+      rw [h]
+    omega
+  -- T1 exact
+  have hT1 : (66099322585698201304896817119133314370855648754593283446756353822335972946493244703677923116935407234039976856169480192 : Int) * n1 * (D * D * D * D) - (66099322585698201304896817119133314370855648754593283446756353822335972946493244703677923116935407234039976856169480192 : Int) * n2 * (D * D * D * D) =
+      (n1 - n2) * (66099322585698201304896817119133314370855648754593283446756353822335972946493244703677923116935407234039976856169480192 : Int) * (D * D * D * D) := by
+    rw [← Int.sub_mul, ← Int.mul_sub]
+    have : (66099322585698201304896817119133314370855648754593283446756353822335972946493244703677923116935407234039976856169480192 : Int) * (n1 - n2) = (n1 - n2) * (66099322585698201304896817119133314370855648754593283446756353822335972946493244703677923116935407234039976856169480192 : Int) := Int.mul_comm _ _
+    rw [this]
+  -- the bounds sum to something nonnegative
+  have hsumQ : (n1 - n2) * (66099322585698201304896817119133314370855648754593283446756353822335972946493244703677923116935407234039976856169480192 : Int) * (D * D * D * D) -
+      (n1 - n2) * (3222466568322584035023748083458858048680556628142048161663360032733083916947184966115495247872000000000000000000000000 : Int) * (D * D * D * D) -
+      (n1 - n2) * (218401995695204726854537179935785100689712000000000000000000000000000000000000000000000000000000000000000000000000 : Int) * (D * D * D * D) -
+      (n1 - n2) * (118500162665284000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000 : Int) * (D * D * D * D) ≥ 0 := by
+    have e1 : (n1 - n2) * (66099322585698201304896817119133314370855648754593283446756353822335972946493244703677923116935407234039976856169480192 : Int) * (D * D * D * D) -
+        (n1 - n2) * (3222466568322584035023748083458858048680556628142048161663360032733083916947184966115495247872000000000000000000000000 : Int) * (D * D * D * D) -
+        (n1 - n2) * (218401995695204726854537179935785100689712000000000000000000000000000000000000000000000000000000000000000000000000 : Int) * (D * D * D * D) -
+        (n1 - n2) * (118500162665284000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000 : Int) * (D * D * D * D) =
+        (n1 - n2) * (62876637496879759399862214498494520537074402414451235285092993789602889029546059737562427869063407234039976856169480192 : Int) * (D * D * D * D) := by
+      have h : (n1 - n2) * (66099322585698201304896817119133314370855648754593283446756353822335972946493244703677923116935407234039976856169480192 : Int) * (D * D * D * D) -
+          (n1 - n2) * (3222466568322584035023748083458858048680556628142048161663360032733083916947184966115495247872000000000000000000000000 : Int) * (D * D * D * D) -
+          (n1 - n2) * (218401995695204726854537179935785100689712000000000000000000000000000000000000000000000000000000000000000000000000 : Int) * (D * D * D * D) -
+          (n1 - n2) * (118500162665284000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000 : Int) * (D * D * D * D) =
+          (n1 - n2) * ((66099322585698201304896817119133314370855648754593283446756353822335972946493244703677923116935407234039976856169480192 : Int) - (3222466568322584035023748083458858048680556628142048161663360032733083916947184966115495247872000000000000000000000000 : Int) - (218401995695204726854537179935785100689712000000000000000000000000000000000000000000000000000000000000000000000000 : Int) - (118500162665284000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000 : Int)) * (D * D * D * D) := by
+        generalize n1 - n2 = w
+        have a1 : w * (66099322585698201304896817119133314370855648754593283446756353822335972946493244703677923116935407234039976856169480192 : Int) * (D * D * D * D) = (66099322585698201304896817119133314370855648754593283446756353822335972946493244703677923116935407234039976856169480192 : Int) * (w * (D * D * D * D)) := by
+          simp only [Int.mul_assoc, Int.mul_comm, Int.mul_left_comm]
+        have a2 : w * (3222466568322584035023748083458858048680556628142048161663360032733083916947184966115495247872000000000000000000000000 : Int) * (D * D * D * D) = (3222466568322584035023748083458858048680556628142048161663360032733083916947184966115495247872000000000000000000000000 : Int) * (w * (D * D * D * D)) := by
+          simp only [Int.mul_assoc, Int.mul_comm, Int.mul_left_comm]
+        have a3 : w * (218401995695204726854537179935785100689712000000000000000000000000000000000000000000000000000000000000000000000000 : Int) * (D * D * D * D) = (218401995695204726854537179935785100689712000000000000000000000000000000000000000000000000000000000000000000000000 : Int) * (w * (D * D * D * D)) := by
+          simp only [Int.mul_assoc, Int.mul_comm, Int.mul_left_comm]
+        have a4 : w * (118500162665284000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000 : Int) * (D * D * D * D) = (118500162665284000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000 : Int) * (w * (D * D * D * D)) := by
+          simp only [Int.mul_assoc, Int.mul_comm, Int.mul_left_comm]
+        have a5 : w * ((66099322585698201304896817119133314370855648754593283446756353822335972946493244703677923116935407234039976856169480192 : Int) - (3222466568322584035023748083458858048680556628142048161663360032733083916947184966115495247872000000000000000000000000 : Int) - (218401995695204726854537179935785100689712000000000000000000000000000000000000000000000000000000000000000000000000 : Int) - (118500162665284000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000 : Int)) * (D * D * D * D) =
+            ((66099322585698201304896817119133314370855648754593283446756353822335972946493244703677923116935407234039976856169480192 : Int) - (3222466568322584035023748083458858048680556628142048161663360032733083916947184966115495247872000000000000000000000000 : Int) - (218401995695204726854537179935785100689712000000000000000000000000000000000000000000000000000000000000000000000000 : Int) - (118500162665284000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000 : Int)) * (w * (D * D * D * D)) := by
+          simp only [Int.mul_assoc, Int.mul_comm, Int.mul_left_comm]
+        omega
+      rw [h, show ((66099322585698201304896817119133314370855648754593283446756353822335972946493244703677923116935407234039976856169480192 : Int) - (3222466568322584035023748083458858048680556628142048161663360032733083916947184966115495247872000000000000000000000000 : Int) - (218401995695204726854537179935785100689712000000000000000000000000000000000000000000000000000000000000000000000000 : Int) - (118500162665284000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000 : Int)) = (62876637496879759399862214498494520537074402414451235285092993789602889029546059737562427869063407234039976856169480192 : Int) from by decide]
+    rw [e1]
+    exact Int.mul_nonneg (Int.mul_nonneg hmono (by decide)) hDDDD
+  generalize (66099322585698201304896817119133314370855648754593283446756353822335972946493244703677923116935407234039976856169480192 : Int) * n1 * (D * D * D * D) = a1 at *
+  generalize (66099322585698201304896817119133314370855648754593283446756353822335972946493244703677923116935407234039976856169480192 : Int) * n2 * (D * D * D * D) = a2 at *
+  generalize (-(690627211385037298547738551962892852267586075469791719173459072596031701017399264062472192 : Int)) * (n1 * n1) * (D * D * D) = b1 at *
+  generalize (-(690627211385037298547738551962892852267586075469791719173459072596031701017399264062472192 : Int)) * (n2 * n2) * (D * D * D) = b2 at *
+  generalize ((2925363287404360843667081098480704995728827760271876675338240 : Int)) * (n1 * n1 * n1) * (D * D) = c1v at *
+  generalize ((2925363287404360843667081098480704995728827760271876675338240 : Int)) * (n2 * n2 * n2) * (D * D) = c2v at *
+  generalize (-(4299840983308505679614339668444 : Int)) * (n1 * n1 * n1 * n1) * D = d1v at *
+  generalize (-(4299840983308505679614339668444 : Int)) * (n2 * n2 * n2 * n2) * D = d2v at *
+  generalize n1 * n1 * n1 * n1 * n1 = e1v at *
+  generalize n2 * n2 * n2 * n2 * n2 = e2v at *
+  generalize (n1 - n2) * (66099322585698201304896817119133314370855648754593283446756353822335972946493244703677923116935407234039976856169480192 : Int) * (D * D * D * D) = g1 at *
+  generalize (n1 - n2) * (3222466568322584035023748083458858048680556628142048161663360032733083916947184966115495247872000000000000000000000000 : Int) * (D * D * D * D) = g2 at *
+  generalize (n1 - n2) * (218401995695204726854537179935785100689712000000000000000000000000000000000000000000000000000000000000000000000000 : Int) * (D * D * D * D) = g4 at *
+  generalize (n1 - n2) * (118500162665284000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000 : Int) * (D * D * D * D) = g5 at *
+  omega
+
+/-! ## Cross-theorems: the pipeline value against the certificate rationals -/
+
+/-- Small-list evaluations for the certificate building blocks. -/
+theorem pow_pos' {a : Int} (h : 0 < a) : ∀ n, 0 < a ^ n := by
+  intro n
+  induction n with
+  | zero =>
+    show (0 : Int) < a ^ 0
+    rw [Int.pow_zero]
+    omega
+  | succ k ih =>
+    rw [Int.pow_succ]
+    exact Int.mul_pos ih h
+
+theorem pow_nonneg' {a : Int} (h : 0 ≤ a) : ∀ n, 0 ≤ a ^ n := by
+  intro n
+  induction n with
+  | zero =>
+    show (0 : Int) ≤ a ^ 0
+    rw [Int.pow_zero]
+    omega
+  | succ k ih =>
+    rw [Int.pow_succ]
+    exact Int.mul_nonneg ih h
+theorem evalA_ge (m : Nat) : evalPoly geA (m : Int) = (m : Int) - Sc := by
+  show -(Sc : Int) + (m : Int) * (1 + (m : Int) * 0) = _
+  omega
+
+theorem evalB_ge (m : Nat) : evalPoly geB (m : Int) = (m : Int) + Sc := by
+  show (Sc : Int) + (m : Int) * (1 + (m : Int) * 0) = _
+  omega
+
+theorem evalB2_ge (m : Nat) :
+    evalPoly geB2 (m : Int) = ((m : Int) + Sc) * ((m : Int) + Sc) := by
+  show evalPoly (polyMul geB geB) (m : Int) = _
+  rw [evalPoly_polyMul, evalB_ge]
+
+theorem evalA2_ge (m : Nat) :
+    evalPoly geA2 (m : Int) = ((m : Int) - Sc) * ((m : Int) - Sc) := by
+  show evalPoly (polyMul geA geA) (m : Int) = _
+  rw [evalPoly_polyMul, evalA_ge]
+
+theorem evalD8_ge (m : Nat) :
+    evalPoly geD8 (m : Int) = 8 * (((m : Int) + Sc) * ((m : Int) + Sc)) := by
+  show evalPoly (polyScale 8 geB2) (m : Int) = _
+  rw [evalPoly_polyScale, evalB2_ge]
+
+theorem evalA96_ge (m : Nat) :
+    evalPoly geA96 (m : Int) = 2 ^ 96 * (((m : Int) - Sc) * ((m : Int) - Sc)) := by
+  show evalPoly (polyScale (2 ^ 96) geA2) (m : Int) = _
+  rw [evalPoly_polyScale, evalA2_ge]
+
+theorem evalWLO_ge (m : Nat) :
+    evalPoly geWLO (m : Int) =
+      2 ^ 99 * (((m : Int) - Sc) * ((m : Int) - Sc)) -
+        ((m : Int) - Sc) * ((m : Int) + Sc) -
+        8 * (((m : Int) + Sc) * ((m : Int) + Sc)) := by
+  show evalPoly (polyAdd (polyAdd (polyScale (2 ^ 99) geA2)
+    (polyNeg (polyMul geA geB))) (polyScale (-8) geB2)) (m : Int) = _
+  rw [evalPoly_polyAdd, evalPoly_polyAdd, evalPoly_polyScale, evalPoly_polyNeg,
+    evalPoly_polyMul, evalPoly_polyScale, evalA2_ge, evalA_ge, evalB_ge, evalB2_ge]
+  omega
+
+theorem evalTN_ge (m : Nat) :
+    evalPoly geTN (m : Int) =
+      2 ^ 17 * ((((m : Int) - Sc) * (((m : Int) + Sc))) *
+        homEvalI PPc (evalPoly geWLO (m : Int)) (evalPoly geD8 (m : Int))) := by
+  show evalPoly (polyScale (2 ^ 17) (polyMul (polyMul geA geB) gePPHwlo)) (m : Int) = _
+  rw [evalPoly_polyScale, evalPoly_polyMul, evalPoly_polyMul, evalA_ge, evalB_ge]
+  have h : evalPoly gePPHwlo (m : Int) =
+      homEvalI PPc (evalPoly geWLO (m : Int)) (evalPoly geD8 (m : Int)) := by
+    show evalPoly (homPoly PPc geWLO geD8) (m : Int) = _
+    exact evalPoly_homPoly PPc geWLO geD8 (m : Int)
+  rw [h]
+
+theorem evalTD_ge (m : Nat) :
+    evalPoly geTD (m : Int) =
+      -homEvalI QQc (evalPoly geA96 (m : Int)) (evalPoly geB2 (m : Int)) := by
+  show evalPoly (polyNeg geQQHws) (m : Int) = _
+  rw [evalPoly_polyNeg]
+  have h : evalPoly geQQHws (m : Int) =
+      homEvalI QQc (evalPoly geA96 (m : Int)) (evalPoly geB2 (m : Int)) := by
+    show evalPoly (homPoly QQc geA96 geB2) (m : Int) = _
+    exact evalPoly_homPoly QQc geA96 geB2 (m : Int)
+  rw [h]
+
+theorem evalWS_ge (m : Nat) :
+    evalPoly certGeWS (m : Int) =
+      2333000000000000000000000000 * (((m : Int) + Sc) * ((m : Int) + Sc)) -
+        2 ^ 96 * (((m : Int) - Sc) * ((m : Int) - Sc)) := by
+  show evalPoly (polyAdd (polyScale UB geB2) (polyScale (-(2 ^ 96)) geA2)) (m : Int) = _
+  rw [evalPoly_polyAdd, evalPoly_polyScale, evalPoly_polyScale, evalB2_ge, evalA2_ge]
+  show UB * _ + _ = _
+  rw [show UB = (2333000000000000000000000000 : Int) from rfl]
+  omega
+
+theorem evalPLOP_ge (m : Nat) :
+    evalPoly gePLOP (m : Int) =
+      homEvalI PPc (evalPoly geA96 (m : Int)) (evalPoly geB2 (m : Int)) -
+        SLOPPc * evalPoly geB2 (m : Int) ^ 4 := by
+  show evalPoly (polyAdd gePPHws (polyScale (-SLOPPc) (polyPow geB2 4))) (m : Int) = _
+  rw [evalPoly_polyAdd, evalPoly_polyScale, evalPoly_polyPow]
+  have h : evalPoly gePPHws (m : Int) =
+      homEvalI PPc (evalPoly geA96 (m : Int)) (evalPoly geB2 (m : Int)) := by
+    show evalPoly (homPoly PPc geA96 geB2) (m : Int) = _
+    exact evalPoly_homPoly PPc geA96 geB2 (m : Int)
+  rw [h, Int.sub_eq_add_neg, Int.neg_mul]
+
+theorem evalDLO_ge (m : Nat) :
+    evalPoly geDLO (m : Int) =
+      -homEvalI QQc (evalPoly geWLO (m : Int)) (evalPoly geD8 (m : Int)) +
+        SLOPQc * evalPoly geD8 (m : Int) ^ 5 := by
+  show evalPoly (polyAdd (polyNeg geQQHwlo) (polyScale SLOPQc (polyPow geD8 5))) (m : Int) = _
+  rw [evalPoly_polyAdd, evalPoly_polyNeg, evalPoly_polyScale, evalPoly_polyPow]
+  have h : evalPoly geQQHwlo (m : Int) =
+      homEvalI QQc (evalPoly geWLO (m : Int)) (evalPoly geD8 (m : Int)) := by
+    show evalPoly (homPoly QQc geWLO geD8) (m : Int) = _
+    exact evalPoly_homPoly QQc geWLO geD8 (m : Int)
+  rw [h]
+
+theorem evalAZ_ge (m : Nat) :
+    evalPoly geAZ (m : Int) = 2 ^ 100 * ((m : Int) - Sc) - ((m : Int) + Sc) := by
+  show evalPoly (polyAdd (polyScale (2 ^ 100) geA) (polyNeg geB)) (m : Int) = _
+  rw [evalPoly_polyAdd, evalPoly_polyScale, evalPoly_polyNeg, evalA_ge, evalB_ge]
+  have e : (2 : Int) ^ 100 * ((m : Int) - Sc) = 2 ^ 100 * (m : Int) - 2 ^ 100 * Sc := by
+    rw [Int.mul_sub]
+  omega
+
+theorem evalTN2b_ge (m : Nat) :
+    evalPoly geTN2b (m : Int) =
+      2 ^ 99 * (evalPoly gePLOP (m : Int) * evalPoly geAZ (m : Int) *
+        ((m : Int) + Sc)) - 2 ^ 56 * evalPoly geDLO (m : Int) := by
+  show evalPoly (polyAdd (polyScale (2 ^ 99) geTN2) (polyNeg geTD2)) (m : Int) = _
+  rw [evalPoly_polyAdd, evalPoly_polyScale, evalPoly_polyNeg]
+  have h1 : evalPoly geTN2 (m : Int) =
+      evalPoly gePLOP (m : Int) * evalPoly geAZ (m : Int) * ((m : Int) + Sc) := by
+    show evalPoly (polyMul (polyMul gePLOP geAZ) geB) (m : Int) = _
+    rw [evalPoly_polyMul, evalPoly_polyMul, evalB_ge]
+  have h2 : evalPoly geTD2 (m : Int) = 2 ^ 56 * evalPoly geDLO (m : Int) := by
+    show evalPoly (polyScale (2 ^ 56) geDLO) (m : Int) = _
+    rw [evalPoly_polyScale]
+  rw [h1, h2, Int.sub_eq_add_neg]
+
+theorem evalTD2b_ge (m : Nat) :
+    evalPoly geTD2b (m : Int) = 2 ^ 99 * (2 ^ 56 * evalPoly geDLO (m : Int)) := by
+  show evalPoly (polyScale (2 ^ 99) geTD2) (m : Int) = _
+  rw [evalPoly_polyScale]
+  have h2 : evalPoly geTD2 (m : Int) = 2 ^ 56 * evalPoly geDLO (m : Int) := by
+    show evalPoly (polyScale (2 ^ 56) geDLO) (m : Int) = _
+    rw [evalPoly_polyScale]
+  rw [h2]
+
+/-- The pipeline value sits below the upper certificate rational on the
+`m ≥ S` branch: `X1 · TD(m) ≤ TN(m) · 2^99`. -/
+theorem bracket_ge_up {m : Nat} (h1 : Sc + 46 ≤ m) (h2 : m < MHI) :
+    toInt (x1W (zWord m)) * evalPoly geTD (m : Int) ≤
+      evalPoly geTN (m : Int) * 2 ^ 99 := by
+  have hMLO : MLO ≤ m := by
+    simp only [MLO]; simp only [Sc] at h1; omega
+  have hSle : Sc ≤ m := by simp only [Sc] at h1 ⊢; omega
+  -- z and its division bracket
+  obtain ⟨q, hzq, hq1, hq2⟩ := z_bracket_ge hSle h2
+  have hzr := zWord_range hMLO h2
+  have hwlt : zWord m < 2 ^ 256 := by unfold zWord; exact evmSdiv_lt _ _
+  have hx1 : x1W (zWord m) = hAt (toInt (zWord m)) := by
+    unfold hAt; rw [ofInt_toInt hwlt]
+  obtain ⟨heq, hmul⟩ := hAt_facts (toInt (zWord m)) hzr.1 hzr.2
+  -- u-hat and its division bracket
+  have huv : uVal (toInt (zWord m)) = q * q / 2 ^ 104 := by
+    unfold uVal
+    rw [hzq]
+    have e : -(q : Int) * -(q : Int) = ((q * q : Nat) : Int) := by
+      rw [Int.neg_mul_neg]
+      omega
+    rw [e]
+    omega
+  have hu_le : q * q / 2 ^ 104 ≤ Uc := by
+    have := uVal_le (toInt (zWord m)) hzr.1 hzr.2
+    rw [huv] at this
+    exact this
+  have hudm := Nat.div_add_mod (q * q) (2 ^ 104)
+  have huml := Nat.mod_lt (q * q) (y := 2 ^ 104) (by omega)
+  -- the quotient is at least one on this branch
+  have hq_ge1 : 1 ≤ q := by
+    rcases Nat.eq_zero_or_pos q with h0 | h
+    · exfalso
+      subst h0
+      have hA46 : (46 : Int) ≤ (m : Int) - Sc := by simp only [Sc] at h1 ⊢; omega
+      have hBmax : (m : Int) + Sc ≤ 34624238973196922243142627472244 := by
+        simp only [MHI] at h2; simp only [Sc]; omega
+      have h46 : (46 : Int) * 2 ^ 100 ≤ ((m : Int) - Sc) * 2 ^ 100 :=
+        mul_le_mul_right_nonneg hA46 (by omega)
+      omega
+    · exact h
+  -- stage sandwiches at u-hat, with every heavy term made opaque
+  obtain ⟨pw, plo, phi, psl, psh⟩ := pS4_facts hu_le
+  obtain ⟨qw, qlo, qhi, qsl, qsh⟩ := qS5_facts hu_le
+  rw [huv] at heq hmul
+  generalize hw1 : pS4 (q * q / 2 ^ 104) = pword at heq hmul pw plo phi psl psh
+  generalize hw2 : qS5 (q * q / 2 ^ 104) = qword at heq qw qlo qhi qsl qsh
+  generalize hPP : evalPoly PPc ((q * q / 2 ^ 104 : Nat) : Int) = PPv at psl psh
+  generalize hQQ : evalPoly QQc ((q * q / 2 ^ 104 : Nat) : Int) = QQv at qsl qsh
+  have hxe : x1W (zWord m) = evmSdiv (evmMul pword (ofInt (toInt (zWord m)))) qword :=
+    hx1.trans heq
+  have hnum_neg : toInt (evmMul pword (ofInt (toInt (zWord m)))) < 0 := by
+    rw [hmul, hzq]
+    have h := mul_le_mul_left_nonneg (show (1 : Int) ≤ (q : Int) by omega)
+      (show (0 : Int) ≤ toInt pword by omega)
+    have e : toInt pword * -(q : Int) = -(toInt pword * (q : Int)) := Int.mul_neg _ _
+    omega
+  have hpz := pz_bound plo phi hzr.1 hzr.2
+  have hX1v : toInt (x1W (zWord m)) =
+      (((toInt pword * (q : Int)).toNat / (-toInt qword).toNat : Nat) : Int) := by
+    rw [hxe, evmSdiv_neg_neg (evmMul_lt _ _) qw hnum_neg
+      (by rw [hmul]; exact hpz.1) (by omega), hmul, hzq]
+    have e : -(toInt pword * -(q : Int)) = toInt pword * (q : Int) := by
+      rw [Int.mul_neg]
+      omega
+    rw [e]
+  have hpq_pos : (0 : Int) ≤ toInt pword * (q : Int) :=
+    Int.mul_nonneg (by omega) (by omega)
+  have hX1_nn : (0 : Int) ≤ toInt (x1W (zWord m)) := by
+    rw [hX1v]
+    exact Int.natCast_nonneg _
+  -- the division bracket for X1
+  have hdiv := Nat.div_mul_le_self (toInt pword * (q : Int)).toNat (-toInt qword).toNat
+  have hX1br : toInt (x1W (zWord m)) * (-toInt qword) ≤ toInt pword * (q : Int) := by
+    rw [hX1v]
+    have e : (((toInt pword * (q : Int)).toNat / (-toInt qword).toNat : Nat) : Int) *
+        (-toInt qword) =
+        ((((toInt pword * (q : Int)).toNat / (-toInt qword).toNat) *
+          (-toInt qword).toNat : Nat) : Int) := by
+      rw [Int.natCast_mul]
+      have : ((-toInt qword).toNat : Int) = -toInt qword := by omega
+      rw [this]
+    rw [e]
+    omega
+  clear heq hxe hmul hX1v hnum_neg hdiv hpz hx1 hzr hwlt hudm huml hzq hw1 hw2
+  generalize hXg : toInt (x1W (zWord m)) = X1v at hX1br hX1_nn ⊢
+  -- value abbreviations
+  have huI1 : ((q * q / 2 ^ 104 : Nat) : Int) * 2 ^ 104 ≤ (q : Int) * q := by
+    have e : (q : Int) * q = ((q * q : Nat) : Int) := by omega
+    rw [e]
+    omega
+  have huI2 : (q : Int) * q ≤ ((q * q / 2 ^ 104 : Nat) : Int) * 2 ^ 104 + 2 ^ 104 - 1 := by
+    have e : (q : Int) * q = ((q * q : Nat) : Int) := by omega
+    rw [e]
+    omega
+  -- ordering of the P arguments: WLO ≤ u-hat · D8
+  have hcastA : ((m - Sc : Nat) : Int) = (m : Int) - Sc := by omega
+  have hcastB : ((m + Sc : Nat) : Int) = (m : Int) + Sc := by omega
+  have hwloLt := wlo_lt_un (d := m - Sc) (q := q) (u := q * q / 2 ^ 104)
+    (B := m + Sc) (by omega)
+    (by omega) (by simp only [MHI] at h2; simp only [Sc] at *; omega)
+    (by rw [hcastA, hcastB]; exact hq2)
+    huI2
+  have hordP : evalPoly geWLO (m : Int) ≤
+      ((q * q / 2 ^ 104 : Nat) : Int) * evalPoly geD8 (m : Int) := by
+    rw [evalWLO_ge, evalD8_ge]
+    rw [hcastA, hcastB] at hwloLt
+    have e1 : ((q * q / 2 ^ 104 : Nat) : Int) * (8 * (((m : Int) + Sc) * ((m : Int) + Sc))) =
+        8 * (((q * q / 2 ^ 104 : Nat) : Int) * (((m : Int) + Sc) * ((m : Int) + Sc))) := by
+      simp only [Int.mul_assoc, Int.mul_comm, Int.mul_left_comm]
+    have e2 : (((m : Int) - Sc) * ((m : Int) - Sc)) * 2 ^ 99 =
+        2 ^ 99 * (((m : Int) - Sc) * ((m : Int) - Sc)) := Int.mul_comm _ _
+    omega
+  -- ordering of the Q arguments: u-hat · B2 ≤ A96
+  have hunle := un_le_dsq (d := m - Sc) (q := q) (u := q * q / 2 ^ 104)
+    (B := m + Sc) (by omega)
+    (by rw [hcastA, hcastB]; exact hq1) huI1
+  have hordQ : ((q * q / 2 ^ 104 : Nat) : Int) * evalPoly geB2 (m : Int) ≤
+      evalPoly geA96 (m : Int) := by
+    rw [evalB2_ge, evalA96_ge]
+    rw [hcastA, hcastB] at hunle
+    exact hunle
+  -- box bounds
+  have hB2nn : (0 : Int) ≤ evalPoly geB2 (m : Int) := by
+    rw [evalB2_ge]
+    exact Int.mul_nonneg (by simp only [Sc]; omega) (by simp only [Sc]; omega)
+  have hD8nn : (0 : Int) ≤ evalPoly geD8 (m : Int) := by
+    rw [evalD8_ge]
+    refine Int.mul_nonneg (by omega) (Int.mul_nonneg ?_ ?_) <;>
+      simp only [Sc] <;> omega
+  have hu_lt_UB : ((q * q / 2 ^ 104 : Nat) : Int) ≤ 2333000000000000000000000000 := by
+    simp only [Uc] at hu_le
+    omega
+  have hb1P : ((q * q / 2 ^ 104 : Nat) : Int) * evalPoly geD8 (m : Int) ≤
+      2333000000000000000000000000 * evalPoly geD8 (m : Int) :=
+    mul_le_mul_right_nonneg hu_lt_UB hD8nn
+  have hb2P : -(2333000000000000000000000000 * evalPoly geD8 (m : Int)) ≤
+      evalPoly geWLO (m : Int) := by
+    rw [evalWLO_ge, evalD8_ge]
+    have hAB : ((m : Int) - Sc) * ((m : Int) + Sc) ≤
+        ((m : Int) + Sc) * ((m : Int) + Sc) :=
+      mul_le_mul_right_nonneg (by omega) (by simp only [Sc]; omega)
+    have hsq : (0 : Int) ≤ (((m : Int) - Sc) * ((m : Int) - Sc)) := by
+      refine Int.mul_nonneg ?_ ?_ <;> simp only [Sc] at h1 ⊢ <;> omega
+    have hBB : (0 : Int) ≤ ((m : Int) + Sc) * ((m : Int) + Sc) := by
+      refine Int.mul_nonneg ?_ ?_ <;> simp only [Sc] <;> omega
+    generalize ((m : Int) - Sc) * ((m : Int) - Sc) = AA at *
+    generalize ((m : Int) - Sc) * ((m : Int) + Sc) = AB at *
+    generalize ((m : Int) + Sc) * ((m : Int) + Sc) = BB at *
+    have h99 : (0 : Int) ≤ 2 ^ 99 * AA := Int.mul_nonneg (by omega) hsq
+    omega
+  -- P comparison through collapse and monotonicity
+  have hcolP : homEvalI PPc (((q * q / 2 ^ 104 : Nat) : Int) *
+      evalPoly geD8 (m : Int)) (evalPoly geD8 (m : Int)) =
+      evalPoly geD8 (m : Int) ^ 4 * PPv := by
+    rw [show PPc = (8203564106909714963200842018502018851024462725819431901516251320229929630934299039494945066816553616430456446611805193566972803059892092928 : Int) :: PP3c from rfl,
+      homEvalI_collapse, ← hPP]
+    rfl
+  have hBpos : (0 : Int) < (m : Int) + Sc := by simp only [Sc]; omega
+  have hD8pos : (0 : Int) < evalPoly geD8 (m : Int) := by
+    rw [evalD8_ge]
+    exact Int.mul_pos (by omega) (Int.mul_pos hBpos hBpos)
+  have hB2pos : (0 : Int) < evalPoly geB2 (m : Int) := by
+    rw [evalB2_ge]
+    exact Int.mul_pos hBpos hBpos
+  have hPanti := homEvalI_PPc_anti (n1 := ((q * q / 2 ^ 104 : Nat) : Int) *
+      evalPoly geD8 (m : Int)) (n2 := evalPoly geWLO (m : Int))
+    (D := evalPoly geD8 (m : Int)) hD8pos hordP hb1P hb2P
+  have hPfin : toInt pword * 2 ^ 358 * evalPoly geD8 (m : Int) ^ 4 ≤
+      homEvalI PPc (evalPoly geWLO (m : Int)) (evalPoly geD8 (m : Int)) := by
+    have hD84 : (0 : Int) ≤ evalPoly geD8 (m : Int) ^ 4 := by
+      have h2' : evalPoly geD8 (m : Int) ^ 2 = evalPoly geD8 (m : Int) *
+          evalPoly geD8 (m : Int) := by
+        have h := Int.pow_succ (evalPoly geD8 (m : Int)) 1
+        rw [Int.pow_one] at h
+        exact h
+      have h4' : evalPoly geD8 (m : Int) ^ 4 = evalPoly geD8 (m : Int) ^ 2 *
+          evalPoly geD8 (m : Int) ^ 2 := by
+        have h3 := Int.pow_succ (evalPoly geD8 (m : Int)) 2
+        have h4 := Int.pow_succ (evalPoly geD8 (m : Int)) 3
+        rw [h3] at h4
+        rw [h4, h2']
+        simp only [Int.mul_assoc]
+      rw [h4', h2']
+      exact Int.mul_nonneg (Int.mul_nonneg (by omega) (by omega))
+        (Int.mul_nonneg (by omega) (by omega))
+    have s1 : toInt pword * 2 ^ 358 * evalPoly geD8 (m : Int) ^ 4 ≤
+        PPv * evalPoly geD8 (m : Int) ^ 4 :=
+      mul_le_mul_right_nonneg psh hD84
+    have e1 : PPv * evalPoly geD8 (m : Int) ^ 4 =
+        evalPoly geD8 (m : Int) ^ 4 * PPv := Int.mul_comm _ _
+    generalize hg1 : homEvalI PPc (((q * q / 2 ^ 104 : Nat) : Int) *
+      evalPoly geD8 (m : Int)) (evalPoly geD8 (m : Int)) = HU at hPanti hcolP
+    generalize hg2 : homEvalI PPc (evalPoly geWLO (m : Int))
+      (evalPoly geD8 (m : Int)) = HW at hPanti ⊢
+    generalize hg3 : PPv * evalPoly geD8 (m : Int) ^ 4 = P1 at s1 e1
+    generalize hg4 : evalPoly geD8 (m : Int) ^ 4 * PPv = P2 at e1 hcolP
+    generalize hg5 : toInt pword * 2 ^ 358 * evalPoly geD8 (m : Int) ^ 4 = P0 at s1 ⊢
+    omega
+  -- Q comparison
+  have hb1Q : evalPoly geA96 (m : Int) ≤
+      2333000000000000000000000000 * evalPoly geB2 (m : Int) := by
+    have hws := geWS_nonneg (m := (m : Int))
+      (by simp only [Sc] at h1; omega) (by simp only [MHI] at h2; omega)
+    rw [evalWS_ge] at hws
+    rw [evalA96_ge, evalB2_ge]
+    omega
+  have hb2Q : -(2333000000000000000000000000 * evalPoly geB2 (m : Int)) ≤
+      ((q * q / 2 ^ 104 : Nat) : Int) * evalPoly geB2 (m : Int) := by
+    have h := Int.mul_nonneg (Int.natCast_nonneg (q * q / 2 ^ 104)) (by omega :
+      (0 : Int) ≤ evalPoly geB2 (m : Int))
+    have h2' : (0 : Int) ≤ 2333000000000000000000000000 * evalPoly geB2 (m : Int) :=
+      Int.mul_nonneg (by omega) (by omega)
+    omega
+  have hQmono := homEvalI_QQc_mono (n1 := evalPoly geA96 (m : Int))
+    (n2 := ((q * q / 2 ^ 104 : Nat) : Int) * evalPoly geB2 (m : Int))
+    (D := evalPoly geB2 (m : Int)) hB2pos hordQ hb1Q hb2Q
+  have hcolQ : homEvalI QQc (((q * q / 2 ^ 104 : Nat) : Int) *
+      evalPoly geB2 (m : Int)) (evalPoly geB2 (m : Int)) =
+      evalPoly geB2 (m : Int) ^ 5 * QQv := by
+    rw [show QQc = (-(2202127471863542086976841246820549867195347718960342176144462014556523185327760268707187588705852038374958668534379582118318610928980329275922055168 : Int)) :: QQ4c from rfl,
+      homEvalI_collapse, ← hQQ]
+    rfl
+  have hQfin : -homEvalI QQc (evalPoly geA96 (m : Int)) (evalPoly geB2 (m : Int)) ≤
+      -toInt qword * 2 ^ 386 * evalPoly geB2 (m : Int) ^ 5 := by
+    have hB25 : (0 : Int) ≤ evalPoly geB2 (m : Int) ^ 5 := pow_nonneg' (by omega) 5
+    have s1 : evalPoly geB2 (m : Int) ^ 5 * QQv ≤
+        homEvalI QQc (evalPoly geA96 (m : Int)) (evalPoly geB2 (m : Int)) := by
+      rw [← hcolQ]
+      exact hQmono
+    have s2 : toInt qword * 2 ^ 386 * evalPoly geB2 (m : Int) ^ 5 ≤
+        QQv * evalPoly geB2 (m : Int) ^ 5 :=
+      mul_le_mul_right_nonneg qsh hB25
+    have e1 : QQv * evalPoly geB2 (m : Int) ^ 5 =
+        evalPoly geB2 (m : Int) ^ 5 * QQv := Int.mul_comm _ _
+    have e2 : -toInt qword * 2 ^ 386 * evalPoly geB2 (m : Int) ^ 5 =
+        -(toInt qword * 2 ^ 386 * evalPoly geB2 (m : Int) ^ 5) := by
+      rw [Int.neg_mul, Int.neg_mul]
+    omega
+  -- final assembly
+  rw [evalTD_ge, evalTN_ge]
+  generalize hPHV : homEvalI PPc (evalPoly geWLO (m : Int))
+    (evalPoly geD8 (m : Int)) = PHV at hPfin ⊢
+  generalize hQHVg : homEvalI QQc (evalPoly geA96 (m : Int))
+    (evalPoly geB2 (m : Int)) = QHV at hQfin ⊢
+  have hD8e := evalD8_ge m
+  have hB2e := evalB2_ge m
+  generalize hD8g : evalPoly geD8 (m : Int) = D8v at hPfin hD8e
+  generalize hB2g : evalPoly geB2 (m : Int) = B2v at hQfin hB2e
+  have hqpos : (0 : Int) < -toInt qword := by omega
+  have hppos : (0 : Int) ≤ toInt pword := by omega
+  have hApos : (0 : Int) ≤ (m : Int) - Sc := by simp only [Sc] at h1 ⊢; omega
+  have hB25 : (0 : Int) ≤ B2v ^ 5 := by
+    rw [hB2e]
+    exact pow_nonneg' (Int.mul_nonneg (by omega) (by omega)) 5
+  have hD84 : (0 : Int) ≤ D8v ^ 4 := by
+    rw [hD8e]
+    refine pow_nonneg' (Int.mul_nonneg (by omega) (Int.mul_nonneg ?_ ?_)) 4 <;>
+      simp only [Sc] <;> omega
+  -- step 1: X1v (-QHV) ≤ X1v ((-qword) 2^386 B2v^5)
+  have s1 : X1v * -QHV ≤ X1v * (-toInt qword * 2 ^ 386 * B2v ^ 5) := by
+    have h := mul_le_mul_left_nonneg hQfin hX1_nn
+    exact h
+  -- step 2: pull the division bracket through
+  have s2 : X1v * (-toInt qword * 2 ^ 386 * B2v ^ 5) ≤
+      toInt pword * (q : Int) * (2 ^ 386 * B2v ^ 5) := by
+    have e1 : X1v * (-toInt qword * 2 ^ 386 * B2v ^ 5) =
+        (X1v * -toInt qword) * (2 ^ 386 * B2v ^ 5) := by
+      simp only [Int.mul_assoc, Int.mul_comm, Int.mul_left_comm]
+    have hf : (0 : Int) ≤ 2 ^ 386 * B2v ^ 5 := Int.mul_nonneg (by omega) hB25
+    have h := mul_le_mul_right_nonneg hX1br hf
+    omega
+  -- step 3: multiply by B and use the z bracket
+  have s3 : toInt pword * (q : Int) * (2 ^ 386 * B2v ^ 5) * ((m : Int) + Sc) ≤
+      toInt pword * (((m : Int) - Sc) * 2 ^ 100) * (2 ^ 386 * B2v ^ 5) := by
+    have e1 : toInt pword * (q : Int) * (2 ^ 386 * B2v ^ 5) * ((m : Int) + Sc) =
+        (toInt pword * (2 ^ 386 * B2v ^ 5)) * ((q : Int) * ((m : Int) + Sc)) := by
+      simp only [Int.mul_assoc, Int.mul_comm, Int.mul_left_comm]
+    have e2 : toInt pword * (((m : Int) - Sc) * 2 ^ 100) * (2 ^ 386 * B2v ^ 5) =
+        (toInt pword * (2 ^ 386 * B2v ^ 5)) * (((m : Int) - Sc) * 2 ^ 100) := by
+      simp only [Int.mul_assoc, Int.mul_comm, Int.mul_left_comm]
+    have hf : (0 : Int) ≤ toInt pword * (2 ^ 386 * B2v ^ 5) :=
+      Int.mul_nonneg hppos (Int.mul_nonneg (by omega) hB25)
+    have h := mul_le_mul_left_nonneg hq1 hf
+    omega
+  -- step 4: bring in the P bound
+  have s4 : toInt pword * (((m : Int) - Sc) * 2 ^ 100) * (2 ^ 386 * B2v ^ 5) *
+      (2 ^ 358 * D8v ^ 4) ≤
+      PHV * (((m : Int) - Sc) * (2 ^ 486 * B2v ^ 5)) := by
+    have e1 : toInt pword * (((m : Int) - Sc) * 2 ^ 100) * (2 ^ 386 * B2v ^ 5) *
+        (2 ^ 358 * D8v ^ 4) =
+        (toInt pword * 2 ^ 358 * D8v ^ 4) *
+          (((m : Int) - Sc) * (2 ^ 100 * 2 ^ 386 * B2v ^ 5)) := by
+      simp only [Int.mul_assoc, Int.mul_comm, Int.mul_left_comm]
+    have hf : (0 : Int) ≤ ((m : Int) - Sc) * (2 ^ 100 * 2 ^ 386 * B2v ^ 5) :=
+      Int.mul_nonneg hApos (Int.mul_nonneg (by omega) hB25)
+    have h := mul_le_mul_right_nonneg hPfin hf
+    have e2 : PHV * (((m : Int) - Sc) * (2 ^ 100 * 2 ^ 386 * B2v ^ 5)) =
+        PHV * (((m : Int) - Sc) * (2 ^ 486 * B2v ^ 5)) := by
+      rw [show ((2 : Int) ^ 100 * 2 ^ 386) = 2 ^ 486 from by decide]
+    omega
+  -- multiplied chain and cancellation
+  have hD84pos : (0 : Int) < D8v ^ 4 := by
+    rw [hD8e]
+    refine pow_pos' (Int.mul_pos (by omega) (Int.mul_pos hBpos hBpos)) 4
+  have hMpos : (0 : Int) < ((m : Int) + Sc) * (2 ^ 358 * D8v ^ 4) :=
+    Int.mul_pos hBpos (Int.mul_pos (by omega) hD84pos)
+  have hMnn : (0 : Int) ≤ ((m : Int) + Sc) * (2 ^ 358 * D8v ^ 4) := by omega
+  have k1 : X1v * -QHV * (((m : Int) + Sc) * (2 ^ 358 * D8v ^ 4)) ≤
+      X1v * (-toInt qword * 2 ^ 386 * B2v ^ 5) *
+        (((m : Int) + Sc) * (2 ^ 358 * D8v ^ 4)) :=
+    mul_le_mul_right_nonneg s1 hMnn
+  have k2 : X1v * (-toInt qword * 2 ^ 386 * B2v ^ 5) *
+      (((m : Int) + Sc) * (2 ^ 358 * D8v ^ 4)) ≤
+      toInt pword * (q : Int) * (2 ^ 386 * B2v ^ 5) *
+        (((m : Int) + Sc) * (2 ^ 358 * D8v ^ 4)) :=
+    mul_le_mul_right_nonneg s2 hMnn
+  have k3 : toInt pword * (q : Int) * (2 ^ 386 * B2v ^ 5) *
+      (((m : Int) + Sc) * (2 ^ 358 * D8v ^ 4)) =
+      toInt pword * (q : Int) * (2 ^ 386 * B2v ^ 5) * ((m : Int) + Sc) *
+        (2 ^ 358 * D8v ^ 4) := by
+    simp only [Int.mul_assoc]
+  have k4 : toInt pword * (q : Int) * (2 ^ 386 * B2v ^ 5) * ((m : Int) + Sc) *
+      (2 ^ 358 * D8v ^ 4) ≤
+      toInt pword * (((m : Int) - Sc) * 2 ^ 100) * (2 ^ 386 * B2v ^ 5) *
+        (2 ^ 358 * D8v ^ 4) :=
+    mul_le_mul_right_nonneg s3 (Int.mul_nonneg (by omega) (by omega))
+  have k6 : 2 ^ 17 * (((m : Int) - Sc) * ((m : Int) + Sc) * PHV) * 2 ^ 99 *
+      (((m : Int) + Sc) * (2 ^ 358 * D8v ^ 4)) =
+      PHV * (((m : Int) - Sc) * (2 ^ 486 * B2v ^ 5)) := by
+    rw [hD8e, hB2e]
+    rw [show ((8 : Int) * (((m : Int) + Sc) * ((m : Int) + Sc))) ^ 4 =
+      4096 * (((m : Int) + Sc) * ((m : Int) + Sc)) ^ 4 from by
+        rw [Int.mul_pow]
+        rw [show ((8 : Int) ^ 4) = 4096 from by decide]]
+    rw [show (((m : Int) + Sc) * ((m : Int) + Sc)) ^ 5 =
+      (((m : Int) + Sc) * ((m : Int) + Sc)) ^ 4 *
+        (((m : Int) + Sc) * ((m : Int) + Sc)) from by
+        rw [Int.pow_succ]]
+    have hAC : 2 ^ 17 * (((m : Int) - Sc) * ((m : Int) + Sc) * PHV) * 2 ^ 99 *
+        (((m : Int) + Sc) * (2 ^ 358 * (4096 * (((m : Int) + Sc) * ((m : Int) + Sc)) ^ 4))) =
+        (2 ^ 17 * 2 ^ 99 * 2 ^ 358 * 4096) *
+          (PHV * (((m : Int) - Sc) * ((((m : Int) + Sc) * ((m : Int) + Sc)) ^ 4 *
+            (((m : Int) + Sc) * ((m : Int) + Sc))))) := by
+      simp only [Int.mul_assoc, Int.mul_comm, Int.mul_left_comm]
+    rw [hAC, show ((2 : Int) ^ 17 * 2 ^ 99 * 2 ^ 358 * 4096) = 2 ^ 486 from by decide]
+    simp only [Int.mul_assoc, Int.mul_comm, Int.mul_left_comm]
+  have key : X1v * -QHV * (((m : Int) + Sc) * (2 ^ 358 * D8v ^ 4)) ≤
+      2 ^ 17 * (((m : Int) - Sc) * ((m : Int) + Sc) * PHV) * 2 ^ 99 *
+        (((m : Int) + Sc) * (2 ^ 358 * D8v ^ 4)) := by
+    rw [k6]
+    omega
+  exact Int.le_of_mul_le_mul_right key hMpos
+
+/-- The pipeline value sits above the lower certificate rational on the
+`m ≥ S` branch: `TN2b(m) · 2^99 ≤ X1 · TD2b(m)`. -/
+theorem bracket_ge_lo {m : Nat} (h1 : Sc + 46 ≤ m) (h2 : m < MHI) :
+    evalPoly geTN2b (m : Int) * 2 ^ 99 ≤
+      toInt (x1W (zWord m)) * evalPoly geTD2b (m : Int) := by
+  have hMLO : MLO ≤ m := by
+    simp only [MLO]; simp only [Sc] at h1; omega
+  have hSle : Sc ≤ m := by simp only [Sc] at h1 ⊢; omega
+  obtain ⟨q, hzq, hq1, hq2⟩ := z_bracket_ge hSle h2
+  have hzr := zWord_range hMLO h2
+  have hwlt : zWord m < 2 ^ 256 := by unfold zWord; exact evmSdiv_lt _ _
+  have hx1 : x1W (zWord m) = hAt (toInt (zWord m)) := by
+    unfold hAt; rw [ofInt_toInt hwlt]
+  obtain ⟨heq, hmul⟩ := hAt_facts (toInt (zWord m)) hzr.1 hzr.2
+  have huv : uVal (toInt (zWord m)) = q * q / 2 ^ 104 := by
+    unfold uVal
+    rw [hzq]
+    have e : -(q : Int) * -(q : Int) = ((q * q : Nat) : Int) := by
+      rw [Int.neg_mul_neg]
+      omega
+    rw [e]
+    omega
+  have hu_le : q * q / 2 ^ 104 ≤ Uc := by
+    have := uVal_le (toInt (zWord m)) hzr.1 hzr.2
+    rw [huv] at this
+    exact this
+  have hudm := Nat.div_add_mod (q * q) (2 ^ 104)
+  have huml := Nat.mod_lt (q * q) (y := 2 ^ 104) (by omega)
+  have hq_ge1 : 1 ≤ q := by
+    rcases Nat.eq_zero_or_pos q with h0 | h
+    · exfalso
+      subst h0
+      have hA46 : (46 : Int) ≤ (m : Int) - Sc := by simp only [Sc] at h1 ⊢; omega
+      have hBmax : (m : Int) + Sc ≤ 34624238973196922243142627472244 := by
+        simp only [MHI] at h2; simp only [Sc]; omega
+      have h46 : (46 : Int) * 2 ^ 100 ≤ ((m : Int) - Sc) * 2 ^ 100 :=
+        mul_le_mul_right_nonneg hA46 (by omega)
+      omega
+    · exact h
+  obtain ⟨pw, plo, phi, psl, psh⟩ := pS4_facts hu_le
+  obtain ⟨qw, qlo, qhi, qsl, qsh⟩ := qS5_facts hu_le
+  rw [huv] at heq hmul
+  generalize hw1 : pS4 (q * q / 2 ^ 104) = pword at heq hmul pw plo phi psl psh
+  generalize hw2 : qS5 (q * q / 2 ^ 104) = qword at heq qw qlo qhi qsl qsh
+  generalize hPP : evalPoly PPc ((q * q / 2 ^ 104 : Nat) : Int) = PPv at psl psh
+  generalize hQQ : evalPoly QQc ((q * q / 2 ^ 104 : Nat) : Int) = QQv at qsl qsh
+  have hxe : x1W (zWord m) = evmSdiv (evmMul pword (ofInt (toInt (zWord m)))) qword :=
+    hx1.trans heq
+  have hnum_neg : toInt (evmMul pword (ofInt (toInt (zWord m)))) < 0 := by
+    rw [hmul, hzq]
+    have h := mul_le_mul_left_nonneg (show (1 : Int) ≤ (q : Int) by omega)
+      (show (0 : Int) ≤ toInt pword by omega)
+    have e : toInt pword * -(q : Int) = -(toInt pword * (q : Int)) := Int.mul_neg _ _
+    omega
+  have hpz := pz_bound plo phi hzr.1 hzr.2
+  have hX1v : toInt (x1W (zWord m)) =
+      (((toInt pword * (q : Int)).toNat / (-toInt qword).toNat : Nat) : Int) := by
+    rw [hxe, evmSdiv_neg_neg (evmMul_lt _ _) qw hnum_neg
+      (by rw [hmul]; exact hpz.1) (by omega), hmul, hzq]
+    have e : -(toInt pword * -(q : Int)) = toInt pword * (q : Int) := by
+      rw [Int.mul_neg]
+      omega
+    rw [e]
+  have hpq_pos : (0 : Int) ≤ toInt pword * (q : Int) :=
+    Int.mul_nonneg (by omega) (by omega)
+  have hX1_nn : (0 : Int) ≤ toInt (x1W (zWord m)) := by
+    rw [hX1v]
+    exact Int.natCast_nonneg _
+  -- LOWER division bracket: pw q < (X1+1)(-qw)
+  have hdm2 := Nat.div_add_mod (toInt pword * (q : Int)).toNat (-toInt qword).toNat
+  have hml2 := Nat.mod_lt (toInt pword * (q : Int)).toNat
+    (y := (-toInt qword).toNat) (by omega)
+  have hX1lo : toInt pword * (q : Int) <
+      (toInt (x1W (zWord m)) + 1) * (-toInt qword) := by
+    rw [hX1v]
+    have e : (((toInt pword * (q : Int)).toNat / (-toInt qword).toNat : Nat) : Int) + 1 =
+        (((toInt pword * (q : Int)).toNat / (-toInt qword).toNat + 1 : Nat) : Int) := by
+      omega
+    rw [e]
+    have e2 : (((toInt pword * (q : Int)).toNat / (-toInt qword).toNat + 1 : Nat) : Int) *
+        (-toInt qword) =
+        ((((toInt pword * (q : Int)).toNat / (-toInt qword).toNat + 1) *
+          (-toInt qword).toNat : Nat) : Int) := by
+      rw [Int.natCast_mul]
+      have : ((-toInt qword).toNat : Int) = -toInt qword := by omega
+      rw [this]
+    rw [e2]
+    have hexp : ((toInt pword * (q : Int)).toNat / (-toInt qword).toNat + 1) *
+        (-toInt qword).toNat =
+        (-toInt qword).toNat * ((toInt pword * (q : Int)).toNat / (-toInt qword).toNat) +
+          (-toInt qword).toNat := by
+      rw [Nat.add_mul, Nat.one_mul, Nat.mul_comm]
+    omega
+  clear heq hxe hmul hX1v hnum_neg hpz hx1 hzr hwlt hudm huml hzq hw1 hw2 hdm2 hml2
+  generalize hXg : toInt (x1W (zWord m)) = X1v at hX1lo hX1_nn ⊢
+  -- u-hat brackets in Int form
+  have huI1 : ((q * q / 2 ^ 104 : Nat) : Int) * 2 ^ 104 ≤ (q : Int) * q := by
+    have hudm := Nat.div_add_mod (q * q) (2 ^ 104)
+    have e : (q : Int) * q = ((q * q : Nat) : Int) := by omega
+    rw [e]
+    omega
+  -- orderings
+  have hcastA : ((m - Sc : Nat) : Int) = (m : Int) - Sc := by omega
+  have hcastB : ((m + Sc : Nat) : Int) = (m : Int) + Sc := by omega
+  have hunle := un_le_dsq (d := m - Sc) (q := q) (u := q * q / 2 ^ 104)
+    (B := m + Sc) (by omega)
+    (by rw [hcastA, hcastB]; exact hq1) huI1
+  have hordQ : ((q * q / 2 ^ 104 : Nat) : Int) * evalPoly geB2 (m : Int) ≤
+      evalPoly geA96 (m : Int) := by
+    rw [evalB2_ge, evalA96_ge]
+    rw [hcastA, hcastB] at hunle
+    exact hunle
+  -- wlo ordering (the Q-argument ordering on this side)
+  have huI2 : (q : Int) * q ≤ ((q * q / 2 ^ 104 : Nat) : Int) * 2 ^ 104 + 2 ^ 104 - 1 := by
+    have hudm := Nat.div_add_mod (q * q) (2 ^ 104)
+    have huml := Nat.mod_lt (q * q) (y := 2 ^ 104) (by omega)
+    have e : (q : Int) * q = ((q * q : Nat) : Int) := by omega
+    rw [e]
+    omega
+  have hwloLt := wlo_lt_un (d := m - Sc) (q := q) (u := q * q / 2 ^ 104)
+    (B := m + Sc) (by omega)
+    (by omega) (by simp only [MHI] at h2; simp only [Sc] at *; omega)
+    (by rw [hcastA, hcastB]; exact hq2)
+    huI2
+  have hordP : evalPoly geWLO (m : Int) ≤
+      ((q * q / 2 ^ 104 : Nat) : Int) * evalPoly geD8 (m : Int) := by
+    rw [evalWLO_ge, evalD8_ge]
+    rw [hcastA, hcastB] at hwloLt
+    have e1 : ((q * q / 2 ^ 104 : Nat) : Int) * (8 * (((m : Int) + Sc) * ((m : Int) + Sc))) =
+        8 * (((q * q / 2 ^ 104 : Nat) : Int) * (((m : Int) + Sc) * ((m : Int) + Sc))) := by
+      simp only [Int.mul_assoc, Int.mul_comm, Int.mul_left_comm]
+    have e2 : (((m : Int) - Sc) * ((m : Int) - Sc)) * 2 ^ 99 =
+        2 ^ 99 * (((m : Int) - Sc) * ((m : Int) - Sc)) := Int.mul_comm _ _
+    omega
+  -- box bounds
+  have hB2nn : (0 : Int) ≤ evalPoly geB2 (m : Int) := by
+    rw [evalB2_ge]
+    exact Int.mul_nonneg (by simp only [Sc]; omega) (by simp only [Sc]; omega)
+  have hD8nn : (0 : Int) ≤ evalPoly geD8 (m : Int) := by
+    rw [evalD8_ge]
+    refine Int.mul_nonneg (by omega) (Int.mul_nonneg ?_ ?_) <;>
+      simp only [Sc] <;> omega
+  have hu_lt_UB : ((q * q / 2 ^ 104 : Nat) : Int) ≤ 2333000000000000000000000000 := by
+    simp only [Uc] at hu_le
+    omega
+  have hb1P : ((q * q / 2 ^ 104 : Nat) : Int) * evalPoly geD8 (m : Int) ≤
+      2333000000000000000000000000 * evalPoly geD8 (m : Int) :=
+    mul_le_mul_right_nonneg hu_lt_UB hD8nn
+  have hb2P : -(2333000000000000000000000000 * evalPoly geD8 (m : Int)) ≤
+      evalPoly geWLO (m : Int) := by
+    rw [evalWLO_ge, evalD8_ge]
+    have hAB : ((m : Int) - Sc) * ((m : Int) + Sc) ≤
+        ((m : Int) + Sc) * ((m : Int) + Sc) :=
+      mul_le_mul_right_nonneg (by omega) (by simp only [Sc]; omega)
+    have hsq : (0 : Int) ≤ (((m : Int) - Sc) * ((m : Int) - Sc)) := by
+      refine Int.mul_nonneg ?_ ?_ <;> simp only [Sc] at h1 ⊢ <;> omega
+    have hBB : (0 : Int) ≤ ((m : Int) + Sc) * ((m : Int) + Sc) := by
+      refine Int.mul_nonneg ?_ ?_ <;> simp only [Sc] <;> omega
+    generalize ((m : Int) - Sc) * ((m : Int) - Sc) = AA at *
+    generalize ((m : Int) - Sc) * ((m : Int) + Sc) = AB at *
+    generalize ((m : Int) + Sc) * ((m : Int) + Sc) = BB at *
+    have h99 : (0 : Int) ≤ 2 ^ 99 * AA := Int.mul_nonneg (by omega) hsq
+    omega
+  have hBpos : (0 : Int) < (m : Int) + Sc := by simp only [Sc]; omega
+  have hD8pos : (0 : Int) < evalPoly geD8 (m : Int) := by
+    rw [evalD8_ge]
+    exact Int.mul_pos (by omega) (Int.mul_pos hBpos hBpos)
+  have hB2pos : (0 : Int) < evalPoly geB2 (m : Int) := by
+    rw [evalB2_ge]
+    exact Int.mul_pos hBpos hBpos
+  have hb1Q : evalPoly geA96 (m : Int) ≤
+      2333000000000000000000000000 * evalPoly geB2 (m : Int) := by
+    have hws := geWS_nonneg (m := (m : Int))
+      (by simp only [Sc] at h1; omega) (by simp only [MHI] at h2; omega)
+    rw [evalWS_ge] at hws
+    rw [evalA96_ge, evalB2_ge]
+    omega
+  have hb2Q : -(2333000000000000000000000000 * evalPoly geB2 (m : Int)) ≤
+      ((q * q / 2 ^ 104 : Nat) : Int) * evalPoly geB2 (m : Int) := by
+    have h := Int.mul_nonneg (Int.natCast_nonneg (q * q / 2 ^ 104)) (by omega :
+      (0 : Int) ≤ evalPoly geB2 (m : Int))
+    have h2' : (0 : Int) ≤ 2333000000000000000000000000 * evalPoly geB2 (m : Int) :=
+      Int.mul_nonneg (by omega) (by omega)
+    omega
+  -- divided-difference monotonicity, with the argument roles of the up-side swapped
+  have hPanti := homEvalI_PPc_anti (n1 := evalPoly geA96 (m : Int))
+    (n2 := ((q * q / 2 ^ 104 : Nat) : Int) * evalPoly geB2 (m : Int))
+    (D := evalPoly geB2 (m : Int)) hB2pos hordQ hb1Q hb2Q
+  have hQmono := homEvalI_QQc_mono (n1 := ((q * q / 2 ^ 104 : Nat) : Int) *
+      evalPoly geD8 (m : Int)) (n2 := evalPoly geWLO (m : Int))
+    (D := evalPoly geD8 (m : Int)) hD8pos hordP hb1P hb2P
+  -- collapse instances
+  have hcolP : homEvalI PPc (((q * q / 2 ^ 104 : Nat) : Int) *
+      evalPoly geB2 (m : Int)) (evalPoly geB2 (m : Int)) =
+      evalPoly geB2 (m : Int) ^ 4 * PPv := by
+    rw [show PPc = (8203564106909714963200842018502018851024462725819431901516251320229929630934299039494945066816553616430456446611805193566972803059892092928 : Int) :: PP3c from rfl,
+      homEvalI_collapse, ← hPP]
+    rfl
+  have hcolP' : homEvalI PPc (((q * q / 2 ^ 104 : Nat) : Int) *
+      evalPoly geB2 (m : Int)) (evalPoly geB2 (m : Int)) =
+      PPv * evalPoly geB2 (m : Int) ^ 4 := by
+    rw [hcolP]
+    exact Int.mul_comm _ _
+  have hcolQ : homEvalI QQc (((q * q / 2 ^ 104 : Nat) : Int) *
+      evalPoly geD8 (m : Int)) (evalPoly geD8 (m : Int)) =
+      evalPoly geD8 (m : Int) ^ 5 * QQv := by
+    rw [show QQc = (-(2202127471863542086976841246820549867195347718960342176144462014556523185327760268707187588705852038374958668534379582118318610928980329275922055168 : Int)) :: QQ4c from rfl,
+      homEvalI_collapse, ← hQQ]
+    rfl
+  have hcolQ' : homEvalI QQc (((q * q / 2 ^ 104 : Nat) : Int) *
+      evalPoly geD8 (m : Int)) (evalPoly geD8 (m : Int)) =
+      QQv * evalPoly geD8 (m : Int) ^ 5 := by
+    rw [hcolQ]
+    exact Int.mul_comm _ _
+  have hB24 : (0 : Int) ≤ evalPoly geB2 (m : Int) ^ 4 := pow_nonneg' (by omega) 4
+  have hD5nn : (0 : Int) ≤ evalPoly geD8 (m : Int) ^ 5 := pow_nonneg' (by omega) 5
+  -- P upper comparison: PLOP(m) ≤ p-hat 2^358 (B²)^4
+  have hPfin : evalPoly gePLOP (m : Int) ≤
+      toInt pword * 2 ^ 358 * evalPoly geB2 (m : Int) ^ 4 := by
+    rw [evalPLOP_ge]
+    have s1P : homEvalI PPc (evalPoly geA96 (m : Int)) (evalPoly geB2 (m : Int)) ≤
+        PPv * evalPoly geB2 (m : Int) ^ 4 := by
+      rw [← hcolP']
+      exact hPanti
+    have s2P : (PPv - SLOPPc) * evalPoly geB2 (m : Int) ^ 4 ≤
+        toInt pword * 2 ^ 358 * evalPoly geB2 (m : Int) ^ 4 :=
+      mul_le_mul_right_nonneg (by omega) hB24
+    have e1P : (PPv - SLOPPc) * evalPoly geB2 (m : Int) ^ 4 =
+        PPv * evalPoly geB2 (m : Int) ^ 4 - SLOPPc * evalPoly geB2 (m : Int) ^ 4 :=
+      Int.sub_mul _ _ _
+    generalize hg1 : homEvalI PPc (evalPoly geA96 (m : Int))
+      (evalPoly geB2 (m : Int)) = HS at s1P ⊢
+    generalize hg2 : evalPoly geB2 (m : Int) ^ 4 = B4 at s1P s2P e1P ⊢
+    generalize hg3 : PPv * B4 = PB4 at s1P e1P
+    generalize hg4 : SLOPPc * B4 = SB4 at e1P ⊢
+    generalize hg5 : (PPv - SLOPPc) * B4 = PSB at s2P e1P
+    generalize hg6 : toInt pword * 2 ^ 358 * B4 = PW4 at s2P ⊢
+    omega
+  -- Q lower comparison: (-q-hat) 2^386 (8B²)^5 ≤ DLO(m)
+  have hQfin : -toInt qword * 2 ^ 386 * evalPoly geD8 (m : Int) ^ 5 ≤
+      evalPoly geDLO (m : Int) := by
+    rw [evalDLO_ge]
+    have s1Q : homEvalI QQc (evalPoly geWLO (m : Int)) (evalPoly geD8 (m : Int)) ≤
+        QQv * evalPoly geD8 (m : Int) ^ 5 := by
+      rw [← hcolQ']
+      exact hQmono
+    have s2Q : (QQv - SLOPQc) * evalPoly geD8 (m : Int) ^ 5 ≤
+        toInt qword * 2 ^ 386 * evalPoly geD8 (m : Int) ^ 5 :=
+      mul_le_mul_right_nonneg (by omega) hD5nn
+    have e1Q : (QQv - SLOPQc) * evalPoly geD8 (m : Int) ^ 5 =
+        QQv * evalPoly geD8 (m : Int) ^ 5 - SLOPQc * evalPoly geD8 (m : Int) ^ 5 :=
+      Int.sub_mul _ _ _
+    have e2Q : -toInt qword * 2 ^ 386 * evalPoly geD8 (m : Int) ^ 5 =
+        -(toInt qword * 2 ^ 386 * evalPoly geD8 (m : Int) ^ 5) := by
+      rw [Int.neg_mul, Int.neg_mul]
+    generalize hg1 : homEvalI QQc (evalPoly geWLO (m : Int))
+      (evalPoly geD8 (m : Int)) = HS at s1Q ⊢
+    generalize hg2 : evalPoly geD8 (m : Int) ^ 5 = D5 at s1Q s2Q e1Q e2Q ⊢
+    generalize hg3 : QQv * D5 = QD at s1Q e1Q
+    generalize hg4 : SLOPQc * D5 = SD at e1Q ⊢
+    generalize hg5 : (QQv - SLOPQc) * D5 = QSD at s2Q e1Q
+    generalize hg6 : toInt qword * 2 ^ 386 * D5 = QW at s2Q e2Q
+    generalize hg7 : -toInt qword * 2 ^ 386 * D5 = QWn at e2Q ⊢
+    omega
+  -- AZ bounds: 0 ≤ AZ(m) ≤ q (m + S)
+  have hAZnn : (0 : Int) ≤ evalPoly geAZ (m : Int) := by
+    rw [evalAZ_ge]
+    simp only [Sc] at h1 ⊢
+    simp only [MHI] at h2
+    omega
+  have hAZle : evalPoly geAZ (m : Int) ≤ (q : Int) * ((m : Int) + Sc) := by
+    rw [evalAZ_ge]
+    have hq2' := hq2
+    have e : ((q : Int) + 1) * ((m : Int) + Sc) =
+        (q : Int) * ((m : Int) + Sc) + ((m : Int) + Sc) := by
+      rw [Int.add_mul, Int.one_mul]
+    rw [e] at hq2'
+    generalize (q : Int) * ((m : Int) + Sc) = QB at hq2' ⊢
+    omega
+  -- numerator chain: 2^99-free part, PLOP·AZ·B ≤ p-hat q 2^358 (B²)^5
+  have hBnn : (0 : Int) ≤ (m : Int) + Sc := by simp only [Sc]; omega
+  have hPWnn : (0 : Int) ≤ toInt pword * 2 ^ 358 * evalPoly geB2 (m : Int) ^ 4 :=
+    Int.mul_nonneg (Int.mul_nonneg (by omega) (by omega)) hB24
+  have t1 : evalPoly gePLOP (m : Int) * evalPoly geAZ (m : Int) ≤
+      toInt pword * 2 ^ 358 * evalPoly geB2 (m : Int) ^ 4 * evalPoly geAZ (m : Int) :=
+    mul_le_mul_right_nonneg hPfin hAZnn
+  have t1b : evalPoly gePLOP (m : Int) * evalPoly geAZ (m : Int) * ((m : Int) + Sc) ≤
+      toInt pword * 2 ^ 358 * evalPoly geB2 (m : Int) ^ 4 * evalPoly geAZ (m : Int) *
+        ((m : Int) + Sc) :=
+    mul_le_mul_right_nonneg t1 hBnn
+  have t2 : toInt pword * 2 ^ 358 * evalPoly geB2 (m : Int) ^ 4 *
+      evalPoly geAZ (m : Int) ≤
+      toInt pword * 2 ^ 358 * evalPoly geB2 (m : Int) ^ 4 *
+        ((q : Int) * ((m : Int) + Sc)) :=
+    mul_le_mul_left_nonneg hAZle hPWnn
+  have t2b : toInt pword * 2 ^ 358 * evalPoly geB2 (m : Int) ^ 4 *
+      evalPoly geAZ (m : Int) * ((m : Int) + Sc) ≤
+      toInt pword * 2 ^ 358 * evalPoly geB2 (m : Int) ^ 4 *
+        ((q : Int) * ((m : Int) + Sc)) * ((m : Int) + Sc) :=
+    mul_le_mul_right_nonneg t2 hBnn
+  have t34 : toInt pword * 2 ^ 358 * evalPoly geB2 (m : Int) ^ 4 *
+      ((q : Int) * ((m : Int) + Sc)) * ((m : Int) + Sc) =
+      toInt pword * (q : Int) * (2 ^ 358 * evalPoly geB2 (m : Int) ^ 5) := by
+    rw [show evalPoly geB2 (m : Int) ^ 5 =
+      evalPoly geB2 (m : Int) ^ 4 * evalPoly geB2 (m : Int) from by rw [Int.pow_succ]]
+    rw [evalB2_ge]
+    simp only [Int.mul_assoc, Int.mul_comm, Int.mul_left_comm]
+  have hTfin : evalPoly gePLOP (m : Int) * evalPoly geAZ (m : Int) * ((m : Int) + Sc) ≤
+      toInt pword * (q : Int) * (2 ^ 358 * evalPoly geB2 (m : Int) ^ 5) := by
+    refine Int.le_trans t1b ?_
+    rw [← t34]
+    exact t2b
+  -- denominator chain: (p-hat q + 1) 2^442 (8B²)^5 ≤ (X1 + 1) 2^56 DLO
+  have hFnn : (0 : Int) ≤ 2 ^ 442 * evalPoly geD8 (m : Int) ^ 5 :=
+    Int.mul_nonneg (by omega) hD5nn
+  have u2 : toInt pword * (q : Int) + 1 ≤ (X1v + 1) * -toInt qword := by
+    have h := hX1lo
+    generalize hg1 : toInt pword * (q : Int) = PQt at h ⊢
+    generalize hg2 : (X1v + 1) * -toInt qword = XQt at h ⊢
+    omega
+  have u3 : (toInt pword * (q : Int) + 1) * (2 ^ 442 * evalPoly geD8 (m : Int) ^ 5) ≤
+      (X1v + 1) * -toInt qword * (2 ^ 442 * evalPoly geD8 (m : Int) ^ 5) :=
+    mul_le_mul_right_nonneg u2 hFnn
+  have u4 : (X1v + 1) * -toInt qword * (2 ^ 442 * evalPoly geD8 (m : Int) ^ 5) =
+      (X1v + 1) * (2 ^ 56 * (-toInt qword * 2 ^ 386 * evalPoly geD8 (m : Int) ^ 5)) := by
+    rw [show (2 : Int) ^ 442 = 2 ^ 56 * 2 ^ 386 from by decide]
+    simp only [Int.mul_assoc, Int.mul_comm, Int.mul_left_comm]
+  have u1b : 2 ^ 56 * (-toInt qword * 2 ^ 386 * evalPoly geD8 (m : Int) ^ 5) ≤
+      2 ^ 56 * evalPoly geDLO (m : Int) :=
+    mul_le_mul_left_nonneg hQfin (by omega)
+  have hX1p1 : (0 : Int) ≤ X1v + 1 := by omega
+  have u5 : (X1v + 1) * (2 ^ 56 * (-toInt qword * 2 ^ 386 *
+      evalPoly geD8 (m : Int) ^ 5)) ≤
+      (X1v + 1) * (2 ^ 56 * evalPoly geDLO (m : Int)) :=
+    mul_le_mul_left_nonneg u1b hX1p1
+  have hRfin : (toInt pword * (q : Int) + 1) *
+      (2 ^ 442 * evalPoly geD8 (m : Int) ^ 5) ≤
+      (X1v + 1) * (2 ^ 56 * evalPoly geDLO (m : Int)) := by
+    refine Int.le_trans ?_ u5
+    rw [← u4]
+    exact u3
+  -- scale bridge: 2^442 (8B²)^5 = 2^457 (B²)^5
+  have ebr : (2 : Int) ^ 442 * evalPoly geD8 (m : Int) ^ 5 =
+      2 ^ 457 * evalPoly geB2 (m : Int) ^ 5 := by
+    rw [evalD8_ge, evalB2_ge]
+    rw [show ((8 : Int) * (((m : Int) + Sc) * ((m : Int) + Sc))) ^ 5 =
+      32768 * ((((m : Int) + Sc) * ((m : Int) + Sc)) ^ 5) from by
+        rw [Int.mul_pow]
+        rw [show ((8 : Int) ^ 5) = 32768 from by decide]]
+    rw [← Int.mul_assoc, show (2 : Int) ^ 442 * 32768 = 2 ^ 457 from by decide]
+  have escale : toInt pword * (q : Int) * (2 ^ 442 * evalPoly geD8 (m : Int) ^ 5) =
+      2 ^ 99 * (toInt pword * (q : Int) * (2 ^ 358 * evalPoly geB2 (m : Int) ^ 5)) := by
+    rw [ebr]
+    rw [show (2 : Int) ^ 457 = 2 ^ 99 * 2 ^ 358 from by decide]
+    simp only [Int.mul_assoc, Int.mul_comm, Int.mul_left_comm]
+  -- final assembly
+  rw [evalTN2b_ge, evalTD2b_ge]
+  have egoal : X1v * (2 ^ 99 * (2 ^ 56 * evalPoly geDLO (m : Int))) =
+      2 ^ 99 * (X1v * (2 ^ 56 * evalPoly geDLO (m : Int))) := by
+    simp only [Int.mul_assoc, Int.mul_comm]
+  rw [egoal]
+  have edist : (X1v + 1) * (2 ^ 56 * evalPoly geDLO (m : Int)) =
+      X1v * (2 ^ 56 * evalPoly geDLO (m : Int)) + 2 ^ 56 * evalPoly geDLO (m : Int) := by
+    rw [Int.add_mul, Int.one_mul]
+  have edist2 : (toInt pword * (q : Int) + 1) *
+      (2 ^ 442 * evalPoly geD8 (m : Int) ^ 5) =
+      toInt pword * (q : Int) * (2 ^ 442 * evalPoly geD8 (m : Int) ^ 5) +
+        2 ^ 442 * evalPoly geD8 (m : Int) ^ 5 := by
+    rw [Int.add_mul, Int.one_mul]
+  generalize hgT : evalPoly gePLOP (m : Int) * evalPoly geAZ (m : Int) *
+    ((m : Int) + Sc) = T at hTfin ⊢
+  generalize hgDLO : evalPoly geDLO (m : Int) = DLO at hRfin edist ⊢
+  generalize hgD5 : evalPoly geD8 (m : Int) ^ 5 = D5g at hRfin edist2 escale hD5nn
+  generalize hgB5 : evalPoly geB2 (m : Int) ^ 5 = B5g at hTfin escale
+  generalize hgPQ : toInt pword * (q : Int) = PQ at hTfin hRfin edist2 escale
+  generalize hgPB : PQ * (2 ^ 358 * B5g) = PB at hTfin escale
+  generalize hgPQD : PQ * (2 ^ 442 * D5g) = PQD at edist2 escale
+  generalize hgRD : (PQ + 1) * (2 ^ 442 * D5g) = RD at hRfin edist2
+  generalize hgXW : X1v * (2 ^ 56 * DLO) = XW at edist ⊢
+  generalize hgXW1 : (X1v + 1) * (2 ^ 56 * DLO) = XW1 at hRfin edist
+  omega
+
+theorem evalA_lt (m : Nat) : evalPoly ltA (m : Int) = (Sc : Int) - m := by
+  show (Sc : Int) + (m : Int) * (-1 + (m : Int) * 0) = _
+  omega
+
+theorem evalB_lt (m : Nat) : evalPoly ltB (m : Int) = (m : Int) + Sc := by
+  show (Sc : Int) + (m : Int) * (1 + (m : Int) * 0) = _
+  omega
+
+theorem evalB2_lt (m : Nat) :
+    evalPoly ltB2 (m : Int) = ((m : Int) + Sc) * ((m : Int) + Sc) := by
+  show evalPoly (polyMul ltB ltB) (m : Int) = _
+  rw [evalPoly_polyMul, evalB_lt]
+
+theorem evalA2_lt (m : Nat) :
+    evalPoly ltA2 (m : Int) = ((Sc : Int) - m) * ((Sc : Int) - m) := by
+  show evalPoly (polyMul ltA ltA) (m : Int) = _
+  rw [evalPoly_polyMul, evalA_lt]
+
+theorem evalD8_lt (m : Nat) :
+    evalPoly ltD8 (m : Int) = 8 * (((m : Int) + Sc) * ((m : Int) + Sc)) := by
+  show evalPoly (polyScale 8 ltB2) (m : Int) = _
+  rw [evalPoly_polyScale, evalB2_lt]
+
+theorem evalA96_lt (m : Nat) :
+    evalPoly ltA96 (m : Int) = 2 ^ 96 * (((Sc : Int) - m) * ((Sc : Int) - m)) := by
+  show evalPoly (polyScale (2 ^ 96) ltA2) (m : Int) = _
+  rw [evalPoly_polyScale, evalA2_lt]
+
+theorem evalWLO_lt (m : Nat) :
+    evalPoly ltWLO (m : Int) =
+      2 ^ 99 * (((Sc : Int) - m) * ((Sc : Int) - m)) -
+        ((Sc : Int) - m) * ((m : Int) + Sc) -
+        8 * (((m : Int) + Sc) * ((m : Int) + Sc)) := by
+  show evalPoly (polyAdd (polyAdd (polyScale (2 ^ 99) ltA2)
+    (polyNeg (polyMul ltA ltB))) (polyScale (-8) ltB2)) (m : Int) = _
+  rw [evalPoly_polyAdd, evalPoly_polyAdd, evalPoly_polyScale, evalPoly_polyNeg,
+    evalPoly_polyMul, evalPoly_polyScale, evalA2_lt, evalA_lt, evalB_lt, evalB2_lt]
+  omega
+
+theorem evalTN_lt (m : Nat) :
+    evalPoly ltTN (m : Int) =
+      2 ^ 17 * ((((Sc : Int) - m) * (((m : Int) + Sc))) *
+        homEvalI PPc (evalPoly ltWLO (m : Int)) (evalPoly ltD8 (m : Int))) := by
+  show evalPoly (polyScale (2 ^ 17) (polyMul (polyMul ltA ltB) ltPPHwlo)) (m : Int) = _
+  rw [evalPoly_polyScale, evalPoly_polyMul, evalPoly_polyMul, evalA_lt, evalB_lt]
+  have h : evalPoly ltPPHwlo (m : Int) =
+      homEvalI PPc (evalPoly ltWLO (m : Int)) (evalPoly ltD8 (m : Int)) := by
+    show evalPoly (homPoly PPc ltWLO ltD8) (m : Int) = _
+    exact evalPoly_homPoly PPc ltWLO ltD8 (m : Int)
+  rw [h]
+
+theorem evalTD_lt (m : Nat) :
+    evalPoly ltTD (m : Int) =
+      -homEvalI QQc (evalPoly ltA96 (m : Int)) (evalPoly ltB2 (m : Int)) := by
+  show evalPoly (polyNeg ltQQHws) (m : Int) = _
+  rw [evalPoly_polyNeg]
+  have h : evalPoly ltQQHws (m : Int) =
+      homEvalI QQc (evalPoly ltA96 (m : Int)) (evalPoly ltB2 (m : Int)) := by
+    show evalPoly (homPoly QQc ltA96 ltB2) (m : Int) = _
+    exact evalPoly_homPoly QQc ltA96 ltB2 (m : Int)
+  rw [h]
+
+theorem evalWS_lt (m : Nat) :
+    evalPoly certLtWS (m : Int) =
+      2333000000000000000000000000 * (((m : Int) + Sc) * ((m : Int) + Sc)) -
+        2 ^ 96 * (((Sc : Int) - m) * ((Sc : Int) - m)) := by
+  show evalPoly (polyAdd (polyScale UB ltB2) (polyScale (-(2 ^ 96)) ltA2)) (m : Int) = _
+  rw [evalPoly_polyAdd, evalPoly_polyScale, evalPoly_polyScale, evalB2_lt, evalA2_lt]
+  show UB * _ + _ = _
+  rw [show UB = (2333000000000000000000000000 : Int) from rfl]
+  omega
+
+theorem evalPLOP_lt (m : Nat) :
+    evalPoly ltPLOP (m : Int) =
+      homEvalI PPc (evalPoly ltA96 (m : Int)) (evalPoly ltB2 (m : Int)) -
+        SLOPPc * evalPoly ltB2 (m : Int) ^ 4 := by
+  show evalPoly (polyAdd ltPPHws (polyScale (-SLOPPc) (polyPow ltB2 4))) (m : Int) = _
+  rw [evalPoly_polyAdd, evalPoly_polyScale, evalPoly_polyPow]
+  have h : evalPoly ltPPHws (m : Int) =
+      homEvalI PPc (evalPoly ltA96 (m : Int)) (evalPoly ltB2 (m : Int)) := by
+    show evalPoly (homPoly PPc ltA96 ltB2) (m : Int) = _
+    exact evalPoly_homPoly PPc ltA96 ltB2 (m : Int)
+  rw [h, Int.sub_eq_add_neg, Int.neg_mul]
+
+theorem evalDLO_lt (m : Nat) :
+    evalPoly ltDLO (m : Int) =
+      -homEvalI QQc (evalPoly ltWLO (m : Int)) (evalPoly ltD8 (m : Int)) +
+        SLOPQc * evalPoly ltD8 (m : Int) ^ 5 := by
+  show evalPoly (polyAdd (polyNeg ltQQHwlo) (polyScale SLOPQc (polyPow ltD8 5))) (m : Int) = _
+  rw [evalPoly_polyAdd, evalPoly_polyNeg, evalPoly_polyScale, evalPoly_polyPow]
+  have h : evalPoly ltQQHwlo (m : Int) =
+      homEvalI QQc (evalPoly ltWLO (m : Int)) (evalPoly ltD8 (m : Int)) := by
+    show evalPoly (homPoly QQc ltWLO ltD8) (m : Int) = _
+    exact evalPoly_homPoly QQc ltWLO ltD8 (m : Int)
+  rw [h]
+
+theorem evalAZ_lt (m : Nat) :
+    evalPoly ltAZ (m : Int) = 2 ^ 100 * ((Sc : Int) - m) - ((m : Int) + Sc) := by
+  show evalPoly (polyAdd (polyScale (2 ^ 100) ltA) (polyNeg ltB)) (m : Int) = _
+  rw [evalPoly_polyAdd, evalPoly_polyScale, evalPoly_polyNeg, evalA_lt, evalB_lt]
+  have e : (2 : Int) ^ 100 * ((Sc : Int) - m) = 2 ^ 100 * (Sc : Int) - 2 ^ 100 * m := by
+    rw [Int.mul_sub]
+  omega
+
+theorem evalTN2b_lt (m : Nat) :
+    evalPoly ltTN2b (m : Int) =
+      2 ^ 99 * (evalPoly ltPLOP (m : Int) * evalPoly ltAZ (m : Int) *
+        ((m : Int) + Sc)) - 2 ^ 56 * evalPoly ltDLO (m : Int) := by
+  show evalPoly (polyAdd (polyScale (2 ^ 99) ltTN2) (polyNeg ltTD2)) (m : Int) = _
+  rw [evalPoly_polyAdd, evalPoly_polyScale, evalPoly_polyNeg]
+  have h1 : evalPoly ltTN2 (m : Int) =
+      evalPoly ltPLOP (m : Int) * evalPoly ltAZ (m : Int) * ((m : Int) + Sc) := by
+    show evalPoly (polyMul (polyMul ltPLOP ltAZ) ltB) (m : Int) = _
+    rw [evalPoly_polyMul, evalPoly_polyMul, evalB_lt]
+  have h2 : evalPoly ltTD2 (m : Int) = 2 ^ 56 * evalPoly ltDLO (m : Int) := by
+    show evalPoly (polyScale (2 ^ 56) ltDLO) (m : Int) = _
+    rw [evalPoly_polyScale]
+  rw [h1, h2, Int.sub_eq_add_neg]
+
+theorem evalTD2b_lt (m : Nat) :
+    evalPoly ltTD2b (m : Int) = 2 ^ 99 * (2 ^ 56 * evalPoly ltDLO (m : Int)) := by
+  show evalPoly (polyScale (2 ^ 99) ltTD2) (m : Int) = _
+  rw [evalPoly_polyScale]
+  have h2 : evalPoly ltTD2 (m : Int) = 2 ^ 56 * evalPoly ltDLO (m : Int) := by
+    show evalPoly (polyScale (2 ^ 56) ltDLO) (m : Int) = _
+    rw [evalPoly_polyScale]
+  rw [h2]
+
+/-- The pipeline magnitude sits below the upper certificate rational on the
+`m < S` branch: `(-X1) · TD(m) ≤ TN(m) · 2^99`. -/
+theorem bracket_lt_up {m : Nat} (h1 : MLO ≤ m) (h2 : m + 46 ≤ Sc) :
+    -toInt (x1W (zWord m)) * evalPoly ltTD (m : Int) ≤
+      evalPoly ltTN (m : Int) * 2 ^ 99 := by
+  have hSge : m ≤ Sc := by simp only [Sc] at h2 ⊢; omega
+  have hMHI : m < MHI := by simp only [MHI]; simp only [Sc] at h2; omega
+  -- z and its division bracket
+  obtain ⟨q, hzq, hq1, hq2⟩ := z_bracket_lt h1 hSge
+  have hzr := zWord_range h1 hMHI
+  have hwlt : zWord m < 2 ^ 256 := by unfold zWord; exact evmSdiv_lt _ _
+  have hx1 : x1W (zWord m) = hAt (toInt (zWord m)) := by
+    unfold hAt; rw [ofInt_toInt hwlt]
+  obtain ⟨heq, hmul⟩ := hAt_facts (toInt (zWord m)) hzr.1 hzr.2
+  -- u-hat and its division bracket
+  have huv : uVal (toInt (zWord m)) = q * q / 2 ^ 104 := by
+    unfold uVal
+    rw [hzq]
+    have e : (q : Int) * (q : Int) = ((q * q : Nat) : Int) := by omega
+    rw [e]
+    omega
+  have hu_le : q * q / 2 ^ 104 ≤ Uc := by
+    have := uVal_le (toInt (zWord m)) hzr.1 hzr.2
+    rw [huv] at this
+    exact this
+  have hudm := Nat.div_add_mod (q * q) (2 ^ 104)
+  have huml := Nat.mod_lt (q * q) (y := 2 ^ 104) (by omega)
+  -- the quotient is at least one on this branch
+  have hq_ge1 : 1 ≤ q := by
+    rcases Nat.eq_zero_or_pos q with h0 | h
+    · exfalso
+      subst h0
+      have hA46 : (46 : Int) ≤ (Sc : Int) - m := by simp only [Sc] at h2 ⊢; omega
+      have hBmax : (m : Int) + Sc ≤ 34624238973196922243142627472244 := by
+        simp only [MHI] at hMHI; simp only [Sc]; omega
+      have h46 : (46 : Int) * 2 ^ 100 ≤ ((Sc : Int) - m) * 2 ^ 100 :=
+        mul_le_mul_right_nonneg hA46 (by omega)
+      omega
+    · exact h
+  -- stage sandwiches at u-hat, with every heavy term made opaque
+  obtain ⟨pw, plo, phi, psl, psh⟩ := pS4_facts hu_le
+  obtain ⟨qw, qlo, qhi, qsl, qsh⟩ := qS5_facts hu_le
+  rw [huv] at heq hmul
+  generalize hw1 : pS4 (q * q / 2 ^ 104) = pword at heq hmul pw plo phi psl psh
+  generalize hw2 : qS5 (q * q / 2 ^ 104) = qword at heq qw qlo qhi qsl qsh
+  generalize hPP : evalPoly PPc ((q * q / 2 ^ 104 : Nat) : Int) = PPv at psl psh
+  generalize hQQ : evalPoly QQc ((q * q / 2 ^ 104 : Nat) : Int) = QQv at qsl qsh
+  have hxe : x1W (zWord m) = evmSdiv (evmMul pword (ofInt (toInt (zWord m)))) qword :=
+    hx1.trans heq
+  have hpq_pos : (0 : Int) ≤ toInt pword * (q : Int) :=
+    Int.mul_nonneg (by omega) (by omega)
+  have hnum_nn : (0 : Int) ≤ toInt (evmMul pword (ofInt (toInt (zWord m)))) := by
+    rw [hmul, hzq]
+    exact hpq_pos
+  have hX1v : toInt (x1W (zWord m)) =
+      -((((toInt pword * (q : Int)).toNat / (-toInt qword).toNat : Nat) : Int)) := by
+    rw [hxe, evmSdiv_pos_neg (evmMul_lt _ _) qw hnum_nn (by omega), hmul, hzq]
+  have hX1neg : -toInt (x1W (zWord m)) =
+      (((toInt pword * (q : Int)).toNat / (-toInt qword).toNat : Nat) : Int) := by
+    rw [hX1v, Int.neg_neg]
+  have hX1_nn : (0 : Int) ≤ -toInt (x1W (zWord m)) := by
+    rw [hX1neg]
+    exact Int.natCast_nonneg _
+  -- the division bracket for the magnitude of X1
+  have hdiv := Nat.div_mul_le_self (toInt pword * (q : Int)).toNat (-toInt qword).toNat
+  have hX1br : -toInt (x1W (zWord m)) * (-toInt qword) ≤ toInt pword * (q : Int) := by
+    rw [hX1neg]
+    have e : (((toInt pword * (q : Int)).toNat / (-toInt qword).toNat : Nat) : Int) *
+        (-toInt qword) =
+        ((((toInt pword * (q : Int)).toNat / (-toInt qword).toNat) *
+          (-toInt qword).toNat : Nat) : Int) := by
+      rw [Int.natCast_mul]
+      have : ((-toInt qword).toNat : Int) = -toInt qword := by omega
+      rw [this]
+    rw [e]
+    omega
+  clear heq hxe hmul hX1v hnum_nn hdiv hx1 hzr hwlt hudm huml hzq hw1 hw2 hX1neg
+  generalize hXg : -toInt (x1W (zWord m)) = X1v at hX1br hX1_nn ⊢
+  -- value abbreviations
+  have huI1 : ((q * q / 2 ^ 104 : Nat) : Int) * 2 ^ 104 ≤ (q : Int) * q := by
+    have e : (q : Int) * q = ((q * q : Nat) : Int) := by omega
+    rw [e]
+    omega
+  have huI2 : (q : Int) * q ≤ ((q * q / 2 ^ 104 : Nat) : Int) * 2 ^ 104 + 2 ^ 104 - 1 := by
+    have e : (q : Int) * q = ((q * q : Nat) : Int) := by omega
+    rw [e]
+    omega
+  -- ordering of the P arguments: WLO ≤ u-hat · D8
+  have hcastA : ((Sc - m : Nat) : Int) = (Sc : Int) - m := by omega
+  have hcastB : ((m + Sc : Nat) : Int) = (m : Int) + Sc := by omega
+  have hwloLt := wlo_lt_un (d := Sc - m) (q := q) (u := q * q / 2 ^ 104)
+    (B := m + Sc) (by omega)
+    (by simp only [MLO] at h1; omega) (by simp only [Sc] at *; omega)
+    (by rw [hcastA, hcastB]; exact hq2)
+    huI2
+  have hordP : evalPoly ltWLO (m : Int) ≤
+      ((q * q / 2 ^ 104 : Nat) : Int) * evalPoly ltD8 (m : Int) := by
+    rw [evalWLO_lt, evalD8_lt]
+    rw [hcastA, hcastB] at hwloLt
+    have e1 : ((q * q / 2 ^ 104 : Nat) : Int) * (8 * (((m : Int) + Sc) * ((m : Int) + Sc))) =
+        8 * (((q * q / 2 ^ 104 : Nat) : Int) * (((m : Int) + Sc) * ((m : Int) + Sc))) := by
+      simp only [Int.mul_assoc, Int.mul_comm, Int.mul_left_comm]
+    have e2 : (((Sc : Int) - m) * ((Sc : Int) - m)) * 2 ^ 99 =
+        2 ^ 99 * (((Sc : Int) - m) * ((Sc : Int) - m)) := Int.mul_comm _ _
+    omega
+  -- ordering of the Q arguments: u-hat · B2 ≤ A96
+  have hunle := un_le_dsq (d := Sc - m) (q := q) (u := q * q / 2 ^ 104)
+    (B := m + Sc) (by simp only [MLO] at h1; omega)
+    (by rw [hcastA, hcastB]; exact hq1) huI1
+  have hordQ : ((q * q / 2 ^ 104 : Nat) : Int) * evalPoly ltB2 (m : Int) ≤
+      evalPoly ltA96 (m : Int) := by
+    rw [evalB2_lt, evalA96_lt]
+    rw [hcastA, hcastB] at hunle
+    exact hunle
+  -- box bounds
+  have hB2nn : (0 : Int) ≤ evalPoly ltB2 (m : Int) := by
+    rw [evalB2_lt]
+    exact Int.mul_nonneg (by simp only [Sc]; omega) (by simp only [Sc]; omega)
+  have hD8nn : (0 : Int) ≤ evalPoly ltD8 (m : Int) := by
+    rw [evalD8_lt]
+    refine Int.mul_nonneg (by omega) (Int.mul_nonneg ?_ ?_) <;>
+      simp only [Sc] <;> omega
+  have hu_lt_UB : ((q * q / 2 ^ 104 : Nat) : Int) ≤ 2333000000000000000000000000 := by
+    simp only [Uc] at hu_le
+    omega
+  have hb1P : ((q * q / 2 ^ 104 : Nat) : Int) * evalPoly ltD8 (m : Int) ≤
+      2333000000000000000000000000 * evalPoly ltD8 (m : Int) :=
+    mul_le_mul_right_nonneg hu_lt_UB hD8nn
+  have hb2P : -(2333000000000000000000000000 * evalPoly ltD8 (m : Int)) ≤
+      evalPoly ltWLO (m : Int) := by
+    rw [evalWLO_lt, evalD8_lt]
+    have hAB : ((Sc : Int) - m) * ((m : Int) + Sc) ≤
+        ((m : Int) + Sc) * ((m : Int) + Sc) :=
+      mul_le_mul_right_nonneg (by omega) (by simp only [Sc]; omega)
+    have hsq : (0 : Int) ≤ (((Sc : Int) - m) * ((Sc : Int) - m)) := by
+      refine Int.mul_nonneg ?_ ?_ <;> simp only [Sc] at h2 ⊢ <;> omega
+    have hBB : (0 : Int) ≤ ((m : Int) + Sc) * ((m : Int) + Sc) := by
+      refine Int.mul_nonneg ?_ ?_ <;> simp only [Sc] <;> omega
+    generalize ((Sc : Int) - m) * ((Sc : Int) - m) = AA at *
+    generalize ((Sc : Int) - m) * ((m : Int) + Sc) = AB at *
+    generalize ((m : Int) + Sc) * ((m : Int) + Sc) = BB at *
+    have h99 : (0 : Int) ≤ 2 ^ 99 * AA := Int.mul_nonneg (by omega) hsq
+    omega
+  -- P comparison through collapse and monotonicity
+  have hcolP : homEvalI PPc (((q * q / 2 ^ 104 : Nat) : Int) *
+      evalPoly ltD8 (m : Int)) (evalPoly ltD8 (m : Int)) =
+      evalPoly ltD8 (m : Int) ^ 4 * PPv := by
+    rw [show PPc = (8203564106909714963200842018502018851024462725819431901516251320229929630934299039494945066816553616430456446611805193566972803059892092928 : Int) :: PP3c from rfl,
+      homEvalI_collapse, ← hPP]
+    rfl
+  have hBpos : (0 : Int) < (m : Int) + Sc := by simp only [Sc]; omega
+  have hD8pos : (0 : Int) < evalPoly ltD8 (m : Int) := by
+    rw [evalD8_lt]
+    exact Int.mul_pos (by omega) (Int.mul_pos hBpos hBpos)
+  have hB2pos : (0 : Int) < evalPoly ltB2 (m : Int) := by
+    rw [evalB2_lt]
+    exact Int.mul_pos hBpos hBpos
+  have hPanti := homEvalI_PPc_anti (n1 := ((q * q / 2 ^ 104 : Nat) : Int) *
+      evalPoly ltD8 (m : Int)) (n2 := evalPoly ltWLO (m : Int))
+    (D := evalPoly ltD8 (m : Int)) hD8pos hordP hb1P hb2P
+  have hPfin : toInt pword * 2 ^ 358 * evalPoly ltD8 (m : Int) ^ 4 ≤
+      homEvalI PPc (evalPoly ltWLO (m : Int)) (evalPoly ltD8 (m : Int)) := by
+    have hD84 : (0 : Int) ≤ evalPoly ltD8 (m : Int) ^ 4 := pow_nonneg' (by omega) 4
+    have s1 : toInt pword * 2 ^ 358 * evalPoly ltD8 (m : Int) ^ 4 ≤
+        PPv * evalPoly ltD8 (m : Int) ^ 4 :=
+      mul_le_mul_right_nonneg psh hD84
+    have e1 : PPv * evalPoly ltD8 (m : Int) ^ 4 =
+        evalPoly ltD8 (m : Int) ^ 4 * PPv := Int.mul_comm _ _
+    generalize hg1 : homEvalI PPc (((q * q / 2 ^ 104 : Nat) : Int) *
+      evalPoly ltD8 (m : Int)) (evalPoly ltD8 (m : Int)) = HU at hPanti hcolP
+    generalize hg2 : homEvalI PPc (evalPoly ltWLO (m : Int))
+      (evalPoly ltD8 (m : Int)) = HW at hPanti ⊢
+    generalize hg3 : PPv * evalPoly ltD8 (m : Int) ^ 4 = P1 at s1 e1
+    generalize hg4 : evalPoly ltD8 (m : Int) ^ 4 * PPv = P2 at e1 hcolP
+    generalize hg5 : toInt pword * 2 ^ 358 * evalPoly ltD8 (m : Int) ^ 4 = P0 at s1 ⊢
+    omega
+  -- Q comparison
+  have hb1Q : evalPoly ltA96 (m : Int) ≤
+      2333000000000000000000000000 * evalPoly ltB2 (m : Int) := by
+    have hws := ltWS_nonneg (m := (m : Int))
+      (by simp only [MLO] at h1; omega) (by simp only [Sc] at h2; omega)
+    rw [evalWS_lt] at hws
+    rw [evalA96_lt, evalB2_lt]
+    omega
+  have hb2Q : -(2333000000000000000000000000 * evalPoly ltB2 (m : Int)) ≤
+      ((q * q / 2 ^ 104 : Nat) : Int) * evalPoly ltB2 (m : Int) := by
+    have h := Int.mul_nonneg (Int.natCast_nonneg (q * q / 2 ^ 104)) (by omega :
+      (0 : Int) ≤ evalPoly ltB2 (m : Int))
+    have h2' : (0 : Int) ≤ 2333000000000000000000000000 * evalPoly ltB2 (m : Int) :=
+      Int.mul_nonneg (by omega) (by omega)
+    omega
+  have hQmono := homEvalI_QQc_mono (n1 := evalPoly ltA96 (m : Int))
+    (n2 := ((q * q / 2 ^ 104 : Nat) : Int) * evalPoly ltB2 (m : Int))
+    (D := evalPoly ltB2 (m : Int)) hB2pos hordQ hb1Q hb2Q
+  have hcolQ : homEvalI QQc (((q * q / 2 ^ 104 : Nat) : Int) *
+      evalPoly ltB2 (m : Int)) (evalPoly ltB2 (m : Int)) =
+      evalPoly ltB2 (m : Int) ^ 5 * QQv := by
+    rw [show QQc = (-(2202127471863542086976841246820549867195347718960342176144462014556523185327760268707187588705852038374958668534379582118318610928980329275922055168 : Int)) :: QQ4c from rfl,
+      homEvalI_collapse, ← hQQ]
+    rfl
+  have hQfin : -homEvalI QQc (evalPoly ltA96 (m : Int)) (evalPoly ltB2 (m : Int)) ≤
+      -toInt qword * 2 ^ 386 * evalPoly ltB2 (m : Int) ^ 5 := by
+    have hB25 : (0 : Int) ≤ evalPoly ltB2 (m : Int) ^ 5 := pow_nonneg' (by omega) 5
+    have s1 : evalPoly ltB2 (m : Int) ^ 5 * QQv ≤
+        homEvalI QQc (evalPoly ltA96 (m : Int)) (evalPoly ltB2 (m : Int)) := by
+      rw [← hcolQ]
+      exact hQmono
+    have s2 : toInt qword * 2 ^ 386 * evalPoly ltB2 (m : Int) ^ 5 ≤
+        QQv * evalPoly ltB2 (m : Int) ^ 5 :=
+      mul_le_mul_right_nonneg qsh hB25
+    have e1 : QQv * evalPoly ltB2 (m : Int) ^ 5 =
+        evalPoly ltB2 (m : Int) ^ 5 * QQv := Int.mul_comm _ _
+    have e2 : -toInt qword * 2 ^ 386 * evalPoly ltB2 (m : Int) ^ 5 =
+        -(toInt qword * 2 ^ 386 * evalPoly ltB2 (m : Int) ^ 5) := by
+      rw [Int.neg_mul, Int.neg_mul]
+    generalize hg1 : homEvalI QQc (evalPoly ltA96 (m : Int))
+      (evalPoly ltB2 (m : Int)) = HW at s1 ⊢
+    generalize hg2 : evalPoly ltB2 (m : Int) ^ 5 = B5 at s1 s2 e1 e2 hB25 ⊢
+    generalize hg3 : QQv * B5 = Q1 at s2 e1
+    generalize hg4 : B5 * QQv = Q2 at e1 s1
+    generalize hg5 : toInt qword * 2 ^ 386 * B5 = Q0 at s2 e2
+    generalize hg6 : -toInt qword * 2 ^ 386 * B5 = Q0n at e2 ⊢
+    omega
+  -- final assembly
+  rw [evalTD_lt, evalTN_lt]
+  generalize hPHV : homEvalI PPc (evalPoly ltWLO (m : Int))
+    (evalPoly ltD8 (m : Int)) = PHV at hPfin ⊢
+  generalize hQHVg : homEvalI QQc (evalPoly ltA96 (m : Int))
+    (evalPoly ltB2 (m : Int)) = QHV at hQfin ⊢
+  have hD8e := evalD8_lt m
+  have hB2e := evalB2_lt m
+  generalize hD8g : evalPoly ltD8 (m : Int) = D8v at hPfin hD8e
+  generalize hB2g : evalPoly ltB2 (m : Int) = B2v at hQfin hB2e
+  have hqpos : (0 : Int) < -toInt qword := by omega
+  have hppos : (0 : Int) ≤ toInt pword := by omega
+  have hApos : (0 : Int) ≤ (Sc : Int) - m := by simp only [Sc] at h2 ⊢; omega
+  have hB25 : (0 : Int) ≤ B2v ^ 5 := by
+    rw [hB2e]
+    exact pow_nonneg' (Int.mul_nonneg (by omega) (by omega)) 5
+  have hD84 : (0 : Int) ≤ D8v ^ 4 := by
+    rw [hD8e]
+    refine pow_nonneg' (Int.mul_nonneg (by omega) (Int.mul_nonneg ?_ ?_)) 4 <;>
+      simp only [Sc] <;> omega
+  -- step 1: X1v (-QHV) ≤ X1v ((-qword) 2^386 B2v^5)
+  have s1 : X1v * -QHV ≤ X1v * (-toInt qword * 2 ^ 386 * B2v ^ 5) := by
+    have h := mul_le_mul_left_nonneg hQfin hX1_nn
+    exact h
+  -- step 2: pull the division bracket through
+  have s2 : X1v * (-toInt qword * 2 ^ 386 * B2v ^ 5) ≤
+      toInt pword * (q : Int) * (2 ^ 386 * B2v ^ 5) := by
+    have e1 : X1v * (-toInt qword * 2 ^ 386 * B2v ^ 5) =
+        (X1v * -toInt qword) * (2 ^ 386 * B2v ^ 5) := by
+      simp only [Int.mul_assoc, Int.mul_comm, Int.mul_left_comm]
+    have hf : (0 : Int) ≤ 2 ^ 386 * B2v ^ 5 := Int.mul_nonneg (by omega) hB25
+    have h := mul_le_mul_right_nonneg hX1br hf
+    omega
+  -- step 3: multiply by B and use the z bracket
+  have s3 : toInt pword * (q : Int) * (2 ^ 386 * B2v ^ 5) * ((m : Int) + Sc) ≤
+      toInt pword * (((Sc : Int) - m) * 2 ^ 100) * (2 ^ 386 * B2v ^ 5) := by
+    have e1 : toInt pword * (q : Int) * (2 ^ 386 * B2v ^ 5) * ((m : Int) + Sc) =
+        (toInt pword * (2 ^ 386 * B2v ^ 5)) * ((q : Int) * ((m : Int) + Sc)) := by
+      simp only [Int.mul_assoc, Int.mul_comm, Int.mul_left_comm]
+    have e2 : toInt pword * (((Sc : Int) - m) * 2 ^ 100) * (2 ^ 386 * B2v ^ 5) =
+        (toInt pword * (2 ^ 386 * B2v ^ 5)) * (((Sc : Int) - m) * 2 ^ 100) := by
+      simp only [Int.mul_assoc, Int.mul_comm, Int.mul_left_comm]
+    have hf : (0 : Int) ≤ toInt pword * (2 ^ 386 * B2v ^ 5) :=
+      Int.mul_nonneg hppos (Int.mul_nonneg (by omega) hB25)
+    have h := mul_le_mul_left_nonneg hq1 hf
+    omega
+  -- step 4: bring in the P bound
+  have s4 : toInt pword * (((Sc : Int) - m) * 2 ^ 100) * (2 ^ 386 * B2v ^ 5) *
+      (2 ^ 358 * D8v ^ 4) ≤
+      PHV * (((Sc : Int) - m) * (2 ^ 486 * B2v ^ 5)) := by
+    have e1 : toInt pword * (((Sc : Int) - m) * 2 ^ 100) * (2 ^ 386 * B2v ^ 5) *
+        (2 ^ 358 * D8v ^ 4) =
+        (toInt pword * 2 ^ 358 * D8v ^ 4) *
+          (((Sc : Int) - m) * (2 ^ 100 * 2 ^ 386 * B2v ^ 5)) := by
+      simp only [Int.mul_assoc, Int.mul_comm, Int.mul_left_comm]
+    have hf : (0 : Int) ≤ ((Sc : Int) - m) * (2 ^ 100 * 2 ^ 386 * B2v ^ 5) :=
+      Int.mul_nonneg hApos (Int.mul_nonneg (by omega) hB25)
+    have h := mul_le_mul_right_nonneg hPfin hf
+    have e2 : PHV * (((Sc : Int) - m) * (2 ^ 100 * 2 ^ 386 * B2v ^ 5)) =
+        PHV * (((Sc : Int) - m) * (2 ^ 486 * B2v ^ 5)) := by
+      rw [show ((2 : Int) ^ 100 * 2 ^ 386) = 2 ^ 486 from by decide]
+    omega
+  -- multiplied chain and cancellation
+  have hD84pos : (0 : Int) < D8v ^ 4 := by
+    rw [hD8e]
+    refine pow_pos' (Int.mul_pos (by omega) (Int.mul_pos hBpos hBpos)) 4
+  have hMpos : (0 : Int) < ((m : Int) + Sc) * (2 ^ 358 * D8v ^ 4) :=
+    Int.mul_pos hBpos (Int.mul_pos (by omega) hD84pos)
+  have hMnn : (0 : Int) ≤ ((m : Int) + Sc) * (2 ^ 358 * D8v ^ 4) := by omega
+  have k1 : X1v * -QHV * (((m : Int) + Sc) * (2 ^ 358 * D8v ^ 4)) ≤
+      X1v * (-toInt qword * 2 ^ 386 * B2v ^ 5) *
+        (((m : Int) + Sc) * (2 ^ 358 * D8v ^ 4)) :=
+    mul_le_mul_right_nonneg s1 hMnn
+  have k2 : X1v * (-toInt qword * 2 ^ 386 * B2v ^ 5) *
+      (((m : Int) + Sc) * (2 ^ 358 * D8v ^ 4)) ≤
+      toInt pword * (q : Int) * (2 ^ 386 * B2v ^ 5) *
+        (((m : Int) + Sc) * (2 ^ 358 * D8v ^ 4)) :=
+    mul_le_mul_right_nonneg s2 hMnn
+  have k3 : toInt pword * (q : Int) * (2 ^ 386 * B2v ^ 5) *
+      (((m : Int) + Sc) * (2 ^ 358 * D8v ^ 4)) =
+      toInt pword * (q : Int) * (2 ^ 386 * B2v ^ 5) * ((m : Int) + Sc) *
+        (2 ^ 358 * D8v ^ 4) := by
+    simp only [Int.mul_assoc]
+  have k4 : toInt pword * (q : Int) * (2 ^ 386 * B2v ^ 5) * ((m : Int) + Sc) *
+      (2 ^ 358 * D8v ^ 4) ≤
+      toInt pword * (((Sc : Int) - m) * 2 ^ 100) * (2 ^ 386 * B2v ^ 5) *
+        (2 ^ 358 * D8v ^ 4) :=
+    mul_le_mul_right_nonneg s3 (Int.mul_nonneg (by omega) (by omega))
+  have k6 : 2 ^ 17 * (((Sc : Int) - m) * ((m : Int) + Sc) * PHV) * 2 ^ 99 *
+      (((m : Int) + Sc) * (2 ^ 358 * D8v ^ 4)) =
+      PHV * (((Sc : Int) - m) * (2 ^ 486 * B2v ^ 5)) := by
+    rw [hD8e, hB2e]
+    rw [show ((8 : Int) * (((m : Int) + Sc) * ((m : Int) + Sc))) ^ 4 =
+      4096 * (((m : Int) + Sc) * ((m : Int) + Sc)) ^ 4 from by
+        rw [Int.mul_pow]
+        rw [show ((8 : Int) ^ 4) = 4096 from by decide]]
+    rw [show (((m : Int) + Sc) * ((m : Int) + Sc)) ^ 5 =
+      (((m : Int) + Sc) * ((m : Int) + Sc)) ^ 4 *
+        (((m : Int) + Sc) * ((m : Int) + Sc)) from by
+        rw [Int.pow_succ]]
+    have hAC : 2 ^ 17 * (((Sc : Int) - m) * ((m : Int) + Sc) * PHV) * 2 ^ 99 *
+        (((m : Int) + Sc) * (2 ^ 358 * (4096 * (((m : Int) + Sc) * ((m : Int) + Sc)) ^ 4))) =
+        (2 ^ 17 * 2 ^ 99 * 2 ^ 358 * 4096) *
+          (PHV * (((Sc : Int) - m) * ((((m : Int) + Sc) * ((m : Int) + Sc)) ^ 4 *
+            (((m : Int) + Sc) * ((m : Int) + Sc))))) := by
+      simp only [Int.mul_assoc, Int.mul_comm, Int.mul_left_comm]
+    rw [hAC, show ((2 : Int) ^ 17 * 2 ^ 99 * 2 ^ 358 * 4096) = 2 ^ 486 from by decide]
+    simp only [Int.mul_assoc, Int.mul_comm, Int.mul_left_comm]
+  have key : X1v * -QHV * (((m : Int) + Sc) * (2 ^ 358 * D8v ^ 4)) ≤
+      2 ^ 17 * (((Sc : Int) - m) * ((m : Int) + Sc) * PHV) * 2 ^ 99 *
+        (((m : Int) + Sc) * (2 ^ 358 * D8v ^ 4)) := by
+    rw [k6]
+    omega
+  exact Int.le_of_mul_le_mul_right key hMpos
+
+/-- The pipeline magnitude sits above the lower certificate rational on the
+`m < S` branch: `TN2b(m) · 2^99 ≤ (-X1) · TD2b(m)`. -/
+theorem bracket_lt_lo {m : Nat} (h1 : MLO ≤ m) (h2 : m + 46 ≤ Sc) :
+    evalPoly ltTN2b (m : Int) * 2 ^ 99 ≤
+      -toInt (x1W (zWord m)) * evalPoly ltTD2b (m : Int) := by
+  have hSge : m ≤ Sc := by simp only [Sc] at h2 ⊢; omega
+  have hMHI : m < MHI := by simp only [MHI]; simp only [Sc] at h2; omega
+  obtain ⟨q, hzq, hq1, hq2⟩ := z_bracket_lt h1 hSge
+  have hzr := zWord_range h1 hMHI
+  have hwlt : zWord m < 2 ^ 256 := by unfold zWord; exact evmSdiv_lt _ _
+  have hx1 : x1W (zWord m) = hAt (toInt (zWord m)) := by
+    unfold hAt; rw [ofInt_toInt hwlt]
+  obtain ⟨heq, hmul⟩ := hAt_facts (toInt (zWord m)) hzr.1 hzr.2
+  have huv : uVal (toInt (zWord m)) = q * q / 2 ^ 104 := by
+    unfold uVal
+    rw [hzq]
+    have e : (q : Int) * (q : Int) = ((q * q : Nat) : Int) := by omega
+    rw [e]
+    omega
+  have hu_le : q * q / 2 ^ 104 ≤ Uc := by
+    have := uVal_le (toInt (zWord m)) hzr.1 hzr.2
+    rw [huv] at this
+    exact this
+  have hq_ge1 : 1 ≤ q := by
+    rcases Nat.eq_zero_or_pos q with h0 | h
+    · exfalso
+      subst h0
+      have hA46 : (46 : Int) ≤ (Sc : Int) - m := by simp only [Sc] at h2 ⊢; omega
+      have hBmax : (m : Int) + Sc ≤ 34624238973196922243142627472244 := by
+        simp only [MHI] at hMHI; simp only [Sc]; omega
+      have h46 : (46 : Int) * 2 ^ 100 ≤ ((Sc : Int) - m) * 2 ^ 100 :=
+        mul_le_mul_right_nonneg hA46 (by omega)
+      omega
+    · exact h
+  obtain ⟨pw, plo, phi, psl, psh⟩ := pS4_facts hu_le
+  obtain ⟨qw, qlo, qhi, qsl, qsh⟩ := qS5_facts hu_le
+  rw [huv] at heq hmul
+  generalize hw1 : pS4 (q * q / 2 ^ 104) = pword at heq hmul pw plo phi psl psh
+  generalize hw2 : qS5 (q * q / 2 ^ 104) = qword at heq qw qlo qhi qsl qsh
+  generalize hPP : evalPoly PPc ((q * q / 2 ^ 104 : Nat) : Int) = PPv at psl psh
+  generalize hQQ : evalPoly QQc ((q * q / 2 ^ 104 : Nat) : Int) = QQv at qsl qsh
+  have hxe : x1W (zWord m) = evmSdiv (evmMul pword (ofInt (toInt (zWord m)))) qword :=
+    hx1.trans heq
+  have hpq_pos : (0 : Int) ≤ toInt pword * (q : Int) :=
+    Int.mul_nonneg (by omega) (by omega)
+  have hnum_nn : (0 : Int) ≤ toInt (evmMul pword (ofInt (toInt (zWord m)))) := by
+    rw [hmul, hzq]
+    exact hpq_pos
+  have hX1v : toInt (x1W (zWord m)) =
+      -((((toInt pword * (q : Int)).toNat / (-toInt qword).toNat : Nat) : Int)) := by
+    rw [hxe, evmSdiv_pos_neg (evmMul_lt _ _) qw hnum_nn (by omega), hmul, hzq]
+  have hX1neg : -toInt (x1W (zWord m)) =
+      (((toInt pword * (q : Int)).toNat / (-toInt qword).toNat : Nat) : Int) := by
+    rw [hX1v, Int.neg_neg]
+  have hX1_nn : (0 : Int) ≤ -toInt (x1W (zWord m)) := by
+    rw [hX1neg]
+    exact Int.natCast_nonneg _
+  -- LOWER division bracket: pw q < (-X1 + 1)(-qw)
+  have hdm2 := Nat.div_add_mod (toInt pword * (q : Int)).toNat (-toInt qword).toNat
+  have hml2 := Nat.mod_lt (toInt pword * (q : Int)).toNat
+    (y := (-toInt qword).toNat) (by omega)
+  have hX1lo : toInt pword * (q : Int) <
+      (-toInt (x1W (zWord m)) + 1) * (-toInt qword) := by
+    rw [hX1neg]
+    have e : (((toInt pword * (q : Int)).toNat / (-toInt qword).toNat : Nat) : Int) + 1 =
+        (((toInt pword * (q : Int)).toNat / (-toInt qword).toNat + 1 : Nat) : Int) := by
+      omega
+    rw [e]
+    have e2 : (((toInt pword * (q : Int)).toNat / (-toInt qword).toNat + 1 : Nat) : Int) *
+        (-toInt qword) =
+        ((((toInt pword * (q : Int)).toNat / (-toInt qword).toNat + 1) *
+          (-toInt qword).toNat : Nat) : Int) := by
+      rw [Int.natCast_mul]
+      have : ((-toInt qword).toNat : Int) = -toInt qword := by omega
+      rw [this]
+    rw [e2]
+    have hexp : ((toInt pword * (q : Int)).toNat / (-toInt qword).toNat + 1) *
+        (-toInt qword).toNat =
+        (-toInt qword).toNat * ((toInt pword * (q : Int)).toNat / (-toInt qword).toNat) +
+          (-toInt qword).toNat := by
+      rw [Nat.add_mul, Nat.one_mul, Nat.mul_comm]
+    omega
+  clear heq hxe hmul hX1v hnum_nn hx1 hzr hwlt hzq hw1 hw2 hdm2 hml2 hX1neg
+  generalize hXg : -toInt (x1W (zWord m)) = X1v at hX1lo hX1_nn ⊢
+  -- u-hat brackets in Int form
+  have huI1 : ((q * q / 2 ^ 104 : Nat) : Int) * 2 ^ 104 ≤ (q : Int) * q := by
+    have e : (q : Int) * q = ((q * q : Nat) : Int) := by omega
+    rw [e]
+    omega
+  have huI2 : (q : Int) * q ≤ ((q * q / 2 ^ 104 : Nat) : Int) * 2 ^ 104 + 2 ^ 104 - 1 := by
+    have e : (q : Int) * q = ((q * q : Nat) : Int) := by omega
+    rw [e]
+    omega
+  -- orderings
+  have hcastA : ((Sc - m : Nat) : Int) = (Sc : Int) - m := by omega
+  have hcastB : ((m + Sc : Nat) : Int) = (m : Int) + Sc := by omega
+  have hunle := un_le_dsq (d := Sc - m) (q := q) (u := q * q / 2 ^ 104)
+    (B := m + Sc) (by simp only [MLO] at h1; omega)
+    (by rw [hcastA, hcastB]; exact hq1) huI1
+  have hordQ : ((q * q / 2 ^ 104 : Nat) : Int) * evalPoly ltB2 (m : Int) ≤
+      evalPoly ltA96 (m : Int) := by
+    rw [evalB2_lt, evalA96_lt]
+    rw [hcastA, hcastB] at hunle
+    exact hunle
+  have hwloLt := wlo_lt_un (d := Sc - m) (q := q) (u := q * q / 2 ^ 104)
+    (B := m + Sc) (by omega)
+    (by simp only [MLO] at h1; omega) (by simp only [Sc] at *; omega)
+    (by rw [hcastA, hcastB]; exact hq2)
+    huI2
+  have hordP : evalPoly ltWLO (m : Int) ≤
+      ((q * q / 2 ^ 104 : Nat) : Int) * evalPoly ltD8 (m : Int) := by
+    rw [evalWLO_lt, evalD8_lt]
+    rw [hcastA, hcastB] at hwloLt
+    have e1 : ((q * q / 2 ^ 104 : Nat) : Int) * (8 * (((m : Int) + Sc) * ((m : Int) + Sc))) =
+        8 * (((q * q / 2 ^ 104 : Nat) : Int) * (((m : Int) + Sc) * ((m : Int) + Sc))) := by
+      simp only [Int.mul_assoc, Int.mul_comm, Int.mul_left_comm]
+    have e2 : (((Sc : Int) - m) * ((Sc : Int) - m)) * 2 ^ 99 =
+        2 ^ 99 * (((Sc : Int) - m) * ((Sc : Int) - m)) := Int.mul_comm _ _
+    omega
+  -- box bounds
+  have hB2nn : (0 : Int) ≤ evalPoly ltB2 (m : Int) := by
+    rw [evalB2_lt]
+    exact Int.mul_nonneg (by simp only [Sc]; omega) (by simp only [Sc]; omega)
+  have hD8nn : (0 : Int) ≤ evalPoly ltD8 (m : Int) := by
+    rw [evalD8_lt]
+    refine Int.mul_nonneg (by omega) (Int.mul_nonneg ?_ ?_) <;>
+      simp only [Sc] <;> omega
+  have hu_lt_UB : ((q * q / 2 ^ 104 : Nat) : Int) ≤ 2333000000000000000000000000 := by
+    simp only [Uc] at hu_le
+    omega
+  have hb1P : ((q * q / 2 ^ 104 : Nat) : Int) * evalPoly ltD8 (m : Int) ≤
+      2333000000000000000000000000 * evalPoly ltD8 (m : Int) :=
+    mul_le_mul_right_nonneg hu_lt_UB hD8nn
+  have hb2P : -(2333000000000000000000000000 * evalPoly ltD8 (m : Int)) ≤
+      evalPoly ltWLO (m : Int) := by
+    rw [evalWLO_lt, evalD8_lt]
+    have hAB : ((Sc : Int) - m) * ((m : Int) + Sc) ≤
+        ((m : Int) + Sc) * ((m : Int) + Sc) :=
+      mul_le_mul_right_nonneg (by omega) (by simp only [Sc]; omega)
+    have hsq : (0 : Int) ≤ (((Sc : Int) - m) * ((Sc : Int) - m)) := by
+      refine Int.mul_nonneg ?_ ?_ <;> simp only [Sc] at h2 ⊢ <;> omega
+    have hBB : (0 : Int) ≤ ((m : Int) + Sc) * ((m : Int) + Sc) := by
+      refine Int.mul_nonneg ?_ ?_ <;> simp only [Sc] <;> omega
+    generalize ((Sc : Int) - m) * ((Sc : Int) - m) = AA at *
+    generalize ((Sc : Int) - m) * ((m : Int) + Sc) = AB at *
+    generalize ((m : Int) + Sc) * ((m : Int) + Sc) = BB at *
+    have h99 : (0 : Int) ≤ 2 ^ 99 * AA := Int.mul_nonneg (by omega) hsq
+    omega
+  have hBpos : (0 : Int) < (m : Int) + Sc := by simp only [Sc]; omega
+  have hD8pos : (0 : Int) < evalPoly ltD8 (m : Int) := by
+    rw [evalD8_lt]
+    exact Int.mul_pos (by omega) (Int.mul_pos hBpos hBpos)
+  have hB2pos : (0 : Int) < evalPoly ltB2 (m : Int) := by
+    rw [evalB2_lt]
+    exact Int.mul_pos hBpos hBpos
+  have hb1Q : evalPoly ltA96 (m : Int) ≤
+      2333000000000000000000000000 * evalPoly ltB2 (m : Int) := by
+    have hws := ltWS_nonneg (m := (m : Int))
+      (by simp only [MLO] at h1; omega) (by simp only [Sc] at h2; omega)
+    rw [evalWS_lt] at hws
+    rw [evalA96_lt, evalB2_lt]
+    omega
+  have hb2Q : -(2333000000000000000000000000 * evalPoly ltB2 (m : Int)) ≤
+      ((q * q / 2 ^ 104 : Nat) : Int) * evalPoly ltB2 (m : Int) := by
+    have h := Int.mul_nonneg (Int.natCast_nonneg (q * q / 2 ^ 104)) (by omega :
+      (0 : Int) ≤ evalPoly ltB2 (m : Int))
+    have h2' : (0 : Int) ≤ 2333000000000000000000000000 * evalPoly ltB2 (m : Int) :=
+      Int.mul_nonneg (by omega) (by omega)
+    omega
+  -- divided-difference monotonicity, with the argument roles of the up-side swapped
+  have hPanti := homEvalI_PPc_anti (n1 := evalPoly ltA96 (m : Int))
+    (n2 := ((q * q / 2 ^ 104 : Nat) : Int) * evalPoly ltB2 (m : Int))
+    (D := evalPoly ltB2 (m : Int)) hB2pos hordQ hb1Q hb2Q
+  have hQmono := homEvalI_QQc_mono (n1 := ((q * q / 2 ^ 104 : Nat) : Int) *
+      evalPoly ltD8 (m : Int)) (n2 := evalPoly ltWLO (m : Int))
+    (D := evalPoly ltD8 (m : Int)) hD8pos hordP hb1P hb2P
+  -- collapse instances
+  have hcolP : homEvalI PPc (((q * q / 2 ^ 104 : Nat) : Int) *
+      evalPoly ltB2 (m : Int)) (evalPoly ltB2 (m : Int)) =
+      evalPoly ltB2 (m : Int) ^ 4 * PPv := by
+    rw [show PPc = (8203564106909714963200842018502018851024462725819431901516251320229929630934299039494945066816553616430456446611805193566972803059892092928 : Int) :: PP3c from rfl,
+      homEvalI_collapse, ← hPP]
+    rfl
+  have hcolP' : homEvalI PPc (((q * q / 2 ^ 104 : Nat) : Int) *
+      evalPoly ltB2 (m : Int)) (evalPoly ltB2 (m : Int)) =
+      PPv * evalPoly ltB2 (m : Int) ^ 4 := by
+    rw [hcolP]
+    exact Int.mul_comm _ _
+  have hcolQ : homEvalI QQc (((q * q / 2 ^ 104 : Nat) : Int) *
+      evalPoly ltD8 (m : Int)) (evalPoly ltD8 (m : Int)) =
+      evalPoly ltD8 (m : Int) ^ 5 * QQv := by
+    rw [show QQc = (-(2202127471863542086976841246820549867195347718960342176144462014556523185327760268707187588705852038374958668534379582118318610928980329275922055168 : Int)) :: QQ4c from rfl,
+      homEvalI_collapse, ← hQQ]
+    rfl
+  have hcolQ' : homEvalI QQc (((q * q / 2 ^ 104 : Nat) : Int) *
+      evalPoly ltD8 (m : Int)) (evalPoly ltD8 (m : Int)) =
+      QQv * evalPoly ltD8 (m : Int) ^ 5 := by
+    rw [hcolQ]
+    exact Int.mul_comm _ _
+  have hB24 : (0 : Int) ≤ evalPoly ltB2 (m : Int) ^ 4 := pow_nonneg' (by omega) 4
+  have hD5nn : (0 : Int) ≤ evalPoly ltD8 (m : Int) ^ 5 := pow_nonneg' (by omega) 5
+  -- P upper comparison: PLOP(m) ≤ p-hat 2^358 (B²)^4
+  have hPfin : evalPoly ltPLOP (m : Int) ≤
+      toInt pword * 2 ^ 358 * evalPoly ltB2 (m : Int) ^ 4 := by
+    rw [evalPLOP_lt]
+    have s1P : homEvalI PPc (evalPoly ltA96 (m : Int)) (evalPoly ltB2 (m : Int)) ≤
+        PPv * evalPoly ltB2 (m : Int) ^ 4 := by
+      rw [← hcolP']
+      exact hPanti
+    have s2P : (PPv - SLOPPc) * evalPoly ltB2 (m : Int) ^ 4 ≤
+        toInt pword * 2 ^ 358 * evalPoly ltB2 (m : Int) ^ 4 :=
+      mul_le_mul_right_nonneg (by omega) hB24
+    have e1P : (PPv - SLOPPc) * evalPoly ltB2 (m : Int) ^ 4 =
+        PPv * evalPoly ltB2 (m : Int) ^ 4 - SLOPPc * evalPoly ltB2 (m : Int) ^ 4 :=
+      Int.sub_mul _ _ _
+    generalize hg1 : homEvalI PPc (evalPoly ltA96 (m : Int))
+      (evalPoly ltB2 (m : Int)) = HS at s1P ⊢
+    generalize hg2 : evalPoly ltB2 (m : Int) ^ 4 = B4 at s1P s2P e1P ⊢
+    generalize hg3 : PPv * B4 = PB4 at s1P e1P
+    generalize hg4 : SLOPPc * B4 = SB4 at e1P ⊢
+    generalize hg5 : (PPv - SLOPPc) * B4 = PSB at s2P e1P
+    generalize hg6 : toInt pword * 2 ^ 358 * B4 = PW4 at s2P ⊢
+    omega
+  -- Q lower comparison: (-q-hat) 2^386 (8B²)^5 ≤ DLO(m)
+  have hQfin : -toInt qword * 2 ^ 386 * evalPoly ltD8 (m : Int) ^ 5 ≤
+      evalPoly ltDLO (m : Int) := by
+    rw [evalDLO_lt]
+    have s1Q : homEvalI QQc (evalPoly ltWLO (m : Int)) (evalPoly ltD8 (m : Int)) ≤
+        QQv * evalPoly ltD8 (m : Int) ^ 5 := by
+      rw [← hcolQ']
+      exact hQmono
+    have s2Q : (QQv - SLOPQc) * evalPoly ltD8 (m : Int) ^ 5 ≤
+        toInt qword * 2 ^ 386 * evalPoly ltD8 (m : Int) ^ 5 :=
+      mul_le_mul_right_nonneg (by omega) hD5nn
+    have e1Q : (QQv - SLOPQc) * evalPoly ltD8 (m : Int) ^ 5 =
+        QQv * evalPoly ltD8 (m : Int) ^ 5 - SLOPQc * evalPoly ltD8 (m : Int) ^ 5 :=
+      Int.sub_mul _ _ _
+    have e2Q : -toInt qword * 2 ^ 386 * evalPoly ltD8 (m : Int) ^ 5 =
+        -(toInt qword * 2 ^ 386 * evalPoly ltD8 (m : Int) ^ 5) := by
+      rw [Int.neg_mul, Int.neg_mul]
+    generalize hg1 : homEvalI QQc (evalPoly ltWLO (m : Int))
+      (evalPoly ltD8 (m : Int)) = HS at s1Q ⊢
+    generalize hg2 : evalPoly ltD8 (m : Int) ^ 5 = D5 at s1Q s2Q e1Q e2Q ⊢
+    generalize hg3 : QQv * D5 = QD at s1Q e1Q
+    generalize hg4 : SLOPQc * D5 = SD at e1Q ⊢
+    generalize hg5 : (QQv - SLOPQc) * D5 = QSD at s2Q e1Q
+    generalize hg6 : toInt qword * 2 ^ 386 * D5 = QW at s2Q e2Q
+    generalize hg7 : -toInt qword * 2 ^ 386 * D5 = QWn at e2Q ⊢
+    omega
+  -- AZ bounds: 0 ≤ AZ(m) ≤ q (m + S)
+  have hAZnn : (0 : Int) ≤ evalPoly ltAZ (m : Int) := by
+    rw [evalAZ_lt]
+    simp only [Sc] at h2 ⊢
+    omega
+  have hAZle : evalPoly ltAZ (m : Int) ≤ (q : Int) * ((m : Int) + Sc) := by
+    rw [evalAZ_lt]
+    have hq2' := hq2
+    have e : ((q : Int) + 1) * ((m : Int) + Sc) =
+        (q : Int) * ((m : Int) + Sc) + ((m : Int) + Sc) := by
+      rw [Int.add_mul, Int.one_mul]
+    rw [e] at hq2'
+    generalize (q : Int) * ((m : Int) + Sc) = QB at hq2' ⊢
+    omega
+  -- numerator chain: PLOP·AZ·B ≤ p-hat q 2^358 (B²)^5
+  have hBnn : (0 : Int) ≤ (m : Int) + Sc := by simp only [Sc]; omega
+  have hPWnn : (0 : Int) ≤ toInt pword * 2 ^ 358 * evalPoly ltB2 (m : Int) ^ 4 :=
+    Int.mul_nonneg (Int.mul_nonneg (by omega) (by omega)) hB24
+  have t1 : evalPoly ltPLOP (m : Int) * evalPoly ltAZ (m : Int) ≤
+      toInt pword * 2 ^ 358 * evalPoly ltB2 (m : Int) ^ 4 * evalPoly ltAZ (m : Int) :=
+    mul_le_mul_right_nonneg hPfin hAZnn
+  have t1b : evalPoly ltPLOP (m : Int) * evalPoly ltAZ (m : Int) * ((m : Int) + Sc) ≤
+      toInt pword * 2 ^ 358 * evalPoly ltB2 (m : Int) ^ 4 * evalPoly ltAZ (m : Int) *
+        ((m : Int) + Sc) :=
+    mul_le_mul_right_nonneg t1 hBnn
+  have t2 : toInt pword * 2 ^ 358 * evalPoly ltB2 (m : Int) ^ 4 *
+      evalPoly ltAZ (m : Int) ≤
+      toInt pword * 2 ^ 358 * evalPoly ltB2 (m : Int) ^ 4 *
+        ((q : Int) * ((m : Int) + Sc)) :=
+    mul_le_mul_left_nonneg hAZle hPWnn
+  have t2b : toInt pword * 2 ^ 358 * evalPoly ltB2 (m : Int) ^ 4 *
+      evalPoly ltAZ (m : Int) * ((m : Int) + Sc) ≤
+      toInt pword * 2 ^ 358 * evalPoly ltB2 (m : Int) ^ 4 *
+        ((q : Int) * ((m : Int) + Sc)) * ((m : Int) + Sc) :=
+    mul_le_mul_right_nonneg t2 hBnn
+  have t34 : toInt pword * 2 ^ 358 * evalPoly ltB2 (m : Int) ^ 4 *
+      ((q : Int) * ((m : Int) + Sc)) * ((m : Int) + Sc) =
+      toInt pword * (q : Int) * (2 ^ 358 * evalPoly ltB2 (m : Int) ^ 5) := by
+    rw [show evalPoly ltB2 (m : Int) ^ 5 =
+      evalPoly ltB2 (m : Int) ^ 4 * evalPoly ltB2 (m : Int) from by rw [Int.pow_succ]]
+    rw [evalB2_lt]
+    simp only [Int.mul_assoc, Int.mul_comm, Int.mul_left_comm]
+  have hTfin : evalPoly ltPLOP (m : Int) * evalPoly ltAZ (m : Int) * ((m : Int) + Sc) ≤
+      toInt pword * (q : Int) * (2 ^ 358 * evalPoly ltB2 (m : Int) ^ 5) := by
+    refine Int.le_trans t1b ?_
+    rw [← t34]
+    exact t2b
+  -- denominator chain: (p-hat q + 1) 2^442 (8B²)^5 ≤ (-X1 + 1) 2^56 DLO
+  have hFnn : (0 : Int) ≤ 2 ^ 442 * evalPoly ltD8 (m : Int) ^ 5 :=
+    Int.mul_nonneg (by omega) hD5nn
+  have u2 : toInt pword * (q : Int) + 1 ≤ (X1v + 1) * -toInt qword := by
+    have h := hX1lo
+    generalize hg1 : toInt pword * (q : Int) = PQt at h ⊢
+    generalize hg2 : (X1v + 1) * -toInt qword = XQt at h ⊢
+    omega
+  have u3 : (toInt pword * (q : Int) + 1) * (2 ^ 442 * evalPoly ltD8 (m : Int) ^ 5) ≤
+      (X1v + 1) * -toInt qword * (2 ^ 442 * evalPoly ltD8 (m : Int) ^ 5) :=
+    mul_le_mul_right_nonneg u2 hFnn
+  have u4 : (X1v + 1) * -toInt qword * (2 ^ 442 * evalPoly ltD8 (m : Int) ^ 5) =
+      (X1v + 1) * (2 ^ 56 * (-toInt qword * 2 ^ 386 * evalPoly ltD8 (m : Int) ^ 5)) := by
+    rw [show (2 : Int) ^ 442 = 2 ^ 56 * 2 ^ 386 from by decide]
+    simp only [Int.mul_assoc, Int.mul_comm, Int.mul_left_comm]
+  have u1b : 2 ^ 56 * (-toInt qword * 2 ^ 386 * evalPoly ltD8 (m : Int) ^ 5) ≤
+      2 ^ 56 * evalPoly ltDLO (m : Int) :=
+    mul_le_mul_left_nonneg hQfin (by omega)
+  have hX1p1 : (0 : Int) ≤ X1v + 1 := by omega
+  have u5 : (X1v + 1) * (2 ^ 56 * (-toInt qword * 2 ^ 386 *
+      evalPoly ltD8 (m : Int) ^ 5)) ≤
+      (X1v + 1) * (2 ^ 56 * evalPoly ltDLO (m : Int)) :=
+    mul_le_mul_left_nonneg u1b hX1p1
+  have hRfin : (toInt pword * (q : Int) + 1) *
+      (2 ^ 442 * evalPoly ltD8 (m : Int) ^ 5) ≤
+      (X1v + 1) * (2 ^ 56 * evalPoly ltDLO (m : Int)) := by
+    refine Int.le_trans ?_ u5
+    rw [← u4]
+    exact u3
+  -- scale bridge: 2^442 (8B²)^5 = 2^457 (B²)^5
+  have ebr : (2 : Int) ^ 442 * evalPoly ltD8 (m : Int) ^ 5 =
+      2 ^ 457 * evalPoly ltB2 (m : Int) ^ 5 := by
+    rw [evalD8_lt, evalB2_lt]
+    rw [show ((8 : Int) * (((m : Int) + Sc) * ((m : Int) + Sc))) ^ 5 =
+      32768 * ((((m : Int) + Sc) * ((m : Int) + Sc)) ^ 5) from by
+        rw [Int.mul_pow]
+        rw [show ((8 : Int) ^ 5) = 32768 from by decide]]
+    rw [← Int.mul_assoc, show (2 : Int) ^ 442 * 32768 = 2 ^ 457 from by decide]
+  have escale : toInt pword * (q : Int) * (2 ^ 442 * evalPoly ltD8 (m : Int) ^ 5) =
+      2 ^ 99 * (toInt pword * (q : Int) * (2 ^ 358 * evalPoly ltB2 (m : Int) ^ 5)) := by
+    rw [ebr]
+    rw [show (2 : Int) ^ 457 = 2 ^ 99 * 2 ^ 358 from by decide]
+    simp only [Int.mul_assoc, Int.mul_comm, Int.mul_left_comm]
+  -- final assembly
+  rw [evalTN2b_lt, evalTD2b_lt]
+  have egoal : X1v * (2 ^ 99 * (2 ^ 56 * evalPoly ltDLO (m : Int))) =
+      2 ^ 99 * (X1v * (2 ^ 56 * evalPoly ltDLO (m : Int))) := by
+    simp only [Int.mul_assoc, Int.mul_comm]
+  rw [egoal]
+  have edist : (X1v + 1) * (2 ^ 56 * evalPoly ltDLO (m : Int)) =
+      X1v * (2 ^ 56 * evalPoly ltDLO (m : Int)) + 2 ^ 56 * evalPoly ltDLO (m : Int) := by
+    rw [Int.add_mul, Int.one_mul]
+  have edist2 : (toInt pword * (q : Int) + 1) *
+      (2 ^ 442 * evalPoly ltD8 (m : Int) ^ 5) =
+      toInt pword * (q : Int) * (2 ^ 442 * evalPoly ltD8 (m : Int) ^ 5) +
+        2 ^ 442 * evalPoly ltD8 (m : Int) ^ 5 := by
+    rw [Int.add_mul, Int.one_mul]
+  generalize hgT : evalPoly ltPLOP (m : Int) * evalPoly ltAZ (m : Int) *
+    ((m : Int) + Sc) = T at hTfin ⊢
+  generalize hgDLO : evalPoly ltDLO (m : Int) = DLO at hRfin edist ⊢
+  generalize hgD5 : evalPoly ltD8 (m : Int) ^ 5 = D5g at hRfin edist2 escale hD5nn
+  generalize hgB5 : evalPoly ltB2 (m : Int) ^ 5 = B5g at hTfin escale
+  generalize hgPQ : toInt pword * (q : Int) = PQ at hTfin hRfin edist2 escale
+  generalize hgPB : PQ * (2 ^ 358 * B5g) = PB at hTfin escale
+  generalize hgPQD : PQ * (2 ^ 442 * D5g) = PQD at edist2 escale
+  generalize hgRD : (PQ + 1) * (2 ^ 442 * D5g) = RD at hRfin edist2
+  generalize hgXW : X1v * (2 ^ 56 * DLO) = XW at edist ⊢
+  generalize hgXW1 : (X1v + 1) * (2 ^ 56 * DLO) = XW1 at hRfin edist
+  omega
+
+end LnFloorCert
diff --git a/formal/ln/LnProof/LnProof/FloorBudget.lean b/formal/ln/LnProof/LnProof/FloorBudget.lean
new file mode 100644
index 000000000..0ec1186ce
--- /dev/null
+++ b/formal/ln/LnProof/LnProof/FloorBudget.lean
@@ -0,0 +1,154 @@
+import LnProof.ExpSum
+
+/-!
+# Per-exponent budget inequalities
+
+The floor-spec assembly multiplies the `X1` caps with the `2^k` caps
+(`cap2U`/`cap2L` raised to the binade shift `k = 160 - clz`), the bias
+caps, and one output ulp (`capEL`), then weakens the resulting rational
+to the `x/10^18` target through the mantissa window. The weakening step
+reduces, per `k`, to one of the four integer inequalities certified here
+by kernel evaluation over the whole `k` range. The slack that closes
+each of them is the bias margin: `9.99e-28 (capEL) - 3.401e-28 (cert ε) -
+3.404e-28 (bias) - 1e-30 (strictness) - 2^-95 ((m+1)/m padding) > 0` on
+the low side, and `3.402e-28 (bias) - 3.401e-28 (cert ε) - k·1e-40 > 0` on
+the high side.
+
+Also provides `capLB_cancel`, the lower mirror of `capUB_cancel`, used
+to move the `2^|k|` factor across the quotient when `k < 0`.
+-/
+
+namespace LnExp
+
+/-- `e^(pa/q) = e^((pa+pb)/q) / e^(pb/q) ≥ (C/W) / (G/V)`. -/
+theorem capLB_cancel {pa pb q C W G V : Nat} (hq : 0 < q)
+    (hsum : capLB (pa + pb) q C W) (hb : capUB pb q G V) :
+    capLB pa q (C * V) (W * G) := by
+  obtain ⟨n, hn⟩ := hsum
+  refine ⟨n, ?_⟩
+  have hd : 0 < fact n * q ^ n := mul_pos' (fact_pos n) (Nat.pow_pos hq)
+  refine Nat.le_of_mul_le_mul_right ?_ hd
+  calc (C * V) * (fact n * q ^ n) * (fact n * q ^ n)
+      = (C * (fact n * q ^ n)) * (V * (fact n * q ^ n)) := by
+        simp only [Nat.mul_assoc, Nat.mul_comm, Nat.mul_left_comm]
+    _ ≤ (expNum n (pa + pb) q * W) * (V * (fact n * q ^ n)) :=
+        Nat.mul_le_mul_right _ hn
+    _ = (expNum n (pa + pb) q * (fact n * q ^ n)) * V * W := by
+        simp only [Nat.mul_assoc, Nat.mul_comm, Nat.mul_left_comm]
+    _ ≤ (expNum n pa q * expNum n pb q) * V * W :=
+        Nat.mul_le_mul_right _ (Nat.mul_le_mul_right _ (sum_le_prod n pa pb q))
+    _ = (expNum n pb q * V) * (expNum n pa q * W) := by
+        simp only [Nat.mul_assoc, Nat.mul_comm, Nat.mul_left_comm]
+    _ ≤ (G * (fact n * q ^ n)) * (expNum n pa q * W) :=
+        Nat.mul_le_mul_right _ (hb n)
+    _ = expNum n pa q * (W * G) * (fact n * q ^ n) := by
+        simp only [Nat.mul_assoc, Nat.mul_comm, Nat.mul_left_comm]
+
+end LnExp
+
+namespace LnFloorCert
+
+/-- Upper weakening budget, `k = 160 - clz ≥ 0` (worst case `x = m 2^k`). -/
+def budgetU (k : Nat) : Bool :=
+  decide ((10 ^ 31 + 3401) * (2 * (10 ^ 40 + 1)) ^ k * (10 ^ 31 - 3402) * 10 ^ 18 ≤
+    2 ^ k * (10 ^ 40 : Nat) ^ k * 10 ^ 80)
+
+/-- Lower weakening budget, `k ≥ 0` (worst case `x = (m+1) 2^k`, `m = 2^95`). -/
+def budgetL (k : Nat) : Bool :=
+  decide ((2 ^ 95 + 1) * 2 ^ k * (10 ^ 40 : Nat) ^ k * 10 ^ 142 ≤
+    2 ^ 95 * (10 ^ 31 - 3401) * (2 * (10 ^ 40 - 1)) ^ k * (10 ^ 31 - 3404) *
+      (10 ^ 31 + 9990) * (10 ^ 31 - 10) * 10 ^ 18)
+
+/-- Upper weakening budget, `k < 0` with `j = -k` (exact mantissa `m = x 2^j`). -/
+def budgetUn (j : Nat) : Bool :=
+  decide ((10 ^ 31 + 3401) * (10 ^ 31 - 3402) * (10 ^ 40 : Nat) ^ j * 2 ^ j * 10 ^ 18 ≤
+    10 ^ 80 * (2 * (10 ^ 40 - 1)) ^ j)
+
+/-- Lower weakening budget, `k < 0` (exact mantissa). -/
+def budgetLn (j : Nat) : Bool :=
+  decide ((10 : Nat) ^ 142 * (2 * (10 ^ 40 + 1)) ^ j ≤
+    2 ^ j * (10 ^ 40 : Nat) ^ j * (10 ^ 31 - 3401) * (10 ^ 31 - 3404) *
+      (10 ^ 31 + 9990) * (10 ^ 31 - 10) * 10 ^ 18)
+
+theorem budgetU_all : (List.range 160).all budgetU = true := by
+  decide +kernel
+
+theorem budgetL_all : (List.range 160).all budgetL = true := by
+  decide +kernel
+
+theorem budgetUn_all : (List.range 96).all budgetUn = true := by
+  decide +kernel
+
+theorem budgetLn_all : (List.range 96).all budgetLn = true := by
+  decide +kernel
+
+theorem budgetU_le {k : Nat} (hk : k ≤ 159) :
+    (10 ^ 31 + 3401) * (2 * (10 ^ 40 + 1)) ^ k * (10 ^ 31 - 3402) * 10 ^ 18 ≤
+      2 ^ k * (10 ^ 40 : Nat) ^ k * 10 ^ 80 := by
+  have h := List.all_eq_true.mp budgetU_all k (List.mem_range.mpr (by omega))
+  simp only [budgetU, decide_eq_true_eq] at h
+  exact h
+
+theorem budgetL_le {k : Nat} (hk : k ≤ 159) :
+    (2 ^ 95 + 1) * 2 ^ k * (10 ^ 40 : Nat) ^ k * 10 ^ 142 ≤
+      2 ^ 95 * (10 ^ 31 - 3401) * (2 * (10 ^ 40 - 1)) ^ k * (10 ^ 31 - 3404) *
+        (10 ^ 31 + 9990) * (10 ^ 31 - 10) * 10 ^ 18 := by
+  have h := List.all_eq_true.mp budgetL_all k (List.mem_range.mpr (by omega))
+  simp only [budgetL, decide_eq_true_eq] at h
+  exact h
+
+theorem budgetUn_le {j : Nat} (hj : j ≤ 95) :
+    (10 ^ 31 + 3401) * (10 ^ 31 - 3402) * (10 ^ 40 : Nat) ^ j * 2 ^ j * 10 ^ 18 ≤
+      10 ^ 80 * (2 * (10 ^ 40 - 1)) ^ j := by
+  have h := List.all_eq_true.mp budgetUn_all j (List.mem_range.mpr (by omega))
+  simp only [budgetUn, decide_eq_true_eq] at h
+  exact h
+
+theorem budgetLn_le {j : Nat} (hj : j ≤ 95) :
+    (10 : Nat) ^ 142 * (2 * (10 ^ 40 + 1)) ^ j ≤
+      2 ^ j * (10 ^ 40 : Nat) ^ j * (10 ^ 31 - 3401) * (10 ^ 31 - 3404) *
+        (10 ^ 31 + 9990) * (10 ^ 31 - 10) * 10 ^ 18 := by
+  have h := List.all_eq_true.mp budgetLn_all j (List.mem_range.mpr (by omega))
+  simp only [budgetLn, decide_eq_true_eq] at h
+  exact h
+
+/-- Reciprocal-side strict budget, `k ≥ 0` (worst case `x = (m+1)·2^k`,
+`m = 2^95`), for the `r + 2 ≤ 0` B-atom. -/
+def budgetB (k : Nat) : Bool :=
+  decide ((10 : Nat) ^ 31 * (10 ^ 40 : Nat) ^ k * (10 ^ 18 * 10 ^ 31) * 10 ^ 31 *
+      ((2 ^ 95 + 1) * 2 ^ k) * 10 ^ 31 ≤
+    10 ^ 18 * (10 ^ 31 - 10) * 2 ^ 95 * (10 ^ 31 - 3401) * (2 * (10 ^ 40 - 1)) ^ k *
+      (10 ^ 31 - 3404) * (10 ^ 31 + 9990))
+
+/-- Reciprocal-side strict budget, `k < 0` (exact mantissa). -/
+def budgetBn (j : Nat) : Bool :=
+  decide ((2 * (10 ^ 40 + 1)) ^ j * (10 : Nat) ^ 31 * (10 ^ 18 * 10 ^ 31) * 10 ^ 31 *
+      10 ^ 31 ≤
+    10 ^ 18 * (10 ^ 31 - 10) * (10 ^ 40 : Nat) ^ j * 2 ^ j * (10 ^ 31 - 3401) *
+      (10 ^ 31 - 3404) * (10 ^ 31 + 9990))
+
+theorem budgetB_all : (List.range 160).all budgetB = true := by
+  decide +kernel
+
+theorem budgetBn_all : (List.range 96).all budgetBn = true := by
+  decide +kernel
+
+theorem budgetB_le {k : Nat} (hk : k ≤ 159) :
+    (10 : Nat) ^ 31 * (10 ^ 40 : Nat) ^ k * (10 ^ 18 * 10 ^ 31) * 10 ^ 31 *
+      ((2 ^ 95 + 1) * 2 ^ k) * 10 ^ 31 ≤
+    10 ^ 18 * (10 ^ 31 - 10) * 2 ^ 95 * (10 ^ 31 - 3401) * (2 * (10 ^ 40 - 1)) ^ k *
+      (10 ^ 31 - 3404) * (10 ^ 31 + 9990) := by
+  have h := List.all_eq_true.mp budgetB_all k (List.mem_range.mpr (by omega))
+  simp only [budgetB, decide_eq_true_eq] at h
+  exact h
+
+theorem budgetBn_le {j : Nat} (hj : j ≤ 95) :
+    (2 * (10 ^ 40 + 1)) ^ j * (10 : Nat) ^ 31 * (10 ^ 18 * 10 ^ 31) * 10 ^ 31 *
+      10 ^ 31 ≤
+    10 ^ 18 * (10 ^ 31 - 10) * (10 ^ 40 : Nat) ^ j * 2 ^ j * (10 ^ 31 - 3401) *
+      (10 ^ 31 - 3404) * (10 ^ 31 + 9990) := by
+  have h := List.all_eq_true.mp budgetBn_all j (List.mem_range.mpr (by omega))
+  simp only [budgetBn, decide_eq_true_eq] at h
+  exact h
+
+end LnFloorCert
diff --git a/formal/ln/LnProof/LnProof/FloorCaps.lean b/formal/ln/LnProof/LnProof/FloorCaps.lean
new file mode 100644
index 000000000..f74019ab6
--- /dev/null
+++ b/formal/ln/LnProof/LnProof/FloorCaps.lean
@@ -0,0 +1,574 @@
+import LnProof.FloorBracket
+import LnProof.FloorCertAux
+
+/-!
+# From cell certificates to exponential caps
+
+Converts the kernel-checked nonnegativity of the four main certificate
+polynomials into `capUB`/`capLB` facts about the pipeline value `X1`:
+integer-scaled statements of `e^(X1/2^99) ≤ (m/S)(1+ε)` and the three
+mirrors, with `ε = 42/10^29`, over the common denominator `10^27 · 2^99`.
+-/
+
+namespace LnFloorCert
+open LnGeneratedModel LnPoly LnExp
+
+set_option maxRecDepth 100000
+
+theorem eval01 (x : Int) : evalPoly ([0, 1] : List Int) x = x := by
+  show (0 : Int) + x * (1 + x * 0) = x
+  omega
+
+theorem evalCertGeUp (m : Nat) :
+    evalPoly certGeUp (m : Int) =
+      (EUD + EUN) * KF1 * ((m : Int) * evalPoly geTD (m : Int) ^ 23) +
+        -(Sc : Int) * EUD *
+          (23 * (expNumI 22 (evalPoly geTN (m : Int)) (evalPoly geTD (m : Int)) *
+            evalPoly geTD (m : Int)) + 2 * evalPoly geTN (m : Int) ^ 23) := by
+  unfold certGeUp
+  simp only [evalPoly_polyAdd, evalPoly_polyScale, evalPoly_polyMul, evalPoly_polyPow,
+    evalPoly_expPolyNum, eval01]
+
+theorem evalCertGeLo (m : Nat) :
+    evalPoly certGeLo (m : Int) =
+      EUD * (Sc : Int) *
+          expNumI 22 (evalPoly geTN2b (m : Int)) (evalPoly geTD2b (m : Int)) +
+        -(EUD - EUN) * KF * ((m : Int) * evalPoly geTD2b (m : Int) ^ 22) := by
+  unfold certGeLo
+  simp only [evalPoly_polyAdd, evalPoly_polyScale, evalPoly_polyMul, evalPoly_polyPow,
+    evalPoly_expPolyNum, eval01]
+
+theorem evalCertLtUp (m : Nat) :
+    evalPoly certLtUp (m : Int) =
+      (EUD + EUN) * ((m : Int) *
+          expNumI 22 (evalPoly ltTN2b (m : Int)) (evalPoly ltTD2b (m : Int))) +
+        -EUD * (Sc : Int) * KF * evalPoly ltTD2b (m : Int) ^ 22 := by
+  unfold certLtUp
+  simp only [evalPoly_polyAdd, evalPoly_polyScale, evalPoly_polyMul, evalPoly_polyPow,
+    evalPoly_expPolyNum, eval01]
+
+theorem evalCertLtLo (m : Nat) :
+    evalPoly certLtLo (m : Int) =
+      (Sc : Int) * EUD * KF1 * evalPoly ltTD (m : Int) ^ 23 +
+        -(EUD - EUN) * ((m : Int) *
+          (23 * (expNumI 22 (evalPoly ltTN (m : Int)) (evalPoly ltTD (m : Int)) *
+            evalPoly ltTD (m : Int)) + 2 * evalPoly ltTN (m : Int) ^ 23)) := by
+  unfold certLtLo
+  simp only [evalPoly_polyAdd, evalPoly_polyScale, evalPoly_polyMul, evalPoly_polyPow,
+    evalPoly_expPolyNum, eval01]
+
+theorem evalCertGeH (m : Nat) :
+    evalPoly certGeH (m : Int) =
+      24 * evalPoly geTD (m : Int) + -2 * evalPoly geTN (m : Int) := by
+  show evalPoly (polyAdd (polyScale 24 geTD) (polyScale (-2) geTN)) (m : Int) = _
+  simp only [evalPoly_polyAdd, evalPoly_polyScale]
+
+theorem evalCertLtH (m : Nat) :
+    evalPoly certLtH (m : Int) =
+      24 * evalPoly ltTD (m : Int) + -2 * evalPoly ltTN (m : Int) := by
+  show evalPoly (polyAdd (polyScale 24 ltTD) (polyScale (-2) ltTN)) (m : Int) = _
+  simp only [evalPoly_polyAdd, evalPoly_polyScale]
+
+theorem evalCertGeTD (m : Nat) :
+    evalPoly certGeTD (m : Int) = evalPoly geTD (m : Int) + -1 := by
+  show evalPoly (polyAdd geTD [-1]) (m : Int) = _
+  rw [evalPoly_polyAdd]
+  show _ + ((-1 : Int) + (m : Int) * 0) = _
+  omega
+
+theorem evalCertGeTD2 (m : Nat) :
+    evalPoly certGeTD2 (m : Int) = evalPoly geTD2b (m : Int) + -1 := by
+  show evalPoly (polyAdd geTD2b [-1]) (m : Int) = _
+  rw [evalPoly_polyAdd]
+  show _ + ((-1 : Int) + (m : Int) * 0) = _
+  omega
+
+theorem evalCertLtTD (m : Nat) :
+    evalPoly certLtTD (m : Int) = evalPoly ltTD (m : Int) + -1 := by
+  show evalPoly (polyAdd ltTD [-1]) (m : Int) = _
+  rw [evalPoly_polyAdd]
+  show _ + ((-1 : Int) + (m : Int) * 0) = _
+  omega
+
+theorem evalCertLtTD2 (m : Nat) :
+    evalPoly certLtTD2 (m : Int) = evalPoly ltTD2b (m : Int) + -1 := by
+  show evalPoly (polyAdd ltTD2b [-1]) (m : Int) = _
+  rw [evalPoly_polyAdd]
+  show _ + ((-1 : Int) + (m : Int) * 0) = _
+  omega
+
+/-! ## Int-to-Nat bridges for the two cap shapes at K = 22 -/
+
+theorem capUB22_of_int {tn td y w : Nat} (htd : 0 < td) (hH : 2 * tn ≤ 24 * td)
+    (h : (expNumI 22 (tn : Int) (td : Int) * (23 * (td : Int)) + 2 * (tn : Int) ^ 23) *
+        (w : Int) ≤ (y : Int) * (25852016738884976640000 * (td : Int) ^ 23)) :
+    capUB tn td y w := by
+  refine capUB_of_partial htd (by omega : 2 * tn ≤ (22 + 2) * td) ?_
+  show (expNum 22 tn td * (23 * td) + 2 * tn ^ 23) * w ≤ y * (fact 23 * td ^ 23)
+  rw [show fact 23 = 25852016738884976640000 from by decide]
+  refine Int.ofNat_le.mp ?_
+  rw [expNumI_eq_expNum] at h
+  simp only [Int.natCast_mul, Int.natCast_add, Int.natCast_pow]
+  exact h
+
+theorem capLB22_of_int {tn td y w : Nat}
+    (h : (y : Int) * (1124000727777607680000 * (td : Int) ^ 22) ≤
+        expNumI 22 (tn : Int) (td : Int) * (w : Int)) :
+    capLB tn td y w := by
+  refine ⟨22, ?_⟩
+  show y * (fact 22 * td ^ 22) ≤ expNum 22 tn td * w
+  rw [show fact 22 = 1124000727777607680000 from by decide]
+  refine Int.ofNat_le.mp ?_
+  rw [expNumI_eq_expNum] at h
+  simp only [Int.natCast_mul, Int.natCast_pow]
+  exact h
+
+/-! ## Certificate nonnegativity to caps at the certificate rationals -/
+
+theorem capGeUp {m : Nat} (h1 : Sc + 46 ≤ m) (h2 : m < MHI)
+    (hup : 0 ≤ evalPoly certGeUp (m : Int)) :
+    capUB (evalPoly geTN (m : Int)).toNat (evalPoly geTD (m : Int)).toNat
+      (m * 10000000000000000000000000003401)
+      560227709747861399187319382270000000000000000000000000000000 := by
+  have hw1 : (56022770974786139918731938273 : Int) ≤ (m : Int) := by
+    simp only [Sc] at h1; omega
+  have hw2 : (m : Int) ≤ 79228162514264337593543950335 := by
+    simp only [MHI] at h2; omega
+  have hTN0 : 0 ≤ evalPoly geTN (m : Int) := geTN_nonneg hw1 hw2
+  have hTD1 : 1 ≤ evalPoly geTD (m : Int) := by
+    have h := geTD_nonneg hw1 hw2
+    rw [evalCertGeTD] at h
+    omega
+  have hHc : 2 * evalPoly geTN (m : Int) ≤ 24 * evalPoly geTD (m : Int) := by
+    have h := geH_nonneg hw1 hw2
+    rw [evalCertGeH] at h
+    omega
+  have htn : ((evalPoly geTN (m : Int)).toNat : Int) = evalPoly geTN (m : Int) :=
+    Int.toNat_of_nonneg hTN0
+  have htd : ((evalPoly geTD (m : Int)).toNat : Int) = evalPoly geTD (m : Int) :=
+    Int.toNat_of_nonneg (by omega)
+  refine capUB22_of_int (by omega) (by omega) ?_
+  rw [htn, htd]
+  rw [evalCertGeUp] at hup
+  simp only [EUD, EUN, KF1, Sc] at hup
+  simp only [Int.natCast_mul]
+  rw [show ((560227709747861399187319382270000000000000000000000000000000 : Nat) : Int) = 560227709747861399187319382270000000000000000000000000000000 from rfl,
+      show ((10000000000000000000000000003401 : Nat) : Int) = 10000000000000000000000000003401 from rfl]
+  have eS : expNumI 22 (evalPoly geTN (m : Int)) (evalPoly geTD (m : Int)) *
+      (23 * evalPoly geTD (m : Int)) =
+      23 * (expNumI 22 (evalPoly geTN (m : Int)) (evalPoly geTD (m : Int)) *
+        evalPoly geTD (m : Int)) := by
+    simp only [Int.mul_assoc, Int.mul_comm, Int.mul_left_comm]
+  rw [eS]
+  have eR : (m : Int) * 10000000000000000000000000003401 *
+      (25852016738884976640000 * evalPoly geTD (m : Int) ^ 23) =
+      10000000000000000000000000003401 * 25852016738884976640000 *
+        ((m : Int) * evalPoly geTD (m : Int) ^ 23) := by
+    simp only [Int.mul_assoc, Int.mul_comm, Int.mul_left_comm]
+  rw [eR]
+  generalize hgET : expNumI 22 (evalPoly geTN (m : Int)) (evalPoly geTD (m : Int)) *
+    evalPoly geTD (m : Int) = ET at hup ⊢
+  generalize hgN23 : evalPoly geTN (m : Int) ^ 23 = N23 at hup ⊢
+  generalize hgMT : (m : Int) * evalPoly geTD (m : Int) ^ 23 = MT at hup ⊢
+  omega
+
+theorem capGeLo {m : Nat} (h1 : Sc + 46 ≤ m) (h2 : m < MHI)
+    (hlo : 0 ≤ evalPoly certGeLo (m : Int)) :
+    capLB (evalPoly geTN2b (m : Int)).toNat (evalPoly geTD2b (m : Int)).toNat
+      (m * 9999999999999999999999999996599)
+      560227709747861399187319382270000000000000000000000000000000 := by
+  have hw1 : (56022770974786139918731938273 : Int) ≤ (m : Int) := by
+    simp only [Sc] at h1; omega
+  have hw2 : (m : Int) ≤ 79228162514264337593543950335 := by
+    simp only [MHI] at h2; omega
+  have hTN0 : 0 ≤ evalPoly geTN2b (m : Int) := geTN2_nonneg hw1 hw2
+  have hTD1 : 1 ≤ evalPoly geTD2b (m : Int) := by
+    have h := geTD2_nonneg hw1 hw2
+    rw [evalCertGeTD2] at h
+    omega
+  have htn : ((evalPoly geTN2b (m : Int)).toNat : Int) = evalPoly geTN2b (m : Int) :=
+    Int.toNat_of_nonneg hTN0
+  have htd : ((evalPoly geTD2b (m : Int)).toNat : Int) = evalPoly geTD2b (m : Int) :=
+    Int.toNat_of_nonneg (by omega)
+  refine capLB22_of_int ?_
+  rw [htn, htd]
+  rw [evalCertGeLo] at hlo
+  simp only [EUD, EUN, KF, Sc] at hlo
+  simp only [Int.natCast_mul]
+  rw [show ((560227709747861399187319382270000000000000000000000000000000 : Nat) : Int) = 560227709747861399187319382270000000000000000000000000000000 from rfl,
+      show ((9999999999999999999999999996599 : Nat) : Int) = 9999999999999999999999999996599 from rfl]
+  have eR : (m : Int) * 9999999999999999999999999996599 *
+      (1124000727777607680000 * evalPoly geTD2b (m : Int) ^ 22) =
+      9999999999999999999999999996599 * 1124000727777607680000 *
+        ((m : Int) * evalPoly geTD2b (m : Int) ^ 22) := by
+    simp only [Int.mul_assoc, Int.mul_comm, Int.mul_left_comm]
+  rw [eR]
+  generalize hgE : expNumI 22 (evalPoly geTN2b (m : Int)) (evalPoly geTD2b (m : Int)) =
+    E at hlo ⊢
+  generalize hgMT : (m : Int) * evalPoly geTD2b (m : Int) ^ 22 = MT at hlo ⊢
+  omega
+
+theorem capLtUp {m : Nat} (h1 : MLO ≤ m) (h2 : m + 46 ≤ Sc)
+    (hup : 0 ≤ evalPoly certLtUp (m : Int)) :
+    capLB (evalPoly ltTN2b (m : Int)).toNat (evalPoly ltTD2b (m : Int)).toNat
+      560227709747861399187319382270000000000000000000000000000000
+      (m * 10000000000000000000000000003401) := by
+  have hw1 : (39614081257132168796771975168 : Int) ≤ (m : Int) := by
+    simp only [MLO] at h1; omega
+  have hw2 : (m : Int) ≤ 56022770974786139918731938181 := by
+    simp only [Sc] at h2; omega
+  have hTN0 : 0 ≤ evalPoly ltTN2b (m : Int) := ltTN2_nonneg hw1 hw2
+  have hTD1 : 1 ≤ evalPoly ltTD2b (m : Int) := by
+    have h := ltTD2_nonneg hw1 hw2
+    rw [evalCertLtTD2] at h
+    omega
+  have htn : ((evalPoly ltTN2b (m : Int)).toNat : Int) = evalPoly ltTN2b (m : Int) :=
+    Int.toNat_of_nonneg hTN0
+  have htd : ((evalPoly ltTD2b (m : Int)).toNat : Int) = evalPoly ltTD2b (m : Int) :=
+    Int.toNat_of_nonneg (by omega)
+  refine capLB22_of_int ?_
+  rw [htn, htd]
+  rw [evalCertLtUp] at hup
+  simp only [EUD, EUN, KF, Sc] at hup
+  simp only [Int.natCast_mul]
+  rw [show ((560227709747861399187319382270000000000000000000000000000000 : Nat) : Int) = 560227709747861399187319382270000000000000000000000000000000 from rfl,
+      show ((10000000000000000000000000003401 : Nat) : Int) = 10000000000000000000000000003401 from rfl]
+  have eR : expNumI 22 (evalPoly ltTN2b (m : Int)) (evalPoly ltTD2b (m : Int)) *
+      ((m : Int) * 10000000000000000000000000003401) =
+      10000000000000000000000000003401 *
+        ((m : Int) * expNumI 22 (evalPoly ltTN2b (m : Int)) (evalPoly ltTD2b (m : Int))) := by
+    simp only [Int.mul_assoc, Int.mul_comm, Int.mul_left_comm]
+  rw [eR]
+  generalize hgME : (m : Int) * expNumI 22 (evalPoly ltTN2b (m : Int))
+    (evalPoly ltTD2b (m : Int)) = ME at hup ⊢
+  generalize hgT22 : evalPoly ltTD2b (m : Int) ^ 22 = T22 at hup ⊢
+  omega
+
+theorem capLtLo {m : Nat} (h1 : MLO ≤ m) (h2 : m + 46 ≤ Sc)
+    (hlo : 0 ≤ evalPoly certLtLo (m : Int)) :
+    capUB (evalPoly ltTN (m : Int)).toNat (evalPoly ltTD (m : Int)).toNat
+      560227709747861399187319382270000000000000000000000000000000
+      (m * 9999999999999999999999999996599) := by
+  have hw1 : (39614081257132168796771975168 : Int) ≤ (m : Int) := by
+    simp only [MLO] at h1; omega
+  have hw2 : (m : Int) ≤ 56022770974786139918731938181 := by
+    simp only [Sc] at h2; omega
+  have hTN0 : 0 ≤ evalPoly ltTN (m : Int) := ltTN_nonneg hw1 hw2
+  have hTD1 : 1 ≤ evalPoly ltTD (m : Int) := by
+    have h := ltTD_nonneg hw1 hw2
+    rw [evalCertLtTD] at h
+    omega
+  have hHc : 2 * evalPoly ltTN (m : Int) ≤ 24 * evalPoly ltTD (m : Int) := by
+    have h := ltH_nonneg hw1 hw2
+    rw [evalCertLtH] at h
+    omega
+  have htn : ((evalPoly ltTN (m : Int)).toNat : Int) = evalPoly ltTN (m : Int) :=
+    Int.toNat_of_nonneg hTN0
+  have htd : ((evalPoly ltTD (m : Int)).toNat : Int) = evalPoly ltTD (m : Int) :=
+    Int.toNat_of_nonneg (by omega)
+  refine capUB22_of_int (by omega) (by omega) ?_
+  rw [htn, htd]
+  rw [evalCertLtLo] at hlo
+  simp only [EUD, EUN, KF1, Sc] at hlo
+  simp only [Int.natCast_mul]
+  rw [show ((560227709747861399187319382270000000000000000000000000000000 : Nat) : Int) = 560227709747861399187319382270000000000000000000000000000000 from rfl,
+      show ((9999999999999999999999999996599 : Nat) : Int) = 9999999999999999999999999996599 from rfl]
+  have eS : expNumI 22 (evalPoly ltTN (m : Int)) (evalPoly ltTD (m : Int)) *
+      (23 * evalPoly ltTD (m : Int)) =
+      23 * (expNumI 22 (evalPoly ltTN (m : Int)) (evalPoly ltTD (m : Int)) *
+        evalPoly ltTD (m : Int)) := by
+    simp only [Int.mul_assoc, Int.mul_comm, Int.mul_left_comm]
+  rw [eS]
+  have eL : (23 * (expNumI 22 (evalPoly ltTN (m : Int)) (evalPoly ltTD (m : Int)) *
+      evalPoly ltTD (m : Int)) + 2 * evalPoly ltTN (m : Int) ^ 23) *
+      ((m : Int) * 9999999999999999999999999996599) =
+      9999999999999999999999999996599 *
+        ((m : Int) * (23 * (expNumI 22 (evalPoly ltTN (m : Int)) (evalPoly ltTD (m : Int)) *
+          evalPoly ltTD (m : Int)) + 2 * evalPoly ltTN (m : Int) ^ 23)) := by
+    simp only [Int.mul_assoc, Int.mul_comm, Int.mul_left_comm]
+  rw [eL]
+  generalize hgMS : (m : Int) * (23 * (expNumI 22 (evalPoly ltTN (m : Int))
+    (evalPoly ltTD (m : Int)) * evalPoly ltTD (m : Int)) +
+      2 * evalPoly ltTN (m : Int) ^ 23) = MS at hlo ⊢
+  generalize hgT23 : evalPoly ltTD (m : Int) ^ 23 = T23 at hlo ⊢
+  omega
+
+/-! ## Sign of the pipeline value on each branch -/
+
+theorem x1_nonneg_ge {m : Nat} (h1 : Sc + 46 ≤ m) (h2 : m < MHI) :
+    0 ≤ toInt (x1W (zWord m)) := by
+  have hw1 : (56022770974786139918731938273 : Int) ≤ (m : Int) := by
+    simp only [Sc] at h1; omega
+  have hw2 : (m : Int) ≤ 79228162514264337593543950335 := by
+    simp only [MHI] at h2; omega
+  have hTN0 : 0 ≤ evalPoly geTN2b (m : Int) := geTN2_nonneg hw1 hw2
+  have hTD1 : 1 ≤ evalPoly geTD2b (m : Int) := by
+    have h := geTD2_nonneg hw1 hw2
+    rw [evalCertGeTD2] at h
+    omega
+  have hbr := bracket_ge_lo h1 h2
+  rcases Int.lt_or_le (toInt (x1W (zWord m))) 0 with hneg | h
+  · exfalso
+    have hnn : 0 ≤ evalPoly geTN2b (m : Int) * 2 ^ 99 :=
+      Int.mul_nonneg hTN0 (by omega)
+    have hm : evalPoly geTD2b (m : Int) * toInt (x1W (zWord m)) ≤
+        1 * toInt (x1W (zWord m)) :=
+      mul_le_mul_right_nonpos hTD1 (by omega)
+    have e1 : evalPoly geTD2b (m : Int) * toInt (x1W (zWord m)) =
+        toInt (x1W (zWord m)) * evalPoly geTD2b (m : Int) := Int.mul_comm _ _
+    have e2 : (1 : Int) * toInt (x1W (zWord m)) = toInt (x1W (zWord m)) :=
+      Int.one_mul _
+    generalize hg1 : evalPoly geTN2b (m : Int) * 2 ^ 99 = A at hbr hnn
+    generalize hg2 : toInt (x1W (zWord m)) * evalPoly geTD2b (m : Int) = B at hbr e1
+    generalize hg3 : evalPoly geTD2b (m : Int) * toInt (x1W (zWord m)) = C at hm e1
+    omega
+  · exact h
+
+theorem x1_nonpos_lt {m : Nat} (h1 : MLO ≤ m) (h2 : m + 46 ≤ Sc) :
+    toInt (x1W (zWord m)) ≤ 0 := by
+  have hw1 : (39614081257132168796771975168 : Int) ≤ (m : Int) := by
+    simp only [MLO] at h1; omega
+  have hw2 : (m : Int) ≤ 56022770974786139918731938181 := by
+    simp only [Sc] at h2; omega
+  have hTN0 : 0 ≤ evalPoly ltTN2b (m : Int) := ltTN2_nonneg hw1 hw2
+  have hTD1 : 1 ≤ evalPoly ltTD2b (m : Int) := by
+    have h := ltTD2_nonneg hw1 hw2
+    rw [evalCertLtTD2] at h
+    omega
+  have hbr := bracket_lt_lo h1 h2
+  rcases Int.lt_or_le 0 (toInt (x1W (zWord m))) with hpos | h
+  · exfalso
+    have hnn : 0 ≤ evalPoly ltTN2b (m : Int) * 2 ^ 99 :=
+      Int.mul_nonneg hTN0 (by omega)
+    have hm : evalPoly ltTD2b (m : Int) * -toInt (x1W (zWord m)) ≤
+        1 * -toInt (x1W (zWord m)) :=
+      mul_le_mul_right_nonpos hTD1 (by omega)
+    have e1 : evalPoly ltTD2b (m : Int) * -toInt (x1W (zWord m)) =
+        -toInt (x1W (zWord m)) * evalPoly ltTD2b (m : Int) := Int.mul_comm _ _
+    generalize hg1 : evalPoly ltTN2b (m : Int) * 2 ^ 99 = A at hbr hnn
+    generalize hg2 : -toInt (x1W (zWord m)) * evalPoly ltTD2b (m : Int) = B at hbr e1
+    generalize hg3 : evalPoly ltTD2b (m : Int) * -toInt (x1W (zWord m)) = C at hm e1
+    omega
+  · exact h
+
+/-! ## Caps at the pipeline value over the common denominator 10^27 · 2^99 -/
+
+theorem x1capGeUp {m : Nat} (h1 : Sc + 46 ≤ m) (h2 : m < MHI)
+    (hup : 0 ≤ evalPoly certGeUp (m : Int)) :
+    capUB ((toInt (x1W (zWord m))).toNat * 1000000000000000000000000000)
+      633825300114114700748351602688000000000000000000000000000
+      (m * 10000000000000000000000000003401)
+      560227709747861399187319382270000000000000000000000000000000 := by
+  have hw1 : (56022770974786139918731938273 : Int) ≤ (m : Int) := by
+    simp only [Sc] at h1; omega
+  have hw2 : (m : Int) ≤ 79228162514264337593543950335 := by
+    simp only [MHI] at h2; omega
+  have hTN0 : 0 ≤ evalPoly geTN (m : Int) := geTN_nonneg hw1 hw2
+  have hTD1 : 1 ≤ evalPoly geTD (m : Int) := by
+    have h := geTD_nonneg hw1 hw2
+    rw [evalCertGeTD] at h
+    omega
+  refine capUB_arg (q' := (evalPoly geTD (m : Int)).toNat) (by omega) ?_
+    (capGeUp h1 h2 hup)
+  rcases Int.lt_or_le (toInt (x1W (zWord m))) 0 with hneg | hpos
+  · have h0 : (toInt (x1W (zWord m))).toNat = 0 := by omega
+    rw [h0]
+    omega
+  · have hX1n : ((toInt (x1W (zWord m))).toNat : Int) = toInt (x1W (zWord m)) :=
+      Int.toNat_of_nonneg hpos
+    have htd : ((evalPoly geTD (m : Int)).toNat : Int) = evalPoly geTD (m : Int) :=
+      Int.toNat_of_nonneg (by omega)
+    have htn : ((evalPoly geTN (m : Int)).toNat : Int) = evalPoly geTN (m : Int) :=
+      Int.toNat_of_nonneg hTN0
+    refine Int.ofNat_le.mp ?_
+    simp only [Int.natCast_mul]
+    rw [show ((1000000000000000000000000000 : Nat) : Int) =
+        1000000000000000000000000000 from rfl,
+      show ((633825300114114700748351602688000000000000000000000000000 : Nat) : Int) =
+        633825300114114700748351602688000000000000000000000000000 from rfl,
+      hX1n, htd, htn]
+    have hbr := bracket_ge_up h1 h2
+    have c1 := mul_le_mul_right_nonneg hbr
+      (show (0 : Int) ≤ 1000000000000000000000000000 by omega)
+    have e1 : toInt (x1W (zWord m)) * 1000000000000000000000000000 *
+        evalPoly geTD (m : Int) =
+        toInt (x1W (zWord m)) * evalPoly geTD (m : Int) * 1000000000000000000000000000 := by
+      simp only [Int.mul_assoc, Int.mul_comm, Int.mul_left_comm]
+    have e2 : evalPoly geTN (m : Int) * 2 ^ 99 * 1000000000000000000000000000 =
+        evalPoly geTN (m : Int) *
+          633825300114114700748351602688000000000000000000000000000 := by
+      rw [Int.mul_assoc, show (2 : Int) ^ 99 * 1000000000000000000000000000 =
+        633825300114114700748351602688000000000000000000000000000 from by decide]
+    generalize hp1 : toInt (x1W (zWord m)) * evalPoly geTD (m : Int) *
+      1000000000000000000000000000 = A at c1 e1
+    generalize hp2 : toInt (x1W (zWord m)) * 1000000000000000000000000000 *
+      evalPoly geTD (m : Int) = B at e1 ⊢
+    generalize hp3 : evalPoly geTN (m : Int) * 2 ^ 99 *
+      1000000000000000000000000000 = C at c1 e2
+    generalize hp4 : evalPoly geTN (m : Int) *
+      633825300114114700748351602688000000000000000000000000000 = D at e2 ⊢
+    clear hp1 hp2 hp3 hp4 hbr hpos hX1n htd htn hTN0 hTD1 hw1 hw2 hup h1 h2
+    omega
+
+theorem x1capGeLo {m : Nat} (h1 : Sc + 46 ≤ m) (h2 : m < MHI)
+    (hlo : 0 ≤ evalPoly certGeLo (m : Int)) :
+    capLB ((toInt (x1W (zWord m))).toNat * 1000000000000000000000000000)
+      633825300114114700748351602688000000000000000000000000000
+      (m * 9999999999999999999999999996599)
+      560227709747861399187319382270000000000000000000000000000000 := by
+  have hw1 : (56022770974786139918731938273 : Int) ≤ (m : Int) := by
+    simp only [Sc] at h1; omega
+  have hw2 : (m : Int) ≤ 79228162514264337593543950335 := by
+    simp only [MHI] at h2; omega
+  have hTN0 : 0 ≤ evalPoly geTN2b (m : Int) := geTN2_nonneg hw1 hw2
+  have hTD1 : 1 ≤ evalPoly geTD2b (m : Int) := by
+    have h := geTD2_nonneg hw1 hw2
+    rw [evalCertGeTD2] at h
+    omega
+  refine capLB_arg (q' := (evalPoly geTD2b (m : Int)).toNat) (by omega) ?_
+    (capGeLo h1 h2 hlo)
+  have hpos := x1_nonneg_ge h1 h2
+  have hX1n : ((toInt (x1W (zWord m))).toNat : Int) = toInt (x1W (zWord m)) :=
+    Int.toNat_of_nonneg hpos
+  have htd : ((evalPoly geTD2b (m : Int)).toNat : Int) = evalPoly geTD2b (m : Int) :=
+    Int.toNat_of_nonneg (by omega)
+  have htn : ((evalPoly geTN2b (m : Int)).toNat : Int) = evalPoly geTN2b (m : Int) :=
+    Int.toNat_of_nonneg hTN0
+  refine Int.ofNat_le.mp ?_
+  simp only [Int.natCast_mul]
+  rw [show ((1000000000000000000000000000 : Nat) : Int) =
+      1000000000000000000000000000 from rfl,
+    show ((633825300114114700748351602688000000000000000000000000000 : Nat) : Int) =
+      633825300114114700748351602688000000000000000000000000000 from rfl,
+    hX1n, htd, htn]
+  have hbr := bracket_ge_lo h1 h2
+  have c1 := mul_le_mul_right_nonneg hbr
+    (show (0 : Int) ≤ 1000000000000000000000000000 by omega)
+  have e1 : toInt (x1W (zWord m)) * 1000000000000000000000000000 *
+      evalPoly geTD2b (m : Int) =
+      toInt (x1W (zWord m)) * evalPoly geTD2b (m : Int) * 1000000000000000000000000000 := by
+    simp only [Int.mul_assoc, Int.mul_comm, Int.mul_left_comm]
+  have e2 : evalPoly geTN2b (m : Int) * 2 ^ 99 * 1000000000000000000000000000 =
+      evalPoly geTN2b (m : Int) *
+        633825300114114700748351602688000000000000000000000000000 := by
+    rw [Int.mul_assoc, show (2 : Int) ^ 99 * 1000000000000000000000000000 =
+      633825300114114700748351602688000000000000000000000000000 from by decide]
+  generalize hp1 : toInt (x1W (zWord m)) * evalPoly geTD2b (m : Int) *
+    1000000000000000000000000000 = A at c1 e1
+  generalize hp2 : toInt (x1W (zWord m)) * 1000000000000000000000000000 *
+    evalPoly geTD2b (m : Int) = B at e1 ⊢
+  generalize hp3 : evalPoly geTN2b (m : Int) * 2 ^ 99 *
+    1000000000000000000000000000 = C at c1 e2
+  generalize hp4 : evalPoly geTN2b (m : Int) *
+    633825300114114700748351602688000000000000000000000000000 = D at e2 ⊢
+  clear hp1 hp2 hp3 hp4 hbr hpos hX1n htd htn hTN0 hTD1 hw1 hw2 hlo h1 h2
+  omega
+
+theorem x1capLtUp {m : Nat} (h1 : MLO ≤ m) (h2 : m + 46 ≤ Sc)
+    (hup : 0 ≤ evalPoly certLtUp (m : Int)) :
+    capLB ((-toInt (x1W (zWord m))).toNat * 1000000000000000000000000000)
+      633825300114114700748351602688000000000000000000000000000
+      560227709747861399187319382270000000000000000000000000000000
+      (m * 10000000000000000000000000003401) := by
+  have hw1 : (39614081257132168796771975168 : Int) ≤ (m : Int) := by
+    simp only [MLO] at h1; omega
+  have hw2 : (m : Int) ≤ 56022770974786139918731938181 := by
+    simp only [Sc] at h2; omega
+  have hTN0 : 0 ≤ evalPoly ltTN2b (m : Int) := ltTN2_nonneg hw1 hw2
+  have hTD1 : 1 ≤ evalPoly ltTD2b (m : Int) := by
+    have h := ltTD2_nonneg hw1 hw2
+    rw [evalCertLtTD2] at h
+    omega
+  refine capLB_arg (q' := (evalPoly ltTD2b (m : Int)).toNat) (by omega) ?_
+    (capLtUp h1 h2 hup)
+  have hneg := x1_nonpos_lt h1 h2
+  have hX1n : (((-toInt (x1W (zWord m))).toNat : Nat) : Int) = -toInt (x1W (zWord m)) :=
+    Int.toNat_of_nonneg (by omega)
+  have htd : ((evalPoly ltTD2b (m : Int)).toNat : Int) = evalPoly ltTD2b (m : Int) :=
+    Int.toNat_of_nonneg (by omega)
+  have htn : ((evalPoly ltTN2b (m : Int)).toNat : Int) = evalPoly ltTN2b (m : Int) :=
+    Int.toNat_of_nonneg hTN0
+  refine Int.ofNat_le.mp ?_
+  simp only [Int.natCast_mul]
+  rw [show ((1000000000000000000000000000 : Nat) : Int) =
+      1000000000000000000000000000 from rfl,
+    show ((633825300114114700748351602688000000000000000000000000000 : Nat) : Int) =
+      633825300114114700748351602688000000000000000000000000000 from rfl,
+    hX1n, htd, htn]
+  have hbr := bracket_lt_lo h1 h2
+  have c1 := mul_le_mul_right_nonneg hbr
+    (show (0 : Int) ≤ 1000000000000000000000000000 by omega)
+  have e1 : -toInt (x1W (zWord m)) * 1000000000000000000000000000 *
+      evalPoly ltTD2b (m : Int) =
+      -toInt (x1W (zWord m)) * evalPoly ltTD2b (m : Int) * 1000000000000000000000000000 := by
+    simp only [Int.mul_assoc, Int.mul_comm]
+  have e2 : evalPoly ltTN2b (m : Int) * 2 ^ 99 * 1000000000000000000000000000 =
+      evalPoly ltTN2b (m : Int) *
+        633825300114114700748351602688000000000000000000000000000 := by
+    rw [Int.mul_assoc, show (2 : Int) ^ 99 * 1000000000000000000000000000 =
+      633825300114114700748351602688000000000000000000000000000 from by decide]
+  generalize hp1 : -toInt (x1W (zWord m)) * evalPoly ltTD2b (m : Int) *
+    1000000000000000000000000000 = A at c1 e1
+  generalize hp2 : -toInt (x1W (zWord m)) * 1000000000000000000000000000 *
+    evalPoly ltTD2b (m : Int) = B at e1 ⊢
+  generalize hp3 : evalPoly ltTN2b (m : Int) * 2 ^ 99 *
+    1000000000000000000000000000 = C at c1 e2
+  generalize hp4 : evalPoly ltTN2b (m : Int) *
+    633825300114114700748351602688000000000000000000000000000 = D at e2 ⊢
+  clear hp1 hp2 hp3 hp4 hbr hneg hX1n htd htn hTN0 hTD1 hw1 hw2 hup h1 h2
+  omega
+
+theorem x1capLtLo {m : Nat} (h1 : MLO ≤ m) (h2 : m + 46 ≤ Sc)
+    (hlo : 0 ≤ evalPoly certLtLo (m : Int)) :
+    capUB ((-toInt (x1W (zWord m))).toNat * 1000000000000000000000000000)
+      633825300114114700748351602688000000000000000000000000000
+      560227709747861399187319382270000000000000000000000000000000
+      (m * 9999999999999999999999999996599) := by
+  have hw1 : (39614081257132168796771975168 : Int) ≤ (m : Int) := by
+    simp only [MLO] at h1; omega
+  have hw2 : (m : Int) ≤ 56022770974786139918731938181 := by
+    simp only [Sc] at h2; omega
+  have hTN0 : 0 ≤ evalPoly ltTN (m : Int) := ltTN_nonneg hw1 hw2
+  have hTD1 : 1 ≤ evalPoly ltTD (m : Int) := by
+    have h := ltTD_nonneg hw1 hw2
+    rw [evalCertLtTD] at h
+    omega
+  refine capUB_arg (q' := (evalPoly ltTD (m : Int)).toNat) (by omega) ?_
+    (capLtLo h1 h2 hlo)
+  have hX1n : (((-toInt (x1W (zWord m))).toNat : Nat) : Int) = -toInt (x1W (zWord m)) :=
+    Int.toNat_of_nonneg (by have := x1_nonpos_lt h1 h2; omega)
+  have htd : ((evalPoly ltTD (m : Int)).toNat : Int) = evalPoly ltTD (m : Int) :=
+    Int.toNat_of_nonneg (by omega)
+  have htn : ((evalPoly ltTN (m : Int)).toNat : Int) = evalPoly ltTN (m : Int) :=
+    Int.toNat_of_nonneg hTN0
+  refine Int.ofNat_le.mp ?_
+  simp only [Int.natCast_mul]
+  rw [show ((1000000000000000000000000000 : Nat) : Int) =
+      1000000000000000000000000000 from rfl,
+    show ((633825300114114700748351602688000000000000000000000000000 : Nat) : Int) =
+      633825300114114700748351602688000000000000000000000000000 from rfl,
+    hX1n, htd, htn]
+  have hbr := bracket_lt_up h1 h2
+  have c1 := mul_le_mul_right_nonneg hbr
+    (show (0 : Int) ≤ 1000000000000000000000000000 by omega)
+  have e1 : -toInt (x1W (zWord m)) * 1000000000000000000000000000 *
+      evalPoly ltTD (m : Int) =
+      -toInt (x1W (zWord m)) * evalPoly ltTD (m : Int) * 1000000000000000000000000000 := by
+    simp only [Int.mul_assoc, Int.mul_comm]
+  have e2 : evalPoly ltTN (m : Int) * 2 ^ 99 * 1000000000000000000000000000 =
+      evalPoly ltTN (m : Int) *
+        633825300114114700748351602688000000000000000000000000000 := by
+    rw [Int.mul_assoc, show (2 : Int) ^ 99 * 1000000000000000000000000000 =
+      633825300114114700748351602688000000000000000000000000000 from by decide]
+  generalize hp1 : -toInt (x1W (zWord m)) * evalPoly ltTD (m : Int) *
+    1000000000000000000000000000 = A at c1 e1
+  generalize hp2 : -toInt (x1W (zWord m)) * 1000000000000000000000000000 *
+    evalPoly ltTD (m : Int) = B at e1 ⊢
+  generalize hp3 : evalPoly ltTN (m : Int) * 2 ^ 99 *
+    1000000000000000000000000000 = C at c1 e2
+  generalize hp4 : evalPoly ltTN (m : Int) *
+    633825300114114700748351602688000000000000000000000000000 = D at e2 ⊢
+  clear hp1 hp2 hp3 hp4 hbr hX1n htd htn hTN0 hTD1 hw1 hw2 hlo h1 h2
+  omega
+
+end LnFloorCert
diff --git a/formal/ln/LnProof/LnProof/FloorCertAux.lean b/formal/ln/LnProof/LnProof/FloorCertAux.lean
new file mode 100644
index 000000000..4576a903b
--- /dev/null
+++ b/formal/ln/LnProof/LnProof/FloorCertAux.lean
@@ -0,0 +1,104 @@
+import LnProof.FloorCertDefs
+
+namespace LnFloorCert
+open LnPoly
+
+set_option maxRecDepth 100000
+
+theorem geH_check : checkCover certGeH 56022770974786139918731938273 79228162514264337593543950335
+    [23205391539478197674812012062] = true := by
+  decide +kernel
+
+theorem geH_nonneg {m : Int} (h1 : 56022770974786139918731938273 ≤ m) (h2 : m ≤ 79228162514264337593543950335) :
+    0 ≤ evalPoly certGeH m :=
+  checkCover_sound _ _ _ _ geH_check m h1 h2
+
+theorem ltH_check : checkCover certLtH 39614081257132168796771975168 56022770974786139918731938181
+    [16408689717653971121959963013] = true := by
+  decide +kernel
+
+theorem ltH_nonneg {m : Int} (h1 : 39614081257132168796771975168 ≤ m) (h2 : m ≤ 56022770974786139918731938181) :
+    0 ≤ evalPoly certLtH m :=
+  checkCover_sound _ _ _ _ ltH_check m h1 h2
+
+theorem geTD_check : checkCover certGeTD 56022770974786139918731938273 79228162514264337593543950335
+    [23205391539478197674812012062] = true := by
+  decide +kernel
+
+theorem geTD_nonneg {m : Int} (h1 : 56022770974786139918731938273 ≤ m) (h2 : m ≤ 79228162514264337593543950335) :
+    0 ≤ evalPoly certGeTD m :=
+  checkCover_sound _ _ _ _ geTD_check m h1 h2
+
+theorem geTD2_check : checkCover certGeTD2 56022770974786139918731938273 79228162514264337593543950335
+    [23205391539478197674812012062] = true := by
+  decide +kernel
+
+theorem geTD2_nonneg {m : Int} (h1 : 56022770974786139918731938273 ≤ m) (h2 : m ≤ 79228162514264337593543950335) :
+    0 ≤ evalPoly certGeTD2 m :=
+  checkCover_sound _ _ _ _ geTD2_check m h1 h2
+
+theorem ltTD_check : checkCover certLtTD 39614081257132168796771975168 56022770974786139918731938181
+    [16408689717653971121959963013] = true := by
+  decide +kernel
+
+theorem ltTD_nonneg {m : Int} (h1 : 39614081257132168796771975168 ≤ m) (h2 : m ≤ 56022770974786139918731938181) :
+    0 ≤ evalPoly certLtTD m :=
+  checkCover_sound _ _ _ _ ltTD_check m h1 h2
+
+theorem ltTD2_check : checkCover certLtTD2 39614081257132168796771975168 56022770974786139918731938181
+    [16408689717653971121959963013] = true := by
+  decide +kernel
+
+theorem ltTD2_nonneg {m : Int} (h1 : 39614081257132168796771975168 ≤ m) (h2 : m ≤ 56022770974786139918731938181) :
+    0 ≤ evalPoly certLtTD2 m :=
+  checkCover_sound _ _ _ _ ltTD2_check m h1 h2
+
+theorem geTN_check : checkCover geTN 56022770974786139918731938273 79228162514264337593543950335
+    [23205391539478197674812012062] = true := by
+  decide +kernel
+
+theorem geTN_nonneg {m : Int} (h1 : 56022770974786139918731938273 ≤ m) (h2 : m ≤ 79228162514264337593543950335) :
+    0 ≤ evalPoly geTN m :=
+  checkCover_sound _ _ _ _ geTN_check m h1 h2
+
+theorem geTN2_check : checkCover geTN2b 56022770974786139918731938273 79228162514264337593543950335
+    [23205391539478197674812012062] = true := by
+  decide +kernel
+
+theorem geTN2_nonneg {m : Int} (h1 : 56022770974786139918731938273 ≤ m) (h2 : m ≤ 79228162514264337593543950335) :
+    0 ≤ evalPoly geTN2b m :=
+  checkCover_sound _ _ _ _ geTN2_check m h1 h2
+
+theorem ltTN_check : checkCover ltTN 39614081257132168796771975168 56022770974786139918731938181
+    [16408689717653971121959963013] = true := by
+  decide +kernel
+
+theorem ltTN_nonneg {m : Int} (h1 : 39614081257132168796771975168 ≤ m) (h2 : m ≤ 56022770974786139918731938181) :
+    0 ≤ evalPoly ltTN m :=
+  checkCover_sound _ _ _ _ ltTN_check m h1 h2
+
+theorem ltTN2_check : checkCover ltTN2b 39614081257132168796771975168 56022770974786139918731938181
+    [16408689717653971121959963013] = true := by
+  decide +kernel
+
+theorem ltTN2_nonneg {m : Int} (h1 : 39614081257132168796771975168 ≤ m) (h2 : m ≤ 56022770974786139918731938181) :
+    0 ≤ evalPoly ltTN2b m :=
+  checkCover_sound _ _ _ _ ltTN2_check m h1 h2
+
+theorem geWS_check : checkCover certGeWS 56022770974786139918731938273 79228162514264337593543950335
+    [23205391539478197674812012062] = true := by
+  decide +kernel
+
+theorem geWS_nonneg {m : Int} (h1 : 56022770974786139918731938273 ≤ m) (h2 : m ≤ 79228162514264337593543950335) :
+    0 ≤ evalPoly certGeWS m :=
+  checkCover_sound _ _ _ _ geWS_check m h1 h2
+
+theorem ltWS_check : checkCover certLtWS 39614081257132168796771975168 56022770974786139918731938181
+    [16408689717653971121959963013] = true := by
+  decide +kernel
+
+theorem ltWS_nonneg {m : Int} (h1 : 39614081257132168796771975168 ≤ m) (h2 : m ≤ 56022770974786139918731938181) :
+    0 ≤ evalPoly certLtWS m :=
+  checkCover_sound _ _ _ _ ltWS_check m h1 h2
+
+end LnFloorCert
diff --git a/formal/ln/LnProof/LnProof/FloorCertDefs.lean b/formal/ln/LnProof/LnProof/FloorCertDefs.lean
new file mode 100644
index 000000000..923c4f7d9
--- /dev/null
+++ b/formal/ln/LnProof/LnProof/FloorCertDefs.lean
@@ -0,0 +1,90 @@
+import LnProof.ShiftCert
+import LnProof.Stages
+
+/-!
+# Floor-specification bracket polynomials
+
+The bracket rationals for `X1/2^99` as integer polynomials in the
+mantissa, homogenized directly over the `Stages` coefficient lists
+`PPc`/`QQc` (denominators `8 B²` at the `wlo` points, `B²` at `w*`), with
+the stage truncation slops entering exactly as `SLOPPc (B²)^4` and
+`SLOPQc (8 B²)^5`. The `checkCover` certificates over these polynomials
+are in the `FloorCert*` files.
+-/
+
+namespace LnFloorCert
+
+open LnPoly LnGeneratedModel
+
+def WINDOW : Nat := 46
+
+def geA : List Int := [-(Sc : Int), 1]
+def geB : List Int := [(Sc : Int), 1]
+def geA2 : List Int := polyMul geA geA
+def geB2 : List Int := polyMul geB geB
+def geWLO : List Int := polyAdd (polyAdd (polyScale (2 ^ 99) geA2) (polyNeg (polyMul geA geB))) (polyScale (-8) geB2)
+def geD8 : List Int := polyScale 8 geB2
+def geA96 : List Int := polyScale (2 ^ 96) geA2
+def gePPHwlo : List Int := homPoly PPc geWLO geD8
+def gePPHws : List Int := homPoly PPc geA96 geB2
+def geQQHws : List Int := homPoly QQc geA96 geB2
+def geQQHwlo : List Int := homPoly QQc geWLO geD8
+def geTN : List Int := polyScale (2 ^ 17) (polyMul (polyMul geA geB) gePPHwlo)
+def geTD : List Int := polyNeg geQQHws
+def gePLOP : List Int := polyAdd gePPHws (polyScale (-SLOPPc) (polyPow geB2 4))
+def geDLO : List Int := polyAdd (polyNeg geQQHwlo) (polyScale SLOPQc (polyPow geD8 5))
+def geAZ : List Int := polyAdd (polyScale (2 ^ 100) geA) (polyNeg geB)
+def geTN2 : List Int := polyMul (polyMul gePLOP geAZ) geB
+def geTD2 : List Int := polyScale (2 ^ 56) geDLO
+def geTN2b : List Int := polyAdd (polyScale (2 ^ 99) geTN2) (polyNeg geTD2)
+def geTD2b : List Int := polyScale (2 ^ 99) geTD2
+
+def ltA : List Int := [(Sc : Int), -1]
+def ltB : List Int := [(Sc : Int), 1]
+def ltA2 : List Int := polyMul ltA ltA
+def ltB2 : List Int := polyMul ltB ltB
+def ltWLO : List Int := polyAdd (polyAdd (polyScale (2 ^ 99) ltA2) (polyNeg (polyMul ltA ltB))) (polyScale (-8) ltB2)
+def ltD8 : List Int := polyScale 8 ltB2
+def ltA96 : List Int := polyScale (2 ^ 96) ltA2
+def ltPPHwlo : List Int := homPoly PPc ltWLO ltD8
+def ltPPHws : List Int := homPoly PPc ltA96 ltB2
+def ltQQHws : List Int := homPoly QQc ltA96 ltB2
+def ltQQHwlo : List Int := homPoly QQc ltWLO ltD8
+def ltTN : List Int := polyScale (2 ^ 17) (polyMul (polyMul ltA ltB) ltPPHwlo)
+def ltTD : List Int := polyNeg ltQQHws
+def ltPLOP : List Int := polyAdd ltPPHws (polyScale (-SLOPPc) (polyPow ltB2 4))
+def ltDLO : List Int := polyAdd (polyNeg ltQQHwlo) (polyScale SLOPQc (polyPow ltD8 5))
+def ltAZ : List Int := polyAdd (polyScale (2 ^ 100) ltA) (polyNeg ltB)
+def ltTN2 : List Int := polyMul (polyMul ltPLOP ltAZ) ltB
+def ltTD2 : List Int := polyScale (2 ^ 56) ltDLO
+def ltTN2b : List Int := polyAdd (polyScale (2 ^ 99) ltTN2) (polyNeg ltTD2)
+def ltTD2b : List Int := polyScale (2 ^ 99) ltTD2
+
+def KF : Int := 1124000727777607680000
+def KF1 : Int := 25852016738884976640000
+def EUN : Int := 3401
+def EUD : Int := 10 ^ 31
+
+def certGeUp : List Int :=
+  polyAdd (polyScale ((EUD + EUN) * KF1) (polyMul [0, 1] (polyPow geTD 23)))
+    (polyScale (-(Sc : Int) * EUD) (polyAdd (polyScale 23 (polyMul (expPolyNum geTN geTD 22) geTD)) (polyScale 2 (polyPow geTN 23))))
+def certGeLo : List Int :=
+  polyAdd (polyScale (EUD * (Sc : Int)) (expPolyNum geTN2b geTD2b 22))
+    (polyScale (-(EUD - EUN) * KF) (polyMul [0, 1] (polyPow geTD2b 22)))
+def certLtUp : List Int :=
+  polyAdd (polyScale (EUD + EUN) (polyMul [0, 1] (expPolyNum ltTN2b ltTD2b 22)))
+    (polyScale (-EUD * (Sc : Int) * KF) (polyPow ltTD2b 22))
+def certLtLo : List Int :=
+  polyAdd (polyScale ((Sc : Int) * EUD * KF1) (polyPow ltTD 23))
+    (polyScale (-(EUD - EUN)) (polyMul [0, 1] (polyAdd (polyScale 23 (polyMul (expPolyNum ltTN ltTD 22) ltTD)) (polyScale 2 (polyPow ltTN 23)))))
+def UB : Int := 2333000000000000000000000000
+def certGeWS : List Int := polyAdd (polyScale UB geB2) (polyScale (-(2 ^ 96)) geA2)
+def certLtWS : List Int := polyAdd (polyScale UB ltB2) (polyScale (-(2 ^ 96)) ltA2)
+def certGeH : List Int := polyAdd (polyScale 24 geTD) (polyScale (-2) geTN)
+def certLtH : List Int := polyAdd (polyScale 24 ltTD) (polyScale (-2) ltTN)
+def certGeTD : List Int := polyAdd geTD [-1]
+def certGeTD2 : List Int := polyAdd geTD2b [-1]
+def certLtTD : List Int := polyAdd ltTD [-1]
+def certLtTD2 : List Int := polyAdd ltTD2b [-1]
+
+end LnFloorCert
diff --git a/formal/ln/LnProof/LnProof/FloorCertGeLo.lean b/formal/ln/LnProof/LnProof/FloorCertGeLo.lean
new file mode 100644
index 000000000..3d03c9185
--- /dev/null
+++ b/formal/ln/LnProof/LnProof/FloorCertGeLo.lean
@@ -0,0 +1,109 @@
+import LnProof.FloorCertDefs
+import LnProof.FloorCertLit
+import LnProof.Kronecker
+import LnProof.FloorCertGeLoC00
+import LnProof.FloorCertGeLoC01
+import LnProof.FloorCertGeLoC02
+import LnProof.FloorCertGeLoC03
+import LnProof.FloorCertGeLoC04
+import LnProof.FloorCertGeLoC05
+import LnProof.FloorCertGeLoC06
+import LnProof.FloorCertGeLoC07
+import LnProof.FloorCertGeLoC08
+import LnProof.FloorCertGeLoC09
+import LnProof.FloorCertGeLoC10
+import LnProof.FloorCertGeLoC11
+import LnProof.FloorCertGeLoC12
+import LnProof.FloorCertGeLoC13
+
+namespace LnFloorCert
+open LnGeneratedModel LnPoly
+
+set_option maxRecDepth 100000
+
+theorem geTN2b_eq_lit : geTN2b = geTN2bLit := by
+  unfold geTN2b geTN2 geTD2 gePLOP geDLO geAZ gePPHws geQQHwlo geA96 geWLO geD8 geB2 geA2
+  decide +kernel
+
+theorem geTD2b_eq_lit : geTD2b = geTD2bLit := by
+  unfold geTD2b geTD2 geDLO geQQHwlo geWLO geD8 geB2 geA2
+  decide +kernel
+
+theorem geLo_eval_eq : ∀ x : Int, evalPoly certGeLo x = evalPoly certGeLoLit x := by
+  refine evalPoly_ext (B := kB) certGeLo certGeLoLit ?_ ?_ ?_
+  · -- Bound `polyL1 certGeLo` via the ℓ1 homomorphism lemmas on the literal
+    -- summands, closing by `exact` through the definitional equality
+    -- `certGeLo ≡ polyAdd …`. `unfold certGeLo` is avoided: it forces the kernel
+    -- to reduce the full construction (minutes); the `exact` defeq is lazy
+    -- congruence bottoming out at `geTD2b ≡ geTD2bLit` (milliseconds).
+    show polyL1 certGeLo * 2 < 2 ^ kB
+    have h1 := polyL1_polyAdd
+      (polyScale (EUD * (Sc : Int)) (expPolyNum geTN2bLit geTD2bLit 22))
+      (polyScale (-(EUD - EUN) * KF) (polyMul [0, 1] (polyPow geTD2bLit 22)))
+    have h2 := polyL1_polyScale (EUD * (Sc : Int)) (expPolyNum geTN2bLit geTD2bLit 22)
+    have h3 := polyL1_expPolyNum geTN2bLit geTD2bLit 22
+    have h7 : (EUD * (Sc : Int)).natAbs * polyL1 (expPolyNum geTN2bLit geTD2bLit 22) ≤
+        (EUD * (Sc : Int)).natAbs *
+          LnExp.expNum 22 (polyL1 geTN2bLit) (polyL1 geTD2bLit) :=
+      Nat.mul_le_mul_left _ h3
+    have h4 := polyL1_polyScale (-(EUD - EUN) * KF) (polyMul [0, 1] (polyPow geTD2bLit 22))
+    have h5 := polyL1_polyMul ([0, 1] : List Int) (polyPow geTD2bLit 22)
+    have h6 := polyL1_polyPow geTD2bLit 22
+    have h8 : polyL1 ([0, 1] : List Int) * polyL1 (polyPow geTD2bLit 22) ≤
+        polyL1 ([0, 1] : List Int) * polyL1 geTD2bLit ^ 22 :=
+      Nat.mul_le_mul_left _ h6
+    have h9 : (-(EUD - EUN) * KF).natAbs * polyL1 (polyMul ([0, 1] : List Int)
+        (polyPow geTD2bLit 22)) ≤
+        (-(EUD - EUN) * KF).natAbs *
+          (polyL1 ([0, 1] : List Int) * polyL1 geTD2bLit ^ 22) :=
+      Nat.mul_le_mul_left _ (Nat.le_trans h5 h8)
+    have hfin : ((EUD * (Sc : Int)).natAbs *
+        LnExp.expNum 22 (polyL1 geTN2bLit) (polyL1 geTD2bLit) +
+        (-(EUD - EUN) * KF).natAbs *
+          (polyL1 ([0, 1] : List Int) * polyL1 geTD2bLit ^ 22)) * 2 < 2 ^ kB := by
+      decide +kernel
+    have hA := Nat.le_trans h2 h7
+    have hB := Nat.le_trans h4 h9
+    exact Nat.lt_of_le_of_lt (Nat.mul_le_mul_right 2 (Nat.le_trans h1 (Nat.add_le_add hA hB))) hfin
+  · show polyL1 certGeLoLit * 2 < 2 ^ kB
+    decide +kernel
+  · show evalPoly certGeLo ((2 : Int) ^ kB) = evalPoly certGeLoLit ((2 : Int) ^ kB)
+    rw [int_two_pow kB]
+    unfold certGeLo
+    rw [geTN2b_eq_lit, geTD2b_eq_lit]
+    simp only [evalPoly_polyAdd, evalPoly_polyScale, evalPoly_polyMul,
+      evalPoly_polyPow, evalPoly_expPolyNum, eval01]
+    decide +kernel
+
+theorem geLo_nonneg {m : Int} (h1 : 56022770974786139918731938273 ≤ m) (h2 : m ≤ 79228162514264337593543950335) :
+    0 ≤ evalPoly certGeLo m := by
+  have hev := geLo_eval_eq m
+  rw [hev]
+  rcases Int.lt_or_le m (62248863508307989581262617183 + 1) with h | h
+  · exact checkCoverK_sound _ _ _ _ _ geLo_cell00 m (by omega) (by omega)
+  rcases Int.lt_or_le m (63042232383408656869457414737 + 1) with h | h
+  · exact checkCoverK_sound _ _ _ _ _ geLo_cell01 m (by omega) (by omega)
+  rcases Int.lt_or_le m (64929052012891719377728977367 + 1) with h | h
+  · exact checkCoverK_sound _ _ _ _ _ geLo_cell02 m (by omega) (by omega)
+  rcases Int.lt_or_le m (68717504609657537844941640470 + 1) with h | h
+  · exact checkCoverK_sound _ _ _ _ _ geLo_cell03 m (by omega) (by omega)
+  rcases Int.lt_or_le m (69233132140651152842861403916 + 1) with h | h
+  · exact checkCoverK_sound _ _ _ _ _ geLo_cell04 m (by omega) (by omega)
+  rcases Int.lt_or_le m (69643680272268497720544738509 + 1) with h | h
+  · exact checkCoverK_sound _ _ _ _ _ geLo_cell05 m (by omega) (by omega)
+  rcases Int.lt_or_le m (73761687789119228727691347873 + 1) with h | h
+  · exact checkCoverK_sound _ _ _ _ _ geLo_cell06 m (by omega) (by omega)
+  rcases Int.lt_or_le m (74347359659513480232328600324 + 1) with h | h
+  · exact checkCoverK_sound _ _ _ _ _ geLo_cell07 m (by omega) (by omega)
+  rcases Int.lt_or_le m (74497159690857676763262189492 + 1) with h | h
+  · exact checkCoverK_sound _ _ _ _ _ geLo_cell08 m (by omega) (by omega)
+  rcases Int.lt_or_le m (77437517811705333581000648120 + 1) with h | h
+  · exact checkCoverK_sound _ _ _ _ _ geLo_cell09 m (by omega) (by omega)
+  rcases Int.lt_or_le m (77857333859755213679737086192 + 1) with h | h
+  · exact checkCoverK_sound _ _ _ _ _ geLo_cell10 m (by omega) (by omega)
+  rcases Int.lt_or_le m (77947664376793543259244624794 + 1) with h | h
+  · exact checkCoverK_sound _ _ _ _ _ geLo_cell11 m (by omega) (by omega)
+  rcases Int.lt_or_le m (78001071025949577278638182916 + 1) with h | h
+  · exact checkCoverK_sound _ _ _ _ _ geLo_cell12 m (by omega) (by omega)
+  exact checkCoverK_sound _ _ _ _ _ geLo_cell13 m (by omega) h2
+end LnFloorCert
diff --git a/formal/ln/LnProof/LnProof/FloorCertGeLoC00.lean b/formal/ln/LnProof/LnProof/FloorCertGeLoC00.lean
new file mode 100644
index 000000000..140ef5692
--- /dev/null
+++ b/formal/ln/LnProof/LnProof/FloorCertGeLoC00.lean
@@ -0,0 +1,13 @@
+import LnProof.FloorCertLit
+import LnProof.KroneckerShift
+
+namespace LnFloorCert
+open LnPoly
+
+set_option maxRecDepth 100000
+
+theorem geLo_cell00 : checkCoverK kB certGeLoLit 56022770974786139918731938273 62248863508307989581262617183
+    [6226092533521849662530678910] = true := by
+  decide +kernel
+
+end LnFloorCert
diff --git a/formal/ln/LnProof/LnProof/FloorCertGeLoC01.lean b/formal/ln/LnProof/LnProof/FloorCertGeLoC01.lean
new file mode 100644
index 000000000..8d7f99133
--- /dev/null
+++ b/formal/ln/LnProof/LnProof/FloorCertGeLoC01.lean
@@ -0,0 +1,13 @@
+import LnProof.FloorCertLit
+import LnProof.KroneckerShift
+
+namespace LnFloorCert
+open LnPoly
+
+set_option maxRecDepth 100000
+
+theorem geLo_cell01 : checkCoverK kB certGeLoLit 62248863508307989581262617184 63042232383408656869457414737
+    [793368875100667288194797553] = true := by
+  decide +kernel
+
+end LnFloorCert
diff --git a/formal/ln/LnProof/LnProof/FloorCertGeLoC02.lean b/formal/ln/LnProof/LnProof/FloorCertGeLoC02.lean
new file mode 100644
index 000000000..549afee53
--- /dev/null
+++ b/formal/ln/LnProof/LnProof/FloorCertGeLoC02.lean
@@ -0,0 +1,13 @@
+import LnProof.FloorCertLit
+import LnProof.KroneckerShift
+
+namespace LnFloorCert
+open LnPoly
+
+set_option maxRecDepth 100000
+
+theorem geLo_cell02 : checkCoverK kB certGeLoLit 63042232383408656869457414738 64929052012891719377728977367
+    [1886819629483062508271562629] = true := by
+  decide +kernel
+
+end LnFloorCert
diff --git a/formal/ln/LnProof/LnProof/FloorCertGeLoC03.lean b/formal/ln/LnProof/LnProof/FloorCertGeLoC03.lean
new file mode 100644
index 000000000..76abdcfe6
--- /dev/null
+++ b/formal/ln/LnProof/LnProof/FloorCertGeLoC03.lean
@@ -0,0 +1,13 @@
+import LnProof.FloorCertLit
+import LnProof.KroneckerShift
+
+namespace LnFloorCert
+open LnPoly
+
+set_option maxRecDepth 100000
+
+theorem geLo_cell03 : checkCoverK kB certGeLoLit 64929052012891719377728977368 68717504609657537844941640470
+    [3788452596765818467212663102] = true := by
+  decide +kernel
+
+end LnFloorCert
diff --git a/formal/ln/LnProof/LnProof/FloorCertGeLoC04.lean b/formal/ln/LnProof/LnProof/FloorCertGeLoC04.lean
new file mode 100644
index 000000000..378949b11
--- /dev/null
+++ b/formal/ln/LnProof/LnProof/FloorCertGeLoC04.lean
@@ -0,0 +1,13 @@
+import LnProof.FloorCertLit
+import LnProof.KroneckerShift
+
+namespace LnFloorCert
+open LnPoly
+
+set_option maxRecDepth 100000
+
+theorem geLo_cell04 : checkCoverK kB certGeLoLit 68717504609657537844941640471 69233132140651152842861403916
+    [515627530993614997919763445] = true := by
+  decide +kernel
+
+end LnFloorCert
diff --git a/formal/ln/LnProof/LnProof/FloorCertGeLoC05.lean b/formal/ln/LnProof/LnProof/FloorCertGeLoC05.lean
new file mode 100644
index 000000000..06daaebe1
--- /dev/null
+++ b/formal/ln/LnProof/LnProof/FloorCertGeLoC05.lean
@@ -0,0 +1,13 @@
+import LnProof.FloorCertLit
+import LnProof.KroneckerShift
+
+namespace LnFloorCert
+open LnPoly
+
+set_option maxRecDepth 100000
+
+theorem geLo_cell05 : checkCoverK kB certGeLoLit 69233132140651152842861403917 69643680272268497720544738509
+    [410548131617344877683334592] = true := by
+  decide +kernel
+
+end LnFloorCert
diff --git a/formal/ln/LnProof/LnProof/FloorCertGeLoC06.lean b/formal/ln/LnProof/LnProof/FloorCertGeLoC06.lean
new file mode 100644
index 000000000..807b724f6
--- /dev/null
+++ b/formal/ln/LnProof/LnProof/FloorCertGeLoC06.lean
@@ -0,0 +1,13 @@
+import LnProof.FloorCertLit
+import LnProof.KroneckerShift
+
+namespace LnFloorCert
+open LnPoly
+
+set_option maxRecDepth 100000
+
+theorem geLo_cell06 : checkCoverK kB certGeLoLit 69643680272268497720544738510 73761687789119228727691347873
+    [4118007516850731007146609363] = true := by
+  decide +kernel
+
+end LnFloorCert
diff --git a/formal/ln/LnProof/LnProof/FloorCertGeLoC07.lean b/formal/ln/LnProof/LnProof/FloorCertGeLoC07.lean
new file mode 100644
index 000000000..e707ec2ca
--- /dev/null
+++ b/formal/ln/LnProof/LnProof/FloorCertGeLoC07.lean
@@ -0,0 +1,13 @@
+import LnProof.FloorCertLit
+import LnProof.KroneckerShift
+
+namespace LnFloorCert
+open LnPoly
+
+set_option maxRecDepth 100000
+
+theorem geLo_cell07 : checkCoverK kB certGeLoLit 73761687789119228727691347874 74347359659513480232328600324
+    [585671870394251504637252450] = true := by
+  decide +kernel
+
+end LnFloorCert
diff --git a/formal/ln/LnProof/LnProof/FloorCertGeLoC08.lean b/formal/ln/LnProof/LnProof/FloorCertGeLoC08.lean
new file mode 100644
index 000000000..88dc39c70
--- /dev/null
+++ b/formal/ln/LnProof/LnProof/FloorCertGeLoC08.lean
@@ -0,0 +1,13 @@
+import LnProof.FloorCertLit
+import LnProof.KroneckerShift
+
+namespace LnFloorCert
+open LnPoly
+
+set_option maxRecDepth 100000
+
+theorem geLo_cell08 : checkCoverK kB certGeLoLit 74347359659513480232328600325 74497159690857676763262189492
+    [149800031344196530933589167] = true := by
+  decide +kernel
+
+end LnFloorCert
diff --git a/formal/ln/LnProof/LnProof/FloorCertGeLoC09.lean b/formal/ln/LnProof/LnProof/FloorCertGeLoC09.lean
new file mode 100644
index 000000000..7e0e89ccf
--- /dev/null
+++ b/formal/ln/LnProof/LnProof/FloorCertGeLoC09.lean
@@ -0,0 +1,13 @@
+import LnProof.FloorCertLit
+import LnProof.KroneckerShift
+
+namespace LnFloorCert
+open LnPoly
+
+set_option maxRecDepth 100000
+
+theorem geLo_cell09 : checkCoverK kB certGeLoLit 74497159690857676763262189493 77437517811705333581000648120
+    [2940358120847656817738458627] = true := by
+  decide +kernel
+
+end LnFloorCert
diff --git a/formal/ln/LnProof/LnProof/FloorCertGeLoC10.lean b/formal/ln/LnProof/LnProof/FloorCertGeLoC10.lean
new file mode 100644
index 000000000..2ad48850c
--- /dev/null
+++ b/formal/ln/LnProof/LnProof/FloorCertGeLoC10.lean
@@ -0,0 +1,13 @@
+import LnProof.FloorCertLit
+import LnProof.KroneckerShift
+
+namespace LnFloorCert
+open LnPoly
+
+set_option maxRecDepth 100000
+
+theorem geLo_cell10 : checkCoverK kB certGeLoLit 77437517811705333581000648121 77857333859755213679737086192
+    [419816048049880098736438071] = true := by
+  decide +kernel
+
+end LnFloorCert
diff --git a/formal/ln/LnProof/LnProof/FloorCertGeLoC11.lean b/formal/ln/LnProof/LnProof/FloorCertGeLoC11.lean
new file mode 100644
index 000000000..b4286088a
--- /dev/null
+++ b/formal/ln/LnProof/LnProof/FloorCertGeLoC11.lean
@@ -0,0 +1,13 @@
+import LnProof.FloorCertLit
+import LnProof.KroneckerShift
+
+namespace LnFloorCert
+open LnPoly
+
+set_option maxRecDepth 100000
+
+theorem geLo_cell11 : checkCoverK kB certGeLoLit 77857333859755213679737086193 77947664376793543259244624794
+    [90330517038329579507538601] = true := by
+  decide +kernel
+
+end LnFloorCert
diff --git a/formal/ln/LnProof/LnProof/FloorCertGeLoC12.lean b/formal/ln/LnProof/LnProof/FloorCertGeLoC12.lean
new file mode 100644
index 000000000..3d2ec7d1e
--- /dev/null
+++ b/formal/ln/LnProof/LnProof/FloorCertGeLoC12.lean
@@ -0,0 +1,13 @@
+import LnProof.FloorCertLit
+import LnProof.KroneckerShift
+
+namespace LnFloorCert
+open LnPoly
+
+set_option maxRecDepth 100000
+
+theorem geLo_cell12 : checkCoverK kB certGeLoLit 77947664376793543259244624795 78001071025949577278638182916
+    [53406649156034019393558121] = true := by
+  decide +kernel
+
+end LnFloorCert
diff --git a/formal/ln/LnProof/LnProof/FloorCertGeLoC13.lean b/formal/ln/LnProof/LnProof/FloorCertGeLoC13.lean
new file mode 100644
index 000000000..3cca3444d
--- /dev/null
+++ b/formal/ln/LnProof/LnProof/FloorCertGeLoC13.lean
@@ -0,0 +1,13 @@
+import LnProof.FloorCertLit
+import LnProof.KroneckerShift
+
+namespace LnFloorCert
+open LnPoly
+
+set_option maxRecDepth 100000
+
+theorem geLo_cell13 : checkCoverK kB certGeLoLit 78001071025949577278638182917 79228162514264337593543950335
+    [1227091488314760314905767418] = true := by
+  decide +kernel
+
+end LnFloorCert
diff --git a/formal/ln/LnProof/LnProof/FloorCertGeUp.lean b/formal/ln/LnProof/LnProof/FloorCertGeUp.lean
new file mode 100644
index 000000000..70fd35e3d
--- /dev/null
+++ b/formal/ln/LnProof/LnProof/FloorCertGeUp.lean
@@ -0,0 +1,123 @@
+import LnProof.FloorCertDefs
+import LnProof.FloorCertLit
+import LnProof.Kronecker
+import LnProof.FloorCertGeUpC00
+import LnProof.FloorCertGeUpC01
+import LnProof.FloorCertGeUpC02
+import LnProof.FloorCertGeUpC03
+import LnProof.FloorCertGeUpC04
+import LnProof.FloorCertGeUpC05
+import LnProof.FloorCertGeUpC06
+import LnProof.FloorCertGeUpC07
+import LnProof.FloorCertGeUpC08
+import LnProof.FloorCertGeUpC09
+import LnProof.FloorCertGeUpC10
+import LnProof.FloorCertGeUpC11
+import LnProof.FloorCertGeUpC12
+import LnProof.FloorCertGeUpC13
+import LnProof.FloorCertGeUpC14
+
+namespace LnFloorCert
+open LnGeneratedModel LnPoly
+
+set_option maxRecDepth 100000
+
+theorem geTN_eq_lit : geTN = geTNLit := by
+  unfold geTN gePPHwlo geWLO geD8 geB2 geA2
+  decide +kernel
+
+theorem geTD_eq_lit : geTD = geTDLit := by
+  unfold geTD geQQHws geA96 geB2 geA2
+  decide +kernel
+
+theorem geUp_eval_eq : ∀ x : Int, evalPoly certGeUp x = evalPoly certGeUpLit x := by
+  refine evalPoly_ext (B := kB) certGeUp certGeUpLit ?_ ?_ ?_
+  · -- Bound `polyL1 certGeUp` through the ℓ1 homomorphism lemmas applied to the
+    -- (literal-coefficient) summands, then close by `exact` through the definitional
+    -- equality `certGeUp ≡ polyAdd …`. Avoiding `unfold certGeUp` here is essential:
+    -- the `unfold` tactic forces the kernel to reduce the degree-276 construction
+    -- (minutes), whereas the defeq the final `exact` performs is lazy congruence
+    -- bottoming out at `geTD ≡ geTDLit` / `geTN ≡ geTNLit` (milliseconds).
+    show polyL1 certGeUp * 2 < 2 ^ kB
+    have h1 := polyL1_polyAdd
+      (polyScale ((EUD + EUN) * KF1) (polyMul [0, 1] (polyPow geTDLit 23)))
+      (polyScale (-(Sc : Int) * EUD) (polyAdd (polyScale 23 (polyMul (expPolyNum geTNLit geTDLit 22) geTDLit)) (polyScale 2 (polyPow geTNLit 23))))
+    have h2 := polyL1_polyScale ((EUD + EUN) * KF1) (polyMul [0, 1] (polyPow geTDLit 23))
+    have h3 := polyL1_polyMul ([0, 1] : List Int) (polyPow geTDLit 23)
+    have h4 := polyL1_polyPow geTDLit 23
+    have h5 : polyL1 ([0, 1] : List Int) * polyL1 (polyPow geTDLit 23) ≤
+        polyL1 ([0, 1] : List Int) * polyL1 geTDLit ^ 23 := Nat.mul_le_mul_left _ h4
+    have h6 : ((EUD + EUN) * KF1).natAbs * polyL1 (polyMul ([0, 1] : List Int) (polyPow geTDLit 23)) ≤
+        ((EUD + EUN) * KF1).natAbs * (polyL1 ([0, 1] : List Int) * polyL1 geTDLit ^ 23) :=
+      Nat.mul_le_mul_left _ (Nat.le_trans h3 h5)
+    have h7 := polyL1_polyScale (-(Sc : Int) * EUD) (polyAdd (polyScale 23 (polyMul (expPolyNum geTNLit geTDLit 22) geTDLit)) (polyScale 2 (polyPow geTNLit 23)))
+    have h8 := polyL1_polyAdd (polyScale 23 (polyMul (expPolyNum geTNLit geTDLit 22) geTDLit)) (polyScale 2 (polyPow geTNLit 23))
+    have h9 := polyL1_polyScale (23 : Int) (polyMul (expPolyNum geTNLit geTDLit 22) geTDLit)
+    have h10 := polyL1_polyMul (expPolyNum geTNLit geTDLit 22) geTDLit
+    have h11 := polyL1_expPolyNum geTNLit geTDLit 22
+    have h12 : polyL1 (expPolyNum geTNLit geTDLit 22) * polyL1 geTDLit ≤
+        LnExp.expNum 22 (polyL1 geTNLit) (polyL1 geTDLit) * polyL1 geTDLit :=
+      Nat.mul_le_mul_right _ h11
+    have h13 : (23 : Int).natAbs * polyL1 (polyMul (expPolyNum geTNLit geTDLit 22) geTDLit) ≤
+        (23 : Int).natAbs * (LnExp.expNum 22 (polyL1 geTNLit) (polyL1 geTDLit) * polyL1 geTDLit) :=
+      Nat.mul_le_mul_left _ (Nat.le_trans h10 h12)
+    have h14 := polyL1_polyScale (2 : Int) (polyPow geTNLit 23)
+    have h15 := polyL1_polyPow geTNLit 23
+    have h16 : (2 : Int).natAbs * polyL1 (polyPow geTNLit 23) ≤
+        (2 : Int).natAbs * polyL1 geTNLit ^ 23 := Nat.mul_le_mul_left _ h15
+    have h17 : (-(Sc : Int) * EUD).natAbs * polyL1 (polyAdd (polyScale 23 (polyMul (expPolyNum geTNLit geTDLit 22) geTDLit)) (polyScale 2 (polyPow geTNLit 23))) ≤
+        (-(Sc : Int) * EUD).natAbs * ((23 : Int).natAbs * (LnExp.expNum 22 (polyL1 geTNLit) (polyL1 geTDLit) * polyL1 geTDLit) + (2 : Int).natAbs * polyL1 geTNLit ^ 23) := by
+      refine Nat.mul_le_mul_left _ ?_
+      have := Nat.le_trans h9 h13
+      have h14' := Nat.le_trans h14 h16
+      omega
+    have hfin : (((EUD + EUN) * KF1).natAbs * (polyL1 ([0, 1] : List Int) * polyL1 geTDLit ^ 23) +
+        (-(Sc : Int) * EUD).natAbs * ((23 : Int).natAbs * (LnExp.expNum 22 (polyL1 geTNLit) (polyL1 geTDLit) * polyL1 geTDLit) + (2 : Int).natAbs * polyL1 geTNLit ^ 23)) * 2 < 2 ^ kB := by
+      decide +kernel
+    have hA := Nat.le_trans h2 h6
+    have hB := Nat.le_trans h7 h17
+    exact Nat.lt_of_le_of_lt (Nat.mul_le_mul_right 2 (Nat.le_trans h1 (Nat.add_le_add hA hB))) hfin
+  · show polyL1 certGeUpLit * 2 < 2 ^ kB
+    decide +kernel
+  · show evalPoly certGeUp ((2 : Int) ^ kB) = evalPoly certGeUpLit ((2 : Int) ^ kB)
+    rw [int_two_pow kB]
+    unfold certGeUp
+    rw [geTN_eq_lit, geTD_eq_lit]
+    simp only [evalPoly_polyAdd, evalPoly_polyScale, evalPoly_polyMul,
+      evalPoly_polyPow, evalPoly_expPolyNum, eval01]
+    decide +kernel
+
+theorem geUp_nonneg {m : Int} (h1 : 56022770974786139918731938273 ≤ m) (h2 : m ≤ 79228162514264337593543950335) :
+    0 ≤ evalPoly certGeUp m := by
+  have hev := geUp_eval_eq m
+  rw [hev]
+  rcases Int.lt_or_le m (59279354229259720917350213723 + 1) with h | h
+  · exact checkCoverK_sound _ _ _ _ _ geUp_cell00 m (by omega) (by omega)
+  rcases Int.lt_or_le m (60868875837913635876431211872 + 1) with h | h
+  · exact checkCoverK_sound _ _ _ _ _ geUp_cell01 m (by omega) (by omega)
+  rcases Int.lt_or_le m (65647199166770921808412026255 + 1) with h | h
+  · exact checkCoverK_sound _ _ _ _ _ geUp_cell02 m (by omega) (by omega)
+  rcases Int.lt_or_le m (66326012476199512076492819330 + 1) with h | h
+  · exact checkCoverK_sound _ _ _ _ _ geUp_cell03 m (by omega) (by omega)
+  rcases Int.lt_or_le m (71285905378028973084942956446 + 1) with h | h
+  · exact checkCoverK_sound _ _ _ _ _ geUp_cell04 m (by omega) (by omega)
+  rcases Int.lt_or_le m (71968434253869915164444390522 + 1) with h | h
+  · exact checkCoverK_sound _ _ _ _ _ geUp_cell05 m (by omega) (by omega)
+  rcases Int.lt_or_le m (72408786498893991617815899218 + 1) with h | h
+  · exact checkCoverK_sound _ _ _ _ _ geUp_cell06 m (by omega) (by omega)
+  rcases Int.lt_or_le m (75861708703758292357820627133 + 1) with h | h
+  · exact checkCoverK_sound _ _ _ _ _ geUp_cell07 m (by omega) (by omega)
+  rcases Int.lt_or_le m (76378401319591968748569314938 + 1) with h | h
+  · exact checkCoverK_sound _ _ _ _ _ geUp_cell08 m (by omega) (by omega)
+  rcases Int.lt_or_le m (76545349455617885268024766253 + 1) with h | h
+  · exact checkCoverK_sound _ _ _ _ _ geUp_cell09 m (by omega) (by omega)
+  rcases Int.lt_or_le m (78599445424075384278202074396 + 1) with h | h
+  · exact checkCoverK_sound _ _ _ _ _ geUp_cell10 m (by omega) (by omega)
+  rcases Int.lt_or_le m (78838265257980444338216869245 + 1) with h | h
+  · exact checkCoverK_sound _ _ _ _ _ geUp_cell11 m (by omega) (by omega)
+  rcases Int.lt_or_le m (78899360831234549898244564055 + 1) with h | h
+  · exact checkCoverK_sound _ _ _ _ _ geUp_cell12 m (by omega) (by omega)
+  rcases Int.lt_or_le m (78974765181663678167544320606 + 1) with h | h
+  · exact checkCoverK_sound _ _ _ _ _ geUp_cell13 m (by omega) (by omega)
+  exact checkCoverK_sound _ _ _ _ _ geUp_cell14 m (by omega) h2
+end LnFloorCert
diff --git a/formal/ln/LnProof/LnProof/FloorCertGeUpC00.lean b/formal/ln/LnProof/LnProof/FloorCertGeUpC00.lean
new file mode 100644
index 000000000..73f6a349d
--- /dev/null
+++ b/formal/ln/LnProof/LnProof/FloorCertGeUpC00.lean
@@ -0,0 +1,13 @@
+import LnProof.FloorCertLit
+import LnProof.KroneckerShift
+
+namespace LnFloorCert
+open LnPoly
+
+set_option maxRecDepth 100000
+
+theorem geUp_cell00 : checkCoverK kB certGeUpLit 56022770974786139918731938273 59279354229259720917350213723
+    [3256583254473580998618275450] = true := by
+  decide +kernel
+
+end LnFloorCert
diff --git a/formal/ln/LnProof/LnProof/FloorCertGeUpC01.lean b/formal/ln/LnProof/LnProof/FloorCertGeUpC01.lean
new file mode 100644
index 000000000..59310ef06
--- /dev/null
+++ b/formal/ln/LnProof/LnProof/FloorCertGeUpC01.lean
@@ -0,0 +1,13 @@
+import LnProof.FloorCertLit
+import LnProof.KroneckerShift
+
+namespace LnFloorCert
+open LnPoly
+
+set_option maxRecDepth 100000
+
+theorem geUp_cell01 : checkCoverK kB certGeUpLit 59279354229259720917350213724 60868875837913635876431211872
+    [1589521608653914959080998148] = true := by
+  decide +kernel
+
+end LnFloorCert
diff --git a/formal/ln/LnProof/LnProof/FloorCertGeUpC02.lean b/formal/ln/LnProof/LnProof/FloorCertGeUpC02.lean
new file mode 100644
index 000000000..ed45419eb
--- /dev/null
+++ b/formal/ln/LnProof/LnProof/FloorCertGeUpC02.lean
@@ -0,0 +1,13 @@
+import LnProof.FloorCertLit
+import LnProof.KroneckerShift
+
+namespace LnFloorCert
+open LnPoly
+
+set_option maxRecDepth 100000
+
+theorem geUp_cell02 : checkCoverK kB certGeUpLit 60868875837913635876431211873 65647199166770921808412026255
+    [4778323328857285931980814382] = true := by
+  decide +kernel
+
+end LnFloorCert
diff --git a/formal/ln/LnProof/LnProof/FloorCertGeUpC03.lean b/formal/ln/LnProof/LnProof/FloorCertGeUpC03.lean
new file mode 100644
index 000000000..31eb347aa
--- /dev/null
+++ b/formal/ln/LnProof/LnProof/FloorCertGeUpC03.lean
@@ -0,0 +1,13 @@
+import LnProof.FloorCertLit
+import LnProof.KroneckerShift
+
+namespace LnFloorCert
+open LnPoly
+
+set_option maxRecDepth 100000
+
+theorem geUp_cell03 : checkCoverK kB certGeUpLit 65647199166770921808412026256 66326012476199512076492819330
+    [678813309428590268080793074] = true := by
+  decide +kernel
+
+end LnFloorCert
diff --git a/formal/ln/LnProof/LnProof/FloorCertGeUpC04.lean b/formal/ln/LnProof/LnProof/FloorCertGeUpC04.lean
new file mode 100644
index 000000000..74dcb06ad
--- /dev/null
+++ b/formal/ln/LnProof/LnProof/FloorCertGeUpC04.lean
@@ -0,0 +1,13 @@
+import LnProof.FloorCertLit
+import LnProof.KroneckerShift
+
+namespace LnFloorCert
+open LnPoly
+
+set_option maxRecDepth 100000
+
+theorem geUp_cell04 : checkCoverK kB certGeUpLit 66326012476199512076492819331 71285905378028973084942956446
+    [4959892901829461008450137115] = true := by
+  decide +kernel
+
+end LnFloorCert
diff --git a/formal/ln/LnProof/LnProof/FloorCertGeUpC05.lean b/formal/ln/LnProof/LnProof/FloorCertGeUpC05.lean
new file mode 100644
index 000000000..d238f74f6
--- /dev/null
+++ b/formal/ln/LnProof/LnProof/FloorCertGeUpC05.lean
@@ -0,0 +1,13 @@
+import LnProof.FloorCertLit
+import LnProof.KroneckerShift
+
+namespace LnFloorCert
+open LnPoly
+
+set_option maxRecDepth 100000
+
+theorem geUp_cell05 : checkCoverK kB certGeUpLit 71285905378028973084942956447 71968434253869915164444390522
+    [682528875840942079501434075] = true := by
+  decide +kernel
+
+end LnFloorCert
diff --git a/formal/ln/LnProof/LnProof/FloorCertGeUpC06.lean b/formal/ln/LnProof/LnProof/FloorCertGeUpC06.lean
new file mode 100644
index 000000000..8783d3490
--- /dev/null
+++ b/formal/ln/LnProof/LnProof/FloorCertGeUpC06.lean
@@ -0,0 +1,13 @@
+import LnProof.FloorCertLit
+import LnProof.KroneckerShift
+
+namespace LnFloorCert
+open LnPoly
+
+set_option maxRecDepth 100000
+
+theorem geUp_cell06 : checkCoverK kB certGeUpLit 71968434253869915164444390523 72408786498893991617815899218
+    [440352245024076453371508695] = true := by
+  decide +kernel
+
+end LnFloorCert
diff --git a/formal/ln/LnProof/LnProof/FloorCertGeUpC07.lean b/formal/ln/LnProof/LnProof/FloorCertGeUpC07.lean
new file mode 100644
index 000000000..df52126a7
--- /dev/null
+++ b/formal/ln/LnProof/LnProof/FloorCertGeUpC07.lean
@@ -0,0 +1,13 @@
+import LnProof.FloorCertLit
+import LnProof.KroneckerShift
+
+namespace LnFloorCert
+open LnPoly
+
+set_option maxRecDepth 100000
+
+theorem geUp_cell07 : checkCoverK kB certGeUpLit 72408786498893991617815899219 75861708703758292357820627133
+    [3452922204864300740004727914] = true := by
+  decide +kernel
+
+end LnFloorCert
diff --git a/formal/ln/LnProof/LnProof/FloorCertGeUpC08.lean b/formal/ln/LnProof/LnProof/FloorCertGeUpC08.lean
new file mode 100644
index 000000000..45c2de71f
--- /dev/null
+++ b/formal/ln/LnProof/LnProof/FloorCertGeUpC08.lean
@@ -0,0 +1,13 @@
+import LnProof.FloorCertLit
+import LnProof.KroneckerShift
+
+namespace LnFloorCert
+open LnPoly
+
+set_option maxRecDepth 100000
+
+theorem geUp_cell08 : checkCoverK kB certGeUpLit 75861708703758292357820627134 76378401319591968748569314938
+    [516692615833676390748687804] = true := by
+  decide +kernel
+
+end LnFloorCert
diff --git a/formal/ln/LnProof/LnProof/FloorCertGeUpC09.lean b/formal/ln/LnProof/LnProof/FloorCertGeUpC09.lean
new file mode 100644
index 000000000..2241fd724
--- /dev/null
+++ b/formal/ln/LnProof/LnProof/FloorCertGeUpC09.lean
@@ -0,0 +1,13 @@
+import LnProof.FloorCertLit
+import LnProof.KroneckerShift
+
+namespace LnFloorCert
+open LnPoly
+
+set_option maxRecDepth 100000
+
+theorem geUp_cell09 : checkCoverK kB certGeUpLit 76378401319591968748569314939 76545349455617885268024766253
+    [166948136025916519455451314] = true := by
+  decide +kernel
+
+end LnFloorCert
diff --git a/formal/ln/LnProof/LnProof/FloorCertGeUpC10.lean b/formal/ln/LnProof/LnProof/FloorCertGeUpC10.lean
new file mode 100644
index 000000000..4b1ce402d
--- /dev/null
+++ b/formal/ln/LnProof/LnProof/FloorCertGeUpC10.lean
@@ -0,0 +1,13 @@
+import LnProof.FloorCertLit
+import LnProof.KroneckerShift
+
+namespace LnFloorCert
+open LnPoly
+
+set_option maxRecDepth 100000
+
+theorem geUp_cell10 : checkCoverK kB certGeUpLit 76545349455617885268024766254 78599445424075384278202074396
+    [2054095968457499010177308142] = true := by
+  decide +kernel
+
+end LnFloorCert
diff --git a/formal/ln/LnProof/LnProof/FloorCertGeUpC11.lean b/formal/ln/LnProof/LnProof/FloorCertGeUpC11.lean
new file mode 100644
index 000000000..11c0a3115
--- /dev/null
+++ b/formal/ln/LnProof/LnProof/FloorCertGeUpC11.lean
@@ -0,0 +1,13 @@
+import LnProof.FloorCertLit
+import LnProof.KroneckerShift
+
+namespace LnFloorCert
+open LnPoly
+
+set_option maxRecDepth 100000
+
+theorem geUp_cell11 : checkCoverK kB certGeUpLit 78599445424075384278202074397 78838265257980444338216869245
+    [238819833905060060014794848] = true := by
+  decide +kernel
+
+end LnFloorCert
diff --git a/formal/ln/LnProof/LnProof/FloorCertGeUpC12.lean b/formal/ln/LnProof/LnProof/FloorCertGeUpC12.lean
new file mode 100644
index 000000000..f5f79937b
--- /dev/null
+++ b/formal/ln/LnProof/LnProof/FloorCertGeUpC12.lean
@@ -0,0 +1,13 @@
+import LnProof.FloorCertLit
+import LnProof.KroneckerShift
+
+namespace LnFloorCert
+open LnPoly
+
+set_option maxRecDepth 100000
+
+theorem geUp_cell12 : checkCoverK kB certGeUpLit 78838265257980444338216869246 78899360831234549898244564055
+    [61095573254105560027694809] = true := by
+  decide +kernel
+
+end LnFloorCert
diff --git a/formal/ln/LnProof/LnProof/FloorCertGeUpC13.lean b/formal/ln/LnProof/LnProof/FloorCertGeUpC13.lean
new file mode 100644
index 000000000..56abae030
--- /dev/null
+++ b/formal/ln/LnProof/LnProof/FloorCertGeUpC13.lean
@@ -0,0 +1,13 @@
+import LnProof.FloorCertLit
+import LnProof.KroneckerShift
+
+namespace LnFloorCert
+open LnPoly
+
+set_option maxRecDepth 100000
+
+theorem geUp_cell13 : checkCoverK kB certGeUpLit 78899360831234549898244564056 78974765181663678167544320606
+    [75404350429128269299756550] = true := by
+  decide +kernel
+
+end LnFloorCert
diff --git a/formal/ln/LnProof/LnProof/FloorCertGeUpC14.lean b/formal/ln/LnProof/LnProof/FloorCertGeUpC14.lean
new file mode 100644
index 000000000..b35da90ad
--- /dev/null
+++ b/formal/ln/LnProof/LnProof/FloorCertGeUpC14.lean
@@ -0,0 +1,13 @@
+import LnProof.FloorCertLit
+import LnProof.KroneckerShift
+
+namespace LnFloorCert
+open LnPoly
+
+set_option maxRecDepth 100000
+
+theorem geUp_cell14 : checkCoverK kB certGeUpLit 78974765181663678167544320607 79228162514264337593543950335
+    [253397332600659425999629728] = true := by
+  decide +kernel
+
+end LnFloorCert
diff --git a/formal/ln/LnProof/LnProof/FloorCertLtLo.lean b/formal/ln/LnProof/LnProof/FloorCertLtLo.lean
new file mode 100644
index 000000000..dc85cd381
--- /dev/null
+++ b/formal/ln/LnProof/LnProof/FloorCertLtLo.lean
@@ -0,0 +1,123 @@
+import LnProof.FloorCertDefs
+import LnProof.FloorCertLit
+import LnProof.Kronecker
+import LnProof.FloorCertLtLoC00
+import LnProof.FloorCertLtLoC01
+import LnProof.FloorCertLtLoC02
+import LnProof.FloorCertLtLoC03
+import LnProof.FloorCertLtLoC04
+import LnProof.FloorCertLtLoC05
+import LnProof.FloorCertLtLoC06
+import LnProof.FloorCertLtLoC07
+import LnProof.FloorCertLtLoC08
+import LnProof.FloorCertLtLoC09
+import LnProof.FloorCertLtLoC10
+import LnProof.FloorCertLtLoC11
+import LnProof.FloorCertLtLoC12
+import LnProof.FloorCertLtLoC13
+import LnProof.FloorCertLtLoC14
+
+namespace LnFloorCert
+open LnGeneratedModel LnPoly
+
+set_option maxRecDepth 100000
+
+theorem ltTN_eq_lit : ltTN = ltTNLit := by
+  unfold ltTN ltPPHwlo ltWLO ltD8 ltB2 ltA2
+  decide +kernel
+
+theorem ltTD_eq_lit : ltTD = ltTDLit := by
+  unfold ltTD ltQQHws ltA96 ltB2 ltA2
+  decide +kernel
+
+theorem ltLo_eval_eq : ∀ x : Int, evalPoly certLtLo x = evalPoly certLtLoLit x := by
+  refine evalPoly_ext (B := kB) certLtLo certLtLoLit ?_ ?_ ?_
+  · -- Bound `polyL1 certLtLo` via the ℓ1 homomorphism lemmas on the literal
+    -- summands, closing by `exact` through the definitional equality
+    -- `certLtLo ≡ polyAdd …`. `unfold certLtLo` is avoided: it forces the kernel
+    -- to reduce the full construction (minutes); the `exact` defeq is lazy
+    -- congruence bottoming out at `ltTD ≡ ltTDLit` (milliseconds).
+    show polyL1 certLtLo * 2 < 2 ^ kB
+    have h1 := polyL1_polyAdd
+      (polyScale ((Sc : Int) * EUD * KF1) (polyPow ltTDLit 23))
+      (polyScale (-(EUD - EUN)) (polyMul [0, 1] (polyAdd (polyScale 23 (polyMul (expPolyNum ltTNLit ltTDLit 22) ltTDLit)) (polyScale 2 (polyPow ltTNLit 23)))))
+    have h2 := polyL1_polyScale ((Sc : Int) * EUD * KF1) (polyPow ltTDLit 23)
+    have h3 := polyL1_polyPow ltTDLit 23
+    have h4 : ((Sc : Int) * EUD * KF1).natAbs * polyL1 (polyPow ltTDLit 23) ≤
+        ((Sc : Int) * EUD * KF1).natAbs * polyL1 ltTDLit ^ 23 :=
+      Nat.mul_le_mul_left _ h3
+    have h5 := polyL1_polyScale (-(EUD - EUN)) (polyMul [0, 1] (polyAdd (polyScale 23 (polyMul (expPolyNum ltTNLit ltTDLit 22) ltTDLit)) (polyScale 2 (polyPow ltTNLit 23))))
+    have h6 := polyL1_polyMul ([0, 1] : List Int) (polyAdd (polyScale 23 (polyMul (expPolyNum ltTNLit ltTDLit 22) ltTDLit)) (polyScale 2 (polyPow ltTNLit 23)))
+    have h7 := polyL1_polyAdd (polyScale 23 (polyMul (expPolyNum ltTNLit ltTDLit 22) ltTDLit)) (polyScale 2 (polyPow ltTNLit 23))
+    have h8 := polyL1_polyScale (23 : Int) (polyMul (expPolyNum ltTNLit ltTDLit 22) ltTDLit)
+    have h9 := polyL1_polyMul (expPolyNum ltTNLit ltTDLit 22) ltTDLit
+    have h10 := polyL1_expPolyNum ltTNLit ltTDLit 22
+    have h11 : polyL1 (expPolyNum ltTNLit ltTDLit 22) * polyL1 ltTDLit ≤
+        LnExp.expNum 22 (polyL1 ltTNLit) (polyL1 ltTDLit) * polyL1 ltTDLit :=
+      Nat.mul_le_mul_right _ h10
+    have h12 : (23 : Int).natAbs * polyL1 (polyMul (expPolyNum ltTNLit ltTDLit 22) ltTDLit) ≤
+        (23 : Int).natAbs * (LnExp.expNum 22 (polyL1 ltTNLit) (polyL1 ltTDLit) * polyL1 ltTDLit) :=
+      Nat.mul_le_mul_left _ (Nat.le_trans h9 h11)
+    have h13 := polyL1_polyScale (2 : Int) (polyPow ltTNLit 23)
+    have h14 := polyL1_polyPow ltTNLit 23
+    have h15 : (2 : Int).natAbs * polyL1 (polyPow ltTNLit 23) ≤
+        (2 : Int).natAbs * polyL1 ltTNLit ^ 23 := Nat.mul_le_mul_left _ h14
+    have h16 : polyL1 ([0, 1] : List Int) * polyL1 (polyAdd (polyScale 23 (polyMul (expPolyNum ltTNLit ltTDLit 22) ltTDLit)) (polyScale 2 (polyPow ltTNLit 23))) ≤
+        polyL1 ([0, 1] : List Int) * ((23 : Int).natAbs * (LnExp.expNum 22 (polyL1 ltTNLit) (polyL1 ltTDLit) * polyL1 ltTDLit) + (2 : Int).natAbs * polyL1 ltTNLit ^ 23) := by
+      refine Nat.mul_le_mul_left _ ?_
+      have hx := Nat.le_trans h8 h12
+      have hy := Nat.le_trans h13 h15
+      omega
+    have h17 : (-(EUD - EUN)).natAbs * polyL1 (polyMul ([0, 1] : List Int) (polyAdd (polyScale 23 (polyMul (expPolyNum ltTNLit ltTDLit 22) ltTDLit)) (polyScale 2 (polyPow ltTNLit 23)))) ≤
+        (-(EUD - EUN)).natAbs * (polyL1 ([0, 1] : List Int) * ((23 : Int).natAbs * (LnExp.expNum 22 (polyL1 ltTNLit) (polyL1 ltTDLit) * polyL1 ltTDLit) + (2 : Int).natAbs * polyL1 ltTNLit ^ 23)) :=
+      Nat.mul_le_mul_left _ (Nat.le_trans h6 h16)
+    have hfin : (((Sc : Int) * EUD * KF1).natAbs * polyL1 ltTDLit ^ 23 +
+        (-(EUD - EUN)).natAbs * (polyL1 ([0, 1] : List Int) * ((23 : Int).natAbs * (LnExp.expNum 22 (polyL1 ltTNLit) (polyL1 ltTDLit) * polyL1 ltTDLit) + (2 : Int).natAbs * polyL1 ltTNLit ^ 23))) * 2 < 2 ^ kB := by
+      decide +kernel
+    have hA := Nat.le_trans h2 h4
+    have hB := Nat.le_trans h5 h17
+    exact Nat.lt_of_le_of_lt (Nat.mul_le_mul_right 2 (Nat.le_trans h1 (Nat.add_le_add hA hB))) hfin
+  · show polyL1 certLtLoLit * 2 < 2 ^ kB
+    decide +kernel
+  · show evalPoly certLtLo ((2 : Int) ^ kB) = evalPoly certLtLoLit ((2 : Int) ^ kB)
+    rw [int_two_pow kB]
+    unfold certLtLo
+    rw [ltTN_eq_lit, ltTD_eq_lit]
+    simp only [evalPoly_polyAdd, evalPoly_polyScale, evalPoly_polyMul,
+      evalPoly_polyPow, evalPoly_expPolyNum, eval01]
+    decide +kernel
+
+theorem ltLo_nonneg {m : Int} (h1 : 39614081257132168796771975168 ≤ m) (h2 : m ≤ 56022770974786139918731938181) :
+    0 ≤ evalPoly certLtLo m := by
+  have hev := ltLo_eval_eq m
+  rw [hev]
+  rcases Int.lt_or_le m (39691568842842447562319269665 + 1) with h | h
+  · exact checkCoverK_sound _ _ _ _ _ ltLo_cell00 m (by omega) (by omega)
+  rcases Int.lt_or_le m (39733100139740266608218414413 + 1) with h | h
+  · exact checkCoverK_sound _ _ _ _ _ ltLo_cell01 m (by omega) (by omega)
+  rcases Int.lt_or_le m (39757653172445695310837028835 + 1) with h | h
+  · exact checkCoverK_sound _ _ _ _ _ ltLo_cell02 m (by omega) (by omega)
+  rcases Int.lt_or_le m (39782184972069981508068781991 + 1) with h | h
+  · exact checkCoverK_sound _ _ _ _ _ ltLo_cell03 m (by omega) (by omega)
+  rcases Int.lt_or_le m (40683318943956774759765093061 + 1) with h | h
+  · exact checkCoverK_sound _ _ _ _ _ ltLo_cell04 m (by omega) (by omega)
+  rcases Int.lt_or_le m (40933137699355212682659008289 + 1) with h | h
+  · exact checkCoverK_sound _ _ _ _ _ ltLo_cell05 m (by omega) (by omega)
+  rcases Int.lt_or_le m (41019543030322903743594235649 + 1) with h | h
+  · exact checkCoverK_sound _ _ _ _ _ ltLo_cell06 m (by omega) (by omega)
+  rcases Int.lt_or_le m (42434861454155548723387563152 + 1) with h | h
+  · exact checkCoverK_sound _ _ _ _ _ ltLo_cell07 m (by omega) (by omega)
+  rcases Int.lt_or_le m (43340936784615056347798031794 + 1) with h | h
+  · exact checkCoverK_sound _ _ _ _ _ ltLo_cell08 m (by omega) (by omega)
+  rcases Int.lt_or_le m (43553475214845372217317803462 + 1) with h | h
+  · exact checkCoverK_sound _ _ _ _ _ ltLo_cell09 m (by omega) (by omega)
+  rcases Int.lt_or_le m (46779428052747433029299757936 + 1) with h | h
+  · exact checkCoverK_sound _ _ _ _ _ ltLo_cell10 m (by omega) (by omega)
+  rcases Int.lt_or_le m (47296264120598942405857135301 + 1) with h | h
+  · exact checkCoverK_sound _ _ _ _ _ ltLo_cell11 m (by omega) (by omega)
+  rcases Int.lt_or_le m (51908282562281673025522611127 + 1) with h | h
+  · exact checkCoverK_sound _ _ _ _ _ ltLo_cell12 m (by omega) (by omega)
+  rcases Int.lt_or_le m (52718525787343046817539678213 + 1) with h | h
+  · exact checkCoverK_sound _ _ _ _ _ ltLo_cell13 m (by omega) (by omega)
+  exact checkCoverK_sound _ _ _ _ _ ltLo_cell14 m (by omega) h2
+end LnFloorCert
diff --git a/formal/ln/LnProof/LnProof/FloorCertLtLoC00.lean b/formal/ln/LnProof/LnProof/FloorCertLtLoC00.lean
new file mode 100644
index 000000000..2f3a73d15
--- /dev/null
+++ b/formal/ln/LnProof/LnProof/FloorCertLtLoC00.lean
@@ -0,0 +1,13 @@
+import LnProof.FloorCertLit
+import LnProof.KroneckerShift
+
+namespace LnFloorCert
+open LnPoly
+
+set_option maxRecDepth 100000
+
+theorem ltLo_cell00 : checkCoverK kB certLtLoLit 39614081257132168796771975168 39691568842842447562319269665
+    [77487585710278765547294497] = true := by
+  decide +kernel
+
+end LnFloorCert
diff --git a/formal/ln/LnProof/LnProof/FloorCertLtLoC01.lean b/formal/ln/LnProof/LnProof/FloorCertLtLoC01.lean
new file mode 100644
index 000000000..db9e541df
--- /dev/null
+++ b/formal/ln/LnProof/LnProof/FloorCertLtLoC01.lean
@@ -0,0 +1,13 @@
+import LnProof.FloorCertLit
+import LnProof.KroneckerShift
+
+namespace LnFloorCert
+open LnPoly
+
+set_option maxRecDepth 100000
+
+theorem ltLo_cell01 : checkCoverK kB certLtLoLit 39691568842842447562319269666 39733100139740266608218414413
+    [41531296897819045899144747] = true := by
+  decide +kernel
+
+end LnFloorCert
diff --git a/formal/ln/LnProof/LnProof/FloorCertLtLoC02.lean b/formal/ln/LnProof/LnProof/FloorCertLtLoC02.lean
new file mode 100644
index 000000000..d43f22e50
--- /dev/null
+++ b/formal/ln/LnProof/LnProof/FloorCertLtLoC02.lean
@@ -0,0 +1,13 @@
+import LnProof.FloorCertLit
+import LnProof.KroneckerShift
+
+namespace LnFloorCert
+open LnPoly
+
+set_option maxRecDepth 100000
+
+theorem ltLo_cell02 : checkCoverK kB certLtLoLit 39733100139740266608218414414 39757653172445695310837028835
+    [24553032705428702618614421] = true := by
+  decide +kernel
+
+end LnFloorCert
diff --git a/formal/ln/LnProof/LnProof/FloorCertLtLoC03.lean b/formal/ln/LnProof/LnProof/FloorCertLtLoC03.lean
new file mode 100644
index 000000000..0aa4a5bec
--- /dev/null
+++ b/formal/ln/LnProof/LnProof/FloorCertLtLoC03.lean
@@ -0,0 +1,13 @@
+import LnProof.FloorCertLit
+import LnProof.KroneckerShift
+
+namespace LnFloorCert
+open LnPoly
+
+set_option maxRecDepth 100000
+
+theorem ltLo_cell03 : checkCoverK kB certLtLoLit 39757653172445695310837028836 39782184972069981508068781991
+    [24531799624286197231753155] = true := by
+  decide +kernel
+
+end LnFloorCert
diff --git a/formal/ln/LnProof/LnProof/FloorCertLtLoC04.lean b/formal/ln/LnProof/LnProof/FloorCertLtLoC04.lean
new file mode 100644
index 000000000..e6c14af13
--- /dev/null
+++ b/formal/ln/LnProof/LnProof/FloorCertLtLoC04.lean
@@ -0,0 +1,13 @@
+import LnProof.FloorCertLit
+import LnProof.KroneckerShift
+
+namespace LnFloorCert
+open LnPoly
+
+set_option maxRecDepth 100000
+
+theorem ltLo_cell04 : checkCoverK kB certLtLoLit 39782184972069981508068781992 40683318943956774759765093061
+    [901133971886793251696311069] = true := by
+  decide +kernel
+
+end LnFloorCert
diff --git a/formal/ln/LnProof/LnProof/FloorCertLtLoC05.lean b/formal/ln/LnProof/LnProof/FloorCertLtLoC05.lean
new file mode 100644
index 000000000..a851edd13
--- /dev/null
+++ b/formal/ln/LnProof/LnProof/FloorCertLtLoC05.lean
@@ -0,0 +1,13 @@
+import LnProof.FloorCertLit
+import LnProof.KroneckerShift
+
+namespace LnFloorCert
+open LnPoly
+
+set_option maxRecDepth 100000
+
+theorem ltLo_cell05 : checkCoverK kB certLtLoLit 40683318943956774759765093062 40933137699355212682659008289
+    [249818755398437922893915227] = true := by
+  decide +kernel
+
+end LnFloorCert
diff --git a/formal/ln/LnProof/LnProof/FloorCertLtLoC06.lean b/formal/ln/LnProof/LnProof/FloorCertLtLoC06.lean
new file mode 100644
index 000000000..a3bed1fcb
--- /dev/null
+++ b/formal/ln/LnProof/LnProof/FloorCertLtLoC06.lean
@@ -0,0 +1,13 @@
+import LnProof.FloorCertLit
+import LnProof.KroneckerShift
+
+namespace LnFloorCert
+open LnPoly
+
+set_option maxRecDepth 100000
+
+theorem ltLo_cell06 : checkCoverK kB certLtLoLit 40933137699355212682659008290 41019543030322903743594235649
+    [86405330967691060935227359] = true := by
+  decide +kernel
+
+end LnFloorCert
diff --git a/formal/ln/LnProof/LnProof/FloorCertLtLoC07.lean b/formal/ln/LnProof/LnProof/FloorCertLtLoC07.lean
new file mode 100644
index 000000000..fe87a0ab2
--- /dev/null
+++ b/formal/ln/LnProof/LnProof/FloorCertLtLoC07.lean
@@ -0,0 +1,13 @@
+import LnProof.FloorCertLit
+import LnProof.KroneckerShift
+
+namespace LnFloorCert
+open LnPoly
+
+set_option maxRecDepth 100000
+
+theorem ltLo_cell07 : checkCoverK kB certLtLoLit 41019543030322903743594235650 42434861454155548723387563152
+    [1415318423832644979793327502] = true := by
+  decide +kernel
+
+end LnFloorCert
diff --git a/formal/ln/LnProof/LnProof/FloorCertLtLoC08.lean b/formal/ln/LnProof/LnProof/FloorCertLtLoC08.lean
new file mode 100644
index 000000000..ae18128dd
--- /dev/null
+++ b/formal/ln/LnProof/LnProof/FloorCertLtLoC08.lean
@@ -0,0 +1,13 @@
+import LnProof.FloorCertLit
+import LnProof.KroneckerShift
+
+namespace LnFloorCert
+open LnPoly
+
+set_option maxRecDepth 100000
+
+theorem ltLo_cell08 : checkCoverK kB certLtLoLit 42434861454155548723387563153 43340936784615056347798031794
+    [906075330459507624410468641] = true := by
+  decide +kernel
+
+end LnFloorCert
diff --git a/formal/ln/LnProof/LnProof/FloorCertLtLoC09.lean b/formal/ln/LnProof/LnProof/FloorCertLtLoC09.lean
new file mode 100644
index 000000000..56b9c2d35
--- /dev/null
+++ b/formal/ln/LnProof/LnProof/FloorCertLtLoC09.lean
@@ -0,0 +1,13 @@
+import LnProof.FloorCertLit
+import LnProof.KroneckerShift
+
+namespace LnFloorCert
+open LnPoly
+
+set_option maxRecDepth 100000
+
+theorem ltLo_cell09 : checkCoverK kB certLtLoLit 43340936784615056347798031795 43553475214845372217317803462
+    [212538430230315869519771667] = true := by
+  decide +kernel
+
+end LnFloorCert
diff --git a/formal/ln/LnProof/LnProof/FloorCertLtLoC10.lean b/formal/ln/LnProof/LnProof/FloorCertLtLoC10.lean
new file mode 100644
index 000000000..e2a9e52bc
--- /dev/null
+++ b/formal/ln/LnProof/LnProof/FloorCertLtLoC10.lean
@@ -0,0 +1,13 @@
+import LnProof.FloorCertLit
+import LnProof.KroneckerShift
+
+namespace LnFloorCert
+open LnPoly
+
+set_option maxRecDepth 100000
+
+theorem ltLo_cell10 : checkCoverK kB certLtLoLit 43553475214845372217317803463 46779428052747433029299757936
+    [3225952837902060811981954473] = true := by
+  decide +kernel
+
+end LnFloorCert
diff --git a/formal/ln/LnProof/LnProof/FloorCertLtLoC11.lean b/formal/ln/LnProof/LnProof/FloorCertLtLoC11.lean
new file mode 100644
index 000000000..1239a5908
--- /dev/null
+++ b/formal/ln/LnProof/LnProof/FloorCertLtLoC11.lean
@@ -0,0 +1,13 @@
+import LnProof.FloorCertLit
+import LnProof.KroneckerShift
+
+namespace LnFloorCert
+open LnPoly
+
+set_option maxRecDepth 100000
+
+theorem ltLo_cell11 : checkCoverK kB certLtLoLit 46779428052747433029299757937 47296264120598942405857135301
+    [516836067851509376557377364] = true := by
+  decide +kernel
+
+end LnFloorCert
diff --git a/formal/ln/LnProof/LnProof/FloorCertLtLoC12.lean b/formal/ln/LnProof/LnProof/FloorCertLtLoC12.lean
new file mode 100644
index 000000000..f8ada64c0
--- /dev/null
+++ b/formal/ln/LnProof/LnProof/FloorCertLtLoC12.lean
@@ -0,0 +1,13 @@
+import LnProof.FloorCertLit
+import LnProof.KroneckerShift
+
+namespace LnFloorCert
+open LnPoly
+
+set_option maxRecDepth 100000
+
+theorem ltLo_cell12 : checkCoverK kB certLtLoLit 47296264120598942405857135302 51908282562281673025522611127
+    [4612018441682730619665475825] = true := by
+  decide +kernel
+
+end LnFloorCert
diff --git a/formal/ln/LnProof/LnProof/FloorCertLtLoC13.lean b/formal/ln/LnProof/LnProof/FloorCertLtLoC13.lean
new file mode 100644
index 000000000..4b591306c
--- /dev/null
+++ b/formal/ln/LnProof/LnProof/FloorCertLtLoC13.lean
@@ -0,0 +1,13 @@
+import LnProof.FloorCertLit
+import LnProof.KroneckerShift
+
+namespace LnFloorCert
+open LnPoly
+
+set_option maxRecDepth 100000
+
+theorem ltLo_cell13 : checkCoverK kB certLtLoLit 51908282562281673025522611128 52718525787343046817539678213
+    [810243225061373792017067085] = true := by
+  decide +kernel
+
+end LnFloorCert
diff --git a/formal/ln/LnProof/LnProof/FloorCertLtLoC14.lean b/formal/ln/LnProof/LnProof/FloorCertLtLoC14.lean
new file mode 100644
index 000000000..88155d1b6
--- /dev/null
+++ b/formal/ln/LnProof/LnProof/FloorCertLtLoC14.lean
@@ -0,0 +1,13 @@
+import LnProof.FloorCertLit
+import LnProof.KroneckerShift
+
+namespace LnFloorCert
+open LnPoly
+
+set_option maxRecDepth 100000
+
+theorem ltLo_cell14 : checkCoverK kB certLtLoLit 52718525787343046817539678214 56022770974786139918731938181
+    [3304245187443093101192259967] = true := by
+  decide +kernel
+
+end LnFloorCert
diff --git a/formal/ln/LnProof/LnProof/FloorCertLtUp.lean b/formal/ln/LnProof/LnProof/FloorCertLtUp.lean
new file mode 100644
index 000000000..54077bbb4
--- /dev/null
+++ b/formal/ln/LnProof/LnProof/FloorCertLtUp.lean
@@ -0,0 +1,107 @@
+import LnProof.FloorCertDefs
+import LnProof.FloorCertLit
+import LnProof.Kronecker
+import LnProof.FloorCertLtUpC00
+import LnProof.FloorCertLtUpC01
+import LnProof.FloorCertLtUpC02
+import LnProof.FloorCertLtUpC03
+import LnProof.FloorCertLtUpC04
+import LnProof.FloorCertLtUpC05
+import LnProof.FloorCertLtUpC06
+import LnProof.FloorCertLtUpC07
+import LnProof.FloorCertLtUpC08
+import LnProof.FloorCertLtUpC09
+import LnProof.FloorCertLtUpC10
+import LnProof.FloorCertLtUpC11
+import LnProof.FloorCertLtUpC12
+import LnProof.FloorCertLtUpC13
+import LnProof.FloorCertLtUpC14
+
+namespace LnFloorCert
+open LnGeneratedModel LnPoly
+
+set_option maxRecDepth 100000
+
+theorem ltTN2b_eq_lit : ltTN2b = ltTN2bLit := by
+  unfold ltTN2b ltTN2 ltTD2 ltPLOP ltDLO ltAZ ltPPHws ltQQHwlo ltA96 ltWLO ltD8 ltB2 ltA2
+  decide +kernel
+
+theorem ltTD2b_eq_lit : ltTD2b = ltTD2bLit := by
+  unfold ltTD2b ltTD2 ltDLO ltQQHwlo ltWLO ltD8 ltB2 ltA2
+  decide +kernel
+
+theorem ltUp_eval_eq : ∀ x : Int, evalPoly certLtUp x = evalPoly certLtUpLit x := by
+  refine evalPoly_ext (B := kB) certLtUp certLtUpLit ?_ ?_ ?_
+  · -- Bound `polyL1 certLtUp` via the ℓ1 homomorphism lemmas on the literal
+    -- summands, closing by `exact` through the definitional equality
+    -- `certLtUp ≡ polyAdd …`. `unfold certLtUp` is avoided: it forces the kernel
+    -- to reduce the full construction (minutes); the `exact` defeq is lazy
+    -- congruence bottoming out at `ltTD2b ≡ ltTD2bLit` (milliseconds).
+    show polyL1 certLtUp * 2 < 2 ^ kB
+    have h1 := polyL1_polyAdd
+      (polyScale (EUD + EUN) (polyMul [0, 1] (expPolyNum ltTN2bLit ltTD2bLit 22)))
+      (polyScale (-EUD * (Sc : Int) * KF) (polyPow ltTD2bLit 22))
+    have h2 := polyL1_polyScale (EUD + EUN) (polyMul [0, 1] (expPolyNum ltTN2bLit ltTD2bLit 22))
+    have h3 := polyL1_polyMul ([0, 1] : List Int) (expPolyNum ltTN2bLit ltTD2bLit 22)
+    have h4 := polyL1_expPolyNum ltTN2bLit ltTD2bLit 22
+    have h5 : polyL1 ([0, 1] : List Int) * polyL1 (expPolyNum ltTN2bLit ltTD2bLit 22) ≤
+        polyL1 ([0, 1] : List Int) * LnExp.expNum 22 (polyL1 ltTN2bLit) (polyL1 ltTD2bLit) :=
+      Nat.mul_le_mul_left _ h4
+    have h6 : (EUD + EUN).natAbs * polyL1 (polyMul ([0, 1] : List Int) (expPolyNum ltTN2bLit ltTD2bLit 22)) ≤
+        (EUD + EUN).natAbs * (polyL1 ([0, 1] : List Int) * LnExp.expNum 22 (polyL1 ltTN2bLit) (polyL1 ltTD2bLit)) :=
+      Nat.mul_le_mul_left _ (Nat.le_trans h3 h5)
+    have h7 := polyL1_polyScale (-EUD * (Sc : Int) * KF) (polyPow ltTD2bLit 22)
+    have h8 := polyL1_polyPow ltTD2bLit 22
+    have h9 : (-EUD * (Sc : Int) * KF).natAbs * polyL1 (polyPow ltTD2bLit 22) ≤
+        (-EUD * (Sc : Int) * KF).natAbs * polyL1 ltTD2bLit ^ 22 :=
+      Nat.mul_le_mul_left _ h8
+    have hfin : ((EUD + EUN).natAbs * (polyL1 ([0, 1] : List Int) * LnExp.expNum 22 (polyL1 ltTN2bLit) (polyL1 ltTD2bLit)) +
+        (-EUD * (Sc : Int) * KF).natAbs * polyL1 ltTD2bLit ^ 22) * 2 < 2 ^ kB := by
+      decide +kernel
+    have hA := Nat.le_trans h2 h6
+    have hB := Nat.le_trans h7 h9
+    exact Nat.lt_of_le_of_lt (Nat.mul_le_mul_right 2 (Nat.le_trans h1 (Nat.add_le_add hA hB))) hfin
+  · show polyL1 certLtUpLit * 2 < 2 ^ kB
+    decide +kernel
+  · show evalPoly certLtUp ((2 : Int) ^ kB) = evalPoly certLtUpLit ((2 : Int) ^ kB)
+    rw [int_two_pow kB]
+    unfold certLtUp
+    rw [ltTN2b_eq_lit, ltTD2b_eq_lit]
+    simp only [evalPoly_polyAdd, evalPoly_polyScale, evalPoly_polyMul,
+      evalPoly_polyPow, evalPoly_expPolyNum, eval01]
+    decide +kernel
+
+theorem ltUp_nonneg {m : Int} (h1 : 39614081257132168796771975168 ≤ m) (h2 : m ≤ 56022770974786139918731938181) :
+    0 ≤ evalPoly certLtUp m := by
+  have hev := ltUp_eval_eq m
+  rw [hev]
+  rcases Int.lt_or_le m (39982534672164782411896871713 + 1) with h | h
+  · exact checkCoverK_sound _ _ _ _ _ ltUp_cell00 m (by omega) (by omega)
+  rcases Int.lt_or_le m (40150853919271982033591711249 + 1) with h | h
+  · exact checkCoverK_sound _ _ _ _ _ ltUp_cell01 m (by omega) (by omega)
+  rcases Int.lt_or_le m (40205001758610997159114444920 + 1) with h | h
+  · exact checkCoverK_sound _ _ _ _ _ ltUp_cell02 m (by omega) (by omega)
+  rcases Int.lt_or_le m (40233125195560580626250736677 + 1) with h | h
+  · exact checkCoverK_sound _ _ _ _ _ ltUp_cell03 m (by omega) (by omega)
+  rcases Int.lt_or_le m (40277017559452910144135999239 + 1) with h | h
+  · exact checkCoverK_sound _ _ _ _ _ ltUp_cell04 m (by omega) (by omega)
+  rcases Int.lt_or_le m (41692588105644715585450931157 + 1) with h | h
+  · exact checkCoverK_sound _ _ _ _ _ ltUp_cell05 m (by omega) (by omega)
+  rcases Int.lt_or_le m (42015714968624513035526540308 + 1) with h | h
+  · exact checkCoverK_sound _ _ _ _ _ ltUp_cell06 m (by omega) (by omega)
+  rcases Int.lt_or_le m (42105566798542397566218396417 + 1) with h | h
+  · exact checkCoverK_sound _ _ _ _ _ ltUp_cell07 m (by omega) (by omega)
+  rcases Int.lt_or_le m (42244228633829548558923780243 + 1) with h | h
+  · exact checkCoverK_sound _ _ _ _ _ ltUp_cell08 m (by omega) (by omega)
+  rcases Int.lt_or_le m (44761589464445247665450168506 + 1) with h | h
+  · exact checkCoverK_sound _ _ _ _ _ ltUp_cell09 m (by omega) (by omega)
+  rcases Int.lt_or_le m (45182237044145709221717782607 + 1) with h | h
+  · exact checkCoverK_sound _ _ _ _ _ ltUp_cell10 m (by omega) (by omega)
+  rcases Int.lt_or_le m (45358461709730537512255462320 + 1) with h | h
+  · exact checkCoverK_sound _ _ _ _ _ ltUp_cell11 m (by omega) (by omega)
+  rcases Int.lt_or_le m (49100624827436726252807356861 + 1) with h | h
+  · exact checkCoverK_sound _ _ _ _ _ ltUp_cell12 m (by omega) (by omega)
+  rcases Int.lt_or_le m (49670427525155949284453311469 + 1) with h | h
+  · exact checkCoverK_sound _ _ _ _ _ ltUp_cell13 m (by omega) (by omega)
+  exact checkCoverK_sound _ _ _ _ _ ltUp_cell14 m (by omega) h2
+end LnFloorCert
diff --git a/formal/ln/LnProof/LnProof/FloorCertLtUpC00.lean b/formal/ln/LnProof/LnProof/FloorCertLtUpC00.lean
new file mode 100644
index 000000000..a802f1b25
--- /dev/null
+++ b/formal/ln/LnProof/LnProof/FloorCertLtUpC00.lean
@@ -0,0 +1,13 @@
+import LnProof.FloorCertLit
+import LnProof.KroneckerShift
+
+namespace LnFloorCert
+open LnPoly
+
+set_option maxRecDepth 100000
+
+theorem ltUp_cell00 : checkCoverK kB certLtUpLit 39614081257132168796771975168 39982534672164782411896871713
+    [368453415032613615124896545] = true := by
+  decide +kernel
+
+end LnFloorCert
diff --git a/formal/ln/LnProof/LnProof/FloorCertLtUpC01.lean b/formal/ln/LnProof/LnProof/FloorCertLtUpC01.lean
new file mode 100644
index 000000000..a26983c70
--- /dev/null
+++ b/formal/ln/LnProof/LnProof/FloorCertLtUpC01.lean
@@ -0,0 +1,13 @@
+import LnProof.FloorCertLit
+import LnProof.KroneckerShift
+
+namespace LnFloorCert
+open LnPoly
+
+set_option maxRecDepth 100000
+
+theorem ltUp_cell01 : checkCoverK kB certLtUpLit 39982534672164782411896871714 40150853919271982033591711249
+    [168319247107199621694839535] = true := by
+  decide +kernel
+
+end LnFloorCert
diff --git a/formal/ln/LnProof/LnProof/FloorCertLtUpC02.lean b/formal/ln/LnProof/LnProof/FloorCertLtUpC02.lean
new file mode 100644
index 000000000..16c726677
--- /dev/null
+++ b/formal/ln/LnProof/LnProof/FloorCertLtUpC02.lean
@@ -0,0 +1,13 @@
+import LnProof.FloorCertLit
+import LnProof.KroneckerShift
+
+namespace LnFloorCert
+open LnPoly
+
+set_option maxRecDepth 100000
+
+theorem ltUp_cell02 : checkCoverK kB certLtUpLit 40150853919271982033591711250 40205001758610997159114444920
+    [54147839339015125522733670] = true := by
+  decide +kernel
+
+end LnFloorCert
diff --git a/formal/ln/LnProof/LnProof/FloorCertLtUpC03.lean b/formal/ln/LnProof/LnProof/FloorCertLtUpC03.lean
new file mode 100644
index 000000000..2a33cd7a3
--- /dev/null
+++ b/formal/ln/LnProof/LnProof/FloorCertLtUpC03.lean
@@ -0,0 +1,13 @@
+import LnProof.FloorCertLit
+import LnProof.KroneckerShift
+
+namespace LnFloorCert
+open LnPoly
+
+set_option maxRecDepth 100000
+
+theorem ltUp_cell03 : checkCoverK kB certLtUpLit 40205001758610997159114444921 40233125195560580626250736677
+    [28123436949583467136291756] = true := by
+  decide +kernel
+
+end LnFloorCert
diff --git a/formal/ln/LnProof/LnProof/FloorCertLtUpC04.lean b/formal/ln/LnProof/LnProof/FloorCertLtUpC04.lean
new file mode 100644
index 000000000..ba507497e
--- /dev/null
+++ b/formal/ln/LnProof/LnProof/FloorCertLtUpC04.lean
@@ -0,0 +1,13 @@
+import LnProof.FloorCertLit
+import LnProof.KroneckerShift
+
+namespace LnFloorCert
+open LnPoly
+
+set_option maxRecDepth 100000
+
+theorem ltUp_cell04 : checkCoverK kB certLtUpLit 40233125195560580626250736678 40277017559452910144135999239
+    [43892363892329517885262561] = true := by
+  decide +kernel
+
+end LnFloorCert
diff --git a/formal/ln/LnProof/LnProof/FloorCertLtUpC05.lean b/formal/ln/LnProof/LnProof/FloorCertLtUpC05.lean
new file mode 100644
index 000000000..fc13d8106
--- /dev/null
+++ b/formal/ln/LnProof/LnProof/FloorCertLtUpC05.lean
@@ -0,0 +1,13 @@
+import LnProof.FloorCertLit
+import LnProof.KroneckerShift
+
+namespace LnFloorCert
+open LnPoly
+
+set_option maxRecDepth 100000
+
+theorem ltUp_cell05 : checkCoverK kB certLtUpLit 40277017559452910144135999240 41692588105644715585450931157
+    [1415570546191805441314931917] = true := by
+  decide +kernel
+
+end LnFloorCert
diff --git a/formal/ln/LnProof/LnProof/FloorCertLtUpC06.lean b/formal/ln/LnProof/LnProof/FloorCertLtUpC06.lean
new file mode 100644
index 000000000..f872571a6
--- /dev/null
+++ b/formal/ln/LnProof/LnProof/FloorCertLtUpC06.lean
@@ -0,0 +1,13 @@
+import LnProof.FloorCertLit
+import LnProof.KroneckerShift
+
+namespace LnFloorCert
+open LnPoly
+
+set_option maxRecDepth 100000
+
+theorem ltUp_cell06 : checkCoverK kB certLtUpLit 41692588105644715585450931158 42015714968624513035526540308
+    [323126862979797450075609150] = true := by
+  decide +kernel
+
+end LnFloorCert
diff --git a/formal/ln/LnProof/LnProof/FloorCertLtUpC07.lean b/formal/ln/LnProof/LnProof/FloorCertLtUpC07.lean
new file mode 100644
index 000000000..b897f90f6
--- /dev/null
+++ b/formal/ln/LnProof/LnProof/FloorCertLtUpC07.lean
@@ -0,0 +1,13 @@
+import LnProof.FloorCertLit
+import LnProof.KroneckerShift
+
+namespace LnFloorCert
+open LnPoly
+
+set_option maxRecDepth 100000
+
+theorem ltUp_cell07 : checkCoverK kB certLtUpLit 42015714968624513035526540309 42105566798542397566218396417
+    [89851829917884530691856108] = true := by
+  decide +kernel
+
+end LnFloorCert
diff --git a/formal/ln/LnProof/LnProof/FloorCertLtUpC08.lean b/formal/ln/LnProof/LnProof/FloorCertLtUpC08.lean
new file mode 100644
index 000000000..b2b215391
--- /dev/null
+++ b/formal/ln/LnProof/LnProof/FloorCertLtUpC08.lean
@@ -0,0 +1,13 @@
+import LnProof.FloorCertLit
+import LnProof.KroneckerShift
+
+namespace LnFloorCert
+open LnPoly
+
+set_option maxRecDepth 100000
+
+theorem ltUp_cell08 : checkCoverK kB certLtUpLit 42105566798542397566218396418 42244228633829548558923780243
+    [138661835287150992705383825] = true := by
+  decide +kernel
+
+end LnFloorCert
diff --git a/formal/ln/LnProof/LnProof/FloorCertLtUpC09.lean b/formal/ln/LnProof/LnProof/FloorCertLtUpC09.lean
new file mode 100644
index 000000000..96ed1317d
--- /dev/null
+++ b/formal/ln/LnProof/LnProof/FloorCertLtUpC09.lean
@@ -0,0 +1,13 @@
+import LnProof.FloorCertLit
+import LnProof.KroneckerShift
+
+namespace LnFloorCert
+open LnPoly
+
+set_option maxRecDepth 100000
+
+theorem ltUp_cell09 : checkCoverK kB certLtUpLit 42244228633829548558923780244 44761589464445247665450168506
+    [2517360830615699106526388262] = true := by
+  decide +kernel
+
+end LnFloorCert
diff --git a/formal/ln/LnProof/LnProof/FloorCertLtUpC10.lean b/formal/ln/LnProof/LnProof/FloorCertLtUpC10.lean
new file mode 100644
index 000000000..3af244c54
--- /dev/null
+++ b/formal/ln/LnProof/LnProof/FloorCertLtUpC10.lean
@@ -0,0 +1,13 @@
+import LnProof.FloorCertLit
+import LnProof.KroneckerShift
+
+namespace LnFloorCert
+open LnPoly
+
+set_option maxRecDepth 100000
+
+theorem ltUp_cell10 : checkCoverK kB certLtUpLit 44761589464445247665450168507 45182237044145709221717782607
+    [420647579700461556267614100] = true := by
+  decide +kernel
+
+end LnFloorCert
diff --git a/formal/ln/LnProof/LnProof/FloorCertLtUpC11.lean b/formal/ln/LnProof/LnProof/FloorCertLtUpC11.lean
new file mode 100644
index 000000000..fe756c7e9
--- /dev/null
+++ b/formal/ln/LnProof/LnProof/FloorCertLtUpC11.lean
@@ -0,0 +1,13 @@
+import LnProof.FloorCertLit
+import LnProof.KroneckerShift
+
+namespace LnFloorCert
+open LnPoly
+
+set_option maxRecDepth 100000
+
+theorem ltUp_cell11 : checkCoverK kB certLtUpLit 45182237044145709221717782608 45358461709730537512255462320
+    [176224665584828290537679712] = true := by
+  decide +kernel
+
+end LnFloorCert
diff --git a/formal/ln/LnProof/LnProof/FloorCertLtUpC12.lean b/formal/ln/LnProof/LnProof/FloorCertLtUpC12.lean
new file mode 100644
index 000000000..a69bc22bc
--- /dev/null
+++ b/formal/ln/LnProof/LnProof/FloorCertLtUpC12.lean
@@ -0,0 +1,13 @@
+import LnProof.FloorCertLit
+import LnProof.KroneckerShift
+
+namespace LnFloorCert
+open LnPoly
+
+set_option maxRecDepth 100000
+
+theorem ltUp_cell12 : checkCoverK kB certLtUpLit 45358461709730537512255462321 49100624827436726252807356861
+    [3742163117706188740551894540] = true := by
+  decide +kernel
+
+end LnFloorCert
diff --git a/formal/ln/LnProof/LnProof/FloorCertLtUpC13.lean b/formal/ln/LnProof/LnProof/FloorCertLtUpC13.lean
new file mode 100644
index 000000000..d00310de8
--- /dev/null
+++ b/formal/ln/LnProof/LnProof/FloorCertLtUpC13.lean
@@ -0,0 +1,13 @@
+import LnProof.FloorCertLit
+import LnProof.KroneckerShift
+
+namespace LnFloorCert
+open LnPoly
+
+set_option maxRecDepth 100000
+
+theorem ltUp_cell13 : checkCoverK kB certLtUpLit 49100624827436726252807356862 49670427525155949284453311469
+    [569802697719223031645954607] = true := by
+  decide +kernel
+
+end LnFloorCert
diff --git a/formal/ln/LnProof/LnProof/FloorCertLtUpC14.lean b/formal/ln/LnProof/LnProof/FloorCertLtUpC14.lean
new file mode 100644
index 000000000..504eef27d
--- /dev/null
+++ b/formal/ln/LnProof/LnProof/FloorCertLtUpC14.lean
@@ -0,0 +1,13 @@
+import LnProof.FloorCertLit
+import LnProof.KroneckerShift
+
+namespace LnFloorCert
+open LnPoly
+
+set_option maxRecDepth 100000
+
+theorem ltUp_cell14 : checkCoverK kB certLtUpLit 49670427525155949284453311470 56022770974786139918731938181
+    [6352343449630190634278626711] = true := by
+  decide +kernel
+
+end LnFloorCert
diff --git a/formal/ln/LnProof/LnProof/FloorConsts.lean b/formal/ln/LnProof/LnProof/FloorConsts.lean
new file mode 100644
index 000000000..121e857af
--- /dev/null
+++ b/formal/ln/LnProof/LnProof/FloorConsts.lean
@@ -0,0 +1,69 @@
+import LnProof.ExpSum
+import LnProof.Stages
+
+/-!
+# Constant-piece exponential caps
+
+Every exponent in the floor-specification assembly is an integer multiple
+of `1/(10^27 2^99)`: the model's quotient contributes `X1/2^99`, the
+exponent word contributes `k LN2c/(2^72 10^27)`, and the bias contributes
+`BIASc/(2^72 10^27)`. This file pins two-sided caps for the two constant
+pieces and a lower cap for one output ulp, each by a single kernel-checked
+partial sum (`capUB_of_partial` carries the geometric tail).
+-/
+
+set_option maxRecDepth 8192
+
+namespace LnFloor
+
+open LnExp LnGeneratedModel
+
+/-- Common denominator of every exponent argument. -/
+def QS : Nat := 10 ^ 27 * 2 ^ 99
+
+theorem QS_pos : 0 < QS := by decide
+
+/-- `e^(LN2c 2^27 / QS) ≤ 2 (1 + 1e-40)`: the scaled `ln 2` constant. -/
+theorem cap2U : capUB (LN2c * 2 ^ 27) QS (2 * (10 ^ 40 + 1)) (10 ^ 40) := by
+  refine capUB_of_partial (K := 40) QS_pos (by decide) ?_
+  decide
+
+/-- `e^(LN2c 2^27 / QS) ≥ 2 (1 - 1e-40)`. -/
+theorem cap2L : capLB (LN2c * 2 ^ 27) QS (2 * (10 ^ 40 - 1)) (10 ^ 40) :=
+  ⟨40, by decide⟩
+
+/-- `e^(BIASc 2^27 / QS) ≤ (S/10^18)(1 - 3.402e-28)`: the bias keeps almost
+all of its 0.3403-ulp margin through the cap. -/
+theorem capBU : capUB (BIASc * 2 ^ 27) QS (Sc * (10 ^ 31 - 3402))
+    (10 ^ 18 * 10 ^ 31) := by
+  refine capUB_of_partial (K := 130) QS_pos (by decide) ?_
+  decide
+
+/-- `e^(BIASc 2^27 / QS) ≥ (S/10^18)(1 - 3.404e-28)`. -/
+theorem capBL : capLB (BIASc * 2 ^ 27) QS (Sc * (10 ^ 31 - 3404))
+    (10 ^ 18 * 10 ^ 31) :=
+  ⟨130, by decide⟩
+
+/-- `e^(2^99/QS) = e^(1e-27) ≥ 1 + 0.999e-27`: one output ulp. -/
+theorem capEL : capLB (2 ^ 99) QS (10 ^ 31 + 9990) (10 ^ 31) :=
+  ⟨3, by decide⟩
+
+/-- Exact signed value of the `ln2 * k` word for every `clz` value. -/
+def ln2kExact (c : Nat) : Bool :=
+  decide (toInt (evmMul LN2c (evmSub 160 c)) =
+    if c ≤ 160 then (LN2c : Int) * ((160 - c : Nat) : Int)
+    else -((LN2c : Int) * ((c - 160 : Nat) : Int)))
+
+theorem ln2k_exact_all : (List.range 256).all ln2kExact = true := by decide
+
+theorem ln2k_exact {c : Nat} (hc : c < 256) :
+    toInt (evmMul LN2c (evmSub 160 c)) =
+      if c ≤ 160 then (LN2c : Int) * ((160 - c : Nat) : Int)
+      else -((LN2c : Int) * ((c - 160 : Nat) : Int)) := by
+  have h := ln2k_exact_all
+  rw [List.all_eq_true] at h
+  have hm := h c (List.mem_range.mpr hc)
+  rw [ln2kExact, decide_eq_true_eq] at hm
+  exact hm
+
+end LnFloor
diff --git a/formal/ln/LnProof/LnProof/FloorModel.lean b/formal/ln/LnProof/LnProof/FloorModel.lean
new file mode 100644
index 000000000..b1885633b
--- /dev/null
+++ b/formal/ln/LnProof/LnProof/FloorModel.lean
@@ -0,0 +1,143 @@
+import LnProof.TopMono
+import LnProof.FloorConsts
+
+/-!
+# Model-side decomposition for the floor specification
+
+For a non-corrected input (`x ≠ 10^18`), the model's output word `r`
+satisfies `r 2^72 ≤ V < (r+1) 2^72` where
+`V = X1 Kc + ln2k(clz x) + BIASc` is the exact pre-shift accumulator.
+This is the bridge from the EVM word pipeline to the exponential-cap
+arithmetic: dividing by `2^72 · 10^27` turns `V` into the sum of exponent
+arguments handled by the caps of `LnProof.FloorConsts`.
+-/
+
+set_option maxRecDepth 4096
+
+namespace LnFloor
+
+open LnGeneratedModel LnPoly
+
+/-- Mantissa word of `x`. -/
+def mant (x : Nat) : Nat := evmShr 160 (evmShl (evmClz x) x)
+
+/-- Signed `ln2 * k` summand for clz value `c`. -/
+def ln2kInt (c : Nat) : Int :=
+  if c ≤ 160 then (LN2c : Int) * ((160 - c : Nat) : Int)
+  else -((LN2c : Int) * ((c - 160 : Nat) : Int))
+
+theorem ln2kInt_eq {c : Nat} (hc : c < 256) :
+    toInt (evmMul LN2c (evmSub 160 c)) = ln2kInt c :=
+  ln2k_exact hc
+
+theorem ln2kInt_bound {c : Nat} (hc : c < 256) :
+    -(310963026251328585646059498617736427643747124513200 : Int) ≤ ln2kInt c ∧
+      ln2kInt c ≤ (523727202107500775824942313461450825505258314969600 : Int) := by
+  rw [← ln2kInt_eq hc]
+  exact ln2k_bound hc
+
+/-- The pre-shift accumulator decomposes exactly. -/
+theorem r4_value {m : Nat} (h1 : MLO ≤ m) (h2 : m < MHI) {c : Nat} (hc : c < 256) :
+    toInt (evmAdd (evmAdd (evmMul (x1W (zWord m)) Kc) (evmMul LN2c (evmSub 160 c)))
+        BIASc) =
+      toInt (x1W (zWord m)) * 7450580596923828125 + ln2kInt c +
+        116873961749927929127912020551506849476088469858172 := by
+  have hB := r1_bound h1 h2
+  have hr1w : x1W (zWord m) < 2 ^ 256 := by unfold x1W; exact evmSdiv_lt _ _
+  have hW := ln2k_bound hc
+  generalize hg : x1W (zWord m) = r1w at *
+  have hKlt : Kc < 2 ^ 256 := by simp only [Kc]; omega
+  have hKc : toInt Kc = (7450580596923828125 : Int) := by
+    rw [toInt_of_lt (by simp only [Kc]; omega)]
+    simp only [Kc]
+    omega
+  have e2 : toInt (evmMul r1w Kc) = toInt r1w * toInt Kc :=
+    evmMul_transport (a := r1w) (b := Kc) hr1w hKlt
+      (by rw [hKc]; simp only [ipow255]; omega)
+      (by rw [hKc]; simp only [ipow255]; omega)
+  rw [hKc] at e2
+  have e3 : toInt (evmAdd (evmMul r1w Kc) (evmMul LN2c (evmSub 160 c))) =
+      toInt (evmMul r1w Kc) + toInt (evmMul LN2c (evmSub 160 c)) :=
+    evmAdd_transport (a := evmMul r1w Kc) (b := evmMul LN2c (evmSub 160 c))
+      (evmMul_lt _ _) (evmMul_lt _ _)
+      (by rw [e2]; clear e2 hKc hKlt; simp only [ipow255]; omega)
+      (by rw [e2]; clear e2 hKc hKlt; simp only [ipow255]; omega)
+  have hBIlt : BIASc < 2 ^ 256 := by simp only [BIASc]; omega
+  have hBI : toInt BIASc = (116873961749927929127912020551506849476088469858172 : Int) := by
+    rw [toInt_of_lt (by simp only [BIASc]; omega)]
+    simp only [BIASc]
+    omega
+  have e4 : toInt (evmAdd (evmAdd (evmMul r1w Kc) (evmMul LN2c (evmSub 160 c))) BIASc) =
+      toInt (evmAdd (evmMul r1w Kc) (evmMul LN2c (evmSub 160 c))) + toInt BIASc :=
+    evmAdd_transport (a := evmAdd (evmMul r1w Kc) (evmMul LN2c (evmSub 160 c)))
+      (b := BIASc) (evmAdd_lt _ _) hBIlt
+      (by rw [e3, e2, hBI]; clear e2 e3 hKc hKlt hBI hBIlt; simp only [ipow255]; omega)
+      (by rw [e3, e2, hBI]; clear e2 e3 hKc hKlt hBI hBIlt; simp only [ipow255]; omega)
+  rw [e4, e3, e2, hBI, ← ln2kInt_eq hc]
+
+/-- The corrected model is nonzero away from `10^18`: monotonicity pins it
+strictly negative below `10^18` (it is `≤ lnWad(10^18 - 1) < 0`) and strictly
+positive above (it is `≥ lnWad(10^18 + 1) > 0`). The two neighbour values are
+decided directly. -/
+theorem model_ne_zero {x : Nat} (h1 : 1 ≤ x) (h2 : x < 2 ^ 255)
+    (hne : x ≠ 1000000000000000000) : toInt (model_ln_wad_evm x) ≠ 0 := by
+  rcases Nat.lt_trichotomy x 1000000000000000000 with hlt | heq | hgt
+  · have hmono := toInt_of_sle (model_lt (by omega)) (model_lt (by omega))
+      (model_ln_wad_mono h1 (by omega : x ≤ 999999999999999999) (by decide))
+    have hlo : toInt (model_ln_wad_evm 999999999999999999) < 0 := by decide +kernel
+    omega
+  · exact absurd heq hne
+  · have hmono := toInt_of_sle (model_lt (by omega)) (model_lt (by omega))
+      (model_ln_wad_mono (by omega : 0 < 1000000000000000001)
+        (by omega : 1000000000000000001 ≤ x) h2)
+    have hhi : 0 < toInt (model_ln_wad_evm 1000000000000000001) := by decide +kernel
+    omega
+
+/-- For non-corrected inputs the model word floors the accumulator:
+`r 2^72 ≤ V < (r + 1) 2^72`. -/
+theorem model_floor_bracket {x : Nat} (h1 : 1 ≤ x) (h2 : x < 2 ^ 255)
+    (hne : x ≠ 1000000000000000000) :
+    toInt (model_ln_wad_evm x) * 4722366482869645213696 ≤
+        toInt (x1W (zWord (mant x))) * 7450580596923828125 + ln2kInt (evmClz x) +
+          116873961749927929127912020551506849476088469858172 ∧
+      toInt (x1W (zWord (mant x))) * 7450580596923828125 + ln2kInt (evmClz x) +
+          116873961749927929127912020551506849476088469858172 <
+        toInt (model_ln_wad_evm x) * 4722366482869645213696 +
+          4722366482869645213696 := by
+  have hx256 : x < 2 ^ 256 := by omega
+  have hc : evmClz x < 256 := by
+    rw [evmClz_eq h1 hx256]
+    omega
+  obtain ⟨me, mlo, mhi⟩ := mant_facts h1 h2
+  have hmant : MLO ≤ mant x ∧ mant x < MHI := by
+    unfold mant
+    rw [me]
+    exact ⟨mlo, mhi⟩
+  have hr4 := r4_value hmant.1 hmant.2 hc
+  have hsarlt : evmSar 72 (evmAdd (evmAdd (evmMul (x1W (zWord (mant x))) Kc)
+      (evmMul LN2c (evmSub 160 (evmClz x)))) BIASc) < 2 ^ 256 :=
+    (evmSar_sandwich_72 (evmAdd_lt _ _)).1
+  -- The model is the self-corrected floor `s + (s == -1)`; off `10^18` it is `s`.
+  have hmc : model_ln_wad_evm x =
+      evmAdd (evmIszero (evmNot (evmSar 72 (evmAdd (evmAdd (evmMul (x1W (zWord (mant x))) Kc)
+        (evmMul LN2c (evmSub 160 (evmClz x)))) BIASc))))
+      (evmSar 72 (evmAdd (evmAdd (evmMul (x1W (zWord (mant x))) Kc)
+        (evmMul LN2c (evmSub 160 (evmClz x)))) BIASc)) := by
+    rw [model_eq_tail hx256]; rfl
+  have hsne : evmSar 72 (evmAdd (evmAdd (evmMul (x1W (zWord (mant x))) Kc)
+      (evmMul LN2c (evmSub 160 (evmClz x)))) BIASc) ≠ 2 ^ 256 - 1 := by
+    intro hs
+    apply model_ne_zero h1 h2 hne
+    rw [hmc, hs]; decide
+  have hmodel : model_ln_wad_evm x =
+      evmSar 72 (evmAdd (evmAdd (evmMul (x1W (zWord (mant x))) Kc)
+        (evmMul LN2c (evmSub 160 (evmClz x)))) BIASc) := by
+    rw [hmc, corr_eq hsarlt, if_neg hsne]
+  obtain ⟨wlt, s1, s2⟩ := evmSar_sandwich_72 (evmAdd_lt
+    (evmAdd (evmMul (x1W (zWord (mant x))) Kc)
+      (evmMul LN2c (evmSub 160 (evmClz x)))) BIASc)
+  rw [hmodel]
+  rw [hr4] at s1 s2
+  exact ⟨s1, s2⟩
+
+end LnFloor
diff --git a/formal/ln/LnProof/LnProof/FloorSpec.lean b/formal/ln/LnProof/LnProof/FloorSpec.lean
new file mode 100644
index 000000000..303b11243
--- /dev/null
+++ b/formal/ln/LnProof/LnProof/FloorSpec.lean
@@ -0,0 +1,349 @@
+import LnProof.FloorAssembly
+
+/-!
+# The floor-cut specification of the `lnWad` model
+
+Top-line cut statement: for every input `1 ≤ x < 2^255`, the model output
+`r` satisfies the two exponential-cut predicates that correspond to
+`r ≤ 10^27·ln(x/10^18) < r + 2` under the standard real interpretation.
+
+The two sides are arithmetized without real numbers through the
+partial sums `S_N(t) = Σ_{j≤N} t^j/j!` of the exponential, using
+the Taylor-cut interface from `LnProof.ExpSum`:
+
+* `FloorSpecA` says `e^(r/10^27) ≤ x/10^18` (for negative `r`, the
+  reciprocal form `e^(|r|/10^27) ≥ 10^18/x`), corresponding to
+  `r ≤ 10^27·ln(x/10^18)`.
+* `FloorSpecB` says `x/10^18 < e^((r+2)/10^27)` with one part in
+  `10^30` of strictness margin (reciprocal form for `r + 2 ≤ 0`),
+  corresponding to `10^27·ln(x/10^18) < r + 2`.
+
+Both are `capUB`/`capLB` statements over `QS = 10^27·2^99`: a `capUB`
+is a `∀ N` bound on every integer-scaled partial sum, a `capLB` exhibits
+one witness partial sum. `LnProof.ExpLogCutSpec` packages these predicates
+as an explicit log-cut specification.
+-/
+
+namespace LnFloorCert
+open LnGeneratedModel LnPoly LnExp LnFloor
+
+-- The self-corrected model term repeats the accumulator (the `s == -1` test
+-- reads the shifted result), so elaboration-time `whnf` of it is expensive.
+-- Keep it opaque here; the `decide +kernel` facts below still reduce it in the
+-- kernel, which ignores this hint.
+attribute [local irreducible] model_ln_wad_evm model_ln_wad_to_wad_evm
+
+set_option maxRecDepth 4096
+
+/-- `r ≤ 10^27·ln(x/10^18)`, arithmetized. -/
+def FloorSpecA (r : Int) (x : Nat) : Prop :=
+  if 0 ≤ r then
+    capUB (r.toNat * 2 ^ 99) QS x (10 ^ 18)
+  else
+    capLB ((-r).toNat * 2 ^ 99) QS (10 ^ 18) x
+
+/-- `10^27·ln(x/10^18) < r + 2`, arithmetized with `1/10^30` slack. -/
+def FloorSpecB (r : Int) (x : Nat) : Prop :=
+  if -1 ≤ r then
+    capLB ((r + 2).toNat * 2 ^ 99) QS (x * 10 ^ 31) (10 ^ 18 * (10 ^ 31 - 10))
+  else
+    capUB ((-(r + 2)).toNat * 2 ^ 99) QS (10 ^ 18 * (10 ^ 31 - 10)) (x * 10 ^ 31)
+
+/-! ## Small pieces -/
+
+theorem expNum_zero (q : Nat) : ∀ n, expNum n 0 q = fact n * q ^ n := by
+  intro n
+  induction n with
+  | zero => rfl
+  | succ k ih =>
+    show (k + 1) * q * expNum k 0 q + 0 ^ (k + 1) = fact (k + 1) * q ^ (k + 1)
+    rw [ih]
+    have h0 : (0 : Nat) ^ (k + 1) = 0 := Nat.zero_pow (by omega)
+    rw [h0]
+    show (k + 1) * q * (fact k * q ^ k) + 0 = (k + 1) * fact k * q ^ (k + 1)
+    have e : q ^ (k + 1) = q ^ k * q := Nat.pow_succ _ _
+    rw [e]
+    simp only [Nat.mul_assoc, Nat.mul_comm, Nat.mul_left_comm]
+    omega
+
+theorem capUB_diag {q y : Nat} (_hq : 0 < q) : capUB 0 q y y := by
+  intro n
+  rw [expNum_zero]
+  have e : fact n * q ^ n * y = y * (fact n * q ^ n) := Nat.mul_comm _ _
+  omega
+
+/-- The model maps the wad exactly to zero. -/
+theorem model_at_wad : toInt (model_ln_wad_evm 1000000000000000000) = 0 := by
+  decide +kernel
+
+/-- Binade window for the mantissa, low-shift side. -/
+theorem mant_window_le {x : Nat} (h1 : 1 ≤ x) (h2 : x < 2 ^ 255)
+    (hc : evmClz x ≤ 160) :
+    mant x * 2 ^ (160 - evmClz x) ≤ x ∧ x < (mant x + 1) * 2 ^ (160 - evmClz x) := by
+  obtain ⟨me, _, _⟩ := mant_facts h1 h2
+  have hclz : evmClz x = 255 - Nat.log2 x := evmClz_eq h1 (by omega)
+  have hm : mant x = x * 2 ^ (255 - Nat.log2 x) / 2 ^ 160 := me
+  rw [hclz] at hc ⊢
+  have hdm := Nat.div_add_mod (x * 2 ^ (255 - Nat.log2 x)) (2 ^ 160)
+  have hml := Nat.mod_lt (x * 2 ^ (255 - Nat.log2 x)) (y := 2 ^ 160) (by decide)
+  have hsplit : 2 ^ (255 - Nat.log2 x) * 2 ^ (160 - (255 - Nat.log2 x)) = 2 ^ 160 := by
+    rw [← Nat.pow_add]
+    congr 1
+    omega
+  rw [hm]
+  generalize hgq : x * 2 ^ (255 - Nat.log2 x) / 2 ^ 160 = q at *
+  generalize hgA : (2 : Nat) ^ (255 - Nat.log2 x) = A at *
+  generalize hgB : (2 : Nat) ^ (160 - (255 - Nat.log2 x)) = B at *
+  have hA0 : 0 < A := by rw [← hgA]; exact Nat.pow_pos (by omega)
+  constructor
+  · refine Nat.le_of_mul_le_mul_left ?_ hA0
+    have e1 : A * (q * B) = 2 ^ 160 * q := by
+      rw [show A * (q * B) = q * (A * B) from by
+        simp only [Nat.mul_left_comm], hsplit]
+      exact Nat.mul_comm _ _
+    have e2 : A * x = x * A := Nat.mul_comm _ _
+    generalize hg1 : A * (q * B) = T1 at e1 ⊢
+    generalize hg3 : A * x = T3 at e2 ⊢
+    generalize hg4 : x * A = T4 at e2 hdm
+    generalize hg5 : 2 ^ 160 * q = T5 at e1 hdm
+    omega
+  · have hlt : x * A < (q + 1) * 2 ^ 160 := by
+      have e : (q + 1) * 2 ^ 160 = 2 ^ 160 * q + 2 ^ 160 := by
+        rw [Nat.add_mul, Nat.one_mul, Nat.mul_comm]
+      omega
+    refine Nat.lt_of_mul_lt_mul_left (a := A) ?_
+    have e1 : A * x = x * A := Nat.mul_comm _ _
+    have e2 : A * ((q + 1) * B) = (q + 1) * 2 ^ 160 := by
+      rw [show A * ((q + 1) * B) = (q + 1) * (A * B) from by
+        simp only [Nat.mul_assoc, Nat.mul_comm], hsplit]
+    generalize hg1 : A * x = T1 at e1 ⊢
+    generalize hg2 : x * A = T2 at e1 hlt
+    generalize hg3 : A * ((q + 1) * B) = T3 at e2 ⊢
+    generalize hg5 : (q + 1) * 2 ^ 160 = T5 at e2 hlt
+    omega
+
+/-- Binade window, high-shift side: the mantissa is exact. -/
+theorem mant_window_gt {x : Nat} (h1 : 1 ≤ x) (h2 : x < 2 ^ 255)
+    (hc : 160 < evmClz x) :
+    mant x = x * 2 ^ (evmClz x - 160) := by
+  obtain ⟨me, _, _⟩ := mant_facts h1 h2
+  have hclz : evmClz x = 255 - Nat.log2 x := evmClz_eq h1 (by omega)
+  have hm : mant x = x * 2 ^ (255 - Nat.log2 x) / 2 ^ 160 := me
+  rw [hclz] at hc ⊢
+  have hsplit : (2 : Nat) ^ (255 - Nat.log2 x) =
+      2 ^ 160 * 2 ^ ((255 - Nat.log2 x) - 160) := by
+    rw [← Nat.pow_add]
+    congr 1
+    omega
+  rw [hm, hsplit]
+  have e : x * (2 ^ 160 * 2 ^ ((255 - Nat.log2 x) - 160)) =
+      x * 2 ^ ((255 - Nat.log2 x) - 160) * 2 ^ 160 := by
+    simp only [Nat.mul_comm, Nat.mul_left_comm]
+  rw [e]
+  exact Nat.mul_div_cancel _ (by decide)
+
+theorem clz_bounds {x : Nat} (h1 : 1 ≤ x) (h2 : x < 2 ^ 255) :
+    1 ≤ evmClz x ∧ evmClz x ≤ 255 := by
+  have hclz : evmClz x = 255 - Nat.log2 x := evmClz_eq h1 (by omega)
+  have hlog : Nat.log2 x < 255 := (Nat.log2_lt (by omega)).mpr (by omega)
+  omega
+
+/-- On the `m ≥ S` branch with a nonnegative shift, the accumulator is
+positive, so the output cannot be negative. -/
+theorem v_pos_ge_pos {m c : Nat} (h1 : Sc ≤ m) (h2 : m < MHI) (hc : c ≤ 160) :
+    0 ≤ toInt (x1W (zWord m)) * 7450580596923828125 + ln2kInt c +
+      116873961749927929127912020551506849476088469858172 := by
+  have hX1 := x1_nonneg_geF h1 h2
+  have hx0 : 0 ≤ toInt (x1W (zWord m)) * 7450580596923828125 :=
+    Int.mul_nonneg hX1 (by omega)
+  have hl : 0 ≤ ln2kInt c := by
+    unfold ln2kInt
+    rw [if_pos hc]
+    exact Int.mul_nonneg (by omega) (Int.natCast_nonneg _)
+  generalize toInt (x1W (zWord m)) * 7450580596923828125 = X at hx0 ⊢
+  omega
+
+/-! ## The theorem -/
+
+/-- **Floor specification.** For every `1 ≤ x < 2^255` the model output
+`r` satisfies `r ≤ 10^27·ln(x/10^18) < r + 2`: the model computes
+`⌊10^27·ln(x/10^18)⌋` exactly or one less. -/
+theorem model_ln_wad_floor {x : Nat} (h1 : 1 ≤ x) (h2 : x < 2 ^ 255) :
+    FloorSpecA (toInt (model_ln_wad_evm x)) x ∧
+      FloorSpecB (toInt (model_ln_wad_evm x)) x := by
+  by_cases hne : x = 1000000000000000000
+  · subst hne
+    rw [model_at_wad]
+    constructor
+    · show FloorSpecA 0 1000000000000000000
+      unfold FloorSpecA
+      rw [if_pos (by omega)]
+      show capUB ((0 : Int).toNat * 2 ^ 99) QS 1000000000000000000 (10 ^ 18)
+      have e : (0 : Int).toNat * 2 ^ 99 = 0 := by decide
+      rw [e]
+      exact capUB_diag QS_pos
+    · show FloorSpecB 0 1000000000000000000
+      unfold FloorSpecB
+      rw [if_pos (by omega)]
+      exact ⟨1, by decide +kernel⟩
+  · obtain ⟨hbr1, hbr2⟩ := model_floor_bracket h1 h2 hne
+    rw [show (4722366482869645213696 : Int) = 2 ^ 72 from by decide] at hbr1 hbr2
+    have hbr2' : toInt (x1W (zWord (mant x))) * 7450580596923828125 +
+        ln2kInt (evmClz x) + 116873961749927929127912020551506849476088469858172 <
+        (toInt (model_ln_wad_evm x) + 1) * 2 ^ 72 := by
+      have e : (toInt (model_ln_wad_evm x) + 1) * 2 ^ 72 =
+          toInt (model_ln_wad_evm x) * 2 ^ 72 + 2 ^ 72 := by
+        rw [Int.add_mul, Int.one_mul]
+      omega
+    -- Generalize the model word: it is the self-corrected floor, whose term
+    -- doubles the accumulator; keeping it opaque avoids reducing it below.
+    revert hbr1 hbr2'
+    generalize toInt (model_ln_wad_evm x) = R
+    intro hbr1 hbr2'
+    obtain ⟨me, hmlo, hmhi⟩ := mant_facts h1 h2
+    have hmant_eq : mant x = x * 2 ^ (255 - Nat.log2 x) / 2 ^ 160 := me
+    have hmant_lo : MLO ≤ mant x := by rw [hmant_eq]; exact hmlo
+    have hmant_hi : mant x < MHI := by rw [hmant_eq]; exact hmhi
+    obtain ⟨hc1, hc255⟩ := clz_bounds h1 h2
+    rcases Nat.lt_or_ge (mant x) Sc with hbranch | hbranch
+    · -- m < S
+      rcases Nat.lt_or_ge 160 (evmClz x) with hcgt | hc
+      · have hw := mant_window_gt h1 h2 hcgt
+        constructor
+        · unfold FloorSpecA
+          rcases Int.lt_or_le R 0 with hr | hr
+          · rw [if_neg (by omega)]
+            exact an_lt_neg hmant_lo hbranch hcgt hc255 hbr1 hbr2' hr hw
+          · rw [if_pos hr]
+            exact up_lt_neg hmant_lo hbranch hcgt hc255 hbr1 hr hw
+        · unfold FloorSpecB
+          rcases Int.lt_or_le R (-1) with hr | hr
+          · rw [if_neg (by omega)]
+            exact bn_lt_neg hmant_lo hbranch hcgt hc255 hbr2' (by omega) hw
+          · rw [if_pos (by omega)]
+            exact lo_lt_neg hmant_lo hbranch hcgt hc255 hbr2' hbr1 (by omega) hw
+      · obtain ⟨hw1, hw2⟩ := mant_window_le h1 h2 hc
+        constructor
+        · unfold FloorSpecA
+          rcases Int.lt_or_le R 0 with hr | hr
+          · rw [if_neg (by omega)]
+            exact an_lt_pos hmant_lo hbranch hc1 hc hbr1 hbr2' hr hw1
+          · rw [if_pos hr]
+            exact up_lt_pos hmant_lo hbranch hc1 hc hbr1 hr hw1
+        · unfold FloorSpecB
+          rcases Int.lt_or_le R (-1) with hr | hr
+          · rw [if_neg (by omega)]
+            exact bn_lt_pos hmant_lo hbranch hc1 hc hbr2' (by omega) hw2
+          · rw [if_pos (by omega)]
+            exact lo_lt_pos hmant_lo hbranch hc1 hc hbr2' hbr1 (by omega) hw2
+    · -- m ≥ S
+      rcases Nat.lt_or_ge 160 (evmClz x) with hcgt | hc
+      · have hw := mant_window_gt h1 h2 hcgt
+        constructor
+        · unfold FloorSpecA
+          rcases Int.lt_or_le R 0 with hr | hr
+          · rw [if_neg (by omega)]
+            exact an_ge_neg hbranch hmant_hi hcgt hc255 hbr1 hbr2' hr hw
+          · rw [if_pos hr]
+            exact up_ge_neg hbranch hmant_hi hcgt hc255 hbr1 hr hw
+        · unfold FloorSpecB
+          rcases Int.lt_or_le R (-1) with hr | hr
+          · rw [if_neg (by omega)]
+            exact bn_ge_neg hbranch hmant_hi hcgt hc255 hbr2' (by omega) hw
+          · rw [if_pos (by omega)]
+            exact lo_ge_neg hbranch hmant_hi hcgt hc255 hbr2' hbr1 (by omega) hw
+      · obtain ⟨hw1, hw2⟩ := mant_window_le h1 h2 hc
+        have hVpos := v_pos_ge_pos hbranch hmant_hi hc
+        have hrpos : 0 ≤ R := by
+          rcases Int.lt_or_le R 0 with hr | hr
+          · exfalso
+            have hRle : (R + 1) * 2 ^ 72 ≤ 0 := by
+              have hle : R + 1 ≤ 0 := by omega
+              have := mul_le_mul_right_nonneg hle (show (0 : Int) ≤ 2 ^ 72 by omega)
+              generalize hgT : (R + 1) * 2 ^ 72 = T at this ⊢
+              omega
+            omega
+          · exact hr
+        constructor
+        · unfold FloorSpecA
+          rw [if_pos hrpos]
+          exact up_ge_pos hbranch hmant_hi hc1 hc hbr1 hrpos hw1
+        · unfold FloorSpecB
+          rw [if_pos (by omega)]
+          exact lo_ge_pos hbranch hmant_hi hc1 hc hbr2' (by omega) hw2
+
+/-- Floor specification for the wad-scale wrapper: the ray-scale output keeps
+the certified logarithm bracket, and the wrapper output is exactly its signed
+floor division by `10^9`. -/
+def FloorSpecToWad (ray wad : Int) (x : Nat) : Prop :=
+  FloorSpecA ray x ∧ FloorSpecB ray x ∧
+    wad * 1000000000 ≤ ray ∧ ray < (wad + 1) * 1000000000
+
+/-- **Wad floor specification.** The `lnWadToWad` model returns the signed
+floor of the certified ray-scale `lnWad` model divided by `10^9`, so the
+ray-scale floor bracket is packaged with the exact division window. -/
+theorem model_ln_wad_to_wad_floor {x : Nat} (h1 : 1 ≤ x) (h2 : x < 2 ^ 255) :
+    FloorSpecToWad (toInt (model_ln_wad_evm x))
+      (toInt (model_ln_wad_to_wad_evm x)) x := by
+  obtain ⟨ha, hb⟩ := model_ln_wad_floor h1 h2
+  obtain ⟨hlo, hhi⟩ := to_wad_floor_window (by omega : x < 2 ^ 256)
+  -- Keep both model words opaque: their terms self-correct (and the wad word
+  -- nests the ray word twice), so unifying them directly is expensive.
+  revert ha hb hlo hhi
+  generalize toInt (model_ln_wad_evm x) = R
+  generalize toInt (model_ln_wad_to_wad_evm x) = W
+  intro ha hb hlo hhi
+  exact ⟨ha, hb, hlo, hhi⟩
+
+/-- The ray-scale model output is negative exactly below one wad. -/
+theorem model_ln_wad_negative_iff {x : Nat} (h1 : 1 ≤ x) (h2 : x < 2 ^ 255) :
+    toInt (model_ln_wad_evm x) < 0 ↔ x < 10 ^ 18 := by
+  constructor
+  · intro hneg
+    rcases Nat.lt_or_ge x (10 ^ 18) with hlt | hxle
+    · exact hlt
+    · have hm := model_ln_wad_mono (x := 10 ^ 18) (y := x) (by decide) hxle h2
+      have hi := toInt_of_sle
+        (model_lt (by decide : (10 ^ 18 : Nat) < 2 ^ 256))
+        (model_lt (by omega : x < 2 ^ 256)) hm
+      have hzero : toInt (model_ln_wad_evm (10 ^ 18)) = 0 := by
+        rw [model_ln_wad_one_wad]
+        decide
+      rw [hzero] at hi
+      omega
+  · intro hx
+    rcases Int.lt_or_le (toInt (model_ln_wad_evm x)) 0 with hneg | hrnon
+    · exact hneg
+    · obtain ⟨ha, _⟩ := model_ln_wad_floor h1 h2
+      unfold FloorSpecA at ha
+      rw [if_pos hrnon] at ha
+      have h0 := ha 0
+      simp only [expNum, fact, Nat.pow_zero, Nat.mul_one, Nat.one_mul] at h0
+      omega
+
+/-- The wad-scale wrapper output is negative exactly below one wad. -/
+theorem model_ln_wad_to_wad_negative_iff {x : Nat} (h1 : 1 ≤ x) (h2 : x < 2 ^ 255) :
+    toInt (model_ln_wad_to_wad_evm x) < 0 ↔ x < 10 ^ 18 := by
+  constructor
+  · intro hneg
+    rcases Nat.lt_or_ge x (10 ^ 18) with hlt | hxle
+    · exact hlt
+    · have hm := model_ln_wad_to_wad_mono (x := 10 ^ 18) (y := x) (by decide) hxle h2
+      have hi := toInt_of_sle
+        (to_wad_lt (by decide : (10 ^ 18 : Nat) < 2 ^ 256))
+        (to_wad_lt (by omega : x < 2 ^ 256)) hm
+      have hzero : toInt (model_ln_wad_to_wad_evm (10 ^ 18)) = 0 := by
+        rw [model_ln_wad_to_wad_one_wad]
+        decide
+      rw [hzero] at hi
+      omega
+  · intro hx
+    have hrneg := (model_ln_wad_negative_iff h1 h2).mpr hx
+    obtain ⟨_, _, hlo, _⟩ := model_ln_wad_to_wad_floor h1 h2
+    rcases Int.lt_or_le (toInt (model_ln_wad_to_wad_evm x)) 0 with hwneg | hwpos
+    · exact hwneg
+    · have hprod : 0 ≤ toInt (model_ln_wad_to_wad_evm x) * 1000000000 := by
+        exact Int.mul_nonneg hwpos (by omega)
+      omega
+
+end LnFloorCert
diff --git a/formal/ln/LnProof/LnProof/FloorWindow.lean b/formal/ln/LnProof/LnProof/FloorWindow.lean
new file mode 100644
index 000000000..5dfbcd27b
--- /dev/null
+++ b/formal/ln/LnProof/LnProof/FloorWindow.lean
@@ -0,0 +1,161 @@
+import LnProof.FloorCaps
+import LnProof.FloorBudget
+import LnProof.FloorConsts
+import LnProof.FloorCertGeUp
+import LnProof.FloorCertGeLo
+import LnProof.FloorCertLtUp
+import LnProof.FloorCertLtLo
+
+/-!
+# Full-branch X1 caps
+
+The certificate rationals only bracket the pipeline outside the
+`|m - S| ≤ 45` window, where the certified ε keeps its margin. Inside
+the window the pipeline argument is within a few parts in `10^30` of
+zero, so the caps hold pointwise with room to spare; they are checked
+here by kernel evaluation of the partial-sum conditions at each of the
+91 mantissas, and combined with the certificate route into caps that
+cover each whole branch.
+-/
+
+namespace LnFloorCert
+open LnGeneratedModel LnPoly LnExp LnFloor
+
+set_option maxRecDepth 10000
+
+/-- Pointwise window check, `m = Sc + i`, `0 ≤ i ≤ 45`. -/
+def wCheckGe (i : Nat) : Bool :=
+  decide (0 ≤ toInt (x1W (zWord (Sc + i)))) &&
+  decide (2 * ((toInt (x1W (zWord (Sc + i)))).toNat * 1000000000000000000000000000) ≤
+    24 * QS) &&
+  decide ((expNum 22 ((toInt (x1W (zWord (Sc + i)))).toNat *
+      1000000000000000000000000000) QS * (23 * QS) +
+      2 * ((toInt (x1W (zWord (Sc + i)))).toNat * 1000000000000000000000000000) ^ 23) *
+      560227709747861399187319382270000000000000000000000000000000 ≤
+    (Sc + i) * 10000000000000000000000000003401 * (fact 23 * QS ^ 23)) &&
+  decide ((Sc + i) * 9999999999999999999999999996599 * (fact 22 * QS ^ 22) ≤
+    expNum 22 ((toInt (x1W (zWord (Sc + i)))).toNat * 1000000000000000000000000000) QS *
+      560227709747861399187319382270000000000000000000000000000000)
+
+/-- Pointwise window check, `m = Sc - 45 + i`, `0 ≤ i ≤ 44`. -/
+def wCheckLt (i : Nat) : Bool :=
+  decide (toInt (x1W (zWord (Sc - 45 + i))) ≤ 0) &&
+  decide (2 * ((-toInt (x1W (zWord (Sc - 45 + i)))).toNat *
+    1000000000000000000000000000) ≤ 24 * QS) &&
+  decide ((expNum 22 ((-toInt (x1W (zWord (Sc - 45 + i)))).toNat *
+      1000000000000000000000000000) QS * (23 * QS) +
+      2 * ((-toInt (x1W (zWord (Sc - 45 + i)))).toNat *
+        1000000000000000000000000000) ^ 23) *
+      ((Sc - 45 + i) * 9999999999999999999999999996599) ≤
+    560227709747861399187319382270000000000000000000000000000000 *
+      (fact 23 * QS ^ 23)) &&
+  decide (560227709747861399187319382270000000000000000000000000000000 *
+      (fact 22 * QS ^ 22) ≤
+    expNum 22 ((-toInt (x1W (zWord (Sc - 45 + i)))).toNat *
+      1000000000000000000000000000) QS *
+      ((Sc - 45 + i) * 10000000000000000000000000003401))
+
+theorem wCheckGe_all : (List.range 46).all wCheckGe = true := by
+  decide +kernel
+
+theorem wCheckLt_all : (List.range 45).all wCheckLt = true := by
+  decide +kernel
+
+theorem wGe_facts {m : Nat} (h1 : Sc ≤ m) (h2 : m ≤ Sc + 45) :
+    0 ≤ toInt (x1W (zWord m)) ∧
+    capUB ((toInt (x1W (zWord m))).toNat * 1000000000000000000000000000) QS
+      (m * 10000000000000000000000000003401)
+      560227709747861399187319382270000000000000000000000000000000 ∧
+    capLB ((toInt (x1W (zWord m))).toNat * 1000000000000000000000000000) QS
+      (m * 9999999999999999999999999996599)
+      560227709747861399187319382270000000000000000000000000000000 := by
+  have hi := List.all_eq_true.mp wCheckGe_all (m - Sc) (List.mem_range.mpr (by omega))
+  simp only [wCheckGe, Bool.and_eq_true, decide_eq_true_eq] at hi
+  rw [show Sc + (m - Sc) = m from by omega] at hi
+  obtain ⟨⟨⟨hsign, hH⟩, hUB⟩, hLB⟩ := hi
+  refine ⟨hsign, ?_, ⟨22, hLB⟩⟩
+  exact capUB_of_partial QS_pos hH hUB
+
+theorem wLt_facts {m : Nat} (h1 : Sc - 45 ≤ m) (h2 : m < Sc) :
+    toInt (x1W (zWord m)) ≤ 0 ∧
+    capLB ((-toInt (x1W (zWord m))).toNat * 1000000000000000000000000000) QS
+      560227709747861399187319382270000000000000000000000000000000
+      (m * 10000000000000000000000000003401) ∧
+    capUB ((-toInt (x1W (zWord m))).toNat * 1000000000000000000000000000) QS
+      560227709747861399187319382270000000000000000000000000000000
+      (m * 9999999999999999999999999996599) := by
+  have hi := List.all_eq_true.mp wCheckLt_all (m - (Sc - 45))
+    (List.mem_range.mpr (by simp only [Sc] at h1 h2 ⊢; omega))
+  simp only [wCheckLt, Bool.and_eq_true, decide_eq_true_eq] at hi
+  rw [show Sc - 45 + (m - (Sc - 45)) = m from by simp only [Sc] at h1 ⊢; omega] at hi
+  obtain ⟨⟨⟨hsign, hH⟩, hUB⟩, hLB⟩ := hi
+  refine ⟨hsign, ⟨22, hLB⟩, ?_⟩
+  exact capUB_of_partial QS_pos hH hUB
+
+/-! ## Full-branch caps and signs -/
+
+theorem x1_nonneg_geF {m : Nat} (h1 : Sc ≤ m) (h2 : m < MHI) :
+    0 ≤ toInt (x1W (zWord m)) := by
+  rcases Nat.lt_or_ge m (Sc + 46) with hw | ho
+  · exact (wGe_facts h1 (by omega)).1
+  · exact x1_nonneg_ge ho h2
+
+theorem x1_nonpos_ltF {m : Nat} (h1 : MLO ≤ m) (h2 : m < Sc) :
+    toInt (x1W (zWord m)) ≤ 0 := by
+  rcases Nat.lt_or_ge m (Sc - 45) with ho | hw
+  · exact x1_nonpos_lt h1 (by simp only [Sc] at ho ⊢; omega)
+  · exact (wLt_facts hw h2).1
+
+theorem x1capGeUpF {m : Nat} (h1 : Sc ≤ m) (h2 : m < MHI) :
+    capUB ((toInt (x1W (zWord m))).toNat * 1000000000000000000000000000) QS
+      (m * 10000000000000000000000000003401)
+      560227709747861399187319382270000000000000000000000000000000 := by
+  rcases Nat.lt_or_ge m (Sc + 46) with hw | ho
+  · exact (wGe_facts h1 (by omega)).2.1
+  · have hup := geUp_nonneg (m := (m : Int))
+      (by simp only [Sc] at ho; omega) (by simp only [MHI] at h2; omega)
+    have h := x1capGeUp ho h2 hup
+    rw [show (633825300114114700748351602688000000000000000000000000000 : Nat) = QS
+      from by decide] at h
+    exact h
+
+theorem x1capGeLoF {m : Nat} (h1 : Sc ≤ m) (h2 : m < MHI) :
+    capLB ((toInt (x1W (zWord m))).toNat * 1000000000000000000000000000) QS
+      (m * 9999999999999999999999999996599)
+      560227709747861399187319382270000000000000000000000000000000 := by
+  rcases Nat.lt_or_ge m (Sc + 46) with hw | ho
+  · exact (wGe_facts h1 (by omega)).2.2
+  · have hlo := geLo_nonneg (m := (m : Int))
+      (by simp only [Sc] at ho; omega) (by simp only [MHI] at h2; omega)
+    have h := x1capGeLo ho h2 hlo
+    rw [show (633825300114114700748351602688000000000000000000000000000 : Nat) = QS
+      from by decide] at h
+    exact h
+
+theorem x1capLtUpF {m : Nat} (h1 : MLO ≤ m) (h2 : m < Sc) :
+    capLB ((-toInt (x1W (zWord m))).toNat * 1000000000000000000000000000) QS
+      560227709747861399187319382270000000000000000000000000000000
+      (m * 10000000000000000000000000003401) := by
+  rcases Nat.lt_or_ge m (Sc - 45) with ho | hw
+  · have hup := ltUp_nonneg (m := (m : Int))
+      (by simp only [MLO] at h1; omega) (by simp only [Sc] at ho ⊢; omega)
+    have h := x1capLtUp h1 (by simp only [Sc] at ho ⊢; omega) hup
+    rw [show (633825300114114700748351602688000000000000000000000000000 : Nat) = QS
+      from by decide] at h
+    exact h
+  · exact (wLt_facts hw h2).2.1
+
+theorem x1capLtLoF {m : Nat} (h1 : MLO ≤ m) (h2 : m < Sc) :
+    capUB ((-toInt (x1W (zWord m))).toNat * 1000000000000000000000000000) QS
+      560227709747861399187319382270000000000000000000000000000000
+      (m * 9999999999999999999999999996599) := by
+  rcases Nat.lt_or_ge m (Sc - 45) with ho | hw
+  · have hlo := ltLo_nonneg (m := (m : Int))
+      (by simp only [MLO] at h1; omega) (by simp only [Sc] at ho ⊢; omega)
+    have h := x1capLtLo h1 (by simp only [Sc] at ho ⊢; omega) hlo
+    rw [show (633825300114114700748351602688000000000000000000000000000 : Nat) = QS
+      from by decide] at h
+    exact h
+  · exact (wLt_facts hw h2).2.2
+
+end LnFloorCert
diff --git a/formal/ln/LnProof/LnProof/Kronecker.lean b/formal/ln/LnProof/LnProof/Kronecker.lean
new file mode 100644
index 000000000..79b57c350
--- /dev/null
+++ b/formal/ln/LnProof/LnProof/Kronecker.lean
@@ -0,0 +1,274 @@
+import LnProof.ShiftCert
+
+/-!
+# Polynomial identity testing by Kronecker evaluation
+
+Two integer polynomials with ℓ1-norm below half of `2^B` agree everywhere
+as soon as they agree at the single point `2^B`: the evaluation is the
+balanced radix-`2^B` digit string of the coefficient list, which is
+unique. This turns the certificate-vs-literal equalities — whose direct
+list-equality decides force the whole construction through the kernel's
+per-coefficient evaluation overhead — into one closed integer-arithmetic
+comparison plus a symbolic ℓ1 bound.
+-/
+
+namespace LnPoly
+
+/-- ℓ1 norm of the coefficient list. -/
+def polyL1 : List Int → Nat
+  | [] => 0
+  | c :: cs => c.natAbs + polyL1 cs
+
+theorem pow2_cast (B : Nat) : ((2 : Int) ^ B) = ((2 ^ B : Nat) : Int) := by
+  rw [Int.natCast_pow]
+  rfl
+
+/-- A multiple of `2^B` strictly inside `(-2^B, 2^B)` is zero. -/
+theorem eq_zero_of_mul_pow {B : Nat} {d k : Int} (hd : d = 2 ^ B * k)
+    (h1 : -(2 ^ B) < d) (h2 : d < 2 ^ B) : d = 0 ∧ k = 0 := by
+  have hP : (0 : Int) < 2 ^ B := by
+    have e : ((2 : Int) ^ B) = ((2 ^ B : Nat) : Int) := by
+      rw [Int.natCast_pow]
+      rfl
+    have h2 : 0 < 2 ^ B := Nat.pow_pos (by omega)
+    omega
+  rcases Int.lt_or_le k 0 with hk | hk
+  · exfalso
+    have h1k : k ≤ -1 := by omega
+    have := mul_le_mul_left_nonneg h1k (by omega : (0 : Int) ≤ 2 ^ B)
+    have e : (2 : Int) ^ B * (-1) = -(2 ^ B) := by
+      rw [Int.mul_neg, Int.mul_one]
+    omega
+  rcases Int.lt_or_le 0 k with hk2 | hk2
+  · exfalso
+    have h1k : 1 ≤ k := by omega
+    have := mul_le_mul_left_nonneg h1k (by omega : (0 : Int) ≤ 2 ^ B)
+    have e : (2 : Int) ^ B * 1 = 2 ^ B := Int.mul_one _
+    omega
+  · have hk0 : k = 0 := by omega
+    subst hk0
+    rw [Int.mul_zero] at hd
+    exact ⟨hd, rfl⟩
+
+/-- Route `(2 : Int) ^ n` through `Nat.pow`. The `Int` monoid power is
+`npowRec` (a linear chain of multiplications the kernel does not accelerate),
+whereas `Nat.pow` is a GMP-backed kernel primitive. Rewriting with this before
+a `decide +kernel` that evaluates a Kronecker point keeps the base a single
+cheap literal instead of an `n`-step reduction recomputed at every use. -/
+theorem int_two_pow (n : Nat) : (2 : Int) ^ n = ((2 ^ n : Nat) : Int) :=
+  (Int.natCast_pow 2 n).symm
+
+/-- Polynomials with small ℓ1 norm that agree at `2^B` agree everywhere. -/
+theorem evalPoly_ext {B : Nat} : ∀ (p q : List Int),
+    polyL1 p * 2 < 2 ^ B → polyL1 q * 2 < 2 ^ B →
+    evalPoly p ((2 : Int) ^ B) = evalPoly q ((2 : Int) ^ B) →
+    ∀ x : Int, evalPoly p x = evalPoly q x := by
+  intro p
+  induction p with
+  | nil =>
+    intro q
+    induction q with
+    | nil => intro _ _ _ _; rfl
+    | cons b q' ihq =>
+      intro hp hq he x
+      -- 0 = b + 2^B e' forces b = 0 and e' = 0
+      show evalPoly ([] : List Int) x = b + x * evalPoly q' x
+      have he' : (0 : Int) = b + 2 ^ B * evalPoly q' ((2 : Int) ^ B) := he
+      simp only [polyL1] at hq
+      have hb : b.natAbs * 2 < 2 ^ B ∧ polyL1 q' * 2 < 2 ^ B := by omega
+      have hbI : -(2 ^ B : Int) < b ∧ (b : Int) < 2 ^ B := by
+        rw [pow2_cast B]
+        omega
+      obtain ⟨hb0, hk0⟩ := eq_zero_of_mul_pow (B := B) (d := -b)
+        (k := evalPoly q' ((2 : Int) ^ B)) (by omega) (by omega) (by omega)
+      have htail := ihq hp hb.2 (by
+        show (0 : Int) = evalPoly q' ((2 : Int) ^ B)
+        omega) x
+      show (0 : Int) = b + x * evalPoly q' x
+      have : evalPoly ([] : List Int) x = (0 : Int) := rfl
+      rw [this] at htail
+      rw [← htail]
+      omega
+  | cons a p' ihp =>
+    intro q
+    match q with
+    | [] =>
+      intro hp hq he x
+      have he' : a + 2 ^ B * evalPoly p' ((2 : Int) ^ B) = (0 : Int) := he
+      simp only [polyL1] at hp
+      have ha : a.natAbs * 2 < 2 ^ B ∧ polyL1 p' * 2 < 2 ^ B := by omega
+      have haI : -(2 ^ B : Int) < a ∧ (a : Int) < 2 ^ B := by
+        rw [pow2_cast B]
+        omega
+      obtain ⟨ha0, hk0⟩ := eq_zero_of_mul_pow (B := B) (d := -a)
+        (k := evalPoly p' ((2 : Int) ^ B)) (by omega) (by omega) (by omega)
+      have htail := ihp [] ha.2 hq (by
+        show evalPoly p' ((2 : Int) ^ B) = (0 : Int)
+        omega) x
+      show a + x * evalPoly p' x = (0 : Int)
+      have h0 : evalPoly ([] : List Int) x = (0 : Int) := rfl
+      rw [h0] at htail
+      rw [htail]
+      omega
+    | b :: q' =>
+      intro hp hq he x
+      have he' : a + 2 ^ B * evalPoly p' ((2 : Int) ^ B) =
+          b + 2 ^ B * evalPoly q' ((2 : Int) ^ B) := he
+      simp only [polyL1] at hp hq
+      have hb : a.natAbs * 2 < 2 ^ B ∧ polyL1 p' * 2 < 2 ^ B ∧
+          b.natAbs * 2 < 2 ^ B ∧ polyL1 q' * 2 < 2 ^ B := by omega
+      have habI : -(2 ^ B : Int) < a - b ∧ (a - b : Int) < 2 ^ B := by
+        rw [pow2_cast B]
+        omega
+      have hd : a - b = 2 ^ B * (evalPoly q' ((2 : Int) ^ B) -
+          evalPoly p' ((2 : Int) ^ B)) := by
+        have e := Int.mul_sub ((2 : Int) ^ B) (evalPoly q' ((2 : Int) ^ B))
+          (evalPoly p' ((2 : Int) ^ B))
+        generalize hE1 : (2 : Int) ^ B * evalPoly p' ((2 : Int) ^ B) = E1 at he' e
+        generalize hE2 : (2 : Int) ^ B * evalPoly q' ((2 : Int) ^ B) = E2 at he' e
+        omega
+      obtain ⟨hab0, hk0⟩ := eq_zero_of_mul_pow (B := B) hd habI.1 habI.2
+      have htail := ihp q' hb.2.1 hb.2.2.2 (by omega) x
+      show a + x * evalPoly p' x = b + x * evalPoly q' x
+      rw [htail]
+      omega
+
+theorem eval01 (x : Int) : evalPoly ([0, 1] : List Int) x = x := by
+  show (0 : Int) + x * (1 + x * 0) = x
+  omega
+
+/-! ## ℓ1 bounds through the polynomial operations -/
+
+theorem polyL1_polyAdd : ∀ (p q : List Int), polyL1 (polyAdd p q) ≤ polyL1 p + polyL1 q := by
+  intro p
+  induction p with
+  | nil =>
+    intro q
+    show polyL1 q ≤ polyL1 ([] : List Int) + polyL1 q
+    simp only [polyL1]
+    omega
+  | cons a p ih =>
+    intro q
+    match q with
+    | [] =>
+      show polyL1 (a :: p) ≤ polyL1 (a :: p) + polyL1 ([] : List Int)
+      simp only [polyL1]
+      omega
+    | b :: q =>
+      show (a + b).natAbs + polyL1 (polyAdd p q) ≤
+        (a.natAbs + polyL1 p) + (b.natAbs + polyL1 q)
+      have h1 := ih q
+      have h2 := Int.natAbs_add_le a b
+      omega
+
+theorem polyL1_polyScale (a : Int) : ∀ (p : List Int),
+    polyL1 (polyScale a p) ≤ a.natAbs * polyL1 p := by
+  intro p
+  induction p with
+  | nil => exact Nat.le_refl _
+  | cons c cs ih =>
+    show (a * c).natAbs + polyL1 (polyScale a cs) ≤ a.natAbs * (c.natAbs + polyL1 cs)
+    rw [Int.natAbs_mul]
+    have hd : a.natAbs * (c.natAbs + polyL1 cs) =
+        a.natAbs * c.natAbs + a.natAbs * polyL1 cs := Nat.mul_add _ _ _
+    generalize hg1 : a.natAbs * c.natAbs = X at *
+    generalize hg2 : a.natAbs * polyL1 cs = Y at *
+    omega
+
+theorem polyL1_polyMulX (p : List Int) : polyL1 (polyMulX p) = polyL1 p := by
+  show (0 : Int).natAbs + polyL1 p = polyL1 p
+  omega
+
+theorem polyL1_polyNeg : ∀ (p : List Int), polyL1 (polyNeg p) = polyL1 p := by
+  intro p
+  induction p with
+  | nil => rfl
+  | cons c cs ih =>
+    show (-c).natAbs + polyL1 (polyNeg cs) = c.natAbs + polyL1 cs
+    rw [Int.natAbs_neg, ih]
+
+theorem polyL1_polyMul : ∀ (p q : List Int), polyL1 (polyMul p q) ≤ polyL1 p * polyL1 q := by
+  intro p
+  induction p with
+  | nil =>
+    intro q
+    show polyL1 ([] : List Int) ≤ polyL1 ([] : List Int) * polyL1 q
+    simp only [polyL1]
+    omega
+  | cons a p ih =>
+    intro q
+    show polyL1 (polyAdd (polyScale a q) (polyMulX (polyMul p q))) ≤
+      (a.natAbs + polyL1 p) * polyL1 q
+    have h1 := polyL1_polyAdd (polyScale a q) (polyMulX (polyMul p q))
+    have h2 := polyL1_polyScale a q
+    have h3 := polyL1_polyMulX (polyMul p q)
+    have h4 := ih q
+    have hd : (a.natAbs + polyL1 p) * polyL1 q =
+        a.natAbs * polyL1 q + polyL1 p * polyL1 q := Nat.add_mul _ _ _
+    generalize hg1 : a.natAbs * polyL1 q = X at *
+    generalize hg2 : polyL1 p * polyL1 q = Y at *
+    omega
+
+theorem polyL1_polyPow (p : List Int) : ∀ (k : Nat),
+    polyL1 (polyPow p k) ≤ polyL1 p ^ k := by
+  intro k
+  induction k with
+  | zero =>
+    show (1 : Int).natAbs + polyL1 ([] : List Int) ≤ 1
+    decide
+  | succ n ih =>
+    show polyL1 (polyMul p (polyPow p n)) ≤ polyL1 p ^ (n + 1)
+    have h1 := polyL1_polyMul p (polyPow p n)
+    have h2 : polyL1 p ^ (n + 1) = polyL1 p ^ n * polyL1 p := Nat.pow_succ _ _
+    have h3 : polyL1 p * polyL1 (polyPow p n) ≤ polyL1 p * polyL1 p ^ n :=
+      Nat.mul_le_mul_left _ ih
+    have h4 : polyL1 p * polyL1 p ^ n = polyL1 p ^ n * polyL1 p := Nat.mul_comm _ _
+    generalize hg1 : polyL1 p * polyL1 (polyPow p n) = X at *
+    generalize hg2 : polyL1 p * polyL1 p ^ n = Y at *
+    generalize hg3 : polyL1 p ^ n * polyL1 p = Z at *
+    omega
+
+theorem polyL1_expPolyNum (tn td : List Int) : ∀ (k : Nat),
+    polyL1 (expPolyNum tn td k) ≤ LnExp.expNum k (polyL1 tn) (polyL1 td) := by
+  intro k
+  induction k with
+  | zero =>
+    show (1 : Int).natAbs + polyL1 ([] : List Int) ≤ 1
+    decide
+  | succ n ih =>
+    show polyL1 (polyAdd (polyScale ((n : Int) + 1) (polyMul td (expPolyNum tn td n)))
+      (polyPow tn (n + 1))) ≤
+      (n + 1) * polyL1 td * LnExp.expNum n (polyL1 tn) (polyL1 td) +
+        polyL1 tn ^ (n + 1)
+    have h1 := polyL1_polyAdd (polyScale ((n : Int) + 1)
+      (polyMul td (expPolyNum tn td n))) (polyPow tn (n + 1))
+    have h2 := polyL1_polyScale ((n : Int) + 1) (polyMul td (expPolyNum tn td n))
+    have h3 := polyL1_polyMul td (expPolyNum tn td n)
+    have h4 := polyL1_polyPow tn (n + 1)
+    have hna : ((n : Int) + 1).natAbs = n + 1 := by omega
+    rw [hna] at h2
+    have h5 : (n + 1) * polyL1 (polyMul td (expPolyNum tn td n)) ≤
+        (n + 1) * (polyL1 td * polyL1 (expPolyNum tn td n)) :=
+      Nat.mul_le_mul_left _ h3
+    have h6 : polyL1 td * polyL1 (expPolyNum tn td n) ≤
+        polyL1 td * LnExp.expNum n (polyL1 tn) (polyL1 td) :=
+      Nat.mul_le_mul_left _ ih
+    have h7 : (n + 1) * (polyL1 td * polyL1 (expPolyNum tn td n)) ≤
+        (n + 1) * (polyL1 td * LnExp.expNum n (polyL1 tn) (polyL1 td)) :=
+      Nat.mul_le_mul_left _ h6
+    have h8 : (n + 1) * (polyL1 td * LnExp.expNum n (polyL1 tn) (polyL1 td)) =
+        (n + 1) * polyL1 td * LnExp.expNum n (polyL1 tn) (polyL1 td) :=
+      (Nat.mul_assoc _ _ _).symm
+    generalize hg1 : polyL1 (polyScale ((n : Int) + 1)
+      (polyMul td (expPolyNum tn td n))) = A at *
+    generalize hg2 : (n + 1) * polyL1 (polyMul td (expPolyNum tn td n)) = C at *
+    generalize hg3 : (n + 1) * (polyL1 td * polyL1 (expPolyNum tn td n)) = D at *
+    generalize hg4 : (n + 1) * (polyL1 td * LnExp.expNum n (polyL1 tn) (polyL1 td)) = E at *
+    generalize hg5 : (n + 1) * polyL1 td * LnExp.expNum n (polyL1 tn) (polyL1 td) = F at *
+    generalize hg6 : polyL1 (polyPow tn (n + 1)) = G at *
+    generalize hg7 : polyL1 tn ^ (n + 1) = H at *
+    generalize hg8 : polyL1 (polyAdd (polyScale ((n : Int) + 1)
+      (polyMul td (expPolyNum tn td n))) (polyPow tn (n + 1))) = T at *
+    omega
+
+end LnPoly
diff --git a/formal/ln/LnProof/LnProof/KroneckerShift.lean b/formal/ln/LnProof/LnProof/KroneckerShift.lean
new file mode 100644
index 000000000..4e8fbc5e0
--- /dev/null
+++ b/formal/ln/LnProof/LnProof/KroneckerShift.lean
@@ -0,0 +1,288 @@
+import LnProof.Kronecker
+
+/-!
+# Packed Taylor shifts for the cell walks
+
+The cell checker Taylor-shifts each certificate literal with a
+Kronecker-substitution homomorphism: the shifted polynomial is *computed*
+inside the decide as a handful of GMP-scale operations on sign-split packed
+naturals (`kShiftHorner`, untrusted), then *certified* by one evaluation
+identity at `2^B` through the `evalPoly_ext` seam. The packed computation
+needs no correctness lemmas: if it produced anything other than the true
+shift, the evaluation identity in the checker would fail. The remaining
+proof obligation is an ℓ1 bound for true shifts, carried by `aeval`, the
+absolute-value evaluation.
+-/
+
+namespace LnPoly
+
+/-- Kronecker digit width shared by the cell-walk `checkCoverK` decides and
+the cert-vs-literal `evalPoly_ext` identities. It must exceed `log2(2·ℓ1)`
+of the certificates; the binding floor is the cell-walk `aeval` bound at
+`~2^37772` (the certificate coefficients are `~37k`-bit and decay `~104`
+bits per degree, so every monomial term is `~`constant scale), with the
+eval-identity `polyL1` floor at `~2^37392`. This clears both with a
+`~228`-bit margin, so it is near-minimal rather than arbitrary. -/
+def kB : Nat := 38000
+
+/-! ## ℓ1 of a Taylor shift -/
+
+/-- Evaluate the coefficient-magnitude polynomial at a `Nat` point. -/
+def aeval : List Int → Nat → Nat
+  | [], _ => 0
+  | c :: cs, m => c.natAbs + m * aeval cs m
+
+theorem synthDiv_rem (p : List Int) (a : Int) :
+    (synthDiv p a).2 = evalPoly p a := by
+  have h := synthDiv_eval p a a
+  have e : a - a = 0 := by omega
+  rw [e, Int.mul_zero] at h
+  omega
+
+/-- Triangle inequality for evaluation against `aeval`. -/
+theorem evalPoly_natAbs_le : ∀ (p : List Int) (x : Int),
+    (evalPoly p x).natAbs ≤ aeval p x.natAbs := by
+  intro p
+  induction p with
+  | nil => intro x; exact Nat.le_refl _
+  | cons c cs ih =>
+    intro x
+    show (c + x * evalPoly cs x).natAbs ≤ c.natAbs + x.natAbs * aeval cs x.natAbs
+    have h1 := Int.natAbs_add_le c (x * evalPoly cs x)
+    have h2 : (x * evalPoly cs x).natAbs = x.natAbs * (evalPoly cs x).natAbs :=
+      Int.natAbs_mul x (evalPoly cs x)
+    have h3 := ih x
+    have h4 : x.natAbs * (evalPoly cs x).natAbs ≤ x.natAbs * aeval cs x.natAbs :=
+      Nat.mul_le_mul_left _ h3
+    generalize hg1 : x.natAbs * (evalPoly cs x).natAbs = A at *
+    generalize hg2 : x.natAbs * aeval cs x.natAbs = B at *
+    omega
+
+/-- `aeval` is monotone in the point. -/
+theorem aeval_mono : ∀ (p : List Int) {m n : Nat}, m ≤ n →
+    aeval p m ≤ aeval p n := by
+  intro p
+  induction p with
+  | nil => intro m n _; exact Nat.le_refl _
+  | cons c cs ih =>
+    intro m n h
+    show c.natAbs + m * aeval cs m ≤ c.natAbs + n * aeval cs n
+    have h1 := ih h
+    have h2 : m * aeval cs m ≤ n * aeval cs n :=
+      Nat.mul_le_mul h h1
+    omega
+
+/-- The synthetic-division step preserves the `aeval` budget: remainder
+magnitude plus the quotient's budget fit inside the dividend's budget at
+`M = 1 + |a|`. -/
+theorem synthDiv_aeval_le : ∀ (p : List Int) (a : Int),
+    (evalPoly p a).natAbs + aeval (synthDiv p a).1 (1 + a.natAbs) ≤
+      aeval p (1 + a.natAbs) := by
+  intro p
+  induction p with
+  | nil =>
+    intro a
+    show (0 : Int).natAbs + 0 ≤ 0
+    omega
+  | cons c cs ih =>
+    intro a
+    match cs, ih with
+    | [], _ =>
+      show (c + a * evalPoly ([] : List Int) a).natAbs +
+        aeval ([] : List Int) (1 + a.natAbs) ≤ c.natAbs + (1 + a.natAbs) * 0
+      show (c + a * 0).natAbs + 0 ≤ c.natAbs + (1 + a.natAbs) * 0
+      have e : c + a * 0 = c := by omega
+      rw [e]
+      omega
+    | c2 :: cs', ih =>
+      have hrec := ih a
+      have hrem := synthDiv_rem (c2 :: cs') a
+      show (c + a * evalPoly (c2 :: cs') a).natAbs +
+        aeval ((synthDiv (c2 :: cs') a).2 :: (synthDiv (c2 :: cs') a).1)
+          (1 + a.natAbs) ≤
+        c.natAbs + (1 + a.natAbs) * aeval (c2 :: cs') (1 + a.natAbs)
+      show (c + a * evalPoly (c2 :: cs') a).natAbs +
+        ((synthDiv (c2 :: cs') a).2.natAbs +
+          (1 + a.natAbs) * aeval (synthDiv (c2 :: cs') a).1 (1 + a.natAbs)) ≤
+        c.natAbs + (1 + a.natAbs) * aeval (c2 :: cs') (1 + a.natAbs)
+      rw [hrem]
+      have h1 := Int.natAbs_add_le c (a * evalPoly (c2 :: cs') a)
+      have h2 : (a * evalPoly (c2 :: cs') a).natAbs =
+          a.natAbs * (evalPoly (c2 :: cs') a).natAbs :=
+        Int.natAbs_mul a (evalPoly (c2 :: cs') a)
+      have h3 : (1 + a.natAbs) * aeval (c2 :: cs') (1 + a.natAbs) =
+          aeval (c2 :: cs') (1 + a.natAbs) +
+            a.natAbs * aeval (c2 :: cs') (1 + a.natAbs) := by
+        rw [Nat.add_mul, Nat.one_mul]
+      have h4 : a.natAbs * ((evalPoly (c2 :: cs') a).natAbs +
+          aeval (synthDiv (c2 :: cs') a).1 (1 + a.natAbs)) ≤
+          a.natAbs * aeval (c2 :: cs') (1 + a.natAbs) :=
+        Nat.mul_le_mul_left _ hrec
+      have h5 : a.natAbs * ((evalPoly (c2 :: cs') a).natAbs +
+          aeval (synthDiv (c2 :: cs') a).1 (1 + a.natAbs)) =
+          a.natAbs * (evalPoly (c2 :: cs') a).natAbs +
+            a.natAbs * aeval (synthDiv (c2 :: cs') a).1 (1 + a.natAbs) :=
+        Nat.mul_add _ _ _
+      have h6 : (1 + a.natAbs) * aeval (synthDiv (c2 :: cs') a).1 (1 + a.natAbs) =
+          aeval (synthDiv (c2 :: cs') a).1 (1 + a.natAbs) +
+            a.natAbs * aeval (synthDiv (c2 :: cs') a).1 (1 + a.natAbs) := by
+        rw [Nat.add_mul, Nat.one_mul]
+      generalize hgEa : (evalPoly (c2 :: cs') a).natAbs = Ea at *
+      generalize hgQ : aeval (synthDiv (c2 :: cs') a).1 (1 + a.natAbs) = Q at *
+      generalize hgC : aeval (c2 :: cs') (1 + a.natAbs) = Cv at *
+      generalize hgX1 : a.natAbs * Ea = X1 at *
+      generalize hgX2 : a.natAbs * Q = X2 at *
+      generalize hgX3 : a.natAbs * Cv = X3 at *
+      generalize hgX4 : a.natAbs * (Ea + Q) = X4 at *
+      omega
+
+/-- ℓ1 of the Taylor shift is bounded by the absolute evaluation at
+`1 + |a|`. -/
+theorem polyL1_polyShiftAux : ∀ (fuel : Nat) (p : List Int) (a : Int),
+    polyL1 (polyShiftAux fuel p a) ≤ aeval p (1 + a.natAbs) := by
+  intro fuel
+  induction fuel with
+  | zero =>
+    intro p a
+    show polyL1 ([] : List Int) ≤ aeval p (1 + a.natAbs)
+    show 0 ≤ aeval p (1 + a.natAbs)
+    omega
+  | succ f ih =>
+    intro p a
+    match p with
+    | [] =>
+      show (0 : Nat) ≤ 0
+      omega
+    | c :: cs =>
+      show polyL1 ((synthDiv (c :: cs) a).2 ::
+        polyShiftAux f (synthDiv (c :: cs) a).1 a) ≤
+        aeval (c :: cs) (1 + a.natAbs)
+      show (synthDiv (c :: cs) a).2.natAbs +
+        polyL1 (polyShiftAux f (synthDiv (c :: cs) a).1 a) ≤
+        aeval (c :: cs) (1 + a.natAbs)
+      have h1 := ih (synthDiv (c :: cs) a).1 a
+      have h2 := synthDiv_aeval_le (c :: cs) a
+      have h3 := synthDiv_rem (c :: cs) a
+      have h4 : aeval (synthDiv (c :: cs) a).1 (1 + a.natAbs) ≤
+          aeval (synthDiv (c :: cs) a).1 (1 + a.natAbs) := Nat.le_refl _
+      generalize hg1 : polyL1 (polyShiftAux f (synthDiv (c :: cs) a).1 a) = L at *
+      generalize hg2 : aeval (synthDiv (c :: cs) a).1 (1 + a.natAbs) = Q at *
+      generalize hg3 : aeval (c :: cs) (1 + a.natAbs) = Cv at *
+      omega
+
+theorem polyL1_polyShift (p : List Int) (a : Int) :
+    polyL1 (polyShift p a) ≤ aeval p (1 + a.natAbs) :=
+  polyL1_polyShiftAux p.length p a
+
+/-! ## Untrusted packed shift computation -/
+
+/-- Sign-split packed polynomial: positive and negative digit strings in
+radix `2^B`. Used only as a fast way to *compute* candidate coefficient
+lists inside `decide`; nothing about it is trusted. -/
+structure KPoly where
+  pos : Nat
+  neg : Nat
+
+def kAdd (a b : KPoly) : KPoly := ⟨a.pos + b.pos, a.neg + b.neg⟩
+
+def kMul (a b : KPoly) : KPoly :=
+  ⟨a.pos * b.pos + a.neg * b.neg, a.pos * b.neg + a.neg * b.pos⟩
+
+def kOfInt (c : Int) : KPoly :=
+  ⟨c.toNat, (-c).toNat⟩
+
+/-- Packed `x + a`. -/
+def kXA (B : Nat) (a : Int) : KPoly :=
+  kAdd (kOfInt a) ⟨2 ^ B, 0⟩
+
+/-- Packed Taylor shift by Horner: `p(x + a)` accumulated as packed
+multiply-adds. -/
+def kShiftHorner (B : Nat) (a : Int) : List Int → KPoly
+  | [] => ⟨0, 0⟩
+  | c :: cs => kAdd (kOfInt c) (kMul (kXA B a) (kShiftHorner B a cs))
+
+/-- Signed digit extraction. -/
+def unpack (B : Nat) : Nat → KPoly → List Int
+  | 0, _ => []
+  | len + 1, A =>
+    (((A.pos &&& (2 ^ B - 1) : Nat) : Int) - ((A.neg &&& (2 ^ B - 1) : Nat) : Int)) ::
+      unpack B len ⟨A.pos >>> B, A.neg >>> B⟩
+
+/-- Square ladder `x^(2^0), x^(2^1), …` of the given depth. -/
+def kSquares (x : KPoly) : Nat → List KPoly
+  | 0 => [x]
+  | d + 1 =>
+    match kSquares x d with
+    | [] => []
+    | s :: rest => kMul s s :: s :: rest
+
+/-- Power from a precomputed square ladder (most significant first). -/
+def kPowL : List KPoly → Nat → KPoly
+  | [], _ => ⟨1, 0⟩
+  | s :: rest, n =>
+    let h := kPowL rest (n % 2 ^ rest.length)
+    if n / 2 ^ rest.length % 2 = 1 then kMul h s else h
+
+/-- Divide-and-conquer packed Taylor shift:
+`P(x+a) = P₀(x+a) + (x+a)^m · P₁(x+a)` with `m = ⌊n/2⌋`. The expensive
+full-size multiplications happen only near the top of the recursion, so
+the cost is a handful of full-size GMP products. -/
+def kShiftDC (B : Nat) (a : Int) (sq : List KPoly) : Nat → List Int → KPoly
+  | 0, p => kShiftHorner B a p
+  | fuel + 1, p =>
+    if p.length ≤ 16 then kShiftHorner B a p
+    else
+      let m := p.length / 2
+      kAdd (kShiftDC B a sq fuel (p.take m))
+        (kMul (kPowL sq m) (kShiftDC B a sq fuel (p.drop m)))
+
+/-- The in-kernel shifted-witness candidate. -/
+def kShiftWitness (B : Nat) (C : List Int) (a : Int) : List Int :=
+  unpack B C.length (kShiftDC B a (kSquares (kXA B a) 9) 16 C)
+
+/-! ## The witness-checked cell walk -/
+
+/-- Certify `0 ≤ P(x)` on `[lo, hi]` by walking cells; each cell's
+shifted polynomial is computed packed and certified by one evaluation
+identity at `2^B` plus the ℓ1 bounds that make `evalPoly_ext` apply. -/
+def checkCoverK (B : Nat) (C : List Int) (lo hi : Int) : List Int → Bool
+  | [] => decide (hi < lo)
+  | w :: ws =>
+    let S := kShiftWitness B C lo
+    decide (0 ≤ w) &&
+      decide (polyL1 S * 2 < 2 ^ B) &&
+      decide (aeval C (1 + lo.natAbs) * 2 < 2 ^ B) &&
+      decide (evalPoly S (((2 ^ B : Nat) : Int)) = evalPoly C (lo + ((2 ^ B : Nat) : Int))) &&
+      decide (0 ≤ (hornerIv S 0 w).1) &&
+      checkCoverK B C (lo + w + 1) hi ws
+
+theorem checkCoverK_sound (B : Nat) (C : List Int) (ws : List Int) :
+    ∀ lo hi : Int, checkCoverK B C lo hi ws = true →
+      ∀ x : Int, lo ≤ x → x ≤ hi → 0 ≤ evalPoly C x := by
+  induction ws with
+  | nil =>
+    intro lo hi h x h1 h2
+    simp only [checkCoverK, decide_eq_true_eq] at h
+    omega
+  | cons w ws ih =>
+    intro lo hi h x h1 h2
+    simp only [checkCoverK, Bool.and_eq_true, decide_eq_true_eq] at h
+    obtain ⟨⟨⟨⟨hw, hS⟩, hC⟩, he⟩, hcell⟩ := h.1
+    have hrest := h.2
+    rcases Int.lt_or_le (lo + w) x with hout | hin
+    · exact ih (lo + w + 1) hi hrest x (by omega) h2
+    · -- the witness agrees with the true shift everywhere
+      have hshift : polyL1 (polyShift C lo) * 2 < 2 ^ B := by
+        have := polyL1_polyShift C lo
+        omega
+      have hext := evalPoly_ext (B := B) (kShiftWitness B C lo)
+        (polyShift C lo) hS hshift
+        (by rw [polyShift_eval, pow2_cast]; exact he)
+      have hs := (hornerIv_sound (kShiftWitness B C lo) (lo := 0) (hi := w)
+        (x := x - lo) (Int.le_refl 0) (by omega) (by omega)).1
+      have hx := hext (x - lo)
+      rw [polyShift_eval] at hx
+      rw [show lo + (x - lo) = x by omega] at hx
+      omega
+
+end LnPoly
diff --git a/formal/ln/LnProof/LnProof/LnMono.lean b/formal/ln/LnProof/LnProof/LnMono.lean
new file mode 100644
index 000000000..25c93c814
--- /dev/null
+++ b/formal/ln/LnProof/LnProof/LnMono.lean
@@ -0,0 +1,63 @@
+import LnProof.GeneratedLnModel
+
+/-!
+# Monotonicity certificates for the generated Ln model
+
+`Ln.lnWad` maps a wad-basis input to a ray-basis `int256` encoded as a
+two's-complement word, so ordering statements use the sign-bit-biased
+unsigned comparison `sle`.
+
+Monotonicity of `lnWad` over its whole domain `0 < x < 2^255` decomposes as:
+
+* adjacent inputs that share the Q103 mantissa and exponent return the same
+  word (the model is a function of the mantissa/exponent pair);
+* within an octave, the mantissa-to-result map is nondecreasing -- proven in
+  `LnProof.StepMono`/`LnProof.ZOctave`/`LnProof.OctaveMono` from the
+  polynomial certificates in `LnProof.Certs`;
+* across the 254 clz seams, the adjacent pair `(2^t - 1, 2^t)` is decided
+  here by kernel evaluation of the generated model;
+* the single corrected point `x = 10^18` (whose exact result, 0, is the only
+  integer value of the function) is decided here together with its
+  neighbors.
+
+The theorems in this file are the finitely-decidable legs of that argument,
+evaluated against the same generated model that the FFI fuzz suite checks
+against the deployed Solidity. `LnProof.TopMono` composes all of the legs
+into `model_ln_wad_mono`, monotonicity over the whole domain.
+-/
+
+set_option maxRecDepth 8192
+
+namespace LnGeneratedModel
+
+/-- Signed (two's complement) `≤` on uint256 words: unsigned comparison with
+the sign bit flipped. -/
+def sle (a b : Nat) : Bool :=
+  decide ((a + 2 ^ 255) % WORD_MOD ≤ (b + 2 ^ 255) % WORD_MOD)
+
+/-- One comparison per clz seam: `f(2^t) ≥ f(2^t - 1)` for `t ∈ [1, 254]`. -/
+def seamMono (f : Nat → Nat) : Bool :=
+  (List.range 254).all fun t => sle (f (2 ^ (t + 1) - 1)) (f (2 ^ (t + 1)))
+
+/-- `lnWad(10**18) = 0` exactly (the branchless `eq` correction in the
+implementation lands the lone integer-valued point of the function). -/
+theorem model_ln_wad_one_wad : model_ln_wad_evm (10 ^ 18) = 0 := by decide
+
+/-- `lnWadToWad(10**18) = 0` exactly. -/
+theorem model_ln_wad_to_wad_one_wad : model_ln_wad_to_wad_evm (10 ^ 18) = 0 := by
+  decide
+
+/-- The `x = 10**18` correction preserves order against both neighbors. -/
+theorem model_ln_wad_one_wad_mono :
+    (sle (model_ln_wad_evm (10 ^ 18 - 1)) (model_ln_wad_evm (10 ^ 18))
+      && sle (model_ln_wad_evm (10 ^ 18)) (model_ln_wad_evm (10 ^ 18 + 1))) = true := by
+  decide
+
+/-- `lnWad` is monotone across every clz seam. -/
+theorem model_ln_wad_seam_mono : seamMono model_ln_wad_evm = true := by decide
+
+/-- `lnWadToWad` is monotone across every clz seam. -/
+theorem model_ln_wad_to_wad_seam_mono : seamMono model_ln_wad_to_wad_evm = true := by
+  decide
+
+end LnGeneratedModel
diff --git a/formal/ln/LnProof/LnProof/OctaveMono.lean b/formal/ln/LnProof/LnProof/OctaveMono.lean
new file mode 100644
index 000000000..4b2cb8b14
--- /dev/null
+++ b/formal/ln/LnProof/LnProof/OctaveMono.lean
@@ -0,0 +1,200 @@
+import LnProof.ZOctave
+
+/-!
+# Within-octave monotonicity of the model tail
+
+`lnTail one kw m` is the generated model's pipeline downstream of the
+`(eq, clz-exponent, mantissa)` triple. `model_eq_tail` re-expresses the
+generated model through it, `ln2k_bound` brackets the `ln2 * k` term by
+kernel evaluation over all 256 `clz` values, and `tail_mono` pushes
+`r1_mono` through the fixed-exponent affine tail.
+-/
+
+set_option maxRecDepth 4096
+
+namespace LnGeneratedModel
+
+open LnPoly
+
+/-- The model tail downstream of `(k, mantissa)`: the floored accumulator
+`s = sar72(X1·K + ln2·k + BIAS)`, self-corrected via `s + (s == -1)`. The
+correction collapses the unique `s = -1` input (`x = 10^18`) to `0` and leaves
+every other input unchanged. -/
+def lnTail (kw m : Nat) : Nat :=
+  let s :=
+    evmSar 72 (evmAdd (evmAdd (evmMul (x1W (zWord m)) Kc) (evmMul LN2c kw)) BIASc)
+  evmAdd (evmIszero (evmNot s)) s
+
+/-- `mul` and `add` are commutative on words. The generated model writes their
+constant operands first (`mul(K, r)`, `add(BIAS, r)`); these orient those
+occurrences to the constant-second form `lnTail` uses. -/
+theorem evmMul_comm (a b : Nat) : evmMul a b = evmMul b a := by
+  unfold evmMul; rw [Nat.mul_comm (u256 a) (u256 b)]
+
+theorem evmAdd_comm (a b : Nat) : evmAdd a b = evmAdd b a := by
+  unfold evmAdd; rw [Nat.add_comm (u256 a) (u256 b)]
+
+theorem model_eq_tail {x : Nat} (h : x < 2 ^ 256) :
+    model_ln_wad_evm x =
+      lnTail (evmSub 160 (evmClz x)) (evmShr 160 (evmShl (evmClz x) x)) := by
+  unfold model_ln_wad_evm lnTail x1W pS4 pS3 pS2 pS1 qS5 qS4 qS3 qS2 qS1 uWord zWord
+  simp only [Sc, P4c, P3c, P2c, P1c, C0c, Q4c, Q3c, Q2c, Q1c, Kc, LN2c, BIASc,
+    u256_of_lt h]
+  rw [evmMul_comm 7450580596923828125,
+    evmAdd_comm (evmMul 3273295013171879848905889459134067659407864468560
+      (evmSub 160 (evmClz x))),
+    evmAdd_comm 116873961749927929127912020551506849476088469858172]
+
+/-- Per-`clz` bracket on the signed value of `ln2 * k`; `[-LN2c*95, LN2c*160]`. -/
+def ln2kOK (c : Nat) : Bool :=
+  decide (-(310963026251328585646059498617736427643747124513200 : Int) ≤
+      toInt (evmMul LN2c (evmSub 160 c)) ∧
+    toInt (evmMul LN2c (evmSub 160 c)) ≤
+      (523727202107500775824942313461450825505258314969600 : Int))
+
+theorem ln2k_all : (List.range 256).all ln2kOK = true := by decide
+
+theorem ln2k_bound {c : Nat} (hc : c < 256) :
+    -(310963026251328585646059498617736427643747124513200 : Int) ≤
+        toInt (evmMul LN2c (evmSub 160 c)) ∧
+      toInt (evmMul LN2c (evmSub 160 c)) ≤
+        (523727202107500775824942313461450825505258314969600 : Int) := by
+  have h := ln2k_all
+  rw [List.all_eq_true] at h
+  have hm := h c (List.mem_range.mpr hc)
+  rw [ln2kOK, decide_eq_true_eq] at hm
+  exact hm
+
+theorem evmAdd_zero {a : Nat} (h : a < 2 ^ 256) : evmAdd a 0 = a := by
+  unfold evmAdd u256
+  simp only [word_mod_eq]
+  omega
+
+/-- The self-correction `s + (s == -1)` is the identity except it sends the
+word `-1` to `0`. -/
+theorem corr_eq {s : Nat} (hs : s < 2 ^ 256) :
+    evmAdd (evmIszero (evmNot s)) s = if s = 2 ^ 256 - 1 then 0 else s := by
+  have hnot : evmNot s = 2 ^ 256 - 1 - s := by
+    unfold evmNot u256 WORD_MOD; rw [Nat.mod_eq_of_lt hs]
+  rw [hnot]
+  by_cases h : s = 2 ^ 256 - 1
+  · subst h; simp only [Nat.sub_self]; decide
+  · rw [if_neg h]
+    have hz : evmIszero (2 ^ 256 - 1 - s) = 0 := by
+      unfold evmIszero u256 WORD_MOD
+      rw [Nat.mod_eq_of_lt (by omega : 2 ^ 256 - 1 - s < 2 ^ 256), if_neg (by omega)]
+    rw [hz, evmAdd_comm, evmAdd_zero hs]
+
+/-- `toInt` view of the self-correction: `-1` becomes `0`, all else fixed. -/
+theorem corr_toInt {s : Nat} (hs : s < 2 ^ 256) :
+    toInt (evmAdd (evmIszero (evmNot s)) s) = if toInt s = -1 then 0 else toInt s := by
+  rw [corr_eq hs]
+  by_cases h : s = 2 ^ 256 - 1
+  · subst h; decide
+  · have hne : toInt s ≠ -1 := by
+      intro hc; apply h; unfold toInt at hc; split at hc <;> simp only [ipow256] at * <;> omega
+    simp only [if_neg h, if_neg hne]
+
+/-- The self-correction is monotone in the signed value. -/
+theorem corr_mono {s s' : Nat} (hs : s < 2 ^ 256) (hs' : s' < 2 ^ 256)
+    (hle : toInt s ≤ toInt s') :
+    toInt (evmAdd (evmIszero (evmNot s)) s) ≤ toInt (evmAdd (evmIszero (evmNot s')) s') := by
+  rw [corr_toInt hs, corr_toInt hs']
+  split <;> split <;> omega
+
+/-- Affine tail over abstract words: `sar72(a*K + W + BIAS)` is monotone in the
+signed value of `a` when every leaf is bracketed. -/
+theorem affine_tail_mono {a a' W : Nat}
+    (haw : a < 2 ^ 256) (haw' : a' < 2 ^ 256) (hWw : W < 2 ^ 256)
+    (hA : toInt a ≤ toInt a')
+    (hBa1 : -(240000000000000000000000000000 : Int) ≤ toInt a)
+    (hBa2 : toInt a ≤ (240000000000000000000000000000 : Int))
+    (hBa1' : -(240000000000000000000000000000 : Int) ≤ toInt a')
+    (hBa2' : toInt a' ≤ (240000000000000000000000000000 : Int))
+    (hW1 : -(310963026251328585646059498617736427643747124513200 : Int) ≤ toInt W)
+    (hW2 : toInt W ≤ (523727202107500775824942313461450825505258314969600 : Int)) :
+    toInt (evmSar 72 (evmAdd (evmAdd (evmMul a Kc) W) BIASc)) ≤
+      toInt (evmSar 72 (evmAdd (evmAdd (evmMul a' Kc) W) BIASc)) := by
+  have hKlt : Kc < 2 ^ 256 := by simp only [Kc]; omega
+  have hKc : toInt Kc = (7450580596923828125 : Int) := by
+    rw [toInt_of_lt (by simp only [Kc]; omega)]
+    simp only [Kc]
+    omega
+  have e2 : toInt (evmMul a Kc) = toInt a * toInt Kc :=
+    evmMul_transport (a := a) (b := Kc) haw hKlt
+      (by rw [hKc]; simp only [ipow255]; omega)
+      (by rw [hKc]; simp only [ipow255]; omega)
+  have e2' : toInt (evmMul a' Kc) = toInt a' * toInt Kc :=
+    evmMul_transport (a := a') (b := Kc) haw' hKlt
+      (by rw [hKc]; simp only [ipow255]; omega)
+      (by rw [hKc]; simp only [ipow255]; omega)
+  rw [hKc] at e2 e2'
+  have e3 : toInt (evmAdd (evmMul a Kc) W) = toInt (evmMul a Kc) + toInt W :=
+    evmAdd_transport (a := evmMul a Kc) (b := W) (evmMul_lt _ _) hWw
+      (by rw [e2]; clear e2 e2' hKc hKlt; simp only [ipow255]; omega)
+      (by rw [e2]; clear e2 e2' hKc hKlt; simp only [ipow255]; omega)
+  have e3' : toInt (evmAdd (evmMul a' Kc) W) = toInt (evmMul a' Kc) + toInt W :=
+    evmAdd_transport (a := evmMul a' Kc) (b := W) (evmMul_lt _ _) hWw
+      (by rw [e2']; clear e2 e2' e3 hKc hKlt; simp only [ipow255]; omega)
+      (by rw [e2']; clear e2 e2' e3 hKc hKlt; simp only [ipow255]; omega)
+  have hBIlt : BIASc < 2 ^ 256 := by simp only [BIASc]; omega
+  have hBI : toInt BIASc = (116873961749927929127912020551506849476088469858172 : Int) := by
+    rw [toInt_of_lt (by simp only [BIASc]; omega)]
+    simp only [BIASc]
+    omega
+  have e4 : toInt (evmAdd (evmAdd (evmMul a Kc) W) BIASc) =
+      toInt (evmAdd (evmMul a Kc) W) + toInt BIASc :=
+    evmAdd_transport (a := evmAdd (evmMul a Kc) W) (b := BIASc)
+      (evmAdd_lt _ _) hBIlt
+      (by rw [e3, e2, hBI]; clear e2 e2' e3 e3' hKc hKlt hBI hBIlt
+          simp only [ipow255]; omega)
+      (by rw [e3, e2, hBI]; clear e2 e2' e3 e3' hKc hKlt hBI hBIlt
+          simp only [ipow255]; omega)
+  have e4' : toInt (evmAdd (evmAdd (evmMul a' Kc) W) BIASc) =
+      toInt (evmAdd (evmMul a' Kc) W) + toInt BIASc :=
+    evmAdd_transport (a := evmAdd (evmMul a' Kc) W) (b := BIASc)
+      (evmAdd_lt _ _) hBIlt
+      (by rw [e3', e2', hBI]; clear e2 e2' e3 e3' e4 hKc hKlt hBI hBIlt
+          simp only [ipow255]; omega)
+      (by rw [e3', e2', hBI]; clear e2 e2' e3 e3' e4 hKc hKlt hBI hBIlt
+          simp only [ipow255]; omega)
+  have hord : toInt (evmAdd (evmAdd (evmMul a Kc) W) BIASc) ≤
+      toInt (evmAdd (evmAdd (evmMul a' Kc) W) BIASc) := by
+    have hmul : toInt a * (7450580596923828125 : Int) ≤
+        toInt a' * (7450580596923828125 : Int) :=
+      mul_le_mul_right_nonneg hA (by omega)
+    rw [e4, e4', e3, e3', e2, e2']
+    omega
+  obtain ⟨-, s1, s2⟩ :=
+    evmSar_sandwich_72 (evmAdd_lt (evmAdd (evmMul a Kc) W) BIASc)
+  obtain ⟨-, s1', s2'⟩ :=
+    evmSar_sandwich_72 (evmAdd_lt (evmAdd (evmMul a' Kc) W) BIASc)
+  generalize toInt (evmSar 72 (evmAdd (evmAdd (evmMul a Kc) W) BIASc)) =
+    sA at s1 s2 ⊢
+  generalize toInt (evmSar 72 (evmAdd (evmAdd (evmMul a' Kc) W) BIASc)) =
+    sB at s1' s2' ⊢
+  generalize toInt (evmAdd (evmAdd (evmMul a Kc) W) BIASc) = tA at s1 s2 hord
+  generalize toInt (evmAdd (evmAdd (evmMul a' Kc) W) BIASc) = tB at s1' s2' hord
+  omega
+
+/-- Monotone tail: with the exponent word fixed and the `ln2 * k` term
+bracketed, the mantissa-to-result map is nondecreasing. -/
+theorem tail_mono {kw m m' : Nat} (h1 : MLO ≤ m) (h2 : m ≤ m') (h3 : m' < MHI)
+    (hW1 : -(310963026251328585646059498617736427643747124513200 : Int) ≤
+      toInt (evmMul LN2c kw))
+    (hW2 : toInt (evmMul LN2c kw) ≤
+      (523727202107500775824942313461450825505258314969600 : Int)) :
+    toInt (lnTail kw m) ≤ toInt (lnTail kw m') := by
+  have hm2 : m < MHI := by simp only [MLO, MHI] at *; omega
+  have hm1' : MLO ≤ m' := by simp only [MLO, MHI] at *; omega
+  have hA := r1_mono h1 h2 h3
+  have hB := r1_bound h1 hm2
+  have hB' := r1_bound hm1' h3
+  have hr1w : x1W (zWord m) < 2 ^ 256 := by unfold x1W; exact evmSdiv_lt _ _
+  have hr1w' : x1W (zWord m') < 2 ^ 256 := by unfold x1W; exact evmSdiv_lt _ _
+  have hsar := affine_tail_mono hr1w hr1w' (evmMul_lt _ _) hA hB.1 hB.2 hB'.1 hB'.2 hW1 hW2
+  unfold lnTail
+  exact corr_mono (evmSar_sandwich_72 (evmAdd_lt _ _)).1
+    (evmSar_sandwich_72 (evmAdd_lt _ _)).1 hsar
+
+end LnGeneratedModel
diff --git a/formal/ln/LnProof/LnProof/Poly.lean b/formal/ln/LnProof/LnProof/Poly.lean
new file mode 100644
index 000000000..7e737d5b9
--- /dev/null
+++ b/formal/ln/LnProof/LnProof/Poly.lean
@@ -0,0 +1,225 @@
+import Init
+
+/-!
+# Polynomial positivity certificates
+
+Dense `Int` polynomials (coefficients low-order first), interval-Horner
+evaluation over nonnegative domains, and a fuel-bounded adaptive bisection
+checker whose `true` result soundly certifies `0 ≤ P(x)` for every integer
+`x` in the queried range. The checker is executed by the kernel via `decide`,
+so the analytic legs of the monotonicity proof reduce to computation.
+-/
+
+namespace LnPoly
+
+/-- Multiplication monotonicity helpers (Init-only, so spelled out). -/
+theorem mul_le_mul_left_nonneg {a b c : Int} (h : a ≤ b) (hc : 0 ≤ c) :
+    c * a ≤ c * b := by
+  have h1 : 0 ≤ c * (b - a) := Int.mul_nonneg hc (by omega)
+  rw [Int.mul_sub] at h1
+  omega
+
+theorem mul_le_mul_right_nonneg {a b c : Int} (h : a ≤ b) (hc : 0 ≤ c) :
+    a * c ≤ b * c := by
+  have h1 : 0 ≤ (b - a) * c := Int.mul_nonneg (by omega) hc
+  rw [Int.sub_mul] at h1
+  omega
+
+theorem mul_le_mul_left_nonpos {a b c : Int} (h : a ≤ b) (hc : c ≤ 0) :
+    c * b ≤ c * a := by
+  have h1 : 0 ≤ -c * (b - a) := Int.mul_nonneg (by omega) (by omega)
+  rw [Int.mul_sub, Int.neg_mul, Int.neg_mul] at h1
+  omega
+
+def evalPoly : List Int → Int → Int
+  | [], _ => 0
+  | c :: cs, x => c + x * evalPoly cs x
+
+/-- Interval Horner over a nonnegative domain `[lo, hi]`, `0 ≤ lo`. Returns
+`(vlo, vhi)` with `vlo ≤ P(x) ≤ vhi` for all `x ∈ [lo, hi]`. -/
+def hornerIv : List Int → Int → Int → Int × Int
+  | [], _, _ => (0, 0)
+  | c :: cs, lo, hi =>
+    let (plo, phi) := hornerIv cs lo hi
+    let mlo := if 0 ≤ plo then lo * plo else hi * plo
+    let mhi := if 0 ≤ phi then hi * phi else lo * phi
+    (c + mlo, c + mhi)
+
+theorem hornerIv_sound (cs : List Int) {lo hi x : Int}
+    (h0 : 0 ≤ lo) (h1 : lo ≤ x) (h2 : x ≤ hi) :
+    (hornerIv cs lo hi).1 ≤ evalPoly cs x ∧ evalPoly cs x ≤ (hornerIv cs lo hi).2 := by
+  induction cs with
+  | nil => simp [hornerIv, evalPoly]
+  | cons c cs ih =>
+    obtain ⟨ihlo, ihhi⟩ := ih
+    simp only [hornerIv, evalPoly]
+    constructor
+    · -- lower bound
+      have hx : 0 ≤ x := by omega
+      split
+      · -- 0 ≤ plo : lo * plo ≤ x * plo ≤ x * P(x)
+        rename_i hplo
+        have s1 : lo * (hornerIv cs lo hi).1 ≤ x * (hornerIv cs lo hi).1 :=
+          mul_le_mul_right_nonneg h1 hplo
+        have s2 : x * (hornerIv cs lo hi).1 ≤ x * evalPoly cs x :=
+          mul_le_mul_left_nonneg ihlo hx
+        omega
+      · -- plo < 0 : hi * plo ≤ x * plo ≤ x * P(x)
+        rename_i hplo
+        have hplo' : (hornerIv cs lo hi).1 ≤ 0 := by omega
+        have s1 : hi * (hornerIv cs lo hi).1 ≤ x * (hornerIv cs lo hi).1 := by
+          have hcomm := mul_le_mul_left_nonpos h2 hplo'
+          rw [Int.mul_comm ((hornerIv cs lo hi).1) hi,
+            Int.mul_comm ((hornerIv cs lo hi).1) x] at hcomm
+          exact hcomm
+        have s2 : x * (hornerIv cs lo hi).1 ≤ x * evalPoly cs x :=
+          mul_le_mul_left_nonneg ihlo hx
+        omega
+    · -- upper bound
+      have hx : 0 ≤ x := by omega
+      split
+      · -- 0 ≤ phi : x * P(x) ≤ x * phi ≤ hi * phi
+        rename_i hphi
+        have s2 : x * evalPoly cs x ≤ x * (hornerIv cs lo hi).2 :=
+          mul_le_mul_left_nonneg ihhi hx
+        have s1 : x * (hornerIv cs lo hi).2 ≤ hi * (hornerIv cs lo hi).2 :=
+          mul_le_mul_right_nonneg h2 hphi
+        omega
+      · -- phi < 0 : x * P(x) ≤ x * phi ≤ lo * phi
+        rename_i hphi
+        have hphi' : (hornerIv cs lo hi).2 ≤ 0 := by omega
+        have s2 : x * evalPoly cs x ≤ x * (hornerIv cs lo hi).2 :=
+          mul_le_mul_left_nonneg ihhi hx
+        have s1 : x * (hornerIv cs lo hi).2 ≤ lo * (hornerIv cs lo hi).2 := by
+          have hcomm := mul_le_mul_left_nonpos h1 hphi'
+          rw [Int.mul_comm ((hornerIv cs lo hi).2) lo,
+            Int.mul_comm ((hornerIv cs lo hi).2) x] at hcomm
+          exact hcomm
+        omega
+
+/-- Adaptive bisection: certifies `0 ≤ P(x)` for every integer `x ∈ [lo, hi]`. -/
+def checkNonneg (cs : List Int) (lo hi : Int) : Nat → Bool
+  | 0 => false
+  | fuel + 1 =>
+    if hi < lo then true
+    else if 0 ≤ (hornerIv cs lo hi).1 then true
+    else if lo = hi then false
+    else
+      let mid := (lo + hi) / 2
+      checkNonneg cs lo mid fuel && checkNonneg cs (mid + 1) hi fuel
+
+theorem checkNonneg_sound (cs : List Int) (fuel : Nat) :
+    ∀ lo hi : Int, 0 ≤ lo → checkNonneg cs lo hi fuel = true →
+      ∀ x : Int, lo ≤ x → x ≤ hi → 0 ≤ evalPoly cs x := by
+  induction fuel with
+  | zero => intro lo hi _ h; simp [checkNonneg] at h
+  | succ fuel ih =>
+    intro lo hi hlo h x hx1 hx2
+    unfold checkNonneg at h
+    split at h
+    · omega
+    · split at h
+      · rename_i hiv
+        have := (hornerIv_sound cs hlo hx1 hx2).1
+        omega
+      · split at h
+        · exact absurd h (by simp)
+        · rw [Bool.and_eq_true] at h
+          by_cases hm : x ≤ (lo + hi) / 2
+          · exact ih lo ((lo + hi) / 2) hlo h.1 x hx1 hm
+          · exact ih ((lo + hi) / 2 + 1) hi (by omega) h.2 x (by omega) hx2
+
+/-! ## Polynomial algebra (with evaluation lemmas) -/
+
+def polyAdd : List Int → List Int → List Int
+  | [], q => q
+  | p, [] => p
+  | a :: p, b :: q => (a + b) :: polyAdd p q
+
+theorem evalPoly_polyAdd (p q : List Int) (x : Int) :
+    evalPoly (polyAdd p q) x = evalPoly p x + evalPoly q x := by
+  induction p generalizing q with
+  | nil => simp [polyAdd, evalPoly]
+  | cons a p ih =>
+    cases q with
+    | nil => simp [polyAdd, evalPoly]
+    | cons b q =>
+      simp only [polyAdd, evalPoly, ih]
+      rw [Int.mul_add]
+      omega
+
+def polyNeg (p : List Int) : List Int := p.map (-·)
+
+theorem evalPoly_polyNeg (p : List Int) (x : Int) :
+    evalPoly (polyNeg p) x = -evalPoly p x := by
+  induction p with
+  | nil => simp [polyNeg, evalPoly]
+  | cons a p ih =>
+    simp only [polyNeg, List.map, evalPoly] at *
+    rw [ih]
+    rw [show x * -evalPoly p x = -(x * evalPoly p x) by rw [Int.mul_neg]]
+    omega
+
+def polySub (p q : List Int) : List Int := polyAdd p (polyNeg q)
+
+theorem evalPoly_polySub (p q : List Int) (x : Int) :
+    evalPoly (polySub p q) x = evalPoly p x - evalPoly q x := by
+  unfold polySub
+  rw [evalPoly_polyAdd, evalPoly_polyNeg]
+  omega
+
+def polyScale (a : Int) (p : List Int) : List Int := p.map (a * ·)
+
+theorem evalPoly_polyScale (a : Int) (p : List Int) (x : Int) :
+    evalPoly (polyScale a p) x = a * evalPoly p x := by
+  induction p with
+  | nil => simp [polyScale, evalPoly]
+  | cons c p ih =>
+    simp only [polyScale, List.map, evalPoly] at *
+    rw [ih, Int.mul_add]
+    rw [show x * (a * evalPoly p x) = a * (x * evalPoly p x) by
+      rw [← Int.mul_assoc, Int.mul_comm x a, Int.mul_assoc]]
+
+theorem evalPoly_singleton (c x : Int) : evalPoly [c] x = c := by
+  simp [evalPoly]
+
+def polyMulX (p : List Int) : List Int := 0 :: p
+
+theorem evalPoly_polyMulX (p : List Int) (x : Int) :
+    evalPoly (polyMulX p) x = x * evalPoly p x := by
+  simp [polyMulX, evalPoly]
+
+def polyMul : List Int → List Int → List Int
+  | [], _ => []
+  | a :: p, q => polyAdd (polyScale a q) (polyMulX (polyMul p q))
+
+theorem evalPoly_polyMul (p q : List Int) (x : Int) :
+    evalPoly (polyMul p q) x = evalPoly p x * evalPoly q x := by
+  induction p with
+  | nil => simp [polyMul, evalPoly]
+  | cons a p ih =>
+    simp only [polyMul, evalPoly]
+    rw [evalPoly_polyAdd, evalPoly_polyScale, evalPoly_polyMulX, ih]
+    rw [Int.add_mul]
+    rw [show x * (evalPoly p x * evalPoly q x) = x * evalPoly p x * evalPoly q x by
+      rw [Int.mul_assoc]]
+
+/-- Composition with `x + 1`: `evalPoly (polyCompAdd1 p) x = evalPoly p (x + 1)`. -/
+def polyCompAdd1 : List Int → List Int
+  | [] => []
+  | c :: cs =>
+    let q := polyCompAdd1 cs
+    polyAdd [c] (polyAdd q (polyMulX q))
+
+theorem evalPoly_polyCompAdd1 (p : List Int) (x : Int) :
+    evalPoly (polyCompAdd1 p) x = evalPoly p (x + 1) := by
+  induction p with
+  | nil => simp [polyCompAdd1, evalPoly]
+  | cons c cs ih =>
+    simp only [polyCompAdd1, evalPoly]
+    rw [evalPoly_polyAdd, evalPoly_polyAdd, evalPoly_polyMulX, ih]
+    simp only [evalPoly]
+    rw [Int.add_mul, Int.one_mul]
+    omega
+
+end LnPoly
diff --git a/formal/ln/LnProof/LnProof/ShiftCert.lean b/formal/ln/LnProof/LnProof/ShiftCert.lean
new file mode 100644
index 000000000..d79b8c7de
--- /dev/null
+++ b/formal/ln/LnProof/LnProof/ShiftCert.lean
@@ -0,0 +1,422 @@
+import LnProof.Poly
+import LnProof.ExpSum
+
+/-!
+# Recentered polynomial nonnegativity certificates
+
+The floor-specification certificate polynomials have ~1e-28 relative slack:
+plain interval Horner cannot see the cancellation between their huge
+monomials, so bisection alone would need ~1e30 cells. Recentering a
+polynomial at each cell's left endpoint (an exact integer Taylor shift)
+exposes the cancellation symbolically; interval Horner over the shifted
+cell `[0, w]` then converges with a few hundred cells.
+
+`checkCover` walks a caller-supplied list of cell widths and certifies
+`0 ≤ P(x)` for every integer `x` in `[lo, hi]`.
+
+The file also provides the polynomial-level partial-sum numerator
+(`expPolyNum`) and its evaluation lemma, connecting the certificate
+polynomials to the `expNum` caps of `LnProof.ExpSum`.
+-/
+
+namespace LnPoly
+
+/-- Synthetic division by `(x - a)`: `P(x) = Q(x) (x - a) + r`. -/
+def synthDiv : List Int → Int → List Int × Int
+  | [], _ => ([], 0)
+  | [c], _ => ([], c)
+  | c :: cs, a =>
+    ((synthDiv cs a).2 :: (synthDiv cs a).1, c + a * (synthDiv cs a).2)
+
+theorem synthDiv_eval (C : List Int) (a x : Int) :
+    evalPoly C x = evalPoly (synthDiv C a).1 x * (x - a) + (synthDiv C a).2 := by
+  match C with
+  | [] => simp [synthDiv, evalPoly]
+  | [c] => simp [synthDiv, evalPoly]
+  | c :: c2 :: cs =>
+    have ih := synthDiv_eval (c2 :: cs) a x
+    show c + x * evalPoly (c2 :: cs) x = _
+    rw [ih]
+    show _ = ((synthDiv (c2 :: cs) a).2 +
+        x * evalPoly ((synthDiv (c2 :: cs) a).1) x) * (x - a) +
+      (c + a * (synthDiv (c2 :: cs) a).2)
+    rw [Int.add_mul]
+    have e1 : x * (evalPoly (synthDiv (c2 :: cs) a).1 x * (x - a) +
+        (synthDiv (c2 :: cs) a).2) =
+        x * evalPoly (synthDiv (c2 :: cs) a).1 x * (x - a) +
+          x * (synthDiv (c2 :: cs) a).2 := by
+      rw [Int.mul_add, Int.mul_assoc]
+    have e2 : x * (synthDiv (c2 :: cs) a).2 =
+        (x - a) * (synthDiv (c2 :: cs) a).2 + a * (synthDiv (c2 :: cs) a).2 := by
+      rw [Int.sub_mul]
+      omega
+    have e3 : (x - a) * (synthDiv (c2 :: cs) a).2 =
+        (synthDiv (c2 :: cs) a).2 * (x - a) := Int.mul_comm _ _
+    omega
+
+theorem synthDiv_length : ∀ (C : List Int) (a : Int), C ≠ [] →
+    (synthDiv C a).1.length + 1 = C.length := by
+  intro C a h
+  match C with
+  | [c] => rfl
+  | c :: c2 :: cs =>
+    have ih := synthDiv_length (c2 :: cs) a (by simp)
+    show ((synthDiv (c2 :: cs) a).2 :: (synthDiv (c2 :: cs) a).1).length + 1 = _
+    simp only [List.length_cons] at *
+    omega
+
+/-- Fuel-based Taylor shift (structural recursion, so the kernel computes
+it inside `decide`). -/
+def polyShiftAux : Nat → List Int → Int → List Int
+  | 0, _, _ => []
+  | _ + 1, [], _ => []
+  | fuel + 1, c :: cs, a =>
+    (synthDiv (c :: cs) a).2 :: polyShiftAux fuel (synthDiv (c :: cs) a).1 a
+
+/-- Exact Taylor shift: `evalPoly (polyShift C a) δ = evalPoly C (a + δ)`. -/
+def polyShift (C : List Int) (a : Int) : List Int :=
+  polyShiftAux C.length C a
+
+theorem polyShiftAux_eval (fuel : Nat) :
+    ∀ (C : List Int) (a δ : Int), C.length ≤ fuel →
+      evalPoly (polyShiftAux fuel C a) δ = evalPoly C (a + δ) := by
+  induction fuel with
+  | zero =>
+    intro C a δ h
+    have : C = [] := List.eq_nil_of_length_eq_zero (by omega)
+    subst this
+    rfl
+  | succ f ih =>
+    intro C a δ h
+    match C with
+    | [] => rfl
+    | c :: cs =>
+      show (synthDiv (c :: cs) a).2 +
+          δ * evalPoly (polyShiftAux f (synthDiv (c :: cs) a).1 a) δ = _
+      have hlen : (synthDiv (c :: cs) a).1.length ≤ f := by
+        have := synthDiv_length (c :: cs) a (by simp)
+        simp only [List.length_cons] at *
+        omega
+      rw [ih _ a δ hlen, synthDiv_eval (c :: cs) a (a + δ)]
+      have e1 : evalPoly (synthDiv (c :: cs) a).1 (a + δ) * (a + δ - a) =
+          δ * evalPoly (synthDiv (c :: cs) a).1 (a + δ) := by
+        rw [show a + δ - a = δ by omega, Int.mul_comm]
+      omega
+
+theorem polyShift_eval (C : List Int) (a δ : Int) :
+    evalPoly (polyShift C a) δ = evalPoly C (a + δ) :=
+  polyShiftAux_eval C.length C a δ (Nat.le_refl _)
+
+/-- Certify `0 ≤ P(x)` for every integer `x ∈ [lo, hi]` by walking cells of
+the given widths, recentering at each cell's left endpoint. -/
+def checkCover (C : List Int) (lo hi : Int) : List Int → Bool
+  | [] => decide (hi < lo)
+  | w :: ws =>
+    decide (0 ≤ w) && decide (0 ≤ (hornerIv (polyShift C lo) 0 w).1) &&
+      checkCover C (lo + w + 1) hi ws
+
+theorem checkCover_sound (C : List Int) (ws : List Int) :
+    ∀ lo hi : Int, checkCover C lo hi ws = true →
+      ∀ x : Int, lo ≤ x → x ≤ hi → 0 ≤ evalPoly C x := by
+  induction ws with
+  | nil =>
+    intro lo hi h x h1 h2
+    simp only [checkCover, decide_eq_true_eq] at h
+    omega
+  | cons w ws ih =>
+    intro lo hi h x h1 h2
+    simp only [checkCover, Bool.and_eq_true, decide_eq_true_eq] at h
+    obtain ⟨⟨hw, hcell⟩, hrest⟩ := h
+    rcases Int.lt_or_le (lo + w) x with hout | hin
+    · exact ih (lo + w + 1) hi hrest x (by omega) h2
+    · have hs := (hornerIv_sound (polyShift C lo) (lo := 0) (hi := w)
+        (x := x - lo) (Int.le_refl 0) (by omega) (by omega)).1
+      rw [polyShift_eval] at hs
+      rw [show lo + (x - lo) = x by omega] at hs
+      omega
+
+/-! ## Partial-sum numerators at the polynomial level -/
+
+/-- Int mirror of `LnExp.expNum`. -/
+def expNumI : Nat → Int → Int → Int
+  | 0, _, _ => 1
+  | n + 1, p, q => (n + 1) * q * expNumI n p q + p ^ (n + 1)
+
+theorem expNumI_eq_expNum (k : Nat) (p q : Nat) :
+    expNumI k (p : Int) (q : Int) = (LnExp.expNum k p q : Int) := by
+  induction k with
+  | zero => rfl
+  | succ n ih =>
+    show ((n : Int) + 1) * q * expNumI n p q + (p : Int) ^ (n + 1) = _
+    rw [ih]
+    show _ = ((((n + 1) * q * LnExp.expNum n p q + p ^ (n + 1) : Nat)) : Int)
+    push_cast
+    omega
+
+def polyPow (P : List Int) : Nat → List Int
+  | 0 => [1]
+  | n + 1 => polyMul P (polyPow P n)
+
+theorem evalPoly_polyPow (P : List Int) (n : Nat) (x : Int) :
+    evalPoly (polyPow P n) x = evalPoly P x ^ n := by
+  induction n with
+  | zero => simp [polyPow, evalPoly]
+  | succ k ih =>
+    show evalPoly (polyMul P (polyPow P k)) x = _
+    rw [evalPoly_polyMul, ih]
+    rw [show evalPoly P x ^ (k + 1) = evalPoly P x ^ k * evalPoly P x from
+      Int.pow_succ _ _]
+    rw [Int.mul_comm]
+
+/-- Polynomial-level partial-sum numerator: evaluates to
+`expNumI k (TN(x)) (TD(x))`. -/
+def expPolyNum (TN TD : List Int) : Nat → List Int
+  | 0 => [1]
+  | n + 1 =>
+    polyAdd (polyScale ((n : Int) + 1) (polyMul TD (expPolyNum TN TD n)))
+      (polyPow TN (n + 1))
+
+theorem evalPoly_expPolyNum (TN TD : List Int) (k : Nat) (x : Int) :
+    evalPoly (expPolyNum TN TD k) x =
+      expNumI k (evalPoly TN x) (evalPoly TD x) := by
+  induction k with
+  | zero => simp [expPolyNum, expNumI, evalPoly]
+  | succ n ih =>
+    show evalPoly (polyAdd (polyScale ((n : Int) + 1)
+      (polyMul TD (expPolyNum TN TD n))) (polyPow TN (n + 1))) x = _
+    rw [evalPoly_polyAdd, evalPoly_polyScale, evalPoly_polyMul, ih,
+      evalPoly_polyPow]
+    show _ = ((n : Int) + 1) * evalPoly TD x * expNumI n (evalPoly TN x)
+      (evalPoly TD x) + evalPoly TN x ^ (n + 1)
+    rw [← Int.mul_assoc]
+
+/-! ## Crude range and difference bounds over a box
+
+`polyHi cs B` bounds `evalPoly cs t` from above for `t ∈ [0, B]`;
+`polyAbs cs B` bounds its magnitude; `polyDiffHi cs B` bounds the divided
+difference `(P(y) - P(x))/(y - x)` from above for `0 ≤ x ≤ y ≤ B`. A
+negative `polyDiffHi` certificate proves the polynomial decreasing on the
+whole box, which is how the bracket lemmas compare pipeline stage values
+at integer points against the certificate polynomials' rational interval
+ends. -/
+
+def iabs (c : Int) : Int := if c < 0 then -c else c
+
+def polyHi : List Int → Int → Int
+  | [], _ => 0
+  | c :: cs, B => c + B * max (polyHi cs B) 0
+
+def polyDiffHi : List Int → Int → Int
+  | [], _ => 0
+  | _ :: cs, B => polyHi cs B + max (B * polyDiffHi cs B) 0
+
+theorem polyHi_bound (cs : List Int) (B : Int) :
+    ∀ t : Int, 0 ≤ t → t ≤ B → evalPoly cs t ≤ polyHi cs B := by
+  induction cs with
+  | nil => intro t _ _; exact Int.le_refl _
+  | cons c cs ih =>
+    intro t h0 hB
+    show c + t * evalPoly cs t ≤ c + B * max (polyHi cs B) 0
+    have hT := ih t h0 hB
+    rcases Int.le_total (evalPoly cs t) 0 with hneg | hpos
+    · have h1 : t * evalPoly cs t ≤ 0 := Int.mul_nonpos_of_nonneg_of_nonpos h0 hneg
+      have h2 : 0 ≤ B * max (polyHi cs B) 0 :=
+        Int.mul_nonneg (by omega) (by omega)
+      omega
+    · have h1 : t * evalPoly cs t ≤ B * evalPoly cs t :=
+        mul_le_mul_right_nonneg hB hpos
+      have h2 : B * evalPoly cs t ≤ B * max (polyHi cs B) 0 :=
+        mul_le_mul_left_nonneg (by omega) (by omega)
+      omega
+
+theorem polyDiffHi_bound (cs : List Int) (B : Int) :
+    ∀ x y : Int, 0 ≤ x → x ≤ y → y ≤ B →
+      evalPoly cs y - evalPoly cs x ≤ polyDiffHi cs B * (y - x) := by
+  induction cs with
+  | nil =>
+    intro x y _ _ _
+    show (0 : Int) - 0 ≤ 0 * (y - x)
+    omega
+  | cons c cs ih =>
+    intro x y hx hxy hyB
+    show c + y * evalPoly cs y - (c + x * evalPoly cs x) ≤
+      (polyHi cs B + max (B * polyDiffHi cs B) 0) * (y - x)
+    -- y T(y) - x T(x) = (y - x) T(y) + x (T(y) - T(x))
+    have hsplit : y * evalPoly cs y - x * evalPoly cs x =
+        (y - x) * evalPoly cs y + x * (evalPoly cs y - evalPoly cs x) := by
+      rw [Int.sub_mul, Int.mul_sub]
+      omega
+    have h1 : (y - x) * evalPoly cs y ≤ (y - x) * polyHi cs B :=
+      mul_le_mul_left_nonneg (polyHi_bound cs B y (by omega) hyB) (by omega)
+    have h2 : x * (evalPoly cs y - evalPoly cs x) ≤ max (B * polyDiffHi cs B) 0 * (y - x) := by
+      have hd := ih x y hx hxy hyB
+      rcases Int.le_total 0 (polyDiffHi cs B) with hD | hD
+      · have s1 : x * (evalPoly cs y - evalPoly cs x) ≤ x * (polyDiffHi cs B * (y - x)) := by
+          rcases Int.le_total (evalPoly cs y - evalPoly cs x) (polyDiffHi cs B * (y - x))
+            with h | h
+          · exact mul_le_mul_left_nonneg h hx
+          · have : evalPoly cs y - evalPoly cs x = polyDiffHi cs B * (y - x) := by omega
+            rw [this]
+            exact Int.le_refl _
+        have s2 : x * (polyDiffHi cs B * (y - x)) ≤ B * (polyDiffHi cs B * (y - x)) :=
+          mul_le_mul_right_nonneg (by omega)
+            (Int.mul_nonneg hD (by omega))
+        have e1 : B * (polyDiffHi cs B * (y - x)) = B * polyDiffHi cs B * (y - x) := by
+          rw [Int.mul_assoc]
+        have hmax : B * polyDiffHi cs B * (y - x) ≤ max (B * polyDiffHi cs B) 0 * (y - x) :=
+          mul_le_mul_right_nonneg (by omega) (by omega)
+        omega
+      · -- divided difference is nonpositive: x * diff ≤ 0
+        have hd0 : evalPoly cs y - evalPoly cs x ≤ 0 := by
+          have : polyDiffHi cs B * (y - x) ≤ 0 :=
+            Int.mul_nonpos_of_nonpos_of_nonneg hD (by omega)
+          omega
+        have s1 : x * (evalPoly cs y - evalPoly cs x) ≤ 0 :=
+          Int.mul_nonpos_of_nonneg_of_nonpos hx hd0
+        have : 0 ≤ max (B * polyDiffHi cs B) 0 * (y - x) :=
+          Int.mul_nonneg (by omega) (by omega)
+        omega
+    have e2 : (polyHi cs B + max (B * polyDiffHi cs B) 0) * (y - x) =
+        (y - x) * polyHi cs B + max (B * polyDiffHi cs B) 0 * (y - x) := by
+      rw [Int.add_mul, Int.mul_comm (polyHi cs B) (y - x)]
+    omega
+
+/-! ## Homogenized two-point evaluation -/
+
+/-- `homPoly cs num den` is `Σ_j cs_j num^j den^(deg - j)` at the
+polynomial level. -/
+def homPoly : List Int → List Int → List Int → List Int
+  | [], _, _ => [0]
+  | c :: cs, num, den =>
+    polyAdd (polyScale c (polyPow den cs.length)) (polyMul num (homPoly cs num den))
+
+/-- `homEvalI cs n d = Σ_j cs_j n^j d^(deg-j)`, Horner-style. -/
+def homEvalI : List Int → Int → Int → Int
+  | [], _, _ => 0
+  | c :: cs, nv, dv => c * dv ^ cs.length + nv * homEvalI cs nv dv
+
+theorem evalPoly_homPoly (cs : List Int) (num den : List Int) (x : Int) :
+    evalPoly (homPoly cs num den) x =
+      homEvalI cs (evalPoly num x) (evalPoly den x) := by
+  induction cs with
+  | nil =>
+    show (0 : Int) + x * 0 = 0
+    omega
+  | cons c cs ih =>
+    show evalPoly (polyAdd (polyScale c (polyPow den cs.length))
+      (polyMul num (homPoly cs num den))) x = _
+    rw [evalPoly_polyAdd, evalPoly_polyScale, evalPoly_polyPow, evalPoly_polyMul, ih]
+    rfl
+
+/-- The trivial homogenization identity: at the pair `(u d, d)` the
+homogenized value collapses to `d^deg · P(u)`. -/
+theorem homEvalI_collapse (u D : Int) :
+    ∀ (c : Int) (cs : List Int),
+      homEvalI (c :: cs) (u * D) D = D ^ cs.length * evalPoly (c :: cs) u := by
+  intro c cs
+  induction cs generalizing c with
+  | nil =>
+    show c * D ^ 0 + u * D * 0 = D ^ 0 * (c + u * 0)
+    rw [Int.mul_zero, Int.mul_zero, Int.add_zero, Int.add_zero, Int.mul_comm]
+  | cons c2 cs ih =>
+    show c * D ^ (c2 :: cs).length + u * D * homEvalI (c2 :: cs) (u * D) D = _
+    rw [ih c2]
+    show c * D ^ (cs.length + 1) + u * D * (D ^ cs.length * evalPoly (c2 :: cs) u) =
+      D ^ (cs.length + 1) * (c + u * evalPoly (c2 :: cs) u)
+    have e1 : (D : Int) ^ (cs.length + 1) = D * D ^ cs.length := by
+      rw [Int.pow_succ, Int.mul_comm]
+    rw [e1, Int.mul_add]
+    have e2 : u * D * (D ^ cs.length * evalPoly (c2 :: cs) u) =
+        D * D ^ cs.length * (u * evalPoly (c2 :: cs) u) := by
+      simp only [Int.mul_assoc, Int.mul_left_comm]
+    have e3 : c * (D * D ^ cs.length) = D * D ^ cs.length * c := by
+      rw [Int.mul_comm]
+    omega
+
+/-! ## Sharing-friendly mirrors of the shift checker
+
+`synthDiv` names its recursive result three times, and the kernel
+re-evaluates each occurrence during `decide`. The `M`-variants bind the
+recursive result through a `match`, so the kernel computes it once per
+step; `checkCoverM_sound` transfers soundness from the reference checker.
+-/
+
+def synthDivM : List Int → Int → List Int × Int
+  | [], _ => ([], 0)
+  | [c], _ => ([], c)
+  | c :: cs, a =>
+    match synthDivM cs a with
+    | (q, r) => (r :: q, c + a * r)
+
+theorem synthDivM_eq : ∀ (C : List Int) (a : Int), synthDivM C a = synthDiv C a := by
+  intro C a
+  match C with
+  | [] => rfl
+  | [c] => rfl
+  | c :: c2 :: cs =>
+    have ih := synthDivM_eq (c2 :: cs) a
+    show (match synthDivM (c2 :: cs) a with
+      | (q, r) => (r :: q, c + a * r)) = _
+    rw [ih]
+    rcases h : synthDiv (c2 :: cs) a with ⟨q, r⟩
+    show (r :: q, c + a * r) = ((synthDiv (c2 :: cs) a).2 :: (synthDiv (c2 :: cs) a).1,
+      c + a * (synthDiv (c2 :: cs) a).2)
+    rw [h]
+
+def polyShiftAuxM : Nat → List Int → Int → List Int
+  | 0, _, _ => []
+  | _ + 1, [], _ => []
+  | fuel + 1, c :: cs, a =>
+    match synthDivM (c :: cs) a with
+    | (q, r) => r :: polyShiftAuxM fuel q a
+
+theorem polyShiftAuxM_eq : ∀ (fuel : Nat) (C : List Int) (a : Int),
+    polyShiftAuxM fuel C a = polyShiftAux fuel C a := by
+  intro fuel
+  induction fuel with
+  | zero => intro C a; rfl
+  | succ f ih =>
+    intro C a
+    match C with
+    | [] => rfl
+    | c :: cs =>
+      show (match synthDivM (c :: cs) a with
+        | (q, r) => r :: polyShiftAuxM f q a) = _
+      rw [synthDivM_eq]
+      rcases h : synthDiv (c :: cs) a with ⟨q, r⟩
+      show r :: polyShiftAuxM f q a =
+        (synthDiv (c :: cs) a).2 :: polyShiftAux f (synthDiv (c :: cs) a).1 a
+      rw [h, ih]
+
+def polyShiftM (C : List Int) (a : Int) : List Int :=
+  polyShiftAuxM C.length C a
+
+theorem polyShiftM_eq (C : List Int) (a : Int) : polyShiftM C a = polyShift C a :=
+  polyShiftAuxM_eq C.length C a
+
+def checkCoverM (C : List Int) (lo hi : Int) : List Int → Bool
+  | [] => decide (hi < lo)
+  | w :: ws =>
+    decide (0 ≤ w) && decide (0 ≤ (hornerIv (polyShiftM C lo) 0 w).1) &&
+      checkCoverM C (lo + w + 1) hi ws
+
+theorem checkCoverM_eq (C : List Int) : ∀ (ws : List Int) (lo hi : Int),
+    checkCoverM C lo hi ws = checkCover C lo hi ws := by
+  intro ws
+  induction ws with
+  | nil => intro lo hi; rfl
+  | cons w ws ih =>
+    intro lo hi
+    show (decide (0 ≤ w) && decide (0 ≤ (hornerIv (polyShiftM C lo) 0 w).1) &&
+      checkCoverM C (lo + w + 1) hi ws) = _
+    rw [polyShiftM_eq, ih]
+    rfl
+
+theorem checkCoverM_sound (C : List Int) (ws : List Int) (lo hi : Int)
+    (h : checkCoverM C lo hi ws = true) :
+    ∀ x : Int, lo ≤ x → x ≤ hi → 0 ≤ evalPoly C x := by
+  refine checkCover_sound C ws lo hi ?_
+  rw [← checkCoverM_eq]
+  exact h
+
+end LnPoly
diff --git a/formal/ln/LnProof/LnProof/Stages.lean b/formal/ln/LnProof/LnProof/Stages.lean
new file mode 100644
index 000000000..9b1a5f466
--- /dev/null
+++ b/formal/ln/LnProof/LnProof/Stages.lean
@@ -0,0 +1,658 @@
+import LnProof.BridgeDiv
+import LnProof.Poly
+
+/-!
+# Horner stage lemmas
+
+Each Horner stage of the model's `p`/`q` evaluation is sandwiched against an
+exact integer polynomial (`PPc` at scale `2^358`, `QQc` at scale `2^386`,
+coefficients low-order first) with a one-sided truncation slop: the
+renormalizing shifts only ever round down. Stage value intervals are concrete
+literals checked by `omega` as the chain is built, so a wrong literal fails
+the build. All scale factors are spelled as numerals (the kernel must not
+unfold `Int` powers of this size).
+-/
+
+namespace LnGeneratedModel
+
+open LnPoly
+
+def Sc : Nat := 56022770974786139918731938227
+def P4c : Nat := 4542704643877621417440
+def P3c : Nat := 287579185854221620442209346
+def P2c : Nat := 75095323053466847604974837616
+def P1c : Nat := 55801080067338082314461576444
+def C0c : Nat := 13972178604861559108982341686387
+def Q4c : Nat := 4299840983308505679614339668444
+def Q3c : Nat := 281702237671157106654810095
+def Q2c : Nat := 53722296096946541673620529149
+def Q1c : Nat := 16613772931382142257332678212554
+def Kc : Nat := 7450580596923828125
+def LN2c : Nat := 3273295013171879848905889459134067659407864468560
+def BIASc : Nat := 116873961749927929127912020551506849476088469858172
+
+/-- Largest |z| over the mantissa domain. -/
+def Zc : Nat := 217494458298375249691265569565
+
+theorem Zc_def : Zc = ((Sc - 2 ^ 95) * 2 ^ 100) / (2 ^ 95 + Sc) := by decide
+
+/-- Largest `u`. -/
+def Uc : Nat := 2332259347626381040680638252
+
+theorem Uc_def : Uc = Zc * Zc / 2 ^ 104 := by decide
+
+def SLOPP1 : Int := 19342813113834066795298815
+def SLOPP2 : Int := 69057699520159162110141648894228821086113826043390164
+def SLOPP3 : Int := 3955335645359842146091088249708864238312943862544998285589320092854593149420376176
+def SLOPPc : Int := 9812004177583774588419572070418085567299104489606785913494676545320496277998160323177880419302954869373068096
+def SLOPQ1 : Int := 0
+def SLOPQ2 : Int := 10384593717069655257060992658440192
+def SLOPQ3 : Int := 37075070122009811747227592743150621693886984893447588011835392
+def SLOPQ4 : Int := 90447264747239228016757156189751796048865736349899133297194457280325857683859743526879232
+def SLOPQc : Int := 368554503459564650655355223502937602070057924280391756343149979867298567572166014505521622720564112305091187444809728
+
+/-! ## Pipeline words -/
+
+def zWord (m : Nat) : Nat := evmSdiv (evmShl 100 (evmSub Sc m)) (evmAdd m Sc)
+
+def uWord (z : Nat) : Nat := evmShr 104 (evmMul z z)
+
+def pS1 (u : Nat) : Nat := evmSub (evmShr 84 (evmMul P4c u)) P3c
+def pS2 (u : Nat) : Nat := evmAdd (evmSar 90 (evmMul (pS1 u) u)) P2c
+def pS3 (u : Nat) : Nat := evmSub (evmSar 97 (evmMul (pS2 u) u)) P1c
+def pS4 (u : Nat) : Nat := evmAdd (evmSar 87 (evmMul (pS3 u) u)) C0c
+
+def qS1 (u : Nat) : Nat := evmSub u Q4c
+def qS2 (u : Nat) : Nat := evmAdd (evmSar 113 (evmMul (qS1 u) u)) Q3c
+def qS3 (u : Nat) : Nat := evmSub (evmSar 90 (evmMul (qS2 u) u)) Q2c
+def qS4 (u : Nat) : Nat := evmAdd (evmSar 88 (evmMul (qS3 u) u)) Q1c
+def qS5 (u : Nat) : Nat := evmSub (evmSar 95 (evmMul (qS4 u) u)) C0c
+
+/-! ## Suffix polynomials (numeral coefficients) -/
+
+def PP1c : List Int := [(-(5562590447406762316237749022682109217671325297934336 : Int) : Int), (4542704643877621417440 : Int)]
+def PP2c : List Int := (1798175745614395766239082622521528960720477616324792863638563111730471590055378944 : Int) :: PP1c
+def PP3c : List Int := (-(211724653123857194763950383720687822670307458715746667734762451892717657012841722322962591250252321890880192512 : Int) : Int) :: PP2c
+def PPc : List Int := (8203564106909714963200842018502018851024462725819431901516251320229929630934299039494945066816553616430456446611805193566972803059892092928 : Int) :: PP3c
+
+def QQ1c : List Int := [(-(4299840983308505679614339668444 : Int) : Int), (1 : Int)]
+def QQ2c : List Int := (2925363287404360843667081098480704995728827760271876675338240 : Int) :: QQ1c
+def QQ3c : List Int := (-(690627211385037298547738551962892852267586075469791719173459072596031701017399264062472192 : Int) : Int) :: QQ2c
+def QQ4c : List Int := (66099322585698201304896817119133314370855648754593283446756353822335972946493244703677923116935407234039976856169480192 : Int) :: QQ3c
+def QQc : List Int := (-(2202127471863542086976841246820549867195347718960342176144462014556523185327760268707187588705852038374958668534379582118318610928980329275922055168 : Int) : Int) :: QQ4c
+
+/-! ## Generic step helpers -/
+
+/-- Transfers a scaled sandwich through one multiplication by `u`. -/
+theorem scaled_mul_step {sv uv E SS slop U : Int}
+    (h1 : SS - slop ≤ sv * E) (h2 : sv * E ≤ SS)
+    (hu0 : 0 ≤ uv) (huU : uv ≤ U) (hslop : 0 ≤ slop) :
+    SS * uv - slop * U ≤ sv * uv * E ∧ sv * uv * E ≤ SS * uv := by
+  have e1 : sv * uv * E = sv * E * uv := by
+    rw [Int.mul_assoc, Int.mul_comm uv E, ← Int.mul_assoc]
+  have low : (SS - slop) * uv ≤ sv * E * uv := mul_le_mul_right_nonneg h1 hu0
+  have high : sv * E * uv ≤ SS * uv := mul_le_mul_right_nonneg h2 hu0
+  have expand : (SS - slop) * uv = SS * uv - slop * uv := by
+    rw [Int.sub_mul]
+  have slopmul : slop * uv ≤ slop * U := mul_le_mul_left_nonneg huU hslop
+  omega
+
+/-- Range of a product from ranges of the factors (second factor nonnegative). -/
+theorem mul_range {s u lo hi U : Int} (h1 : lo ≤ s) (h2 : s ≤ hi) (h3 : 0 ≤ u)
+    (h4 : u ≤ U) : min (lo * U) 0 ≤ s * u ∧ s * u ≤ max (hi * U) 0 := by
+  have hU : 0 ≤ U := by omega
+  constructor
+  · rcases Int.le_total 0 s with hs | hs
+    · have : 0 ≤ s * u := Int.mul_nonneg hs h3
+      omega
+    · have a1 : s * U ≤ s * u := mul_le_mul_left_nonpos h4 hs
+      have a2 : lo * U ≤ s * U := mul_le_mul_right_nonneg h1 hU
+      omega
+  · rcases Int.le_total 0 s with hs | hs
+    · have a1 : s * u ≤ s * U := mul_le_mul_left_nonneg h4 hs
+      have a2 : s * U ≤ hi * U := mul_le_mul_right_nonneg h2 hU
+      omega
+    · have a1 : s * u ≤ 0 * u := mul_le_mul_right_nonneg hs h3
+      rw [Int.zero_mul] at a1
+      omega
+
+theorem toInt_u {u : Nat} (h : u ≤ Uc) : toInt u = (u : Int) := by
+  refine toInt_of_lt ?_
+  simp only [Uc] at h
+  omega
+
+/-! ## q-chain stage 1 (exact) -/
+
+theorem qS1_facts {u : Nat} (hu : u ≤ Uc) :
+    qS1 u < 2 ^ 256 ∧
+    (-(4299840983308505679614339668444 : Int)) ≤ toInt (qS1 u) ∧
+    toInt (qS1 u) ≤ (-(4297508723960879298573659030192 : Int)) ∧
+    evalPoly QQ1c (u : Int) - SLOPQ1 ≤ toInt (qS1 u) * 1 ∧
+    toInt (qS1 u) * 1 ≤ evalPoly QQ1c (u : Int) := by
+  have htu : toInt u = (u : Int) := toInt_u hu
+  simp only [Uc] at hu
+  have hu256 : u < 2 ^ 256 := by omega
+  have hT : toInt (qS1 u) = (u : Int) - (4299840983308505679614339668444 : Int) := by
+    unfold qS1
+    have h2 : toInt Q4c = (4299840983308505679614339668444 : Int) := toInt_of_lt (by simp only [Q4c]; omega)
+    rw [← htu, ← h2]
+    refine evmSub_transport hu256 (by simp only [Q4c]; omega) ?_ ?_ <;>
+      rw [htu, h2] <;> simp only [ipow255] <;> omega
+  refine ⟨evmSub_lt _ _, ?_, ?_, ?_, ?_⟩
+  · rw [hT]; omega
+  · rw [hT]; omega
+  · rw [hT]
+    simp only [QQ1c, evalPoly, SLOPQ1]
+    omega
+  · rw [hT]
+    simp only [QQ1c, evalPoly]
+    omega
+
+/-! ## p-chain stage 1 -/
+
+theorem pS1_facts {u : Nat} (hu : u ≤ Uc) :
+    pS1 u < 2 ^ 256 ∧
+    (-(287579185854221620442209346 : Int)) ≤ toInt (pS1 u) ∧
+    toInt (pS1 u) ≤ (-(287031449322475267106929263 : Int)) ∧
+    evalPoly PP1c (u : Int) - SLOPP1 ≤ toInt (pS1 u) * 19342813113834066795298816 ∧
+    toInt (pS1 u) * 19342813113834066795298816 ≤ evalPoly PP1c (u : Int) := by
+  simp only [Uc] at hu
+  have hm1 : evmMul P4c u = P4c * u := by
+    unfold evmMul u256
+    simp only [word_mod_eq, P4c]
+    omega
+  have hm1lt : P4c * u < 2 ^ 256 := by simp only [P4c]; omega
+  have hd1 : evmShr 84 (evmMul P4c u) = P4c * u / 2 ^ 84 := by
+    rw [hm1]; exact evmShr_eq_div_84 hm1lt
+  have hT : toInt (pS1 u) = ((P4c * u / 2 ^ 84 : Nat) : Int) - (287579185854221620442209346 : Int) := by
+    unfold pS1
+    rw [hd1]
+    have h1 : toInt (P4c * u / 2 ^ 84 : Nat) = ((P4c * u / 2 ^ 84 : Nat) : Int) :=
+      toInt_of_lt (by simp only [P4c]; omega)
+    have h2 : toInt P3c = (287579185854221620442209346 : Int) := toInt_of_lt (by simp only [P3c]; omega)
+    rw [← h1, ← h2]
+    refine evmSub_transport (by simp only [P4c]; omega) (by simp only [P3c]; omega) ?_ ?_ <;>
+      rw [h1, h2] <;> simp only [P4c, ipow255] <;> omega
+  refine ⟨evmSub_lt _ _, ?_, ?_, ?_, ?_⟩
+  · rw [hT]; simp only [P4c]; omega
+  · rw [hT]; simp only [P4c]; omega
+  · rw [hT]
+    simp only [PP1c, evalPoly, SLOPP1, P4c]
+    omega
+  · rw [hT]
+    simp only [PP1c, evalPoly, P4c]
+    omega
+
+theorem pS2_facts {u : Nat} (hu : u ≤ Uc) :
+    pS2 u < 2 ^ 256 ∧
+    (74553528440556136823910938445 : Int) ≤ toInt (pS2 u) ∧
+    toInt (pS2 u) ≤ (75095323053466847604974837616 : Int) ∧
+    evalPoly PP2c (u : Int) - SLOPP2 ≤ toInt (pS2 u) * 23945242826029513411849172299223580994042798784118784 ∧
+    toInt (pS2 u) * 23945242826029513411849172299223580994042798784118784 ≤ evalPoly PP2c (u : Int) := by
+  obtain ⟨hw, hlo, hhi, hsl, hsh⟩ := pS1_facts hu
+  have htu : toInt u = (u : Int) := toInt_u hu
+  simp only [Uc] at hu
+  have hu256 : u < 2 ^ 256 := by omega
+  have hu0 : (0 : Int) ≤ (u : Int) := by omega
+  have huU : (u : Int) ≤ 2332259347626381040680638252 := by omega
+  have hrange := mul_range hlo hhi hu0 huU
+  have hmT : toInt (evmMul (pS1 u) u) = toInt (pS1 u) * (u : Int) := by
+    rw [← htu]
+    refine evmMul_transport hw hu256 ?_ ?_ <;> rw [htu] <;>
+      simp only [ipow255] <;> omega
+  obtain ⟨hwm, hs1, hs2⟩ := evmSar_sandwich_90 (evmMul_lt (pS1 u) u)
+  rw [hmT] at hs1 hs2
+  have hdb : (-(541794612910710781063899171 : Int)) ≤ toInt (evmSar 90 (evmMul (pS1 u) u)) ∧
+      toInt (evmSar 90 (evmMul (pS1 u) u)) ≤ (0 : Int) := by
+    clear hsl hsh hmT hw htu hu256 hu
+    generalize hB : toInt (pS1 u) * (u : Int) = B at hs1 hs2 hrange
+    generalize hD : toInt (evmSar 90 (evmMul (pS1 u) u)) = D at hs1 hs2 ⊢
+    omega
+  have hcT : toInt P2c = (75095323053466847604974837616 : Int) := toInt_of_lt (by simp only [P2c]; omega)
+  have hT : toInt (pS2 u) =
+      toInt (evmSar 90 (evmMul (pS1 u) u)) + (75095323053466847604974837616 : Int) := by
+    unfold pS2
+    rw [← hcT]
+    refine evmAdd_transport hwm (by simp only [P2c]; omega) ?_ ?_
+    · clear hsl hsh hrange hs1 hs2 hmT
+      rw [hcT]
+      simp only [ipow255]
+      omega
+    · clear hsl hsh hrange hs1 hs2 hmT
+      rw [hcT]
+      simp only [ipow255]
+      omega
+  have hstep := scaled_mul_step hsl hsh hu0 huU (by simp only [SLOPP1]; omega)
+  have ec : evalPoly PP2c (u : Int) =
+      (1798175745614395766239082622521528960720477616324792863638563111730471590055378944 : Int) + evalPoly PP1c (u : Int) * (u : Int) := by
+    show (1798175745614395766239082622521528960720477616324792863638563111730471590055378944 : Int) + (u : Int) * evalPoly PP1c (u : Int) = _
+    rw [Int.mul_comm]
+  refine ⟨evmAdd_lt _ _, ?_, ?_, ?_, ?_⟩
+  · rw [hT]
+    clear hsl hsh hrange hs1 hs2 hstep ec hmT
+    omega
+  · rw [hT]
+    clear hsl hsh hrange hs1 hs2 hstep ec hmT
+    omega
+  · rw [hT, ec]
+    clear hrange hdb hsl hsh hmT hwm hw htu hu256 hcT hu hlo hhi
+    simp only [SLOPP1] at hstep
+    simp only [SLOPP2]
+    generalize hB : toInt (pS1 u) * (u : Int) = B at hs1 hs2 hstep
+    generalize hE : evalPoly PP1c (u : Int) * (u : Int) = E at hstep ⊢
+    generalize hD : toInt (evmSar 90 (evmMul (pS1 u) u)) = D at hs1 hs2 ⊢
+    omega
+  · rw [hT, ec]
+    clear hrange hdb hsl hsh hmT hwm hw htu hu256 hcT hu hlo hhi
+    simp only [SLOPP1] at hstep
+    generalize hB : toInt (pS1 u) * (u : Int) = B at hs1 hs2 hstep
+    generalize hE : evalPoly PP1c (u : Int) * (u : Int) = E at hstep ⊢
+    generalize hD : toInt (evmSar 90 (evmMul (pS1 u) u)) = D at hs1 hs2 ⊢
+    omega
+
+theorem pS3_facts {u : Nat} (hu : u ≤ Uc) :
+    pS3 u < 2 ^ 256 ∧
+    (-(55801080067338082314461576444 : Int)) ≤ toInt (pS3 u) ∧
+    toInt (pS3 u) ≤ (-(54695780110880438990702023699 : Int)) ∧
+    evalPoly PP3c (u : Int) - SLOPP3 ≤ toInt (pS3 u) * 3794275180128377091639574036764685364535950857523710002444946112771297432041422848 ∧
+    toInt (pS3 u) * 3794275180128377091639574036764685364535950857523710002444946112771297432041422848 ≤ evalPoly PP3c (u : Int) := by
+  obtain ⟨hw, hlo, hhi, hsl, hsh⟩ := pS2_facts hu
+  have htu : toInt u = (u : Int) := toInt_u hu
+  simp only [Uc] at hu
+  have hu256 : u < 2 ^ 256 := by omega
+  have hu0 : (0 : Int) ≤ (u : Int) := by omega
+  have huU : (u : Int) ≤ 2332259347626381040680638252 := by omega
+  have hrange := mul_range hlo hhi hu0 huU
+  have hmT : toInt (evmMul (pS2 u) u) = toInt (pS2 u) * (u : Int) := by
+    rw [← htu]
+    refine evmMul_transport hw hu256 ?_ ?_ <;> rw [htu] <;>
+      simp only [ipow255] <;> omega
+  obtain ⟨hwm, hs1, hs2⟩ := evmSar_sandwich_97 (evmMul_lt (pS2 u) u)
+  rw [hmT] at hs1 hs2
+  have hdb : (0 : Int) ≤ toInt (evmSar 97 (evmMul (pS2 u) u)) ∧
+      toInt (evmSar 97 (evmMul (pS2 u) u)) ≤ (1105299956457643323759552745 : Int) := by
+    clear hsl hsh hmT hw htu hu256 hu
+    generalize hB : toInt (pS2 u) * (u : Int) = B at hs1 hs2 hrange
+    generalize hD : toInt (evmSar 97 (evmMul (pS2 u) u)) = D at hs1 hs2 ⊢
+    omega
+  have hcT : toInt P1c = (55801080067338082314461576444 : Int) := toInt_of_lt (by simp only [P1c]; omega)
+  have hT : toInt (pS3 u) =
+      toInt (evmSar 97 (evmMul (pS2 u) u)) - (55801080067338082314461576444 : Int) := by
+    unfold pS3
+    rw [← hcT]
+    refine evmSub_transport hwm (by simp only [P1c]; omega) ?_ ?_
+    · clear hsl hsh hrange hs1 hs2 hmT
+      rw [hcT]
+      simp only [ipow255]
+      omega
+    · clear hsl hsh hrange hs1 hs2 hmT
+      rw [hcT]
+      simp only [ipow255]
+      omega
+  have hstep := scaled_mul_step hsl hsh hu0 huU (by simp only [SLOPP2]; omega)
+  have ec : evalPoly PP3c (u : Int) =
+      (-(211724653123857194763950383720687822670307458715746667734762451892717657012841722322962591250252321890880192512 : Int)) + evalPoly PP2c (u : Int) * (u : Int) := by
+    show (-(211724653123857194763950383720687822670307458715746667734762451892717657012841722322962591250252321890880192512 : Int)) + (u : Int) * evalPoly PP2c (u : Int) = _
+    rw [Int.mul_comm]
+  refine ⟨evmSub_lt _ _, ?_, ?_, ?_, ?_⟩
+  · rw [hT]
+    clear hsl hsh hrange hs1 hs2 hstep ec hmT
+    omega
+  · rw [hT]
+    clear hsl hsh hrange hs1 hs2 hstep ec hmT
+    omega
+  · rw [hT, ec]
+    clear hrange hdb hsl hsh hmT hwm hw htu hu256 hcT hu hlo hhi
+    simp only [SLOPP2] at hstep
+    simp only [SLOPP3]
+    generalize hB : toInt (pS2 u) * (u : Int) = B at hs1 hs2 hstep
+    generalize hE : evalPoly PP2c (u : Int) * (u : Int) = E at hstep ⊢
+    generalize hD : toInt (evmSar 97 (evmMul (pS2 u) u)) = D at hs1 hs2 ⊢
+    omega
+  · rw [hT, ec]
+    clear hrange hdb hsl hsh hmT hwm hw htu hu256 hcT hu hlo hhi
+    simp only [SLOPP2] at hstep
+    generalize hB : toInt (pS2 u) * (u : Int) = B at hs1 hs2 hstep
+    generalize hE : evalPoly PP2c (u : Int) * (u : Int) = E at hstep ⊢
+    generalize hD : toInt (evmSar 97 (evmMul (pS2 u) u)) = D at hs1 hs2 ⊢
+    omega
+
+theorem pS4_facts {u : Nat} (hu : u ≤ Uc) :
+    pS4 u < 2 ^ 256 ∧
+    (13131151825116561693704478250792 : Int) ≤ toInt (pS4 u) ∧
+    toInt (pS4 u) ≤ (13972178604861559108982341686387 : Int) ∧
+    evalPoly PPc (u : Int) - SLOPPc ≤ toInt (pS4 u) * 587135645693458306972370149197334256843920637227079967676822742883052256278652110865924749596192175757983744 ∧
+    toInt (pS4 u) * 587135645693458306972370149197334256843920637227079967676822742883052256278652110865924749596192175757983744 ≤ evalPoly PPc (u : Int) := by
+  obtain ⟨hw, hlo, hhi, hsl, hsh⟩ := pS3_facts hu
+  have htu : toInt u = (u : Int) := toInt_u hu
+  simp only [Uc] at hu
+  have hu256 : u < 2 ^ 256 := by omega
+  have hu0 : (0 : Int) ≤ (u : Int) := by omega
+  have huU : (u : Int) ≤ 2332259347626381040680638252 := by omega
+  have hrange := mul_range hlo hhi hu0 huU
+  have hmT : toInt (evmMul (pS3 u) u) = toInt (pS3 u) * (u : Int) := by
+    rw [← htu]
+    refine evmMul_transport hw hu256 ?_ ?_ <;> rw [htu] <;>
+      simp only [ipow255] <;> omega
+  obtain ⟨hwm, hs1, hs2⟩ := evmSar_sandwich_87 (evmMul_lt (pS3 u) u)
+  rw [hmT] at hs1 hs2
+  have hdb : (-(841026779744997415277863435595 : Int)) ≤ toInt (evmSar 87 (evmMul (pS3 u) u)) ∧
+      toInt (evmSar 87 (evmMul (pS3 u) u)) ≤ (0 : Int) := by
+    clear hsl hsh hmT hw htu hu256 hu
+    generalize hB : toInt (pS3 u) * (u : Int) = B at hs1 hs2 hrange
+    generalize hD : toInt (evmSar 87 (evmMul (pS3 u) u)) = D at hs1 hs2 ⊢
+    omega
+  have hcT : toInt C0c = (13972178604861559108982341686387 : Int) := toInt_of_lt (by simp only [C0c]; omega)
+  have hT : toInt (pS4 u) =
+      toInt (evmSar 87 (evmMul (pS3 u) u)) + (13972178604861559108982341686387 : Int) := by
+    unfold pS4
+    rw [← hcT]
+    refine evmAdd_transport hwm (by simp only [C0c]; omega) ?_ ?_
+    · clear hsl hsh hrange hs1 hs2 hmT
+      rw [hcT]
+      simp only [ipow255]
+      omega
+    · clear hsl hsh hrange hs1 hs2 hmT
+      rw [hcT]
+      simp only [ipow255]
+      omega
+  have hstep := scaled_mul_step hsl hsh hu0 huU (by simp only [SLOPP3]; omega)
+  have ec : evalPoly PPc (u : Int) =
+      (8203564106909714963200842018502018851024462725819431901516251320229929630934299039494945066816553616430456446611805193566972803059892092928 : Int) + evalPoly PP3c (u : Int) * (u : Int) := by
+    show (8203564106909714963200842018502018851024462725819431901516251320229929630934299039494945066816553616430456446611805193566972803059892092928 : Int) + (u : Int) * evalPoly PP3c (u : Int) = _
+    rw [Int.mul_comm]
+  refine ⟨evmAdd_lt _ _, ?_, ?_, ?_, ?_⟩
+  · rw [hT]
+    clear hsl hsh hrange hs1 hs2 hstep ec hmT
+    omega
+  · rw [hT]
+    clear hsl hsh hrange hs1 hs2 hstep ec hmT
+    omega
+  · rw [hT, ec]
+    clear hrange hdb hsl hsh hmT hwm hw htu hu256 hcT hu hlo hhi
+    simp only [SLOPP3] at hstep
+    simp only [SLOPPc]
+    generalize hB : toInt (pS3 u) * (u : Int) = B at hs1 hs2 hstep
+    generalize hE : evalPoly PP3c (u : Int) * (u : Int) = E at hstep ⊢
+    generalize hD : toInt (evmSar 87 (evmMul (pS3 u) u)) = D at hs1 hs2 ⊢
+    omega
+  · rw [hT, ec]
+    clear hrange hdb hsl hsh hmT hwm hw htu hu256 hcT hu hlo hhi
+    simp only [SLOPP3] at hstep
+    generalize hB : toInt (pS3 u) * (u : Int) = B at hs1 hs2 hstep
+    generalize hE : evalPoly PP3c (u : Int) * (u : Int) = E at hstep ⊢
+    generalize hD : toInt (evmSar 87 (evmMul (pS3 u) u)) = D at hs1 hs2 ⊢
+    omega
+
+theorem qS2_facts {u : Nat} (hu : u ≤ Uc) :
+    qS2 u < 2 ^ 256 ∧
+    (280736543239593144629477427 : Int) ≤ toInt (qS2 u) ∧
+    toInt (qS2 u) ≤ (281702237671157106654810095 : Int) ∧
+    evalPoly QQ2c (u : Int) - SLOPQ2 ≤ toInt (qS2 u) * 10384593717069655257060992658440192 ∧
+    toInt (qS2 u) * 10384593717069655257060992658440192 ≤ evalPoly QQ2c (u : Int) := by
+  obtain ⟨hw, hlo, hhi, hsl, hsh⟩ := qS1_facts hu
+  have htu : toInt u = (u : Int) := toInt_u hu
+  simp only [Uc] at hu
+  have hu256 : u < 2 ^ 256 := by omega
+  have hu0 : (0 : Int) ≤ (u : Int) := by omega
+  have huU : (u : Int) ≤ 2332259347626381040680638252 := by omega
+  have hrange := mul_range hlo hhi hu0 huU
+  have hmT : toInt (evmMul (qS1 u) u) = toInt (qS1 u) * (u : Int) := by
+    rw [← htu]
+    refine evmMul_transport hw hu256 ?_ ?_ <;> rw [htu] <;>
+      simp only [ipow255] <;> omega
+  obtain ⟨hwm, hs1, hs2⟩ := evmSar_sandwich_113 (evmMul_lt (qS1 u) u)
+  rw [hmT] at hs1 hs2
+  have hdb : (-(965694431563962025332668 : Int)) ≤ toInt (evmSar 113 (evmMul (qS1 u) u)) ∧
+      toInt (evmSar 113 (evmMul (qS1 u) u)) ≤ (0 : Int) := by
+    clear hsl hsh hmT hw htu hu256 hu
+    generalize hB : toInt (qS1 u) * (u : Int) = B at hs1 hs2 hrange
+    generalize hD : toInt (evmSar 113 (evmMul (qS1 u) u)) = D at hs1 hs2 ⊢
+    omega
+  have hcT : toInt Q3c = (281702237671157106654810095 : Int) := toInt_of_lt (by simp only [Q3c]; omega)
+  have hT : toInt (qS2 u) =
+      toInt (evmSar 113 (evmMul (qS1 u) u)) + (281702237671157106654810095 : Int) := by
+    unfold qS2
+    rw [← hcT]
+    refine evmAdd_transport hwm (by simp only [Q3c]; omega) ?_ ?_
+    · clear hsl hsh hrange hs1 hs2 hmT
+      rw [hcT]
+      simp only [ipow255]
+      omega
+    · clear hsl hsh hrange hs1 hs2 hmT
+      rw [hcT]
+      simp only [ipow255]
+      omega
+  have hstep := scaled_mul_step hsl hsh hu0 huU (by simp only [SLOPQ1]; omega)
+  have ec : evalPoly QQ2c (u : Int) =
+      (2925363287404360843667081098480704995728827760271876675338240 : Int) + evalPoly QQ1c (u : Int) * (u : Int) := by
+    show (2925363287404360843667081098480704995728827760271876675338240 : Int) + (u : Int) * evalPoly QQ1c (u : Int) = _
+    rw [Int.mul_comm]
+  refine ⟨evmAdd_lt _ _, ?_, ?_, ?_, ?_⟩
+  · rw [hT]
+    clear hsl hsh hrange hs1 hs2 hstep ec hmT
+    omega
+  · rw [hT]
+    clear hsl hsh hrange hs1 hs2 hstep ec hmT
+    omega
+  · rw [hT, ec]
+    clear hrange hdb hsl hsh hmT hwm hw htu hu256 hcT hu hlo hhi
+    simp only [SLOPQ1] at hstep
+    simp only [SLOPQ2]
+    generalize hB : toInt (qS1 u) * (u : Int) = B at hs1 hs2 hstep
+    generalize hE : evalPoly QQ1c (u : Int) * (u : Int) = E at hstep ⊢
+    generalize hD : toInt (evmSar 113 (evmMul (qS1 u) u)) = D at hs1 hs2 ⊢
+    omega
+  · rw [hT, ec]
+    clear hrange hdb hsl hsh hmT hwm hw htu hu256 hcT hu hlo hhi
+    simp only [SLOPQ1] at hstep
+    generalize hB : toInt (qS1 u) * (u : Int) = B at hs1 hs2 hstep
+    generalize hE : evalPoly QQ1c (u : Int) * (u : Int) = E at hstep ⊢
+    generalize hD : toInt (evmSar 113 (evmMul (qS1 u) u)) = D at hs1 hs2 ⊢
+    omega
+
+theorem qS3_facts {u : Nat} (hu : u ≤ Uc) :
+    qS3 u < 2 ^ 256 ∧
+    (-(53722296096946541673620529149 : Int)) ≤ toInt (qS3 u) ∧
+    toInt (qS3 u) ≤ (-(53191573560954338523077576765 : Int)) ∧
+    evalPoly QQ3c (u : Int) - SLOPQ3 ≤ toInt (qS3 u) * 12855504354071922204335696738729300820177623950262342682411008 ∧
+    toInt (qS3 u) * 12855504354071922204335696738729300820177623950262342682411008 ≤ evalPoly QQ3c (u : Int) := by
+  obtain ⟨hw, hlo, hhi, hsl, hsh⟩ := qS2_facts hu
+  have htu : toInt u = (u : Int) := toInt_u hu
+  simp only [Uc] at hu
+  have hu256 : u < 2 ^ 256 := by omega
+  have hu0 : (0 : Int) ≤ (u : Int) := by omega
+  have huU : (u : Int) ≤ 2332259347626381040680638252 := by omega
+  have hrange := mul_range hlo hhi hu0 huU
+  have hmT : toInt (evmMul (qS2 u) u) = toInt (qS2 u) * (u : Int) := by
+    rw [← htu]
+    refine evmMul_transport hw hu256 ?_ ?_ <;> rw [htu] <;>
+      simp only [ipow255] <;> omega
+  obtain ⟨hwm, hs1, hs2⟩ := evmSar_sandwich_90 (evmMul_lt (qS2 u) u)
+  rw [hmT] at hs1 hs2
+  have hdb : (0 : Int) ≤ toInt (evmSar 90 (evmMul (qS2 u) u)) ∧
+      toInt (evmSar 90 (evmMul (qS2 u) u)) ≤ (530722535992203150542952384 : Int) := by
+    clear hsl hsh hmT hw htu hu256 hu
+    generalize hB : toInt (qS2 u) * (u : Int) = B at hs1 hs2 hrange
+    generalize hD : toInt (evmSar 90 (evmMul (qS2 u) u)) = D at hs1 hs2 ⊢
+    omega
+  have hcT : toInt Q2c = (53722296096946541673620529149 : Int) := toInt_of_lt (by simp only [Q2c]; omega)
+  have hT : toInt (qS3 u) =
+      toInt (evmSar 90 (evmMul (qS2 u) u)) - (53722296096946541673620529149 : Int) := by
+    unfold qS3
+    rw [← hcT]
+    refine evmSub_transport hwm (by simp only [Q2c]; omega) ?_ ?_
+    · clear hsl hsh hrange hs1 hs2 hmT
+      rw [hcT]
+      simp only [ipow255]
+      omega
+    · clear hsl hsh hrange hs1 hs2 hmT
+      rw [hcT]
+      simp only [ipow255]
+      omega
+  have hstep := scaled_mul_step hsl hsh hu0 huU (by simp only [SLOPQ2]; omega)
+  have ec : evalPoly QQ3c (u : Int) =
+      (-(690627211385037298547738551962892852267586075469791719173459072596031701017399264062472192 : Int)) + evalPoly QQ2c (u : Int) * (u : Int) := by
+    show (-(690627211385037298547738551962892852267586075469791719173459072596031701017399264062472192 : Int)) + (u : Int) * evalPoly QQ2c (u : Int) = _
+    rw [Int.mul_comm]
+  refine ⟨evmSub_lt _ _, ?_, ?_, ?_, ?_⟩
+  · rw [hT]
+    clear hsl hsh hrange hs1 hs2 hstep ec hmT
+    omega
+  · rw [hT]
+    clear hsl hsh hrange hs1 hs2 hstep ec hmT
+    omega
+  · rw [hT, ec]
+    clear hrange hdb hsl hsh hmT hwm hw htu hu256 hcT hu hlo hhi
+    simp only [SLOPQ2] at hstep
+    simp only [SLOPQ3]
+    generalize hB : toInt (qS2 u) * (u : Int) = B at hs1 hs2 hstep
+    generalize hE : evalPoly QQ2c (u : Int) * (u : Int) = E at hstep ⊢
+    generalize hD : toInt (evmSar 90 (evmMul (qS2 u) u)) = D at hs1 hs2 ⊢
+    omega
+  · rw [hT, ec]
+    clear hrange hdb hsl hsh hmT hwm hw htu hu256 hcT hu hlo hhi
+    simp only [SLOPQ2] at hstep
+    generalize hB : toInt (qS2 u) * (u : Int) = B at hs1 hs2 hstep
+    generalize hE : evalPoly QQ2c (u : Int) * (u : Int) = E at hstep ⊢
+    generalize hD : toInt (evmSar 90 (evmMul (qS2 u) u)) = D at hs1 hs2 ⊢
+    omega
+
+theorem qS4_facts {u : Nat} (hu : u ≤ Uc) :
+    qS4 u < 2 ^ 256 ∧
+    (16208925125278758204286268920273 : Int) ≤ toInt (qS4 u) ∧
+    toInt (qS4 u) ≤ (16613772931382142257332678212554 : Int) ∧
+    evalPoly QQ4c (u : Int) - SLOPQ4 ≤ toInt (qS4 u) * 3978585891278293137243057985174566720803649206378781739523711815145275976100267004264448 ∧
+    toInt (qS4 u) * 3978585891278293137243057985174566720803649206378781739523711815145275976100267004264448 ≤ evalPoly QQ4c (u : Int) := by
+  obtain ⟨hw, hlo, hhi, hsl, hsh⟩ := qS3_facts hu
+  have htu : toInt u = (u : Int) := toInt_u hu
+  simp only [Uc] at hu
+  have hu256 : u < 2 ^ 256 := by omega
+  have hu0 : (0 : Int) ≤ (u : Int) := by omega
+  have huU : (u : Int) ≤ 2332259347626381040680638252 := by omega
+  have hrange := mul_range hlo hhi hu0 huU
+  have hmT : toInt (evmMul (qS3 u) u) = toInt (qS3 u) * (u : Int) := by
+    rw [← htu]
+    refine evmMul_transport hw hu256 ?_ ?_ <;> rw [htu] <;>
+      simp only [ipow255] <;> omega
+  obtain ⟨hwm, hs1, hs2⟩ := evmSar_sandwich_88 (evmMul_lt (qS3 u) u)
+  rw [hmT] at hs1 hs2
+  have hdb : (-(404847806103384053046409292281 : Int)) ≤ toInt (evmSar 88 (evmMul (qS3 u) u)) ∧
+      toInt (evmSar 88 (evmMul (qS3 u) u)) ≤ (0 : Int) := by
+    clear hsl hsh hmT hw htu hu256 hu
+    generalize hB : toInt (qS3 u) * (u : Int) = B at hs1 hs2 hrange
+    generalize hD : toInt (evmSar 88 (evmMul (qS3 u) u)) = D at hs1 hs2 ⊢
+    omega
+  have hcT : toInt Q1c = (16613772931382142257332678212554 : Int) := toInt_of_lt (by simp only [Q1c]; omega)
+  have hT : toInt (qS4 u) =
+      toInt (evmSar 88 (evmMul (qS3 u) u)) + (16613772931382142257332678212554 : Int) := by
+    unfold qS4
+    rw [← hcT]
+    refine evmAdd_transport hwm (by simp only [Q1c]; omega) ?_ ?_
+    · clear hsl hsh hrange hs1 hs2 hmT
+      rw [hcT]
+      simp only [ipow255]
+      omega
+    · clear hsl hsh hrange hs1 hs2 hmT
+      rw [hcT]
+      simp only [ipow255]
+      omega
+  have hstep := scaled_mul_step hsl hsh hu0 huU (by simp only [SLOPQ3]; omega)
+  have ec : evalPoly QQ4c (u : Int) =
+      (66099322585698201304896817119133314370855648754593283446756353822335972946493244703677923116935407234039976856169480192 : Int) + evalPoly QQ3c (u : Int) * (u : Int) := by
+    show (66099322585698201304896817119133314370855648754593283446756353822335972946493244703677923116935407234039976856169480192 : Int) + (u : Int) * evalPoly QQ3c (u : Int) = _
+    rw [Int.mul_comm]
+  refine ⟨evmAdd_lt _ _, ?_, ?_, ?_, ?_⟩
+  · rw [hT]
+    clear hsl hsh hrange hs1 hs2 hstep ec hmT
+    omega
+  · rw [hT]
+    clear hsl hsh hrange hs1 hs2 hstep ec hmT
+    omega
+  · rw [hT, ec]
+    clear hrange hdb hsl hsh hmT hwm hw htu hu256 hcT hu hlo hhi
+    simp only [SLOPQ3] at hstep
+    simp only [SLOPQ4]
+    generalize hB : toInt (qS3 u) * (u : Int) = B at hs1 hs2 hstep
+    generalize hE : evalPoly QQ3c (u : Int) * (u : Int) = E at hstep ⊢
+    generalize hD : toInt (evmSar 88 (evmMul (qS3 u) u)) = D at hs1 hs2 ⊢
+    omega
+  · rw [hT, ec]
+    clear hrange hdb hsl hsh hmT hwm hw htu hu256 hcT hu hlo hhi
+    simp only [SLOPQ3] at hstep
+    generalize hB : toInt (qS3 u) * (u : Int) = B at hs1 hs2 hstep
+    generalize hE : evalPoly QQ3c (u : Int) * (u : Int) = E at hstep ⊢
+    generalize hD : toInt (evmSar 88 (evmMul (qS3 u) u)) = D at hs1 hs2 ⊢
+    omega
+
+theorem qS5_facts {u : Nat} (hu : u ≤ Uc) :
+    qS5 u < 2 ^ 256 ∧
+    (-(13972178604861559108982341686387 : Int)) ≤ toInt (qS5 u) ∧
+    toInt (qS5 u) ≤ (-(12994050979812020140807993775673 : Int)) ∧
+    evalPoly QQc (u : Int) - SLOPQc ≤ toInt (qS5 u) * 157608024785577916849116160400574455220318957081861786671793173616982887085988842445657065019539662563226511961227264 ∧
+    toInt (qS5 u) * 157608024785577916849116160400574455220318957081861786671793173616982887085988842445657065019539662563226511961227264 ≤ evalPoly QQc (u : Int) := by
+  obtain ⟨hw, hlo, hhi, hsl, hsh⟩ := qS4_facts hu
+  have htu : toInt u = (u : Int) := toInt_u hu
+  simp only [Uc] at hu
+  have hu256 : u < 2 ^ 256 := by omega
+  have hu0 : (0 : Int) ≤ (u : Int) := by omega
+  have huU : (u : Int) ≤ 2332259347626381040680638252 := by omega
+  have hrange := mul_range hlo hhi hu0 huU
+  have hmT : toInt (evmMul (qS4 u) u) = toInt (qS4 u) * (u : Int) := by
+    rw [← htu]
+    refine evmMul_transport hw hu256 ?_ ?_ <;> rw [htu] <;>
+      simp only [ipow255] <;> omega
+  obtain ⟨hwm, hs1, hs2⟩ := evmSar_sandwich_95 (evmMul_lt (qS4 u) u)
+  rw [hmT] at hs1 hs2
+  have hdb : (0 : Int) ≤ toInt (evmSar 95 (evmMul (qS4 u) u)) ∧
+      toInt (evmSar 95 (evmMul (qS4 u) u)) ≤ (978127625049538968174347910714 : Int) := by
+    clear hsl hsh hmT hw htu hu256 hu
+    generalize hB : toInt (qS4 u) * (u : Int) = B at hs1 hs2 hrange
+    generalize hD : toInt (evmSar 95 (evmMul (qS4 u) u)) = D at hs1 hs2 ⊢
+    omega
+  have hcT : toInt C0c = (13972178604861559108982341686387 : Int) := toInt_of_lt (by simp only [C0c]; omega)
+  have hT : toInt (qS5 u) =
+      toInt (evmSar 95 (evmMul (qS4 u) u)) - (13972178604861559108982341686387 : Int) := by
+    unfold qS5
+    rw [← hcT]
+    refine evmSub_transport hwm (by simp only [C0c]; omega) ?_ ?_
+    · clear hsl hsh hrange hs1 hs2 hmT
+      rw [hcT]
+      simp only [ipow255]
+      omega
+    · clear hsl hsh hrange hs1 hs2 hmT
+      rw [hcT]
+      simp only [ipow255]
+      omega
+  have hstep := scaled_mul_step hsl hsh hu0 huU (by simp only [SLOPQ4]; omega)
+  have ec : evalPoly QQc (u : Int) =
+      (-(2202127471863542086976841246820549867195347718960342176144462014556523185327760268707187588705852038374958668534379582118318610928980329275922055168 : Int)) + evalPoly QQ4c (u : Int) * (u : Int) := by
+    show (-(2202127471863542086976841246820549867195347718960342176144462014556523185327760268707187588705852038374958668534379582118318610928980329275922055168 : Int)) + (u : Int) * evalPoly QQ4c (u : Int) = _
+    rw [Int.mul_comm]
+  refine ⟨evmSub_lt _ _, ?_, ?_, ?_, ?_⟩
+  · rw [hT]
+    clear hsl hsh hrange hs1 hs2 hstep ec hmT
+    omega
+  · rw [hT]
+    clear hsl hsh hrange hs1 hs2 hstep ec hmT
+    omega
+  · rw [hT, ec]
+    clear hrange hdb hsl hsh hmT hwm hw htu hu256 hcT hu hlo hhi
+    simp only [SLOPQ4] at hstep
+    simp only [SLOPQc]
+    generalize hB : toInt (qS4 u) * (u : Int) = B at hs1 hs2 hstep
+    generalize hE : evalPoly QQ4c (u : Int) * (u : Int) = E at hstep ⊢
+    generalize hD : toInt (evmSar 95 (evmMul (qS4 u) u)) = D at hs1 hs2 ⊢
+    omega
+  · rw [hT, ec]
+    clear hrange hdb hsl hsh hmT hwm hw htu hu256 hcT hu hlo hhi
+    simp only [SLOPQ4] at hstep
+    generalize hB : toInt (qS4 u) * (u : Int) = B at hs1 hs2 hstep
+    generalize hE : evalPoly QQ4c (u : Int) * (u : Int) = E at hstep ⊢
+    generalize hD : toInt (evmSar 95 (evmMul (qS4 u) u)) = D at hs1 hs2 ⊢
+    omega
+
+def pWordD (u : Nat) : Nat := pS4 u
+def qWordD (u : Nat) : Nat := qS5 u
+
+end LnGeneratedModel
diff --git a/formal/ln/LnProof/LnProof/StepMono.lean b/formal/ln/LnProof/LnProof/StepMono.lean
new file mode 100644
index 000000000..b8f47eab6
--- /dev/null
+++ b/formal/ln/LnProof/LnProof/StepMono.lean
@@ -0,0 +1,462 @@
+import LnProof.Certs
+
+/-!
+# The within-octave step
+
+`hAt v` is the model's quotient pipeline applied to an arbitrary `z`-value
+`v` (as a two's-complement word). This file proves it antitone over
+consecutive integers in `[-Zc, Zc]`: the same-`u` case is division
+monotonicity; the `u`-step cases are the `G1`/`G2` certificates pushed
+through the truncation sandwiches.
+-/
+
+namespace LnGeneratedModel
+
+open LnPoly
+
+def x1W (z : Nat) : Nat := evmSdiv (evmMul (pS4 (uWord z)) z) (qS5 (uWord z))
+
+def hAt (v : Int) : Nat := x1W (ofInt v)
+
+/-- Nat-level `u` of an integer `z`-value. -/
+def uVal (v : Int) : Nat := (v * v).toNat / 2 ^ 104
+
+theorem sq_bound {v Z : Int} (hZ : 0 ≤ Z) (h1 : -Z ≤ v) (h2 : v ≤ Z) :
+    0 ≤ v * v ∧ v * v ≤ Z * Z := by
+  rcases Int.le_total 0 v with hv | hv
+  · refine ⟨Int.mul_nonneg hv hv, ?_⟩
+    have a1 : v * v ≤ v * Z := mul_le_mul_left_nonneg h2 hv
+    have a2 : v * Z ≤ Z * Z := mul_le_mul_right_nonneg h2 hZ
+    omega
+  · have hnv : 0 ≤ -v := by omega
+    have e1 : v * v = -v * -v := by rw [Int.neg_mul_neg]
+    refine ⟨by rw [e1]; exact Int.mul_nonneg hnv hnv, ?_⟩
+    have a1 : -v * -v ≤ -v * Z := mul_le_mul_left_nonneg (by omega) hnv
+    have a2 : -v * Z ≤ Z * Z := mul_le_mul_right_nonneg (by omega) hZ
+    omega
+
+theorem zsq_facts (v : Int) (h1 : -(217494458298375249691265569570 : Int) ≤ v)
+    (h2 : v ≤ (217494458298375249691265569570 : Int)) :
+    toInt (evmMul (ofInt v) (ofInt v)) = v * v ∧
+      evmMul (ofInt v) (ofInt v) = (v * v).toNat := by
+  have hsq := sq_bound (by omega : (0:Int) ≤ 217494458298375249691265569570) h1 h2
+  have hb : -(2 ^ 255) ≤ v ∧ v < 2 ^ 255 := by
+    simp only [ipow255]; omega
+  have ht : toInt (ofInt v) = v := toInt_ofInt hb.1 hb.2
+  have hsqB : v * v < 2 ^ 255 := by
+    simp only [ipow255]
+    omega
+  have hT : toInt (evmMul (ofInt v) (ofInt v)) = v * v := by
+    have := evmMul_transport (ofInt_lt v) (ofInt_lt v)
+      (by rw [ht]; omega) (by rw [ht]; exact hsqB)
+    rw [ht] at this
+    exact this
+  refine ⟨hT, ?_⟩
+  have hlt : evmMul (ofInt v) (ofInt v) < 2 ^ 256 := evmMul_lt _ _
+  have ht2 : evmMul (ofInt v) (ofInt v) < 2 ^ 255 := by
+    have h' := hT
+    unfold toInt at h'
+    split at h' <;> simp only [ipow255, ipow256] at * <;> omega
+  have ht3 := toInt_of_lt ht2
+  omega
+
+theorem uWord_eq (v : Int) (h1 : -(217494458298375249691265569570 : Int) ≤ v)
+    (h2 : v ≤ (217494458298375249691265569570 : Int)) :
+    uWord (ofInt v) = uVal v := by
+  obtain ⟨_, hw⟩ := zsq_facts v h1 h2
+  unfold uWord uVal
+  rw [hw]
+  refine evmShr_eq_div_104 ?_
+  have hsq := sq_bound (by omega : (0:Int) ≤ 217494458298375249691265569570) h1 h2
+  omega
+
+theorem uVal_le (v : Int) (h1 : -(217494458298375249691265569570 : Int) ≤ v)
+    (h2 : v ≤ (217494458298375249691265569570 : Int)) :
+    uVal v ≤ Uc := by
+  have hsq := sq_bound (by omega : (0:Int) ≤ 217494458298375249691265569570) h1 h2
+  unfold uVal Uc
+  omega
+
+/-- One `z`-step moves `u` by at most one (downward for `v ≥ 1`). -/
+theorem uVal_step_pos (v : Int) (hv : 1 ≤ v)
+    (h2 : v ≤ (217494458298375249691265569570 : Int)) :
+    uVal v - 1 ≤ uVal (v - 1) ∧ uVal (v - 1) ≤ uVal v := by
+  have e1 : (v - 1) * (v - 1) = v * v - 2 * v + 1 := by
+    rw [Int.sub_mul, Int.mul_sub, Int.mul_sub]
+    omega
+  have hsq := sq_bound (by omega : (0:Int) ≤ 217494458298375249691265569570)
+    (by omega) h2
+  unfold uVal
+  rw [e1]
+  omega
+
+/-- One `z`-step moves `u` by at most one (upward for `v ≤ 0`). -/
+theorem uVal_step_nonpos (v : Int) (hv : v ≤ 0)
+    (h1 : -(217494458298375249691265569570 : Int) ≤ v - 1) :
+    uVal v ≤ uVal (v - 1) ∧ uVal (v - 1) ≤ uVal v + 1 := by
+  have e1 : (v - 1) * (v - 1) = v * v - 2 * v + 1 := by
+    rw [Int.sub_mul, Int.mul_sub, Int.mul_sub]
+    omega
+  have hsq := sq_bound (by omega : (0:Int) ≤ 217494458298375249691265569570)
+    (by omega) (by omega)
+  unfold uVal
+  rw [e1]
+  omega
+
+/-! ## Product helpers -/
+
+theorem toNat_mul_of_nonneg {x y : Int} (hx : 0 ≤ x) (hy : 0 ≤ y) :
+    x.toNat * y.toNat = (x * y).toNat := by
+  obtain ⟨a, rfl⟩ := Int.eq_ofNat_of_zero_le hx
+  obtain ⟨b, rfl⟩ := Int.eq_ofNat_of_zero_le hy
+  rfl
+
+theorem triple_mono {a1 b1 c1 a2 b2 c2 : Int} (ha : 0 ≤ a1) (hb : 0 ≤ b1) (hc : 0 ≤ c1)
+    (h1 : a1 ≤ a2) (h2 : b1 ≤ b2) (h3 : c1 ≤ c2) : a1 * b1 * c1 ≤ a2 * b2 * c2 := by
+  have s1 : a1 * b1 ≤ a2 * b1 := mul_le_mul_right_nonneg h1 hb
+  have s2 : a2 * b1 ≤ a2 * b2 := mul_le_mul_left_nonneg h2 (by omega)
+  have s3 : a1 * b1 * c1 ≤ a2 * b2 * c1 := mul_le_mul_right_nonneg (by omega) hc
+  have s4 : a2 * b2 * c1 ≤ a2 * b2 * c2 := by
+    refine mul_le_mul_left_nonneg h3 ?_
+    have : (0 : Int) ≤ a2 * b1 := by
+      have := Int.mul_nonneg (by omega : (0:Int) ≤ a2) hb
+      omega
+    have : (0 : Int) ≤ a2 * b2 := by omega
+    omega
+  omega
+
+/-- `((x*A)*y)*(z*B) = ((x*y)*z)*(A*B)` — regroup scale factors. -/
+theorem regroup (x A y z B : Int) :
+    x * A * y * (z * B) = x * y * z * (A * B) := by
+  simp [Int.mul_comm, Int.mul_left_comm]
+
+/-- Positive-branch certificate application: for `w ∈ [1, Zc]` and a `u`-step
+down, the slop-worst-case cross inequality. -/
+theorem g1_step {um1 : Int} (h0 : 0 ≤ um1) (h1 : um1 ≤ UcI - 1) {w : Int}
+    (hw1 : 1 ≤ w) (hw2 : w ≤ ZcI) :
+    evalPoly PPc um1 * (-evalPoly QQc (um1 + 1) + SLOPQc) * (w - 1) ≤
+      (evalPoly PPc (um1 + 1) + -SLOPPc) * -evalPoly QQc um1 * w := by
+  have hG := G1_all h0 h1
+  have hPm := certP_all h0 (by omega)
+  have hP1 := certP_all (v := um1 + 1) (by omega) (by omega)
+  have hQ1 := certQ_all (v := um1 + 1) (by omega) (by omega)
+  have hQ0 := certQ_all (v := um1) h0 (by omega)
+  have hSP : (0 : Int) ≤ SLOPPc := by simp only [SLOPPc]; omega
+  have hSQ : (0 : Int) ≤ SLOPQc := by simp only [SLOPQc]; omega
+  have hA0 : (0 : Int) ≤ evalPoly PPc um1 * (-evalPoly QQc (um1 + 1) + SLOPQc) :=
+    Int.mul_nonneg (by omega) (by omega)
+  have hC0 : (0 : Int) ≤ (evalPoly PPc (um1 + 1) + -SLOPPc) * -evalPoly QQc um1 :=
+    Int.mul_nonneg (by omega) (by omega)
+  generalize hA : evalPoly PPc um1 * (-evalPoly QQc (um1 + 1) + SLOPQc) = A at hG hA0 ⊢
+  generalize hC : (evalPoly PPc (um1 + 1) + -SLOPPc) * -evalPoly QQc um1 = C at hG hC0 ⊢
+  simp only [ZcI] at hG hw2
+  rcases Int.le_total A C with hAC | hAC
+  · -- A ≤ C: A*(w-1) ≤ C*(w-1) ≤ C*w
+    have s1 : A * (w - 1) ≤ C * (w - 1) := mul_le_mul_right_nonneg hAC (by omega)
+    have s2 : C * (w - 1) ≤ C * w := mul_le_mul_left_nonneg (by omega) hC0
+    omega
+  · -- A > C: from Zc*(A-C) ≤ A and w ≤ Zc
+    have hZ : (217494458298375249691265569570 : Int) * (A - C) ≤ A := by omega
+    have s1 : w * (A - C) ≤ (217494458298375249691265569570 : Int) * (A - C) :=
+      mul_le_mul_right_nonneg hw2 (by omega)
+    have e1 : w * (A - C) = w * A - w * C := by rw [Int.mul_sub]
+    have e2 : A * (w - 1) = A * w - A := by rw [Int.mul_sub]; omega
+    have e3 : A * w = w * A := Int.mul_comm A w
+    have e4 : C * w = w * C := Int.mul_comm C w
+    have e5 : ZcI * (A - C) = ZcI * A - ZcI * C := by rw [Int.mul_sub]
+    omega
+
+/-- Nonpositive-branch certificate application: for `m = -w ∈ [0, Zc - 1]` and
+a `u`-step up. -/
+theorem g2_step {um1 : Int} (h0 : 0 ≤ um1) (h1 : um1 ≤ UcI - 1) {m : Int}
+    (hm0 : 0 ≤ m) (hm1 : m ≤ ZcI) :
+    evalPoly PPc um1 * (-evalPoly QQc (um1 + 1) + SLOPQc) * m ≤
+      (evalPoly PPc (um1 + 1) + -SLOPPc) * -evalPoly QQc um1 * (m + 1) := by
+  have hG2 := G2_all h0 h1
+  have hPm := certP_all h0 (by omega)
+  have hP1 := certP_all (v := um1 + 1) (by omega) (by omega)
+  have hQ1 := certQ_all (v := um1 + 1) (by omega) (by omega)
+  have hQ0 := certQ_all (v := um1) h0 (by omega)
+  have hSP : (0 : Int) ≤ SLOPPc := by simp only [SLOPPc]; omega
+  have hSQ : (0 : Int) ≤ SLOPQc := by simp only [SLOPQc]; omega
+  have hA0 : (0 : Int) ≤ evalPoly PPc um1 * (-evalPoly QQc (um1 + 1) + SLOPQc) :=
+    Int.mul_nonneg (by omega) (by omega)
+  have hC0 : (0 : Int) ≤ (evalPoly PPc (um1 + 1) + -SLOPPc) * -evalPoly QQc um1 :=
+    Int.mul_nonneg (by omega) (by omega)
+  generalize hA : evalPoly PPc um1 * (-evalPoly QQc (um1 + 1) + SLOPQc) = A at hG2 hA0 ⊢
+  generalize hC : (evalPoly PPc (um1 + 1) + -SLOPPc) * -evalPoly QQc um1 = C at hG2 hC0 ⊢
+  simp only [ZcI] at hG2 hm1
+  rcases Int.le_total A C with hAC | hAC
+  · -- A ≤ C: A*m ≤ C*m ≤ C*(m+1)
+    have s1 : A * m ≤ C * m := mul_le_mul_right_nonneg hAC hm0
+    have s2 : C * m ≤ C * (m + 1) := mul_le_mul_left_nonneg (by omega) hC0
+    omega
+  · -- A > C: from Zc*(A-C) ≤ C and m ≤ Zc:
+    -- A*m ≤ C*(m+1) ⟺ m*(A-C) ≤ C
+    have hZ : (217494458298375249691265569570 : Int) * (A - C) ≤ C := by omega
+    have s1 : m * (A - C) ≤ (217494458298375249691265569570 : Int) * (A - C) :=
+      mul_le_mul_right_nonneg hm1 (by omega)
+    have e1 : m * (A - C) = m * A - m * C := by rw [Int.mul_sub]
+    have e2 : A * m = m * A := Int.mul_comm A m
+    have e3 : C * (m + 1) = m * C + C := by
+      rw [Int.mul_comm C (m + 1), Int.add_mul, Int.one_mul]
+    omega
+
+/-! ## Cross-multiplication to Nat division -/
+
+theorem cross_to_div {n1 n2 W1 W2 : Int} (hn1 : 0 ≤ n1) (hn2 : 0 ≤ n2)
+    (hW1 : 0 < W1) (hW2 : 0 < W2) (hcross : n1 * W2 ≤ n2 * W1) :
+    n1.toNat / W1.toNat ≤ n2.toNat / W2.toNat := by
+  refine nat_div_cross_mono (by omega) (by omega) ?_
+  have e1 := toNat_mul_of_nonneg hn1 (by omega : (0:Int) ≤ W2)
+  have e2 := toNat_mul_of_nonneg hn2 (by omega : (0:Int) ≤ W1)
+  omega
+
+/-- `(P * w * W) * (E1 * E2) = (P * E1) * (W * E2) * w`. -/
+theorem ident1 (P w W E1 E2 : Int) :
+    P * w * W * (E1 * E2) = P * E1 * (W * E2) * w := by
+  simp [Int.mul_comm, Int.mul_left_comm]
+
+/-- Numerator product bound: `|P * w| < 2^255` for the certified ranges. -/
+theorem pz_bound {P w : Int}
+    (hP1 : (13131151825116561693704478250792 : Int) ≤ P)
+    (hP2 : P ≤ (13972178604861559108982341686387 : Int))
+    (h1 : -(217494458298375249691265569570 : Int) ≤ w)
+    (h2 : w ≤ (217494458298375249691265569570 : Int)) :
+    -(2 ^ 255) < P * w ∧ P * w < 2 ^ 255 := by
+  rcases Int.le_total 0 w with hw | hw
+  · have := mul_range hP1 hP2 hw h2
+    simp only [ipow255]
+    omega
+  · have hnw : 0 ≤ -w := by omega
+    have e1 : P * w = -(P * -w) := by
+      rw [Int.mul_neg]
+      omega
+    have := mul_range hP1 hP2 hnw (by omega : -w ≤ (217494458298375249691265569570 : Int))
+    simp only [ipow255]
+    omega
+
+/-! ## The step lemma -/
+
+/-- Bundle of facts about the quotient pipeline at an integer `z`-value. -/
+theorem hAt_facts (w : Int)
+    (h1 : -(217494458298375249691265569570 : Int) ≤ w)
+    (h2 : w ≤ (217494458298375249691265569570 : Int)) :
+    hAt w = evmSdiv (evmMul (pS4 (uVal w)) (ofInt w)) (qS5 (uVal w)) ∧
+      toInt (evmMul (pS4 (uVal w)) (ofInt w)) = toInt (pS4 (uVal w)) * w := by
+  have hue := uWord_eq w h1 h2
+  have hul := uVal_le w h1 h2
+  obtain ⟨pw, plo, phi, _, _⟩ := pS4_facts hul
+  have hofw : toInt (ofInt w) = w :=
+    toInt_ofInt (by simp only [ipow255]; omega) (by simp only [ipow255]; omega)
+  have hb := pz_bound plo phi h1 h2
+  constructor
+  · unfold hAt x1W
+    rw [hue]
+  · have := evmMul_transport pw (ofInt_lt w)
+      (by rw [hofw]; omega) (by rw [hofw]; omega)
+    rw [hofw] at this
+    exact this
+
+/-- Cancellation of a positive literal factor. -/
+theorem le_of_mul_le_mul_pos {a b c : Int} (h : a * c ≤ b * c) (hc : 0 < c) :
+    a ≤ b := by
+  rcases Int.lt_or_le b a with hlt | hle
+  · exfalso
+    have := Int.mul_lt_mul_of_pos_right hlt hc
+    omega
+  · exact hle
+
+theorem hI_step (v : Int)
+    (hlo : -(217494458298375249691265569570 : Int) ≤ v - 1)
+    (hhi : v ≤ (217494458298375249691265569570 : Int)) :
+    toInt (hAt v) ≤ toInt (hAt (v - 1)) := by
+  have hv1 : -(217494458298375249691265569570 : Int) ≤ v := by omega
+  have hv2 : v - 1 ≤ (217494458298375249691265569570 : Int) := by omega
+  have hu2le := uVal_le v hv1 hhi
+  have hu1le := uVal_le (v - 1) hlo hv2
+  have hub2 : uVal v ≤ 2332259347626381040680638252 := by
+    simp only [Uc] at hu2le; exact hu2le
+  have hub1 : uVal (v - 1) ≤ 2332259347626381040680638252 := by
+    simp only [Uc] at hu1le; exact hu1le
+  have hstepP : 1 ≤ v → uVal v - 1 ≤ uVal (v - 1) ∧ uVal (v - 1) ≤ uVal v :=
+    fun h => uVal_step_pos v h hhi
+  have hstepN : v ≤ 0 → uVal v ≤ uVal (v - 1) ∧ uVal (v - 1) ≤ uVal v + 1 :=
+    fun h => uVal_step_nonpos v h hlo
+  obtain ⟨pw2, plo2, phi2, psl2, psh2⟩ := pS4_facts hu2le
+  obtain ⟨pw1, plo1, phi1, psl1, psh1⟩ := pS4_facts hu1le
+  obtain ⟨qw2, qlo2, qhi2, qsl2, qsh2⟩ := qS5_facts hu2le
+  obtain ⟨qw1, qlo1, qhi1, qsl1, qsh1⟩ := qS5_facts hu1le
+  have hb2 := pz_bound plo2 phi2 hv1 hhi
+  have hb1 := pz_bound plo1 phi1 hlo hv2
+  have hcP2 := certP_all (v := ((uVal v : Nat) : Int)) (by omega)
+    (by simp only [UcI]; omega)
+  have hcP1 := certP_all (v := ((uVal (v - 1) : Nat) : Int)) (by omega)
+    (by simp only [UcI]; omega)
+  have hcQ2 := certQ_all (v := ((uVal v : Nat) : Int)) (by omega)
+    (by simp only [UcI]; omega)
+  have hcQ1 := certQ_all (v := ((uVal (v - 1) : Nat) : Int)) (by omega)
+    (by simp only [UcI]; omega)
+  have hSP : (0 : Int) ≤ SLOPPc := by simp only [SLOPPc]; omega
+  have hSQ : (0 : Int) ≤ SLOPQc := by simp only [SLOPQc]; omega
+  obtain ⟨he2, hn2⟩ := hAt_facts v hv1 hhi
+  obtain ⟨he1, hn1⟩ := hAt_facts (v - 1) hlo hv2
+  rw [he2, he1]
+  clear he2 he1 hu2le hu1le
+  have hpeq : uVal (v - 1) = uVal v → pS4 (uVal (v - 1)) = pS4 (uVal v) :=
+    fun h => by rw [h]
+  have hqeq : uVal (v - 1) = uVal v → qS5 (uVal (v - 1)) = qS5 (uVal v) :=
+    fun h => by rw [h]
+  have hm2lt := evmMul_lt (pS4 (uVal v)) (ofInt v)
+  have hm1lt := evmMul_lt (pS4 (uVal (v - 1))) (ofInt (v - 1))
+  generalize hu2g : uVal v = u2 at *
+  generalize hu1g : uVal (v - 1) = u1 at *
+  generalize hp2g : pS4 u2 = pword2 at *
+  generalize hp1g : pS4 u1 = pword1 at *
+  generalize hq2g : qS5 u2 = qword2 at *
+  generalize hq1g : qS5 u1 = qword1 at *
+  generalize hm2g : evmMul pword2 (ofInt v) = mword2 at *
+  generalize hm1g : evmMul pword1 (ofInt (v - 1)) = mword1 at *
+  clear hu2g hu1g hp2g hp1g hq2g hq1g hm2g hm1g
+  have hq2neg : toInt qword2 < 0 := by omega
+  have hq1neg : toInt qword1 < 0 := by omega
+  have hp2pos : (0 : Int) ≤ toInt pword2 := by omega
+  have hp1pos : (0 : Int) ≤ toInt pword1 := by omega
+  rcases Int.lt_or_le v 1 with hneg | hpos
+  · -- v ≤ 0, v - 1 ≤ -1
+    have hv0 : v ≤ 0 := by omega
+    obtain ⟨hus1, hus2⟩ := hstepN hv0
+    have hnum1neg : toInt pword1 * (v - 1) < 0 := by
+      have h := mul_le_mul_left_nonneg (show v - 1 ≤ -1 by omega) hp1pos
+      omega
+    have hf1 := evmSdiv_neg_neg hm1lt qw1
+      (hn1 ▸ hnum1neg) (hn1 ▸ (by omega : -(2 ^ 255) < toInt pword1 * (v - 1)))
+      hq1neg
+    rcases Int.lt_or_le v 0 with hvneg | hveq
+    · -- v ≤ -1
+      have hnum2neg : toInt pword2 * v < 0 := by
+        have h := mul_le_mul_left_nonneg (show v ≤ -1 by omega) hp2pos
+        omega
+      have hf2 := evmSdiv_neg_neg hm2lt qw2
+        (hn2 ▸ hnum2neg) (hn2 ▸ (by omega : -(2 ^ 255) < toInt pword2 * v))
+        hq2neg
+      rw [hf2, hf1, hn2, hn1]
+      clear hf2 hf1 hn2 hn1 hb2 hb1
+      have hcross : -(toInt pword2 * v) * (-toInt qword1) ≤
+          -(toInt pword1 * (v - 1)) * (-toInt qword2) := by
+        rcases Nat.lt_or_ge u2 u1 with hustep | husame
+        · have hcast : ((u1 : Nat) : Int) = ((u2 : Nat) : Int) + 1 := by omega
+          have hg := g2_step (um1 := ((u2 : Nat) : Int))
+            (by omega) (by simp only [UcI]; omega)
+            (m := -v) (by omega) (by simp only [ZcI]; omega)
+          rw [← hcast] at hg
+          have lhsP : (0 : Int) ≤ toInt pword2 * 587135645693458306972370149197334256843920637227079967676822742883052256278652110865924749596192175757983744 := by omega
+          have lhsW : (0 : Int) ≤ -toInt qword1 * 157608024785577916849116160400574455220318957081861786671793173616982887085988842445657065019539662563226511961227264 := by omega
+          have lb : -toInt qword1 * 157608024785577916849116160400574455220318957081861786671793173616982887085988842445657065019539662563226511961227264 ≤
+              -evalPoly QQc ((u1 : Nat) : Int) + SLOPQc := by omega
+          have l1 : toInt pword2 * 587135645693458306972370149197334256843920637227079967676822742883052256278652110865924749596192175757983744 * (-toInt qword1 * 157608024785577916849116160400574455220318957081861786671793173616982887085988842445657065019539662563226511961227264) * -v ≤
+              evalPoly PPc ((u2 : Nat) : Int) *
+                (-evalPoly QQc ((u1 : Nat) : Int) + SLOPQc) * -v :=
+            triple_mono lhsP lhsW (by omega) psh2 lb (by omega)
+          have rb1 : evalPoly PPc ((u1 : Nat) : Int) + -SLOPPc ≤
+              toInt pword1 * 587135645693458306972370149197334256843920637227079967676822742883052256278652110865924749596192175757983744 := by omega
+          have rb2 : -evalPoly QQc ((u2 : Nat) : Int) ≤ -toInt qword2 * 157608024785577916849116160400574455220318957081861786671793173616982887085988842445657065019539662563226511961227264 := by
+            omega
+          have r1 : (evalPoly PPc ((u1 : Nat) : Int) + -SLOPPc) *
+              -evalPoly QQc ((u2 : Nat) : Int) * (-v + 1) ≤
+              toInt pword1 * 587135645693458306972370149197334256843920637227079967676822742883052256278652110865924749596192175757983744 * (-toInt qword2 * 157608024785577916849116160400574455220318957081861786671793173616982887085988842445657065019539662563226511961227264) * (-v + 1) :=
+            triple_mono (by omega) (by omega) (by omega) rb1 rb2 (by omega)
+          have eL := ident1 (toInt pword2) (-v) (-toInt qword1) (587135645693458306972370149197334256843920637227079967676822742883052256278652110865924749596192175757983744) (157608024785577916849116160400574455220318957081861786671793173616982887085988842445657065019539662563226511961227264)
+          have eR := ident1 (toInt pword1) (-v + 1) (-toInt qword2) (587135645693458306972370149197334256843920637227079967676822742883052256278652110865924749596192175757983744) (157608024785577916849116160400574455220318957081861786671793173616982887085988842445657065019539662563226511961227264)
+          refine le_of_mul_le_mul_pos (c := (587135645693458306972370149197334256843920637227079967676822742883052256278652110865924749596192175757983744 : Int) * 157608024785577916849116160400574455220318957081861786671793173616982887085988842445657065019539662563226511961227264) ?_ (by omega)
+          have m1 : -(toInt pword2 * v) = toInt pword2 * -v := by rw [Int.mul_neg]
+          have m2 : -(toInt pword1 * (v - 1)) = toInt pword1 * (-v + 1) := by
+            rw [show (-v + 1 : Int) = -(v - 1) by omega, Int.mul_neg]
+          rw [m1, m2, eL, eR]
+          generalize gA : toInt pword2 * 587135645693458306972370149197334256843920637227079967676822742883052256278652110865924749596192175757983744 * (-toInt qword1 * 157608024785577916849116160400574455220318957081861786671793173616982887085988842445657065019539662563226511961227264) * -v = A at l1 ⊢
+          generalize gB : evalPoly PPc ((u2 : Nat) : Int) *
+            (-evalPoly QQc ((u1 : Nat) : Int) + SLOPQc) * -v = B at l1 hg
+          generalize gC : (evalPoly PPc ((u1 : Nat) : Int) + -SLOPPc) *
+            -evalPoly QQc ((u2 : Nat) : Int) * (-v + 1) = C at hg r1
+          generalize gD : toInt pword1 * 587135645693458306972370149197334256843920637227079967676822742883052256278652110865924749596192175757983744 *
+            (-toInt qword2 * 157608024785577916849116160400574455220318957081861786671793173616982887085988842445657065019539662563226511961227264) * (-v + 1) = D at r1 ⊢
+          omega
+        · have huv : u1 = u2 := by omega
+          have hpe := hpeq huv
+          have hqe := hqeq huv
+          rw [hpe, hqe]
+          have m1 : -(toInt pword2 * v) = toInt pword2 * -v := by rw [Int.mul_neg]
+          have m2 : -(toInt pword2 * (v - 1)) = toInt pword2 * (-v + 1) := by
+            rw [show (-v + 1 : Int) = -(v - 1) by omega, Int.mul_neg]
+          rw [m1, m2]
+          have hmono : toInt pword2 * -v ≤ toInt pword2 * (-v + 1) :=
+            mul_le_mul_left_nonneg (by omega) hp2pos
+          exact mul_le_mul_right_nonneg hmono (by omega)
+      have hdd := cross_to_div (by omega) (by omega) (by omega) (by omega) hcross
+      omega
+    · -- v = 0
+      have hveq0 : v = 0 := by omega
+      subst hveq0
+      have hf2 := evmSdiv_pos_neg hm2lt qw2
+        (hn2 ▸ (by omega : (0 : Int) ≤ toInt pword2 * 0)) hq2neg
+      rw [hf2, hf1, hn2, hn1]
+      clear hf2 hf1 hn2 hn1 hb2 hb1
+      simp only [Int.mul_zero, Int.toNat_zero, Nat.zero_div]
+      have hq := Int.natCast_nonneg
+        ((-(toInt pword1 * (0 - 1))).toNat / (-toInt qword1).toNat)
+      omega
+  · -- v ≥ 1, v - 1 ≥ 0
+    obtain ⟨hus1, hus2⟩ := hstepP hpos
+    have hnum2pos : 0 ≤ toInt pword2 * v := Int.mul_nonneg hp2pos (by omega)
+    have hnum1pos : 0 ≤ toInt pword1 * (v - 1) := Int.mul_nonneg hp1pos (by omega)
+    have hf2 := evmSdiv_pos_neg hm2lt qw2 (hn2 ▸ hnum2pos) hq2neg
+    have hf1 := evmSdiv_pos_neg hm1lt qw1 (hn1 ▸ hnum1pos) hq1neg
+    rw [hf2, hf1, hn2, hn1]
+    clear hf2 hf1 hn2 hn1 hb2 hb1
+    have hcross : toInt pword1 * (v - 1) * (-toInt qword2) ≤
+        toInt pword2 * v * (-toInt qword1) := by
+      rcases Nat.lt_or_ge u1 u2 with hustep | husame
+      · have hcast : ((u1 : Nat) : Int) = ((u2 : Nat) : Int) - 1 := by omega
+        have hg := g1_step (um1 := ((u2 : Nat) : Int) - 1)
+          (by omega) (by simp only [UcI]; omega)
+          (w := v) hpos (by simp only [ZcI]; omega)
+        rw [show ((u2 : Nat) : Int) - 1 + 1 = ((u2 : Nat) : Int) by omega,
+          ← hcast] at hg
+        have lhsP : (0 : Int) ≤ toInt pword1 * 587135645693458306972370149197334256843920637227079967676822742883052256278652110865924749596192175757983744 := by omega
+        have lhsW : (0 : Int) ≤ -toInt qword2 * 157608024785577916849116160400574455220318957081861786671793173616982887085988842445657065019539662563226511961227264 := by omega
+        have lb : -toInt qword2 * 157608024785577916849116160400574455220318957081861786671793173616982887085988842445657065019539662563226511961227264 ≤
+            -evalPoly QQc ((u2 : Nat) : Int) + SLOPQc := by omega
+        have l1 : toInt pword1 * 587135645693458306972370149197334256843920637227079967676822742883052256278652110865924749596192175757983744 * (-toInt qword2 * 157608024785577916849116160400574455220318957081861786671793173616982887085988842445657065019539662563226511961227264) * (v - 1) ≤
+            evalPoly PPc ((u1 : Nat) : Int) *
+              (-evalPoly QQc ((u2 : Nat) : Int) + SLOPQc) * (v - 1) :=
+          triple_mono lhsP lhsW (by omega) psh1 lb (by omega)
+        have rb1 : evalPoly PPc ((u2 : Nat) : Int) + -SLOPPc ≤
+            toInt pword2 * 587135645693458306972370149197334256843920637227079967676822742883052256278652110865924749596192175757983744 := by omega
+        have rb2 : -evalPoly QQc ((u1 : Nat) : Int) ≤ -toInt qword1 * 157608024785577916849116160400574455220318957081861786671793173616982887085988842445657065019539662563226511961227264 := by
+          omega
+        have r1 : (evalPoly PPc ((u2 : Nat) : Int) + -SLOPPc) *
+            -evalPoly QQc ((u1 : Nat) : Int) * v ≤
+            toInt pword2 * 587135645693458306972370149197334256843920637227079967676822742883052256278652110865924749596192175757983744 * (-toInt qword1 * 157608024785577916849116160400574455220318957081861786671793173616982887085988842445657065019539662563226511961227264) * v :=
+          triple_mono (by omega) (by omega) (by omega) rb1 rb2 (by omega)
+        have eL := ident1 (toInt pword1) (v - 1) (-toInt qword2) (587135645693458306972370149197334256843920637227079967676822742883052256278652110865924749596192175757983744) (157608024785577916849116160400574455220318957081861786671793173616982887085988842445657065019539662563226511961227264)
+        have eR := ident1 (toInt pword2) v (-toInt qword1) (587135645693458306972370149197334256843920637227079967676822742883052256278652110865924749596192175757983744) (157608024785577916849116160400574455220318957081861786671793173616982887085988842445657065019539662563226511961227264)
+        refine le_of_mul_le_mul_pos (c := (587135645693458306972370149197334256843920637227079967676822742883052256278652110865924749596192175757983744 : Int) * 157608024785577916849116160400574455220318957081861786671793173616982887085988842445657065019539662563226511961227264) ?_ (by omega)
+        rw [eL, eR]
+        generalize gA : toInt pword1 * 587135645693458306972370149197334256843920637227079967676822742883052256278652110865924749596192175757983744 * (-toInt qword2 * 157608024785577916849116160400574455220318957081861786671793173616982887085988842445657065019539662563226511961227264) * (v - 1) = A at l1 ⊢
+        generalize gB : evalPoly PPc ((u1 : Nat) : Int) *
+          (-evalPoly QQc ((u2 : Nat) : Int) + SLOPQc) * (v - 1) = B at l1 hg
+        generalize gC : (evalPoly PPc ((u2 : Nat) : Int) + -SLOPPc) *
+          -evalPoly QQc ((u1 : Nat) : Int) * v = C at hg r1
+        generalize gD : toInt pword2 * 587135645693458306972370149197334256843920637227079967676822742883052256278652110865924749596192175757983744 * (-toInt qword1 * 157608024785577916849116160400574455220318957081861786671793173616982887085988842445657065019539662563226511961227264) * v = D at r1 ⊢
+        omega
+      · have huv : u1 = u2 := by omega
+        have hpe := hpeq huv
+        have hqe := hqeq huv
+        rw [hpe, hqe]
+        have hmono : toInt pword2 * (v - 1) ≤ toInt pword2 * v :=
+          mul_le_mul_left_nonneg (by omega) hp2pos
+        exact mul_le_mul_right_nonneg hmono (by omega)
+    have hdd := cross_to_div hnum1pos hnum2pos (by omega) (by omega) hcross
+    omega
+
+end LnGeneratedModel
\ No newline at end of file
diff --git a/formal/ln/LnProof/LnProof/TopMono.lean b/formal/ln/LnProof/LnProof/TopMono.lean
new file mode 100644
index 000000000..bc561deff
--- /dev/null
+++ b/formal/ln/LnProof/LnProof/TopMono.lean
@@ -0,0 +1,387 @@
+import LnProof.OctaveMono
+import LnProof.LnMono
+
+/-!
+# Monotonicity of the generated `lnWad` model over its whole domain
+
+The three legs are stitched together here:
+
+* within an octave (`evmClz` fixed), `tail_mono` carries the analytic
+  certificates through the model tail;
+* each adjacent pair crossing a `clz` seam is decided in `LnMono`;
+* the `x = 10^18` corrected point and its neighbors are decided in `LnMono`.
+
+`model_ln_wad_mono` chains the unit step over the domain, and
+`model_ln_wad_to_wad_mono` pushes the result through the wad helper's
+floor division.
+-/
+
+set_option maxRecDepth 4096
+
+namespace LnGeneratedModel
+
+/-! ## `sle` / `toInt` glue -/
+
+theorem sle_eq_sleInt (a b : Nat) : sle a b = sleInt a b := rfl
+
+theorem sle_of_toInt {a b : Nat} (ha : a < 2 ^ 256) (hb : b < 2 ^ 256)
+    (h : toInt a ≤ toInt b) : sle a b = true := by
+  rw [sle_eq_sleInt]
+  exact (sleInt_iff ha hb).mpr h
+
+theorem toInt_of_sle {a b : Nat} (ha : a < 2 ^ 256) (hb : b < 2 ^ 256)
+    (h : sle a b = true) : toInt a ≤ toInt b := by
+  rw [sle_eq_sleInt] at h
+  exact (sleInt_iff ha hb).mp h
+
+theorem model_lt {x : Nat} (h : x < 2 ^ 256) : model_ln_wad_evm x < 2 ^ 256 := by
+  rw [model_eq_tail h]
+  unfold lnTail
+  exact evmAdd_lt _ _
+
+/-! ## Small opcode facts -/
+
+theorem evmClz_eq {x : Nat} (h1 : 1 ≤ x) (h2 : x < 2 ^ 256) :
+    evmClz x = 255 - Nat.log2 x := by
+  unfold evmClz
+  rw [u256_of_lt h2, if_neg (by omega)]
+
+/-! ## The mantissa for a fixed `clz` -/
+
+theorem mant_facts {x : Nat} (h1 : 1 ≤ x) (h2 : x < 2 ^ 255) :
+    evmShr 160 (evmShl (evmClz x) x) = x * 2 ^ (255 - Nat.log2 x) / 2 ^ 160 ∧
+      MLO ≤ x * 2 ^ (255 - Nat.log2 x) / 2 ^ 160 ∧
+      x * 2 ^ (255 - Nat.log2 x) / 2 ^ 160 < MHI := by
+  have hx0 : x ≠ 0 := by omega
+  have ha1 : Nat.log2 x < 255 := (Nat.log2_lt hx0).mpr (by omega)
+  have h2a : 2 ^ Nat.log2 x ≤ x := (Nat.le_log2 hx0).mp (Nat.le_refl _)
+  have hx2a : x < 2 ^ (Nat.log2 x + 1) := (Nat.log2_lt hx0).mp (Nat.lt_succ_self _)
+  have hclz : evmClz x = 255 - Nat.log2 x := evmClz_eq h1 (by omega)
+  have hpow : 2 ^ (Nat.log2 x + 1) * 2 ^ (255 - Nat.log2 x) = 2 ^ 256 := by
+    rw [← Nat.pow_add]
+    congr 1
+    omega
+  have hov : x * 2 ^ (255 - Nat.log2 x) < 2 ^ 256 := by
+    have h := (Nat.mul_lt_mul_right (Nat.two_pow_pos (255 - Nat.log2 x))).mpr hx2a
+    rw [hpow] at h
+    exact h
+  have hlo : 2 ^ 255 ≤ x * 2 ^ (255 - Nat.log2 x) := by
+    have h := Nat.mul_le_mul_right (2 ^ (255 - Nat.log2 x)) h2a
+    have he : 2 ^ Nat.log2 x * 2 ^ (255 - Nat.log2 x) = 2 ^ 255 := by
+      rw [← Nat.pow_add]
+      congr 1
+      omega
+    rw [he] at h
+    exact h
+  refine ⟨?_, ?_, ?_⟩
+  · rw [hclz, evmShl_eq (by omega) hov, evmShr_eq_div_160 hov]
+  · have h := Nat.div_le_div_right (c := 2 ^ 160) hlo
+    have he : (2 : Nat) ^ 255 / 2 ^ 160 = 2 ^ 95 := by decide
+    rw [he] at h
+    simp only [MLO]
+    exact h
+  · have h := (Nat.div_lt_iff_lt_mul (Nat.two_pow_pos 160)).mpr
+      (by rw [show (2 : Nat) ^ 96 * 2 ^ 160 = 2 ^ 256 by decide]; exact hov)
+    simp only [MHI]
+    exact h
+
+/-! ## The decided legs, extracted -/
+
+theorem seam_extract {t : Nat} (ht1 : 1 ≤ t) (ht2 : t ≤ 254) :
+    sle (model_ln_wad_evm (2 ^ t - 1)) (model_ln_wad_evm (2 ^ t)) = true := by
+  have h := model_ln_wad_seam_mono
+  rw [seamMono, List.all_eq_true] at h
+  have hm := h (t - 1) (List.mem_range.mpr (by omega))
+  rw [show t - 1 + 1 = t by omega] at hm
+  exact hm
+
+/-! ## The unit step -/
+
+theorem model_unit_step {x : Nat} (h1 : 1 ≤ x) (h2 : x + 1 < 2 ^ 255) :
+    toInt (model_ln_wad_evm x) ≤ toInt (model_ln_wad_evm (x + 1)) := by
+  have hx256 : x < 2 ^ 256 := by omega
+  have hx1256 : x + 1 < 2 ^ 256 := by omega
+  have hd := model_ln_wad_one_wad_mono
+  rw [Bool.and_eq_true] at hd
+  rcases Decidable.em (x = 999999999999999999) with hsp | hne1
+  · -- x = 10^18 - 1: decided
+    subst hsp
+    have h := toInt_of_sle (model_lt (by omega)) (model_lt (by omega)) hd.1
+    rw [show (10 : Nat) ^ 18 - 1 = 999999999999999999 by decide,
+      show (10 : Nat) ^ 18 = 999999999999999999 + 1 by decide] at h
+    exact h
+  · rcases Decidable.em (x = 1000000000000000000) with hsp | hne2
+    · -- x = 10^18: decided
+      subst hsp
+      have h := toInt_of_sle (model_lt (by omega)) (model_lt (by omega)) hd.2
+      rw [show (10 : Nat) ^ 18 = 1000000000000000000 by decide,
+        show (10 : Nat) ^ 18 + 1 = 1000000000000000000 + 1 by decide] at h
+      exact h
+    · rcases Decidable.em (evmClz (x + 1) = evmClz x) with hclz | hclz
+      · -- same octave: the analytic leg
+        have e1 := evmClz_eq h1 hx256
+        have e2 := evmClz_eq (by omega) hx1256
+        have hl1 : Nat.log2 x < 255 := (Nat.log2_lt (by omega)).mpr (by omega)
+        have hl2 : Nat.log2 (x + 1) < 255 := (Nat.log2_lt (by omega)).mpr (by omega)
+        have hlog : Nat.log2 (x + 1) = Nat.log2 x := by omega
+        obtain ⟨me, mlo, mhi⟩ := mant_facts h1 (by omega)
+        obtain ⟨me', mlo', mhi'⟩ := mant_facts (x := x + 1) (by omega) h2
+        have hmm : x * 2 ^ (255 - Nat.log2 x) / 2 ^ 160 ≤
+            (x + 1) * 2 ^ (255 - Nat.log2 (x + 1)) / 2 ^ 160 := by
+          rw [hlog]
+          exact Nat.div_le_div_right (Nat.mul_le_mul_right _ (Nat.le_succ x))
+        have hc : evmClz x < 256 := by omega
+        rw [model_eq_tail hx256, model_eq_tail hx1256, me, me', hclz]
+        exact tail_mono mlo hmm mhi' (ln2k_bound hc).1 (ln2k_bound hc).2
+      · -- clz seam: x + 1 is a power of two; decided
+        have e1 := evmClz_eq h1 hx256
+        have e2 := evmClz_eq (by omega) hx1256
+        have hl1 : Nat.log2 x < 255 := (Nat.log2_lt (by omega)).mpr (by omega)
+        have hl2 : Nat.log2 (x + 1) < 255 := (Nat.log2_lt (by omega)).mpr (by omega)
+        have hlog : Nat.log2 (x + 1) ≠ Nat.log2 x := by omega
+        have h2a : 2 ^ Nat.log2 x ≤ x := (Nat.le_log2 (by omega)).mp (Nat.le_refl _)
+        have hx2a : x < 2 ^ (Nat.log2 x + 1) :=
+          (Nat.log2_lt (by omega)).mp (Nat.lt_succ_self _)
+        have h2b : 2 ^ Nat.log2 (x + 1) ≤ x + 1 :=
+          (Nat.le_log2 (by omega)).mp (Nat.le_refl _)
+        have hab : Nat.log2 x ≤ Nat.log2 (x + 1) :=
+          (Nat.le_log2 (by omega)).mpr (by omega)
+        have hstep : 2 ^ (Nat.log2 x + 1) ≤ 2 ^ Nat.log2 (x + 1) :=
+          Nat.pow_le_pow_right (by omega) (by omega)
+        have hxe : x + 1 = 2 ^ Nat.log2 (x + 1) := by omega
+        have hb1 : 1 ≤ Nat.log2 (x + 1) := by
+          rcases Nat.eq_zero_or_pos (Nat.log2 (x + 1)) with h0 | hpos
+          · exfalso
+            rw [h0] at hxe
+            omega
+          · exact hpos
+        have hs := seam_extract hb1 (by omega)
+        have h := toInt_of_sle (model_lt (by omega)) (model_lt (by omega)) hs
+        rw [show 2 ^ Nat.log2 (x + 1) - 1 = x by omega, ← hxe] at h
+        exact h
+
+/-! ## The full domain -/
+
+/-- `lnWad` is monotone nondecreasing over its entire domain
+`0 < x ≤ y < 2^255` (signed comparison of the output words). -/
+theorem model_ln_wad_mono {x y : Nat} (hx : 0 < x) (hxy : x ≤ y)
+    (hy : y < 2 ^ 255) : sle (model_ln_wad_evm x) (model_ln_wad_evm y) = true := by
+  have key : ∀ n : Nat, x + n < 2 ^ 255 →
+      toInt (model_ln_wad_evm x) ≤ toInt (model_ln_wad_evm (x + n)) := by
+    intro n
+    induction n with
+    | zero => intro _; exact Int.le_refl _
+    | succ k ih =>
+      intro hk
+      have hs := model_unit_step (x := x + k) (by omega) (by omega)
+      have he : x + (k + 1) = x + k + 1 := by omega
+      rw [he]
+      exact Int.le_trans (ih (by omega)) hs
+  have hkey := key (y - x) (by omega)
+  rw [show x + (y - x) = y by omega] at hkey
+  exact sle_of_toInt (model_lt (by omega)) (model_lt (by omega)) hkey
+
+/-! ## The wad helper -/
+
+theorem evmSub_zero {a : Nat} (h : a < 2 ^ 256) : evmSub a 0 = a := by
+  unfold evmSub u256
+  simp only [word_mod_eq]
+  omega
+
+theorem evmSlt_zero {r : Nat} (h : r < 2 ^ 256) :
+    evmSlt r 0 = if toInt r < 0 then 1 else 0 := by
+  unfold evmSlt u256 toInt
+  simp only [word_mod_eq]
+  repeat' split
+  all_goals omega
+
+theorem evmSgt_zero_eq_slt_zero (r : Nat) : evmSgt 0 r = evmSlt r 0 := by
+  unfold evmSgt evmSlt
+  rfl
+
+theorem to_wad_eq {x : Nat} (h : x < 2 ^ 256) :
+    model_ln_wad_to_wad_evm x =
+      evmSdiv
+        (evmSub (model_ln_wad_evm x)
+          (evmMul (evmSlt (model_ln_wad_evm x) 0) 999999999))
+        1000000000 := by
+  unfold model_ln_wad_to_wad_evm
+  simp only [u256_of_lt h]
+  rw [evmSgt_zero_eq_slt_zero, evmMul_comm 999999999]
+
+theorem to_wad_numerator_eq {r : Nat} (hr : r < 2 ^ 256)
+    (hb1 : -(12259964326927110866866776217202473468949912977468817408 : Int) ≤ toInt r)
+    (hb2 : toInt r ≤ (12259964326927110866866776217202473468949912977468817409 : Int)) :
+    toInt (evmSub r (evmMul (evmSlt r 0) 999999999)) =
+      toInt r - (if toInt r < 0 then (999999999 : Int) else 0) := by
+  have hm1 : evmMul 1 999999999 = 999999999 := by decide
+  have hm0 : evmMul 0 999999999 = 0 := by decide
+  have h999 : toInt 999999999 = (999999999 : Int) := by decide
+  rw [evmSlt_zero hr]
+  rcases Int.lt_or_le (toInt r) 0 with hneg | hpos
+  · rw [if_pos hneg, if_pos hneg, hm1]
+    rw [evmSub_transport hr (by omega)
+      (by rw [h999]; simp only [ipow255]; omega)
+      (by rw [h999]; simp only [ipow255]; omega), h999]
+  · rw [if_neg (by omega), if_neg (by omega), hm0, evmSub_zero hr]
+    omega
+
+theorem floor_div_pos_window {a : Int} (ha : 0 ≤ a) :
+    (((a.toNat / 1000000000 : Nat) : Int) * 1000000000 ≤ a) ∧
+      (a < (((a.toNat / 1000000000 : Nat) : Int) + 1) * 1000000000) := by
+  have hsplit := Nat.div_add_mod a.toNat 1000000000
+  have hmod := Nat.mod_lt a.toNat (by decide : 0 < 1000000000)
+  have ha' : ((a.toNat : Nat) : Int) = a := Int.toNat_of_nonneg ha
+  constructor <;> omega
+
+theorem floor_div_neg_window {a : Int} (ha : a < 0) :
+    (-(((((-a).toNat + 999999999) / 1000000000 : Nat) : Int)) * 1000000000 ≤ a) ∧
+      (a < (-(((((-a).toNat + 999999999) / 1000000000 : Nat) : Int)) + 1) *
+        1000000000) := by
+  let A := (-a).toNat
+  let q := (A + 999999999) / 1000000000
+  have hapos : 0 < A := by
+    unfold A
+    rcases Nat.eq_zero_or_pos (-a).toNat with hz | hp
+    · have hcast : (((-a).toNat : Nat) : Int) = -a := Int.toNat_of_nonneg (by omega)
+      rw [hz] at hcast
+      omega
+    · exact hp
+  have ha' : ((A : Nat) : Int) = -a := by
+    unfold A
+    exact Int.toNat_of_nonneg (by omega)
+  have hsplit := Nat.div_add_mod (A + 999999999) 1000000000
+  have hmod := Nat.mod_lt (A + 999999999) (by decide : 0 < 1000000000)
+  constructor <;> unfold q at * <;> omega
+
+/-- The model's output sits inside `[-2^183, 2^183 + 1]`: the post-shift value is
+a 184-bit signed quantity, and the `s + (s == -1)` self-correction keeps it there
+(it only sends `-1` to `0`). -/
+theorem lnTail_bound (kw m : Nat) :
+    -(12259964326927110866866776217202473468949912977468817408 : Int) ≤
+        toInt (lnTail kw m) ∧
+      toInt (lnTail kw m) ≤
+        (12259964326927110866866776217202473468949912977468817409 : Int) := by
+  unfold lnTail
+  obtain ⟨wlt, s1, s2⟩ := evmSar_sandwich_72 (evmAdd_lt
+    (evmAdd (evmMul (x1W (zWord m)) Kc) (evmMul LN2c kw)) BIASc)
+  have hwl := toInt_lt (evmAdd_lt
+    (evmAdd (evmMul (x1W (zWord m)) Kc) (evmMul LN2c kw)) BIASc)
+  have hwg := toInt_ge (evmAdd_lt
+    (evmAdd (evmMul (x1W (zWord m)) Kc) (evmMul LN2c kw)) BIASc)
+  rw [corr_toInt wlt]
+  generalize toInt (evmAdd (evmAdd (evmMul (x1W (zWord m)) Kc) (evmMul LN2c kw)) BIASc) =
+    t at s1 s2 hwl hwg
+  generalize toInt (evmSar 72 (evmAdd (evmAdd (evmMul (x1W (zWord m)) Kc) (evmMul LN2c kw)) BIASc)) =
+    s at s1 s2 ⊢
+  simp only [ipow255] at hwl hwg
+  split <;> omega
+
+theorem model_bound {x : Nat} (h : x < 2 ^ 256) :
+    -(12259964326927110866866776217202473468949912977468817408 : Int) ≤
+        toInt (model_ln_wad_evm x) ∧
+      toInt (model_ln_wad_evm x) ≤
+        (12259964326927110866866776217202473468949912977468817409 : Int) := by
+  rw [model_eq_tail h]
+  exact lnTail_bound _ _
+
+theorem to_wad_floor_window {x : Nat} (h : x < 2 ^ 256) :
+    toInt (model_ln_wad_to_wad_evm x) * 1000000000 ≤ toInt (model_ln_wad_evm x) ∧
+      toInt (model_ln_wad_evm x) < (toInt (model_ln_wad_to_wad_evm x) + 1) *
+        1000000000 := by
+  have hr := model_lt h
+  obtain ⟨hb1, hb2⟩ := model_bound h
+  have hn := to_wad_numerator_eq hr hb1 hb2
+  have hnlt : evmSub (model_ln_wad_evm x) (evmMul (evmSlt (model_ln_wad_evm x) 0) 999999999) <
+      2 ^ 256 := evmSub_lt _ _
+  have hdlt : (1000000000 : Nat) < 2 ^ 256 := by omega
+  have hden : toInt 1000000000 = (1000000000 : Int) := by decide
+  have hdenN : ((1000000000 : Int)).toNat = 1000000000 := by decide
+  rw [to_wad_eq h]
+  generalize hw : evmSub (model_ln_wad_evm x) (evmMul (evmSlt (model_ln_wad_evm x) 0) 999999999) = nw at hn hnlt ⊢
+  rcases Int.lt_or_le (toInt (model_ln_wad_evm x)) 0 with hneg | hpos
+  · rw [if_pos hneg] at hn
+    have hnum : toInt nw < 0 := by omega
+    rw [evmSdiv_neg_pos hnlt hdlt hnum (by simp only [ipow255]; omega)
+      (by rw [hden]; omega), hden, hdenN]
+    have hwnd := floor_div_neg_window (a := toInt (model_ln_wad_evm x)) hneg
+    have hmag : (-toInt nw).toNat = (-toInt (model_ln_wad_evm x)).toNat + 999999999 := by
+      apply Int.ofNat.inj
+      change ((-toInt nw).toNat : Int) =
+        (((-toInt (model_ln_wad_evm x)).toNat + 999999999 : Nat) : Int)
+      rw [Int.toNat_of_nonneg (by omega : 0 ≤ -toInt nw), Int.natCast_add,
+        Int.toNat_of_nonneg (by omega : 0 ≤ -toInt (model_ln_wad_evm x))]
+      omega
+    rw [hmag]
+    exact hwnd
+  · rw [if_neg (by omega)] at hn
+    have hnum : 0 ≤ toInt nw := by omega
+    rw [evmSdiv_pos_pos hnlt hdlt hnum (by rw [hden]; omega), hden, hdenN]
+    have hwnd := floor_div_pos_window (a := toInt (model_ln_wad_evm x)) hpos
+    have hn0 : toInt nw = toInt (model_ln_wad_evm x) := by omega
+    rw [hn0]
+    exact hwnd
+
+/-- Signed floor division by `10^9` (as the helper computes it) is monotone. -/
+theorem floordiv_mono {r r' : Nat} (hr : r < 2 ^ 256) (hr' : r' < 2 ^ 256)
+    (hb1 : -(12259964326927110866866776217202473468949912977468817408 : Int) ≤ toInt r)
+    (hb2 : toInt r ≤ (12259964326927110866866776217202473468949912977468817409 : Int))
+    (hb1' : -(12259964326927110866866776217202473468949912977468817408 : Int) ≤ toInt r')
+    (hb2' : toInt r' ≤ (12259964326927110866866776217202473468949912977468817409 : Int))
+    (hle : toInt r ≤ toInt r') :
+    toInt (evmSdiv (evmSub r (evmMul (evmSlt r 0) 999999999)) 1000000000) ≤
+      toInt (evmSdiv (evmSub r' (evmMul (evmSlt r' 0) 999999999)) 1000000000) := by
+  have hden : toInt 1000000000 = (1000000000 : Int) := by decide
+  have hdenN : ((1000000000 : Int)).toNat = 1000000000 := by decide
+  have hdlt : (1000000000 : Nat) < 2 ^ 256 := by omega
+  have e1 := to_wad_numerator_eq hr hb1 hb2
+  have e1' := to_wad_numerator_eq hr' hb1' hb2'
+  have hnlt : evmSub r (evmMul (evmSlt r 0) 999999999) < 2 ^ 256 := evmSub_lt _ _
+  have hnlt' : evmSub r' (evmMul (evmSlt r' 0) 999999999) < 2 ^ 256 := evmSub_lt _ _
+  have hdpos : (0 : Int) < toInt 1000000000 := by rw [hden]; omega
+  generalize evmSub r (evmMul (evmSlt r 0) 999999999) = nw at e1 hnlt ⊢
+  generalize evmSub r' (evmMul (evmSlt r' 0) 999999999) = nw' at e1' hnlt' ⊢
+  rcases Int.lt_or_le (toInt r) 0 with hneg | hpos
+  · rw [if_pos hneg] at e1
+    have hnum : toInt nw < 0 := by omega
+    rw [evmSdiv_neg_pos hnlt hdlt hnum (by simp only [ipow255]; omega) hdpos, e1, hden,
+      hdenN]
+    rcases Int.lt_or_le (toInt r') 0 with hneg' | hpos'
+    · rw [if_pos hneg'] at e1'
+      have hnum' : toInt nw' < 0 := by omega
+      rw [evmSdiv_neg_pos hnlt' hdlt hnum' (by simp only [ipow255]; omega) hdpos, e1',
+        hden, hdenN]
+      omega
+    · rw [if_neg (by omega)] at e1'
+      have hnum' : (0 : Int) ≤ toInt nw' := by omega
+      rw [evmSdiv_pos_pos hnlt' hdlt hnum' hdpos, e1', hden, hdenN]
+      omega
+  · rw [if_neg (by omega)] at e1
+    rw [if_neg (by omega)] at e1'
+    have hnum : (0 : Int) ≤ toInt nw := by omega
+    have hnum' : (0 : Int) ≤ toInt nw' := by omega
+    rw [evmSdiv_pos_pos hnlt hdlt hnum hdpos,
+      evmSdiv_pos_pos hnlt' hdlt hnum' hdpos, e1, e1', hden, hdenN]
+    omega
+
+theorem to_wad_lt {x : Nat} (h : x < 2 ^ 256) :
+    model_ln_wad_to_wad_evm x < 2 ^ 256 := by
+  rw [to_wad_eq h]
+  exact evmSdiv_lt _ _
+
+/-- `lnWadToWad` is monotone nondecreasing over the entire domain
+`0 < x ≤ y < 2^255`. -/
+theorem model_ln_wad_to_wad_mono {x y : Nat} (hx : 0 < x) (hxy : x ≤ y)
+    (hy : y < 2 ^ 255) :
+    sle (model_ln_wad_to_wad_evm x) (model_ln_wad_to_wad_evm y) = true := by
+  have hx256 : x < 2 ^ 256 := by omega
+  have hy256 : y < 2 ^ 256 := by omega
+  have hr := model_ln_wad_mono hx hxy hy
+  have hri := toInt_of_sle (model_lt hx256) (model_lt hy256) hr
+  obtain ⟨hb1, hb2⟩ := model_bound hx256
+  obtain ⟨hb1', hb2'⟩ := model_bound hy256
+  have hdd := floordiv_mono (model_lt hx256) (model_lt hy256) hb1 hb2 hb1' hb2' hri
+  rw [to_wad_eq hx256, to_wad_eq hy256]
+  exact sle_of_toInt (evmSdiv_lt _ _) (evmSdiv_lt _ _) hdd
+
+end LnGeneratedModel
diff --git a/formal/ln/LnProof/LnProof/ZOctave.lean b/formal/ln/LnProof/LnProof/ZOctave.lean
new file mode 100644
index 000000000..dbe34faf5
--- /dev/null
+++ b/formal/ln/LnProof/LnProof/ZOctave.lean
@@ -0,0 +1,384 @@
+import LnProof.StepMono
+
+/-!
+# The mantissa-to-`z` map and the within-octave chain
+
+`zWord m` is antitone in the mantissa (consecutive cross-products reduce to
+the `P + Q = 2S` identity after sharing the single bilinear atom `P*Q`),
+stays within `[-Zc, Zc]`, and `hAt` is antitone over any interval of
+`z`-values by chaining `hI_step`.
+-/
+
+set_option maxRecDepth 4096
+
+namespace LnGeneratedModel
+
+open LnPoly
+
+def MLO : Nat := 2 ^ 95
+def MHI : Nat := 2 ^ 96
+
+theorem zWord_transport {m : Nat} (h1 : MLO ≤ m) (h2 : m < MHI) :
+    toInt (evmShl 100 (evmSub Sc m)) =
+        ((Sc : Int) - (m : Int)) * 1267650600228229401496703205376 ∧
+      toInt (evmAdd m Sc) = (m : Int) + (Sc : Int) := by
+  simp only [MLO, MHI] at h1 h2
+  have hSc : toInt Sc = (Sc : Int) := toInt_of_lt (by simp only [Sc]; omega)
+  have hm : toInt m = (m : Int) := toInt_of_lt (by simp only [Sc] at *; omega)
+  have e1 : toInt (evmSub Sc m) = (Sc : Int) - (m : Int) := by
+    rw [← hSc, ← hm]
+    refine evmSub_transport (by simp only [Sc]; omega) (by omega) ?_ ?_ <;>
+      rw [hSc, hm] <;> simp only [Sc, ipow255] <;> omega
+  have e2 : toInt (evmShl 100 (evmSub Sc m)) =
+      ((Sc : Int) - (m : Int)) * 1267650600228229401496703205376 := by
+    rw [← e1]
+    refine evmShl_transport_100 (evmSub_lt _ _) ?_ ?_ <;> rw [e1] <;>
+      simp only [Sc, ipow255] <;> omega
+  have e3 : toInt (evmAdd m Sc) = (m : Int) + (Sc : Int) := by
+    rw [← hSc, ← hm]
+    refine evmAdd_transport (by omega) (by simp only [Sc]; omega) ?_ ?_ <;>
+      rw [hSc, hm] <;> simp only [Sc, ipow255] <;> omega
+  exact ⟨e2, e3⟩
+
+/-- Value, range and unit-step antitonicity of `zWord`, proven together so the
+sign analysis is shared. -/
+theorem zWord_range {m : Nat} (h1 : MLO ≤ m) (h2 : m < MHI) :
+    -(217494458298375249691265569570 : Int) ≤ toInt (zWord m) ∧
+      toInt (zWord m) ≤ (217494458298375249691265569570 : Int) := by
+  obtain ⟨e2, e3⟩ := zWord_transport h1 h2
+  simp only [MLO, MHI] at h1 h2
+  have hden : (0 : Int) < toInt (evmAdd m Sc) := by
+    rw [e3]; simp only [Sc]; omega
+  have hdenv : toInt (evmAdd m Sc) = (m : Int) + (Sc : Int) := e3
+  unfold zWord
+  rcases Int.le_total ((m : Int)) ((Sc : Int)) with hms | hms
+  · -- numerator ≥ 0
+    have hnum : (0 : Int) ≤ toInt (evmShl 100 (evmSub Sc m)) := by
+      rw [e2]; exact Int.mul_nonneg (by omega) (by omega)
+    rw [evmSdiv_pos_pos (evmShl_lt _ _) (evmAdd_lt _ _) hnum hden]
+    constructor
+    · have := Int.natCast_nonneg
+        ((toInt (evmShl 100 (evmSub Sc m))).toNat / (toInt (evmAdd m Sc)).toNat)
+      omega
+    · have hq : (toInt (evmShl 100 (evmSub Sc m))).toNat /
+          (toInt (evmAdd m Sc)).toNat < 217494458298375249691265569571 := by
+        rw [Nat.div_lt_iff_lt_mul (by rw [hdenv]; simp only [Sc]; omega)]
+        rw [e2, hdenv]
+        simp only [Sc] at *
+        omega
+      omega
+  · -- numerator ≤ 0
+    rcases Int.lt_or_le (toInt (evmShl 100 (evmSub Sc m))) 0 with hneg | hpos
+    · rw [evmSdiv_neg_pos (evmShl_lt _ _) (evmAdd_lt _ _) hneg
+        (by rw [e2]; simp only [Sc, ipow255] at *; omega) hden]
+      constructor
+      · have hq : (-toInt (evmShl 100 (evmSub Sc m))).toNat /
+            (toInt (evmAdd m Sc)).toNat < 217494458298375249691265569571 := by
+          rw [Nat.div_lt_iff_lt_mul (by rw [hdenv]; simp only [Sc]; omega)]
+          rw [hdenv]
+          have he2' : -toInt (evmShl 100 (evmSub Sc m)) =
+              ((m : Int) - (Sc : Int)) * 1267650600228229401496703205376 := by
+            rw [e2]
+            rw [show ((m : Int) - Sc) = -((Sc : Int) - m) by omega, Int.neg_mul]
+          rw [he2']
+          simp only [Sc] at *
+          omega
+        omega
+      · have := Int.natCast_nonneg
+          ((-toInt (evmShl 100 (evmSub Sc m))).toNat / (toInt (evmAdd m Sc)).toNat)
+        omega
+    · rw [evmSdiv_pos_pos (evmShl_lt _ _) (evmAdd_lt _ _) hpos hden]
+      constructor
+      · have := Int.natCast_nonneg
+          ((toInt (evmShl 100 (evmSub Sc m))).toNat / (toInt (evmAdd m Sc)).toNat)
+        omega
+      · have hq : (toInt (evmShl 100 (evmSub Sc m))).toNat /
+            (toInt (evmAdd m Sc)).toNat < 217494458298375249691265569571 := by
+          rw [Nat.div_lt_iff_lt_mul (by rw [hdenv]; simp only [Sc]; omega)]
+          rw [e2, hdenv]
+          simp only [Sc] at *
+          omega
+        omega
+
+/-- Cross inequalities for consecutive mantissas, linearized through the
+single bilinear atom `P*E*Q`. -/
+theorem zcross_pos {P Q E : Int} (hE : 0 ≤ E) (hPQ : 0 ≤ P + Q) :
+    (P - 1) * E * Q ≤ P * E * (Q + 1) := by
+  have e1 : (P - 1) * E * Q = P * E * Q - E * Q := by
+    rw [Int.sub_mul, Int.one_mul, Int.sub_mul]
+  have e2 : P * E * (Q + 1) = P * E * Q + P * E := by
+    rw [Int.mul_add, Int.mul_one]
+  have e3 : 0 ≤ E * (P + Q) := Int.mul_nonneg hE hPQ
+  have e4 : E * (P + Q) = E * P + E * Q := by rw [Int.mul_add]
+  have e5 : E * P = P * E := Int.mul_comm E P
+  omega
+
+theorem zcross_neg {P Q E : Int} (hE : 0 ≤ E) (hPQ : 0 ≤ P + Q) :
+    -P * E * (Q + 1) ≤ (-P + 1) * E * Q := by
+  have e1 : -P * E * (Q + 1) = -P * E * Q + -P * E := by
+    rw [Int.mul_add, Int.mul_one]
+  have e2 : (-P + 1) * E * Q = -P * E * Q + E * Q := by
+    rw [Int.add_mul, Int.one_mul, Int.add_mul]
+  have e3 : 0 ≤ E * (P + Q) := Int.mul_nonneg hE hPQ
+  have e4 : E * (P + Q) = E * P + E * Q := by rw [Int.mul_add]
+  have e5 : E * P = P * E := Int.mul_comm E P
+  have e6 : -P * E = -(P * E) := by rw [Int.neg_mul]
+  omega
+
+/-- Unit-step antitonicity of `zWord`. -/
+theorem zWord_antitone_step {m : Nat} (h1 : MLO ≤ m) (h2 : m + 1 < MHI) :
+    toInt (zWord (m + 1)) ≤ toInt (zWord m) := by
+  obtain ⟨e2, e3⟩ := zWord_transport h1 (by simp only [MLO, MHI] at *; omega)
+  obtain ⟨f2, f3⟩ := zWord_transport (m := m + 1)
+    (by simp only [MLO, MHI] at *; omega) h2
+  simp only [MLO, MHI] at h1 h2
+  have hden1 : (0 : Int) < toInt (evmAdd m Sc) := by rw [e3]; simp only [Sc]; omega
+  have hden2 : (0 : Int) < toInt (evmAdd (m + 1) Sc) := by
+    rw [f3]; simp only [Sc]; omega
+  have hc1 : ((m + 1 : Nat) : Int) = (m : Int) + 1 := by omega
+  have f2' : toInt (evmShl 100 (evmSub Sc (m + 1))) =
+      ((Sc : Int) - (m : Int) - 1) * 1267650600228229401496703205376 := by
+    rw [f2, hc1]
+    rw [show ((Sc : Int) - ((m : Int) + 1)) = (Sc : Int) - (m : Int) - 1 by omega]
+  have f3' : toInt (evmAdd (m + 1) Sc) = ((m : Int) + (Sc : Int)) + 1 := by
+    rw [f3, hc1]
+    omega
+  have hPQ : (0 : Int) ≤ ((Sc : Int) - (m : Int)) + ((m : Int) + (Sc : Int)) := by
+    simp only [Sc]
+    omega
+  unfold zWord
+  rcases Int.lt_or_le 0 ((Sc : Int) - (m : Int)) with hP1 | hP0
+  · -- both numerators nonnegative
+    have hn1 : (0 : Int) ≤ toInt (evmShl 100 (evmSub Sc m)) := by
+      rw [e2]; exact Int.mul_nonneg (by omega) (by omega)
+    have hn2 : (0 : Int) ≤ toInt (evmShl 100 (evmSub Sc (m + 1))) := by
+      rw [f2']; exact Int.mul_nonneg (by omega) (by omega)
+    rw [evmSdiv_pos_pos (evmShl_lt _ _) (evmAdd_lt _ _) hn2 hden2,
+      evmSdiv_pos_pos (evmShl_lt _ _) (evmAdd_lt _ _) hn1 hden1]
+    have hcross : toInt (evmShl 100 (evmSub Sc (m + 1))) * toInt (evmAdd m Sc) ≤
+        toInt (evmShl 100 (evmSub Sc m)) * toInt (evmAdd (m + 1) Sc) := by
+      rw [e2, e3, f2', f3']
+      have := zcross_pos (P := (Sc : Int) - (m : Int)) (Q := (m : Int) + (Sc : Int))
+        (E := 1267650600228229401496703205376) (by omega) hPQ
+      rw [show ((Sc : Int) - (m : Int) - 1) = ((Sc : Int) - (m : Int)) - 1 by omega]
+      exact this
+    have hdd := cross_to_div hn2 hn1 hden2 hden1 hcross
+    omega
+  · -- P ≤ 0
+    rcases Int.lt_or_le (toInt (evmShl 100 (evmSub Sc m))) 0 with hneg1 | hpos1
+    · -- both numerators negative
+      have hPneg : (Sc : Int) - (m : Int) ≤ 0 := by omega
+      have hneg2 : toInt (evmShl 100 (evmSub Sc (m + 1))) < 0 := by
+        rw [f2']
+        have h := mul_le_mul_right_nonneg
+          (show ((Sc : Int) - (m : Int) - 1) ≤ -1 by omega)
+          (by omega : (0 : Int) ≤ 1267650600228229401496703205376)
+        omega
+      have hbnd1 : -(2 ^ 255) < toInt (evmShl 100 (evmSub Sc m)) := by
+        rw [e2]
+        have h := mul_le_mul_right_nonneg
+          (show (-(2 ^ 104) : Int) ≤ (Sc : Int) - (m : Int) by simp only [Sc]; omega)
+          (by omega : (0 : Int) ≤ 1267650600228229401496703205376)
+        have e : (-(2 ^ 104) : Int) * 1267650600228229401496703205376 =
+            -(2 ^ 104 * 1267650600228229401496703205376) := by
+          rw [Int.neg_mul]
+        simp only [ipow255] at *
+        omega
+      have hbnd2 : -(2 ^ 255) < toInt (evmShl 100 (evmSub Sc (m + 1))) := by
+        rw [f2']
+        have h := mul_le_mul_right_nonneg
+          (show (-(2 ^ 104) : Int) ≤ (Sc : Int) - (m : Int) - 1 by
+            simp only [Sc]; omega)
+          (by omega : (0 : Int) ≤ 1267650600228229401496703205376)
+        have e : (-(2 ^ 104) : Int) * 1267650600228229401496703205376 =
+            -(2 ^ 104 * 1267650600228229401496703205376) := by
+          rw [Int.neg_mul]
+        simp only [ipow255] at *
+        omega
+      rw [evmSdiv_neg_pos (evmShl_lt _ _) (evmAdd_lt _ _) hneg2 hbnd2 hden2,
+        evmSdiv_neg_pos (evmShl_lt _ _) (evmAdd_lt _ _) hneg1 hbnd1 hden1]
+      have hcross : (-toInt (evmShl 100 (evmSub Sc m))) * toInt (evmAdd (m + 1) Sc) ≤
+          (-toInt (evmShl 100 (evmSub Sc (m + 1)))) * toInt (evmAdd m Sc) := by
+        rw [e2, e3, f2', f3']
+        have hz := zcross_neg (P := (Sc : Int) - (m : Int))
+          (Q := (m : Int) + (Sc : Int))
+          (E := 1267650600228229401496703205376) (by omega) hPQ
+        have m1 : -(((Sc : Int) - (m : Int)) * 1267650600228229401496703205376) =
+            -((Sc : Int) - (m : Int)) * 1267650600228229401496703205376 := by
+          rw [Int.neg_mul]
+        have m2 : -(((Sc : Int) - (m : Int) - 1) * 1267650600228229401496703205376) =
+            (-((Sc : Int) - (m : Int)) + 1) * 1267650600228229401496703205376 := by
+          rw [show (-((Sc : Int) - (m : Int)) + 1) = -((Sc : Int) - (m : Int) - 1) by
+            omega, Int.neg_mul]
+        rw [m1, m2]
+        exact hz
+      have hk1 : (0 : Int) ≤ -toInt (evmShl 100 (evmSub Sc m)) := by omega
+      have hk2 : (0 : Int) ≤ -toInt (evmShl 100 (evmSub Sc (m + 1))) := by omega
+      have hdd := cross_to_div hk1 hk2 hden1 hden2 hcross
+      omega
+    · -- P = 0: z(m) = 0, z(m+1) ≤ 0
+      have hP0' : (Sc : Int) - (m : Int) = 0 := by
+        rcases Int.lt_or_le ((Sc : Int) - (m : Int)) 0 with hlt | hge
+        · exfalso
+          have h := mul_le_mul_right_nonneg
+            (show ((Sc : Int) - (m : Int)) ≤ -1 by omega)
+            (by omega : (0 : Int) ≤ 1267650600228229401496703205376)
+          rw [e2] at hpos1
+          omega
+        · omega
+      have hneg2 : toInt (evmShl 100 (evmSub Sc (m + 1))) < 0 := by
+        rw [f2', hP0']
+        omega
+      have hbnd2 : -(2 ^ 255) < toInt (evmShl 100 (evmSub Sc (m + 1))) := by
+        rw [f2', hP0']
+        simp only [ipow255]
+        omega
+      rw [evmSdiv_neg_pos (evmShl_lt _ _) (evmAdd_lt _ _) hneg2 hbnd2 hden2,
+        evmSdiv_pos_pos (evmShl_lt _ _) (evmAdd_lt _ _) hpos1 hden1]
+      have h0 : toInt (evmShl 100 (evmSub Sc m)) = 0 := by
+        rw [e2, hP0']
+        omega
+      rw [h0]
+      simp only [Int.toNat_zero, Nat.zero_div]
+      have := Int.natCast_nonneg
+        ((-toInt (evmShl 100 (evmSub Sc (m + 1)))).toNat /
+          (toInt (evmAdd (m + 1) Sc)).toNat)
+      omega
+
+/-- `hAt` is antitone over any interval of `z`-values in `[-Zc, Zc]`,
+by chaining `hI_step`. -/
+theorem hAt_antitone {v w : Int}
+    (h1 : -(217494458298375249691265569570 : Int) ≤ v) (h2 : v ≤ w)
+    (h3 : w ≤ (217494458298375249691265569570 : Int)) :
+    toInt (hAt w) ≤ toInt (hAt v) := by
+  have key : ∀ n : Nat, v + (n : Int) ≤ (217494458298375249691265569570 : Int) →
+      toInt (hAt (v + (n : Int))) ≤ toInt (hAt v) := by
+    intro n
+    induction n with
+    | zero =>
+      intro _
+      have he : v + ((0 : Nat) : Int) = v := by omega
+      rw [he]
+      exact Int.le_refl _
+    | succ k ih =>
+      intro hk
+      have he : v + ((k + 1 : Nat) : Int) = v + (k : Int) + 1 := by omega
+      rw [he]
+      have hs := hI_step (v + (k : Int) + 1) (by omega) (by omega)
+      have hsimp : v + (k : Int) + 1 - 1 = v + (k : Int) := by omega
+      rw [hsimp] at hs
+      exact Int.le_trans hs (ih (by omega))
+  have hn : v + (((w - v).toNat : Nat) : Int) = w := by omega
+  have hkey := key (w - v).toNat (by omega)
+  rw [hn] at hkey
+  exact hkey
+
+/-- `zWord` is antitone over the whole mantissa range, by chaining
+`zWord_antitone_step`. -/
+theorem zWord_antitone {m m' : Nat} (h1 : MLO ≤ m) (h2 : m ≤ m') (h3 : m' < MHI) :
+    toInt (zWord m') ≤ toInt (zWord m) := by
+  have key : ∀ n : Nat, m + n < MHI → toInt (zWord (m + n)) ≤ toInt (zWord m) := by
+    intro n
+    induction n with
+    | zero => intro _; exact Int.le_refl _
+    | succ k ih =>
+      intro hk
+      have hs := zWord_antitone_step (m := m + k)
+        (by simp only [MLO, MHI] at *; omega) (by simp only [MLO, MHI] at *; omega)
+      have he : m + (k + 1) = m + k + 1 := by omega
+      rw [he]
+      exact Int.le_trans hs (ih (by simp only [MLO, MHI] at *; omega))
+  have he : m + (m' - m) = m' := by omega
+  have hkey := key (m' - m) (by omega)
+  rw [he] at hkey
+  exact hkey
+
+/-- Magnitude bound on the quotient pipeline: `|X1| ≤ 2.4e29` (the true
+extremum is `≈ 2.34e29`). -/
+theorem hAt_bound {w : Int}
+    (h1 : -(217494458298375249691265569570 : Int) ≤ w)
+    (h2 : w ≤ (217494458298375249691265569570 : Int)) :
+    -(240000000000000000000000000000 : Int) ≤ toInt (hAt w) ∧
+      toInt (hAt w) ≤ (240000000000000000000000000000 : Int) := by
+  obtain ⟨heq, hmul⟩ := hAt_facts w h1 h2
+  have hul := uVal_le w h1 h2
+  obtain ⟨pw, plo, phi, _, _⟩ := pS4_facts hul
+  obtain ⟨qw, qlo, qhi, _, _⟩ := qS5_facts hul
+  have hb := pz_bound plo phi h1 h2
+  have hmw : evmMul (pS4 (uVal w)) (ofInt w) < 2 ^ 256 := evmMul_lt _ _
+  rw [heq]
+  clear heq hul
+  generalize pS4 (uVal w) = pword at *
+  generalize qS5 (uVal w) = qword at *
+  rcases Int.le_total 0 w with hw | hw
+  · -- numerator `P * w ≥ 0`
+    have hnum : (0 : Int) ≤ toInt (evmMul pword (ofInt w)) := by
+      rw [hmul]; exact Int.mul_nonneg (by omega) hw
+    rw [evmSdiv_pos_neg hmw qw hnum (by omega)]
+    have s1 : toInt (evmMul pword (ofInt w)) ≤
+        toInt pword * 217494458298375249691265569570 := by
+      rw [hmul]; exact mul_le_mul_left_nonneg h2 (by omega)
+    have s2 : toInt pword * 217494458298375249691265569570 ≤
+        13972178604861559108982341686387 * 217494458298375249691265569570 :=
+      mul_le_mul_right_nonneg phi (by omega)
+    have hdiv : (toInt (evmMul pword (ofInt w))).toNat /
+        (-toInt qword).toNat < 240000000000000000000000000001 := by
+      rw [Nat.div_lt_iff_lt_mul (by omega)]
+      omega
+    have hge := Int.natCast_nonneg ((toInt (evmMul pword (ofInt w))).toNat /
+      (-toInt qword).toNat)
+    omega
+  · -- numerator `P * w ≤ 0`
+    have hPnegw : (0 : Int) ≤ toInt pword * (-w) :=
+      Int.mul_nonneg (by omega) (by omega)
+    have hPe : toInt pword * (-w) = -(toInt pword * w) :=
+      Int.mul_neg _ _
+    rcases Int.lt_or_le (toInt (evmMul pword (ofInt w))) 0 with hneg | hpos
+    · rw [evmSdiv_neg_neg hmw qw hneg (by rw [hmul]; exact hb.1) (by omega)]
+      have s1 : -toInt (evmMul pword (ofInt w)) ≤
+          toInt pword * 217494458298375249691265569570 := by
+        rw [hmul, ← hPe]
+        exact mul_le_mul_left_nonneg (by omega) (by omega)
+      have s2 : toInt pword * 217494458298375249691265569570 ≤
+          13972178604861559108982341686387 * 217494458298375249691265569570 :=
+        mul_le_mul_right_nonneg phi (by omega)
+      have hdiv : (-toInt (evmMul pword (ofInt w))).toNat /
+          (-toInt qword).toNat < 240000000000000000000000000001 := by
+        rw [Nat.div_lt_iff_lt_mul (by omega)]
+        omega
+      have hge := Int.natCast_nonneg ((-toInt (evmMul pword (ofInt w))).toNat /
+        (-toInt qword).toNat)
+      omega
+    · rw [evmSdiv_pos_neg hmw qw hpos (by omega)]
+      have hz : (toInt (evmMul pword (ofInt w))).toNat = 0 := by omega
+      rw [hz, Nat.zero_div]
+      omega
+
+/-- The model's `r_1` (as a function of the mantissa) is monotone
+nondecreasing across the whole octave. -/
+theorem r1_mono {m m' : Nat} (h1 : MLO ≤ m) (h2 : m ≤ m') (h3 : m' < MHI) :
+    toInt (x1W (zWord m)) ≤ toInt (x1W (zWord m')) := by
+  have hz := zWord_antitone h1 h2 h3
+  have hr := zWord_range h1 (by simp only [MLO, MHI] at *; omega)
+  have hr' := zWord_range (m := m') (by simp only [MLO, MHI] at *; omega) h3
+  have hwlt : zWord m < 2 ^ 256 := by unfold zWord; exact evmSdiv_lt _ _
+  have hwlt' : zWord m' < 2 ^ 256 := by unfold zWord; exact evmSdiv_lt _ _
+  have e : x1W (zWord m) = hAt (toInt (zWord m)) := by
+    unfold hAt; rw [ofInt_toInt hwlt]
+  have e' : x1W (zWord m') = hAt (toInt (zWord m')) := by
+    unfold hAt; rw [ofInt_toInt hwlt']
+  rw [e, e']
+  exact hAt_antitone hr'.1 hz hr.2
+
+/-- Magnitude bound on the model's `r_1` over the whole octave. -/
+theorem r1_bound {m : Nat} (h1 : MLO ≤ m) (h2 : m < MHI) :
+    -(240000000000000000000000000000 : Int) ≤ toInt (x1W (zWord m)) ∧
+      toInt (x1W (zWord m)) ≤ (240000000000000000000000000000 : Int) := by
+  have hr := zWord_range h1 h2
+  have hwlt : zWord m < 2 ^ 256 := by unfold zWord; exact evmSdiv_lt _ _
+  have e : x1W (zWord m) = hAt (toInt (zWord m)) := by
+    unfold hAt; rw [ofInt_toInt hwlt]
+  rw [e]
+  exact hAt_bound hr.1 hr.2
+
+end LnGeneratedModel
diff --git a/formal/ln/LnProof/Main.lean b/formal/ln/LnProof/Main.lean
new file mode 100644
index 000000000..f8813bc63
--- /dev/null
+++ b/formal/ln/LnProof/Main.lean
@@ -0,0 +1,51 @@
+import LnProof.GeneratedLnModel
+
+/-!
+# Ln model evaluator
+
+Compiled executable for evaluating the generated EVM-faithful Ln model
+on concrete inputs. Intended for fuzz testing via Foundry's `vm.ffi`.
+
+Usage:
+  ln-model <function> <hex_x>
+
+Functions: ln_wad, ln_wad_to_wad
+
+Output: 0x-prefixed hex uint256 (two's complement int256) on stdout.
+-/
+
+open LnGeneratedModel in
+def evalFunction (name : String) (x : Nat) : Option Nat :=
+  match name with
+  | "ln_wad"        => some (model_ln_wad_evm x)
+  | "ln_wad_to_wad" => some (model_ln_wad_to_wad_evm x)
+  | _               => none
+
+def natToHex64 (n : Nat) : String :=
+  let hex := String.ofList (Nat.toDigits 16 n)
+  "0x" ++ String.ofList (List.replicate (64 - hex.length) '0') ++ hex
+
+def parseHex (s : String) : Option Nat :=
+  let s := if s.startsWith "0x" || s.startsWith "0X" then s.drop 2 else s
+  s.foldl (fun acc c =>
+    acc.bind fun n =>
+      if '0' ≤ c && c ≤ '9' then some (n * 16 + (c.toNat - '0'.toNat))
+      else if 'a' ≤ c && c ≤ 'f' then some (n * 16 + (c.toNat - 'a'.toNat + 10))
+      else if 'A' ≤ c && c ≤ 'F' then some (n * 16 + (c.toNat - 'A'.toNat + 10))
+      else none
+  ) (some 0)
+
+def main (args : List String) : IO UInt32 := do
+  match args with
+  | [fnName, hexX] =>
+    match parseHex hexX with
+    | none => IO.eprintln s!"Invalid hex input: {hexX}"; return 1
+    | some x =>
+      match evalFunction fnName x with
+      | none => IO.eprintln s!"Unknown function: {fnName}"; return 1
+      | some result =>
+        IO.println (natToHex64 result)
+        return 0
+  | _ =>
+    IO.eprintln "Usage: ln-model <ln_wad|ln_wad_to_wad> <hex_x>"
+    return 1
diff --git a/formal/ln/LnProof/lake-manifest.json b/formal/ln/LnProof/lake-manifest.json
new file mode 100644
index 000000000..b14226a32
--- /dev/null
+++ b/formal/ln/LnProof/lake-manifest.json
@@ -0,0 +1,5 @@
+{"version": "1.1.0",
+ "packagesDir": ".lake/packages",
+ "packages": [],
+ "name": "LnProof",
+ "lakeDir": ".lake"}
diff --git a/formal/ln/LnProof/lakefile.toml b/formal/ln/LnProof/lakefile.toml
new file mode 100644
index 000000000..19886d49a
--- /dev/null
+++ b/formal/ln/LnProof/lakefile.toml
@@ -0,0 +1,10 @@
+name = "LnProof"
+version = "0.1.0"
+defaultTargets = ["LnProof"]
+
+[[lean_lib]]
+name = "LnProof"
+
+[[lean_exe]]
+name = "ln-model"
+root = "Main"
diff --git a/formal/ln/LnProof/lean-toolchain b/formal/ln/LnProof/lean-toolchain
new file mode 100644
index 000000000..4c685fa08
--- /dev/null
+++ b/formal/ln/LnProof/lean-toolchain
@@ -0,0 +1 @@
+leanprover/lean4:v4.28.0
diff --git a/formal/python/evm_builtins.py b/formal/python/evm_builtins.py
index 6ee3d6455..f0c2ee812 100644
--- a/formal/python/evm_builtins.py
+++ b/formal/python/evm_builtins.py
@@ -167,6 +167,73 @@ def norm_helper(self) -> str:
         "  if nn = 0 then 0 else (aa * bb) % nn",
         "def normMulmod (a b n : Nat) : Nat :=\n" "  if n = 0 then 0 else (a * b) % n",
     ),
+    ModeledBuiltin(
+        "sdiv",
+        2,
+        # Two's complement division truncating toward zero, in sign-magnitude
+        # form. The magnitude of a negative word w is WORD_MOD - w, which also
+        # makes the lone wrapping case sdiv(-2^255, -1) = -2^255 come out
+        # right: 2^255 / 1 = 2^255 re-encodes to itself.
+        "def evmSdiv (a b : Nat) : Nat :=\n"
+        "  let aa := u256 a\n"
+        "  let bb := u256 b\n"
+        "  let na := decide (2 ^ 255 ≤ aa)\n"
+        "  let nb := decide (2 ^ 255 ≤ bb)\n"
+        "  let ma := if na then WORD_MOD - aa else aa\n"
+        "  let mb := if nb then WORD_MOD - bb else bb\n"
+        "  if bb = 0 then 0\n"
+        "  else if na = nb then u256 (ma / mb)\n"
+        "  else u256 (WORD_MOD - ma / mb)",
+        "def normSdiv (a b : Nat) : Nat :=\n"
+        "  let na := decide (2 ^ 255 ≤ a % WORD_MOD)\n"
+        "  let nb := decide (2 ^ 255 ≤ b % WORD_MOD)\n"
+        "  let ma := if na then WORD_MOD - a % WORD_MOD else a % WORD_MOD\n"
+        "  let mb := if nb then WORD_MOD - b % WORD_MOD else b % WORD_MOD\n"
+        "  if b % WORD_MOD = 0 then 0\n"
+        "  else if na = nb then ma / mb % WORD_MOD\n"
+        "  else (WORD_MOD - ma / mb) % WORD_MOD",
+    ),
+    ModeledBuiltin(
+        "sar",
+        2,
+        # Arithmetic shift right via the identity sar(s, v) = not(shr(s, not v))
+        # for negative v.
+        "def evmSar (shift value : Nat) : Nat :=\n"
+        "  let s := u256 shift\n"
+        "  let v := u256 value\n"
+        "  if 2 ^ 255 ≤ v then\n"
+        "    if 256 ≤ s then WORD_MOD - 1\n"
+        "    else WORD_MOD - 1 - (WORD_MOD - 1 - v) / 2 ^ s\n"
+        "  else if 256 ≤ s then 0\n"
+        "  else v / 2 ^ s",
+        "def normSar (shift value : Nat) : Nat :=\n"
+        "  let s := shift % WORD_MOD\n"
+        "  let v := value % WORD_MOD\n"
+        "  if 2 ^ 255 ≤ v then\n"
+        "    if 256 ≤ s then WORD_MOD - 1\n"
+        "    else WORD_MOD - 1 - (WORD_MOD - 1 - v) / 2 ^ s\n"
+        "  else if 256 ≤ s then 0\n"
+        "  else v / 2 ^ s",
+    ),
+    ModeledBuiltin(
+        "slt",
+        2,
+        # Signed comparison is unsigned comparison with the sign bit flipped.
+        "def evmSlt (a b : Nat) : Nat :=\n"
+        "  if (u256 a + 2 ^ 255) % WORD_MOD < (u256 b + 2 ^ 255) % WORD_MOD then 1 else 0",
+        "def normSlt (a b : Nat) : Nat :=\n"
+        "  if (a % WORD_MOD + 2 ^ 255) % WORD_MOD < (b % WORD_MOD + 2 ^ 255) % WORD_MOD then 1\n"
+        "  else 0",
+    ),
+    ModeledBuiltin(
+        "sgt",
+        2,
+        "def evmSgt (a b : Nat) : Nat :=\n"
+        "  if (u256 b + 2 ^ 255) % WORD_MOD < (u256 a + 2 ^ 255) % WORD_MOD then 1 else 0",
+        "def normSgt (a b : Nat) : Nat :=\n"
+        "  if (b % WORD_MOD + 2 ^ 255) % WORD_MOD < (a % WORD_MOD + 2 ^ 255) % WORD_MOD then 1\n"
+        "  else 0",
+    ),
 )
 
 # Complete set of Yul/EVM builtins that solc reserves (error 5568).
diff --git a/formal/python/ln/__init__.py b/formal/python/ln/__init__.py
new file mode 100644
index 000000000..254bb16e1
--- /dev/null
+++ b/formal/python/ln/__init__.py
@@ -0,0 +1 @@
+"""Formal helpers for Ln.sol counterexample checks."""
diff --git a/formal/python/ln/check_ln_counterexample.py b/formal/python/ln/check_ln_counterexample.py
new file mode 100644
index 000000000..9186a9c5f
--- /dev/null
+++ b/formal/python/ln/check_ln_counterexample.py
@@ -0,0 +1,124 @@
+#!/usr/bin/env python3
+from __future__ import annotations
+
+from decimal import Decimal, localcontext
+
+from formal.python.evm_builtins import WORD_MOD, eval_pure_builtin, u256
+
+WAD = 10**18
+RAY = 10**27
+SIGN_BIT = 1 << 255
+
+# x = WAD + 1 is the witness input for the floor specification: the exact result lies
+# strictly inside (10**9 - 1, 10**9), so any rounding mode other than floor (or floor - 1)
+# is detectable here.
+WITNESS_X = WAD + 1
+EXPECTED_FLOOR_RESULT = 10**9 - 1
+
+# Constants mirrored from src/vendor/Ln.sol (see the comments there for derivations).
+_S = 0xB504F333F9DE6484597D89B3
+_P4 = 0xF642B0ED5372FF45E0
+_P3 = 0xEDE142E73A9ACBB00E9C42
+_P2 = 0xF2A56533E74A454C9D585F70
+_P1 = 0xB44D9253CD61FB87DC7EFCFC
+_C0 = 0xB05A8B41CF51C04D1B8A08D473
+_Q4 = 0x364589193443B48661938F59DC
+_Q3 = 0xE904C4E76307954DF78FEF
+_Q2 = 0xAD960AB2F600BD9765C15FFD
+_Q1 = 0xD1B1FEDEC544F0EA0BC812BBCA
+_K = 0x6765C793FA10079D
+_LN2 = 0x23D5B9FF36551802AA5D6F9754B0F3FAD83B19450
+_BIAS = 0x4FF7E9B32826A6AEC97EA1E696BD71EB764C77277C
+
+
+def _op(name: str, *args: int) -> int:
+    return eval_pure_builtin(name, tuple(args))
+
+
+def _i256(word: int) -> int:
+    word = u256(word)
+    return word - WORD_MOD if word >= SIGN_BIT else word
+
+
+def ln_wad_evm(x: int) -> int:
+    """Step-for-step mirror of `Ln.lnWadToRay` from src/vendor/Ln.sol (wad in, ray out)."""
+    x_word = u256(x)
+    if _op("iszero", _op("sgt", x_word, 0)) != 0:
+        raise ValueError("LnWadUndefined")
+
+    c = _op("clz", x_word)
+    k = _op("sub", 0xA0, c)
+    x_word = _op("shr", 0xA0, _op("shl", c, x_word))
+
+    z = _op("sdiv", _op("shl", 0x64, _op("sub", _S, x_word)), _op("add", x_word, _S))
+    u = _op("shr", 0x68, _op("mul", z, z))
+
+    p = _op("sub", _op("shr", 0x54, _op("mul", _P4, u)), _P3)
+    p = _op("add", _op("sar", 0x5A, _op("mul", p, u)), _P2)
+    p = _op("sub", _op("sar", 0x61, _op("mul", p, u)), _P1)
+    p = _op("add", _op("sar", 0x57, _op("mul", p, u)), _C0)
+
+    q = _op("sub", u, _Q4)
+    q = _op("add", _op("sar", 0x71, _op("mul", q, u)), _Q3)
+    q = _op("sub", _op("sar", 0x5A, _op("mul", q, u)), _Q2)
+    q = _op("add", _op("sar", 0x58, _op("mul", q, u)), _Q1)
+    q = _op("sub", _op("sar", 0x5F, _op("mul", q, u)), _C0)
+
+    r = _op("sdiv", _op("mul", p, z), q)
+    r = _op("mul", r, _K)
+    r = _op("add", r, _op("mul", _LN2, k))
+    r = _op("add", r, _BIAS)
+    r = _op("sar", 0x48, r)
+    # lnWadToRay(10**18) = 0 is the only integer-valued result; the floored
+    # accumulator lands on -1 there. `iszero(not(r))` adds 1 back exactly when
+    # r == -1 (and never otherwise), giving the exact 0.
+    return _i256(_op("add", _op("iszero", _op("not", r)), r))
+
+
+def ln_wad_to_wad_evm(x: int) -> int:
+    """Step-for-step mirror of `Ln.lnWad` from src/vendor/Ln.sol (wad in, wad out)."""
+    r = u256(ln_wad_evm(x))
+    return _i256(
+        _op("sdiv", _op("sub", r, _op("mul", _op("slt", r, 0), 0x3B9AC9FF)), 0x3B9ACA00)
+    )
+
+
+def floor_spec_for_witness(x: int) -> int:
+    if x != WAD + 1:
+        raise ValueError("exact floor proof is specialized to WAD + 1")
+
+    # For t > 0, t - t**2/2 < ln(1 + t) < t. With t = 1 / WAD, the exact value
+    # RAY * ln(1 + t) lies in (10**9 - 5e-10, 10**9), so its floor is 10**9 - 1.
+    return 10**9 - 1
+
+
+def decimal_ln_ray(x: int) -> Decimal:
+    with localcontext() as ctx:
+        ctx.prec = 120
+        return (Decimal(x) / Decimal(WAD)).ln() * Decimal(RAY)
+
+
+def main() -> int:
+    actual = ln_wad_evm(WITNESS_X)
+    expected = floor_spec_for_witness(WITNESS_X)
+    value = decimal_ln_ray(WITNESS_X)
+
+    assert expected == EXPECTED_FLOOR_RESULT, expected
+    # lnWadToRay must return floor(L) or floor(L) - 1.
+    assert actual in (expected, expected - 1), actual
+    # ln(10**18 / 10**18) = 0 exactly, and the implementation pins it.
+    assert ln_wad_evm(WAD) == 0
+    assert ln_wad_to_wad_evm(WAD) == 0
+    # The wad-basis helper floors the ray result by 10**9 in both sign regimes.
+    assert ln_wad_to_wad_evm(WITNESS_X) in (0, -1)
+    assert ln_wad_to_wad_evm(WAD - 1) == -2  # ray result -1000000001 floors to -2
+
+    print(f"x = {WITNESS_X}")
+    print(f"lnWadToRay EVM result = {actual}")
+    print(f"floor mathematical result = {expected}")
+    print(f"1e27 * ln(x / 1e18) = {value}")
+    return 0
+
+
+if __name__ == "__main__":
+    raise SystemExit(main())
diff --git a/formal/python/ln/check_ln_monotone.py b/formal/python/ln/check_ln_monotone.py
new file mode 100644
index 000000000..084e340dd
--- /dev/null
+++ b/formal/python/ln/check_ln_monotone.py
@@ -0,0 +1,259 @@
+#!/usr/bin/env python3
+"""Monotonicity certificate for `Ln.lnWadToRay` (src/vendor/Ln.sol).
+
+The claim: x1 < x2 implies lnWadToRay(x1) <= lnWadToRay(x2) over the whole domain
+x in [1, 2**255).
+
+Proof structure
+===============
+
+Write m for the Q103 mantissa and k for the exponent (x ~ m * 2**k with m in
+[2**103, 2**104)). Adjacent inputs either share (m, k) (identical result),
+advance m by one within an octave, or cross a clz seam from
+(m = 2**104 - 2**(104-t), k) to (m = 2**103, k + 1) at x = 2**t. The
+correction `r + (r == -1)` raises the single floored result that equals -1
+(only x = 10**18, whose exact result is the integer 0) up to 0, which preserves
+order against both neighbors (checked exactly below).
+
+Within an octave, the result is `sar(72, X1 * 5**27 + k*LN2 + BIAS)` with
+X1 = sdiv(p(u) * z, q(u)); `sar` and the exact affine map preserve order, so
+it suffices that X1 is nondecreasing in m. That follows from this chain:
+
+1.  z = sdiv((S - m) << 100, m + S) is nonincreasing in m, stepping by 0 or -1
+    per unit of m. The real argument zeta = (S - m)*2**100/(m + S) has
+    d(zeta)/dm = -2*S*2**100/(m + S)**2, which is negative and (checked below)
+    less than 1 in magnitude, and `sdiv` truncation toward zero is a monotone
+    function of zeta.
+2.  u = (z*z) >> 104 changes by at most 1 per unit step of z, because
+    2*|z| + 1 < 2**104 (checked below).
+3.  X1 = trunc(A(z)) with A(z) = p(u(z))*z/q(u(z)), and truncation toward zero
+    is monotone, so it suffices that A is antitone in the integer z. Per unit
+    step of z,
+        A(z-1) - A(z) = R(u') + z*(R(u') - R(u)),   R = p/(-q),
+    where u' = u(z-1) differs from u by at most 1. Splitting R into the
+    real-coefficient rational R_real plus per-point truncation jitter,
+    R(u') - R(u) = [R_real(u') - R_real(u)] + jitter, the real part has the
+    helpful sign (R_real is nondecreasing -- checked below by exact interval
+    subdivision -- and the sign of the u-step matches the sign of z), so
+        A(z-1) - A(z) >= R_min - z_max * 2*J > 0
+    where R_min is a lower bound for R on the domain (from exact integer
+    interval propagation of the Horner stages, including truncation slop) and
+    J bounds |R - R_real| at any point: each Horner stage truncation theta_i
+    in [0, 1) at stage basis b_i, followed by j more multiplies by u,
+    perturbs the final Q94 polynomial by less than 2**(94 - b_i) * u_max**j,
+    so J <= (slop_p + R_max * slop_q) / |q|_min.
+
+The clz seams do not satisfy a useful one-sided bound (the rational's error
+at u_max enters both seam endpoints with the same sign and no cancellation),
+so all 254 of them are verified exactly. The certified sign of the error at
+u_max (negative, about -0.32 ulp weighted) gives the seam checks slack; this
+script derives each seam result directly from the EVM mirror.
+
+Everything here is exact integer/rational arithmetic -- no floating point.
+
+The same argument is machine-checked end to end in Lean against the generated
+model (formal/ln/LnProof, theorem `model_ln_wad_mono` in LnProof/TopMono.lean);
+this script is its executable exact-rational counterpart.
+"""
+
+from __future__ import annotations
+
+import sys
+from fractions import Fraction
+
+from formal.python.ln.check_ln_counterexample import (
+    _BIAS,
+    _C0,
+    _K,
+    _LN2,
+    _P1,
+    _P2,
+    _P3,
+    _P4,
+    _Q1,
+    _Q2,
+    _Q3,
+    _Q4,
+    _S,
+    WAD,
+    ln_wad_evm,
+)
+
+# Stage layout mirrored from src/vendor/Ln.sol: (coefficient, basis, remaining
+# multiplies by u after the coefficient is added). Signs follow the p~ = -p,
+# z~ = -z convention used by the implementation.
+W = 95
+P_COEFFS = ((_P4, 68, 4), (-_P3, 80, 3), (_P2, 86, 2), (-_P1, 85, 1), (_C0, 94, 0))
+Q_COEFFS = ((-_Q4, 96, 4), (_Q3, 79, 3), (-_Q2, 85, 2), (_Q1, 93, 1), (-_C0, 94, 0))
+FINAL_BASIS = 94
+Z_BASIS = 100
+U_BASIS = 96
+
+
+def _domain() -> tuple[int, int]:
+    """Largest |z| over m in [2**W, 2**(W+1)) and largest u, as integers."""
+    two_w = 1 << W
+    z_lo = Fraction(((_S - two_w) << Z_BASIS), two_w + _S)
+    z_hi = Fraction(((2 * two_w - 1 - _S) << Z_BASIS), 2 * two_w - 1 + _S)
+    zmax = max(int(z_lo), int(-z_hi), int(-z_lo), int(z_hi))
+    umax = (zmax * zmax) >> (2 * Z_BASIS - U_BASIS)
+    return zmax, umax + 1
+
+
+def _stage_intervals(
+    coeffs: tuple[tuple[int, int, int], ...], umax_int: int, monic_first: bool
+) -> list[tuple[int, int]]:
+    """Exact integer interval propagation of the Horner stages, including the
+    [0, 1) truncation slop of each renormalizing shift. Returns the list of
+    per-stage (lo, hi) bounds."""
+    (c0, b0, _), rest = coeffs[0], coeffs[1:]
+    if monic_first:
+        lo, hi = c0, umax_int + c0
+    else:
+        lo = hi = c0
+    prev_basis = U_BASIS if monic_first else b0
+    out = [(lo, hi)]
+    for c, b, _ in rest:
+        shift = prev_basis + U_BASIS - b
+        cands = (0, lo * umax_int, hi * umax_int)
+        lo = min(cands) // (1 << shift) - 1 + c
+        hi = max(cands) // (1 << shift) + c
+        assert (
+            max(abs(lo * umax_int), abs(hi * umax_int)).bit_length() < 255
+        ), "mul overflow"
+        prev_basis = b
+        out.append((lo, hi))
+    return out
+
+
+def _slop(coeffs: tuple[tuple[int, int, int], ...], umax_int: int) -> Fraction:
+    """Bound, in final-basis units, on |integer Horner value - real-coefficient
+    polynomial * 2**FINAL_BASIS|: the sum over stages of the truncation range
+    [0, 1) scaled by 2**(FINAL_BASIS - basis) and u_max**j."""
+    u = Fraction(umax_int, 1 << U_BASIS)
+    total = Fraction(0)
+    for _, b, j in coeffs[1:]:
+        total += Fraction(1 << FINAL_BASIS, 1 << b) * u**j
+    return total
+
+
+def _poly_coeffs(coeffs: tuple[tuple[int, int, int], ...]) -> list[Fraction]:
+    """Real-coefficient polynomial as exact rationals, low order first."""
+    out = [Fraction(0)] * 6
+    for c, b, j in coeffs:
+        out[j] += Fraction(c, 1 << b)
+    return out
+
+
+def _poly_mul(a: list[Fraction], b: list[Fraction]) -> list[Fraction]:
+    out = [Fraction(0)] * (len(a) + len(b) - 1)
+    for i, x in enumerate(a):
+        for j, y in enumerate(b):
+            out[i + j] += x * y
+    return out
+
+
+def _poly_deriv(a: list[Fraction]) -> list[Fraction]:
+    return [i * c for i, c in enumerate(a)][1:]
+
+
+def _interval_horner(
+    coeffs: list[Fraction], lo: Fraction, hi: Fraction
+) -> tuple[Fraction, Fraction]:
+    vlo = vhi = coeffs[-1]
+    for c in reversed(coeffs[:-1]):
+        cands = (vlo * lo, vlo * hi, vhi * lo, vhi * hi)
+        vlo, vhi = min(cands) + c, max(cands) + c
+    return vlo, vhi
+
+
+def _certify_positive(
+    coeffs: list[Fraction], lo: Fraction, hi: Fraction, depth: int = 0
+) -> bool:
+    """Certify min of the polynomial over [lo, hi] is nonnegative by exact
+    interval bisection."""
+    blo, _ = _interval_horner(coeffs, lo, hi)
+    if blo >= 0:
+        return True
+    if depth >= 40:
+        return False
+    mid = (lo + hi) / 2
+    return _certify_positive(coeffs, lo, mid, depth + 1) and _certify_positive(
+        coeffs, mid, hi, depth + 1
+    )
+
+
+def main() -> int:
+    zmax, umax_int = _domain()
+
+    # (1) the mantissa -> z map is strictly antitone: each unit step of m lowers the
+    # integer z by at least one (at Q95, by 8 to 16, since |d(zeta)/dm| = 2*S*2^100/(m+S)^2
+    # >= 1 over the octave). The quotient is antitone per unit step of z (3b), which
+    # telescopes over that multi-unit decrease, so z need not step by exactly one.
+    two_w = 1 << W
+    assert (
+        2 * _S << Z_BASIS >= ((two_w << 1) + _S) ** 2
+    ), "z not strictly decreasing in m"
+
+    # (2) u steps by at most one per unit step of z.
+    assert 2 * zmax + 1 < 1 << (2 * Z_BASIS - U_BASIS), "u step > 1"
+
+    # (3a) integer interval propagation: p > 0, q < 0, and R = p/(-q) bounds.
+    pst = _stage_intervals(P_COEFFS, umax_int, monic_first=False)
+    qst = _stage_intervals(Q_COEFFS, umax_int, monic_first=True)
+    p_lo, p_hi = pst[-1]
+    q_lo, q_hi = qst[-1]
+    assert p_lo > 0, "p not positive"
+    assert q_hi < 0, "q not negative"
+    r_min = Fraction(p_lo, -q_lo)
+    r_max = Fraction(p_hi, -q_hi)
+
+    # (3b) truncation jitter bound J and the step inequality.
+    slop_p = _slop(P_COEFFS, umax_int)
+    slop_q = _slop(Q_COEFFS, umax_int)
+    jitter = (slop_p + r_max * slop_q) / (-q_hi)
+    step_margin = r_min - zmax * 2 * jitter
+    assert (
+        step_margin > 0
+    ), f"within-octave step margin not positive: {float(step_margin)}"
+
+    # (3c) the real-coefficient rational is nondecreasing on [0, u_max]:
+    # N(u) = P'(u) * (-Q(u)) + P(u) * Q'(u) >= 0.
+    pr = _poly_coeffs(P_COEFFS)
+    qr = _poly_coeffs(Q_COEFFS) + []
+    qr.append(Fraction(0))
+    qr[5] += 1  # monic u**5 term
+    n_poly = [
+        a + b
+        for a, b in zip(
+            _poly_mul(_poly_deriv(pr), [-c for c in qr]), _poly_mul(pr, _poly_deriv(qr))
+        )
+    ]
+    u_hi = Fraction(umax_int, 1 << U_BASIS)
+    assert _certify_positive(n_poly, Fraction(0), u_hi), "R_real not monotone"
+
+    # clz seams: verified exactly, one pair per exponent.
+    for t in range(1, 255):
+        assert ln_wad_evm(1 << t) >= ln_wad_evm((1 << t) - 1), f"seam at 2**{t}"
+
+    # the x == 10**18 correction point and its neighbors.
+    assert ln_wad_evm(WAD) == 0
+    assert ln_wad_evm(WAD - 1) <= 0 <= ln_wad_evm(WAD + 1)
+
+    print("within-octave step margin:", float(step_margin))
+    print("R in [", float(r_min), ",", float(r_max), "]")
+    print(
+        "slop_p =",
+        float(slop_p),
+        " slop_q =",
+        float(slop_q),
+        " z_max*2J =",
+        float(zmax * 2 * jitter),
+    )
+    print("all 254 clz seams monotone; lnWadToRay(10**18) == 0")
+    print("monotonicity certificate: OK")
+    return 0
+
+
+if __name__ == "__main__":
+    raise SystemExit(main())
diff --git a/formal/python/ln/gen_cert_literals.py b/formal/python/ln/gen_cert_literals.py
new file mode 100644
index 000000000..812d47ddb
--- /dev/null
+++ b/formal/python/ln/gen_cert_literals.py
@@ -0,0 +1,218 @@
+#!/usr/bin/env python3
+"""Emit FloorCertLit.lean: literal coefficient lists for the four main
+certificate polynomials, mirroring the constructions in FloorCertDefs.lean."""
+
+import math
+import pathlib
+import sys
+
+sys.set_int_max_str_digits(2000000)
+sys.path.insert(0, str(pathlib.Path(__file__).resolve().parents[3]))
+from formal.python.ln.check_ln_counterexample import (
+    _C0,
+    _P1,
+    _P2,
+    _P3,
+    _P4,
+    _Q1,
+    _Q2,
+    _Q3,
+    _Q4,
+    _S,
+)
+
+S = _S
+K = 22
+KF = math.factorial(K)
+KF1 = math.factorial(K + 1)
+EUN, EUD = 3401, 10**31
+
+PPc: list[int] = [_C0 * 2**358, -_P1 * 2**271, _P2 * 2**174, -_P3 * 2**84, _P4]
+QQc: list[int] = [-_C0 * 2**386, _Q1 * 2**291, -_Q2 * 2**203, _Q3 * 2**113, -_Q4, 1]
+SLOPPc = 9812004177583774588419572070418085567299104489606785913494676545320496277998160323177880419302954869373068096
+SLOPQc = 368554503459564650655355223502937602070057924280391756343149979867298567572166014505521622720564112305091187444809728
+
+
+def pmul(a: list[int], b: list[int]) -> list[int]:
+    if not a or not b:
+        return []
+    out = [0] * (len(a) + len(b) - 1)
+    for i, x in enumerate(a):
+        for j, y in enumerate(b):
+            out[i + j] += x * y
+    return out
+
+
+def padd(a: list[int], b: list[int]) -> list[int]:
+    out = list(a) if len(a) >= len(b) else list(b)
+    for i, y in enumerate(b if len(a) >= len(b) else a):
+        out[i] += y
+    return out
+
+
+def pscale(c: int, a: list[int]) -> list[int]:
+    return [c * x for x in a]
+
+
+def ppow(a: list[int], n: int) -> list[int]:
+    # mirror Lean polyPow: P^(n+1) = polyMul P (polyPow P n)
+    r = [1]
+    for _ in range(n):
+        r = pmul(a, r)
+    return r
+
+
+def pneg(a: list[int]) -> list[int]:
+    return [-c for c in a]
+
+
+def hom(coeffs: list[int], num: list[int], den: list[int]) -> list[int]:
+    # mirror Lean homPoly: Horner form with [0] base; keeps trailing zeros
+    out = [0]
+    for j in range(len(coeffs) - 1, -1, -1):
+        out = padd(pscale(coeffs[j], ppow(den, len(coeffs) - 1 - j)), pmul(num, out))
+    return out
+
+
+def exp_poly_num(tn: list[int], td: list[int], k: int) -> list[int]:
+    # mirror Lean expPolyNum
+    if k == 0:
+        return [1]
+    r = exp_poly_num(tn, td, k - 1)
+    return padd(pscale(k, pmul(td, r)), ppow(tn, k))
+
+
+def build_branch(sign: int) -> dict[str, list[int]]:
+    A = [-S, 1] if sign > 0 else [S, -1]
+    B = [S, 1]
+    A2 = pmul(A, A)
+    B2 = pmul(B, B)
+    WLO = padd(padd(pscale(2**99, A2), pneg(pmul(A, B))), pscale(-8, B2))
+    D8 = pscale(8, B2)
+    A96 = pscale(2**96, A2)
+    PPHwlo = hom(PPc, WLO, D8)
+    QQHws = hom(QQc, A96, B2)
+    QQHwlo = hom(QQc, WLO, D8)
+    PPHws = hom(PPc, A96, B2)
+    TN = pscale(2**17, pmul(pmul(A, B), PPHwlo))
+    TD = pneg(QQHws)
+    PLOP = padd(PPHws, pscale(-SLOPPc, ppow(B2, 4)))
+    DLO = padd(pneg(QQHwlo), pscale(SLOPQc, ppow(D8, 5)))
+    AZ = padd(pscale(2**100, A), pneg(B))
+    TN2 = pmul(pmul(PLOP, AZ), B)
+    TD2 = pscale(2**56, DLO)
+    TN2b = padd(pscale(2**99, TN2), pneg(TD2))
+    TD2b = pscale(2**99, TD2)
+    return dict(TN=TN, TD=TD, TN2b=TN2b, TD2b=TD2b)
+
+
+GE = build_branch(+1)
+LT = build_branch(-1)
+
+certs: dict[str, list[int]] = {}
+EPN_ge = exp_poly_num(GE["TN"], GE["TD"], K)
+certs["certGeUpLit"] = padd(
+    pscale((EUD + EUN) * KF1, pmul([0, 1], ppow(GE["TD"], K + 1))),
+    pscale(
+        -S * EUD,
+        padd(pscale(K + 1, pmul(EPN_ge, GE["TD"])), pscale(2, ppow(GE["TN"], K + 1))),
+    ),
+)
+EPN2_ge = exp_poly_num(GE["TN2b"], GE["TD2b"], K)
+certs["certGeLoLit"] = padd(
+    pscale(EUD * S, EPN2_ge),
+    pscale(-(EUD - EUN) * KF, pmul([0, 1], ppow(GE["TD2b"], K))),
+)
+EPNlt_w = exp_poly_num(LT["TN2b"], LT["TD2b"], K)
+certs["certLtUpLit"] = padd(
+    pscale((EUD + EUN), pmul([0, 1], EPNlt_w)),
+    pscale(-EUD * S * KF, ppow(LT["TD2b"], K)),
+)
+EPNlt_t = exp_poly_num(LT["TN"], LT["TD"], K)
+certs["certLtLoLit"] = padd(
+    pscale(S * EUD * KF1, ppow(LT["TD"], K + 1)),
+    pscale(
+        -(EUD - EUN),
+        pmul(
+            [0, 1],
+            padd(
+                pscale(K + 1, pmul(EPNlt_t, LT["TD"])), pscale(2, ppow(LT["TN"], K + 1))
+            ),
+        ),
+    ),
+)
+
+
+def peval(a: list[int], x: int) -> int:
+    acc = 0
+    for c in reversed(a):
+        acc = acc * x + c
+    return acc
+
+
+def ptrim(a: list[int]) -> list[int]:
+    # Drop high-degree zero coefficients (the trailing entries of the
+    # low-degree-first list). Horner evaluation ignores them, so the trimmed
+    # list agrees with the original everywhere and has a no-larger ell-1 norm;
+    # the cell walks then Taylor-shift a shorter polynomial. The cert literals
+    # are matched to their constructions by `evalPoly_ext` (an evaluation
+    # identity), which tolerates this; the base TN/TD literals below are
+    # matched by list equality and are left exactly as built.
+    out = list(a)
+    while len(out) > 1 and out[-1] == 0:
+        out.pop()
+    return out
+
+
+# Kronecker digit width used by the proof (FloorCert*.lean `*_eval_eq` and the
+# cell-walk `checkCoverK`). It must exceed log2(2 * ell1) of the certificates;
+# the binding floor is the cell-walk `aeval` bound at ~2^37772 (the certificate
+# coefficients are ~37k-bit and the monomials decay ~104 bits/degree, so every
+# term is ~constant scale), with the eval-identity `polyL1` floor at ~2^37392.
+# 38000 clears both with a ~228-bit margin; it is not a free parameter.
+_B_CERT = 38000
+for _name in ("certGeUpLit", "certGeLoLit", "certLtUpLit", "certLtLoLit"):
+    _full = certs[_name]
+    _trimmed = ptrim(_full)
+    assert peval(_trimmed, 1 << _B_CERT) == peval(_full, 1 << _B_CERT), _name
+    print(_name, "trimmed", len(_full), "->", len(_trimmed))
+    certs[_name] = _trimmed
+
+base: dict[str, list[int]] = {}
+for br, D in (("ge", GE), ("lt", LT)):
+    for nm in ("TN", "TD", "TN2b", "TD2b"):
+        base[f"{br}{nm}Lit"] = D[nm]
+certs = {**base, **certs}
+
+out: list[str] = [
+    "/-! Generated by formal/python/ln/gen_cert_literals.py — literal",
+    "coefficient lists for the four main certificate polynomials. The",
+    "`*_eq_lit` theorems in the certificate files verify these against",
+    "the `FloorCertDefs` constructions in the kernel. -/",
+    "",
+    "namespace LnFloorCert",
+    "",
+]
+for name, cs in certs.items():
+    out.append(f"def {name} : List Int := [")
+    body = ",\n".join(f"  {c}" for c in cs)
+    out.append(body + "]")
+    out.append("")
+    print(
+        name, "deg", len(cs) - 1, "max coeff bits", max(abs(c).bit_length() for c in cs)
+    )
+out.append("end LnFloorCert")
+import os
+
+out_path = os.path.join(
+    os.path.dirname(__file__),
+    "..",
+    "..",
+    "ln",
+    "LnProof",
+    "LnProof",
+    "FloorCertLit.lean",
+)
+with open(os.path.abspath(out_path), "w") as f:
+    f.write("\n".join(out) + "\n")
+print("written")
diff --git a/formal/python/ln/generate_ln_model.py b/formal/python/ln/generate_ln_model.py
new file mode 100644
index 000000000..c25315fce
--- /dev/null
+++ b/formal/python/ln/generate_ln_model.py
@@ -0,0 +1,118 @@
+#!/usr/bin/env python3
+"""
+Generate Lean models of Ln.sol from Yul IR.
+
+This script extracts `lnWadToRay` and `lnWad` from the Yul IR produced by
+`forge inspect` on a wrapper contract and emits Lean definitions with
+opcode-faithful uint256 EVM semantics.
+
+The non-positive-input revert guard (a `Panic(uint256)` with the
+division-by-zero code `0x12`) is stripped before translation: the memory
+model only supports straight-line memory writes, and every Lean theorem
+about the model quantifies over the non-reverting domain 0 < x < 2**255
+anyway. The strip is exact-match and fails loudly if the guard's shape in
+the IR ever changes.
+"""
+
+from __future__ import annotations
+
+import re
+from typing import cast
+
+_REVERT_GUARD = re.compile(
+    r"if\s+iszero\(slt\(0x00,\s*(\w+)\)\)\s*"
+    r"\{\s*mstore\(0x00,\s*0x4e487b71\)\s*mstore\(0x20,\s*0x12\)\s*"
+    r"revert\(0x1c,\s*0x24\)\s*\}",
+)
+
+
+def strip_revert_guard(yul_text: str) -> str:
+    stripped, count = _REVERT_GUARD.subn("", yul_text)
+    if count != 1:
+        raise SystemExit(
+            "expected exactly one non-positive-input revert guard in the Yul"
+            f" IR, found {count}"
+        )
+    return stripped
+
+
+if __package__ in (None, ""):
+    import pathlib
+    import sys
+
+    sys.path.insert(0, str(pathlib.Path(__file__).resolve().parents[3]))
+
+    from formal.python.generator_cli import run_generator
+    from formal.python.model_config import (
+        CliConfig,
+        EmissionConfig,
+        ModelConfig,
+        SelectionConfig,
+        TransformConfig,
+    )
+else:
+    from ..generator_cli import run_generator
+    from ..model_config import (
+        CliConfig,
+        EmissionConfig,
+        ModelConfig,
+        SelectionConfig,
+        TransformConfig,
+    )
+
+CONFIG = ModelConfig(
+    selection=SelectionConfig(
+        function_order=("lnWadToRay", "lnWad"),
+        inner_fn="lnWadToRay",
+    ),
+    emission=EmissionConfig(
+        # The model identifiers keep their established names: `model_ln_wad` is the
+        # ray-output computation (Solidity `lnWadToRay`) and `model_ln_wad_to_wad` is
+        # the wad-output computation (Solidity `lnWad`), matching every theorem in the
+        # proof corpus.
+        model_names={
+            "lnWadToRay": "model_ln_wad",
+            "lnWad": "model_ln_wad_to_wad",
+        },
+        header_comment="Auto-generated from Solidity Ln assembly and assignment flow.",
+        generator_label="formal/python/ln/generate_ln_model.py",
+        norm_rewrite=None,
+    ),
+    transforms=TransformConfig(
+        skip_norm=frozenset({"lnWadToRay", "lnWad"}),
+    ),
+    cli=CliConfig(
+        source_label="src/vendor/Ln.sol",
+        namespace="LnGeneratedModel",
+        output="formal/ln/LnProof/LnProof/GeneratedLnModel.lean",
+        description="Generate Lean model of Ln.sol functions from Yul IR",
+    ),
+)
+
+
+def main() -> int:
+    import sys
+    import tempfile
+
+    argv = sys.argv[1:]
+    try:
+        yul_at = argv.index("--yul")
+        yul_arg = argv[yul_at + 1]
+    except (ValueError, IndexError):
+        raise SystemExit("--yul <path|-> is required")
+
+    if yul_arg == "-":
+        # typeshed types `sys.stdin` as `TextIO | Any`; the read is a `str`.
+        yul_text = cast(str, sys.stdin.read())
+    else:
+        with open(yul_arg) as source:
+            yul_text = source.read()
+    with tempfile.NamedTemporaryFile("w", suffix=".yul", delete=False) as handle:
+        handle.write(strip_revert_guard(yul_text))
+        argv[yul_at + 1] = handle.name
+    sys.argv[1:] = argv
+    return run_generator(CONFIG)
+
+
+if __name__ == "__main__":
+    raise SystemExit(main())
diff --git a/src/vendor/Ln.sol b/src/vendor/Ln.sol
new file mode 100644
index 000000000..43a7c81db
--- /dev/null
+++ b/src/vendor/Ln.sol
@@ -0,0 +1,143 @@
+// SPDX-License-Identifier: MIT
+pragma solidity ^0.8.34;
+
+library Ln {
+    /// @notice Compute the natural logarithm of a positive fixnum with 10**18 (wad) basis,
+    ///         returning the result as a fixnum with 10**27 (ray) basis.
+    /// @dev Let L = 10²⁷ ⋅ ln(x / 10¹⁸) be the exact, infinite-precision result. This function
+    ///      returns either ⌊L⌋ or ⌊L⌋ - 1; it never overestimates. `lnWadToRay(10**18) == 0`
+    ///      exactly, and the result is negative iff `x < 10**18`. `lnWadToRay` is monotonic; x₁ <
+    ///      x₂ → lnWadToRay(x₁) ≤ lnWadToRay(x₂). Reverts with `Panic(18)` when `x <= 0`.
+    function lnWadToRay(int256 x) internal pure returns (int256 r) {
+        // Equivalent pseudocode; fixed-point truncations are accounted for below:
+        //     require(x > 0);
+        //     k = ⌊log₂(x)⌋ - 95;                       // x = m ⋅ 2ᵏ, m ∈ [2⁹⁵, 2⁹⁶)
+        //     m = x / 2ᵏ;                               // Q95 fixnum ∈ [1, 2)
+        //     z = (s - m) / (m + s);                    // s = √2 ⋅ 2⁹⁵; |z| ≤ 3 - 2√2
+        //     h = atanh(-z) = (p(z²) ⋅ z) / q(z²);      // ln(m / 2⁹⁵) = 2h + ln(s / 2⁹⁵)
+        //     r = ⌊10²⁷ ⋅ (2h + ln(s) + k⋅ln(2) - 18⋅ln(10)) - margin⌋
+        //     return r + (r = -1);
+        //
+        // z is negated (s - m, not m - s) so that every polynomial coefficient below can be written
+        // as a positive literal; q carries the compensating negation. p/-q is a (4,5)-degree
+        // rational polynomial approximation of f(u) = atanh(√u)/√u on u ∈ [0, (3-2√2)²], fit under
+        // the weight √u (the weight the error carries into ln), with q monic and p(0) = -q(0)
+        // constrained so both polynomials share their constant-term literal. The weighted sup-norm
+        // error of the integer-rounded rational 2⋅√u⋅|p/-q - f|⋅10²⁷ is ≤0.327ulp.
+        //
+        // Mixed fixed-point bases, chosen so every renormalizing shift lands a value directly
+        // at the basis its consumer needs (each quantity is rounded exactly once):
+        //     m:      Q95 (truncated from x; error < 2⁻⁹⁵)
+        //     z:      Q100 (one sdiv)
+        //     u = z²: Q96 (one `shr` by 104, straight from the Q200 product)
+        //     Horner stages: a coefficient followed by j more multiplies by u tolerates a shorter
+        //         basis, so the stage bases form a staircase -- p: Q68, Q80, Q86, Q85, Q94; q: Q96
+        //         (the monic stage shares u's basis for free), Q79, Q85, Q93, Q94. Each literal
+        //         then takes the widest basis that fits its minimal `PUSH` width. One `SAR` per
+        //         multiply is forced: ray precision requires ~96 significant bits while each
+        //         multiply by u consumes ~91 bits of headroom, so consecutive unrenormalized steps
+        //         cannot fit in 256 bits.
+        //     p, q final: Q94 (|p ⋅ z| < 2²⁰¹; both final stage shifts land there directly)
+        //     p⋅z/q: one `SDIV` at Q100 (granularity 2⁻¹⁰⁰, ~0.0016 ulp)
+        //     output: the quotient is h in Q100; multiplying by 5²⁷ = 2⋅10²⁷⋅2⁷² / 2¹⁰⁰ folds in
+        //         the factor of 2 and places it on the 10²⁷ ⋅ 2⁷² grid shared by the k⋅ln(2) term
+        //         and the bias, so the closing `sar(72, …)` is the single output-rounding floor
+        //
+        // Error budget in ulps (1 ulp = 10⁻²⁷ of ln; 2⁷² pre-shift units): rational polynomial
+        // approximation and coefficient quantization ≤0.327 combined; mantissa (Q95) truncation
+        // ≤2⁻⁹⁵⋅10²⁷ ≈ 0.026 (downward only); z, u, and `SDIV` truncations ≤0.005 combined; Horner
+        // stage truncations ≤10⁻⁴; ln(2) and bias constant rounding ≤10⁻¹⁹. The bias is reduced by
+        // a margin of ~1.607⋅10²¹ units (0.3403 ulp), so the Q72 accumulator never exceeds L⋅2⁷²;
+        // margin plus downward errors total < 0.699 ⋅ 2⁷², so it always exceeds (L-1)⋅2⁷².
+        // `sar(72, …)` therefore yields ⌊L⌋ or ⌊L⌋ - 1.
+        //
+        // Monotonicity: within an octave, the integer z = sdiv((s-m)⋅2¹⁰⁰, m+s) is strictly
+        // decreasing in m -- ∂/∂m⋅[(s-m)/(m+s)⋅2¹⁰⁰] = -2s⋅2¹⁰⁰/(m+s)² ∈ [-16, -8] over the octave,
+        // so each unit step of m lowers z by 8 to 16 (and `SDIV`, monotone, never reverses that).
+        // The quotient p⋅z/q is an antitone function of the integer z: per unit step of z it moves
+        // by at least Rₘᵢₙ - zₘₐₓ⋅2J > 0.29 quotient units (R = p/-q ≥ 0.939; J bounds the
+        // truncation of R between adjacent u values), so it is antitone across each m-step's
+        // multi-unit z decrease, and `SDIV` truncation toward zero preserves order. The x = 10¹⁸
+        // correction preserves monotonicity because its neighbors' results bracket [0, 999999999].
+        assembly ("memory-safe") {
+            if iszero(slt(0x00, x)) {
+                mstore(0x00, 0x4e487b71) // selector for `Panic(uint256)`
+                mstore(0x20, 0x12)       // panic code for division by zero
+                revert(0x1c, 0x24)
+            }
+
+            // Normalize: x := m, a Q95 fixnum, m ∈ [1, 2), truncated from x / 2ᵏ. Truncation
+            // underestimates ln(x) by less than 2⁻⁹⁵ (only possible when k > 0).
+            let c := clz(x)
+            let k := sub(0xa0, c)
+            x := shr(0xa0, shl(c, x))
+
+            // z = (s - m)/(m + s) in Q100, truncated toward zero, where the Q95 constant s =
+            // 0xb504f333f9de6484597d89b3 = round(√2 ⋅ 2⁹⁵). Centering at s makes |z| ≤ 3 - 2⋅√2 ≈
+            // 0.17157 over m ∈ [1, 2).
+            let s := 0xb504f333f9de6484597d89b3
+            let z := sdiv(shl(0x64, sub(s, x)), add(x, s))
+
+            // u = z² in Q96, truncated; u ∈ [0, 0.029438 ⋅ 2⁹⁶].
+            let u := shr(0x68, mul(z, z))
+
+            // Constant terms of p and q in Q94; p(0) = -q(0) by construction, so the literal is
+            // shared.
+            let c0 := 0xb05a8b41cf51c04d1b8a08d473
+
+            // Numerator p(u), Horner up the basis staircase Q68 → Q80 → Q86 → Q85 → Q94. p(u)/2⁹⁴ ∈
+            // [663.7, 705.5] on the domain. The leading product is nonnegative, so the first shift
+            // may be logical.
+            let p := sub(shr(0x54, mul(0xf642b0ed5372ff45e0, u)), 0xede142e73a9acbb00e9c42)
+            p := add(sar(0x5a, mul(p, u)), 0xf2a56533e74a454c9d585f70)
+            p := sub(sar(0x61, mul(p, u)), 0xb44d9253cd61fb87dc7efcfc)
+            p := add(sar(0x57, mul(p, u)), c0)
+
+            // Denominator q(u), monic, Horner up the staircase Q96 → Q79 → Q85 → Q93 →
+            // Q94. q(u)/2⁹⁴ ∈ [-705.5, -656.0] on the domain: bounded away from zero, and
+            // p(u)/-q(u) ∈ [1, 1.01].
+            let q := sub(u, 0x364589193443b48661938f59dc)
+            q := add(sar(0x71, mul(q, u)), 0xe904c4e76307954df78fef)
+            q := sub(sar(0x5a, mul(q, u)), 0xad960ab2f600bd9765c15ffd)
+            q := add(sar(0x58, mul(q, u)), 0xd1b1fedec544f0ea0bc812bbca)
+            q := sub(sar(0x5f, mul(q, u)), c0)
+
+            // h = atanh(-z/2¹⁰⁰) in Q100: |p ⋅ z| < 2²⁰¹ ∧ |q| > 656 ⋅ 2⁹⁴, so the quotient fits in
+            // 98 bits.
+            r := sdiv(mul(p, z), q)
+
+            // Double h and rescale to ray in Q72: 5²⁷ = 2 ⋅ 10²⁷ ⋅ 2⁷² / 2¹⁰⁰; exact.
+            r := mul(0x6765c793fa10079d, r)
+
+            // Add k ⋅ round(ln(2) ⋅ 10²⁷ ⋅ 2⁷²). k is two's complement (k ∈ [-95, 159])
+            r := add(mul(0x23d5b9ff36551802aa5d6f9754b0f3fad83b19450, k), r)
+
+            // Add ⌊(ln(s/2⁹⁵) + 95⋅ln(2) - 18⋅ln(10)) ⋅ 10²⁷ ⋅ 2⁷²⌋ minus the one-sided error
+            // margin described above.
+            r := add(0x4ff7e9b32826a6aec97ea1e696bd71eb764c77277c, r)
+
+            // Q72 → integer ray result (`SAR` floors).
+            r := sar(0x48, r)
+
+            // lnWadToRay(1⋅10¹⁸) = 0 is the only input whose exact result is an integer. The
+            // approximation above lands on -1; correct this to get exactly 0.
+            r := add(iszero(not(r)), r)
+        }
+    }
+
+    /// @notice Compute the natural logarithm of a positive fixnum with 10**18 (wad) basis,
+    ///         returning the result as a fixnum with 10**18 (wad) basis.
+    /// @dev Let Lw = 10¹⁸ * ln(x / 10¹⁸) be the exact, infinite-precision result. This function
+    ///      returns either `⌊Lw⌋` or `⌊Lw⌋ - 1`. Like `lnWadToRay`, `lnWad(10**18) == 0` exactly,
+    ///      and `lnWad` is monotonic.
+    function lnWad(int256 x) internal pure returns (int256 r) {
+        r = lnWadToRay(x);
+        // Floor division of the ray result by 10⁹. `SDIV` alone truncates toward zero, which would
+        // round negative results the wrong way. Equivalent Solidity:
+        //     r = (r - (r < 0 ? 10**9 - 1 : 0)) / 10**9;
+        // The subtraction cannot overflow: |r| < 2⁹⁷.
+        assembly ("memory-safe") {
+            r := sdiv(sub(r, mul(0x3b9ac9ff, sgt(0x00, r))), 0x3b9aca00)
+        }
+    }
+}
diff --git a/src/wrappers/LnWrapper.sol b/src/wrappers/LnWrapper.sol
new file mode 100644
index 000000000..cff4190f0
--- /dev/null
+++ b/src/wrappers/LnWrapper.sol
@@ -0,0 +1,17 @@
+// SPDX-License-Identifier: MIT
+pragma solidity ^0.8.34;
+
+import {Ln} from "src/vendor/Ln.sol";
+
+/// @dev Thin wrapper exposing Ln's internal function for `forge inspect ... ir`.
+/// Function names are prefixed with `wrap_` to avoid Yul name collisions with the
+/// library functions, keeping the IR unambiguous for the formal-proof code generator.
+contract LnWrapper {
+    function wrap_lnWadToRay(int256 x) external pure returns (int256) {
+        return Ln.lnWadToRay(x);
+    }
+
+    function wrap_lnWad(int256 x) external pure returns (int256) {
+        return Ln.lnWad(x);
+    }
+}
diff --git a/test/0.8.25/formal-model/LnModel.t.sol b/test/0.8.25/formal-model/LnModel.t.sol
new file mode 100644
index 000000000..623707451
--- /dev/null
+++ b/test/0.8.25/formal-model/LnModel.t.sol
@@ -0,0 +1,45 @@
+// SPDX-License-Identifier: MIT
+pragma solidity ^0.8.34;
+
+import {LnTest} from "../../0.8.34/Ln.t.sol";
+import {FormalModelFFI} from "./FormalModelFFI.t.sol";
+import {LnWrapper} from "src/wrappers/LnWrapper.sol";
+import {stdError} from "@forge-std/Test.sol";
+
+/// @dev Runs the LnTest suite against the generated Lean model via `vm.ffi`,
+/// and differentially fuzzes the model against the real contract. Requires
+/// the `ln-model` binary to be pre-built:
+///   cd formal/ln/LnProof && lake build ln-model
+contract LnModelTest is LnTest, FormalModelFFI {
+    string private constant _BIN = "formal/ln/LnProof/.lake/build/bin/ln-model";
+    LnWrapper private _wrapper;
+
+    function setUp() external {
+        _wrapper = new LnWrapper();
+    }
+
+    function _lnWadToRay(int256 x) internal override returns (int256) {
+        return int256(_ffiScalar(_BIN, "ln_wad", uint256(x)));
+    }
+
+    /// The generated model strips the revert guard (it models the non-reverting
+    /// domain), so the revert behavior is exercised against the real contract.
+    function testLnWadUndefined() external override {
+        vm.expectRevert(stdError.divisionError);
+        _wrapper.wrap_lnWadToRay(0);
+        vm.expectRevert(stdError.divisionError);
+        _wrapper.wrap_lnWadToRay(-1);
+        vm.expectRevert(stdError.divisionError);
+        _wrapper.wrap_lnWad(type(int256).min);
+    }
+
+    function testDiffLnWad(int256 x) external {
+        x = bound(x, 1, type(int256).max);
+        assertEq(_wrapper.wrap_lnWadToRay(x), int256(_ffiScalar(_BIN, "ln_wad", uint256(x))));
+    }
+
+    function testDiffLnWadToWad(int256 x) external {
+        x = bound(x, 1, type(int256).max);
+        assertEq(_wrapper.wrap_lnWad(x), int256(_ffiScalar(_BIN, "ln_wad_to_wad", uint256(x))));
+    }
+}
diff --git a/test/0.8.34/Ln.t.sol b/test/0.8.34/Ln.t.sol
new file mode 100644
index 000000000..787210be8
--- /dev/null
+++ b/test/0.8.34/Ln.t.sol
@@ -0,0 +1,289 @@
+// SPDX-License-Identifier: MIT
+pragma solidity ^0.8.34;
+
+import {Ln} from "src/vendor/Ln.sol";
+import {Test, stdError} from "@forge-std/Test.sol";
+
+contract LnTest is Test {
+
+    int256 private constant _MIN_RESULT = -41446531673892822312323846185; // lnWadToRay(1)
+    int256 private constant _MAX_RESULT = 135305999368893231589070344786; // lnWadToRay(2**255 - 1)
+    // floor(ln(2) * 10**27); the exact value's fractional part is ~0.458
+    int256 private constant _LN2_RAY_FLOOR = 693147180559945309417232121;
+
+    function _lnWadToRay(int256 x) internal virtual returns (int256) {
+        return Ln.lnWadToRay(x);
+    }
+
+    /// Asserts that `lnWadToRay(x)` returns exactly `expected`, and that `expected` honors the
+    /// specification `r == floor(L) || r == floor(L) - 1` for the independently computed
+    /// `floorL = floor(10**27 * ln(x / 10**18))`. Reference values use 1500-bit precision
+    /// arithmetic.
+    function _check(int256 x, int256 floorL, int256 expected) internal {
+        assertTrue(expected == floorL || expected == floorL - 1, "vector violates spec");
+        assertEq(_lnWadToRay(x), expected, "lnWadToRay mismatch");
+    }
+
+    /// Same as `_check`, for the wad-basis helper (`floorL` here is floor(10**18 * ln(x/10**18))).
+    function _checkWad(int256 x, int256 floorL, int256 expected) internal {
+        assertTrue(expected == floorL || expected == floorL - 1, "wad vector violates spec");
+        assertEq(Ln.lnWad(x), expected, "lnWad mismatch");
+    }
+
+    function testLnWadVectors() external {
+        _check(1, -41446531673892822312323846185, -41446531673892822312323846185);
+        _check(2, -40753384493332877002906614063, -40753384493332877002906614063);
+        _check(3, -40347919385224712620928600948, -40347919385224712620928600948);
+        _check(10, -39143946580898776628305854730, -39143946580898776628305854730);
+        _check(1000000000, -20723265836946411156161923093, -20723265836946411156161923093);
+        _check(999999999999999999, -1000000001, -1000000001);
+        _check(1000000000000000000, 0, 0);
+        _check(1000000000000000001, 999999999, 999999999);
+        _check(1000000000000000002, 1999999999, 1999999999);
+        _check(2000000000000000000, 693147180559945309417232121, 693147180559945309417232120);
+        _check(3000000000000000000, 1098612288668109691395245236, 1098612288668109691395245236);
+        _check(2718281828459045235, 999999999999999999867457646, 999999999999999999867457645);
+        _check(2718281828459045236, 1000000000000000000235337087, 1000000000000000000235337087);
+        _check(1000000000000000000000000000, 20723265836946411156161923092, 20723265836946411156161923091);
+        _check(1000000000000000000000000000000000000, 41446531673892822312323846184, 41446531673892822312323846184);
+        _check(123456789123456789123456789, 18631401767168018033693933347, 18631401767168018033693933346);
+        _check(79228162514264337593543950335, 25095597659861927391730437475, 25095597659861927391730437474);
+        _check(79228162514264337593543950336, 25095597659861927391730437475, 25095597659861927391730437475);
+        _check(10141204801825835211973625643007, 29947627923781544557651062325, 29947627923781544557651062325);
+        _check(10141204801825835211973625643008, 29947627923781544557651062325, 29947627923781544557651062325);
+        _check(10141204801825835211973625643009, 29947627923781544557651062325, 29947627923781544557651062325);
+        _check(14341829369545251819195376186229, 30294201514061517212359678386, 30294201514061517212359678386);
+        _check(14341829369545251819195376186228, 30294201514061517212359678386, 30294201514061517212359678386);
+        _check(14341829369545251819195376186230, 30294201514061517212359678386, 30294201514061517212359678386);
+        _check(14686033274414337862856065214698496, 37225673319660970306531999601, 37225673319660970306531999600);
+        _check(
+            33070006991101558613323983488220271120422962987008,
+            72576179528218181086810837795,
+            72576179528218181086810837795
+        );
+        _check(
+            40938685753732063808775600771488980723442195955767696598656108627666290081792,
+            134959425778613258934361728726,
+            134959425778613258934361728726
+        );
+        _check(854839645001009215068541, 13658669180622829786346106842, 13658669180622829786346106842);
+        _check(
+            57896044618658097711785492504343953926634992332820282019728792003956564819967,
+            135305999368893231589070344787,
+            135305999368893231589070344786
+        );
+        _check(
+            28948022309329048855892746252171976963317496166410141009864396001978282422329,
+            134612852188333286279653112666,
+            134612852188333286279653112666
+        );
+        _check(23140692632779269005, 3141592653589793238431136704, 3141592653589793238431136704);
+        _check(23140692632779269006, 3141592653589793238474350622, 3141592653589793238474350622);
+        _check(969072426304810639, -31415926535897932726158747, -31415926535897932726158747);
+        _check(969072426304810640, -31415926535897931694244132, -31415926535897931694244132);
+        _check(5928094615866830025140, 8687458127689783079736836747, 8687458127689783079736836747);
+        _check(5928094615866830025141, 8687458127689783079737005436, 8687458127689783079737005436);
+        _check(
+            57896044618658097697547599337506629650395051143722560294519976603075720888694,
+            135305999368893231588824423096,
+            135305999368893231588824423096
+        );
+        _check(
+            57896044618658097697547599337506629650395051143722560294519976603075720888695,
+            135305999368893231588824423097,
+            135305999368893231588824423096
+        );
+        _check(
+            11531340134437266330889532247840319230885847573287662864764254025110034622679,
+            133692418858407420767716863671,
+            133692418858407420767716863670
+        );
+        _check(
+            25516211913201189358184556770476725351838266340863452733436591784686693881804,
+            134486664312116391125706346920,
+            134486664312116391125706346919
+        );
+        _check(
+            12632054297359577276854956051144103779902310235702452798294750994440826097481,
+            133783587876002393482496706494,
+            133783587876002393482496706494
+        );
+        _check(
+            19773015028832046656908425566003276233326493345842583107020653497704963467163,
+            134231668431467386104102171272,
+            134231668431467386104102171272
+        );
+        _check(
+            26369303708180783249380978459038522241083721636123224543466395688722460378193,
+            134519550895981731608092936045,
+            134519550895981731608092936045
+        );
+        _check(
+            7929557224029897922379974571763889658076579711267156775272714680526020418224,
+            133317947499191107922839574039,
+            133317947499191107922839574038
+        );
+        _check(
+            806542931244966051059409939570788318127957726580128171790838039545703343801,
+            131032352149376846726895485143,
+            131032352149376846726895485142
+        );
+        _check(
+            13625595200484246010113629581784085527247382575443943192068219507274893064444,
+            133859300324694985150113926368,
+            133859300324694985150113926368
+        );
+    }
+
+    function lnWadToRayExternal(int256 x) external returns (int256) {
+        return _lnWadToRay(x);
+    }
+
+    function testLnWadUndefined() external virtual {
+        vm.expectRevert(stdError.divisionError);
+        this.lnWadToRayExternal(0);
+        vm.expectRevert(stdError.divisionError);
+        this.lnWadToRayExternal(-1);
+        vm.expectRevert(stdError.divisionError);
+        this.lnWadToRayExternal(type(int256).min);
+    }
+
+    /// `L(2x) - L(x) = 10**27 * ln(2)` exactly. Both results lie in `(L - 2, L]`, so their
+    /// difference lies in `(10**27 * ln(2) - 2, 10**27 * ln(2) + 2)`; with the fractional part
+    /// of `10**27 * ln(2)` being ~0.458, the difference of the integer results is confined to
+    /// `[floor - 1, floor + 2]`.
+    function testFuzzLnWadDouble(int256 x) external {
+        x = bound(x, 1, (type(int256).max >> 1));
+        int256 d = _lnWadToRay(x << 1) - _lnWadToRay(x);
+        assertGe(d, _LN2_RAY_FLOOR - 1, "doubling delta too low");
+        assertLe(d, _LN2_RAY_FLOOR + 2, "doubling delta too high");
+    }
+
+    function testFuzzLnWadRange(int256 x) external {
+        x = bound(x, 1, type(int256).max);
+        int256 r = _lnWadToRay(x);
+        assertGe(r, _MIN_RESULT, "below global minimum");
+        assertLe(r, _MAX_RESULT, "above global maximum");
+    }
+
+    function testLnWadToWadVectors() external {
+        _checkWad(1, -41446531673892822313, -41446531673892822313);
+        _checkWad(2, -40753384493332877003, -40753384493332877003);
+        _checkWad(3, -40347919385224712621, -40347919385224712621);
+        _checkWad(10, -39143946580898776629, -39143946580898776629);
+        _checkWad(1000000000, -20723265836946411157, -20723265836946411157);
+        _checkWad(999999999999999999, -2, -2);
+        _checkWad(1000000000000000000, 0, 0);
+        _checkWad(1000000000000000001, 0, 0);
+        _checkWad(1000000000000000002, 1, 1);
+        _checkWad(2000000000000000000, 693147180559945309, 693147180559945309);
+        _checkWad(3000000000000000000, 1098612288668109691, 1098612288668109691);
+        _checkWad(2718281828459045235, 999999999999999999, 999999999999999999);
+        _checkWad(2718281828459045236, 1000000000000000000, 1000000000000000000);
+        _checkWad(1000000000000000000000000000, 20723265836946411156, 20723265836946411156);
+        _checkWad(1000000000000000000000000000000000000, 41446531673892822312, 41446531673892822312);
+        _checkWad(123456789123456789123456789, 18631401767168018033, 18631401767168018033);
+        _checkWad(79228162514264337593543950335, 25095597659861927391, 25095597659861927391);
+        _checkWad(79228162514264337593543950336, 25095597659861927391, 25095597659861927391);
+        _checkWad(10141204801825835211973625643007, 29947627923781544557, 29947627923781544557);
+        _checkWad(10141204801825835211973625643008, 29947627923781544557, 29947627923781544557);
+        _checkWad(10141204801825835211973625643009, 29947627923781544557, 29947627923781544557);
+        _checkWad(14341829369545251819195376186229, 30294201514061517212, 30294201514061517212);
+        _checkWad(14341829369545251819195376186228, 30294201514061517212, 30294201514061517212);
+        _checkWad(14341829369545251819195376186230, 30294201514061517212, 30294201514061517212);
+        _checkWad(14686033274414337862856065214698496, 37225673319660970306, 37225673319660970306);
+        _checkWad(33070006991101558613323983488220271120422962987008, 72576179528218181086, 72576179528218181086);
+        _checkWad(
+            40938685753732063808775600771488980723442195955767696598656108627666290081792,
+            134959425778613258934,
+            134959425778613258934
+        );
+        _checkWad(854839645001009215068541, 13658669180622829786, 13658669180622829786);
+        _checkWad(
+            57896044618658097711785492504343953926634992332820282019728792003956564819967,
+            135305999368893231589,
+            135305999368893231589
+        );
+        _checkWad(
+            28948022309329048855892746252171976963317496166410141009864396001978282422329,
+            134612852188333286279,
+            134612852188333286279
+        );
+        _checkWad(23140692632779269005, 3141592653589793238, 3141592653589793238);
+        _checkWad(23140692632779269006, 3141592653589793238, 3141592653589793238);
+        _checkWad(969072426304810639, -31415926535897933, -31415926535897933);
+        _checkWad(969072426304810640, -31415926535897932, -31415926535897932);
+        _checkWad(5928094615866830025140, 8687458127689783079, 8687458127689783079);
+        _checkWad(5928094615866830025141, 8687458127689783079, 8687458127689783079);
+        _checkWad(
+            57896044618658097697547599337506629650395051143722560294519976603075720888694,
+            135305999368893231588,
+            135305999368893231588
+        );
+        _checkWad(
+            57896044618658097697547599337506629650395051143722560294519976603075720888695,
+            135305999368893231588,
+            135305999368893231588
+        );
+        _checkWad(
+            11531340134437266330889532247840319230885847573287662864764254025110034622679,
+            133692418858407420767,
+            133692418858407420767
+        );
+        _checkWad(
+            25516211913201189358184556770476725351838266340863452733436591784686693881804,
+            134486664312116391125,
+            134486664312116391125
+        );
+        _checkWad(
+            12632054297359577276854956051144103779902310235702452798294750994440826097481,
+            133783587876002393482,
+            133783587876002393482
+        );
+        _checkWad(
+            19773015028832046656908425566003276233326493345842583107020653497704963467163,
+            134231668431467386104,
+            134231668431467386104
+        );
+        _checkWad(
+            26369303708180783249380978459038522241083721636123224543466395688722460378193,
+            134519550895981731608,
+            134519550895981731608
+        );
+        _checkWad(
+            7929557224029897922379974571763889658076579711267156775272714680526020418224,
+            133317947499191107922,
+            133317947499191107922
+        );
+        _checkWad(
+            806542931244966051059409939570788318127957726580128171790838039545703343801,
+            131032352149376846726,
+            131032352149376846726
+        );
+        _checkWad(
+            13625595200484246010113629581784085527247382575443943192068219507274893064444,
+            133859300324694985150,
+            133859300324694985150
+        );
+    }
+
+    function testLnWadExactOne() external {
+        assertEq(_lnWadToRay(1e18), 0, "lnWadToRay(1e18) != 0");
+        assertEq(Ln.lnWad(1e18), 0, "lnWad(1e18) != 0");
+    }
+
+    /// Monotonicity across every clz seam: the only adjacent-input pairs not covered by the
+    /// within-octave certificate in formal/python/ln/check_ln_monotone.py.
+    function testLnWadMonotoneBoundaries() external {
+        for (uint256 t = 1; t < 255; t++) {
+            int256 hi = int256(uint256(1) << t);
+            assertGe(_lnWadToRay(hi), _lnWadToRay(hi - 1), "octave seam not monotone");
+        }
+    }
+
+    function testFuzzLnWadMonotone(int256 x) external {
+        x = bound(x, 1, type(int256).max - 1);
+        assertGe(_lnWadToRay(x + 1), _lnWadToRay(x), "not monotone");
+        assertGe(Ln.lnWad(x + 1), Ln.lnWad(x), "wad helper not monotone");
+    }
+}