chore: better hypothesis for Vector.getElem_take

This PR adds the BV_CONCAT_CONST, BV_CONCAT_EXTRACT and ELIM_ZERO_EXTEND
rule from Bitwuzla to bv_decide.

.github/workflows/awaiting-mathlib.yml

@@ -0,0 +1,20 @@
+name: Check awaiting-mathlib label
+
+on:
+  merge_group:
+  pull_request:
+    types: [opened, labeled]
+
+jobs:
+  check-awaiting-mathlib:
+    runs-on: ubuntu-latest
+    steps:
+      - name: Check awaiting-mathlib label
+        if: github.event_name == 'pull_request'
+        uses: actions/github-script@v7
+        with:
+          script: |
+            const { labels } = context.payload.pull_request;
+            if (labels.some(label => label.name == "awaiting-mathlib") && !labels.some(label => label.name == "builds-mathlib")) {
+              core.setFailed('PR is marked "awaiting-mathlib" but "builds-mathlib" label has not been applied yet by the bot');
+            }

.github/workflows/ci.yml

@@ -204,7 +204,8 @@ jobs:
                 "os": "macos-14",
                 "CMAKE_OPTIONS": "-DLEAN_INSTALL_SUFFIX=-darwin_aarch64",
                 "release": true,
-                "check-level": 0,
+                // special cased below
+                // "check-level": 0,
                 "shell": "bash -euxo pipefail {0}",
                 "llvm-url": "https://github.com/leanprover/lean-llvm/releases/download/15.0.1/lean-llvm-aarch64-apple-darwin.tar.zst",
                 "prepare-llvm": "../script/prepare-llvm-macos.sh lean-llvm*",
@@ -260,8 +261,21 @@ jobs:
               //   "CTEST_OPTIONS": "-R \"leantest_1007\\.lean|leantest_Format\\.lean|leanruntest\\_1037.lean|leanruntest_ac_rfl\\.lean|leanruntest_tempfile.lean\\.|leanruntest_libuv\\.lean\""
               // }
             ];
-            console.log(`matrix:\n${JSON.stringify(matrix, null, 2)}`)
-            return matrix.filter((job) => level >= job["check-level"])
+            console.log(`matrix:\n${JSON.stringify(matrix, null, 2)}`);
+            const isPr = "${{ github.event_name }}" == "pull_request";
+            const filter = (job) => {
+              if (job["name"] === "macOS aarch64") {
+                // Special handling for MacOS aarch64, we want:
+                // 1. To run it in PRs so Mac devs get PR toolchains
+                // 2. To skip it in merge queues as it takes longer than the Linux build and adds
+                //    little value in the merge queue
+                // 3. To run it in release (obviously)
+                return isPr || level >= 2;
+              } else {
+                return level >= job["check-level"];
+              }
+            };
+            return matrix.filter(filter);
 
   build:
     needs: [configure]

.github/workflows/pr-release.yml

@@ -34,7 +34,7 @@ jobs:
       - name: Download artifact from the previous workflow.
         if: ${{ steps.workflow-info.outputs.pullRequestNumber != '' }}
         id: download-artifact
-        uses: dawidd6/action-download-artifact@v8 # https://github.com/marketplace/actions/download-workflow-artifact
+        uses: dawidd6/action-download-artifact@v9 # https://github.com/marketplace/actions/download-workflow-artifact
         with:
           run_id: ${{ github.event.workflow_run.id }}
           path: artifacts
@@ -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:

script/release_notes.py

@@ -65,20 +65,21 @@ def format_markdown_description(pr_number, description):
     link = f"[#{pr_number}](https://github.com/leanprover/lean4/pull/{pr_number})"
     return f"{link} {description}"
 
+def commit_types():
+    # see doc/dev/commit_convention.md
+    return ['feat', 'fix', 'doc', 'style', 'refactor', 'test', 'chore', 'perf']
+
 def count_commit_types(commits):
     counts = {
         'total': len(commits),
-        'feat': 0,
-        'fix': 0,
-        'refactor': 0,
-        'doc': 0,
-        'chore': 0
     }
+    for commit_type in commit_types():
+        counts[commit_type] = 0
     
     for _, first_line, _ in commits:
-        for commit_type in ['feat:', 'fix:', 'refactor:', 'doc:', 'chore:']:
-            if first_line.startswith(commit_type):
-                counts[commit_type.rstrip(':')] += 1
+        for commit_type in commit_types():
+            if first_line.startswith(f'{commit_type}:'):
+                counts[commit_type] += 1
                 break
     
     return counts
@@ -158,8 +159,9 @@ def main():
     counts = count_commit_types(commits)
     print(f"For this release, {counts['total']} changes landed. "
           f"In addition to the {counts['feat']} feature additions and {counts['fix']} fixes listed below "
-          f"there were {counts['refactor']} refactoring changes, {counts['doc']} documentation improvements "
-          f"and {counts['chore']} chores.\n")
+          f"there were {counts['refactor']} refactoring changes, {counts['doc']} documentation improvements, "
+          f"{counts['perf']} performance improvements, {counts['test']} improvements to the test suite "
+          f"and {counts['style'] + counts['chore']} other changes.\n")
 
     section_order = sort_sections_order()
     sorted_changelog = sorted(changelog.items(), key=lambda item: section_order.index(format_section_title(item[0])) if format_section_title(item[0]) in section_order else len(section_order))

src/CMakeLists.txt

@@ -10,7 +10,7 @@ endif()
 include(ExternalProject)
 project(LEAN CXX C)
 set(LEAN_VERSION_MAJOR 4)
-set(LEAN_VERSION_MINOR 18)
+set(LEAN_VERSION_MINOR 19)
 set(LEAN_VERSION_PATCH 0)
 set(LEAN_VERSION_IS_RELEASE 0)  # This number is 1 in the release revision, and 0 otherwise.
 set(LEAN_SPECIAL_VERSION_DESC "" CACHE STRING "Additional version description like 'nightly-2018-03-11'")

src/Init/Control/Id.lean

@@ -10,6 +10,28 @@ import Init.Core
 
 universe u
 
+/--
+The identity function on types, used primarily for its `Monad` instance.
+
+The identity monad is useful together with monad transformers to construct monads for particular
+purposes. Additionally, it can be used with `do`-notation in order to use control structures such as
+local mutability, `for`-loops, and early returns in code that does not otherwise use monads.
+
+Examples:
+```lean example
+def containsFive (xs : List Nat) : Bool := Id.run do
+  for x in xs do
+    if x == 5 then return true
+  return false
+```
+
+```lean example
+#eval containsFive [1, 3, 5, 7]
+```
+```output
+true
+```
+-/
 def Id (type : Type u) : Type u := type
 
 namespace Id
@@ -20,9 +42,18 @@ instance : Monad Id where
   bind x f := f x
   map f x := f x
 
+/--
+The identity monad has a `bind` operator.
+-/
 def hasBind : Bind Id :=
   inferInstance
 
+/--
+Runs a computation in the identity monad.
+
+This function is the identity function. Because its parameter has type `Id α`, it causes
+`do`-notation in its arguments to use the `Monad Id` instance.
+-/
 @[always_inline, inline]
 protected def run (x : Id α) : α := x
 

src/Init/Core.lean

@@ -226,9 +226,9 @@ structure PSigma {α : Sort u} (β : α → Sort v) where
   (This will usually require a type ascription to determine `β`
   since it is not determined from `a` and `b` alone.) -/
   mk ::
-  /-- The first component of a dependent pair. If `p : @Sigma α β` then `p.1 : α`. -/
+  /-- The first component of a dependent pair. If `p : @PSigma α β` then `p.1 : α`. -/
   fst : α
-  /-- The second component of a dependent pair. If `p : Sigma β` then `p.2 : β p.1`. -/
+  /-- The second component of a dependent pair. If `p : PSigma β` then `p.2 : β p.1`. -/
   snd : β fst
 
 /--
@@ -1925,10 +1925,6 @@ protected abbrev recOnSubsingleton₂
 end
 end Quotient
 
-section
-variable {α : Type u}
-variable (r : α → α → Prop)
-
 instance Quotient.decidableEq {α : Sort u} {s : Setoid α} [d : ∀ (a b : α), Decidable (a ≈ b)]
     : DecidableEq (Quotient s) :=
   fun (q₁ q₂ : Quotient s) =>

src/Init/Data/Array/Lemmas.lean

@@ -2984,6 +2984,14 @@ theorem foldlM_push [Monad m] [LawfulMonad m] (xs : Array α) (a : α) (f : β
     (xs.push a).foldlM f b = xs.foldlM f b >>= fun b => f b a := by
   simp
 
+@[simp] theorem foldlM_pure [Monad m] [LawfulMonad m] (f : β → α → β) (b) (xs : Array α) :
+    xs.foldlM (m := m) (pure <| f · ·) b start stop = pure (xs.foldl f b start stop) := by
+  rw [foldl, foldlM_start_stop, ← foldlM_toList, List.foldlM_pure, foldl_toList, foldl, ← foldlM_start_stop]
+
+@[simp] theorem foldrM_pure [Monad m] [LawfulMonad m] (f : α → β → β) (b) (xs : Array α) :
+    xs.foldrM (m := m) (pure <| f · ·) b start stop = pure (xs.foldr f b start stop) := by
+  rw [foldr, foldrM_start_stop, ← foldrM_toList, List.foldrM_pure, foldr_toList, foldr, ← foldrM_start_stop]
+
 theorem foldl_eq_foldlM (f : β → α → β) (b) (xs : Array α) :
     xs.foldl f b start stop = xs.foldlM (m := Id) f b start stop := by
   simp [foldl, Id.run]

src/Init/Data/Array/Monadic.lean

@@ -23,9 +23,13 @@ open Nat
 
 /-! ### mapM -/
 
-@[simp] theorem mapM_id {xs : Array α} {f : α → Id β} : xs.mapM f = xs.map f := by
+@[simp] theorem mapM_pure [Monad m] [LawfulMonad m] (xs : Array α) (f : α → β) :
+    xs.mapM (m := m) (pure <| f ·) = pure (xs.map f) := by
   induction xs; simp_all
 
+@[simp] theorem mapM_id {xs : Array α} {f : α → Id β} : xs.mapM f = xs.map f :=
+  mapM_pure _ _
+
 @[simp] theorem mapM_append [Monad m] [LawfulMonad m] (f : α → m β) {xs ys : Array α} :
     (xs ++ ys).mapM f = (return (← xs.mapM f) ++ (← ys.mapM f)) := by
   rcases xs with ⟨xs⟩
@@ -227,6 +231,32 @@ theorem forIn_pure_yield_eq_foldl [Monad m] [LawfulMonad m]
   rcases xs with ⟨xs⟩
   simp
 
+/-! ### allM and anyM -/
+
+@[simp] theorem anyM_pure [Monad m] [LawfulMonad m] (p : α → Bool) (xs : Array α) :
+    xs.anyM (m := m) (pure <| p ·) = pure (xs.any p) := by
+  cases xs
+  simp
+
+@[simp] theorem allM_pure [Monad m] [LawfulMonad m] (p : α → Bool) (xs : Array α) :
+    xs.allM (m := m) (pure <| p ·) = pure (xs.all p) := by
+  cases xs
+  simp
+
+/-! ### findM? and findSomeM? -/
+
+@[simp]
+theorem findM?_pure {m} [Monad m] [LawfulMonad m] (p : α → Bool) (xs : Array α) :
+    findM? (m := m) (pure <| p ·) xs = pure (xs.find? p) := by
+  cases xs
+  simp
+
+@[simp]
+theorem findSomeM?_pure [Monad m] [LawfulMonad m] (f : α → Option β) (xs : Array α) :
+    findSomeM? (m := m) (pure <| f ·) xs = pure (xs.findSome? f) := by
+  cases xs
+  simp
+
 end Array
 
 namespace List
@@ -357,12 +387,12 @@ and simplifies these to the function directly taking the value.
   simp
   rw [List.foldlM_subtype hf]
 
-@[wf_preprocess] theorem foldlM_wfParam [Monad m] (xs : Array α) (f : β → α → m β) :
-    (wfParam xs).foldlM f = xs.attach.unattach.foldlM f := by
+@[wf_preprocess] theorem foldlM_wfParam [Monad m] (xs : Array α) (f : β → α → m β) (init : β) :
+    (wfParam xs).foldlM f init = xs.attach.unattach.foldlM f init := by
   simp [wfParam]
 
-@[wf_preprocess] theorem foldlM_unattach [Monad m] (P : α → Prop) (xs : Array (Subtype P)) (f : β → α → m β) :
-    xs.unattach.foldlM f = xs.foldlM fun b ⟨x, h⟩ =>
+@[wf_preprocess] theorem foldlM_unattach [Monad m] (P : α → Prop) (xs : Array (Subtype P)) (f : β → α → m β) (init : β) :
+    xs.unattach.foldlM f init = xs.foldlM (init := init) fun b ⟨x, h⟩ =>
       binderNameHint b f <| binderNameHint x (f b) <| binderNameHint h () <|
       f b (wfParam x) := by
   simp [wfParam]
@@ -381,12 +411,12 @@ and simplifies these to the function directly taking the value.
   rw [List.foldrM_subtype hf]
 
 
-@[wf_preprocess] theorem foldrM_wfParam [Monad m] [LawfulMonad m] (xs : Array α) (f : α → β → m β) :
-    (wfParam xs).foldrM f = xs.attach.unattach.foldrM f := by
+@[wf_preprocess] theorem foldrM_wfParam [Monad m] [LawfulMonad m] (xs : Array α) (f : α → β → m β) (init : β) :
+    (wfParam xs).foldrM f init = xs.attach.unattach.foldrM f init := by
   simp [wfParam]
 
-@[wf_preprocess] theorem foldrM_unattach [Monad m] [LawfulMonad m] (P : α → Prop) (xs : Array (Subtype P)) (f : α → β → m β) :
-    xs.unattach.foldrM f = xs.foldrM fun ⟨x, h⟩ b =>
+@[wf_preprocess] theorem foldrM_unattach [Monad m] [LawfulMonad m] (P : α → Prop) (xs : Array (Subtype P)) (f : α → β → m β) (init : β):
+    xs.unattach.foldrM f init = xs.foldrM (init := init) fun ⟨x, h⟩ b =>
       binderNameHint x f <| binderNameHint h () <| binderNameHint b (f x) <|
       f (wfParam x) b := by
   simp [wfParam]

src/Init/Data/BEq.lean

@@ -49,6 +49,14 @@ theorem BEq.symm_false [BEq α] [PartialEquivBEq α] {a b : α} : (a == b) = fal
 theorem BEq.trans [BEq α] [PartialEquivBEq α] {a b c : α} : a == b → b == c → a == c :=
   PartialEquivBEq.trans
 
+theorem BEq.congr_left [BEq α] [PartialEquivBEq α] {a b c : α} (h : a == b) :
+    (a == c) = (b == c) :=
+  Bool.eq_iff_iff.mpr ⟨BEq.trans (BEq.symm h), BEq.trans h⟩
+
+theorem BEq.congr_right [BEq α] [PartialEquivBEq α] {a b c : α} (h : b == c) :
+    (a == b) = (a == c) :=
+  Bool.eq_iff_iff.mpr ⟨fun h' => BEq.trans h' h, fun h' => BEq.trans h' (BEq.symm h)⟩
+
 theorem BEq.neq_of_neq_of_beq [BEq α] [PartialEquivBEq α] {a b c : α} :
     (a == b) = false → b == c → (a == c) = false :=
   fun h₁ h₂ => Bool.eq_false_iff.2 fun h₃ => Bool.eq_false_iff.1 h₁ (BEq.trans h₃ (BEq.symm h₂))

src/Init/Data/BitVec/Bitblast.lean

@@ -109,7 +109,12 @@ open Nat Bool
 
 namespace Bool
 
-/-- At least two out of three booleans are true. -/
+/--
+At least two out of three Booleans are true.
+
+This function is typically used to model addition of binary numbers, to combine a carry bit with two
+addend bits.
+-/
 abbrev atLeastTwo (a b c : Bool) : Bool := a && b || a && c || b && c
 
 @[simp] theorem atLeastTwo_false_left  : atLeastTwo false b c = (b && c) := by simp [atLeastTwo]
@@ -478,6 +483,36 @@ theorem msb_neg {w : Nat} {x : BitVec w} :
         case zero => exact hmsb
         case succ => exact getMsbD_x _ hi (by omega)
 
+/-- This is false if `v < w` and `b = intMin`. See also `signExtend_neg_of_ne_intMin`. -/
+@[simp] theorem signExtend_neg_of_le {v w : Nat} (h : w ≤ v) (b : BitVec v) :
+    (-b).signExtend w = -b.signExtend w := by
+  apply BitVec.eq_of_getElem_eq
+  intro i hi
+  simp only [getElem_signExtend, getElem_neg]
+  rw [dif_pos (by omega), dif_pos (by omega)]
+  simp only [getLsbD_signExtend, Bool.and_eq_true, decide_eq_true_eq, Bool.ite_eq_true_distrib,
+    Bool.bne_right_inj, decide_eq_decide]
+  exact ⟨fun ⟨j, hj₁, hj₂⟩ => ⟨j, ⟨hj₁, ⟨by omega, by rwa [if_pos (by omega)]⟩⟩⟩,
+    fun ⟨j, hj₁, hj₂, hj₃⟩ => ⟨j, hj₁, by rwa [if_pos (by omega)] at hj₃⟩⟩
+
+/-- This is false if `v < w` and `b = intMin`. See also `signExtend_neg_of_le`. -/
+@[simp] theorem signExtend_neg_of_ne_intMin {v w : Nat} (b : BitVec v) (hb : b ≠ intMin v) :
+    (-b).signExtend w = -b.signExtend w := by
+  refine (by omega : w ≤ v ∨ v < w).elim (fun h => signExtend_neg_of_le h b) (fun h => ?_)
+  apply BitVec.eq_of_toInt_eq
+  rw [toInt_signExtend_of_le (by omega), toInt_neg_of_ne_intMin hb, toInt_neg_of_ne_intMin,
+    toInt_signExtend_of_le (by omega)]
+  apply ne_of_apply_ne BitVec.toInt
+  rw [toInt_signExtend_of_le (by omega), toInt_intMin_of_pos (by omega)]
+  have := b.le_two_mul_toInt
+  have : -2 ^ w < -2 ^ v := by
+    apply Int.neg_lt_neg
+    norm_cast
+    rwa [Nat.pow_lt_pow_iff_right (by omega)]
+  have : 2 * b.toInt ≠ -2 ^ w := by omega
+  rw [(show w = w - 1 + 1 by omega), Int.pow_succ] at this
+  omega
+
 /-! ### abs -/
 
 theorem msb_abs {w : Nat} {x : BitVec w} :
@@ -544,6 +579,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]
@@ -1244,8 +1288,8 @@ theorem saddOverflow_eq {w : Nat} (x y : BitVec w) :
   simp only [saddOverflow]
   rcases w with _|w
   · revert x y; decide
-  · have := le_toInt (x := x); have := toInt_lt (x := x)
-    have := le_toInt (x := y); have := toInt_lt (x := y)
+  · have := le_two_mul_toInt (x := x); have := two_mul_toInt_lt (x := x)
+    have := le_two_mul_toInt (x := y); have := two_mul_toInt_lt (x := y)
     simp only [← decide_or, msb_eq_toInt, decide_beq_decide, toInt_add, ← decide_not, ← decide_and,
       decide_eq_decide]
     rw_mod_cast [Int.bmod_neg_iff (by omega) (by omega)]

src/Init/Data/BitVec/Lemmas.lean

@@ -13,7 +13,9 @@ import Init.Data.Nat.Div.Lemmas
 import Init.Data.Nat.Mod
 import Init.Data.Nat.Div.Lemmas
 import Init.Data.Int.Bitwise.Lemmas
+import Init.Data.Int.LemmasAux
 import Init.Data.Int.Pow
+import Init.Data.Int.LemmasAux
 
 set_option linter.missingDocs true
 
@@ -239,12 +241,16 @@ theorem eq_of_getMsbD_eq {x y : BitVec w}
 theorem of_length_zero {x : BitVec 0} : x = 0#0 := by ext; simp [← getLsbD_eq_getElem]
 
 theorem toNat_zero_length (x : BitVec 0) : x.toNat = 0 := by simp [of_length_zero]
+theorem toInt_zero_length (x : BitVec 0) : x.toInt = 0 := by simp [of_length_zero]
+
 theorem getLsbD_zero_length (x : BitVec 0) : x.getLsbD i = false := by simp
 theorem getMsbD_zero_length (x : BitVec 0) : x.getMsbD i = false := by simp
 theorem msb_zero_length (x : BitVec 0) : x.msb = false := by simp [BitVec.msb, of_length_zero]
 
 theorem toNat_of_zero_length (h : w = 0) (x : BitVec w) : x.toNat = 0 := by
   subst h; simp [toNat_zero_length]
+theorem toInt_of_zero_length (h : w = 0) (x : BitVec w) : x.toInt = 0 := by
+  subst h; simp [toInt_zero_length]
 theorem getLsbD_of_zero_length (h : w = 0) (x : BitVec w) : x.getLsbD i = false := by
   subst h; simp [getLsbD_zero_length]
 theorem getMsbD_of_zero_length (h : w = 0) (x : BitVec w) : x.getMsbD i = false := by
@@ -323,8 +329,25 @@ 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
 
+@[simp] theorem finMk_toNat (x : BitVec w) : Fin.mk x.toNat x.isLt = x.toFin := rfl
+
+@[simp] theorem toFin_ofNatLT {n : Nat} (h : n < 2 ^ w) : (BitVec.ofNatLT n h).toFin = Fin.mk n h := rfl
+
+@[simp] theorem toFin_ofFin (n : Fin (2 ^ w)) : (BitVec.ofFin n).toFin = n := rfl
+@[simp] theorem ofFin_toFin (x : BitVec w) : BitVec.ofFin x.toFin = x := rfl
+
+@[simp] theorem ofNatLT_finVal (n : Fin (2 ^ w)) : BitVec.ofNatLT n.val n.isLt = BitVec.ofFin n := rfl
+
+@[simp] theorem ofNatLT_toNat (x : BitVec w) : BitVec.ofNatLT x.toNat x.isLt = x := rfl
+
+@[simp] theorem ofNat_finVal (n : Fin (2 ^ w)) : BitVec.ofNat w n.val = BitVec.ofFin n := by
+  rw [← BitVec.ofNatLT_eq_ofNat n.isLt, ofNatLT_finVal]
+
 -- Remark: we don't use `[simp]` here because simproc` subsumes it for literals.
 -- If `x` and `n` are not literals, applying this theorem eagerly may not be a good idea.
 theorem getLsbD_ofNat (n : Nat) (x : Nat) (i : Nat) :
@@ -528,6 +551,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
@@ -538,6 +564,16 @@ theorem toInt_eq_toNat_bmod (x : BitVec n) : x.toInt = Int.bmod x.toNat (2^n) :=
     rw [Int.bmod_neg] <;> simp only [←Int.ofNat_emod, toNat_mod_cancel]
     omega
 
+theorem toInt_neg_of_msb_true {x : BitVec w} (h : x.msb = true) : x.toInt < 0 := by
+  simp only [BitVec.toInt]
+  have : 2 * x.toNat ≥ 2 ^ w := msb_eq_true_iff_two_mul_ge.mp h
+  omega
+
+theorem toInt_nonneg_of_msb_false {x : BitVec w} (h : x.msb = false) : 0 ≤ x.toInt := by
+  simp only [BitVec.toInt]
+  have : 2 * x.toNat < 2 ^ w := msb_eq_false_iff_two_mul_lt.mp h
+  omega
+
 /-- Prove equality of bitvectors in terms of nat operations. -/
 theorem eq_of_toInt_eq {x y : BitVec n} : x.toInt = y.toInt → x = y := by
   intro eq
@@ -569,6 +605,11 @@ theorem toInt_ofNat {n : Nat} (x : Nat) :
   have p : 0 ≤ i % (2^n : Nat) := by omega
   simp [toInt_eq_toNat_bmod, Int.toNat_of_nonneg p]
 
