perf: bad filter

`has_fvar(e)` is a bad filter. For example, the free variable may be a
let-variable. The kernel was timining out when checking some proof
terms produced by cutsat. Many thanks to @nomeata for finding the
issue.

.github/workflows/pr-release.yml

@@ -155,6 +155,20 @@ jobs:
           fi
 
           if [[ -n "$MESSAGE" ]]; then
+            # Check if force-mathlib-ci label is present
+            LABELS="$(curl --retry 3 --location --silent \
+                          -H "Authorization: token ${{ secrets.MATHLIB4_COMMENT_BOT }}" \
+                          -H "Accept: application/vnd.github.v3+json" \
+                          "https://api.github.com/repos/leanprover/lean4/issues/${{ steps.workflow-info.outputs.pullRequestNumber }}/labels" \
+                          | jq -r '.[].name')"
+            
+            if echo "$LABELS" | grep -q "^force-mathlib-ci$"; then
+              echo "force-mathlib-ci label detected, forcing CI despite issues"
+              MESSAGE="Forcing Mathlib CI because the \`force-mathlib-ci\` label is present, despite problem: $MESSAGE"
+              FORCE_CI=true
+            else
+              MESSAGE="$MESSAGE You can force Mathlib CI using the \`force-mathlib-ci\` label."
+            fi
 
             echo "Checking existing messages"
 
@@ -201,7 +215,12 @@ jobs:
             else
               echo "The message already exists in the comment body."
             fi
-            echo "mathlib_ready=false" >> "$GITHUB_OUTPUT"
+
+            if [[ "$FORCE_CI" == "true" ]]; then
+              echo "mathlib_ready=true" >> "$GITHUB_OUTPUT"
+            else
+              echo "mathlib_ready=false" >> "$GITHUB_OUTPUT"
+            fi
           else
             echo "mathlib_ready=true" >> "$GITHUB_OUTPUT"
           fi
@@ -252,7 +271,7 @@ jobs:
           if git ls-remote --heads --tags --exit-code origin "nightly-testing-${MOST_RECENT_NIGHTLY}" >/dev/null; then
             BASE="nightly-testing-${MOST_RECENT_NIGHTLY}"
           else
-            echo "This shouldn't be possible: couldn't find a 'nightly-testing-${MOST_RECENT_NIGHTLY}' tag at Batteries. Falling back to 'nightly-testing'."
+            echo "Couldn't find a 'nightly-testing-${MOST_RECENT_NIGHTLY}' tag at Batteries. Falling back to 'nightly-testing'."
             BASE=nightly-testing
           fi
 
@@ -316,7 +335,7 @@ jobs:
           if git ls-remote --heads --tags --exit-code origin "nightly-testing-${MOST_RECENT_NIGHTLY}" >/dev/null; then
             BASE="nightly-testing-${MOST_RECENT_NIGHTLY}"
           else
-            echo "This shouldn't be possible: couldn't find a 'nightly-testing-${MOST_RECENT_NIGHTLY}' branch at Mathlib. Falling back to 'nightly-testing'."
+            echo "Couldn't find a 'nightly-testing-${MOST_RECENT_NIGHTLY}' branch at Mathlib. Falling back to 'nightly-testing'."
             BASE=nightly-testing
           fi
 

CMakeLists.txt

@@ -47,10 +47,11 @@ if (NOT ${CMAKE_SYSTEM_NAME} MATCHES "Emscripten")
     if(${CMAKE_SYSTEM_NAME} MATCHES "Windows")
       string(APPEND CADICAL_CXXFLAGS " -DNUNLOCKED")
     endif()
+    string(APPEND CADICAL_CXXFLAGS " -DNCLOSEFROM")
     ExternalProject_add(cadical
       PREFIX cadical
       GIT_REPOSITORY https://github.com/arminbiere/cadical
-      GIT_TAG rel-1.9.5
+      GIT_TAG rel-2.1.2
       CONFIGURE_COMMAND ""
       # https://github.com/arminbiere/cadical/blob/master/BUILD.md#manual-build
       BUILD_COMMAND $(MAKE) -f ${CMAKE_SOURCE_DIR}/src/cadical.mk CMAKE_EXECUTABLE_SUFFIX=${CMAKE_EXECUTABLE_SUFFIX} CXX=${CADICAL_CXX} CXXFLAGS=${CADICAL_CXXFLAGS}

flake.lock

@@ -36,17 +36,17 @@
     },
     "nixpkgs-cadical": {
       "locked": {
-        "lastModified": 1722221733,
-        "narHash": "sha256-sga9SrrPb+pQJxG1ttJfMPheZvDOxApFfwXCFO0H9xw=",
+        "lastModified": 1740791350,
+        "narHash": "sha256-igS2Z4tVw5W/x3lCZeeadt0vcU9fxtetZ/RyrqsCRQ0=",
         "owner": "NixOS",
         "repo": "nixpkgs",
-        "rev": "12bf09802d77264e441f48e25459c10c93eada2e",
+        "rev": "199169a2135e6b864a888e89a2ace345703c025d",
         "type": "github"
       },
       "original": {
         "owner": "NixOS",
         "repo": "nixpkgs",
-        "rev": "12bf09802d77264e441f48e25459c10c93eada2e",
+        "rev": "199169a2135e6b864a888e89a2ace345703c025d",
         "type": "github"
       }
     },

flake.nix

@@ -8,8 +8,8 @@
   # old nixpkgs used for portable release with older glibc (2.26)
   inputs.nixpkgs-older.url = "github:NixOS/nixpkgs/0b307aa73804bbd7a7172899e59ae0b8c347a62d";
   inputs.nixpkgs-older.flake = false;
-  # for cadical 1.9.5; sync with CMakeLists.txt
-  inputs.nixpkgs-cadical.url = "github:NixOS/nixpkgs/12bf09802d77264e441f48e25459c10c93eada2e";
+  # for cadical 2.1.2; sync with CMakeLists.txt by taking commit from https://www.nixhub.io/packages/cadical
+  inputs.nixpkgs-cadical.url = "github:NixOS/nixpkgs/199169a2135e6b864a888e89a2ace345703c025d";
   inputs.flake-utils.url = "github:numtide/flake-utils";
 
   outputs = inputs: inputs.flake-utils.lib.eachDefaultSystem (system:

src/Init/Data/BitVec/Bitblast.lean

@@ -544,6 +544,15 @@ theorem slt_eq_not_carry (x y : BitVec w) :
 theorem sle_eq_not_slt (x y : BitVec w) : x.sle y = !y.slt x := by
   simp only [BitVec.sle, BitVec.slt, ← decide_not, decide_eq_decide]; omega
 
+theorem zero_sle_eq_not_msb {w : Nat} {x : BitVec w} : BitVec.sle 0#w x = !x.msb := by
+  rw [sle_eq_not_slt, BitVec.slt_zero_eq_msb]
+
+theorem zero_sle_iff_msb_eq_false {w : Nat} {x : BitVec w} : BitVec.sle 0#w x ↔ x.msb = false := by
+  simp [zero_sle_eq_not_msb]
+
+theorem toNat_toInt_of_sle {w : Nat} (b : BitVec w) (hb : BitVec.sle 0#w b) : b.toInt.toNat = b.toNat :=
+  toNat_toInt_of_msb b (zero_sle_iff_msb_eq_false.1 hb)
+
 theorem sle_eq_carry (x y : BitVec w) :
     x.sle y = !((x.msb == y.msb).xor (carry w y (~~~x) true)) := by
   rw [sle_eq_not_slt, slt_eq_not_carry, beq_comm]

src/Init/Data/BitVec/Lemmas.lean

@@ -324,6 +324,9 @@ theorem getMsbD_ofNatLt {n x i : Nat} (h : x < 2^n) :
 @[simp, bitvec_to_nat] theorem toNat_ofNat (x w : Nat) : (BitVec.ofNat w x).toNat = x % 2^w := by
   simp [BitVec.toNat, BitVec.ofNat, Fin.ofNat']
 
+theorem ofNatLT_eq_ofNat {w : Nat} {n : Nat} (hn) : BitVec.ofNatLT n hn = BitVec.ofNat w n :=
+  eq_of_toNat_eq (by simp [Nat.mod_eq_of_lt hn])
+
 @[simp] theorem toFin_ofNat (x : Nat) : toFin (BitVec.ofNat w x) = Fin.ofNat' (2^w) x := rfl
 
 -- Remark: we don't use `[simp]` here because simproc` subsumes it for literals.
@@ -529,6 +532,9 @@ theorem toInt_eq_toNat_of_msb {x : BitVec w} (h : x.msb = false) :
     x.toInt = x.toNat := by
   simp [toInt_eq_msb_cond, h]
 
+theorem toNat_toInt_of_msb {w : Nat} (b : BitVec w) (hb : b.msb = false) : b.toInt.toNat = b.toNat := by
+  simp [b.toInt_eq_toNat_of_msb hb]
+
 theorem toInt_eq_toNat_bmod (x : BitVec n) : x.toInt = Int.bmod x.toNat (2^n) := by
   simp only [toInt_eq_toNat_cond]
   split
@@ -651,6 +657,12 @@ theorem slt_zero_iff_msb_cond {x : BitVec w} : x.slt 0#w ↔ x.msb = true := by
     simp [BitVec.slt, this]
     omega
 
+theorem slt_zero_eq_msb {w : Nat} {x : BitVec  w} : x.slt 0#w = x.msb := by
+  rw [Bool.eq_iff_iff, BitVec.slt_zero_iff_msb_cond]
+
+theorem sle_iff_toInt_le {w : Nat} {b b' : BitVec w} : b.sle b' ↔ b.toInt ≤ b'.toInt :=
+  decide_eq_true_iff
+
 /-! ### setWidth, zeroExtend and truncate -/
 
 @[simp]
@@ -2058,7 +2070,7 @@ theorem signExtend_eq_setWidth_of_lt (x : BitVec w) {v : Nat} (hv : v ≤ w):
   simp [getElem_signExtend, show i < w by omega]
 
 /-- Sign extending to the same bitwidth is a no op. -/
-theorem signExtend_eq (x : BitVec w) : x.signExtend w = x := by
+@[simp] theorem signExtend_eq (x : BitVec w) : x.signExtend w = x := by
   rw [signExtend_eq_setWidth_of_lt _ (Nat.le_refl _), setWidth_eq]
 
 /-- Sign extending to a larger bitwidth depends on the msb.
@@ -2100,43 +2112,63 @@ theorem toNat_signExtend (x : BitVec w) {v : Nat} :
   · have : 2^w ≤ 2^v := Nat.pow_le_pow_right Nat.two_pos (by omega)
     rw [toNat_signExtend_of_le x (by omega), toNat_setWidth, Nat.mod_eq_of_lt (by omega)]
 
-/-
+/--
 If the current width `w` is smaller than the extended width `v`,
 then the value when interpreted as an integer does not change.
 -/
-theorem toInt_signExtend_of_lt {x : BitVec w} (hv : w < v):
+theorem toInt_signExtend_of_le {x : BitVec w} (h : w ≤ v) :
     (x.signExtend v).toInt = x.toInt := by
-  simp only [toInt_eq_msb_cond, toNat_signExtend]
-  have : (x.signExtend v).msb = x.msb := by
-    rw [msb_eq_getLsbD_last, getLsbD_eq_getElem (Nat.sub_one_lt_of_lt hv)]
-    simp [getElem_signExtend, Nat.le_sub_one_of_lt hv]
+  by_cases hlt : w < v
+  · rw [toInt_signExtend_of_lt hlt]
+  · obtain rfl : w = v := by omega
+    simp
+where
+  toInt_signExtend_of_lt {x : BitVec w} (hv : w < v):
+      (x.signExtend v).toInt = x.toInt := by
+    simp only [toInt_eq_msb_cond, toNat_signExtend]
+    have : (x.signExtend v).msb = x.msb := by
+      rw [msb_eq_getLsbD_last, getLsbD_eq_getElem (Nat.sub_one_lt_of_lt hv)]
+      simp [getElem_signExtend, Nat.le_sub_one_of_lt hv]
+      omega
+    have H : 2^w ≤ 2^v := Nat.pow_le_pow_right (by omega) (by omega)
+    simp only [this, toNat_setWidth, Int.natCast_add, Int.ofNat_emod, Int.natCast_mul]
+    by_cases h : x.msb
+    <;> norm_cast
+    <;> simp [h, Nat.mod_eq_of_lt (Nat.lt_of_lt_of_le x.isLt H)]
     omega
-  have H : 2^w ≤ 2^v := Nat.pow_le_pow_right (by omega) (by omega)
-  simp only [this, toNat_setWidth, Int.natCast_add, Int.ofNat_emod, Int.natCast_mul]
-  by_cases h : x.msb
-  <;> norm_cast
-  <;> simp [h, Nat.mod_eq_of_lt (Nat.lt_of_lt_of_le x.isLt H)]
-  omega
 
-/-
+/--
 If the current width `w` is larger than the extended width `v`,
 then the value when interpreted as an integer is truncated,
 and we compute a modulo by `2^v`.
 -/
-theorem toInt_signExtend_of_le {x : BitVec w} (hv : v ≤ w) :
+theorem toInt_signExtend_eq_toNat_bmod_of_le {x : BitVec w} (hv : v ≤ w) :
     (x.signExtend v).toInt = Int.bmod x.toNat (2^v) := by
   simp [signExtend_eq_setWidth_of_lt _ hv]
 
-/-
+/--
 Interpreting the sign extension of `(x : BitVec w)` to width `v`
-computes `x % 2^v` (where `%` is the balanced mod).
+computes `x % 2^v` (where `%` is the balanced mod). See `toInt_signExtend` for a version stated
+in terms of `toInt` instead of `toNat`.
 -/
-theorem toInt_signExtend (x : BitVec w) :
-    (x.signExtend v).toInt = Int.bmod x.toNat (2^(min v w)) := by
+theorem toInt_signExtend_eq_toNat_bmod (x : BitVec w) :
+    (x.signExtend v).toInt = Int.bmod x.toNat (2 ^ min v w) := by
   by_cases hv : v ≤ w
-  · simp [toInt_signExtend_of_le hv, Nat.min_eq_left hv]
+  · simp [toInt_signExtend_eq_toNat_bmod_of_le hv, Nat.min_eq_left hv]
   · simp only [Nat.not_le] at hv
-    rw [toInt_signExtend_of_lt hv, Nat.min_eq_right (by omega), toInt_eq_toNat_bmod]
+    rw [toInt_signExtend_of_le (Nat.le_of_lt hv),
+      Nat.min_eq_right (by omega), toInt_eq_toNat_bmod]
+
+theorem toInt_signExtend (x : BitVec w) :
+    (x.signExtend v).toInt = x.toInt.bmod (2 ^ min v w) := by
+  rw [toInt_signExtend_eq_toNat_bmod, BitVec.toInt_eq_toNat_bmod, Int.bmod_bmod_of_dvd]
+  exact Nat.pow_dvd_pow _ (Nat.min_le_right v w)
+
+theorem toInt_signExtend_eq_toInt_bmod_of_le (x : BitVec w) (h : v ≤ w) :
+    (x.signExtend v).toInt = x.toInt.bmod (2 ^ v) := by
+  rw [BitVec.toInt_signExtend, Nat.min_eq_left h]
+
+attribute [simp] BitVec.signExtend_eq
 
 /-! ### append -/
 

src/Init/Data/Bool.lean

@@ -539,8 +539,8 @@ theorem cond_decide {α} (p : Prop) [Decidable p] (t e : α) :
 @[simp] theorem cond_eq_false_distrib : ∀(c t f : Bool),
     (cond c t f = false) = ite (c = true) (t = false) (f = false) := by decide
 
-protected theorem cond_true  {α : Type u} {a b : α} : cond true  a b = a := cond_true  a b
-protected theorem cond_false {α : Type u} {a b : α} : cond false a b = b := cond_false a b
+protected theorem cond_true  {α : Sort u} {a b : α} : cond true  a b = a := cond_true  a b
+protected theorem cond_false {α : Sort u} {a b : α} : cond false a b = b := cond_false a b
 
 @[simp] theorem cond_true_left   : ∀(c f : Bool), cond c true f  = ( c || f) := by decide
 @[simp] theorem cond_false_left  : ∀(c f : Bool), cond c false f = (!c && f) := by decide

src/Init/Data/Int/DivMod/Bootstrap.lean

@@ -158,6 +158,10 @@ theorem add_mul_ediv_right (a b : Int) {c : Int} (H : c ≠ 0) : (a + b * c) / c
       apply congrArg negSucc
       rw [Nat.mul_comm, Nat.sub_mul_div]; rwa [Nat.mul_comm]
 
+theorem add_mul_ediv_left (a : Int) {b : Int}
+    (c : Int) (H : b ≠ 0) : (a + b * c) / b = a / b + c :=
+  Int.mul_comm .. ▸ Int.add_mul_ediv_right _ _ H
+
 theorem add_ediv_of_dvd_right {a b c : Int} (H : c ∣ b) : (a + b) / c = a / c + b / c :=
   if h : c = 0 then by simp [h] else by
     let ⟨k, hk⟩ := H
@@ -196,16 +200,6 @@ theorem emod_lt_of_pos (a : Int) {b : Int} (H : 0 < b) : a % b < b :=
   | ofNat _, _, ⟨_, rfl⟩ => ofNat_lt.2 (Nat.mod_lt _ (Nat.succ_pos _))
   | -[_+1], _, ⟨_, rfl⟩ => Int.sub_lt_self _ (ofNat_lt.2 <| Nat.succ_pos _)
 
-theorem mul_ediv_self_le {x k : Int} (h : k ≠ 0) : k * (x / k) ≤ x :=
-  calc k * (x / k)
-    _ ≤ k * (x / k) + x % k := Int.le_add_of_nonneg_right (emod_nonneg x h)
-    _ = x                   := ediv_add_emod _ _
-
-theorem lt_mul_ediv_self_add {x k : Int} (h : 0 < k) : x < k * (x / k) + k :=
-  calc x
-    _ = k * (x / k) + x % k := (ediv_add_emod _ _).symm
-    _ < k * (x / k) + k     := Int.add_lt_add_left (emod_lt_of_pos x h) _
-
 @[simp] theorem add_mul_emod_self {a b c : Int} : (a + b * c) % c = a % c :=
   if cz : c = 0 then by
     rw [cz, Int.mul_zero, Int.add_zero]
@@ -313,6 +307,18 @@ theorem emod_pos_of_not_dvd {a b : Int} (h : ¬ a ∣ b) : a = 0 ∨ 0 < b % a :
   · simp_all
   · exact Or.inr (Int.lt_iff_le_and_ne.mpr ⟨emod_nonneg b w, Ne.symm h⟩)
 
+/-! ### `/` and ordering -/
+
+theorem mul_ediv_self_le {x k : Int} (h : k ≠ 0) : k * (x / k) ≤ x :=
+  calc k * (x / k)
+    _ ≤ k * (x / k) + x % k := Int.le_add_of_nonneg_right (emod_nonneg x h)
+    _ = x                   := ediv_add_emod _ _
+
+theorem lt_mul_ediv_self_add {x k : Int} (h : 0 < k) : x < k * (x / k) + k :=
+  calc x
+    _ = k * (x / k) + x % k := (ediv_add_emod _ _).symm
+    _ < k * (x / k) + k     := Int.add_lt_add_left (emod_lt_of_pos x h) _
+
 /-! ### bmod -/
 
 @[simp] theorem bmod_emod : bmod x m % m = x % m := by

src/Init/Data/Int/DivMod/Lemmas.lean

@@ -40,6 +40,17 @@ protected theorem dvd_add_left {a b c : Int} (H : a ∣ c) : a ∣ b + c ↔ a
 protected theorem dvd_add_right {a b c : Int} (H : a ∣ b) : a ∣ b + c ↔ a ∣ c := by
   rw [Int.add_comm, Int.dvd_add_left H]
 
+@[simp] protected theorem dvd_add_mul_self {a b c : Int} : a ∣ b + c * a ↔ a ∣ b := by
+  rw [Int.dvd_add_left (Int.dvd_mul_left c a)]
+
+@[simp] protected theorem dvd_add_self_mul {a b c : Int} : a ∣ b + a * c ↔ a ∣ b := by
+  rw [Int.mul_comm, Int.dvd_add_mul_self]
+
+@[simp] protected theorem dvd_mul_self_add {a b c : Int} : a ∣ b * a + c ↔ a ∣ c := by
+  rw [Int.add_comm, Int.dvd_add_mul_self]
+
+@[simp] protected theorem dvd_self_mul_add {a b c : Int} : a ∣ a * b + c ↔ a ∣ c := by
+  rw [Int.mul_comm, Int.dvd_mul_self_add]
 protected theorem dvd_iff_dvd_of_dvd_sub {a b c : Int} (H : a ∣ b - c) : a ∣ b ↔ a ∣ c :=
   ⟨fun h => Int.sub_sub_self b c ▸ Int.dvd_sub h H,
    fun h => Int.sub_add_cancel b c ▸ Int.dvd_add H h⟩
@@ -390,10 +401,13 @@ theorem tmod_eq_fmod {a b : Int} :
 
 /-! ### `/` ediv -/
 
-theorem ediv_neg' {a b : Int} (Ha : a < 0) (Hb : 0 < b) : a / b < 0 :=
+theorem ediv_neg_of_neg_of_pos {a b : Int} (Ha : a < 0) (Hb : 0 < b) : a / b < 0 :=
   match a, b, eq_negSucc_of_lt_zero Ha, eq_succ_of_zero_lt Hb with
   | _, _, ⟨_, rfl⟩, ⟨_, rfl⟩ => negSucc_lt_zero _
 
+@[deprecated ediv_neg_of_neg_of_pos (since := "2025-03-04")]
+abbrev ediv_neg' := @ediv_neg_of_neg_of_pos
+
 theorem negSucc_ediv (m : Nat) {b : Int} (H : 0 < b) : -[m+1] / b = -(ediv m b + 1) :=
   match b, eq_succ_of_zero_lt H with
   | _, ⟨_, rfl⟩ => rfl
@@ -423,17 +437,16 @@ theorem ediv_pos_of_neg_of_neg {a b : Int} (ha : a < 0) (hb : b < 0) : 0 < a / b
   match a, b, ha, hb with
   | .negSucc a, .negSucc b, _, _ => apply ofNat_succ_pos
 
-theorem ediv_nonpos {a b : Int} (Ha : 0 ≤ a) (Hb : b ≤ 0) : a / b ≤ 0 :=
+theorem ediv_nonpos_of_nonneg_of_nonpos {a b : Int} (Ha : 0 ≤ a) (Hb : b ≤ 0) : a / b ≤ 0 :=
   Int.nonpos_of_neg_nonneg <| Int.ediv_neg .. ▸ Int.ediv_nonneg Ha (Int.neg_nonneg_of_nonpos Hb)
 
+@[deprecated ediv_nonpos_of_nonneg_of_nonpos (since := "2025-03-04")]
+abbrev ediv_nonpos := @ediv_nonpos_of_nonneg_of_nonpos
+
 theorem ediv_eq_zero_of_lt {a b : Int} (H1 : 0 ≤ a) (H2 : a < b) : a / b = 0 :=
   match a, b, eq_ofNat_of_zero_le H1, eq_succ_of_zero_lt (Int.lt_of_le_of_lt H1 H2) with
   | _, _, ⟨_, rfl⟩, ⟨_, rfl⟩ => congrArg Nat.cast <| Nat.div_eq_of_lt <| ofNat_lt.1 H2
 
-theorem add_mul_ediv_left (a : Int) {b : Int}
-    (c : Int) (H : b ≠ 0) : (a + b * c) / b = a / b + c :=
-  Int.mul_comm .. ▸ Int.add_mul_ediv_right _ _ H
-
 @[simp] theorem mul_ediv_mul_of_pos {a : Int}
     (b c : Int) (H : 0 < a) : (a * b) / (a * c) = b / c :=
   suffices ∀ (m k : Nat) (b : Int), (m.succ * b) / (m.succ * k) = b / k from
@@ -477,6 +490,15 @@ protected theorem eq_ediv_of_mul_eq_left {a b c : Int}
     (H1 : b ≠ 0) (H2 : a * b = c) : a = c / b :=
   (Int.ediv_eq_of_eq_mul_left H1 H2.symm).symm
 
+@[simp] protected theorem ediv_self {a : Int} (H : a ≠ 0) : a / a = 1 := by
+  have := Int.mul_ediv_cancel 1 H; rwa [Int.one_mul] at this
+
+@[simp] protected theorem neg_ediv_self (a : Int) (h : a ≠ 0) : (-a) / a = -1 := by
+  rw [neg_ediv_of_dvd (Int.dvd_refl a), Int.ediv_self h]
+
+-- There are no theorems `neg_ediv : ∀ {a b : Int}, (-a) / b = - (a / b)` or
+-- `neg_ediv_neg: ∀ {a b : Int},  (-a) / (-b) = a / b` because these are false.
+
 /-! ### emod -/
 
 theorem mod_def' (m n : Int) : m % n = emod m n := rfl
@@ -607,12 +629,6 @@ theorem dvd_emod_sub_self {x : Int} {m : Nat} : (m : Int) ∣ x % m - x := by
 @[simp] theorem emod_one (a : Int) : a % 1 = 0 := by
   simp [emod_def, Int.one_mul, Int.sub_self]
 
-@[simp] protected theorem ediv_self {a : Int} (H : a ≠ 0) : a / a = 1 := by
-  have := Int.mul_ediv_cancel 1 H; rwa [Int.one_mul] at this
-
-@[simp] protected theorem neg_ediv_self (a : Int) (h : a ≠ 0) : (-a) / a = -1 := by
-  rw [neg_ediv_of_dvd (Int.dvd_refl a), Int.ediv_self h]
-
 @[simp]
 theorem emod_sub_cancel (x y : Int): (x - y) % y = x % y := by
   by_cases h : y = 0
@@ -746,6 +762,8 @@ theorem ediv_eq_ediv_of_mul_eq_mul {a b c d : Int}
 
 /-! ### tdiv -/
 
+-- `tdiv` analogues of `ediv` lemmas from `Bootstrap.lean`
+
 unseal Nat.div in
 @[simp] protected theorem tdiv_neg : ∀ a b : Int, a.tdiv (-b) = -(a.tdiv b)
   | ofNat m, 0 => show ofNat (m / 0) = -↑(m / 0) by rw [Nat.div_zero]; rfl
@@ -753,12 +771,12 @@ unseal Nat.div in
   | ofNat _, succ _ | -[_+1], 0 | -[_+1], -[_+1] => rfl
 
 /-!
-We don't give `tdiv` versions of
-* `add_mul_ediv_right : c ≠ 0 → (a + b * c) / c = a / c + b`
-* `add_mul_ediv_left : b ≠ 0 → (a + b * c) / b = a / b + c`
-* `add_ediv_of_dvd_right : c ∣ b → (a + b) / c = a / c + b / c`
-* `add_ediv_of_dvd_left : c ∣ a → (a + b) / c = a / c + b / c`
-because they all involve awkward off-by-one corrections.
+There are no lemmas
+* `add_mul_tdiv_right : c ≠ 0 → (a + b * c).tdiv c = a.tdiv c + b`
+* `add_mul_tdiv_left : b ≠ 0 → (a + b * c).tdiv b = a.tdiv b + c`
+* `add_tdiv_of_dvd_right : c ∣ b → (a + b).tdiv c = a.tdiv c + b.tdiv c`
+* `add_tdiv_of_dvd_left : c ∣ a → (a + b).tdiv c = a.tdiv c + b.tdiv c`
+because these statements are all incorrect, and require awkward conditional off-by-one corrections.
 -/
 
 @[simp] theorem mul_tdiv_cancel (a : Int) {b : Int} (H : b ≠ 0) : (a * b).tdiv b = a := by
@@ -767,8 +785,10 @@ because they all involve awkward off-by-one corrections.
 @[simp] theorem mul_tdiv_cancel_left (b : Int) (H : a ≠ 0) : (a * b).tdiv a = b :=
   Int.mul_comm .. ▸ Int.mul_tdiv_cancel _ H
 
--- There's no good analogues of `ediv_nonneg_iff_of_pos`, `ediv_neg'`, or `negSucc_ediv`
--- for `tdiv`.
+-- `tdiv` analogues of `ediv` lemmas given above
+
+-- There are no lemmas `tdiv_nonneg_iff_of_pos`, `tdiv_neg_of_neg_of_pos`, or `negSucc_tdiv`
+-- corresponding to `ediv_nonneg_iff_of_pos`, `ediv_neg_of_neg_of_pos`, or `negSucc_ediv` as they require awkward corrections.
 
 protected theorem tdiv_nonneg {a b : Int} (Ha : 0 ≤ a) (Hb : 0 ≤ b) : 0 ≤ a.tdiv b :=
   match a, b, eq_ofNat_of_zero_le Ha, eq_ofNat_of_zero_le Hb with
@@ -792,9 +812,12 @@ theorem tdiv_nonneg_of_nonpos_of_nonpos {a b : Int} (Ha : a ≤ 0) (Hb : b ≤ 0
           exact ediv_pos_of_neg_of_neg h'' h'
       omega
 
-protected theorem tdiv_nonpos {a b : Int} (Ha : 0 ≤ a) (Hb : b ≤ 0) : a.tdiv b ≤ 0 :=
+protected theorem tdiv_nonpos_of_nonneg_of_nonpos {a b : Int} (Ha : 0 ≤ a) (Hb : b ≤ 0) : a.tdiv b ≤ 0 :=
   Int.nonpos_of_neg_nonneg <| Int.tdiv_neg .. ▸ Int.tdiv_nonneg Ha (Int.neg_nonneg_of_nonpos Hb)
 
+@[deprecated Int.tdiv_nonpos_of_nonneg_of_nonpos (since := "2025-03-04")]
+abbrev tdiv_nonpos := @Int.tdiv_nonpos_of_nonneg_of_nonpos
+
 theorem tdiv_eq_zero_of_lt {a b : Int} (H1 : 0 ≤ a) (H2 : a < b) : a.tdiv b = 0 :=
   match a, b, eq_ofNat_of_zero_le H1, eq_succ_of_zero_lt (Int.lt_of_le_of_lt H1 H2) with
   | _, _, ⟨_, rfl⟩, ⟨_, rfl⟩ => congrArg Nat.cast <| Nat.div_eq_of_lt <| ofNat_lt.1 H2
@@ -840,6 +863,9 @@ protected theorem eq_tdiv_of_mul_eq_left {a b c : Int}
     (H1 : b ≠ 0) (H2 : a * b = c) : a = c.tdiv b :=
   (Int.tdiv_eq_of_eq_mul_left H1 H2.symm).symm
 
+@[simp] protected theorem tdiv_self {a : Int} (H : a ≠ 0) : a.tdiv a = 1 := by
+  have := Int.mul_tdiv_cancel 1 H; rwa [Int.one_mul] at this
+
 unseal Nat.div in
 @[simp] protected theorem neg_tdiv : ∀ a b : Int, (-a).tdiv b = -(a.tdiv b)
   | 0, n => by simp [Int.neg_zero]
@@ -849,34 +875,6 @@ unseal Nat.div in
 protected theorem neg_tdiv_neg (a b : Int) : (-a).tdiv (-b) = a.tdiv b := by
   simp [Int.tdiv_neg, Int.neg_tdiv, Int.neg_neg]
 
-@[simp] protected theorem tdiv_self {a : Int} (H : a ≠ 0) : a.tdiv a = 1 := by
-  have := Int.mul_tdiv_cancel 1 H; rwa [Int.one_mul] at this
-
-theorem mul_tdiv_cancel_of_tmod_eq_zero {a b : Int} (H : a.tmod b = 0) : b * (a.tdiv b) = a := by
-  have := tmod_add_tdiv a b; rwa [H, Int.zero_add] at this
-
-theorem tdiv_mul_cancel_of_tmod_eq_zero {a b : Int} (H : a.tmod b = 0) : a.tdiv b * b = a := by
-  rw [Int.mul_comm, mul_tdiv_cancel_of_tmod_eq_zero H]
-
-theorem dvd_of_tmod_eq_zero {a b : Int} (H : tmod b a = 0) : a ∣ b :=
-  ⟨b.tdiv a, (mul_tdiv_cancel_of_tmod_eq_zero H).symm⟩
-
-protected theorem mul_tdiv_assoc (a : Int) : ∀ {b c : Int}, c ∣ b → (a * b).tdiv c = a * (b.tdiv c)
-  | _, c, ⟨d, rfl⟩ =>
-    if cz : c = 0 then by simp [cz, Int.mul_zero] else by
-      rw [Int.mul_left_comm, Int.mul_tdiv_cancel_left _ cz, Int.mul_tdiv_cancel_left _ cz]
-
-protected theorem mul_tdiv_assoc' (b : Int) {a c : Int} (h : c ∣ a) :
-    (a * b).tdiv c = a.tdiv c * b := by
-  rw [Int.mul_comm, Int.mul_tdiv_assoc _ h, Int.mul_comm]
-
-theorem tdiv_dvd_tdiv : ∀ {a b c : Int}, a ∣ b → b ∣ c → b.tdiv a ∣ c.tdiv a
-  | a, _, _, ⟨b, rfl⟩, ⟨c, rfl⟩ => by
-    by_cases az : a = 0
-    · simp [az]
-    · rw [Int.mul_tdiv_cancel_left _ az, Int.mul_assoc, Int.mul_tdiv_cancel_left _ az]
-      apply Int.dvd_mul_right
-
 @[simp] theorem natAbs_tdiv (a b : Int) : natAbs (a.tdiv b) = (natAbs a).div (natAbs b) :=
   match a, b, eq_nat_or_neg a, eq_nat_or_neg b with
   | _, _, ⟨_, .inl rfl⟩, ⟨_, .inl rfl⟩ => rfl
@@ -886,13 +884,15 @@ theorem tdiv_dvd_tdiv : ∀ {a b c : Int}, a ∣ b → b ∣ c → b.tdiv a ∣
 
 /-! ### tmod -/
 
+-- `tmod` analogues of `emod` lemmas from `Bootstrap.lean`
+
 theorem ofNat_tmod (m n : Nat) : (↑(m % n) : Int) = tmod m n := rfl
 
 @[simp] theorem tmod_one (a : Int) : tmod a 1 = 0 := by
   simp [tmod_def, Int.tdiv_one, Int.one_mul, Int.sub_self]
 
-theorem tmod_eq_of_lt {a b : Int} (H1 : 0 ≤ a) (H2 : a < b) : tmod a b = a := by
-  rw [tmod_eq_emod_of_nonneg H1, emod_eq_of_lt H1 H2]
+theorem tmod_nonneg : ∀ {a : Int} (b : Int), 0 ≤ a → 0 ≤ tmod a b
+  | ofNat _, -[_+1], _ | ofNat _, ofNat _, _ => ofNat_nonneg _
 
 theorem tmod_lt_of_pos (a : Int) {b : Int} (H : 0 < b) : tmod a b < b :=
   match a, b, eq_succ_of_zero_lt H with
@@ -900,12 +900,23 @@ theorem tmod_lt_of_pos (a : Int) {b : Int} (H : 0 < b) : tmod a b < b :=
   | -[_+1], _, ⟨n, rfl⟩ => Int.lt_of_le_of_lt
     (Int.neg_nonpos_of_nonneg <| Int.ofNat_nonneg _) (ofNat_pos.2 n.succ_pos)
 
-theorem tmod_nonneg : ∀ {a : Int} (b : Int), 0 ≤ a → 0 ≤ tmod a b
-  | ofNat _, -[_+1], _ | ofNat _, ofNat _, _ => ofNat_nonneg _
-
 @[simp] theorem tmod_neg (a b : Int) : tmod a (-b) = tmod a b := by
   rw [tmod_def, tmod_def, Int.tdiv_neg, Int.neg_mul_neg]
 
+@[simp] theorem neg_tmod (a b : Int) : tmod (-a) b = -tmod a b := by
+  rw [tmod_def, Int.neg_tdiv, Int.mul_neg, tmod_def]
+  omega
+
+-- The following statements for `tmod` are false:
+-- `add_mul_tmod_self {a b c : Int} : (a + b * c).tmod c = a.tmod c`
+-- `add_mul_tmod_self_left (a b c : Int) : (a + b * c).tmod b = a.tmod b`
+-- `tmod_add_tmod (m n k : Int) : (m.tmod n + k).tmod n = (m + k).tmod n`
+-- `add_tmod_tmod (m n k : Int) : (m + n.tmod k).tmod k = (m + n).tmod k`
+-- `add_tmod (a b n : Int) : (a + b).tmod n = (a.tmod n + b.tmod n).tmod n`
+-- `add_tmod_eq_add_tmod_right {m n k : Int} (i : Int) : (m.tmod n = k.tmod n) → (m + i).tmod n = (k + i).tmod n`
+-- `tmod_add_cancel_right {m n k : Int} (i) : (m + i).tmod n = (k + i).tmod n ↔ m.tmod n = k.tmod n`
+-- `sub_tmod (a b n : Int) : (a - b).tmod n = (a.tmod n - b.tmod n).tmod n`
+
 @[simp] theorem mul_tmod_left (a b : Int) : (a * b).tmod b = 0 :=
   if h : b = 0 then by simp [h, Int.mul_zero] else by
     rw [Int.tmod_def, Int.mul_tdiv_cancel _ h, Int.mul_comm, Int.sub_self]
@@ -913,9 +924,78 @@ theorem tmod_nonneg : ∀ {a : Int} (b : Int), 0 ≤ a → 0 ≤ tmod a b
 @[simp] theorem mul_tmod_right (a b : Int) : (a * b).tmod a = 0 := by
   rw [Int.mul_comm, mul_tmod_left]
 
+/--
+If a predicate on the integers is invariant under negation,
+then it is sufficient to prove it for the nonnegative integers.
+-/
+theorem wlog_sign {P : Int → Prop} (inv : ∀ a, P a ↔ P (-a)) (w : ∀ n : Nat, P n) (a : Int) : P a := by
+  cases a with
+  | ofNat n => exact w n
+  | negSucc n =>
+    rw [negSucc_eq, ← inv, ← ofNat_succ]
+    apply w
+
+attribute [local simp] Int.neg_inj
+
+theorem mul_tmod (a b n : Int) : (a * b).tmod n = (a.tmod n * b.tmod n).tmod n := by
+  induction a using wlog_sign
+  case inv => simp
+  induction b using wlog_sign
+  case inv => simp
+  induction n using wlog_sign
+  case inv => simp
+  simp only [← Int.natCast_mul, ← ofNat_tmod]
+  rw [Nat.mul_mod]
+
+@[simp] theorem tmod_self {a : Int} : a.tmod a = 0 := by
+  have := mul_tmod_left 1 a; rwa [Int.one_mul] at this
+
+@[simp] theorem tmod_tmod_of_dvd (n : Int) {m k : Int}
+    (h : m ∣ k) : (n.tmod k).tmod m = n.tmod m := by
+  induction n using wlog_sign
+  case inv => simp
+  induction k using wlog_sign
+  case inv => simp [Int.dvd_neg]
+  induction m using wlog_sign
+  case inv => simp
+  simp only [← Int.natCast_mul, ← ofNat_tmod]
+  norm_cast at h
+  rw [Nat.mod_mod_of_dvd _ h]
+
+@[simp] theorem tmod_tmod (a b : Int) : (a.tmod b).tmod b = a.tmod b :=
+  tmod_tmod_of_dvd a (Int.dvd_refl b)
+
 theorem tmod_eq_zero_of_dvd : ∀ {a b : Int}, a ∣ b → tmod b a = 0
   | _, _, ⟨_, rfl⟩ => mul_tmod_right ..
 
+-- `tmod` analogues of `emod` lemmas from above
+
+theorem tmod_eq_of_lt {a b : Int} (H1 : 0 ≤ a) (H2 : a < b) : tmod a b = a := by
+  rw [tmod_eq_emod_of_nonneg H1, emod_eq_of_lt H1 H2]
+
+-- lemmas about `tmod` without `emod` analogues
+
+theorem tdiv_sign : ∀ a b, a.tdiv (sign b) = a * sign b
+  | _, succ _ => by simp [sign, Int.mul_one]
+  | _, 0 => by simp [sign, Int.mul_zero]
+  | _, -[_+1] => by simp [sign, Int.mul_neg, Int.mul_one]
+
+protected theorem sign_eq_tdiv_abs (a : Int) : sign a = a.tdiv (natAbs a) :=
+  if az : a = 0 then by simp [az] else
+    (Int.tdiv_eq_of_eq_mul_left (ofNat_ne_zero.2 <| natAbs_ne_zero.2 az)
+      (sign_mul_natAbs _).symm).symm
+
+/-! properties of `tdiv` and `tmod` -/
+
+theorem mul_tdiv_cancel_of_tmod_eq_zero {a b : Int} (H : a.tmod b = 0) : b * (a.tdiv b) = a := by
+  have := tmod_add_tdiv a b; rwa [H, Int.zero_add] at this
+
+theorem tdiv_mul_cancel_of_tmod_eq_zero {a b : Int} (H : a.tmod b = 0) : a.tdiv b * b = a := by
+  rw [Int.mul_comm, mul_tdiv_cancel_of_tmod_eq_zero H]
+
+theorem dvd_of_tmod_eq_zero {a b : Int} (H : tmod b a = 0) : a ∣ b :=
+  ⟨b.tdiv a, (mul_tdiv_cancel_of_tmod_eq_zero H).symm⟩
+
 theorem dvd_iff_tmod_eq_zero {a b : Int} : a ∣ b ↔ tmod b a = 0 :=
   ⟨tmod_eq_zero_of_dvd, dvd_of_tmod_eq_zero⟩
 
@@ -936,9 +1016,6 @@ protected theorem mul_tdiv_cancel' {a b : Int} (H : a ∣ b) : a * b.tdiv a = b
 protected theorem eq_mul_of_tdiv_eq_right {a b c : Int}
     (H1 : b ∣ a) (H2 : a.tdiv b = c) : a = b * c := by rw [← H2, Int.mul_tdiv_cancel' H1]
 
-@[simp] theorem tmod_self {a : Int} : a.tmod a = 0 := by
-  have := mul_tmod_left 1 a; rwa [Int.one_mul] at this
-
 @[simp] theorem neg_tmod_self (a : Int) : (-a).tmod a = 0 := by
   rw [← dvd_iff_tmod_eq_zero, Int.dvd_neg]
   exact Int.dvd_refl a
@@ -959,7 +1036,6 @@ protected theorem eq_mul_of_tdiv_eq_left {a b c : Int}
     (H1 : b ∣ a) (H2 : a.tdiv b = c) : a = c * b := by
   rw [Int.mul_comm, Int.eq_mul_of_tdiv_eq_right H1 H2]
 
-
 protected theorem eq_zero_of_tdiv_eq_zero {d n : Int} (h : d ∣ n) (H : n.tdiv d = 0) : n = 0 := by
   rw [← Int.mul_tdiv_cancel' h, H, Int.mul_zero]
 
@@ -968,33 +1044,50 @@ protected theorem eq_zero_of_tdiv_eq_zero {d n : Int} (h : d ∣ n) (H : n.tdiv
   refine ⟨fun h => ?_, congrArg (tdiv · d)⟩
   rw [← Int.mul_tdiv_cancel' hda, ← Int.mul_tdiv_cancel' hdb, h]
 
-theorem tdiv_sign : ∀ a b, a.tdiv (sign b) = a * sign b
-  | _, succ _ => by simp [sign, Int.mul_one]
-  | _, 0 => by simp [sign, Int.mul_zero]
-  | _, -[_+1] => by simp [sign, Int.mul_neg, Int.mul_one]
+protected theorem mul_tdiv_assoc (a : Int) : ∀ {b c : Int}, c ∣ b → (a * b).tdiv c = a * (b.tdiv c)
+  | _, c, ⟨d, rfl⟩ =>
+    if cz : c = 0 then by simp [cz, Int.mul_zero] else by
+      rw [Int.mul_left_comm, Int.mul_tdiv_cancel_left _ cz, Int.mul_tdiv_cancel_left _ cz]
 
-protected theorem sign_eq_tdiv_abs (a : Int) : sign a = a.tdiv (natAbs a) :=
-  if az : a = 0 then by simp [az] else
-    (Int.tdiv_eq_of_eq_mul_left (ofNat_ne_zero.2 <| natAbs_ne_zero.2 az)
-      (sign_mul_natAbs _).symm).symm
+protected theorem mul_tdiv_assoc' (b : Int) {a c : Int} (h : c ∣ a) :
+    (a * b).tdiv c = a.tdiv c * b := by
+  rw [Int.mul_comm, Int.mul_tdiv_assoc _ h, Int.mul_comm]
+
+theorem tdiv_dvd_tdiv : ∀ {a b c : Int}, a ∣ b → b ∣ c → b.tdiv a ∣ c.tdiv a
+  | a, _, _, ⟨b, rfl⟩, ⟨c, rfl⟩ => by
+    by_cases az : a = 0
+    · simp [az]
+    · rw [Int.mul_tdiv_cancel_left _ az, Int.mul_assoc, Int.mul_tdiv_cancel_left _ az]
+      apply Int.dvd_mul_right
+
+/-! ### `tdiv` and ordering -/
+
+-- Theorems about `tdiv` and ordering, whose `ediv` analogues are in `Bootstrap.lean`.
+
+theorem mul_tdiv_self_le {x k : Int} (h : 0 ≤ x) : k * (x.tdiv k) ≤ x := by
+  by_cases w : k = 0
+  · simp [w, h]
+  · rw [tdiv_eq_ediv_of_nonneg h]
+    apply mul_ediv_self_le w
+
+theorem lt_mul_tdiv_self_add {x k : Int} (h : 0 < k) : x < k * (x.tdiv k) + k := by
+  rw [tdiv_eq_ediv, sign_eq_one_of_pos h]
+  have := lt_mul_ediv_self_add (x := x) h
+  split <;> simp [Int.mul_add] <;> omega
 
 /-! ### fdiv -/
 
-theorem fdiv_nonneg {a b : Int} (Ha : 0 ≤ a) (Hb : 0 ≤ b) : 0 ≤ a.fdiv b :=
-  match a, b, eq_ofNat_of_zero_le Ha, eq_ofNat_of_zero_le Hb with
-  | _, _, ⟨_, rfl⟩, ⟨_, rfl⟩ => ofNat_fdiv .. ▸ ofNat_zero_le _
+-- There is no theorem `fdiv_neg : ∀ a b : Int, a.fdiv (-b) = -(a.fdiv b)`
+-- because this is false, for example at `a = 2`, `b = 3`, as `-1 ≠ 0`.
 
-unseal Nat.div in
-theorem fdiv_nonpos : ∀ {a b : Int}, 0 ≤ a → b ≤ 0 → a.fdiv b ≤ 0
-  | 0, 0, _, _ | 0, -[_+1], _, _ | succ _, 0, _, _ | succ _, -[_+1], _, _ => ⟨_⟩
+theorem add_mul_fdiv_right (a b : Int) {c : Int} (H : c ≠ 0) : (a + b * c).fdiv c = a.fdiv c + b := by
+  rw [fdiv_eq_ediv, add_mul_ediv_right _ _ H, fdiv_eq_ediv]
+  simp only [Int.dvd_add_left (Int.dvd_mul_left _ _)]
+  split <;> omega
 
-theorem fdiv_neg' : ∀ {a b : Int}, a < 0 → 0 < b → a.fdiv b < 0
-  | -[_+1], succ _, _, _ => negSucc_lt_zero _
-
-@[simp] theorem fdiv_one : ∀ a : Int, a.fdiv 1 = a
-  | 0 => rfl
-  | succ _ => congrArg Nat.cast (Nat.div_one _)
-  | -[_+1] => congrArg negSucc (Nat.div_one _)
+theorem add_mul_fdiv_left (a : Int) {b : Int}
+    (c : Int) (H : b ≠ 0) : (a + b * c).fdiv b = a.fdiv b + c := by
+  rw [Int.mul_comm, Int.add_mul_fdiv_right _ _ H]
 
 @[simp] theorem mul_fdiv_cancel (a : Int) {b : Int} (H : b ≠ 0) : fdiv (a * b) b = a :=
   if b0 : 0 ≤ b then by
@@ -1010,32 +1103,174 @@ theorem fdiv_neg' : ∀ {a b : Int}, a < 0 → 0 < b → a.fdiv b < 0
 @[simp] theorem mul_fdiv_cancel_left (b : Int) (H : a ≠ 0) : fdiv (a * b) a = b :=
   Int.mul_comm .. ▸ Int.mul_fdiv_cancel _ H
 
+theorem add_fdiv_of_dvd_right {a b c : Int} (H : c ∣ b) : (a + b).fdiv c = a.fdiv c + b.fdiv c := by
+  by_cases h : c = 0
+  · simp [h]
+  · obtain ⟨d, rfl⟩ := H
+    rw [add_mul_fdiv_left _ _ h]
+    simp [h]
+
+theorem add_fdiv_of_dvd_left {a b c : Int} (H : c ∣ a) : (a + b).fdiv c = a.fdiv c + b.fdiv c := by
+  rw [Int.add_comm, Int.add_fdiv_of_dvd_right H, Int.add_comm]
+
+theorem fdiv_nonneg {a b : Int} (Ha : 0 ≤ a) (Hb : 0 ≤ b) : 0 ≤ a.fdiv b :=
+  match a, b, eq_ofNat_of_zero_le Ha, eq_ofNat_of_zero_le Hb with
+  | _, _, ⟨_, rfl⟩, ⟨_, rfl⟩ => ofNat_fdiv .. ▸ ofNat_zero_le _
+
+theorem fdiv_nonneg_of_nonpos_of_nonpos {a b : Int} (Ha : a ≤ 0) (Hb : b ≤ 0) : 0 ≤ a.fdiv b := by
+  rw [fdiv_eq_ediv]
+  by_cases ha : a = 0
+  · simp [ha]
+  · by_cases hb : b = 0
+    · simp [hb]
+    · have : 0 < a / b := ediv_pos_of_neg_of_neg (by omega) (by omega)
+      split <;> omega
+
+unseal Nat.div in
+theorem fdiv_nonpos_of_nonneg_of_nonpos : ∀ {a b : Int}, 0 ≤ a → b ≤ 0 → a.fdiv b ≤ 0
+  | 0, 0, _, _ | 0, -[_+1], _, _ | succ _, 0, _, _ | succ _, -[_+1], _, _ => ⟨_⟩
+
+@[deprecated fdiv_nonpos_of_nonneg_of_nonpos (since := "2025-03-04")]
+abbrev fdiv_nonpos := @fdiv_nonpos_of_nonneg_of_nonpos
+
+theorem fdiv_neg_of_neg_of_pos : ∀ {a b : Int}, a < 0 → 0 < b → a.fdiv b < 0
+  | -[_+1], succ _, _, _ => negSucc_lt_zero _
+
+@[deprecated fdiv_neg_of_neg_of_pos (since := "2025-03-04")]
+abbrev fdiv_neg := @fdiv_neg_of_neg_of_pos
+
+theorem fdiv_eq_zero_of_lt {a b : Int} (H1 : 0 ≤ a) (H2 : a < b) : a.fdiv b = 0 := by
+  rw [fdiv_eq_ediv, if_pos, Int.sub_zero]
+  · apply ediv_eq_zero_of_lt (by omega) (by omega)
+  · left; omega
+
+@[simp] theorem mul_fdiv_mul_of_pos {a : Int}
+    (b c : Int) (H : 0 < a) : (a * b).fdiv (a * c) = b.fdiv c := by
+  rw [fdiv_eq_ediv, mul_ediv_mul_of_pos _ _ H, fdiv_eq_ediv]
+  congr 2
+  simp [Int.mul_dvd_mul_iff_left (Int.ne_of_gt H)]
+  constructor
+  · rintro (h | h)
+    · exact .inl (Int.nonneg_of_mul_nonneg_right h H)
+    · exact .inr h
+  · rintro (h | h)
+    · exact .inl (Int.mul_nonneg (by omega) h)
+    · exact .inr h
+
+@[simp] theorem mul_fdiv_mul_of_pos_left
+    (a : Int) {b : Int} (c : Int) (H : 0 < b) : (a * b).fdiv (c * b) = a.fdiv c := by
+  rw [Int.mul_comm a b, Int.mul_comm c b, Int.mul_fdiv_mul_of_pos _ _ H]
+
+@[simp] theorem fdiv_one : ∀ a : Int, a.fdiv 1 = a
+  | 0 => rfl
+  | succ _ => congrArg Nat.cast (Nat.div_one _)
+  | -[_+1] => congrArg negSucc (Nat.div_one _)
+
+protected theorem fdiv_eq_of_eq_mul_right {a b c : Int}
+    (H1 : b ≠ 0) (H2 : a = b * c) : a.fdiv b = c := by rw [H2, Int.mul_fdiv_cancel_left _ H1]
+
+protected theorem eq_fdiv_of_mul_eq_right {a b c : Int}
+    (H1 : a ≠ 0) (H2 : a * b = c) : b = c.tdiv a :=
+  (Int.tdiv_eq_of_eq_mul_right H1 H2.symm).symm
+
+protected theorem fdiv_eq_of_eq_mul_left {a b c : Int}
+    (H1 : b ≠ 0) (H2 : a = c * b) : a.fdiv b = c :=
+  Int.fdiv_eq_of_eq_mul_right H1 (by rw [Int.mul_comm, H2])
+
+protected theorem eq_fdiv_of_mul_eq_left {a b c : Int}
+    (H1 : b ≠ 0) (H2 : a * b = c) : a = c.fdiv b :=
+  (Int.fdiv_eq_of_eq_mul_left H1 H2.symm).symm
+
 @[simp] protected theorem fdiv_self {a : Int} (H : a ≠ 0) : a.fdiv a = 1 := by
   have := Int.mul_fdiv_cancel 1 H; rwa [Int.one_mul] at this
 
-theorem lt_fdiv_add_one_mul_self (a : Int) {b : Int} (H : 0 < b) : a < (a.fdiv b + 1) * b :=
-  Int.fdiv_eq_ediv_of_nonneg _ (Int.le_of_lt H) ▸ lt_ediv_add_one_mul_self a H
+-- `neg_fdiv : ∀ a b : Int, (-a).fdiv b = -(a.fdiv b)` is untrue.
+
+protected theorem neg_fdiv_neg (a b : Int) : (-a).fdiv (-b) = a.fdiv b := by
+  match a, b with
+  | 0, 0 => rfl
+  | 0, ofNat b => simp
+  | 0, -[b+1] => simp
+  | ofNat (a + 1), 0 => simp
+  | ofNat (a + 1), ofNat (b + 1) =>
+    unfold fdiv
+    simp only [ofNat_eq_coe, natCast_add, Nat.cast_ofNat_Int, Nat.succ_eq_add_one]
+    rw [← negSucc_eq, ← negSucc_eq]
+  | ofNat (a + 1), -[b+1] =>
+    unfold fdiv
+    simp only [ofNat_eq_coe, natCast_add, Nat.cast_ofNat_Int, Nat.succ_eq_add_one]
+    rw [← negSucc_eq, neg_negSucc]
+  | -[a+1], 0 => simp
+  | -[a+1], ofNat (b + 1) =>
+    unfold fdiv
+    simp only [ofNat_eq_coe, natCast_add, Nat.cast_ofNat_Int, Nat.succ_eq_add_one]
+    rw [neg_negSucc, ← negSucc_eq]
+  | -[a+1], -[b+1] =>
+    unfold fdiv
+    simp only [ofNat_eq_coe, ofNat_ediv, Nat.succ_eq_add_one, natCast_add, Nat.cast_ofNat_Int]
+    rw [neg_negSucc, neg_negSucc]
+    simp
+
+-- `natAbs_fdiv (a b : Int) : natAbs (a.fdiv b) = (natAbs a).div (natAbs b)` is untrue.
 
 /-! ### fmod -/
 
+-- `fmod` analogues of `emod` lemmas from `Bootstrap.lean`
+
 theorem ofNat_fmod (m n : Nat) : ↑(m % n) = fmod m n := by
   cases m <;> simp [fmod, Nat.succ_eq_add_one]
 
 @[simp] theorem fmod_one (a : Int) : a.fmod 1 = 0 := by
   simp [fmod_def, Int.one_mul, Int.sub_self]
 
-theorem fmod_eq_of_lt {a b : Int} (H1 : 0 ≤ a) (H2 : a < b) : a.fmod b = a := by
-  rw [fmod_eq_emod_of_nonneg _ (Int.le_trans H1 (Int.le_of_lt H2)), emod_eq_of_lt H1 H2]
-
 theorem fmod_nonneg {a b : Int} (ha : 0 ≤ a) (hb : 0 ≤ b) : 0 ≤ a.fmod b :=
   fmod_eq_tmod_of_nonneg ha hb ▸ tmod_nonneg _ ha
 
-theorem fmod_nonneg' (a : Int) {b : Int} (hb : 0 < b) : 0 ≤ a.fmod b :=
+theorem fmod_nonneg_of_pos (a : Int) {b : Int} (hb : 0 < b) : 0 ≤ a.fmod b :=
   fmod_eq_emod_of_nonneg _ (Int.le_of_lt hb) ▸ emod_nonneg _ (Int.ne_of_lt hb).symm
 
+@[deprecated fmod_nonneg_of_pos (since := "2025-03-04")]
+abbrev fmod_nonneg' := @fmod_nonneg_of_pos
+
 theorem fmod_lt_of_pos (a : Int) {b : Int} (H : 0 < b) : a.fmod b < b :=
   fmod_eq_emod_of_nonneg _ (Int.le_of_lt H) ▸ emod_lt_of_pos a H
 
+-- There is no `fmod_neg : ∀ {a b : Int}, a.fmod (-b) = -a.fmod b` as this is false.
+
+@[simp] theorem add_mul_fmod_self {a b c : Int} : (a + b * c).fmod c = a.fmod c := by
+  rw [fmod_eq_emod, add_mul_emod_self, fmod_eq_emod]
+  simp
+
+@[simp] theorem add_mul_fmod_self_left (a b c : Int) : (a + b * c).fmod b = a.fmod b := by
+  rw [Int.mul_comm, Int.add_mul_fmod_self]
+
+@[simp] theorem fmod_add_fmod (m n k : Int) : (m.fmod n + k).fmod n = (m + k).fmod n := by
+  by_cases h : n = 0
+  · simp [h]
+  rw [fmod_def, fmod_def]
+  conv => rhs; rw [fmod_def]
+  have : m - n * m.fdiv n + k = m + k + n * (- m.fdiv n) := by simp [Int.mul_neg]; omega
+  rw [this, add_fdiv_of_dvd_right (Int.dvd_mul_right ..), Int.mul_add, mul_fdiv_cancel_left _ h]
+  omega
+
+@[simp] theorem add_fmod_fmod (m n k : Int) : (m + n.fmod k).fmod k = (m + n).fmod k := by
+  rw [Int.add_comm, Int.fmod_add_fmod, Int.add_comm]
+
+theorem add_fmod (a b n : Int) : (a + b).fmod n = (a.fmod n + b.fmod n).fmod n := by
+  simp
+
+theorem add_fmod_eq_add_fmod_right {m n k : Int} (i : Int)
+    (H : m.fmod n = k.fmod n) : (m + i).fmod n = (k + i).fmod n := by
+  rw [add_fmod]
+  conv => rhs; rw [add_fmod]
+  rw [H]
+
+theorem fmod_add_cancel_right {m n k : Int} (i) : (m + i).fmod n = (k + i).fmod n ↔ m.fmod n = k.fmod n :=
+  ⟨fun H => by
+    have := add_fmod_eq_add_fmod_right (-i) H
+    rwa [Int.add_neg_cancel_right, Int.add_neg_cancel_right] at this,
+  add_fmod_eq_add_fmod_right _⟩
+
 @[simp] theorem mul_fmod_left (a b : Int) : (a * b).fmod b = 0 :=
   if h : b = 0 then by simp [h, Int.mul_zero] else by
     rw [Int.fmod_def, Int.mul_fdiv_cancel _ h, Int.mul_comm, Int.sub_self]
@@ -1043,9 +1278,56 @@ theorem fmod_lt_of_pos (a : Int) {b : Int} (H : 0 < b) : a.fmod b < b :=
 @[simp] theorem mul_fmod_right (a b : Int) : (a * b).fmod a = 0 := by
   rw [Int.mul_comm, mul_fmod_left]
 
+theorem mul_fmod (a b n : Int) : (a * b).fmod n = (a.fmod n * b.fmod n).fmod n := by
+  conv => lhs; rw [
+    ← fmod_add_fdiv a n, ← fmod_add_fdiv' b n, Int.add_mul, Int.mul_add, Int.mul_add,
+    Int.mul_assoc, Int.mul_assoc, ← Int.mul_add n _ _, add_mul_fmod_self_left,
+    ← Int.mul_assoc, add_mul_fmod_self]
+
 @[simp] theorem fmod_self {a : Int} : a.fmod a = 0 := by
   have := mul_fmod_left 1 a; rwa [Int.one_mul] at this
 
+@[simp] theorem fmod_fmod_of_dvd (n : Int) {m k : Int}
+    (h : m ∣ k) : (n.fmod k).fmod m = n.fmod m := by
+  conv => rhs; rw [← fmod_add_fdiv n k]
+  match k, h with
+  | _, ⟨t, rfl⟩ => rw [Int.mul_assoc, add_mul_fmod_self_left]
+
+@[simp] theorem fmod_fmod (a b : Int) : (a.fmod b).fmod b = a.fmod b :=
+  fmod_fmod_of_dvd _ (Int.dvd_refl b)
+
+theorem sub_fmod (a b n : Int) : (a - b).fmod n = (a.fmod n - b.fmod n).fmod n := by
+  apply (fmod_add_cancel_right b).mp
+  rw [Int.sub_add_cancel, ← Int.add_fmod_fmod, Int.sub_add_cancel, fmod_fmod]
+
+theorem fmod_eq_zero_of_dvd : ∀ {a b : Int}, a ∣ b → b.fmod a = 0
+  | _, _, ⟨_, rfl⟩ => mul_fmod_right ..
+
+-- `fmod` analogues of `emod` lemmas from above
+
+theorem fmod_eq_of_lt {a b : Int} (H1 : 0 ≤ a) (H2 : a < b) : a.fmod b = a := by
+  rw [fmod_eq_emod_of_nonneg _ (Int.le_trans H1 (Int.le_of_lt H2)), emod_eq_of_lt H1 H2]
+
+-- lemmas about `fmod` without `emod` analogues
+
+theorem fdiv_sign {a b : Int} : a.fdiv (sign b) = a * sign b := by
+  rw [fdiv_eq_ediv]
+  rcases sign_trichotomy b with h | h | h <;> simp [h]
+
+protected theorem sign_eq_fdiv_abs (a : Int) : sign a = a.fdiv (natAbs a) :=
+  if az : a = 0 then by simp [az] else
+    (Int.fdiv_eq_of_eq_mul_left (ofNat_ne_zero.2 <| natAbs_ne_zero.2 az)
+      (sign_mul_natAbs _).symm).symm
+
+/-! ### properties of `fdiv` and `fmod` -/
+
+/-! ### `fdiv` and ordering -/
+
+-- Theorems about `fdiv` and ordering, whose `ediv` analogues are in `Bootstrap.lean`.
+
+theorem lt_fdiv_add_one_mul_self (a : Int) {b : Int} (H : 0 < b) : a < (a.fdiv b + 1) * b :=
+  Int.fdiv_eq_ediv_of_nonneg _ (Int.le_of_lt H) ▸ lt_ediv_add_one_mul_self a H
+
 /-! ### bmod -/
 
 @[simp]
@@ -1100,6 +1382,9 @@ theorem bmod_add_mul_cancel (x : Int) (n : Nat) (k : Int) : Int.bmod (x + n * k)
 theorem bmod_sub_cancel (x : Int) (n : Nat) : Int.bmod (x - n) n = Int.bmod x n := by
   simp [bmod_def]
 
+@[simp] theorem Int.bmod_sub_mul_cancel (x : Int) (n : Nat) (k : Int) : (x - n * k).bmod n = x.bmod n := by
+  rw [Int.sub_eq_add_neg, Int.neg_mul_eq_mul_neg, Int.bmod_add_mul_cancel]
+
 @[simp]
 theorem emod_add_bmod_congr (x : Int) (n : Nat) : Int.bmod (x%n + y) n = Int.bmod (x + y) n := by
   simp [Int.emod_def, Int.sub_eq_add_neg]

src/Init/Data/Int/Lemmas.lean

@@ -78,7 +78,7 @@ theorem negSucc_eq (n : Nat) : -[n+1] = -((n : Int) + 1) := rfl
   | succ _ => rfl
   | -[_+1] => rfl
 
-protected theorem neg_inj {a b : Int} : -a = -b ↔ a = b :=
+@[simp] protected theorem neg_inj {a b : Int} : -a = -b ↔ a = b :=
   ⟨fun h => by rw [← Int.neg_neg a, ← Int.neg_neg b, h], congrArg _⟩
 
 @[simp] protected theorem neg_eq_zero : -a = 0 ↔ a = 0 := Int.neg_inj (b := 0)

src/Init/Data/Int/LemmasAux.lean

@@ -65,4 +65,16 @@ theorem bmod_eq_self_of_le {n : Int} {m : Nat} (hn' : -(m / 2) ≤ n) (hn : n <
   apply eq_zero_of_dvd_of_natAbs_lt_natAbs Int.dvd_bmod_sub_self
   omega
 
+protected theorem sub_eq_iff_eq_add {b a c : Int} : a - b = c ↔ a = c + b := by omega
+protected theorem sub_eq_iff_eq_add' {b a c : Int} : a - b = c ↔ a = b + c := by omega
+
+theorem bmod_bmod_of_dvd {a : Int} {n m : Nat} (hnm : n ∣ m) :
+    (a.bmod m).bmod n = a.bmod n := by
+  rw [← Int.sub_eq_iff_eq_add.2 (bmod_add_bdiv a m).symm]
+  obtain ⟨k, rfl⟩ := hnm
+  simp [Int.mul_assoc]
+
+@[simp] theorem toNat_le {m : Int} {n : Nat} : m.toNat ≤ n ↔ m ≤ n := by omega
+@[simp] theorem toNat_lt' {m : Int} {n : Nat} (hn : 0 < n) : m.toNat < n ↔ m < n := by omega
+
 end Int

src/Init/Data/Int/Linear.lean

@@ -1213,7 +1213,7 @@ def cooper_dvd_left_split_ineq_cert (p₁ p₂ : Poly) (k : Int) (b : Int) (p' :
   p₂.leadCoeff == b && p' == p₁.addConst (b*k)
 
 theorem cooper_dvd_left_split_ineq (ctx : Context) (p₁ p₂ p₃ : Poly) (d : Int) (k : Nat) (b : Int) (p' : Poly)
-    : cooper_dvd_left_split ctx p₁ p₂ p₃ d k → cooper_dvd_left_split_ineq_cert p₁ p₂ k b p' → p'.denote ctx ≤ 0 := by
+    : cooper_dvd_left_split ctx p₁ p₂ p₃ d k → cooper_dvd_left_split_ineq_cert p₁ p₂ k b p' → p'.denote' ctx ≤ 0 := by
   simp [cooper_dvd_left_split_ineq_cert, cooper_dvd_left_split]
   intros; subst p' b; simp [denote'_mul_combine_mul_addConst_eq]; assumption
 
@@ -1221,7 +1221,7 @@ def cooper_dvd_left_split_dvd1_cert (p₁ p' : Poly) (a : Int) (k : Int) : Bool
   a == p₁.leadCoeff && p' == p₁.tail.addConst k
 
 theorem cooper_dvd_left_split_dvd1 (ctx : Context) (p₁ p₂ p₃ : Poly) (d : Int) (k : Nat) (a : Int) (p' : Poly)
-    : cooper_dvd_left_split ctx p₁ p₂ p₃ d k → cooper_dvd_left_split_dvd1_cert p₁ p' a k → a ∣ p'.denote ctx := by
+    : cooper_dvd_left_split ctx p₁ p₂ p₃ d k → cooper_dvd_left_split_dvd1_cert p₁ p' a k → a ∣ p'.denote' ctx := by
   simp [cooper_dvd_left_split_dvd1_cert, cooper_dvd_left_split]
   intros; subst a p'; simp; assumption
 
@@ -1234,7 +1234,7 @@ def cooper_dvd_left_split_dvd2_cert (p₁ p₃ : Poly) (d : Int) (k : Nat) (d' :
   d' == a*d && p' == p₂.addConst (c*k)
 
 theorem cooper_dvd_left_split_dvd2 (ctx : Context) (p₁ p₂ p₃ : Poly) (d : Int) (k : Nat) (d' : Int) (p' : Poly)
-    : cooper_dvd_left_split ctx p₁ p₂ p₃ d k → cooper_dvd_left_split_dvd2_cert p₁ p₃ d k d' p' → d' ∣ p'.denote ctx := by
+    : cooper_dvd_left_split ctx p₁ p₂ p₃ d k → cooper_dvd_left_split_dvd2_cert p₁ p₃ d k d' p' → d' ∣ p'.denote' ctx := by
   simp [cooper_dvd_left_split_dvd2_cert, cooper_dvd_left_split]
   intros; subst d' p'; simp; assumption
 
@@ -1295,7 +1295,7 @@ def cooper_left_split_ineq_cert (p₁ p₂ : Poly) (k : Int) (b : Int) (p' : Pol
   p₂.leadCoeff == b && p' == p₁.addConst (b*k)
 
 theorem cooper_left_split_ineq (ctx : Context) (p₁ p₂ : Poly) (k : Nat) (b : Int) (p' : Poly)
-    : cooper_left_split ctx p₁ p₂ k → cooper_left_split_ineq_cert p₁ p₂ k b p' → p'.denote ctx ≤ 0 := by
+    : cooper_left_split ctx p₁ p₂ k → cooper_left_split_ineq_cert p₁ p₂ k b p' → p'.denote' ctx ≤ 0 := by
   simp [cooper_left_split_ineq_cert, cooper_left_split]
   intros; subst p' b; simp [denote'_mul_combine_mul_addConst_eq]; assumption
 
@@ -1303,7 +1303,7 @@ def cooper_left_split_dvd_cert (p₁ p' : Poly) (a : Int) (k : Int) : Bool :=
   a == p₁.leadCoeff && p' == p₁.tail.addConst k
 
 theorem cooper_left_split_dvd (ctx : Context) (p₁ p₂ : Poly) (k : Nat) (a : Int) (p' : Poly)
-    : cooper_left_split ctx p₁ p₂ k → cooper_left_split_dvd_cert p₁ p' a k → a ∣ p'.denote ctx := by
+    : cooper_left_split ctx p₁ p₂ k → cooper_left_split_dvd_cert p₁ p' a k → a ∣ p'.denote' ctx := by
   simp [cooper_left_split_dvd_cert, cooper_left_split]
   intros; subst a p'; simp; assumption
 
@@ -1380,7 +1380,7 @@ def cooper_dvd_right_split_ineq_cert (p₁ p₂ : Poly) (k : Int) (a : Int) (p'
   p₁.leadCoeff == a && p' == p₂.addConst ((-a)*k)
 
 theorem cooper_dvd_right_split_ineq (ctx : Context) (p₁ p₂ p₃ : Poly) (d : Int) (k : Nat) (a : Int) (p' : Poly)
-    : cooper_dvd_right_split ctx p₁ p₂ p₃ d k → cooper_dvd_right_split_ineq_cert p₁ p₂ k a p' → p'.denote ctx ≤ 0 := by
+    : cooper_dvd_right_split ctx p₁ p₂ p₃ d k → cooper_dvd_right_split_ineq_cert p₁ p₂ k a p' → p'.denote' ctx ≤ 0 := by
   simp [cooper_dvd_right_split_ineq_cert, cooper_dvd_right_split]
   intros; subst a p'; simp [denote'_mul_combine_mul_addConst_eq]; assumption
 
@@ -1388,7 +1388,7 @@ def cooper_dvd_right_split_dvd1_cert (p₂ p' : Poly) (b : Int) (k : Int) : Bool
   b == p₂.leadCoeff && p' == p₂.tail.addConst k
 
 theorem cooper_dvd_right_split_dvd1 (ctx : Context) (p₁ p₂ p₃ : Poly) (d : Int) (k : Nat) (b : Int) (p' : Poly)
-    : cooper_dvd_right_split ctx p₁ p₂ p₃ d k → cooper_dvd_right_split_dvd1_cert p₂ p' b k → b ∣ p'.denote ctx := by
+    : cooper_dvd_right_split ctx p₁ p₂ p₃ d k → cooper_dvd_right_split_dvd1_cert p₂ p' b k → b ∣ p'.denote' ctx := by
   simp [cooper_dvd_right_split_dvd1_cert, cooper_dvd_right_split]
   intros; subst b p'; simp; assumption
 
@@ -1401,7 +1401,7 @@ def cooper_dvd_right_split_dvd2_cert (p₂ p₃ : Poly) (d : Int) (k : Nat) (d'
   d' == b*d && p' == p₂.addConst ((-c)*k)
 
 theorem cooper_dvd_right_split_dvd2 (ctx : Context) (p₁ p₂ p₃ : Poly) (d : Int) (k : Nat) (d' : Int) (p' : Poly)
-    : cooper_dvd_right_split ctx p₁ p₂ p₃ d k → cooper_dvd_right_split_dvd2_cert p₂ p₃ d k d' p' → d' ∣ p'.denote ctx := by
+    : cooper_dvd_right_split ctx p₁ p₂ p₃ d k → cooper_dvd_right_split_dvd2_cert p₂ p₃ d k d' p' → d' ∣ p'.denote' ctx := by
   simp [cooper_dvd_right_split_dvd2_cert, cooper_dvd_right_split]
   intros; subst d' p'; simp; assumption
 
@@ -1461,7 +1461,7 @@ def cooper_right_split_ineq_cert (p₁ p₂ : Poly) (k : Int) (a : Int) (p' : Po
   p₁.leadCoeff == a && p' == p₂.addConst ((-a)*k)
 
 theorem cooper_right_split_ineq (ctx : Context) (p₁ p₂ : Poly) (k : Nat) (a : Int) (p' : Poly)
-    : cooper_right_split ctx p₁ p₂ k → cooper_right_split_ineq_cert p₁ p₂ k a p' → p'.denote ctx ≤ 0 := by
+    : cooper_right_split ctx p₁ p₂ k → cooper_right_split_ineq_cert p₁ p₂ k a p' → p'.denote' ctx ≤ 0 := by
   simp [cooper_right_split_ineq_cert, cooper_right_split]
   intros; subst a p'; simp [denote'_mul_combine_mul_addConst_eq]; assumption
 
@@ -1469,10 +1469,159 @@ def cooper_right_split_dvd_cert (p₂ p' : Poly) (b : Int) (k : Int) : Bool :=
   b == p₂.leadCoeff && p' == p₂.tail.addConst k
 
 theorem cooper_right_split_dvd (ctx : Context) (p₁ p₂ : Poly) (k : Nat) (b : Int) (p' : Poly)
-    : cooper_right_split ctx p₁ p₂ k → cooper_right_split_dvd_cert p₂ p' b k → b ∣ p'.denote ctx := by
+    : cooper_right_split ctx p₁ p₂ k → cooper_right_split_dvd_cert p₂ p' b k → b ∣ p'.denote' ctx := by
   simp [cooper_right_split_dvd_cert, cooper_right_split]
   intros; subst b p'; simp; assumption
 
+private theorem one_emod_eq_one {a : Int} (h : a > 1) : 1 % a = 1 := by
+  have aux₁ := Int.ediv_add_emod 1 a
+  have : 1 / a = 0 := Int.ediv_eq_zero_of_lt (by decide) h
+  simp [this] at aux₁
+  assumption
+
+private theorem ex_of_dvd {α β a b d x : Int}
+    (h₀ : d > 1)
+    (h₁ : d ∣ a*x + b)
+    (h₂ : α * a + β * d = 1)
+    : ∃ k, x = k * d + (- α * b) % d := by
+  have ⟨k, h₁⟩ := h₁
+  have aux₁ : (α * a) % d = 1 := by
+    replace h₂ := congrArg (· % d) h₂; simp at h₂
+    rw [one_emod_eq_one h₀] at h₂
+    assumption
+  have : ((α * a) * x) % d = (- α * b) % d := by
+    replace h₁ := congrArg (α * ·) h₁; simp only at h₁
+    rw [Int.mul_add] at h₁
+    replace h₁ := congrArg (· - α * b) h₁; simp only [Int.add_sub_cancel] at h₁
+    rw [← Int.mul_assoc, Int.mul_left_comm, Int.sub_eq_add_neg] at h₁
+    replace h₁ := congrArg (· % d) h₁; simp only at h₁
+    rw [Int.add_emod, Int.mul_emod_right, Int.zero_add, Int.emod_emod, ← Int.neg_mul] at h₁
+    assumption
+  have : x % d = (- α * b) % d := by
+    rw [Int.mul_emod, aux₁, Int.one_mul, Int.emod_emod] at this
+    assumption
+  have : x = (x / d)*d + (- α * b) % d := by
+    conv => lhs; rw [← Int.ediv_add_emod x d]
+    rw [Int.mul_comm, this]
+  exists x / d
+
+private theorem cdiv_le {a d k : Int} : d > 0 → a ≤ k * d → cdiv a d ≤ k := by
+  intro h₁ h₂
+  simp [cdiv]
+  replace h₂ := Int.neg_le_neg h₂
+  rw [← Int.neg_mul] at h₂
+  replace h₂ := Int.le_ediv_of_mul_le h₁ h₂
+  replace h₂ := Int.neg_le_neg h₂
+  simp at h₂
+  assumption
+
+private theorem cooper_unsat'_helper {a b d c k x : Int}
+    (d_pos : d > 0)
+    (h₁ : x = k * d + c)
+    (h₂ : a ≤ x)
+    (h₃ : x ≤ b)
+    : ¬ b < (cdiv (a - c) d) * d + c := by
+  intro h₄
+  have aux₁ : cdiv (a - c) d ≤ k := by
+    rw [h₁] at h₂
+    replace h₂ := Int.sub_right_le_of_le_add h₂
+    exact cdiv_le d_pos h₂
+  have aux₂ : cdiv (a - c) d * d ≤ k * d := Int.mul_le_mul_of_nonneg_right aux₁ (Int.le_of_lt d_pos)
+  have aux₃ : cdiv (a - c) d * d + c ≤ k * d + c := Int.add_le_add_right aux₂ _
+  have aux₄ : cdiv (a - c) d * d + c ≤ x := by rw [←h₁] at aux₃; assumption
+  have aux₅ : cdiv (a - c) d * d + c ≤ b := Int.le_trans aux₄ h₃
+  have := Int.lt_of_le_of_lt aux₅ h₄
+  exact Int.lt_irrefl _ this
+
+private theorem cooper_unsat' {a c b d e α β x : Int}
+    (h₁ : d > 1)
+    (h₂ : d ∣ c*x + e)
+    (h₃ : α * c + β * d = 1)
+    (h₄ : (-1)*x + a ≤ 0)
+    (h₅ : x + b ≤ 0)
+    (h₆ : -b < cdiv (a - -α * e % d) d * d + -α * e % d)
+    : False := by
+  have ⟨k, h⟩ := ex_of_dvd h₁ h₂ h₃
+  have d_pos : d > 0 := Int.lt_trans (by decide) h₁
+  replace h₄ := Int.le_neg_add_of_add_le h₄; simp at h₄
+  replace h₅ := Int.neg_le_neg (Int.le_neg_add_of_add_le h₅); simp at h₅
+  have := cooper_unsat'_helper d_pos h h₄ h₅
+  exact this h₆
+
+abbrev Poly.casesOnAdd (p : Poly) (k : Int → Var → Poly → Bool) : Bool :=
+  p.casesOn (fun _  => false) k
+
+abbrev Poly.casesOnNum (p : Poly) (k : Int → Bool) : Bool :=
+  p.casesOn k (fun _ _ _ => false)
+
+def cooper_unsat_cert (p₁ p₂ p₃ : Poly) (d : Int) (α β : Int) : Bool :=
+  p₁.casesOnAdd fun k₁ x p₁ =>
+  p₂.casesOnAdd fun k₂ y p₂ =>
+  p₃.casesOnAdd fun c z p₃ =>
+  p₁.casesOnNum fun a =>
+  p₂.casesOnNum fun b =>
+  p₃.casesOnNum fun e =>
+  (k₁ == -1) |>.and (k₂ == 1) |>.and
+  (x == y) |>.and (x == z) |>.and
+  (d > 1) |>.and (α * c + β * d == 1) |>.and
+  (-b < cdiv (a - -α * e % d) d * d + -α * e % d)
+
+theorem cooper_unsat (ctx : Context) (p₁ p₂ p₃ : Poly) (d : Int) (α β : Int)
+   : cooper_unsat_cert p₁ p₂ p₃ d α β →
+     p₁.denote' ctx ≤ 0 → p₂.denote' ctx ≤ 0 → d ∣ p₃.denote' ctx → False := by
+  unfold cooper_unsat_cert <;> cases p₁ <;> cases p₂ <;> cases p₃ <;> simp only [Poly.casesOnAdd,
+    Bool.false_eq_true, Poly.denote'_add, mul_def, add_def, false_implies]
+  next k₁ x p₁ k₂ y p₂ c z p₃ =>
+  cases p₁ <;> cases p₂ <;> cases p₃ <;> simp only [Poly.casesOnNum, Int.reduceNeg,
+    Bool.and_eq_true, beq_iff_eq, decide_eq_true_eq, and_imp, Bool.false_eq_true,
+    mul_def, add_def, false_implies, Poly.denote]
+  next a b e =>
+  intro _ _ _ _; subst k₁ k₂ y z
+  intro h₁ h₃ h₆; generalize Var.denote ctx x = x'
+  intro h₄ h₅ h₂
+  rw [Int.one_mul] at h₅
+  exact cooper_unsat' h₁ h₂ h₃ h₄ h₅ h₆
+
+theorem ediv_emod (x y : Int) : -1 * x + y * (x / y) + x % y = 0 := by
+  rw [Int.add_assoc, Int.ediv_add_emod x y, Int.add_comm]
+  simp
+  rw [← Int.sub_eq_add_neg, Int.sub_self]
+
+theorem emod_nonneg (x y : Int) : y != 0 → -1 * (x % y) ≤ 0 := by
+  simp; intro h
+  have := Int.neg_le_neg (Int.emod_nonneg x h)
+  simp at this
+  assumption
+
+def emod_le_cert (y n : Int) : Bool :=
+  y != 0 && n == 1 - y.natAbs
+
+theorem emod_le (x y : Int) (n : Int) : emod_le_cert y n → x % y + n ≤ 0 := by
+  simp [emod_le_cert]
+  intro h₁
+  cases Int.lt_or_gt_of_ne h₁
+  next h =>
+    rw [Int.ofNat_natAbs_of_nonpos (Int.le_of_lt h)]
+    simp only [Int.sub_neg]
+    intro; subst n
+    rw [Int.add_assoc, Int.add_left_comm]
+    apply Int.add_le_of_le_sub_left
+    rw [Int.zero_sub, Int.add_comm]
+    have : 0 < -y := by
+      have := Int.neg_lt_neg h
+      rw [Int.neg_zero] at this
+      assumption
+    have := Int.emod_lt_of_pos x this
+    rw [Int.emod_neg] at this
+    exact this
+  next h =>
+    rw [Int.natAbs_of_nonneg (Int.le_of_lt h)]
+    intro; subst n
+    rw [Int.sub_eq_add_neg, Int.add_assoc, Int.add_left_comm]
+    apply Int.add_le_of_le_sub_left
+    simp only [Int.add_comm, Int.sub_neg, Int.add_zero]
+    exact Int.emod_lt_of_pos x h
+
 end Int.Linear
 
 theorem Int.not_le_eq (a b : Int) : (¬a ≤ b) = (b + 1 ≤ a) := by

src/Init/Data/Int/Order.lean

@@ -139,6 +139,9 @@ protected theorem not_le_of_gt {a b : Int} (h : b < a) : ¬a ≤ b :=
 @[simp] protected theorem not_lt {a b : Int} : ¬a < b ↔ b ≤ a :=
   by rw [← Int.not_le, Decidable.not_not]
 
+protected theorem le_of_not_gt {a b : Int} (h : ¬ a > b) : a ≤ b :=
+  Int.not_lt.mp h
+
 protected theorem lt_trichotomy (a b : Int) : a < b ∨ a = b ∨ b < a :=
   if eq : a = b then .inr <| .inl eq else
   if le : a ≤ b then .inl <| Int.lt_iff_le_and_ne.2 ⟨le, eq⟩ else
@@ -938,6 +941,22 @@ protected theorem mul_self_le_mul_self {a b : Int} (h1 : 0 ≤ a) (h2 : a ≤ b)
 protected theorem mul_self_lt_mul_self {a b : Int} (h1 : 0 ≤ a) (h2 : a < b) : a * a < b * b :=
   Int.mul_lt_mul' (Int.le_of_lt h2) h2 h1 (Int.lt_of_le_of_lt h1 h2)
 
+protected theorem nonneg_of_mul_nonneg_left {a b : Int}
+    (h : 0 ≤ a * b) (hb : 0 < b) : 0 ≤ a :=
+  Int.le_of_not_gt fun ha => Int.not_le_of_gt (Int.mul_neg_of_neg_of_pos ha hb) h
+
+protected theorem nonneg_of_mul_nonneg_right {a b : Int}
+    (h : 0 ≤ a * b) (ha : 0 < a) : 0 ≤ b :=
+  Int.le_of_not_gt fun hb => Int.not_le_of_gt (Int.mul_neg_of_pos_of_neg ha hb) h
+
+protected theorem nonpos_of_mul_nonpos_left {a b : Int}
+    (h : a * b ≤ 0) (hb : 0 < b) : a ≤ 0 :=
+  Int.le_of_not_gt fun ha : a > 0 => Int.not_le_of_gt (Int.mul_pos ha hb) h
+
+protected theorem nonpos_of_mul_nonpos_right {a b : Int}
+    (h : a * b ≤ 0) (ha : 0 < a) : b ≤ 0 :=
+  Int.le_of_not_gt fun hb : b > 0 => Int.not_le_of_gt (Int.mul_pos ha hb) h
+
 /- ## sign -/
 
 @[simp] theorem sign_zero : sign 0 = 0 := rfl
@@ -1021,6 +1040,12 @@ theorem sign_eq_neg_one_iff_neg {a : Int} : sign a = -1 ↔ a < 0 :=
 @[simp] theorem sign_mul_self : sign i * i = natAbs i := by
   rw [Int.mul_comm, mul_sign_self]
 
+theorem sign_trichotomy (a : Int) : sign a = 1 ∨ sign a = 0 ∨ sign a = -1 := by
+  match a with
+  | 0 => simp
+  | .ofNat (_ + 1) => simp
+  | .negSucc _ => simp
+
 /- ## natAbs -/
 
 theorem natAbs_ne_zero {a : Int} : a.natAbs ≠ 0 ↔ a ≠ 0 := not_congr Int.natAbs_eq_zero

src/Init/Data/List/Basic.lean

@@ -1758,10 +1758,10 @@ where
 
 /-! ### removeAll -/
 
-/-- `O(|xs|)`. Computes the "set difference" of lists,
+/-- `O(|xs| * |ys|)`. Computes the "set difference" of lists,
 by filtering out all elements of `xs` which are also in `ys`.
 * `removeAll [1, 1, 5, 1, 2, 4, 5] [1, 2, 2] = [5, 4, 5]`
- -/
+-/
 def removeAll [BEq α] (xs ys : List α) : List α :=
   xs.filter (fun x => !ys.elem x)
 

src/Init/Data/SInt/Lemmas.lean

@@ -5,7 +5,9 @@ Authors: Markus Himmel
 -/
 prelude
 import Init.Data.SInt.Basic
-import Init.Data.BitVec.Lemmas
+import Init.Data.BitVec.Bitblast
+import Init.Data.Int.LemmasAux
+import Init.Data.UInt.Lemmas
 
 open Lean in
 set_option hygiene false in
@@ -21,8 +23,8 @@ macro "declare_int_theorems" typeName:ident _bits:term:arg : command => do
     toBitVec_inj.symm
   @[int_toBitVec] theorem ne_iff_toBitVec_ne {a b : $typeName} : a ≠ b ↔ a.toBitVec ≠ b.toBitVec :=
     Decidable.not_iff_not.2 eq_iff_toBitVec_eq
-  @[simp] theorem toBitVec_ofNat {n : Nat} : toBitVec (ofNat n) = BitVec.ofNat _ n := rfl
-  @[simp, int_toBitVec] theorem toBitVec_ofNatOfNat {n : Nat} : toBitVec (no_index (OfNat.ofNat n)) = OfNat.ofNat n := rfl
+  @[simp] theorem toBitVec_ofNat' {n : Nat} : toBitVec (ofNat n) = BitVec.ofNat _ n := rfl
+  @[simp, int_toBitVec] theorem toBitVec_ofNat {n : Nat} : toBitVec (no_index (OfNat.ofNat n)) = OfNat.ofNat n := rfl
 
   end $typeName
   )
@@ -34,6 +36,118 @@ declare_int_theorems Int32 32
 declare_int_theorems Int64 64
 declare_int_theorems ISize System.Platform.numBits
 
+theorem Int8.toInt.inj {x y : Int8} (h : x.toInt = y.toInt) : x = y := Int8.toBitVec.inj (BitVec.eq_of_toInt_eq h)
+theorem Int8.toInt_inj {x y : Int8} : x.toInt = y.toInt ↔ x = y := ⟨Int8.toInt.inj, fun h => h ▸ rfl⟩
+theorem Int16.toInt.inj {x y : Int16} (h : x.toInt = y.toInt) : x = y := Int16.toBitVec.inj (BitVec.eq_of_toInt_eq h)
+theorem Int16.toInt_inj {x y : Int16} : x.toInt = y.toInt ↔ x = y := ⟨Int16.toInt.inj, fun h => h ▸ rfl⟩
+theorem Int32.toInt.inj {x y : Int32} (h : x.toInt = y.toInt) : x = y := Int32.toBitVec.inj (BitVec.eq_of_toInt_eq h)
+theorem Int32.toInt_inj {x y : Int32} : x.toInt = y.toInt ↔ x = y := ⟨Int32.toInt.inj, fun h => h ▸ rfl⟩
+theorem Int64.toInt.inj {x y : Int64} (h : x.toInt = y.toInt) : x = y := Int64.toBitVec.inj (BitVec.eq_of_toInt_eq h)
+theorem Int64.toInt_inj {x y : Int64} : x.toInt = y.toInt ↔ x = y := ⟨Int64.toInt.inj, fun h => h ▸ rfl⟩
+theorem ISize.toInt.inj {x y : ISize} (h : x.toInt = y.toInt) : x = y := ISize.toBitVec.inj (BitVec.eq_of_toInt_eq h)
+theorem ISize.toInt_inj {x y : ISize} : x.toInt = y.toInt ↔ x = y := ⟨ISize.toInt.inj, fun h => h ▸ rfl⟩
+
+@[simp] theorem Int8.toBitVec_neg (x : Int8) : (-x).toBitVec = -x.toBitVec := rfl
+@[simp] theorem Int16.toBitVec_neg (x : Int16) : (-x).toBitVec = -x.toBitVec := rfl
+@[simp] theorem Int32.toBitVec_neg (x : Int32) : (-x).toBitVec = -x.toBitVec := rfl
+@[simp] theorem Int64.toBitVec_neg (x : Int64) : (-x).toBitVec = -x.toBitVec := rfl
+@[simp] theorem ISize.toBitVec_neg (x : ISize) : (-x).toBitVec = -x.toBitVec := rfl
+
+@[simp] theorem ISize.toBitVec_zero : (0 : ISize).toBitVec = 0 := rfl
+
+@[simp] theorem Int8.toBitVec_ofInt (i : Int) : (ofInt i).toBitVec = BitVec.ofInt _ i := rfl
+@[simp] theorem Int16.toBitVec_ofInt (i : Int) : (ofInt i).toBitVec = BitVec.ofInt _ i := rfl
+@[simp] theorem Int32.toBitVec_ofInt (i : Int) : (ofInt i).toBitVec = BitVec.ofInt _ i := rfl
+@[simp] theorem Int64.toBitVec_ofInt (i : Int) : (ofInt i).toBitVec = BitVec.ofInt _ i := rfl
+@[simp] theorem ISize.toBitVec_ofInt (i : Int) : (ofInt i).toBitVec = BitVec.ofInt _ i := rfl
+
+@[simp] theorem Int8.neg_zero : -(0 : Int8) = 0 := rfl
+@[simp] theorem Int16.neg_zero : -(0 : Int16) = 0 := rfl
+@[simp] theorem Int32.neg_zero : -(0 : Int32) = 0 := rfl
+@[simp] theorem Int64.neg_zero : -(0 : Int64) = 0 := rfl
+@[simp] theorem ISize.neg_zero : -(0 : ISize) = 0 := ISize.toBitVec.inj (by simp)
+
+theorem ISize.toNat_toBitVec_ofNat_of_lt {n : Nat} (h : n < 2^32) :
+    (ofNat n).toBitVec.toNat = n :=
+  Nat.mod_eq_of_lt (Nat.lt_of_lt_of_le h (by cases USize.size_eq <;> simp_all +decide))
+
+theorem Int8.toInt_ofInt {n : Int} (hn : -2^7 ≤ n) (hn' : n < 2^7) : toInt (ofInt n) = n := by
+  rw [toInt, toBitVec_ofInt, BitVec.toInt_ofInt_eq_self (by decide) hn hn']
+theorem Int16.toInt_ofInt {n : Int} (hn : -2^15 ≤ n) (hn' : n < 2^15) : toInt (ofInt n) = n := by
+  rw [toInt, toBitVec_ofInt, BitVec.toInt_ofInt_eq_self (by decide) hn hn']
+theorem Int32.toInt_ofInt {n : Int} (hn : -2^31 ≤ n) (hn' : n < 2^31) : toInt (ofInt n) = n := by
+  rw [toInt, toBitVec_ofInt, BitVec.toInt_ofInt_eq_self (by decide) hn hn']
+theorem Int64.toInt_ofInt {n : Int} (hn : -2^63 ≤ n) (hn' : n < 2^63) : toInt (ofInt n) = n := by
+  rw [toInt, toBitVec_ofInt, BitVec.toInt_ofInt_eq_self (by decide) hn hn']
+theorem ISize.toInt_ofInt {n : Int} (hn : -2^31 ≤ n) (hn' : n < 2^31) : toInt (ofInt n) = n := by
+  rw [toInt, toBitVec_ofInt, BitVec.toInt_ofInt_eq_self] <;> cases System.Platform.numBits_eq
+    <;> (simp_all; try omega)
+
+theorem ISize.toInt_ofInt_of_two_pow_numBits_le {n : Int} (hn : -2 ^ (System.Platform.numBits - 1) ≤ n)
+    (hn' : n < 2 ^ (System.Platform.numBits - 1)) : toInt (ofInt n) = n := by
+  rw [toInt, toBitVec_ofInt, BitVec.toInt_ofInt_eq_self _ hn hn']
+  cases System.Platform.numBits_eq <;> simp_all
+
+theorem ISize.toNatClampNeg_ofInt_eq_zero {n : Int} (hn : -2^31 ≤ n) (hn' : n ≤ 0) :
+    toNatClampNeg (ofInt n) = 0 := by
+  rwa [toNatClampNeg, toInt_ofInt hn (by omega), Int.toNat_eq_zero]
+
+theorem Int64.neg_ofInt {n : Int} : -ofInt n = ofInt (-n) :=
+  toBitVec.inj (by simp [BitVec.ofInt_neg])
+theorem ISize.neg_ofInt {n : Int} : -ofInt n = ofInt (-n) :=
+  toBitVec.inj (by simp [BitVec.ofInt_neg])
+
+theorem Int8.ofInt_eq_ofNat {n : Nat} : ofInt n = ofNat n := toBitVec.inj (by simp)
+theorem Int16.ofInt_eq_ofNat {n : Nat} : ofInt n = ofNat n := toBitVec.inj (by simp)
+theorem Int32.ofInt_eq_ofNat {n : Nat} : ofInt n = ofNat n := toBitVec.inj (by simp)
+theorem Int64.ofInt_eq_ofNat {n : Nat} : ofInt n = ofNat n := toBitVec.inj (by simp)
+theorem ISize.ofInt_eq_ofNat {n : Nat} : ofInt n = ofNat n := toBitVec.inj (by simp)
+
+theorem ISize.neg_ofNat {n : Nat} : -ofNat n = ofInt (-n) := by
+  rw [← neg_ofInt, ofInt_eq_ofNat]
+
+theorem Int8.toNatClampNeg_ofNat_of_lt {n : Nat} (h : n < 2 ^ 7) : toNatClampNeg (ofNat n) = n := by
+  rw [toNatClampNeg, ← ofInt_eq_ofNat, toInt_ofInt (by omega) (by omega), Int.toNat_ofNat]
+theorem ISize.toNatClampNeg_ofNat_of_lt {n : Nat} (h : n < 2 ^ 31) : toNatClampNeg (ofNat n) = n := by
+  rw [toNatClampNeg, ← ofInt_eq_ofNat, toInt_ofInt (by omega) (by omega), Int.toNat_ofNat]
+
+theorem ISize.toNatClampNeg_neg_ofNat_of_le {n : Nat} (h : n ≤ 2 ^ 31) :
+    toNatClampNeg (-ofNat n) = 0 := by
+  rw [neg_ofNat, toNatClampNeg_ofInt_eq_zero (by omega) (by omega)]
+
+theorem Int8.toInt_ofNat_of_lt {n : Nat} (h : n < 2 ^ 7) : toInt (ofNat n) = n := by
+  rw [← ofInt_eq_ofNat, toInt_ofInt (by omega) (by omega)]
+theorem Int16.toInt_ofNat_of_lt {n : Nat} (h : n < 2 ^ 15) : toInt (ofNat n) = n := by
+  rw [← ofInt_eq_ofNat, toInt_ofInt (by omega) (by omega)]
+theorem Int32.toInt_ofNat_of_lt {n : Nat} (h : n < 2 ^ 31) : toInt (ofNat n) = n := by
+  rw [← ofInt_eq_ofNat, toInt_ofInt (by omega) (by omega)]
+theorem Int64.toInt_ofNat_of_lt {n : Nat} (h : n < 2 ^ 63) : toInt (ofNat n) = n := by
+  rw [← ofInt_eq_ofNat, toInt_ofInt (by omega) (by omega)]
+theorem ISize.toInt_ofNat_of_lt {n : Nat} (h : n < 2 ^ 31) : toInt (ofNat n) = n := by
+  rw [← ofInt_eq_ofNat, toInt_ofInt (by omega) (by omega)]
+theorem ISize.toInt_ofNat_of_lt_two_pow_numBits {n : Nat}
+    (h : n < 2 ^ (System.Platform.numBits - 1)) : toInt (ofNat n) = n := by
+  rw [← ofInt_eq_ofNat, toInt_ofInt_of_two_pow_numBits_le] <;>
+    cases System.Platform.numBits_eq <;> simp_all <;> omega
+
+theorem Int64.toInt_neg_ofNat_of_le {n : Nat} (h : n ≤ 2^63) : toInt (-ofNat n) = -n := by
+  rw [← ofInt_eq_ofNat, neg_ofInt, toInt_ofInt (by omega) (by omega)]
+theorem ISize.toInt_neg_ofNat_of_le {n : Nat} (h : n ≤ 2 ^ 31) : toInt (-ofNat n) = -n := by
+  rw [← ofInt_eq_ofNat, neg_ofInt, toInt_ofInt (by omega) (by omega)]
+
+theorem Int8.toInt_zero : toInt 0 = 0 := by simp
+theorem Int16.toInt_zero : toInt 0 = 0 := by simp
+theorem Int32.toInt_zero : toInt 0 = 0 := by simp
+theorem Int64.toInt_zero : toInt 0 = 0 := by simp
+theorem ISize.toInt_zero : toInt 0 = 0 := by simp
+
+@[simp] theorem ISize.toInt_minValue : ISize.minValue.toInt = -2^(System.Platform.numBits - 1) := by
+  rw [minValue, toInt_ofInt_of_two_pow_numBits_le] <;> cases System.Platform.numBits_eq
+    <;> simp_all
+@[simp] theorem ISize.toInt_maxValue : ISize.maxValue.toInt = 2^(System.Platform.numBits - 1) - 1:= by
+  rw [maxValue, toInt_ofInt_of_two_pow_numBits_le] <;> cases System.Platform.numBits_eq
+    <;> simp_all
+
 @[simp] theorem UInt8.toBitVec_toInt8 (x : UInt8) : x.toInt8.toBitVec = x.toBitVec := rfl
 @[simp] theorem UInt16.toBitVec_toInt16 (x : UInt16) : x.toInt16.toBitVec = x.toBitVec := rfl
 @[simp] theorem UInt32.toBitVec_toInt32 (x : UInt32) : x.toInt32.toBitVec = x.toBitVec := rfl
@@ -52,47 +166,702 @@ declare_int_theorems ISize System.Platform.numBits
 @[simp] theorem UInt64.toUInt64_toInt64 (x : UInt64) : x.toInt64.toUInt64 = x := rfl
 @[simp] theorem USize.toUSize_toISize (x : USize) : x.toISize.toUSize = x := rfl
 
-@[simp] theorem ISize.toBitVec_neg (x : ISize) : (-x).toBitVec = -x.toBitVec := rfl
-@[simp] theorem ISize.toBitVec_zero : (0 : ISize).toBitVec = 0 := rfl
-@[simp] theorem ISize.toBitVec_ofInt (i : Int) : (ofInt i).toBitVec = BitVec.ofInt _ i := rfl
+@[simp] theorem Int8.toNat_toInt (x : Int8) : x.toInt.toNat = x.toNatClampNeg := rfl
+@[simp] theorem Int16.toNat_toInt (x : Int16) : x.toInt.toNat = x.toNatClampNeg := rfl
+@[simp] theorem Int32.toNat_toInt (x : Int32) : x.toInt.toNat = x.toNatClampNeg := rfl
+@[simp] theorem Int64.toNat_toInt (x : Int64) : x.toInt.toNat = x.toNatClampNeg := rfl
+@[simp] theorem ISize.toNat_toInt (x : ISize) : x.toInt.toNat = x.toNatClampNeg := rfl
 
-@[simp] theorem Int8.neg_zero : -(0 : Int8) = 0 := rfl
-@[simp] theorem Int16.neg_zero : -(0 : Int16) = 0 := rfl
-@[simp] theorem Int32.neg_zero : -(0 : Int32) = 0 := rfl
-@[simp] theorem Int64.neg_zero : -(0 : Int64) = 0 := rfl
-@[simp] theorem ISize.neg_zero : -(0 : ISize) = 0 := ISize.toBitVec.inj (by simp)
+@[simp] theorem Int8.toInt_toBitVec (x : Int8) : x.toBitVec.toInt = x.toInt := rfl
+@[simp] theorem Int16.toInt_toBitVec (x : Int16) : x.toBitVec.toInt = x.toInt := rfl
+@[simp] theorem Int32.toInt_toBitVec (x : Int32) : x.toBitVec.toInt = x.toInt := rfl
+@[simp] theorem Int64.toInt_toBitVec (x : Int64) : x.toBitVec.toInt = x.toInt := rfl
+@[simp] theorem ISize.toInt_toBitVec (x : ISize) : x.toBitVec.toInt = x.toInt := rfl
 
-theorem ISize.toNat_toBitVec_ofNat_of_lt {n : Nat} (h : n < 2^32) :
-    (ofNat n).toBitVec.toNat = n :=
-  Nat.mod_eq_of_lt (Nat.lt_of_lt_of_le h (by cases USize.size_eq <;> simp_all +decide))
+@[simp] theorem Int8.toBitVec_toInt16 (x : Int8) : x.toInt16.toBitVec = x.toBitVec.signExtend 16 := rfl
+@[simp] theorem Int8.toBitVec_toInt32 (x : Int8) : x.toInt32.toBitVec = x.toBitVec.signExtend 32 := rfl
+@[simp] theorem Int8.toBitVec_toInt64 (x : Int8) : x.toInt64.toBitVec = x.toBitVec.signExtend 64 := rfl
+@[simp] theorem Int8.toBitVec_toISize (x : Int8) : x.toISize.toBitVec = x.toBitVec.signExtend System.Platform.numBits := rfl
 
-theorem ISize.toInt_ofInt {n : Int} (hn : -2^31 ≤ n) (hn' : n < 2^31) : toInt (ofInt n) = n := by
-  rw [toInt, toBitVec_ofInt, BitVec.toInt_ofInt_eq_self] <;> cases System.Platform.numBits_eq
-    <;> (simp_all; try omega)
+@[simp] theorem Int16.toBitVec_toInt8 (x : Int16) : x.toInt8.toBitVec = x.toBitVec.signExtend 8 := rfl
+@[simp] theorem Int16.toBitVec_toInt32 (x : Int16) : x.toInt32.toBitVec = x.toBitVec.signExtend 32 := rfl
+@[simp] theorem Int16.toBitVec_toInt64 (x : Int16) : x.toInt64.toBitVec = x.toBitVec.signExtend 64 := rfl
+@[simp] theorem Int16.toBitVec_toISize (x : Int16) : x.toISize.toBitVec = x.toBitVec.signExtend System.Platform.numBits := rfl
 
-theorem ISize.toNatClampNeg_ofInt_eq_zero {n : Int} (hn : -2^31 ≤ n) (hn' : n ≤ 0) :
-    toNatClampNeg (ofInt n) = 0 := by
-  rwa [toNatClampNeg, toInt_ofInt hn (by omega), Int.toNat_eq_zero]
+@[simp] theorem Int32.toBitVec_toInt8 (x : Int32) : x.toInt8.toBitVec = x.toBitVec.signExtend 8 := rfl
+@[simp] theorem Int32.toBitVec_toInt16 (x : Int32) : x.toInt16.toBitVec = x.toBitVec.signExtend 16 := rfl
+@[simp] theorem Int32.toBitVec_toInt64 (x : Int32) : x.toInt64.toBitVec = x.toBitVec.signExtend 64 := rfl
+@[simp] theorem Int32.toBitVec_toISize (x : Int32) : x.toISize.toBitVec = x.toBitVec.signExtend System.Platform.numBits := rfl
 
-theorem ISize.neg_ofInt {n : Int} : -ofInt n = ofInt (-n) :=
-  toBitVec.inj (by simp [BitVec.ofInt_neg])
+@[simp] theorem Int64.toBitVec_toInt8 (x : Int64) : x.toInt8.toBitVec = x.toBitVec.signExtend 8 := rfl
+@[simp] theorem Int64.toBitVec_toInt16 (x : Int64) : x.toInt16.toBitVec = x.toBitVec.signExtend 16 := rfl
+@[simp] theorem Int64.toBitVec_toInt32 (x : Int64) : x.toInt32.toBitVec = x.toBitVec.signExtend 32 := rfl
+@[simp] theorem Int64.toBitVec_toISize (x : Int64) : x.toISize.toBitVec = x.toBitVec.signExtend System.Platform.numBits := rfl
 
-theorem ISize.ofInt_eq_ofNat {n : Nat} : ofInt n = ofNat n :=
-  toBitVec.inj (by simp)
+@[simp] theorem ISize.toBitVec_toInt8 (x : ISize) : x.toInt8.toBitVec = x.toBitVec.signExtend 8 := rfl
+@[simp] theorem ISize.toBitVec_toInt16 (x : ISize) : x.toInt16.toBitVec = x.toBitVec.signExtend 16 := rfl
+@[simp] theorem ISize.toBitVec_toInt32 (x : ISize) : x.toInt32.toBitVec = x.toBitVec.signExtend 32 := rfl
+@[simp] theorem ISize.toBitVec_toInt64 (x : ISize) : x.toInt64.toBitVec = x.toBitVec.signExtend 64 := rfl
 
-theorem ISize.neg_ofNat {n : Nat} : -ofNat n = ofInt (-n) := by
-  rw [← neg_ofInt, ofInt_eq_ofNat]
+theorem Int8.toInt_lt (x : Int8) : x.toInt < 2 ^ 7 := Int.lt_of_mul_lt_mul_left BitVec.toInt_lt (by decide)
+theorem Int8.le_toInt (x : Int8) : -2 ^ 7 ≤ x.toInt := Int.le_of_mul_le_mul_left BitVec.le_toInt (by decide)
+theorem Int16.toInt_lt (x : Int16) : x.toInt < 2 ^ 15 := Int.lt_of_mul_lt_mul_left BitVec.toInt_lt (by decide)
+theorem Int16.le_toInt (x : Int16) : -2 ^ 15 ≤ x.toInt := Int.le_of_mul_le_mul_left BitVec.le_toInt (by decide)
+theorem Int32.toInt_lt (x : Int32) : x.toInt < 2 ^ 31 := Int.lt_of_mul_lt_mul_left BitVec.toInt_lt (by decide)
+theorem Int32.le_toInt (x : Int32) : -2 ^ 31 ≤ x.toInt := Int.le_of_mul_le_mul_left BitVec.le_toInt (by decide)
+theorem Int64.toInt_lt (x : Int64) : x.toInt < 2 ^ 63 := Int.lt_of_mul_lt_mul_left BitVec.toInt_lt (by decide)
+theorem Int64.le_toInt (x : Int64) : -2 ^ 63 ≤ x.toInt := Int.le_of_mul_le_mul_left BitVec.le_toInt (by decide)
+theorem ISize.toInt_lt_two_pow_numBits (x : ISize) : x.toInt < 2 ^ (System.Platform.numBits - 1) := by
+  have := x.toBitVec.toInt_lt; cases System.Platform.numBits_eq <;> simp_all <;> omega
+theorem ISize.two_pow_numBits_le_toInt (x : ISize) : -2 ^ (System.Platform.numBits - 1) ≤ x.toInt := by
+  have := x.toBitVec.le_toInt; cases System.Platform.numBits_eq <;> simp_all <;> omega
+theorem ISize.toInt_lt (x : ISize) : x.toInt < 2 ^ 63 := by
+  have := x.toBitVec.toInt_lt; cases System.Platform.numBits_eq <;> simp_all <;> omega
+theorem ISize.le_toInt (x : ISize) : -2 ^ 63 ≤ x.toInt := by
+  have := x.toBitVec.le_toInt; cases System.Platform.numBits_eq <;> simp_all <;> omega
 
-theorem ISize.toNatClampNeg_ofNat_of_lt {n : Nat} (h : n < 2 ^ 31) :
-    toNatClampNeg (ofNat n) = n := by
-  rw [toNatClampNeg, ← ofInt_eq_ofNat, toInt_ofInt (by omega) (by omega), Int.toNat_ofNat]
+theorem Int8.toInt_le (x : Int8) : x.toInt ≤ Int8.maxValue.toInt := Int.le_of_lt_add_one x.toInt_lt
+theorem Int16.toInt_le (x : Int16) : x.toInt ≤ Int16.maxValue.toInt := Int.le_of_lt_add_one x.toInt_lt
+theorem Int32.toInt_le (x : Int32) : x.toInt ≤ Int32.maxValue.toInt := Int.le_of_lt_add_one x.toInt_lt
+theorem Int64.toInt_le (x : Int64) : x.toInt ≤ Int64.maxValue.toInt := Int.le_of_lt_add_one x.toInt_lt
+theorem ISize.toInt_le (x : ISize) : x.toInt ≤ ISize.maxValue.toInt := by
+  rw [toInt_ofInt_of_two_pow_numBits_le]
+  · exact Int.le_of_lt_add_one (by simpa using x.toInt_lt_two_pow_numBits)
+  · cases System.Platform.numBits_eq <;> simp_all
+  · cases System.Platform.numBits_eq <;> simp_all
+theorem Int8.minValue_le_toInt (x : Int8) : Int8.minValue.toInt ≤ x.toInt := x.le_toInt
+theorem Int16.minValue_le_toInt (x : Int16) : Int16.minValue.toInt ≤ x.toInt := x.le_toInt
+theorem Int32.minValue_le_toInt (x : Int32) : Int32.minValue.toInt ≤ x.toInt := x.le_toInt
+theorem Int64.minValue_le_toInt (x : Int64) : Int64.minValue.toInt ≤ x.toInt := x.le_toInt
+theorem ISize.minValue_le_toInt (x : ISize) : ISize.minValue.toInt ≤ x.toInt := by
+  rw [toInt_ofInt_of_two_pow_numBits_le]
+  · exact x.two_pow_numBits_le_toInt
+  · cases System.Platform.numBits_eq <;> simp_all
+  · cases System.Platform.numBits_eq <;> simp_all
 
-theorem ISize.toNatClampNeg_neg_ofNat_of_le {n : Nat} (h : n ≤ 2 ^ 31) :
-    toNatClampNeg (-ofNat n) = 0 := by
-  rw [neg_ofNat, toNatClampNeg_ofInt_eq_zero (by omega) (by omega)]
+theorem ISize.toInt_minValue_le : ISize.minValue.toInt ≤ -2^31 := by
+  rw [minValue, toInt_ofInt_of_two_pow_numBits_le] <;> cases System.Platform.numBits_eq
+    <;> simp_all
 
-theorem ISize.toInt_ofNat_of_lt {n : Nat} (h : n < 2 ^ 31) : toInt (ofNat n) = n := by
-  rw [← ofInt_eq_ofNat, toInt_ofInt (by omega) (by omega)]
+theorem ISize.le_toInt_maxValue : 2 ^ 31 - 1 ≤ ISize.maxValue.toInt := by
+  rw [maxValue, toInt_ofInt_of_two_pow_numBits_le] <;> cases System.Platform.numBits_eq
+    <;> simp_all
 
-theorem ISize.toInt_neg_ofNat_of_le {n : Nat} (h : n ≤ 2 ^ 31) : toInt (-ofNat n) = -n := by
-  rw [← ofInt_eq_ofNat, neg_ofInt, toInt_ofInt (by omega) (by omega)]
+theorem Int8.iSizeMinValue_le_toInt (x : Int8) : ISize.minValue.toInt ≤ x.toInt :=
+  Int.le_trans (Int.le_trans ISize.toInt_minValue_le (by decide)) x.le_toInt
+theorem Int8.toInt_le_iSizeMaxValue (x : Int8) : x.toInt ≤ ISize.maxValue.toInt :=
+  Int.le_trans x.toInt_le (Int.le_trans (by decide) ISize.le_toInt_maxValue)
+theorem Int16.iSizeMinValue_le_toInt (x : Int16) : ISize.minValue.toInt ≤ x.toInt :=
+  Int.le_trans (Int.le_trans ISize.toInt_minValue_le (by decide)) x.le_toInt
+theorem Int16.toInt_le_iSizeMaxValue (x : Int16) : x.toInt ≤ ISize.maxValue.toInt :=
+  Int.le_trans x.toInt_le (Int.le_trans (by decide) ISize.le_toInt_maxValue)
+theorem Int32.iSizeMinValue_le_toInt (x : Int32) : ISize.minValue.toInt ≤ x.toInt :=
+  Int.le_trans (Int.le_trans ISize.toInt_minValue_le (by decide)) x.le_toInt
+theorem Int32.toInt_le_iSizeMaxValue (x : Int32) : x.toInt ≤ ISize.maxValue.toInt :=
+  Int.le_trans x.toInt_le (Int.le_trans (by decide) ISize.le_toInt_maxValue)
+
+theorem ISize.int64MinValue_le_toInt (x : ISize) : Int64.minValue.toInt ≤ x.toInt :=
+  Int.le_trans (by decide) x.le_toInt
+theorem ISize.toInt_le_int64MaxValue (x : ISize) : x.toInt ≤ Int64.maxValue.toInt :=
+  Int.le_of_lt_add_one x.toInt_lt
+
+theorem Int8.toNatClampNeg_lt (x : Int8) : x.toNatClampNeg < 2 ^ 7 := (Int.toNat_lt' (by decide)).2 x.toInt_lt
+theorem Int16.toNatClampNeg_lt (x : Int16) : x.toNatClampNeg < 2 ^ 15 := (Int.toNat_lt' (by decide)).2 x.toInt_lt
+theorem Int32.toNatClampNeg_lt (x : Int32) : x.toNatClampNeg < 2 ^ 31 := (Int.toNat_lt' (by decide)).2 x.toInt_lt
+theorem Int64.toNatClampNeg_lt (x : Int64) : x.toNatClampNeg < 2 ^ 63 := (Int.toNat_lt' (by decide)).2 x.toInt_lt
+theorem ISize.toNatClampNeg_lt_two_pow_numBits (x : ISize) : x.toNatClampNeg < 2 ^ (System.Platform.numBits - 1) := by
+  rw [toNatClampNeg, Int.toNat_lt', Int.natCast_pow]
+  · exact x.toInt_lt_two_pow_numBits
+  · cases System.Platform.numBits_eq <;> simp_all
+theorem ISize.toNatClampNeg_lt (x : ISize) : x.toNatClampNeg < 2 ^ 63 := (Int.toNat_lt' (by decide)).2 x.toInt_lt
+
+@[simp] theorem Int8.toInt_toInt16 (x : Int8) : x.toInt16.toInt = x.toInt :=
+  x.toBitVec.toInt_signExtend_of_le (by decide)
+@[simp] theorem Int8.toInt_toInt32 (x : Int8) : x.toInt32.toInt = x.toInt :=
+  x.toBitVec.toInt_signExtend_of_le (by decide)
+@[simp] theorem Int8.toInt_toInt64 (x : Int8) : x.toInt64.toInt = x.toInt :=
+  x.toBitVec.toInt_signExtend_of_le (by decide)
+@[simp] theorem Int8.toInt_toISize (x : Int8) : x.toISize.toInt = x.toInt :=
+  x.toBitVec.toInt_signExtend_of_le (by cases System.Platform.numBits_eq <;> simp_all)
+
+@[simp] theorem Int16.toInt_toInt8 (x : Int16) : x.toInt8.toInt = x.toInt.bmod (2 ^ 8) :=
+  x.toBitVec.toInt_signExtend_eq_toInt_bmod_of_le (by decide)
+@[simp] theorem Int16.toInt_toInt32 (x : Int16) : x.toInt32.toInt = x.toInt :=
+  x.toBitVec.toInt_signExtend_of_le (by decide)
+@[simp] theorem Int16.toInt_toInt64 (x : Int16) : x.toInt64.toInt = x.toInt :=
+  x.toBitVec.toInt_signExtend_of_le (by decide)
+@[simp] theorem Int16.toInt_toISize (x : Int16) : x.toISize.toInt = x.toInt :=
+  x.toBitVec.toInt_signExtend_of_le (by cases System.Platform.numBits_eq <;> simp_all)
+
+@[simp] theorem Int32.toInt_toInt8 (x : Int32) : x.toInt8.toInt = x.toInt.bmod (2 ^ 8) :=
+  x.toBitVec.toInt_signExtend_eq_toInt_bmod_of_le (by decide)
+@[simp] theorem Int32.toInt_toInt16 (x : Int32) : x.toInt16.toInt = x.toInt.bmod (2 ^ 16) :=
+  x.toBitVec.toInt_signExtend_eq_toInt_bmod_of_le (by decide)
+@[simp] theorem Int32.toInt_toInt64 (x : Int32) : x.toInt64.toInt = x.toInt :=
+  x.toBitVec.toInt_signExtend_of_le (by decide)
+@[simp] theorem Int32.toInt_toISize (x : Int32) : x.toISize.toInt = x.toInt :=
+  x.toBitVec.toInt_signExtend_of_le (by cases System.Platform.numBits_eq <;> simp_all)
+
+@[simp] theorem Int64.toInt_toInt8 (x : Int64) : x.toInt8.toInt = x.toInt.bmod (2 ^ 8) :=
+  x.toBitVec.toInt_signExtend_eq_toInt_bmod_of_le (by decide)
+@[simp] theorem Int64.toInt_toInt16 (x : Int64) : x.toInt16.toInt = x.toInt.bmod (2 ^ 16) :=
+  x.toBitVec.toInt_signExtend_eq_toInt_bmod_of_le (by decide)
+@[simp] theorem Int64.toInt_toInt32 (x : Int64) : x.toInt32.toInt = x.toInt.bmod (2 ^ 32) :=
+  x.toBitVec.toInt_signExtend_eq_toInt_bmod_of_le (by decide)
+@[simp] theorem Int64.toInt_toISize (x : Int64) : x.toISize.toInt = x.toInt.bmod (2 ^ System.Platform.numBits) :=
+  x.toBitVec.toInt_signExtend_eq_toInt_bmod_of_le (by cases System.Platform.numBits_eq <;> simp_all)
+
+@[simp] theorem ISize.toInt_toInt8 (x : ISize) : x.toInt8.toInt = x.toInt.bmod (2 ^ 8) :=
+  x.toBitVec.toInt_signExtend_eq_toInt_bmod_of_le (by cases System.Platform.numBits_eq <;> simp_all)
+@[simp] theorem ISize.toInt_toInt16 (x : ISize) : x.toInt16.toInt = x.toInt.bmod (2 ^ 16) :=
+  x.toBitVec.toInt_signExtend_eq_toInt_bmod_of_le (by cases System.Platform.numBits_eq <;> simp_all)
+@[simp] theorem ISize.toInt_toInt32 (x : ISize) : x.toInt32.toInt = x.toInt.bmod (2 ^ 32) :=
+  x.toBitVec.toInt_signExtend_eq_toInt_bmod_of_le (by cases System.Platform.numBits_eq <;> simp_all)
+@[simp] theorem ISize.toInt_toInt64 (x : ISize) : x.toInt64.toInt = x.toInt :=
+  x.toBitVec.toInt_signExtend_of_le (by cases System.Platform.numBits_eq <;> simp_all)
+
+@[simp] theorem Int8.toNatClampNeg_toInt16 (x : Int8) : x.toInt16.toNatClampNeg = x.toNatClampNeg :=
+  congrArg Int.toNat x.toInt_toInt16
+@[simp] theorem Int8.toNatClampNeg_toInt32 (x : Int8) : x.toInt32.toNatClampNeg = x.toNatClampNeg :=
+  congrArg Int.toNat x.toInt_toInt32
+@[simp] theorem Int8.toNatClampNeg_toInt64 (x : Int8) : x.toInt64.toNatClampNeg = x.toNatClampNeg :=
+  congrArg Int.toNat x.toInt_toInt64
+@[simp] theorem Int8.toNatClampNeg_toISize (x : Int8) : x.toISize.toNatClampNeg = x.toNatClampNeg :=
+  congrArg Int.toNat x.toInt_toISize
+
+@[simp] theorem Int16.toNatClampNeg_toInt32 (x : Int16) : x.toInt32.toNatClampNeg = x.toNatClampNeg :=
+  congrArg Int.toNat x.toInt_toInt32
+@[simp] theorem Int16.toNatClampNeg_toInt64 (x : Int16) : x.toInt64.toNatClampNeg = x.toNatClampNeg :=
+  congrArg Int.toNat x.toInt_toInt64
+@[simp] theorem Int16.toNatClampNeg_toISize (x : Int16) : x.toISize.toNatClampNeg = x.toNatClampNeg :=
+  congrArg Int.toNat x.toInt_toISize
+
+@[simp] theorem Int32.toNatClampNeg_toInt64 (x : Int32) : x.toInt64.toNatClampNeg = x.toNatClampNeg :=
+  congrArg Int.toNat x.toInt_toInt64
+@[simp] theorem Int32.toNatClampNeg_toISize (x : Int32) : x.toISize.toNatClampNeg = x.toNatClampNeg :=
+  congrArg Int.toNat x.toInt_toISize
+
+@[simp] theorem ISize.toNatClampNeg_toInt64 (x : ISize) : x.toInt64.toNatClampNeg = x.toNatClampNeg :=
+  congrArg Int.toNat x.toInt_toInt64
+
+@[simp] theorem Int8.toInt8_toUInt8 (x : Int8) : x.toUInt8.toInt8 = x := rfl
+@[simp] theorem Int16.toInt16_toUInt16 (x : Int16) : x.toUInt16.toInt16 = x := rfl
+@[simp] theorem Int32.toInt32_toUInt32 (x : Int32) : x.toUInt32.toInt32 = x := rfl
+@[simp] theorem Int64.toInt64_toUInt64 (x : Int64) : x.toUInt64.toInt64 = x := rfl
+@[simp] theorem ISize.toISize_toUSize (x : ISize) : x.toUSize.toISize = x := rfl
+
+theorem Int8.toNat_toBitVec (x : Int8) : x.toBitVec.toNat = x.toUInt8.toNat := rfl
+theorem Int16.toNat_toBitVec (x : Int16) : x.toBitVec.toNat = x.toUInt16.toNat := rfl
+theorem Int32.toNat_toBitVec (x : Int32) : x.toBitVec.toNat = x.toUInt32.toNat := rfl
+theorem Int64.toNat_toBitVec (x : Int64) : x.toBitVec.toNat = x.toUInt64.toNat := rfl
+theorem ISize.toNat_toBitVec (x : ISize) : x.toBitVec.toNat = x.toUSize.toNat := rfl
+
+theorem Int8.toNat_toBitVec_of_le {x : Int8} (hx : 0 ≤ x) : x.toBitVec.toNat = x.toNatClampNeg :=
+  (x.toBitVec.toNat_toInt_of_sle hx).symm
+theorem Int16.toNat_toBitVec_of_le {x : Int16} (hx : 0 ≤ x) : x.toBitVec.toNat = x.toNatClampNeg :=
+  (x.toBitVec.toNat_toInt_of_sle hx).symm
+theorem Int32.toNat_toBitVec_of_le {x : Int32} (hx : 0 ≤ x) : x.toBitVec.toNat = x.toNatClampNeg :=
+  (x.toBitVec.toNat_toInt_of_sle hx).symm
+theorem Int64.toNat_toBitVec_of_le {x : Int64} (hx : 0 ≤ x) : x.toBitVec.toNat = x.toNatClampNeg :=
+  (x.toBitVec.toNat_toInt_of_sle hx).symm
+theorem ISize.toNat_toBitVec_of_le {x : ISize} (hx : 0 ≤ x) : x.toBitVec.toNat = x.toNatClampNeg :=
+  (x.toBitVec.toNat_toInt_of_sle hx).symm
+
+theorem Int8.toNat_toUInt8_of_le {x : Int8} (hx : 0 ≤ x) : x.toUInt8.toNat = x.toNatClampNeg := by
+  rw [← toNat_toBitVec, toNat_toBitVec_of_le hx]
+theorem Int16.toNat_toUInt16_of_le {x : Int16} (hx : 0 ≤ x) : x.toUInt16.toNat = x.toNatClampNeg := by
+  rw [← toNat_toBitVec, toNat_toBitVec_of_le hx]
+theorem Int32.toNat_toUInt32_of_le {x : Int32} (hx : 0 ≤ x) : x.toUInt32.toNat = x.toNatClampNeg := by
+  rw [← toNat_toBitVec, toNat_toBitVec_of_le hx]
+theorem Int64.toNat_toUInt64_of_le {x : Int64} (hx : 0 ≤ x) : x.toUInt64.toNat = x.toNatClampNeg := by
+  rw [← toNat_toBitVec, toNat_toBitVec_of_le hx]
+theorem ISize.toNat_toUISize_of_le {x : ISize} (hx : 0 ≤ x) : x.toUSize.toNat = x.toNatClampNeg := by
+  rw [← toNat_toBitVec, toNat_toBitVec_of_le hx]
+
+theorem Int8.toFin_toBitVec (x : Int8) : x.toBitVec.toFin = x.toUInt8.toFin := rfl
+theorem Int16.toFin_toBitVec (x : Int16) : x.toBitVec.toFin = x.toUInt16.toFin := rfl
+theorem Int32.toFin_toBitVec (x : Int32) : x.toBitVec.toFin = x.toUInt32.toFin := rfl
+theorem Int64.toFin_toBitVec (x : Int64) : x.toBitVec.toFin = x.toUInt64.toFin := rfl
+theorem ISize.toFin_toBitVec (x : ISize) : x.toBitVec.toFin = x.toUSize.toFin := rfl
+
+@[simp] theorem Int8.toBitVec_toUInt8 (x : Int8) : x.toUInt8.toBitVec = x.toBitVec := rfl
+@[simp] theorem Int16.toBitVec_toUInt16 (x : Int16) : x.toUInt16.toBitVec = x.toBitVec := rfl
+@[simp] theorem Int32.toBitVec_toUInt32 (x : Int32) : x.toUInt32.toBitVec = x.toBitVec := rfl
+@[simp] theorem Int64.toBitVec_toUInt64 (x : Int64) : x.toUInt64.toBitVec = x.toBitVec := rfl
+@[simp] theorem ISize.toBitVec_toUISize (x : ISize) : x.toUSize.toBitVec = x.toBitVec := rfl
+
+@[simp] theorem UInt8.ofBitVec_int8ToBitVec (x : Int8) : UInt8.ofBitVec x.toBitVec = x.toUInt8 := rfl
+@[simp] theorem UInt16.ofBitVec_int16ToBitVec (x : Int16) : UInt16.ofBitVec x.toBitVec = x.toUInt16 := rfl
+@[simp] theorem UInt32.ofBitVec_int32ToBitVec (x : Int32) : UInt32.ofBitVec x.toBitVec = x.toUInt32 := rfl
+@[simp] theorem UInt64.ofBitVec_int64ToBitVec (x : Int64) : UInt64.ofBitVec x.toBitVec = x.toUInt64 := rfl
+@[simp] theorem USize.ofBitVec_iSizeToBitVec (x : ISize) : USize.ofBitVec x.toBitVec = x.toUSize := rfl
+
+@[simp] theorem Int8.ofBitVec_toBitVec (x : Int8) : Int8.ofBitVec x.toBitVec = x := rfl
+@[simp] theorem Int16.ofBitVec_toBitVec (x : Int16) : Int16.ofBitVec x.toBitVec = x := rfl
+@[simp] theorem Int32.ofBitVec_toBitVec (x : Int32) : Int32.ofBitVec x.toBitVec = x := rfl
+@[simp] theorem Int64.ofBitVec_toBitVec (x : Int64) : Int64.ofBitVec x.toBitVec = x := rfl
+@[simp] theorem ISize.ofBitVec_toBitVec (x : ISize) : ISize.ofBitVec x.toBitVec = x := rfl
+
+@[simp] theorem Int8.ofBitVec_int16ToBitVec (x : Int16) : Int8.ofBitVec (x.toBitVec.signExtend 8) = x.toInt8 := rfl
+@[simp] theorem Int8.ofBitVec_int32ToBitVec (x : Int32) : Int8.ofBitVec (x.toBitVec.signExtend 8) = x.toInt8 := rfl
+@[simp] theorem Int8.ofBitVec_int64ToBitVec (x : Int64) : Int8.ofBitVec (x.toBitVec.signExtend 8) = x.toInt8 := rfl
+@[simp] theorem Int8.ofBitVec_iSizeToBitVec (x : ISize) : Int8.ofBitVec (x.toBitVec.signExtend 8) = x.toInt8 := rfl
+
+@[simp] theorem Int16.ofBitVec_int8toBitVec (x : Int8) : Int16.ofBitVec (x.toBitVec.signExtend 16) = x.toInt16 := rfl
+@[simp] theorem Int16.ofBitVec_int32ToBitVec (x : Int32) : Int16.ofBitVec (x.toBitVec.signExtend 16) = x.toInt16 := rfl
+@[simp] theorem Int16.ofBitVec_int64ToBitVec (x : Int64) : Int16.ofBitVec (x.toBitVec.signExtend 16) = x.toInt16 := rfl
+@[simp] theorem Int16.ofBitVec_iSizeToBitVec (x : ISize) : Int16.ofBitVec (x.toBitVec.signExtend 16) = x.toInt16 := rfl
+
+@[simp] theorem Int32.ofBitVec_int8toBitVec (x : Int8) : Int32.ofBitVec (x.toBitVec.signExtend 32) = x.toInt32 := rfl
+@[simp] theorem Int32.ofBitVec_int16ToBitVec (x : Int16) : Int32.ofBitVec (x.toBitVec.signExtend 32) = x.toInt32 := rfl
+@[simp] theorem Int32.ofBitVec_int64ToBitVec (x : Int64) : Int32.ofBitVec (x.toBitVec.signExtend 32) = x.toInt32 := rfl
+@[simp] theorem Int32.ofBitVec_iSizeToBitVec (x : ISize) : Int32.ofBitVec (x.toBitVec.signExtend 32) = x.toInt32 := rfl
+
+@[simp] theorem Int64.ofBitVec_int8toBitVec (x : Int8) : Int64.ofBitVec (x.toBitVec.signExtend 64) = x.toInt64 := rfl
+@[simp] theorem Int64.ofBitVec_int16ToBitVec (x : Int16) : Int64.ofBitVec (x.toBitVec.signExtend 64) = x.toInt64 := rfl
+@[simp] theorem Int64.ofBitVec_int32ToBitVec (x : Int32) : Int64.ofBitVec (x.toBitVec.signExtend 64) = x.toInt64 := rfl
+@[simp] theorem Int64.ofBitVec_iSizeToBitVec (x : ISize) : Int64.ofBitVec (x.toBitVec.signExtend 64) = x.toInt64 := rfl
+
+@[simp] theorem ISize.ofBitVec_int8toBitVec (x : Int8) : ISize.ofBitVec (x.toBitVec.signExtend System.Platform.numBits) = x.toISize := rfl
+@[simp] theorem ISize.ofBitVec_int16ToBitVec (x : Int16) : ISize.ofBitVec (x.toBitVec.signExtend System.Platform.numBits) = x.toISize := rfl
+@[simp] theorem ISize.ofBitVec_int32ToBitVec (x : Int32) : ISize.ofBitVec (x.toBitVec.signExtend System.Platform.numBits) = x.toISize := rfl
+@[simp] theorem ISize.ofBitVec_int64ToBitVec (x : Int64) : ISize.ofBitVec (x.toBitVec.signExtend System.Platform.numBits) = x.toISize := rfl
+
+@[simp] theorem Int8.toBitVec_ofIntLE (x : Int) (h₁ h₂) : (Int8.ofIntLE x h₁ h₂).toBitVec = BitVec.ofInt 8 x := rfl
+@[simp] theorem Int16.toBitVec_ofIntLE (x : Int) (h₁ h₂) : (Int16.ofIntLE x h₁ h₂).toBitVec = BitVec.ofInt 16 x := rfl
+@[simp] theorem Int32.toBitVec_ofIntLE (x : Int) (h₁ h₂) : (Int32.ofIntLE x h₁ h₂).toBitVec = BitVec.ofInt 32 x := rfl
+@[simp] theorem Int64.toBitVec_ofIntLE (x : Int) (h₁ h₂) : (Int64.ofIntLE x h₁ h₂).toBitVec = BitVec.ofInt 64 x := rfl
+@[simp] theorem ISize.toBitVec_ofIntLE (x : Int) (h₁ h₂) : (ISize.ofIntLE x h₁ h₂).toBitVec = BitVec.ofInt System.Platform.numBits x := rfl
+
+@[simp] theorem Int8.toInt_bmod (x : Int8) : x.toInt.bmod 256 = x.toInt := Int.bmod_eq_self_of_le x.le_toInt x.toInt_lt
+@[simp] theorem Int16.toInt_bmod (x : Int16) : x.toInt.bmod 65536 = x.toInt := Int.bmod_eq_self_of_le x.le_toInt x.toInt_lt
+@[simp] theorem Int32.toInt_bmod (x : Int32) : x.toInt.bmod 4294967296 = x.toInt := Int.bmod_eq_self_of_le x.le_toInt x.toInt_lt
+@[simp] theorem Int64.toInt_bmod (x : Int64) : x.toInt.bmod 18446744073709551616 = x.toInt := Int.bmod_eq_self_of_le x.le_toInt x.toInt_lt
+@[simp] theorem ISize.toInt_bmod_two_pow_numBits (x : ISize) : x.toInt.bmod (2 ^ System.Platform.numBits) = x.toInt := by
+  refine Int.bmod_eq_self_of_le ?_ ?_
+  · have := x.two_pow_numBits_le_toInt
+    cases System.Platform.numBits_eq <;> simp_all
+  · have := x.toInt_lt_two_pow_numBits
+    cases System.Platform.numBits_eq <;> simp_all
+
+@[simp] theorem Int8.toInt_bmod_65536 (x : Int8) : x.toInt.bmod 65536 = x.toInt :=
+  Int.bmod_eq_self_of_le (Int.le_trans (by decide) x.le_toInt) (Int.lt_of_lt_of_le x.toInt_lt (by decide))
+@[simp] theorem Int8.toInt_bmod_4294967296 (x : Int8) : x.toInt.bmod 4294967296 = x.toInt :=
+  Int.bmod_eq_self_of_le (Int.le_trans (by decide) x.le_toInt) (Int.lt_of_lt_of_le x.toInt_lt (by decide))
+@[simp] theorem Int16.toInt_bmod_4294967296 (x : Int16) : x.toInt.bmod 4294967296 = x.toInt :=
+  Int.bmod_eq_self_of_le (Int.le_trans (by decide) x.le_toInt) (Int.lt_of_lt_of_le x.toInt_lt (by decide))
+@[simp] theorem Int8.toInt_bmod_18446744073709551616 (x : Int8) : x.toInt.bmod 18446744073709551616 = x.toInt :=
+  Int.bmod_eq_self_of_le (Int.le_trans (by decide) x.le_toInt) (Int.lt_of_lt_of_le x.toInt_lt (by decide))
+@[simp] theorem Int16.toInt_bmod_18446744073709551616 (x : Int16) : x.toInt.bmod 18446744073709551616 = x.toInt :=
+  Int.bmod_eq_self_of_le (Int.le_trans (by decide) x.le_toInt) (Int.lt_of_lt_of_le x.toInt_lt (by decide))
+@[simp] theorem Int32.toInt_bmod_18446744073709551616 (x : Int32) : x.toInt.bmod 18446744073709551616 = x.toInt :=
+  Int.bmod_eq_self_of_le (Int.le_trans (by decide) x.le_toInt) (Int.lt_of_lt_of_le x.toInt_lt (by decide))
+@[simp] theorem ISize.toInt_bmod_18446744073709551616 (x : ISize) : x.toInt.bmod 18446744073709551616 = x.toInt :=
+  Int.bmod_eq_self_of_le x.le_toInt x.toInt_lt
+@[simp] theorem Int8.toInt_bmod_two_pow_numBits (x : Int8) : x.toInt.bmod (2 ^ System.Platform.numBits) = x.toInt := by
+  refine Int.bmod_eq_self_of_le (Int.le_trans ?_ x.iSizeMinValue_le_toInt)
+    (Int.lt_of_le_sub_one (Int.le_trans x.toInt_le_iSizeMaxValue ?_))
+  all_goals cases System.Platform.numBits_eq <;> simp_all
+@[simp] theorem Int16.toInt_bmod_two_pow_numBits (x : Int16) : x.toInt.bmod (2 ^ System.Platform.numBits) = x.toInt := by
+  refine Int.bmod_eq_self_of_le (Int.le_trans ?_ x.iSizeMinValue_le_toInt)
+    (Int.lt_of_le_sub_one (Int.le_trans x.toInt_le_iSizeMaxValue ?_))
+  all_goals cases System.Platform.numBits_eq <;> simp_all
+@[simp] theorem Int32.toInt_bmod_two_pow_numBits (x : Int32) : x.toInt.bmod (2 ^ System.Platform.numBits) = x.toInt := by
+  refine Int.bmod_eq_self_of_le (Int.le_trans ?_ x.iSizeMinValue_le_toInt)
+    (Int.lt_of_le_sub_one (Int.le_trans x.toInt_le_iSizeMaxValue ?_))
+  all_goals cases System.Platform.numBits_eq <;> simp_all
+
+@[simp] theorem BitVec.ofInt_int8ToInt (x : Int8) : BitVec.ofInt 8 x.toInt = x.toBitVec := BitVec.eq_of_toInt_eq (by simp)
+@[simp] theorem BitVec.ofInt_int16ToInt (x : Int16) : BitVec.ofInt 16 x.toInt = x.toBitVec := BitVec.eq_of_toInt_eq (by simp)
+@[simp] theorem BitVec.ofInt_int32ToInt (x : Int32) : BitVec.ofInt 32 x.toInt = x.toBitVec := BitVec.eq_of_toInt_eq (by simp)
+@[simp] theorem BitVec.ofInt_int64ToInt (x : Int64) : BitVec.ofInt 64 x.toInt = x.toBitVec := BitVec.eq_of_toInt_eq (by simp)
+@[simp] theorem BitVec.ofInt_iSizeToInt (x : ISize) : BitVec.ofInt System.Platform.numBits x.toInt = x.toBitVec :=
+  BitVec.eq_of_toInt_eq (by simp)
+
+@[simp] theorem Int8.ofIntLE_toInt (x : Int8) : Int8.ofIntLE x.toInt x.minValue_le_toInt x.toInt_le = x := Int8.toBitVec.inj (by simp)
+@[simp] theorem Int16.ofIntLE_toInt (x : Int16) : Int16.ofIntLE x.toInt x.minValue_le_toInt x.toInt_le = x := Int16.toBitVec.inj (by simp)
+@[simp] theorem Int32.ofIntLE_toInt (x : Int32) : Int32.ofIntLE x.toInt x.minValue_le_toInt x.toInt_le = x := Int32.toBitVec.inj (by simp)
+@[simp] theorem Int64.ofIntLE_toInt (x : Int64) : Int64.ofIntLE x.toInt x.minValue_le_toInt x.toInt_le = x := Int64.toBitVec.inj (by simp)
+@[simp] theorem ISize.ofIntLE_toInt (x : ISize) : ISize.ofIntLE x.toInt x.minValue_le_toInt x.toInt_le = x := ISize.toBitVec.inj (by simp)
+
+theorem Int8.ofIntLE_int16ToInt (x : Int16) {h₁ h₂} : Int8.ofIntLE x.toInt h₁ h₂ = x.toInt8 := rfl
+theorem Int8.ofIntLE_int32ToInt (x : Int32) {h₁ h₂} : Int8.ofIntLE x.toInt h₁ h₂ = x.toInt8 := rfl
+theorem Int8.ofIntLE_int64ToInt (x : Int64) {h₁ h₂} : Int8.ofIntLE x.toInt h₁ h₂ = x.toInt8 := rfl
+theorem Int8.ofIntLE_iSizeToInt (x : ISize) {h₁ h₂} : Int8.ofIntLE x.toInt h₁ h₂ = x.toInt8 := rfl
+
+@[simp] theorem Int16.ofIntLE_int8ToInt (x : Int8) :
+    Int16.ofIntLE x.toInt (Int.le_trans (by decide) x.minValue_le_toInt) (Int.le_trans x.toInt_le (by decide)) = x.toInt16 := rfl
+theorem Int16.ofIntLE_int32ToInt (x : Int32) {h₁ h₂} : Int16.ofIntLE x.toInt h₁ h₂ = x.toInt16 := rfl
+theorem Int16.ofIntLE_int64ToInt (x : Int64) {h₁ h₂} : Int16.ofIntLE x.toInt h₁ h₂ = x.toInt16 := rfl
+theorem Int16.ofIntLE_iSizeToInt (x : ISize) {h₁ h₂} : Int16.ofIntLE x.toInt h₁ h₂ = x.toInt16 := rfl
+
+@[simp] theorem Int32.ofIntLE_int8ToInt (x : Int8) :
+    Int32.ofIntLE x.toInt (Int.le_trans (by decide) x.minValue_le_toInt) (Int.le_trans x.toInt_le (by decide)) = x.toInt32 := rfl
+@[simp] theorem Int32.ofIntLE_int16ToInt (x : Int16) :
+    Int32.ofIntLE x.toInt (Int.le_trans (by decide) x.minValue_le_toInt) (Int.le_trans x.toInt_le (by decide)) = x.toInt32 := rfl
+theorem Int32.ofIntLE_int64ToInt (x : Int64) {h₁ h₂} : Int32.ofIntLE x.toInt h₁ h₂ = x.toInt32 := rfl
+theorem Int32.ofIntLE_iSizeToInt (x : ISize) {h₁ h₂} : Int32.ofIntLE x.toInt h₁ h₂ = x.toInt32 := rfl
+
+@[simp] theorem Int64.ofIntLE_int8ToInt (x : Int8) :
+    Int64.ofIntLE x.toInt (Int.le_trans (by decide) x.minValue_le_toInt) (Int.le_trans x.toInt_le (by decide)) = x.toInt64 := rfl
+@[simp] theorem Int64.ofIntLE_int16ToInt (x : Int16) :
+    Int64.ofIntLE x.toInt (Int.le_trans (by decide) x.minValue_le_toInt) (Int.le_trans x.toInt_le (by decide)) = x.toInt64 := rfl
+@[simp] theorem Int64.ofIntLE_int32ToInt (x : Int32) :
+    Int64.ofIntLE x.toInt (Int.le_trans (by decide) x.minValue_le_toInt) (Int.le_trans x.toInt_le (by decide)) = x.toInt64 := rfl
+@[simp] theorem Int64.ofIntLE_iSizeToInt (x : ISize) :
+    Int64.ofIntLE x.toInt x.int64MinValue_le_toInt x.toInt_le_int64MaxValue = x.toInt64 := rfl
+
+@[simp] theorem ISize.ofIntLE_int8ToInt (x : Int8) :
+    ISize.ofIntLE x.toInt x.iSizeMinValue_le_toInt x.toInt_le_iSizeMaxValue = x.toISize := rfl
+@[simp] theorem ISize.ofIntLE_int16ToInt (x : Int16) :
+    ISize.ofIntLE x.toInt x.iSizeMinValue_le_toInt x.toInt_le_iSizeMaxValue = x.toISize := rfl
+@[simp] theorem ISize.ofIntLE_int32ToInt (x : Int32) :
+    ISize.ofIntLE x.toInt x.iSizeMinValue_le_toInt x.toInt_le_iSizeMaxValue = x.toISize := rfl
+theorem ISize.ofIntLE_int64ToInt (x : Int64) {h₁ h₂} : ISize.ofIntLE x.toInt h₁ h₂ = x.toISize := rfl
+
+@[simp] theorem Int8.ofInt_toInt (x : Int8) : Int8.ofInt x.toInt = x := Int8.toBitVec.inj (by simp)
+@[simp] theorem Int16.ofInt_toInt (x : Int16) : Int16.ofInt x.toInt = x := Int16.toBitVec.inj (by simp)
+@[simp] theorem Int32.ofInt_toInt (x : Int32) : Int32.ofInt x.toInt = x := Int32.toBitVec.inj (by simp)
+@[simp] theorem Int64.ofInt_toInt (x : Int64) : Int64.ofInt x.toInt = x := Int64.toBitVec.inj (by simp)
+@[simp] theorem ISize.ofInt_toInt (x : ISize) : ISize.ofInt x.toInt = x := ISize.toBitVec.inj (by simp)
+
+@[simp] theorem Int8.ofInt_int16ToInt (x : Int16) : Int8.ofInt x.toInt = x.toInt8 := rfl
+@[simp] theorem Int8.ofInt_int32ToInt (x : Int32) : Int8.ofInt x.toInt = x.toInt8 := rfl
+@[simp] theorem Int8.ofInt_int64ToInt (x : Int64) : Int8.ofInt x.toInt = x.toInt8 := rfl
+@[simp] theorem Int8.ofInt_iSizeToInt (x : ISize) : Int8.ofInt x.toInt = x.toInt8 := rfl
+
+@[simp] theorem Int16.ofInt_int8ToInt (x : Int8) : Int16.ofInt x.toInt = x.toInt16 := rfl
+@[simp] theorem Int16.ofInt_int32ToInt (x : Int32) : Int16.ofInt x.toInt = x.toInt16 := rfl
+@[simp] theorem Int16.ofInt_int64ToInt (x : Int64) : Int16.ofInt x.toInt = x.toInt16 := rfl
+@[simp] theorem Int16.ofInt_iSizeToInt (x : ISize) : Int16.ofInt x.toInt = x.toInt16 := rfl
+
+@[simp] theorem Int32.ofInt_int8ToInt (x : Int8) : Int32.ofInt x.toInt = x.toInt32 := rfl
+@[simp] theorem Int32.ofInt_int16ToInt (x : Int16) : Int32.ofInt x.toInt = x.toInt32 := rfl
+@[simp] theorem Int32.ofInt_int64ToInt (x : Int64) : Int32.ofInt x.toInt = x.toInt32 := rfl
+@[simp] theorem Int32.ofInt_iSizeToInt (x : ISize) : Int32.ofInt x.toInt = x.toInt32 := rfl
+
+@[simp] theorem Int64.ofInt_int8ToInt (x : Int8) : Int64.ofInt x.toInt = x.toInt64 := rfl
+@[simp] theorem Int64.ofInt_int16ToInt (x : Int16) : Int64.ofInt x.toInt = x.toInt64 := rfl
+@[simp] theorem Int64.ofInt_int32ToInt (x : Int32) : Int64.ofInt x.toInt = x.toInt64 := rfl
+@[simp] theorem Int64.ofInt_iSizeToInt (x : ISize) : Int64.ofInt x.toInt = x.toInt64 := rfl
+
+@[simp] theorem ISize.ofInt_int8ToInt (x : Int8) : ISize.ofInt x.toInt = x.toISize := rfl
+@[simp] theorem ISize.ofInt_int16ToInt (x : Int16) : ISize.ofInt x.toInt = x.toISize := rfl
+@[simp] theorem ISize.ofInt_int32ToInt (x : Int32) : ISize.ofInt x.toInt = x.toISize := rfl
+@[simp] theorem ISize.ofInt_int64ToInt (x : Int64) : ISize.ofInt x.toInt = x.toISize := rfl
+
+@[simp] theorem Int8.toInt_ofIntLE {x : Int} {h₁ h₂} : (ofIntLE x h₁ h₂).toInt = x := by
+  rw [ofIntLE, toInt_ofInt h₁ (Int.lt_of_le_sub_one h₂)]
+@[simp] theorem Int16.toInt_ofIntLE {x : Int} {h₁ h₂} : (ofIntLE x h₁ h₂).toInt = x := by
+  rw [ofIntLE, toInt_ofInt h₁ (Int.lt_of_le_sub_one h₂)]
+@[simp] theorem Int32.toInt_ofIntLE {x : Int} {h₁ h₂} : (ofIntLE x h₁ h₂).toInt = x := by
+  rw [ofIntLE, toInt_ofInt h₁ (Int.lt_of_le_sub_one h₂)]
+@[simp] theorem Int64.toInt_ofIntLE {x : Int} {h₁ h₂} : (ofIntLE x h₁ h₂).toInt = x := by
+  rw [ofIntLE, toInt_ofInt h₁ (Int.lt_of_le_sub_one h₂)]
+@[simp] theorem ISize.toInt_ofIntLE {x : Int} {h₁ h₂} : (ofIntLE x h₁ h₂).toInt = x := by
+  rw [ofIntLE, toInt_ofInt_of_two_pow_numBits_le]
+  · simpa using h₁
+  · apply Int.lt_of_le_sub_one
+    simpa using h₂
+
+theorem Int8.ofIntLE_eq_ofIntTruncate {x : Int} {h₁ h₂} : (ofIntLE x h₁ h₂) = ofIntTruncate x := by
+  rw [ofIntTruncate, dif_pos h₁, dif_pos h₂]
+theorem Int16.ofIntLE_eq_ofIntTruncate {x : Int} {h₁ h₂} : (ofIntLE x h₁ h₂) = ofIntTruncate x := by
+  rw [ofIntTruncate, dif_pos h₁, dif_pos h₂]
+theorem Int32.ofIntLE_eq_ofIntTruncate {x : Int} {h₁ h₂} : (ofIntLE x h₁ h₂) = ofIntTruncate x := by
+  rw [ofIntTruncate, dif_pos h₁, dif_pos h₂]
+theorem Int64.ofIntLE_eq_ofIntTruncate {x : Int} {h₁ h₂} : (ofIntLE x h₁ h₂) = ofIntTruncate x := by
+  rw [ofIntTruncate, dif_pos h₁, dif_pos h₂]
+theorem ISize.ofIntLE_eq_ofIntTruncate {x : Int} {h₁ h₂} : (ofIntLE x h₁ h₂) = ofIntTruncate x := by
+  rw [ofIntTruncate, dif_pos h₁, dif_pos h₂]
+
+theorem Int8.toInt_ofIntTruncate {x : Int} (h₁ : Int8.minValue.toInt ≤ x)
+    (h₂ : x ≤ Int8.maxValue.toInt) : (Int8.ofIntTruncate x).toInt = x := by
+  rw [← ofIntLE_eq_ofIntTruncate (h₁ := h₁) (h₂ := h₂), toInt_ofIntLE]
+theorem Int16.toInt_ofIntTruncate {x : Int} (h₁ : Int16.minValue.toInt ≤ x)
+    (h₂ : x ≤ Int16.maxValue.toInt) : (Int16.ofIntTruncate x).toInt = x := by
+  rw [← ofIntLE_eq_ofIntTruncate (h₁ := h₁) (h₂ := h₂), toInt_ofIntLE]
+theorem Int32.toInt_ofIntTruncate {x : Int} (h₁ : Int32.minValue.toInt ≤ x)
+    (h₂ : x ≤ Int32.maxValue.toInt) : (Int32.ofIntTruncate x).toInt = x := by
+  rw [← ofIntLE_eq_ofIntTruncate (h₁ := h₁) (h₂ := h₂), toInt_ofIntLE]
+theorem Int64.toInt_ofIntTruncate {x : Int} (h₁ : Int64.minValue.toInt ≤ x)
+    (h₂ : x ≤ Int64.maxValue.toInt) : (Int64.ofIntTruncate x).toInt = x := by
+  rw [← ofIntLE_eq_ofIntTruncate (h₁ := h₁) (h₂ := h₂), toInt_ofIntLE]
+theorem ISize.toInt_ofIntTruncate {x : Int} (h₁ : ISize.minValue.toInt ≤ x)
+    (h₂ : x ≤ ISize.maxValue.toInt) : (ISize.ofIntTruncate x).toInt = x := by
+  rw [← ofIntLE_eq_ofIntTruncate (h₁ := h₁) (h₂ := h₂), toInt_ofIntLE]
+
+@[simp] theorem Int8.ofIntTruncate_toInt (x : Int8) : Int8.ofIntTruncate x.toInt = x :=
+  Int8.toInt.inj (toInt_ofIntTruncate x.minValue_le_toInt x.toInt_le)
+@[simp] theorem Int16.ofIntTruncate_toInt (x : Int16) : Int16.ofIntTruncate x.toInt = x :=
+  Int16.toInt.inj (toInt_ofIntTruncate x.minValue_le_toInt x.toInt_le)
+@[simp] theorem Int32.ofIntTruncate_toInt (x : Int32) : Int32.ofIntTruncate x.toInt = x :=
+  Int32.toInt.inj (toInt_ofIntTruncate x.minValue_le_toInt x.toInt_le)
+@[simp] theorem Int64.ofIntTruncate_toInt (x : Int64) : Int64.ofIntTruncate x.toInt = x :=
+  Int64.toInt.inj (toInt_ofIntTruncate x.minValue_le_toInt x.toInt_le)
+@[simp] theorem ISize.ofIntTruncate_toInt (x : ISize) : ISize.ofIntTruncate x.toInt = x :=
+  ISize.toInt.inj (toInt_ofIntTruncate x.minValue_le_toInt x.toInt_le)
+
+@[simp] theorem Int16.ofIntTruncate_int8ToInt (x : Int8) : Int16.ofIntTruncate x.toInt = x.toInt16 :=
+  Int16.toInt.inj (by
+    rw [toInt_ofIntTruncate, Int8.toInt_toInt16]
+    · exact Int.le_trans (by decide) x.minValue_le_toInt
+    · exact Int.le_trans x.toInt_le (by decide))
+@[simp] theorem Int32.ofIntTruncate_int8ToInt (x : Int8) : Int32.ofIntTruncate x.toInt = x.toInt32 :=
+  Int32.toInt.inj (by
+    rw [toInt_ofIntTruncate, Int8.toInt_toInt32]
+    · exact Int.le_trans (by decide) x.minValue_le_toInt
+    · exact Int.le_trans x.toInt_le (by decide))
+@[simp] theorem Int64.ofIntTruncate_int8ToInt (x : Int8) : Int64.ofIntTruncate x.toInt = x.toInt64 :=
+  Int64.toInt.inj (by
+    rw [toInt_ofIntTruncate, Int8.toInt_toInt64]
+    · exact Int.le_trans (by decide) x.minValue_le_toInt
+    · exact Int.le_trans x.toInt_le (by decide))
+@[simp] theorem ISize.ofIntTruncate_int8ToInt (x : Int8) : ISize.ofIntTruncate x.toInt = x.toISize :=
+  ISize.toInt.inj (by
+    rw [toInt_ofIntTruncate, Int8.toInt_toISize]
+    · exact x.iSizeMinValue_le_toInt
+    · exact x.toInt_le_iSizeMaxValue)
+
+@[simp] theorem Int32.ofIntTruncate_int16ToInt (x : Int16) : Int32.ofIntTruncate x.toInt = x.toInt32 :=
+  Int32.toInt.inj (by
+    rw [toInt_ofIntTruncate, Int16.toInt_toInt32]
+    · exact Int.le_trans (by decide) x.minValue_le_toInt
+    · exact Int.le_trans x.toInt_le (by decide))
+@[simp] theorem Int64.ofIntTruncate_int16ToInt (x : Int16) : Int64.ofIntTruncate x.toInt = x.toInt64 :=
+  Int64.toInt.inj (by
+    rw [toInt_ofIntTruncate, Int16.toInt_toInt64]
+    · exact Int.le_trans (by decide) x.minValue_le_toInt
+    · exact Int.le_trans x.toInt_le (by decide))
+@[simp] theorem ISize.ofIntTruncate_int16ToInt (x : Int16) : ISize.ofIntTruncate x.toInt = x.toISize :=
+  ISize.toInt.inj (by
+    rw [toInt_ofIntTruncate, Int16.toInt_toISize]
+    · exact x.iSizeMinValue_le_toInt
+    · exact x.toInt_le_iSizeMaxValue)
+
+@[simp] theorem Int64.ofIntTruncate_int32ToInt (x : Int32) : Int64.ofIntTruncate x.toInt = x.toInt64 :=
+  Int64.toInt.inj (by
+    rw [toInt_ofIntTruncate, Int32.toInt_toInt64]
+    · exact Int.le_trans (by decide) x.minValue_le_toInt
+    · exact Int.le_trans x.toInt_le (by decide))
+@[simp] theorem ISize.ofIntTruncate_int32ToInt (x : Int32) : ISize.ofIntTruncate x.toInt = x.toISize :=
+  ISize.toInt.inj (by
+    rw [toInt_ofIntTruncate, Int32.toInt_toISize]
+    · exact x.iSizeMinValue_le_toInt
+    · exact x.toInt_le_iSizeMaxValue)
+
+@[simp] theorem Int64.ofIntTruncate_iSizeToInt (x : ISize) : Int64.ofIntTruncate x.toInt = x.toInt64 :=
+  Int64.toInt.inj (by
+    rw [toInt_ofIntTruncate, ISize.toInt_toInt64]
+    · exact x.int64MinValue_le_toInt
+    · exact x.toInt_le_int64MaxValue)
+
+theorem Int8.le_iff_toInt_le {x y : Int8} : x ≤ y ↔ x.toInt ≤ y.toInt := BitVec.sle_iff_toInt_le
+theorem Int16.le_iff_toInt_le {x y : Int16} : x ≤ y ↔ x.toInt ≤ y.toInt := BitVec.sle_iff_toInt_le
+theorem Int32.le_iff_toInt_le {x y : Int32} : x ≤ y ↔ x.toInt ≤ y.toInt := BitVec.sle_iff_toInt_le
+theorem Int64.le_iff_toInt_le {x y : Int64} : x ≤ y ↔ x.toInt ≤ y.toInt := BitVec.sle_iff_toInt_le
+theorem ISize.le_iff_toInt_le {x y : ISize} : x ≤ y ↔ x.toInt ≤ y.toInt := BitVec.sle_iff_toInt_le
+
+theorem Int8.cast_toNatClampNeg (x : Int8) (hx : 0 ≤ x) : x.toNatClampNeg = x.toInt := by
+  rw [toNatClampNeg, toInt, Int.toNat_of_nonneg (by simpa using le_iff_toInt_le.1 hx)]
+theorem Int16.cast_toNatClampNeg (x : Int16) (hx : 0 ≤ x) : x.toNatClampNeg = x.toInt := by
+  rw [toNatClampNeg, toInt, Int.toNat_of_nonneg (by simpa using le_iff_toInt_le.1 hx)]
+theorem Int32.cast_toNatClampNeg (x : Int32) (hx : 0 ≤ x) : x.toNatClampNeg = x.toInt := by
+  rw [toNatClampNeg, toInt, Int.toNat_of_nonneg (by simpa using le_iff_toInt_le.1 hx)]
+theorem Int64.cast_toNatClampNeg (x : Int64) (hx : 0 ≤ x) : x.toNatClampNeg = x.toInt := by
+  rw [toNatClampNeg, toInt, Int.toNat_of_nonneg (by simpa using le_iff_toInt_le.1 hx)]
+theorem ISize.cast_toNatClampNeg (x : ISize) (hx : 0 ≤ x) : x.toNatClampNeg = x.toInt := by
+  rw [toNatClampNeg, toInt, Int.toNat_of_nonneg (by simpa using le_iff_toInt_le.1 hx)]
+
+theorem Int8.ofNat_toNatClampNeg (x : Int8) (hx : 0 ≤ x) : Int8.ofNat x.toNatClampNeg = x :=
+  Int8.toInt.inj (by rw [Int8.toInt_ofNat_of_lt x.toNatClampNeg_lt, cast_toNatClampNeg _ hx])
+theorem Int16.ofNat_toNatClampNeg (x : Int16) (hx : 0 ≤ x) : Int16.ofNat x.toNatClampNeg = x :=
+  Int16.toInt.inj (by rw [Int16.toInt_ofNat_of_lt x.toNatClampNeg_lt, cast_toNatClampNeg _ hx])
+theorem Int32.ofNat_toNatClampNeg (x : Int32) (hx : 0 ≤ x) : Int32.ofNat x.toNatClampNeg = x :=
+  Int32.toInt.inj (by rw [Int32.toInt_ofNat_of_lt x.toNatClampNeg_lt, cast_toNatClampNeg _ hx])
+theorem Int64.ofNat_toNatClampNeg (x : Int64) (hx : 0 ≤ x) : Int64.ofNat x.toNatClampNeg = x :=
+  Int64.toInt.inj (by rw [Int64.toInt_ofNat_of_lt x.toNatClampNeg_lt, cast_toNatClampNeg _ hx])
+theorem ISize.ofNat_toNatClampNeg (x : ISize) (hx : 0 ≤ x) : ISize.ofNat x.toNatClampNeg = x :=
+  ISize.toInt.inj (by rw [ISize.toInt_ofNat_of_lt_two_pow_numBits x.toNatClampNeg_lt_two_pow_numBits,
+    cast_toNatClampNeg _ hx])
+
+theorem Int16.ofNat_int8ToNatClampNeg (x : Int8) (hx : 0 ≤ x) : Int16.ofNat x.toNatClampNeg = x.toInt16 :=
+  Int16.toInt.inj (by rw [Int16.toInt_ofNat_of_lt (Nat.lt_of_lt_of_le x.toNatClampNeg_lt (by decide)),
+    Int8.cast_toNatClampNeg _ hx, Int8.toInt_toInt16])
+theorem Int32.ofNat_int8ToNatClampNeg (x : Int8) (hx : 0 ≤ x) : Int32.ofNat x.toNatClampNeg = x.toInt32 :=
+  Int32.toInt.inj (by rw [Int32.toInt_ofNat_of_lt (Nat.lt_of_lt_of_le x.toNatClampNeg_lt (by decide)),
+    Int8.cast_toNatClampNeg _ hx, Int8.toInt_toInt32])
+theorem Int64.ofNat_int8ToNatClampNeg (x : Int8) (hx : 0 ≤ x) : Int64.ofNat x.toNatClampNeg = x.toInt64 :=
+  Int64.toInt.inj (by rw [Int64.toInt_ofNat_of_lt (Nat.lt_of_lt_of_le x.toNatClampNeg_lt (by decide)),
+    Int8.cast_toNatClampNeg _ hx, Int8.toInt_toInt64])
+theorem ISize.ofNat_int8ToNatClampNeg (x : Int8) (hx : 0 ≤ x) : ISize.ofNat x.toNatClampNeg = x.toISize :=
+  ISize.toInt.inj (by rw [ISize.toInt_ofNat_of_lt (Nat.lt_of_lt_of_le x.toNatClampNeg_lt (by decide)),
+    Int8.cast_toNatClampNeg _ hx, Int8.toInt_toISize])
+
+theorem Int32.ofNat_int16ToNatClampNeg (x : Int16) (hx : 0 ≤ x) : Int32.ofNat x.toNatClampNeg = x.toInt32 :=
+  Int32.toInt.inj (by rw [Int32.toInt_ofNat_of_lt (Nat.lt_of_lt_of_le x.toNatClampNeg_lt (by decide)),
+    Int16.cast_toNatClampNeg _ hx, Int16.toInt_toInt32])
+theorem Int64.ofNat_int16ToNatClampNeg (x : Int16) (hx : 0 ≤ x) : Int64.ofNat x.toNatClampNeg = x.toInt64 :=
+  Int64.toInt.inj (by rw [Int64.toInt_ofNat_of_lt (Nat.lt_of_lt_of_le x.toNatClampNeg_lt (by decide)),
+    Int16.cast_toNatClampNeg _ hx, Int16.toInt_toInt64])
+theorem ISize.ofNat_int16ToNatClampNeg (x : Int16) (hx : 0 ≤ x) : ISize.ofNat x.toNatClampNeg = x.toISize :=
+  ISize.toInt.inj (by rw [ISize.toInt_ofNat_of_lt (Nat.lt_of_lt_of_le x.toNatClampNeg_lt (by decide)),
+    Int16.cast_toNatClampNeg _ hx, Int16.toInt_toISize])
+
+theorem Int64.ofNat_int32ToNatClampNeg (x : Int32) (hx : 0 ≤ x) : Int64.ofNat x.toNatClampNeg = x.toInt64 :=
+  Int64.toInt.inj (by rw [Int64.toInt_ofNat_of_lt (Nat.lt_of_lt_of_le x.toNatClampNeg_lt (by decide)),
+    Int32.cast_toNatClampNeg _ hx, Int32.toInt_toInt64])
+theorem ISize.ofNat_int32ToNatClampNeg (x : Int32) (hx : 0 ≤ x) : ISize.ofNat x.toNatClampNeg = x.toISize :=
+  ISize.toInt.inj (by rw [ISize.toInt_ofNat_of_lt (Nat.lt_of_lt_of_le x.toNatClampNeg_lt (by decide)),
+    Int32.cast_toNatClampNeg _ hx, Int32.toInt_toISize])
+
+@[simp] theorem Int8.toInt8_toInt16 (n : Int8) : n.toInt16.toInt8 = n :=
+  Int8.toInt.inj (by simp)
+@[simp] theorem Int8.toInt8_toInt32 (n : Int8) : n.toInt32.toInt8 = n :=
+  Int8.toInt.inj (by simp)
+@[simp] theorem Int8.toInt8_toInt64 (n : Int8) : n.toInt64.toInt8 = n :=
+  Int8.toInt.inj (by simp)
+@[simp] theorem Int8.toInt8_toISize (n : Int8) : n.toISize.toInt8 = n :=
+  Int8.toInt.inj (by simp)
+
+@[simp] theorem Int8.toInt16_toInt32 (n : Int8) : n.toInt32.toInt16 = n.toInt16 :=
+  Int16.toInt.inj (by simp)
+@[simp] theorem Int8.toInt16_toInt64 (n : Int8) : n.toInt64.toInt16 = n.toInt16 :=
+  Int16.toInt.inj (by simp)
+@[simp] theorem Int8.toInt16_toISize (n : Int8) : n.toISize.toInt16 = n.toInt16 :=
+  Int16.toInt.inj (by simp)
+
+@[simp] theorem Int8.toInt32_toInt16 (n : Int8) : n.toInt16.toInt32 = n.toInt32 :=
+  Int32.toInt.inj (by simp)
+@[simp] theorem Int8.toInt32_toInt64 (n : Int8) : n.toInt64.toInt32 = n.toInt32 :=
+  Int32.toInt.inj (by simp)
+@[simp] theorem Int8.toInt32_toISize (n : Int8) : n.toISize.toInt32 = n.toInt32 :=
+  Int32.toInt.inj (by simp)
+
+@[simp] theorem Int8.toInt64_toInt16 (n : Int8) : n.toInt16.toInt64 = n.toInt64 :=
+  Int64.toInt.inj (by simp)
+@[simp] theorem Int8.toInt64_toInt32 (n : Int8) : n.toInt32.toInt64 = n.toInt64 :=
+  Int64.toInt.inj (by simp)
+@[simp] theorem Int8.toInt64_toISize (n : Int8) : n.toISize.toInt64 = n.toInt64 :=
+  Int64.toInt.inj (by simp)
+
+@[simp] theorem Int8.toISize_toInt16 (n : Int8) : n.toInt16.toISize = n.toISize :=
+  ISize.toInt.inj (by simp)
+@[simp] theorem Int8.toISize_toInt32 (n : Int8) : n.toInt32.toISize = n.toISize :=
+  ISize.toInt.inj (by simp)
+@[simp] theorem Int8.toISize_toInt64 (n : Int8) : n.toInt64.toISize = n.toISize :=
+  ISize.toInt.inj (by simp)
+
+@[simp] theorem Int16.toInt8_toInt32 (n : Int16) : n.toInt32.toInt8 = n.toInt8 :=
+  Int8.toInt.inj (by simp)
+@[simp] theorem Int16.toInt8_toInt64 (n : Int16) : n.toInt64.toInt8 = n.toInt8 :=
+  Int8.toInt.inj (by simp)
+@[simp] theorem Int16.toInt8_toISize (n : Int16) : n.toISize.toInt8 = n.toInt8 :=
+  Int8.toInt.inj (by simp)
+
+@[simp] theorem Int16.toInt16_toInt32 (n : Int16) : n.toInt32.toInt16 = n :=
+  Int16.toInt.inj (by simp)
+@[simp] theorem Int16.toInt16_toInt64 (n : Int16) : n.toInt64.toInt16 = n :=
+  Int16.toInt.inj (by simp)
+@[simp] theorem Int16.toInt16_toISize (n : Int16) : n.toISize.toInt16 = n :=
+  Int16.toInt.inj (by simp)
+
+@[simp] theorem Int16.toInt32_toInt64 (n : Int16) : n.toInt64.toInt32 = n.toInt32 :=
+  Int32.toInt.inj (by simp)
+@[simp] theorem Int16.toInt32_toISize (n : Int16) : n.toISize.toInt32 = n.toInt32 :=
+  Int32.toInt.inj (by simp)
+
+@[simp] theorem Int16.toInt64_toInt32 (n : Int16) : n.toInt32.toInt64 = n.toInt64 :=
+  Int64.toInt.inj (by simp)
+@[simp] theorem Int16.toInt64_toISize (n : Int16) : n.toISize.toInt64 = n.toInt64 :=
+  Int64.toInt.inj (by simp)
+
+@[simp] theorem Int16.toISize_toInt32 (n : Int16) : n.toInt32.toISize = n.toISize :=
+  ISize.toInt.inj (by simp)
+@[simp] theorem Int16.toISize_toInt64 (n : Int16) : n.toInt64.toISize = n.toISize :=
+  ISize.toInt.inj (by simp)
+
+@[simp] theorem Int32.toInt8_toInt16 (n : Int32) : n.toInt16.toInt8 = n.toInt8 :=
+  Int8.toInt.inj (by simpa using Int.bmod_bmod_of_dvd (by decide))
+@[simp] theorem Int32.toInt8_toInt64 (n : Int32) : n.toInt64.toInt8 = n.toInt8 :=
+  Int8.toInt.inj (by simp)
+@[simp] theorem Int32.toInt8_toISize (n : Int32) : n.toISize.toInt8 = n.toInt8 :=
+  Int8.toInt.inj (by simp)
+
+@[simp] theorem Int32.toInt16_toInt64 (n : Int32) : n.toInt64.toInt16 = n.toInt16 :=
+  Int16.toInt.inj (by simp)
+@[simp] theorem Int32.toInt16_toISize (n : Int32) : n.toISize.toInt16 = n.toInt16 :=
+  Int16.toInt.inj (by simp)
+
+@[simp] theorem Int32.toInt32_toInt64 (n : Int32) : n.toInt64.toInt32 = n :=
+  Int32.toInt.inj (by simp)
+@[simp] theorem Int32.toInt32_toISize (n : Int32) : n.toISize.toInt32 = n :=
+  Int32.toInt.inj (by simp)
+
+@[simp] theorem Int32.toInt64_toISize (n : Int32) : n.toISize.toInt64 = n.toInt64 :=
+  Int64.toInt.inj (by simp)
+
+@[simp] theorem Int32.toISize_toInt64 (n : Int32) : n.toInt64.toISize = n.toISize :=
+  ISize.toInt.inj (by simp)
+
+@[simp] theorem Int64.toInt8_toInt16 (n : Int64) : n.toInt16.toInt8 = n.toInt8 :=
+  Int8.toInt.inj (by simpa using Int.bmod_bmod_of_dvd (by decide))
+@[simp] theorem Int64.toInt8_toInt32 (n : Int64) : n.toInt32.toInt8 = n.toInt8 :=
+  Int8.toInt.inj (by simpa using Int.bmod_bmod_of_dvd (by decide))
+@[simp] theorem Int64.toInt8_toISize (n : Int64) : n.toISize.toInt8 = n.toInt8 :=
+  Int8.toInt.inj (by simpa using Int.bmod_bmod_of_dvd (by cases System.Platform.numBits_eq <;> simp_all))
+
+@[simp] theorem Int64.toInt16_toInt32 (n : Int64) : n.toInt32.toInt16 = n.toInt16 :=
+  Int16.toInt.inj (by simpa using Int.bmod_bmod_of_dvd (by decide))
+@[simp] theorem Int64.toInt16_toISize (n : Int64) : n.toISize.toInt16 = n.toInt16 :=
+  Int16.toInt.inj (by simpa using Int.bmod_bmod_of_dvd (by cases System.Platform.numBits_eq <;> simp_all))
+
+@[simp] theorem Int64.toInt32_toISize (n : Int64) : n.toISize.toInt32 = n.toInt32 :=
+  Int32.toInt.inj (by simpa using Int.bmod_bmod_of_dvd (by cases System.Platform.numBits_eq <;> simp_all))
+
+@[simp] theorem ISize.toInt8_toInt16 (n : ISize) : n.toInt16.toInt8 = n.toInt8 :=
+  Int8.toInt.inj (by simpa using Int.bmod_bmod_of_dvd (by decide))
+@[simp] theorem ISize.toInt8_toInt32 (n : ISize) : n.toInt32.toInt8 = n.toInt8 :=
+  Int8.toInt.inj (by simpa using Int.bmod_bmod_of_dvd (by decide))
+@[simp] theorem ISize.toInt8_toInt64 (n : ISize) : n.toInt64.toInt8 = n.toInt8 :=
+  Int8.toInt.inj (by simp)
+
+@[simp] theorem ISize.toInt16_toInt32 (n : ISize) : n.toInt32.toInt16 = n.toInt16 :=
+  Int16.toInt.inj (by simpa using Int.bmod_bmod_of_dvd (by decide))
+@[simp] theorem ISize.toInt16_toInt64 (n : ISize) : n.toInt64.toInt16 = n.toInt16 :=
+  Int16.toInt.inj (by simp)
+
+@[simp] theorem ISize.toInt32_toInt64 (n : ISize) : n.toInt64.toInt32 = n.toInt32 :=
+  Int32.toInt.inj (by simp)
+
+@[simp] theorem ISize.toISize_toInt64 (n : ISize) : n.toInt64.toISize = n :=
+  ISize.toInt.inj (by simp)
+
+theorem UInt8.toInt8_ofNatLT {n : Nat} (hn) : (UInt8.ofNatLT n hn).toInt8 = Int8.ofNat n :=
+  Int8.toBitVec.inj (by simp [BitVec.ofNatLT_eq_ofNat])
+theorem UInt16.toInt16_ofNatLT {n : Nat} (hn) : (UInt16.ofNatLT n hn).toInt16 = Int16.ofNat n :=
+  Int16.toBitVec.inj (by simp [BitVec.ofNatLT_eq_ofNat])
+theorem UInt32.toInt32_ofNatLT {n : Nat} (hn) : (UInt32.ofNatLT n hn).toInt32 = Int32.ofNat n :=
+  Int32.toBitVec.inj (by simp [BitVec.ofNatLT_eq_ofNat])
+theorem UInt64.toInt64_ofNatLT {n : Nat} (hn) : (UInt64.ofNatLT n hn).toInt64 = Int64.ofNat n :=
+  Int64.toBitVec.inj (by simp [BitVec.ofNatLT_eq_ofNat])
+theorem USize.toISize_ofNatLT {n : Nat} (hn) : (USize.ofNatLT n hn).toISize = ISize.ofNat n :=
+  ISize.toBitVec.inj (by simp [BitVec.ofNatLT_eq_ofNat])
+
+@[simp] theorem UInt8.toInt8_ofNat' {n : Nat} : (UInt8.ofNat n).toInt8 = Int8.ofNat n := rfl
+@[simp] theorem UInt16.toInt16_ofNat' {n : Nat} : (UInt16.ofNat n).toInt16 = Int16.ofNat n := rfl
+@[simp] theorem UInt32.toInt32_ofNat' {n : Nat} : (UInt32.ofNat n).toInt32 = Int32.ofNat n := rfl
+@[simp] theorem UInt64.toInt64_ofNat' {n : Nat} : (UInt64.ofNat n).toInt64 = Int64.ofNat n := rfl
+@[simp] theorem USize.toISize_ofNat' {n : Nat} : (USize.ofNat n).toISize = ISize.ofNat n := rfl
+
+@[simp] theorem UInt8.toInt8_ofNat {n : Nat} : toInt8 (no_index (OfNat.ofNat n)) = OfNat.ofNat n := rfl
+@[simp] theorem UInt16.toInt16_ofNat {n : Nat} : toInt16 (no_index (OfNat.ofNat n)) = OfNat.ofNat n := rfl
+@[simp] theorem UInt32.toInt32_ofNat {n : Nat} : toInt32 (no_index (OfNat.ofNat n)) = OfNat.ofNat n := rfl
+@[simp] theorem UInt64.toInt64_ofNat {n : Nat} : toInt64 (no_index (OfNat.ofNat n)) = OfNat.ofNat n := rfl
+@[simp] theorem USize.toISize_ofNat {n : Nat} : toISize (no_index (OfNat.ofNat n)) = OfNat.ofNat n := rfl
+
+@[simp] theorem UInt8.toInt8_ofBitVec (b) : (UInt8.ofBitVec b).toInt8 = Int8.ofBitVec b := rfl
+@[simp] theorem UInt16.toInt16_ofBitVec (b) : (UInt16.ofBitVec b).toInt16 = Int16.ofBitVec b := rfl
+@[simp] theorem UInt32.toInt32_ofBitVec (b) : (UInt32.ofBitVec b).toInt32 = Int32.ofBitVec b := rfl
+@[simp] theorem UInt64.toInt64_ofBitVec (b) : (UInt64.ofBitVec b).toInt64 = Int64.ofBitVec b := rfl
+@[simp] theorem USize.toInt8_ofBitVec (b) : (USize.ofBitVec b).toISize = ISize.ofBitVec b := rfl

src/Init/Data/UInt/Lemmas.lean

@@ -1,7 +1,7 @@
 /-
 Copyright (c) 2024 Amazon.com, Inc. or its affiliates. All Rights Reserved.
 Released under Apache 2.0 license as described in the file LICENSE.
-Authors: Leonardo de Moura, François G. Dorais, Mario Carneiro, Mac Malone
+Authors: Leonardo de Moura, François G. Dorais, Mario Carneiro, Mac Malone, Markus Himmel
 -/
 prelude
 import Init.Data.UInt.Basic
@@ -27,7 +27,10 @@ macro "declare_uint_theorems" typeName:ident bits:term:arg : command => do
   @[deprecated toNat_ofBitVec (since := "2025-02-12")]
   theorem toNat_mk : (ofBitVec a).toNat = a.toNat := rfl
 
-  @[simp] theorem toNat_ofNat {n : Nat} : (ofNat n).toNat = n % 2 ^ $bits := BitVec.toNat_ofNat ..
+  @[simp] theorem toNat_ofNat' {n : Nat} : (ofNat n).toNat = n % 2 ^ $bits := BitVec.toNat_ofNat ..
+
+  -- Not `simp` because we have simprocs which will avoid the modulo.
+  theorem toNat_ofNat {n : Nat} : toNat (no_index (OfNat.ofNat n)) = n % 2 ^ $bits := toNat_ofNat'
 
   @[simp] theorem toNat_ofNatLT {n : Nat} {h : n < size} : (ofNatLT n h).toNat = n := BitVec.toNat_ofNatLT ..
 
@@ -55,11 +58,16 @@ macro "declare_uint_theorems" typeName:ident bits:term:arg : command => do
   theorem mk_toBitVec_eq : ∀ (a : $typeName), ofBitVec a.toBitVec = a
     | ⟨_, _⟩ => rfl
 
+  @[deprecated "Use `toNat_toBitVec` and `toNat_ofNat_of_lt`." (since := "2025-03-05")]
   theorem toBitVec_eq_of_lt {a : Nat} : a < size → (ofNat a).toBitVec.toNat = a :=
     Nat.mod_eq_of_lt
 
-  theorem toNat_ofNat_of_lt {n : Nat} (h : n < size) : (ofNat n).toNat = n := by
-    rw [toNat, toBitVec_eq_of_lt h]
+  theorem toBitVec_ofNat' (n : Nat) : (ofNat n).toBitVec = BitVec.ofNat _ n := rfl
+
+  theorem toNat_ofNat_of_lt' {n : Nat} (h : n < size) : (ofNat n).toNat = n := by
+    rw [toNat, toBitVec_ofNat', BitVec.toNat_ofNat, Nat.mod_eq_of_lt h]
+  theorem toNat_ofNat_of_lt {n : Nat} (h : n < size) : toNat (OfNat.ofNat n) = n :=
+    toNat_ofNat_of_lt' h
 
   @[int_toBitVec] theorem le_def {a b : $typeName} : a ≤ b ↔ a.toBitVec ≤ b.toBitVec := .rfl
 
@@ -151,10 +159,10 @@ macro "declare_uint_theorems" typeName:ident bits:term:arg : command => do
   protected theorem toNat_lt_size (a : $typeName) : a.toNat < size := a.toBitVec.isLt
 
   open $typeName (toNat_mod toNat_lt_size) in
-  protected theorem toNat_mod_lt {m : Nat} : ∀ (u : $typeName), m > 0 → toNat (u % ofNat m) < m := by
+  protected theorem toNat_mod_lt {m : Nat} : ∀ (u : $typeName), 0 < m → toNat (u % ofNat m) < m := by
     intro u h1
     by_cases h2 : m < size
-    · rw [toNat_mod, toNat_ofNat_of_lt h2]
+    · rw [toNat_mod, toNat_ofNat_of_lt' h2]
       apply Nat.mod_lt _ h1
     · apply Nat.lt_of_lt_of_le
       · apply toNat_lt_size
@@ -258,16 +266,20 @@ theorem USize.toNat_ofNat_of_lt_32 {n : Nat} (h : n < 4294967296) : toNat (ofNat
   toNat_ofNat_of_lt (Nat.lt_of_lt_of_le h USize.le_size)
 
 theorem UInt32.toNat_lt_of_lt {n : UInt32} {m : Nat} (h : m < size) : n < ofNat m → n.toNat < m := by
-  simp [-toNat_toBitVec, lt_def, BitVec.lt_def, UInt32.toNat, toBitVec_eq_of_lt h]
+  rw [lt_def, BitVec.lt_def, toNat_toBitVec, toNat_toBitVec, toNat_ofNat_of_lt' h]
+  exact id
 
 theorem UInt32.lt_toNat_of_lt {n : UInt32} {m : Nat} (h : m < size) : ofNat m < n → m < n.toNat := by
-  simp [-toNat_toBitVec, lt_def, BitVec.lt_def, UInt32.toNat, toBitVec_eq_of_lt h]
+  rw [lt_def, BitVec.lt_def, toNat_toBitVec, toNat_toBitVec, toNat_ofNat_of_lt' h]
+  exact id
 
 theorem UInt32.toNat_le_of_le {n : UInt32} {m : Nat} (h : m < size) : n ≤ ofNat m → n.toNat ≤ m := by
-  simp [-toNat_toBitVec, le_def, BitVec.le_def, UInt32.toNat, toBitVec_eq_of_lt h]
+  rw [le_def, BitVec.le_def, toNat_toBitVec, toNat_toBitVec, toNat_ofNat_of_lt' h]
+  exact id
 
 theorem UInt32.le_toNat_of_le {n : UInt32} {m : Nat} (h : m < size) : ofNat m ≤ n → m ≤ n.toNat := by
-  simp [-toNat_toBitVec, le_def, BitVec.le_def, UInt32.toNat, toBitVec_eq_of_lt h]
+  rw [le_def, BitVec.le_def, toNat_toBitVec, toNat_toBitVec, toNat_ofNat_of_lt' h]
+  exact id
 
 @[simp] theorem UInt8.toNat_lt (n : UInt8) : n.toNat < 2 ^ 8 := n.toFin.isLt
 @[simp] theorem UInt16.toNat_lt (n : UInt16) : n.toNat < 2 ^ 16 := n.toFin.isLt
@@ -311,6 +323,15 @@ theorem USize.size_dvd_uInt64Size : USize.size ∣ UInt64.size := by cases USize
 @[simp] theorem mod_uInt64Size_uSizeSize (n : Nat) : n % UInt64.size % USize.size = n % USize.size :=
   Nat.mod_mod_of_dvd _ USize.size_dvd_uInt64Size
 
+@[simp] theorem USize.size_sub_one_mod_uint8Size : (USize.size - 1) % UInt8.size = UInt8.size - 1 := by
+  cases USize.size_eq <;> simp_all +decide
+@[simp] theorem USize.size_sub_one_mod_uint16Size : (USize.size - 1) % UInt16.size = UInt16.size - 1 := by
+  cases USize.size_eq <;> simp_all +decide
+@[simp] theorem USize.size_sub_one_mod_uint32Size : (USize.size - 1) % UInt32.size = UInt32.size - 1 := by
+  cases USize.size_eq <;> simp_all +decide
+@[simp] theorem UInt64.size_sub_one_mod_uSizeSize : 18446744073709551615 % USize.size = USize.size - 1 := by
+  cases USize.size_eq <;> simp_all +decide
+
 @[simp] theorem UInt8.toNat_mod_size (n : UInt8) : n.toNat % UInt8.size = n.toNat := Nat.mod_eq_of_lt n.toNat_lt
 @[simp] theorem UInt8.toNat_mod_uInt16Size (n : UInt8) : n.toNat % UInt16.size = n.toNat := Nat.mod_eq_of_lt (Nat.lt_trans n.toNat_lt (by decide))
 @[simp] theorem UInt8.toNat_mod_uInt32Size (n : UInt8) : n.toNat % UInt32.size = n.toNat := Nat.mod_eq_of_lt (Nat.lt_trans n.toNat_lt (by decide))
@@ -785,3 +806,402 @@ theorem USize.ofNatTruncate_eq_ofNat (n : Nat) (hn : n < USize.size) :
 -- @[simp] theorem UInt64.toUSize_toUInt32 (n : UInt64) : n.toUInt32.toUSize = ? :=
 -- @[simp] theorem USize.toUInt64_toUInt32 (n : USize) : n.toUInt32.toUInt64 = ? :=
 -- @[simp] theorem USize.toUSize_toUInt32 (n : USize) : n.toInt32.toUSize = ? :=
+
+@[simp] theorem UInt8.toNat_ofFin (x : Fin UInt8.size) : (UInt8.ofFin x).toNat = x.val := rfl
+@[simp] theorem UInt16.toNat_ofFin (x : Fin UInt16.size) : (UInt16.ofFin x).toNat = x.val := rfl
+@[simp] theorem UInt32.toNat_ofFin (x : Fin UInt32.size) : (UInt32.ofFin x).toNat = x.val := rfl
+@[simp] theorem UInt64.toNat_ofFin (x : Fin UInt64.size) : (UInt64.ofFin x).toNat = x.val := rfl
+@[simp] theorem USize.toNat_ofFin (x : Fin USize.size) : (USize.ofFin x).toNat = x.val := rfl
+
+theorem UInt8.toNat_ofNatTruncate_of_lt {n : Nat} (hn : n < UInt8.size) :
+    (UInt8.ofNatTruncate n).toNat = n := by rw [UInt8.ofNatTruncate, dif_pos hn, toNat_ofNatLT]
+theorem UInt16.toNat_ofNatTruncate_of_lt {n : Nat} (hn : n < UInt16.size) :
+    (UInt16.ofNatTruncate n).toNat = n := by rw [UInt16.ofNatTruncate, dif_pos hn, toNat_ofNatLT]
+theorem UInt32.toNat_ofNatTruncate_of_lt {n : Nat} (hn : n < UInt32.size) :
+    (UInt32.ofNatTruncate n).toNat = n := by rw [UInt32.ofNatTruncate, dif_pos hn, toNat_ofNatLT]
+theorem UInt64.toNat_ofNatTruncate_of_lt {n : Nat} (hn : n < UInt64.size) :
+    (UInt64.ofNatTruncate n).toNat = n := by rw [UInt64.ofNatTruncate, dif_pos hn, toNat_ofNatLT]
+theorem USize.toNat_ofNatTruncate_of_lt {n : Nat} (hn : n < USize.size) :
+    (USize.ofNatTruncate n).toNat = n := by rw [USize.ofNatTruncate, dif_pos hn, toNat_ofNatLT]
+
+theorem UInt8.toNat_ofNatTruncate_of_le {n : Nat} (hn : UInt8.size ≤ n) :
+    (UInt8.ofNatTruncate n).toNat = UInt8.size - 1 := by rw [ofNatTruncate, dif_neg (by omega), toNat_ofNatLT]
+theorem UInt16.toNat_ofNatTruncate_of_le {n : Nat} (hn : UInt16.size ≤ n) :
+    (UInt16.ofNatTruncate n).toNat = UInt16.size - 1 := by rw [ofNatTruncate, dif_neg (by omega), toNat_ofNatLT]
+theorem UInt32.toNat_ofNatTruncate_of_le {n : Nat} (hn : UInt32.size ≤ n) :
+    (UInt32.ofNatTruncate n).toNat = UInt32.size - 1 := by rw [ofNatTruncate, dif_neg (by omega), toNat_ofNatLT]
+theorem UInt64.toNat_ofNatTruncate_of_le {n : Nat} (hn : UInt64.size ≤ n) :
+    (UInt64.ofNatTruncate n).toNat = UInt64.size - 1 := by rw [ofNatTruncate, dif_neg (by omega), toNat_ofNatLT]
+theorem USize.toNat_ofNatTruncate_of_le {n : Nat} (hn : USize.size ≤ n) :
+    (USize.ofNatTruncate n).toNat = USize.size - 1 := by rw [ofNatTruncate, dif_neg (by omega), toNat_ofNatLT]
+
+@[simp] theorem UInt8.toFin_ofNatLT {n : Nat} (hn) : (UInt8.ofNatLT n hn).toFin = ⟨n, hn⟩ := rfl
+@[simp] theorem UInt16.toFin_ofNatLT {n : Nat} (hn) : (UInt16.ofNatLT n hn).toFin = ⟨n, hn⟩ := rfl
+@[simp] theorem UInt32.toFin_ofNatLT {n : Nat} (hn) : (UInt32.ofNatLT n hn).toFin = ⟨n, hn⟩ := rfl
+@[simp] theorem UInt64.toFin_ofNatLT {n : Nat} (hn) : (UInt64.ofNatLT n hn).toFin = ⟨n, hn⟩ := rfl
+@[simp] theorem USize.toFin_ofNatLT {n : Nat} (hn) : (USize.ofNatLT n hn).toFin = ⟨n, hn⟩ := rfl
+
+@[simp] theorem UInt8.toFin_ofNat' {n : Nat} : (UInt8.ofNat n).toFin = Fin.ofNat' _ n := rfl
+@[simp] theorem UInt16.toFin_ofNat' {n : Nat} : (UInt16.ofNat n).toFin = Fin.ofNat' _ n := rfl
+@[simp] theorem UInt32.toFin_ofNat' {n : Nat} : (UInt32.ofNat n).toFin = Fin.ofNat' _ n := rfl
+@[simp] theorem UInt64.toFin_ofNat' {n : Nat} : (UInt64.ofNat n).toFin = Fin.ofNat' _ n := rfl
+@[simp] theorem USize.toFin_ofNat' {n : Nat} : (USize.ofNat n).toFin = Fin.ofNat' _ n := rfl
+
+@[simp] theorem UInt8.toFin_ofBitVec {b} : (UInt8.ofBitVec b).toFin = b.toFin := rfl
+@[simp] theorem UInt16.toFin_ofBitVec {b} : (UInt16.ofBitVec b).toFin = b.toFin := rfl
+@[simp] theorem UInt32.toFin_ofBitVec {b} : (UInt32.ofBitVec b).toFin = b.toFin := rfl
+@[simp] theorem UInt64.toFin_ofBitVec {b} : (UInt64.ofBitVec b).toFin = b.toFin := rfl
+@[simp] theorem USize.toFin_ofBitVec {b} : (USize.ofBitVec b).toFin = b.toFin := rfl
+
+theorem UInt8.toFin_ofNatTruncate_of_lt {n : Nat} (hn : n < UInt8.size) :
+    (UInt8.ofNatTruncate n).toFin = ⟨n, hn⟩ :=
+  Fin.val_inj.1 (by simp [toNat_ofNatTruncate_of_lt hn])
+theorem UInt16.toFin_ofNatTruncate_of_lt {n : Nat} (hn : n < UInt16.size) :
+    (UInt16.ofNatTruncate n).toFin = ⟨n, hn⟩ :=
+  Fin.val_inj.1 (by simp [toNat_ofNatTruncate_of_lt hn])
+theorem UInt32.toFin_ofNatTruncate_of_lt {n : Nat} (hn : n < UInt32.size) :
+    (UInt32.ofNatTruncate n).toFin = ⟨n, hn⟩ :=
+  Fin.val_inj.1 (by simp [toNat_ofNatTruncate_of_lt hn])
+theorem UInt64.toFin_ofNatTruncate_of_lt {n : Nat} (hn : n < UInt64.size) :
+    (UInt64.ofNatTruncate n).toFin = ⟨n, hn⟩ :=
+  Fin.val_inj.1 (by simp [toNat_ofNatTruncate_of_lt hn])
+theorem USize.toFin_ofNatTruncate_of_lt {n : Nat} (hn : n < USize.size) :
+    (USize.ofNatTruncate n).toFin = ⟨n, hn⟩ :=
+  Fin.val_inj.1 (by simp [toNat_ofNatTruncate_of_lt hn])
+
+theorem UInt8.toFin_ofNatTruncate_of_le {n : Nat} (hn : UInt8.size ≤ n) :
+    (UInt8.ofNatTruncate n).toFin = ⟨UInt8.size - 1, by decide⟩ :=
+  Fin.val_inj.1 (by simp [toNat_ofNatTruncate_of_le hn])
+theorem UInt16.toFin_ofNatTruncate_of_le {n : Nat} (hn : UInt16.size ≤ n) :
+    (UInt16.ofNatTruncate n).toFin = ⟨UInt16.size - 1, by decide⟩ :=
+  Fin.val_inj.1 (by simp [toNat_ofNatTruncate_of_le hn])
+theorem UInt32.toFin_ofNatTruncate_of_le {n : Nat} (hn : UInt32.size ≤ n) :
+    (UInt32.ofNatTruncate n).toFin = ⟨UInt32.size - 1, by decide⟩ :=
+  Fin.val_inj.1 (by simp [toNat_ofNatTruncate_of_le hn])
+theorem UInt64.toFin_ofNatTruncate_of_le {n : Nat} (hn : UInt64.size ≤ n) :
+    (UInt64.ofNatTruncate n).toFin = ⟨UInt64.size - 1, by decide⟩ :=
+  Fin.val_inj.1 (by simp [toNat_ofNatTruncate_of_le hn])
+theorem USize.toFin_ofNatTruncate_of_le {n : Nat} (hn : USize.size ≤ n) :
+    (USize.ofNatTruncate n).toFin = ⟨USize.size - 1, by cases USize.size_eq <;> simp_all⟩ :=
+  Fin.val_inj.1 (by simp [toNat_ofNatTruncate_of_le hn])
+
+@[simp] theorem UInt8.toBitVec_ofNatLT {n : Nat} (hn : n < UInt8.size) :
+    (UInt8.ofNatLT n hn).toBitVec = BitVec.ofNatLT n hn := rfl
+@[simp] theorem UInt16.toBitVec_ofNatLT {n : Nat} (hn : n < UInt16.size) :
+    (UInt16.ofNatLT n hn).toBitVec = BitVec.ofNatLT n hn := rfl
+@[simp] theorem UInt32.toBitVec_ofNatLT {n : Nat} (hn : n < UInt32.size) :
+    (UInt32.ofNatLT n hn).toBitVec = BitVec.ofNatLT n hn := rfl
+@[simp] theorem UInt64.toBitVec_ofNatLT {n : Nat} (hn : n < UInt64.size) :
+    (UInt64.ofNatLT n hn).toBitVec = BitVec.ofNatLT n hn := rfl
+@[simp] theorem USize.toBitVec_ofNatLT {n : Nat} (hn : n < USize.size) :
+    (USize.ofNatLT n hn).toBitVec = BitVec.ofNatLT n hn := rfl
+
+@[simp] theorem UInt8.toBitVec_ofFin (n : Fin UInt8.size) : (UInt8.ofFin n).toBitVec = BitVec.ofFin n := rfl
+@[simp] theorem UInt16.toBitVec_ofFin (n : Fin UInt16.size) : (UInt16.ofFin n).toBitVec = BitVec.ofFin n := rfl
+@[simp] theorem UInt32.toBitVec_ofFin (n : Fin UInt32.size) : (UInt32.ofFin n).toBitVec = BitVec.ofFin n := rfl
+@[simp] theorem UInt64.toBitVec_ofFin (n : Fin UInt64.size) : (UInt64.ofFin n).toBitVec = BitVec.ofFin n := rfl
+@[simp] theorem USize.toBitVec_ofFin (n : Fin USize.size) : (USize.ofFin n).toBitVec = BitVec.ofFin n := rfl
+
+@[simp] theorem UInt8.toBitVec_ofBitVec (n) : (UInt8.ofBitVec n).toBitVec = n := rfl
+@[simp] theorem UInt16.toBitVec_ofBitVec (n) : (UInt16.ofBitVec n).toBitVec = n := rfl
+@[simp] theorem UInt32.toBitVec_ofBitVec (n) : (UInt32.ofBitVec n).toBitVec = n := rfl
+@[simp] theorem UInt64.toBitVec_ofBitVec (n) : (UInt64.ofBitVec n).toBitVec = n := rfl
+@[simp] theorem USize.toBitVec_ofBitVec (n) : (USize.ofBitVec n).toBitVec = n := rfl
+
+theorem UInt8.toBitVec_ofNatTruncate_of_lt {n : Nat} (hn : n < UInt8.size) :
+    (UInt8.ofNatTruncate n).toBitVec = BitVec.ofNatLT n hn :=
+  BitVec.eq_of_toNat_eq (by simp [toNat_ofNatTruncate_of_lt hn])
+theorem UInt16.toBitVec_ofNatTruncate_of_lt {n : Nat} (hn : n < UInt16.size) :
+    (UInt16.ofNatTruncate n).toBitVec = BitVec.ofNatLT n hn :=
+  BitVec.eq_of_toNat_eq (by simp [toNat_ofNatTruncate_of_lt hn])
+theorem UInt32.toBitVec_ofNatTruncate_of_lt {n : Nat} (hn : n < UInt32.size) :
+    (UInt32.ofNatTruncate n).toBitVec = BitVec.ofNatLT n hn :=
+  BitVec.eq_of_toNat_eq (by simp [toNat_ofNatTruncate_of_lt hn])
+theorem UInt64.toBitVec_ofNatTruncate_of_lt {n : Nat} (hn : n < UInt64.size) :
+    (UInt64.ofNatTruncate n).toBitVec = BitVec.ofNatLT n hn :=
+  BitVec.eq_of_toNat_eq (by simp [toNat_ofNatTruncate_of_lt hn])
+theorem USize.toBitVec_ofNatTruncate_of_lt {n : Nat} (hn : n < USize.size) :
+    (USize.ofNatTruncate n).toBitVec = BitVec.ofNatLT n hn :=
+  BitVec.eq_of_toNat_eq (by simp [toNat_ofNatTruncate_of_lt hn])
+
+theorem UInt8.toBitVec_ofNatTruncate_of_le {n : Nat} (hn : UInt8.size ≤ n) :
+    (UInt8.ofNatTruncate n).toBitVec = BitVec.ofNatLT (UInt8.size - 1) (by decide) :=
+  BitVec.eq_of_toNat_eq (by simp [toNat_ofNatTruncate_of_le hn])
+theorem UInt16.toBitVec_ofNatTruncate_of_le {n : Nat} (hn : UInt16.size ≤ n) :
+    (UInt16.ofNatTruncate n).toBitVec = BitVec.ofNatLT (UInt16.size - 1) (by decide) :=
+  BitVec.eq_of_toNat_eq (by simp [toNat_ofNatTruncate_of_le hn])
+theorem UInt32.toBitVec_ofNatTruncate_of_le {n : Nat} (hn : UInt32.size ≤ n) :
+    (UInt32.ofNatTruncate n).toBitVec = BitVec.ofNatLT (UInt32.size - 1) (by decide) :=
+  BitVec.eq_of_toNat_eq (by simp [toNat_ofNatTruncate_of_le hn])
+theorem UInt64.toBitVec_ofNatTruncate_of_le {n : Nat} (hn : UInt64.size ≤ n) :
+    (UInt64.ofNatTruncate n).toBitVec = BitVec.ofNatLT (UInt64.size - 1) (by decide) :=
+  BitVec.eq_of_toNat_eq (by simp [toNat_ofNatTruncate_of_le hn])
+theorem USize.toBitVec_ofNatTruncate_of_le {n : Nat} (hn : USize.size ≤ n) :
+    (USize.ofNatTruncate n).toBitVec = BitVec.ofNatLT (USize.size - 1) (by cases USize.size_eq <;> simp_all) :=
+  BitVec.eq_of_toNat_eq (by simp [toNat_ofNatTruncate_of_le hn])
+
+@[simp] theorem UInt16.toUInt8_ofNatLT {n : Nat} (hn) : (UInt16.ofNatLT n hn).toUInt8 = UInt8.ofNat n := rfl
+@[simp] theorem UInt32.toUInt8_ofNatLT {n : Nat} (hn) : (UInt32.ofNatLT n hn).toUInt8 = UInt8.ofNat n := rfl
+@[simp] theorem UInt64.toUInt8_ofNatLT {n : Nat} (hn) : (UInt64.ofNatLT n hn).toUInt8 = UInt8.ofNat n := rfl
+@[simp] theorem USize.toUInt8_ofNatLT {n : Nat} (hn) : (USize.ofNatLT n hn).toUInt8 = UInt8.ofNat n := rfl
+
+@[simp] theorem UInt16.toUInt8_ofFin (n) : (UInt16.ofFin n).toUInt8 = UInt8.ofNat n.val := rfl
+@[simp] theorem UInt32.toUInt8_ofFin (n) : (UInt32.ofFin n).toUInt8 = UInt8.ofNat n.val := rfl
+@[simp] theorem UInt64.toUInt8_ofFin (n) : (UInt64.ofFin n).toUInt8 = UInt8.ofNat n.val := rfl
+@[simp] theorem USize.toUInt8_ofFin (n) : (USize.ofFin n).toUInt8 = UInt8.ofNat n.val := rfl
+
+@[simp] theorem UInt16.toUInt8_ofBitVec (b) : (UInt16.ofBitVec b).toUInt8 = UInt8.ofBitVec (b.setWidth _) := rfl
+@[simp] theorem UInt32.toUInt8_ofBitVec (b) : (UInt32.ofBitVec b).toUInt8 = UInt8.ofBitVec (b.setWidth _) := rfl
+@[simp] theorem UInt64.toUInt8_ofBitVec (b) : (UInt64.ofBitVec b).toUInt8 = UInt8.ofBitVec (b.setWidth _) := rfl
+@[simp] theorem USize.toUInt8_ofBitVec (b) : (USize.ofBitVec b).toUInt8 = UInt8.ofBitVec (b.setWidth _) :=
+  UInt8.toNat.inj (by simp)
+
+@[simp] theorem UInt16.toUInt8_ofNat' (n : Nat) : (UInt16.ofNat n).toUInt8 = UInt8.ofNat n := UInt8.toNat.inj (by simp)
+@[simp] theorem UInt32.toUInt8_ofNat' (n : Nat) : (UInt32.ofNat n).toUInt8 = UInt8.ofNat n := UInt8.toNat.inj (by simp)
+@[simp] theorem UInt64.toUInt8_ofNat' (n : Nat) : (UInt64.ofNat n).toUInt8 = UInt8.ofNat n := UInt8.toNat.inj (by simp)
+@[simp] theorem USize.toUInt8_ofNat' (n : Nat) : (USize.ofNat n).toUInt8 = UInt8.ofNat n := UInt8.toNat.inj (by simp)
+
+@[simp] theorem UInt16.toUInt8_ofNat {n : Nat} : toUInt8 (no_index (OfNat.ofNat n)) = OfNat.ofNat n := toUInt8_ofNat' _
+@[simp] theorem UInt32.toUInt8_ofNat {n : Nat} : toUInt8 (no_index (OfNat.ofNat n)) = OfNat.ofNat n := toUInt8_ofNat' _
+@[simp] theorem UInt64.toUInt8_ofNat {n : Nat} : toUInt8 (no_index (OfNat.ofNat n)) = OfNat.ofNat n := toUInt8_ofNat' _
+@[simp] theorem USize.toUInt8_ofNat {n : Nat} : toUInt8 (no_index (OfNat.ofNat n)) = OfNat.ofNat n := toUInt8_ofNat' _
+
+theorem UInt16.toUInt8_ofNatTruncate_of_lt {n : Nat} (hn : n < UInt16.size) :
+    (UInt16.ofNatTruncate n).toUInt8 = UInt8.ofNat n := by rw [ofNatTruncate, dif_pos hn, toUInt8_ofNatLT]
+theorem UInt32.toUInt8_ofNatTruncate_of_lt {n : Nat} (hn : n < UInt32.size) :
+    (UInt32.ofNatTruncate n).toUInt8 = UInt8.ofNat n := by rw [ofNatTruncate, dif_pos hn, toUInt8_ofNatLT]
+theorem UInt64.toUInt8_ofNatTruncate_of_lt {n : Nat} (hn : n < UInt64.size) :
+    (UInt64.ofNatTruncate n).toUInt8 = UInt8.ofNat n := by rw [ofNatTruncate, dif_pos hn, toUInt8_ofNatLT]
+theorem USize.toUInt8_ofNatTruncate_of_lt {n : Nat} (hn : n < USize.size) :
+    (USize.ofNatTruncate n).toUInt8 = UInt8.ofNat n := by rw [ofNatTruncate, dif_pos hn, toUInt8_ofNatLT]
+
+theorem UInt16.toUInt8_ofNatTruncate_of_le {n : Nat} (hn : UInt16.size ≤ n) :
+    (UInt16.ofNatTruncate n).toUInt8 = UInt8.ofNatLT (UInt8.size - 1) (by decide) :=
+  UInt8.toNat.inj (by simp [toNat_ofNatTruncate_of_le hn])
+theorem UInt32.toUInt8_ofNatTruncate_of_le {n : Nat} (hn : UInt32.size ≤ n) :
+    (UInt32.ofNatTruncate n).toUInt8 = UInt8.ofNatLT (UInt8.size - 1) (by decide) :=
+  UInt8.toNat.inj (by simp [toNat_ofNatTruncate_of_le hn])
+theorem UInt64.toUInt8_ofNatTruncate_of_le {n : Nat} (hn : UInt64.size ≤ n) :
+    (UInt64.ofNatTruncate n).toUInt8 = UInt8.ofNatLT (UInt8.size - 1) (by decide) :=
+  UInt8.toNat.inj (by simp [toNat_ofNatTruncate_of_le hn])
+theorem USize.toUInt8_ofNatTruncate_of_le {n : Nat} (hn : USize.size ≤ n) :
+    (USize.ofNatTruncate n).toUInt8 = UInt8.ofNatLT (UInt8.size - 1) (by decide) :=
+  UInt8.toNat.inj (by simp [toNat_ofNatTruncate_of_le hn])
+
+@[simp] theorem UInt32.toUInt16_ofNatLT {n : Nat} (hn) : (UInt32.ofNatLT n hn).toUInt16 = UInt16.ofNat n := rfl
+@[simp] theorem UInt64.toUInt16_ofNatLT {n : Nat} (hn) : (UInt64.ofNatLT n hn).toUInt16 = UInt16.ofNat n := rfl
+@[simp] theorem USize.toUInt16_ofNatLT {n : Nat} (hn) : (USize.ofNatLT n hn).toUInt16 = UInt16.ofNat n := rfl
+
+@[simp] theorem UInt32.toUInt16_ofFin (n) : (UInt32.ofFin n).toUInt16 = UInt16.ofNat n.val := rfl
+@[simp] theorem UInt64.toUInt16_ofFin (n) : (UInt64.ofFin n).toUInt16 = UInt16.ofNat n.val := rfl
+@[simp] theorem USize.toUInt16_ofFin (n) : (USize.ofFin n).toUInt16 = UInt16.ofNat n.val := rfl
+
+@[simp] theorem UInt32.toUInt16_ofBitVec (b) : (UInt32.ofBitVec b).toUInt16 = UInt16.ofBitVec (b.setWidth _) := rfl
+@[simp] theorem UInt64.toUInt16_ofBitVec (b) : (UInt64.ofBitVec b).toUInt16 = UInt16.ofBitVec (b.setWidth _) := rfl
+@[simp] theorem USize.toUInt16_ofBitVec (b) : (USize.ofBitVec b).toUInt16 = UInt16.ofBitVec (b.setWidth _) :=
+  UInt16.toNat.inj (by simp)
+
+@[simp] theorem UInt32.toUInt16_ofNat' (n : Nat) : (UInt32.ofNat n).toUInt16 = UInt16.ofNat n := UInt16.toNat.inj (by simp)
+@[simp] theorem UInt64.toUInt16_ofNat' (n : Nat) : (UInt64.ofNat n).toUInt16 = UInt16.ofNat n := UInt16.toNat.inj (by simp)
+@[simp] theorem USize.toUInt16_ofNat' (n : Nat) : (USize.ofNat n).toUInt16 = UInt16.ofNat n := UInt16.toNat.inj (by simp)
+
+@[simp] theorem UInt32.toUInt16_ofNat {n : Nat} : toUInt16 (no_index (OfNat.ofNat n)) = OfNat.ofNat n := UInt32.toUInt16_ofNat' _
+@[simp] theorem UInt64.toUInt16_ofNat {n : Nat} : toUInt16 (no_index (OfNat.ofNat n)) = OfNat.ofNat n := UInt64.toUInt16_ofNat' _
+@[simp] theorem USize.toUInt16_ofNat {n : Nat} : toUInt16 (no_index (OfNat.ofNat n)) = OfNat.ofNat n := USize.toUInt16_ofNat' _
+
+theorem UInt32.toUInt16_ofNatTruncate_of_lt {n : Nat} (hn : n < UInt32.size) :
+    (UInt32.ofNatTruncate n).toUInt16 = UInt16.ofNat n := by rw [ofNatTruncate, dif_pos hn, toUInt16_ofNatLT]
+theorem UInt64.toUInt16_ofNatTruncate_of_lt {n : Nat} (hn : n < UInt64.size) :
+    (UInt64.ofNatTruncate n).toUInt16 = UInt16.ofNat n := by rw [ofNatTruncate, dif_pos hn, toUInt16_ofNatLT]
+theorem USize.toUInt16_ofNatTruncate_of_lt {n : Nat} (hn : n < USize.size) :
+    (USize.ofNatTruncate n).toUInt16 = UInt16.ofNat n := by rw [ofNatTruncate, dif_pos hn, toUInt16_ofNatLT]
+
+theorem UInt32.toUInt16_ofNatTruncate_of_le {n : Nat} (hn : UInt32.size ≤ n) :
+    (UInt32.ofNatTruncate n).toUInt16 = UInt16.ofNatLT (UInt16.size - 1) (by decide) :=
+  UInt16.toNat.inj (by simp [toNat_ofNatTruncate_of_le hn])
+theorem UInt64.toUInt16_ofNatTruncate_of_le {n : Nat} (hn : UInt64.size ≤ n) :
+    (UInt64.ofNatTruncate n).toUInt16 = UInt16.ofNatLT (UInt16.size - 1) (by decide) :=
+  UInt16.toNat.inj (by simp [toNat_ofNatTruncate_of_le hn])
+theorem USize.toUInt16_ofNatTruncate_of_le {n : Nat} (hn : USize.size ≤ n) :
+    (USize.ofNatTruncate n).toUInt16 = UInt16.ofNatLT (UInt16.size - 1) (by decide) :=
+  UInt16.toNat.inj (by simp [toNat_ofNatTruncate_of_le hn])
+
+@[simp] theorem UInt64.toUInt32_ofNatLT {n : Nat} (hn) : (UInt64.ofNatLT n hn).toUInt32 = UInt32.ofNat n := rfl
+@[simp] theorem USize.toUInt32_ofNatLT {n : Nat} (hn) : (USize.ofNatLT n hn).toUInt32 = UInt32.ofNat n := rfl
+
+@[simp] theorem UInt64.toUInt32_ofFin (n) : (UInt64.ofFin n).toUInt32 = UInt32.ofNat n.val := rfl
+@[simp] theorem USize.toUInt32_ofFin (n) : (USize.ofFin n).toUInt32 = UInt32.ofNat n.val := rfl
+
+@[simp] theorem UInt64.toUInt32_ofBitVec (b) : (UInt64.ofBitVec b).toUInt32 = UInt32.ofBitVec (b.setWidth _) := rfl
+@[simp] theorem USize.toUInt32_ofBitVec (b) : (USize.ofBitVec b).toUInt32 = UInt32.ofBitVec (b.setWidth _) :=
+  UInt32.toNat.inj (by simp)
+
+@[simp] theorem UInt64.toUInt32_ofNat' (n : Nat) : (UInt64.ofNat n).toUInt32 = UInt32.ofNat n := UInt32.toNat.inj (by simp)
+@[simp] theorem USize.toUInt32_ofNat' (n : Nat) : (USize.ofNat n).toUInt32 = UInt32.ofNat n := UInt32.toNat.inj (by simp)
+
+@[simp] theorem UInt64.toUInt32_ofNat {n : Nat} : toUInt32 (no_index (OfNat.ofNat n)) = OfNat.ofNat n := UInt64.toUInt32_ofNat' _
+@[simp] theorem USize.toUInt32_ofNat {n : Nat} : toUInt32 (no_index (OfNat.ofNat n)) = OfNat.ofNat n := USize.toUInt32_ofNat' _
+
+theorem UInt64.toUInt32_ofNatTruncate_of_lt {n : Nat} (hn : n < UInt64.size) :
+    (UInt64.ofNatTruncate n).toUInt32 = UInt32.ofNat n := by rw [ofNatTruncate, dif_pos hn, toUInt32_ofNatLT]
+theorem USize.toUInt32_ofNatTruncate_of_lt {n : Nat} (hn : n < USize.size) :
+    (USize.ofNatTruncate n).toUInt32 = UInt32.ofNat n := by rw [ofNatTruncate, dif_pos hn, toUInt32_ofNatLT]
+
+theorem UInt64.toUInt32_ofNatTruncate_of_le {n : Nat} (hn : UInt64.size ≤ n) :
+    (UInt64.ofNatTruncate n).toUInt32 = UInt32.ofNatLT (UInt32.size - 1) (by decide) :=
+  UInt32.toNat.inj (by simp [toNat_ofNatTruncate_of_le hn])
+theorem USize.toUInt32_ofNatTruncate_of_le {n : Nat} (hn : USize.size ≤ n) :
+    (USize.ofNatTruncate n).toUInt32 = UInt32.ofNatLT (UInt32.size - 1) (by decide) :=
+  UInt32.toNat.inj (by simp [toNat_ofNatTruncate_of_le hn])
+
+@[simp] theorem UInt64.toUSize_ofNatLT {n : Nat} (hn) : (UInt64.ofNatLT n hn).toUSize = USize.ofNat n := rfl
+
+@[simp] theorem UInt64.toUSize_ofFin (n) : (UInt64.ofFin n).toUSize = USize.ofNat n.val := rfl
+
+@[simp] theorem UInt64.toUSize_ofBitVec (b) : (UInt64.ofBitVec b).toUSize = USize.ofBitVec (b.setWidth _) :=
+  USize.toNat.inj (by simp)
+
+@[simp] theorem UInt64.toUSize_ofNat' (n : Nat) : (UInt64.ofNat n).toUSize = USize.ofNat n := USize.toNat.inj (by simp)
+
+@[simp] theorem UInt64.toUSize_ofNat {n : Nat} : toUSize (no_index (OfNat.ofNat n)) = OfNat.ofNat n := UInt64.toUSize_ofNat' _
+
+theorem UInt64.toUSize_ofNatTruncate_of_lt {n : Nat} (hn : n < UInt64.size) :
+    (UInt64.ofNatTruncate n).toUSize = USize.ofNat n := by rw [ofNatTruncate, dif_pos hn, toUSize_ofNatLT]
+
+theorem UInt64.toUSize_ofNatTruncate_of_le {n : Nat} (hn : UInt64.size ≤ n) :
+    (UInt64.ofNatTruncate n).toUSize = USize.ofNatLT (USize.size - 1) (by cases USize.size_eq <;> simp_all) :=
+  USize.toNat.inj (by simp [toNat_ofNatTruncate_of_le hn])
+
+theorem UInt8.toUInt16_ofNatLT {n : Nat} (h) :
+    (UInt8.ofNatLT n h).toUInt16 = UInt16.ofNatLT n (Nat.lt_of_lt_of_le h (by decide)) := rfl
+theorem UInt8.toUInt32_ofNatLT {n : Nat} (h) :
+    (UInt8.ofNatLT n h).toUInt32 = UInt32.ofNatLT n (Nat.lt_of_lt_of_le h (by decide)) := rfl
+theorem UInt8.toUInt64_ofNatLT {n : Nat} (h) :
+    (UInt8.ofNatLT n h).toUInt64 = UInt64.ofNatLT n (Nat.lt_of_lt_of_le h (by decide)) := rfl
+theorem UInt8.toUSize_ofNatLT {n : Nat} (h) :
+    (UInt8.ofNatLT n h).toUSize = USize.ofNatLT n (Nat.lt_of_lt_of_le h size_le_usizeSize) := rfl
+
+theorem UInt8.toUInt16_ofFin {n} :
+  (UInt8.ofFin n).toUInt16 = UInt16.ofNatLT n.val (Nat.lt_of_lt_of_le n.isLt (by decide)) := rfl
+theorem UInt8.toUInt32_ofFin {n} :
+  (UInt8.ofFin n).toUInt32 = UInt32.ofNatLT n.val (Nat.lt_of_lt_of_le n.isLt (by decide)) := rfl
+theorem UInt8.toUInt64_ofFin {n} :
+  (UInt8.ofFin n).toUInt64 = UInt64.ofNatLT n.val (Nat.lt_of_lt_of_le n.isLt (by decide)) := rfl
+theorem UInt8.toUSize_ofFin {n} :
+  (UInt8.ofFin n).toUSize = USize.ofNatLT n.val (Nat.lt_of_lt_of_le n.isLt size_le_usizeSize) := rfl
+
+@[simp] theorem UInt8.toUInt16_ofBitVec {b} : (UInt8.ofBitVec b).toUInt16 = UInt16.ofBitVec (b.setWidth _) := rfl
+@[simp] theorem UInt8.toUInt32_ofBitVec {b} : (UInt8.ofBitVec b).toUInt32 = UInt32.ofBitVec (b.setWidth _) := rfl
+@[simp] theorem UInt8.toUInt64_ofBitVec {b} : (UInt8.ofBitVec b).toUInt64 = UInt64.ofBitVec (b.setWidth _) := rfl
+@[simp] theorem UInt8.toUSize_ofBitVec {b} : (UInt8.ofBitVec b).toUSize = USize.ofBitVec (b.setWidth _) :=
+  USize.toBitVec_inj.1 (by simp)
+
+theorem UInt8.toUInt16_ofNatTruncate_of_lt {n : Nat} (hn : n < UInt8.size) :
+    (UInt8.ofNatTruncate n).toUInt16 = UInt16.ofNatLT n (Nat.lt_of_lt_of_le hn (by decide)) :=
+  UInt16.toNat.inj (by simp [toNat_ofNatTruncate_of_lt hn])
+theorem UInt8.toUInt32_ofNatTruncate_of_lt {n : Nat} (hn : n < UInt8.size) :
+    (UInt8.ofNatTruncate n).toUInt32 = UInt32.ofNatLT n (Nat.lt_of_lt_of_le hn (by decide)) :=
+  UInt32.toNat.inj (by simp [toNat_ofNatTruncate_of_lt hn])
+theorem UInt8.toUInt64_ofNatTruncate_of_lt {n : Nat} (hn : n < UInt8.size) :
+    (UInt8.ofNatTruncate n).toUInt64 = UInt64.ofNatLT n (Nat.lt_of_lt_of_le hn (by decide)) :=
+  UInt64.toNat.inj (by simp [toNat_ofNatTruncate_of_lt hn])
+theorem UInt8.toUSize_ofNatTruncate_of_lt {n : Nat} (hn : n < UInt8.size) :
+    (UInt8.ofNatTruncate n).toUSize = USize.ofNatLT n (Nat.lt_of_lt_of_le hn size_le_usizeSize) :=
+  USize.toNat.inj (by simp [toNat_ofNatTruncate_of_lt hn])
+
+theorem UInt8.toUInt16_ofNatTruncate_of_le {n : Nat} (hn : UInt8.size ≤ n) :
+    (UInt8.ofNatTruncate n).toUInt16 = UInt16.ofNatLT (UInt8.size - 1) (by decide) :=
+  UInt16.toNat.inj (by simp [toNat_ofNatTruncate_of_le hn])
+theorem UInt8.toUInt32_ofNatTruncate_of_le {n : Nat} (hn : UInt8.size ≤ n) :
+    (UInt8.ofNatTruncate n).toUInt32 = UInt32.ofNatLT (UInt8.size - 1) (by decide) :=
+  UInt32.toNat.inj (by simp [toNat_ofNatTruncate_of_le hn])
+theorem UInt8.toUInt64_ofNatTruncate_of_le {n : Nat} (hn : UInt8.size ≤ n) :
+    (UInt8.ofNatTruncate n).toUInt64 = UInt64.ofNatLT (UInt8.size - 1) (by decide) :=
+  UInt64.toNat.inj (by simp [toNat_ofNatTruncate_of_le hn])
+theorem UInt8.toUSize_ofNatTruncate_of_le {n : Nat} (hn : UInt8.size ≤ n) :
+    (UInt8.ofNatTruncate n).toUSize = USize.ofNatLT (UInt8.size - 1) (Nat.lt_of_lt_of_le (by decide) size_le_usizeSize) :=
+  USize.toNat.inj (by simp [toNat_ofNatTruncate_of_le hn])
+
+theorem UInt16.toUInt32_ofNatLT {n : Nat} (h) :
+    (UInt16.ofNatLT n h).toUInt32 = UInt32.ofNatLT n (Nat.lt_of_lt_of_le h (by decide)) := rfl
+theorem UInt16.toUInt64_ofNatLT {n : Nat} (h) :
+    (UInt16.ofNatLT n h).toUInt64 = UInt64.ofNatLT n (Nat.lt_of_lt_of_le h (by decide)) := rfl
+theorem UInt16.toUSize_ofNatLT {n : Nat} (h) :
+    (UInt16.ofNatLT n h).toUSize = USize.ofNatLT n (Nat.lt_of_lt_of_le h size_le_usizeSize) := rfl
+
+theorem UInt16.toUInt32_ofFin {n} :
+  (UInt16.ofFin n).toUInt32 = UInt32.ofNatLT n.val (Nat.lt_of_lt_of_le n.isLt (by decide)) := rfl
+theorem UInt16.toUInt64_ofFin {n} :
+  (UInt16.ofFin n).toUInt64 = UInt64.ofNatLT n.val (Nat.lt_of_lt_of_le n.isLt (by decide)) := rfl
+theorem UInt16.toUSize_ofFin {n} :
+  (UInt16.ofFin n).toUSize = USize.ofNatLT n.val (Nat.lt_of_lt_of_le n.isLt size_le_usizeSize) := rfl
+
+@[simp] theorem UInt16.toUInt32_ofBitVec {b} : (UInt16.ofBitVec b).toUInt32 = UInt32.ofBitVec (b.setWidth _) := rfl
+@[simp] theorem UInt16.toUInt64_ofBitVec {b} : (UInt16.ofBitVec b).toUInt64 = UInt64.ofBitVec (b.setWidth _) := rfl
+@[simp] theorem UInt16.toUSize_ofBitVec {b} : (UInt16.ofBitVec b).toUSize = USize.ofBitVec (b.setWidth _) :=
+  USize.toBitVec_inj.1 (by simp)
+
+theorem UInt16.toUInt32_ofNatTruncate_of_lt {n : Nat} (hn : n < UInt16.size) :
+    (UInt16.ofNatTruncate n).toUInt32 = UInt32.ofNatLT n (Nat.lt_of_lt_of_le hn (by decide)) :=
+  UInt32.toNat.inj (by simp [toNat_ofNatTruncate_of_lt hn])
+theorem UInt16.toUInt64_ofNatTruncate_of_lt {n : Nat} (hn : n < UInt16.size) :
+    (UInt16.ofNatTruncate n).toUInt64 = UInt64.ofNatLT n (Nat.lt_of_lt_of_le hn (by decide)) :=
+  UInt64.toNat.inj (by simp [toNat_ofNatTruncate_of_lt hn])
+theorem UInt16.toUSize_ofNatTruncate_of_lt {n : Nat} (hn : n < UInt16.size) :
+    (UInt16.ofNatTruncate n).toUSize = USize.ofNatLT n (Nat.lt_of_lt_of_le hn size_le_usizeSize) :=
+  USize.toNat.inj (by simp [toNat_ofNatTruncate_of_lt hn])
+
+theorem UInt16.toUInt32_ofNatTruncate_of_le {n : Nat} (hn : UInt16.size ≤ n) :
+    (UInt16.ofNatTruncate n).toUInt32 = UInt32.ofNatLT (UInt16.size - 1) (by decide) :=
+  UInt32.toNat.inj (by simp [toNat_ofNatTruncate_of_le hn])
+theorem UInt16.toUInt64_ofNatTruncate_of_le {n : Nat} (hn : UInt16.size ≤ n) :
+    (UInt16.ofNatTruncate n).toUInt64 = UInt64.ofNatLT (UInt16.size - 1) (by decide) :=
+  UInt64.toNat.inj (by simp [toNat_ofNatTruncate_of_le hn])
+theorem UInt16.toUSize_ofNatTruncate_of_le {n : Nat} (hn : UInt16.size ≤ n) :
+    (UInt16.ofNatTruncate n).toUSize = USize.ofNatLT (UInt16.size - 1) (Nat.lt_of_lt_of_le (by decide) size_le_usizeSize) :=
+  USize.toNat.inj (by simp [toNat_ofNatTruncate_of_le hn])
+
+theorem UInt32.toUInt64_ofNatLT {n : Nat} (h) :
+    (UInt32.ofNatLT n h).toUInt64 = UInt64.ofNatLT n (Nat.lt_of_lt_of_le h (by decide)) := rfl
+theorem UInt32.toUSize_ofNatLT {n : Nat} (h) :
+    (UInt32.ofNatLT n h).toUSize = USize.ofNatLT n (Nat.lt_of_lt_of_le h size_le_usizeSize) := rfl
+
+theorem UInt32.toUInt64_ofFin {n} :
+  (UInt32.ofFin n).toUInt64 = UInt64.ofNatLT n.val (Nat.lt_of_lt_of_le n.isLt (by decide)) := rfl
+theorem UInt32.toUSize_ofFin {n} :
+  (UInt32.ofFin n).toUSize = USize.ofNatLT n.val (Nat.lt_of_lt_of_le n.isLt size_le_usizeSize) := rfl
+
+@[simp] theorem UInt32.toUInt64_ofBitVec {b} : (UInt32.ofBitVec b).toUInt64 = UInt64.ofBitVec (b.setWidth _) := rfl
+@[simp] theorem UInt32.toUSize_ofBitVec {b} : (UInt32.ofBitVec b).toUSize = USize.ofBitVec (b.setWidth _) :=
+  USize.toBitVec_inj.1 (by simp)
+
+theorem UInt32.toUInt64_ofNatTruncate_of_lt {n : Nat} (hn : n < UInt32.size) :
+    (UInt32.ofNatTruncate n).toUInt64 = UInt64.ofNatLT n (Nat.lt_of_lt_of_le hn (by decide)) :=
+  UInt64.toNat.inj (by simp [toNat_ofNatTruncate_of_lt hn])
+theorem UInt32.toUSize_ofNatTruncate_of_lt {n : Nat} (hn : n < UInt32.size) :
+    (UInt32.ofNatTruncate n).toUSize = USize.ofNatLT n (Nat.lt_of_lt_of_le hn size_le_usizeSize) :=
+  USize.toNat.inj (by simp [toNat_ofNatTruncate_of_lt hn])
+
+theorem UInt32.toUInt64_ofNatTruncate_of_le {n : Nat} (hn : UInt32.size ≤ n) :
+    (UInt32.ofNatTruncate n).toUInt64 = UInt64.ofNatLT (UInt32.size - 1) (by decide) :=
+  UInt64.toNat.inj (by simp [toNat_ofNatTruncate_of_le hn])
+theorem UInt32.toUSize_ofNatTruncate_of_le {n : Nat} (hn : UInt32.size ≤ n) :
+    (UInt32.ofNatTruncate n).toUSize = USize.ofNatLT (UInt32.size - 1) (Nat.lt_of_lt_of_le (by decide) size_le_usizeSize) :=
+  USize.toNat.inj (by simp [toNat_ofNatTruncate_of_le hn])
+
+theorem USize.toUInt64_ofNatLT {n : Nat} (h) :
+    (USize.ofNatLT n h).toUInt64 = UInt64.ofNatLT n (Nat.lt_of_lt_of_le h size_le_uint64Size) := rfl
+
+theorem USize.toUInt64_ofFin {n} :
+  (USize.ofFin n).toUInt64 = UInt64.ofNatLT n.val (Nat.lt_of_lt_of_le n.isLt size_le_uint64Size) := rfl
+
+@[simp] theorem USize.toUInt64_ofBitVec {b} : (USize.ofBitVec b).toUInt64 = UInt64.ofBitVec (b.setWidth _) :=
+  UInt64.toBitVec_inj.1 (by simp)
+
+theorem USize.toUInt64_ofNatTruncate_of_lt {n : Nat} (hn : n < USize.size) :
+    (USize.ofNatTruncate n).toUInt64 = UInt64.ofNatLT n (Nat.lt_of_lt_of_le hn size_le_uint64Size) :=
+  UInt64.toNat.inj (by simp [toNat_ofNatTruncate_of_lt hn])
+
+theorem USize.toUInt64_ofNatTruncate_of_le {n : Nat} (hn : USize.size ≤ n) :
+    (USize.ofNatTruncate n).toUInt64 = UInt64.ofNatLT (USize.size - 1) (by cases USize.size_eq <;> simp_all +decide) :=
+  UInt64.toNat.inj (by simp [toNat_ofNatTruncate_of_le hn])

src/Init/Grind/Norm.lean

@@ -123,6 +123,7 @@ init_grind_norm
   Nat.add_eq Nat.sub_eq Nat.mul_eq Nat.zero_eq Nat.le_eq
   -- Int
   Int.lt_eq
+  Int.emod_neg Int.ediv_zero Int.emod_zero
   -- GT GE
   ge_eq gt_eq
   -- Int op folding

src/Init/Prelude.lean

@@ -1007,7 +1007,7 @@ boolean condition. It can also be written as `bif b then x else y`.
 This is `@[macro_inline]` because `x` and `y` should not
 be eagerly evaluated (see `ite`).
 -/
-@[macro_inline] def cond {α : Type u} (c : Bool) (x y : α) : α :=
+@[macro_inline] def cond {α : Sort u} (c : Bool) (x y : α) : α :=
   match c with
   | true  => x
   | false => y

src/Init/System/Promise.lean

@@ -75,3 +75,10 @@ Like `Promise.result`, but resolves to `dflt` if the promise is dropped without
 -/
 @[macro_inline] def Promise.resultD (promise : Promise α) (dflt : α) : Task α :=
   promise.result?.map (sync := true) (·.getD dflt)
+
+/--
+Checks whether the promise has already been resolved, i.e. whether access to `result*` will return
+immediately.
+-/
+def Promise.isResolved (promise : Promise α) : BaseIO Bool :=
+  IO.hasFinished promise.result?

src/Lean/AddDecl.lean

@@ -46,9 +46,9 @@ where go env
 def addDecl (decl : Declaration) : CoreM Unit := do
   -- register namespaces for newly added constants; this used to be done by the kernel itself
   -- but that is incompatible with moving it to a separate task
+  -- NOTE: we do not use `getTopLevelNames` here so that inductive types are registered as
+  -- namespaces
   modifyEnv (decl.getNames.foldl registerNamePrefixes)
-  if let .inductDecl _ _ types _ := decl then
-    modifyEnv (types.foldl (registerNamePrefixes · <| ·.name ++ `rec))
 
   if !Elab.async.get (← getOptions) then
     return (← doAdd)
@@ -79,7 +79,7 @@ def addDecl (decl : Declaration) : CoreM Unit := do
   Core.logSnapshotTask { stx? := none, reportingRange? := endRange?, task := t, cancelTk? := cancelTk }
 where doAdd := do
   profileitM Exception "type checking" (← getOptions) do
-    withTraceNode `Kernel (fun _ => return m!"typechecking declarations {decl.getNames}") do
+    withTraceNode `Kernel (fun _ => return m!"typechecking declarations {decl.getTopLevelNames}") do
       if !(← MonadLog.hasErrors) && decl.hasSorry then
         logWarning m!"declaration uses 'sorry'"
       let env ← (← getEnv).addDeclAux (← getOptions) decl (← read).cancelTk?

src/Lean/Declaration.lean

@@ -194,8 +194,22 @@ def Declaration.definitionVal! : Declaration → DefinitionVal
   | _ => panic! "Expected a `Declaration.defnDecl`."
 
 /--
-Returns all top-level names to be defined by adding this declaration to the environment. This does
-not include auxiliary definitions such as projections.
+Returns all top-level names to be defined by adding this declaration to the environment, i.e.
+excluding nested helper declarations generated automatically.
+-/
+def Declaration.getTopLevelNames : Declaration → List Name
+  | .axiomDecl val          => [val.name]
+  | .defnDecl val           => [val.name]
+  | .thmDecl val            => [val.name]
+  | .opaqueDecl val         => [val.name]
+  | .quotDecl               => [``Quot]
+  | .mutualDefnDecl defns   => defns.map (·.name)
+  | .inductDecl _ _ types _ => types.map (·.name)
+
+/--
+Returns all names to be defined by adding this declaration to the environment. This does not include
+auxiliary definitions such as projections added by the elaborator, nor auxiliary recursors computed
+by the kernel for nested inductive types.
 -/
 def Declaration.getNames : Declaration → List Name
   | .axiomDecl val          => [val.name]
@@ -204,7 +218,7 @@ def Declaration.getNames : Declaration → List Name
   | .opaqueDecl val         => [val.name]
   | .quotDecl               => [``Quot, ``Quot.mk, ``Quot.lift, ``Quot.ind]
   | .mutualDefnDecl defns   => defns.map (·.name)
-  | .inductDecl _ _ types _ => types.map (·.name)
+  | .inductDecl _ _ types _ => types.flatMap fun t => t.name :: (t.name.appendCore `rec) :: t.ctors.map (·.name)
 
 @[specialize] def Declaration.foldExprM {α} {m : Type → Type} [Monad m] (d : Declaration) (f : α → Expr → m α) (a : α) : m α :=
   match d with

src/Lean/Elab/Deriving/DecEq.lean

@@ -134,9 +134,7 @@ partial def mkEnumOfNat (declName : Name) : MetaM Unit := do
   let enumType := mkConst declName
   let ctors := indVal.ctors.toArray
   withLocalDeclD `n (mkConst ``Nat) fun n => do
-    -- After the next stage0 update, this can be reverted to
-    -- let cond := mkConst ``cond [1]
-    let cond := (← mkAppOptM ``cond #[enumType]).appFn!
+    let cond := mkConst ``cond [1]
     let rec mkDecTree (low high : Nat) : Expr :=
       if low + 1 == high then
         mkConst ctors[low]!

src/Lean/Elab/MutualInductive.lean

@@ -910,6 +910,24 @@ private def mkInductiveDecl (vars : Array Expr) (elabs : Array InductiveElabStep
           let decl := Declaration.inductDecl levelParams numParams indTypes isUnsafe
           Term.ensureNoUnassignedMVars decl
           addDecl decl
+
+          -- For nested inductive types, the kernel adds a variable number of auxiliary recursors.
+          -- Let the elaborator know about them as well. (Other auxiliaries have already been
+          -- registered by `addDecl` via `Declaration.getNames`.)
+          -- NOTE: If we want to make inductive elaboration parallel, this should switch to using
+          -- reserved names.
+          for indType in indTypes do
+            let mut i := 1
+            while true do
+              let auxRecName := indType.name ++ `rec |>.appendIndexAfter i
+              let env ← getEnv
+              let some const := env.toKernelEnv.find? auxRecName | break
+              let res ← env.addConstAsync auxRecName .recursor
+              res.commitConst res.asyncEnv (info? := const)
+              res.commitCheckEnv res.asyncEnv
+              setEnv res.mainEnv
+              i := i + 1
+
           let replaceIndFVars (e : Expr) : MetaM Expr := do
             let indFVar2Const := mkIndFVar2Const views indFVars levelParams
             return (← instantiateMVars e).replace fun e' =>
@@ -932,7 +950,6 @@ private def mkInductiveDecl (vars : Array Expr) (elabs : Array InductiveElabStep
           if (ctor.declId.getPos? (canonicalOnly := true)).isSome then
             Term.addTermInfo' ctor.declId (← mkConstWithLevelParams ctor.declName) (isBinder := true)
             enableRealizationsForConst ctor.declName
-        enableRealizationsForConst view.declName
     return res
 
 private def mkAuxConstructions (declNames : Array Name) : TermElabM Unit := do
@@ -962,6 +979,8 @@ private def elabInductiveViews (vars : Array Expr) (elabs : Array InductiveElabS
       IndPredBelow.mkBelow view0.declName
       for e in elabs do
         mkInjectiveTheorems e.view.declName
+    for e in elabs do
+      enableRealizationsForConst e.view.declName
     return res
 
 /-- Ensures that there are no conflicts among or between the type and constructor names defined in `elabs`. -/

src/Lean/Elab/PreDefinition/EqUnfold.lean

@@ -22,32 +22,36 @@ Returns the "const unfold" theorem (`f.eq_unfold`) for the given declaration.
 This is not extensible, and always builds on the unfold theorem (`f.eq_def`).
 -/
 def getConstUnfoldEqnFor? (declName : Name) : MetaM (Option Name) := do
-  let some unfoldEqnName ← getUnfoldEqnFor? (nonRec := true) declName | return none
-  let info ← getConstInfo unfoldEqnName
-  let type ← forallTelescope info.type fun xs eq => do
-    let some (_, lhs, rhs) := eq.eq? | throwError "Unexpected unfold theorem type {info.type}"
-    unless lhs.getAppFn.isConstOf declName do
-     throwError "Unexpected unfold theorem type {info.type}"
-    unless lhs.getAppArgs == xs do
-     throwError "Unexpected unfold theorem type {info.type}"
-    let type ← mkEq lhs.getAppFn (← mkLambdaFVars xs rhs)
-    return type
-  let value ← withNewMCtxDepth do
-    let main ← mkFreshExprSyntheticOpaqueMVar type
-    if (← tryURefl main.mvarId!) then -- try to make a rfl lemma if possible
-      instantiateMVars main
-    else forallTelescope info.type fun xs _eq => do
-      let mut proof ← mkConstWithLevelParams unfoldEqnName
-      proof := mkAppN proof xs
-      for x in xs.reverse do
-        proof ← mkLambdaFVars #[x] proof
-        proof ← mkAppM ``funext #[proof]
-      return proof
+  if (← getUnfoldEqnFor? (nonRec := true) declName).isNone then
+    return none
   let name := .str declName eqUnfoldThmSuffix
-  addDecl <| Declaration.thmDecl {
-    name, type, value
-    levelParams := info.levelParams
-  }
+  realizeConst declName name do
+    -- we have to call `getUnfoldEqnFor?` again to make `unfoldEqnName` available in this context
+    let some unfoldEqnName ← getUnfoldEqnFor? (nonRec := true) declName | unreachable!
+    let info ← getConstInfo unfoldEqnName
+    let type ← forallTelescope info.type fun xs eq => do
+      let some (_, lhs, rhs) := eq.eq? | throwError "Unexpected unfold theorem type {info.type}"
+      unless lhs.getAppFn.isConstOf declName do
+        throwError "Unexpected unfold theorem type {info.type}"
+      unless lhs.getAppArgs == xs do
+        throwError "Unexpected unfold theorem type {info.type}"
+      let type ← mkEq lhs.getAppFn (← mkLambdaFVars xs rhs)
+      return type
+    let value ← withNewMCtxDepth do
+      let main ← mkFreshExprSyntheticOpaqueMVar type
+      if (← tryURefl main.mvarId!) then -- try to make a rfl lemma if possible
+        instantiateMVars main
+      else forallTelescope info.type fun xs _eq => do
+        let mut proof ← mkConstWithLevelParams unfoldEqnName
+        proof := mkAppN proof xs
+        for x in xs.reverse do
+          proof ← mkLambdaFVars #[x] proof
+          proof ← mkAppM ``funext #[proof]
+        return proof
+    addDecl <| Declaration.thmDecl {
+      name, type, value
+      levelParams := info.levelParams
+    }
   return some name
 
 

src/Lean/Elab/PreDefinition/Eqns.lean

@@ -416,13 +416,18 @@ def mkEqns (declName : Name) (declNames : Array Name) (tryRefl := true): MetaM (
     trace[Elab.definition.eqns] "eqnType[{i}]: {eqnTypes[i]}"
     let name := (Name.str declName eqnThmSuffixBase).appendIndexAfter (i+1)
     thmNames := thmNames.push name
+    -- determinism: `type` should be independent of the environment changes since `baseName` was
+    -- added
+    realizeConst declName name (doRealize name info type)
+  return thmNames
+where
+  doRealize name info type := withOptions (tactic.hygienic.set · false) do
     let value ← mkEqnProof declName type tryRefl
     let (type, value) ← removeUnusedEqnHypotheses type value
     addDecl <| Declaration.thmDecl {
       name, type, value
       levelParams := info.levelParams
     }
-  return thmNames
 
 /--
   Auxiliary method for `mkUnfoldEq`. The structure is based on `mkEqnTypes`.
@@ -465,9 +470,12 @@ partial def mkUnfoldProof (declName : Name) (mvarId : MVarId) : MetaM Unit := do
   go mvarId
 
 /-- Generate the "unfold" lemma for `declName`. -/
-def mkUnfoldEq (declName : Name) (info : EqnInfoCore) : MetaM Name := withLCtx {} {} do
-  withOptions (tactic.hygienic.set · false) do
-    let baseName := declName
+def mkUnfoldEq (declName : Name) (info : EqnInfoCore) : MetaM Name := do
+  let name := Name.str declName unfoldThmSuffix
+  realizeConst declName name (doRealize name)
+  return name
+where
+  doRealize name := withOptions (tactic.hygienic.set · false) do
     lambdaTelescope info.value fun xs body => do
       let us := info.levelParams.map mkLevelParam
       let type ← mkEq (mkAppN (Lean.mkConst declName us) xs) body
@@ -475,12 +483,10 @@ def mkUnfoldEq (declName : Name) (info : EqnInfoCore) : MetaM Name := withLCtx {
       mkUnfoldProof declName goal.mvarId!
       let type ← mkForallFVars xs type
       let value ← mkLambdaFVars xs (← instantiateMVars goal)
-      let name := Name.str baseName unfoldThmSuffix
       addDecl <| Declaration.thmDecl {
         name, type, value
         levelParams := info.levelParams
       }
-      return name
 
 def getUnfoldFor? (declName : Name) (getInfo? : Unit → Option EqnInfoCore) : MetaM (Option Name) := do
   if let some info := getInfo? () then

src/Lean/Elab/PreDefinition/FixedParams.lean

@@ -0,0 +1,496 @@
+/-
+Copyright (c) 2025 Lean FRO, LLC. All rights reserved.
+Released under Apache 2.0 license as described in the file LICENSE.
+Authors: Joachim Breitner
+-/
+
+prelude
+import Lean.Elab.PreDefinition.Basic
+
+/-!
+This module contains the logic for figuring out, given mutually recursive predefinitions,
+which parameters are “fixed”. This used to be a simple task when we only considered a fixed prefix,
+but becomes a quite involved task if we allow fixed parameters also later in the parameter list,
+and possibly in a different order in different modules.
+
+The main components of this module are
+
+ * The pure `Info` data type for the bookkeeping during analysis
+ * The `FixedParamPerm` type, with the analysis result for one function
+   (effectively a mask and a permutation)
+ * The `FixedParamPerms` data type, with the data for a whole recursive group.
+ * The `getFixedParamPerms` function that calculates the fixed parameters
+ * Various `MetaM` functions for bringing into scope fixed and varying paramters, assembling
+   argument lists etc.
+
+-/
+
+namespace Lean.Elab.FixedParams
+
+
+/--
+To determine which parameters in mutually recursive predefinitions are fixed, and how they
+correspond to each other, we run an analysis that aggregates information in the `Info` data type.
+
+Abstractly, this represents
+* a set `varying` of `(funIdx × paramIdx)` pairs known to be varying, initially empty
+* a directed graph whose nodes are `(funIdx × paramIdx)` pairs, initially empty
+
+We find the largest set and graph that satisfies these rules:
+* Every parameter has to be related to itself: `(funIdx, paramIdx) → (funIdx, paramIdx)`.
+* whenever the function with index `caller` calls `callee` and the `argIdx`'s argument is reducibly
+  defeq to `paramIdx`, then we have an edge `(caller, paramIdx) → (callee, argIdx)`.
+* whenever the function with index `caller` calls `callee` and the `argIdx`'s argument is not reducibly
+  defeq to any of the `caller`'s parameters, then `(callee, argIdx) ∈ varying`.
+* If we have `(caller, paramIdx₁) → (callee, argIdx)` and `(caller, paramIdx₂) → (callee, argIdx)`
+  with `paramIdx₁ ≠ paramIdx₂`, then `(callee, argIdx) ∈ varying`.
+* The graph is transitive
+* If we have `(caller, paramIdx) → (callee, argIdx)` and `(caller, paramIdx) ∈ varying`, then
+  `(callee, argIdx) ∈ varying`
+* If the type of `funIdx`’s parameter `paramIdx₂ depends on the `paramIdx₁` and
+  `(funIdx, paramIdx₁) ∈ varying`, then `(funIdx, paramIdx₁) ∈ varying`
+* For structural recursion: The target and all its indices are `varying`.
+  (This is taking into account post-hoc, using `FixedParamPerms.erase`)
+
+Under the assumption that the predefintions indeed are mutually recursive, then the resulting graph,
+restricted to the non-`varying` nodes, should partition into cliques that have one member from each
+function. Every such clique becomes a fixed parameter.
+
+-/
+structure Info where
+  /-
+  The concrete data structure for set and graph exploits some of the invariants:
+  * Once we know a parameter is varying, it's incoming edges are irrelevant.
+  * There can be at most one incoming edge
+
+  So we have
+
+  * `graph[callee][argIdx] = none`: `(callee, argIdx) ∈ varying`
+  * `graph[callee][argIdx] = some a`:
+    * `(callee, argIdx) ∉ varying` (yet) and
+    * `a[callerIdx] = none`: we have no edge to `(callee, argIdx)`
+    * `a[callerIdx] = some paramIdx`: we have edge `(callerIdx, paramIdx) → (callee, argIdx)`
+  -/
+  graph : Array (Array (Option (Array (Option Nat))))
+  /--
+  The dependency structure of the function parameter.
+  If `paramIdx₂ ∈ revDeps[funIdx][paraIdx₁]`, then the type of `paramIdx₂` depends on `parmaIdx₁`
+  -/
+  revDeps : Array (Array (Array Nat))
+
+
+def Info.init (revDeps : Array (Array (Array Nat))) : Info where
+  graph := revDeps.map fun deps =>
+    mkArray deps.size (some (mkArray revDeps.size none))
+  revDeps
+
+def Info.addSelfCalls (info : Info) : Info :=
+  { info with graph := info.graph.mapIdx fun funIdx paramInfos =>
+    paramInfos.mapIdx fun paramIdx paramInfo? =>
+      paramInfo?.map fun callers =>
+        callers.set! funIdx (some paramIdx) }
+
+/--
+Is this parameter still plausibly a fixed parameter?
+-/
+def Info.mayBeFixed (callerIdx paramIdx : Nat) (info : Info) : Bool :=
+  info.graph[callerIdx]![paramIdx]!.isSome
+
+/--
+This parameter is varying. Set and propagate that information.
+-/
+partial def Info.setVarying (funIdx paramIdx : Nat) (info : Info) : Info := Id.run do
+  let mut info : Info := info
+  if info.mayBeFixed funIdx paramIdx then
+    -- Set this as varying
+    info := { info with graph := info.graph.modify funIdx (·.set! paramIdx none) }
+    -- Propagate along edges for already observed calls
+    for otherFunIdx in [:info.graph.size] do
+      for otherParamIdx in [:info.graph[otherFunIdx]!.size] do
+        if let some otherParamInfo := info.graph[otherFunIdx]![otherParamIdx]! then
+          if otherParamInfo[funIdx]! = some paramIdx then
+            info := Info.setVarying otherFunIdx otherParamIdx info
+    -- Propagate along type dependencies edges
+    for dependingParam in info.revDeps[funIdx]![paramIdx]! do
+      info := Info.setVarying funIdx dependingParam info
+  info
+
+def Info.getCallerParam? (calleeIdx argIdx callerIdx : Nat) (info : Info) : Option Nat :=
+  info.graph[calleeIdx]![argIdx]!.bind (·[callerIdx]!)
+
+/--
+We observe a possibly valid edge.
+-/
+partial def Info.setCallerParam (calleeIdx argIdx callerIdx paramIdx : Nat) (info : Info) : Info :=
+  if info.mayBeFixed calleeIdx argIdx then
+    if info.mayBeFixed callerIdx paramIdx then
+      if let some paramIdx' := info.getCallerParam? calleeIdx argIdx callerIdx then
+      -- We already have an etry
+      if paramIdx = paramIdx' then
+        -- all good
+        info
+      else
+        -- Inconsistent information
+        info.setVarying calleeIdx argIdx
+    else
+      -- Set the new entry
+      let info := { info with graph := info.graph.modify calleeIdx (·.modify argIdx (·.map (·.set! callerIdx (some paramIdx)))) }
+      Id.run do
+        -- Propagate information about the caller
+        let mut info : Info := info
+        if let some callerParamInfo := info.graph[callerIdx]![paramIdx]! then
+          for h : otherFunIdx in [:callerParamInfo.size] do
+            if let some otherParamIdx := callerParamInfo[otherFunIdx] then
+              info := info.setCallerParam calleeIdx argIdx otherFunIdx otherParamIdx
+        -- Propagate information about the callee
+        for otherFunIdx in [:info.graph.size] do
+          for otherArgIdx in [:info.graph[otherFunIdx]!.size] do
+            if let some otherArgsInfo := info.graph[otherFunIdx]![otherArgIdx]! then
+              if let some paramIdx' := otherArgsInfo[calleeIdx]! then
+                if paramIdx' = argIdx then
+                  info := info.setCallerParam otherFunIdx otherArgIdx callerIdx paramIdx
+
+        return info
+    else
+      -- Param not fixed, so argument isn't either
+      info.setVarying calleeIdx argIdx
+  else
+    info
+
+def Info.format (info : Info) : Format := Format.line.joinSep <|
+  info.graph.toList.map fun paramInfos =>
+    (f!"• " ++ ·) <| f!" ".joinSep <| paramInfos.toList.map fun
+      | .none => f!"❌"
+      | .some callerInfos => .sbracket <| f!" ".joinSep <| callerInfos.toList.map fun
+        | Option.none => f!"?"
+        | .some idx => f!"#{idx+1}"
+
+
+instance : ToFormat Info := ⟨Info.format⟩
+
+end FixedParams
+
+open Lean Meta FixedParams
+
+def getParamRevDeps (preDefs : Array PreDefinition) : MetaM (Array (Array (Array Nat))) := do
+  preDefs.mapM fun preDef =>
+    lambdaTelescope preDef.value (cleanupAnnotations := true) fun xs _ => do
+      let mut revDeps := #[]
+      for h : i in [:xs.size] do
+        let mut deps := #[]
+        for h : j in [i+1:xs.size] do
+          if (← dependsOn (← inferType xs[j]) xs[i].fvarId!) then
+            deps := deps.push j
+        revDeps := revDeps.push deps
+      pure revDeps
+
+def getFixedParamsInfo (preDefs : Array PreDefinition) : MetaM FixedParams.Info := do
+  let revDeps ← getParamRevDeps preDefs
+  let arities := revDeps.map (·.size)
+  let ref ← IO.mkRef (Info.init revDeps)
+
+  ref.modify .addSelfCalls
+
+  for h : callerIdx in [:preDefs.size] do
+    let preDef := preDefs[callerIdx]
+    lambdaTelescope preDef.value fun params body => do
+      assert! params.size = arities[callerIdx]!
+
+      -- TODO: transform is overkill, a simple visit-all-subexpression that takes applications
+      -- as whole suffices
+      discard <| Meta.transform (skipConstInApp := true) body fun e => e.withApp fun f args => do
+        unless f.isConst do
+          return .continue
+        let n := f.constName!
+        let some calleeIdx := preDefs.findIdx? (·.declName = n) | return .continue
+        for argIdx in [:arities[calleeIdx]!] do
+          if (← ref.get).mayBeFixed calleeIdx argIdx then
+            if h : argIdx < args.size then
+              let arg := args[argIdx]
+              -- We have seen this before (or it is a self-call), so only check that one param
+              if let some paramIdx := (← ref.get).getCallerParam? calleeIdx argIdx callerIdx then
+                let param := params[paramIdx]!
+                unless (← withoutProofIrrelevance <| withReducible <| isDefEq param arg) do
+                  trace[Elab.definition.fixedParams] "getFixedParams: notFixed {calleeIdx} {argIdx}:\nIn {e}\n{param} =/= {arg}"
+                  ref.modify (Info.setVarying calleeIdx argIdx)
+              else
+              -- Try all parameters
+              let mut any := false
+              for h : paramIdx in [:params.size] do
+                if (← ref.get).mayBeFixed callerIdx paramIdx then
+                  let param := params[paramIdx]
+                  if (← withoutProofIrrelevance <| withReducible <| isDefEq param arg) then
+                    ref.modify (Info.setCallerParam calleeIdx argIdx callerIdx paramIdx)
+                    any := true
+              unless any do
+                trace[Elab.definition.fixedParams] "getFixedParams: notFixed {calleeIdx} {argIdx}:\nIn {e}\n{arg} not matched"
+                -- Argument is none of the plausible parameters, so it cannot be a fixed argument
+                ref.modify (Info.setVarying calleeIdx argIdx)
+            else
+              -- Underapplication
+              trace[Elab.definition.fixedParams] "getFixedParams: notFixed {calleeIdx} {argIdx}:\nIn {e}\ntoo few arguments for {argIdx}"
+              ref.modify (Info.setVarying calleeIdx argIdx)
+        return .continue
+
+  let info ← ref.get
+  trace[Elab.definition.fixedParams] "getFixedParams:{info.format.indentD}"
+  return info
+
+/--
+For a given function, a mapping from its parameters to the (indices of the) fixed parameters of the
+recursive group.
+The length of the array is the arity of the function, as determined from its body, consistent
+with the arity used by well-founded recursion.
+For the first function, they appear in order; for other functions they may be reordered.
+-/
+abbrev FixedParamPerm := Array (Option Nat)
+
+/--
+This data structure stores the result of the fixed parameter analysis. See `FixedParams.Info` for
+details on the analysis.
+-/
+structure FixedParamPerms where
+  /-- Number of fixed parameters -/
+  numFixed : Nat
+  /--
+  For each function in the clique, a mapping from its parameters to the fixed parameters.
+  For the first function, they appear in order; for other functions they may be reordered.
+   -/
+  perms : Array FixedParamPerm
+  /--
+  The dependencies among the parameters. See `FixedParams.Info.revDeps`.
+  We need this for the `FixedParamsPerm.erase` operation.
+  -/
+  revDeps : Array (Array (Array Nat))
+deriving Inhabited, Repr
+
+def getFixedParamPerms (preDefs : Array PreDefinition) : MetaM FixedParamPerms := do
+  let info ← getFixedParamsInfo preDefs
+  lambdaTelescope preDefs[0]!.value fun xs _ => do
+    let paramInfos := info.graph[0]!
+    assert! xs.size = paramInfos.size
+
+    let mut firstPerm := #[]
+    let mut numFixed := 0
+    for paramIdx in [:xs.size], x in xs, paramInfo? in paramInfos do
+      if let some paramInfo := paramInfo? then
+        assert! paramInfo[0]! = some paramIdx
+        firstPerm := firstPerm.push (some numFixed)
+        numFixed := numFixed + 1
+      else
+        firstPerm := firstPerm.push none
+
+    let mut perms := #[firstPerm]
+    for h : funIdx in [1:info.graph.size] do
+      let paramInfos := info.graph[funIdx]
+      let mut perm := #[]
+      for paramInfo? in paramInfos do
+        if let some paramInfo := paramInfo? then
+          if let some firstParamIdx := paramInfo[0]! then
+            assert! firstPerm[firstParamIdx]!.isSome
+            perm := perm.push firstPerm[firstParamIdx]!
+          else
+            panic! "Incomplete paramInfo"
+        else
+          perm := perm.push none
+      perms := perms.push perm
+
+    return { numFixed, perms, revDeps := info.revDeps }
+
+def FixedParamPerm.numFixed (perm : FixedParamPerm) : Nat :=
+  perm.countP Option.isSome
+
+def FixedParamPerm.isFixed (perm : FixedParamPerm) (i : Nat) : Bool :=
+  perm[i]?.join.isSome
+
+/--
+Brings the fixed parameters from `type`, which should the the type of the `funIdx`'s function, into
+scope.
+-/
+private partial def FixedParamPerm.forallTelescopeImpl (perm : FixedParamPerm)
+    (type : Expr) (k : Array Expr → MetaM α) : MetaM α := do
+  go 0 type (mkArray perm.numFixed (mkSort 0))
+where
+  go i type xs := do
+    match perm[i]? with
+    | .some (Option.some fixedParamIdx) =>
+      forallBoundedTelescope type (some 1) (cleanupAnnotations := true) fun xs' type => do
+        assert! xs'.size = 1
+        let x := xs'[0]!
+        assert! !(← inferType x).hasLooseBVars
+        assert! fixedParamIdx < xs.size
+        go (i + 1) type (xs.set! fixedParamIdx x)
+    | .some .none =>
+      let type ← whnf type
+      assert! type.isForall
+      go (i + 1) type.bindingBody! xs
+    | .none =>
+      k xs
+
+def FixedParamPerm.forallTelescope [MonadControlT MetaM n] [Monad n]
+    (perm : FixedParamPerm) (type : Expr) (k : Array Expr → n α) : n α := do
+  map1MetaM (fun k => perm.forallTelescopeImpl type k) k
+
+
+/--
+If `type` is the type of the `funIdx`'s function, instantiate the fixed paramters.
+-/
+def FixedParamPerm.instantiateForall (perm: FixedParamPerm) (type₀ : Expr) (xs : Array Expr) : MetaM Expr := do
+  assert! xs.size = perm.numFixed
+  let mask := perm.toList
+  go mask type₀
+where
+  go | [], type => pure type
+     | (.some fixedParamIdx)::mask, type => do
+        assert! fixedParamIdx < xs.size
+        go mask (← Meta.instantiateForall type #[xs[fixedParamIdx]!])
+     | .none::mask, type =>
+        forallBoundedTelescope type (some 1) fun ys type => do
+          assert! ys.size = 1
+          mkForallFVars ys (← go mask type)
+
+/--
+If `value` is the body of the `funIdx`'s function, instantiate the fixed paramters.
+Expects enough manifest lambdas to instantiate all fixed parameters, but can handle
+eta-contracted definitions beyond that.
+-/
+def FixedParamPerm.instantiateLambda (perm : FixedParamPerm) (value₀ : Expr) (xs : Array Expr) : MetaM Expr := do
+  assert! xs.size = perm.numFixed
+  let mask := perm.toList
+  go mask value₀
+where
+  go | [], value => pure value
+     | (.some fixedParamIdx)::mask, value => do
+        assert! fixedParamIdx < xs.size
+        go mask (← Meta.instantiateLambda value #[xs[fixedParamIdx]!])
+     | .none::mask, value =>
+        if mask.all Option.isNone then
+          -- Nothing left to do. Also helpful if we may encounter an eta-contracted value
+          return value
+        else
+          lambdaBoundedTelescope value 1 fun ys value => do
+            assert! ys.size = 1
+            mkLambdaFVars ys (← go mask value)
+
+/--
+If `xs` are arguments to the `funIdx`'s function, pick only the fixed ones, and reorder appropriately.
+Expects `xs` to match the arity of the function.
+-/
+def FixedParamPerm.pickFixed (perm : FixedParamPerm) (xs : Array α) : Array α := Id.run do
+  assert! xs.size = perm.size
+  if h : xs.size = 0 then
+    pure #[]
+  else
+    let dummy := xs[0]
+    let ys := mkArray perm.numFixed dummy
+    go (perm.zip xs).toList ys
+where
+  go | [], ys => return ys
+     | (.some fixedParamIdx, x)::xs, ys => do
+        assert! fixedParamIdx < ys.size
+        go xs (ys.set! fixedParamIdx x)
+     | (.none, _) :: perm, ys =>
+        go perm ys
+
+/--
+If `xs` are arguments to the `funIdx`'s function, pick only the varying ones.
+Unlike `pickFixed`, this function can handle over- or under-application.
+-/
+def FixedParamPerm.pickVarying (perm : FixedParamPerm) (xs : Array α) : Array α := Id.run do
+  let mut ys := #[]
+  for h : i in [:xs.size] do
+    if perm[i]?.join.isNone then ys := ys.push xs[i]
+  pure ys
+
+/--
+Intersperses the fixed and varying parameters to be in the original parameter order.
+Can handle over- or und-application (extra or missing varying args), as long
+as there are all varying parameters that go before fixed parameters.
+(We expect to always find all fixed parameters, else they woudn't be fixed parameters.)
+-/
+partial def FixedParamPerm.buildArgs (perm : FixedParamPerm) (fixedArgs varyingArgs : Array α) : Array α :=
+  assert! fixedArgs.size = perm.numFixed
+  go 0 0 #[]
+where
+  go i j (xs : Array α) :=
+    if _ : i < perm.size then
+      if let some fixedParamIdx := perm[i] then
+        if _ : fixedParamIdx < fixedArgs.size then
+          go (i + 1) j (xs.push fixedArgs[fixedParamIdx])
+        else
+          panic! "FixedParams.buildArgs: too few fixed args"
+      else
+        if _ : j < varyingArgs.size then
+          go (i + 1) (j + 1) (xs.push varyingArgs[j])
+        else
+          if perm[i:].all Option.isNone then
+            xs -- Under-application
+          else
+            panic! "FixedParams.buildArgs: too few varying args"
+    else
+      xs ++ varyingArgs[j:] -- (Possibly) over-application
+
+/--
+Are all fixed parameters a non-reordered prefix?
+-/
+def FixedParamPerms.fixedArePrefix (fixedParamPerms : FixedParamPerms) : Bool :=
+  fixedParamPerms.perms.all fun paramInfos =>
+    paramInfos ==
+      (Array.range fixedParamPerms.numFixed).map Option.some ++
+      mkArray (paramInfos.size - fixedParamPerms.numFixed) .none
+
+/--
+If `xs` are the fixed parameters that are in scope, and `toErase` are, for each function, the
+positions of arguments that must no longer be fixed parameters, then this function splits partitions
+`xs` into those to keep and those to erase, and updates `FixedParams` accordingly.
+
+This is used in structural recursion, where we may discover that some fixed parameters are actually
+indices and need to be treated as varying, including all parameters that depend on them.
+-/
+def FixedParamPerms.erase  (fixedParamPerms : FixedParamPerms) (xs : Array Expr)
+    (toErase : Array (Array Nat)) : (FixedParamPerms × Array Expr × Array FVarId) := Id.run do
+  assert! xs.all (·.isFVar)
+  assert! fixedParamPerms.numFixed  = xs.size
+  assert! toErase.size = fixedParamPerms.perms.size
+  -- Calculate a mask on the fixed parameters of variables to erase
+  let mut mask := mkArray fixedParamPerms.numFixed false
+  for funIdx in [:toErase.size], paramIdxs in toErase, mapping in fixedParamPerms.perms do
+    for paramIdx in paramIdxs do
+      assert! paramIdx < mapping.size
+      if let some fixedParamIdx := mapping[paramIdx]! then
+        mask := mask.set! fixedParamIdx true
+  -- Take the transitive closure under under `fixedParamPerms.revDeps`.
+  let mut changed := true
+  while changed do
+    changed := false
+    for h : funIdx in [:fixedParamPerms.perms.size] do
+      for h : paramIdx₁ in [:fixedParamPerms.perms[funIdx].size] do
+        if let some fixedParamIdx₁ := fixedParamPerms.perms[funIdx][paramIdx₁] then
+          if mask[fixedParamIdx₁]! then
+            for paramIdx₂ in fixedParamPerms.revDeps[funIdx]![paramIdx₁]! do
+              if let some fixedParamIdx₂ := fixedParamPerms.perms[funIdx][paramIdx₂]! then
+                if !mask[fixedParamIdx₂]! then
+                  mask := mask.set! fixedParamIdx₂ true
+                  changed := true
+  -- Calculate reindexing map, variables to keep, variables to erase
+  let mut reindex := #[]
+  let mut fvarsToErase :=#[]
+  let mut toKeep :=#[]
+  for i in [:mask.size], erase in mask, x in xs do
+    if erase then
+      reindex := reindex.push none
+      fvarsToErase := fvarsToErase.push x.fvarId!
+    else
+      reindex := reindex.push (Option.some toKeep.size)
+      toKeep := toKeep.push x
+  let fixedParamPerms' : FixedParamPerms := {
+    numFixed := toKeep.size
+    perms := fixedParamPerms.perms.map (·.map (·.bind (reindex[·]!)))
+    revDeps := fixedParamPerms.revDeps
+  }
+  return (fixedParamPerms', toKeep, fvarsToErase)
+
+end Lean.Elab
+
+builtin_initialize
+  Lean.registerTraceClass `Elab.definition.fixedParams

src/Lean/Elab/PreDefinition/Mutual.lean

@@ -26,24 +26,6 @@ where
       withLocalDecl vals[0]!.bindingName! vals[0]!.binderInfo vals[0]!.bindingDomain! fun x =>
         go (fvars.push x) (vals.map fun val => val.bindingBody!.instantiate1 x)
 
-def getFixedPrefix (preDefs : Array PreDefinition) : MetaM Nat :=
-  withCommonTelescope preDefs fun xs vals => do
-    let resultRef ← IO.mkRef xs.size
-    for val in vals do
-      if (← resultRef.get) == 0 then return 0
-      forEachExpr' val fun e => do
-        if preDefs.any fun preDef => e.isAppOf preDef.declName then
-          let args := e.getAppArgs
-          resultRef.modify (min args.size ·)
-          for arg in args, x in xs do
-            if !(← withoutProofIrrelevance <| withReducible <| isDefEq arg x) then
-              -- We continue searching if e's arguments are not a prefix of `xs`
-              return true
-          return false
-        else
-          return true
-    resultRef.get
-
 def addPreDefsFromUnary (preDefs : Array PreDefinition) (preDefsNonrec : Array PreDefinition)
     (unaryPreDefNonRec : PreDefinition) : TermElabM Unit := do
   /-

src/Lean/Elab/PreDefinition/PartialFixpoint/Eqns.lean

@@ -9,6 +9,7 @@ import Lean.Meta.Tactic.Rewrite
 import Lean.Meta.Tactic.Split
 import Lean.Elab.PreDefinition.Basic
 import Lean.Elab.PreDefinition.Eqns
+import Lean.Elab.PreDefinition.FixedParams
 import Lean.Meta.ArgsPacker.Basic
 import Init.Data.Array.Basic
 import Init.Internal.Order.Basic
@@ -20,12 +21,13 @@ open Eqns
 structure EqnInfo extends EqnInfoCore where
   declNames       : Array Name
   declNameNonRec  : Name
-  fixedPrefixSize : Nat
+  fixedParamPerms : FixedParamPerms
   deriving Inhabited
 
 builtin_initialize eqnInfoExt : MapDeclarationExtension EqnInfo ← mkMapDeclarationExtension
 
-def registerEqnsInfo (preDefs : Array PreDefinition) (declNameNonRec : Name) (fixedPrefixSize : Nat) : MetaM Unit := do
+def registerEqnsInfo (preDefs : Array PreDefinition) (declNameNonRec : Name)
+    (fixedParamPerms : FixedParamPerms) : MetaM Unit := do
   preDefs.forM fun preDef => ensureEqnReservedNamesAvailable preDef.declName
   unless preDefs.all fun p => p.kind.isTheorem do
     unless (← preDefs.allM fun p => isProp p.type) do
@@ -33,7 +35,7 @@ def registerEqnsInfo (preDefs : Array PreDefinition) (declNameNonRec : Name) (fi
       modifyEnv fun env =>
         preDefs.foldl (init := env) fun env preDef =>
           eqnInfoExt.insert env preDef.declName { preDef with
-            declNames, declNameNonRec, fixedPrefixSize }
+            declNames, declNameNonRec, fixedParamPerms }
 
 private def deltaLHSUntilFix (declName declNameNonRec : Name) (mvarId : MVarId) : MetaM MVarId := mvarId.withContext do
   let target ← mvarId.getType'
@@ -66,9 +68,12 @@ private def rwFixEq (mvarId : MVarId) : MetaM MVarId := mvarId.withContext do
   return mvarNew.mvarId!
 
 /-- Generate the "unfold" lemma for `declName`. -/
-def mkUnfoldEq (declName : Name) (info : EqnInfo) : MetaM Name := withLCtx {} {} do
-  withOptions (tactic.hygienic.set · false) do
-    let baseName := declName
+def mkUnfoldEq (declName : Name) (info : EqnInfo) : MetaM Name := do
+  let name := Name.str declName unfoldThmSuffix
+  realizeConst declName name (doRealize name)
+  return name
+where
+  doRealize name := withOptions (tactic.hygienic.set · false) do
     lambdaTelescope info.value fun xs body => do
       let us := info.levelParams.map mkLevelParam
       let type ← mkEq (mkAppN (Lean.mkConst declName us) xs) body
@@ -90,12 +95,10 @@ def mkUnfoldEq (declName : Name) (info : EqnInfo) : MetaM Name := withLCtx {} {}
           throwError "failed to generate unfold theorem for '{declName}':\n{e.toMessageData}"
       let type ← mkForallFVars xs type
       let value ← mkLambdaFVars xs goal
-      let name := Name.str baseName unfoldThmSuffix
       addDecl <| Declaration.thmDecl {
         name, type, value
         levelParams := info.levelParams
       }
-      return name
 
 def getUnfoldFor? (declName : Name) : MetaM (Option Name) := do
   let name := Name.str declName unfoldThmSuffix

src/Lean/Elab/PreDefinition/PartialFixpoint/Induction.lean

@@ -70,21 +70,21 @@ def deriveInduction (name : Name) : MetaM Unit := do
 
     let infos ← eqnInfo.declNames.mapM getConstInfoDefn
     -- First open up the fixed parameters everywhere
-    let e' ← lambdaBoundedTelescope infos[0]!.value eqnInfo.fixedPrefixSize fun xs _ => do
+    let e' ← eqnInfo.fixedParamPerms.perms[0]!.forallTelescope infos[0]!.type fun xs => do
       -- Now look at the body of an arbitrary of the functions (they are essentially the same
       -- up to the final projections)
-      let body ← instantiateLambda infos[0]!.value xs
+      let body ← eqnInfo.fixedParamPerms.perms[0]!.instantiateLambda infos[0]!.value xs
 
       -- The body should now be of the form of the form (fix … ).2.2.1
       -- We strip the projections (if present)
-      let body' := PProdN.stripProjs body
+      let body' := PProdN.stripProjs body.eta -- TODO: Eta more carefully?
       let some fixApp ← whnfUntil body' ``fix
-        | throwError "Unexpected function body {body}"
+        | throwError "Unexpected function body {body}, could not whnfUntil fix"
       let_expr fix α instCCPOα F hmono := fixApp
-        | throwError "Unexpected function body {body'}"
+        | throwError "Unexpected function body {body'}, not an application of fix"
 
       let instCCPOs := CCPOProdProjs infos.size instCCPOα
-      let types ← infos.mapM (instantiateForall ·.type xs)
+      let types ← infos.mapIdxM (eqnInfo.fixedParamPerms.perms[·]!.instantiateForall ·.type xs)
       let packedType ← PProdN.pack 0 types
       let motiveTypes ← types.mapM (mkArrow · (.sort 0))
       let motiveNames := numberNames motiveTypes.size "motive"
@@ -135,7 +135,11 @@ def deriveInduction (name : Name) : MetaM Unit := do
             let packedConclusion ← PProdN.pack 0 <| ←
               motives.mapIdxM fun i motive => do
                 let f ← mkConstWithLevelParams infos[i]!.name
-                return mkApp motive (mkAppN f xs)
+                let fEtaExpanded ← lambdaTelescope infos[i]!.value fun ys _ =>
+                  mkLambdaFVars ys (mkAppN f ys)
+                let fInst ← eqnInfo.fixedParamPerms.perms[i]!.instantiateLambda fEtaExpanded xs
+                let fInst := fInst.eta
+                return mkApp motive fInst
             let e' ← mkExpectedTypeHint e' packedConclusion
             let e' ← mkLambdaFVars hs e'
             let e' ← mkLambdaFVars adms e'
@@ -228,9 +232,10 @@ def derivePartialCorrectness (name : Name) : MetaM Unit := do
       throwError "{name} is not defined by partial_fixpoint"
 
     let infos ← eqnInfo.declNames.mapM getConstInfoDefn
+    let fixedParamPerm0 := eqnInfo.fixedParamPerms.perms[0]!
     -- First open up the fixed parameters everywhere
-    let e' ← lambdaBoundedTelescope infos[0]!.value eqnInfo.fixedPrefixSize fun xs _ => do
-      let types ← infos.mapM (instantiateForall ·.type xs)
+    let e' ← fixedParamPerm0.forallTelescope infos[0]!.type fun xs => do
+      let types ← infos.mapIdxM (eqnInfo.fixedParamPerms.perms[·]!.instantiateForall ·.type xs)
 
       -- for `f : α → β → Option γ`, we expect a `motive : α → β → γ → Prop`
       let motiveTypes ← types.mapM fun type =>

src/Lean/Elab/PreDefinition/PartialFixpoint/Main.lean

@@ -18,33 +18,44 @@ open Monotonicity
 
 open Lean.Order
 
-private def replaceRecApps (recFnNames : Array Name) (fixedPrefixSize : Nat) (f : Expr) (e : Expr) : MetaM Expr := do
+private def replaceRecApps (recFnNames : Array Name) (fixedParamPerms : FixedParamPerms) (f : Expr) (e : Expr) : MetaM Expr := do
+  assert! recFnNames.size = fixedParamPerms.perms.size
   let t ← inferType f
-  return e.replace fun e =>
-    if let some idx := recFnNames.findIdx? (e.isAppOfArity · fixedPrefixSize) then
-      some <| PProdN.proj recFnNames.size idx t f
-    else
-      none
+  return e.replace fun e => do
+    let fn := e.getAppFn
+    guard fn.isConst
+    let idx ← recFnNames.idxOf? fn.constName!
+    let args := e.getAppArgs
+    let varying := fixedParamPerms.perms[idx]!.pickVarying args
+    return mkAppN (PProdN.proj recFnNames.size idx t f) varying
 
 /--
 For pretty error messages:
 Takes `F : (fun f => e)`, where `f` is the packed function, and replaces `f` in `e` with the user-visible
 constants, which are added to the environment temporarily.
 -/
-private def unReplaceRecApps {α} (preDefs : Array PreDefinition) (fixedArgs : Array Expr)
+private def unReplaceRecApps {α} (preDefs : Array PreDefinition) (fixedParamPerms : FixedParamPerms) (fixedArgs : Array Expr)
     (F : Expr) (k : Expr → MetaM α) : MetaM α := do
   unless F.isLambda do throwError "Expected lambda:{indentExpr F}"
   withoutModifyingEnv do
     preDefs.forM addAsAxiom
-    let fns := preDefs.map fun d =>
-      mkAppN (.const d.declName (d.levelParams.map mkLevelParam)) fixedArgs
+    let fns ← preDefs.mapIdxM fun funIdx preDef => do
+      let value ← fixedParamPerms.perms[funIdx]!.instantiateLambda preDef.value fixedArgs
+      lambdaTelescope value fun xs _ =>
+        let args := fixedParamPerms.perms[funIdx]!.buildArgs fixedArgs xs
+        let call := mkAppN (.const preDef.declName (preDef.levelParams.map mkLevelParam)) args
+        mkLambdaFVars (etaReduce := true) xs call
     let packedFn ← PProdN.mk 0 fns
     let e ← lambdaBoundedTelescope F 1 fun f e => do
       let f := f[0]!
       -- Replace f with calls to the constants
-      let e := e.replace fun e => do if e == f then return packedFn else none
-      -- And reduce projection redexes
+      let e := e.replace fun e => do
+        if e == f then return packedFn else none
+      -- And reduce projection and beta redexes
+      -- (This is a bit blunt; we could try harder to only replace the projection and beta-redexes
+      -- introduced above)
       let e ← PProdN.reduceProjs e
+      let e ← Core.betaReduce e
       pure e
     k e
 
@@ -81,15 +92,12 @@ def partialFixpoint (preDefs : Array PreDefinition) : TermElabM Unit := do
           mkAppOptM ``FlatOrder.instCCPO #[none, classicalWitness]
       mkLambdaFVars xs inst
 
-  let fixedPrefixSize ← Mutual.getFixedPrefix preDefs
-  trace[Elab.definition.partialFixpoint] "fixed prefix size: {fixedPrefixSize}"
-
   let declNames := preDefs.map (·.declName)
-
-  forallBoundedTelescope preDefs[0]!.type fixedPrefixSize fun fixedArgs _ => do
+  let fixedParamPerms ← getFixedParamPerms preDefs
+  fixedParamPerms.perms[0]!.forallTelescope preDefs[0]!.type fun fixedArgs => do
     -- ∀ x y, CCPO (rᵢ x y)
-    let ccpoInsts := ccpoInsts.map (·.beta fixedArgs)
-    let types ← preDefs.mapM (instantiateForall ·.type fixedArgs)
+    let ccpoInsts ← ccpoInsts.mapIdxM (fixedParamPerms.perms[·]!.instantiateLambda · fixedArgs)
+    let types ← preDefs.mapIdxM (fixedParamPerms.perms[·]!.instantiateForall ·.type fixedArgs)
 
     -- (∀ x y, r₁ x y) ×' (∀ x y, r₂ x y)
     let packedType ← PProdN.pack 0 types
@@ -108,7 +116,7 @@ def partialFixpoint (preDefs : Array PreDefinition) : TermElabM Unit := do
 
     -- Error reporting hook, presenting monotonicity errors in terms of recursive functions
     let failK {α} f (monoThms : Array Name) : MetaM α := do
-      unReplaceRecApps preDefs fixedArgs f fun t => do
+      unReplaceRecApps preDefs fixedParamPerms fixedArgs f fun t => do
         let extraMsg := if monoThms.isEmpty then m!"" else
           m!"Tried to apply {.andList (monoThms.toList.map (m!"'{.ofConstName ·}'"))}, but failed.\n\
              Possible cause: A missing `{.ofConstName ``MonoBind}` instance.\n\
@@ -122,13 +130,13 @@ def partialFixpoint (preDefs : Array PreDefinition) : TermElabM Unit := do
 
     -- Adjust the body of each function to take the other functions as a
     -- (packed) parameter
-    let Fs ← preDefs.mapM fun preDef => do
-      let body ← instantiateLambda preDef.value fixedArgs
+    let Fs ← preDefs.mapIdxM fun funIdx preDef => do
+      let body ← fixedParamPerms.perms[funIdx]!.instantiateLambda preDef.value fixedArgs
       withLocalDeclD (← mkFreshUserName `f) packedType fun f => do
         let body' ← withoutModifyingEnv do
           -- replaceRecApps needs the constants in the env to typecheck things
           preDefs.forM (addAsAxiom ·)
-          replaceRecApps declNames fixedPrefixSize f body
+          replaceRecApps declNames fixedParamPerms f body
         mkLambdaFVars #[f] body'
 
     -- Construct and solve monotonicity goals for each function separately
@@ -160,7 +168,7 @@ def partialFixpoint (preDefs : Array PreDefinition) : TermElabM Unit := do
     trace[Elab.definition.partialFixpoint] "packedValue: {packedValue}"
 
     let declName :=
-      if preDefs.size = 1 then
+      if preDefs.size = 1 && fixedParamPerms.fixedArePrefix then
         preDefs[0]!.declName
       else
         preDefs[0]!.declName ++ `mutual
@@ -170,17 +178,22 @@ def partialFixpoint (preDefs : Array PreDefinition) : TermElabM Unit := do
       declName := declName
       type := packedType'
       value := packedValue'}
+
     let preDefsNonrec ← preDefs.mapIdxM fun fidx preDef => do
-      let us := preDefNonRec.levelParams.map mkLevelParam
-      let value := mkConst preDefNonRec.declName us
-      let value := mkAppN value fixedArgs
-      let value := PProdN.proj preDefs.size fidx packedType value
-      let value ← mkLambdaFVars fixedArgs value
-      pure { preDef with value }
+      forallBoundedTelescope preDef.type fixedParamPerms.perms[fidx]!.size fun params _ => do
+        let fixed := fixedParamPerms.perms[fidx]!.pickFixed params
+        let varying := fixedParamPerms.perms[fidx]!.pickVarying params
+        let us := preDefNonRec.levelParams.map mkLevelParam
+        let value := mkConst preDefNonRec.declName us
+        let value := mkAppN value fixed
+        let value := PProdN.proj preDefs.size fidx packedType value
+        let value := mkAppN value varying
+        let value ← mkLambdaFVars (etaReduce := true) params value
+        pure { preDef with value }
 
     Mutual.addPreDefsFromUnary preDefs preDefsNonrec preDefNonRec
     let preDefs ← Mutual.cleanPreDefs preDefs
-    PartialFixpoint.registerEqnsInfo preDefs preDefNonRec.declName fixedPrefixSize
+    PartialFixpoint.registerEqnsInfo preDefs preDefNonRec.declName fixedParamPerms
     Mutual.addPreDefAttributes preDefs
 
 end Lean.Elab

src/Lean/Elab/PreDefinition/Structural/BRecOn.lean

@@ -155,7 +155,8 @@ private partial def replaceRecApps (recArgInfos : Array RecArgInfo) (positions :
               try toBelow below recArgInfo.indGroupInst.params.size positions fnIdx recArg
               catch _ => throwError "failed to eliminate recursive application{indentExpr e}"
             -- We don't pass the fixed parameters, the indices and the major arg to `f`, only the rest
-            let (_, fArgs) := recArgInfo.pickIndicesMajor args[recArgInfo.numFixed:]
+            let ys := recArgInfo.fixedParamPerm.pickVarying args
+            let (_, fArgs) := recArgInfo.pickIndicesMajor ys
             let fArgs ← fArgs.mapM (replaceRecApps recArgInfos positions below ·)
             return mkAppN f fArgs
           else

src/Lean/Elab/PreDefinition/Structural/Eqns.lean

@@ -10,6 +10,7 @@ import Lean.Meta.Tactic.Simp.Main
 import Lean.Meta.Tactic.Apply
 import Lean.Elab.PreDefinition.Basic
 import Lean.Elab.PreDefinition.Eqns
+import Lean.Elab.PreDefinition.FixedParams
 import Lean.Elab.PreDefinition.Structural.Basic
 
 namespace Lean.Elab
@@ -21,7 +22,7 @@ namespace Structural
 structure EqnInfo extends EqnInfoCore where
   recArgPos : Nat
   declNames : Array Name
-  numFixed  : Nat
+  fixedParamPerms : FixedParamPerms
   deriving Inhabited
 
 private partial def mkProof (declName : Name) (type : Expr) : MetaM Expr := do
@@ -74,21 +75,26 @@ def mkEqns (info : EqnInfo) : MetaM (Array Name) :=
     trace[Elab.definition.structural.eqns] "eqnType {i}: {type}"
     let name := (Name.str baseName eqnThmSuffixBase).appendIndexAfter (i+1)
     thmNames := thmNames.push name
+    -- determinism: `type` should be independent of the environment changes since `baseName` was
+    -- added
+    realizeConst baseName name (doRealize name type)
+  return thmNames
+where
+  doRealize name type := withOptions (tactic.hygienic.set · false) do
     let value ← mkProof info.declName type
     let (type, value) ← removeUnusedEqnHypotheses type value
     addDecl <| Declaration.thmDecl {
       name, type, value
       levelParams := info.levelParams
     }
-  return thmNames
 
 builtin_initialize eqnInfoExt : MapDeclarationExtension EqnInfo ← mkMapDeclarationExtension
 
 def registerEqnsInfo (preDef : PreDefinition) (declNames : Array Name) (recArgPos : Nat)
-    (numFixed : Nat) : CoreM Unit := do
+    (fixedParamPerms : FixedParamPerms) : CoreM Unit := do
   ensureEqnReservedNamesAvailable preDef.declName
   modifyEnv fun env => eqnInfoExt.insert env preDef.declName
-    { preDef with recArgPos, declNames, numFixed }
+    { preDef with recArgPos, declNames, fixedParamPerms }
 
 def getEqnsFor? (declName : Name) : MetaM (Option (Array Name)) := do
   if let some info := eqnInfoExt.find? (← getEnv) declName then

src/Lean/Elab/PreDefinition/Structural/FindRecArg.lean

@@ -5,6 +5,7 @@ Authors: Leonardo de Moura, Joachim Breitner
 -/
 prelude
 import Lean.Elab.PreDefinition.TerminationMeasure
+import Lean.Elab.PreDefinition.FixedParams
 import Lean.Elab.PreDefinition.Structural.Basic
 import Lean.Elab.PreDefinition.Structural.RecArgInfo
 
@@ -58,9 +59,10 @@ private def hasBadParamDep? (ys : Array Expr) (indParams : Array Expr) : MetaM (
 Assemble the `RecArgInfo` for the `i`th parameter in the parameter list `xs`. This performs
 various sanity checks on the parameter (is it even of inductive type etc).
 -/
-def getRecArgInfo (fnName : Name) (numFixed : Nat) (xs : Array Expr) (i : Nat) : MetaM RecArgInfo := do
+def getRecArgInfo (fnName : Name) (fixedParamPerm : FixedParamPerm) (xs : Array Expr) (i : Nat) : MetaM RecArgInfo := do
+  assert! fixedParamPerm.size = xs.size
   if h : i < xs.size then
-    if i < numFixed then
+    if fixedParamPerm.isFixed i then
       throwError "it is unchanged in the recursive calls"
     let x := xs[i]
     let localDecl ← getFVarLocalDecl x
@@ -79,16 +81,14 @@ def getRecArgInfo (fnName : Name) (numFixed : Nat) (xs : Array Expr) (i : Nat) :
       else if !indIndices.allDiff then
         throwError "its type {indInfo.name} is an inductive family and indices are not pairwise distinct{indentExpr xType}"
       else
-        let indexMinPos := getIndexMinPos xs indIndices
-        let numFixed    := if indexMinPos < numFixed then indexMinPos else numFixed
-        let ys          := xs[numFixed:]
+        let ys := fixedParamPerm.pickVarying xs
         match (← hasBadIndexDep? ys indIndices) with
         | some (index, y) =>
           throwError "its type {indInfo.name} is an inductive family{indentExpr xType}\nand index{indentExpr index}\ndepends on the non index{indentExpr y}"
         | none =>
           match (← hasBadParamDep? ys indParams) with
           | some (indParam, y) =>
-            throwError "its type is an inductive datatype{indentExpr xType}\nand the datatype parameter{indentExpr indParam}\ndepends on the function parameter{indentExpr y}\nwhich does not come before the varying parameters and before the indices of the recursion parameter."
+            throwError "its type is an inductive datatype{indentExpr xType}\nand the datatype parameter{indentExpr indParam}\ndepends on the function parameter{indentExpr y}\nwhich is not fixed."
           | none =>
             let indAll := indInfo.all.toArray
             let .some indIdx := indAll.idxOf? indInfo.name | panic! "{indInfo.name} not in {indInfo.all}"
@@ -98,7 +98,7 @@ def getRecArgInfo (fnName : Name) (numFixed : Nat) (xs : Array Expr) (i : Nat) :
               levels := us
               params := indParams }
             return { fnName       := fnName
-                     numFixed     := numFixed
+                     fixedParamPerm := fixedParamPerm
                      recArgPos    := i
                      indicesPos   := indicesPos
                      indGroupInst := indGroupInst
@@ -115,25 +115,27 @@ The `xs` are the fixed parameters, `value` the body with the fixed prefix instan
 Takes the optional user annotation into account (`termMeasure?`). If this is given and the measure
 is unsuitable, throw an error.
 -/
-def getRecArgInfos (fnName : Name) (xs : Array Expr) (value : Expr)
-    (termMeasure? : Option TerminationMeasure) : MetaM (Array RecArgInfo × MessageData) := do
+def getRecArgInfos (fnName : Name) (fixedParamPerm : FixedParamPerm) (xs : Array Expr)
+    (value : Expr) (termMeasure? : Option TerminationMeasure) : MetaM (Array RecArgInfo × MessageData) := do
   lambdaTelescope value fun ys _ => do
     if let .some termMeasure := termMeasure? then
       -- User explicitly asked to use a certain measure, so throw errors eagerly
       let recArgInfo ← withRef termMeasure.ref do
         mapError (f := (m!"cannot use specified measure for structural recursion:{indentD ·}")) do
-          getRecArgInfo fnName xs.size (xs ++ ys) (← termMeasure.structuralArg)
+          let args := fixedParamPerm.buildArgs xs ys
+          getRecArgInfo fnName fixedParamPerm args (← termMeasure.structuralArg)
       return (#[recArgInfo], m!"")
     else
+      let args := fixedParamPerm.buildArgs xs ys
       let mut recArgInfos := #[]
       let mut report : MessageData := m!""
       -- No `termination_by`, so try all, and remember the errors
-      for idx in [:xs.size + ys.size] do
+      for idx in [:args.size] do
         try
-          let recArgInfo ← getRecArgInfo fnName xs.size (xs ++ ys) idx
+          let recArgInfo ← getRecArgInfo fnName fixedParamPerm args idx
           recArgInfos := recArgInfos.push recArgInfo
         catch e =>
-          report := report ++ (m!"Not considering parameter {← prettyParam (xs ++ ys) idx} of {fnName}:" ++
+          report := report ++ (m!"Not considering parameter {← prettyParam args idx} of {fnName}:" ++
             indentD e.toMessageData) ++ "\n"
       trace[Elab.definition.structural] "getRecArgInfos report: {report}"
       return (recArgInfos, report)
@@ -211,7 +213,7 @@ def argsInGroup (group : IndGroupInst) (xs : Array Expr) (value : Expr)
           let indicesPos := indIndices.map fun index => match (xs++ys).idxOf? index with | some i => i | none => unreachable!
           return .some
             { fnName       := recArgInfo.fnName
-              numFixed     := recArgInfo.numFixed
+              fixedParamPerm  := recArgInfo.fixedParamPerm
               recArgPos    := recArgInfo.recArgPos
               indicesPos   := indicesPos
               indGroupInst := group
@@ -232,13 +234,13 @@ def allCombinations (xss : Array (Array α)) : Option (Array (Array α)) :=
     some (go 0 #[])
 
 
-def tryAllArgs (fnNames : Array Name) (xs : Array Expr) (values : Array Expr)
-   (termMeasure?s : Array (Option TerminationMeasure)) (k : Array RecArgInfo → M α) : M α := do
+def tryAllArgs (fnNames : Array Name) (fixedParamPerms : FixedParamPerms) (xs : Array Expr)
+   (values : Array Expr) (termMeasure?s : Array (Option TerminationMeasure)) (k : Array RecArgInfo → M α) : M α := do
   let mut report := m!""
   -- Gather information on all possible recursive arguments
   let mut recArgInfoss := #[]
-  for fnName in fnNames, value in values, termMeasure? in termMeasure?s do
-    let (recArgInfos, thisReport) ← getRecArgInfos fnName xs value termMeasure?
+  for fnName in fnNames, value in values, termMeasure? in termMeasure?s, fixedParamPerm in fixedParamPerms.perms do
+    let (recArgInfos, thisReport) ← getRecArgInfos fnName fixedParamPerm xs value termMeasure?
     report := report ++ thisReport
     recArgInfoss := recArgInfoss.push recArgInfos
   -- Put non-indices first
@@ -266,8 +268,6 @@ def tryAllArgs (fnNames : Array Name) (xs : Array Expr) (values : Array Expr)
           -- are ok in a nested group. This logic can maybe simplified)
           unless (← hasConst (group.brecOnName false 0)) do
             throwError "the type {group} does not have a `.brecOn` recursor"
-          -- TODO: Here we used to save and restore the state. But should the `try`-`catch`
-          -- not suffice?
           let r ← k comb
           trace[Elab.definition.structural] "tryAllArgs report:\n{report}"
           return r

src/Lean/Elab/PreDefinition/Structural/IndPred.lean

@@ -12,23 +12,24 @@ import Lean.Elab.PreDefinition.Structural.RecArgInfo
 namespace Lean.Elab.Structural
 open Meta
 
-private def replaceIndPredRecApp (numFixed : Nat) (funType : Expr) (e : Expr) : M Expr := do
+private def replaceIndPredRecApp (fixedParamPerm : FixedParamPerm) (funType : Expr) (e : Expr) : M Expr := do
   withoutProofIrrelevance do
   withTraceNode `Elab.definition.structural (fun _ => pure m!"eliminating recursive call {e}") do
     -- We want to replace `e` with an expression of the same type
     let main ← mkFreshExprSyntheticOpaqueMVar (← inferType e)
-    let args : Array Expr := e.getAppArgs[numFixed:]
+    let args : Array Expr := e.getAppArgs
+    let ys := fixedParamPerm.pickVarying args
     let lctx ← getLCtx
     let r ← lctx.anyM fun localDecl => do
       if localDecl.isAuxDecl then return false
       let (mvars, _, t) ← forallMetaTelescope localDecl.type -- NB: do not reduce, we want to see the `funType`
       unless t.getAppFn == funType do return false
       withTraceNodeBefore `Elab.definition.structural (do pure m!"trying {mkFVar localDecl.fvarId} : {localDecl.type}") do
-        if args.size < t.getAppNumArgs then
-          trace[Elab.definition.structural] "too few arguments. Underapplied recursive call?"
+        if ys.size < t.getAppNumArgs then
+          trace[Elab.definition.structural] "too few arguments, expected {t.getAppNumArgs}, found {ys.size}. Underapplied recursive call?"
           return false
-        if (← (t.getAppArgs.zip args).allM (fun (t,s) => isDefEq t s)) then
-          main.mvarId!.assign (mkAppN (mkAppN localDecl.toExpr mvars) args[t.getAppNumArgs:])
+        if (← (t.getAppArgs.zip ys).allM (fun (t,s) => isDefEq t s)) then
+          main.mvarId!.assign (mkAppN (mkAppN localDecl.toExpr mvars) ys[t.getAppNumArgs:])
           return ← mvars.allM fun v => do
             unless (← v.mvarId!.isAssigned) do
               trace[Elab.definition.structural] "Cannot use {mkFVar localDecl.fvarId}: parameter {v} remains unassigned"
@@ -62,7 +63,7 @@ private partial def replaceIndPredRecApps (recArgInfo : RecArgInfo) (funType : E
       let processApp (e : Expr) : M Expr := do
         e.withApp fun f args => do
           if f.isConstOf recArgInfo.fnName then
-            replaceIndPredRecApp recArgInfo.numFixed funType e
+            replaceIndPredRecApp recArgInfo.fixedParamPerm funType e
           else
             return mkAppN (← loop f) (← args.mapM loop)
       match (← matchMatcherApp? e) with
@@ -100,7 +101,7 @@ def mkIndPredBRecOn (recArgInfo : RecArgInfo) (value : Expr) : M Expr := do
   lambdaTelescope value fun ys value => do
     let type  := (← inferType value).headBeta
     let (indexMajorArgs, otherArgs) := recArgInfo.pickIndicesMajor ys
-    trace[Elab.definition.structural] "numFixed: {recArgInfo.numFixed}, indexMajorArgs: {indexMajorArgs}, otherArgs: {otherArgs}"
+    trace[Elab.definition.structural] "indexMajorArgs: {indexMajorArgs}, otherArgs: {otherArgs}"
     let funType ← mkLambdaFVars ys type
     withLetDecl `funType (← inferType funType) funType fun funType => do
       let motive ← mkForallFVars otherArgs (mkAppN funType ys)

src/Lean/Elab/PreDefinition/Structural/Main.lean

@@ -5,6 +5,7 @@ Authors: Leonardo de Moura, Joachim Breitner
 -/
 prelude
 import Lean.Elab.PreDefinition.TerminationMeasure
+import Lean.Elab.PreDefinition.Mutual
 import Lean.Elab.PreDefinition.Structural.Basic
 import Lean.Elab.PreDefinition.Structural.FindRecArg
 import Lean.Elab.PreDefinition.Structural.Preprocess
@@ -71,27 +72,9 @@ where
       withLocalDecl vals[0]!.bindingName! vals[0]!.binderInfo vals[0]!.bindingDomain! fun x =>
         go (fvars.push x) (vals.map fun val => val.bindingBody!.instantiate1 x)
 
-def getMutualFixedPrefix (preDefs : Array PreDefinition) : M Nat :=
-  withCommonTelescope preDefs fun xs vals => do
-    let resultRef ← IO.mkRef xs.size
-    for val in vals do
-      if (← resultRef.get) == 0 then return 0
-      forEachExpr' val fun e => do
-        if preDefs.any fun preDef => e.isAppOf preDef.declName then
-          let args := e.getAppArgs
-          resultRef.modify (min args.size ·)
-          for arg in args, x in xs do
-            if !(← withoutProofIrrelevance <| withReducible <| isDefEq arg x) then
-              -- We continue searching if e's arguments are not a prefix of `xs`
-              return true
-          return false
-        else
-          return true
-    resultRef.get
-
-private def elimMutualRecursion (preDefs : Array PreDefinition) (xs : Array Expr)
-    (recArgInfos : Array RecArgInfo) : M (Array PreDefinition) := do
-  let values ← preDefs.mapM (instantiateLambda ·.value xs)
+private def elimMutualRecursion (preDefs : Array PreDefinition) (fixedParamPerms : FixedParamPerms)
+    (xs : Array Expr) (recArgInfos : Array RecArgInfo) : M (Array PreDefinition) := do
+  let values ← preDefs.mapIdxM (fixedParamPerms.perms[·]!.instantiateLambda ·.value xs)
   let indInfo ← getConstInfoInduct recArgInfos[0]!.indGroupInst.all[0]!
   if ← isInductivePredicate indInfo.name then
     -- Here we branch off to the IndPred construction, but only for non-mutual functions
@@ -102,7 +85,8 @@ private def elimMutualRecursion (preDefs : Array PreDefinition) (xs : Array Expr
     let recArgInfo := recArgInfos[0]!
     let value := values[0]!
     let valueNew ← mkIndPredBRecOn recArgInfo value
-    let valueNew ← mkLambdaFVars xs valueNew
+    let valueNew ← lambdaTelescope value fun ys _ => do
+      mkLambdaFVars (etaReduce := true) (fixedParamPerms.perms[0]!.buildArgs xs ys) (mkAppN valueNew ys)
     trace[Elab.definition.structural] "Nonrecursive value:{indentExpr valueNew}"
     check valueNew
     return #[{ preDef with value := valueNew }]
@@ -123,12 +107,16 @@ private def elimMutualRecursion (preDefs : Array PreDefinition) (xs : Array Expr
   -- Assemble the individual `.brecOn` applications
   let valuesNew ← (Array.zip recArgInfos values).mapIdxM fun i (r, v) =>
     mkBrecOnApp positions i brecOnConst FArgs r v
-  -- Abstract over the fixed prefixed
-  let valuesNew ← valuesNew.mapM (mkLambdaFVars xs ·)
+  -- Abstract over the fixed prefixed, preserving the original parameter order
+  let valuesNew ← (values.zip valuesNew).mapIdxM fun i ⟨value, valueNew⟩ =>
+    lambdaTelescope value fun ys _ => do
+      -- NB: Do not eta-contract here, other code (e.g. FunInd) expects this to have the
+      -- same number of head lambdas as the original definition
+      mkLambdaFVars (fixedParamPerms.perms[i]!.buildArgs xs ys) (valueNew.beta ys)
   return (Array.zip preDefs valuesNew).map fun ⟨preDef, valueNew⟩ => { preDef with value := valueNew }
 
 private def inferRecArgPos (preDefs : Array PreDefinition) (termMeasure?s : Array (Option TerminationMeasure)) :
-    M (Array Nat × (Array PreDefinition) × Nat) := do
+    M (Array Nat × (Array PreDefinition) × FixedParamPerms) := do
   withoutModifyingEnv do
     preDefs.forM (addAsAxiom ·)
     let fnNames := preDefs.map (·.declName)
@@ -136,25 +124,39 @@ private def inferRecArgPos (preDefs : Array PreDefinition) (termMeasure?s : Arra
       return { preDef with value := (← preprocess preDef.value fnNames) }
 
     -- The syntactically fixed arguments
-    let maxNumFixed ← getMutualFixedPrefix preDefs
+    let fixedParamPerms ← getFixedParamPerms preDefs
 
-    lambdaBoundedTelescope preDefs[0]!.value maxNumFixed fun xs _ => do
-      assert! xs.size = maxNumFixed
-      let values ← preDefs.mapM (instantiateLambda ·.value xs)
+    fixedParamPerms.perms[0]!.forallTelescope preDefs[0]!.type fun xs => do
+      let values ← preDefs.mapIdxM (fixedParamPerms.perms[·]!.instantiateLambda ·.value xs)
 
-      tryAllArgs fnNames xs values termMeasure?s fun recArgInfos => do
+      tryAllArgs fnNames fixedParamPerms xs values termMeasure?s fun recArgInfos => do
         let recArgPoss := recArgInfos.map (·.recArgPos)
         trace[Elab.definition.structural] "Trying argument set {recArgPoss}"
-        let numFixed := recArgInfos.foldl (·.min ·.numFixed) maxNumFixed
-        if numFixed < maxNumFixed then
-          trace[Elab.definition.structural] "Reduced numFixed from {maxNumFixed} to {numFixed}"
-        -- We may have decreased the number of arguments we consider fixed, so update
-        -- the recArgInfos, remove the extra arguments from local environment, and recalculate value
-        let recArgInfos := recArgInfos.map ({· with numFixed := numFixed })
-        withErasedFVars (xs.extract numFixed xs.size |>.map (·.fvarId!)) do
-          let xs := xs[:numFixed]
-          let preDefs' ← elimMutualRecursion preDefs xs recArgInfos
-          return (recArgPoss, preDefs', numFixed)
+        let (fixedParamPerms', xs', toErase) := fixedParamPerms.erase xs (recArgInfos.map (·.indicesAndRecArgPos))
+        -- We may have to turn some fixed parameters into varying parameters
+        let recArgInfos := recArgInfos.mapIdx fun i recArgInfo =>
+          {recArgInfo with fixedParamPerm := fixedParamPerms'.perms[i]!}
+        if xs'.size != xs.size then
+          trace[Elab.definition.structural] "Reduced fixed params from {xs} to {xs'}, erasing {toErase.map mkFVar}"
+          trace[Elab.definition.structural] "New recArgInfos {repr recArgInfos}"
+        -- Check that the parameters of the IndGroupInsts are still fine
+          for recArgInfo in recArgInfos do
+            for indParam in recArgInfo.indGroupInst.params do
+              for y in toErase do
+                if (← dependsOn indParam y) then
+                  if indParam.isFVarOf y then
+                    throwError "its type is an inductive datatype and the datatype parameter\
+                      {indentExpr indParam}\n\
+                      which cannot be fixed as it is an index or depends on an index, and indices \
+                      cannot be fixed parameters when using structural recursion."
+                  else
+                    throwError "its type is an inductive datatype and the datatype parameter\
+                      {indentExpr indParam}\ndepends on the function parameter{indentExpr (mkFVar y)}\n\
+                      which cannot be fixed as it is an index or depends on an index, and indices \
+                      cannot be fixed parameters when using structural recursion."
+        withErasedFVars toErase do
+          let preDefs' ← elimMutualRecursion preDefs fixedParamPerms' xs' recArgInfos
+          return (recArgPoss, preDefs', fixedParamPerms')
 
 def reporttermMeasure (preDef : PreDefinition) (recArgPos : Nat) : MetaM Unit := do
   if let some ref := preDef.termination.terminationBy?? then
@@ -167,7 +169,7 @@ def reporttermMeasure (preDef : PreDefinition) (recArgPos : Nat) : MetaM Unit :=
 
 def structuralRecursion (preDefs : Array PreDefinition) (termMeasure?s : Array (Option TerminationMeasure)) : TermElabM Unit := do
   let names := preDefs.map (·.declName)
-  let ((recArgPoss, preDefsNonRec, numFixed), state) ← run <| inferRecArgPos preDefs termMeasure?s
+  let ((recArgPoss, preDefsNonRec, fixedParamPerms), state) ← run <| inferRecArgPos preDefs termMeasure?s
   for recArgPos in recArgPoss, preDef in preDefs do
     reporttermMeasure preDef recArgPos
   state.addMatchers.forM liftM
@@ -190,7 +192,7 @@ def structuralRecursion (preDefs : Array PreDefinition) (termMeasure?s : Array (
         for theorems and definitions that are propositions.
         See issue #2327
         -/
-        registerEqnsInfo preDef (preDefs.map (·.declName)) recArgPos numFixed
+        registerEqnsInfo preDef (preDefs.map (·.declName)) recArgPos fixedParamPerms
     addSmartUnfoldingDef preDef recArgPos
     markAsRecursive preDef.declName
   for preDef in preDefs do

src/Lean/Elab/PreDefinition/Structural/RecArgInfo.lean

@@ -6,6 +6,7 @@ Authors: Leonardo de Moura, Joachim Breitner
 prelude
 import Lean.Meta.Basic
 import Lean.Meta.ForEachExpr
+import Lean.Elab.PreDefinition.FixedParams
 import Lean.Elab.PreDefinition.Structural.IndGroupInfo
 
 namespace Lean.Elab.Structural
@@ -14,18 +15,18 @@ namespace Lean.Elab.Structural
 /--
 Information about the argument of interest of a structurally recursive function.
 
-The `Expr`s in this data structure expect the `fixedParams` to be in scope, but not the other
+The `Expr`s in this data structure expect the fixed parameters to be in scope, but not the other
 parameters of the function. This ensures that this data structure makes sense in the other functions
 of a mutually recursive group.
 -/
 structure RecArgInfo where
   /-- the name of the recursive function -/
   fnName       : Name
-  /-- the fixed prefix of arguments of the function we are trying to justify termination using structural recursion. -/
-  numFixed     : Nat
-  /-- position (counted including fixed prefix) of the argument we are recursing on -/
+  /-- Information which arguments are fixed -/
+  fixedParamPerm : FixedParamPerm
+  /-- position of the argument we are recursing on, among all parameters -/
   recArgPos    : Nat
-  /-- position (counted including fixed prefix) of the indices of the inductive datatype we are recursing on -/
+  /-- position of the indices of the inductive datatype we are recursing on, among all parameters -/
   indicesPos   : Array Nat
   /-- The inductive group (with parameters) of the argument's type -/
   indGroupInst : IndGroupInst
@@ -36,23 +37,29 @@ structure RecArgInfo where
   indIdx       : Nat
 deriving Inhabited, Repr
 
+  /-- position of the argument and its indices we are recursing on, among all parameters -/
+def RecArgInfo.indicesAndRecArgPos (info : RecArgInfo) : Array Nat :=
+  info.indicesPos.push info.recArgPos
+
 /--
-If `xs` are the parameters of the functions (excluding fixed prefix), partitions them
-into indices and major arguments, and other parameters.
+If `xs` are the varing parameters of the functions, partitions them into indices and major
+arguments, and other parameters.
 -/
 def RecArgInfo.pickIndicesMajor (info : RecArgInfo) (xs : Array Expr) : (Array Expr × Array Expr) := Id.run do
+  -- To simplify the index calculation, pad xs with dummy values where fixed parameters are
+  let xs := info.fixedParamPerm.buildArgs (mkArray info.fixedParamPerm.numFixed (mkSort 0)) xs
   -- First indices and major arg, using the order they appear in `info.indicesPos`
   let mut indexMajorArgs := #[]
   let indexMajorPos := info.indicesPos.push info.recArgPos
   for j in indexMajorPos do
-    assert! info.numFixed ≤ j && j - info.numFixed < xs.size
-    indexMajorArgs := indexMajorArgs.push xs[j - info.numFixed]!
+    indexMajorArgs := indexMajorArgs.push xs[j]!
   -- Then the other arguments, in the order they appear in `xs`
-  let mut otherArgs := #[]
+  let mut otherVaryingArgs := #[]
   for h : i in [:xs.size] do
-    unless indexMajorPos.contains (i + info.numFixed) do
-      otherArgs := otherArgs.push xs[i]
-  return (indexMajorArgs, otherArgs)
+    unless indexMajorPos.contains i do
+      unless info.fixedParamPerm.isFixed i do
+        otherVaryingArgs := otherVaryingArgs.push xs[i]
+  return (indexMajorArgs, otherVaryingArgs)
 
 /--
 Name of the recursive data type. Assumes that it is not one of the auxiliary ones.

src/Lean/Elab/PreDefinition/TerminationMeasure.lean

@@ -52,7 +52,6 @@ Elaborates a `TerminationBy` to an `TerminationMeasure`.
 def TerminationMeasure.elab (funName : Name) (type : Expr) (arity extraParams : Nat)
     (hint : TerminationBy) : TermElabM TerminationMeasure := withDeclName funName do
   assert! extraParams ≤ arity
-
   if h : hint.vars.size > extraParams then
     let mut msg := m!"{parameters hint.vars.size} bound in `termination_by`, but the body of " ++
       m!"{funName} only binds {parameters extraParams}."
@@ -64,7 +63,7 @@ def TerminationMeasure.elab (funName : Name) (type : Expr) (arity extraParams :
 
   -- Bring parameters before the colon into scope
   let r ← withoutErrToSorry <|
-    forallBoundedTelescope type (arity - extraParams) fun ys type' => do
+    forallBoundedTelescope (cleanupAnnotations := true) type (arity - extraParams) fun ys type' => do
       -- Bring the variables bound by `termination_by` into scope.
       elabFunBinders hint.vars (some type') fun xs type' => do
         -- Elaborate the body in this local environment

src/Lean/Elab/PreDefinition/WF/Eqns.lean

@@ -10,6 +10,7 @@ import Lean.Elab.PreDefinition.Basic
 import Lean.Elab.PreDefinition.Eqns
 import Lean.Meta.ArgsPacker.Basic
 import Lean.Elab.PreDefinition.WF.Unfold
+import Lean.Elab.PreDefinition.FixedParams
 import Init.Data.Array.Basic
 
 namespace Lean.Elab.WF
@@ -21,13 +22,15 @@ structure EqnInfo extends EqnInfoCore where
   declNameNonRec  : Name
   fixedPrefixSize : Nat
   argsPacker      : ArgsPacker
+  fixedParamPerms : FixedParamPerms
   deriving Inhabited
 
 
 builtin_initialize eqnInfoExt : MapDeclarationExtension EqnInfo ← mkMapDeclarationExtension
 
-def registerEqnsInfo (preDefs : Array PreDefinition) (declNameNonRec : Name) (fixedPrefixSize : Nat)
+def registerEqnsInfo (preDefs : Array PreDefinition) (declNameNonRec : Name) (fixedParamPerms : FixedParamPerms)
     (argsPacker : ArgsPacker) : MetaM Unit := do
+  let fixedPrefixSize := fixedParamPerms.numFixed
   preDefs.forM fun preDef => ensureEqnReservedNamesAvailable preDef.declName
   /-
   See issue #2327.
@@ -40,7 +43,7 @@ def registerEqnsInfo (preDefs : Array PreDefinition) (declNameNonRec : Name) (fi
       modifyEnv fun env =>
         preDefs.foldl (init := env) fun env preDef =>
           eqnInfoExt.insert env preDef.declName { preDef with
-            declNames, declNameNonRec, fixedPrefixSize, argsPacker }
+            declNames, declNameNonRec, fixedPrefixSize, argsPacker, fixedParamPerms }
 
 def getEqnsFor? (declName : Name) : MetaM (Option (Array Name)) := do
   if let some info := eqnInfoExt.find? (← getEnv) declName then

src/Lean/Elab/PreDefinition/WF/Fix.lean

@@ -17,6 +17,11 @@ import Lean.Util.HasConstCache
 namespace Lean.Elab.WF
 open Meta
 
+register_builtin_option debug.definition.wf.replaceRecApps : Bool := {
+    defValue := false
+    descr    := "Type check every step of the well-founded definition translation"
+  }
+
 /-
 Creates a subgoal for a recursive call, as an unsolved `MVar`. The goal is cleaned up, and
 the current syntax reference is stored in the `MVar`’s type as a `RecApp` marker, for
@@ -32,11 +37,13 @@ private def mkDecreasingProof (decreasingProp : Expr) : TermElabM Expr := do
 
 private partial def replaceRecApps (recFnName : Name) (fixedPrefixSize : Nat) (F : Expr) (e : Expr) : TermElabM Expr := do
   trace[Elab.definition.wf] "replaceRecApps:{indentExpr e}"
-  trace[Elab.definition.wf] "{F} : {← inferType F}"
-  loop F e |>.run' {}
+  trace[Elab.definition.wf] "type of functorial {F} is{indentExpr (← inferType F)}"
+  let e ← loop F e |>.run' {}
+  return e
 where
   processRec (F : Expr) (e : Expr) : StateRefT (HasConstCache #[recFnName]) TermElabM Expr := do
     if e.getAppNumArgs < fixedPrefixSize + 1 then
+      trace[Elab.definition.wf] "replaceRecApp: eta-expanding{indentExpr e}"
       loop F (← etaExpand e)
     else
       let args := e.getAppArgs
@@ -55,6 +62,19 @@ where
     modifyGet (·.contains e)
 
   loop (F : Expr) (e : Expr) : StateRefT (HasConstCache #[recFnName]) TermElabM Expr := do
+    let e' ← loopGo F e
+    if (debug.definition.wf.replaceRecApps.get (← getOptions)) then
+      withTransparency .all do withNewMCtxDepth do
+        unless (← isTypeCorrect e') do
+          throwError "Type error introduced when transforming{indentExpr e}\nto{indentExpr e'}"
+        let t1 ← inferType e
+        let t2 ← inferType e'
+        unless (← isDefEq t1 t2) do
+          let (t1, t2) ← addPPExplicitToExposeDiff t1 t2
+          throwError "Type not preserved transforming{indentExpr e}\nto{indentExpr e'}\nType was{indentExpr t1}\nand now is{indentExpr t2}"
+    return e'
+
+  loopGo (F : Expr) (e : Expr) : StateRefT (HasConstCache #[recFnName]) TermElabM Expr := do
     if !(← containsRecFn e) then
       return e
     match e with
@@ -83,7 +103,8 @@ where
               unless xs.size = numParams do
                 throwError "unexpected matcher application alternative{indentExpr alt}\nat application{indentExpr e}"
               let FAlt := xs[numParams - 1]!
-              mkLambdaFVars xs (← loop FAlt altBody)
+              let altBody' ← loop FAlt altBody
+              mkLambdaFVars xs altBody'
           return { matcherApp with alts := altsNew, discrs := (← matcherApp.discrs.mapM (loop F)) }.toExpr
         else
           processApp F e
@@ -183,34 +204,35 @@ def groupGoalsByFunction (argsPacker : ArgsPacker) (numFuncs : Nat) (goals : Arr
     r := r.modify funidx (·.push goal)
   return r
 
-def solveDecreasingGoals (argsPacker : ArgsPacker) (decrTactics : Array (Option DecreasingBy)) (value : Expr) : MetaM Expr := do
+def solveDecreasingGoals (funNames : Array Name) (argsPacker : ArgsPacker) (decrTactics : Array (Option DecreasingBy)) (value : Expr) : MetaM Expr := do
   let goals ← getMVarsNoDelayed value
   let goals ← assignSubsumed goals
   let goalss ← groupGoalsByFunction argsPacker decrTactics.size goals
-  for goals in goalss, decrTactic? in decrTactics do
+  for funName in funNames, goals in goalss, decrTactic? in decrTactics do
     Lean.Elab.Term.TermElabM.run' do
-    match decrTactic? with
-    | none => do
-      for goal in goals do
-        let type ← goal.getType
-        let some ref := getRecAppSyntax? (← goal.getType)
-          | throwError "MVar not annotated as a recursive call:{indentExpr type}"
-        withRef ref <| applyDefaultDecrTactic goal
-    | some decrTactic => withRef decrTactic.ref do
-      unless goals.isEmpty do -- unlikely to be empty
-        -- make info from `runTactic` available
-        goals.forM fun goal => pushInfoTree (.hole goal)
-        let remainingGoals ← Tactic.run goals[0]! do
-          Tactic.setGoals goals.toList
-          applyCleanWfTactic
-          Tactic.withTacticInfoContext decrTactic.ref do
-            Tactic.evalTactic decrTactic.tactic
-        unless remainingGoals.isEmpty do
-          Term.reportUnsolvedGoals remainingGoals
+    Term.withDeclName funName do
+      match decrTactic? with
+      | none => do
+        for goal in goals do
+          let type ← goal.getType
+          let some ref := getRecAppSyntax? (← goal.getType)
+            | throwError "MVar not annotated as a recursive call:{indentExpr type}"
+          withRef ref <| applyDefaultDecrTactic goal
+      | some decrTactic => withRef decrTactic.ref do
+        unless goals.isEmpty do -- unlikely to be empty
+          -- make info from `runTactic` available
+          goals.forM fun goal => pushInfoTree (.hole goal)
+          let remainingGoals ← Tactic.run goals[0]! do
+            Tactic.setGoals goals.toList
+            applyCleanWfTactic
+            Tactic.withTacticInfoContext decrTactic.ref do
+              Tactic.evalTactic decrTactic.tactic
+          unless remainingGoals.isEmpty do
+            Term.reportUnsolvedGoals remainingGoals
   instantiateMVars value
 
 def mkFix (preDef : PreDefinition) (prefixArgs : Array Expr) (argsPacker : ArgsPacker)
-    (wfRel : Expr) (decrTactics : Array (Option DecreasingBy)) : TermElabM Expr := do
+    (wfRel : Expr) (funNames : Array Name) (decrTactics : Array (Option DecreasingBy)) : TermElabM Expr := do
   let type ← instantiateForall preDef.type prefixArgs
   let (wfFix, varName) ← forallBoundedTelescope type (some 1) fun x type => do
     let x := x[0]!
@@ -233,7 +255,7 @@ def mkFix (preDef : PreDefinition) (prefixArgs : Array Expr) (argsPacker : ArgsP
       let val := preDef.value.beta (prefixArgs.push x)
       let val ← processSumCasesOn x F val fun x F val => do
         processPSigmaCasesOn x F val (replaceRecApps preDef.declName prefixArgs.size)
-      let val ← solveDecreasingGoals argsPacker decrTactics val
+      let val ← solveDecreasingGoals funNames argsPacker decrTactics val
       mkLambdaFVars prefixArgs (mkApp wfFix (← mkLambdaFVars #[x, F] val))
 
 end Lean.Elab.WF

src/Lean/Elab/PreDefinition/WF/GuessLex.lean

@@ -13,8 +13,10 @@ import Lean.Meta.ArgsPacker
 import Lean.Elab.Quotation
 import Lean.Elab.RecAppSyntax
 import Lean.Elab.PreDefinition.Basic
+import Lean.Elab.PreDefinition.Mutual
 import Lean.Elab.PreDefinition.Structural.Basic
 import Lean.Elab.PreDefinition.TerminationMeasure
+import Lean.Elab.PreDefinition.FixedParams
 import Lean.Elab.PreDefinition.WF.Basic
 import Lean.Data.Array
 
@@ -169,24 +171,25 @@ def withUserNames {α} (xs : Array Expr) (ns : Array Name) (k : MetaM α) : Meta
   withLCtx' lctx k
 
 /-- Create one measure for each (eligible) parameter of the given predefintion.  -/
-def simpleMeasures (preDefs : Array PreDefinition) (fixedPrefixSize : Nat)
+def simpleMeasures (preDefs : Array PreDefinition) (fixedParamPerms : FixedParamPerms)
     (userVarNamess : Array (Array Name)) : MetaM (Array (Array BasicMeasure)) := do
   let is_mutual : Bool := preDefs.size > 1
   preDefs.mapIdxM fun funIdx preDef => do
-    lambdaTelescope preDef.value fun xs _ => do
-      withUserNames xs[fixedPrefixSize:] userVarNamess[funIdx]! do
+    lambdaTelescope preDef.value fun params _ => do
+      let xs := fixedParamPerms.perms[funIdx]!.pickVarying params
+      withUserNames xs userVarNamess[funIdx]! do
         let mut ret : Array BasicMeasure := #[]
-        for x in xs[fixedPrefixSize:] do
+        for x in xs do
           -- If the `SizeOf` instance produces a constant (e.g. because it's type is a `Prop` or
           -- `Type`), then ignore this parameter
           let sizeOf ← whnfD (← mkAppM ``sizeOf #[x])
           if sizeOf.isLit then continue
 
-          let natFn ← mkLambdaFVars xs (← mkAppM ``sizeOf #[x])
+          let natFn ← mkLambdaFVars params (← mkAppM ``sizeOf #[x])
           -- Determine if we need to exclude `sizeOf` in the measure we show/pass on.
           let fn ←
-            if  ← mayOmitSizeOf is_mutual xs[fixedPrefixSize:] x
-            then mkLambdaFVars xs x
+            if  ← mayOmitSizeOf is_mutual xs x
+            then mkLambdaFVars params x
             else pure natFn
           ret := ret.push { ref := .missing, structural := false, fn, natFn }
         return ret
@@ -339,24 +342,26 @@ def filterSubsumed (rcs : Array RecCallWithContext ) : Array RecCallWithContext
 Traverse a unary `PreDefinition`, and returns a `WithRecCall` closure for each recursive
 call site.
 -/
-def collectRecCalls (unaryPreDef : PreDefinition) (fixedPrefixSize : Nat)
+def collectRecCalls (unaryPreDef : PreDefinition) (fixedParamPerms : FixedParamPerms)
     (argsPacker : ArgsPacker) : MetaM (Array RecCallWithContext) := withoutModifyingState do
   addAsAxiom unaryPreDef
-  lambdaBoundedTelescope unaryPreDef.value (fixedPrefixSize + 1) fun xs body => do
-    unless xs.size == fixedPrefixSize + 1 do
+  lambdaBoundedTelescope unaryPreDef.value (fixedParamPerms.numFixed + 1) fun xs body => do
+    unless xs.size == fixedParamPerms.numFixed + 1 do
       throwError "Unexpected number of lambdas in unary pre-definition"
-    let ys := xs[:fixedPrefixSize]
-    let param := xs[fixedPrefixSize]!
-    withRecApps unaryPreDef.declName fixedPrefixSize param body fun param args => do
-      unless args.size ≥ fixedPrefixSize + 1 do
+    let ys := xs[:fixedParamPerms.numFixed]
+    let param := xs[fixedParamPerms.numFixed]!
+    withRecApps unaryPreDef.declName fixedParamPerms.numFixed param body fun param args => do
+      unless args.size ≥ fixedParamPerms.numFixed + 1 do
         throwError "Insufficient arguments in recursive call"
-      let arg := args[fixedPrefixSize]!
+      let arg := args[fixedParamPerms.numFixed]!
       trace[Elab.definition.wf] "collectRecCalls: {unaryPreDef.declName} ({param}) → {unaryPreDef.declName} ({arg})"
       let some (caller, params) := argsPacker.unpack param
         | throwError "Cannot unpack param, unexpected expression:{indentExpr param}"
       let some (callee, args) := argsPacker.unpack arg
         | throwError "Cannot unpack arg, unexpected expression:{indentExpr arg}"
-      RecCallWithContext.create (← getRef) caller (ys ++ params) callee (ys ++ args)
+      let callerParams := fixedParamPerms.perms[caller]!.buildArgs ys params
+      let calleeArgs := fixedParamPerms.perms[callee]!.buildArgs ys args
+      RecCallWithContext.create (← getRef) caller callerParams callee calleeArgs
 
 /-- Is the expression a `<`-like comparison of `Nat` expressions -/
 def isNatCmp (e : Expr) : Option (Expr × Expr) :=
@@ -367,7 +372,7 @@ def isNatCmp (e : Expr) : Option (Expr × Expr) :=
   | GE.ge α _ e₁ e₂ => if α.isConstOf ``Nat then some (e₂, e₁) else none
   | _ => none
 
-def complexMeasures (preDefs : Array PreDefinition) (fixedPrefixSize : Nat)
+def complexMeasures (preDefs : Array PreDefinition) (fixedParamPerms : FixedParamPerms)
     (userVarNamess : Array (Array Name)) (recCalls : Array RecCallWithContext) :
     MetaM (Array (Array BasicMeasure)) := do
   preDefs.mapIdxM fun funIdx _preDef => do
@@ -377,20 +382,21 @@ def complexMeasures (preDefs : Array PreDefinition) (fixedPrefixSize : Nat)
       unless rc.caller = funIdx do continue
       -- Only look at calls where the parameters have not been refined
       unless rc.params.all (·.isFVar) do continue
-      let xs := rc.params.map (·.fvarId!)
-      let varyingParams : Array FVarId := xs[fixedPrefixSize:]
+      let varyingParams := fixedParamPerms.perms[funIdx]!.pickVarying rc.params
+      let varyingFVars := varyingParams.map (·.fvarId!)
+      let params := rc.params.map (·.fvarId!)
       measures ← rc.ctxt.run do
-        withUserNames rc.params[fixedPrefixSize:] userVarNamess[funIdx]! do
+        withUserNames varyingParams userVarNamess[funIdx]! do
         trace[Elab.definition.wf] "rc: {rc.caller} ({rc.params}) → {rc.callee} ({rc.args})"
         let mut measures := measures
         for ldecl in ← getLCtx do
           if let some (e₁, e₂) := isNatCmp ldecl.type then
             -- We only want to consider these expressions if they depend only on the function's
             -- immediate arguments, so check that
-            if e₁.hasAnyFVar (! xs.contains ·) then continue
-            if e₂.hasAnyFVar (! xs.contains ·) then continue
+            if e₁.hasAnyFVar (! params.contains ·) then continue
+            if e₂.hasAnyFVar (! params.contains ·) then continue
             -- If e₁ does not depend on any varying parameters, simply ignore it
-            let e₁_is_const := ! e₁.hasAnyFVar (varyingParams.contains ·)
+            let e₁_is_const := ! e₁.hasAnyFVar (varyingFVars.contains ·)
             let body := if e₁_is_const then e₂ else mkNatSub e₂ e₁
             -- Avoid adding simple measures
             unless body.isFVar do
@@ -426,7 +432,7 @@ def GuessLexRel.toNatRel : GuessLexRel → Expr
 For a given recursive call, and a choice of parameter and argument index,
 try to prove equality, < or ≤.
 -/
-def evalRecCall (decrTactic? : Option DecreasingBy) (callerMeasures calleeMeasures : Array BasicMeasure)
+def evalRecCall (callerName: Name) (decrTactic? : Option DecreasingBy) (callerMeasures calleeMeasures : Array BasicMeasure)
   (rcc : RecCallWithContext) (callerMeasureIdx calleeMeasureIdx : Nat) : MetaM GuessLexRel := do
   rcc.ctxt.run do
     let callerMeasure := callerMeasures[callerMeasureIdx]!
@@ -446,26 +452,28 @@ def evalRecCall (decrTactic? : Option DecreasingBy) (callerMeasures calleeMeasur
         if rel = .eq then
           MVarId.refl mvarId
         else do
-          Lean.Elab.Term.TermElabM.run' do Term.withoutErrToSorry do
-            let remainingGoals ← Tactic.run mvarId do Tactic.withoutRecover do
-              applyCleanWfTactic
-              let tacticStx : Syntax ←
-                match decrTactic? with
-                | none => pure (← `(tactic| decreasing_tactic)).raw
-                | some decrTactic =>
-                  trace[Elab.definition.wf] "Using tactic {decrTactic.tactic.raw}"
-                  pure decrTactic.tactic.raw
-              Tactic.evalTactic tacticStx
-            remainingGoals.forM fun _ => throwError "goal not solved"
+          Lean.Elab.Term.TermElabM.run' do Term.withDeclName callerName do
+            Term.withoutErrToSorry do
+              let remainingGoals ← Tactic.run mvarId do Tactic.withoutRecover do
+                applyCleanWfTactic
+                let tacticStx : Syntax ←
+                  match decrTactic? with
+                  | none => pure (← `(tactic| decreasing_tactic)).raw
+                  | some decrTactic =>
+                    trace[Elab.definition.wf] "Using tactic {decrTactic.tactic.raw}"
+                    pure decrTactic.tactic.raw
+                Tactic.evalTactic tacticStx
+              remainingGoals.forM fun _ => throwError "goal not solved"
         trace[Elab.definition.wf] "inspectRecCall: success!"
         return rel
-      catch _e =>
-        trace[Elab.definition.wf] "Did not find {rel} proof: {goalsToMessageData [mvarId]}"
+      catch e =>
+        trace[Elab.definition.wf] "Did not find {rel} proof. Goal:{goalsToMessageData [mvarId]}\nError:{indentD e.toMessageData}"
         continue
     return .no_idea
 
 /- A cache for `evalRecCall` -/
 structure RecCallCache where mk'' ::
+  callerName : Name
   decrTactic? : Option DecreasingBy
   callerMeasures : Array BasicMeasure
   calleeMeasures : Array BasicMeasure
@@ -473,14 +481,15 @@ structure RecCallCache where mk'' ::
   cache : IO.Ref (Array (Array (Option GuessLexRel)))
 
 /-- Create a cache to memoize calls to `evalRecCall descTactic? rcc` -/
-def RecCallCache.mk (decrTactics : Array (Option DecreasingBy)) (measuress : Array (Array BasicMeasure))
+def RecCallCache.mk (funNames : Array Name) (decrTactics : Array (Option DecreasingBy)) (measuress : Array (Array BasicMeasure))
     (rcc : RecCallWithContext) :
     BaseIO RecCallCache := do
+  let callerName := funNames[rcc.caller]!
   let decrTactic? := decrTactics[rcc.caller]!
   let callerMeasures := measuress[rcc.caller]!
   let calleeMeasures := measuress[rcc.callee]!
   let cache ← IO.mkRef <| Array.mkArray callerMeasures.size (Array.mkArray calleeMeasures.size Option.none)
-  return { decrTactic?, callerMeasures, calleeMeasures, rcc, cache }
+  return { callerName, decrTactic?, callerMeasures, calleeMeasures, rcc, cache }
 
 /-- Run `evalRecCall` and cache there result -/
 def RecCallCache.eval (rc: RecCallCache) (callerMeasureIdx calleeMeasureIdx : Nat) : MetaM GuessLexRel := do
@@ -488,7 +497,7 @@ def RecCallCache.eval (rc: RecCallCache) (callerMeasureIdx calleeMeasureIdx : Na
   if let Option.some res := (← rc.cache.get)[callerMeasureIdx]![calleeMeasureIdx]! then
     return res
   else
-    let res ← evalRecCall rc.decrTactic? rc.callerMeasures rc.calleeMeasures rc.rcc callerMeasureIdx calleeMeasureIdx
+    let res ← evalRecCall  rc.callerName rc.decrTactic? rc.callerMeasures rc.calleeMeasures rc.rcc callerMeasureIdx calleeMeasureIdx
     rc.cache.modify (·.modify callerMeasureIdx (·.set! calleeMeasureIdx res))
     return res
 
@@ -739,17 +748,18 @@ def mkProdElem (xs : Array Expr) : MetaM Expr := do
     let n := xs.size
     xs[0:n-1].foldrM (init:=xs[n-1]!) fun x p => mkAppM ``Prod.mk #[x,p]
 
-def toTerminationMeasures (preDefs : Array PreDefinition) (fixedPrefixSize : Nat)
+def toTerminationMeasures (preDefs : Array PreDefinition) (fixedParamPerms : FixedParamPerms)
     (userVarNamess : Array (Array Name)) (measuress : Array (Array BasicMeasure))
     (solution : Array MutualMeasure) : MetaM TerminationMeasures := do
   preDefs.mapIdxM fun funIdx preDef => do
     let measures := measuress[funIdx]!
-    lambdaTelescope preDef.value fun xs _ => do
-      withUserNames xs[fixedPrefixSize:] userVarNamess[funIdx]! do
+    lambdaTelescope preDef.value fun params _ => do
+      let xs := fixedParamPerms.perms[funIdx]!.pickVarying params
+      withUserNames xs userVarNamess[funIdx]! do
         let args := solution.map fun
-          | .args tmIdxs => measures[tmIdxs[funIdx]!]!.fn.beta xs
+          | .args tmIdxs => measures[tmIdxs[funIdx]!]!.fn.beta params
           | .func funIdx' => mkNatLit <| if funIdx' == funIdx then 1 else 0
-        let fn ← mkLambdaFVars xs (← mkProdElem args)
+        let fn ← mkLambdaFVars params (← mkProdElem args)
         return { ref := .missing, structural := false, fn}
 
 /--
@@ -777,19 +787,19 @@ terminates. See the module doc string for a high-level overview.
 The `preDefs` are used to determine arity and types of parameters; the bodies are ignored.
 -/
 def guessLex (preDefs : Array PreDefinition) (unaryPreDef : PreDefinition)
-    (fixedPrefixSize : Nat) (argsPacker : ArgsPacker) :
+    (fixedParamPerms : FixedParamPerms) (argsPacker : ArgsPacker) :
     MetaM TerminationMeasures := do
   let userVarNamess ← argsPacker.varNamess.mapM (naryVarNames ·)
   trace[Elab.definition.wf] "varNames is: {userVarNamess}"
 
   -- Collect all recursive calls and extract their context
-  let recCalls ← collectRecCalls unaryPreDef fixedPrefixSize argsPacker
+  let recCalls ← collectRecCalls unaryPreDef fixedParamPerms argsPacker
   let recCalls := filterSubsumed recCalls
 
   -- For every function, the measures we want to use
   -- (One for each non-forbiddend arg)
-  let basicMeassures₁ ← simpleMeasures preDefs fixedPrefixSize userVarNamess
-  let basicMeassures₂ ← complexMeasures preDefs fixedPrefixSize userVarNamess recCalls
+  let basicMeassures₁ ← simpleMeasures preDefs fixedParamPerms userVarNamess
+  let basicMeassures₂ ← complexMeasures preDefs fixedParamPerms userVarNamess recCalls
   let basicMeasures := Array.zipWith (· ++ ·) basicMeassures₁ basicMeassures₂
 
   -- The list of measures, including the measures that order functions.
@@ -798,16 +808,16 @@ def guessLex (preDefs : Array PreDefinition) (unaryPreDef : PreDefinition)
 
   -- If there is only one plausible measure, use that
   if let #[solution] := mutualMeasures then
-    let termMeasures ← toTerminationMeasures preDefs fixedPrefixSize userVarNamess basicMeasures #[solution]
+    let termMeasures ← toTerminationMeasures preDefs fixedParamPerms userVarNamess basicMeasures #[solution]
     reportTerminationMeasures preDefs termMeasures
     return termMeasures
 
-  let rcs ← recCalls.mapM (RecCallCache.mk (preDefs.map (·.termination.decreasingBy?)) basicMeasures ·)
+  let rcs ← recCalls.mapM (RecCallCache.mk (preDefs.map (·.declName)) (preDefs.map (·.termination.decreasingBy?)) basicMeasures ·)
   let callMatrix := rcs.map (inspectCall ·)
 
   match ← liftMetaM <| solve mutualMeasures callMatrix with
   | .some solution => do
-    let termMeasures ← toTerminationMeasures preDefs fixedPrefixSize userVarNamess basicMeasures solution
+    let termMeasures ← toTerminationMeasures preDefs fixedParamPerms userVarNamess basicMeasures solution
     reportTerminationMeasures preDefs termMeasures
     return termMeasures
   | .none =>

src/Lean/Elab/PreDefinition/WF/Main.lean

@@ -23,12 +23,11 @@ def wfRecursion (preDefs : Array PreDefinition) (termMeasure?s : Array (Option T
   let termMeasures? := termMeasure?s.mapM id -- Either all or none, checked by `elabTerminationByHints`
   let preDefs ← preDefs.mapM fun preDef =>
     return { preDef with value := (← floatRecApp preDef.value) }
-  let (fixedPrefixSize, argsPacker, unaryPreDef, wfPreprocessProofs) ← withoutModifyingEnv do
+  let (fixedParamPerms, argsPacker, unaryPreDef, wfPreprocessProofs) ← withoutModifyingEnv do
     for preDef in preDefs do
       addAsAxiom preDef
-    let fixedPrefixSize ← Mutual.getFixedPrefix preDefs
-    trace[Elab.definition.wf] "fixed prefix: {fixedPrefixSize}"
-    let varNamess ← preDefs.mapM (varyingVarNames fixedPrefixSize ·)
+    let fixedParamPerms ← getFixedParamPerms preDefs
+    let varNamess ← preDefs.mapIdxM fun i preDef => varyingVarNames fixedParamPerms i preDef
     for varNames in varNamess, preDef in preDefs do
       if varNames.isEmpty then
         throwError "well-founded recursion cannot be used, '{preDef.declName}' does not take any (non-fixed) arguments"
@@ -36,33 +35,35 @@ def wfRecursion (preDefs : Array PreDefinition) (termMeasure?s : Array (Option T
     let (preDefsAttached, wfPreprocessProofs) ← Array.unzip <$> preDefs.mapM fun preDef => do
       let result ← preprocess preDef.value
       return ({preDef with value := result.expr}, result)
-    return (fixedPrefixSize, argsPacker, ← packMutual fixedPrefixSize argsPacker preDefsAttached, wfPreprocessProofs)
+    let unaryPreDef ← packMutual fixedParamPerms argsPacker preDefsAttached
+    return (fixedParamPerms, argsPacker, unaryPreDef, wfPreprocessProofs)
+  trace[Elab.definition.wf] "unaryPreDef:{indentD unaryPreDef.value}"
 
   let wf : TerminationMeasures ← do
     if let some tms := termMeasures? then pure tms else
     -- No termination_by here, so use GuessLex to infer one
-    guessLex preDefs unaryPreDef fixedPrefixSize argsPacker
+    guessLex preDefs unaryPreDef fixedParamPerms argsPacker
 
-  let preDefNonRec ← forallBoundedTelescope unaryPreDef.type fixedPrefixSize fun prefixArgs type => do
+  let preDefNonRec ← forallBoundedTelescope unaryPreDef.type fixedParamPerms.numFixed fun fixedArgs type => do
     let type ← whnfForall type
     unless type.isForall do
       throwError "wfRecursion: expected unary function type: {type}"
     let packedArgType := type.bindingDomain!
-    elabWFRel (preDefs.map (·.declName)) unaryPreDef.declName prefixArgs argsPacker packedArgType wf fun wfRel => do
+    elabWFRel (preDefs.map (·.declName)) unaryPreDef.declName fixedParamPerms fixedArgs argsPacker packedArgType wf fun wfRel => do
       trace[Elab.definition.wf] "wfRel: {wfRel}"
       let (value, envNew) ← withoutModifyingEnv' do
         addAsAxiom unaryPreDef
-        let value ← mkFix unaryPreDef prefixArgs argsPacker wfRel (preDefs.map (·.termination.decreasingBy?))
+        let value ← mkFix unaryPreDef fixedArgs argsPacker wfRel (preDefs.map (·.declName)) (preDefs.map (·.termination.decreasingBy?))
         eraseRecAppSyntaxExpr value
       /- `mkFix` invokes `decreasing_tactic` which may add auxiliary theorems to the environment. -/
       let value ← unfoldDeclsFrom envNew value
       return { unaryPreDef with value }
 
   trace[Elab.definition.wf] ">> {preDefNonRec.declName} :=\n{preDefNonRec.value}"
-  let preDefsNonrec ← preDefsFromUnaryNonRec fixedPrefixSize argsPacker preDefs preDefNonRec
+  let preDefsNonrec ← preDefsFromUnaryNonRec fixedParamPerms argsPacker preDefs preDefNonRec
   Mutual.addPreDefsFromUnary preDefs preDefsNonrec preDefNonRec
   let preDefs ← Mutual.cleanPreDefs preDefs
-  registerEqnsInfo preDefs preDefNonRec.declName fixedPrefixSize argsPacker
+  registerEqnsInfo preDefs preDefNonRec.declName fixedParamPerms argsPacker
   for preDef in preDefs, wfPreprocessProof in wfPreprocessProofs do
     unless preDef.kind.isTheorem do
       unless (← isProp preDef.type) do

src/Lean/Elab/PreDefinition/WF/PackMutual.lean

@@ -6,6 +6,7 @@ Authors: Leonardo de Moura, Joachim Breitner
 prelude
 import Lean.Meta.ArgsPacker
 import Lean.Elab.PreDefinition.Basic
+import Lean.Elab.PreDefinition.FixedParams
 import Lean.Elab.PreDefinition.WF.Eqns
 
 /-!
@@ -38,7 +39,7 @@ def withAppN (n : Nat) (e : Expr) (k : Array Expr → MetaM Expr) : MetaM Expr :
 /--
 Processes the expression and replaces calls to  the `preDefs` with calls to `f`.
 -/
-def packCalls (fixedPrefix : Nat) (argsPacker : ArgsPacker) (funNames : Array Name) (newF : Expr)
+def packCalls (fixedParamPerms : FixedParamPerms) (argsPacker : ArgsPacker) (funNames : Array Name) (newF : Expr)
   (e : Expr) : MetaM Expr := do
   let fType ← inferType newF
   unless fType.isForall do
@@ -49,16 +50,19 @@ def packCalls (fixedPrefix : Nat) (argsPacker : ArgsPacker) (funNames : Array Na
     if !f.isConst then
       return TransformStep.done e
     if let some fidx := funNames.idxOf? f.constName! then
-      let arity := fixedPrefix + argsPacker.varNamess[fidx]!.size
+      assert! fidx < fixedParamPerms.perms.size
+      let mask := fixedParamPerms.perms[fidx]!.map Option.isSome
+      let arity := mask.size
       let e' ← withAppN arity e fun args => do
-        let packedArg ← argsPacker.pack domain fidx args[fixedPrefix:]
+        let varying := fixedParamPerms.perms[fidx]!.pickVarying args
+        let packedArg ← argsPacker.pack domain fidx varying
         return mkApp newF packedArg
       return TransformStep.done e'
     return TransformStep.done e
     )
 
-def mutualName (argsPacker : ArgsPacker) (preDefs : Array PreDefinition) : Name :=
-  if argsPacker.onlyOneUnary then
+def mutualName (fixedParamPerms : FixedParamPerms) (argsPacker : ArgsPacker) (preDefs : Array PreDefinition) : Name :=
+  if fixedParamPerms.fixedArePrefix && argsPacker.onlyOneUnary then
     preDefs[0]!.declName
   else
     if argsPacker.numFuncs > 1 then
@@ -70,13 +74,16 @@ def mutualName (argsPacker : ArgsPacker) (preDefs : Array PreDefinition) : Name
 Creates a single unary function from the given `preDefs`, using the machinery in the `ArgPacker`
 module.
 -/
-def packMutual (fixedPrefix : Nat) (argsPacker : ArgsPacker) (preDefs : Array PreDefinition) : MetaM PreDefinition := do
-  if argsPacker.onlyOneUnary then return preDefs[0]!
-  let newFn := mutualName argsPacker preDefs
+def packMutual (fixedParamPerms : FixedParamPerms) (argsPacker : ArgsPacker) (preDefs : Array PreDefinition) : MetaM PreDefinition := do
+  let newFn := mutualName fixedParamPerms argsPacker preDefs
+  if newFn = preDefs[0]!.declName then
+    return preDefs[0]!
   -- Bring the fixed prefix into scope
-  forallBoundedTelescope preDefs[0]!.type (some fixedPrefix) fun ys _ => do
-    let types ← preDefs.mapM (instantiateForall ·.type ys)
-    let vals ← preDefs.mapM (instantiateLambda ·.value ys)
+  fixedParamPerms.perms[0]!.forallTelescope preDefs[0]!.type fun ys => do
+    let types ← preDefs.mapIdxM fun i preDef =>
+      fixedParamPerms.perms[i]!.instantiateForall preDef.type ys
+    let vals ← preDefs.mapIdxM fun i preDef =>
+      fixedParamPerms.perms[i]!.instantiateLambda preDef.value ys
 
     let type ← argsPacker.uncurryType types
 
@@ -90,12 +97,12 @@ def packMutual (fixedPrefix : Nat) (argsPacker : ArgsPacker) (preDefs : Array Pr
     let f := mkAppN (mkConst newFn us) ys
 
     let value ← argsPacker.uncurry vals
-    let value ← packCalls fixedPrefix argsPacker (preDefs.map (·.declName)) f value
+    let value ← packCalls fixedParamPerms argsPacker (preDefs.map (·.declName)) f value
     let value ← mkLambdaFVars ys value
     return { preDefNew with value }
 
 /--
-Collect the names of the varying variables (after the fixed prefix); this also determines the
+Collect the names of the varying variables (excluding the fixed parameters); this also determines the
 arity for the well-founded translations, and is turned into an `ArgsPacker`.
 We use the term to determine the arity, but take the name from the type, for better names in the
 ```
@@ -103,26 +110,33 @@ fun : (n : Nat) → Nat | 0 => 0 | n+1 => fun n
 ```
 idiom.
 -/
-def varyingVarNames (fixedPrefixSize : Nat) (preDef : PreDefinition) : MetaM (Array Name) := do
+def varyingVarNames (fixedParamPerms : FixedParamPerms) (preDefIdx : Nat) (preDef : PreDefinition) : MetaM (Array Name) := do
   -- We take the arity from the term, but the names from the types
   let arity ← lambdaTelescope preDef.value fun xs _ => return xs.size
-  assert! fixedPrefixSize ≤ arity
   forallBoundedTelescope preDef.type arity fun xs _ => do
     assert! xs.size = arity
-    let xs : Array Expr := xs[fixedPrefixSize:]
-    xs.mapM (·.fvarId!.getUserName)
+    assert! fixedParamPerms.perms[preDefIdx]!.size = arity
+    let mut ns := #[]
+    for x in xs, paramInfo in fixedParamPerms.perms[preDefIdx]! do
+      if paramInfo.isSome then continue -- skip fixed parameters
+      ns := ns.push (← x.fvarId!.getUserName)
+    return ns
 
-
-def preDefsFromUnaryNonRec (fixedPrefixSize : Nat) (argsPacker : ArgsPacker)
+def preDefsFromUnaryNonRec (fixedParamPerms : FixedParamPerms) (argsPacker : ArgsPacker)
     (preDefs : Array PreDefinition) (unaryPreDefNonRec : PreDefinition) : MetaM (Array PreDefinition) := do
   withoutModifyingEnv do
     let us := unaryPreDefNonRec.levelParams.map mkLevelParam
     addAsAxiom unaryPreDefNonRec
     preDefs.mapIdxM fun fidx preDef => do
-      let value ← forallBoundedTelescope preDef.type (some fixedPrefixSize) fun xs _ => do
+      let arity := fixedParamPerms.perms[fidx]!.size
+      let value ← forallBoundedTelescope preDef.type (some arity) fun params _ => do
+        assert! arity = params.size
+        let xs := fixedParamPerms.perms[fidx]!.pickFixed params
+        let ys := fixedParamPerms.perms[fidx]!.pickVarying params
         let value := mkAppN (mkConst unaryPreDefNonRec.declName us) xs
         let value ← argsPacker.curryProj value fidx
-        mkLambdaFVars xs value
+        let value := value.beta ys
+        mkLambdaFVars params value
       trace[Elab.definition.wf] "{preDef.declName} := {value}"
       pure { preDef with value }
 

src/Lean/Elab/PreDefinition/WF/Rel.lean

@@ -10,6 +10,7 @@ import Lean.Meta.Tactic.Rename
 import Lean.Elab.SyntheticMVars
 import Lean.Elab.PreDefinition.Basic
 import Lean.Elab.PreDefinition.TerminationMeasure
+import Lean.Elab.PreDefinition.FixedParams
 import Lean.Meta.ArgsPacker
 
 namespace Lean.Elab.WF
@@ -22,16 +23,18 @@ a mutual clique, they must be the same for all functions.
 
 This ensures the preconditions for `ArgsPacker.uncurryND`.
 -/
-def checkCodomains (names : Array Name) (prefixArgs : Array Expr) (arities : Array Nat)
+def checkCodomains (names : Array Name) (fixedParamPerms : FixedParamPerms) (fixedArgs : Array Expr) (arities : Array Nat)
     (termMeasures : TerminationMeasures) : TermElabM Expr := do
   let mut codomains := #[]
-  for name in names, arity in arities, termMeasure in termMeasures do
-    let type ← inferType (termMeasure.fn.beta prefixArgs)
-    let codomain ← forallBoundedTelescope type arity fun xs codomain => do
+  for name in names, funIdx in [:names.size], arity in arities, termMeasure in termMeasures do
+    let measureType ← inferType termMeasure.fn
+    let measureType ← fixedParamPerms.perms[funIdx]!.instantiateForall measureType fixedArgs
+    let codomain ← forallBoundedTelescope measureType arity fun xs codomain => do
+      assert! xs.size = arity
       let fvars := xs.map (·.fvarId!)
       if codomain.hasAnyFVar (fvars.contains ·) then
         throwErrorAt termMeasure.ref  m!"The termination measure's type must not depend on the " ++
-          m!"function's varying parameters, but {name}'s termination measure does:{indentExpr type}\n" ++
+          m!"function's varying parameters, but {name}'s termination measure does:{indentExpr measureType}\n" ++
           "Try using `sizeOf` explicitly"
       pure codomain
     codomains := codomains.push codomain
@@ -51,14 +54,16 @@ If the `termMeasures` map the packed argument `argType` to `β`, then this funct
 continuation a value of type `WellFoundedRelation argType` that is derived from the instance
 for `WellFoundedRelation β` using `invImage`.
 -/
-def elabWFRel (declNames : Array Name) (unaryPreDefName : Name) (prefixArgs : Array Expr)
-    (argsPacker : ArgsPacker) (argType : Expr) (termMeasures : TerminationMeasures)
+def elabWFRel (declNames : Array Name) (unaryPreDefName : Name) (fixedParamPerms : FixedParamPerms)
+    (fixedArgs : Array Expr) (argsPacker : ArgsPacker) (argType : Expr) (termMeasures : TerminationMeasures)
     (k : Expr → TermElabM α) : TermElabM α := withDeclName unaryPreDefName do
   let α := argType
   let u ← getLevel α
-  let β ← checkCodomains declNames prefixArgs argsPacker.arities termMeasures
+  let β ← checkCodomains declNames fixedParamPerms fixedArgs argsPacker.arities termMeasures
   let v ← getLevel β
-  let packedF ← argsPacker.uncurryND (termMeasures.map (·.fn.beta prefixArgs))
+  let fns ← termMeasures.mapIdxM fun i measure =>
+    fixedParamPerms.perms[i]!.instantiateLambda measure.fn fixedArgs
+  let packedF ← argsPacker.uncurryND fns
   let inst ← synthInstance (.app (.const ``WellFoundedRelation [v]) β)
   let rel ← instantiateMVars (mkApp4 (.const ``invImage [u,v]) α β packedF inst)
   k rel

src/Lean/Elab/PreDefinition/WF/Unfold.lean

@@ -75,8 +75,9 @@ private partial def mkUnfoldProof (declName : Name) (mvarId : MVarId) : MetaM Un
         throwError "failed to generate equational theorem for '{declName}'\n{MessageData.ofGoal mvarId}"
 
 def mkUnfoldEq (preDef : PreDefinition) (unaryPreDefName : Name) (wfPreprocessProof : Simp.Result) : MetaM Unit := do
+  let baseName := preDef.declName
+  let name := Name.str baseName unfoldThmSuffix
   withOptions (tactic.hygienic.set · false) do
-    let baseName := preDef.declName
     lambdaTelescope preDef.value fun xs body => do
       let us := preDef.levelParams.map mkLevelParam
       let lhs := mkAppN (Lean.mkConst preDef.declName us) xs
@@ -93,7 +94,6 @@ def mkUnfoldEq (preDef : PreDefinition) (unaryPreDefName : Name) (wfPreprocessPr
       let value ← instantiateMVars main
       let type ← mkForallFVars xs type
       let value ← mkLambdaFVars xs value
-      let name := Name.str baseName unfoldThmSuffix
       addDecl <| Declaration.thmDecl {
         name, type, value
         levelParams := preDef.levelParams

src/Lean/Elab/Tactic/BVDecide/Frontend/LRAT.lean

@@ -33,13 +33,7 @@ structure TacticContext where
   config : BVDecideConfig
 
 def TacticContext.new (lratPath : System.FilePath) (config : BVDecideConfig) :
-    Lean.Elab.TermElabM TacticContext := do
-  -- Account for: https://github.com/arminbiere/cadical/issues/112
-  let config :=
-    if System.Platform.isWindows then
-      { config with binaryProofs := false }
-    else
-      config
+    TermElabM TacticContext := do
   let exprDef ← Lean.Elab.Term.mkAuxName `_expr_def
   let certDef ← Lean.Elab.Term.mkAuxName `_cert_def
   let reflectionDef ← Lean.Elab.Term.mkAuxName `_reflection_def

src/Lean/Elab/Tactic/BVDecide/Frontend/Normalize/Enums.lean

@@ -105,7 +105,7 @@ def getEqIffEnumToBitVecEqFor (declName : Name) : MetaM Name := do
     let inverseValue ←
       withLocalDeclD `x bvType fun x => do
         let instBeq ← synthInstance (mkApp (mkConst ``BEq [0]) bvType)
-        let inv ← mkInverse x declType instBeq ctors (BitVec.ofNat bvSize 0) (mkConst ctors.head!)
+        let inv := mkInverse x declType instBeq ctors (BitVec.ofNat bvSize 0) (mkConst ctors.head!)
         mkLambdaFVars #[x] inv
 
     let value ←
@@ -144,9 +144,9 @@ def getEqIffEnumToBitVecEqFor (declName : Name) : MetaM Name := do
 where
   mkInverse {w : Nat} (input : Expr) (retType : Expr) (instBEq : Expr) (ctors : List Name)
       (counter : BitVec w) (acc : Expr) :
-      MetaM Expr := do
+      Expr :=
     match ctors with
-    | [] => pure acc
+    | [] => acc
     | ctor :: ctors =>
       let eq :=
         mkApp4
@@ -155,10 +155,7 @@ where
           instBEq
           input
           (toExpr counter)
-      -- After the next stage0 update, this can be reverted to
-      -- let acc := mkApp4 (mkConst ``cond [1]) retType eq (mkConst ctor) acc
-      -- and mkInverse can be pure again
-      let acc ← mkAppOptM ``cond #[retType, eq, mkConst ctor, acc]
+      let acc := mkApp4 (mkConst ``cond [1]) retType eq (mkConst ctor) acc
       mkInverse input retType instBEq ctors (counter + 1) acc
 
 /--

src/Lean/Elab/Term.lean

@@ -1820,42 +1820,24 @@ def addAutoBoundImplicitsInlayHint (autos : Array Expr) (inlayHintPos : String.P
     return
   let autoNames ← autos.mapM (·.fvarId!.getUserName)
   let formattedHint := s!" \{{" ".intercalate <| Array.toList <| autoNames.map toString}}"
-  let autoLabelParts : List (InlayHintLabelPart × Option Expr) := Array.toList <| ← autos.mapM fun auto => do
-    let name := toString <| ← auto.fvarId!.getUserName
-    return ({ value := name }, some auto)
-  let p value : InlayHintLabelPart × Option Expr := ({ value }, none)
-  let labelParts := [p " ", p "{"] ++ [p " "].intercalate (autoLabelParts.map ([·])) ++ [p "}"]
-  let labelParts := labelParts.toArray
   let deferredResolution ih := do
-    let .parts ps := ih.label
-      | return ih
-    let mut ps' := #[]
-    for h : i in [:ps.size] do
-      let p := ps[i]
-      let some (part, some auto) := labelParts[i]?
-        | ps' := ps'.push p
-          continue
+    let description := "Automatically-inserted implicit parameters:"
+    let codeBlockStart := "```lean"
+    let typeInfos ← autos.mapM fun auto => do
+      let name := toString <| ← auto.fvarId!.getUserName
       let type := toString <| ← Meta.ppExpr <| ← instantiateMVars (← inferType auto)
-      let tooltip := s!"{part.value} : {type}"
-      ps' := ps'.push { p with tooltip? := tooltip }
-      let some separatorPart := ps'[ps'.size - 2]?
-        | continue
-      -- We assign the leading `{` and the separation spaces the same tooltip as the auto-implicit
-      -- following it. The reason for this is that VS Code does not display a text cursor
-      -- on auto-implicits, but a regular cursor, and hitting single character auto-implicits
-      -- with that cursor can be a bit tricky. Adding the leading space or the opening `{` to the
-      -- tooltip area makes this much easier.
-      ps' := ps'.set! (ps'.size - 2) { separatorPart with tooltip? := tooltip }
-    return { ih with label := .parts ps' }
+      return s!"{name} : {type}"
+    let codeBlockEnd := "```"
+    let tooltip := "\n".intercalate <| description :: codeBlockStart :: typeInfos.toList ++ [codeBlockEnd]
+    return { ih with tooltip? := tooltip }
   pushInfoLeaf <| .ofCustomInfo {
       position := inlayHintPos
-      label := .parts <| labelParts.map (·.1)
+      label := .name formattedHint
       textEdits := #[{
         range := ⟨inlayHintPos, inlayHintPos⟩,
         newText := formattedHint
       }]
       kind? := some .parameter
-      tooltip? := "Automatically-inserted implicit parameters"
       lctx := ← getLCtx
       deferredResolution
       : InlayHint

src/Lean/Environment.lean

@@ -420,13 +420,18 @@ private def AsyncContext.mayContain (ctx : AsyncContext) (n : Name) : Bool :=
 /--
 Constant info and environment extension states eventually resulting from async elaboration.
 -/
-structure AsyncConst where
+private structure AsyncConst where
   constInfo : AsyncConstantInfo
   /--
   Reported extension state eventually fulfilled by promise; may be missing for tasks (e.g. kernel
   checking) that can eagerly guarantee they will not report any state.
   -/
   exts?     : Option (Task (Array EnvExtensionState))
+  /--
+  `Task AsyncConsts` except for problematic recursion. The set of nested constants created while
+  elaborating this constant.
+  -/
+  consts    : Task Dynamic
 
 /-- Data structure holding a sequence of `AsyncConst`s optimized for efficient access. -/
 private structure AsyncConsts where
@@ -436,12 +441,13 @@ private structure AsyncConsts where
   map : NameMap AsyncConst
   /-- Trie of declaration names without private name prefixes for fast longest-prefix access. -/
   normalizedTrie : NameTrie AsyncConst
-deriving Inhabited
+deriving Inhabited, TypeName
 
 private def AsyncConsts.add (aconsts : AsyncConsts) (aconst : AsyncConst) : AsyncConsts :=
   let normalizedName := privateToUserName aconst.constInfo.name
   if let some aconst' := aconsts.normalizedTrie.find? normalizedName then
-    panic! s!"AsyncConsts.add: duplicate normalized declaration name {aconst.constInfo.name} vs. {aconst'.constInfo.name}"
+    let _ : Inhabited AsyncConsts := ⟨aconsts⟩
+    panic! s!"duplicate normalized declaration name {aconst.constInfo.name} vs. {aconst'.constInfo.name}"
   else { aconsts with
     size := aconsts.size + 1
     revList := aconst :: aconsts.revList
@@ -458,6 +464,17 @@ private def AsyncConsts.findPrefix? (aconsts : AsyncConsts) (declName : Name) :
   -- `findLongestPrefix?`
   aconsts.normalizedTrie.findLongestPrefix? (privateToUserName declName)
 
+/--
+Finds constants including from other elaboration branches by recursively looking up longest
+prefixes (which is sufficient by `AsyncContext.mayContain`).
+-/
+private partial def AsyncConsts.findRec? (aconsts : AsyncConsts) (declName : Name) : Option AsyncConst := do
+  let c ← aconsts.findPrefix? declName
+  if c.constInfo.name == declName then
+    return c
+  let aconsts ← c.consts.get.get? AsyncConsts
+  AsyncConsts.findRec? aconsts declName
+
 /-- Context for `realizeConst` established by `enableRealizationsForConst`. -/
 private structure RealizationContext where
   /--
@@ -486,23 +503,23 @@ structure Environment where
   -/
   private mk ::
   /--
-  Kernel environment not containing any asynchronously elaborated declarations. Also stores
-  environment extension state for the current branch of the environment.
+  Kernel environment containing imported constants. Also stores environment extension state for the
+  current branch of the environment.
 
-  Ignoring extension state, this is guaranteed to be some prior version of `checked` that is eagerly
-  available. Thus we prefer taking information from it instead of `checked` whenever possible.
+  As `base` is eagerly available, we prefer taking information from it instead of `checked` whenever
+  possible.
   -/
-  checkedWithoutAsync : Kernel.Environment
+  base : Kernel.Environment
   /--
   Kernel environment task that is fulfilled when all asynchronously elaborated declarations are
   finished, containing the resulting environment. Also collects the environment extension state of
   all environment branches that contributed contained declarations.
   -/
-  checked             : Task Kernel.Environment := .pure checkedWithoutAsync
+  checked             : Task Kernel.Environment := .pure base
   /--
   Container of asynchronously elaborated declarations. For consistency, `updateBaseAfterKernelAdd`
-  makes sure this contains constants added even synchronously, i.e. this is a superset of
-  `checkedWithoutAsync` except for imported constants.
+  makes sure this contains constants added even synchronously, i.e. `base ⨃ asyncConsts` is the set
+  of constants known on the current environment branch, which is a subset of `checked`.
   -/
   private asyncConsts : AsyncConsts := default
   /-- Information about this asynchronous branch of the environment, if any. -/
@@ -525,7 +542,7 @@ namespace Environment
 -- used only when the kernel calls into the interpreter, and in `Lean.Kernel.Exception.mkCtx`
 @[export lean_elab_environment_of_kernel_env]
 def ofKernelEnv (env : Kernel.Environment) : Environment :=
-  { checkedWithoutAsync := env, realizedImportedConsts? := none }
+  { base := env, realizedImportedConsts? := none }
 
 @[export lean_elab_environment_to_kernel_env]
 def toKernelEnv (env : Environment) : Kernel.Environment :=
@@ -533,11 +550,11 @@ def toKernelEnv (env : Environment) : Kernel.Environment :=
 
 /-- Consistently updates synchronous and asynchronous parts of the environment without blocking. -/
 private def modifyCheckedAsync (env : Environment) (f : Kernel.Environment → Kernel.Environment) : Environment :=
-  { env with checked := env.checked.map (sync := true) f, checkedWithoutAsync := f env.checkedWithoutAsync }
+  { env with checked := env.checked.map (sync := true) f, base := f env.base }
 
 /-- Sets synchronous and asynchronous parts of the environment to the given kernel environment. -/
 private def setCheckedSync (env : Environment) (newChecked : Kernel.Environment) : Environment :=
-  { env with checked := .pure newChecked, checkedWithoutAsync := newChecked }
+  { env with checked := .pure newChecked, base := newChecked }
 
 /-- True while inside `realizeConst`'s `realize`. -/
 def isRealizing (env : Environment) : Bool :=
@@ -573,7 +590,7 @@ def addDeclCore (env : Environment) (maxHeartbeats : USize) (decl : @& Declarati
     (cancelTk? : @& Option IO.CancelToken) (doCheck := true) :
     Except Kernel.Exception Environment := do
   if let some ctx := env.asyncCtx? then
-    if let some n := decl.getNames.find? (!ctx.mayContain ·) then
+    if let some n := decl.getTopLevelNames.find? (!ctx.mayContain ·) then
       throw <| .other s!"cannot add declaration {n} to environment as it is restricted to the \
         prefix {ctx.declPrefix}"
   if doCheck then
@@ -592,7 +609,12 @@ def const2ModIdx (env : Environment) : Std.HashMap Name ModuleIdx :=
 -- only needed for the lakefile.lean cache
 @[export lake_environment_add]
 private def lakeAdd (env : Environment) (cinfo : ConstantInfo) : Environment :=
-  env.setCheckedSync <| env.checked.get.add cinfo
+  let env := env.setCheckedSync <| env.checked.get.add cinfo
+  { env with asyncConsts := env.asyncConsts.add {
+    constInfo := .ofConstantInfo cinfo
+    exts? := none
+    consts := .pure <| .mk (α := AsyncConsts) default
+  } }
 
 /--
 Save an extra constant name that is used to populate `const2ModIdx` when we import
@@ -605,48 +627,44 @@ def addExtraName (env : Environment) (name : Name) : Environment :=
   else
     env.modifyCheckedAsync fun env => { env with extraConstNames := env.extraConstNames.insert name }
 
-/-- Find base case: name did not match any asynchronous declaration. -/
-private def findNoAsync (env : Environment) (n : Name) : Option ConstantInfo := do
+/-- `findAsync?` after `base` access -/
+private def findAsync?' (env : Environment) (n : Name) : Option AsyncConstantInfo := do
+  if let some asyncConst := env.asyncConsts.find? n then
+    -- Constant for which an asynchronous elaboration task was spawned
+    return asyncConst.constInfo
   if env.asyncMayContain n then
     -- Constant definitely not generated in a different environment branch: return none, callers
     -- have already checked this branch.
     none
-  else if let some _ := env.asyncConsts.findPrefix? n then
+  if let some c := env.asyncConsts.findRec? n then
     -- Constant generated in a different environment branch: wait for final kernel environment. Rare
     -- case when only proofs are elaborated asynchronously as they are rarely inspected. Could be
     -- optimized in the future by having the elaboration thread publish an (incremental?) map of
     -- generated declarations before kernel checking (which must wait on all previous threads).
-    env.checked.get.constants.find?' n
-  else
-    -- Not in the kernel environment nor in the name prefix of environment branch: undefined by
-    -- `addDeclCore` invariant.
-    none
+    return c.constInfo
+  -- Not in the kernel environment nor in the name prefix of environment branch: undefined by
+  -- `addDeclCore` invariant.
+  none
 
 /--
 Looks up the given declaration name in the environment, avoiding forcing any in-progress elaboration
 tasks unless necessary.
 -/
 def findAsync? (env : Environment) (n : Name) : Option AsyncConstantInfo := do
-  -- Check declarations already added to the kernel environment (e.g. because they were imported)
-  -- first as that should be the most common case. It is safe to use `find?'` because we never
-  -- overwrite imported declarations.
-  if let some c := env.checkedWithoutAsync.constants.find?' n then
-    some <| .ofConstantInfo c
-  else if let some asyncConst := env.asyncConsts.find? n then
-    -- Constant for which an asynchronous elaboration task was spawned
-    return asyncConst.constInfo
-  else env.findNoAsync n |>.map .ofConstantInfo
+  -- Avoid going through `AsyncConstantInfo` for `base` access
+  if let some c := env.base.constants.map₁[n]? then
+    return .ofConstantInfo c
+  findAsync?' env n
 
 /--
 Looks up the given declaration name in the environment, avoiding forcing any in-progress elaboration
 tasks for declaration bodies (which are not accessible from `ConstantVal`).
 -/
 def findConstVal? (env : Environment) (n : Name) : Option ConstantVal := do
-  if let some c := env.checkedWithoutAsync.constants.find?' n then
-    some c.toConstantVal
-  else if let some asyncConst := env.asyncConsts.find? n then
-    return asyncConst.constInfo.toConstantVal
-  else env.findNoAsync n |>.map (·.toConstantVal)
+  -- Avoid going through `AsyncConstantInfo` for `base` access
+  if let some c := env.base.constants.map₁[n]? then
+    return c.toConstantVal
+  env.findAsync?' n |>.map (·.toConstantVal)
 
 /--
 Allows `realizeConst` calls for imported declarations in all derived environment branches.
@@ -666,19 +684,24 @@ def enableRealizationsForImports (env : Environment) (opts : Options) : BaseIO E
 /--
 Allows `realizeConst` calls for the given declaration in all derived environment branches.
 Realizations will run using the given environment and options to ensure deterministic results. Note
-that while we check that the function isn't called too *early*, i.e. before the declaration is
-actually added to the environment, we cannot automatically check that it isn't called too *late*,
-i.e. before all environment extensions that may be relevant to realizations have been set. We do
-check that we are not calling it from a different branch than `c` was added on, which would be
-definitely too late.
+that while we check that the function isn't called before the declaration is actually added to the
+environment, we cannot automatically check that it isn't otherwise called too early in the sense
+that helper declarations and environment extension state that may be relevant to realizations may
+not have been added yet. We do check that we are not calling it from a different branch than `c` was
+added on, which would be definitely too late. Thus, this function should generally be called in
+elaborators calling `addDecl` (when that declaration is a plausible target for realization) at the
+latest possible point, i.e. at the very end of the elaborator or just before a first realization may
+be triggered if any.
 -/
 def enableRealizationsForConst (env : Environment) (opts : Options) (c : Name) :
     BaseIO Environment := do
   if env.findAsync? c |>.isNone then
-    panic! s!"Environment.enableRealizationsForConst: declaration {c} not found in environment"
+    panic! s!"declaration {c} not found in environment"
+    return env
   if let some asyncCtx := env.asyncCtx? then
     if !asyncCtx.mayContain c then
-      panic! s!"Environment.enableRealizationsForConst: {c} is outside current context {asyncCtx.declPrefix}"
+      panic! s!"{c} is outside current context {asyncCtx.declPrefix}"
+      return env
   if env.realizedLocalConsts.contains c then
     return env
   return { env with realizedLocalConsts := env.realizedLocalConsts.insert c {
@@ -691,13 +714,10 @@ def enableRealizationsForConst (env : Environment) (opts : Options) (c : Name) :
 Looks up the given declaration name in the environment, blocking on the corresponding elaboration
 task if not yet complete.
 -/
-def find? (env : Environment) (n : Name) : Option ConstantInfo :=
-  if let some c := env.checkedWithoutAsync.constants.find?' n then
-    some c
-  else if let some asyncConst := env.asyncConsts.find? n then
-    return asyncConst.constInfo.toConstantInfo
-  else
-    env.findNoAsync n
+def find? (env : Environment) (n : Name) : Option ConstantInfo := do
+  if let some c := env.base.constants.map₁[n]? then
+    return c
+  env.findAsync?' n |>.map (·.toConstantInfo)
 
 /-- Returns debug output about the asynchronous state of the environment. -/
 def dbgFormatAsyncState (env : Environment) : BaseIO String :=
@@ -710,7 +730,7 @@ def dbgFormatAsyncState (env : Environment) : BaseIO String :=
   \nrealizedImportedConsts?: {repr <| (← env.realizedImportedConsts?.mapM fun ctx => do
     return (← ctx.constsRef.get).toList.map fun (n, m?) =>
       (n, m?.get.1.map (fun c : AsyncConst => c.constInfo.name.toString) |> toString))}
-  \ncheckedWithoutAsync.constants.map₂: {repr <| env.checkedWithoutAsync.constants.map₂.toList.map (·.1)}"
+  \nbase.constants.map₂: {repr <| env.base.constants.map₂.toList.map (·.1)}"
 
 /-- Returns debug output about the synchronous state of the environment. -/
 def dbgFormatCheckedSyncState (env : Environment) : BaseIO String :=
@@ -786,6 +806,7 @@ structure AddConstAsyncResult where
   private infoPromise : IO.Promise ConstantInfo
   private extensionsPromise : IO.Promise (Array EnvExtensionState)
   private checkedEnvPromise : IO.Promise Kernel.Environment
+  private constsPromise : IO.Promise AsyncConsts
 
 /-- Creates fallback info to be used in case promises are dropped unfulfilled. -/
 private def mkFallbackConstInfo (constName : Name) (kind : ConstantKind) : ConstantInfo :=
@@ -806,7 +827,7 @@ private def mkFallbackConstInfo (constName : Name) (kind : ConstantKind) : Const
     | .axiom  => .axiomInfo { fallbackVal with
       isUnsafe := false
     }
-    | k => panic! s!"Environment.mkFallbackConstInfo: unsupported constant kind {repr k}"
+    | k => panic! s!"unsupported constant kind {repr k}"
 
 /--
 Starts the asynchronous addition of a constant to the environment. The environment is split into a
@@ -827,17 +848,23 @@ def addConstAsync (env : Environment) (constName : Name) (kind : ConstantKind) (
   let infoPromise ← IO.Promise.new
   let extensionsPromise ← IO.Promise.new
   let checkedEnvPromise ← IO.Promise.new
+  let constsPromise ← IO.Promise.new
 
-  let fallbackConstInfo := mkFallbackConstInfo constName kind
+  -- We use a thunk here because we don't have a fallback for recursors, but that specific
+  -- invocation cannot fail anyway
+  let fallbackConstInfo := Thunk.mk fun _ => mkFallbackConstInfo constName kind
 
   let asyncConst := {
     constInfo := {
       name := constName
       kind
-      sig := sigPromise.resultD fallbackConstInfo.toConstantVal
-      constInfo := infoPromise.resultD fallbackConstInfo
+      sig := sigPromise.resultD fallbackConstInfo.get.toConstantVal
+      constInfo := infoPromise.resultD fallbackConstInfo.get
     }
     exts? := guard reportExts *> some (extensionsPromise.resultD env.toKernelEnv.extensions)
+    consts := constsPromise.result?.map (sync := true) fun
+      | some consts => .mk consts
+      | none        => .mk (α := AsyncConsts) default
   }
   return {
     constName, kind
@@ -847,7 +874,7 @@ def addConstAsync (env : Environment) (constName : Name) (kind : ConstantKind) (
         | some kenv => .pure kenv
         | none      => env.checked }
     asyncEnv := env.enterAsync constName
-    sigPromise, infoPromise, extensionsPromise, checkedEnvPromise
+    sigPromise, infoPromise, extensionsPromise, checkedEnvPromise, constsPromise
   }
 
 /--
@@ -862,8 +889,9 @@ def AddConstAsyncResult.commitSignature (res : AddConstAsyncResult) (sig : Const
   res.sigPromise.resolve sig
 
 /--
-Commits the full constant info to the main environment branch. If `info?` is `none`, it is taken
-from the given environment. The declaration name and kind must match the original values given to
+Commits the full constant info as well as the current environment extension state and set of nested
+asynchronous constants to the main environment branch. If `info?` is `none`, it is taken from the
+given environment. The declaration name and kind must match the original values given to
 `addConstAsync`. The signature must match the previous `commitSignature` call, if any.
 -/
 def AddConstAsyncResult.commitConst (res : AddConstAsyncResult) (env : Environment)
@@ -883,7 +911,8 @@ def AddConstAsyncResult.commitConst (res : AddConstAsyncResult) (env : Environme
   if sig.type != info.type then
     throw <| .userError s!"AddConstAsyncResult.commitConst: constant has type {info.type} but expected {sig.type}"
   res.infoPromise.resolve info
-  res.extensionsPromise.resolve env.checkedWithoutAsync.extensions
+  res.extensionsPromise.resolve env.base.extensions
+  res.constsPromise.resolve env.asyncConsts
 
 /--
 Assuming `Lean.addDecl` has been run for the constant to be added on the async environment branch,
@@ -893,10 +922,10 @@ kernel additions there. All `commitConst` preconditions apply.
 -/
 def AddConstAsyncResult.commitCheckEnv (res : AddConstAsyncResult) (env : Environment) :
     IO Unit := do
-  let some _ := env.findAsync? res.constName
-    | throw <| .userError s!"AddConstAsyncResult.checkAndCommitEnv: constant {res.constName} not \
-      found in async context"
-  res.commitConst env
+  -- We should skip `commitConst` in case it has already been called, perhaps with a different
+  -- `info?`
+  if !(← res.infoPromise.isResolved) then
+    res.commitConst env
   res.checkedEnvPromise.resolve env.checked.get
 
 def contains (env : Environment) (n : Name) : Bool :=
@@ -907,11 +936,11 @@ Checks whether the given declaration is known on the current branch, in which ca
 not block.
 -/
 def containsOnBranch (env : Environment) (n : Name) : Bool :=
-  (env.asyncConsts.find? n |>.isSome) || env.checkedWithoutAsync.constants.contains n
+  (env.asyncConsts.find? n |>.isSome) || env.base.constants.contains n
 
 def header (env : Environment) : EnvironmentHeader :=
   -- can be assumed to be in sync with `env.checked`; see `setMainModule`, the only modifier of the header
-  env.checkedWithoutAsync.header
+  env.base.header
 
 def imports (env : Environment) : Array Import :=
   env.header.imports
@@ -921,8 +950,8 @@ def allImportedModuleNames (env : Environment) : Array Name :=
 
 def setMainModule (env : Environment) (m : Name) : Environment := Id.run do
   if env.realizedImportedConsts?.isSome then
-    panic! "Environment.setMainModule: cannot set after `enableRealizationsForImports`"
-    return env
+    let _ : Inhabited Environment := ⟨env⟩
+    return panic! "cannot set after `enableRealizationsForImports`"
   env.modifyCheckedAsync ({ · with header.mainModule := m })
 
 def mainModule (env : Environment) : Name :=
@@ -930,7 +959,7 @@ def mainModule (env : Environment) : Name :=
 
 def getModuleIdxFor? (env : Environment) (declName : Name) : Option ModuleIdx :=
   -- async constants are always from the current module
-  env.checkedWithoutAsync.const2ModIdx[declName]?
+  env.base.const2ModIdx[declName]?
 
 def isConstructor (env : Environment) (declName : Name) : Bool :=
   match env.find? declName with
@@ -1068,6 +1097,7 @@ private unsafe def setStateImpl {σ} (ext : EnvExtension σ) (exts : Array EnvEx
   if h : ext.idx < exts.size then
     exts.set ext.idx (unsafeCast s)
   else
+    -- do not return an empty array on panic, avoiding follow-up out-of-bounds accesses
     have : Inhabited (Array EnvExtensionState) := ⟨exts⟩
     panic! invalidExtMsg
 
@@ -1078,6 +1108,7 @@ private unsafe def modifyStateImpl {σ : Type} (ext : EnvExtension σ) (exts : A
       let s : σ := f s
       unsafeCast s
   else
+    -- do not return an empty array on panic, avoiding follow-up out-of-bounds accesses
     have : Inhabited (Array EnvExtensionState) := ⟨exts⟩
     panic! invalidExtMsg
 
@@ -1099,19 +1130,21 @@ Note that in modes `sync` and `async`, `f` will be called twice, on the local an
 state.
 -/
 def modifyState {σ : Type} (ext : EnvExtension σ) (env : Environment) (f : σ → σ) : Environment := Id.run do
+  -- for panics
+  let _ : Inhabited Environment := ⟨env⟩
   -- safety: `ext`'s constructor is private, so we can assume the entry at `ext.idx` is of type `σ`
   match ext.asyncMode with
   | .mainOnly =>
     if let some asyncCtx := env.asyncCtx? then
-      panic! s!"Environment.modifyState: environment extension is marked as `mainOnly` but used in \
+      return panic! s!"environment extension is marked as `mainOnly` but used in \
         {if asyncCtx.realizing then "realization" else "async"} context '{asyncCtx.declPrefix}'"
-    return { env with checkedWithoutAsync.extensions := unsafe ext.modifyStateImpl env.checkedWithoutAsync.extensions f }
+    return { env with base.extensions := unsafe ext.modifyStateImpl env.base.extensions f }
   | .local =>
-    return { env with checkedWithoutAsync.extensions := unsafe ext.modifyStateImpl env.checkedWithoutAsync.extensions f }
+    return { env with base.extensions := unsafe ext.modifyStateImpl env.base.extensions f }
   | _ =>
     if ext.replay?.isNone then
       if let some asyncCtx := env.asyncCtx?.filter (·.realizing) then
-        panic! s!"Environment.modifyState: environment extension must set `replay?` field to be \
+        return panic! s!"environment extension must set `replay?` field to be \
           used in realization context '{asyncCtx.declPrefix}'"
     env.modifyCheckedAsync fun env =>
       { env with extensions := unsafe ext.modifyStateImpl env.extensions f }
@@ -1129,9 +1162,9 @@ private unsafe def getStateUnsafe {σ : Type} [Inhabited σ] (ext : EnvExtension
   -- safety: `ext`'s constructor is private, so we can assume the entry at `ext.idx` is of type `σ`
   match asyncMode with
   | .sync     => ext.getStateImpl env.checked.get.extensions
-  | .async    => panic! "EnvExtension.getState: called on `async` extension, use `findStateAsync` \
+  | .async    => panic! "called on `async` extension, use `findStateAsync` \
     instead or pass `(asyncMode := .local)` to explicitly access local state"
-  | _         => ext.getStateImpl env.checkedWithoutAsync.extensions
+  | _         => ext.getStateImpl env.base.extensions
 
 /--
 Returns the current extension state. See `AsyncMode` for details on how modifications from
@@ -1147,10 +1180,10 @@ opaque getState {σ : Type} [Inhabited σ] (ext : EnvExtension σ) (env : Enviro
 private unsafe def findStateAsyncUnsafe {σ : Type} [Inhabited σ]
     (ext : EnvExtension σ) (env : Environment) (declPrefix : Name) : σ :=
   -- safety: `ext`'s constructor is private, so we can assume the entry at `ext.idx` is of type `σ`
-  if let some { exts? := some exts, .. } := env.asyncConsts.findPrefix? declPrefix then
+  if let some { exts? := some exts, .. } := env.asyncConsts.findRec? declPrefix then
     ext.getStateImpl exts.get
   else
-    ext.getStateImpl env.checkedWithoutAsync.extensions
+    ext.getStateImpl env.base.extensions
 
 /--
 Returns the final extension state on the environment branch corresponding to the passed declaration
@@ -1190,7 +1223,7 @@ def mkEmptyEnvironment (trustLevel : UInt32 := 0) : IO Environment := do
   if initializing then throw (IO.userError "environment objects cannot be created during initialization")
   let exts ← mkInitialExtensionStates
   return {
-    checkedWithoutAsync := {
+    base := {
       const2ModIdx    := {}
       constants       := {}
       header          := { trustLevel }
@@ -1549,7 +1582,7 @@ def mkExtNameMap (startingAt : Nat) : IO (Std.HashMap Name Nat) := do
 private def setImportedEntries (env : Environment) (mods : Array ModuleData) (startingAt : Nat := 0) : IO Environment := do
   -- We work directly on the states array instead of `env` as `Environment.modifyState` introduces
   -- significant overhead on such frequent calls
-  let mut states := env.checkedWithoutAsync.extensions
+  let mut states := env.base.extensions
   let extDescrs ← persistentEnvExtensionsRef.get
   /- For extensions starting at `startingAt`, ensure their `importedEntries` array have size `mods.size`. -/
   for extDescr in extDescrs[startingAt:] do
@@ -1565,7 +1598,7 @@ private def setImportedEntries (env : Environment) (mods : Array ModuleData) (st
         -- safety: as in `modifyState`
         states := unsafe extDescrs[entryIdx]!.toEnvExtension.modifyStateImpl states fun s =>
           { s with importedEntries := s.importedEntries.set! modIdx entries }
-  return env.setCheckedSync { env.checkedWithoutAsync with extensions := states }
+  return env.setCheckedSync { env.base with extensions := states }
 
 /--
   "Forward declaration" needed for updating the attribute table with user-defined attributes.
@@ -1581,7 +1614,7 @@ private def setImportedEntries (env : Environment) (mods : Array ModuleData) (st
 @[extern 1 "lean_get_num_attributes"] opaque getNumBuiltinAttributes : IO Nat
 
 private def ensureExtensionsArraySize (env : Environment) : IO Environment := do
-  let exts ← EnvExtension.ensureExtensionsArraySize env.checkedWithoutAsync.extensions
+  let exts ← EnvExtension.ensureExtensionsArraySize env.base.extensions
   return env.modifyCheckedAsync ({ · with extensions := exts })
 
 private partial def finalizePersistentExtensions (env : Environment) (mods : Array ModuleData) (opts : Options) : IO Environment := do
@@ -1701,7 +1734,7 @@ def finalizeImport (s : ImportState) (imports : Array Import) (opts : Options) (
   let constants : ConstMap := SMap.fromHashMap constantMap false
   let exts ← mkInitialExtensionStates
   let mut env : Environment := {
-    checkedWithoutAsync := {
+    base := {
       const2ModIdx, constants
       quotInit        := !imports.isEmpty -- We assume `core.lean` initializes quotient module
       extraConstNames := {}
@@ -1785,7 +1818,7 @@ def Kernel.enableDiag (env : Lean.Environment) (flag : Bool) : Lean.Environment
   env.modifyCheckedAsync (·.enableDiag flag)
 
 def Kernel.isDiagnosticsEnabled (env : Lean.Environment) : Bool :=
-  env.checkedWithoutAsync.isDiagnosticsEnabled
+  env.base.isDiagnosticsEnabled
 
 def Kernel.resetDiag (env : Lean.Environment) : Lean.Environment :=
   env.modifyCheckedAsync (·.resetDiag)
@@ -1811,16 +1844,16 @@ def getNamespaceSet (env : Environment) : NameSSet :=
   namespacesExt.getState env
 
 @[export lean_elab_environment_update_base_after_kernel_add]
-private def updateBaseAfterKernelAdd (env : Environment) (kernel : Kernel.Environment) (decl : Declaration) : Environment :=
+private def updateBaseAfterKernelAdd (env : Environment) (kenv : Kernel.Environment) (decl : Declaration) : Environment :=
   { env with
-    checked := .pure kernel
-    checkedWithoutAsync := { kernel with extensions := env.checkedWithoutAsync.extensions }
+    checked := .pure kenv
     -- make constants available in `asyncConsts` as well; see its docstring
     asyncConsts := decl.getNames.foldl (init := env.asyncConsts) fun asyncConsts n =>
       if asyncConsts.find? n |>.isNone then
         asyncConsts.add {
-          constInfo := .ofConstantInfo (kernel.find? n |>.get!)
+          constInfo := .ofConstantInfo (kenv.find? n |>.get!)
           exts? := none
+          consts := .pure <| .mk (α := AsyncConsts) default
         }
       else asyncConsts }
 
@@ -1832,7 +1865,7 @@ def displayStats (env : Environment) : IO Unit := do
   IO.println ("number of memory-mapped modules:       " ++ toString (env.header.regions.filter (·.isMemoryMapped) |>.size));
   IO.println ("number of buckets for imported consts: " ++ toString env.constants.numBuckets);
   IO.println ("trust level:                           " ++ toString env.header.trustLevel);
-  IO.println ("number of extensions:                  " ++ toString env.checkedWithoutAsync.extensions.size);
+  IO.println ("number of extensions:                  " ++ toString env.base.extensions.size);
   pExtDescrs.forM fun extDescr => do
     IO.println ("extension '" ++ toString extDescr.name ++ "'")
     let s := extDescr.toEnvExtension.getState env
@@ -1877,7 +1910,7 @@ def realizeConst (env : Environment) (forConst : Name) (constName : Name)
     IO (Environment × Dynamic) := do
   let mut env := env
   -- find `RealizationContext` for `forConst` in `realizedImportedConsts?` or `realizedLocalConsts`
-  let ctx ← if env.checkedWithoutAsync.const2ModIdx.contains forConst then
+  let ctx ← if env.base.const2ModIdx.contains forConst then
     env.realizedImportedConsts?.getDM <|
       throw <| .userError s!"Environment.realizeConst: `realizedImportedConsts` is empty"
   else
@@ -1918,7 +1951,7 @@ def realizeConst (env : Environment) (forConst : Name) (constName : Name)
       let consts := realizeEnv'.asyncConsts.revList.take numNewConsts |>.reverse
       let consts := consts.map fun c =>
         if c.exts?.isNone then
-          { c with exts? := some <| .pure realizeEnv'.checkedWithoutAsync.extensions }
+          { c with exts? := some <| .pure realizeEnv'.base.extensions }
         else c
       let exts ← EnvExtension.envExtensionsRef.get
       let replay := (maybeAddToKernelEnv realizeEnv realizeEnv' consts · exts)
@@ -1950,17 +1983,19 @@ where
         -- generator.
         kenv := kenv.add info
         continue
-      let decl := match info with
+      -- for panics
+      let _ : Inhabited Kernel.Environment := ⟨kenv⟩
+      let decl ← match info with
         | .thmInfo thm   => .thmDecl thm
         | .defnInfo defn => .defnDecl defn
-        | _              => panic! s!"Environment.realizeConst: {c.constInfo.name} must be definition/theorem"
+        | _              =>
+          return panic! s!"{c.constInfo.name} must be definition/theorem"
       -- realized kernel additions cannot be interrupted - which would be bad anyway as they can be
       -- reused between snapshots
       match kenv.addDeclCore 0 decl none with
       | .ok kenv' => kenv := kenv'
       | .error e =>
-        let _ : Inhabited Kernel.Environment := ⟨kenv⟩
-        panic! s!"Environment.realizeConst: failed to add {c.constInfo.name} to environment\n{e.toRawString}"
+        return panic! s!"failed to add {c.constInfo.name} to environment\n{e.toRawString}"
     for ext in exts do
       if let some replay := ext.replay? then
         kenv := { kenv with

src/Lean/Meta/ArgsPacker.lean

@@ -328,6 +328,8 @@ if they are all the same.
 
 -/
 def uncurryType (types : Array Expr) : MetaM Expr := do
+  if types.size = 1 then
+    return types[0]!
   let types ← types.mapM whnfForall
   types.forM fun type => do
     unless type.isForall do

src/Lean/Meta/Basic.lean

@@ -2271,6 +2271,10 @@ def realizeConst (forConst : Name) (constName : Name) (realize : MetaM Unit) :
   -- the relevant local environment extension state when accessed on this branch.
   if env.containsOnBranch constName then
     return
+  -- TODO: remove when Mathlib passes without it
+  if !Elab.async.get (← getOptions) then
+    realize
+    return
   withTraceNode `Meta.realizeConst (fun _ => return constName) do
     let coreCtx ← readThe Core.Context
     let coreCtx := {

src/Lean/Meta/Eqns.lean

@@ -141,25 +141,27 @@ structure EqnsExtState where
 
 /- We generate the equations on demand. -/
 builtin_initialize eqnsExt : EnvExtension EqnsExtState ←
-  registerEnvExtension (pure {})
+  registerEnvExtension (pure {}) (asyncMode := .local)
 
 /--
 Simple equation theorem for nonrecursive definitions.
 -/
 private def mkSimpleEqThm (declName : Name) (suffix := Name.mkSimple unfoldThmSuffix) : MetaM (Option Name) := do
   if let some (.defnInfo info) := (← getEnv).find? declName then
-    lambdaTelescope (cleanupAnnotations := true) info.value fun xs body => do
-      let lhs := mkAppN (mkConst info.name <| info.levelParams.map mkLevelParam) xs
-      let type  ← mkForallFVars xs (← mkEq lhs body)
-      let value ← mkLambdaFVars xs (← mkEqRefl lhs)
-      let name := declName ++ suffix
-      addDecl <| Declaration.thmDecl {
-        name, type, value
-        levelParams := info.levelParams
-      }
-      return some name
+    let name := declName ++ suffix
+    realizeConst declName name (doRealize name info)
+    return some name
   else
     return none
+where doRealize name info := do
+  lambdaTelescope (cleanupAnnotations := true) info.value fun xs body => do
+    let lhs := mkAppN (mkConst info.name <| info.levelParams.map mkLevelParam) xs
+    let type  ← mkForallFVars xs (← mkEq lhs body)
+    let value ← mkLambdaFVars xs (← mkEqRefl lhs)
+    addDecl <| Declaration.thmDecl {
+      name, type, value
+      levelParams := info.levelParams
+    }
 
 /--
 Returns `some declName` if `thmName` is an equational theorem for `declName`.

src/Lean/Meta/Match/MatcherApp/Transform.lean

@@ -37,21 +37,27 @@ private partial def updateAlts (unrefinedArgType : Expr) (typeNew : Expr) (altNu
     else
       throwError "failed to add argument to matcher application, argument type was not refined by `casesOn`"
 
-/-- Given
-  - matcherApp `match_i As (fun xs => motive[xs]) discrs (fun ys_1 => (alt_1 : motive (C_1[ys_1])) ... (fun ys_n => (alt_n : motive (C_n[ys_n]) remaining`, and
-  - expression `e : B[discrs]`,
-  Construct the term
-  `match_i As (fun xs => B[xs] -> motive[xs]) discrs (fun ys_1 (y : B[C_1[ys_1]]) => alt_1) ... (fun ys_n (y : B[C_n[ys_n]]) => alt_n) e remaining`.
+/--
+Given
+- matcherApp `match_i As (fun xs => motive[xs]) discrs (fun ys_1 => (alt_1 : motive (C_1[ys_1])) ... (fun ys_n => (alt_n : motive (C_n[ys_n]) remaining`, and
+- expression `e : B[discrs]`,
+Construct the term
+`match_i As (fun xs => B[xs] -> motive[xs]) discrs (fun ys_1 (y : B[C_1[ys_1]]) => alt_1) ... (fun ys_n (y : B[C_n[ys_n]]) => alt_n) e remaining`.
 
-  We use `kabstract` to abstract the discriminants from `B[discrs]`.
+We only abstract discriminants that are fvars.  We used to use `kabstract` to abstract all
+discriminants from `B[discrs]`, but that changes the type of the arg in ways that make it no
+longer compatible with the original recursive function (issue #7322).
 
-  This method assumes
-  - the `matcherApp.motive` is a lambda abstraction where `xs.size == discrs.size`
-  - each alternative is a lambda abstraction where `ys_i.size == matcherApp.altNumParams[i]`
+If this is still not great, then we could try to use `kabstract`, but only on the last paramter
+of the `arg` (the termination proof obligation).
 
-  This is used in `Lean.Elab.PreDefinition.WF.Fix` when replacing recursive calls with calls to
-  the argument provided by `fix` to refine type of the local variable used for recursive calls,
-  which may mention `major`. See there for how to use this function.
+This method assumes
+- the `matcherApp.motive` is a lambda abstraction where `xs.size == discrs.size`
+- each alternative is a lambda abstraction where `ys_i.size == matcherApp.altNumParams[i]`
+
+This is used in `Lean.Elab.PreDefinition.WF.Fix` when replacing recursive calls with calls to
+the argument provided by `fix` to refine type of the local variable used for recursive calls,
+which may mention `major`. See there for how to use this function.
 -/
 def addArg (matcherApp : MatcherApp) (e : Expr) : MetaM MatcherApp :=
   lambdaTelescope matcherApp.motive fun motiveArgs motiveBody => do
@@ -59,11 +65,13 @@ def addArg (matcherApp : MatcherApp) (e : Expr) : MetaM MatcherApp :=
       -- This error can only happen if someone implemented a transformation that rewrites the motive created by `mkMatcher`.
       throwError "unexpected matcher application, motive must be lambda expression with #{matcherApp.discrs.size} arguments"
     let eType ← inferType e
-    let eTypeAbst ← matcherApp.discrs.size.foldRevM (init := eType) fun i _ eTypeAbst => do
-      let motiveArg := motiveArgs[i]!
+    let eTypeAbst := matcherApp.discrs.size.foldRev (init := eType) fun i _ eTypeAbst =>
       let discr     := matcherApp.discrs[i]
-      let eTypeAbst ← kabstract eTypeAbst discr
-      return eTypeAbst.instantiate1 motiveArg
+      if discr.isFVar then
+        let motiveArg := motiveArgs[i]!
+        eTypeAbst.replaceFVar discr motiveArg
+      else
+        eTypeAbst
     let motiveBody ← mkArrow eTypeAbst motiveBody
     let matcherLevels ← match matcherApp.uElimPos? with
       | none     => pure matcherApp.matcherLevels

src/Lean/Meta/Tactic/FunInd.lean

@@ -695,10 +695,10 @@ def deriveUnaryInduction (name : Name) : MetaM Name := do
     | fix@WellFounded.fix α _motive rel wf body target =>
       unless params.back! == target do
         throwError "functional induction: expected the target as last parameter{indentExpr e}"
-      let fixedParams := params.pop
+      let fixedParamPerms := params.pop
       let motiveType ← mkForallFVars #[target] (.sort levelZero)
       withLocalDeclD `motive motiveType fun motive => do
-        let fn := mkAppN (← mkConstWithLevelParams name) fixedParams
+        let fn := mkAppN (← mkConstWithLevelParams name) fixedParamPerms
         let isRecCall : Expr → Option Expr := fun e =>
           if e.isApp && e.appFn!.isFVarOf motive.fvarId! then
             mkApp fn e.appArg!
@@ -732,7 +732,7 @@ def deriveUnaryInduction (name : Name) : MetaM Name := do
         -- induction principle match the type of the function better.
         -- But this leads to avoidable parameters that make functional induction strictly less
         -- useful (e.g. when the unsued parameter mentions bound variables in the users' goal)
-        let (paramMask, e') ← mkLambdaFVarsMasked fixedParams e'
+        let (paramMask, e') ← mkLambdaFVarsMasked fixedParamPerms e'
         let e' ← instantiateMVars e'
         return (e', paramMask)
     | _ =>
@@ -787,16 +787,25 @@ def projectMutualInduct (names : Array Name) (mutualInduct : Name) : MetaM Unit
 For a (non-mutual!) definition of `name`, uses the `FunIndInfo` associated with the `unaryInduct` and
 derives the one for the n-ary function.
 -/
-def setNaryFunIndInfo (name : Name) (arity : Nat) (unaryInduct : Name) : MetaM Unit := do
-    let inductName := getFunInductName name
-    unless inductName = unaryInduct do
-      let some unaryFunIndInfo ← getFunIndInfoForInduct? unaryInduct
-        | throwError "Expected {unaryInduct} to have FunIndInfo"
-      setFunIndInfo {
-        unaryFunIndInfo with
-        funIndName := inductName
-        params := unaryFunIndInfo.params.filter (· != .target) ++ mkArray arity .target
-      }
+def setNaryFunIndInfo (fixedParamPerms : FixedParamPerms) (name : Name) (unaryInduct : Name) : MetaM Unit := do
+  assert!  fixedParamPerms.perms.size = 1 -- only non-mutual for now
+  let funIndName := getFunInductName name
+  unless funIndName = unaryInduct do
+    let some unaryFunIndInfo ← getFunIndInfoForInduct? unaryInduct
+      | throwError "Expected {unaryInduct} to have FunIndInfo"
+    let fixedParamPerm := fixedParamPerms.perms[0]!
+    let mut params := #[]
+    let mut j := 0
+    for h : i in [:fixedParamPerm.size] do
+      if fixedParamPerm[i].isSome then
+        assert! j + 1 < unaryFunIndInfo.params.size
+        params := params.push unaryFunIndInfo.params[j]!
+        j := j + 1
+      else
+        params := params.push .target
+    assert! j + 1 = unaryFunIndInfo.params.size
+
+    setFunIndInfo { unaryFunIndInfo with funIndName, params }
 
 /--
 In the type of `value`, reduces
@@ -920,13 +929,15 @@ Given a recursive definition `foo` defined via structural recursion, derive `foo
 if needed, and `foo.induct` for all functions in the group.
 See module doc for details.
  -/
-def deriveInductionStructural (names : Array Name) (numFixed : Nat) : MetaM Unit := do
+def deriveInductionStructural (names : Array Name) (fixedParamPerms : FixedParamPerms) : MetaM Unit := do
   let infos ← names.mapM getConstInfoDefn
+  assert! infos.size > 0
   -- First open up the fixed parameters everywhere
-  let (e', paramMask, motiveArities) ← lambdaBoundedTelescope infos[0]!.value numFixed fun xs _ => do
+  let (e', paramMask, motiveArities) ← fixedParamPerms.perms[0]!.forallTelescope infos[0]!.type fun xs => do
     -- Now look at the body of an arbitrary of the functions (they are essentially the same
     -- up to the final projections)
-    let body ← instantiateLambda infos[0]!.value xs
+    let body ← fixedParamPerms.perms[0]!.instantiateLambda infos[0]!.value xs
+    let body := body.eta
 
     lambdaTelescope body fun ys body => do
       -- The body is of the form (brecOn … ).2.2.1 extra1 extra2 etc; ignore the
@@ -938,7 +949,7 @@ def deriveInductionStructural (names : Array Name) (numFixed : Nat) : MetaM Unit
 
       let body := PProdN.stripProjs body
       let .const brecOnName us := f |
-        throwError "{infos[0]!.name}: unexpected body:{indentExpr infos[0]!.value}"
+        throwError "{infos[0]!.name}: unexpected body:{indentExpr infos[0]!.value}\ninstantiated to{indentExpr body}"
       unless isBRecOnRecursor (← getEnv) brecOnName do
         throwError "{infos[0]!.name}: expected .brecOn application, found:{indentExpr body}"
 
@@ -975,12 +986,13 @@ def deriveInductionStructural (names : Array Name) (numFixed : Nat) : MetaM Unit
         motives.mapM fun motive =>
           forallTelescopeReducing motive fun xs _ => pure xs.size
 
-
-      let recArgInfos ← infos.mapM fun info => do
+      -- Recreate the recArgInfos. Maybe more robust and simpler to store relevant parts in the EqnInfos?
+      let recArgInfos ← infos.mapIdxM fun funIdx info => do
         let some eqnInfo := Structural.eqnInfoExt.find? (← getEnv) info.name | throwError "{info.name} missing eqnInfo"
-        let value ← instantiateLambda info.value xs
+        let value ← fixedParamPerms.perms[funIdx]!.instantiateLambda info.value xs
         let recArgInfo' ← lambdaTelescope value fun ys _ =>
-          Structural.getRecArgInfo info.name numFixed (xs ++ ys) eqnInfo.recArgPos
+          let args := fixedParamPerms.perms[funIdx]!.buildArgs xs ys
+          Structural.getRecArgInfo info.name fixedParamPerms.perms[funIdx]! args eqnInfo.recArgPos
         let #[recArgInfo] ← Structural.argsInGroup group xs value #[recArgInfo']
           | throwError "Structural.argsInGroup did not return a recArgInfo"
         pure recArgInfo
@@ -998,23 +1010,24 @@ def deriveInductionStructural (names : Array Name) (numFixed : Nat) : MetaM Unit
         -- context, and are the parts relevant for every function in the mutual group
 
         -- Calculate the types of the induction motives (natural argument order) for each function
-        let motiveTypes ← infos.mapM fun info => do
-          lambdaTelescope (← instantiateLambda info.value xs) fun ys _ =>
+        let motiveTypes ← infos.mapIdxM fun funIdx info => do
+          lambdaTelescope (← fixedParamPerms.perms[funIdx]!.instantiateLambda info.value xs) fun ys _ =>
             mkForallFVars ys (.sort levelZero)
-        let motiveArities ← infos.mapM fun info => do
-          lambdaTelescope (← instantiateLambda info.value xs) fun ys _ => pure ys.size
+        let motiveArities ← infos.mapIdxM fun funIdx info => do
+          lambdaTelescope (← fixedParamPerms.perms[funIdx]!.instantiateLambda info.value xs) fun ys _ =>
+            pure ys.size
         let motiveNames := Array.ofFn (n := infos.size) fun ⟨i, _⟩ =>
           if infos.size = 1 then .mkSimple "motive" else .mkSimple s!"motive_{i+1}"
 
         withLocalDeclsDND (motiveNames.zip motiveTypes) fun motives => do
 
           -- Prepare the `isRecCall` that recognizes recursive calls
-          let fns := infos.map fun info =>
-            mkAppN (.const info.name (info.levelParams.map mkLevelParam)) xs
           let isRecCall : Expr → Option Expr := fun e => do
-            if let .some i := motives.idxOf? e.getAppFn then
-              if e.getAppNumArgs = motiveArities[i]! then
-                return mkAppN fns[i]! e.getAppArgs
+            if let .some funIdx := motives.idxOf? e.getAppFn then
+              if e.getAppNumArgs = motiveArities[funIdx]! then
+                let info := infos[funIdx]!
+                let args := fixedParamPerms.perms[funIdx]!.buildArgs xs e.getAppArgs
+                return mkAppN (.const info.name (info.levelParams.map mkLevelParam)) args
             .none
 
           -- Motives with parameters reordered, to put indices and major first
@@ -1062,8 +1075,8 @@ def deriveInductionStructural (names : Array Name) (numFixed : Nat) : MetaM Unit
             for info in infos, recArgInfo in recArgInfos, idx in [:infos.size] do
               -- Take care to pick the `ys` from the type, to get the variable names expected
               -- by the user, but use the value arity
-              let arity ← lambdaTelescope (← instantiateLambda info.value xs) fun ys _ => pure ys.size
-              let e ← forallBoundedTelescope (← instantiateForall info.type xs) arity fun ys _ => do
+              let arity ← lambdaTelescope (← fixedParamPerms.perms[idx]!.instantiateLambda info.value xs) fun ys _ => pure ys.size
+              let e ← forallBoundedTelescope (← fixedParamPerms.perms[idx]!.instantiateForall info.type xs) arity fun ys _ => do
                 let (indicesMajor, rest) := recArgInfo.pickIndicesMajor ys
                 -- Find where in the function packing we are (TODO: abstract out)
                 let some indIdx := positions.findIdx? (·.contains idx) | panic! "invalid positions"
@@ -1205,9 +1218,9 @@ def deriveInduction (name : Name) : MetaM Unit := do
       let unpackedInductName ← unpackMutualInduction eqnInfo unaryInductName
       projectMutualInduct eqnInfo.declNames unpackedInductName
       if eqnInfo.argsPacker.numFuncs = 1 then
-        setNaryFunIndInfo eqnInfo.declNames[0]! eqnInfo.argsPacker.arities[0]! unaryInductName
+        setNaryFunIndInfo eqnInfo.fixedParamPerms eqnInfo.declNames[0]! unaryInductName
     else if let some eqnInfo := Structural.eqnInfoExt.find? (← getEnv) name then
-      deriveInductionStructural eqnInfo.declNames eqnInfo.numFixed
+      deriveInductionStructural eqnInfo.declNames eqnInfo.fixedParamPerms
     else
       throwError "constant '{name}' is not structurally or well-founded recursive"
 

src/Lean/Meta/Tactic/FunIndInfo.lean

@@ -21,7 +21,7 @@ inductive FunIndParamKind where
   | dropped
   | param
   | target
-deriving BEq, Repr
+deriving BEq, Repr, Inhabited
 
 /--
 A `FunIndInfo` indicates how a function's arguments map to the arguments of the functional induction

src/Lean/Meta/Tactic/Grind/Arith/Cutsat.lean

@@ -16,6 +16,7 @@ import Lean.Meta.Tactic.Grind.Arith.Cutsat.Var
 import Lean.Meta.Tactic.Grind.Arith.Cutsat.EqCnstr
 import Lean.Meta.Tactic.Grind.Arith.Cutsat.SearchM
 import Lean.Meta.Tactic.Grind.Arith.Cutsat.Model
+import Lean.Meta.Tactic.Grind.Arith.Cutsat.DivMod
 
 namespace Lean
 
@@ -54,5 +55,9 @@ builtin_initialize registerTraceClass `grind.debug.cutsat.diseq
 builtin_initialize registerTraceClass `grind.debug.cutsat.diseq.split
 builtin_initialize registerTraceClass `grind.debug.cutsat.backtrack
 builtin_initialize registerTraceClass `grind.debug.cutsat.search
+builtin_initialize registerTraceClass `grind.debug.cutsat.cooper
+builtin_initialize registerTraceClass `grind.debug.cutsat.conflict
+builtin_initialize registerTraceClass `grind.debug.cutsat.assign
+builtin_initialize registerTraceClass `grind.debug.cutsat.subst
 
 end Lean

src/Lean/Meta/Tactic/Grind/Arith/Cutsat/DivMod.lean

@@ -0,0 +1,42 @@
+/-
+Copyright (c) 2025 Amazon.com, Inc. or its affiliates. All Rights Reserved.
+Released under Apache 2.0 license as described in the file LICENSE.
+Authors: Leonardo de Moura
+-/
+prelude
+import Lean.Meta.Tactic.Grind.PropagatorAttr
+import Lean.Meta.Tactic.Grind.Arith.Cutsat.Util
+import Lean.Meta.Tactic.Grind.Canon
+import Lean.Meta.Tactic.Grind.Core
+
+namespace Lean.Meta.Grind.Arith.Cutsat
+
+private def assertFact (h : Expr) : GoalM Unit := do
+  let prop ← shareCommon (← canon (← inferType h))
+  trace[Meta.debug] "{prop}"
+  add prop h 0
+
+private def expandDivMod (a : Expr) (b : Int) : GoalM Unit := do
+  if b == 0 then return ()
+  if (← get').divMod.contains (a, b) then return ()
+  modify' fun s => { s with divMod := s.divMod.insert (a, b) }
+  let n : Int := 1 - b.natAbs
+  let b := mkIntLit b
+  assertFact <| mkApp2 (mkConst ``Int.Linear.ediv_emod) a b
+  assertFact <| mkApp3 (mkConst ``Int.Linear.emod_nonneg) a b reflBoolTrue
+  assertFact <| mkApp4 (mkConst ``Int.Linear.emod_le) a b (toExpr n) reflBoolTrue
+
+builtin_grind_propagator propagateDiv ↑HDiv.hDiv := fun e => do
+  let_expr HDiv.hDiv _ _ _ inst a b ← e | return ()
+  unless (← isInstHDivInt inst) do return ()
+  let some b ← getIntValue? b | return ()
+  -- Remark: we currently do not consider the case where `b` is in the equivalence class of a numeral.
+  expandDivMod a b
+
+builtin_grind_propagator propagateMod ↑HMod.hMod := fun e => do
+  let_expr HMod.hMod _ _ _ inst a b ← e | return ()
+  unless (← isInstHModInt inst) do return ()
+  let some b ← getIntValue? b | return ()
+  expandDivMod a b
+
+end Lean.Meta.Grind.Arith.Cutsat

src/Lean/Meta/Tactic/Grind/Arith/Cutsat/DvdCnstr.lean

@@ -12,19 +12,16 @@ import Lean.Meta.Tactic.Grind.Arith.Cutsat.Proof
 
 namespace Lean.Meta.Grind.Arith.Cutsat
 
-def mkDvdCnstr (d : Int) (p : Poly) (h : DvdCnstrProof) : GoalM DvdCnstr := do
-  return { d, p, h, id := (← mkCnstrId) }
-
-def DvdCnstr.norm (c : DvdCnstr) : GoalM DvdCnstr := do
-  let c ← if c.p.isSorted then
-    pure c
+def DvdCnstr.norm (c : DvdCnstr) : DvdCnstr :=
+  let c := if c.p.isSorted then
+    c
   else
-    mkDvdCnstr c.d c.p.norm (.norm c)
+    { d := c.d, p := c.p.norm, h :=.norm c }
   let g := c.p.gcdCoeffs c.d
   if c.p.getConst % g == 0 && g != 1 then
-    mkDvdCnstr (c.d/g) (c.p.div g) (.divCoeffs c)
+    { d := c.d/g, p := c.p.div g, h := .divCoeffs c }
   else
-    return c
+    c
 
 /--
 Given an equation `c₁` containing the monomial `a*x`, and a divisibility constraint `c₂`
@@ -36,7 +33,7 @@ def DvdCnstr.applyEq (a : Int) (x : Var) (c₁ : EqCnstr) (b : Int) (c₂ : DvdC
   let d := Int.ofNat (a * c₂.d).natAbs
   let p := (q.mul a |>.combine (p.mul (-b)))
   trace[grind.cutsat.subst] "{← getVar x}, {← c₁.pp}, {← c₂.pp}"
-  mkDvdCnstr d p (.subst x c₁ c₂)
+  return { d, p, h := .subst x c₁ c₂ }
 
 partial def DvdCnstr.applySubsts (c : DvdCnstr) : GoalM DvdCnstr := withIncRecDepth do
   let some (b, x, c₁) ← c.p.findVarToSubst | return c
@@ -47,9 +44,10 @@ partial def DvdCnstr.applySubsts (c : DvdCnstr) : GoalM DvdCnstr := withIncRecDe
 /-- Asserts divisibility constraint. -/
 partial def DvdCnstr.assert (c : DvdCnstr) : GoalM Unit := withIncRecDepth do
   if (← inconsistent) then return ()
-  let c ← c.norm
-  let c ← c.applySubsts
+  trace[grind.cutsat.dvd] "{← c.pp}"
+  let c ← c.norm.applySubsts
   if c.isUnsat then
+    trace[grind.cutsat.dvd.unsat] "{← c.pp}"
     setInconsistent (.dvd c)
     return ()
   if c.isTrivial then
@@ -74,13 +72,13 @@ partial def DvdCnstr.assert (c : DvdCnstr) : GoalM Unit := withIncRecDepth do
     -/
     let α_d₂_p₁ := p₁.mul (α*d₂)
     let β_d₁_p₂ := p₂.mul (β*d₁)
-    let combine ← mkDvdCnstr (d₁*d₂) (.add d x (α_d₂_p₁.combine β_d₁_p₂)) (.solveCombine c c')
+    let combine := { d := d₁*d₂, p := .add d x (α_d₂_p₁.combine β_d₁_p₂), h := .solveCombine c c' : DvdCnstr }
     trace[grind.cutsat.dvd.solve.combine] "{← combine.pp}"
     modify' fun s => { s with dvds := s.dvds.set x none}
     combine.assert
     let a₂_p₁ := p₁.mul a₂
     let a₁_p₂ := p₂.mul (-a₁)
-    let elim ← mkDvdCnstr d (a₂_p₁.combine a₁_p₂) (.solveElim c c')
+    let elim := { d, p := a₂_p₁.combine a₁_p₂, h := .solveElim c c' : DvdCnstr }
     trace[grind.cutsat.dvd.solve.elim] "{← elim.pp}"
     elim.assert
   else
@@ -96,7 +94,7 @@ builtin_grind_propagator propagateDvd ↓Dvd.dvd := fun e => do
       return ()
   if (← isEqTrue e) then
     let p ← toPoly b
-    let c ← mkDvdCnstr d p (.expr (← mkOfEqTrue (← mkEqTrueProof e)))
+    let c := { d, p, h := .expr (← mkOfEqTrue (← mkEqTrueProof e)) : DvdCnstr }
     trace[grind.cutsat.assert.dvd] "{← c.pp}"
     c.assert
   else if (← isEqFalse e) then

src/Lean/Meta/Tactic/Grind/Arith/Cutsat/EqCnstr.lean

@@ -14,23 +14,21 @@ namespace Lean.Meta.Grind.Arith.Cutsat
 private def _root_.Int.Linear.Poly.substVar (p : Poly) : GoalM (Option (Var × EqCnstr × Poly)) := do
   let some (a, x, c) ← p.findVarToSubst | return none
   let b := c.p.coeff x
-  let p := p.mul (-b) |>.combine (c.p.mul a)
-  return some (x, c, p)
+  let p' := p.mul (-b) |>.combine (c.p.mul a)
+  trace[grind.debug.cutsat.subst] "{← p.pp}, {a}, {← getVar x}, {← c.pp}, {b}, {← p'.pp}"
+  return some (x, c, p')
 
-def EqCnstr.norm (c : EqCnstr) : GoalM EqCnstr := do
-  let c ← if c.p.isSorted then
-    pure c
+def EqCnstr.norm (c : EqCnstr) : EqCnstr :=
+  if c.p.isSorted then
+    c
   else
-    mkEqCnstr c.p.norm (.norm c)
+    { p := c.p.norm, h := .norm c }
 
-def mkDiseqCnstr (p : Poly) (h : DiseqCnstrProof) : GoalM DiseqCnstr := do
-  return { p, h, id := (← mkCnstrId) }
-
-def DiseqCnstr.norm (c : DiseqCnstr) : GoalM DiseqCnstr := do
-  let c ← if c.p.isSorted then
-    pure c
+def DiseqCnstr.norm (c : DiseqCnstr) : DiseqCnstr :=
+  if c.p.isSorted then
+    c
   else
-    mkDiseqCnstr c.p.norm (.norm c)
+    { p := c.p.norm, h := .norm c }
 
 /--
 Given an equation `c₁` containing the monomial `a*x`, and a disequality constraint `c₂`
@@ -41,13 +39,12 @@ def DiseqCnstr.applyEq (a : Int) (x : Var) (c₁ : EqCnstr) (b : Int) (c₂ : Di
   let q := c₂.p
   let p := p.mul b |>.combine (q.mul (-a))
   trace[grind.cutsat.subst] "{← getVar x}, {← c₁.pp}, {← c₂.pp}"
-  mkDiseqCnstr p (.subst x c₁ c₂)
+  return { p, h := .subst x c₁ c₂ }
 
 partial def DiseqCnstr.applySubsts (c : DiseqCnstr) : GoalM DiseqCnstr := withIncRecDepth do
   let some (x, c₁, p) ← c.p.substVar | return c
   trace[grind.cutsat.subst] "{← getVar x}, {← c.pp}, {← c₁.pp}"
-  let c ← mkDiseqCnstr p (.subst x c₁ c)
-  applySubsts c
+  applySubsts { p, h := .subst x c₁ c }
 
 /--
 Given a disequality `c`, tries to find an inequality to be refined using
@@ -61,8 +58,7 @@ private def DiseqCnstr.findLe (c : DiseqCnstr) : GoalM Bool := do
     for c' in cs' do
       if c.p == c'.p || c.p.isNegEq c'.p then
         c'.erase
-        let le ← mkLeCnstr (c'.p.addConst 1) (.ofLeDiseq c' c)
-        le.assert
+        { p := c'.p.addConst 1, h := .ofLeDiseq c' c : LeCnstr }.assert
         return true
     return false
   go true <||> go false
@@ -70,8 +66,7 @@ private def DiseqCnstr.findLe (c : DiseqCnstr) : GoalM Bool := do
 def DiseqCnstr.assert (c : DiseqCnstr) : GoalM Unit := do
   if (← inconsistent) then return ()
   trace[grind.cutsat.assert] "{← c.pp}"
-  let c ← c.norm
-  let c ← c.applySubsts
+  let c ← c.norm.applySubsts
   if c.p.isUnsatDiseq then
     setInconsistent (.diseq c)
     return ()
@@ -79,10 +74,10 @@ def DiseqCnstr.assert (c : DiseqCnstr) : GoalM Unit := do
     trace[grind.cutsat.diseq.trivial] "{← c.pp}"
     return ()
   let k := c.p.gcdCoeffs c.p.getConst
-  let c ← if k == 1 then
-    pure c
+  let c := if k == 1 then
+    c
   else
-    mkDiseqCnstr (c.p.div k) (.divCoeffs c)
+    { p := c.p.div k, h := .divCoeffs c }
   if (← c.findLe) then
     return ()
   let .add _ x _ := c.p | c.throwUnexpected
@@ -114,8 +109,7 @@ where
 partial def EqCnstr.applySubsts (c : EqCnstr) : GoalM EqCnstr := withIncRecDepth do
   let some (x, c₁, p) ← c.p.substVar | return c
   trace[grind.cutsat.subst] "{← getVar x}, {← c.pp}, {← c₁.pp}"
-  let c ← mkEqCnstr p (.subst x c₁ c)
-  applySubsts c
+  applySubsts { p, h := .subst x c₁ c : EqCnstr }
 
 private def updateDvdCnstr (a : Int) (x : Var) (c : EqCnstr) (y : Var) : GoalM Unit := do
   let some c' := (← get').dvds[y]! | return ()
@@ -201,36 +195,35 @@ private def updateOccs (k : Int) (x : Var) (c : EqCnstr) : GoalM Unit := do
 def EqCnstr.assertImpl (c : EqCnstr) : GoalM Unit := do
   if (← inconsistent) then return ()
   trace[grind.cutsat.assert] "{← c.pp}"
-  let c ← c.norm
-  let c ← c.applySubsts
+  let c ← c.norm.applySubsts
   if c.p.isUnsatEq then
     setInconsistent (.eq c)
     return ()
   if c.isTrivial then
-    trace[grind.cutsat.le.trivial] "{← c.pp}"
+    trace[grind.cutsat.eq.trivial] "{← c.pp}"
     return ()
   let k := c.p.gcdCoeffs'
   if c.p.getConst % k > 0 then
     setInconsistent (.eq c)
     return ()
-  let c ← if k == 1 then
-    pure c
+  let c := if k == 1 then
+    c
   else
-    mkEqCnstr (c.p.div k) (.divCoeffs c)
+    { p := c.p.div k, h := .divCoeffs c }
   trace[grind.cutsat.eq] "{← c.pp}"
   let some (k, x) := c.p.pickVarToElim? | c.throwUnexpected
+  trace[grind.debug.cutsat.subst] ">> {← getVar x}, {← c.pp}"
+  modify' fun s => { s with
+    elimEqs := s.elimEqs.set x (some c)
+    elimStack := x :: s.elimStack
+  }
   updateOccs k x c
   if (← inconsistent) then return ()
   -- assert a divisibility constraint IF `|k| != 1`
   if k.natAbs != 1 then
     let p := c.p.insert (-k) x
     let d := Int.ofNat k.natAbs
-    let c ← mkDvdCnstr d p (.ofEq x c)
-    c.assert
-  modify' fun s => { s with
-    elimEqs := s.elimEqs.set x (some c)
-    elimStack := x :: s.elimStack
-  }
+    { d, p, h := .ofEq x c : DvdCnstr }.assert
 
 private def exprAsPoly (a : Expr) : GoalM Poly := do
   if let some p := (← get').terms.find? { expr := a } then
@@ -248,8 +241,7 @@ def processNewEqImpl (a b : Expr) : GoalM Unit := do
   let p₁ ← exprAsPoly a
   let p₂ ← exprAsPoly b
   let p := p₁.combine (p₂.mul (-1))
-  let c ← mkEqCnstr p (.core p₁ p₂ (← mkEqProof a b))
-  c.assert
+  { p, h := .core p₁ p₂ (← mkEqProof a b) : EqCnstr }.assert
 
 @[export lean_process_cutsat_eq_lit]
 def processNewEqLitImpl (a ke : Expr) : GoalM Unit := do
@@ -258,11 +250,11 @@ def processNewEqLitImpl (a ke : Expr) : GoalM Unit := do
   let p₁ ← exprAsPoly a
   let h ← mkEqProof a ke
   let c ← if k == 0 then
-    mkEqCnstr p₁ (.expr h)
+    pure { p := p₁, h := .expr h : EqCnstr }
   else
     let p₂ ← exprAsPoly ke
     let p := p₁.combine (p₂.mul (-1))
-    mkEqCnstr p (.core p₁ p₂ h)
+    pure { p, h := .core p₁ p₂ h : EqCnstr }
   c.assert
 
 @[export lean_process_cutsat_diseq]
@@ -272,11 +264,11 @@ def processNewDiseqImpl (a b : Expr) : GoalM Unit := do
   let some h ← mkDiseqProof? a b
     | throwError "internal `grind` error, failed to build disequality proof for{indentExpr a}\nand{indentExpr b}"
   let c ← if let some 0 ← getIntValue? b then
-    mkDiseqCnstr p₁ (.expr h)
+    pure { p := p₁, h := .expr h : DiseqCnstr }
   else
     let p₂ ← exprAsPoly b
     let p := p₁.combine (p₂.mul (-1))
-    mkDiseqCnstr p (.core p₁ p₂ h)
+    pure {p, h := .core p₁ p₂ h : DiseqCnstr }
   c.assert
 
 /-- Different kinds of terms internalized by this module. -/

src/Lean/Meta/Tactic/Grind/Arith/Cutsat/LeCnstr.lean

@@ -11,19 +11,17 @@ import Lean.Meta.Tactic.Grind.Arith.Cutsat.Util
 import Lean.Meta.Tactic.Grind.Arith.Cutsat.Proof
 
 namespace Lean.Meta.Grind.Arith.Cutsat
-def mkLeCnstr (p : Poly) (h : LeCnstrProof) : GoalM LeCnstr := do
-  return { p, h, id := (← mkCnstrId) }
 
-def LeCnstr.norm (c : LeCnstr) : GoalM LeCnstr := do
-  let c ← if c.p.isSorted then
-    pure c
+def LeCnstr.norm (c : LeCnstr) : LeCnstr :=
+  let c := if c.p.isSorted then
+    c
   else
-    mkLeCnstr c.p.norm (.norm c)
+    { p := c.p.norm, h := .norm c }
   let k := c.p.gcdCoeffs'
   if k != 1 then
-    mkLeCnstr (c.p.div k) (.divCoeffs c)
+    { p := c.p.div k, h := .divCoeffs c }
   else
-    return c
+    c
 
 /--
 Given an equation `c₁` containing the monomial `a*x`, and an inequality constraint `c₂`
@@ -37,7 +35,7 @@ def LeCnstr.applyEq (a : Int) (x : Var) (c₁ : EqCnstr) (b : Int) (c₂ : LeCns
   else
     p.mul b |>.combine (q.mul (-a))
   trace[grind.cutsat.subst] "{← getVar x}, {← c₁.pp}, {← c₂.pp}"
-  mkLeCnstr p (.subst x c₁ c₂)
+  return { p, h := .subst x c₁ c₂ }
 
 partial def LeCnstr.applySubsts (c : LeCnstr) : GoalM LeCnstr := withIncRecDepth do
   let some (b, x, c₁) ← c.p.findVarToSubst | return c
@@ -70,7 +68,8 @@ private def findEq (c : LeCnstr) : GoalM Bool := do
   for c' in cs' do
     if c.p.isNegEq c'.p then
       c'.erase
-      let eq ← mkEqCnstr c.p (.ofLeGe c c')
+      let eq := { p := c.p, h := .ofLeGe c c' : EqCnstr }
+      trace[grind.debug.cutsat.eq] "new eq: {← eq.pp}"
       eq.assert
       return true
   return false
@@ -93,14 +92,14 @@ where
       if c.p == c'.p || c.p.isNegEq c'.p then
         -- Remove `c'`
         modify' fun s => { s with diseqs := s.diseqs.modify x fun cs' => cs'.filter fun c => c.p != c'.p }
-        return some (← mkLeCnstr (c.p.addConst 1) (.ofLeDiseq c c'))
+        return some { p := c.p.addConst 1, h := .ofLeDiseq c c' }
     return none
 
 def LeCnstr.assert (c : LeCnstr) : GoalM Unit := do
   if (← inconsistent) then return ()
-  let c ← c.norm
-  let c ← c.applySubsts
+  let c ← c.norm.applySubsts
   if c.isUnsat then
+    trace[grind.cutsat.le.unsat] "{← c.pp}"
     setInconsistent (.le c)
     return ()
   if c.isTrivial then
@@ -140,9 +139,9 @@ integer inequality, asserts it to the cutsat state.
 def propagateIfIntLe (e : Expr) (eqTrue : Bool) : GoalM Unit := do
   let some p ← toPolyLe? e | return ()
   let c ← if eqTrue then
-    mkLeCnstr p (.expr (← mkOfEqTrue (← mkEqTrueProof e)))
+    pure { p, h := .expr (← mkOfEqTrue (← mkEqTrueProof e)) : LeCnstr }
   else
-    mkLeCnstr (p.mul (-1) |>.addConst 1) (.notExpr p (← mkOfEqFalse (← mkEqFalseProof e)))
+    pure { p := p.mul (-1) |>.addConst 1, h := .notExpr p (← mkOfEqFalse (← mkEqFalseProof e)) : LeCnstr }
   trace[grind.cutsat.assert.le] "{← c.pp}"
   c.assert
 

src/Lean/Meta/Tactic/Grind/Arith/Cutsat/Model.lean

@@ -94,6 +94,6 @@ def mkModel (goal : Goal) : MetaM (Array (Expr × Rat)) := do
   for (e, v) in model do
     unless isInterpretedTerm e do
       r := r.push (e, v)
-  return r
+  return r.qsort fun (e₁, _) (e₂, _) => e₁.lt e₂
 
 end Lean.Meta.Grind.Arith.Cutsat

src/Lean/Meta/Tactic/Grind/Arith/Cutsat/Proof.lean

@@ -14,7 +14,7 @@ private def DvdCnstr.get_d_a (c : DvdCnstr) : GoalM (Int × Int) := do
   return (d, a)
 
 mutual
-partial def EqCnstr.toExprProof (c' : EqCnstr) : ProofM Expr := c'.caching do
+partial def EqCnstr.toExprProof (c' : EqCnstr) : ProofM Expr := caching c' do
   match c'.h with
   | .expr h =>
     return h
@@ -34,7 +34,7 @@ partial def EqCnstr.toExprProof (c' : EqCnstr) : ProofM Expr := c'.caching do
       (← getContext) (toExpr c₁.p) (toExpr c₂.p)
       reflBoolTrue (← c₁.toExprProof) (← c₂.toExprProof)
 
-partial def DvdCnstr.toExprProof (c' : DvdCnstr) : ProofM Expr := c'.caching do
+partial def DvdCnstr.toExprProof (c' : DvdCnstr) : ProofM Expr := caching c' do
   match c'.h with
   | .expr h =>
     return h
@@ -87,7 +87,7 @@ partial def DvdCnstr.toExprProof (c' : DvdCnstr) : ProofM Expr := c'.caching do
     return mkApp10 (mkConst thmName)
       (← getContext) (toExpr p₁) (toExpr p₂) (toExpr c₃.p) (toExpr c₃.d) (toExpr s.k) (toExpr c'.d) (toExpr c'.p) (← s.toExprProof) reflBoolTrue
 
-partial def LeCnstr.toExprProof (c' : LeCnstr) : ProofM Expr := c'.caching do
+partial def LeCnstr.toExprProof (c' : LeCnstr) : ProofM Expr := caching c' do
   match c'.h with
   | .expr h =>
     return h
@@ -127,7 +127,7 @@ partial def LeCnstr.toExprProof (c' : LeCnstr) : ProofM Expr := c'.caching do
     let { c₁, c₂, c₃?, left } := s.pred
     let p₁ := c₁.p
     let p₂ := c₂.p
-    let coeff := if left then p₁.leadCoeff else p₂.leadCoeff
+    let coeff := if left then p₂.leadCoeff else p₁.leadCoeff
     match c₃? with
     | none =>
       let thmName := if left then ``Int.Linear.cooper_left_split_ineq else ``Int.Linear.cooper_right_split_ineq
@@ -138,7 +138,7 @@ partial def LeCnstr.toExprProof (c' : LeCnstr) : ProofM Expr := c'.caching do
       return mkApp10 (mkConst thmName)
         (← getContext) (toExpr p₁) (toExpr p₂) (toExpr c₃.p) (toExpr c₃.d) (toExpr s.k) (toExpr coeff) (toExpr c'.p) (← s.toExprProof) reflBoolTrue
 
-partial def DiseqCnstr.toExprProof (c' : DiseqCnstr) : ProofM Expr := c'.caching do
+partial def DiseqCnstr.toExprProof (c' : DiseqCnstr) : ProofM Expr := caching c' do
   match c'.h with
   | .expr h =>
     return h
@@ -156,7 +156,7 @@ partial def DiseqCnstr.toExprProof (c' : DiseqCnstr) : ProofM Expr := c'.caching
       (← getContext) (toExpr x) (toExpr c₁.p) (toExpr c₂.p) (toExpr c'.p)
       reflBoolTrue (← c₁.toExprProof) (← c₂.toExprProof)
 
-partial def CooperSplit.toExprProof (s : CooperSplit) : ProofM Expr := caching s.id do
+partial def CooperSplit.toExprProof (s : CooperSplit) : ProofM Expr := caching s do
   match s.h with
   | .dec h => return mkFVar h
   | .last hs _ =>
@@ -190,7 +190,7 @@ partial def CooperSplit.toExprProof (s : CooperSplit) : ProofM Expr := caching s
       let h ← c.toExprProofCore -- proof of `False`
       -- `hNotCase` is a proof for `¬ pred (k-1)`
       let hNotCase := mkLambda `h .default type (h.abstract #[mkFVar fvarId])
-      result := mkApp4 (mkConst ``Int.Linear.orOver_resolve) (toExpr k) pred result hNotCase
+      result := mkApp4 (mkConst ``Int.Linear.orOver_resolve) (toExpr (k-1)) pred result hNotCase
       k := k - 1
     -- `result` is now a proof of `OrOver 1 pred`
     return mkApp2 (mkConst ``Int.Linear.orOver_one) pred result
@@ -198,21 +198,23 @@ partial def CooperSplit.toExprProof (s : CooperSplit) : ProofM Expr := caching s
 partial def UnsatProof.toExprProofCore (h : UnsatProof) : ProofM Expr := do
   match h with
   | .le c =>
-    trace[grind.cutsat.le.unsat] "{← c.pp}"
     return mkApp4 (mkConst ``Int.Linear.le_unsat) (← getContext) (toExpr c.p) reflBoolTrue (← c.toExprProof)
   | .dvd c =>
-    trace[grind.cutsat.dvd.unsat] "{← c.pp}"
     return mkApp5 (mkConst ``Int.Linear.dvd_unsat) (← getContext) (toExpr c.d) (toExpr c.p) reflBoolTrue (← c.toExprProof)
   | .eq c =>
-    trace[grind.cutsat.eq.unsat] "{← c.pp}"
     if c.p.isUnsatEq then
       return mkApp4 (mkConst ``Int.Linear.eq_unsat) (← getContext) (toExpr c.p) reflBoolTrue (← c.toExprProof)
     else
       let k := c.p.gcdCoeffs'
       return mkApp5 (mkConst ``Int.Linear.eq_unsat_coeff) (← getContext) (toExpr c.p) (toExpr (Int.ofNat k)) reflBoolTrue (← c.toExprProof)
   | .diseq c =>
-    trace[grind.cutsat.diseq.unsat] "{← c.pp}"
     return mkApp4 (mkConst ``Int.Linear.diseq_unsat) (← getContext) (toExpr c.p) reflBoolTrue (← c.toExprProof)
+  | .cooper c₁ c₂ c₃ =>
+    let .add c _ _ := c₃.p | c₃.throwUnexpected
+    let d := c₃.d
+    let (_, α, β) := gcdExt c d
+    let h := mkApp7 (mkConst ``Int.Linear.cooper_unsat) (← getContext) (toExpr c₁.p) (toExpr c₂.p) (toExpr c₃.p) (toExpr c₃.d) (toExpr α) (toExpr β)
+    return mkApp4 h reflBoolTrue (← c₁.toExprProof) (← c₂.toExprProof) (← c₃.toExprProof)
 
 end
 
@@ -220,6 +222,7 @@ def UnsatProof.toExprProof (h : UnsatProof) : GoalM Expr := do
   withProofContext do h.toExprProofCore
 
 def setInconsistent (h : UnsatProof) : GoalM Unit := do
+  trace[grind.debug.cutsat.conflict] "setInconsistent [{← inconsistent}]: {← h.pp}"
   if (← get').caseSplits then
     -- Let the search procedure in `SearchM` resolve the conflict.
     modify' fun s => { s with conflict? := some h }
@@ -233,14 +236,14 @@ We collect them and perform non chronological backtracking.
 -/
 
 structure CollectDecVars.State where
-  visited : Std.HashSet Nat := {}
+  visited : Std.HashSet UInt64 := {}
   found : FVarIdSet := {}
-
 abbrev CollectDecVarsM := ReaderT FVarIdSet (StateM CollectDecVars.State)
 
-private def alreadyVisited (id : Nat) : CollectDecVarsM Bool := do
-  if (← get).visited.contains id then return true
-  modify fun s => { s with visited := s.visited.insert id }
+private def alreadyVisited (c : α) : CollectDecVarsM Bool := do
+  let addr := unsafe (ptrAddrUnsafe c).toUInt64 >>> 2
+  if (← get).visited.contains addr then return true
+  modify fun s => { s with visited := s.visited.insert addr }
   return false
 
 private def markAsFound (fvarId : FVarId) : CollectDecVarsM Unit := do
@@ -252,26 +255,30 @@ private def collectExpr (e : Expr) : CollectDecVarsM Unit := do
     markAsFound fvarId
 
 mutual
-partial def EqCnstr.collectDecVars (c' : EqCnstr) : CollectDecVarsM Unit := do unless (← alreadyVisited c'.id) do
+partial def EqCnstr.collectDecVars (c' : EqCnstr) : CollectDecVarsM Unit := do unless (← alreadyVisited c') do
   match c'.h with
   | .expr h => collectExpr h
   | .core .. => return () -- Equalities coming from the core never contain cutsat decision variables
   | .norm c | .divCoeffs c => c.collectDecVars
   | .subst _ c₁ c₂ | .ofLeGe c₁ c₂ => c₁.collectDecVars; c₂.collectDecVars
 
-partial def CooperSplit.collectDecVars (s : CooperSplit) : CollectDecVarsM Unit := do unless (← alreadyVisited s.id) do
+partial def CooperSplit.collectDecVars (s : CooperSplit) : CollectDecVarsM Unit := do unless (← alreadyVisited s) do
+  s.pred.c₁.collectDecVars
+  s.pred.c₂.collectDecVars
+  if let some c₃ := s.pred.c₃? then
+    c₃.collectDecVars
   match s.h with
   | .dec h => markAsFound h
   | .last (decVars := decVars) .. => decVars.forM markAsFound
 
-partial def DvdCnstr.collectDecVars (c' : DvdCnstr) : CollectDecVarsM Unit := do unless (← alreadyVisited c'.id) do
+partial def DvdCnstr.collectDecVars (c' : DvdCnstr) : CollectDecVarsM Unit := do unless (← alreadyVisited c') do
   match c'.h with
   | .expr h => collectExpr h
   | .cooper₁ c | .cooper₂ c
   | .norm c | .elim c | .divCoeffs c | .ofEq _ c => c.collectDecVars
   | .solveCombine c₁ c₂ | .solveElim c₁ c₂ | .subst _ c₁ c₂ => c₁.collectDecVars; c₂.collectDecVars
 
-partial def LeCnstr.collectDecVars (c' : LeCnstr) : CollectDecVarsM Unit := do unless (← alreadyVisited c'.id) do
+partial def LeCnstr.collectDecVars (c' : LeCnstr) : CollectDecVarsM Unit := do unless (← alreadyVisited c') do
   match c'.h with
   | .expr h => collectExpr h
   | .notExpr .. => return () -- This kind of proof is used for connecting with the `grind` core.
@@ -279,7 +286,7 @@ partial def LeCnstr.collectDecVars (c' : LeCnstr) : CollectDecVarsM Unit := do u
   | .combine c₁ c₂ | .subst _ c₁ c₂ | .ofLeDiseq c₁ c₂ => c₁.collectDecVars; c₂.collectDecVars
   | .ofDiseqSplit (decVars := decVars) .. => decVars.forM markAsFound
 
-partial def DiseqCnstr.collectDecVars (c' : DiseqCnstr) : CollectDecVarsM Unit := do unless (← alreadyVisited c'.id) do
+partial def DiseqCnstr.collectDecVars (c' : DiseqCnstr) : CollectDecVarsM Unit := do unless (← alreadyVisited c') do
   match c'.h with
   | .expr h => collectExpr h
   | .core .. => return () -- Disequalities coming from the core never contain cutsat decision variables
@@ -291,6 +298,7 @@ end
 def UnsatProof.collectDecVars (h : UnsatProof) : CollectDecVarsM Unit := do
   match h with
   | .le c | .dvd c | .eq c | .diseq c => c.collectDecVars
+  | .cooper c₁ c₂ c₃ => c₁.collectDecVars; c₂.collectDecVars; c₃.collectDecVars
 
 abbrev CollectDecVarsM.run (x : CollectDecVarsM Unit) (decVars : FVarIdSet) : FVarIdSet :=
   let (_, s) := x decVars |>.run {}

src/Lean/Meta/Tactic/Grind/Arith/Cutsat/Search.lean

@@ -26,25 +26,30 @@ def CooperSplit.assert (cs : CooperSplit) : GoalM Unit := do
   let b   := p₂.leadCoeff
   let p₁' := p.mul b |>.combine (q.mul (-a))
   let p₁' := p₁'.addConst <| if left then b*k else (-a)*k
-  let c₁' ← mkLeCnstr p₁' (.cooper cs)
+  let c₁' := { p := p₁', h := .cooper cs : LeCnstr }
+  trace[grind.debug.cutsat.cooper] "{← c₁'.pp}"
   c₁'.assert
+  if (← inconsistent) then return ()
   let p₂' := if left then p else q
   let p₂' := p₂'.addConst k
-  let c₂' ← mkDvdCnstr (if left then a else b) p₂' (.cooper₁ cs)
+  let c₂' := { d := if left then a else b, p := p₂', h := .cooper₁ cs : DvdCnstr }
+  trace[grind.debug.cutsat.cooper] "dvd₁: {← c₂'.pp}"
   c₂'.assert
+  if (← inconsistent) then return ()
   let some c₃ := c₃? | return ()
   let p₃  := c₃.p
   let d   := c₃.d
   let s   := p₃.tail
   let c   := p₃.leadCoeff
-  let c₃' ← if left then
+  let c₃' := if left then
     let p₃' := p.mul c |>.combine (s.mul (-a))
     let p₃' := p₃'.addConst (c*k)
-    mkDvdCnstr (a*d) p₃' (.cooper₂ cs)
+    { d := a*d, p := p₃', h := .cooper₂ cs : DvdCnstr }
   else
     let p₃' := q.mul (-c) |>.combine (s.mul b)
     let p₃' := p₃'.addConst (-c*k)
-    mkDvdCnstr (b*d) p₃' (.cooper₂ cs)
+    { d := b*d, p := p₃', h := .cooper₂ cs : DvdCnstr }
+  trace[grind.debug.cutsat.cooper] "dvd₂: {← c₃'.pp}"
   c₃'.assert
 
 private def checkIsNextVar (x : Var) : GoalM Unit := do
@@ -81,6 +86,7 @@ where
       modify' fun s => { s with assignment := s.assignment.set x 0 }
       let some v ← c.p.eval? | c.throwUnexpected
       let v := (-v) / a
+      trace[grind.debug.cutsat.assign] "{← getVar x}, {← c.pp}, {v}"
       traceAssignment x v
       modify' fun s => { s with assignment := s.assignment.set x v }
       go xs
@@ -178,7 +184,7 @@ def resolveDvdConflict (c : DvdCnstr) : GoalM Unit := do
   trace[grind.cutsat.conflict] "{← c.pp}"
   let d := c.d
   let .add a _ p := c.p | c.throwUnexpected
-  (← mkDvdCnstr (a.gcd d) p (.elim c)).assert
+  { d := a.gcd d, p, h := .elim c : DvdCnstr }.assert
 
 /--
 Given a divisibility constraint solution space `s := { b, d }`,
@@ -266,17 +272,33 @@ def resolveRealLowerUpperConflict (c₁ c₂ : LeCnstr) : GoalM Bool := do
   let .add a₂ _ p₂ := c₂.p | c₂.throwUnexpected
   let p := p₁.mul a₂.natAbs |>.combine (p₂.mul a₁.natAbs)
   if (← p.satisfiedLe) != .false then
+    trace[grind.cutsat.conflict] "not resolved"
     return false
   else
-    let c ← mkLeCnstr p (.combine c₁ c₂)
+    let c := { p, h := .combine c₁ c₂ : LeCnstr }
+    trace[grind.cutsat.conflict] "resolved: {← c.pp}"
     c.assert
     return true
 
+def resolveCooperUnary (pred : CooperSplitPred) : SearchM Bool := do
+  let some c₃ := pred.c₃? | return false
+  let .add (-1) _ (.num a) := pred.c₁.p | return false
+  let .add 1 _ (.num b) := pred.c₂.p | return false
+  let .add c _ (.num e) := c₃.p | return false
+  let d := c₃.d
+  let (1, α, _) := gcdExt c d | return false
+  unless -b < Int.Linear.cdiv (a - -α * e % d) d * d + -α * e % d do
+    return false
+  setInconsistent (.cooper pred.c₁ pred.c₂ c₃)
+  return true
+
 def resolveCooperPred (pred : CooperSplitPred) : SearchM Unit := do
+  trace[grind.cutsat.conflict] "[{pred.numCases}]: {← pred.pp}"
+  if (← resolveCooperUnary pred) then
+    return
   let n := pred.numCases
-  let fvarId ← mkCase (.cooper pred #[])
-  let s : CooperSplit := { pred, k := n - 1, id := (← mkCnstrId), h := .dec fvarId }
-  s.assert
+  let fvarId ← mkCase (.cooper pred #[] {})
+  { pred, k := n - 1, h := .dec fvarId : CooperSplit }.assert
 
 def resolveCooper (c₁ c₂ : LeCnstr) : SearchM Unit := do
   let left : Bool := c₁.p.leadCoeff.natAbs < c₂.p.leadCoeff.natAbs
@@ -295,10 +317,10 @@ splits `c` and resolve with `c₁`.
 Recall that a disequality
 -/
 def resolveRatDiseq (c₁ : LeCnstr) (c : DiseqCnstr) : SearchM Unit := do
-  let c ← if c.p.leadCoeff < 0 then
-    mkDiseqCnstr (c.p.mul (-1)) (.neg c)
+  let c := if c.p.leadCoeff < 0 then
+    { p := c.p.mul (-1), h := .neg c : DiseqCnstr }
   else
-    pure c
+    c
   let fvarId ← if let some fvarId := (← get').diseqSplits.find? c.p then
     trace[grind.debug.cutsat.diseq.split] "{← c.pp}, reusing {fvarId.name}"
     pure fvarId
@@ -308,12 +330,13 @@ def resolveRatDiseq (c₁ : LeCnstr) (c : DiseqCnstr) : SearchM Unit := do
     modify' fun s => { s with diseqSplits := s.diseqSplits.insert c.p fvarId }
     pure fvarId
   let p₂ := c.p.addConst 1
-  let c₂ ← mkLeCnstr p₂ (.expr (mkFVar fvarId))
+  let c₂ := { p := p₂, h := .expr (mkFVar fvarId) : LeCnstr }
   let b ← resolveRealLowerUpperConflict c₁ c₂
   assert! b
 
 def processVar (x : Var) : SearchM Unit := do
   if (← eliminated x) then
+    trace[grind.debug.cutsat.search] "eliminated: {← getVar x}"
     /-
     Variable has been eliminated, and will be assigned later after we have assigned
     variables that have not been eliminated.
@@ -325,6 +348,7 @@ def processVar (x : Var) : SearchM Unit := do
     if let some solutions ← c.getSolutions? then
       pure solutions
     else
+      trace[grind.debug.cutsat.search] "dvd conflict: {← c.pp}"
       resolveDvdConflict c
       return ()
   else
@@ -392,36 +416,57 @@ private def findCase (decVars : FVarIdSet) : SearchM Case := do
     trace[grind.debug.cutsat.backtrack] "skipping {case.fvarId.name}"
   unreachable!
 
-def resolveConflict (h : UnsatProof) : SearchM Bool := do
+private def union (vs₁ vs₂ : FVarIdSet) : FVarIdSet :=
+  vs₁.fold (init := vs₂) (·.insert ·)
+
+def resolveConflict (h : UnsatProof) : SearchM Unit := do
+  trace[grind.debug.cutsat.backtrack] "resolve conflict, decision stack: {(← get).cases.toList.map fun c => c.fvarId.name}"
   let decVars := h.collectDecVars.run (← get).decVars
+  trace[grind.debug.cutsat.backtrack] "dec vars: {decVars.toList.map (·.name)}"
   if decVars.isEmpty then
+    trace[grind.debug.cutsat.backtrack] "close goal: {← h.pp}"
     closeGoal (← h.toExprProof)
-    return false
+    return ()
   let c ← findCase decVars
   modify' fun _  => c.saved
+  trace[grind.debug.cutsat.backtrack] "backtracking {c.fvarId.name}"
+  let decVars := decVars.erase c.fvarId
   match c.kind with
   | .diseq c₁ =>
-    let decVars := decVars.erase c.fvarId |>.toArray
+    let decVars := decVars.toArray
     let p' := c₁.p.mul (-1) |>.addConst 1
-    let c' ← mkLeCnstr p' (.ofDiseqSplit c₁ c.fvarId h decVars)
+    let c' := { p := p', h := .ofDiseqSplit c₁ c.fvarId h decVars : LeCnstr }
     trace[grind.debug.cutsat.backtrack] "resolved diseq split: {← c'.pp}"
     c'.assert
-    return true
-  | _ => throwError "NIY resolve conflict"
+  | .cooper pred hs decVars' =>
+    let decVars' := union decVars decVars'
+    let n := pred.numCases
+    let hs := hs.push (c.fvarId, h)
+    trace[grind.debug.cutsat.backtrack] "cooper #{hs.size + 1}, {← pred.pp}, {hs.map fun p => p.1.name}"
+    let s ← if hs.size + 1 < n then
+      let fvarId ← mkCase (.cooper pred hs decVars')
+      pure { pred, k := n - hs.size - 1, h := .dec fvarId : CooperSplit }
+    else
+      let decVars' := decVars'.toArray
+      trace[grind.debug.cutsat.backtrack] "cooper last case, {← pred.pp}, dec vars: {decVars'.map (·.name)}"
+      pure { pred, k := 0, h := .last hs decVars' : CooperSplit }
+    s.assert
 
 /-- Search for an assignment/model for the linear constraints. -/
 def searchAssigmentMain : SearchM Unit := do
   repeat
+    trace[grind.debug.cutsat.search] "main loop"
     if (← hasAssignment) then
       return ()
     if (← isInconsistent) then
       -- `grind` state is inconsistent
       return ()
     if let some c := (← get').conflict? then
-      unless (← resolveConflict c) do
-        return ()
-    let x : Var := (← get').assignment.size
-    processVar x
+      resolveConflict c
+    else
+      let x : Var := (← get').assignment.size
+      trace[grind.debug.cutsat.search] "next var: {← getVar x}"
+      processVar x
 
 def traceModel : GoalM Unit := do
   if (← isTracingEnabledFor `grind.cutsat.model) then
@@ -436,6 +481,7 @@ def searchAssigment : GoalM Unit := do
     trace[grind.debug.cutsat.search] "restart using Cooper resolution"
     modify' fun s => { s with assignment := {} }
     searchAssigmentMain .int |>.run' {}
+    trace[grind.debug.cutsat.search] "after search int model, inconsistent: {← isInconsistent}"
     if (← isInconsistent) then return ()
   assignElimVars
   traceModel

src/Lean/Meta/Tactic/Grind/Arith/Cutsat/SearchM.lean

@@ -14,7 +14,7 @@ In principle, we only need to support two kinds of case split.
 -/
 inductive CaseKind where
   | diseq (d : DiseqCnstr)
-  | cooper (s : CooperSplitPred) (hs : Array (FVarId × UnsatProof))
+  | cooper (s : CooperSplitPred) (hs : Array (FVarId × UnsatProof)) (decVars : FVarIdSet)
   deriving Inhabited
 
 structure Case where
@@ -74,6 +74,7 @@ def mkCase (kind : CaseKind) : SearchM FVarId := do
     decVars := s.decVars.insert fvarId
   }
   modify' fun s => { s with caseSplits := true }
+  trace[grind.debug.cutsat.backtrack] "mkCase fvarId: {fvarId.name}"
   return fvarId
 
 end Lean.Meta.Grind.Arith.Cutsat

src/Lean/Meta/Tactic/Grind/Arith/Cutsat/Types.lean

@@ -75,7 +75,6 @@ mutual
 structure EqCnstr where
   p  : Poly
   h  : EqCnstrProof
-  id : Nat
 
 inductive EqCnstrProof where
   | expr (h : Expr)
@@ -90,8 +89,6 @@ structure DvdCnstr where
   d  : Int
   p  : Poly
   h  : DvdCnstrProof
-  /-- Unique id for caching proofs in `ProofM` -/
-  id : Nat
 
 /--
 The predicate of type `Nat → Prop`, which serves as the conclusion of the
@@ -118,7 +115,6 @@ structure CooperSplit where
   pred  : CooperSplitPred
   k     : Nat
   h     : CooperSplitProof
-  id    : Nat
 
 /--
 The `cooper_left`, `cooper_right`, `cooper_dvd_left`, and `cooper_dvd_right` theorems have a resulting type
@@ -150,7 +146,6 @@ inductive DvdCnstrProof where
 structure LeCnstr where
   p  : Poly
   h  : LeCnstrProof
-  id : Nat
 
 inductive LeCnstrProof where
   | expr (h : Expr)
@@ -169,7 +164,6 @@ inductive LeCnstrProof where
 structure DiseqCnstr where
   p  : Poly
   h  : DiseqCnstrProof
-  id : Nat
 
 inductive DiseqCnstrProof where
   | expr (h : Expr)
@@ -188,20 +182,21 @@ inductive UnsatProof where
   | le (c : LeCnstr)
   | eq (c : EqCnstr)
   | diseq (c : DiseqCnstr)
+  | cooper (c₁ c₂ : LeCnstr) (c₃ : DvdCnstr)
 
 end
 
 instance : Inhabited LeCnstr where
-  default := { p := .num 0, h := .expr default, id := 0 }
+  default := { p := .num 0, h := .expr default }
 
 instance : Inhabited DvdCnstr where
-  default := { d := 0, p := .num 0, h := .expr default, id := 0 }
+  default := { d := 0, p := .num 0, h := .expr default }
 
 instance : Inhabited CooperSplitPred where
   default := { left := false, c₁ := default, c₂ := default, c₃? := none }
 
 instance : Inhabited CooperSplit where
-  default := { pred := default, k := 0, h := .dec default, id := 0 }
+  default := { pred := default, k := 0, h := .dec default }
 
 abbrev VarSet := RBTree Var compare
 
@@ -272,10 +267,14 @@ structure State where
   This is necessary because the same disequality may be in different conflicts.
   -/
   diseqSplits : PHashMap Poly FVarId := {}
-
-  /-
-  TODO: Model-based theory combination.
+  /--
+  Pairs `(x, n)` s.t. we have expanded the theorems
+  - `Int.Linear.ediv_emod`
+  - `Int.Linear.emod_nonneg`
+  - `Int.Linear.emod_le`
   -/
+  divMod : PHashSet (Expr × Int) := {}
+  /- TODO: Model-based theory combination. -/
   deriving Inhabited
 
 end Lean.Meta.Grind.Arith.Cutsat

src/Lean/Meta/Tactic/Grind/Arith/Cutsat/Util.lean

@@ -64,9 +64,6 @@ def mkCnstrId : GoalM Nat := do
   modify' fun s => { s with nextCnstrId := id + 1 }
   return id
 
-def mkEqCnstr (p : Poly) (h : EqCnstrProof) : GoalM EqCnstr := do
-  return { p, h, id := (← mkCnstrId) }
-
 @[extern "lean_grind_cutsat_assert_eq"] -- forward definition
 opaque EqCnstr.assert (c : EqCnstr) : GoalM Unit
 
@@ -189,7 +186,7 @@ def toContextExpr : GoalM Expr := do
     return RArray.toExpr (mkConst ``Int) id (RArray.leaf (mkIntLit 0))
 
 structure ProofM.State where
-  cache : Std.HashMap Nat Expr := {}
+  cache : Std.HashMap UInt64 Expr := {}
 
 /-- Auxiliary monad for constructing cutsat proofs. -/
 abbrev ProofM := ReaderT Expr (StateRefT ProofM.State GoalM)
@@ -198,19 +195,15 @@ abbrev ProofM := ReaderT Expr (StateRefT ProofM.State GoalM)
 abbrev getContext : ProofM Expr := do
   read
 
-abbrev caching (id : Nat) (k : ProofM Expr) : ProofM Expr := do
-  if let some h := (← get).cache[id]? then
+abbrev caching (c : α) (k : ProofM Expr) : ProofM Expr := do
+  let addr := unsafe (ptrAddrUnsafe c).toUInt64 >>> 2
+  if let some h := (← get).cache[addr]? then
     return h
   else
     let h ← k
-    modify fun s => { s with cache := s.cache.insert id h }
+    modify fun s => { s with cache := s.cache.insert addr h }
     return h
 
-abbrev DvdCnstr.caching (c : DvdCnstr) (k : ProofM Expr) : ProofM Expr := Cutsat.caching c.id k
-abbrev LeCnstr.caching (c : LeCnstr) (k : ProofM Expr) : ProofM Expr := Cutsat.caching c.id k
-abbrev EqCnstr.caching (c : EqCnstr) (k : ProofM Expr) : ProofM Expr := Cutsat.caching c.id k
-abbrev DiseqCnstr.caching (c : DiseqCnstr) (k : ProofM Expr) : ProofM Expr := Cutsat.caching c.id k
-
 abbrev withProofContext (x : ProofM Expr) : GoalM Expr := do
   withLetDecl `ctx (mkApp (mkConst ``RArray) (mkConst ``Int)) (← toContextExpr) fun ctx => do
     let h ← x ctx |>.run' {}
@@ -291,4 +284,12 @@ def CooperSplitPred.numCases (pred : CooperSplitPred) : Nat :=
     else
       Int.lcm b (b * d / Int.gcd (b * d) c)
 
+def CooperSplitPred.pp (pred : CooperSplitPred) : GoalM MessageData := do
+  return m!"{← pred.c₁.pp}, {← pred.c₂.pp}, {← if let some c₃ := pred.c₃? then c₃.pp else pure "none"}"
+
+def UnsatProof.pp (h : UnsatProof) : GoalM MessageData := do
+  match h with
+  | .le c | .eq c | .dvd c | .diseq c => c.pp
+  | .cooper c₁ c₂ c₃ => return m!"{← c₁.pp}, {← c₂.pp}, {← c₃.pp}"
+
 end Lean.Meta.Grind.Arith.Cutsat

src/Lean/Meta/Tactic/Grind/MarkNestedProofs.lean

@@ -8,6 +8,7 @@ import Init.Grind.Util
 import Lean.Util.PtrSet
 import Lean.Meta.Basic
 import Lean.Meta.InferType
+import Lean.Meta.Tactic.Grind.Util
 
 namespace Lean.Meta.Grind
 
@@ -21,6 +22,13 @@ where
       if let some r := (← get).find? e then
         return r
       let prop ← inferType e
+      /-
+      We must unfold reducible constants occurring in `prop` because the congruence closure
+      module in `grind` assumes they have been expanded.
+      See `grind_mark_nested_proofs_bug.lean` for an example.
+      TODO: We may have to normalize `prop` too.
+      -/
+      let prop ← unfoldReducible prop
       let e' := mkApp2 (mkConst ``Lean.Grind.nestedProof) prop e
       modify fun s => s.insert e e'
       return e'

src/Lean/MonadEnv.lean

@@ -24,10 +24,11 @@ def withEnv [Monad m] [MonadFinally m] [MonadEnv m] (env : Environment) (x : m
   finally
     setEnv saved
 
-def isInductive [Monad m] [MonadEnv m] (declName : Name) : m Bool := do
-  match (← getEnv).find? declName with
-  | some (ConstantInfo.inductInfo ..) => return true
-  | _ => return false
+def isInductiveCore (env : Environment) (declName : Name) : Bool :=
+  env.find? declName matches some (.inductInfo ..)
+
+def isInductive [Monad m] [MonadEnv m] (declName : Name) : m Bool :=
+  return isInductiveCore (← getEnv) declName
 
 def isRecCore (env : Environment) (declName : Name) : Bool :=
   match env.find? declName with

src/Lean/Replay.lean

@@ -22,10 +22,6 @@ after replaying any inductive definitions occurring in `constantMap`.
 * a verifier for an `Environment`, by sending everything to the kernel, or
 * a mechanism to safely transfer constants from one `Environment` to another.
 
-## Deprecation note
-
-We've decided that this code should live in the `https://github.com/leanprover/lean4checker` repository,
-rather than the core distribution. This code is now deprecated, and will be removed in a future release.
 -/
 
 namespace Lean.Environment
@@ -36,7 +32,7 @@ structure Context where
   newConstants : Std.HashMap Name ConstantInfo
 
 structure State where
-  env : Kernel.Environment
+  env : Environment
   remaining : NameSet := {}
   pending : NameSet := {}
   postponedConstructors : NameSet := {}
@@ -157,7 +153,6 @@ open Replay
 Throws a `IO.userError` if the kernel rejects a constant,
 or if there are malformed recursors or constructors for inductive types.
 -/
-@[deprecated "Use the `lean4checker` package instead" (since := "2025-03-04")]
 def replay (newConstants : Std.HashMap Name ConstantInfo) (env : Environment) : IO Environment := do
   let mut remaining : NameSet := ∅
   for (n, ci) in newConstants.toList do
@@ -165,10 +160,10 @@ def replay (newConstants : Std.HashMap Name ConstantInfo) (env : Environment) :
     -- Later we may want to handle partial constants.
     if !ci.isUnsafe && !ci.isPartial then
       remaining := remaining.insert n
-  let (_, s) ← StateRefT'.run (s := { env := env.toKernelEnv, remaining }) do
+  let (_, s) ← StateRefT'.run (s := { env, remaining }) do
     ReaderT.run (r := { newConstants }) do
       for n in remaining do
         replayConstant n
       checkPostponedConstructors
       checkPostponedRecursors
-  return .ofKernelEnv s.env
+  return s.env

src/Lean/Server/FileWorker/InlayHints.lean

@@ -98,15 +98,17 @@ def applyEditToHint? (hintMod : Name) (ihi : Elab.InlayHintInfo) (range : String
   }
 
 structure InlayHintState where
-  oldInlayHints      : Array Elab.InlayHintInfo
-  oldFinishedSnaps   : Nat
-  lastEditTimestamp? : Option Nat
+  oldInlayHints           : Array Elab.InlayHintInfo
+  oldFinishedSnaps        : Nat
+  lastEditTimestamp?      : Option Nat
+  isFirstRequestAfterEdit : Bool
   deriving TypeName, Inhabited
 
 def InlayHintState.init : InlayHintState := {
   oldInlayHints := #[]
   oldFinishedSnaps := 0
   lastEditTimestamp? := none
+  isFirstRequestAfterEdit := false
 }
 
 def handleInlayHints (p : InlayHintParams) (s : InlayHintState) :
@@ -115,6 +117,20 @@ def handleInlayHints (p : InlayHintParams) (s : InlayHintState) :
   let text := ctx.doc.meta.text
   let range := text.lspRangeToUtf8Range p.range
   let srcSearchPath := ctx.srcSearchPath
+  if s.isFirstRequestAfterEdit then
+    -- We immediately respond to the first inlay hint request after an edit with the old inlay hints,
+    -- without waiting for the edit delay.
+    -- The reason for this is that in VS Code, when it hasn't received a new set of inlay hints,
+    -- edits to the document visually move all old inlay hints, but do not actually update other
+    -- fields, like the `textEdit` field. This means that e.g. inlay hint insertion will insert
+    -- the inlay hint at the wrong position.
+    -- To reduce the size of the window for this race condition, we attempt to minimize the delay
+    -- after an edit, providing VS Code with a set of old inlay hints that we have already updated
+    -- correctly for VS Code ASAP.
+    let lspInlayHints ← s.oldInlayHints.mapM (·.toLspInlayHint srcSearchPath text)
+    let r := { response := lspInlayHints, isComplete := false }
+    let s := { s with isFirstRequestAfterEdit := false }
+    return (r, s)
   -- We delay sending inlay hints by 3000ms to avoid inlay hint flickering on the client.
   -- VS Code already has a mechanism for this, but it is not sufficient.
   let inlayHintEditDelayMs := 3000
@@ -126,6 +142,16 @@ def handleInlayHints (p : InlayHintParams) (s : InlayHintState) :
       let timeSinceLastEditMs := timestamp - lastEditTimestamp
       inlayHintEditDelayMs - timeSinceLastEditMs
   let (snaps, _, isComplete) ← ctx.doc.cmdSnaps.getFinishedPrefixWithConsistentLatency editDelayMs.toUInt32 (cancelTk? := ctx.cancelTk.cancellationTask)
+  if ← IO.hasFinished ctx.cancelTk.cancellationTask then
+    -- Inlay hint request has been cancelled, either by a cancellation request or another edit.
+    -- In the former case, we will simply discard the result and respond with a request error
+    -- denoting cancellation.
+    -- In the latter case, we respond with the old inlay hints, since we can't respond with an error.
+    -- This is to prevent cancellation from making us serve updated inlay hints before the
+    -- edit delay has passed.
+    let lspInlayHints ← s.oldInlayHints.mapM (·.toLspInlayHint srcSearchPath text)
+    let r := { response := lspInlayHints, isComplete := false }
+    return (r, s)
   let snaps := snaps.toArray
   let finishedSnaps := snaps.size
   let oldFinishedSnaps := s.oldFinishedSnaps
@@ -170,6 +196,7 @@ def handleInlayHintsDidChange (p : DidChangeTextDocumentParams)
     oldInlayHints := updatedOldInlayHints
     oldFinishedSnaps := 0
     lastEditTimestamp?
+    isFirstRequestAfterEdit := true
   }
 
 where
@@ -186,8 +213,13 @@ where
       return some mod
     let modName ← match modName? with
       | .ok (some modName) => pure modName
-      | .ok none => pure .anonymous -- `.anonymous` occurs in untitled files
-      | .error err => throw <| .ofIoError err
+      -- `.anonymous` occurs in untitled files (`.ok none` case).
+      -- There is an intentional bug here where the `.error _` case spits out `.anonymous`.
+      -- This means that we don't correctly update inlay hint locations when the file for this
+      -- file worker has been deleted. As of writing this, there are no inlay hints that use this
+      -- field anyways.
+      -- In the future, we should resolve this by caching the module name in `DocumentMeta`.
+      | _ => pure .anonymous
     let mut updatedOldInlayHints := #[]
     for ihi in oldInlayHints do
       let mut ihi := ihi

src/Std/Data/DHashMap/Basic.lean

@@ -210,6 +210,26 @@ instance [BEq α] [Hashable α] : ForM m (DHashMap α β) ((a : α) × β a) whe
 instance [BEq α] [Hashable α] : ForIn m (DHashMap α β) ((a : α) × β a) where
   forIn m init f := m.forIn (fun a b acc => f ⟨a, b⟩ acc) init
 
+namespace Const
+
+variable {β : Type v}
+
+/-!
+We do not define `ForM` and `ForIn` instances that are specialized to constant `β`. Instead, we
+define uncurried versions of `forM` and `forIn` that will be used in the `Const` lemmas and to
+define the `ForM` and `ForIn` instances for `HashMap`.
+-/
+
+@[inline, inherit_doc forM] def forMUncurried (f : α × β → m PUnit)
+    (b : DHashMap α (fun _ => β)) : m PUnit :=
+  b.forM fun a b => f ⟨a, b⟩
+
+@[inline, inherit_doc forIn] def forInUncurried
+    (f : α × β → δ → m (ForInStep δ)) (init : δ) (b : DHashMap α (fun _ => β)) : m δ :=
+  b.forIn (init := init) fun a b d => f ⟨a, b⟩ d
+
+end Const
+
 section Unverified
 
 /-! We currently do not provide lemmas for the functions below. -/

src/Std/Data/DHashMap/Internal/Index.lean

@@ -48,7 +48,7 @@ cf. https://github.com/leanprover/lean4/issues/4157
   ⟨(scrambleHash hash).toUSize &&& (sz.toUSize - 1), by
     -- This proof is a good test for our USize API
     by_cases h' : sz < USize.size
-    · rw [USize.toNat_and, USize.toNat_sub_of_le, USize.toNat_ofNat_of_lt h']
+    · rw [USize.toNat_and, USize.toNat_sub_of_le, USize.toNat_ofNat_of_lt' h']
       · exact Nat.lt_of_le_of_lt Nat.and_le_right (Nat.sub_lt h (by simp))
       · simp [USize.le_iff_toNat_le, Nat.mod_eq_of_lt h', Nat.succ_le_of_lt h]
     · exact Nat.lt_of_lt_of_le (USize.toNat_lt_size _) (Nat.le_of_not_lt h')⟩

src/Std/Data/DHashMap/Internal/Raw.lean

@@ -32,181 +32,95 @@ theorem insert_eq [BEq α] [Hashable α] {m : Raw α β} (h : m.WF) {a : α} {b
     m.insert a b = (Raw₀.insert ⟨m, h.size_buckets_pos⟩ a b).1 := by
   simp [Raw.insert, h.size_buckets_pos]
 
-theorem insert_val [BEq α] [Hashable α] {m : Raw₀ α β} {a : α} {b : β a} :
-    m.val.insert a b = m.insert a b := by
-  simp [Raw.insert, m.2]
-
 theorem insertIfNew_eq [BEq α] [Hashable α] {m : Raw α β} (h : m.WF) {a : α} {b : β a} :
     m.insertIfNew a b = (Raw₀.insertIfNew ⟨m, h.size_buckets_pos⟩ a b).1 := by
   simp [Raw.insertIfNew, h.size_buckets_pos]
 
-theorem insertIfNew_val [BEq α] [Hashable α] {m : Raw₀ α β} {a : α} {b : β a} :
-    m.val.insertIfNew a b = m.insertIfNew a b := by
-  simp [Raw.insertIfNew, m.2]
-
 theorem containsThenInsert_snd_eq [BEq α] [Hashable α] {m : Raw α β} (h : m.WF) {a : α} {b : β a} :
     (m.containsThenInsert a b).2 = (Raw₀.containsThenInsert ⟨m, h.size_buckets_pos⟩ a b).2.1 := by
   simp [Raw.containsThenInsert, h.size_buckets_pos]
 
-theorem containsThenInsert_snd_val [BEq α] [Hashable α] {m : Raw₀ α β} {a : α} {b : β a} :
-    (m.val.containsThenInsert a b).2 = (m.containsThenInsert a b).2.1 := by
-  simp [Raw.containsThenInsert, m.2]
-
 theorem containsThenInsert_fst_eq [BEq α] [Hashable α] {m : Raw α β} (h : m.WF) {a : α} {b : β a} :
     (m.containsThenInsert a b).1 = (Raw₀.containsThenInsert ⟨m, h.size_buckets_pos⟩ a b).1 := by
   simp [Raw.containsThenInsert, h.size_buckets_pos]
 
-theorem containsThenInsert_fst_val [BEq α] [Hashable α] {m : Raw₀ α β} {a : α} {b : β a} :
-    (m.val.containsThenInsert a b).1 = (m.containsThenInsert a b).1 := by
-  simp [Raw.containsThenInsert, m.2]
-
 theorem containsThenInsertIfNew_snd_eq [BEq α] [Hashable α] {m : Raw α β} (h : m.WF) {a : α}
     {b : β a} : (m.containsThenInsertIfNew a b).2 =
       (Raw₀.containsThenInsertIfNew ⟨m, h.size_buckets_pos⟩ a b).2.1 := by
   simp [Raw.containsThenInsertIfNew, h.size_buckets_pos]
 
-theorem containsThenInsertIfNew_snd_val [BEq α] [Hashable α] {m : Raw₀ α β} {a : α} {b : β a} :
-    (m.val.containsThenInsertIfNew a b).2 = (m.containsThenInsertIfNew a b).2.1 := by
-  simp [Raw.containsThenInsertIfNew, m.2]
-
 theorem containsThenInsertIfNew_fst_eq [BEq α] [Hashable α] {m : Raw α β} (h : m.WF) {a : α}
     {b : β a} : (m.containsThenInsertIfNew a b).1 =
       (Raw₀.containsThenInsertIfNew ⟨m, h.size_buckets_pos⟩ a b).1 := by
   simp [Raw.containsThenInsertIfNew, h.size_buckets_pos]
 
-theorem containsThenInsertIfNew_fst_val [BEq α] [Hashable α] {m : Raw₀ α β} {a : α} {b : β a} :
-    (m.val.containsThenInsertIfNew a b).1 = (m.containsThenInsertIfNew a b).1 := by
-  simp [Raw.containsThenInsertIfNew, m.2]
-
 theorem getThenInsertIfNew?_snd_eq [BEq α] [Hashable α] [LawfulBEq α] {m : Raw α β} (h : m.WF)
     {a : α} {b : β a} : (m.getThenInsertIfNew? a b).2 =
       (Raw₀.getThenInsertIfNew? ⟨m, h.size_buckets_pos⟩ a b).2.1 := by
   simp [Raw.getThenInsertIfNew?, h.size_buckets_pos]
 
-theorem getThenInsertIfNew?_snd_val [BEq α] [Hashable α] [LawfulBEq α] {m : Raw₀ α β} {a : α}
-    {b : β a} : (m.val.getThenInsertIfNew? a b).2 = (m.getThenInsertIfNew? a b).2.1 := by
-  simp [Raw.getThenInsertIfNew?, m.2]
-
 theorem getThenInsertIfNew?_fst_eq [BEq α] [Hashable α] [LawfulBEq α] {m : Raw α β} (h : m.WF)
     {a : α} {b : β a} : (m.getThenInsertIfNew? a b).1 =
       (Raw₀.getThenInsertIfNew? ⟨m, h.size_buckets_pos⟩ a b).1 := by
   simp [Raw.getThenInsertIfNew?, h.size_buckets_pos]
 
-theorem getThenInsertIfNew?_fst_val [BEq α] [Hashable α] [LawfulBEq α] {m : Raw₀ α β} {a : α}
-    {b : β a} : (m.val.getThenInsertIfNew? a b).1 = (m.getThenInsertIfNew? a b).1 := by
-  simp [Raw.getThenInsertIfNew?, m.2]
-
 theorem get?_eq [BEq α] [Hashable α] [LawfulBEq α] {m : Raw α β} (h : m.WF) {a : α} :
     m.get? a = Raw₀.get? ⟨m, h.size_buckets_pos⟩ a := by
   simp [Raw.get?, h.size_buckets_pos]
 
-theorem get?_val [BEq α] [Hashable α] [LawfulBEq α] {m : Raw₀ α β} {a : α} :
-    m.val.get? a = m.get? a := by
-  simp [Raw.get?, m.2]
-
 theorem contains_eq [BEq α] [Hashable α] {m : Raw α β} (h : m.WF) {a : α} :
     m.contains a = Raw₀.contains ⟨m, h.size_buckets_pos⟩ a := by
   simp [Raw.contains, h.size_buckets_pos]
 
-theorem contains_val [BEq α] [Hashable α] {m : Raw₀ α β} {a : α} :
-    m.val.contains a = m.contains a := by
-  simp [Raw.contains, m.2]
-
 theorem get_eq [BEq α] [Hashable α] [LawfulBEq α] {m : Raw α β} {a : α} {h : a ∈ m} :
     m.get a h = Raw₀.get ⟨m, by change dite .. = true at h; split at h <;> simp_all⟩ a
       (by change dite .. = true at h; split at h <;> simp_all) := rfl
 
-theorem get_val [BEq α] [Hashable α] [LawfulBEq α] {m : Raw₀ α β} {a : α} {h : a ∈ m.val} :
-    m.val.get a h = m.get a (contains_val (m := m) ▸ h) := rfl
-
 theorem getD_eq [BEq α] [Hashable α] [LawfulBEq α] {m : Raw α β} (h : m.WF) {a : α}
     {fallback : β a} : m.getD a fallback = Raw₀.getD ⟨m, h.size_buckets_pos⟩ a fallback := by
   simp [Raw.getD, h.size_buckets_pos]
 
-theorem getD_val [BEq α] [Hashable α] [LawfulBEq α] {m : Raw₀ α β} {a : α} {fallback : β a} :
-    m.val.getD a fallback = m.getD a fallback := by
-  simp [Raw.getD, m.2]
-
 theorem get!_eq [BEq α] [Hashable α] [LawfulBEq α] {m : Raw α β} (h : m.WF) {a : α}
     [Inhabited (β a)] : m.get! a = Raw₀.get! ⟨m, h.size_buckets_pos⟩ a := by
   simp [Raw.get!, h.size_buckets_pos]
 
-theorem get!_val [BEq α] [Hashable α] [LawfulBEq α] {m : Raw₀ α β} {a : α} [Inhabited (β a)] :
-    m.val.get! a = m.get! a := by
-  simp [Raw.get!, m.2]
-
 theorem getKey?_eq [BEq α] [Hashable α] {m : Raw α β} (h : m.WF) {a : α} :
     m.getKey? a = Raw₀.getKey? ⟨m, h.size_buckets_pos⟩ a := by
   simp [Raw.getKey?, h.size_buckets_pos]
 
-theorem getKey?_val [BEq α] [Hashable α] {m : Raw₀ α β} {a : α} :
-    m.val.getKey? a = m.getKey? a := by
-  simp [Raw.getKey?, m.2]
-
 theorem getKey_eq [BEq α] [Hashable α] {m : Raw α β} {a : α} {h : a ∈ m} :
     m.getKey a h = Raw₀.getKey ⟨m, by change dite .. = true at h; split at h <;> simp_all⟩ a
       (by change dite .. = true at h; split at h <;> simp_all) := rfl
 
-theorem getKey_val [BEq α] [Hashable α] {m : Raw₀ α β} {a : α} {h : a ∈ m.val}  :
-    m.val.getKey a h = m.getKey a (contains_val (m := m) ▸ h) := rfl
-
 theorem getKeyD_eq [BEq α] [Hashable α] {m : Raw α β} (h : m.WF) {a fallback : α} :
     m.getKeyD a fallback = Raw₀.getKeyD ⟨m, h.size_buckets_pos⟩ a fallback := by
   simp [Raw.getKeyD, h.size_buckets_pos]
 
-theorem getKeyD_val [BEq α] [Hashable α] {m : Raw₀ α β} {a fallback : α} :
-    m.val.getKeyD a fallback = m.getKeyD a fallback := by
-  simp [Raw.getKeyD, m.2]
-
 theorem getKey!_eq [BEq α] [Hashable α] [Inhabited α] {m : Raw α β} (h : m.WF) {a : α} :
     m.getKey! a = Raw₀.getKey! ⟨m, h.size_buckets_pos⟩ a := by
   simp [Raw.getKey!, h.size_buckets_pos]
 
-theorem getKey!_val [BEq α] [Hashable α] [Inhabited α] {m : Raw₀ α β} {a : α} :
-    m.val.getKey! a = m.getKey! a := by
-  simp [Raw.getKey!, m.2]
-
 theorem erase_eq [BEq α] [Hashable α] {m : Raw α β} (h : m.WF) {a : α} :
     m.erase a = Raw₀.erase ⟨m, h.size_buckets_pos⟩ a := by
   simp [Raw.erase, h.size_buckets_pos]
 
-theorem erase_val [BEq α] [Hashable α] {m : Raw₀ α β} {a : α} :
-    m.val.erase a = m.erase a := by
-  simp [Raw.erase, m.2]
-
 theorem filterMap_eq [BEq α] [Hashable α] {m : Raw α β} (h : m.WF)
     {f : (a : α) → β a → Option (δ a)} : m.filterMap f =
       Raw₀.filterMap f ⟨m, h.size_buckets_pos⟩ := by
   simp [Raw.filterMap, h.size_buckets_pos]
 
-theorem filterMap_val [BEq α] [Hashable α] {m : Raw₀ α β} {f : (a : α) → β a → Option (δ a)} :
-    m.val.filterMap f = m.filterMap f := by
-  simp [Raw.filterMap, m.2]
-
 theorem map_eq [BEq α] [Hashable α] {m : Raw α β} (h : m.WF) {f : (a : α) → β a → δ a} :
     m.map f = Raw₀.map f ⟨m, h.size_buckets_pos⟩ := by
   simp [Raw.map, h.size_buckets_pos]
 
-theorem map_val [BEq α] [Hashable α] {m : Raw₀ α β} {f : (a : α) → β a → δ a} :
-    m.val.map f = m.map f := by
-  simp [Raw.map, m.2]
-
 theorem filter_eq [BEq α] [Hashable α] {m : Raw α β} (h : m.WF) {f : (a : α) → β a → Bool} :
     m.filter f = Raw₀.filter f ⟨m, h.size_buckets_pos⟩ := by
   simp [Raw.filter, h.size_buckets_pos]
 
-theorem filter_val [BEq α] [Hashable α] {m : Raw₀ α β} {f : (a : α) → β a → Bool} :
-    m.val.filter f = m.filter f := by
-  simp [Raw.filter, m.2]
-
 theorem insertMany_eq [BEq α] [Hashable α] {m : Raw α β} (h : m.WF) {ρ : Type w} [ForIn Id ρ ((a : α) × β a)] {l : ρ} :
     m.insertMany l = Raw₀.insertMany ⟨m, h.size_buckets_pos⟩ l := by
   simp [Raw.insertMany, h.size_buckets_pos]
 
-theorem insertMany_val [BEq α][Hashable α] {m : Raw₀ α β} {ρ : Type w} [ForIn Id ρ ((a : α) × β a)] {l : ρ} :
-    m.val.insertMany l = m.insertMany l := by
-  simp [Raw.insertMany, m.2]
-
 theorem ofList_eq [BEq α] [Hashable α] {l : List ((a : α) × β a)} :
     Raw.ofList l = Raw₀.insertMany Raw₀.empty l := by
   simp only [Raw.ofList, Raw.insertMany, (Raw.WF.empty).size_buckets_pos ∅, ↓reduceDIte]
@@ -228,10 +142,6 @@ theorem Const.insertMany_eq [BEq α] [Hashable α] {m : Raw α (fun _ => β)} (h
     Raw.Const.insertMany m l = Raw₀.Const.insertMany ⟨m, h.size_buckets_pos⟩ l := by
   simp [Raw.Const.insertMany, h.size_buckets_pos]
 
-theorem Const.insertMany_val [BEq α][Hashable α] {m : Raw₀ α (fun _ => β)} {ρ : Type w} [ForIn Id ρ (α × β)] {l : ρ} :
-    Raw.Const.insertMany m.val l = Raw₀.Const.insertMany m l := by
-  simp [Raw.Const.insertMany, m.2]
-
 theorem Const.ofList_eq [BEq α] [Hashable α] {l : List (α × β)} :
     Raw.Const.ofList l = Raw₀.Const.insertMany Raw₀.empty l := by
   simp only [Raw.Const.ofList, Raw.Const.insertMany, (Raw.WF.empty).size_buckets_pos ∅, ↓reduceDIte]
@@ -242,11 +152,6 @@ theorem Const.insertManyIfNewUnit_eq {ρ : Type w} [ForIn Id ρ α] [BEq α] [Ha
     Raw.Const.insertManyIfNewUnit m l = Raw₀.Const.insertManyIfNewUnit ⟨m, h.size_buckets_pos⟩ l := by
   simp [Raw.Const.insertManyIfNewUnit, h.size_buckets_pos]
 
-theorem Const.insertManyIfNewUnit_val {ρ : Type w} [ForIn Id ρ α] [BEq α] [Hashable α]
-    {m : Raw₀ α (fun _ => Unit)} {l : ρ} :
-    Raw.Const.insertManyIfNewUnit m.val l = Raw₀.Const.insertManyIfNewUnit m l := by
-  simp [Raw.Const.insertManyIfNewUnit, m.2]
-
 theorem Const.unitOfList_eq [BEq α] [Hashable α] {l : List α} :
     Raw.Const.unitOfList l = Raw₀.Const.insertManyIfNewUnit Raw₀.empty l := by
   simp only [Raw.Const.unitOfList, Raw.Const.insertManyIfNewUnit, (Raw.WF.empty).size_buckets_pos ∅,
@@ -257,56 +162,31 @@ theorem Const.get?_eq [BEq α] [Hashable α] {m : Raw α (fun _ => β)} (h : m.W
     Raw.Const.get? m a = Raw₀.Const.get? ⟨m, h.size_buckets_pos⟩ a := by
   simp [Raw.Const.get?, h.size_buckets_pos]
 
-theorem Const.get?_val [BEq α] [Hashable α] {m : Raw₀ α (fun _ => β)} {a : α} :
-    Raw.Const.get? m.val a = Raw₀.Const.get? m a := by
-  simp [Raw.Const.get?, m.2]
-
 theorem Const.get_eq [BEq α] [Hashable α] {m : Raw α (fun _ => β)} {a : α} {h : a ∈ m} :
     Raw.Const.get m a h = Raw₀.Const.get
       ⟨m, by change dite .. = true at h; split at h <;> simp_all⟩ a
       (by change dite .. = true at h; split at h <;> simp_all) :=
   rfl
 
-theorem Const.get_val [BEq α] [Hashable α] {m : Raw₀ α (fun _ => β)} {a : α} {h : a ∈ m.val} :
-    Raw.Const.get m.val a h = Raw₀.Const.get m a (contains_val (m := m) ▸ h) := rfl
-
 theorem Const.getD_eq [BEq α] [Hashable α] {m : Raw α (fun _ => β)} (h : m.WF) {a : α}
     {fallback : β} : Raw.Const.getD m a fallback =
       Raw₀.Const.getD ⟨m, h.size_buckets_pos⟩ a fallback := by
   simp [Raw.Const.getD, h.size_buckets_pos]
 
-theorem Const.getD_val [BEq α] [Hashable α] {m : Raw₀ α (fun _ => β)} {a : α} {fallback : β} :
-    Raw.Const.getD m.val a fallback = Raw₀.Const.getD m a fallback := by
-  simp [Raw.Const.getD, m.2]
-
 theorem Const.get!_eq [BEq α] [Hashable α] [Inhabited β] {m : Raw α (fun _ => β)} (h : m.WF)
     {a : α} : Raw.Const.get! m a = Raw₀.Const.get! ⟨m, h.size_buckets_pos⟩ a := by
   simp [Raw.Const.get!, h.size_buckets_pos]
 
-theorem Const.get!_val [BEq α] [Hashable α] [Inhabited β] {m : Raw₀ α (fun _ => β)} {a : α} :
-    Raw.Const.get! m.val a = Raw₀.Const.get! m a := by
-  simp [Raw.Const.get!, m.2]
-
 theorem Const.getThenInsertIfNew?_snd_eq [BEq α] [Hashable α] {m : Raw α (fun _ => β)} (h : m.WF)
     {a : α} {b : β} : (Raw.Const.getThenInsertIfNew? m a b).2 =
       (Raw₀.Const.getThenInsertIfNew? ⟨m, h.size_buckets_pos⟩ a b).2.1 := by
   simp [Raw.Const.getThenInsertIfNew?, h.size_buckets_pos]
 
-theorem Const.getThenInsertIfNew?_snd_val [BEq α] [Hashable α] {m : Raw₀ α (fun _ => β)} {a : α}
-    {b : β} : (Raw.Const.getThenInsertIfNew? m.val a b).2 =
-      (Raw₀.Const.getThenInsertIfNew? m a b).2.1 := by
-  simp [Raw.Const.getThenInsertIfNew?, m.2]
-
 theorem Const.getThenInsertIfNew?_fst_eq [BEq α] [Hashable α] {m : Raw α (fun _ => β)} (h : m.WF)
     {a : α} {b : β} : (Raw.Const.getThenInsertIfNew? m a b).1 =
       (Raw₀.Const.getThenInsertIfNew? ⟨m, h.size_buckets_pos⟩ a b).1 := by
   simp [Raw.Const.getThenInsertIfNew?, h.size_buckets_pos]
 
-theorem Const.getThenInsertIfNew?_fst_val [BEq α] [Hashable α] {m : Raw₀ α (fun _ => β)} {a : α}
-    {b : β} : (Raw.Const.getThenInsertIfNew? m.val a b).1 =
-      (Raw₀.Const.getThenInsertIfNew? m a b).1 := by
-  simp [Raw.Const.getThenInsertIfNew?, m.2]
-
 theorem Const.alter_eq [BEq α] [EquivBEq α] [Hashable α] {m : Raw α (fun _ => β)} (h : m.WF) {k : α} {f : Option β → Option β} :
     Raw.Const.alter m k f = Raw₀.Const.alter ⟨m, h.size_buckets_pos⟩ k f := by
   simp [Raw.Const.alter, h.size_buckets_pos]

src/Std/Data/DHashMap/Internal/WF.lean

@@ -1081,6 +1081,11 @@ theorem wfImp_insertMany [BEq α] [Hashable α] [EquivBEq α] [LawfulHashable α
     Raw.WFImp (m.insertMany l).1.1 :=
   Raw.WF.out ((m.insertMany l).2 _ Raw.WF.insert₀ (.wf m.2 h))
 
+theorem wf_insertMany₀ [BEq α] [Hashable α] [EquivBEq α] [LawfulHashable α] {ρ : Type w}
+    [ForIn Id ρ ((a : α) × β a)] {m : Raw α β} {h : 0 < m.buckets.size} {l : ρ} (h' : m.WF) :
+    (Raw₀.insertMany ⟨m, h⟩ l).1.1.WF :=
+  (Raw₀.insertMany ⟨m, h⟩ l).2 _ Raw.WF.insert₀ h'
+
 theorem toListModel_insertMany_list [BEq α] [Hashable α] [EquivBEq α] [LawfulHashable α]
     {m : Raw₀ α β} {l : List ((a : α) × (β a))} (h : Raw.WFImp m.1) :
     Perm (toListModel (insertMany m l).1.1.buckets)
@@ -1117,6 +1122,11 @@ theorem Const.wfImp_insertMany {β : Type v} [BEq α] [Hashable α] [EquivBEq α
     {l : ρ} (h : Raw.WFImp m.1) : Raw.WFImp (Const.insertMany m l).1.1 :=
   Raw.WF.out ((Const.insertMany m l).2 _ Raw.WF.insert₀ (.wf m.2 h))
 
+theorem Const.wf_insertMany₀ {β : Type v} [BEq α] [Hashable α] [EquivBEq α] [LawfulHashable α]
+    {ρ : Type w} [ForIn Id ρ (α × β)] {m : Raw α (fun _ => β)} {h : 0 < m.buckets.size}
+    {l : ρ} (h' : m.WF) : (Const.insertMany ⟨m, h⟩ l).1.1.WF :=
+  (Raw₀.Const.insertMany ⟨m, h⟩ l).2 _ Raw.WF.insert₀ h'
+
 /-! # `Const.insertListIfNewUnitₘ` -/
 
 theorem Const.toListModel_insertListIfNewUnitₘ [BEq α] [Hashable α] [EquivBEq α] [LawfulHashable α]
@@ -1145,4 +1155,9 @@ theorem Const.wfImp_insertManyIfNewUnit [BEq α] [Hashable α] [EquivBEq α] [La
     Raw.WFImp (Const.insertManyIfNewUnit m l).1.1 :=
   Raw.WF.out ((Const.insertManyIfNewUnit m l).2 _ Raw.WF.insertIfNew₀ (.wf m.2 h))
 
+theorem Const.wf_insertManyIfNewUnit₀ [BEq α] [Hashable α] [EquivBEq α] [LawfulHashable α]
+    {ρ : Type w} [ForIn Id ρ α] {m : Raw α (fun _ => Unit)} {h : 0 < m.buckets.size}
+    {l : ρ} (h' : m.WF) : (Const.insertManyIfNewUnit ⟨m, h⟩ l).1.1.WF :=
+  (Raw₀.Const.insertManyIfNewUnit ⟨m, h⟩ l).2 _ Raw.WF.insertIfNew₀ h'
+
 end Raw₀

src/Std/Data/DHashMap/Lemmas.lean

@@ -1155,6 +1155,23 @@ theorem forIn_eq_forIn_toList [Monad m'] [LawfulMonad m']
     ForIn.forIn m init f = ForIn.forIn m.toList init f :=
   Raw₀.forIn_eq_forIn_toList ⟨m.1, m.2.size_buckets_pos⟩
 
+theorem foldM_eq_foldlM_keys [Monad m'] [LawfulMonad m'] {f : δ → α → m' δ} {init : δ} :
+    m.foldM (fun d a _ => f d a) init = m.keys.foldlM f init :=
+  Raw₀.foldM_eq_foldlM_keys ⟨m.1, m.2.size_buckets_pos⟩
+
+theorem fold_eq_foldl_keys {f : δ → α → δ} {init : δ} :
+    m.fold (fun d a _ => f d a) init = m.keys.foldl f init :=
+  Raw₀.fold_eq_foldl_keys ⟨m.1, m.2.size_buckets_pos⟩
+
+theorem forM_eq_forM_keys [Monad m'] [LawfulMonad m'] {f : α → m' PUnit} :
+    ForM.forM m (fun a => f a.1) = m.keys.forM f :=
+  Raw₀.forM_eq_forM_keys ⟨m.1, m.2.size_buckets_pos⟩
+
+theorem forIn_eq_forIn_keys [Monad m'] [LawfulMonad m'] {f : α → δ → m' (ForInStep δ)}
+    {init : δ} :
+    ForIn.forIn m init (fun a d => f a.1 d) = ForIn.forIn m.keys init f :=
+  Raw₀.forIn_eq_forIn_keys ⟨m.1, m.2.size_buckets_pos⟩
+
 namespace Const
 
 variable {β : Type v} {m : DHashMap α (fun _ => β)}
@@ -1168,34 +1185,62 @@ theorem fold_eq_foldl_toList {f : δ → (a : α) → β → δ} {init : δ} :
     m.fold f init = (Const.toList m).foldl (fun a b => f a b.1 b.2) init :=
   Raw₀.Const.fold_eq_foldl_toList ⟨m.1, m.2.size_buckets_pos⟩
 
-theorem forM_eq_forM_toList [Monad m'] [LawfulMonad m'] {f : (a : α) → β → m' PUnit} :
-    m.forM f = (Const.toList m).forM (fun a => f a.1 a.2) :=
+theorem forM_eq_forMUncurried [Monad m'] [LawfulMonad m'] {f : α → β → m' PUnit} :
+    DHashMap.forM f m = forMUncurried (fun a => f a.1 a.2) m := rfl
+
+theorem forMUncurried_eq_forM_toList [Monad m'] [LawfulMonad m'] {f : α × β → m' PUnit} :
+    Const.forMUncurried f m = (Const.toList m).forM f :=
   Raw₀.Const.forM_eq_forM_toList ⟨m.1, m.2.size_buckets_pos⟩
 
+/--
+Deprecated, use `forMUncurried_eq_forM_toList` together with `forM_eq_forMUncurried` instead.
+-/
+@[deprecated forMUncurried_eq_forM_toList (since := "2025-03-02")]
+theorem forM_eq_forM_toList [Monad m'] [LawfulMonad m'] {f : α → β → m' PUnit} :
+    DHashMap.forM f m = (Const.toList m).forM (fun a => f a.1 a.2) :=
+  Raw₀.Const.forM_eq_forM_toList ⟨m.1, m.2.size_buckets_pos⟩
+
+theorem forIn_eq_forInUncurried [Monad m'] [LawfulMonad m']
+    {f : α → β → δ → m' (ForInStep δ)} {init : δ} :
+    DHashMap.forIn f init m = forInUncurried (fun a b => f a.1 a.2 b) init m := rfl
+
+theorem forInUncurried_eq_forIn_toList [Monad m'] [LawfulMonad m']
+    {f : α × β → δ → m' (ForInStep δ)} {init : δ} :
+    Const.forInUncurried f init m = ForIn.forIn (Const.toList m) init f :=
+  Raw₀.Const.forIn_eq_forIn_toList ⟨m.1, m.2.size_buckets_pos⟩
+
+/--
+Deprecated, use `forInUncurried_eq_forIn_toList` together with `forIn_eq_forInUncurried` instead.
+-/
+@[deprecated forInUncurried_eq_forIn_toList (since := "2025-03-02")]
 theorem forIn_eq_forIn_toList [Monad m'] [LawfulMonad m']
-    {f : (a : α) → β → δ → m' (ForInStep δ)} {init : δ} :
-    m.forIn f init = ForIn.forIn (Const.toList m) init (fun a b => f a.1 a.2 b) :=
+    {f : α × β → δ → m' (ForInStep δ)} {init : δ} :
+    Const.forInUncurried f init m = ForIn.forIn (Const.toList m) init f :=
   Raw₀.Const.forIn_eq_forIn_toList ⟨m.1, m.2.size_buckets_pos⟩
 
 variable {m : DHashMap α (fun _ => Unit)}
 
+@[deprecated DHashMap.foldM_eq_foldlM_keys (since := "2025-02-28")]
 theorem foldM_eq_foldlM_keys [Monad m'] [LawfulMonad m']
     {f : δ → α → m' δ} {init : δ} :
     m.foldM (fun d a _ => f d a) init = m.keys.foldlM f init :=
-  Raw₀.Const.foldM_eq_foldlM_keys ⟨m.1, m.2.size_buckets_pos⟩
+  Raw₀.foldM_eq_foldlM_keys ⟨m.1, m.2.size_buckets_pos⟩
 
+@[deprecated DHashMap.fold_eq_foldl_keys (since := "2025-02-28")]
 theorem fold_eq_foldl_keys {f : δ → α → δ} {init : δ} :
     m.fold (fun d a _ => f d a) init = m.keys.foldl f init :=
-  Raw₀.Const.fold_eq_foldl_keys ⟨m.1, m.2.size_buckets_pos⟩
+  Raw₀.fold_eq_foldl_keys ⟨m.1, m.2.size_buckets_pos⟩
 
+@[deprecated DHashMap.forM_eq_forM_keys (since := "2025-02-28")]
 theorem forM_eq_forM_keys [Monad m'] [LawfulMonad m'] {f : α → m' PUnit} :
     m.forM (fun a _ => f a) = m.keys.forM f :=
-  Raw₀.Const.forM_eq_forM_keys ⟨m.1, m.2.size_buckets_pos⟩
+  Raw₀.forM_eq_forM_keys ⟨m.1, m.2.size_buckets_pos⟩
 
+@[deprecated DHashMap.forIn_eq_forIn_keys (since := "2025-02-28")]
 theorem forIn_eq_forIn_keys [Monad m'] [LawfulMonad m']
     {f : α → δ → m' (ForInStep δ)} {init : δ} :
     m.forIn (fun a _ d => f a d) init = ForIn.forIn m.keys init f :=
-  Raw₀.Const.forIn_eq_forIn_keys ⟨m.1, m.2.size_buckets_pos⟩
+  Raw₀.forIn_eq_forIn_keys ⟨m.1, m.2.size_buckets_pos⟩
 
 end Const
 

src/Std/Data/DHashMap/Raw.lean

@@ -373,6 +373,26 @@ instance : ForM m (Raw α β) ((a : α) × β a) where
 instance : ForIn m (Raw α β) ((a : α) × β a) where
   forIn m init f := m.forIn (fun a b acc => f ⟨a, b⟩ acc) init
 
+namespace Const
+
+variable {β : Type v}
+
+/-!
+We do not define `ForM` and `ForIn` instances that are specialized to constant `β`. Instead, we
+define uncurried versions of `forM` and `forIn` that will be used in the `Const` lemmas and to
+define the `ForM` and `ForIn` instances for `HashMap.Raw`.
+-/
+
+@[inline, inherit_doc forM] def forMUncurried (f : α × β → m PUnit)
+    (b : Raw α (fun _ => β)) : m PUnit :=
+  b.forM fun a b => f ⟨a, b⟩
+
+@[inline, inherit_doc forIn] def forInUncurried
+    (f : α × β → δ → m (ForInStep δ)) (init : δ) (b : Raw α (fun _ => β)) : m δ :=
+  b.forIn (init := init) fun a b d => f ⟨a, b⟩ d
+
+end Const
+
 section Unverified
 
 /-! We currently do not provide lemmas for the functions below. -/

src/Std/Data/DHashMap/RawLemmas.lean

@@ -32,38 +32,19 @@ open Lean Elab Meta Tactic
 
 private def baseNames : Array Name :=
   #[``Raw.empty_eq, ``Raw.emptyc_eq,
-    ``insert_eq, ``insert_val,
-    ``insertIfNew_eq, ``insertIfNew_val,
-    ``containsThenInsert_snd_eq, ``containsThenInsert_snd_val,
-    ``containsThenInsertIfNew_snd_eq, ``containsThenInsertIfNew_snd_val,
-    ``getThenInsertIfNew?_snd_eq, ``getThenInsertIfNew?_snd_val,
-    ``map_eq, ``map_val,
-    ``filter_eq, ``filter_val,
-    ``erase_eq, ``erase_val,
-    ``filterMap_eq, ``filterMap_val,
-    ``Const.getThenInsertIfNew?_snd_eq, ``Const.getThenInsertIfNew?_snd_val,
-    ``containsThenInsert_fst_eq, ``containsThenInsert_fst_val,
-    ``containsThenInsertIfNew_fst_eq, ``containsThenInsertIfNew_fst_val,
-    ``Const.get?_eq, ``Const.get?_val,
-    ``Const.get_eq, ``Const.get_val,
-    ``Const.getD_eq, ``Const.getD_val,
-    ``Const.get!_eq, ``Const.get!_val,
-    ``getThenInsertIfNew?_fst_eq, ``getThenInsertIfNew?_fst_val,
-    ``Const.getThenInsertIfNew?_fst_eq, ``Const.getThenInsertIfNew?_fst_val,
-    ``get?_eq, ``get?_val,
-    ``contains_eq, ``contains_val,
-    ``get_eq, ``get_val,
-    ``getD_eq, ``getD_val,
-    ``get!_eq, ``get!_val,
-    ``getKey?_eq, ``getKey?_val,
-    ``getKey_eq, ``getKey_val,
-    ``getKey!_eq, ``getKey!_val,
-    ``getKeyD_eq, ``getKeyD_val,
-    ``insertMany_eq, ``insertMany_val,
-    ``Const.insertMany_eq, ``Const.insertMany_val,
-    ``Const.insertManyIfNewUnit_eq, ``Const.insertManyIfNewUnit_val,
+    ``insert_eq, ``insertIfNew_eq, ``erase_eq, ``contains_eq,
+    ``containsThenInsert_fst_eq, ``containsThenInsert_snd_eq,
+    ``containsThenInsertIfNew_fst_eq, ``containsThenInsertIfNew_snd_eq,
+    ``getThenInsertIfNew?_fst_eq, ``getThenInsertIfNew?_snd_eq,
+    ``Const.getThenInsertIfNew?_snd_eq, ``Const.getThenInsertIfNew?_fst_eq,
+    ``map_eq, ``filter_eq, ``filterMap_eq,
+    ``get?_eq, ``get_eq, ``get!_eq, ``getD_eq,
+    ``Const.get?_eq, ``Const.get_eq, ``Const.getD_eq, ``Const.get!_eq,
+    ``getKey?_eq, ``getKey_eq, ``getKey!_eq, ``getKeyD_eq,
+    ``insertMany_eq, ``Const.insertMany_eq, ``Const.insertManyIfNewUnit_eq,
     ``ofList_eq, ``Const.ofList_eq, ``Const.unitOfList_eq,
-    ``alter_eq, ``Const.alter_eq, ``modify_eq, ``Const.modify_eq]
+    ``alter_eq, ``Const.alter_eq, ``modify_eq, ``Const.modify_eq,
+    ``Subtype.eta]
 
 /-- Internal implementation detail of the hash map -/
 scoped syntax "simp_to_raw" ("using" term)? : tactic
@@ -73,9 +54,9 @@ open Internal.Raw₀
 macro_rules
 | `(tactic| simp_to_raw $[using $using?]?) => do
   `(tactic|
-    (try simp (discharger := wf_trivial) only [$[$(Array.map Lean.mkIdent baseNames):term],*]
+    (try simp (discharger := with_reducible wf_trivial) only [$[$(Array.map Lean.mkIdent baseNames):term],*]
      $[apply $(using?.toArray):term];*)
-     <;> wf_trivial)
+     <;> with_reducible try wf_trivial)
 
 end Internal.Raw
 
@@ -1255,6 +1236,24 @@ theorem forIn_eq_forIn_toList [Monad m'] [LawfulMonad m']
     ForIn.forIn m init f = ForIn.forIn m.toList init f :=
   Raw₀.forIn_eq_forIn_toList ⟨m, h.size_buckets_pos⟩
 
+theorem foldM_eq_foldlM_keys [Monad m'] [LawfulMonad m'] (h : m.WF)
+    {f : δ → α → m' δ} {init : δ} :
+    m.foldM (fun d a _ => f d a) init = m.keys.foldlM f init :=
+  Raw₀.foldM_eq_foldlM_keys ⟨m, h.size_buckets_pos⟩
+
+theorem fold_eq_foldl_keys (h : m.WF) {f : δ → α → δ} {init : δ} :
+    m.fold (fun d a _ => f d a) init = m.keys.foldl f init :=
+  Raw₀.fold_eq_foldl_keys ⟨m, h.size_buckets_pos⟩
+
+theorem forM_eq_forM_keys [Monad m'] [LawfulMonad m'] (h : m.WF) {f : α → m' PUnit} :
+    ForM.forM m (fun a => f a.1) = m.keys.forM f :=
+  Raw₀.forM_eq_forM_keys ⟨m, h.size_buckets_pos⟩
+
+theorem forIn_eq_forIn_keys [Monad m'] [LawfulMonad m'] (h : m.WF)
+    {f : α → δ → m' (ForInStep δ)} {init : δ} :
+    ForIn.forIn m init (fun a d => f a.1 d) = ForIn.forIn m.keys init f :=
+  Raw₀.forIn_eq_forIn_keys ⟨m, h.size_buckets_pos⟩
+
 namespace Const
 
 variable {β : Type v} {m : Raw α (fun _ => β)}
@@ -1268,10 +1267,39 @@ theorem fold_eq_foldl_toList (h : m.WF) {f : δ → (a : α) → β → δ} {ini
     m.fold f init = (Raw.Const.toList m).foldl (fun a b => f a b.1 b.2) init :=
   Raw₀.Const.fold_eq_foldl_toList ⟨m, h.size_buckets_pos⟩
 
+omit [BEq α] [Hashable α] in
+theorem forM_eq_forMUncurried [Monad m'] [LawfulMonad m']
+    {f : α → β → m' PUnit} :
+    Raw.forM f m = Const.forMUncurried (fun a => f a.1 a.2) m := rfl
+
+theorem forMUncurried_eq_forM_toList [Monad m'] [LawfulMonad m'] (h : m.WF)
+    {f : α × β → m' PUnit} :
+    forMUncurried f m = (toList m).forM f :=
+  Raw₀.Const.forM_eq_forM_toList ⟨m, h.size_buckets_pos⟩
+
+/--
+Deprecated, use `forMUncurried_eq_forM_toList` together with `forM_eq_forMUncurried` instead.
+-/
+@[deprecated forMUncurried_eq_forM_toList (since := "2025-03-02")]
 theorem forM_eq_forM_toList [Monad m'] [LawfulMonad m'] (h : m.WF) {f : (a : α) → β → m' PUnit} :
     m.forM f = (Raw.Const.toList m).forM (fun a => f a.1 a.2) :=
   Raw₀.Const.forM_eq_forM_toList ⟨m, h.size_buckets_pos⟩
 
+omit [BEq α] [Hashable α] in
+@[simp]
+theorem forIn_eq_forInUncurried [Monad m'] [LawfulMonad m']
+    {f : α → β → δ → m' (ForInStep δ)} {init : δ} :
+    forIn f init m = forInUncurried (fun a b => f a.1 a.2 b) init m := rfl
+
+theorem forInUncurried_eq_forIn_toList [Monad m'] [LawfulMonad m'] (h : m.WF)
+    {f : α × β → δ → m' (ForInStep δ)} {init : δ} :
+    forInUncurried f init m = ForIn.forIn (toList m) init f :=
+  Raw₀.Const.forIn_eq_forIn_toList ⟨m, h.size_buckets_pos⟩
+
+/--
+Deprecated, use `forInUncurried_eq_forIn_toList` together with `forIn_eq_forInUncurried` instead.
+-/
+@[deprecated forInUncurried_eq_forIn_toList (since := "2025-03-02")]
 theorem forIn_eq_forIn_toList [Monad m'] [LawfulMonad m'] (h : m.WF)
     {f : (a : α) → β → δ → m' (ForInStep δ)} {init : δ} :
     m.forIn f init = ForIn.forIn (Raw.Const.toList m) init (fun a b => f a.1 a.2 b) :=
@@ -1279,23 +1307,27 @@ theorem forIn_eq_forIn_toList [Monad m'] [LawfulMonad m'] (h : m.WF)
 
 variable {m : Raw α (fun _ => Unit)}
 
+@[deprecated Raw.foldM_eq_foldlM_keys (since := "2025-02-28")]
 theorem foldM_eq_foldlM_keys [Monad m'] [LawfulMonad m'] (h : m.WF)
     {f : δ → α → m' δ} {init : δ} :
     m.foldM (fun d a _ => f d a) init = m.keys.foldlM f init :=
-  Raw₀.Const.foldM_eq_foldlM_keys ⟨m, h.size_buckets_pos⟩
+  Raw₀.foldM_eq_foldlM_keys ⟨m, h.size_buckets_pos⟩
 
+@[deprecated Raw.fold_eq_foldl_keys (since := "2025-02-28")]
 theorem fold_eq_foldl_keys (h : m.WF) {f : δ → α → δ} {init : δ} :
     m.fold (fun d a _ => f d a) init = m.keys.foldl f init :=
-  Raw₀.Const.fold_eq_foldl_keys ⟨m, h.size_buckets_pos⟩
+  Raw₀.fold_eq_foldl_keys ⟨m, h.size_buckets_pos⟩
 
+@[deprecated Raw.forM_eq_forM_keys (since := "2025-02-28")]
 theorem forM_eq_forM_keys [Monad m'] [LawfulMonad m'] (h : m.WF) {f : α → m' PUnit} :
     m.forM (fun a _ => f a) = m.keys.forM f :=
-  Raw₀.Const.forM_eq_forM_keys ⟨m, h.size_buckets_pos⟩
+  Raw₀.forM_eq_forM_keys ⟨m, h.size_buckets_pos⟩
 
+@[deprecated Raw.forIn_eq_forIn_keys (since := "2025-02-28")]
 theorem forIn_eq_forIn_keys [Monad m'] [LawfulMonad m'] (h : m.WF)
     {f : α → δ → m' (ForInStep δ)} {init : δ} :
     m.forIn (fun a _ d => f a d) init = ForIn.forIn m.keys init f :=
-  Raw₀.Const.forIn_eq_forIn_keys ⟨m, h.size_buckets_pos⟩
+  Raw₀.forIn_eq_forIn_keys ⟨m, h.size_buckets_pos⟩
 
 end Const
 

src/Std/Data/DTreeMap/Basic.lean

@@ -820,7 +820,7 @@ def forM (f : (a : α) → β a → m PUnit) (t : DTreeMap α β cmp) : m PUnit
 /-- Support for the `for` loop construct in `do` blocks. Iteration happens in ascending order. -/
 @[inline]
 def forIn (f : (a : α) → β a → δ → m (ForInStep δ)) (init : δ) (t : DTreeMap α β cmp) : m δ :=
-  t.inner.forIn (fun c a b => f a b c) init
+  t.inner.forIn f init
 
 instance : ForM m (DTreeMap α β cmp) ((a : α) × β a) where
   forM t f := t.forM (fun a b => f ⟨a, b⟩)
@@ -828,6 +828,26 @@ instance : ForM m (DTreeMap α β cmp) ((a : α) × β a) where
 instance : ForIn m (DTreeMap α β cmp) ((a : α) × β a) where
   forIn m init f := m.forIn (fun a b acc => f ⟨a, b⟩ acc) init
 
+namespace Const
+
+variable {β : Type v}
+
+/-!
+We do not define `ForM` and `ForIn` instances that are specialized to constant `β`. Instead, we
+define uncurried versions of `forM` and `forIn` that will be used in the `Const` lemmas and to
+define the `ForM` and `ForIn` instances for `DTreeMap`.
+-/
+
+@[inline, inherit_doc DTreeMap.forM]
+def forMUncurried (f : α × β → m PUnit) (t : DTreeMap α β cmp) : m PUnit :=
+  t.inner.forM fun a b => f ⟨a, b⟩
+
+@[inline, inherit_doc DTreeMap.forIn]
+def forInUncurried (f : α × β → δ → m (ForInStep δ)) (init : δ) (t : DTreeMap α β cmp) : m δ :=
+  t.inner.forIn (fun a b acc => f ⟨a, b⟩ acc) init
+
+end Const
+
 /-- Check if any element satisfes the predicate, short-circuiting if a predicate fails. -/
 @[inline]
 def any (t : DTreeMap α β cmp) (p : (a : α) → β a → Bool) : Bool := Id.run $ do

src/Std/Data/DTreeMap/Internal/Lemmas.lean

@@ -20,7 +20,7 @@ set_option autoImplicit false
 open Std.Internal.List
 open Std.Internal
 
-universe u v
+universe u v w
 
 namespace Std.DTreeMap.Internal.Impl
 
@@ -60,7 +60,10 @@ private def queryNames : Array Name :=
     ``getD_eq_getValueCastD, ``Const.getD_eq_getValueD,
     ``getKey?_eq_getKey?, ``getKey_eq_getKey,
     ``getKey!_eq_getKey!, ``getKeyD_eq_getKeyD,
-    ``keys_eq_keys, ``toList_eq_toListModel, ``Const.toList_eq_toListModel_map]
+    ``keys_eq_keys, ``toList_eq_toListModel, ``Const.toList_eq_toListModel_map,
+    ``foldlM_eq_foldlM_toListModel, ``foldl_eq_foldl,
+    ``foldrM_eq_foldrM, ``foldr_eq_foldr,
+    ``forM_eq_forM, ``forIn_eq_forIn_toListModel]
 
 private def modifyMap : Std.HashMap Name Name :=
   .ofList
@@ -1571,4 +1574,95 @@ theorem distinct_keys_toList [TransOrd α] (h : t.WF) :
 
 end Const
 
+section monadic
+
+variable {t : Impl α β} {δ : Type w} {m : Type w → Type w}
+
+theorem foldlM_eq_foldlM_toList [Monad m] [LawfulMonad m]
+    {f : δ → (a : α) → β a → m δ} {init : δ} :
+    t.foldlM f init = t.toList.foldlM (fun a b => f a b.1 b.2) init := by
+  simp_to_model
+
+theorem foldl_eq_foldl_toList {f : δ → (a : α) → β a → δ} {init : δ} :
+    t.foldl f init = t.toList.foldl (fun a b => f a b.1 b.2) init := by
+  simp_to_model
+
+theorem foldrM_eq_foldrM_toList [Monad m] [LawfulMonad m]
+    {f : (a : α) → β a → δ → m δ} {init : δ} :
+    t.foldrM f init = t.toList.foldrM (fun a b => f a.1 a.2 b) init := by
+  simp_to_model
+
+theorem foldr_eq_foldr_toList {f : (a : α) → β a → δ → δ} {init : δ} :
+    t.foldr f init = t.toList.foldr (fun a b => f a.1 a.2 b) init := by
+  simp_to_model
+
+theorem forM_eq_forM_toList [Monad m] [LawfulMonad m] {f : (a : α) × β a → m PUnit} :
+    t.forM (fun k v => f ⟨k, v⟩) = ForM.forM t.toList f := by
+  simp_to_model using rfl
+
+theorem forIn_eq_forIn_toList [Monad m] [LawfulMonad m]
+    {f : (a : α) × β a → δ → m (ForInStep δ)} {init : δ} :
+    t.forIn (fun k v => f ⟨k, v⟩) init = ForIn.forIn t.toList init f := by
+  simp_to_model
+
+theorem foldlM_eq_foldlM_keys [Monad m] [LawfulMonad m] {f : δ → α → m δ} {init : δ} :
+    t.foldlM (fun d a _ => f d a) init = t.keys.foldlM f init := by
+  simp_to_model using List.foldlM_eq_foldlM_keys
+
+theorem foldl_eq_foldl_keys {f : δ → α → δ} {init : δ} :
+    t.foldl (fun d a _ => f d a) init = t.keys.foldl f init := by
+  simp_to_model using List.foldl_eq_foldl_keys
+
+theorem foldrM_eq_foldrM_keys [Monad m] [LawfulMonad m] {f : α → δ → m δ} {init : δ} :
+    t.foldrM (fun a _ d => f a d) init = t.keys.foldrM f init := by
+  simp_to_model using List.foldrM_eq_foldrM_keys
+
+theorem foldr_eq_foldr_keys {f : α → δ → δ} {init : δ} :
+    t.foldr (fun a _ d => f a d) init = t.keys.foldr f init := by
+  simp_to_model using List.foldr_eq_foldr_keys
+
+theorem forM_eq_forM_keys [Monad m] [LawfulMonad m] {f : α → m PUnit} :
+    t.forM (fun a _ => f a) = t.keys.forM f := by
+  simp_to_model using List.forM_eq_forM_keys
+
+theorem forIn_eq_forIn_keys [Monad m] [LawfulMonad m] {f : α → δ → m (ForInStep δ)}
+    {init : δ} :
+    t.forIn (fun a _ d => f a d) init = ForIn.forIn t.keys init f := by
+  simp_to_model using List.forIn_eq_forIn_keys
+
+namespace Const
+
+variable {β : Type v} {t : Impl α β}
+
+theorem foldlM_eq_foldlM_toList [Monad m] [LawfulMonad m]
+    {f : δ → (a : α) → β → m δ} {init : δ} :
+    t.foldlM f init = (Const.toList t).foldlM (fun a b => f a b.1 b.2) init := by
+  simp_to_model using List.foldlM_eq_foldlM_toProd
+
+theorem foldl_eq_foldl_toList {f : δ → (a : α) → β → δ} {init : δ} :
+    t.foldl f init = (Const.toList t).foldl (fun a b => f a b.1 b.2) init := by
+  simp_to_model using List.foldl_eq_foldl_toProd
+
+theorem foldrM_eq_foldrM_toList [Monad m] [LawfulMonad m]
+    {f : (a : α) → β → δ → m δ} {init : δ} :
+    t.foldrM f init = (Const.toList t).foldrM (fun a b => f a.1 a.2 b) init := by
+  simp_to_model using List.foldrM_eq_foldrM_toProd
+
+theorem foldr_eq_foldr_toList {f : (a : α) → β → δ → δ} {init : δ} :
+    t.foldr f init = (Const.toList t).foldr (fun a b => f a.1 a.2 b) init := by
+  simp_to_model using List.foldr_eq_foldr_toProd
+
+theorem forM_eq_forM_toList [Monad m] [LawfulMonad m] {f : (a : α) → β → m PUnit} :
+    t.forM f = (Const.toList t).forM (fun a => f a.1 a.2) := by
+  simp_to_model using List.forM_eq_forM_toProd
+
+theorem forIn_eq_forIn_toList [Monad m] [LawfulMonad m]
+    {f : α → β → δ → m (ForInStep δ)} {init : δ} :
+    t.forIn f init = ForIn.forIn (Const.toList t) init (fun a b => f a.1 a.2 b) := by
+  simp_to_model using List.forIn_eq_forIn_toProd
+
+end Const
+
+end monadic
+
 end Std.DTreeMap.Internal.Impl

src/Std/Data/DTreeMap/Internal/Queries.lean

@@ -217,20 +217,20 @@ def forM {m} [Monad m] (f : (a : α) → β a → m PUnit) (t : Impl α β) : m
 
 /-- Implementation detail. -/
 @[specialize]
-def forInStep {m} [Monad m] (f : δ → (a : α) → β a → m (ForInStep δ)) (init : δ) :
+def forInStep {m} [Monad m] (f : (a : α) → β a → δ → m (ForInStep δ)) (init : δ) :
     Impl α β → m (ForInStep δ)
   | .leaf => pure (.yield init)
   | .inner _ k v l r => do
     match ← forInStep f init l with
     | ForInStep.done d => return (.done d)
     | ForInStep.yield d =>
-      match ← f d k v with
+      match ← f k v d with
       | ForInStep.done d => return (.done d)
       | ForInStep.yield d => forInStep f d r
 
 /-- Support for the `for` construct in `do` blocks. -/
 @[inline]
-def forIn {m} [Monad m] (f : δ → (a : α) → β a → m (ForInStep δ)) (init : δ) (t : Impl α β) : m δ := do
+def forIn {m} [Monad m] (f : (a : α) → β a → δ → m (ForInStep δ)) (init : δ) (t : Impl α β) : m δ := do
   match ← forInStep f init t with
   | ForInStep.done d => return d
   | ForInStep.yield d => return d

src/Std/Data/DTreeMap/Internal/WF/Lemmas.lean

@@ -1110,7 +1110,7 @@ theorem ordered_mergeWith [Ord α] [TransOrd α] [LawfulEqOrd α] {t₁ t₂ : I
 ### foldlM
 -/
 
-theorem foldlM_eq_foldlM {t : Impl α β} {m δ} [Monad m] [LawfulMonad m]
+theorem foldlM_eq_foldlM_toListModel {t : Impl α β} {m δ} [Monad m] [LawfulMonad m]
     {f : δ → (a : α) → β a → m δ} {init} :
     t.foldlM (init := init) f = t.toListModel.foldlM (init := init) fun acc p => f acc p.1 p.2 := by
   induction t generalizing init with
@@ -1119,13 +1119,18 @@ theorem foldlM_eq_foldlM {t : Impl α β} {m δ} [Monad m] [LawfulMonad m]
     simp only [foldlM, toListModel_inner, List.foldl_append, List.foldl_cons]
     simp [ihl, ihr]
 
+theorem foldlM_toListModel_eq_foldlM {t : Impl α β} {m δ} [Monad m] [LawfulMonad m]
+    {f : δ → ((a : α) × β a) → m δ} {init} :
+    t.toListModel.foldlM (init := init) f = t.foldlM (init := init) fun acc k v => f acc ⟨k, v⟩ := by
+  rw [foldlM_eq_foldlM_toListModel]
+
 /-!
 ### foldl
 -/
 
 theorem foldl_eq_foldl {t : Impl α β} {δ} {f : δ → (a : α) → β a → δ} {init} :
     t.foldl (init := init) f = t.toListModel.foldl (init := init) fun acc p => f acc p.1 p.2 := by
-  rw [foldl, foldlM_eq_foldlM, List.foldl_eq_foldlM, Id.run]
+  rw [foldl, foldlM_eq_foldlM_toListModel, List.foldl_eq_foldlM, Id.run]
 
 /-!
 ### foldrM
@@ -1173,6 +1178,60 @@ theorem keys_eq_keys {t : Impl α β} :
     simp [ih]
     rw [List.keys.eq_def]
 
+/-!
+### forM
+-/
+
+theorem forM_eq_forM {t: Impl α β} {m : Type w → Type w} [Monad m] [LawfulMonad m]
+    {f : (a : α) → β a → m PUnit} :
+    t.forM f = t.toListModel.forM (fun a => f a.1 a.2) := by
+  simp only [Impl.forM, foldlM_eq_foldlM_toListModel]
+  induction t.toListModel with
+  | nil => rfl
+  | cons e es ih => simp [ih]
+
+/-!
+### forIn
+-/
+
+theorem forInStep_eq_foldlM {δ : Type w} {t : Impl α β} {m : Type w → Type w} [Monad m] [LawfulMonad m]
+    {f : (a : α) → β a → δ → m (ForInStep δ)} {init : δ} :
+    t.forInStep f init = t.foldlM (init := .yield init) fun
+      | .yield d => fun k v => f k v d
+      | .done d => fun _ _ => pure (.done d) := by
+  induction t generalizing init with
+  | leaf => simp only [forInStep, foldlM]
+  | inner sz k v l r ihl ihr =>
+    simp [forInStep, foldlM, ihl, ihr]
+    congr; ext step
+    cases step
+    case yield =>
+      simp
+      congr; ext step
+      cases step
+      · simp
+        clear ihl ihr
+        apply Eq.symm
+        induction r <;> simp [foldlM, *]
+      · simp
+    case done =>
+      simp only [pure_bind]
+      clear ihl ihr
+      apply Eq.symm
+      induction r <;> simp [foldlM, *]
+
+
+theorem forIn_eq_forIn_toListModel {δ : Type w} {t : Impl α β} {m : Type w → Type w} [Monad m] [LawfulMonad m]
+    {f : (a : α) → β a → δ → m (ForInStep δ)} {init : δ} :
+    t.forIn f init = ForIn.forIn t.toListModel init (fun a d => f a.1 a.2 d) := by
+  rw [Impl.forIn, forInStep_eq_foldlM, List.forIn_eq_foldlM, foldlM_eq_foldlM_toListModel]
+  induction t.toListModel with
+  | nil => simp
+  | cons e es ih =>
+    simp only [List.foldlM_cons, bind_assoc, map_bind, map_eq_pure_bind]
+    congr; ext step
+    congr <;> ext step' <;> cases step' <;> rfl
+
 namespace Const
 
 variable {β : Type v}

src/Std/Data/DTreeMap/Lemmas.lean

@@ -19,7 +19,7 @@ open Std.DTreeMap.Internal
 set_option linter.missingDocs true
 set_option autoImplicit false
 
-universe u v
+universe u v w
 
 namespace Std.DTreeMap
 
@@ -1036,4 +1036,128 @@ theorem distinct_keys_toList [TransCmp cmp] :
 
 end Const
 
+section monadic
+
+variable {δ : Type w} {m : Type w → Type w}
+
+theorem foldlM_eq_foldlM_toList [Monad m] [LawfulMonad m]
+    {f : δ → (a : α) → β a → m δ} {init : δ} :
+    t.foldlM f init = t.toList.foldlM (fun a b => f a b.1 b.2) init :=
+  Impl.foldlM_eq_foldlM_toList
+
+theorem foldl_eq_foldl_toList {f : δ → (a : α) → β a → δ} {init : δ} :
+    t.foldl f init = t.toList.foldl (fun a b => f a b.1 b.2) init :=
+  Impl.foldl_eq_foldl_toList
+
+theorem foldrM_eq_foldrM_toList [Monad m] [LawfulMonad m] {f : (a : α) → β a → δ → m δ} {init : δ} :
+    t.foldrM f init = t.toList.foldrM (fun a b => f a.1 a.2 b) init :=
+  Impl.foldrM_eq_foldrM_toList
+
+theorem foldr_eq_foldr_toList {f : (a : α) → β a → δ → δ} {init : δ} :
+    t.foldr f init = t.toList.foldr (fun a b => f a.1 a.2 b) init :=
+  Impl.foldr_eq_foldr_toList
+
+@[simp]
+theorem forM_eq_forM [Monad m] [LawfulMonad m] {f : (a : α) → β a → m PUnit} :
+    t.forM f = ForM.forM t (fun a => f a.1 a.2) := rfl
+
+theorem forM_eq_forM_toList [Monad m] [LawfulMonad m] {f : (a : α) × β a → m PUnit} :
+    ForM.forM t f = ForM.forM t.toList f :=
+  Impl.forM_eq_forM_toList
+
+@[simp]
+theorem forIn_eq_forIn [Monad m] [LawfulMonad m]
+    {f : (a : α) → β a → δ → m (ForInStep δ)} {init : δ} :
+    t.forIn f init = ForIn.forIn t init (fun a b => f a.1 a.2 b) := rfl
+
+theorem forIn_eq_forIn_toList [Monad m] [LawfulMonad m]
+    {f : (a : α) × β a → δ → m (ForInStep δ)} {init : δ} :
+    ForIn.forIn t init f = ForIn.forIn t.toList init f :=
+  Impl.forIn_eq_forIn_toList (f := f)
+
+theorem foldlM_eq_foldlM_keys [Monad m] [LawfulMonad m] {f : δ → α → m δ} {init : δ} :
+    t.foldlM (fun d a _ => f d a) init = t.keys.foldlM f init :=
+  Impl.foldlM_eq_foldlM_keys
+
+theorem foldl_eq_foldl_keys {f : δ → α → δ} {init : δ} :
+    t.foldl (fun d a _ => f d a) init = t.keys.foldl f init :=
+  Impl.foldl_eq_foldl_keys
+
+theorem foldrM_eq_foldrM_keys [Monad m] [LawfulMonad m]
+    {f : α → δ → m δ} {init : δ} :
+    t.foldrM (fun a _ d => f a d) init = t.keys.foldrM f init :=
+  Impl.foldrM_eq_foldrM_keys
+
+theorem foldr_eq_foldr_keys {f : α → δ → δ} {init : δ} :
+    t.foldr (fun a _ d => f a d) init = t.keys.foldr f init :=
+  Impl.foldr_eq_foldr_keys
+
+theorem forM_eq_forM_keys [Monad m] [LawfulMonad m] {f : α → m PUnit} :
+    ForM.forM t (fun a => f a.1) = t.keys.forM f :=
+  Impl.forM_eq_forM_keys
+
+theorem forIn_eq_forIn_keys [Monad m] [LawfulMonad m]
+    {f : α → δ → m (ForInStep δ)} {init : δ} :
+    ForIn.forIn t init (fun a d => f a.1 d) = ForIn.forIn t.keys init f :=
+  Impl.forIn_eq_forIn_keys
+
+namespace Const
+
+variable {β : Type v} {t : DTreeMap α β cmp}
+
+theorem foldlM_eq_foldlM_toList [Monad m] [LawfulMonad m]
+    {f : δ → α → β → m δ} {init : δ} :
+    t.foldlM f init = (Const.toList t).foldlM (fun a b => f a b.1 b.2) init :=
+  Impl.Const.foldlM_eq_foldlM_toList
+
+theorem foldl_eq_foldl_toList {f : δ → α → β → δ} {init : δ} :
+    t.foldl f init = (Const.toList t).foldl (fun a b => f a b.1 b.2) init :=
+  Impl.Const.foldl_eq_foldl_toList
+
+theorem foldrM_eq_foldrM_toList [Monad m] [LawfulMonad m]
+    {f : α → β → δ → m δ} {init : δ} :
+    t.foldrM f init = (Const.toList t).foldrM (fun a b => f a.1 a.2 b) init :=
+  Impl.Const.foldrM_eq_foldrM_toList
+
+theorem foldr_eq_foldr_toList {f : α → β → δ → δ} {init : δ} :
+    t.foldr f init = (Const.toList t).foldr (fun a b => f a.1 a.2 b) init :=
+  Impl.Const.foldr_eq_foldr_toList
+
+theorem forM_eq_forMUncurried [Monad m] [LawfulMonad m] {f : α → β → m PUnit} :
+    t.forM f = forMUncurried (fun a => f a.1 a.2) t := rfl
+
+theorem forMUncurried_eq_forM_toList [Monad m] [LawfulMonad m] {f : α × β → m PUnit} :
+    forMUncurried f t = (Const.toList t).forM f :=
+  Impl.Const.forM_eq_forM_toList
+
+/--
+Deprecated, use `forMUncurried_eq_forM_toList` together with `forM_eq_forMUncurried` instead.
+-/
+@[deprecated forMUncurried_eq_forM_toList (since := "2025-03-02")]
+theorem forM_eq_forM_toList [Monad m] [LawfulMonad m] {f : α → β → m PUnit} :
+    t.forM f = (Const.toList t).forM (fun a => f a.1 a.2) :=
+  Impl.Const.forM_eq_forM_toList
+
+theorem forIn_eq_forInUncurried [Monad m] [LawfulMonad m]
+    {f : α → β → δ → m (ForInStep δ)} {init : δ} :
+    t.forIn f init = forInUncurried (fun a b => f a.1 a.2 b) init t := rfl
+
+theorem forInUncurried_eq_forIn_toList [Monad m] [LawfulMonad m]
+    {f : α × β → δ → m (ForInStep δ)} {init : δ} :
+    forInUncurried f init t = ForIn.forIn (Const.toList t) init f :=
+  Impl.Const.forIn_eq_forIn_toList
+
+/--
+Deprecated, use `forInUncurried_eq_forIn_toList` together with `forIn_eq_forInUncurried` instead.
+-/
+@[deprecated forInUncurried_eq_forIn_toList (since := "2025-03-02")]
+theorem forIn_eq_forIn_toList [Monad m] [LawfulMonad m]
+    {f : α → β → δ → m (ForInStep δ)} {init : δ} :
+    t.forIn f init = ForIn.forIn (Const.toList t) init (fun a b => f a.1 a.2 b) :=
+  Impl.Const.forIn_eq_forIn_toList
+
+end Const
+
+end monadic
+
 end Std.DTreeMap

src/Std/Data/DTreeMap/Raw/Basic.lean

@@ -584,7 +584,7 @@ def forM (f : (a : α) → β a → m PUnit) (t : Raw α β cmp) : m PUnit :=
 
 @[inline, inherit_doc DTreeMap.forIn]
 def forIn (f : (a : α) → β a → δ → m (ForInStep δ)) (init : δ) (t : Raw α β cmp) : m δ :=
-  t.inner.forIn (fun c a b => f a b c) init
+  t.inner.forIn f init
 
 instance : ForM m (Raw α β cmp) ((a : α) × β a) where
   forM t f := t.forM (fun a b => f ⟨a, b⟩)
@@ -592,6 +592,26 @@ instance : ForM m (Raw α β cmp) ((a : α) × β a) where
 instance : ForIn m (Raw α β cmp) ((a : α) × β a) where
   forIn t init f := t.forIn (fun a b acc => f ⟨a, b⟩ acc) init
 
+namespace Const
+
+variable {β : Type v}
+
+/-!
+We do not define `ForM` and `ForIn` instances that are specialized to constant `β`. Instead, we
+define uncurried versions of `forM` and `forIn` that will be used in the `Const` lemmas and to
+define the `ForM` and `ForIn` instances for `DTreeMap.Raw`.
+-/
+
+@[inline, inherit_doc Raw.forM]
+def forMUncurried (f : α × β → m PUnit) (t : Raw α β cmp) : m PUnit :=
+  t.inner.forM fun a b => f ⟨a, b⟩
+
+@[inline, inherit_doc Raw.forIn]
+def forInUncurried (f : α × β → δ → m (ForInStep δ)) (init : δ) (t : Raw α β cmp) : m δ :=
+  t.inner.forIn (fun a b d => f ⟨a, b⟩ d) init
+
+end Const
+
 @[inline, inherit_doc DTreeMap.any]
 def any (t : Raw α β cmp) (p : (a : α) → β a → Bool) : Bool := Id.run $ do
   for ⟨a, b⟩ in t do

src/Std/Data/DTreeMap/Raw/Lemmas.lean

@@ -20,7 +20,7 @@ set_option autoImplicit false
 
 open Std.DTreeMap.Internal
 
-universe u v
+universe u v w
 
 namespace Std.DTreeMap.Raw
 
@@ -1045,4 +1045,124 @@ theorem distinct_keys_toList [TransCmp cmp] (h : t.WF) :
 
 end Const
 
+section monadic
+
+variable {δ : Type w} {m : Type w → Type w}
+
+theorem foldlM_eq_foldlM_toList [Monad m] [LawfulMonad m] {f : δ → (a : α) → β a → m δ} {init : δ} :
+    t.foldlM f init = t.toList.foldlM (fun a b => f a b.1 b.2) init :=
+  Impl.foldlM_eq_foldlM_toList
+
+theorem foldl_eq_foldl_toList {f : δ → (a : α) → β a → δ} {init : δ} :
+    t.foldl f init = t.toList.foldl (fun a b => f a b.1 b.2) init :=
+  Impl.foldl_eq_foldl_toList
+
+theorem foldrM_eq_foldrM_toList [Monad m] [LawfulMonad m] {f : (a : α) → β a → δ → m δ} {init : δ} :
+    t.foldrM f init = t.toList.foldrM (fun a b => f a.1 a.2 b) init :=
+  Impl.foldrM_eq_foldrM_toList
+
+theorem foldr_eq_foldr_toList {f : (a : α) → β a → δ → δ} {init : δ} :
+    t.foldr f init = t.toList.foldr (fun a b => f a.1 a.2 b) init :=
+  Impl.foldr_eq_foldr_toList
+
+@[simp]
+theorem forM_eq_forM [Monad m] [LawfulMonad m] {f : (a : α) → β a → m PUnit} :
+    t.forM f = ForM.forM t (fun a => f a.1 a.2) := rfl
+
+theorem forM_eq_forM_toList [Monad m] [LawfulMonad m] {f : (a : α) × β a → m PUnit} :
+    ForM.forM t f = ForM.forM t.toList f :=
+  Impl.forM_eq_forM_toList
+
+@[simp]
+theorem forIn_eq_forIn [Monad m] [LawfulMonad m]
+    {f : (a : α) → β a → δ → m (ForInStep δ)} {init : δ} :
+    t.forIn f init = ForIn.forIn t init (fun a b => f a.1 a.2 b) := rfl
+
+theorem forIn_eq_forIn_toList [Monad m] [LawfulMonad m]
+    {f : (a : α) × β a → δ → m (ForInStep δ)} {init : δ} :
+    ForIn.forIn t init f = ForIn.forIn t.toList init f :=
+  Impl.forIn_eq_forIn_toList (f := f)
+
+theorem foldlM_eq_foldlM_keys [Monad m] [LawfulMonad m] {f : δ → α → m δ} {init : δ} :
+    t.foldlM (fun d a _ => f d a) init = t.keys.foldlM f init :=
+  Impl.foldlM_eq_foldlM_keys
+
+theorem foldl_eq_foldl_keys {f : δ → α → δ} {init : δ} :
+    t.foldl (fun d a _ => f d a) init = t.keys.foldl f init :=
+  Impl.foldl_eq_foldl_keys
+
+theorem foldrM_eq_foldrM_keys [Monad m] [LawfulMonad m] {f : α → δ → m δ} {init : δ} :
+    t.foldrM (fun a _ d => f a d) init = t.keys.foldrM f init :=
+  Impl.foldrM_eq_foldrM_keys
+
+theorem foldr_eq_foldr_keys {f : α → δ → δ} {init : δ} :
+    t.foldr (fun a _ d => f a d) init = t.keys.foldr f init :=
+  Impl.foldr_eq_foldr_keys
+
+theorem forM_eq_forM_keys [Monad m] [LawfulMonad m] {f : α → m PUnit} :
+    ForM.forM t (fun a => f a.1) = t.keys.forM f :=
+  Impl.forM_eq_forM_keys
+
+theorem forIn_eq_forIn_keys [Monad m] [LawfulMonad m]
+    {f : α → δ → m (ForInStep δ)} {init : δ} :
+    ForIn.forIn t init (fun a d => f a.1 d) = ForIn.forIn t.keys init f :=
+  Impl.forIn_eq_forIn_keys
+
+namespace Const
+
+variable {β : Type v} {t : Raw α β cmp}
+
+theorem foldlM_eq_foldlM_toList [Monad m] [LawfulMonad m] {f : δ → α → β → m δ} {init : δ} :
+    t.foldlM f init = (Const.toList t).foldlM (fun a b => f a b.1 b.2) init :=
+  Impl.Const.foldlM_eq_foldlM_toList
+
+theorem foldl_eq_foldl_toList {f : δ → α → β → δ} {init : δ} :
+    t.foldl f init = (Const.toList t).foldl (fun a b => f a b.1 b.2) init :=
+  Impl.Const.foldl_eq_foldl_toList
+
+theorem foldrM_eq_foldrM_toList [Monad m] [LawfulMonad m] {f : α → β → δ → m δ} {init : δ} :
+    t.foldrM f init = (Const.toList t).foldrM (fun a b => f a.1 a.2 b) init :=
+  Impl.Const.foldrM_eq_foldrM_toList
+
+theorem foldr_eq_foldr_toList {f : α → β → δ → δ} {init : δ} :
+    t.foldr f init = (Const.toList t).foldr (fun a b => f a.1 a.2 b) init :=
+  Impl.Const.foldr_eq_foldr_toList
+
+theorem forM_eq_forMUncurried [Monad m] [LawfulMonad m] {f : α → β → m PUnit} :
+    t.forM f = forMUncurried (fun a => f a.1 a.2) t := rfl
+
+theorem forMUncurried_eq_forM_toList [Monad m] [LawfulMonad m] {f : α × β → m PUnit} :
+    forMUncurried f t = (Const.toList t).forM f :=
+  Impl.Const.forM_eq_forM_toList
+
+/--
+Deprecated, use `forMUncurried_eq_forM_toList` together with `forM_eq_forMUncurried` instead.
+-/
+@[deprecated forMUncurried_eq_forM_toList (since := "2025-03-02")]
+theorem forM_eq_forM_toList [Monad m] [LawfulMonad m] {f : α → β → m PUnit} :
+    t.forM f = (Const.toList t).forM (fun a => f a.1 a.2) :=
+  Impl.Const.forM_eq_forM_toList
+
+theorem forIn_eq_forInUncurried [Monad m] [LawfulMonad m]
+    {f : α → β → δ → m (ForInStep δ)} {init : δ} :
+    t.forIn f init = forInUncurried (fun a b => f a.1 a.2 b) init t := rfl
+
+theorem forInUncurried_eq_forIn_toList [Monad m] [LawfulMonad m]
+    {f : α × β → δ → m (ForInStep δ)} {init : δ} :
+    forInUncurried f init t = ForIn.forIn (Const.toList t) init f :=
+  Impl.Const.forIn_eq_forIn_toList
+
+/--
+Deprecated, use `forInUncurried_eq_forIn_toList` together with `forIn_eq_forInUncurried` instead.
+-/
+@[deprecated forInUncurried_eq_forIn_toList (since := "2025-03-02")]
+theorem forIn_eq_forIn_toList [Monad m] [LawfulMonad m]
+    {f : α → β → δ → m (ForInStep δ)} {init : δ} :
+    t.forIn f init = ForIn.forIn (Const.toList t) init (fun a b => f a.1 a.2 b) :=
+  Impl.Const.forIn_eq_forIn_toList
+
+end Const
+
+end monadic
+
 end Std.DTreeMap.Raw

src/Std/Data/HashMap/Lemmas.lean

@@ -822,7 +822,7 @@ theorem forM_eq_forM [Monad m'] [LawfulMonad m'] {f : (a : α) → β → m' PUn
 
 theorem forM_eq_forM_toList [Monad m'] [LawfulMonad m'] {f : α × β → m' PUnit} :
     ForM.forM m f = ForM.forM m.toList f :=
-  DHashMap.Const.forM_eq_forM_toList
+  DHashMap.Const.forMUncurried_eq_forM_toList
 
 @[simp]
 theorem forIn_eq_forIn [Monad m'] [LawfulMonad m']
@@ -832,27 +832,25 @@ theorem forIn_eq_forIn [Monad m'] [LawfulMonad m']
 theorem forIn_eq_forIn_toList [Monad m'] [LawfulMonad m']
     {f : α × β → δ → m' (ForInStep δ)} {init : δ} :
     ForIn.forIn m init f = ForIn.forIn m.toList init f :=
-  DHashMap.Const.forIn_eq_forIn_toList
-
-variable {m : DHashMap α (fun _ => Unit)}
+  DHashMap.Const.forInUncurried_eq_forIn_toList
 
 theorem foldM_eq_foldlM_keys [Monad m'] [LawfulMonad m']
     {f : δ → α → m' δ} {init : δ} :
     m.foldM (fun d a _ => f d a) init = m.keys.foldlM f init :=
-  DHashMap.Const.foldM_eq_foldlM_keys
+  DHashMap.foldM_eq_foldlM_keys
 
 theorem fold_eq_foldl_keys {f : δ → α → δ} {init : δ} :
     m.fold (fun d a _ => f d a) init = m.keys.foldl f init :=
-  DHashMap.Const.fold_eq_foldl_keys
+  DHashMap.fold_eq_foldl_keys
 
 theorem forM_eq_forM_keys [Monad m'] [LawfulMonad m'] {f : α → m' PUnit} :
-    m.forM (fun a _ => f a) = m.keys.forM f :=
-  DHashMap.Const.forM_eq_forM_keys
+    ForM.forM m (fun a => f a.1) = m.keys.forM f :=
+  DHashMap.forM_eq_forM_keys
 
 theorem forIn_eq_forIn_keys [Monad m'] [LawfulMonad m']
     {f : α → δ → m' (ForInStep δ)} {init : δ} :
-    m.forIn (fun a _ d => f a d) init = ForIn.forIn m.keys init f :=
-  DHashMap.Const.forIn_eq_forIn_keys
+    ForIn.forIn m init (fun a d => f a.1 d) = ForIn.forIn m.keys init f :=
+  DHashMap.forIn_eq_forIn_keys
 
 end monadic
 

src/Std/Data/HashMap/RawLemmas.lean

@@ -835,7 +835,7 @@ theorem forM_eq_forM [Monad m'] [LawfulMonad m'] {f : (a : α) → β → m' PUn
 
 theorem forM_eq_forM_toList [Monad m'] [LawfulMonad m'] (h : m.WF) {f : α × β → m' PUnit} :
     ForM.forM m f = ForM.forM m.toList f :=
-  DHashMap.Raw.Const.forM_eq_forM_toList h.out
+  DHashMap.Raw.Const.forMUncurried_eq_forM_toList h.out
 
 omit [BEq α] [Hashable α] in
 @[simp]
@@ -846,27 +846,25 @@ theorem forIn_eq_forIn [Monad m'] [LawfulMonad m']
 theorem forIn_eq_forIn_toList [Monad m'] [LawfulMonad m'] (h : m.WF)
     {f : α × β → δ → m' (ForInStep δ)} {init : δ} :
     ForIn.forIn m init f = ForIn.forIn m.toList init f :=
-  DHashMap.Raw.Const.forIn_eq_forIn_toList h.out
-
-variable {m : Raw α Unit}
+  DHashMap.Raw.Const.forInUncurried_eq_forIn_toList h.out
 
 theorem foldM_eq_foldlM_keys [Monad m'] [LawfulMonad m'] (h : m.WF)
     {f : δ → α → m' δ} {init : δ} :
     m.foldM (fun d a _ => f d a) init = m.keys.foldlM f init :=
-  DHashMap.Raw.Const.foldM_eq_foldlM_keys h.out
+  DHashMap.Raw.foldM_eq_foldlM_keys h.out
 
 theorem fold_eq_foldl_keys (h : m.WF) {f : δ → α → δ} {init : δ} :
     m.fold (fun d a _ => f d a) init = m.keys.foldl f init :=
-  DHashMap.Raw.Const.fold_eq_foldl_keys h.out
+  DHashMap.Raw.fold_eq_foldl_keys h.out
 
 theorem forM_eq_forM_keys [Monad m'] [LawfulMonad m'] (h : m.WF) {f : α → m' PUnit} :
-    m.forM (fun a _ => f a) = m.keys.forM f :=
-  DHashMap.Raw.Const.forM_eq_forM_keys h.out
+    ForM.forM m (fun a => f a.1) = m.keys.forM f :=
+  DHashMap.Raw.forM_eq_forM_keys h.out
 
 theorem forIn_eq_forIn_keys [Monad m'] [LawfulMonad m'] (h : m.WF)
     {f : α → δ → m' (ForInStep δ)} {init : δ} :
-    m.forIn (fun a _ d => f a d) init = ForIn.forIn m.keys init f :=
-  DHashMap.Raw.Const.forIn_eq_forIn_keys h.out
+    ForIn.forIn m init (fun a d => f a.1 d) = ForIn.forIn m.keys init f :=
+  DHashMap.Raw.forIn_eq_forIn_keys h.out
 
 end monadic
 

src/Std/Data/HashSet/Lemmas.lean

@@ -442,7 +442,7 @@ theorem forM_eq_forM_toList [Monad m'] [LawfulMonad m'] {f : α → m' PUnit} :
 @[simp]
 theorem forIn_eq_forIn [Monad m'] [LawfulMonad m']
     {f : α → δ → m' (ForInStep δ)} {init : δ} :
-    m.forIn f init = ForIn.forIn m init f := rfl
+    ForIn.forIn m init f = ForIn.forIn m init f := rfl
 
 theorem forIn_eq_forIn_toList [Monad m'] [LawfulMonad m']
     {f : α → δ → m' (ForInStep δ)} {init : δ} :

src/Std/Data/Internal/List/Associative.lean

@@ -2156,6 +2156,14 @@ theorem foldl_eq_foldl_toProd {β : Type v} {δ : Type w}
   | cons hd tl ih => simp [ih]
 
 theorem foldrM_eq_foldrM_toProd {β : Type v} {δ : Type w} {m' : Type w → Type w} [Monad m']
+    [LawfulMonad m'] {l : List ((_ : α) × β)} {f : (a : α) → β → δ → m' δ} {init : δ} :
+    l.foldrM (fun a b => f a.1 a.2 b) init =
+      (l.map fun x => (x.1, x.2)).foldrM (fun a b => f a.1 a.2 b) init := by
+  induction l generalizing init with
+  | nil => simp
+  | cons hd tl ih => simp [ih]
+
+theorem foldrM_eq_foldrM_toProd' {β : Type v} {δ : Type w} {m' : Type w → Type w} [Monad m']
     [LawfulMonad m'] {l : List ((_ : α) × β)} {f : δ → (a : α) → β → m' δ} {init : δ} :
     l.foldrM (fun a b => f b a.1 a.2) init =
       (l.map fun x => (x.1, x.2)).foldrM (fun a b => f b a.1 a.2) init := by
@@ -2164,6 +2172,14 @@ theorem foldrM_eq_foldrM_toProd {β : Type v} {δ : Type w} {m' : Type w → Typ
   | cons hd tl ih => simp [ih]
 
 theorem foldr_eq_foldr_toProd {β : Type v} {δ : Type w}
+    {l : List ((_ : α) × β)} {f : (a : α) → β → δ → δ} {init : δ} :
+    l.foldr (fun a b => f a.1 a.2 b) init =
+      (l.map fun x => (x.1, x.2)).foldr (fun a b => f a.1 a.2 b) init := by
+  induction l generalizing init with
+  | nil => simp
+  | cons hd tl ih => simp [ih]
+
+theorem foldr_eq_foldr_toProd' {β : Type v} {δ : Type w}
     {l : List ((_ : α) × β)} {f : δ → (a : α) → β → δ} {init : δ} :
     l.foldr (fun a b => f b a.1 a.2) init =
       (l.map fun x => (x.1, x.2)).foldr (fun a b => f b a.1 a.2) init := by
@@ -2187,7 +2203,7 @@ theorem forIn_eq_forIn_toProd {β : Type v} {δ : Type w} {m' : Type w → Type
   | cons hd tl => simp
 
 theorem foldlM_eq_foldlM_keys {δ : Type w} {m' : Type w → Type w} [Monad m'] [LawfulMonad m']
-    {l : List ((_ : α) × Unit)} {f : δ → α → m' δ} {init : δ} :
+    {l : List ((a : α) × β a)} {f : δ → α → m' δ} {init : δ} :
     l.foldlM (fun a b => f a b.1) init = (keys l).foldlM f init := by
   induction l generalizing init with
   | nil => simp
@@ -2197,14 +2213,22 @@ theorem foldlM_eq_foldlM_keys {δ : Type w} {m' : Type w → Type w} [Monad m']
     simp [ih]
 
 theorem foldl_eq_foldl_keys {δ : Type w}
-    {l : List ((_ : α) × Unit)} {f : δ → α → δ} {init : δ} :
+    {l : List ((a : α) × β a)} {f : δ → α → δ} {init : δ} :
     l.foldl (fun a b => f a b.1) init = (keys l).foldl f init := by
   induction l generalizing init with
   | nil => simp
   | cons hd tl ih => simp [List.foldlM_cons, keys, ih]
 
 theorem foldrM_eq_foldrM_keys {δ : Type w} {m' : Type w → Type w} [Monad m'] [LawfulMonad m']
-    {l : List ((_ : α) × Unit)} {f : δ → α → m' δ} {init : δ} :
+    {l : List ((a : α) × β a)} {f : α → δ → m' δ} {init : δ} :
+    l.foldrM (fun a b => f a.1 b) init = (keys l).foldrM f init := by
+  induction l generalizing init with
+  | nil => simp
+  | cons hd tl ih =>
+    simp [keys, ih]
+
+theorem foldrM_eq_foldrM_keys' {δ : Type w} {m' : Type w → Type w} [Monad m'] [LawfulMonad m']
+    {l : List ((a : α) × β a)} {f : δ → α → m' δ} {init : δ} :
     l.foldrM (fun a b => f b a.1) init = (keys l).foldrM (fun a b => f b a) init := by
   induction l generalizing init with
   | nil => simp
@@ -2212,14 +2236,21 @@ theorem foldrM_eq_foldrM_keys {δ : Type w} {m' : Type w → Type w} [Monad m']
     simp [keys, ih]
 
 theorem foldr_eq_foldr_keys {δ : Type w}
-    {l : List ((_ : α) × Unit)} {f : δ → α → δ} {init : δ} :
+    {l : List ((a : α) × β a)} {f : α → δ → δ} {init : δ} :
+    l.foldr (fun a b => f a.1 b) init = (keys l).foldr f init := by
+  induction l generalizing init with
+  | nil => simp
+  | cons hd tl ih => simp [keys, ih]
+
+theorem foldr_eq_foldr_keys' {δ : Type w}
+    {l : List ((a : α) × β a)} {f : δ → α → δ} {init : δ} :
     l.foldr (fun a b => f b a.1) init = (keys l).foldr (fun a b => f b a) init := by
   induction l generalizing init with
   | nil => simp
   | cons hd tl ih => simp [keys, ih]
 
 theorem forM_eq_forM_keys {m' : Type w → Type w} [Monad m'] [LawfulMonad m']
-    {l : List ((_ : α) × Unit)} {f : α → m' PUnit} :
+    {l : List ((a : α) × β a)} {f : α → m' PUnit} :
     l.forM (fun a => f a.1) = (keys l).forM f := by
   induction l with
   | nil => simp
@@ -2230,7 +2261,7 @@ theorem forM_eq_forM_keys {m' : Type w → Type w} [Monad m'] [LawfulMonad m']
     apply ih
 
 theorem forIn_eq_forIn_keys {δ : Type w} {m' : Type w → Type w} [Monad m'] [LawfulMonad m']
-    {f : α → δ → m' (ForInStep δ)} {init : δ} {l : List ((_ : α) × Unit)} :
+    {f : α → δ → m' (ForInStep δ)} {init : δ} {l : List ((a : α) × β a)} :
     ForIn.forIn l init (fun a d => f a.fst d) = ForIn.forIn (keys l) init f := by
   induction l generalizing init with
   | nil => simp

src/Std/Data/TreeMap/Lemmas.lean

@@ -17,7 +17,7 @@ This file contains lemmas about `Std.Data.TreeMap`. Most of the lemmas require
 set_option linter.missingDocs true
 set_option autoImplicit false
 
-universe u v
+universe u v w
 
 namespace Std.TreeMap
 
@@ -727,4 +727,68 @@ theorem distinct_keys_toList [TransCmp cmp] :
     (toList t).Pairwise (fun a b => ¬ cmp a.1 b.1 = .eq) :=
   DTreeMap.Const.distinct_keys_toList
 
+section monadic
+
+variable {δ : Type w} {m : Type w → Type w}
+
+theorem foldlM_eq_foldlM_toList [Monad m] [LawfulMonad m] {f : δ → α → β → m δ} {init : δ} :
+    t.foldlM f init = t.toList.foldlM (fun a b => f a b.1 b.2) init :=
+  DTreeMap.Const.foldlM_eq_foldlM_toList
+
+theorem foldl_eq_foldl_toList {f : δ → α → β → δ} {init : δ} :
+    t.foldl f init = t.toList.foldl (fun a b => f a b.1 b.2) init :=
+  DTreeMap.Const.foldl_eq_foldl_toList
+
+theorem foldrM_eq_foldrM_toList [Monad m] [LawfulMonad m] {f : α → β → δ → m δ} {init : δ} :
+    t.foldrM f init = t.toList.foldrM (fun a b => f a.1 a.2 b) init :=
+  DTreeMap.Const.foldrM_eq_foldrM_toList
+
+theorem foldr_eq_foldr_toList {f : α → β → δ → δ} {init : δ} :
+    t.foldr f init = t.toList.foldr (fun a b => f a.1 a.2 b) init :=
+  DTreeMap.Const.foldr_eq_foldr_toList
+
+@[simp]
+theorem forM_eq_forM [Monad m] [LawfulMonad m] {f : α → β → m PUnit} :
+    t.forM f = ForM.forM t (fun a => f a.1 a.2) := rfl
+
+theorem forM_eq_forM_toList [Monad m] [LawfulMonad m] {f : α × β → m PUnit} :
+    ForM.forM t f = ForM.forM t.toList f :=
+  DTreeMap.Const.forMUncurried_eq_forM_toList (f := f)
+
+@[simp]
+theorem forIn_eq_forIn [Monad m] [LawfulMonad m]
+    {f : α → β → δ → m (ForInStep δ)} {init : δ} :
+    t.forIn f init = ForIn.forIn t init (fun a d => f a.1 a.2 d) := rfl
+
+theorem forIn_eq_forIn_toList [Monad m] [LawfulMonad m]
+    {f : α × β → δ → m (ForInStep δ)} {init : δ} :
+    ForIn.forIn t init f = ForIn.forIn t.toList init f :=
+  DTreeMap.Const.forInUncurried_eq_forIn_toList
+
+theorem foldlM_eq_foldlM_keys [Monad m] [LawfulMonad m] {f : δ → α → m δ} {init : δ} :
+    t.foldlM (fun d a _ => f d a) init = t.keys.foldlM f init :=
+  DTreeMap.foldlM_eq_foldlM_keys
+
+theorem foldl_eq_foldl_keys {f : δ → α → δ} {init : δ} :
+    t.foldl (fun d a _ => f d a) init = t.keys.foldl f init :=
+  DTreeMap.foldl_eq_foldl_keys
+
+theorem foldrM_eq_foldrM_keys [Monad m] [LawfulMonad m] {f : α → δ → m δ} {init : δ} :
+    t.foldrM (fun a _ d => f a d) init = t.keys.foldrM f init :=
+  DTreeMap.foldrM_eq_foldrM_keys
+
+theorem foldr_eq_foldr_keys {f : α → δ → δ} {init : δ} :
+    t.foldr (fun a _ d => f a d) init = t.keys.foldr f init :=
+  DTreeMap.foldr_eq_foldr_keys
+
+theorem forM_eq_forM_keys [Monad m] [LawfulMonad m] {f : α → m PUnit} :
+    ForM.forM t (fun a => f a.1) = t.keys.forM f :=
+  DTreeMap.forM_eq_forM_keys
+
+theorem forIn_eq_forIn_keys [Monad m] [LawfulMonad m] {f : α → δ → m (ForInStep δ)} {init : δ} :
+    ForIn.forIn t init (fun a d => f a.1 d) = ForIn.forIn t.keys init f :=
+  DTreeMap.forIn_eq_forIn_keys
+
+end monadic
+
 end Std.TreeMap

src/Std/Data/TreeMap/Raw/Lemmas.lean

@@ -18,7 +18,7 @@ These proofs can be obtained from `Std.Data.TreeMap.Raw.WF`.
 set_option linter.missingDocs true
 set_option autoImplicit false
 
-universe u v
+universe u v w
 
 namespace Std.TreeMap.Raw
 
@@ -735,4 +735,68 @@ theorem distinct_keys_toList [TransCmp cmp] (h : t.WF) :
     (toList t).Pairwise (fun a b => ¬ cmp a.1 b.1 = .eq) :=
   DTreeMap.Raw.Const.distinct_keys_toList h
 
+section monadic
+
+variable {δ : Type w} {m : Type w → Type w}
+
+theorem foldlM_eq_foldlM_toList [Monad m] [LawfulMonad m] {f : δ → α → β → m δ} {init : δ} :
+    t.foldlM f init = t.toList.foldlM (fun a b => f a b.1 b.2) init :=
+  DTreeMap.Raw.Const.foldlM_eq_foldlM_toList
+
+theorem foldl_eq_foldl_toList {f : δ → α → β → δ} {init : δ} :
+    t.foldl f init = t.toList.foldl (fun a b => f a b.1 b.2) init :=
+  DTreeMap.Raw.Const.foldl_eq_foldl_toList
+
+theorem foldrM_eq_foldrM_toList [Monad m] [LawfulMonad m] {f : α → β → δ → m δ} {init : δ} :
+    t.foldrM f init = t.toList.foldrM (fun a b => f a.1 a.2 b) init :=
+  DTreeMap.Raw.Const.foldrM_eq_foldrM_toList
+
+theorem foldr_eq_foldr_toList {f : α → β → δ → δ} {init : δ} :
+    t.foldr f init = t.toList.foldr (fun a b => f a.1 a.2 b) init :=
+  DTreeMap.Raw.Const.foldr_eq_foldr_toList
+
+@[simp]
+theorem forM_eq_forM [Monad m] [LawfulMonad m] {f : α → β → m PUnit} :
+    t.forM f = ForM.forM t (fun a => f a.1 a.2) := rfl
+
+theorem forM_eq_forM_toList [Monad m] [LawfulMonad m] {f : α × β → m PUnit} :
+    ForM.forM t f = t.toList.forM f :=
+  DTreeMap.Raw.Const.forMUncurried_eq_forM_toList (f := f)
+
+@[simp]
+theorem forIn_eq_forIn [Monad m] [LawfulMonad m] {f : α → β → δ → m (ForInStep δ)} {init : δ} :
+    t.forIn f init = ForIn.forIn t init (fun a d => f a.1 a.2 d) := rfl
+
+theorem forIn_eq_forIn_toList [Monad m] [LawfulMonad m]
+    {f : α × β → δ → m (ForInStep δ)} {init : δ} :
+    ForIn.forIn t init f = ForIn.forIn t.toList init f :=
+  DTreeMap.Raw.Const.forInUncurried_eq_forIn_toList
+
+theorem foldlM_eq_foldlM_keys [Monad m] [LawfulMonad m] {f : δ → α → m δ} {init : δ} :
+    t.foldlM (fun d a _ => f d a) init = t.keys.foldlM f init :=
+  DTreeMap.Raw.foldlM_eq_foldlM_keys
+
+theorem foldl_eq_foldl_keys {f : δ → α → δ} {init : δ} :
+    t.foldl (fun d a _ => f d a) init = t.keys.foldl f init :=
+  DTreeMap.Raw.foldl_eq_foldl_keys
+
+theorem foldrM_eq_foldrM_keys [Monad m] [LawfulMonad m] {f : α → δ → m δ} {init : δ} :
+    t.foldrM (fun a _ d => f a d) init = t.keys.foldrM f init :=
+  DTreeMap.Raw.foldrM_eq_foldrM_keys
+
+theorem foldr_eq_foldr_keys {f : α → δ → δ} {init : δ} :
+    t.foldr (fun a _ d => f a d) init = t.keys.foldr f init :=
+  DTreeMap.Raw.foldr_eq_foldr_keys
+
+theorem forM_eq_forM_keys [Monad m] [LawfulMonad m] {f : α → m PUnit} :
+    ForM.forM t (fun a => f a.1) = t.keys.forM f :=
+  DTreeMap.Raw.forM_eq_forM_keys
+
+theorem forIn_eq_forIn_keys [Monad m] [LawfulMonad m]
+    {f : α → δ → m (ForInStep δ)} {init : δ} :
+    ForIn.forIn t init (fun a d => f a.1 d) = ForIn.forIn t.keys init f :=
+  DTreeMap.Raw.forIn_eq_forIn_keys
+
+end monadic
+
 end Std.TreeMap.Raw

src/Std/Data/TreeSet/Lemmas.lean

@@ -17,7 +17,7 @@ This file contains lemmas about `Std.Data.TreeSet`. Most of the lemmas require
 set_option linter.missingDocs true
 set_option autoImplicit false
 
-universe u v
+universe u v w
 
 namespace Std.TreeSet
 
@@ -358,4 +358,42 @@ theorem distinct_toList [TransCmp cmp] :
     t.toList.Pairwise (fun a b => ¬ cmp a b = .eq) :=
   DTreeMap.distinct_keys
 
+section monadic
+
+variable {δ : Type w} {m : Type w → Type w}
+
+theorem foldlM_eq_foldlM_toList [Monad m] [LawfulMonad m] {f : δ → α → m δ} {init : δ} :
+    t.foldlM f init = t.toList.foldlM f init :=
+  TreeMap.foldlM_eq_foldlM_keys
+
+theorem foldl_eq_foldl_toList {f : δ → α → δ} {init : δ} :
+    t.foldl f init = t.toList.foldl f init :=
+  TreeMap.foldl_eq_foldl_keys
+
+theorem foldrM_eq_foldrM_toList [Monad m] [LawfulMonad m] {f : α → δ → m δ} {init : δ} :
+    t.foldrM f init = t.toList.foldrM f init :=
+  TreeMap.foldrM_eq_foldrM_keys
+
+theorem foldr_eq_foldr_toList {f : α → δ → δ} {init : δ} :
+    t.foldr f init = t.toList.foldr f init :=
+  TreeMap.foldr_eq_foldr_keys
+
+@[simp]
+theorem forM_eq_forM [Monad m] [LawfulMonad m] {f : α → m PUnit} :
+    t.forM f = ForM.forM t f := rfl
+
+theorem forM_eq_forM_toList [Monad m] [LawfulMonad m] {f : α → m PUnit} :
+    ForM.forM t f = t.toList.forM f :=
+  TreeMap.forM_eq_forM_keys
+
+@[simp]
+theorem forIn_eq_forIn [Monad m] [LawfulMonad m] {f : α → δ → m (ForInStep δ)} {init : δ} :
+    t.forIn f init = ForIn.forIn t init f := rfl
+
+theorem forIn_eq_forIn_toList [Monad m] [LawfulMonad m] {f : α → δ → m (ForInStep δ)} {init : δ} :
+    ForIn.forIn t init f = ForIn.forIn t.toList init f :=
+  TreeMap.forIn_eq_forIn_keys
+
+end monadic
+
 end Std.TreeSet

src/Std/Data/TreeSet/Raw/Lemmas.lean

@@ -18,7 +18,7 @@ These proofs can be obtained from `Std.Data.TreeSet.Raw.WF`.
 set_option linter.missingDocs true
 set_option autoImplicit false
 
-universe u v
+universe u v w
 
 namespace Std.TreeSet.Raw
 
@@ -359,4 +359,37 @@ theorem distinct_toList [TransCmp cmp] (h : t.WF) :
     t.toList.Pairwise (fun a b => ¬ cmp a b = .eq) :=
   DTreeMap.Raw.distinct_keys h
 
+section monadic
+
+variable {δ : Type w} {m : Type w → Type w}
+
+theorem foldlM_eq_foldlM_toList [Monad m] [LawfulMonad m]
+    {f : δ → α → m δ} {init : δ} :
+    t.foldlM f init = t.toList.foldlM f init :=
+  TreeMap.Raw.foldlM_eq_foldlM_keys
+
+theorem foldl_eq_foldl_toList {f : δ → α → δ} {init : δ} :
+    t.foldl f init = t.toList.foldl f init :=
+  TreeMap.Raw.foldl_eq_foldl_keys
+
+theorem foldrM_eq_foldrM_toList [Monad m] [LawfulMonad m]
+    {f : α → δ → m δ} {init : δ} :
+    t.foldrM f init = t.toList.foldrM f init :=
+  TreeMap.Raw.foldrM_eq_foldrM_keys
+
+theorem foldr_eq_foldr_toList {f : α → δ → δ} {init : δ} :
+    t.foldr f init = t.toList.foldr f init :=
+  TreeMap.Raw.foldr_eq_foldr_keys
+
+theorem forM_eq_forM_toList [Monad m] [LawfulMonad m] {f : α → m PUnit} :
+    ForM.forM t f = t.toList.forM f :=
+  TreeMap.Raw.forM_eq_forM_keys
+
+theorem forIn_eq_forIn_toList [Monad m] [LawfulMonad m]
+    {f : α → δ → m (ForInStep δ)} {init : δ} :
+    ForIn.forIn t init f = ForIn.forIn t.toList init f :=
+  TreeMap.Raw.forIn_eq_forIn_keys
+
+end monadic
+
 end Std.TreeSet.Raw

src/Std/Tactic/BVDecide/Syntax.lean

@@ -21,7 +21,6 @@ structure BVDecideConfig where
   trimProofs : Bool := true
   /--
   Whether to use the binary LRAT proof format.
-  Currently set to false and ignored on Windows due to a bug in CaDiCal.
   -/
   binaryProofs : Bool := true
   /--

src/kernel/type_checker.cpp

@@ -618,7 +618,6 @@ template<typename F> optional<expr> type_checker::reduce_bin_nat_pred(F const &
 }
 
 optional<expr> type_checker::reduce_nat(expr const & e) {
-    if (has_fvar(e)) return none_expr();
     unsigned nargs = get_app_num_args(e);
     if (nargs == 1) {
         expr const & f = app_fn(e);

src/lean.mk.in

@@ -163,5 +163,7 @@ clean:
 .PRECIOUS: $(BC_OUT)/%.bc $(C_OUT)/%.c $(TEMP_OUT)/%.o $(TEMP_OUT)/%.o.export
 
 ifndef C_ONLY
+ifndef UNSAFE_ASSUME_OLD
 include $(DEPS)
 endif
+endif

stage0/src/stdlib_flags.h

@@ -1,7 +1,5 @@
 #include "util/options.h"
 
-// please update stage0
-
 namespace lean {
 options get_default_options() {
     options opts;