+theorem toInt_ofInt_eq_self {w : Nat} (hw : 0 < w) {n : Int}
+    (h : -2 ^ (w - 1) ≤ n) (h' : n < 2 ^ (w - 1)) : (BitVec.ofInt w n).toInt = n := by
+  have hw : w = (w - 1) + 1 := by omega
+  rw [toInt_ofInt, Int.bmod_eq_self_of_le] <;> (rw [hw]; simp [Int.natCast_pow]; omega)
+
 @[simp] theorem ofInt_natCast (w n : Nat) :
   BitVec.ofInt w (n : Int) = BitVec.ofNat w n := rfl
 
@@ -604,7 +645,7 @@ theorem toInt_zero {w : Nat} : (0#w).toInt = 0 := by
 `x.toInt` is less than `2^(w-1)`.
 We phrase the fact in terms of `2^w` to prevent a case split on `w=0` when the lemma is used.
 -/
-theorem toInt_lt {w : Nat} {x : BitVec w} : 2 * x.toInt < 2 ^ w := by
+theorem two_mul_toInt_lt {w : Nat} {x : BitVec w} : 2 * x.toInt < 2 ^ w := by
   simp only [BitVec.toInt]
   rcases w with _|w'
   · omega
@@ -612,11 +653,25 @@ theorem toInt_lt {w : Nat} {x : BitVec w} : 2 * x.toInt < 2 ^ w := by
     simp only [Nat.zero_lt_succ, Nat.mul_lt_mul_left, Int.natCast_mul, Int.Nat.cast_ofNat_Int]
     norm_cast; omega
 
+theorem two_mul_toInt_le {w : Nat} {x : BitVec w} : 2 * x.toInt ≤ 2 ^ w - 1 :=
+  Int.le_sub_one_of_lt two_mul_toInt_lt
+
+theorem toInt_lt {w : Nat} {x : BitVec w} : x.toInt < 2 ^ (w - 1) := by
+  by_cases h : w = 0
+  · subst h
+    simp [eq_nil x]
+  · have := @two_mul_toInt_lt w x
+    rw_mod_cast [← Nat.two_pow_pred_add_two_pow_pred (by omega), Int.mul_comm, Int.natCast_add] at this
+    omega
+
+theorem toInt_le {w : Nat} {x : BitVec w} : x.toInt ≤ 2 ^ (w - 1) - 1 :=
+  Int.le_sub_one_of_lt toInt_lt
+
 /--
 `x.toInt` is greater than or equal to `-2^(w-1)`.
 We phrase the fact in terms of `2^w` to prevent a case split on `w=0` when the lemma is used.
 -/
-theorem le_toInt {w : Nat} {x : BitVec w} : -2 ^ w ≤ 2 * x.toInt := by
+theorem le_two_mul_toInt {w : Nat} {x : BitVec w} : -2 ^ w ≤ 2 * x.toInt := by
   simp only [BitVec.toInt]
   rcases w with _|w'
   · omega
@@ -624,6 +679,16 @@ theorem le_toInt {w : Nat} {x : BitVec w} : -2 ^ w ≤ 2 * x.toInt := by
     simp only [Nat.zero_lt_succ, Nat.mul_lt_mul_left, Int.natCast_mul, Int.Nat.cast_ofNat_Int]
     norm_cast; omega
 
+
+theorem le_toInt {w : Nat} (x : BitVec w) : -2 ^ (w - 1) ≤ x.toInt := by
+  by_cases h : w = 0
+  · subst h
+    simp [BitVec.eq_nil x]
+  · have := le_two_mul_toInt (w := w) (x := x)
+    generalize x.toInt = x at *
+    rw [(show w = w - 1 + 1 by omega), Int.pow_succ] at this
+    omega
+
 /-! ### slt -/
 
 /--
@@ -645,6 +710,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]
@@ -996,6 +1067,11 @@ theorem extractLsb'_eq_extractLsb {w : Nat} (x : BitVec w) (start len : Nat) (h
   apply eq_of_toNat_eq
   simp [extractLsb, show len - 1 + 1 = len by omega]
 
+/-- Extracting all the bits of a bitvector is an identity operation. -/
+@[simp] theorem extractLsb'_eq_self {x : BitVec w} : x.extractLsb' 0 w = x := by
+  apply eq_of_toNat_eq
+  simp [extractLsb']
+
 /-! ### allOnes -/
 
 @[simp] theorem toNat_allOnes : (allOnes v).toNat = 2^v - 1 := by
@@ -1467,6 +1543,16 @@ theorem extractLsb_not_of_lt {x : BitVec w} {hi lo : Nat} (hlo : lo ≤ hi) (hhi
   simp [hk, show k ≤ hi - lo by omega]
   omega
 
+@[simp]
+theorem ne_not_self {a : BitVec w} (h : 0 < w) : a ≠ ~~~a := by
+  have : ∃ x, x < w := ⟨w - 1, by omega⟩
+  simp [BitVec.eq_of_getElem_eq_iff, this]
+
+@[simp]
+theorem not_self_ne {a : BitVec w} (h : 0 < w) : ~~~a ≠ a := by
+  rw [ne_comm]
+  simp [h]
+
 /-! ### cast -/
 
 @[simp] theorem not_cast {x : BitVec w} (h : w = w') : ~~~(x.cast h) = (~~~x).cast h := by
@@ -1735,7 +1821,7 @@ theorem toInt_ushiftRight {x : BitVec w} {n : Nat} :
     simp [hn]
 
 @[simp]
-theorem toFin_uShiftRight {x : BitVec w} {n : Nat} :
+theorem toFin_ushiftRight {x : BitVec w} {n : Nat} :
     (x >>> n).toFin = x.toFin / (Fin.ofNat' (2^w) (2^n)) := by
   apply Fin.eq_of_val_eq
   by_cases hn : n < w
@@ -1941,11 +2027,118 @@ theorem getMsbD_sshiftRight {x : BitVec w} {i n : Nat} :
         by_cases h₄ : n + (w - 1 - i) < w <;> (simp only [h₄, ↓reduceIte]; congr; omega)
   · simp [h]
 
+theorem toInt_shiftRight_lt {x : BitVec w} {n : Nat} :
+    x.toInt >>> n < 2 ^ (w - 1) := by
+  have := @Int.shiftRight_le_of_nonneg x.toInt n
+  have := @Int.shiftRight_le_of_nonpos x.toInt n
+  have := @BitVec.toInt_lt w x
+  have := @Nat.one_le_two_pow (w-1)
+  norm_cast at *
+  omega
+
+theorem le_toInt_shiftRight {x : BitVec w} {n : Nat} :
+    -(2 ^ (w - 1)) ≤ x.toInt >>> n := by
+  have := @Int.le_shiftRight_of_nonpos x.toInt n
+  have := @Int.le_shiftRight_of_nonneg x.toInt n
+  have := @BitVec.le_toInt w x
+  have := @Nat.one_le_two_pow (w-1)
+  norm_cast at *
+  omega
+
+theorem toNat_sshiftRight_of_msb_true {x : BitVec w} {n : Nat} (h : x.msb = true) :
+    (x.sshiftRight n).toNat = 2 ^ w - 1 - (2 ^ w - 1 - x.toNat) >>> n := by
+  simp [sshiftRight_eq_of_msb_true, h]
+
+theorem toNat_sshiftRight_of_msb_false {x : BitVec w} {n : Nat} (h : x.msb = false) :
+    (x.sshiftRight n).toNat = x.toNat >>> n := by
+  simp [sshiftRight_eq_of_msb_false, h]
+
+theorem toNat_sshiftRight {x : BitVec w} {n : Nat} :
+    (x.sshiftRight n).toNat =
+      if x.msb
+      then 2 ^ w - 1 - (2 ^ w - 1 - x.toNat) >>> n
+      else x.toNat >>> n := by
+  by_cases h : x.msb
+  · simp [toNat_sshiftRight_of_msb_true, h]
+  · rw [Bool.not_eq_true] at h
+    simp [toNat_sshiftRight_of_msb_false, h]
+
+theorem toFin_sshiftRight_of_msb_true {x : BitVec w} {n : Nat} (h : x.msb = true) :
+    (x.sshiftRight n).toFin = Fin.ofNat' (2^w) (2 ^ w - 1 - (2 ^ w - 1 - x.toNat) >>> n) := by
+  apply Fin.eq_of_val_eq
+  simp only [val_toFin, toNat_sshiftRight, h, ↓reduceIte, Fin.val_ofNat']
+  rw [Nat.mod_eq_of_lt]
+  have := x.isLt
+  have ineq : ∀ y, 2 ^ w - 1 - y < 2 ^ w := by omega
+  exact ineq ((2 ^ w - 1 - x.toNat) >>> n)
+
+theorem toFin_sshiftRight_of_msb_false {x : BitVec w} {n : Nat} (h : x.msb = false) :
+    (x.sshiftRight n).toFin = Fin.ofNat' (2^w) (x.toNat >>> n) := by
+  apply Fin.eq_of_val_eq
+  simp only [val_toFin, toNat_sshiftRight, h, Bool.false_eq_true, ↓reduceIte, Fin.val_ofNat']
+  have := Nat.shiftRight_le x.toNat n
+  rw [Nat.mod_eq_of_lt (by omega)]
+
+theorem toFin_sshiftRight {x : BitVec w} {n : Nat} :
+    (x.sshiftRight n).toFin =
+      if x.msb
+      then Fin.ofNat' (2^w) (2 ^ w - 1 - (2 ^ w - 1 - x.toNat) >>> n)
+      else Fin.ofNat' (2^w) (x.toNat >>> n) := by
+  by_cases h : x.msb
+  · simp [toFin_sshiftRight_of_msb_true, h]
+  · simp [toFin_sshiftRight_of_msb_false, h]
+
+@[simp]
+theorem toInt_sshiftRight {x : BitVec w} {n : Nat} :
+    (x.sshiftRight n).toInt = x.toInt >>> n := by
+  by_cases h : w = 0
+  · subst h
+    simp [BitVec.eq_nil x]
+  · rw [sshiftRight, toInt_ofInt, ←Nat.two_pow_pred_add_two_pow_pred (by omega)]
+    have := @toInt_shiftRight_lt w x n
+    have := @le_toInt_shiftRight w x n
+    norm_cast at *
+    exact Int.bmod_eq_self_of_le (by omega) (by omega)
+
 /-! ### sshiftRight reductions from BitVec to Nat -/
 
 @[simp]
 theorem sshiftRight_eq' (x : BitVec w) : x.sshiftRight' y = x.sshiftRight y.toNat := rfl
 
+theorem toNat_sshiftRight'_of_msb_true {x y : BitVec w} (h : x.msb = true) :
+    (x.sshiftRight' y).toNat = 2 ^ w - 1 - (2 ^ w - 1 - x.toNat) >>> y.toNat := by
+  rw [sshiftRight_eq', toNat_sshiftRight_of_msb_true h]
+
+theorem toNat_sshiftRight'_of_msb_false {x y : BitVec w} (h : x.msb = false) :
+    (x.sshiftRight' y).toNat = x.toNat >>> y.toNat := by
+  rw [sshiftRight_eq', toNat_sshiftRight_of_msb_false h]
+
+theorem toNat_sshiftRight' {x y : BitVec w} :
+    (x.sshiftRight' y).toNat =
+      if x.msb
+      then 2 ^ w - 1 - (2 ^ w - 1 - x.toNat) >>> y.toNat
+      else x.toNat >>> y.toNat := by
+  rw [sshiftRight_eq', toNat_sshiftRight]
+
+theorem toFin_sshiftRight'_of_msb_true {x y : BitVec w} (h : x.msb = true) :
+    (x.sshiftRight' y).toFin = Fin.ofNat' (2^w) (2 ^ w - 1 - (2 ^ w - 1 - x.toNat) >>> y.toNat) := by
+  rw [sshiftRight_eq', toFin_sshiftRight_of_msb_true h]
+
+theorem toFin_sshiftRight'_of_msb_false {x y : BitVec w} (h : x.msb = false) :
+    (x.sshiftRight' y).toFin = Fin.ofNat' (2^w) (x.toNat >>> y.toNat) := by
+  rw [sshiftRight_eq', toFin_sshiftRight_of_msb_false h]
+
+theorem toFin_sshiftRight' {x y : BitVec w} :
+    (x.sshiftRight' y).toFin =
+      if x.msb
+      then Fin.ofNat' (2^w) (2 ^ w - 1 - (2 ^ w - 1 - x.toNat) >>> y.toNat)
+      else Fin.ofNat' (2^w) (x.toNat >>> y.toNat) := by
+  rw [sshiftRight_eq', toFin_sshiftRight]
+
+theorem toInt_sshiftRight' {x y : BitVec w} :
+    (x.sshiftRight' y).toInt = x.toInt >>> y.toNat := by
+  rw [sshiftRight_eq', toInt_sshiftRight]
+
 -- This should not be a `@[simp]` lemma as the left hand side is not in simp normal form.
 theorem getLsbD_sshiftRight' {x y : BitVec w} {i : Nat} :
     getLsbD (x.sshiftRight' y) i =
@@ -2036,14 +2229,18 @@ theorem msb_signExtend {x : BitVec w} :
   · simp [h, BitVec.msb, getMsbD_signExtend, show ¬ (v - w = 0) by omega]
 
 /-- Sign extending to a width smaller than the starting width is a truncation. -/
-theorem signExtend_eq_setWidth_of_lt (x : BitVec w) {v : Nat} (hv : v ≤ w):
+theorem signExtend_eq_setWidth_of_le (x : BitVec w) {v : Nat} (hv : v ≤ w) :
   x.signExtend v = x.setWidth v := by
   ext i h
   simp [getElem_signExtend, show i < w by omega]
 
+@[deprecated signExtend_eq_setWidth_of_le (since := "2025-03-07")]
+theorem signExtend_eq_setWidth_of_lt (x : BitVec w) {v : Nat} (hv : v ≤ w) :
+  x.signExtend v = x.setWidth v := signExtend_eq_setWidth_of_le x hv
+
 /-- Sign extending to the same bitwidth is a no op. -/
-theorem signExtend_eq (x : BitVec w) : x.signExtend w = x := by
-  rw [signExtend_eq_setWidth_of_lt _ (Nat.le_refl _), setWidth_eq]
+@[simp] theorem signExtend_eq (x : BitVec w) : x.signExtend w = x := by
+  rw [signExtend_eq_setWidth_of_le _ (Nat.le_refl _), setWidth_eq]
 
 /-- Sign extending to a larger bitwidth depends on the msb.
 If the msb is false, then the result equals the original value.
@@ -2080,47 +2277,65 @@ theorem toNat_signExtend (x : BitVec w) {v : Nat} :
     (x.signExtend v).toNat = (x.setWidth v).toNat + if x.msb then 2^v - 2^w else 0 := by
   by_cases h : v ≤ w
   · have : 2^v ≤ 2^w := Nat.pow_le_pow_right Nat.two_pos h
-    simp [signExtend_eq_setWidth_of_lt x h, toNat_setWidth, Nat.sub_eq_zero_of_le this]
+    simp [signExtend_eq_setWidth_of_le x h, toNat_setWidth, Nat.sub_eq_zero_of_le this]
   · 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]
+  simp [signExtend_eq_setWidth_of_le _ 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]
 
 /-! ### append -/
 
@@ -2265,6 +2480,42 @@ theorem msb_shiftLeft {x : BitVec w} {n : Nat} :
     (x <<< n).msb = x.getMsbD n := by
   simp [BitVec.msb]
 
+/--
+A `(x : BitVec v)` set to width `w` equals `(v - w)` zeros,
+followed by the low `(min v w) bits of `x`
+-/
+theorem setWidth_eq_append_extractLsb' {v : Nat} {x : BitVec v} {w : Nat} :
+    x.setWidth w = ((0#(w - v)) ++ x.extractLsb' 0 (min v w)).cast (by omega) := by
+  ext i hi
+  simp only [getElem_cast, getElem_append]
+  by_cases hiv : i < v
+  · simp [hi]
+    omega
+  · simp [getLsbD_ge x i (by omega)]
+
+/--
+A `(x : BitVec v)` set to a width `w ≥ v` equals `(w - v)` zeros, followed by `x`.
+-/
+theorem setWidth_eq_append {v : Nat} {x : BitVec v} {w : Nat} (h : v ≤ w) :
+    x.setWidth w = ((0#(w - v)) ++ x).cast (by omega) := by
+  rw [setWidth_eq_append_extractLsb']
+  ext i hi
+  simp only [getElem_cast, getElem_append]
+  by_cases hiv : i < v
+  · simp [hiv]
+    omega
+  · simp [hiv, getLsbD_ge x i (by omega)]
+
+theorem setWidth_eq_extractLsb' {v : Nat} {x : BitVec v} {w : Nat} (h : w ≤ v) :
+    x.setWidth w = (x.extractLsb' 0 w).cast (by omega) := by
+  rw [setWidth_eq_append_extractLsb']
+  ext i hi
+  simp only [getElem_cast, getElem_append]
+  by_cases hiv : i < v
+  · simp [hi]
+    omega
+  · simp [getLsbD_ge x i (by omega)]
+
 theorem ushiftRight_eq_extractLsb'_of_lt {x : BitVec w} {n : Nat} (hn : n < w) :
     x >>> n = ((0#n) ++ (x.extractLsb' n (w - n))).cast (by omega) := by
   ext i hi
@@ -2282,6 +2533,29 @@ theorem shiftLeft_eq_concat_of_lt {x : BitVec w} {n : Nat} (hn : n < w) :
   · simp [hi']
   · simp [hi', show i - n < w by omega]
 
+/-- Combine adjacent `extractLsb'` operations into a single `extractLsb'`. -/
+theorem extractLsb'_append_extractLsb'_eq_extractLsb' {x : BitVec w} (h : start₂ = start₁ + len₁) :
+    ((x.extractLsb' start₂ len₂) ++ (x.extractLsb' start₁ len₁)) =
+    (x.extractLsb' start₁ (len₁ + len₂)).cast (by omega) := by
+  ext i h
+  simp only [getElem_append, getElem_extractLsb', dite_eq_ite, getElem_cast, ite_eq_left_iff,
+    Nat.not_lt]
+  intros hi
+  congr 1
+  omega
+
+/-- Combine adjacent `~~~ (extractLsb _)'` operations into a single `~~~ (extractLsb _)'`. -/
+theorem not_extractLsb'_append_not_extractLsb'_eq_not_extractLsb' {x : BitVec w} (h : start₂ = start₁ + len₁) :
+    (~~~ (x.extractLsb' start₂ len₂) ++ ~~~ (x.extractLsb' start₁ len₁)) =
+    (~~~ x.extractLsb' start₁ (len₁ + len₂)).cast (by omega) := by
+  ext i h
+  simp only [getElem_cast, getElem_not, getElem_extractLsb', getElem_append]
+  by_cases hi : i < len₁
+  · simp [hi]
+  · simp only [hi, ↓reduceDIte, Bool.not_eq_eq_eq_not, Bool.not_not]
+    congr 1
+    omega
+
 /-! ### rev -/
 
 theorem getLsbD_rev (x : BitVec w) (i : Fin w) :
@@ -2693,6 +2967,9 @@ theorem toInt_neg {x : BitVec w} :
   rw [← BitVec.zero_sub, toInt_sub]
   simp [BitVec.toInt_ofNat]
 
+theorem ofInt_neg {w : Nat} {n : Int} : BitVec.ofInt w (-n) = -BitVec.ofInt w n :=
+  eq_of_toInt_eq (by simp [toInt_neg])
+
 @[simp] theorem toFin_neg (x : BitVec n) :
     (-x).toFin = Fin.ofNat' (2^n) (2^n - x.toNat) :=
   rfl
@@ -3151,6 +3428,7 @@ then `x / y` is nonnegative, thus `toInt` and `toNat` coincide.
 theorem toInt_udiv_of_msb {x : BitVec w} (h : x.msb = false) (y : BitVec w) :
     (x / y).toInt = x.toNat / y.toNat := by
   simp [toInt_eq_msb_cond, msb_udiv_eq_false_of h]
+  norm_cast
 
 /-! ### umod -/
 
@@ -3950,7 +4228,6 @@ theorem toNat_intMin : (intMin w).toNat = 2 ^ (w - 1) % 2 ^ w := by
 /--
 The RHS is zero in case `w = 0` which is modeled by wrapping the expression in `... % 2 ^ w`.
 -/
-@[simp]
 theorem toInt_intMin {w : Nat} :
     (intMin w).toInt = -((2 ^ (w - 1) % 2 ^ w) : Nat) := by
   by_cases h : w = 0
@@ -3962,10 +4239,16 @@ theorem toInt_intMin {w : Nat} :
     rw [Nat.mul_comm]
     simp [w_pos]
 
+theorem toInt_intMin_of_pos {v : Nat} (hv : 0 < v) : (intMin v).toInt = -2 ^ (v - 1) := by
+  rw [toInt_intMin, Nat.mod_eq_of_lt]
+  · simp [Int.natCast_pow]
+  · rw [Nat.pow_lt_pow_iff_right (by omega)]
+    omega
+
 theorem toInt_intMin_le (x : BitVec w) :
     (intMin w).toInt ≤ x.toInt := by
   cases w
-  case zero => simp [@of_length_zero x]
+  case zero => simp [toInt_intMin, @of_length_zero x]
   case succ w =>
     simp only [toInt_intMin, Nat.add_one_sub_one, Int.ofNat_emod]
     have : 0 < 2 ^ w := Nat.two_pow_pos w
@@ -4109,9 +4392,7 @@ theorem sub_le_sub_iff_le {x y z : BitVec w} (hxz : z ≤ x) (hyz : z ≤ y) :
 
 theorem msb_eq_toInt {x : BitVec w}:
     x.msb = decide (x.toInt < 0) := by
-  by_cases h : x.msb <;>
-  · simp [h, toInt_eq_msb_cond]
-    omega
+  by_cases h : x.msb <;> simp [h, toInt_eq_msb_cond] <;> omega
 
 theorem msb_eq_toNat {x : BitVec w}:
     x.msb = decide (x.toNat ≥ 2 ^ (w - 1)) := by
@@ -4346,6 +4627,9 @@ instance instDecidableExistsBitVec :
 
 set_option linter.missingDocs false
 
+@[deprecated toFin_uShiftRight (since := "2025-02-18")]
+abbrev toFin_uShiftRight := @toFin_ushiftRight
+
 @[deprecated signExtend_eq_setWidth_of_msb_false (since := "2024-12-08")]
 abbrev signExtend_eq_not_setWidth_not_of_msb_false := @signExtend_eq_setWidth_of_msb_false
 
@@ -4458,7 +4742,7 @@ abbrev signExtend_eq_not_zeroExtend_not_of_msb_false  := @signExtend_eq_setWidth
 abbrev signExtend_eq_not_zeroExtend_not_of_msb_true := @signExtend_eq_not_setWidth_not_of_msb_true
 
 @[deprecated signExtend_eq_setWidth_of_lt (since := "2024-09-18")]
-abbrev signExtend_eq_truncate_of_lt := @signExtend_eq_setWidth_of_lt
+abbrev signExtend_eq_truncate_of_lt := @signExtend_eq_setWidth_of_le
 
 @[deprecated truncate_append (since := "2024-09-18")]
 abbrev truncate_append := @setWidth_append

src/Init/Data/Bool.lean

@@ -9,7 +9,19 @@ import Init.NotationExtra
 
 namespace Bool
 
-/-- Boolean exclusive or -/
+/--
+Boolean “exclusive or”. `xor x y` can be written `x ^^ y`.
+
+`x ^^ y` is `true` when precisely one of `x` or `y` is `true`. Unlike `and` and `or`, it does not
+have short-circuiting behavior, because one argument's value never determines the final value. Also
+unlike `and` and `or`, there is no commonly-used corresponding propositional connective.
+
+Examples:
+ * `false ^^ false = false`
+ * `true ^^ false = true`
+ * `false ^^ true = true`
+ * `true ^^ true = false`
+-/
 abbrev xor : Bool → Bool → Bool := bne
 
 @[inherit_doc] infixl:33 " ^^ " => xor
@@ -367,7 +379,9 @@ theorem and_or_inj_left_iff :
 
 /-! ## toNat -/
 
-/-- convert a `Bool` to a `Nat`, `false -> 0`, `true -> 1` -/
+/--
+Converts `true` to `1` and `false` to `0`.
+-/
 def toNat (b : Bool) : Nat := cond b 1 0
 
 @[simp, bitvec_to_nat] theorem toNat_false : false.toNat = 0 := rfl
@@ -388,7 +402,9 @@ theorem toNat_lt (b : Bool) : b.toNat < 2 :=
 
 /-! ## toInt -/
 
-/-- convert a `Bool` to an `Int`, `false -> 0`, `true -> 1` -/
+/--
+Converts `true` to `1` and `false` to `0`.
+-/
 def toInt (b : Bool) : Int := cond b 1 0
 
 @[simp] theorem toInt_false : false.toInt = 0 := rfl
@@ -539,8 +555,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/Char/Basic.lean

@@ -15,7 +15,15 @@ Note that values in `[0xd800, 0xdfff]` are reserved for [UTF-16 surrogate pairs]
 
 namespace Char
 
+/--
+One character is less than another if its code point is strictly less than the other's.
+-/
 protected def lt (a b : Char) : Prop := a.val < b.val
+
+/--
+One character is less than or equal to another if its code point is less than or equal to the
+other's.
+-/
 protected def le (a b : Char) : Prop := a.val ≤ b.val
 
 instance : LT Char := ⟨Char.lt⟩
@@ -27,7 +35,10 @@ instance (a b : Char) :  Decidable (a < b) :=
 instance (a b : Char) : Decidable (a ≤ b) :=
   UInt32.decLe _ _
 
-/-- Determines if the given nat is a valid [Unicode scalar value](https://www.unicode.org/glossary/#unicode_scalar_value).-/
+/--
+True for natural numbers that are valid [Unicode scalar
+values](https://www.unicode.org/glossary/#unicode_scalar_value).
+-/
 abbrev isValidCharNat (n : Nat) : Prop :=
   n < 0xd800 ∨ (0xdfff < n ∧ n < 0x110000)
 
@@ -50,55 +61,93 @@ theorem isValidChar_of_isValidCharNat (n : Nat) (h : isValidCharNat n) : isValid
 theorem isValidChar_zero : isValidChar 0 :=
   Or.inl (by decide)
 
-/-- Underlying unicode code point as a `Nat`. -/
+/--
+The character's Unicode code point as a `Nat`.
+-/
 @[inline] def toNat (c : Char) : Nat :=
   c.val.toNat
 
-/-- Convert a character into a `UInt8`, by truncating (reducing modulo 256) if necessary. -/
+/--
+Converts a character into a `UInt8` that contains its code point.
+
+If the code point is larger than 255, it is truncated (reduced modulo 256).
+-/
 @[inline] def toUInt8 (c : Char) : UInt8 :=
   c.val.toUInt8
 
-/-- The numbers from 0 to 256 are all valid UTF-8 characters, so we can embed one in the other. -/
+/--
+Converts an 8-bit unsigned integer into a character.
+
+The integer's value is interpreted as a Unicode code point.
+-/
 def ofUInt8 (n : UInt8) : Char := ⟨n.toUInt32, .inl (Nat.lt_trans n.toBitVec.isLt (by decide))⟩
 
 instance : Inhabited Char where
   default := 'A'
 
-/-- Is the character a space (U+0020) a tab (U+0009), a carriage return (U+000D) or a newline (U+000A)? -/
+/--
+Returns `true` if the character is a space `(' ', U+0020)`, a tab `('\t', U+0009)`, a carriage
+return `('\r', U+000D)`, or a newline `('\n', U+000A)`.
+-/
 @[inline] def isWhitespace (c : Char) : Bool :=
   c = ' ' || c = '\t' || c = '\r' || c = '\n'
 
-/-- Is the character in `ABCDEFGHIJKLMNOPQRSTUVWXYZ`? -/
+/--
+Returns `true` if the character is a uppercase ASCII letter.
+
+The uppercase ASCII letters are the following: `ABCDEFGHIJKLMNOPQRSTUVWXYZ`.
+-/
 @[inline] def isUpper (c : Char) : Bool :=
   c.val ≥ 65 && c.val ≤ 90
 
-/-- Is the character in `abcdefghijklmnopqrstuvwxyz`? -/
+/--
+Returns `true` if the character is a lowercase ASCII letter.
+
+The lowercase ASCII letters are the following: `abcdefghijklmnopqrstuvwxyz`.
+-/
 @[inline] def isLower (c : Char) : Bool :=
   c.val ≥ 97 && c.val ≤ 122
 
-/-- Is the character in `ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz`? -/
+/--
+Returns `true` if the character is an ASCII letter.
+
+The ASCII letters are the following: `ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz`.
+-/
 @[inline] def isAlpha (c : Char) : Bool :=
   c.isUpper || c.isLower
 
-/-- Is the character in `0123456789`? -/
+/--
+Returns `true` if the character is an ASCII digit.
+
+The ASCII digits are the following: `0123456789`.
+-/
 @[inline] def isDigit (c : Char) : Bool :=
   c.val ≥ 48 && c.val ≤ 57
 
-/-- Is the character in `ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789`? -/
+/--
+Returns `true` if the character is an ASCII letter or digit.
+
+The ASCII letters are the following: `ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz`.
+The ASCII digits are the following: `0123456789`.
+-/
 @[inline] def isAlphanum (c : Char) : Bool :=
   c.isAlpha || c.isDigit
 
-/-- Convert an upper case character to its lower case character.
+/--
+Converts an uppercase ASCII letter to the corresponding lowercase letter. Letters outside the ASCII
+alphabet are returned unchanged.
 
-Only works on basic latin letters.
+The uppercase ASCII letters are the following: `ABCDEFGHIJKLMNOPQRSTUVWXYZ`.
 -/
 def toLower (c : Char) : Char :=
   let n := toNat c;
   if n >= 65 ∧ n <= 90 then ofNat (n + 32) else c
 
-/-- Convert a lower case character to its upper case character.
+/--
+Converts a lowercase ASCII letter to the corresponding uppercase letter. Letters outside the ASCII
+alphabet are returned unchanged.
 
-Only works on basic latin letters.
+The lowercase ASCII letters are the following: `abcdefghijklmnopqrstuvwxyz`.
 -/
 def toUpper (c : Char) : Char :=
   let n := toNat c;

src/Init/Data/Fin/Lemmas.lean

@@ -45,6 +45,7 @@ theorem val_ne_iff {a b : Fin n} : a.1 ≠ b.1 ↔ a ≠ b := not_congr val_inj
 theorem forall_iff {p : Fin n → Prop} : (∀ i, p i) ↔ ∀ i h, p ⟨i, h⟩ :=
   ⟨fun h i hi => h ⟨i, hi⟩, fun h ⟨i, hi⟩ => h i hi⟩
 
+/-- Restatement of `Fin.mk.injEq` as an `iff`. -/
 protected theorem mk.inj_iff {n a b : Nat} {ha : a < n} {hb : b < n} :
     (⟨a, ha⟩ : Fin n) = ⟨b, hb⟩ ↔ a = b := Fin.ext_iff
 
@@ -55,6 +56,14 @@ theorem eq_mk_iff_val_eq {a : Fin n} {k : Nat} {hk : k < n} :
 
 theorem mk_val (i : Fin n) : (⟨i, i.isLt⟩ : Fin n) = i := Fin.eta ..
 
+@[simp] theorem mk_eq_zero {n a : Nat} {ha : a < n} [NeZero n] :
+    (⟨a, ha⟩ : Fin n) = 0 ↔ a = 0 :=
+  mk.inj_iff
+
+@[simp] theorem zero_eq_mk {n a : Nat} {ha : a < n} [NeZero n] :
+    0 = (⟨a, ha⟩ : Fin n) ↔ a = 0 := by
+  simp [eq_comm]
+
 @[simp] theorem val_ofNat' (n : Nat) [NeZero n] (a : Nat) :
   (Fin.ofNat' n a).val = a % n := rfl
 

src/Init/Data/Int.lean

@@ -14,3 +14,4 @@ import Init.Data.Int.Order
 import Init.Data.Int.Pow
 import Init.Data.Int.Cooper
 import Init.Data.Int.Linear
+import Init.Data.Int.OfNat

src/Init/Data/Int/Basic.lean

@@ -17,10 +17,12 @@ open Nat
 This file defines the `Int` type as well as
 
 * coercions, conversions, and compatibility with numeric literals,
-* basic arithmetic operations add/sub/mul/div/mod/pow,
+* basic arithmetic operations add/sub/mul/pow,
 * a few `Nat`-related operations such as `negOfNat` and `subNatNat`,
 * relations `<`/`≤`/`≥`/`>`, the `NonNeg` property and `min`/`max`,
 * decidability of equality, relations and `NonNeg`.
+
+Division and modulus operations are defined in `Init.Data.Int.DivMod.Basic`.
 -/
 
 /--

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

@@ -27,7 +27,7 @@ theorem shiftRight_eq_div_pow (m : Int) (n : Nat) :
     m >>> n = m / ((2 ^ n) : Nat) := by
   simp only [shiftRight_eq, Int.shiftRight, Nat.shiftRight_eq_div_pow]
   split
-  · simp
+  · simp; norm_cast
   · rw [negSucc_ediv _ (by norm_cast; exact Nat.pow_pos (Nat.zero_lt_two))]
     rfl
 
@@ -39,4 +39,47 @@ theorem zero_shiftRight (n : Nat) : (0 : Int) >>> n = 0 := by
 theorem shiftRight_zero (n : Int) : n >>> 0 = n := by
   simp [Int.shiftRight_eq_div_pow]
 
+theorem le_shiftRight_of_nonpos {n : Int} {s : Nat} (h : n ≤ 0) : n ≤ n >>> s := by
+  simp only [Int.shiftRight_eq, Int.shiftRight, Int.ofNat_eq_coe]
+  split
+  case _ _ _ m =>
+    simp only [ofNat_eq_coe] at h
+    by_cases hm : m = 0
+    · simp [hm]
+    · omega
+  case _ _ _ m =>
+    by_cases hm : m = 0
+    · simp [hm]
+    · have := Nat.shiftRight_le m s
+      omega
+
+theorem shiftRight_le_of_nonneg {n : Int} {s : Nat} (h : 0 ≤ n) : n >>> s ≤ n := by
+  simp only [Int.shiftRight_eq, Int.shiftRight, Int.ofNat_eq_coe]
+  split
+  case _ _ _ m =>
+    simp only [Int.ofNat_eq_coe] at h
+    by_cases hm : m = 0
+    · simp [hm]
+    · have := Nat.shiftRight_le m s
+      simp
+      omega
+  case _ _ _ m =>
+    omega
+
+theorem le_shiftRight_of_nonneg {n : Int} {s : Nat} (h : 0 ≤ n) : 0 ≤ (n >>> s) := by
+  rw [Int.shiftRight_eq_div_pow]
+  by_cases h' : s = 0
+  · simp [h', h]
+  · have := @Nat.pow_pos 2 s (by omega)
+    have := @Int.ediv_nonneg n (2^s) h (by norm_cast at *; omega)
+    norm_cast at *
+
+theorem shiftRight_le_of_nonpos {n : Int} {s : Nat} (h : n ≤ 0) : (n >>> s) ≤ 0 := by
+  rw [Int.shiftRight_eq_div_pow]
+  by_cases h' : s = 0
+  · simp [h', h]
+  · have : 1 < 2 ^ s := Nat.one_lt_two_pow (by omega)
+    have rl : n / 2 ^ s ≤ 0 := Int.ediv_nonpos_of_nonpos_of_neg (by omega) (by norm_cast at *; omega)
+    norm_cast at *
+
 end Int

src/Init/Data/Int/Cooper.lean

@@ -227,33 +227,4 @@ theorem cooper_resolution_dvd_right
     · exact Int.mul_neg _ _ ▸ Int.neg_le_of_neg_le lower
     · exact Int.mul_neg _ _ ▸ Int.neg_mul _ _ ▸ dvd
 
-/--
-Left Cooper resolution of an upper and lower bound.
--/
-theorem cooper_resolution_left
-    {a b p q : Int} (a_pos : 0 < a) (b_pos : 0 < b) :
-    (∃ x, p ≤ a * x ∧ b * x ≤ q) ↔
-    (∃ k : Int, 0 ≤ k ∧ k < a ∧ b * k + b * p ≤ a * q ∧ a ∣ k + p) := by
-  have h := cooper_resolution_dvd_left
-    a_pos b_pos Int.zero_lt_one (c := 1) (s := 0) (p := p) (q := q)
-  simp only [Int.mul_one, Int.one_mul, Int.mul_zero, Int.add_zero, gcd_one, Int.ofNat_one,
-    Int.ediv_one, lcm_self, Int.natAbs_of_nonneg (Int.le_of_lt a_pos), Int.one_dvd, and_true,
-    and_self] at h
-  exact h
-
-/--
-Right Cooper resolution of an upper and lower bound.
--/
-theorem cooper_resolution_right
-    {a b p q : Int} (a_pos : 0 < a) (b_pos : 0 < b) :
-    (∃ x, p ≤ a * x ∧ b * x ≤ q) ↔
-    (∃ k : Int, 0 ≤ k ∧ k < b ∧ a * k + b * p ≤ a * q ∧ b ∣ k - q) := by
-  have h := cooper_resolution_dvd_right
-    a_pos b_pos Int.zero_lt_one (c := 1) (s := 0) (p := p) (q := q)
-  have : ∀ k : Int, (b ∣ -k + q) ↔ (b ∣ k - q) := by
-    intro k
-    rw [← Int.dvd_neg, Int.neg_add, Int.neg_neg, Int.sub_eq_add_neg]
-  simp only [Int.mul_one, Int.one_mul, Int.mul_zero, Int.add_zero, gcd_one, Int.ofNat_one,
-    Int.ediv_one, lcm_self, Int.natAbs_of_nonneg (Int.le_of_lt b_pos), Int.one_dvd, and_true,
-    and_self, ← Int.neg_eq_neg_one_mul, this] at h
-  exact h
+end Int

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

@@ -21,26 +21,28 @@ and satisfy `x / 0 = 0` and `x % 0 = x`.
 In early versions of Lean, the typeclasses provided by `/` and `%`
 were defined in terms of `tdiv` and `tmod`, and these were named simply as `div` and `mod`.
 
-However we decided it was better to use `ediv` and `emod`,
+However we decided it was better to use `ediv` and `emod` for the default typeclass instances,
 as they are consistent with the conventions used in SMTLib, and Mathlib,
 and often mathematical reasoning is easier with these conventions.
-
 At that time, we did not rename `div` and `mod` to `tdiv` and `tmod` (along with all their lemma).
+
 In September 2024, we decided to do this rename (with deprecations in place),
 and later we intend to rename `ediv` and `emod` to `div` and `mod`, as nearly all users will only
 ever need to use these functions and their associated lemmas.
 
-In December 2024, we removed `tdiv` and `tmod`, but have not yet renamed `ediv` and `emod`.
+In December 2024, we removed `div` and `mod`, but have not yet renamed `ediv` and `emod`.
 -/
 
 /-! ### E-rounding division
-This pair satisfies `0 ≤ mod x y < natAbs y` for `y ≠ 0`.
+This pair satisfies `0 ≤ emod x y < natAbs y` for `y ≠ 0`.
 -/
 
 /--
-Integer division. This version of `Int.div` uses the E-rounding convention
-(euclidean division), in which `Int.emod x y` satisfies `0 ≤ mod x y < natAbs y` for `y ≠ 0`
-and `Int.ediv` is the unique function satisfying `emod x y + (ediv x y) * y = x`.
+Integer division. This version of integer division uses the E-rounding convention
+(euclidean division), in which `Int.emod x y` satisfies `0 ≤ emod x y < natAbs y` for `y ≠ 0`
+and `Int.ediv` is the unique function satisfying `emod x y + (ediv x y) * y = x` for `y ≠ 0`.
+
+This means that `Int.ediv x y = floor (x / y)` when `y > 0` and `Int.ediv x y = ceil (x / y)` when `y < 0`.
 
 This is the function powering the `/` notation on integers.
 
@@ -71,7 +73,7 @@ def ediv : (@& Int) → (@& Int) → Int
   | -[m+1],  -[n+1]  => ofNat (succ (m / succ n))
 
 /--
-Integer modulus. This version of `Int.mod` uses the E-rounding convention
+Integer modulus. This version of integer modulus uses the E-rounding convention
 (euclidean division), in which `Int.emod x y` satisfies `0 ≤ emod x y < natAbs y` for `y ≠ 0`
 and `Int.ediv` is the unique function satisfying `emod x y + (ediv x y) * y = x`.
 
@@ -109,7 +111,7 @@ instance : Div Int where
 instance : Mod Int where
   mod := Int.emod
 
-@[simp, norm_cast] theorem ofNat_ediv (m n : Nat) : (↑(m / n) : Int) = ↑m / ↑n := rfl
+@[norm_cast] theorem ofNat_ediv (m n : Nat) : (↑(m / n) : Int) = ↑m / ↑n := rfl
 
 theorem ofNat_ediv_ofNat {a b : Nat} : (↑a / ↑b : Int) = (a / b : Nat) := rfl
 @[norm_cast]
@@ -165,6 +167,9 @@ def tdiv : (@& Int) → (@& Int) → Int
   unconditionally (see [`Int.tmod_add_tdiv`][theo tmod_add_tdiv]). In
   particular, `a % 0 = a`.
 
+  `tmod` satisfies `natAbs (tmod a b) = natAbs a % natAbs b`,
+  and when `b` does not divide `a`, `tmod a b` has the same sign as `a`.
+
   [t-rounding]: https://dl.acm.org/doi/pdf/10.1145/128861.128862
   [theo tmod_add_tdiv]: https://leanprover-community.github.io/mathlib4_docs/find/?pattern=Int.tmod_add_tdiv#doc
 
@@ -229,7 +234,7 @@ def fdiv : Int → Int → Int
   | -[m+1],  -[n+1]  => ofNat (succ m / succ n)
 
 /--
-Integer modulus. This version of `Int.mod` uses the F-rounding convention
+Integer modulus. This version of integer modulus uses the F-rounding convention
 (flooring division), in which `Int.fdiv x y` satisfies `fdiv x y = floor (x / y)`
 and `Int.fmod` is the unique function satisfying `fmod x y + (fdiv x y) * y = x`.
 
@@ -268,11 +273,14 @@ Balanced mod (and balanced div) are a division and modulus pair such
 that `b * (Int.bdiv a b) + Int.bmod a b = a` and
 `-b/2 ≤ Int.bmod a b < b/2` for all `a : Int` and `b > 0`.
 
-This is used in Omega as well as signed bitvectors.
+Note that unlike `emod`, `fmod`, and `tmod`,
+`bmod` takes a natural number as the second argument, rather than an integer.
+
+This function is used in `omega` as well as signed bitvectors.
 -/
 
 /--
-Balanced modulus.  This version of Integer modulus uses the
+Balanced modulus.  This version of integer modulus uses the
 balanced rounding convention, which guarantees that
 `-m/2 ≤ bmod x m < m/2` for `m ≠ 0` and `bmod x m` is congruent
 to `x` modulo `m`.

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

@@ -18,7 +18,7 @@ open Nat (succ)
 
 namespace Int
 
--- /-! ### dvd  -/
+/-! ### dvd  -/
 
 protected theorem dvd_def (a b : Int) : (a ∣ b) = Exists (fun c => b = a * c) := rfl
 
@@ -53,7 +53,7 @@ protected theorem dvd_mul_left (a b : Int) : b ∣ a * b := ⟨_, Int.mul_comm .
   constructor <;> exact fun ⟨k, e⟩ =>
     ⟨-k, by simp [e, Int.neg_mul, Int.mul_neg, Int.neg_neg]⟩
 
-protected theorem dvd_neg {a b : Int} : a ∣ -b ↔ a ∣ b := by
+@[simp] protected theorem dvd_neg {a b : Int} : a ∣ -b ↔ a ∣ b := by
   constructor <;> exact fun ⟨k, e⟩ =>
     ⟨-k, by simp [← e, Int.neg_mul, Int.mul_neg, Int.neg_neg]⟩
 
@@ -67,7 +67,7 @@ protected theorem dvd_neg {a b : Int} : a ∣ -b ↔ a ∣ b := by
 theorem ofNat_dvd_left {n : Nat} {z : Int} : (↑n : Int) ∣ z ↔ n ∣ z.natAbs := by
   rw [← natAbs_dvd_natAbs, natAbs_ofNat]
 
-/-! ### *div zero  -/
+/-! ### ediv zero  -/
 
 @[simp] theorem zero_ediv : ∀ b : Int, 0 / b = 0
   | ofNat _ => show ofNat _ = _ by simp
@@ -77,7 +77,7 @@ theorem ofNat_dvd_left {n : Nat} {z : Int} : (↑n : Int) ∣ z ↔ n ∣ z.natA
   | ofNat _ => show ofNat _ = _ by simp
   | -[_+1] => rfl
 
-/-! ### mod zero -/
+/-! ### emod zero -/
 
 @[simp] theorem zero_emod (b : Int) : 0 % b = 0 := rfl
 
@@ -89,7 +89,6 @@ theorem ofNat_dvd_left {n : Nat} {z : Int} : (↑n : Int) ∣ z ↔ n ∣ z.natA
 
 @[simp, norm_cast] theorem ofNat_emod (m n : Nat) : (↑(m % n) : Int) = m % n := rfl
 
-
 /-! ### mod definitions -/
 
 theorem emod_add_ediv : ∀ a b : Int, a % b + b * (a / b) = a
@@ -106,18 +105,23 @@ where
       ← Int.neg_neg (_-_), Int.neg_sub, Int.sub_sub_self, Int.add_right_comm]
     exact congrArg (fun x => -(ofNat x + 1)) (Nat.mod_add_div ..)
 
+/-- Variant of `emod_add_ediv` with the multiplication written the other way around. -/
 theorem emod_add_ediv' (a b : Int) : a % b + a / b * b = a := by
   rw [Int.mul_comm]; exact emod_add_ediv ..
 
 theorem ediv_add_emod (a b : Int) : b * (a / b) + a % b = a := by
   rw [Int.add_comm]; exact emod_add_ediv ..
 
+/-- Variant of `ediv_add_emod` with the multiplication written the other way around. -/
+theorem ediv_add_emod' (a b : Int) : a / b * b + a % b = a := by
+  rw [Int.mul_comm]; exact ediv_add_emod ..
+
 theorem emod_def (a b : Int) : a % b = a - b * (a / b) := by
   rw [← Int.add_sub_cancel (a % b), emod_add_ediv]
 
 /-! ### `/` ediv -/
 
-@[simp] protected theorem ediv_neg : ∀ a b : Int, a / (-b) = -(a / b)
+@[simp] theorem ediv_neg : ∀ a b : Int, a / (-b) = -(a / b)
   | ofNat m, 0 => show ofNat (m / 0) = -↑(m / 0) by rw [Nat.div_zero]; rfl
   | ofNat _, -[_+1] => (Int.neg_neg _).symm
   | ofNat _, succ _ | -[_+1], 0 | -[_+1], succ _ | -[_+1], -[_+1] => rfl
@@ -154,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
@@ -170,13 +178,14 @@ theorem add_ediv_of_dvd_left {a b c : Int} (H : c ∣ a) : (a + b) / c = a / c +
 @[simp] theorem mul_ediv_cancel_left (b : Int) (H : a ≠ 0) : (a * b) / a = b :=
   Int.mul_comm .. ▸ Int.mul_ediv_cancel _ H
 
-theorem div_nonneg_iff_of_pos {a b : Int} (h : 0 < b) : a / b ≥ 0 ↔ a ≥ 0 := by
+theorem ediv_nonneg_iff_of_pos {a b : Int} (h : 0 < b) : 0 ≤ a / b ↔ 0 ≤ a := by
   rw [Int.div_def]
   match b, h with
   | Int.ofNat (b+1), _ =>
     rcases a with ⟨a⟩ <;> simp [Int.ediv]
-    norm_cast
-    simp
+
+@[deprecated ediv_nonneg_iff_of_pos (since := "2025-02-28")]
+abbrev div_nonneg_iff_of_pos := @ediv_nonneg_iff_of_pos
 
 /-! ### emod -/
 
@@ -189,16 +198,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]
@@ -306,6 +305,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/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)
@@ -91,7 +91,7 @@ theorem add_neg_one (i : Int) : i + -1 = i - 1 := rfl
 
 /- ## basic properties of subNatNat -/
 
--- @[elabAsElim] -- TODO(Mario): unexpected eliminator resulting type
+@[elab_as_elim]
 theorem subNatNat_elim (m n : Nat) (motive : Nat → Nat → Int → Prop)
     (hp : ∀ i n, motive (n + i) n i)
     (hn : ∀ i m, motive m (m + i + 1) -[i+1]) :
@@ -269,6 +269,17 @@ protected theorem add_left_cancel {a b c : Int} (h : a + b = a + c) : b = c := b
   rw [Int.add_right_neg, Int.add_comm a, ← Int.add_assoc, Int.add_assoc b,
     Int.add_right_neg, Int.add_zero, Int.add_right_neg]
 
+/--
+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
+
 /- ## subtraction -/
 
 @[simp] theorem negSucc_sub_one (n : Nat) : -[n+1] - 1 = -[n + 1 +1] := rfl

src/Init/Data/Int/LemmasAux.lean

@@ -46,4 +46,52 @@ theorem bmod_neg_iff {m : Nat} {x : Int} (h2 : -m ≤ x) (h1 : x < m) :
   · rw [Int.emod_eq_of_lt xpos (by omega)]; omega
   · rw [Int.add_emod_self.symm, Int.emod_eq_of_lt (by omega) (by omega)]; omega
 
+@[simp] theorem natCast_le_zero : {n : Nat} → (n : Int) ≤ 0 ↔ n = 0 := by omega
+
+@[simp] theorem toNat_eq_zero : ∀ {n : Int}, n.toNat = 0 ↔ n ≤ 0 := by omega
+
+theorem eq_zero_of_dvd_of_natAbs_lt_natAbs {d n : Int} (h : d ∣ n) (h₁ : n.natAbs < d.natAbs) :
+    n = 0 := by
+  obtain ⟨a, rfl⟩ := h
+  rw [natAbs_mul] at h₁
+  suffices ¬ 0 < a.natAbs by simp [Int.natAbs_eq_zero.1 (Nat.eq_zero_of_not_pos this)]
+  exact fun h => Nat.lt_irrefl _ (Nat.lt_of_le_of_lt (Nat.le_mul_of_pos_right d.natAbs h) h₁)
+
+theorem bmod_eq_self_of_le {n : Int} {m : Nat} (hn' : -(m / 2) ≤ n) (hn : n < (m + 1) / 2) :
+    n.bmod m = n := by
+  rw [← Int.sub_eq_zero]
+  have := le_bmod (x := n) (m := m) (by omega)
+  have := bmod_lt (x := n) (m := m) (by omega)
+  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
+
+@[simp] protected theorem neg_nonpos_iff (i : Int) : -i ≤ 0 ↔ 0 ≤ i := by omega
+
+@[simp] theorem zero_le_ofNat (n : Nat) : 0 ≤ ((no_index (OfNat.ofNat n)) : Int) :=
+  ofNat_nonneg _
+
+@[simp] theorem neg_natCast_le_natCast (n m : Nat) : -(n : Int) ≤ (m : Int) :=
+  Int.le_trans (by simp) (ofNat_zero_le m)
+
+@[simp] theorem neg_natCast_le_ofNat (n m : Nat) : -(n : Int) ≤ (no_index (OfNat.ofNat m)) :=
+  Int.le_trans (by simp) (ofNat_zero_le m)
+
+@[simp] theorem neg_ofNat_le_ofNat (n m : Nat) : -(no_index (OfNat.ofNat n)) ≤ (no_index (OfNat.ofNat m)) :=
+  Int.le_trans (by simp) (ofNat_zero_le m)
+
+@[simp] theorem neg_ofNat_le_natCast (n m : Nat) : -(no_index (OfNat.ofNat n)) ≤ (m : Int) :=
+  Int.le_trans (by simp) (ofNat_zero_le m)
+
 end Int

src/Init/Data/Int/Linear.lean

@@ -9,6 +9,7 @@ import Init.Data.Prod
 import Init.Data.Int.Lemmas
 import Init.Data.Int.LemmasAux
 import Init.Data.Int.DivMod.Bootstrap
+import Init.Data.Int.Cooper
 import Init.Data.Int.Gcd
 import Init.Data.RArray
 import Init.Data.AC
@@ -186,14 +187,13 @@ theorem cmod_gt_of_pos (a : Int) {b : Int} (h : 0 < b) : cmod a b > -b :=
 
 theorem cmod_nonpos (a : Int) {b : Int} (h : b ≠ 0) : cmod a b ≤ 0 := by
   have := Int.neg_le_neg (Int.emod_nonneg (-a) h)
-  simp at this
-  assumption
+  simpa [cmod] using this
 
 theorem cmod_eq_zero_iff_emod_eq_zero (a b : Int) : cmod a b = 0 ↔ a%b = 0 := by
   unfold cmod
   have := @Int.emod_eq_emod_iff_emod_sub_eq_zero  b b a
   simp at this
-  simp [Int.neg_emod, ← this, Eq.comm]
+  simp [Int.neg_emod_eq_sub_emod, ← this, Eq.comm]
 
 private abbrev div_mul_cancel_of_mod_zero :=
   @Int.ediv_mul_cancel_of_emod_eq_zero
@@ -250,14 +250,24 @@ def Poly.divCoeffs (k : Int) : Poly → Bool
 /--
 `p.mul k` multiplies all coefficients and constant of the polynomial `p` by `k`.
 -/
-def Poly.mul (p : Poly) (k : Int) : Poly :=
+def Poly.mul' (p : Poly) (k : Int) : Poly :=
   match p with
   | .num k' => .num (k*k')
-  | .add k' v p => .add (k*k') v (mul p k)
+  | .add k' v p => .add (k*k') v (mul' p k)
+
+def Poly.mul (p : Poly) (k : Int) : Poly :=
+  if k == 0 then
+    .num 0
+  else
+    p.mul' k
 
 @[simp] theorem Poly.denote_mul (ctx : Context) (p : Poly) (k : Int) : (p.mul k).denote ctx = k * p.denote ctx := by
-  induction p <;> simp [mul, denote, *]
-  rw [Int.mul_assoc, Int.mul_add]
+  simp [mul]
+  split
+  next => simp [*, denote]
+  next =>
+    induction p <;> simp [mul', denote, *]
+    rw [Int.mul_assoc, Int.mul_add]
 
 attribute [local simp] Int.add_comm Int.add_assoc Int.add_left_comm Int.add_mul Int.mul_add
 attribute [local simp] Poly.insert Poly.denote Poly.norm Poly.addConst
@@ -531,8 +541,9 @@ def Poly.isValidLe (p : Poly) : Bool :=
   | .num k => k ≤ 0
   | _ => false
 
+attribute [-simp] Int.not_le in
 theorem le_eq_false (ctx : Context) (lhs rhs : Expr) : (lhs.sub rhs).norm.isUnsatLe → (lhs.denote ctx ≤ rhs.denote ctx) = False := by
-  simp [Poly.isUnsatLe] <;> split <;> simp
+  simp only [Poly.isUnsatLe] <;> split <;> simp
   next p k h =>
     intro h'
     replace h := congrArg (Poly.denote ctx) h
@@ -820,7 +831,7 @@ def le_neg_cert (p₁ p₂ : Poly) : Bool :=
 theorem le_neg (ctx : Context) (p₁ p₂ : Poly) : le_neg_cert p₁ p₂ → ¬ p₁.denote' ctx ≤ 0 → p₂.denote' ctx ≤ 0 := by
   simp [le_neg_cert]
   intro; subst p₂; simp; intro h
-  replace h : _ + 1 ≤ -0 := Int.neg_lt_neg <| Int.lt_of_not_ge h
+  replace h : _ + 1 ≤ -0 := Int.neg_lt_neg h
   simp at h
   exact h
 
@@ -844,11 +855,28 @@ theorem le_combine (ctx : Context) (p₁ p₂ p₃ : Poly)
   · rw [← Int.zero_mul (Poly.denote ctx p₂)]; apply Int.mul_le_mul_of_nonpos_right <;> simp [*]
   · rw [← Int.zero_mul (Poly.denote ctx p₁)]; apply Int.mul_le_mul_of_nonpos_right <;> simp [*]
 
+def le_combine_coeff_cert (p₁ p₂ p₃ : Poly) (k : Int) : Bool :=
+  let a₁ := p₁.leadCoeff.natAbs
+  let a₂ := p₂.leadCoeff.natAbs
+  let p  := p₁.mul a₂ |>.combine (p₂.mul a₁)
+  k > 0 && (p.divCoeffs k && p₃ == p.div k)
+
+theorem le_combine_coeff (ctx : Context) (p₁ p₂ p₃ : Poly) (k : Int)
+    : le_combine_coeff_cert p₁ p₂ p₃ k → p₁.denote' ctx ≤ 0 → p₂.denote' ctx ≤ 0 → p₃.denote' ctx ≤ 0 := by
+  simp only [le_combine_coeff_cert, gt_iff_lt, Bool.and_eq_true, decide_eq_true_eq, beq_iff_eq, and_imp]
+  let a₁ := p₁.leadCoeff.natAbs
+  let a₂ := p₂.leadCoeff.natAbs
+  generalize h : (p₁.mul a₂ |>.combine (p₂.mul a₁)) = p
+  intro h₁ h₂ h₃ h₄ h₅
+  have := le_combine ctx p₁ p₂ p
+  simp only [le_combine_cert, beq_iff_eq] at this
+  have aux₁ := this h.symm h₄ h₅
+  have := le_coeff ctx p p₃ k
+  simp only [le_coeff_cert, gt_iff_lt, Bool.and_eq_true, decide_eq_true_eq, beq_iff_eq, and_imp] at this
+  exact this h₁ h₂ h₃ aux₁
+
 theorem le_unsat (ctx : Context) (p : Poly) : p.isUnsatLe → p.denote' ctx ≤ 0 → False := by
   simp [Poly.isUnsatLe]; split <;> simp
-  intro h₁ h₂
-  have := Int.lt_of_le_of_lt h₂ h₁
-  simp at this
 
 theorem eq_norm (ctx : Context) (p₁ p₂ : Poly) (h : p₁.norm == p₂) : p₁.denote' ctx = 0 → p₂.denote' ctx = 0 := by
   simp at h
@@ -990,7 +1018,7 @@ theorem eq_le_subst_nonpos (ctx : Context) (x : Var) (p₁ : Poly) (p₂ : Poly)
   intro h
   intro; subst p₃
   intro h₁ h₂
-  simp [*]
+  simp [*, -Int.neg_nonpos_iff]
   replace h₂ := Int.mul_le_mul_of_nonpos_left h₂ h; simp at h₂; clear h
   rw [← Int.neg_zero]
   apply Int.neg_le_neg
@@ -1021,6 +1049,9 @@ theorem diseq_coeff (ctx : Context) (p p' : Poly) (k : Int) : eq_coeff_cert p p'
   simp [eq_coeff_cert]
   intro _ _; simp [mul_eq_zero_iff, *]
 
+theorem diseq_neg (ctx : Context) (p p' : Poly) : p' == p.mul (-1) → p.denote' ctx ≠ 0 → p'.denote' ctx ≠ 0 := by
+  simp; intro _ _; simp [mul_eq_zero_iff, *]
+
 theorem diseq_unsat (ctx : Context) (p : Poly) : p.isUnsatDiseq → p.denote' ctx ≠ 0 → False := by
   simp [Poly.isUnsatDiseq] <;> split <;> simp
 
@@ -1049,7 +1080,7 @@ def eq_of_le_ge_cert (p₁ p₂ : Poly) : Bool :=
 theorem eq_of_le_ge (ctx : Context) (p₁ : Poly) (p₂ : Poly)
     : eq_of_le_ge_cert p₁ p₂ → p₁.denote' ctx ≤ 0 → p₂.denote' ctx ≤ 0 → p₁.denote' ctx = 0 := by
   simp [eq_of_le_ge_cert]
-  intro; subst p₂; simp
+  intro; subst p₂; simp [-Int.neg_nonpos_iff]
   intro h₁ h₂
   replace h₂ := Int.neg_le_of_neg_le h₂; simp at h₂
   simp [Int.eq_iff_le_and_ge, *]
@@ -1068,6 +1099,650 @@ theorem le_of_le_diseq (ctx : Context) (p₁ : Poly) (p₂ : Poly) (p₃ : Poly)
     next h => have := Int.lt_of_le_of_lt h₁ h; simp at this
   intro h; cases h <;> intro <;> subst p₂ p₃ <;> simp <;> apply this
 
+def diseq_split_cert (p₁ p₂ p₃ : Poly) : Bool :=
+  p₂ == p₁.addConst 1 &&
+  p₃ == (p₁.mul (-1)).addConst 1
+
+theorem diseq_split (ctx : Context) (p₁ p₂ p₃ : Poly)
+    : diseq_split_cert p₁ p₂ p₃ → p₁.denote' ctx ≠ 0 → p₂.denote' ctx ≤ 0 ∨ p₃.denote' ctx ≤ 0 := by
+  simp [diseq_split_cert]
+  intro _ _; subst p₂ p₃; simp
+  generalize p₁.denote ctx = p
+  intro h; cases Int.lt_or_gt_of_ne h
+  next h => have := Int.add_one_le_of_lt h; rw [Int.add_comm]; simp [*]
+  next h => have := Int.add_one_le_of_lt (Int.neg_lt_neg h); simp at this; simp [*]
+
+theorem diseq_split_resolve (ctx : Context) (p₁ p₂ p₃ : Poly)
+    : diseq_split_cert p₁ p₂ p₃ → p₁.denote' ctx ≠ 0 → ¬p₂.denote' ctx ≤ 0 → p₃.denote' ctx ≤ 0 := by
+  intro h₁ h₂ h₃
+  exact (diseq_split ctx p₁ p₂ p₃ h₁ h₂).resolve_left h₃
+
+def OrOver (n : Nat) (p : Nat → Prop) : Prop :=
+  match n with
+  | 0 => False
+  | n+1 => p n ∨ OrOver n p
+
+theorem orOver_one {p} : OrOver 1 p → p 0 := by simp [OrOver]
+
+theorem orOver_resolve {n p} : OrOver (n+1) p → ¬ p n → OrOver n p := by
+  intro h₁ h₂
+  rw [OrOver] at h₁
+  cases h₁
+  · contradiction
+  · assumption
+
+def OrOver_cases_type (n : Nat) (p : Nat → Prop) : Prop :=
+  match n with
+  | 0 => p 0
+  | n+1 => ¬ p (n+1) → OrOver_cases_type n p
+
+theorem orOver_cases {n p} : OrOver (n+1) p → OrOver_cases_type n p := by
+  induction n <;> simp [OrOver_cases_type]
+  next => exact orOver_one
+  next n ih => intro h₁ h₂; exact ih (orOver_resolve h₁ h₂)
+
+private theorem orOver_of_p {i n p} (h₁ : i < n) (h₂ : p i) : OrOver n p := by
+  induction n
+  next => simp at h₁
+  next n ih =>
+    simp [OrOver]
+    cases Nat.eq_or_lt_of_le <| Nat.le_of_lt_add_one h₁
+    next h => subst i; exact Or.inl h₂
+    next h => exact Or.inr (ih h)
+
+private theorem orOver_of_exists {n p} : (∃ k, k < n ∧ p k) → OrOver n p := by
+  intro ⟨k, h₁, h₂⟩
+  apply orOver_of_p h₁ h₂
+
+private theorem ofNat_toNat {a : Int} : a ≥ 0 → Int.ofNat a.toNat = a := by cases a <;> simp
+private theorem cast_toNat {a : Int} : a ≥ 0 → a.toNat = a := by cases a <;> simp
+private theorem ofNat_lt {a : Int} {n : Nat} : a ≥ 0 → a < Int.ofNat n → a.toNat < n := by cases a <;> simp
+@[local simp] private theorem lcm_neg_left (a b : Int) : Int.lcm (-a) b = Int.lcm a b := by simp [Int.lcm]
+@[local simp] private theorem lcm_neg_right (a b : Int) : Int.lcm a (-b) = Int.lcm a b := by simp [Int.lcm]
+@[local simp] private theorem gcd_neg_left (a b : Int) : Int.gcd (-a) b = Int.gcd a b := by simp [Int.gcd]
+@[local simp] private theorem gcd_neg_right (a b : Int) : Int.gcd a (-b) = Int.gcd a b := by simp [Int.gcd]
+@[local simp] private theorem gcd_zero (a : Int) : Int.gcd a 0 = a.natAbs := by simp [Int.gcd]
+@[local simp] private theorem lcm_one (a : Int) : Int.lcm a 1 = a.natAbs := by simp [Int.lcm]
+
+private theorem cooper_dvd_left_core
+    {a b c d s p q x : Int} (a_neg : a < 0) (b_pos : 0 < b) (d_pos : 0 < d)
+    (h₁ : a * x + p ≤ 0)
+    (h₂ : b * x + q ≤ 0)
+    (h₃ : d ∣ c * x + s)
+    : OrOver (Int.lcm a (a * d / Int.gcd (a * d) c)) fun k =>
+        b * p + (-a) * q + b * k ≤ 0 ∧
+        a ∣ p + k ∧
+        a * d ∣ c * p + (-a) * s + c * k := by
+  have a_pos' : 0 < -a := by apply Int.neg_pos_of_neg; assumption
+  have h₁'    : p ≤ (-a)*x := by rw [Int.neg_mul, ← Lean.Omega.Int.add_le_zero_iff_le_neg']; assumption
+  have h₂'    : b * x ≤ -q := by rw [← Lean.Omega.Int.add_le_zero_iff_le_neg', Int.add_comm]; assumption
+  have ⟨k, h₁, h₂, h₃, h₄, h₅⟩ := Int.cooper_resolution_dvd_left a_pos' b_pos d_pos |>.mp ⟨x, h₁', h₂', h₃⟩
+  rw [Int.neg_mul] at h₂
+  simp only [Int.neg_mul, neg_gcd, lcm_neg_left, Int.mul_neg, Int.neg_neg, Int.neg_dvd] at *
+  rw [Int.neg_ediv_of_dvd Int.gcd_dvd_left] at h₂
+  simp only [lcm_neg_right] at h₂
+  have : c * k + c * p + -(a * s) = c * p + -(a * s) + c * k := by ac_rfl
+  rw [this] at h₅; clear this
+  rw [← ofNat_toNat h₁] at h₃ h₄ h₅
+  rw [Int.add_comm] at h₄
+  have := ofNat_lt h₁ h₂
+  apply orOver_of_exists
+  replace h₃ := Int.add_le_add_right h₃ (-(a*q)); rw [Int.add_right_neg] at h₃
+  have : b * Int.ofNat k.toNat + b * p + -(a * q) = b * p + -(a * q) + b * Int.ofNat k.toNat := by ac_rfl
+  rw [this] at h₃
+  exists k.toNat
+
+def cooper_dvd_left_cert (p₁ p₂ p₃ : Poly) (d : Int) (n : Nat) : Bool :=
+  p₁.casesOn (fun _ => false) fun a x _ =>
+  p₂.casesOn (fun _ => false) fun b y _ =>
+  p₃.casesOn (fun _ => false) fun c z _ =>
+   .and (x == y) <| .and (x == z) <|
+   .and (a < 0)  <| .and (b > 0)  <|
+   .and (d > 0)  <| n == Int.lcm a (a * d / Int.gcd (a * d) c)
+
+def Poly.tail (p : Poly) : Poly :=
+  match p with
+  | .add _ _ p => p
+  | _ => p
+
+def cooper_dvd_left_split (ctx : Context) (p₁ p₂ p₃ : Poly) (d : Int) (k : Nat) : Prop :=
+  let p  := p₁.tail
+  let q  := p₂.tail
+  let s  := p₃.tail
+  let a  := p₁.leadCoeff
+  let b  := p₂.leadCoeff
+  let c  := p₃.leadCoeff
+  let p₁ := p.mul b |>.combine (q.mul (-a))
+  let p₂ := p.mul c |>.combine (s.mul (-a))
+  (p₁.addConst (b*k)).denote' ctx ≤ 0
+  ∧ a ∣ (p.addConst k).denote' ctx
+  ∧ a*d ∣ (p₂.addConst (c*k)).denote' ctx
+
+private theorem denote'_mul_combine_mul_addConst_eq (ctx : Context) (p q : Poly) (a b c : Int)
+    : ((p.mul b |>.combine (q.mul a)).addConst c).denote' ctx = b*p.denote ctx + a*q.denote ctx + c := by
+  simp
+
+private theorem denote'_addConst_eq (ctx : Context) (p : Poly) (a : Int)
+    : (p.addConst a).denote' ctx = p.denote ctx + a := by
+  simp
+
+theorem cooper_dvd_left (ctx : Context) (p₁ p₂ p₃ : Poly) (d : Int) (n : Nat)
+    : cooper_dvd_left_cert p₁ p₂ p₃ d n
+      → p₁.denote' ctx ≤ 0
+      → p₂.denote' ctx ≤ 0
+      → d ∣ p₃.denote' ctx
+      → OrOver n (cooper_dvd_left_split ctx p₁ p₂ p₃ d) := by
+ unfold cooper_dvd_left_split
+ cases p₁ <;> cases p₂ <;> cases p₃ <;> simp [cooper_dvd_left_cert, Poly.tail, -Poly.denote'_eq_denote]
+ next a x p b y q c z s =>
+ intro _ _; subst y z
+ intro ha hb hd
+ intro; subst n
+ simp only [Poly.denote'_add, Poly.leadCoeff]
+ intro h₁ h₂ h₃
+ simp only [denote'_mul_combine_mul_addConst_eq]
+ simp only [denote'_addConst_eq]
+ exact cooper_dvd_left_core ha hb hd h₁ h₂ h₃
+
+def cooper_dvd_left_split_ineq_cert (p₁ p₂ : Poly) (k : Int) (b : Int) (p' : Poly) : Bool :=
+  let p  := p₁.tail
+  let q  := p₂.tail
+  let a  := p₁.leadCoeff
+  let p₁ := p.mul b |>.combine (q.mul (-a))
+  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
+  simp [cooper_dvd_left_split_ineq_cert, cooper_dvd_left_split]
+  intros; subst p' b; simp [denote'_mul_combine_mul_addConst_eq]; assumption
+
+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
+  simp [cooper_dvd_left_split_dvd1_cert, cooper_dvd_left_split]
+  intros; subst a p'; simp; assumption
+
+def cooper_dvd_left_split_dvd2_cert (p₁ p₃ : Poly) (d : Int) (k : Nat) (d' : Int) (p' : Poly): Bool :=
+  let p  := p₁.tail
+  let s  := p₃.tail
+  let a  := p₁.leadCoeff
+  let c  := p₃.leadCoeff
+  let p₂ := p.mul c |>.combine (s.mul (-a))
+  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
+  simp [cooper_dvd_left_split_dvd2_cert, cooper_dvd_left_split]
+  intros; subst d' p'; simp; assumption
+
+private theorem cooper_left_core
+    {a b p q x : Int} (a_neg : a < 0) (b_pos : 0 < b)
+    (h₁ : a * x + p ≤ 0)
+    (h₂ : b * x + q ≤ 0)
+    : OrOver a.natAbs fun k =>
+        b * p + (-a) * q + b * k ≤ 0 ∧
+        a ∣ p + k := by
+  have d_pos : (0 : Int) < 1 := by decide
+  have h₃ : 1 ∣ 0*x + 0 := Int.one_dvd _
+  have h := cooper_dvd_left_core a_neg b_pos d_pos h₁ h₂ h₃
+  simp only [Int.mul_one, gcd_zero, ofNat_natAbs_of_nonpos (Int.le_of_lt a_neg), Int.ediv_neg,
+    Int.ediv_self (Int.ne_of_lt a_neg), Int.reduceNeg, lcm_neg_right, lcm_one,
+    Int.add_left_comm, Int.zero_mul, Int.mul_zero, Int.add_zero, Int.dvd_zero,
+    and_true] at h
+  assumption
+
+def cooper_left_cert (p₁ p₂ : Poly) (n : Nat) : Bool :=
+  p₁.casesOn (fun _ => false) fun a x _ =>
+  p₂.casesOn (fun _ => false) fun b y _ =>
+   .and (x == y) <| .and (a < 0)  <| .and (b > 0)  <|
+   n == a.natAbs
+
+def cooper_left_split (ctx : Context) (p₁ p₂ : Poly) (k : Nat) : Prop :=
+  let p  := p₁.tail
+  let q  := p₂.tail
+  let a  := p₁.leadCoeff
+  let b  := p₂.leadCoeff
+  let p₁ := p.mul b |>.combine (q.mul (-a))
+  (p₁.addConst (b*k)).denote' ctx ≤ 0
+  ∧ a ∣ (p.addConst k).denote' ctx
+
+theorem cooper_left (ctx : Context) (p₁ p₂ : Poly) (n : Nat)
+    : cooper_left_cert p₁ p₂ n
+      → p₁.denote' ctx ≤ 0
+      → p₂.denote' ctx ≤ 0
+      → OrOver n (cooper_left_split ctx p₁ p₂) := by
+ unfold cooper_left_split
+ cases p₁ <;> cases p₂ <;> simp [cooper_left_cert, Poly.tail, -Poly.denote'_eq_denote]
+ next a x p b y q =>
+ intro; subst y
+ intro ha hb
+ intro; subst n
+ simp only [Poly.denote'_add, Poly.leadCoeff]
+ intro h₁ h₂
+ have := cooper_left_core ha hb h₁ h₂
+ simp only [denote'_mul_combine_mul_addConst_eq]
+ simp only [denote'_addConst_eq]
+ assumption
+
+def cooper_left_split_ineq_cert (p₁ p₂ : Poly) (k : Int) (b : Int) (p' : Poly) : Bool :=
+  let p  := p₁.tail
+  let q  := p₂.tail
+  let a  := p₁.leadCoeff
+  let p₁ := p.mul b |>.combine (q.mul (-a))
+  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
+  simp [cooper_left_split_ineq_cert, cooper_left_split]
+  intros; subst p' b; simp [denote'_mul_combine_mul_addConst_eq]; assumption
+
+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
+  simp [cooper_left_split_dvd_cert, cooper_left_split]
+  intros; subst a p'; simp; assumption
+
+private theorem cooper_dvd_right_core
+    {a b c d s p q x : Int} (a_neg : a < 0) (b_pos : 0 < b) (d_pos : 0 < d)
+    (h₁ : a * x + p ≤ 0)
+    (h₂ : b * x + q ≤ 0)
+    (h₃ : d ∣ c * x + s)
+    : OrOver (Int.lcm b (b * d / Int.gcd (b * d) c)) fun k =>
+      b * p + (-a) * q + (-a) * k ≤ 0 ∧
+      b ∣ q + k ∧
+      b * d ∣ (-c) * q + b * s + (-c) * k := by
+  have a_pos' : 0 < -a := by apply Int.neg_pos_of_neg; assumption
+  have h₁'    : p ≤ (-a)*x := by rw [Int.neg_mul, ← Lean.Omega.Int.add_le_zero_iff_le_neg']; assumption
+  have h₂'    : b * x ≤ -q := by rw [← Lean.Omega.Int.add_le_zero_iff_le_neg', Int.add_comm]; assumption
+  have ⟨k, h₁, h₂, h₃, h₄, h₅⟩ := Int.cooper_resolution_dvd_right a_pos' b_pos d_pos |>.mp ⟨x, h₁', h₂', h₃⟩
+  simp only [Int.neg_mul, neg_gcd, lcm_neg_left, Int.mul_neg, Int.neg_neg, Int.neg_dvd] at *
+  apply orOver_of_exists
+  have hlt := ofNat_lt h₁ h₂
+  replace h₃ := Int.add_le_add_right h₃ (-(a*q)); rw [Int.add_right_neg] at h₃
+  have : -(a * k) + b * p + -(a * q) = b * p + -(a * q) + -(a * k) := by ac_rfl
+  rw [this] at h₃; clear this
+  rw [Int.sub_neg, Int.add_comm] at h₄
+  have : -(c * k) + -(c * q) + b * s = -(c * q) + b * s + -(c * k) := by ac_rfl
+  rw [this] at h₅; clear this
+  exists k.toNat
+  simp only [hlt, true_and, and_true, cast_toNat h₁, h₃, h₄, h₅]
+
+def cooper_dvd_right_cert (p₁ p₂ p₃ : Poly) (d : Int) (n : Nat) : Bool :=
+  p₁.casesOn (fun _ => false) fun a x _ =>
+  p₂.casesOn (fun _ => false) fun b y _ =>
+  p₃.casesOn (fun _ => false) fun c z _ =>
+   .and (x == y) <| .and (x == z) <|
+   .and (a < 0)  <| .and (b > 0)  <|
+   .and (d > 0)  <| n == Int.lcm b (b * d / Int.gcd (b * d) c)
+
+def cooper_dvd_right_split (ctx : Context) (p₁ p₂ p₃ : Poly) (d : Int) (k : Nat) : Prop :=
+  let p  := p₁.tail
+  let q  := p₂.tail
+  let s  := p₃.tail
+  let a  := p₁.leadCoeff
+  let b  := p₂.leadCoeff
+  let c  := p₃.leadCoeff
+  let p₁ := p.mul b |>.combine (q.mul (-a))
+  let p₂ := q.mul (-c) |>.combine (s.mul b)
+  (p₁.addConst ((-a)*k)).denote' ctx ≤ 0
+  ∧ b ∣ (q.addConst k).denote' ctx
+  ∧ b*d ∣ (p₂.addConst ((-c)*k)).denote' ctx
+
+theorem cooper_dvd_right (ctx : Context) (p₁ p₂ p₃ : Poly) (d : Int) (n : Nat)
+    : cooper_dvd_right_cert p₁ p₂ p₃ d n
+      → p₁.denote' ctx ≤ 0
+      → p₂.denote' ctx ≤ 0
+      → d ∣ p₃.denote' ctx
+      → OrOver n (cooper_dvd_right_split ctx p₁ p₂ p₃ d) := by
+ unfold cooper_dvd_right_split
+ cases p₁ <;> cases p₂ <;> cases p₃ <;> simp [cooper_dvd_right_cert, Poly.tail, -Poly.denote'_eq_denote]
+ next a x p b y q c z s =>
+ intro _ _; subst y z
+ intro ha hb hd
+ intro; subst n
+ simp only [Poly.denote'_add, Poly.leadCoeff]
+ intro h₁ h₂ h₃
+ have := cooper_dvd_right_core ha hb hd h₁ h₂ h₃
+ simp only [denote'_mul_combine_mul_addConst_eq]
+ simp only [denote'_addConst_eq, ←Int.neg_mul]
+ exact cooper_dvd_right_core ha hb hd h₁ h₂ h₃
+
+def cooper_dvd_right_split_ineq_cert (p₁ p₂ : Poly) (k : Int) (a : Int) (p' : Poly) : Bool :=
+  let p  := p₁.tail
+  let q  := p₂.tail
+  let b  := p₂.leadCoeff
+  let p₂ := p.mul b |>.combine (q.mul (-a))
+  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
+  simp [cooper_dvd_right_split_ineq_cert, cooper_dvd_right_split]
+  intros; subst a p'; simp [denote'_mul_combine_mul_addConst_eq]; assumption
+
+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
+  simp [cooper_dvd_right_split_dvd1_cert, cooper_dvd_right_split]
+  intros; subst b p'; simp; assumption
+
+def cooper_dvd_right_split_dvd2_cert (p₂ p₃ : Poly) (d : Int) (k : Nat) (d' : Int) (p' : Poly): Bool :=
+  let q  := p₂.tail
+  let s  := p₃.tail
+  let b  := p₂.leadCoeff
+  let c  := p₃.leadCoeff
+  let p₂ := q.mul (-c) |>.combine (s.mul b)
+  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
+  simp [cooper_dvd_right_split_dvd2_cert, cooper_dvd_right_split]
+  intros; subst d' p'; simp; assumption
+
+private theorem cooper_right_core
+    {a b p q x : Int} (a_neg : a < 0) (b_pos : 0 < b)
+    (h₁ : a * x + p ≤ 0)
+    (h₂ : b * x + q ≤ 0)
+    : OrOver b.natAbs fun k =>
+      b * p + (-a) * q + (-a) * k ≤ 0 ∧
+      b ∣ q + k := by
+  have d_pos : (0 : Int) < 1 := by decide
+  have h₃ : 1 ∣ 0*x + 0 := Int.one_dvd _
+  have h := cooper_dvd_right_core a_neg b_pos d_pos h₁ h₂ h₃
+  simp only [Int.mul_one, gcd_zero, Int.natAbs_of_nonneg (Int.le_of_lt b_pos), Int.ediv_neg,
+    Int.ediv_self (Int.ne_of_gt b_pos), Int.reduceNeg, lcm_neg_right, lcm_one,
+    Int.add_left_comm, Int.zero_mul, Int.mul_zero, Int.add_zero, Int.dvd_zero,
+    and_true, Int.neg_zero] at h
+  assumption
+
+def cooper_right_cert (p₁ p₂ : Poly) (n : Nat) : Bool :=
+  p₁.casesOn (fun _ => false) fun a x _ =>
+  p₂.casesOn (fun _ => false) fun b y _ =>
+  .and (x == y) <| .and (a < 0)  <| .and (b > 0) <| n == b.natAbs
+
+def cooper_right_split (ctx : Context) (p₁ p₂ : Poly) (k : Nat) : Prop :=
+  let p  := p₁.tail
+  let q  := p₂.tail
+  let a  := p₁.leadCoeff
+  let b  := p₂.leadCoeff
+  let p₁ := p.mul b |>.combine (q.mul (-a))
+  (p₁.addConst ((-a)*k)).denote' ctx ≤ 0
+  ∧ b ∣ (q.addConst k).denote' ctx
+
+theorem cooper_right (ctx : Context) (p₁ p₂ : Poly) (n : Nat)
+    : cooper_right_cert p₁ p₂ n
+      → p₁.denote' ctx ≤ 0
+      → p₂.denote' ctx ≤ 0
+      → OrOver n (cooper_right_split ctx p₁ p₂) := by
+ unfold cooper_right_split
+ cases p₁ <;> cases p₂ <;> simp [cooper_right_cert, Poly.tail, -Poly.denote'_eq_denote]
+ next a x p b y q =>
+ intro; subst y
+ intro ha hb
+ intro; subst n
+ simp only [Poly.denote'_add, Poly.leadCoeff]
+ intro h₁ h₂
+ have := cooper_right_core ha hb h₁ h₂
+ simp only [denote'_mul_combine_mul_addConst_eq]
+ simp only [denote'_addConst_eq, ←Int.neg_mul]
+ assumption
+
+def cooper_right_split_ineq_cert (p₁ p₂ : Poly) (k : Int) (a : Int) (p' : Poly) : Bool :=
+  let p  := p₁.tail
+  let q  := p₂.tail
+  let b  := p₂.leadCoeff
+  let p₂ := p.mul b |>.combine (q.mul (-a))
+  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
+  simp [cooper_right_split_ineq_cert, cooper_right_split]
+  intros; subst a p'; simp [denote'_mul_combine_mul_addConst_eq]; assumption
+
+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
+  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
+
+theorem natCast_nonneg (x : Nat) : (-1:Int) * NatCast.natCast x ≤ 0 := by
+  simp
+
+private theorem dvd_le_tight' {d p b₁ b₂ : Int} (hd : d > 0) (h₁ : d ∣ p + b₁) (h₂ : p + b₂ ≤ 0)
+    : p + (b₁ - d*((b₁-b₂) / d)) ≤ 0 := by
+  have ⟨k, h⟩ := h₁
+  replace h₁ : p = d*k - b₁ := by
+    replace h := congrArg (· - b₁) h
+    simp only [Int.add_sub_cancel] at h
+    assumption
+  replace h₂ : d*k - b₁ + b₂ ≤ 0 := by
+    rw [h₁] at h₂; assumption
+  have : d*k ≤ b₁ - b₂ := by
+    rw [Int.sub_eq_add_neg, Int.add_assoc, Lean.Omega.Int.add_le_zero_iff_le_neg,
+        Int.neg_add, Int.neg_neg, ← Int.sub_eq_add_neg] at h₂
+    assumption
+  replace this : k ≤ (b₁ - b₂)/d := by
+    rw [Int.mul_comm] at this; exact Int.le_ediv_of_mul_le hd this
+  replace this := Int.mul_le_mul_of_nonneg_left this (Int.le_of_lt hd)
+  rw [←h] at this
+  replace this := Int.sub_nonpos_of_le this
+  rw [Int.add_sub_assoc] at this
+  exact this
+
+private theorem eq_neg_addConst_add (ctx : Context) (p : Poly)
+    : p.denote' ctx = (p.addConst (-p.getConst)).denote' ctx + p.getConst := by
+  simp only [Poly.denote'_eq_denote, Poly.denote_addConst, Int.add_comm, Int.add_left_comm]
+  rw [Int.add_right_neg]
+  simp
+
+def dvd_le_tight_cert (d : Int) (p₁ p₂ p₃ : Poly) : Bool :=
+  let b₁ := p₁.getConst
+  let b₂ := p₂.getConst
+  let p  := p₁.addConst (-b₁)
+  d > 0 && (p₂ == p.addConst b₂ && p₃ == p.addConst (b₁ - d*((b₁ - b₂)/d)))
+
+theorem dvd_le_tight (ctx : Context) (d : Int) (p₁ p₂ p₃ : Poly)
+    : dvd_le_tight_cert d p₁ p₂ p₃ → d ∣ p₁.denote' ctx → p₂.denote' ctx ≤ 0 → p₃.denote' ctx ≤ 0 := by
+  simp only [dvd_le_tight_cert, gt_iff_lt, Bool.and_eq_true, decide_eq_true_eq, beq_iff_eq, and_imp]
+  generalize p₂.getConst = b₂
+  intro hd _ _; subst p₂ p₃
+  have := eq_neg_addConst_add ctx p₁
+  revert this
+  generalize p₁.getConst = b₁
+  generalize p₁.addConst (-b₁) = p
+  intro h₁; rw [h₁]; clear h₁
+  simp only [denote'_addConst_eq]
+  simp only [Poly.denote'_eq_denote]
+  exact dvd_le_tight' hd
+
+def dvd_neg_le_tight_cert (d : Int) (p₁ p₂ p₃ : Poly) : Bool :=
+  let b₁ := p₁.getConst
+  let b₂ := p₂.getConst
+  let p  := p₁.addConst (-b₁)
+  let b₁ := -b₁
+  let p  := p.mul (-1)
+  d > 0 && (p₂ == p.addConst b₂ && p₃ == p.addConst (b₁ - d*((b₁ - b₂)/d)))
+
+theorem Poly.mul_minus_one_getConst_eq (p : Poly) : (p.mul (-1)).getConst = -p.getConst := by
+  simp [Poly.mul, Poly.getConst]
+  induction p <;> simp [Poly.mul', Poly.getConst, *]
+
+theorem dvd_neg_le_tight (ctx : Context) (d : Int) (p₁ p₂ p₃ : Poly)
+    : dvd_neg_le_tight_cert d p₁ p₂ p₃ → d ∣ p₁.denote' ctx → p₂.denote' ctx ≤ 0 → p₃.denote' ctx ≤ 0 := by
+  simp only [dvd_neg_le_tight_cert, gt_iff_lt, Bool.and_eq_true, decide_eq_true_eq, beq_iff_eq, and_imp]
+  generalize p₂.getConst = b₂
+  intro hd _ _; subst p₂ p₃
+  simp only [Poly.denote'_eq_denote, Int.reduceNeg, Poly.denote_addConst, Poly.denote_mul,
+    Int.mul_add, Int.neg_mul, Int.one_mul, Int.mul_neg, Int.neg_neg, Int.add_comm, Int.add_assoc]
+  intro h₁ h₂
+  replace h₁ := Int.dvd_neg.mpr h₁
+  have := eq_neg_addConst_add ctx (p₁.mul (-1))
+  simp [Poly.mul_minus_one_getConst_eq] at this
+  rw [← Int.add_assoc] at this
+  rw [this] at h₁; clear this
+  rw [← Int.add_assoc]
+  revert h₁ h₂
+  generalize -Poly.denote ctx p₁ + p₁.getConst = p
+  generalize -p₁.getConst = b₁
+  intro h₁ h₂; rw [Int.add_comm] at h₁
+  exact dvd_le_tight' hd h₂ h₁
+
 end Int.Linear
 
 theorem Int.not_le_eq (a b : Int) : (¬a ≤ b) = (b + 1 ≤ a) := by

src/Init/Data/Int/OfNat.lean

@@ -0,0 +1,64 @@
+/-
+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 Init.Data.Int.Lemmas
+import Init.Data.Int.DivMod
+import Init.Data.RArray
+
+namespace Int.OfNat
+/-!
+Helper definitions and theorems for converting `Nat` expressions into `Int` one.
+We use them to implement the arithmetic theories in `grind`
+-/
+
+abbrev Var := Nat
+abbrev Context := Lean.RArray Nat
+def Var.denote (ctx : Context) (v : Var) : Nat :=
+  ctx.get v
+
+inductive Expr where
+  | num  (v : Nat)
+  | var  (i : Var)
+  | add  (a b : Expr)
+  | mul  (a b : Expr)
+  | div  (a b : Expr)
+  | mod  (a b : Expr)
+
+def Expr.denote (ctx : Context) : Expr → Nat
+  | .num k    => k
+  | .var v    => v.denote ctx
+  | .add a b  => Nat.add (denote ctx a) (denote ctx b)
+  | .mul a b  => Nat.mul (denote ctx a) (denote ctx b)
+  | .div a b  => Nat.div (denote ctx a) (denote ctx b)
+  | .mod a b  => Nat.mod (denote ctx a) (denote ctx b)
+
+def Expr.denoteAsInt (ctx : Context) : Expr → Int
+  | .num k    => Int.ofNat k
+  | .var v    => Int.ofNat (v.denote ctx)
+  | .add a b  => Int.add (denoteAsInt ctx a) (denoteAsInt ctx b)
+  | .mul a b  => Int.mul (denoteAsInt ctx a) (denoteAsInt ctx b)
+  | .div a b  => Int.ediv (denoteAsInt ctx a) (denoteAsInt ctx b)
+  | .mod a b  => Int.emod (denoteAsInt ctx a) (denoteAsInt ctx b)
+
+@[local simp] private theorem fold_div (a b : Nat) : a.div b = a / b := rfl
+@[local simp] private theorem fold_mod (a b : Nat) : a.mod b = a % b := rfl
+
+theorem Expr.denoteAsInt_eq (ctx : Context) (e : Expr) : e.denoteAsInt ctx = e.denote ctx := by
+  induction e <;> simp [denote, denoteAsInt, Int.ofNat_ediv, *] <;> rfl
+
+theorem Expr.eq (ctx : Context) (lhs rhs : Expr)
+    : (lhs.denote ctx = rhs.denote ctx) = (lhs.denoteAsInt ctx = rhs.denoteAsInt ctx) := by
+  simp [denoteAsInt_eq, Int.ofNat_inj]
+
+theorem Expr.le (ctx : Context) (lhs rhs : Expr)
+    : (lhs.denote ctx ≤ rhs.denote ctx) = (lhs.denoteAsInt ctx ≤ rhs.denoteAsInt ctx) := by
+  simp [denoteAsInt_eq, Int.ofNat_le]
+
+theorem Expr.dvd (ctx : Context) (lhs rhs : Expr)
+    : (lhs.denote ctx ∣ rhs.denote ctx) = (lhs.denoteAsInt ctx ∣ rhs.denoteAsInt ctx) := by
+  simp [denoteAsInt_eq, Int.ofNat_dvd]
+
+end Int.OfNat

src/Init/Data/Int/Order.lean

@@ -133,12 +133,15 @@ protected theorem lt_of_not_ge {a b : Int} (h : ¬a ≤ b) : b < a :=
 protected theorem not_le_of_gt {a b : Int} (h : b < a) : ¬a ≤ b :=
   (Int.lt_iff_le_not_le.mp h).right
 
-protected theorem not_le {a b : Int} : ¬a ≤ b ↔ b < a :=
+@[simp] protected theorem not_le {a b : Int} : ¬a ≤ b ↔ b < a :=
   Iff.intro Int.lt_of_not_ge Int.not_le_of_gt
 
-protected theorem not_lt {a b : Int} : ¬a < b ↔ b ≤ a :=
+@[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
@@ -358,6 +361,10 @@ protected theorem sub_lt_self (a : Int) {b : Int} (h : 0 < b) : a - b < a :=
 
 theorem add_one_le_of_lt {a b : Int} (H : a < b) : a + 1 ≤ b := H
 
+protected theorem le_iff_lt_add_one {a b : Int} : a ≤ b ↔ a < b + 1 := by
+  rw [Int.lt_iff_add_one_le]
+  exact (Int.add_le_add_iff_right 1).symm
+
 /- ### Order properties and multiplication -/
 
 
@@ -425,7 +432,7 @@ protected theorem mul_le_mul_of_nonpos_left {a b c : Int}
 
 /- ## natAbs -/
 
-@[simp] theorem natAbs_ofNat (n : Nat) : natAbs ↑n = n := rfl
+@[simp, norm_cast] theorem natAbs_ofNat (n : Nat) : natAbs ↑n = n := rfl
 @[simp] theorem natAbs_negSucc (n : Nat) : natAbs -[n+1] = n.succ := rfl
 @[simp] theorem natAbs_zero : natAbs (0 : Int) = (0 : Nat) := rfl
 @[simp] theorem natAbs_one : natAbs (1 : Int) = (1 : Nat) := rfl
@@ -470,6 +477,13 @@ theorem natAbs_of_nonneg {a : Int} (H : 0 ≤ a) : (natAbs a : Int) = a :=
 theorem ofNat_natAbs_of_nonpos {a : Int} (H : a ≤ 0) : (natAbs a : Int) = -a := by
   rw [← natAbs_neg, natAbs_of_nonneg (Int.neg_nonneg_of_nonpos H)]
 
+theorem natAbs_sub_of_nonneg_of_le {a b : Int} (h₁ : 0 ≤ b) (h₂ : b ≤ a) :
+    (a - b).natAbs = a.natAbs - b.natAbs := by
+  rw [← Int.ofNat_inj]
+  rw [natAbs_of_nonneg, ofNat_sub, natAbs_of_nonneg (Int.le_trans h₁ h₂), natAbs_of_nonneg h₁]
+  · rwa [← Int.ofNat_le, natAbs_of_nonneg h₁, natAbs_of_nonneg (Int.le_trans h₁ h₂)]
+  · exact Int.sub_nonneg_of_le h₂
+
 /-! ### toNat -/
 
 theorem toNat_eq_max : ∀ a : Int, (toNat a : Int) = max a 0
@@ -938,6 +952,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 +1051,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/List/Control.lean

@@ -227,14 +227,19 @@ def findM? {m : Type → Type u} [Monad m] {α : Type} (p : α → m Bool) : Lis
     | false => findM? p as
 
 @[simp]
-theorem findM?_id (p : α → Bool) (as : List α) : findM? (m := Id) p as = as.find? p := by
+theorem findM?_pure {m} [Monad m] [LawfulMonad m] (p : α → Bool) (as : List α) :
+    findM? (m := m) (pure <| p ·) as = pure (as.find? p) := by
   induction as with
   | nil => rfl
   | cons a as ih =>
     simp only [findM?, find?]
     cases p a with
-    | true  => rfl
-    | false => rw [ih]; rfl
+    | true  => simp
+    | false => simp [ih]
+
+@[simp]
+theorem findM?_id (p : α → Bool) (as : List α) : findM? (m := Id) p as = as.find? p :=
+  findM?_pure _ _
 
 @[specialize]
 def findSomeM? {m : Type u → Type v} [Monad m] {α : Type w} {β : Type u} (f : α → m (Option β)) : List α → m (Option β)
@@ -245,14 +250,19 @@ def findSomeM? {m : Type u → Type v} [Monad m] {α : Type w} {β : Type u} (f
     | none   => findSomeM? f as
 
 @[simp]
-theorem findSomeM?_id (f : α → Option β) (as : List α) : findSomeM? (m := Id) f as = as.findSome? f := by
+theorem findSomeM?_pure [Monad m] [LawfulMonad m] (f : α → Option β) (as : List α) :
+    findSomeM? (m := m) (pure <| f ·) as = pure (as.findSome? f) := by
   induction as with
   | nil => rfl
   | cons a as ih =>
     simp only [findSomeM?, findSome?]
     cases f a with
-    | some b => rfl
-    | none   => rw [ih]; rfl
+    | some b => simp
+    | none   => simp [ih]
+
+@[simp]
+theorem findSomeM?_id (f : α → Option β) (as : List α) : findSomeM? (m := Id) f as = as.findSome? f :=
+  findSomeM?_pure _ _
 
 theorem findM?_eq_findSomeM? [Monad m] [LawfulMonad m] (p : α → m Bool) (as : List α) :
     as.findM? p = as.findSomeM? fun a => return if (← p a) then some a else none := by

src/Init/Data/List/Lemmas.lean

@@ -2535,6 +2535,14 @@ theorem flatMap_reverse {β} (l : List α) (f : α → List β) : (l.reverse.fla
   simp only [foldrM]
   induction l <;> simp_all
 
+@[simp] theorem foldlM_pure [Monad m] [LawfulMonad m] (f : β → α → β) (b) (l : List α) :
+    l.foldlM (m := m) (pure <| f · ·) b = pure (l.foldl f b) := by
+  induction l generalizing b <;> simp [*]
+
+@[simp] theorem foldrM_pure [Monad m] [LawfulMonad m] (f : α → β → β) (b) (l : List α) :
+    l.foldrM (m := m) (pure <| f · ·) b = pure (l.foldr f b) := by
+  induction l generalizing b <;> simp [*]
+
 theorem foldl_eq_foldlM (f : β → α → β) (b) (l : List α) :
     l.foldl f b = l.foldlM (m := Id) f b := by
   induction l generalizing b <;> simp [*, foldl]

src/Init/Data/List/Monadic.lean

@@ -56,9 +56,13 @@ theorem mapM'_eq_mapM [Monad m] [LawfulMonad m] (f : α → m β) (l : List α)
 @[simp] theorem mapM_cons [Monad m] [LawfulMonad m] (f : α → m β) :
     (a :: l).mapM f = (return (← f a) :: (← l.mapM f)) := by simp [← mapM'_eq_mapM, mapM']
 
-@[simp] theorem mapM_id {l : List α} {f : α → Id β} : l.mapM f = l.map f := by
+@[simp] theorem mapM_pure [Monad m] [LawfulMonad m] (l : List α) (f : α → β) :
+    l.mapM (m := m) (pure <| f ·) = pure (l.map f) := by
   induction l <;> simp_all
 
+@[simp] theorem mapM_id {l : List α} {f : α → Id β} : l.mapM f = l.map f :=
+  mapM_pure _ _
+
 @[simp] theorem mapM_append [Monad m] [LawfulMonad m] (f : α → m β) {l₁ l₂ : List α} :
     (l₁ ++ l₂).mapM f = (return (← l₁.mapM f) ++ (← l₂.mapM f)) := by induction l₁ <;> simp [*]
 
@@ -395,7 +399,7 @@ theorem forIn_pure_yield_eq_foldl [Monad m] [LawfulMonad m]
     forIn (l.map g) init f = forIn l init fun a y => f (g a) y := by
   induction l generalizing init <;> simp_all
 
-/-! ### allM -/
+/-! ### allM and anyM -/
 
 theorem allM_eq_not_anyM_not [Monad m] [LawfulMonad m] (p : α → m Bool) (as : List α) :
     allM p as = (! ·) <$> anyM ((! ·) <$> p ·) as := by
@@ -407,6 +411,18 @@ theorem allM_eq_not_anyM_not [Monad m] [LawfulMonad m] (p : α → m Bool) (as :
     funext b
     split <;> simp_all
 
+@[simp] theorem anyM_pure [Monad m] [LawfulMonad m] (p : α → Bool) (as : List α) :
+    as.anyM (m := m) (pure <| p ·) = pure (as.any p) := by
+  induction as with
+  | nil => simp
+  | cons a as ih =>
+    simp only [anyM, ih, pure_bind, all_cons]
+    split <;> simp_all
+
+@[simp] theorem allM_pure [Monad m] [LawfulMonad m] (p : α → Bool) (as : List α) :
+    as.allM (m := m) (pure <| p ·) = pure (as.all p) := by
+  simp [allM_eq_not_anyM_not, all_eq_not_any_not]
+
 /-! ### Recognizing higher order functions using a function that only depends on the value. -/
 
 /--
@@ -422,12 +438,12 @@ and simplifies these to the function directly taking the value.
   | nil => simp
   | cons a l ih => simp [ih, hf]
 
-@[wf_preprocess] theorem foldlM_wfParam [Monad m] (xs : List α) (f : β → α → m β) :
-    (wfParam xs).foldlM f = xs.attach.unattach.foldlM f := by
+@[wf_preprocess] theorem foldlM_wfParam [Monad m] (xs : List α) (f : β → α → m β) (init : β) :
+    (wfParam xs).foldlM f init = xs.attach.unattach.foldlM f init := by
   simp [wfParam]
 
-@[wf_preprocess] theorem foldlM_unattach [Monad m] (P : α → Prop) (xs : List (Subtype P)) (f : β → α → m β) :
-    xs.unattach.foldlM f = xs.foldlM fun b ⟨x, h⟩ =>
+@[wf_preprocess] theorem foldlM_unattach [Monad m] (P : α → Prop) (xs : List (Subtype P)) (f : β → α → m β) (init : β):
+    xs.unattach.foldlM f init = xs.foldlM (init := init) fun b ⟨x, h⟩ =>
       binderNameHint b f <| binderNameHint x (f b) <| binderNameHint h () <|
       f b (wfParam x) := by
   simp [wfParam]
@@ -449,12 +465,12 @@ and simplifies these to the function directly taking the value.
     funext b
     simp [hf]
 
-@[wf_preprocess] theorem foldrM_wfParam [Monad m] [LawfulMonad m] (xs : List α) (f : α → β → m β) :
-    (wfParam xs).foldrM f = xs.attach.unattach.foldrM f := by
+@[wf_preprocess] theorem foldrM_wfParam [Monad m] [LawfulMonad m] (xs : List α) (f : α → β → m β) (init : β) :
+    (wfParam xs).foldrM f init = xs.attach.unattach.foldrM f init := by
   simp [wfParam]
 
-@[wf_preprocess] theorem foldrM_unattach [Monad m] [LawfulMonad m] (P : α → Prop) (xs : List (Subtype P)) (f : α → β → m β) :
-    xs.unattach.foldrM f = xs.foldrM fun ⟨x, h⟩ b =>
+@[wf_preprocess] theorem foldrM_unattach [Monad m] [LawfulMonad m] (P : α → Prop) (xs : List (Subtype P)) (f : α → β → m β) (init : β) :
+    xs.unattach.foldrM f init = xs.foldrM (init := init) fun ⟨x, h⟩ b =>
       binderNameHint x f <| binderNameHint h () <| binderNameHint b (f x) <|
       f (wfParam x) b := by
   simp [wfParam]

src/Init/Data/List/Perm.lean

@@ -47,6 +47,14 @@ instance : Trans (Perm (α := α)) (Perm (α := α)) (Perm (α := α)) where
 
 theorem perm_comm {l₁ l₂ : List α} : l₁ ~ l₂ ↔ l₂ ~ l₁ := ⟨Perm.symm, Perm.symm⟩
 
+protected theorem Perm.congr_left {l₁ l₂ : List α} (h : l₁ ~ l₂) (l₃ : List α) :
+    l₁ ~ l₃ ↔ l₂ ~ l₃ :=
+  ⟨h.symm.trans, h.trans⟩
+
+protected theorem Perm.congr_right {l₁ l₂ : List α} (h : l₁ ~ l₂) (l₃ : List α) :
+    l₃ ~ l₁ ↔ l₃ ~ l₂ :=
+  ⟨fun h' => h'.trans h, fun h' => h'.trans h.symm⟩
+
 theorem Perm.swap' (x y : α) {l₁ l₂ : List α} (p : l₁ ~ l₂) : y :: x :: l₁ ~ x :: y :: l₂ :=
   (swap ..).trans <| p.cons _ |>.cons _
 

src/Init/Data/Nat/Bitwise/Basic.lean

@@ -74,6 +74,10 @@ theorem shiftRight_eq_div_pow (m : Nat) : ∀ n, m >>> n = m / 2 ^ n
 theorem shiftRight_eq_zero (m n : Nat) (hn : m < 2^n) : m >>> n = 0 := by
   simp [Nat.shiftRight_eq_div_pow, Nat.div_eq_of_lt hn]
 
+theorem shiftRight_le (m n : Nat) : m >>> n ≤ m := by
+  simp only [shiftRight_eq_div_pow]
+  apply Nat.div_le_self
+
 /-!
 ### testBit
 We define an operation for testing individual bits in the binary representation

src/Init/Data/Nat/Div/Lemmas.lean

@@ -27,8 +27,8 @@ theorem div_le_iff_le_mul (h : 0 < k) : x / k ≤ y ↔ x ≤ y * k + k - 1 := b
   omega
 
 -- TODO: reprove `div_eq_of_lt_le` in terms of this:
-protected theorem div_eq_iff (h : 0 < k) : x / k = y ↔ x ≤ y * k + k - 1 ∧ y * k ≤ x := by
-  rw [Nat.eq_iff_le_and_ge, le_div_iff_mul_le h, Nat.div_le_iff_le_mul h]
+protected theorem div_eq_iff (h : 0 < k) : x / k = y ↔ y * k ≤ x ∧ x ≤ y * k + k - 1 := by
+  rw [Nat.eq_iff_le_and_ge, and_comm, le_div_iff_mul_le h, Nat.div_le_iff_le_mul h]
 
 theorem lt_of_div_eq_zero (h : 0 < k) (h' : x / k = 0) : x < k := by
   rw [Nat.div_eq_iff h] at h'
@@ -98,18 +98,34 @@ theorem succ_div_of_not_dvd {a b : Nat} (h : ¬ b ∣ a + 1) :
     rw [eq_comm, Nat.div_eq_iff (by simp)]
     constructor
     · rw [Nat.div_mul_self_eq_mod_sub_self]
-      have : (a + 1) % (b + 1) < b + 1 := Nat.mod_lt _ (by simp)
       omega
     · rw [Nat.div_mul_self_eq_mod_sub_self]
+      have : (a + 1) % (b + 1) < b + 1 := Nat.mod_lt _ (by simp)
       omega
 
 theorem succ_div_of_mod_ne_zero {a b : Nat} (h : (a + 1) % b ≠ 0) :
     (a + 1) / b = a / b := by
   rw [succ_div_of_not_dvd (by rwa [dvd_iff_mod_eq_zero])]
 
-theorem succ_div {a b : Nat} : (a + 1) / b = a / b + if b ∣ a + 1 then 1 else 0 := by
+protected theorem succ_div {a b : Nat} : (a + 1) / b = a / b + if b ∣ a + 1 then 1 else 0 := by
   split <;> rename_i h
   · simp [succ_div_of_dvd h]
   · simp [succ_div_of_not_dvd h]
 
+protected theorem add_div {a b c : Nat} (h : 0 < c) :
+    (a + b) / c = a / c + b / c + if c ≤ a % c + b % c then 1 else 0 := by
+  conv => lhs; rw [← Nat.div_add_mod a c]
+  rw [Nat.add_assoc, mul_add_div h]
+  conv => lhs; rw [← Nat.div_add_mod b c]
+  rw [Nat.add_comm (a % c), Nat.add_assoc, mul_add_div h, ← Nat.add_assoc, Nat.add_comm (b % c)]
+  congr
+  rw [Nat.div_eq_iff h]
+  constructor
+  · split <;> rename_i h
+    · simpa using h
+    · simp
+  · have := mod_lt a h
+    have := mod_lt b h
+    split <;> · simp; omega
+
 end Nat

src/Init/Data/OfScientific.lean

@@ -80,9 +80,9 @@ instance : OfScientific Float32 where
 def Float32.ofNat (n : Nat) : Float32 :=
   OfScientific.ofScientific n false 0
 
-def Float32.ofInt : Int → Float
-  | Int.ofNat n => Float.ofNat n
-  | Int.negSucc n => Float.neg (Float.ofNat (Nat.succ n))
+def Float32.ofInt : Int → Float32
+  | Int.ofNat n => Float32.ofNat n
+  | Int.negSucc n => Float32.neg (Float32.ofNat (Nat.succ n))
 
 instance : OfNat Float32 n   := ⟨Float32.ofNat n⟩
 

src/Init/Data/Repr.lean

@@ -251,6 +251,14 @@ where
     let d1 := n % 16;
     hexDigitRepr d2 ++ hexDigitRepr d1
 
+/--
+Quotes the character to its representation as a character literal, surrounded by single quotes and
+escaped as necessary.
+
+Examples:
+ * `'L'.quote = "'L'"`
+ * `'"'.quote = "'\\\"'"`
+-/
 def Char.quote (c : Char) : String :=
   "'" ++ Char.quoteCore c ++ "'"
 

src/Init/Data/SInt.lean

@@ -8,6 +8,7 @@ import Init.Data.SInt.Basic
 import Init.Data.SInt.Float
 import Init.Data.SInt.Float32
 import Init.Data.SInt.Lemmas
+import Init.Data.SInt.Bitwise
 
 /-!
 This module contains the definitions and basic theory about signed fixed width integer types.

src/Init/Data/SInt/Basic.lean

@@ -77,6 +77,9 @@ Obtain the `BitVec` that contains the 2's complement representation of the `Int8
 -/
 @[inline] def Int8.toBitVec (x : Int8) : BitVec 8 := x.toUInt8.toBitVec
 
+theorem Int8.toBitVec.inj : {x y : Int8} → x.toBitVec = y.toBitVec → x = y
+  | ⟨⟨_⟩⟩, ⟨⟨_⟩⟩, rfl => rfl
+
 /-- Obtains the `Int8` that is 2's complement equivalent to the `UInt8`. -/
 @[inline] def UInt8.toInt8 (i : UInt8) : Int8 := Int8.ofUInt8 i
 @[inline, deprecated UInt8.toInt8 (since := "2025-02-13"), inherit_doc UInt8.toInt8]
@@ -110,8 +113,8 @@ instance : ReprAtom Int8 := ⟨⟩
 instance : Hashable Int8 where
   hash i := i.toUInt8.toUInt64
 
-instance : OfNat Int8 n := ⟨Int8.ofNat n⟩
-instance : Neg Int8 where
+instance Int8.instOfNat : OfNat Int8 n := ⟨Int8.ofNat n⟩
+instance Int8.instNeg : Neg Int8 where
   neg := Int8.neg
 
 /-- The maximum value an `Int8` may attain, that is, `2^7 - 1 = 127`. -/
@@ -189,6 +192,9 @@ instance : ShiftLeft Int8   := ⟨Int8.shiftLeft⟩
 instance : ShiftRight Int8  := ⟨Int8.shiftRight⟩
 instance : DecidableEq Int8 := Int8.decEq
 
+/--
+Converts `true` to `1` and `false` to `0`.
+-/
 @[extern "lean_bool_to_int8"]
 def Bool.toInt8 (b : Bool) : Int8 := if b then 1 else 0
 
@@ -213,6 +219,9 @@ Obtain the `BitVec` that contains the 2's complement representation of the `Int1
 -/
 @[inline] def Int16.toBitVec (x : Int16) : BitVec 16 := x.toUInt16.toBitVec
 
+theorem Int16.toBitVec.inj : {x y : Int16} → x.toBitVec = y.toBitVec → x = y
+  | ⟨⟨_⟩⟩, ⟨⟨_⟩⟩, rfl => rfl
+
 /-- Obtains the `Int16` that is 2's complement equivalent to the `UInt16`. -/
 @[inline] def UInt16.toInt16 (i : UInt16) : Int16 := Int16.ofUInt16 i
 @[inline, deprecated UInt16.toInt16 (since := "2025-02-13"), inherit_doc UInt16.toInt16]
@@ -250,8 +259,8 @@ instance : ReprAtom Int16 := ⟨⟩
 instance : Hashable Int16 where
   hash i := i.toUInt16.toUInt64
 
-instance : OfNat Int16 n := ⟨Int16.ofNat n⟩
-instance : Neg Int16 where
+instance Int16.instOfNat : OfNat Int16 n := ⟨Int16.ofNat n⟩
+instance Int16.instNeg : Neg Int16 where
   neg := Int16.neg
 
 /-- The maximum value an `Int16` may attain, that is, `2^15 - 1 = 32767`. -/
@@ -329,6 +338,9 @@ instance : ShiftLeft Int16   := ⟨Int16.shiftLeft⟩
 instance : ShiftRight Int16  := ⟨Int16.shiftRight⟩
 instance : DecidableEq Int16 := Int16.decEq
 
+/--
+Converts `true` to `1` and `false` to `0`.
+-/
 @[extern "lean_bool_to_int16"]
 def Bool.toInt16 (b : Bool) : Int16 := if b then 1 else 0
 
@@ -353,6 +365,9 @@ Obtain the `BitVec` that contains the 2's complement representation of the `Int3
 -/
 @[inline] def Int32.toBitVec (x : Int32) : BitVec 32 := x.toUInt32.toBitVec
 
+theorem Int32.toBitVec.inj : {x y : Int32} → x.toBitVec = y.toBitVec → x = y
+  | ⟨⟨_⟩⟩, ⟨⟨_⟩⟩, rfl => rfl
+
 /-- Obtains the `Int32` that is 2's complement equivalent to the `UInt32`. -/
 @[inline] def UInt32.toInt32 (i : UInt32) : Int32 := Int32.ofUInt32 i
 @[inline, deprecated UInt32.toInt32 (since := "2025-02-13"), inherit_doc UInt32.toInt32]
@@ -394,8 +409,8 @@ instance : ReprAtom Int16 := ⟨⟩
 instance : Hashable Int32 where
   hash i := i.toUInt32.toUInt64
 
-instance : OfNat Int32 n := ⟨Int32.ofNat n⟩
-instance : Neg Int32 where
+instance Int32.instOfNat : OfNat Int32 n := ⟨Int32.ofNat n⟩
+instance Int32.instNeg : Neg Int32 where
   neg := Int32.neg
 
 /-- The maximum value an `Int32` may attain, that is, `2^31 - 1 = 2147483647`. -/
@@ -473,6 +488,9 @@ instance : ShiftLeft Int32   := ⟨Int32.shiftLeft⟩
 instance : ShiftRight Int32  := ⟨Int32.shiftRight⟩
 instance : DecidableEq Int32 := Int32.decEq
 
+/--
+Converts `true` to `1` and `false` to `0`.
+-/
 @[extern "lean_bool_to_int32"]
 def Bool.toInt32 (b : Bool) : Int32 := if b then 1 else 0
 
@@ -497,6 +515,9 @@ Obtain the `BitVec` that contains the 2's complement representation of the `Int6
 -/
 @[inline] def Int64.toBitVec (x : Int64) : BitVec 64 := x.toUInt64.toBitVec
 
+theorem Int64.toBitVec.inj : {x y : Int64} → x.toBitVec = y.toBitVec → x = y
+  | ⟨⟨_⟩⟩, ⟨⟨_⟩⟩, rfl => rfl
+
 /-- Obtains the `Int64` that is 2's complement equivalent to the `UInt64`. -/
 @[inline] def UInt64.toInt64 (i : UInt64) : Int64 := Int64.ofUInt64 i
 @[inline, deprecated UInt64.toInt64 (since := "2025-02-13"), inherit_doc UInt64.toInt64]
@@ -542,8 +563,8 @@ instance : ReprAtom Int64 := ⟨⟩
 instance : Hashable Int64 where
   hash i := i.toUInt64
 
-instance : OfNat Int64 n := ⟨Int64.ofNat n⟩
-instance : Neg Int64 where
+instance Int64.instOfNat : OfNat Int64 n := ⟨Int64.ofNat n⟩
+instance Int64.instNeg : Neg Int64 where
   neg := Int64.neg
 
 /-- The maximum value an `Int64` may attain, that is, `2^63 - 1 = 9223372036854775807`. -/
@@ -621,6 +642,9 @@ instance : ShiftLeft Int64   := ⟨Int64.shiftLeft⟩
 instance : ShiftRight Int64  := ⟨Int64.shiftRight⟩
 instance : DecidableEq Int64 := Int64.decEq
 
+/--
+Converts `true` to `1` and `false` to `0`.
+-/
 @[extern "lean_bool_to_int64"]
 def Bool.toInt64 (b : Bool) : Int64 := if b then 1 else 0
 
@@ -645,6 +669,9 @@ Obtain the `BitVec` that contains the 2's complement representation of the `ISiz
 -/
 @[inline] def ISize.toBitVec (x : ISize) : BitVec System.Platform.numBits := x.toUSize.toBitVec
 
+theorem ISize.toBitVec.inj : {x y : ISize} → x.toBitVec = y.toBitVec → x = y
+  | ⟨⟨_⟩⟩, ⟨⟨_⟩⟩, rfl => rfl
+
 /-- Obtains the `ISize` that is 2's complement equivalent to the `USize`. -/
 @[inline] def USize.toISize (i : USize) : ISize := ISize.ofUSize i
 @[inline, deprecated USize.toISize (since := "2025-02-13"), inherit_doc USize.toISize]
@@ -700,8 +727,8 @@ instance : ReprAtom ISize := ⟨⟩
 instance : Hashable ISize where
   hash i := i.toUSize.toUInt64
 
-instance : OfNat ISize n := ⟨ISize.ofNat n⟩
-instance : Neg ISize where
+instance ISize.instOfNat : OfNat ISize n := ⟨ISize.ofNat n⟩
+instance ISize.instNeg : Neg ISize where
   neg := ISize.neg
 
 /-- The maximum value an `ISize` may attain, that is, `2^(System.Platform.numBits - 1) - 1`. -/
@@ -780,6 +807,9 @@ instance : ShiftLeft ISize   := ⟨ISize.shiftLeft⟩
 instance : ShiftRight ISize  := ⟨ISize.shiftRight⟩
 instance : DecidableEq ISize := ISize.decEq
 
+/--
+Converts `true` to `1` and `false` to `0`.
+-/
 @[extern "lean_bool_to_isize"]
 def Bool.toISize (b : Bool) : ISize := if b then 1 else 0
 

src/Init/Data/SInt/Bitwise.lean

@@ -0,0 +1,57 @@
+/-
+Copyright (c) 2025 Lean FRO, LLC. All rights reserved.
+Released under Apache 2.0 license as described in the file LICENSE.
+Authors: Markus Himmel
+-/
+prelude
+import Init.Data.SInt.Lemmas
+
+set_option hygiene false in
+macro "declare_bitwise_int_theorems" typeName:ident bits:term:arg : command =>
+`(
+namespace $typeName
+
+@[simp, int_toBitVec] protected theorem toBitVec_add {a b : $typeName} : (a + b).toBitVec = a.toBitVec + b.toBitVec := rfl
+@[simp, int_toBitVec] protected theorem toBitVec_sub {a b : $typeName} : (a - b).toBitVec = a.toBitVec - b.toBitVec := rfl
+@[simp, int_toBitVec] protected theorem toBitVec_mul {a b : $typeName} : (a * b).toBitVec = a.toBitVec * b.toBitVec := rfl
+@[simp, int_toBitVec] protected theorem toBitVec_div {a b : $typeName} : (a / b).toBitVec = a.toBitVec.sdiv b.toBitVec := rfl
+@[simp, int_toBitVec] protected theorem toBitVec_mod {a b : $typeName} : (a % b).toBitVec = a.toBitVec.srem b.toBitVec := rfl
+@[simp, int_toBitVec] protected theorem toBitVec_not {a : $typeName} : (~~~a).toBitVec = ~~~a.toBitVec := rfl
+@[simp, int_toBitVec] protected theorem toBitVec_and (a b : $typeName) : (a &&& b).toBitVec = a.toBitVec &&& b.toBitVec := rfl
+@[simp, int_toBitVec] protected theorem toBitVec_or (a b : $typeName) : (a ||| b).toBitVec = a.toBitVec ||| b.toBitVec := rfl
+@[simp, int_toBitVec] protected theorem toBitVec_xor (a b : $typeName) : (a ^^^ b).toBitVec = a.toBitVec ^^^ b.toBitVec := rfl
+@[simp, int_toBitVec] protected theorem toBitVec_shiftLeft (a b : $typeName) : (a <<< b).toBitVec = a.toBitVec <<< (b.toBitVec.smod $bits) := rfl
+@[simp, int_toBitVec] protected theorem toBitVec_shiftRight (a b : $typeName) : (a >>> b).toBitVec = a.toBitVec.sshiftRight' (b.toBitVec.smod $bits) := rfl
+@[simp, int_toBitVec] protected theorem toBitVec_abs (a : $typeName) : a.abs.toBitVec = a.toBitVec.abs := rfl
+
+end $typeName
+)
+declare_bitwise_int_theorems Int8 8
+declare_bitwise_int_theorems Int16 16
+declare_bitwise_int_theorems Int32 32
+declare_bitwise_int_theorems Int64 64
+declare_bitwise_int_theorems ISize System.Platform.numBits
+
+@[simp, int_toBitVec]
+theorem Bool.toBitVec_toInt8 {b : Bool} : b.toInt8.toBitVec = (BitVec.ofBool b).setWidth 8 := by
+  cases b <;> simp [toInt8]
+
+@[simp, int_toBitVec]
+theorem Bool.toBitVec_toInt16 {b : Bool} : b.toInt16.toBitVec = (BitVec.ofBool b).setWidth 16 := by
+  cases b <;> simp [toInt16]
+
+@[simp, int_toBitVec]
+theorem Bool.toBitVec_toInt32 {b : Bool} : b.toInt32.toBitVec = (BitVec.ofBool b).setWidth 32 := by
+  cases b <;> simp [toInt32]
+
+@[simp, int_toBitVec]
+theorem Bool.toBitVec_toInt64 {b : Bool} : b.toInt64.toBitVec = (BitVec.ofBool b).setWidth 64 := by
+  cases b <;> simp [toInt64]
+
+@[simp, int_toBitVec]
+theorem Bool.toBitVec_toISize {b : Bool} :
+    b.toISize.toBitVec = (BitVec.ofBool b).setWidth System.Platform.numBits := by
+  cases b
+  · simp [toISize]
+  · apply BitVec.eq_of_toNat_eq
+    simp [toISize]

src/Init/Data/String/Basic.lean

@@ -1169,6 +1169,13 @@ end String
 
 namespace Char
 
+/--
+Constructs a singleton string that contains only the provided character.
+
+Examples:
+ * `'L'.toString = "L"`
+ * `'"'.toString = "\""`
+-/
 @[inline] protected def toString (c : Char) : String :=
   String.singleton c
 

src/Init/Data/UInt/Basic.lean

@@ -65,6 +65,9 @@ instance : Xor UInt8       := ⟨UInt8.xor⟩
 instance : ShiftLeft UInt8  := ⟨UInt8.shiftLeft⟩
 instance : ShiftRight UInt8 := ⟨UInt8.shiftRight⟩
 
+/--
+Converts `true` to `1` and `false` to `0`.
+-/
 @[extern "lean_bool_to_uint8"]
 def Bool.toUInt8 (b : Bool) : UInt8 := if b then 1 else 0
 
@@ -137,6 +140,9 @@ instance : Xor UInt16       := ⟨UInt16.xor⟩
 instance : ShiftLeft UInt16  := ⟨UInt16.shiftLeft⟩
 instance : ShiftRight UInt16 := ⟨UInt16.shiftRight⟩
 
+/--
+Converts `true` to `1` and `false` to `0`.
+-/
 @[extern "lean_bool_to_uint16"]
 def Bool.toUInt16 (b : Bool) : UInt16 := if b then 1 else 0
 
@@ -211,6 +217,9 @@ instance : Xor UInt32       := ⟨UInt32.xor⟩
 instance : ShiftLeft UInt32  := ⟨UInt32.shiftLeft⟩
 instance : ShiftRight UInt32 := ⟨UInt32.shiftRight⟩
 
+/--
+Converts `true` to `1` and `false` to `0`.
+-/
 @[extern "lean_bool_to_uint32"]
 def Bool.toUInt32 (b : Bool) : UInt32 := if b then 1 else 0
 
@@ -270,6 +279,9 @@ instance : Xor UInt64       := ⟨UInt64.xor⟩
 instance : ShiftLeft UInt64  := ⟨UInt64.shiftLeft⟩
 instance : ShiftRight UInt64 := ⟨UInt64.shiftRight⟩
 
+/--
+Converts `true` to `1` and `false` to `0`.
+-/
 @[extern "lean_bool_to_uint64"]
 def Bool.toUInt64 (b : Bool) : UInt64 := if b then 1 else 0
 
@@ -376,6 +388,9 @@ instance : Xor USize        := ⟨USize.xor⟩
 instance : ShiftLeft USize  := ⟨USize.shiftLeft⟩
 instance : ShiftRight USize := ⟨USize.shiftRight⟩
 
+/--
+Converts `true` to `1` and `false` to `0`.
+-/
 @[extern "lean_bool_to_usize"]
 def Bool.toUSize (b : Bool) : USize := if b then 1 else 0
 

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
@@ -287,6 +299,8 @@ theorem UInt32.size_le_usizeSize : UInt32.size ≤ USize.size := by
 theorem USize.size_eq_two_pow : USize.size = 2 ^ System.Platform.numBits := rfl
 theorem USize.toNat_lt_two_pow_numBits (n : USize) : n.toNat < 2 ^ System.Platform.numBits := n.toFin.isLt
 @[simp] theorem USize.toNat_lt (n : USize) : n.toNat < 2 ^ 64 := Nat.lt_of_lt_of_le n.toFin.isLt size_le
+theorem USize.size_le_uint64Size : USize.size ≤ UInt64.size := by
+  cases USize.size_eq <;> simp_all +decide
 
 theorem UInt8.toNat_lt_usizeSize (n : UInt8) : n.toNat < USize.size :=
   Nat.lt_of_lt_of_le n.toNat_lt (by cases USize.size_eq <;> simp_all)
@@ -309,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))
@@ -373,7 +396,7 @@ theorem USize.size_dvd_uInt64Size : USize.size ∣ UInt64.size := by cases USize
 @[simp] theorem UInt32.toFin_toUSize (n : UInt32) :
   n.toUSize.toFin = n.toFin.castLE size_le_usizeSize := rfl
 
-@[simp] theorem USize.toFin_toUInt64 (n : USize) : n.toUInt64.toFin = n.toFin.castLE size_le_usizeSize := rfl
+@[simp] theorem USize.toFin_toUInt64 (n : USize) : n.toUInt64.toFin = n.toFin.castLE size_le_uint64Size := rfl
 
 @[simp] theorem UInt16.toBitVec_toUInt8 (n : UInt16) : n.toUInt8.toBitVec = n.toBitVec.setWidth 8 := rfl
 @[simp] theorem UInt32.toBitVec_toUInt8 (n : UInt32) : n.toUInt8.toBitVec = n.toBitVec.setWidth 8 := rfl
@@ -783,3 +806,541 @@ 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])
+
+@[simp] theorem UInt8.toUInt16_ofNat' {n : Nat} (hn : n < UInt8.size) : (UInt8.ofNat n).toUInt16 = UInt16.ofNat n := by
+  rw [← UInt8.ofNatLT_eq_ofNat (h := hn), toUInt16_ofNatLT, UInt16.ofNatLT_eq_ofNat]
+@[simp] theorem UInt8.toUInt32_ofNat' {n : Nat} (hn : n < UInt8.size) : (UInt8.ofNat n).toUInt32 = UInt32.ofNat n := by
+  rw [← UInt8.ofNatLT_eq_ofNat (h := hn), toUInt32_ofNatLT, UInt32.ofNatLT_eq_ofNat]
+@[simp] theorem UInt8.toUInt64_ofNat' {n : Nat} (hn : n < UInt8.size) : (UInt8.ofNat n).toUInt64 = UInt64.ofNat n := by
+  rw [← UInt8.ofNatLT_eq_ofNat (h := hn), toUInt64_ofNatLT, UInt64.ofNatLT_eq_ofNat]
+@[simp] theorem UInt8.toUSize_ofNat' {n : Nat} (hn : n < UInt8.size) : (UInt8.ofNat n).toUSize = USize.ofNat n := by
+  rw [← UInt8.ofNatLT_eq_ofNat (h := hn), toUSize_ofNatLT, USize.ofNatLT_eq_ofNat]
+
+@[simp] theorem UInt16.toUInt32_ofNat' {n : Nat} (hn : n < UInt16.size) : (UInt16.ofNat n).toUInt32 = UInt32.ofNat n := by
+  rw [← UInt16.ofNatLT_eq_ofNat (h := hn), toUInt32_ofNatLT, UInt32.ofNatLT_eq_ofNat]
+@[simp] theorem UInt16.toUInt64_ofNat' {n : Nat} (hn : n < UInt16.size) : (UInt16.ofNat n).toUInt64 = UInt64.ofNat n := by
+  rw [← UInt16.ofNatLT_eq_ofNat (h := hn), toUInt64_ofNatLT, UInt64.ofNatLT_eq_ofNat]
+@[simp] theorem UInt16.toUSize_ofNat' {n : Nat} (hn : n < UInt16.size) : (UInt16.ofNat n).toUSize = USize.ofNat n := by
+  rw [← UInt16.ofNatLT_eq_ofNat (h := hn), toUSize_ofNatLT, USize.ofNatLT_eq_ofNat]
+
+@[simp] theorem UInt32.toUInt64_ofNat' {n : Nat} (hn : n < UInt32.size) : (UInt32.ofNat n).toUInt64 = UInt64.ofNat n := by
+  rw [← UInt32.ofNatLT_eq_ofNat (h := hn), toUInt64_ofNatLT, UInt64.ofNatLT_eq_ofNat]
+@[simp] theorem UInt32.toUSize_ofNat' {n : Nat} (hn : n < UInt32.size) : (UInt32.ofNat n).toUSize = USize.ofNat n := by
+  rw [← UInt32.ofNatLT_eq_ofNat (h := hn), toUSize_ofNatLT, USize.ofNatLT_eq_ofNat]
+
+@[simp] theorem USize.toUInt64_ofNat' {n : Nat} (hn : n < USize.size) : (USize.ofNat n).toUInt64 = UInt64.ofNat n := by
+  rw [← USize.ofNatLT_eq_ofNat (h := hn), toUInt64_ofNatLT, UInt64.ofNatLT_eq_ofNat]
+
+@[simp] theorem UInt8.toUInt16_ofNat {n : Nat} (hn : n < 256) : toUInt16 (no_index (OfNat.ofNat n)) = OfNat.ofNat n :=
+  UInt8.toUInt16_ofNat' hn
+@[simp] theorem UInt8.toUInt32_ofNat {n : Nat} (hn : n < 256) : toUInt32 (no_index (OfNat.ofNat n)) = OfNat.ofNat n :=
+  UInt8.toUInt32_ofNat' hn
+@[simp] theorem UInt8.toUInt64_ofNat {n : Nat} (hn : n < 256) : toUInt64 (no_index (OfNat.ofNat n)) = OfNat.ofNat n :=
+  UInt8.toUInt64_ofNat' hn
+@[simp] theorem UInt8.toUSize_ofNat {n : Nat} (hn : n < 256) : toUSize (no_index (OfNat.ofNat n)) = OfNat.ofNat n :=
+  UInt8.toUSize_ofNat' hn
+
+@[simp] theorem UInt16.toUInt32_ofNat {n : Nat} (hn : n < 65536) : toUInt32 (no_index (OfNat.ofNat n)) = OfNat.ofNat n :=
+  UInt16.toUInt32_ofNat' hn
+@[simp] theorem UInt16.toUInt64_ofNat {n : Nat} (hn : n < 65536) : toUInt64 (no_index (OfNat.ofNat n)) = OfNat.ofNat n :=
+  UInt16.toUInt64_ofNat' hn
+@[simp] theorem UInt16.toUSize_ofNat {n : Nat} (hn : n < 65536) : toUSize (no_index (OfNat.ofNat n)) = OfNat.ofNat n :=
+  UInt16.toUSize_ofNat' hn
+
+@[simp] theorem UInt32.toUInt64_ofNat {n : Nat} (hn : n < 4294967296) : toUInt64 (no_index (OfNat.ofNat n)) = OfNat.ofNat n :=
+  UInt32.toUInt64_ofNat' hn
+@[simp] theorem UInt32.toUSize_ofNat {n : Nat} (hn : n < 4294967296) : toUSize (no_index (OfNat.ofNat n)) = OfNat.ofNat n :=
+  UInt32.toUSize_ofNat' hn
+
+@[simp] theorem USize.toUInt64_ofNat {n : Nat} (hn : n < 4294967296) : toUInt64 (no_index (OfNat.ofNat n)) = OfNat.ofNat n :=
+  USize.toUInt64_ofNat' (Nat.lt_of_lt_of_le hn UInt32.size_le_usizeSize)
+
+@[simp] theorem UInt8.ofNatLT_finVal (n : Fin UInt8.size) : UInt8.ofNatLT n.val n.isLt = UInt8.ofFin n := rfl
+@[simp] theorem UInt16.ofNatLT_finVal (n : Fin UInt16.size) : UInt16.ofNatLT n.val n.isLt = UInt16.ofFin n := rfl
+@[simp] theorem UInt32.ofNatLT_finVal (n : Fin UInt32.size) : UInt32.ofNatLT n.val n.isLt = UInt32.ofFin n := rfl
+@[simp] theorem UInt64.ofNatLT_finVal (n : Fin UInt64.size) : UInt64.ofNatLT n.val n.isLt = UInt64.ofFin n := rfl
+@[simp] theorem USize.ofNatLT_finVal (n : Fin USize.size) : USize.ofNatLT n.val n.isLt = USize.ofFin n := rfl
+
+@[simp] theorem UInt8.ofNatLT_bitVecToNat (n : BitVec 8) : UInt8.ofNatLT n.toNat n.isLt = UInt8.ofBitVec n := rfl
+@[simp] theorem UInt16.ofNatLT_bitVecToNat (n : BitVec 16) : UInt16.ofNatLT n.toNat n.isLt = UInt16.ofBitVec n := rfl
+@[simp] theorem UInt32.ofNatLT_bitVecToNat (n : BitVec 32) : UInt32.ofNatLT n.toNat n.isLt = UInt32.ofBitVec n := rfl
+@[simp] theorem UInt64.ofNatLT_bitVecToNat (n : BitVec 64) : UInt64.ofNatLT n.toNat n.isLt = UInt64.ofBitVec n := rfl
+@[simp] theorem USize.ofNatLT_bitVecToNat (n : BitVec System.Platform.numBits) : USize.ofNatLT n.toNat n.isLt = USize.ofBitVec n := rfl
+
+@[simp] theorem UInt8.ofNat_finVal (n : Fin UInt8.size) : UInt8.ofNat n.val = UInt8.ofFin n := by
+  rw [← ofNatLT_eq_ofNat (h := n.isLt), ofNatLT_finVal]
+@[simp] theorem UInt16.ofNat_finVal (n : Fin UInt16.size) : UInt16.ofNat n.val = UInt16.ofFin n := by
+  rw [← ofNatLT_eq_ofNat (h := n.isLt), ofNatLT_finVal]
+@[simp] theorem UInt32.ofNat_finVal (n : Fin UInt32.size) : UInt32.ofNat n.val = UInt32.ofFin n := by
+  rw [← ofNatLT_eq_ofNat (h := n.isLt), ofNatLT_finVal]
+@[simp] theorem UInt64.ofNat_finVal (n : Fin UInt64.size) : UInt64.ofNat n.val = UInt64.ofFin n := by
+  rw [← ofNatLT_eq_ofNat (h := n.isLt), ofNatLT_finVal]
+@[simp] theorem USize.ofNat_finVal (n : Fin USize.size) : USize.ofNat n.val = USize.ofFin n := by
+  rw [← ofNatLT_eq_ofNat (h := n.isLt), ofNatLT_finVal]
+
+@[simp] theorem UInt8.ofNat_bitVecToNat (n : BitVec 8) : UInt8.ofNat n.toNat = UInt8.ofBitVec n := by
+  rw [← ofNatLT_eq_ofNat (h := n.isLt), ofNatLT_bitVecToNat]
+@[simp] theorem UInt16.ofNat_bitVecToNat (n : BitVec 16) : UInt16.ofNat n.toNat = UInt16.ofBitVec n := by
+  rw [← ofNatLT_eq_ofNat (h := n.isLt), ofNatLT_bitVecToNat]
+@[simp] theorem UInt32.ofNat_bitVecToNat (n : BitVec 32) : UInt32.ofNat n.toNat = UInt32.ofBitVec n := by
+  rw [← ofNatLT_eq_ofNat (h := n.isLt), ofNatLT_bitVecToNat]
+@[simp] theorem UInt64.ofNat_bitVecToNat (n : BitVec 64) : UInt64.ofNat n.toNat = UInt64.ofBitVec n := by
+  rw [← ofNatLT_eq_ofNat (h := n.isLt), ofNatLT_bitVecToNat]
+@[simp] theorem USize.ofNat_bitVecToNat (n : BitVec System.Platform.numBits) : USize.ofNat n.toNat = USize.ofBitVec n := by
+  rw [← ofNatLT_eq_ofNat (h := n.isLt), ofNatLT_bitVecToNat]
+
+@[simp] theorem UInt8.ofNatTruncate_finVal (n : Fin UInt8.size) : UInt8.ofNatTruncate n.val = UInt8.ofFin n := by
+  rw [ofNatTruncate_eq_ofNat _ n.isLt, UInt8.ofNat_finVal]
+@[simp] theorem UInt16.ofNatTruncate_finVal (n : Fin UInt16.size) : UInt16.ofNatTruncate n.val = UInt16.ofFin n := by
+  rw [ofNatTruncate_eq_ofNat _ n.isLt, UInt16.ofNat_finVal]
+@[simp] theorem UInt32.ofNatTruncate_finVal (n : Fin UInt32.size) : UInt32.ofNatTruncate n.val = UInt32.ofFin n := by
+  rw [ofNatTruncate_eq_ofNat _ n.isLt, UInt32.ofNat_finVal]
+@[simp] theorem UInt64.ofNatTruncate_finVal (n : Fin UInt64.size) : UInt64.ofNatTruncate n.val = UInt64.ofFin n := by
+  rw [ofNatTruncate_eq_ofNat _ n.isLt, UInt64.ofNat_finVal]
+@[simp] theorem USize.ofNatTruncate_finVal (n : Fin USize.size) : USize.ofNatTruncate n.val = USize.ofFin n := by
+  rw [ofNatTruncate_eq_ofNat _ n.isLt, USize.ofNat_finVal]
+
+@[simp] theorem UInt8.ofNatTruncate_bitVecToNat (n : BitVec 8) : UInt8.ofNatTruncate n.toNat = UInt8.ofBitVec n := by
+  rw [ofNatTruncate_eq_ofNat _ n.isLt, ofNat_bitVecToNat]
+@[simp] theorem UInt16.ofNatTruncate_bitVecToNat (n : BitVec 16) : UInt16.ofNatTruncate n.toNat = UInt16.ofBitVec n := by
+  rw [ofNatTruncate_eq_ofNat _ n.isLt, ofNat_bitVecToNat]
+@[simp] theorem UInt32.ofNatTruncate_bitVecToNat (n : BitVec 32) : UInt32.ofNatTruncate n.toNat = UInt32.ofBitVec n := by
+  rw [ofNatTruncate_eq_ofNat _ n.isLt, ofNat_bitVecToNat]
+@[simp] theorem UInt64.ofNatTruncate_bitVecToNat (n : BitVec 64) : UInt64.ofNatTruncate n.toNat = UInt64.ofBitVec n := by
+  rw [ofNatTruncate_eq_ofNat _ n.isLt, ofNat_bitVecToNat]
+@[simp] theorem USize.ofNatTruncate_bitVecToNat (n : BitVec System.Platform.numBits) : USize.ofNatTruncate n.toNat = USize.ofBitVec n := by
+  rw [ofNatTruncate_eq_ofNat _ n.isLt, ofNat_bitVecToNat]
+
+@[simp] theorem UInt8.ofFin_mk {n : Nat} (hn) : UInt8.ofFin (Fin.mk n hn) = UInt8.ofNatLT n hn := rfl
+@[simp] theorem UInt16.ofFin_mk {n : Nat} (hn) : UInt16.ofFin (Fin.mk n hn) = UInt16.ofNatLT n hn := rfl
+@[simp] theorem UInt32.ofFin_mk {n : Nat} (hn) : UInt32.ofFin (Fin.mk n hn) = UInt32.ofNatLT n hn := rfl
+@[simp] theorem UInt64.ofFin_mk {n : Nat} (hn) : UInt64.ofFin (Fin.mk n hn) = UInt64.ofNatLT n hn := rfl
+@[simp] theorem USize.ofFin_mk {n : Nat} (hn) : USize.ofFin (Fin.mk n hn) = USize.ofNatLT n hn := rfl
+
+@[simp] theorem UInt8.ofFin_bitVecToFin (n : BitVec 8) : UInt8.ofFin n.toFin = UInt8.ofBitVec n := rfl
+@[simp] theorem UInt16.ofFin_bitVecToFin (n : BitVec 16) : UInt16.ofFin n.toFin = UInt16.ofBitVec n := rfl
+@[simp] theorem UInt32.ofFin_bitVecToFin (n : BitVec 32) : UInt32.ofFin n.toFin = UInt32.ofBitVec n := rfl
+@[simp] theorem UInt64.ofFin_bitVecToFin (n : BitVec 64) : UInt64.ofFin n.toFin = UInt64.ofBitVec n := rfl
+@[simp] theorem USize.ofFin_bitVecToFin (n : BitVec System.Platform.numBits) : USize.ofFin n.toFin = USize.ofBitVec n := rfl
+
+@[simp] theorem UInt8.ofBitVec_ofNatLT {n : Nat} (hn) : UInt8.ofBitVec (BitVec.ofNatLT n hn) = UInt8.ofNatLT n hn := rfl
+@[simp] theorem UInt16.ofBitVec_ofNatLT {n : Nat} (hn) : UInt16.ofBitVec (BitVec.ofNatLT n hn) = UInt16.ofNatLT n hn := rfl
+@[simp] theorem UInt32.ofBitVec_ofNatLT {n : Nat} (hn) : UInt32.ofBitVec (BitVec.ofNatLT n hn) = UInt32.ofNatLT n hn := rfl
+@[simp] theorem UInt64.ofBitVec_ofNatLT {n : Nat} (hn) : UInt64.ofBitVec (BitVec.ofNatLT n hn) = UInt64.ofNatLT n hn := rfl
+@[simp] theorem USize.ofBitVec_ofNatLT {n : Nat} (hn) : USize.ofBitVec (BitVec.ofNatLT n hn) = USize.ofNatLT n hn := rfl
+
+@[simp] theorem UInt8.ofBitVec_ofFin (n) : UInt8.ofBitVec (BitVec.ofFin n) = UInt8.ofFin n := rfl
+@[simp] theorem UInt16.ofBitVec_ofFin (n) : UInt16.ofBitVec (BitVec.ofFin n) = UInt16.ofFin n := rfl
+@[simp] theorem UInt32.ofBitVec_ofFin (n) : UInt32.ofBitVec (BitVec.ofFin n) = UInt32.ofFin n := rfl
+@[simp] theorem UInt64.ofBitVec_ofFin (n) : UInt64.ofBitVec (BitVec.ofFin n) = UInt64.ofFin n := rfl
+@[simp] theorem USize.ofBitVec_ofFin (n) : USize.ofBitVec (BitVec.ofFin n) = USize.ofFin n := rfl
+
+@[simp] theorem BitVec.ofNat_uInt8ToNat (n : UInt8) : BitVec.ofNat 8 n.toNat = n.toBitVec :=
+  BitVec.eq_of_toNat_eq (by simp)
+@[simp] theorem BitVec.ofNat_uInt16ToNat (n : UInt16) : BitVec.ofNat 16 n.toNat = n.toBitVec :=
+  BitVec.eq_of_toNat_eq (by simp)
+@[simp] theorem BitVec.ofNat_uInt32ToNat (n : UInt32) : BitVec.ofNat 32 n.toNat = n.toBitVec :=
+  BitVec.eq_of_toNat_eq (by simp)
+@[simp] theorem BitVec.ofNat_uInt64ToNat (n : UInt64) : BitVec.ofNat 64 n.toNat = n.toBitVec :=
+  BitVec.eq_of_toNat_eq (by simp)
+@[simp] theorem BitVec.ofNat_uSizeToNat (n : USize) : BitVec.ofNat System.Platform.numBits n.toNat = n.toBitVec :=
+  BitVec.eq_of_toNat_eq (by simp)

src/Init/Data/Vector/Lemmas.lean

@@ -2189,6 +2189,16 @@ theorem extract_empty (start stop : Nat) :
   rcases xs with ⟨xs, rfl⟩
   simp
 
+@[simp]
+theorem foldlM_pure [Monad m] [LawfulMonad m] (f : β → α → β) (b) (xs : Vector α n) :
+    xs.foldlM (m := m) (pure <| f · ·) b = pure (xs.foldl f b) :=
+  Array.foldlM_pure _ _ _
+
+@[simp]
+theorem foldrM_pure [Monad m] [LawfulMonad m] (f : α → β → β) (b) (xs : Vector α n) :
+    xs.foldrM (m := m) (pure <| f · ·) b = pure (xs.foldr f b) :=
+  Array.foldrM_pure _ _ _
+
 theorem foldl_eq_foldlM (f : β → α → β) (b) (xs : Vector α n) :
     xs.foldl f b = xs.foldlM (m := Id) f b := by
   rcases xs with ⟨xs, rfl⟩
@@ -2828,7 +2838,7 @@ theorem swap_comm (xs : Vector α n) {i j : Nat} {hi hj} :
 
 /-! ### take -/
 
-@[simp] theorem getElem_take (xs : Vector α n) (j : Nat) (hi : i < min n j) :
+@[simp] theorem getElem_take (xs : Vector α n) (j : Nat) (hi : i < min j n) :
     (xs.take j)[i] = xs[i] := by
   cases xs
   simp

src/Init/Data/Vector/Monadic.lean

@@ -29,6 +29,12 @@ open Nat
 
 /-! ### mapM -/
 
+@[simp]
+theorem mapM_pure [Monad m] [LawfulMonad m] {xs : Vector α n} (f : α → β) :
+    xs.mapM (m := m) (pure <| f ·) = pure (xs.map f) := by
+  apply map_toArray_inj.mp
+  simp
+
 @[congr] theorem mapM_congr [Monad m] {xs ys : Vector α n} (w : xs = ys)
     {f : α → m β} :
     xs.mapM f = ys.mapM f := by
@@ -215,4 +221,30 @@ theorem forIn_pure_yield_eq_foldl [Monad m] [LawfulMonad m]
   rcases xs with ⟨xs, rfl⟩
   simp
 
+
+/-! ### allM and anyM -/
+
+@[simp] theorem anyM_pure [Monad m] [LawfulMonad m] (p : α → Bool) (xs : Vector α n) :
+    xs.anyM (m := m) (pure <| p ·) = pure (xs.any p) := by
+  cases xs
+  simp
+
+@[simp] theorem allM_pure [Monad m] [LawfulMonad m] (p : α → Bool) (xs : Vector α n) :
+    xs.allM (m := m) (pure <| p ·) = pure (xs.all p) := by
+  cases xs
+  simp
+
+/-! ### findM? and findSomeM? -/
+
+theorem findM?_pure {m} [Monad m] [LawfulMonad m] (p : α → Bool) (xs : Vector α n) :
+    findM? (m := m) (pure <| p ·) xs = pure (xs.find? p) := by
+  cases xs
+  simp
+
+@[simp]
+theorem findSomeM?_pure [Monad m] [LawfulMonad m] (f : α → Option β) (xs : Vector α n) :
+    findSomeM? (m := m) (pure <| f ·) xs = pure (xs.findSome? f) := by
+  cases xs
+  simp
+
 end Vector

src/Init/Grind/Norm.lean

@@ -123,10 +123,11 @@ 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
-  Int.add_def Int.mul_def
+  Int.add_def Int.mul_def Int.ofNat_eq_coe
   Int.Linear.sub_fold Int.Linear.neg_fold
   -- Int divides
   Int.one_dvd Int.zero_dvd

src/Init/Grind/Tactics.lean

@@ -69,6 +69,11 @@ structure Config where
   verbose : Bool := true
   /-- If `clean` is `true`, `grind` uses `expose_names` and only generates accessible names. -/
   clean : Bool := true
+  /--
+  If `qlia` is `true`, `grind` may generate counterexamples for integer constraints
+  using rational numbers, and ignoring divisibility constraints.
+  This approach is cheaper but incomplete. -/
+  qlia : Bool := false
   deriving Inhabited, BEq
 
 end Lean.Grind

src/Init/Grind/Util.lean

@@ -5,6 +5,7 @@ Authors: Leonardo de Moura
 -/
 prelude
 import Init.Core
+import Init.Classical
 
 namespace Lean.Grind
 
@@ -77,5 +78,23 @@ def offsetUnexpander : PrettyPrinter.Unexpander := fun stx => do
   | `($_ $lhs:term $rhs:term) => `($lhs + $rhs)
   | _ => throw ()
 
+/--
+A marker to indicate that a proposition has already been normalized and should not
+be processed again.
+
+This prevents issues when case-splitting on the condition `c` of an if-then-else
+expression. Without this marker, the negated condition `¬c` might be rewritten into
+an alternative form `c'`, which `grind` may not recognize as equivalent to `¬c`.
+As a result, `grind` could fail to propagate that `if c then a else b` simplifies to `b`
+in the `¬c` branch.
+-/
+def alreadyNorm (p : Prop) : Prop := p
+
+/--
+`Classical.em` variant where disjuncts are marked with `alreadyNorm` gadget.
+See comment at `alreadyNorm`
+-/
+theorem em (p : Prop) : alreadyNorm p ∨ alreadyNorm (¬ p) :=
+  Classical.em p
 
 end Lean.Grind

src/Init/Omega/Constraint.lean

@@ -111,9 +111,7 @@ def isExact : Constraint → Bool
 
 theorem not_sat_of_isImpossible (h : isImpossible c) {t} : ¬ c.sat t := by
   rcases c with ⟨_ | l, _ | u⟩ <;> simp [isImpossible, sat] at h ⊢
-  intro w
-  rw [Int.not_le]
-  exact Int.lt_of_lt_of_le h w
+  exact Int.lt_of_lt_of_le h
 
 /--
 Scale a constraint by multiplying by an integer.
@@ -139,17 +137,14 @@ theorem scale_sat {c : Constraint} (k) (w : c.sat t) : (scale k c).sat (k * t) :
   · rcases c with ⟨_ | l, _ | u⟩ <;> split <;> rename_i h <;> simp_all [sat, flip, map]
     · replace h := Int.le_of_lt h
       exact Int.mul_le_mul_of_nonneg_left w h
-    · rw [Int.not_lt] at h
-      exact Int.mul_le_mul_of_nonpos_left h w
+    · exact Int.mul_le_mul_of_nonpos_left h w
     · replace h := Int.le_of_lt h
       exact Int.mul_le_mul_of_nonneg_left w h
-    · rw [Int.not_lt] at h
-      exact Int.mul_le_mul_of_nonpos_left h w
+    · exact Int.mul_le_mul_of_nonpos_left h w
     · constructor
       · exact Int.mul_le_mul_of_nonneg_left w.1 (Int.le_of_lt h)
       · exact Int.mul_le_mul_of_nonneg_left w.2 (Int.le_of_lt h)
-    · replace h := Int.not_lt.mp h
-      constructor
+    · constructor
       · exact Int.mul_le_mul_of_nonpos_left h w.2
       · exact Int.mul_le_mul_of_nonpos_left h w.1
 
@@ -210,21 +205,19 @@ theorem div_sat (c : Constraint) (t : Int) (k : Nat) (n : k ≠ 0) (h : (k : Int
   · simp_all [sat, div]
   · simp [sat, div] at w ⊢
     apply Int.le_of_sub_nonneg
-    rw [← Int.sub_ediv_of_dvd _ h, ← ge_iff_le, Int.div_nonneg_iff_of_pos n]
+    rw [← Int.sub_ediv_of_dvd _ h, Int.ediv_nonneg_iff_of_pos n]
     exact Int.sub_nonneg_of_le w
   · simp [sat, div] at w ⊢
     apply Int.le_of_sub_nonneg
-    rw [Int.sub_neg, ← Int.add_ediv_of_dvd_left h, ← ge_iff_le,
-      Int.div_nonneg_iff_of_pos n]
+    rw [Int.sub_neg, ← Int.add_ediv_of_dvd_left h, Int.ediv_nonneg_iff_of_pos n]
     exact Int.sub_nonneg_of_le w
   · simp [sat, div] at w ⊢
     constructor
     · apply Int.le_of_sub_nonneg
-      rw [Int.sub_neg, ← Int.add_ediv_of_dvd_left h, ← ge_iff_le,
-        Int.div_nonneg_iff_of_pos n]
+      rw [Int.sub_neg, ← Int.add_ediv_of_dvd_left h, Int.ediv_nonneg_iff_of_pos n]
       exact Int.sub_nonneg_of_le w.1
     · apply Int.le_of_sub_nonneg
-      rw [← Int.sub_ediv_of_dvd _ h, ← ge_iff_le, Int.div_nonneg_iff_of_pos n]
+      rw [← Int.sub_ediv_of_dvd _ h, Int.ediv_nonneg_iff_of_pos n]
       exact Int.sub_nonneg_of_le w.2
 
 /--

src/Init/Prelude.lean

@@ -561,16 +561,17 @@ theorem Or.neg_resolve_left  (h : Or (Not a) b) (ha : a) : b := h.elim (absurd h
 theorem Or.neg_resolve_right (h : Or a (Not b)) (nb : b) : a := h.elim id (absurd nb)
 
 /--
-`Bool` is the type of boolean values, `true` and `false`. Classically,
-this is equivalent to `Prop` (the type of propositions), but the distinction
-is important for programming, because values of type `Prop` are erased in the
-code generator, while `Bool` corresponds to the type called `bool` or `boolean`
-in most programming languages.
+The Boolean values, `true` and `false`.
+
+Logically speaking, this is equivalent to `Prop` (the type of propositions). The distinction is
+important for programming: both propositions and their proofs are erased in the code generator,
+while `Bool` corresponds to the Boolean type in most programming languages and carries precisely one
+bit of run-time information.
 -/
 inductive Bool : Type where
-  /-- The boolean value `false`, not to be confused with the proposition `False`. -/
+  /-- The Boolean value `false`, not to be confused with the proposition `False`. -/
   | false : Bool
-  /-- The boolean value `true`, not to be confused with the proposition `True`. -/
+  /-- The Boolean value `true`, not to be confused with the proposition `True`. -/
   | true : Bool
 
 export Bool (false true)
@@ -900,7 +901,12 @@ theorem of_decide_eq_self_eq_true [inst : DecidableEq α] (a : α) : Eq (decide
   | isTrue  _  => rfl
   | isFalse h₁ => absurd rfl h₁
 
-/-- Decidable equality for Bool -/
+/--
+Decides whether two Booleans are equal.
+
+This function should normally be called via the `DecidableEq Bool` instance that it exists to
+support.
+-/
 @[inline] def Bool.decEq (a b : Bool) : Decidable (Eq a b) :=
    match a, b with
    | false, false => isTrue rfl
@@ -1002,22 +1008,34 @@ instance [dp : Decidable p] : Decidable (Not p) :=
 /-! # Boolean operators -/
 
 /--
-`cond b x y` is the same as `if b then x else y`, but optimized for a
-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`).
+The conditional function.
+
+`cond c x y` is the same as `if c then x else y`, but optimized for a Boolean condition rather than
+a decidable proposition. It can also be written using the notation `bif c then x else y`.
+
+Just like `ite`, `cond` is declared `@[macro_inline]`, which causes applications of `cond` to be
+unfolded. As a result, `x` and `y` are not evaluated at runtime until one of them is selected, and
+only the selected branch is evaluated.
 -/
-@[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
 
 
 /--
-`Bool.dcond b (fun h => x) (fun h => y)` is the same as `if h _ : b then x else y`,
-but optimized for a 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 `dite`).
-This definition intendend for metaprogramming use, and does not come with a suitable API.
+The dependent conditional function, in which each branch is provided with a local assumption about
+the condition's value. This allows the value to be used in proofs as well as for control flow.
+
+`dcond c (fun h => x) (fun h => y)` is the same as `if h : c then x else y`, but optimized for a
+Boolean condition rather than a decidable proposition. Unlike the non-dependent version `cond`,
+there is no special notation for `dcond`.
+
+Just like `ite`, `dite`, and `cond`, `dcond` is declared `@[macro_inline]`, which causes
+applications of `dcond` to be unfolded. As a result, `x` and `y` are not evaluated at runtime until
+one of them is selected, and only the selected branch is evaluated. `dcond` is intended for
+metaprogramming use, rather than for use in verified programs, so behavioral lemmas are not
+provided.
 -/
 @[macro_inline]
 protected def Bool.dcond {α : Sort u} (c : Bool) (x : Eq c true → α) (y : Eq c false → α) : α :=
@@ -1026,10 +1044,13 @@ protected def Bool.dcond {α : Sort u} (c : Bool) (x : Eq c true → α) (y : Eq
   | false => y rfl
 
 /--
-`or x y`, or `x || y`, is the boolean "or" operation (not to be confused
-with `Or : Prop → Prop → Prop`, which is the propositional connective).
-It is `@[macro_inline]` because it has C-like short-circuiting behavior:
-if `x` is true then `y` is not evaluated.
+Boolean “or”, also known as disjunction. `or x y` can be written `x || y`.
+
+The corresponding propositional connective is `Or : Prop → Prop → Prop`, written with the `∨`
+operator.
+
+The Boolean `or` is a `@[macro_inline]` function in order to give it short-circuiting evaluation:
+if `x` is `true` then `y` is not evaluated at runtime.
 -/
 @[macro_inline] def Bool.or (x y : Bool) : Bool :=
   match x with
@@ -1037,10 +1058,13 @@ if `x` is true then `y` is not evaluated.
   | false => y
 
 /--
-`and x y`, or `x && y`, is the boolean "and" operation (not to be confused
-with `And : Prop → Prop → Prop`, which is the propositional connective).
-It is `@[macro_inline]` because it has C-like short-circuiting behavior:
-if `x` is false then `y` is not evaluated.
+Boolean “and”, also known as conjunction. `and x y` can be written `x && y`.
+
+The corresponding propositional connective is `And : Prop → Prop → Prop`, written with the `∧`
+operator.
+
+The Boolean `and` is a `@[macro_inline]` function in order to give it short-circuiting evaluation:
+if `x` is `false` then `y` is not evaluated at runtime.
 -/
 @[macro_inline] def Bool.and (x y : Bool) : Bool :=
   match x with
@@ -1048,8 +1072,10 @@ if `x` is false then `y` is not evaluated.
   | true  => y
 
 /--
-`not x`, or `!x`, is the boolean "not" operation (not to be confused
-with `Not : Prop → Prop`, which is the propositional connective).
+Boolean negation, also known as Boolean complement. `not x` can be written `!x`.
+
+This is a function that maps the value `true` to `false` and the value `false` to `true`. The
+propositional connective is `Not : Prop → Prop`.
 -/
 @[inline] def Bool.not : Bool → Bool
   | true  => false
@@ -2223,12 +2249,13 @@ it is also not a "surrogate" character (the range `0xd800` to `0xdfff` inclusive
 abbrev UInt32.isValidChar (n : UInt32) : Prop :=
   n.toNat.isValidChar
 
-/-- The `Char` Type represents an unicode scalar value.
-    See http://www.unicode.org/glossary/#unicode_scalar_value). -/
+/--
+Characters are Unicode [scalar values](http://www.unicode.org/glossary/#unicode_scalar_value).
+-/
 structure Char where
-  /-- The underlying unicode scalar value as a `UInt32`. -/
+  /-- The underlying Unicode scalar value as a `UInt32`. -/
   val   : UInt32
-  /-- The value must be a legal codepoint. -/
+  /-- The value must be a legal scalar value. -/
   valid : val.isValidChar
 
 private theorem isValidChar_UInt32 {n : Nat} (h : n.isValidChar) : LT.lt n UInt32.size :=
@@ -2245,8 +2272,8 @@ def Char.ofNatAux (n : @& Nat) (h : n.isValidChar) : Char :=
   { val := ⟨BitVec.ofNatLT n (isValidChar_UInt32 h)⟩, valid := h }
 
 /--
-Convert a `Nat` into a `Char`. If the `Nat` does not encode a valid unicode scalar value,
-`'\0'` is returned instead.
+Converts a `Nat` into a `Char`. If the `Nat` does not encode a valid Unicode scalar value, `'\0'` is
+returned instead.
 -/
 @[noinline, match_pattern]
 def Char.ofNat (n : Nat) : Char :=
@@ -2625,12 +2652,15 @@ attribute [nospecialize] Inhabited
 `Array α` is the type of [dynamic arrays](https://en.wikipedia.org/wiki/Dynamic_array)
 with elements from `α`. This type has special support in the runtime.
 
-An array has a size and a capacity; the size is `Array.size` but the capacity
-is not observable from Lean code. Arrays perform best when unshared; as long
+Arrays perform best when unshared; as long
 as they are used "linearly" all updates will be performed destructively on the
 array, so it has comparable performance to mutable arrays in imperative
 programming languages.
 
+An array has a size and a capacity; the size is `Array.size` but the capacity
+is not observable from Lean code. `Array.mkEmpty n` creates an array which is equal to `#[]`,
+but internally allocates an array of capacity `n`.
+
 From the point of view of proofs `Array α` is just a wrapper around `List α`.
 -/
 structure Array (α : Type u) where

src/Init/System/Platform.lean

@@ -26,9 +26,11 @@ def target : String := getTarget ()
 theorem numBits_pos : 0 < numBits := by
   cases numBits_eq <;> next h => simp [h]
 
+@[simp]
 theorem le_numBits : 32 ≤ numBits := by
   cases numBits_eq <;> next h => simp [h]
 
+@[simp]
 theorem numBits_le : numBits ≤ 64 := by
   cases numBits_eq <;> next h => simp [h]
 

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/Init/Tactics.lean

@@ -461,11 +461,14 @@ syntax config := atomic(" (" &"config") " := " withoutPosition(term) ")"
 /-- The `*` location refers to all hypotheses and the goal. -/
 syntax locationWildcard := " *"
 
+/-- The `⊢` location refers to the current goal. -/
+syntax locationType := patternIgnore(atomic("|" noWs "-") <|> "⊢")
+
 /--
-A hypothesis location specification consists of 1 or more hypothesis references
-and optionally `⊢` denoting the goal.
+A sequence of one or more locations at which a tactic should operate. These can include local
+hypotheses and `⊢`, which denotes the goal.
 -/
-syntax locationHyp := (ppSpace colGt term:max)+ patternIgnore(ppSpace (atomic("|" noWs "-") <|> "⊢"))?
+syntax locationHyp := (ppSpace colGt (term:max <|> locationType))+
 
 /--
 Location specifications are used by many tactics that can operate on either the
@@ -1347,7 +1350,7 @@ syntax (name := omega) "omega" optConfig : tactic
 Currently the preprocessor is implemented as `try simp only [bitvec_to_nat] at *`.
 `bitvec_to_nat` is a `@[simp]` attribute that you can (cautiously) add to more theorems.
 -/
-macro "bv_omega" : tactic => `(tactic| (try simp only [bitvec_to_nat] at *) <;> omega)
+macro "bv_omega" : tactic => `(tactic| (try simp -implicitDefEqProofs only [bitvec_to_nat] at *) <;> omega)
 
 /-- Implementation of `ac_nf` (the full `ac_nf` calls `trivial` afterwards). -/
 syntax (name := acNf0) "ac_nf0" (location)? : tactic

src/Lean.lean

@@ -39,3 +39,4 @@ import Lean.AddDecl
 import Lean.Replay
 import Lean.PrivateName
 import Lean.PremiseSelection
+import Lean.Namespace

src/Lean/AddDecl.lean

@@ -5,6 +5,7 @@ Authors: Leonardo de Moura
 -/
 prelude
 import Lean.CoreM
+import Lean.Namespace
 
 namespace Lean
 
@@ -46,9 +47,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,9 +80,9 @@ 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'"
+        logWarning <| .tagged `hasSorry m!"declaration uses 'sorry'"
       let env ← (← getEnv).addDeclAux (← getOptions) decl (← read).cancelTk?
         |> ofExceptKernelException
       setEnv env

src/Lean/Attributes.lean

@@ -252,6 +252,13 @@ def registerEnumAttributes (attrDescrs : List (Name × String × α))
       let r : Array (Name × α) := m.fold (fun a n p => a.push (n, p)) #[]
       r.qsort (fun a b => Name.quickLt a.1 b.1)
     statsFn         := fun s => "enumeration attribute extension" ++ Format.line ++ "number of local entries: " ++ format s.size
+    -- We assume (and check below) that, if used asynchronously, enum attributes are set only in the
+    -- same context in which the tagged declaration was created
+    asyncMode       := .async
+    replay?         := some fun _ newState consts st => consts.foldl (init := st) fun st c =>
+      match newState.find? c with
+      | some v => st.insert c v
+      | _      => st
   }
   let attrs := attrDescrs.map fun (name, descr, val) => {
     ref             := ref
@@ -279,15 +286,16 @@ def getValue [Inhabited α] (attr : EnumAttributes α) (env : Environment) (decl
     match (attr.ext.getModuleEntries env modIdx).binSearch (decl, default) (fun a b => Name.quickLt a.1 b.1) with
     | some (_, val) => some val
     | none          => none
-  | none        => (attr.ext.getState env).find? decl
+  | none        => (attr.ext.findStateAsync env decl).find? decl
 
-def setValue (attrs : EnumAttributes α) (env : Environment) (decl : Name) (val : α) : Except String Environment :=
+def setValue (attrs : EnumAttributes α) (env : Environment) (decl : Name) (val : α) : Except String Environment := do
   if (env.getModuleIdxFor? decl).isSome then
-    Except.error ("invalid '" ++ toString attrs.ext.name ++ "'.setValue, declaration is in an imported module")
-  else if ((attrs.ext.getState env).find? decl).isSome then
-    Except.error ("invalid '" ++ toString attrs.ext.name ++ "'.setValue, attribute has already been set")
-  else
-    Except.ok (attrs.ext.addEntry env (decl, val))
+    throw s!"invalid '{attrs.ext.name}'.setValue, declaration is in an imported module"
+  if !env.asyncMayContain decl then
+    throw s!"invalid '{attrs.ext.name}'.setValue, declaration is not from this async context"
+  if ((attrs.ext.findStateAsync env decl).find? decl).isSome then
+    throw s!"invalid '{attrs.ext.name}'.setValue, attribute has already been set"
+  return attrs.ext.addEntry env (decl, val)
 
 end EnumAttributes
 

src/Lean/Compiler/ClosedTermCache.lean

@@ -11,10 +11,17 @@ namespace Lean
 structure ClosedTermCache where
   map        : PHashMap Expr Name := {}
   constNames : NameSet := {}
+  -- used for `replay?` only
+  revExprs   : List Expr := []
   deriving Inhabited
 
 builtin_initialize closedTermCacheExt : EnvExtension ClosedTermCache ←
   registerEnvExtension (pure {}) (asyncMode := .sync)  -- compilation is non-parallel anyway
+    (replay? := some fun oldState newState _ s =>
+      let newExprs := newState.revExprs.take (newState.revExprs.length - oldState.revExprs.length)
+      newExprs.foldl (init := s) fun s e =>
+        let c := newState.map.find! e
+        { s with map := s.map.insert e c, constNames := s.constNames.insert c, revExprs := e :: s.revExprs })
 
 @[export lean_cache_closed_term_name]
 def cacheClosedTermName (env : Environment) (e : Expr) (n : Name) : Environment :=

src/Lean/Compiler/IR/CompilerM.lean

@@ -94,6 +94,7 @@ builtin_initialize declMapExt : SimplePersistentEnvExtension Decl DeclMap ←
     -- share a name prefix with the top-level Lean declaration being compiled, e.g. from
     -- specialization.
     asyncMode     := .sync
+    replay?       := some <| SimplePersistentEnvExtension.replayOfFilter (!·.contains ·.name) (fun s d => s.insert d.name d)
   }
 
 @[export lean_ir_find_env_decl]

src/Lean/Compiler/IR/ElimDeadBranches.lean

@@ -143,6 +143,7 @@ builtin_initialize functionSummariesExt : SimplePersistentEnvExtension (FunId ×
     addEntryFn := fun s ⟨e, n⟩ => s.insert e n
     toArrayFn := fun s => sortEntries s.toArray
     asyncMode := .sync  -- compilation is non-parallel anyway
+    replay? := some <| SimplePersistentEnvExtension.replayOfFilter (!·.contains ·.1) (fun s ⟨e, n⟩ => s.insert e n)
   }
 
 def addFunctionSummary (env : Environment) (fid : FunId) (v : Value) : Environment :=

src/Lean/Compiler/Specialize.lean

@@ -111,6 +111,9 @@ builtin_initialize specExtension : SimplePersistentEnvExtension SpecEntry SpecSt
     addEntryFn    := SpecState.addEntry,
     addImportedFn := fun es => (mkStateFromImportedEntries SpecState.addEntry {} es).switch
     asyncMode     := .sync  -- compilation is non-parallel anyway
+    replay?       := some <| SimplePersistentEnvExtension.replayOfFilter (fun
+      | s, .info n _ => !s.specInfo.contains n
+      | s, .cache key _ => !s.cache.contains key) SpecState.addEntry
   }
 
 @[export lean_add_specialization_info]

src/Lean/CoreM.lean

@@ -44,6 +44,13 @@ register_builtin_option Elab.async : Bool := {
       `Lean.Command.State.snapshotTasks`."
 }
 
+/-- Performance option used by cmdline driver. -/
+register_builtin_option internal.cmdlineSnapshots : Bool := {
+  defValue := false
+  descr    := "reduce information stored in snapshots to the minimum necessary \
+    for the cmdline driver: diagnostics per command and final full snapshot"
+}
+
 /--
 If the `diagnostics` option is not already set, gives a message explaining this option.
 Begins with a `\n\n`, so an error message can look like `m!"some error occurred{useDiagnosticMsg}"`.
@@ -365,6 +372,16 @@ for incremental reporting during elaboration of a single command.
 def getAndEmptyMessageLog : CoreM MessageLog :=
   modifyGet fun s => (s.messages, { s with messages := s.messages.markAllReported })
 
+/--
+Returns the current set of tasks added by `logSnapshotTask` and then resets it. When
+saving/restoring state of an action that may have logged such tasks during incremental reuse, this
+function must be used to store them in the corresponding snapshot tree; otherwise, they will leak
+outside and may be cancelled by a later step, potentially leading to inconsistent state being
+reused.
+-/
+def getAndEmptySnapshotTasks : CoreM (Array (Language.SnapshotTask Language.SnapshotTree)) :=
+  modifyGet fun s => (s.snapshotTasks, { s with snapshotTasks := #[] })
+
 instance : MonadLog CoreM where
   getRef      := getRef
   getFileMap  := return (← read).fileMap
@@ -535,7 +552,9 @@ opaque compileDeclsOld (env : Environment) (opt : @& Options) (decls : @& List N
 -- `ref?` is used for error reporting if available
 partial def compileDecls (decls : List Name) (ref? : Option Declaration := none)
     (logErrors := true) : CoreM Unit := do
-  if !Elab.async.get (← getOptions) then
+  -- When inside `realizeConst`, do compilation synchronously so that `_cstage*` constants are found
+  -- by the replay code
+  if !Elab.async.get (← getOptions) || (← getEnv).isRealizing then
     doCompile
     return
   let env ← getEnv

src/Lean/Data/Lsp/Capabilities.lean

@@ -59,12 +59,29 @@ structure WorkspaceClientCapabilities where
   workspaceEdit? : Option WorkspaceEditClientCapabilities := none
   deriving ToJson, FromJson
 
+structure LeanClientCapabilities where
+  /--
+  Whether the client supports `DiagnosticWith.isSilent = true`.
+  If `none` or `false`, silent diagnostics will not be served to the client.
+  -/
+  silentDiagnosticSupport? : Option Bool := none
+  deriving ToJson, FromJson
+
 structure ClientCapabilities where
   textDocument? : Option TextDocumentClientCapabilities := none
   window?       : Option WindowClientCapabilities       := none
   workspace?    : Option WorkspaceClientCapabilities    := none
+  /-- Capabilties for Lean language server extensions. -/
+  lean?         : Option LeanClientCapabilities         := none
   deriving ToJson, FromJson
 
+def ClientCapabilities.silentDiagnosticSupport (c : ClientCapabilities) : Bool := Id.run do
+  let some lean := c.lean?
+    | return false
+  let some silentDiagnosticSupport := lean.silentDiagnosticSupport?
+    | return false
+  return silentDiagnosticSupport
+
 -- TODO largely unimplemented
 structure ServerCapabilities where
   textDocumentSync?         : Option TextDocumentSyncOptions := none

src/Lean/Data/Lsp/Diagnostics.lean

@@ -66,13 +66,42 @@ inductive DiagnosticTag where
 
 instance : FromJson DiagnosticTag := ⟨fun j =>
   match j.getNat? with
-  | Except.ok 1 => return DiagnosticTag.unnecessary
-  | Except.ok 2 => return DiagnosticTag.deprecated
-  | _      => throw "unknown DiagnosticTag"⟩
+  | Except.ok 1  => return DiagnosticTag.unnecessary
+  | Except.ok 2  => return DiagnosticTag.deprecated
+  | _            => throw "unknown DiagnosticTag"⟩
 
 instance : ToJson DiagnosticTag := ⟨fun
-  | DiagnosticTag.unnecessary => (1 : Nat)
-  | DiagnosticTag.deprecated  => (2 : Nat)⟩
+  | DiagnosticTag.unnecessary   => (1 : Nat)
+  | DiagnosticTag.deprecated    => (2 : Nat)⟩
+
+/--
+Custom diagnostic tags provided by the language server.
+We use a separate diagnostic field for this to avoid confusing LSP clients with our custom tags.
+-/
+inductive LeanDiagnosticTag where
+  /--
+  Diagnostics representing an "unsolved goals" error.
+  Corresponds to `MessageData.tagged `Tactic.unsolvedGoals ..`.
+  -/
+  | unsolvedGoals
+  /--
+  Diagnostics representing a "goals accomplished" silent message.
+  Corresponds to `MessageData.tagged `goalsAccomplished ..`.
+  -/
+  | goalsAccomplished
+  deriving Inhabited, BEq, Ord
+
+instance : FromJson LeanDiagnosticTag where
+  fromJson? j :=
+    match j.getNat? with
+    | .ok 1 => return LeanDiagnosticTag.unsolvedGoals
+    | .ok 2 => return LeanDiagnosticTag.goalsAccomplished
+    | _     => throw "unknown LeanDiagnosticTag"
+
+instance : ToJson LeanDiagnosticTag where
+  toJson
+  | .unsolvedGoals => (1 : Nat)
+  | .goalsAccomplished => (2 : Nat)
 
 /-- Represents a related message and source code location for a diagnostic.
     This should be used to point to code locations that cause or are related to
@@ -94,6 +123,13 @@ structure DiagnosticWith (α : Type) where
   /-- Extension: preserve semantic range of errors when truncating them for display purposes. -/
   fullRange? : Option Range := some range
   severity? : Option DiagnosticSeverity := none
+  /--
+  Extension: whether this diagnostic should not be displayed as a regular diagnostic in the editor.
+  In VS Code, this means that the diagnostic does not have a squiggly and is not displayed in
+  the InfoView under 'All Messages', but it is still displayed under 'Messages'.
+  Defaults to `false`.
+  -/
+  isSilent? : Option Bool := none
   /-- The diagnostic's code, which might appear in the user interface. -/
   code? : Option DiagnosticCode := none
   /-- A human-readable string describing the source of this diagnostic, e.g. 'typescript' or 'super lint'. -/
@@ -104,6 +140,8 @@ structure DiagnosticWith (α : Type) where
   message : α
   /-- Additional metadata about the diagnostic. -/
   tags? : Option (Array DiagnosticTag) := none
+  /-- Additional Lean-specific metadata about the diagnostic. -/
+  leanTags? : Option (Array LeanDiagnosticTag) := none
   /-- An array of related diagnostic information, e.g. when symbol-names within a scope collide all definitions can be marked via this property. -/
   relatedInformation? : Option (Array DiagnosticRelatedInformation) := none
   /-- A data entry field that is preserved between a `textDocument/publishDiagnostics` notification and `textDocument/codeAction` request. -/

src/Lean/Data/Lsp/Internal.lean

@@ -7,6 +7,7 @@ Authors: Joscha Mennicken
 prelude
 import Lean.Expr
 import Lean.Data.Lsp.Basic
+import Std.Data.TreeMap
 
 set_option linter.missingDocs true -- keep it documented
 
@@ -29,7 +30,7 @@ inductive RefIdent where
   | const (moduleName : String) (identName : String) : RefIdent
   /-- Unnamed identifier. These are used for all local references. -/
   | fvar (moduleName : String) (id : String) : RefIdent
-  deriving BEq, Hashable, Inhabited
+  deriving BEq, Hashable, Inhabited, Ord
 
 namespace RefIdent
 
@@ -154,7 +155,13 @@ instance : FromJson RefInfo where
     pure { definition?, usages }
 
 /-- References from a single module/file -/
-def ModuleRefs := Std.HashMap RefIdent RefInfo
+def ModuleRefs := Std.TreeMap RefIdent RefInfo
+  deriving EmptyCollection
+
+instance : ForIn m ModuleRefs (RefIdent × RefInfo) where
+  forIn map init f :=
+    let map : Std.TreeMap RefIdent RefInfo := map
+    forIn map init f
 
 instance : ToJson ModuleRefs where
   toJson m := Json.mkObj <| m.toList.map fun (ident, info) => (ident.toJson.compress, toJson info)
@@ -162,7 +169,7 @@ instance : ToJson ModuleRefs where
 instance : FromJson ModuleRefs where
   fromJson? j := do
     let node ← j.getObj?
-    node.foldM (init := Std.HashMap.empty) fun m k v =>
+    node.foldM (init := ∅) fun m k v =>
       return m.insert (← RefIdent.fromJson? (← Json.parse k)) (← fromJson? v)
 
 /--

src/Lean/Data/Lsp/Utf16.lean

@@ -15,6 +15,7 @@ to interact with Lean strings using UTF-16 indices. -/
 
 namespace Char
 
+/-- Returns the number of bytes required to encode this `Char` in UTF-16. -/
 def utf16Size (c : Char) : UInt32 :=
   if c.val ≤ 0xFFFF then 1 else 2
 

src/Lean/Data/Name.lean

@@ -132,6 +132,7 @@ def isInternalDetail : Name → Bool
       || matchPrefix s "eq_"
       || matchPrefix s "match_"
       || matchPrefix s "proof_"
+      || matchPrefix s "omega_"
       || p.isInternalOrNum
   | .num _ _     => true
   | p            => p.isInternalOrNum

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/DeclarationRange.lean

@@ -20,8 +20,7 @@ def addBuiltinDeclarationRanges (declName : Name) (declRanges : DeclarationRange
   builtinDeclRanges.modify (·.insert declName declRanges)
 
 def addDeclarationRanges [Monad m] [MonadEnv m] (declName : Name) (declRanges : DeclarationRanges) : m Unit := do
-  unless declRangeExt.contains (← getEnv) declName do
-    modifyEnv fun env => declRangeExt.insert env declName declRanges
+  modifyEnv fun env => declRangeExt.insert env declName declRanges
 
 def findDeclarationRangesCore? [Monad m] [MonadEnv m] (declName : Name) : m (Option DeclarationRanges) :=
   return declRangeExt.find? (← getEnv) declName

src/Lean/Elab/App.lean

@@ -1215,7 +1215,7 @@ private def resolveLValAux (e : Expr) (eType : Expr) (lval : LVal) : TermElabM L
     let fullName := Name.mkStr structName fieldName
     for localDecl in (← getLCtx) do
       if localDecl.isAuxDecl then
-        if let some localDeclFullName := (← read).auxDeclToFullName.find? localDecl.fvarId then
+        if let some localDeclFullName := (← getLCtx).auxDeclToFullName.find? localDecl.fvarId then
           if fullName == (privateToUserName? localDeclFullName).getD localDeclFullName then
             /- LVal notation is being used to make a "local" recursive call. -/
             return LValResolution.localRec structName fullName localDecl.toExpr

src/Lean/Elab/BuiltinNotation.lean

@@ -201,12 +201,27 @@ private def elabTParserMacroAux (prec lhsPrec e : Term) : TermElabM Syntax := do
 
 @[builtin_macro Lean.Parser.Term.assert]  def expandAssert : Macro
   | `(assert! $cond; $body) =>
-    -- TODO: support for disabling runtime assertions
     match cond.raw.reprint with
     | some code => `(if $cond then $body else panic! ("assertion violation: " ++ $(quote code)))
     | none => `(if $cond then $body else panic! ("assertion violation"))
   | _ => Macro.throwUnsupported
 
+register_builtin_option debugAssertions : Bool := {
+  defValue := false
+  descr := "enable `debug_assert!` statements\
+    \n\
+    \nDefaults to `false` unless the Lake `buildType` is `debug`."
+}
+
+@[builtin_term_elab Lean.Parser.Term.debugAssert]  def elabDebugAssert : TermElab :=
+  adaptExpander fun
+    | `(Parser.Term.debugAssert| debug_assert! $cond; $body) => do
+      if debugAssertions.get (← getOptions) then
+        `(assert! $cond; $body)
+      else
+        return body
+    | _ => throwUnsupportedSyntax
+
 @[builtin_macro Lean.Parser.Term.dbgTrace]  def expandDbgTrace : Macro
   | `(dbg_trace $arg:interpolatedStr; $body) => `(dbgTrace (s! $arg) fun _ => $body)
   | `(dbg_trace $arg:term; $body)            => `(dbgTrace (toString $arg) fun _ => $body)

src/Lean/Elab/Command.lean

@@ -491,6 +491,8 @@ partial def elabCommand (stx : Syntax) : CommandElabM Unit := do
                   -- check absence of traces; see Note [Incremental Macros]
                   guard <| !oldSnap.hasTraces && !hasTraces
                   return oldSnap
+                if snap.old?.isSome && oldSnap?.isNone then
+                  snap.old?.forM (·.val.cancelRec)
                 let oldCmds? := oldSnap?.map fun old =>
                   if old.newStx.isOfKind nullKind then old.newStx.getArgs else #[old.newStx]
                 let cmdPromises ← cmds.mapM fun _ => IO.Promise.new
@@ -519,6 +521,8 @@ partial def elabCommand (stx : Syntax) : CommandElabM Unit := do
                       let old ← oldSnap?
                       return { stx := (← oldCmd?), val := (← old.next[i]?) }
                   } }) do
+                    if oldSnap?.isSome && (← read).snap?.isNone then
+                      oldSnap?.bind (·.next[i]?) |>.forM (·.cancelRec)
                     elabCommand cmd
                     -- Resolve promise for commands not supporting incrementality; waiting for
                     -- `withAlwaysResolvedPromises` to do this could block reporting by later

src/Lean/Elab/DefView.lean

@@ -49,9 +49,11 @@ structure BodyProcessedSnapshot extends Language.Snapshot where
   state : Term.SavedState
   /-- Elaboration result. -/
   value : Expr
+  /-- Untyped snapshots from `logSnapshotTask`, saved at this level for cancellation. -/
+  moreSnaps : Array (SnapshotTask SnapshotTree)
 deriving Nonempty
 instance : Language.ToSnapshotTree BodyProcessedSnapshot where
-  toSnapshotTree s := ⟨s.toSnapshot, #[]⟩
+  toSnapshotTree s := ⟨s.toSnapshot, s.moreSnaps⟩
 
 /-- Snapshot after elaboration of a definition header. -/
 structure HeaderProcessedSnapshot extends Language.Snapshot where
@@ -67,13 +69,15 @@ structure HeaderProcessedSnapshot extends Language.Snapshot where
   bodyStx : Syntax
   /-- Result of body elaboration. -/
   bodySnap : SnapshotTask (Option BodyProcessedSnapshot)
+  /-- Untyped snapshots from `logSnapshotTask`, saved at this level for cancellation. -/
+  moreSnaps : Array (SnapshotTask SnapshotTree)
 deriving Nonempty
 instance : Language.ToSnapshotTree HeaderProcessedSnapshot where
   toSnapshotTree s := ⟨s.toSnapshot,
     (match s.tacSnap? with
       | some tac => #[tac.map (sync := true) toSnapshotTree]
       | none     => #[]) ++
-    #[s.bodySnap.map (sync := true) toSnapshotTree]⟩
+    #[s.bodySnap.map (sync := true) toSnapshotTree] ++ s.moreSnaps⟩
 
 /-- State before elaboration of a mutual definition. -/
 structure DefParsed where

src/Lean/Elab/Deriving/DecEq.lean

@@ -134,7 +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
-    let cond := mkConst ``cond [levelZero]
+    let cond := mkConst ``cond [1]
     let rec mkDecTree (low high : Nat) : Expr :=
       if low + 1 == high then
         mkConst ctors[low]!

src/Lean/Elab/Do.lean

@@ -1036,6 +1036,9 @@ def seqToTerm (action : Syntax) (k : Syntax) : M Syntax := withRef action <| wit
   else if action.getKind == ``Parser.Term.doAssert then
     let cond := action[1]
     `(assert! $cond; $k)
+  else if action.getKind == ``Parser.Term.doDebugAssert then
+    let cond := action[1]
+    `(debugAssert| debug_assert! $cond; $k)
   else
     let action ← withRef action ``(($action : $((←read).m) PUnit))
     ``(Bind.bind $action (fun (_ : PUnit) => $k))
@@ -1765,6 +1768,8 @@ mutual
             return mkSeq doElem (← doSeqToCode doElems)
           else if k == ``Parser.Term.doAssert then
             return mkSeq doElem (← doSeqToCode doElems)
+          else if k == ``Parser.Term.doDebugAssert then
+            return mkSeq doElem (← doSeqToCode doElems)
           else if k == ``Parser.Term.doNested then
             let nestedDoSeq := doElem[1]
             doSeqToCode (getDoSeqElems nestedDoSeq ++ doElems)

src/Lean/Elab/Frontend.lean

@@ -146,7 +146,7 @@ def runFrontend
     : IO (Environment × Bool) := do
   let startTime := (← IO.monoNanosNow).toFloat / 1000000000
   let inputCtx := Parser.mkInputContext input fileName
-  let opts := Language.Lean.internal.cmdlineSnapshots.setIfNotSet opts true
+  let opts := Lean.internal.cmdlineSnapshots.setIfNotSet opts true
   let ctx := { inputCtx with }
   let processor := Language.Lean.process
   let snap ← processor (fun _ => pure <| .ok { mainModuleName, opts, trustLevel, plugins }) none ctx

src/Lean/Elab/GuardMsgs.lean

@@ -152,6 +152,8 @@ def MessageOrdering.apply (mode : MessageOrdering) (msgs : List String) : List S
     let mut toCheck : MessageLog := .empty
     let mut toPassthrough : MessageLog := .empty
     for msg in msgs.toList do
+      if msg.isSilent then
+        continue
       match specFn msg with
       | .check       => toCheck := toCheck.add msg
       | .drop        => pure ()

src/Lean/Elab/MutualDef.lean

@@ -166,6 +166,8 @@ private def elabHeaders (views : Array DefView)
             view.value.eqWithInfoAndTraceReuse (← getOptions) old.bodyStx
           -- no syntax guard to store, we already did the necessary checks
           oldBodySnap? := guard reuseBody *> pure ⟨.missing, old.bodySnap⟩
+          if oldBodySnap?.isNone then
+            old.bodySnap.cancelRec
           oldTacSnap? := do
               guard reuseTac
               some ⟨(← old.tacStx?), (← old.tacSnap?)⟩
@@ -229,6 +231,7 @@ private def elabHeaders (views : Array DefView)
         snap.new.resolve <| some {
           diagnostics :=
             (← Language.Snapshot.Diagnostics.ofMessageLog (← Core.getAndEmptyMessageLog))
+          moreSnaps := (← Core.getAndEmptySnapshotTasks)
           view := newHeader.toDefViewElabHeaderData
           state := newState
           tacStx?
@@ -428,6 +431,10 @@ private def elabFunValues (headers : Array DefViewElabHeader) (vars : Array Expr
         if let some old := old.val.get then
           snap.new.resolve <| some old
           reusableResult? := some (old.value, old.state)
+        else
+          -- NOTE: this will eagerly cancel async tasks not associated with an inner snapshot, most
+          -- importantly kernel checking and compilation of the top-level declaration
+          old.val.cancelRec
 
     let (val, state) ← withRestoreOrSaveFull reusableResult? header.tacSnap? do
       withReuseContext header.value do
@@ -479,6 +486,7 @@ private def elabFunValues (headers : Array DefViewElabHeader) (vars : Array Expr
       snap.new.resolve <| some {
         diagnostics :=
           (← Language.Snapshot.Diagnostics.ofMessageLog (← Core.getAndEmptyMessageLog))
+        moreSnaps := (← Core.getAndEmptySnapshotTasks)
         state
         value := val
       }
@@ -606,16 +614,26 @@ private def mkInitialUsedFVarsMap [Monad m] [MonadMCtx m] (sectionVars : Array E
   for mainFVarId in mainFVarIds do
     usedFVarMap := usedFVarMap.insert mainFVarId sectionVarSet
   for toLift in letRecsToLift do
-    let state := Lean.collectFVars {} toLift.val
-    let state := Lean.collectFVars state toLift.type
-    let mut set := state.fvarSet
+    let mut state := Lean.collectFVars {} toLift.val
+    state := Lean.collectFVars state toLift.type
+    let mut set := {}
     /- toLift.val may contain metavariables that are placeholders for nested let-recs. We should collect the fvarId
        for the associated let-rec because we need this information to compute the fixpoint later. -/
     let mvarIds := (toLift.val.collectMVars {}).result
     for mvarId in mvarIds do
-      match (← letRecsToLift.findSomeM? fun (toLift : LetRecToLift) => return if toLift.mvarId == (← getDelayedMVarRoot mvarId) then some toLift.fvarId else none) with
+      let root ← getDelayedMVarRoot mvarId
+      match letRecsToLift.findSome? fun (toLift : LetRecToLift) => if toLift.mvarId == root then some toLift.fvarId else none with
       | some fvarId => set := set.insert fvarId
-      | none        => pure ()
+      | none        =>
+        /- If the metavariable is not a nested let-rec, it may contribute additional free-variable
+           dependencies not caught in the fixed-point routine. In particular, delayed assignments
+           due to `match` expressions or tactic blocks induce fvar dependencies that we need to
+           account for (see #6927) but cannot ascertain through instantiation if those expressions
+           contain still-unassigned metavariable placeholders for other let-recs. See Note
+           [Delayed-Assigned Metavariables in Free Variable Collection] for more information. -/
+        let some rootAssignment ← getExprMVarAssignment? root | continue
+        state := Lean.collectFVars state rootAssignment
+    set := state.fvarSet.union set
     usedFVarMap := usedFVarMap.insert toLift.fvarId set
   return usedFVarMap
 
@@ -1060,6 +1078,52 @@ where
             unless (← processDefDeriving className header.declName) do
               throwError "failed to synthesize instance '{className}' for '{header.declName}'"
 
+/--
+Logs a snapshot task that waits for the entire snapshot tree in `defsParsedSnap` and then logs a
+`goalsAccomplished` silent message for theorems and `Prop`-typed examples if the entire mutual block
+is error-free and contains no syntactical `sorry`s.
+-/
+private def logGoalsAccomplishedSnapshotTask (views : Array DefView)
+    (defsParsedSnap : DefsParsedSnapshot) : TermElabM Unit := do
+  if Lean.internal.cmdlineSnapshots.get (← getOptions) then
+    -- Skip 'goals accomplished' task if we are on the command line.
+    -- These messages are only used in the language server.
+    return
+  let currentLog ← Core.getMessageLog
+  let snaps := #[SnapshotTask.finished none (toSnapshotTree defsParsedSnap)] ++
+    (← getThe Core.State).snapshotTasks
+  let tree := SnapshotTree.mk { diagnostics := .empty } snaps
+  let logGoalsAccomplishedAct ← Term.wrapAsyncAsSnapshot (cancelTk? := none) fun () => do
+    -- NOTE: `waitAll` below ensures `getAll` will not block here
+    let logs := tree.getAll.map (·.diagnostics.msgLog) |>.push currentLog
+    let hasErrorOrSorry := logs.any fun log =>
+      log.reportedPlusUnreported.any fun msg =>
+        msg.severity matches .error || msg.data.hasTag (· == `hasSorry)
+    if hasErrorOrSorry then
+      return
+    for d in defsParsedSnap.defs, view in views do
+      let logGoalsAccomplished :=
+        let msgData := .tagged `goalsAccomplished m!"Goals accomplished!"
+        logAt view.ref msgData (severity := .information) (isSilent := true)
+      match view.kind with
+      | .theorem =>
+        logGoalsAccomplished
+      | .example =>
+        let some processedSnap := d.headerProcessedSnap.get
+          | continue
+        if ! (← isProp processedSnap.view.type) then
+          continue
+        logGoalsAccomplished
+      | _ => continue
+  let logGoalsAccomplishedTask ← BaseIO.mapTask (t := ← tree.waitAll) fun _ =>
+    logGoalsAccomplishedAct
+  Core.logSnapshotTask {
+    stx? := none
+    -- Use first line of the mutual block to avoid covering the progress of the whole mutual block
+    reportingRange? := (← getRef).getPos?.map fun pos => ⟨pos, pos⟩
+    task := logGoalsAccomplishedTask
+  }
+
 end Term
 namespace Command
 
@@ -1094,20 +1158,55 @@ def elabMutualDef (ds : Array Syntax) : CommandElabM Unit := do
           return ⟨.missing, oldParsed.headerProcessedSnap⟩
         new := headerPromise
       } }
+      if snap.old?.isSome && (view.headerSnap?.bind (·.old?)).isNone then
+        snap.old?.forM (·.val.cancelRec)
       defs := defs.push {
         fullHeaderRef
         headerProcessedSnap := { stx? := d, task := headerPromise.resultD default }
       }
       reusedAllHeaders := reusedAllHeaders && view.headerSnap?.any (·.old?.isSome)
     views := views.push view
+  let defsParsedSnap := { defs, diagnostics := .empty : DefsParsedSnapshot }
   if let some snap := snap? then
     -- no non-fatal diagnostics at this point
-    snap.new.resolve <| .ofTyped { defs, diagnostics := .empty : DefsParsedSnapshot }
+    snap.new.resolve <| .ofTyped defsParsedSnap
   let sc ← getScope
-  runTermElabM fun vars => Term.elabMutualDef vars sc views
+  runTermElabM fun vars => do
+    Term.elabMutualDef vars sc views
+    Term.logGoalsAccomplishedSnapshotTask views defsParsedSnap
 
 builtin_initialize
   registerTraceClass `Elab.definition.mkClosure
 
 end Command
 end Lean.Elab
+
+/-!
+# Note [Delayed-Assigned Metavariables in Free Variable Collection]
+
+Nested declarations using `let rec` should compile correctly even when nested within expressions
+that are elaborated using delayed metavariable assignments, such as `match` expressions and tactic
+blocks. Previously, declaring a `let rec` within such an expression in the following fashion
+```lean
+def f x :=
+  let rec g :=
+    match ... with
+    | pat =>
+      let rec h := ... g ...
+      ... x ...
+```
+where `g` depends on some free variable bound by `f` (like `x` above) would cause `MutualClosure` to
+fail to detect that transitive fvar dependency of `h` (which must pass it as an argument to `g`),
+leading to an unbound fvar in the body of `h` that was ultimately fed to the kernel. This occurred
+because `MutualClosure` processes let-recs from most to least nested. Initially, the body of `g` is
+an application of the delayed-assigned metavariable generated by `match` elaboration; the root
+metavariable of that delayed assignment is, in turn, assigned to an expression that refers to the
+mvar that will eventually be assigned to `g` once we process that declaration. Therefore, when we
+initially process the most-nested declaration `h` (before `g`), we cannot instantiate the
+`match`-expression mvar's delayed assignment (since the metavariable that will eventually be
+assigned to the yet-unprocessed `g` remains unassigned). Thus, we do not detect any of the fvar
+dependencies of `g` in the `match` body -- namely, that corresponding to `x`, which `h` should
+therefore also take as a parameter. This also caused a knock-on effect in certain situations,
+wherein `h` would compile as an `axiom` rather than as `opaque`, rendering `f` erroneously
+noncomputable.
+-/

src/Lean/Elab/MutualInductive.lean

@@ -336,7 +336,7 @@ private def withInductiveLocalDecls (rs : Array PreElabHeaderResult) (x : Array
     let rec loop (i : Nat) (indFVars : Array Expr) := do
       if h : i < namesAndTypes.size then
         let (declName, shortDeclName, type) := namesAndTypes[i]
-        Term.withAuxDecl shortDeclName type declName fun indFVar => loop (i+1) (indFVars.push indFVar)
+        withAuxDecl shortDeclName type declName fun indFVar => loop (i+1) (indFVars.push indFVar)
       else
         x params indFVars
     loop 0 #[]
@@ -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' =>
@@ -961,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
   /-
@@ -82,6 +64,7 @@ Assign final attributes to the definitions. Assumes the EqnInfos to be already p
 def addPreDefAttributes (preDefs : Array PreDefinition) : TermElabM Unit := do
   for preDef in preDefs do
     markAsRecursive preDef.declName
+    -- must happen before `generateEagerEqns`
     enableRealizationsForConst preDef.declName
     generateEagerEqns preDef.declName
     applyAttributesOf #[preDef] AttributeApplicationTime.afterCompilation

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

@@ -63,28 +63,30 @@ private def numberNames (n : Nat) (base : String) : Array Name :=
   .ofFn (n := n) fun ⟨i, _⟩ =>
     if n == 1 then .mkSimple base else .mkSimple s!"{base}_{i+1}"
 
-def deriveInduction (name : Name) : MetaM Unit := do
+def deriveInduction (name : Name) : MetaM Unit :=
+  let inductName := name ++ `fixpoint_induct
+  realizeConst name inductName do
   mapError (f := (m!"Cannot derive fixpoint induction principle (please report this issue)\n{indentD ·}")) do
     let some eqnInfo := eqnInfoExt.find? (← getEnv) name |
       throwError "{name} is not defined by partial_fixpoint"
 
     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 +137,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'
@@ -152,7 +158,6 @@ def deriveInduction (name : Name) : MetaM Unit := do
     -- Prune unused level parameters, preserving the original order
     let us := infos[0]!.levelParams.filter (params.contains ·)
 
-    let inductName := name ++ `fixpoint_induct
     addDecl <| Declaration.thmDecl
       { name := inductName, levelParams := us, type := eTyp, value := e' }
 
@@ -219,6 +224,8 @@ def mkOptionAdm (motive : Expr) : MetaM Expr := do
     pure inst
 
 def derivePartialCorrectness (name : Name) : MetaM Unit := do
+  let inductName := name ++ `partial_correctness
+  realizeConst name inductName do
   let fixpointInductThm := name ++ `fixpoint_induct
   unless (← getEnv).contains fixpointInductThm do
     deriveInduction name
@@ -228,9 +235,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 =>
@@ -273,7 +281,6 @@ def derivePartialCorrectness (name : Name) : MetaM Unit := do
     -- Prune unused level parameters, preserving the original order
     let us := infos[0]!.levelParams.filter (params.contains ·)
 
-    let inductName := name ++ `partial_correctness
     addDecl <| Declaration.thmDecl
       { name := inductName, levelParams := us, type := eTyp, value := e' }
 

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,39 +35,43 @@ 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
         WF.mkUnfoldEq preDef preDefNonRec.declName wfPreprocessProof
-  Mutual.addPreDefAttributes preDefs
+  -- must happen before `addPreDefAttributes` enables realizations for the top-level functions,
+  -- which may need to use realizations on `preDefNonRec`
   enableRealizationsForConst preDefNonRec.declName
+  Mutual.addPreDefAttributes preDefs
 
 builtin_initialize registerTraceClass `Elab.definition.wf