feat: changed the names of set

This PR adds support for throwing named errors with associated error
explanations. In particular, it adds elaborators for the syntax defined
in #8649, which use the error-explanation infrastructure added in #8651.
This includes completions, hovers, and jump-to-definition for error
names.

Note that another stage0 rebuild will be required to define explanations
using `register_error_explanation`.

---------

Co-authored-by: Joachim Breitner <mail@joachim-breitner.de>
Co-authored-by: Marc Huisinga <mhuisi@protonmail.com>

.github/workflows/build-template.yml

@@ -62,11 +62,11 @@ jobs:
         with:
           msystem: clang64
           # `:` means do not prefix with msystem
-          pacboy: "make: python: cmake clang ccache gmp libuv git: zip: unzip: diffutils: binutils: tree: zstd tar:"
+          pacboy: "make: python: cmake clang ccache gmp libuv libidn2 git: zip: unzip: diffutils: binutils: tree: zstd tar:"
         if: runner.os == 'Windows'
       - name: Install Brew Packages
         run: |
-          brew install ccache tree zstd coreutils gmp libuv
+          brew install ccache tree zstd coreutils gmp libuv libidn2
         if: runner.os == 'macOS'
       - name: Checkout
         uses: actions/checkout@v4
@@ -95,7 +95,7 @@ jobs:
         run: |
           sudo dpkg --add-architecture i386
           sudo apt-get update
-          sudo apt-get install -y gcc-multilib g++-multilib ccache libuv1-dev:i386 pkgconf:i386
+          sudo apt-get install -y gcc-multilib g++-multilib ccache libidn2-0-dev libuv1-dev:i386 pkgconf:i386
         if: matrix.cmultilib
       - name: Cache
         id: restore-cache
@@ -104,7 +104,7 @@ jobs:
           # NOTE: must be in sync with `save` below
           path: |
             .ccache
-            ${{ matrix.name == 'Linux Lake' && 'build/stage1/**/*.trace
+            ${{ matrix.name == 'Linux Lake' && false && 'build/stage1/**/*.trace
             build/stage1/**/*.olean*
             build/stage1/**/*.ilean
             build/stage1/**/*.c
@@ -245,7 +245,7 @@ jobs:
           # NOTE: must be in sync with `restore` above
           path: |
             .ccache
-            ${{ matrix.name == 'Linux Lake' && 'build/stage1/**/*.trace
+            ${{ matrix.name == 'Linux Lake' && false && 'build/stage1/**/*.trace
             build/stage1/**/*.olean*
             build/stage1/**/*.ilean
             build/stage1/**/*.c

.github/workflows/ci.yml

@@ -164,9 +164,15 @@ jobs:
               {
                 // portable release build: use channel with older glibc (2.26)
                 "name": "Linux release",
-                "os": large ? "nscloud-ubuntu-22.04-amd64-4x8" : "ubuntu-latest",
+                "os": large && level < 2 ? "nscloud-ubuntu-22.04-amd64-4x16" : "ubuntu-latest",
                 "release": true,
-                "check-level": 2,
+                // Special handling for release jobs. We want:
+                // 1. To run it in PRs so developrs get PR toolchains (so secondary is sufficient)
+                // 2. To skip it in merge queues as it takes longer than the
+                //    Linux lake build and adds little value in the merge queue
+                // 3. To run it in release (obviously)
+                "check-level": isPr ? 0 : 2,
+                "secondary": isPr,
                 "shell": "nix develop .#oldGlibc -c bash -euxo pipefail {0}",
                 "llvm-url": "https://github.com/leanprover/lean-llvm/releases/download/19.1.2/lean-llvm-x86_64-linux-gnu.tar.zst",
                 "prepare-llvm": "../script/prepare-llvm-linux.sh lean-llvm*",
@@ -176,12 +182,13 @@ jobs:
               },
               {
                 "name": "Linux Lake",
-                "os": large ? "nscloud-ubuntu-22.04-amd64-8x8" : "ubuntu-latest",
+                "os": large ? "nscloud-ubuntu-22.04-amd64-8x16" : "ubuntu-latest",
                 "check-level": 0,
                 "test": true,
                 "check-rebootstrap": level >= 1,
                 "check-stage3": level >= 2,
-                "test-speedcenter": level >= 2,
+                // NOTE: `test-speedcenter` currently seems to be broken on `ubuntu-latest`
+                "test-speedcenter": large && level >= 2,
                 "CMAKE_OPTIONS": "-DUSE_LAKE=ON",
               },
               {
@@ -215,7 +222,8 @@ jobs:
               },
               {
                 "name": "macOS aarch64",
-                "os": "macos-14",
+                // standard GH runner only comes with 7GB so use large runner if possible
+                "os": large ? "nscloud-macos-sonoma-arm64-6x14" : "macos-14",
                 "CMAKE_OPTIONS": "-DLEAN_INSTALL_SUFFIX=-darwin_aarch64",
                 "release": true,
                 "shell": "bash -euxo pipefail {0}",
@@ -223,11 +231,7 @@ jobs:
                 "prepare-llvm": "../script/prepare-llvm-macos.sh lean-llvm*",
                 "binary-check": "otool -L",
                 "tar": "gtar", // https://github.com/actions/runner-images/issues/2619
-                // Special handling for MacOS aarch64, we want:
-                // 1. To run it in PRs so Mac devs get PR toolchains (so secondary is sufficient)
-                // 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)
+                // See above for release job levels
                 "check-level": isPr ? 0 : 2,
                 "secondary": isPr,
               },
@@ -246,7 +250,7 @@ jobs:
               },
               {
                 "name": "Linux aarch64",
-                "os": "nscloud-ubuntu-22.04-arm64-4x8",
+                "os": "nscloud-ubuntu-22.04-arm64-4x16",
                 "CMAKE_OPTIONS": "-DLEAN_INSTALL_SUFFIX=-linux_aarch64",
                 "release": true,
                 "check-level": 2,

doc/make/index.md

@@ -9,6 +9,7 @@ Requirements
 - [CMake](http://www.cmake.org)
 - [GMP (GNU multiprecision library)](http://gmplib.org/)
 - [LibUV](https://libuv.org/)
+- [Libidn2](https://www.gnu.org/software/libidn/#libidn2)
 
 Platform-Specific Setup
 -----------------------

doc/make/msys2.md

@@ -32,7 +32,7 @@ MSYS2 has a package management system, [pacman][pacman].
 Here are the commands to install all dependencies needed to compile Lean on your machine.
 
 ```bash
-pacman -S make python mingw-w64-clang-x86_64-cmake mingw-w64-clang-x86_64-clang mingw-w64-clang-x86_64-ccache mingw-w64-clang-x86_64-libuv mingw-w64-clang-x86_64-gmp git unzip diffutils binutils
+pacman -S make python mingw-w64-clang-x86_64-cmake mingw-w64-clang-x86_64-clang mingw-w64-clang-x86_64-ccache mingw-w64-clang-x86_64-libuv mingw-w64-x86_64-libidn2 mingw-w64-clang-x86_64-gmp git unzip diffutils binutils
 ```
 
 You should now be able to run these commands:

doc/make/osx-10.9.md

@@ -38,6 +38,7 @@ cmake -DCMAKE_CXX_COMPILER=g++ ...
 brew install cmake
 brew install gmp
 brew install libuv
+brew install libidn2
 brew install pkgconf
 ```
 

doc/make/ubuntu.md

@@ -8,5 +8,5 @@ follow the [generic build instructions](index.md).
 ## Basic packages
 
 ```bash
-sudo apt-get install git libgmp-dev libuv1-dev cmake ccache clang pkgconf
+sudo apt-get install git libgmp-dev libuv1-dev cmake ccache clang pkgconf libidn2-dev
 ```

flake.nix

@@ -24,7 +24,7 @@
           stdenv = pkgs.overrideCC pkgs.stdenv lean-packages.llvmPackages.clang;
         } ({
           buildInputs = with pkgs; [
-            cmake gmp libuv ccache pkg-config
+            cmake gmp libuv ccache libidn2 pkg-config
             lean-packages.llvmPackages.llvm  # llvm-symbolizer for asan/lsan
             gdb
             tree  # for CI

nix/bootstrap.nix

@@ -1,5 +1,5 @@
 { src, debug ? false, stage0debug ? false, extraCMakeFlags ? [],
-  stdenv, lib, cmake, pkg-config, gmp, libuv, cadical, git, gnumake, bash, buildLeanPackage, writeShellScriptBin, runCommand, symlinkJoin, lndir, perl, gnused, darwin, llvmPackages, linkFarmFromDrvs,
+  stdenv, lib, cmake, pkg-config, gmp, libuv, cadical, git, gnumake, bash, libidn2, buildLeanPackage, writeShellScriptBin, runCommand, symlinkJoin, lndir, perl, gnused, darwin, llvmPackages, linkFarmFromDrvs,
   ... } @ args:
 with builtins;
 lib.warn "The Nix-based build is deprecated" rec {
@@ -7,7 +7,7 @@ lib.warn "The Nix-based build is deprecated" rec {
   sourceByRegex = p: rs: lib.sourceByRegex p (map (r: "(/src/)?${r}") rs);
   buildCMake = args: stdenv.mkDerivation ({
     nativeBuildInputs = [ cmake pkg-config ];
-    buildInputs = [ gmp libuv llvmPackages.llvm ];
+    buildInputs = [ gmp libuv libidn2 llvmPackages.llvm ];
     # https://github.com/NixOS/nixpkgs/issues/60919
     hardeningDisable = [ "all" ];
     dontStrip = (args.debug or debug);
@@ -159,7 +159,7 @@ lib.warn "The Nix-based build is deprecated" rec {
       test = buildCMake {
         name = "lean-test-${desc}";
         realSrc = lib.sourceByRegex src [ "src.*" "tests.*" ];
-        buildInputs = [ gmp libuv perl git cadical ];
+        buildInputs = [ gmp libuv perl libidn2 git cadical ];
         preConfigure = ''
           cd src
         '';

src/CMakeLists.txt

@@ -311,15 +311,38 @@ index 5e8e0166..f3b29134 100644
 	  PATCH_COMMAND git reset --hard HEAD && printf "${LIBUV_PATCH}" > patch.diff && git apply patch.diff
     BUILD_IN_SOURCE ON
     INSTALL_COMMAND "")
+
   set(LIBUV_INCLUDE_DIRS "${CMAKE_BINARY_DIR}/libuv/src/libuv/include")
   set(LIBUV_LDFLAGS "${CMAKE_BINARY_DIR}/libuv/src/libuv/libuv.a")
+
+  ExternalProject_add(libidn2
+    PREFIX libidn2
+    GIT_REPOSITORY https://gitlab.com/libidn/libidn2.git
+    # Use a stable release tag
+    GIT_TAG v2.3.4
+    CONFIGURE_COMMAND <SOURCE_DIR>/configure --host=wasm32-unknown-emscripten --prefix=<INSTALL_DIR> --disable-shared --enable-static --disable-doc --disable-nls --with-pic CFLAGS=${LIBIDN2_EMSCRIPTEN_FLAGS}
+    PATCH_COMMAND git reset --hard HEAD && printf "${LIBIDN2_PATCH}" > patch.diff && git apply patch.diff || true
+    BUILD_COMMAND make -j${CMAKE_BUILD_PARALLEL_LEVEL}
+    BUILD_IN_SOURCE ON
+    INSTALL_COMMAND make install)
+
+  set(LIBIDN2_INCLUDE_DIRS "${CMAKE_BINARY_DIR}/libidn2/include")
+  set(LIBIDN2_LDFLAGS "${CMAKE_BINARY_DIR}/libidn2/lib/libidn2.a")
+
 else()
   find_package(LibUV 1.0.0 REQUIRED)
+  find_package(LibIDN2 1.0.0 REQUIRED)
 endif()
+
 include_directories(${LIBUV_INCLUDE_DIRS})
+include_directories(${LIBIDN2_INCLUDE_DIRS})
+
 if(NOT LEAN_STANDALONE)
   string(JOIN " " LIBUV_LDFLAGS ${LIBUV_LDFLAGS})
   string(APPEND LEAN_EXTRA_LINKER_FLAGS " ${LIBUV_LDFLAGS}")
+
+  string(JOIN " " LIBIDN2_LDFLAGS ${LIBIDN2_LDFLAGS})
+  string(APPEND LEAN_EXTRA_LINKER_FLAGS " ${LIBIDN2_LDFLAGS}")
 endif()
 
 # Windows SDK (for ICU)

src/Init.lean

@@ -37,6 +37,7 @@ import Init.Ext
 import Init.Omega
 import Init.MacroTrace
 import Init.Grind
+import Init.GrindInstances
 import Init.While
 import Init.Syntax
 import Init.Internal

src/Init/Data.lean

@@ -46,3 +46,4 @@ import Init.Data.NeZero
 import Init.Data.Function
 import Init.Data.RArray
 import Init.Data.Vector
+import Init.Data.Iterators

src/Init/Data/Array/Count.lean

@@ -52,6 +52,7 @@ theorem countP_push {a : α} {xs : Array α} : countP p (xs.push a) = countP p x
   rcases xs with ⟨xs⟩
   simp_all
 
+@[grind =]
 theorem countP_singleton {a : α} : countP p #[a] = if p a then 1 else 0 := by
   simp
 
@@ -59,10 +60,12 @@ theorem size_eq_countP_add_countP {xs : Array α} : xs.size = countP p xs + coun
   rcases xs with ⟨xs⟩
   simp [List.length_eq_countP_add_countP (p := p)]
 
+@[grind _=_]
 theorem countP_eq_size_filter {xs : Array α} : countP p xs = (filter p xs).size := by
   rcases xs with ⟨xs⟩
   simp [List.countP_eq_length_filter]
 
+@[grind =]
 theorem countP_eq_size_filter' : countP p = size ∘ filter p := by
   funext xs
   apply countP_eq_size_filter
@@ -71,7 +74,7 @@ theorem countP_le_size : countP p xs ≤ xs.size := by
   simp only [countP_eq_size_filter]
   apply size_filter_le
 
-@[simp] theorem countP_append {xs ys : Array α} : countP p (xs ++ ys) = countP p xs + countP p ys := by
+@[simp, grind =] theorem countP_append {xs ys : Array α} : countP p (xs ++ ys) = countP p xs + countP p ys := by
   rcases xs with ⟨xs⟩
   rcases ys with ⟨ys⟩
   simp
@@ -102,6 +105,7 @@ theorem boole_getElem_le_countP {xs : Array α} {i : Nat} (h : i < xs.size) :
   rcases xs with ⟨xs⟩
   simp [List.boole_getElem_le_countP]
 
+@[grind =]
 theorem countP_set {xs : Array α} {i : Nat} {a : α} (h : i < xs.size) :
     (xs.set i a).countP p = xs.countP p - (if p xs[i] then 1 else 0) + (if p a then 1 else 0) := by
   rcases xs with ⟨xs⟩
@@ -146,7 +150,7 @@ theorem countP_flatMap {p : β → Bool} {xs : Array α} {f : α → Array β} :
   rcases xs with ⟨xs⟩
   simp [List.countP_flatMap, Function.comp_def]
 
-@[simp] theorem countP_reverse {xs : Array α} : countP p xs.reverse = countP p xs := by
+@[simp, grind =] theorem countP_reverse {xs : Array α} : countP p xs.reverse = countP p xs := by
   rcases xs with ⟨xs⟩
   simp [List.countP_reverse]
 
@@ -173,7 +177,7 @@ variable [BEq α]
   cases xs
   simp
 
-@[simp] theorem count_empty {a : α} : count a #[] = 0 := rfl
+@[simp, grind =] theorem count_empty {a : α} : count a #[] = 0 := rfl
 
 theorem count_push {a b : α} {xs : Array α} :
     count a (xs.push b) = count a xs + if b == a then 1 else 0 := by
@@ -186,21 +190,28 @@ theorem count_eq_countP' {a : α} : count a = countP (· == a) := by
 
 theorem count_le_size {a : α} {xs : Array α} : count a xs ≤ xs.size := countP_le_size
 
+grind_pattern count_le_size => count a xs
+
+@[grind =]
+theorem count_eq_size_filter {a : α} {xs : Array α} : count a xs = (filter (· == a) xs).size := by
+  simp [count, countP_eq_size_filter]
+
 theorem count_le_count_push {a b : α} {xs : Array α} : count a xs ≤ count a (xs.push b) := by
   simp [count_push]
 
+@[grind =]
 theorem count_singleton {a b : α} : count a #[b] = if b == a then 1 else 0 := by
   simp [count_eq_countP]
 
-@[simp] theorem count_append {a : α} {xs ys : Array α} : count a (xs ++ ys) = count a xs + count a ys :=
+@[simp, grind =] theorem count_append {a : α} {xs ys : Array α} : count a (xs ++ ys) = count a xs + count a ys :=
   countP_append
 
-@[simp] theorem count_flatten {a : α} {xss : Array (Array α)} :
+@[simp, grind =] theorem count_flatten {a : α} {xss : Array (Array α)} :
     count a xss.flatten = (xss.map (count a)).sum := by
   cases xss using array₂_induction
   simp [List.count_flatten, Function.comp_def]
 
-@[simp] theorem count_reverse {a : α} {xs : Array α} : count a xs.reverse = count a xs := by
+@[simp, grind =] theorem count_reverse {a : α} {xs : Array α} : count a xs.reverse = count a xs := by
   rcases xs with ⟨xs⟩
   simp
 
@@ -209,6 +220,7 @@ theorem boole_getElem_le_count {xs : Array α} {i : Nat} {a : α} (h : i < xs.si
   rw [count_eq_countP]
   apply boole_getElem_le_countP (p := (· == a))
 
+@[grind =]
 theorem count_set {xs : Array α} {i : Nat} {a b : α} (h : i < xs.size) :
     (xs.set i a).count b = xs.count b - (if xs[i] == b then 1 else 0) + (if a == b then 1 else 0) := by
   simp [count_eq_countP, countP_set, h]

src/Init/Data/Array/Extract.lean

@@ -46,7 +46,7 @@ theorem size_extract_of_le {as : Array α} {i j : Nat} (h : j ≤ as.size) :
   simp
   omega
 
-@[simp]
+@[simp, grind =]
 theorem extract_push {as : Array α} {b : α} {start stop : Nat} (h : stop ≤ as.size) :
     (as.push b).extract start stop = as.extract start stop := by
   ext i h₁ h₂
@@ -56,7 +56,7 @@ theorem extract_push {as : Array α} {b : α} {start stop : Nat} (h : stop ≤ a
     simp only [getElem_extract, getElem_push]
     rw [dif_pos (by omega)]
 
-@[simp]
+@[simp, grind =]
 theorem extract_eq_pop {as : Array α} {stop : Nat} (h : stop = as.size - 1) :
     as.extract 0 stop = as.pop := by
   ext i h₁ h₂
@@ -65,7 +65,7 @@ theorem extract_eq_pop {as : Array α} {stop : Nat} (h : stop = as.size - 1) :
   · simp only [size_extract, size_pop] at h₁ h₂
     simp [getElem_extract, getElem_pop]
 
-@[simp]
+@[simp, grind _=_]
 theorem extract_append_extract {as : Array α} {i j k : Nat} :
     as.extract i j ++ as.extract j k = as.extract (min i j) (max j k) := by
   ext l h₁ h₂
@@ -169,7 +169,7 @@ theorem getElem?_extract_of_succ {as : Array α} {j : Nat} :
   simp [getElem?_extract]
   omega
 
-@[simp] theorem extract_extract {as : Array α} {i j k l : Nat} :
+@[simp, grind =] theorem extract_extract {as : Array α} {i j k l : Nat} :
     (as.extract i j).extract k l = as.extract (i + k) (min (i + l) j) := by
   ext m h₁ h₂
   · simp
@@ -185,6 +185,7 @@ theorem ne_empty_of_extract_ne_empty {as : Array α} {i j : Nat} (h : as.extract
     as ≠ #[] :=
   mt extract_eq_empty_of_eq_empty h
 
+@[grind =]
 theorem extract_set {as : Array α} {i j k : Nat} (h : k < as.size) {a : α} :
     (as.set k a).extract i j =
       if _ : k < i then
@@ -211,13 +212,14 @@ theorem extract_set {as : Array α} {i j k : Nat} (h : k < as.size) {a : α} :
         simp [getElem_set]
         omega
 
+@[grind =]
 theorem set_extract {as : Array α} {i j k : Nat} (h : k < (as.extract i j).size) {a : α} :
     (as.extract i j).set k a = (as.set (i + k) a (by simp at h; omega)).extract i j := by
   ext l h₁ h₂
   · simp
   · simp_all [getElem_set]
 
-@[simp]
+@[simp, grind =]
 theorem extract_append {as bs : Array α} {i j : Nat} :
     (as ++ bs).extract i j = as.extract i j ++ bs.extract (i - as.size) (j - as.size) := by
   ext l h₁ h₂
@@ -242,14 +244,14 @@ theorem extract_append_right {as bs : Array α} :
     (as ++ bs).extract as.size (as.size + i) = bs.extract 0 i := by
   simp
 
-@[simp] theorem map_extract {as : Array α} {i j : Nat} :
+@[simp, grind =] theorem map_extract {as : Array α} {i j : Nat} :
     (as.extract i j).map f = (as.map f).extract i j := by
   ext l h₁ h₂
   · simp
   · simp only [size_map, size_extract] at h₁ h₂
     simp only [getElem_map, getElem_extract]
 
-@[simp] theorem extract_replicate {a : α} {n i j : Nat} :
+@[simp, grind =] theorem extract_replicate {a : α} {n i j : Nat} :
     (replicate n a).extract i j = replicate (min j n - i) a := by
   ext l h₁ h₂
   · simp
@@ -297,6 +299,7 @@ theorem set_eq_push_extract_append_extract {as : Array α} {i : Nat} (h : i < as
   simp at h
   simp [List.set_eq_take_append_cons_drop, h, List.take_of_length_le]
 
+@[grind =]
 theorem extract_reverse {as : Array α} {i j : Nat} :
     as.reverse.extract i j = (as.extract (as.size - j) (as.size - i)).reverse := by
   ext l h₁ h₂
@@ -307,6 +310,7 @@ theorem extract_reverse {as : Array α} {i j : Nat} :
     congr 1
     omega
 
+@[grind =]
 theorem reverse_extract {as : Array α} {i j : Nat} :
     (as.extract i j).reverse = as.reverse.extract (as.size - j) (as.size - i) := by
   rw [extract_reverse]

src/Init/Data/Array/InsertIdx.lean

@@ -47,11 +47,16 @@ theorem insertIdx_zero {xs : Array α} {x : α} : xs.insertIdx 0 x = #[x] ++ xs
   simp at h
   simp [List.length_insertIdx, h]
 
-theorem eraseIdx_insertIdx {i : Nat} {xs : Array α} (h : i ≤ xs.size) :
+theorem eraseIdx_insertIdx_self {i : Nat} {xs : Array α} (h : i ≤ xs.size) :
     (xs.insertIdx i a).eraseIdx i (by simp; omega) = xs := by
   rcases xs with ⟨xs⟩
   simp_all
 
+@[deprecated eraseIdx_insertIdx_self (since := "2025-06-15")]
+theorem eraseIdx_insertIdx {i : Nat} {xs : Array α} (h : i ≤ xs.size) :
+    (xs.insertIdx i a).eraseIdx i (by simp; omega) = xs := by
+  simp [eraseIdx_insertIdx_self]
+
 theorem insertIdx_eraseIdx_of_ge {as : Array α}
     (w₁ : i < as.size) (w₂ : j ≤ (as.eraseIdx i).size) (h : i ≤ j) :
     (as.eraseIdx i).insertIdx j a =
@@ -66,6 +71,18 @@ theorem insertIdx_eraseIdx_of_le {as : Array α}
   cases as
   simpa using List.insertIdx_eraseIdx_of_le (by simpa) (by simpa)
 
+@[grind =]
+theorem insertIdx_eraseIdx {as : Array α} (h₁ : i < as.size) (h₂ : j ≤ (as.eraseIdx i).size) :
+    (as.eraseIdx i).insertIdx j a =
+      if h : i ≤ j then
+        (as.insertIdx (j + 1) a (by simp_all; omega)).eraseIdx i (by simp_all; omega)
+      else
+        (as.insertIdx j a).eraseIdx (i + 1) (by simp_all) := by
+  split <;> rename_i h'
+  · rw [insertIdx_eraseIdx_of_ge] <;> omega
+  · rw [insertIdx_eraseIdx_of_le] <;> omega
+
+@[grind =]
 theorem insertIdx_comm (a b : α) {i j : Nat} {xs : Array α} (_ : i ≤ j) (_ : j ≤ xs.size) :
     (xs.insertIdx i a).insertIdx (j + 1) b (by simpa) =
       (xs.insertIdx j b).insertIdx i a (by simp; omega) := by
@@ -81,6 +98,7 @@ theorem insertIdx_size_self {xs : Array α} {x : α} : xs.insertIdx xs.size x =
   rcases xs with ⟨xs⟩
   simp
 
+@[grind =]
 theorem getElem_insertIdx {xs : Array α} {x : α} {i k : Nat} (w : i ≤ xs.size) (h : k < (xs.insertIdx i x).size) :
     (xs.insertIdx i x)[k] =
       if h₁ : k < i then
@@ -106,6 +124,7 @@ theorem getElem_insertIdx_of_gt {xs : Array α} {x : α} {i k : Nat} (w : k ≤
   simp [getElem_insertIdx, w, h]
   rw [dif_neg (by omega), dif_neg (by omega)]
 
+@[grind =]
 theorem getElem?_insertIdx {xs : Array α} {x : α} {i k : Nat} (h : i ≤ xs.size) :
     (xs.insertIdx i x)[k]? =
       if k < i then

src/Init/Data/Array/Lemmas.lean

@@ -89,6 +89,8 @@ theorem size_pos_of_mem {a : α} {xs : Array α} (h : a ∈ xs) : 0 < xs.size :=
   simp only [mem_toArray] at h
   simpa using List.length_pos_of_mem h
 
+grind_pattern size_pos_of_mem => a ∈ xs, xs.size
+
 theorem exists_mem_of_size_pos {xs : Array α} (h : 0 < xs.size) : ∃ a, a ∈ xs := by
   cases xs
   simpa using List.exists_mem_of_length_pos h

src/Init/Data/Array/Perm.lean

@@ -91,17 +91,26 @@ theorem Perm.mem_iff {a : α} {xs ys : Array α} (p : xs ~ ys) : a ∈ xs ↔ a
   simp only [perm_iff_toList_perm] at p
   simpa using p.mem_iff
 
+grind_pattern Perm.mem_iff => xs ~ ys, a ∈ xs
+grind_pattern Perm.mem_iff => xs ~ ys, a ∈ ys
+
 theorem Perm.append {xs ys as bs : Array α} (p₁ : xs ~ ys) (p₂ : as ~ bs) :
     xs ++ as ~ ys ++ bs := by
   cases xs; cases ys; cases as; cases bs
   simp only [append_toArray, perm_iff_toList_perm] at p₁ p₂ ⊢
   exact p₁.append p₂
 
+grind_pattern Perm.append => xs ~ ys, as ~ bs, xs ++ as
+grind_pattern Perm.append => xs ~ ys, as ~ bs, ys ++ bs
+
 theorem Perm.push (x : α) {xs ys : Array α} (p : xs ~ ys) :
     xs.push x ~ ys.push x := by
   rw [push_eq_append_singleton]
   exact p.append .rfl
 
+grind_pattern Perm.push => xs ~ ys, xs.push x
+grind_pattern Perm.push => xs ~ ys, ys.push x
+
 theorem Perm.push_comm (x y : α) {xs ys : Array α} (p : xs ~ ys) :
     (xs.push x).push y ~ (ys.push y).push x := by
   cases xs; cases ys

src/Init/Data/Array/Range.lean

@@ -128,6 +128,16 @@ theorem erase_range' :
   simp only [← List.toArray_range', List.erase_toArray]
   simp [List.erase_range']
 
+@[simp, grind =]
+theorem count_range' {a s n step} (h : 0 < step := by simp) :
+    count a (range' s n step) = if ∃ i, i < n ∧ a = s + step * i then 1 else 0 := by
+  rw [← List.toArray_range', List.count_toArray, ← List.count_range' h]
+
+@[simp, grind =]
+theorem count_range_1' {a s n} :
+    count a (range' s n) = if s ≤ a ∧ a < s + n then 1 else 0 := by
+  rw [← List.toArray_range', List.count_toArray, ← List.count_range_1']
+
 /-! ### range -/
 
 @[grind _=_]
@@ -179,11 +189,11 @@ theorem self_mem_range_succ {n : Nat} : n ∈ range (n + 1) := by simp
 @[simp, grind =] theorem take_range {i n : Nat} : take (range n) i = range (min i n) := by
   ext <;> simp
 
-@[simp] theorem find?_range_eq_some {n : Nat} {i : Nat} {p : Nat → Bool} :
+@[simp, grind =] theorem find?_range_eq_some {n : Nat} {i : Nat} {p : Nat → Bool} :
     (range n).find? p = some i ↔ p i ∧ i ∈ range n ∧ ∀ j, j < i → !p j := by
   simp [range_eq_range']
 
-@[simp] theorem find?_range_eq_none {n : Nat} {p : Nat → Bool} :
+@[simp, grind =] theorem find?_range_eq_none {n : Nat} {p : Nat → Bool} :
     (range n).find? p = none ↔ ∀ i, i < n → !p i := by
   simp only [← List.toArray_range, List.find?_toArray, List.find?_range_eq_none]
 
@@ -191,6 +201,10 @@ theorem self_mem_range_succ {n : Nat} : n ∈ range (n + 1) := by simp
 theorem erase_range : (range n).erase i = range (min n i) ++ range' (i + 1) (n - (i + 1)) := by
   simp [range_eq_range', erase_range']
 
+@[simp, grind =]
+theorem count_range {a n} :
+    count a (range n) = if a < n then 1 else 0 := by
+  rw [← List.toArray_range, List.count_toArray, ← List.count_range]
 
 /-! ### zipIdx -/
 
@@ -199,7 +213,7 @@ theorem zipIdx_eq_empty_iff {xs : Array α} {i : Nat} : xs.zipIdx i = #[] ↔ xs
   cases xs
   simp
 
-@[simp]
+@[simp, grind =]
 theorem getElem?_zipIdx {xs : Array α} {i j} : (zipIdx xs i)[j]? = xs[j]?.map fun a => (a, i + j) := by
   simp [getElem?_def]
 
@@ -242,7 +256,7 @@ theorem zipIdx_eq_map_add {xs : Array α} {i : Nat} :
   simp only [zipIdx_toArray, List.map_toArray, mk.injEq]
   rw [List.zipIdx_eq_map_add]
 
-@[simp]
+@[simp, grind =]
 theorem zipIdx_singleton {x : α} {k : Nat} : zipIdx #[x] k = #[(x, k)] :=
   rfl
 
@@ -290,6 +304,7 @@ theorem zipIdx_map {xs : Array α} {k : Nat} {f : α → β} :
   cases xs
   simp [List.zipIdx_map]
 
+@[grind =]
 theorem zipIdx_append {xs ys : Array α} {k : Nat} :
     zipIdx (xs ++ ys) k = zipIdx xs k ++ zipIdx ys (k + xs.size) := by
   cases xs

src/Init/Data/BitVec.lean

@@ -6,7 +6,10 @@ Authors: Kim Morrison
 module
 
 prelude
+import Init.Data.BitVec.BasicAux
 import Init.Data.BitVec.Basic
+import Init.Data.BitVec.Bootstrap
 import Init.Data.BitVec.Bitblast
-import Init.Data.BitVec.Folds
+import Init.Data.BitVec.Decidable
 import Init.Data.BitVec.Lemmas
+import Init.Data.BitVec.Folds

src/Init/Data/BitVec/Basic.lean

@@ -74,25 +74,27 @@ section getXsb
 
 /--
 Returns the `i`th least significant bit.
-
-This will be renamed `getLsb` after the existing deprecated alias is removed.
 -/
-@[inline, expose] def getLsb' (x : BitVec w) (i : Fin w) : Bool := x.toNat.testBit i
+@[inline, expose] def getLsb (x : BitVec w) (i : Fin w) : Bool := x.toNat.testBit i
+
+@[deprecated getLsb (since := "2025-06-17"), inherit_doc getLsb]
+abbrev getLsb' := @getLsb
 
 /-- Returns the `i`th least significant bit, or `none` if `i ≥ w`. -/
 @[inline, expose] def getLsb? (x : BitVec w) (i : Nat) : Option Bool :=
-  if h : i < w then some (getLsb' x ⟨i, h⟩) else none
+  if h : i < w then some (getLsb x ⟨i, h⟩) else none
 
 /--
 Returns the `i`th most significant bit.
-
-This will be renamed `BitVec.getMsb` after the existing deprecated alias is removed.
 -/
-@[inline] def getMsb' (x : BitVec w) (i : Fin w) : Bool := x.getLsb' ⟨w-1-i, by omega⟩
+@[inline] def getMsb (x : BitVec w) (i : Fin w) : Bool := x.getLsb ⟨w-1-i, by omega⟩
+
+@[deprecated getMsb (since := "2025-06-17"), inherit_doc getMsb]
+abbrev getMsb' := @getMsb
 
 /-- Returns the `i`th most significant bit or `none` if `i ≥ w`. -/
 @[inline] def getMsb? (x : BitVec w) (i : Nat) : Option Bool :=
-  if h : i < w then some (getMsb' x ⟨i, h⟩) else none
+  if h : i < w then some (getMsb x ⟨i, h⟩) else none
 
 /-- Returns the `i`th least significant bit or `false` if `i ≥ w`. -/
 @[inline, expose] def getLsbD (x : BitVec w) (i : Nat) : Bool :=
@@ -110,11 +112,11 @@ end getXsb
 section getElem
 
 instance : GetElem (BitVec w) Nat Bool fun _ i => i < w where
-  getElem xs i h := xs.getLsb' ⟨i, h⟩
+  getElem xs i h := xs.getLsb ⟨i, h⟩
 
 /-- We prefer `x[i]` as the simp normal form for `getLsb'` -/
-@[simp] theorem getLsb'_eq_getElem (x : BitVec w) (i : Fin w) :
-    x.getLsb' i = x[i] := rfl
+@[simp] theorem getLsb_eq_getElem (x : BitVec w) (i : Fin w) :
+    x.getLsb i = x[i] := rfl
 
 /-- We prefer `x[i]?` as the simp normal form for `getLsb?` -/
 @[simp] theorem getLsb?_eq_getElem? (x : BitVec w) (i : Nat) :
@@ -723,6 +725,12 @@ def twoPow (w : Nat) (i : Nat) : BitVec w := 1#w <<< i
 
 end bitwise
 
+/-- The bitvector of width `w` that has the smallest value when interpreted as an integer. -/
+def intMin (w : Nat) := twoPow w (w - 1)
+
+/-- The bitvector of width `w` that has the largest value when interpreted as an integer. -/
+def intMax (w : Nat) := (twoPow w (w - 1)) - 1
+
 /--
 Computes a hash of a bitvector, combining 64-bit words using `mixHash`.
 -/
@@ -842,4 +850,15 @@ treating `x` and `y` as 2's complement signed bitvectors.
 def smulOverflow {w : Nat} (x y : BitVec w) : Bool :=
   (x.toInt * y.toInt ≥ 2 ^ (w - 1)) || (x.toInt * y.toInt < - 2 ^ (w - 1))
 
+/-- Count the number of leading zeros downward from the `n`-th bit to the `0`-th bit for the bitblaster.
+  This builds a tree of `if-then-else` lookups whose length is linear in the bitwidth,
+  and an efficient circuit for bitblasting `clz`. -/
+def clzAuxRec {w : Nat} (x : BitVec w) (n : Nat) : BitVec w :=
+  match n with
+  | 0 => if x.getLsbD 0 then BitVec.ofNat w (w - 1) else BitVec.ofNat w w
+  | n' + 1 => if x.getLsbD n then BitVec.ofNat w (w - 1 - n) else clzAuxRec x n'
+
+/-- Count the number of leading zeros. -/
+def clz (x : BitVec w) : BitVec w := clzAuxRec x (w - 1)
+
 end BitVec

src/Init/Data/BitVec/Bitblast.lean

@@ -6,12 +6,14 @@ Authors: Harun Khan, Abdalrhman M Mohamed, Joe Hendrix, Siddharth Bhat
 module
 
 prelude
-import Init.Data.BitVec.Folds
 import all Init.Data.Nat.Bitwise.Basic
 import Init.Data.Nat.Mod
 import all Init.Data.Int.DivMod
 import Init.Data.Int.LemmasAux
-import all Init.Data.BitVec.Lemmas
+import all Init.Data.BitVec.Basic
+import Init.Data.BitVec.Decidable
+import Init.Data.BitVec.Lemmas
+import Init.Data.BitVec.Folds
 
 /-!
 # Bit blasting of bitvectors
@@ -518,9 +520,6 @@ theorem msb_neg {w : Nat} {x : BitVec w} :
   rw [(show w = w - 1 + 1 by omega), Int.pow_succ] at this
   omega
 
-@[simp] theorem setWidth_neg_of_le {x : BitVec v} (h : w ≤ v) : BitVec.setWidth w (-x) = -BitVec.setWidth w x := by
-  simp [← BitVec.signExtend_eq_setWidth_of_le _ h, BitVec.signExtend_neg_of_le h]
-
 /-! ### abs -/
 
 theorem msb_abs {w : Nat} {x : BitVec w} :
@@ -548,54 +547,14 @@ theorem ult_eq_not_carry (x y : BitVec w) : x.ult y = !carry w x (~~~y) true :=
   rw [Nat.mod_eq_of_lt (by omega)]
   omega
 
-theorem ule_eq_not_ult (x y : BitVec w) : x.ule y = !y.ult x := by
-  simp [BitVec.ule, BitVec.ult, ← decide_not]
-
 theorem ule_eq_carry (x y : BitVec w) : x.ule y = carry w y (~~~x) true := by
   simp [ule_eq_not_ult, ult_eq_not_carry]
 
-/-- If two bitvectors have the same `msb`, then signed and unsigned comparisons coincide -/
-theorem slt_eq_ult_of_msb_eq {x y : BitVec w} (h : x.msb = y.msb) :
-    x.slt y = x.ult y := by
-  simp only [BitVec.slt, toInt_eq_msb_cond, BitVec.ult, decide_eq_decide, h]
-  cases y.msb <;> simp
-
-/-- If two bitvectors have different `msb`s, then unsigned comparison is determined by this bit -/
-theorem ult_eq_msb_of_msb_neq {x y : BitVec w} (h : x.msb ≠ y.msb) :
-    x.ult y = y.msb := by
-  simp only [BitVec.ult, msb_eq_decide, ne_eq, decide_eq_decide] at *
-  omega
-
-/-- If two bitvectors have different `msb`s, then signed and unsigned comparisons are opposites -/
-theorem slt_eq_not_ult_of_msb_neq {x y : BitVec w} (h : x.msb ≠ y.msb) :
-    x.slt y = !x.ult y := by
-  simp only [BitVec.slt, toInt_eq_msb_cond, Bool.eq_not_of_ne h, ult_eq_msb_of_msb_neq h]
-  cases y.msb <;> (simp [-Int.natCast_pow]; omega)
-
-theorem slt_eq_ult {x y : BitVec w} :
-    x.slt y = (x.msb != y.msb).xor (x.ult y) := by
-  by_cases h : x.msb = y.msb
-  · simp [h, slt_eq_ult_of_msb_eq]
-  · have h' : x.msb != y.msb := by simp_all
-    simp [slt_eq_not_ult_of_msb_neq h, h']
-
 theorem slt_eq_not_carry {x y : BitVec w} :
     x.slt y = (x.msb == y.msb).xor (carry w x (~~~y) true) := by
   simp only [slt_eq_ult, bne, ult_eq_not_carry]
   cases x.msb == y.msb <;> simp
 
-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} {x : BitVec w} (hx : BitVec.sle 0#w x) : x.toInt.toNat = x.toNat :=
-  toNat_toInt_of_msb x (zero_sle_iff_msb_eq_false.1 hx)
-
 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]
@@ -618,12 +577,6 @@ theorem neg_sle_zero (h : 0 < w) {x : BitVec w} :
   rw [sle_eq_slt_or_eq, neg_slt_zero h, sle_eq_slt_or_eq]
   simp [Bool.beq_eq_decide_eq (-x), Bool.beq_eq_decide_eq _ x, Eq.comm (a := x), Bool.or_assoc]
 
-theorem sle_eq_ule {x y : BitVec w} : x.sle y = (x.msb != y.msb ^^ x.ule y) := by
-  rw [sle_eq_not_slt, slt_eq_ult, ← Bool.xor_not, ← ule_eq_not_ult, bne_comm]
-
-theorem sle_eq_ule_of_msb_eq {x y : BitVec w} (h : x.msb = y.msb) : x.sle y = x.ule y := by
-  simp [BitVec.sle_eq_ule, h]
-
 /-! ### mul recurrence for bit blasting -/
 
 /--

src/Init/Data/BitVec/Bootstrap.lean

@@ -0,0 +1,146 @@
+/-
+Copyright (c) 2023 Lean FRO, LLC. All rights reserved.
+Released under Apache 2.0 license as described in the file LICENSE.
+Authors: Joe Hendrix, Harun Khan, Alex Keizer, Abdalrhman M Mohamed, Siddharth Bhat
+-/
+module
+
+prelude
+import all Init.Data.BitVec.Basic
+
+namespace BitVec
+
+theorem testBit_toNat (x : BitVec w) : x.toNat.testBit i = x.getLsbD i := rfl
+
+@[simp] theorem getLsbD_ofFin (x : Fin (2^n)) (i : Nat) :
+    getLsbD (BitVec.ofFin x) i = x.val.testBit i := rfl
+
+@[simp] theorem getLsbD_of_ge (x : BitVec w) (i : Nat) (ge : w ≤ i) : getLsbD x i = false := by
+  let ⟨x, x_lt⟩ := x
+  simp only [getLsbD_ofFin]
+  apply Nat.testBit_lt_two_pow
+  have p : 2^w ≤ 2^i := Nat.pow_le_pow_right (by omega) ge
+  omega
+
+/-- Prove equality of bitvectors in terms of nat operations. -/
+theorem eq_of_toNat_eq {n} : ∀ {x y : BitVec n}, x.toNat = y.toNat → x = y
+  | ⟨_, _⟩, ⟨_, _⟩, rfl => rfl
+
+theorem eq_of_getLsbD_eq {x y : BitVec w}
+    (pred : ∀ i, i < w → x.getLsbD i = y.getLsbD i) : x = y := by
+  apply eq_of_toNat_eq
+  apply Nat.eq_of_testBit_eq
+  intro i
+  if i_lt : i < w then
+    exact pred i i_lt
+  else
+    have p : i ≥ w := Nat.le_of_not_gt i_lt
+    simp [testBit_toNat, getLsbD_of_ge _ _ p]
+
+@[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]
+
+@[ext] theorem eq_of_getElem_eq {x y : BitVec n} :
+        (∀ i (hi : i < n), x[i] = y[i]) → x = y :=
+  fun h => BitVec.eq_of_getLsbD_eq (h ↑·)
+
+@[simp] theorem toNat_append (x : BitVec m) (y : BitVec n) :
+    (x ++ y).toNat = x.toNat <<< n ||| y.toNat :=
+  rfl
+
+@[simp] theorem toNat_ofBool (b : Bool) : (ofBool b).toNat = b.toNat := by
+  cases b <;> rfl
+
+@[simp, bitvec_to_nat] theorem toNat_cast (h : w = v) (x : BitVec w) : (x.cast h).toNat = x.toNat := rfl
+
+@[simp, bitvec_to_nat] theorem toNat_ofFin (x : Fin (2^n)) : (BitVec.ofFin x).toNat = x.val := rfl
+
+@[simp] theorem toNat_ofNatLT (x : Nat) (p : x < 2^w) : (x#'p).toNat = x := rfl
+
+@[simp] theorem toNat_cons (b : Bool) (x : BitVec w) :
+    (cons b x).toNat = (b.toNat <<< w) ||| x.toNat := by
+  let ⟨x, _⟩ := x
+  simp only [cons, toNat_cast, toNat_append, toNat_ofBool, toNat_ofFin]
+
+theorem getElem_cons {b : Bool} {n} {x : BitVec n} {i : Nat} (h : i < n + 1) :
+    (cons b x)[i] = if h : i = n then b else x[i] := by
+  simp only [getElem_eq_testBit_toNat, toNat_cons, Nat.testBit_or, getLsbD]
+  rw [Nat.testBit_shiftLeft]
+  rcases Nat.lt_trichotomy i n with i_lt_n | i_eq_n | n_lt_i
+  · have p1 : ¬(n ≤ i) := by omega
+    have p2 : i ≠ n := by omega
+    simp [p1, p2]
+  · simp only [i_eq_n, ge_iff_le, Nat.le_refl, decide_true, Nat.sub_self, Nat.testBit_zero,
+    Bool.true_and, testBit_toNat, getLsbD_of_ge, Bool.or_false, ↓reduceIte]
+    cases b <;> trivial
+  · have p1 : i ≠ n := by omega
+    have p2 : i - n ≠ 0 := by omega
+    simp [p1, p2, Nat.testBit_bool_to_nat]
+
+private theorem lt_two_pow_of_le {x m n : Nat} (lt : x < 2 ^ m) (le : m ≤ n) : x < 2 ^ n :=
+  Nat.lt_of_lt_of_le lt (Nat.pow_le_pow_right (by trivial : 0 < 2) le)
+
+@[simp, bitvec_to_nat] theorem toNat_setWidth' {m n : Nat} (p : m ≤ n) (x : BitVec m) :
+    (setWidth' p x).toNat = x.toNat := by
+  simp only [setWidth', toNat_ofNatLT]
+
+@[simp, bitvec_to_nat] theorem toNat_setWidth (i : Nat) (x : BitVec n) :
+    BitVec.toNat (setWidth i x) = x.toNat % 2^i := by
+  let ⟨x, lt_n⟩ := x
+  simp only [setWidth]
+  if n_le_i : n ≤ i then
+    have x_lt_two_i : x < 2 ^ i := lt_two_pow_of_le lt_n n_le_i
+    simp [n_le_i, Nat.mod_eq_of_lt, x_lt_two_i]
+  else
+    simp [n_le_i, toNat_ofNat]
+
+@[simp] theorem ofNat_toNat (m : Nat) (x : BitVec n) : BitVec.ofNat m x.toNat = setWidth m x := by
+  apply eq_of_toNat_eq
+  simp only [toNat_ofNat, toNat_setWidth]
+
+theorem getElem_setWidth' (x : BitVec w) (i : Nat) (h : w ≤ v) (hi : i < v) :
+    (setWidth' h x)[i] = x.getLsbD i := by
+  rw [getElem_eq_testBit_toNat, toNat_setWidth', getLsbD]
+
+@[simp]
+theorem getElem_setWidth (m : Nat) (x : BitVec n) (i : Nat) (h : i < m) :
+    (setWidth m x)[i] = x.getLsbD i := by
+  rw [setWidth]
+  split
+  · rw [getElem_setWidth']
+  · simp only [ofNat_toNat, getElem_eq_testBit_toNat, toNat_setWidth, Nat.testBit_mod_two_pow,
+      getLsbD, Bool.and_eq_right_iff_imp, decide_eq_true_eq]
+    omega
+
+@[simp] theorem cons_msb_setWidth (x : BitVec (w+1)) : (cons x.msb (x.setWidth w)) = x := by
+  ext i
+  simp only [getElem_cons]
+  split <;> rename_i h
+  · simp [BitVec.msb, getMsbD, h]
+  · by_cases h' : i < w
+    · simp_all only [getElem_setWidth, getLsbD_eq_getElem]
+    · omega
+
+@[simp, bitvec_to_nat] theorem toNat_neg (x : BitVec n) : (- x).toNat = (2^n - x.toNat) % 2^n := by
+  simp [Neg.neg, BitVec.neg]
+
+@[simp] theorem setWidth_neg_of_le {x : BitVec v} (h : w ≤ v) : BitVec.setWidth w (-x) = -BitVec.setWidth w x := by
+  apply BitVec.eq_of_toNat_eq
+  simp only [toNat_setWidth, toNat_neg]
+  rw [Nat.mod_mod_of_dvd _ (Nat.pow_dvd_pow 2 h)]
+  rw [Nat.mod_eq_mod_iff]
+  rw [Nat.mod_def]
+  refine ⟨1 + x.toNat / 2^w, 2^(v-w), ?_⟩
+  rw [← Nat.pow_add]
+  have : v - w + w = v := by omega
+  rw [this]
+  rw [Nat.add_mul, Nat.one_mul, Nat.mul_comm (2^w)]
+  have sub_sub : ∀ (a : Nat) {b c : Nat} (h : c ≤ b), a - (b - c) = a + c - b := by omega
+  rw [sub_sub _ (Nat.div_mul_le_self x.toNat (2 ^ w))]
+  have : x.toNat / 2 ^ w * 2 ^ w ≤ x.toNat := Nat.div_mul_le_self x.toNat (2 ^ w)
+  have : x.toNat < 2 ^w ∨ x.toNat - 2 ^ w < x.toNat / 2 ^ w * 2 ^ w := by
+    have := Nat.lt_div_mul_add (a := x.toNat) (b := 2 ^ w) (Nat.two_pow_pos w)
+    omega
+  omega
+
+end BitVec

src/Init/Data/BitVec/Decidable.lean

@@ -0,0 +1,79 @@
+/-
+Copyright (c) 2023 Lean FRO, LLC. All rights reserved.
+Released under Apache 2.0 license as described in the file LICENSE.
+Authors: Joe Hendrix, Harun Khan, Alex Keizer, Abdalrhman M Mohamed, Siddharth Bhat
+
+-/
+module
+
+prelude
+import Init.Data.BitVec.Bootstrap
+
+set_option linter.missingDocs true
+
+namespace BitVec
+
+/-! ### Decidable quantifiers -/
+
+theorem forall_zero_iff {P : BitVec 0 → Prop} :
+    (∀ v, P v) ↔ P 0#0 := by
+  constructor
+  · intro h
+    apply h
+  · intro h v
+    obtain (rfl : v = 0#0) := (by ext i ⟨⟩)
+    apply h
+
+theorem forall_cons_iff {P : BitVec (n + 1) → Prop} :
+    (∀ v : BitVec (n + 1), P v) ↔ (∀ (x : Bool) (v : BitVec n), P (v.cons x)) := by
+  constructor
+  · intro h _ _
+    apply h
+  · intro h v
+    have w : v = (v.setWidth n).cons v.msb := by simp only [cons_msb_setWidth]
+    rw [w]
+    apply h
+
+instance instDecidableForallBitVecZero (P : BitVec 0 → Prop) :
+    ∀ [Decidable (P 0#0)], Decidable (∀ v, P v)
+  | .isTrue h => .isTrue fun v => by
+    obtain (rfl : v = 0#0) := (by ext i ⟨⟩)
+    exact h
+  | .isFalse h => .isFalse (fun w => h (w _))
+
+instance instDecidableForallBitVecSucc (P : BitVec (n+1) → Prop) [DecidablePred P]
+    [Decidable (∀ (x : Bool) (v : BitVec n), P (v.cons x))] : Decidable (∀ v, P v) :=
+  decidable_of_iff' (∀ x (v : BitVec n), P (v.cons x)) forall_cons_iff
+
+instance instDecidableExistsBitVecZero (P : BitVec 0 → Prop) [Decidable (P 0#0)] :
+    Decidable (∃ v, P v) :=
+  decidable_of_iff (¬ ∀ v, ¬ P v) Classical.not_forall_not
+
+instance instDecidableExistsBitVecSucc (P : BitVec (n+1) → Prop) [DecidablePred P]
+    [Decidable (∀ (x : Bool) (v : BitVec n), ¬ P (v.cons x))] : Decidable (∃ v, P v) :=
+  decidable_of_iff (¬ ∀ v, ¬ P v) Classical.not_forall_not
+
+/--
+For small numerals this isn't necessary (as typeclass search can use the above two instances),
+but for large numerals this provides a shortcut.
+Note, however, that for large numerals the decision procedure may be very slow,
+and you should use `bv_decide` if possible.
+-/
+instance instDecidableForallBitVec :
+    ∀ (n : Nat) (P : BitVec n → Prop) [DecidablePred P], Decidable (∀ v, P v)
+  | 0, _, _ => inferInstance
+  | n + 1, _, _ =>
+    have := instDecidableForallBitVec n
+    inferInstance
+
+/--
+For small numerals this isn't necessary (as typeclass search can use the above two instances),
+but for large numerals this provides a shortcut.
+Note, however, that for large numerals the decision procedure may be very slow.
+-/
+instance instDecidableExistsBitVec :
+    ∀ (n : Nat) (P : BitVec n → Prop) [DecidablePred P], Decidable (∃ v, P v)
+  | 0, _, _ => inferInstance
+  | _ + 1, _, _ => inferInstance
+
+end BitVec

src/Init/Data/BitVec/Lemmas.lean

@@ -2,7 +2,6 @@
 Copyright (c) 2023 Lean FRO, LLC. All rights reserved.
 Released under Apache 2.0 license as described in the file LICENSE.
 Authors: Joe Hendrix, Harun Khan, Alex Keizer, Abdalrhman M Mohamed, Siddharth Bhat
-
 -/
 module
 
@@ -19,6 +18,7 @@ import Init.Data.Int.Bitwise.Lemmas
 import Init.Data.Int.LemmasAux
 import Init.Data.Int.Pow
 import Init.Data.Int.LemmasAux
+import Init.Data.BitVec.Bootstrap
 
 set_option linter.missingDocs true
 
@@ -27,19 +27,9 @@ namespace BitVec
 @[simp] theorem mk_zero : BitVec.ofFin (w := w) ⟨0, h⟩ = 0#w := rfl
 @[simp] theorem ofNatLT_zero : BitVec.ofNatLT (w := w) 0 h = 0#w := rfl
 
-@[simp] theorem getLsbD_ofFin (x : Fin (2^n)) (i : Nat) :
-    getLsbD (BitVec.ofFin x) i = x.val.testBit i := rfl
-
 @[simp] theorem getElem_ofFin (x : Fin (2^n)) (i : Nat) (h : i < n) :
     (BitVec.ofFin x)[i] = x.val.testBit i := rfl
 
-@[simp] theorem getLsbD_of_ge (x : BitVec w) (i : Nat) (ge : w ≤ i) : getLsbD x i = false := by
-  let ⟨x, x_lt⟩ := x
-  simp only [getLsbD_ofFin]
-  apply Nat.testBit_lt_two_pow
-  have p : 2^w ≤ 2^i := Nat.pow_le_pow_right (by omega) ge
-  omega
-
 @[simp] theorem getMsbD_of_ge (x : BitVec w) (i : Nat) (ge : w ≤ i) : getMsbD x i = false := by
   rw [getMsbD]
   simp only [Bool.and_eq_false_imp, decide_eq_true_eq]
@@ -127,10 +117,6 @@ This normalized a bitvec using `ofFin` to `ofNat`.
 theorem ofFin_eq_ofNat : @BitVec.ofFin w (Fin.mk x lt) = BitVec.ofNat w x := by
   simp only [BitVec.ofNat, Fin.ofNat, lt, Nat.mod_eq_of_lt]
 
-/-- Prove equality of bitvectors in terms of nat operations. -/
-theorem eq_of_toNat_eq {n} : ∀ {x y : BitVec n}, x.toNat = y.toNat → x = y
-  | ⟨_, _⟩, ⟨_, _⟩, rfl => rfl
-
 /-- Prove nonequality of bitvectors in terms of nat operations. -/
 theorem toNat_ne_iff_ne {n} {x y : BitVec n} : x.toNat ≠ y.toNat ↔ x ≠ y := by
   constructor
@@ -153,26 +139,28 @@ protected theorem toNat_lt_twoPow_of_le (h : m ≤ n) {x : BitVec m} :
   apply Nat.pow_le_pow_of_le
   <;> omega
 
-theorem testBit_toNat (x : BitVec w) : x.toNat.testBit i = x.getLsbD i := rfl
-
 theorem two_pow_le_toNat_of_getElem_eq_true {i : Nat} {x : BitVec w}
     (hi : i < w) (hx : x[i] = true) : 2^i ≤ x.toNat := by
   apply Nat.ge_two_pow_of_testBit
   rw [← getElem_eq_testBit_toNat x i hi]
   exact hx
 
-theorem getMsb'_eq_getLsb' (x : BitVec w) (i : Fin w) :
-    x.getMsb' i = x.getLsb' ⟨w - 1 - i, by omega⟩ := by
-  simp only [getMsb', getLsb']
+theorem getMsb_eq_getLsb (x : BitVec w) (i : Fin w) :
+    x.getMsb i = x.getLsb ⟨w - 1 - i, by omega⟩ := by
+  simp only [getMsb, getLsb]
 
 theorem getMsb?_eq_getLsb? (x : BitVec w) (i : Nat) :
     x.getMsb? i = if i < w then x.getLsb? (w - 1 - i) else none := by
   simp only [getMsb?, getLsb?_eq_getElem?]
-  split <;> simp [getMsb'_eq_getLsb']
+  split <;> simp [getMsb_eq_getLsb]
 
 theorem getMsbD_eq_getLsbD (x : BitVec w) (i : Nat) : x.getMsbD i = (decide (i < w) && x.getLsbD (w - 1 - i)) := by
   rw [getMsbD, getLsbD]
 
+@[deprecated getMsb_eq_getLsb (since := "2025-06-17")]
+theorem getMsb'_eq_getLsb' (x : BitVec w) (i : Nat) : x.getMsbD i = (decide (i < w) && x.getLsbD (w - 1 - i)) := by
+  rw [getMsbD, getLsbD]
+
 theorem getLsbD_eq_getMsbD (x : BitVec w) (i : Nat) : x.getLsbD i = (decide (i < w) && x.getMsbD (w - 1 - i)) := by
   rw [getMsbD]
   by_cases h₁ : i < w <;> by_cases h₂ : w - 1 - i < w <;>
@@ -241,21 +229,6 @@ theorem getMsbD_eq_getMsb?_getD (x : BitVec w) (i : Nat) :
       intros
       omega
 
-theorem eq_of_getLsbD_eq {x y : BitVec w}
-    (pred : ∀ i, i < w → x.getLsbD i = y.getLsbD i) : x = y := by
-  apply eq_of_toNat_eq
-  apply Nat.eq_of_testBit_eq
-  intro i
-  if i_lt : i < w then
-    exact pred i i_lt
-  else
-    have p : i ≥ w := Nat.le_of_not_gt i_lt
-    simp [testBit_toNat, getLsbD_of_ge _ _ p]
-
-@[ext] theorem eq_of_getElem_eq {x y : BitVec n} :
-        (∀ i (hi : i < n), x[i] = y[i]) → x = y :=
-  fun h => BitVec.eq_of_getLsbD_eq (h ↑·)
-
 theorem eq_of_getLsbD_eq_iff {w : Nat} {x y : BitVec w} :
     x = y ↔ ∀ (i : Nat), i < w → x.getLsbD i = y.getLsbD i := by
   have iff := @BitVec.eq_of_getElem_eq_iff w x y
@@ -342,9 +315,6 @@ open Fin.NatCast in
 @[simp, norm_cast] theorem toFin_natCast (n : Nat) : toFin (n : BitVec w) = (n : Fin (2^w)) := by
   rfl
 
-@[simp] theorem toNat_ofBool (b : Bool) : (ofBool b).toNat = b.toNat := by
-  cases b <;> rfl
-
 @[simp] theorem toInt_ofBool (b : Bool) : (ofBool b).toInt = -b.toInt := by
   cases b <;> simp
 
@@ -368,10 +338,6 @@ theorem ofBool_eq_iff_eq : ∀ {b b' : Bool}, BitVec.ofBool b = BitVec.ofBool b'
 @[simp] theorem ofBool_xor_ofBool : ofBool b ^^^ ofBool b' = ofBool (b ^^ b') := by
   cases b <;> cases b' <;> rfl
 
-@[simp, bitvec_to_nat] theorem toNat_ofFin (x : Fin (2^n)) : (BitVec.ofFin x).toNat = x.val := rfl
-
-@[simp] theorem toNat_ofNatLT (x : Nat) (p : x < 2^w) : (x#'p).toNat = x := rfl
-
 @[deprecated toNat_ofNatLT (since := "2025-02-13")]
 theorem toNat_ofNatLt (x : Nat) (p : x < 2^w) : (x#'p).toNat = x := rfl
 
@@ -391,9 +357,6 @@ theorem getLsbD_ofNatLt {n : Nat} (x : Nat) (lt : x < 2^n) (i : Nat) :
 theorem getMsbD_ofNatLt {n x i : Nat} (h : x < 2^n) :
     getMsbD (x#'h) i = (decide (i < n) && x.testBit (n - 1 - i)) := getMsbD_ofNatLT h
 
-@[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])
 
@@ -581,7 +544,6 @@ theorem msb_eq_getMsbD_zero (x : BitVec w) : x.msb = x.getMsbD 0 := by
 
 /-! ### cast -/
 
-@[simp, bitvec_to_nat] theorem toNat_cast (h : w = v) (x : BitVec w) : (x.cast h).toNat = x.toNat := rfl
 @[simp] theorem toFin_cast (h : w = v) (x : BitVec w) :
     (x.cast h).toFin = x.toFin.cast (by rw [h]) :=
   rfl
@@ -905,20 +867,6 @@ theorem truncate_eq_setWidth {v : Nat} {x : BitVec w} :
 theorem zeroExtend_eq_setWidth {v : Nat} {x : BitVec w} :
   zeroExtend v x = setWidth v x := rfl
 
-@[simp, bitvec_to_nat] theorem toNat_setWidth' {m n : Nat} (p : m ≤ n) (x : BitVec m) :
-    (setWidth' p x).toNat = x.toNat := by
-  simp [setWidth']
-
-@[simp, bitvec_to_nat] theorem toNat_setWidth (i : Nat) (x : BitVec n) :
-    BitVec.toNat (setWidth i x) = x.toNat % 2^i := by
-  let ⟨x, lt_n⟩ := x
-  simp only [setWidth]
-  if n_le_i : n ≤ i then
-    have x_lt_two_i : x < 2 ^ i := lt_two_pow_of_le lt_n n_le_i
-    simp [n_le_i, Nat.mod_eq_of_lt, x_lt_two_i]
-  else
-    simp [n_le_i, toNat_ofNat]
-
 @[simp] theorem toInt_setWidth (x : BitVec w) :
     (x.setWidth v).toInt = Int.bmod x.toNat (2^v) := by
   simp [toInt_eq_toNat_bmod, toNat_setWidth, Int.emod_bmod, -Int.natCast_pow]
@@ -936,10 +884,6 @@ theorem zeroExtend_eq_setWidth {v : Nat} {x : BitVec w} :
   apply eq_of_toNat_eq
   simp [toNat_setWidth]
 
-@[simp] theorem ofNat_toNat (m : Nat) (x : BitVec n) : BitVec.ofNat m x.toNat = setWidth m x := by
-  apply eq_of_toNat_eq
-  simp
-
 /-- Moves one-sided left toNat equality to BitVec equality. -/
 theorem toNat_eq_nat {x : BitVec w} {y : Nat}
   : (x.toNat = y) ↔ (y < 2^w ∧ (x = BitVec.ofNat w y)) := by
@@ -955,19 +899,6 @@ theorem nat_eq_toNat {x : BitVec w} {y : Nat}
   rw [@eq_comm _ _ x.toNat]
   apply toNat_eq_nat
 
-theorem getElem_setWidth' (x : BitVec w) (i : Nat) (h : w ≤ v) (hi : i < v) :
-    (setWidth' h x)[i] = x.getLsbD i := by
-  rw [getElem_eq_testBit_toNat, toNat_setWidth', getLsbD]
-
-@[simp]
-theorem getElem_setWidth (m : Nat) (x : BitVec n) (i : Nat) (h : i < m) :
-    (setWidth m x)[i] = x.getLsbD i := by
-  rw [setWidth]
-  split
-  · rw [getElem_setWidth']
-  · simp [getElem_eq_testBit_toNat, getLsbD]
-    omega
-
 theorem getElem?_setWidth' (x : BitVec w) (i : Nat) (h : w ≤ v) :
     (setWidth' h x)[i]? = if i < v then some (x.getLsbD i) else none := by
   simp [getElem?_eq, getElem_setWidth']
@@ -1932,6 +1863,63 @@ theorem shiftLeftZeroExtend_eq {x : BitVec w} :
     exact Nat.mul_lt_mul_of_pos_right x.isLt (Nat.two_pow_pos _)
   · omega
 
+@[simp]
+theorem toNat_shiftLeftZeroExtend {x : BitVec w} :
+    (shiftLeftZeroExtend x n).toNat = x.toNat <<< n := by
+  rcases n with _|n
+  · simp [shiftLeftZeroExtend]
+  · simp only [shiftLeftZeroExtend_eq, toNat_shiftLeft, toNat_setWidth]
+    have :=  Nat.pow_lt_pow_of_lt (a := 2) (n := w) (m := w + (n + 1)) (by omega) (by omega)
+    have : x.toNat <<< (n + 1) < 2 ^ (w + (n + 1)) := by
+      rw [Nat.shiftLeft_eq, Nat.pow_add (m := w) (n := n + 1), Nat.mul_lt_mul_right (by apply Nat.two_pow_pos (w := n + 1))]
+      omega
+    rw [Nat.mod_eq_of_lt (by rw [Nat.mod_eq_of_lt (by omega)]; omega), Nat.mod_eq_of_lt (by omega)]
+
+@[simp]
+theorem toInt_shiftLeftZeroExtend {x : BitVec w} :
+    (shiftLeftZeroExtend x n).toInt = x.toInt * 2 ^ n := by
+  rw [shiftLeftZeroExtend_eq]
+  rcases w with _|w
+  · simp [of_length_zero, shiftLeftZeroExtend_eq]
+  · rcases n with _|n
+    · simp [shiftLeftZeroExtend_eq]
+    · have := Nat.pow_pos (a := 2) (n := n + 1) (by omega)
+      have : x.toNat <<< (n + 1) < 2 ^ (w + 1 + (n + 1)) := by
+        rw [Nat.shiftLeft_eq, Nat.pow_add (a := 2) (m := w + 1) (n := n + 1), Nat.mul_lt_mul_right (by omega)]
+        omega
+      simp only [shiftLeftZeroExtend_eq, toInt_shiftLeft, toNat_setWidth, Nat.lt_add_right_iff_pos,
+        Nat.zero_lt_succ, toNat_mod_cancel_of_lt, Int.bmod_def]
+      by_cases hmsb : x.msb
+      · have hge := toNat_ge_of_msb_true hmsb
+        simp only [Nat.add_one_sub_one, ge_iff_le] at hge
+        rw [Int.emod_eq_of_lt (by norm_cast; rw [Nat.shiftLeft_eq]; omega) (by omega)]
+        rw_mod_cast [← Nat.add_assoc]
+        rw [show (2 ^ (w + 1 + n + 1) + 1) / 2 = 2 ^ (w + 1 + n) by omega, Int.natCast_pow,
+          Int.cast_ofNat_Int, Nat.shiftLeft_eq, Nat.add_assoc, Nat.pow_add (a := 2) (m := w) (n := 1 + n),
+          Nat.add_comm 1 n]
+        simp only [Nat.mul_lt_mul_right (by omega), show ¬x.toNat < 2 ^ w by omega, reduceIte,
+          Int.natCast_mul, Int.natCast_pow, Int.cast_ofNat_Int, toInt_eq_toNat_cond,
+          show ¬2 * x.toNat < 2 ^ (w + 1) by simp [Nat.pow_add, Nat.mul_comm (2 ^ w) 2, hge]]
+        norm_cast
+        simp [Int.natCast_mul, Int.natCast_pow, Int.cast_ofNat_Int, Int.sub_mul,
+          Int.sub_right_inj, show w + (n + 1) + 1 = (w + 1) + (n + 1) by omega, Nat.pow_add]
+      · simp only [Bool.not_eq_true] at hmsb
+        have hle := toNat_lt_of_msb_false (x := x) hmsb
+        simp only [Nat.add_one_sub_one] at hle
+        rw [Int.emod_eq_of_lt (by norm_cast; rw [Nat.shiftLeft_eq]; omega) (by omega)]
+        rw_mod_cast [← Nat.add_assoc]
+        rw [show (2 ^ (w + 1 + n + 1) + 1) / 2 = 2 ^ (w + 1 + n) by omega, Int.natCast_pow,
+          Int.cast_ofNat_Int, Nat.shiftLeft_eq, Nat.add_assoc,  Nat.pow_add (a := 2) (m := w) (n := 1 + n), Nat.add_comm 1 n]
+        simp [Nat.mul_lt_mul_right (b := x.toNat) (c := 2 ^ w) (a := 2 ^ (n + 1)) (by omega), hle,
+          reduceIte, Int.natCast_mul, Int.natCast_pow, Int.cast_ofNat_Int, toInt_eq_toNat_of_msb hmsb]
+
+theorem toFin_shiftLeftZeroExtend {x : BitVec w} :
+    (shiftLeftZeroExtend x n).toFin = Fin.ofNat (2 ^ (w + n)) (x.toNat * 2 ^ n) := by
+  rcases w with _|w
+  · simp [of_length_zero, shiftLeftZeroExtend_eq]
+  · have := Nat.pow_le_pow_of_le (a := 2) (n := w + 1) (m := w + 1 + n) (by omega) (by omega)
+    rw [shiftLeftZeroExtend_eq, toFin_shiftLeft, toNat_setWidth, Nat.mod_eq_of_lt (by omega), Nat.shiftLeft_eq]
+
 @[simp] theorem getElem_shiftLeftZeroExtend {x : BitVec m} {n : Nat} (h : i < m + n) :
     (shiftLeftZeroExtend x n)[i] = if h' : i < n then false else x[i - n] := by
   rw [shiftLeftZeroExtend_eq]
@@ -2673,10 +2661,6 @@ theorem toFin_signExtend (x : BitVec w) :
 theorem append_def (x : BitVec v) (y : BitVec w) :
     x ++ y = (shiftLeftZeroExtend x w ||| setWidth' (Nat.le_add_left w v) y) := rfl
 
-@[simp] theorem toNat_append (x : BitVec m) (y : BitVec n) :
-    (x ++ y).toNat = x.toNat <<< n ||| y.toNat :=
-  rfl
-
 theorem getLsbD_append {x : BitVec n} {y : BitVec m} :
     getLsbD (x ++ y) i = if i < m then getLsbD y i else getLsbD x (i - m) := by
   simp only [append_def, getLsbD_or, getLsbD_shiftLeftZeroExtend, getLsbD_setWidth']
@@ -3061,11 +3045,6 @@ theorem getMsbD_rev (x : BitVec w) (i : Fin w) :
 
 /-! ### cons -/
 
-@[simp] theorem toNat_cons (b : Bool) (x : BitVec w) :
-    (cons b x).toNat = (b.toNat <<< w) ||| x.toNat := by
-  let ⟨x, _⟩ := x
-  simp [cons, toNat_append, toNat_ofBool]
-
 /-- Variant of `toNat_cons` using `+` instead of `|||`. -/
 theorem toNat_cons' {x : BitVec w} :
     (cons a x).toNat = (a.toNat <<< w) + x.toNat := by
@@ -3085,21 +3064,6 @@ theorem getLsbD_cons (b : Bool) {n} (x : BitVec n) (i : Nat) :
     have p2 : i - n ≠ 0 := by omega
     simp [p1, p2, Nat.testBit_bool_to_nat]
 
-theorem getElem_cons {b : Bool} {n} {x : BitVec n} {i : Nat} (h : i < n + 1) :
-    (cons b x)[i] = if h : i = n then b else x[i] := by
-  simp only [getElem_eq_testBit_toNat, toNat_cons, Nat.testBit_or, getLsbD]
-  rw [Nat.testBit_shiftLeft]
-  rcases Nat.lt_trichotomy i n with i_lt_n | i_eq_n | n_lt_i
-  · have p1 : ¬(n ≤ i) := by omega
-    have p2 : i ≠ n := by omega
-    simp [p1, p2]
-  · simp only [i_eq_n, ge_iff_le, Nat.le_refl, decide_true, Nat.sub_self, Nat.testBit_zero,
-    Bool.true_and, testBit_toNat, getLsbD_of_ge, Bool.or_false, ↓reduceIte]
-    cases b <;> trivial
-  · have p1 : i ≠ n := by omega
-    have p2 : i - n ≠ 0 := by omega
-    simp [p1, p2, Nat.testBit_bool_to_nat]
-
 @[simp] theorem msb_cons : (cons a x).msb = a := by
   simp [cons, msb_cast, msb_append]
 
@@ -3119,15 +3083,6 @@ theorem setWidth_succ (x : BitVec w) :
     have j_lt : j < i := Nat.lt_of_le_of_ne (Nat.le_of_succ_le_succ h) j_eq
     simp [j_eq, j_lt]
 
-@[simp] theorem cons_msb_setWidth (x : BitVec (w+1)) : (cons x.msb (x.setWidth w)) = x := by
-  ext i
-  simp only [getElem_cons]
-  split <;> rename_i h
-  · simp [BitVec.msb, getMsbD, h]
-  · by_cases h' : i < w
-    · simp_all
-    · omega
-
 @[simp] theorem not_cons (x : BitVec w) (b : Bool) : ~~~(cons b x) = cons (!b) (~~~x) := by
   simp [cons]
 
@@ -3513,6 +3468,11 @@ theorem ofNat_sub_ofNat {n} (x y : Nat) : BitVec.ofNat n x - BitVec.ofNat n y =
   apply eq_of_toNat_eq
   simp [BitVec.ofNat, Fin.ofNat_sub]
 
+theorem ofNat_sub_ofNat_of_le (x y : Nat) (hy : y < 2 ^ w) (hlt : y ≤ x):
+    BitVec.ofNat w x - BitVec.ofNat w y = BitVec.ofNat w (x - y) := by
+  apply eq_of_toNat_eq
+  simp [Nat.mod_eq_of_lt hy, show 2 ^ w - y + x = 2 ^ w + (x - y) by omega, Nat.add_mod_left]
+
 @[simp] protected theorem sub_zero (x : BitVec n) : x - 0#n = x := by apply eq_of_toNat_eq ; simp
 
 @[simp] protected theorem zero_sub (x : BitVec n) : 0#n - x = -x := rfl
@@ -3524,9 +3484,6 @@ theorem ofNat_sub_ofNat {n} (x y : Nat) : BitVec.ofNat n x - BitVec.ofNat n y =
   · simp
   · exact Nat.le_of_lt x.isLt
 
-@[simp, bitvec_to_nat] theorem toNat_neg (x : BitVec n) : (- x).toNat = (2^n - x.toNat) % 2^n := by
-  simp [Neg.neg, BitVec.neg]
-
 theorem toNat_neg_of_pos {x : BitVec n} (h : 0#n < x) :
     (- x).toNat = 2^n - x.toNat := by
   change 0 < x.toNat at h
@@ -5172,9 +5129,6 @@ theorem BitVec.setWidth_add_eq_mod {x y : BitVec w} : BitVec.setWidth i (x + y)
 
 /-! ### intMin -/
 
-/-- The bitvector of width `w` that has the smallest value when interpreted as an integer. -/
-def intMin (w : Nat) := twoPow w (w - 1)
-
 theorem getLsbD_intMin (w : Nat) : (intMin w).getLsbD i = decide (i + 1 = w) := by
   simp only [intMin, getLsbD_twoPow, bool_to_prop]
   omega
@@ -5325,9 +5279,6 @@ theorem neg_le_intMin_of_msb_eq_true {x : BitVec w} (hx : x.msb = true) : -x ≤
 
 /-! ### intMax -/
 
-/-- The bitvector of width `w` that has the largest value when interpreted as an integer. -/
-def intMax (w : Nat) := (twoPow w (w - 1)) - 1
-
 @[simp, bitvec_to_nat]
 theorem toNat_intMax : (intMax w).toNat = 2 ^ (w - 1) - 1 := by
   simp only [intMax]
@@ -5679,68 +5630,71 @@ theorem msb_replicate {n w : Nat} {x : BitVec w} :
   simp only [BitVec.msb, getMsbD_replicate, Nat.zero_mod]
   cases n <;> cases w <;> simp
 
-/-! ### Decidable quantifiers -/
+/-! ### Count leading zeros -/
 
-theorem forall_zero_iff {P : BitVec 0 → Prop} :
-    (∀ v, P v) ↔ P 0#0 := by
-  constructor
-  · intro h
-    apply h
-  · intro h v
-    obtain (rfl : v = 0#0) := (by ext i ⟨⟩)
-    apply h
+theorem clzAuxRec_zero (x : BitVec w) :
+    x.clzAuxRec 0 = if x.getLsbD 0 then BitVec.ofNat w (w - 1) else BitVec.ofNat w w := by rfl
 
-theorem forall_cons_iff {P : BitVec (n + 1) → Prop} :
-    (∀ v : BitVec (n + 1), P v) ↔ (∀ (x : Bool) (v : BitVec n), P (v.cons x)) := by
-  constructor
-  · intro h _ _
-    apply h
-  · intro h v
-    have w : v = (v.setWidth n).cons v.msb := by simp
-    rw [w]
-    apply h
+theorem clzAuxRec_succ (x : BitVec w) :
+    x.clzAuxRec (n + 1) = if x.getLsbD (n + 1) then BitVec.ofNat w (w - 1 - (n + 1)) else BitVec.clzAuxRec x n := by rfl
 
-instance instDecidableForallBitVecZero (P : BitVec 0 → Prop) :
-    ∀ [Decidable (P 0#0)], Decidable (∀ v, P v)
-  | .isTrue h => .isTrue fun v => by
-    obtain (rfl : v = 0#0) := (by ext i ⟨⟩)
-    exact h
-  | .isFalse h => .isFalse (fun w => h (w _))
+theorem clzAuxRec_eq_clzAuxRec_of_le (x : BitVec w) (h : w - 1 ≤ n) :
+    x.clzAuxRec n = x.clzAuxRec (w - 1) := by
+  let k := n - (w - 1)
+  rw [show n = (w - 1) + k by omega]
+  induction k
+  · case zero => simp
+  · case succ k ihk =>
+    simp [show w - 1 + (k + 1) = (w - 1 + k) + 1 by omega, clzAuxRec_succ, ihk,
+      show x.getLsbD (w - 1 + k + 1) = false by simp only [show w ≤ w - 1 + k + 1 by omega, getLsbD_of_ge]]
 
-instance instDecidableForallBitVecSucc (P : BitVec (n+1) → Prop) [DecidablePred P]
-    [Decidable (∀ (x : Bool) (v : BitVec n), P (v.cons x))] : Decidable (∀ v, P v) :=
-  decidable_of_iff' (∀ x (v : BitVec n), P (v.cons x)) forall_cons_iff
+/-! ### Inequalities (le / lt) -/
 
-instance instDecidableExistsBitVecZero (P : BitVec 0 → Prop) [Decidable (P 0#0)] :
-    Decidable (∃ v, P v) :=
-  decidable_of_iff (¬ ∀ v, ¬ P v) Classical.not_forall_not
+theorem ule_eq_not_ult (x y : BitVec w) : x.ule y = !y.ult x := by
+  simp [BitVec.ule, BitVec.ult, ← decide_not]
 
-instance instDecidableExistsBitVecSucc (P : BitVec (n+1) → Prop) [DecidablePred P]
-    [Decidable (∀ (x : Bool) (v : BitVec n), ¬ P (v.cons x))] : Decidable (∃ v, P v) :=
-  decidable_of_iff (¬ ∀ v, ¬ P v) Classical.not_forall_not
+/-- If two bitvectors have the same `msb`, then signed and unsigned comparisons coincide -/
+theorem slt_eq_ult_of_msb_eq {x y : BitVec w} (h : x.msb = y.msb) :
+    x.slt y = x.ult y := by
+  simp only [BitVec.slt, toInt_eq_msb_cond, BitVec.ult, decide_eq_decide, h]
+  cases y.msb <;> simp
 
-/--
-For small numerals this isn't necessary (as typeclass search can use the above two instances),
-but for large numerals this provides a shortcut.
-Note, however, that for large numerals the decision procedure may be very slow,
-and you should use `bv_decide` if possible.
--/
-instance instDecidableForallBitVec :
-    ∀ (n : Nat) (P : BitVec n → Prop) [DecidablePred P], Decidable (∀ v, P v)
-  | 0, _, _ => inferInstance
-  | n + 1, _, _ =>
-    have := instDecidableForallBitVec n
-    inferInstance
+/-- If two bitvectors have different `msb`s, then unsigned comparison is determined by this bit -/
+theorem ult_eq_msb_of_msb_neq {x y : BitVec w} (h : x.msb ≠ y.msb) :
+    x.ult y = y.msb := by
+  simp only [BitVec.ult, msb_eq_decide, ne_eq, decide_eq_decide] at *
+  omega
 
-/--
-For small numerals this isn't necessary (as typeclass search can use the above two instances),
-but for large numerals this provides a shortcut.
-Note, however, that for large numerals the decision procedure may be very slow.
--/
-instance instDecidableExistsBitVec :
-    ∀ (n : Nat) (P : BitVec n → Prop) [DecidablePred P], Decidable (∃ v, P v)
-  | 0, _, _ => inferInstance
-  | _ + 1, _, _ => inferInstance
+/-- If two bitvectors have different `msb`s, then signed and unsigned comparisons are opposites -/
+theorem slt_eq_not_ult_of_msb_neq {x y : BitVec w} (h : x.msb ≠ y.msb) :
+    x.slt y = !x.ult y := by
+  simp only [BitVec.slt, toInt_eq_msb_cond, Bool.eq_not_of_ne h, ult_eq_msb_of_msb_neq h]
+  cases y.msb <;> (simp [-Int.natCast_pow]; omega)
+
+theorem slt_eq_ult {x y : BitVec w} :
+    x.slt y = (x.msb != y.msb).xor (x.ult y) := by
+  by_cases h : x.msb = y.msb
+  · simp [h, slt_eq_ult_of_msb_eq]
+  · have h' : x.msb != y.msb := by simp_all
+    simp [slt_eq_not_ult_of_msb_neq h, h']
+
+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} {x : BitVec w} (hx : BitVec.sle 0#w x) : x.toInt.toNat = x.toNat :=
+  toNat_toInt_of_msb x (zero_sle_iff_msb_eq_false.1 hx)
+
+theorem sle_eq_ule {x y : BitVec w} : x.sle y = (x.msb != y.msb ^^ x.ule y) := by
+  rw [sle_eq_not_slt, slt_eq_ult, ← Bool.xor_not, ← ule_eq_not_ult, bne_comm]
+
+theorem sle_eq_ule_of_msb_eq {x y : BitVec w} (h : x.msb = y.msb) : x.sle y = x.ule y := by
+  simp [BitVec.sle_eq_ule, h]
 
 /-! ### Deprecations -/
 

src/Init/Data/Function.lean

@@ -31,19 +31,19 @@ Examples:
 @[inline, expose]
 def uncurry : (α → β → φ) → α × β → φ := fun f a => f a.1 a.2
 
-@[simp]
+@[simp, grind]
 theorem curry_uncurry (f : α → β → φ) : curry (uncurry f) = f :=
   rfl
 
-@[simp]
+@[simp, grind]
 theorem uncurry_curry (f : α × β → φ) : uncurry (curry f) = f :=
   funext fun ⟨_a, _b⟩ => rfl
 
-@[simp]
+@[simp, grind]
 theorem uncurry_apply_pair {α β γ} (f : α → β → γ) (x : α) (y : β) : uncurry f (x, y) = f x y :=
   rfl
 
-@[simp]
+@[simp, grind]
 theorem curry_apply {α β γ} (f : α × β → γ) (x : α) (y : β) : curry f x y = f (x, y) :=
   rfl
 

src/Init/Data/Iterators.lean

@@ -0,0 +1,19 @@
+/-
+Copyright (c) 2025 Lean FRO, LLC. All rights reserved.
+Released under Apache 2.0 license as described in the file LICENSE.
+Authors: Paul Reichert
+-/
+module
+
+prelude
+import Init.Data.Iterators.Basic
+import Init.Data.Iterators.PostconditionMonad
+import Init.Data.Iterators.Consumers
+import Init.Data.Iterators.Lemmas
+import Init.Data.Iterators.Internal
+
+/-!
+# Iterators
+
+See `Std.Data.Iterators` for an overview over the iterator API.
+-/

src/Init/Data/Iterators/Basic.lean

@@ -3,6 +3,8 @@ Copyright (c) 2025 Lean FRO, LLC. All rights reserved.
 Released under Apache 2.0 license as described in the file LICENSE.
 Authors: Paul Reichert
 -/
+module
+
 prelude
 import Init.Core
 import Init.Classical
@@ -31,7 +33,7 @@ See `Std.Data.Iterators.Producers` for ways to iterate over common data structur
 By convention, the monadic iterator associated with an object can be obtained via dot notation.
 For example, `List.iterM IO` creates an iterator over a list in the monad `IO`.
 
-See `Std.Data.Iterators.Consumers` for ways to use an iterator. For example, `it.toList` will
+See `Init.Data.Iterators.Consumers` for ways to use an iterator. For example, `it.toList` will
 convert a provably finite iterator `it` into a list and `it.allowNontermination.toList` will
 do so even if finiteness cannot be proved. It is also always possible to manually iterate using
 `it.step`, relying on the termination measures `it.finitelyManySteps` and `it.finitelyManySkips`.
@@ -75,7 +77,7 @@ See `Std.Data.Iterators.Producers` for ways to iterate over common data structur
 By convention, the monadic iterator associated with an object can be obtained via dot notation.
 For example, `List.iterM IO` creates an iterator over a list in the monad `IO`.
 
-See `Std.Data.Iterators.Consumers` for ways to use an iterator. For example, `it.toList` will
+See `Init.Data.Iterators.Consumers` for ways to use an iterator. For example, `it.toList` will
 convert a provably finite iterator `it` into a list and `it.allowNontermination.toList` will
 do so even if finiteness cannot be proved. It is also always possible to manually iterate using
 `it.step`, relying on the termination measures `it.finitelyManySteps` and `it.finitelyManySkips`.
@@ -111,12 +113,14 @@ structure Iter {α : Type w} (β : Type w) where
 Converts a pure iterator (`Iter β`) into a monadic iterator (`IterM Id β`) in the
 identity monad `Id`.
 -/
+@[expose]
 def Iter.toIterM {α : Type w} {β : Type w} (it : Iter (α := α) β) : IterM (α := α) Id β :=
   ⟨it.internalState⟩
 
 /--
 Converts a monadic iterator (`IterM Id β`) over `Id` into a pure iterator (`Iter β`).
 -/
+@[expose]
 def IterM.toIter {α : Type w} {β : Type w} (it : IterM (α := α) Id β) : Iter (α := α) β :=
   ⟨it.internalState⟩
 
@@ -170,6 +174,7 @@ inductive IterStep (α β) where
 Returns the succeeding iterator stored in an iterator step or `none` if the step is `.done`
 and the iterator has finished.
 -/
+@[expose]
 def IterStep.successor : IterStep α β → Option α
   | .yield it _ => some it
   | .skip it => some it
@@ -179,7 +184,7 @@ def IterStep.successor : IterStep α β → Option α
 If present, applies `f` to the iterator of an `IterStep` and replaces the iterator
 with the result of the application of `f`.
 -/
-@[always_inline, inline]
+@[always_inline, inline, expose]
 def IterStep.mapIterator {α' : Type u'} (f : α → α') : IterStep α β → IterStep α' β
   | .yield it out => .yield (f it) out
   | .skip it => .skip (f it)
@@ -224,12 +229,13 @@ of another state. Having this proof bundled up with the step is important for te
 
 See `IterM.Step` and `Iter.Step` for the concrete choice of the plausibility predicate.
 -/
+@[expose]
 def PlausibleIterStep (IsPlausibleStep : IterStep α β → Prop) := Subtype IsPlausibleStep
 
 /--
 Match pattern for the `yield` case. See also `IterStep.yield`.
 -/
-@[match_pattern, simp]
+@[match_pattern, simp, expose]
 def PlausibleIterStep.yield {IsPlausibleStep : IterStep α β → Prop}
     (it' : α) (out : β) (h : IsPlausibleStep (.yield it' out)) :
     PlausibleIterStep IsPlausibleStep :=
@@ -238,7 +244,7 @@ def PlausibleIterStep.yield {IsPlausibleStep : IterStep α β → Prop}
 /--
 Match pattern for the `skip` case. See also `IterStep.skip`.
 -/
-@[match_pattern, simp]
+@[match_pattern, simp, expose]
 def PlausibleIterStep.skip {IsPlausibleStep : IterStep α β → Prop}
     (it' : α) (h : IsPlausibleStep (.skip it')) : PlausibleIterStep IsPlausibleStep :=
   ⟨.skip it', h⟩
@@ -246,7 +252,7 @@ def PlausibleIterStep.skip {IsPlausibleStep : IterStep α β → Prop}
 /--
 Match pattern for the `done` case. See also `IterStep.done`.
 -/
-@[match_pattern, simp]
+@[match_pattern, simp, expose]
 def PlausibleIterStep.done {IsPlausibleStep : IterStep α β → Prop}
     (h : IsPlausibleStep .done) : PlausibleIterStep IsPlausibleStep :=
   ⟨.done, h⟩
@@ -283,7 +289,7 @@ section Monadic
 /--
 Converts wraps the state of an iterator into an `IterM` object.
 -/
-@[always_inline, inline]
+@[always_inline, inline, expose]
 def toIterM {α : Type w} (it : α) (m : Type w → Type w') (β : Type w) :
     IterM (α := α) m β :=
   ⟨it⟩
@@ -302,6 +308,7 @@ theorem internalState_toIterM {α m β} (it : α) :
 Asserts that certain step is plausibly the successor of a given iterator. What "plausible" means
 is up to the `Iterator` instance but it should be strong enough to allow termination proofs.
 -/
+@[expose]
 abbrev IterM.IsPlausibleStep {α : Type w} {m : Type w → Type w'} {β : Type w} [Iterator α m β] :
     IterM (α := α) m β → IterStep (IterM (α := α) m β) β → Prop :=
   Iterator.IsPlausibleStep (α := α) (m := m)
@@ -310,6 +317,7 @@ abbrev IterM.IsPlausibleStep {α : Type w} {m : Type w → Type w'} {β : Type w
 The type of the step object returned by `IterM.step`, containing an `IterStep`
 and a proof that this is a plausible step for the given iterator.
 -/
+@[expose]
 abbrev IterM.Step {α : Type w} {m : Type w → Type w'} {β : Type w} [Iterator α m β]
     (it : IterM (α := α) m β) :=
   PlausibleIterStep it.IsPlausibleStep
@@ -318,6 +326,7 @@ abbrev IterM.Step {α : Type w} {m : Type w → Type w'} {β : Type w} [Iterator
 Asserts that a certain output value could plausibly be emitted by the given iterator in its next
 step.
 -/
+@[expose]
 def IterM.IsPlausibleOutput {α : Type w} {m : Type w → Type w'} {β : Type w} [Iterator α m β]
     (it : IterM (α := α) m β) (out : β) : Prop :=
   ∃ it', it.IsPlausibleStep (.yield it' out)
@@ -326,6 +335,7 @@ def IterM.IsPlausibleOutput {α : Type w} {m : Type w → Type w'} {β : Type w}
 Asserts that a certain iterator `it'` could plausibly be the directly succeeding iterator of another
 given iterator `it`.
 -/
+@[expose]
 def IterM.IsPlausibleSuccessorOf {α : Type w} {m : Type w → Type w'} {β : Type w} [Iterator α m β]
     (it' it : IterM (α := α) m β) : Prop :=
   ∃ step, step.successor = some it' ∧ it.IsPlausibleStep step
@@ -334,6 +344,7 @@ def IterM.IsPlausibleSuccessorOf {α : Type w} {m : Type w → Type w'} {β : Ty
 Asserts that a certain iterator `it'` could plausibly be the directly succeeding iterator of another
 given iterator `it` while no value is emitted (see `IterStep.skip`).
 -/
+@[expose]
 def IterM.IsPlausibleSkipSuccessorOf {α : Type w} {m : Type w → Type w'} {β : Type w}
     [Iterator α m β] (it' it : IterM (α := α) m β) : Prop :=
   it.IsPlausibleStep (.skip it')
@@ -356,6 +367,7 @@ section Pure
 Asserts that certain step is plausibly the successor of a given iterator. What "plausible" means
 is up to the `Iterator` instance but it should be strong enough to allow termination proofs.
 -/
+@[expose]
 def Iter.IsPlausibleStep {α : Type w} {β : Type w} [Iterator α Id β]
     (it : Iter (α := α) β) (step : IterStep (Iter (α := α) β) β) : Prop :=
   it.toIterM.IsPlausibleStep (step.mapIterator Iter.toIterM)
@@ -364,6 +376,7 @@ def Iter.IsPlausibleStep {α : Type w} {β : Type w} [Iterator α Id β]
 The type of the step object returned by `Iter.step`, containing an `IterStep`
 and a proof that this is a plausible step for the given iterator.
 -/
+@[expose]
 def Iter.Step {α : Type w} {β : Type w} [Iterator α Id β] (it : Iter (α := α) β) :=
   PlausibleIterStep (Iter.IsPlausibleStep it)
 
@@ -378,7 +391,7 @@ def Iter.Step.toMonadic {α : Type w} {β : Type w} [Iterator α Id β] {it : It
 /--
 Converts an `IterM.Step` into an `Iter.Step`.
 -/
-@[always_inline, inline]
+@[always_inline, inline, expose]
 def IterM.Step.toPure {α : Type w} {β : Type w} [Iterator α Id β] {it : IterM (α := α) Id β}
     (step : it.Step) : it.toIter.Step :=
   ⟨step.val.mapIterator IterM.toIter, (by simp [Iter.IsPlausibleStep, step.property])⟩
@@ -402,6 +415,7 @@ theorem IterM.Step.toPure_done {α β : Type w} [Iterator α Id β] {it : IterM
 Asserts that a certain output value could plausibly be emitted by the given iterator in its next
 step.
 -/
+@[expose]
 def Iter.IsPlausibleOutput {α : Type w} {β : Type w} [Iterator α Id β]
     (it : Iter (α := α) β) (out : β) : Prop :=
   it.toIterM.IsPlausibleOutput out
@@ -410,6 +424,7 @@ def Iter.IsPlausibleOutput {α : Type w} {β : Type w} [Iterator α Id β]
 Asserts that a certain iterator `it'` could plausibly be the directly succeeding iterator of another
 given iterator `it`.
 -/
+@[expose]
 def Iter.IsPlausibleSuccessorOf {α : Type w} {β : Type w} [Iterator α Id β]
     (it' it : Iter (α := α) β) : Prop :=
   it'.toIterM.IsPlausibleSuccessorOf it.toIterM
@@ -427,7 +442,7 @@ Makes a single step with the given iterator `it`, potentially emitting a value a
 succeeding iterator. If this function is used recursively, termination can sometimes be proved with
 the termination measures `it.finitelyManySteps` and `it.finitelyManySkips`.
 -/
-@[always_inline, inline]
+@[always_inline, inline, expose]
 def Iter.step {α β : Type w} [Iterator α Id β] (it : Iter (α := α) β) : it.Step :=
   it.toIterM.step.run.toPure
 
@@ -456,6 +471,7 @@ structure IterM.TerminationMeasures.Finite
 The relation of plausible successors on `IterM.TerminationMeasures.Finite`. It is well-founded
 if there is a `Finite` instance.
 -/
+@[expose]
 def IterM.TerminationMeasures.Finite.Rel
     {α : Type w} {m : Type w → Type w'} {β : Type w} [Iterator α m β] :
     TerminationMeasures.Finite α m → TerminationMeasures.Finite α m → Prop :=
@@ -464,12 +480,13 @@ def IterM.TerminationMeasures.Finite.Rel
 instance {α : Type w} {m : Type w → Type w'} {β : Type w} [Iterator α m β]
     [Finite α m] : WellFoundedRelation (IterM.TerminationMeasures.Finite α m) where
   rel := IterM.TerminationMeasures.Finite.Rel
-  wf := (InvImage.wf _ Finite.wf).transGen
+  wf := by exact (InvImage.wf _ Finite.wf).transGen
 
 /--
 Termination measure to be used in well-founded recursive functions recursing over a finite iterator
 (see also `Finite`).
 -/
+@[expose]
 def IterM.finitelyManySteps {α : Type w} {m : Type w → Type w'} {β : Type w} [Iterator α m β]
     [Finite α m] (it : IterM (α := α) m β) : IterM.TerminationMeasures.Finite α m :=
   ⟨it⟩
@@ -494,9 +511,10 @@ theorem IterM.TerminationMeasures.Finite.rel_of_skip
 macro_rules | `(tactic| decreasing_trivial) => `(tactic|
   first
   | exact IterM.TerminationMeasures.Finite.rel_of_yield ‹_›
-  | exact IterM.TerminationMeasures.Finite.rel_of_skip ‹_›)
+  | exact IterM.TerminationMeasures.Finite.rel_of_skip ‹_›
+  | fail)
 
-@[inherit_doc IterM.finitelyManySteps]
+@[inherit_doc IterM.finitelyManySteps, expose]
 def Iter.finitelyManySteps {α : Type w} {β : Type w} [Iterator α Id β] [Finite α Id]
     (it : Iter (α := α) β) : IterM.TerminationMeasures.Finite α Id :=
   it.toIterM.finitelyManySteps
@@ -521,7 +539,8 @@ theorem Iter.TerminationMeasures.Finite.rel_of_skip
 macro_rules | `(tactic| decreasing_trivial) => `(tactic|
   first
   | exact Iter.TerminationMeasures.Finite.rel_of_yield ‹_›
-  | exact Iter.TerminationMeasures.Finite.rel_of_skip ‹_›)
+  | exact Iter.TerminationMeasures.Finite.rel_of_skip ‹_›
+  | fail)
 
 theorem IterM.isPlausibleSuccessorOf_of_yield
     {α : Type w} {m : Type w → Type w'} {β : Type w} [Iterator α m β]
@@ -561,6 +580,7 @@ structure IterM.TerminationMeasures.Productive
 The relation of plausible successors while skipping on `IterM.TerminationMeasures.Productive`.
 It is well-founded if there is a `Productive` instance.
 -/
+@[expose]
 def IterM.TerminationMeasures.Productive.Rel
     {α : Type w} {m : Type w → Type w'} {β : Type w} [Iterator α m β] :
     TerminationMeasures.Productive α m → TerminationMeasures.Productive α m → Prop :=
@@ -569,12 +589,13 @@ def IterM.TerminationMeasures.Productive.Rel
 instance {α : Type w} {m : Type w → Type w'} {β : Type w} [Iterator α m β]
     [Productive α m] : WellFoundedRelation (IterM.TerminationMeasures.Productive α m) where
   rel := IterM.TerminationMeasures.Productive.Rel
-  wf := (InvImage.wf _ Productive.wf).transGen
+  wf := by exact (InvImage.wf _ Productive.wf).transGen
 
 /--
 Termination measure to be used in well-founded recursive functions recursing over a productive
 iterator (see also `Productive`).
 -/
+@[expose]
 def IterM.finitelyManySkips {α : Type w} {m : Type w → Type w'} {β : Type w} [Iterator α m β]
     [Productive α m] (it : IterM (α := α) m β) : IterM.TerminationMeasures.Productive α m :=
   ⟨it⟩
@@ -590,9 +611,11 @@ theorem IterM.TerminationMeasures.Productive.rel_of_skip
   .single h
 
 macro_rules | `(tactic| decreasing_trivial) => `(tactic|
-  exact IterM.TerminationMeasures.Productive.rel_of_skip ‹_›)
+  first
+    | exact IterM.TerminationMeasures.Productive.rel_of_skip ‹_›
+    | fail)
 
-@[inherit_doc IterM.finitelyManySkips]
+@[inherit_doc IterM.finitelyManySkips, expose]
 def Iter.finitelyManySkips {α : Type w} {β : Type w} [Iterator α Id β] [Productive α Id]
     (it : Iter (α := α) β) : IterM.TerminationMeasures.Productive α Id :=
   it.toIterM.finitelyManySkips
@@ -608,7 +631,9 @@ theorem Iter.TerminationMeasures.Productive.rel_of_skip
   IterM.TerminationMeasures.Productive.rel_of_skip h
 
 macro_rules | `(tactic| decreasing_trivial) => `(tactic|
-  exact Iter.TerminationMeasures.Productive.rel_of_skip ‹_›)
+  first
+    | exact Iter.TerminationMeasures.Productive.rel_of_skip ‹_›
+    | fail)
 
 instance [Iterator α m β] [Finite α m] : Productive α m where
   wf := by

src/Init/Data/Iterators/Consumers.lean

@@ -0,0 +1,13 @@
+/-
+Copyright (c) 2025 Lean FRO, LLC. All rights reserved.
+Released under Apache 2.0 license as described in the file LICENSE.
+Authors: Paul Reichert
+-/
+module
+
+prelude
+import Init.Data.Iterators.Consumers.Monadic
+import Init.Data.Iterators.Consumers.Access
+import Init.Data.Iterators.Consumers.Collect
+import Init.Data.Iterators.Consumers.Loop
+import Init.Data.Iterators.Consumers.Partial

src/Init/Data/Iterators/Consumers/Access.lean

@@ -3,8 +3,10 @@ Copyright (c) 2025 Lean FRO, LLC. All rights reserved.
 Released under Apache 2.0 license as described in the file LICENSE.
 Authors: Paul Reichert
 -/
+module
+
 prelude
-import Std.Data.Iterators.Consumers.Partial
+import Init.Data.Iterators.Consumers.Partial
 
 namespace Std.Iterators
 

src/Init/Data/Iterators/Consumers/Collect.lean

@@ -3,10 +3,12 @@ Copyright (c) 2025 Lean FRO, LLC. All rights reserved.
 Released under Apache 2.0 license as described in the file LICENSE.
 Authors: Paul Reichert
 -/
+module
+
 prelude
-import Std.Data.Iterators.Basic
-import Std.Data.Iterators.Consumers.Partial
-import Std.Data.Iterators.Consumers.Monadic.Collect
+import Init.Data.Iterators.Basic
+import Init.Data.Iterators.Consumers.Partial
+import Init.Data.Iterators.Consumers.Monadic.Collect
 
 /-!
 # Collectors

src/Init/Data/Iterators/Consumers/Loop.lean

@@ -3,9 +3,11 @@ Copyright (c) 2025 Lean FRO, LLC. All rights reserved.
 Released under Apache 2.0 license as described in the file LICENSE.
 Authors: Paul Reichert
 -/
+module
+
 prelude
-import Std.Data.Iterators.Consumers.Monadic.Loop
-import Std.Data.Iterators.Consumers.Partial
+import Init.Data.Iterators.Consumers.Monadic.Loop
+import Init.Data.Iterators.Consumers.Partial
 
 /-!
 # Loop consumers

src/Init/Data/Iterators/Consumers/Monadic.lean

@@ -0,0 +1,11 @@
+/-
+Copyright (c) 2025 Lean FRO, LLC. All rights reserved.
+Released under Apache 2.0 license as described in the file LICENSE.
+Authors: Paul Reichert
+-/
+module
+
+prelude
+import Init.Data.Iterators.Consumers.Monadic.Collect
+import Init.Data.Iterators.Consumers.Monadic.Loop
+import Init.Data.Iterators.Consumers.Monadic.Partial

src/Init/Data/Iterators/Consumers/Monadic/Collect.lean

@@ -3,9 +3,11 @@ Copyright (c) 2025 Lean FRO, LLC. All rights reserved.
 Released under Apache 2.0 license as described in the file LICENSE.
 Authors: Paul Reichert
 -/
+module
+
 prelude
-import Std.Data.Iterators.Consumers.Monadic.Partial
-import Std.Data.Internal.LawfulMonadLiftFunction
+import Init.Data.Iterators.Consumers.Monadic.Partial
+import Init.Data.Iterators.Internal.LawfulMonadLiftFunction
 
 /-!
 # Collectors

src/Init/Data/Iterators/Consumers/Monadic/Loop.lean

@@ -3,10 +3,12 @@ Copyright (c) 2025 Lean FRO, LLC. All rights reserved.
 Released under Apache 2.0 license as described in the file LICENSE.
 Authors: Paul Reichert
 -/
+module
+
 prelude
 import Init.RCases
-import Std.Data.Iterators.Basic
-import Std.Data.Iterators.Consumers.Monadic.Partial
+import Init.Data.Iterators.Basic
+import Init.Data.Iterators.Consumers.Monadic.Partial
 
 /-!
 # Loop-based consumers
@@ -62,8 +64,9 @@ class IteratorLoop (α : Type w) (m : Type w → Type w') {β : Type w} [Iterato
   forIn : ∀ (_lift : (γ : Type w) → m γ → n γ) (γ : Type w),
       (plausible_forInStep : β → γ → ForInStep γ → Prop) →
       IteratorLoop.WellFounded α m plausible_forInStep →
-      IterM (α := α) m β → γ →
-      ((b : β) → (c : γ) → n (Subtype (plausible_forInStep b c))) → n γ
+      (it : IterM (α := α) m β) → γ →
+      ((b : β) → (c : γ) → n (Subtype (plausible_forInStep b c))) →
+      n γ
 
 /--
 `IteratorLoopPartial α m` provides efficient implementations of loop-based consumers for `α`-based
@@ -76,7 +79,8 @@ provided by the standard library.
 class IteratorLoopPartial (α : Type w) (m : Type w → Type w') {β : Type w} [Iterator α m β]
     (n : Type w → Type w'') where
   forInPartial : ∀ (_lift : (γ : Type w) → m γ → n γ) {γ : Type w},
-      IterM (α := α) m β → γ → ((b : β) → (c : γ) → n (ForInStep γ)) → n γ
+      (it : IterM (α := α) m β) → γ →
+      ((b : β) → (c : γ) → n (ForInStep γ)) → n γ
 
 end Typeclasses
 
@@ -91,7 +95,7 @@ private def IteratorLoop.WFRel.mk {α : Type w} {m : Type w → Type w'} {β : T
     IteratorLoop.WFRel wf :=
   (it, c)
 
-instance {α : Type w} {m : Type w → Type w'} {β : Type w} [Iterator α m β]
+private instance {α : Type w} {m : Type w → Type w'} {β : Type w} [Iterator α m β]
     {γ : Type x} {plausible_forInStep : β → γ → ForInStep γ → Prop}
     (wf : IteratorLoop.WellFounded α m plausible_forInStep) :
     WellFoundedRelation (IteratorLoop.WFRel wf) where
@@ -116,9 +120,13 @@ def IterM.DefaultConsumers.forIn {m : Type w → Type w'} {α : Type w} {β : Ty
     match ← it.step with
     | .yield it' out _ =>
       match ← f out init with
-      | ⟨.yield c, _⟩ => IterM.DefaultConsumers.forIn lift _ plausible_forInStep wf it' c f
+      | ⟨.yield c, _⟩ =>
+        IterM.DefaultConsumers.forIn lift _ plausible_forInStep wf it' c
+          (fun out acc => f out acc)
       | ⟨.done c, _⟩ => return c
-    | .skip it' _ => IterM.DefaultConsumers.forIn lift _ plausible_forInStep wf it' init f
+    | .skip it' _ =>
+      IterM.DefaultConsumers.forIn lift _ plausible_forInStep wf it' init
+        (fun out acc => f out acc)
     | .done _ => return init
 termination_by IteratorLoop.WFRel.mk wf it init
 decreasing_by
@@ -159,9 +167,13 @@ partial def IterM.DefaultConsumers.forInPartial {m : Type w → Type w'} {α : T
     match ← it.step with
     | .yield it' out _ =>
       match ← f out init with
-      | .yield c => IterM.DefaultConsumers.forInPartial lift _ it' c f
+      | .yield c =>
+        IterM.DefaultConsumers.forInPartial lift _ it' c
+          fun out acc => f out acc
       | .done c => return c
-    | .skip it' _ => IterM.DefaultConsumers.forInPartial lift _ it' init f
+    | .skip it' _ =>
+      IterM.DefaultConsumers.forInPartial lift _ it' init
+        fun out acc => f out acc
     | .done _ => return init
 
 /--
@@ -206,12 +218,13 @@ def IteratorLoop.finiteForIn {m : Type w → Type w'} {n : Type w → Type w''}
   forIn {γ} [Monad n] it init f :=
     IteratorLoop.forIn (α := α) (m := m) lift γ (fun _ _ _ => True)
       wellFounded_of_finite
-      it init ((⟨·, .intro⟩) <$> f · ·)
+      it init (fun out acc => (⟨·, .intro⟩) <$> f out acc)
 
 instance {m : Type w → Type w'} {n : Type w → Type w''}
     {α : Type w} {β : Type w} [Iterator α m β] [Finite α m] [IteratorLoop α m n]
     [MonadLiftT m n] :
-    ForIn n (IterM (α := α) m β) β := IteratorLoop.finiteForIn (fun _ => monadLift)
+    ForIn n (IterM (α := α) m β) β :=
+  IteratorLoop.finiteForIn (fun _ => monadLift)
 
 instance {m : Type w → Type w'} {n : Type w → Type w''}
     {α : Type w} {β : Type w} [Iterator α m β] [IteratorLoopPartial α m n] [MonadLiftT m n] :

src/Init/Data/Iterators/Consumers/Monadic/Partial.lean

@@ -3,8 +3,10 @@ Copyright (c) 2025 Lean FRO, LLC. All rights reserved.
 Released under Apache 2.0 license as described in the file LICENSE.
 Authors: Paul Reichert
 -/
+module
+
 prelude
-import Std.Data.Iterators.Basic
+import Init.Data.Iterators.Basic
 
 namespace Std.Iterators
 

src/Init/Data/Iterators/Consumers/Partial.lean

@@ -3,8 +3,10 @@ Copyright (c) 2025 Lean FRO, LLC. All rights reserved.
 Released under Apache 2.0 license as described in the file LICENSE.
 Authors: Paul Reichert
 -/
+module
+
 prelude
-import Std.Data.Iterators.Basic
+import Init.Data.Iterators.Basic
 
 namespace Std.Iterators
 

src/Init/Data/Iterators/Internal.lean

@@ -0,0 +1,10 @@
+/-
+Copyright (c) 2025 Lean FRO, LLC. All rights reserved.
+Released under Apache 2.0 license as described in the file LICENSE.
+Authors: Paul Reichert
+-/
+module
+
+prelude
+import Init.Data.Iterators.Internal.LawfulMonadLiftFunction
+import Init.Data.Iterators.Internal.Termination

src/Init/Data/Iterators/Internal/LawfulMonadLiftFunction.lean

@@ -3,6 +3,8 @@ Copyright (c) 2025 Lean FRO, LLC. All rights reserved.
 Released under Apache 2.0 license as described in the file LICENSE.
 Authors: Paul Reichert
 -/
+module
+
 prelude
 import Init.Control.Basic
 import Init.Control.Lawful.Basic

src/Init/Data/Iterators/Internal/Termination.lean

@@ -3,8 +3,10 @@ Copyright (c) 2025 Lean FRO, LLC. All rights reserved.
 Released under Apache 2.0 license as described in the file LICENSE.
 Authors: Paul Reichert
 -/
+module
+
 prelude
-import Std.Data.Iterators.Basic
+import Init.Data.Iterators.Basic
 
 /-!
 This is an internal module used by iterator implementations.

src/Init/Data/Iterators/Lemmas.lean

@@ -3,5 +3,7 @@ Copyright (c) 2025 Lean FRO, LLC. All rights reserved.
 Released under Apache 2.0 license as described in the file LICENSE.
 Authors: Paul Reichert
 -/
+module
+
 prelude
-import Std.Data.Iterators.Internal.Termination
+import Init.Data.Iterators.Lemmas.Consumers

src/Init/Data/Iterators/Lemmas/Basic.lean

@@ -3,8 +3,10 @@ Copyright (c) 2025 Lean FRO, LLC. All rights reserved.
 Released under Apache 2.0 license as described in the file LICENSE.
 Authors: Paul Reichert
 -/
+module
+
 prelude
-import Std.Data.Iterators.Basic
+import Init.Data.Iterators.Basic
 
 namespace Std.Iterators
 

src/Init/Data/Iterators/Lemmas/Consumers.lean

@@ -0,0 +1,11 @@
+/-
+Copyright (c) 2025 Lean FRO, LLC. All rights reserved.
+Released under Apache 2.0 license as described in the file LICENSE.
+Authors: Paul Reichert
+-/
+module
+
+prelude
+import Init.Data.Iterators.Lemmas.Consumers.Monadic
+import Init.Data.Iterators.Lemmas.Consumers.Collect
+import Init.Data.Iterators.Lemmas.Consumers.Loop

src/Init/Data/Iterators/Lemmas/Consumers/Collect.lean

@@ -0,0 +1,114 @@
+/-
+Copyright (c) 2025 Lean FRO, LLC. All rights reserved.
+Released under Apache 2.0 license as described in the file LICENSE.
+Authors: Paul Reichert
+-/
+module
+
+prelude
+import Init.Data.Iterators.Lemmas.Basic
+import Init.Data.Iterators.Lemmas.Consumers.Monadic.Collect
+import all Init.Data.Iterators.Consumers.Access
+import all Init.Data.Iterators.Consumers.Collect
+
+namespace Std.Iterators
+
+theorem Iter.toArray_eq_toArray_toIterM {α β} [Iterator α Id β] [Finite α Id] [IteratorCollect α Id Id]
+    [LawfulIteratorCollect α Id Id] {it : Iter (α := α) β} :
+    it.toArray = it.toIterM.toArray.run :=
+  (rfl)
+
+theorem Iter.toList_eq_toList_toIterM {α β} [Iterator α Id β] [Finite α Id] [IteratorCollect α Id Id]
+    [LawfulIteratorCollect α Id Id] {it : Iter (α := α) β} :
+    it.toList = it.toIterM.toList.run :=
+  (rfl)
+
+theorem Iter.toListRev_eq_toListRev_toIterM {α β} [Iterator α Id β] [Finite α Id]
+    {it : Iter (α := α) β} :
+    it.toListRev = it.toIterM.toListRev.run :=
+  (rfl)
+
+@[simp]
+theorem IterM.toList_toIter {α β} [Iterator α Id β] [Finite α Id] [IteratorCollect α Id Id]
+    {it : IterM (α := α) Id β} :
+    it.toIter.toList = it.toList.run :=
+  (rfl)
+
+@[simp]
+theorem IterM.toListRev_toIter {α β} [Iterator α Id β] [Finite α Id]
+    {it : IterM (α := α) Id β} :
+    it.toIter.toListRev = it.toListRev.run :=
+  (rfl)
+
+theorem Iter.toList_toArray {α β} [Iterator α Id β] [Finite α Id] [IteratorCollect α Id Id]
+    [LawfulIteratorCollect α Id Id] {it : Iter (α := α) β} :
+    it.toArray.toList = it.toList := by
+  simp [toArray_eq_toArray_toIterM, toList_eq_toList_toIterM, ← IterM.toList_toArray]
+
+theorem Iter.toArray_toList {α β} [Iterator α Id β] [Finite α Id] [IteratorCollect α Id Id]
+    [LawfulIteratorCollect α Id Id] {it : Iter (α := α) β} :
+    it.toList.toArray = it.toArray := by
+  simp [toArray_eq_toArray_toIterM, toList_eq_toList_toIterM, ← IterM.toArray_toList]
+
+@[simp]
+theorem Iter.reverse_toListRev [Iterator α Id β] [Finite α Id]
+    [IteratorCollect α Id Id] [LawfulIteratorCollect α Id Id]
+    {it : Iter (α := α) β} :
+    it.toListRev.reverse = it.toList := by
+  simp [toListRev_eq_toListRev_toIterM, toList_eq_toList_toIterM, ← IterM.reverse_toListRev]
+
+theorem Iter.toListRev_eq {α β} [Iterator α Id β] [Finite α Id] [IteratorCollect α Id Id]
+    [LawfulIteratorCollect α Id Id] {it : Iter (α := α) β} :
+    it.toListRev = it.toList.reverse := by
+  simp [Iter.toListRev_eq_toListRev_toIterM, Iter.toList_eq_toList_toIterM, IterM.toListRev_eq]
+
+theorem Iter.toArray_eq_match_step {α β} [Iterator α Id β] [Finite α Id] [IteratorCollect α Id Id]
+    [LawfulIteratorCollect α Id Id] {it : Iter (α := α) β} :
+    it.toArray = match it.step with
+      | .yield it' out _ => #[out] ++ it'.toArray
+      | .skip it' _ => it'.toArray
+      | .done _ => #[] := by
+  simp only [Iter.toArray_eq_toArray_toIterM, Iter.step]
+  rw [IterM.toArray_eq_match_step, Id.run_bind]
+  generalize it.toIterM.step.run = step
+  cases step using PlausibleIterStep.casesOn <;> simp
+
+theorem Iter.toList_eq_match_step {α β} [Iterator α Id β] [Finite α Id] [IteratorCollect α Id Id]
+    [LawfulIteratorCollect α Id Id] {it : Iter (α := α) β} :
+    it.toList = match it.step with
+      | .yield it' out _ => out :: it'.toList
+      | .skip it' _ => it'.toList
+      | .done _ => [] := by
+  rw [← Iter.toList_toArray, Iter.toArray_eq_match_step]
+  split <;> simp [Iter.toList_toArray]
+
+theorem Iter.toListRev_eq_match_step {α β} [Iterator α Id β] [Finite α Id] {it : Iter (α := α) β} :
+    it.toListRev = match it.step with
+      | .yield it' out _ => it'.toListRev ++ [out]
+      | .skip it' _ => it'.toListRev
+      | .done _ => [] := by
+  rw [Iter.toListRev_eq_toListRev_toIterM, IterM.toListRev_eq_match_step, Iter.step, Id.run_bind]
+  generalize it.toIterM.step.run = step
+  cases step using PlausibleIterStep.casesOn <;> simp
+
+theorem Iter.getElem?_toList_eq_atIdxSlow? {α β}
+    [Iterator α Id β] [Finite α Id] [IteratorCollect α Id Id] [LawfulIteratorCollect α Id Id]
+    {it : Iter (α := α) β} {k : Nat} :
+    it.toList[k]? = it.atIdxSlow? k := by
+  induction it using Iter.inductSteps generalizing k with | step it ihy ihs =>
+  rw [toList_eq_match_step, atIdxSlow?]
+  obtain ⟨step, h⟩ := it.step
+  cases step
+  · cases k <;> simp [ihy h]
+  · simp [ihs h]
+  · simp
+
+theorem Iter.toList_eq_of_atIdxSlow?_eq {α₁ α₂ β}
+    [Iterator α₁ Id β] [Finite α₁ Id] [IteratorCollect α₁ Id Id] [LawfulIteratorCollect α₁ Id Id]
+    [Iterator α₂ Id β] [Finite α₂ Id] [IteratorCollect α₂ Id Id] [LawfulIteratorCollect α₂ Id Id]
+    {it₁ : Iter (α := α₁) β} {it₂ : Iter (α := α₂) β}
+    (h : ∀ k, it₁.atIdxSlow? k = it₂.atIdxSlow? k) :
+    it₁.toList = it₂.toList := by
+  ext; simp [getElem?_toList_eq_atIdxSlow?, h]
+
+end Std.Iterators

src/Init/Data/Iterators/Lemmas/Consumers/Loop.lean

@@ -0,0 +1,180 @@
+/-
+Copyright (c) 2025 Lean FRO, LLC. All rights reserved.
+Released under Apache 2.0 license as described in the file LICENSE.
+Authors: Paul Reichert
+-/
+module
+
+prelude
+import Init.Data.Iterators.Lemmas.Consumers.Collect
+import all Init.Data.Iterators.Lemmas.Consumers.Monadic.Loop
+import all Init.Data.Iterators.Consumers.Loop
+
+namespace Std.Iterators
+
+theorem Iter.forIn_eq {α β : Type w} [Iterator α Id β] [Finite α Id]
+    {m : Type w → Type w''} [Monad m] [IteratorLoop α Id m] [hl : LawfulIteratorLoop α Id m]
+    {γ : Type w} {it : Iter (α := α) β} {init : γ}
+    {f : (b : β) → γ → m (ForInStep γ)} :
+    ForIn.forIn it init f =
+      IterM.DefaultConsumers.forIn (fun _ c => pure c.run) γ (fun _ _ _ => True)
+        IteratorLoop.wellFounded_of_finite it.toIterM init
+          (fun out acc => (⟨·, .intro⟩) <$>
+            f out acc) := by
+  cases hl.lawful; rfl
+
+theorem Iter.forIn_eq_forIn_toIterM {α β : Type w} [Iterator α Id β]
+    [Finite α Id] {m : Type w → Type w''} [Monad m] [LawfulMonad m]
+    [IteratorLoop α Id m] [LawfulIteratorLoop α Id m]
+    {γ : Type w} {it : Iter (α := α) β} {init : γ}
+    {f : β → γ → m (ForInStep γ)} :
+    ForIn.forIn it init f =
+      letI : MonadLift Id m := ⟨Std.Internal.idToMonad (α := _)⟩
+      ForIn.forIn it.toIterM init f := by
+  rfl
+
+theorem Iter.forIn_eq_match_step {α β : Type w} [Iterator α Id β]
+    [Finite α Id] {m : Type w → Type w''} [Monad m] [LawfulMonad m]
+    [IteratorLoop α Id m] [LawfulIteratorLoop α Id m]
+    {γ : Type w} {it : Iter (α := α) β} {init : γ}
+    {f : β → γ → m (ForInStep γ)} :
+    ForIn.forIn it init f = (do
+      match it.step with
+      | .yield it' out _ =>
+        match ← f out init with
+        | .yield c => ForIn.forIn it' c f
+        | .done c => return c
+      | .skip it' _ => ForIn.forIn it' init f
+      | .done _ => return init) := by
+  rw [Iter.forIn_eq_forIn_toIterM, @IterM.forIn_eq_match_step, Iter.step]
+  simp only [liftM, monadLift, pure_bind]
+  generalize it.toIterM.step = step
+  cases step using PlausibleIterStep.casesOn
+  · apply bind_congr
+    intro forInStep
+    rfl
+  · rfl
+  · rfl
+
+theorem Iter.forIn_toList {α β : Type w} [Iterator α Id β]
+    [Finite α Id] {m : Type w → Type w''} [Monad m] [LawfulMonad m]
+    [IteratorLoop α Id m] [LawfulIteratorLoop α Id m]
+    [IteratorCollect α Id Id] [LawfulIteratorCollect α Id Id]
+    {γ : Type w} {it : Iter (α := α) β} {init : γ}
+    {f : β → γ → m (ForInStep γ)} :
+    ForIn.forIn it.toList init f = ForIn.forIn it init f := by
+  rw [List.forIn_eq_foldlM]
+  induction it using Iter.inductSteps generalizing init with case step it ihy ihs =>
+  rw [forIn_eq_match_step, Iter.toList_eq_match_step]
+  simp only [map_eq_pure_bind]
+  generalize it.step = step
+  cases step using PlausibleIterStep.casesOn
+  · rename_i it' out h
+    simp only [List.foldlM_cons, bind_pure_comp, map_bind]
+    apply bind_congr
+    intro forInStep
+    cases forInStep
+    · induction it'.toList <;> simp [*]
+    · simp only [ForIn.forIn, forIn', List.forIn'] at ihy
+      simp [ihy h, forIn_eq_forIn_toIterM]
+  · rename_i it' h
+    simp only [bind_pure_comp]
+    rw [ihs h]
+  · simp
+
+theorem Iter.foldM_eq_forIn {α β γ : Type w} [Iterator α Id β] [Finite α Id] {m : Type w → Type w'}
+    [Monad m] [IteratorLoop α Id m] {f : γ → β → m γ}
+    {init : γ} {it : Iter (α := α) β} :
+    it.foldM (init := init) f = ForIn.forIn it init (fun x acc => ForInStep.yield <$> f acc x) :=
+  (rfl)
+
+theorem Iter.foldM_eq_foldM_toIterM {α β : Type w} [Iterator α Id β]
+    [Finite α Id] {m : Type w → Type w''} [Monad m] [LawfulMonad m]
+    [IteratorLoop α Id m] [LawfulIteratorLoop α Id m]
+    {γ : Type w} {it : Iter (α := α) β} {init : γ} {f : γ → β → m γ} :
+    it.foldM (init := init) f = letI : MonadLift Id m := ⟨pure⟩; it.toIterM.foldM (init := init) f :=
+  (rfl)
+
+theorem Iter.forIn_yield_eq_foldM {α β γ δ : Type w} [Iterator α Id β]
+    [Finite α Id] {m : Type w → Type w''} [Monad m] [LawfulMonad m] [IteratorLoop α Id m]
+    [LawfulIteratorLoop α Id m] {f : β → γ → m δ} {g : β → γ → δ → γ} {init : γ}
+    {it : Iter (α := α) β} :
+    ForIn.forIn it init (fun c b => (fun d => .yield (g c b d)) <$> f c b) =
+      it.foldM (fun b c => g c b <$> f c b) init := by
+  simp [Iter.foldM_eq_forIn]
+
+theorem Iter.foldM_eq_match_step {α β γ : Type w} [Iterator α Id β] [Finite α Id]
+    {m : Type w → Type w'} [Monad m] [LawfulMonad m] [IteratorLoop α Id m]
+    [LawfulIteratorLoop α Id m] {f : γ → β → m γ} {init : γ} {it : Iter (α := α) β} :
+    it.foldM (init := init) f = (do
+      match it.step with
+      | .yield it' out _ => it'.foldM (init := ← f init out) f
+      | .skip it' _ => it'.foldM (init := init) f
+      | .done _ => return init) := by
+  rw [Iter.foldM_eq_forIn, Iter.forIn_eq_match_step]
+  generalize it.step = step
+  cases step using PlausibleIterStep.casesOn <;> simp [foldM_eq_forIn]
+
+theorem Iter.foldlM_toList {α β γ : Type w} [Iterator α Id β] [Finite α Id] {m : Type w → Type w'}
+    [Monad m] [LawfulMonad m] [IteratorLoop α Id m] [LawfulIteratorLoop α Id m]
+    [IteratorCollect α Id Id] [LawfulIteratorCollect α Id Id]
+    {f : γ → β → m γ}
+    {init : γ} {it : Iter (α := α) β} :
+    it.toList.foldlM (init := init) f = it.foldM (init := init) f := by
+  rw [Iter.foldM_eq_forIn, ← Iter.forIn_toList]
+  simp only [List.forIn_yield_eq_foldlM, id_map']
+
+theorem IterM.forIn_eq_foldM {α β : Type w} [Iterator α Id β]
+    [Finite α Id] {m : Type w → Type w''} [Monad m] [LawfulMonad m]
+    [IteratorLoop α Id m] [LawfulIteratorLoop α Id m]
+    [IteratorCollect α Id Id] [LawfulIteratorCollect α Id Id]
+    {γ : Type w} {it : Iter (α := α) β} {init : γ}
+    {f : β → γ → m (ForInStep γ)} :
+    forIn it init f = ForInStep.value <$>
+      it.foldM (fun c b => match c with
+        | .yield c => f b c
+        | .done c => pure (.done c)) (ForInStep.yield init) := by
+  simp only [← Iter.forIn_toList, List.forIn_eq_foldlM, ← Iter.foldlM_toList]; rfl
+
+theorem Iter.fold_eq_forIn {α β γ : Type w} [Iterator α Id β]
+    [Finite α Id] [IteratorLoop α Id Id] {f : γ → β → γ} {init : γ} {it : Iter (α := α) β} :
+    it.fold (init := init) f =
+      (ForIn.forIn (m := Id) it init (fun x acc => pure (ForInStep.yield (f acc x)))).run := by
+  rfl
+
+theorem Iter.fold_eq_foldM {α β γ : Type w} [Iterator α Id β]
+    [Finite α Id] [IteratorLoop α Id Id] {f : γ → β → γ} {init : γ}
+    {it : Iter (α := α) β} :
+    it.fold (init := init) f = (it.foldM (m := Id) (init := init) (pure <| f · ·)).run := by
+  simp [foldM_eq_forIn, fold_eq_forIn]
+
+@[simp]
+theorem Iter.forIn_pure_yield_eq_fold {α β γ : Type w} [Iterator α Id β]
+    [Finite α Id] [IteratorLoop α Id Id]
+    [LawfulIteratorLoop α Id Id] {f : β → γ → γ} {init : γ}
+    {it : Iter (α := α) β} :
+    ForIn.forIn (m := Id) it init (fun c b => pure (.yield (f c b))) =
+      pure (it.fold (fun b c => f c b) init) := by
+  simp only [fold_eq_forIn]
+  rfl
+
+theorem Iter.fold_eq_match_step {α β γ : Type w} [Iterator α Id β] [Finite α Id]
+    [IteratorLoop α Id Id] [LawfulIteratorLoop α Id Id]
+    {f : γ → β → γ} {init : γ} {it : Iter (α := α) β} :
+    it.fold (init := init) f = (match it.step with
+      | .yield it' out _ => it'.fold (init := f init out) f
+      | .skip it' _ => it'.fold (init := init) f
+      | .done _ => init) := by
+  rw [fold_eq_foldM, foldM_eq_match_step]
+  simp only [fold_eq_foldM]
+  generalize it.step = step
+  cases step using PlausibleIterStep.casesOn <;> simp
+
+theorem Iter.foldl_toList {α β γ : Type w} [Iterator α Id β] [Finite α Id]
+    [IteratorLoop α Id Id] [LawfulIteratorLoop α Id Id]
+    [IteratorCollect α Id Id] [LawfulIteratorCollect α Id Id]
+    {f : γ → β → γ} {init : γ} {it : Iter (α := α) β} :
+    it.toList.foldl (init := init) f = it.fold (init := init) f := by
+  rw [fold_eq_foldM, List.foldl_eq_foldlM, ← Iter.foldlM_toList]
+
+end Std.Iterators

src/Init/Data/Iterators/Lemmas/Consumers/Monadic.lean

@@ -3,7 +3,8 @@ Copyright (c) 2025 Lean FRO, LLC. All rights reserved.
 Released under Apache 2.0 license as described in the file LICENSE.
 Authors: Paul Reichert
 -/
+module
+
 prelude
-import Std.Data.Iterators.Consumers.Monadic.Collect
-import Std.Data.Iterators.Consumers.Monadic.Loop
-import Std.Data.Iterators.Consumers.Monadic.Partial
+import Init.Data.Iterators.Lemmas.Consumers.Monadic.Collect
+import Init.Data.Iterators.Lemmas.Consumers.Monadic.Loop

src/Init/Data/Iterators/Lemmas/Consumers/Monadic/Collect.lean

@@ -0,0 +1,157 @@
+/-
+Copyright (c) 2025 Lean FRO, LLC. All rights reserved.
+Released under Apache 2.0 license as described in the file LICENSE.
+Authors: Paul Reichert
+-/
+module
+
+prelude
+import Init.Data.Array.Lemmas
+import Init.Data.Iterators.Lemmas.Monadic.Basic
+import all Init.Data.Iterators.Consumers.Monadic.Collect
+
+namespace Std.Iterators
+
+variable {α β γ : Type w} {m : Type w → Type w'} {n : Type w → Type w''}
+  {lift : ⦃δ : Type w⦄ → m δ → n δ} {f : β → n γ} {it : IterM (α := α) m β}
+
+theorem IterM.DefaultConsumers.toArrayMapped.go.aux₁ [Monad n] [LawfulMonad n] [Iterator α m β]
+    [Finite α m] {b : γ} {bs : Array γ} :
+    IterM.DefaultConsumers.toArrayMapped.go lift f it (#[b] ++ bs) (m := m) =
+      (#[b] ++ ·) <$> IterM.DefaultConsumers.toArrayMapped.go lift f it bs (m := m) := by
+  induction it, bs using IterM.DefaultConsumers.toArrayMapped.go.induct
+  next it bs ih₁ ih₂ =>
+  rw [go, map_eq_pure_bind, go, bind_assoc]
+  apply bind_congr
+  intro step
+  split
+  · simp [ih₁ _ _ ‹_›]
+  · simp [ih₂ _ ‹_›]
+  · simp
+
+theorem IterM.DefaultConsumers.toArrayMapped.go.aux₂ [Monad n] [LawfulMonad n] [Iterator α m β]
+    [Finite α m] {acc : Array γ} :
+    IterM.DefaultConsumers.toArrayMapped.go lift f it acc (m := m) =
+      (acc ++ ·) <$> IterM.DefaultConsumers.toArrayMapped lift f it (m := m) := by
+  rw [← Array.toArray_toList (xs := acc)]
+  generalize acc.toList = acc
+  induction acc with
+  | nil => simp [toArrayMapped]
+  | cons x xs ih =>
+    rw [List.toArray_cons, IterM.DefaultConsumers.toArrayMapped.go.aux₁, ih]
+    simp only [Functor.map_map, Array.append_assoc]
+
+theorem IterM.DefaultConsumers.toArrayMapped_eq_match_step [Monad n] [LawfulMonad n]
+    [Iterator α m β] [Finite α m] :
+    IterM.DefaultConsumers.toArrayMapped lift f it (m := m) = letI : MonadLift m n := ⟨lift (δ := _)⟩; (do
+      match ← it.step with
+      | .yield it' out _ =>
+        return #[← f out] ++ (← IterM.DefaultConsumers.toArrayMapped lift f it' (m := m))
+      | .skip it' _ => IterM.DefaultConsumers.toArrayMapped lift f it' (m := m)
+      | .done _ => return #[]) := by
+  rw [IterM.DefaultConsumers.toArrayMapped, IterM.DefaultConsumers.toArrayMapped.go]
+  apply bind_congr
+  intro step
+  split <;> simp [IterM.DefaultConsumers.toArrayMapped.go.aux₂]
+
+theorem IterM.toArray_eq_match_step [Monad m] [LawfulMonad m] [Iterator α m β] [Finite α m]
+    [IteratorCollect α m m] [LawfulIteratorCollect α m m] :
+    it.toArray = (do
+      match ← it.step with
+      | .yield it' out _ => return #[out] ++ (← it'.toArray)
+      | .skip it' _ => it'.toArray
+      | .done _ => return #[]) := by
+  simp only [IterM.toArray, LawfulIteratorCollect.toArrayMapped_eq]
+  rw [IterM.DefaultConsumers.toArrayMapped_eq_match_step]
+  simp [bind_pure_comp, pure_bind, toArray]
+
+theorem IterM.toList_toArray [Monad m] [Iterator α m β] [Finite α m] [IteratorCollect α m m]
+    {it : IterM (α := α) m β} :
+    Array.toList <$> it.toArray = it.toList := by
+  simp [IterM.toList]
+
+theorem IterM.toArray_toList [Monad m] [LawfulMonad m] [Iterator α m β] [Finite α m]
+    [IteratorCollect α m m] {it : IterM (α := α) m β} :
+    List.toArray <$> it.toList = it.toArray := by
+  simp [IterM.toList]
+
+theorem IterM.toList_eq_match_step [Monad m] [LawfulMonad m] [Iterator α m β] [Finite α m]
+    [IteratorCollect α m m] [LawfulIteratorCollect α m m] {it : IterM (α := α) m β} :
+    it.toList = (do
+      match ← it.step with
+      | .yield it' out _ => return out :: (← it'.toList)
+      | .skip it' _ => it'.toList
+      | .done _ => return []) := by
+  simp [← IterM.toList_toArray]
+  rw [IterM.toArray_eq_match_step, map_eq_pure_bind, bind_assoc]
+  apply bind_congr
+  intro step
+  split <;> simp
+
+theorem IterM.toListRev.go.aux₁ [Monad m] [LawfulMonad m] [Iterator α m β] [Finite α m]
+    {it : IterM (α := α) m β} {b : β} {bs : List β} :
+    IterM.toListRev.go it (bs ++ [b]) = (· ++ [b]) <$> IterM.toListRev.go it bs:= by
+  induction it, bs using IterM.toListRev.go.induct
+  next it bs ih₁ ih₂ =>
+  rw [go, go, map_eq_pure_bind, bind_assoc]
+  apply bind_congr
+  intro step
+  simp only [List.cons_append] at ih₁
+  split <;> simp [*]
+
+theorem IterM.toListRev.go.aux₂ [Monad m] [LawfulMonad m] [Iterator α m β] [Finite α m]
+    {it : IterM (α := α) m β} {acc : List β} :
+    IterM.toListRev.go it acc = (· ++ acc) <$> it.toListRev := by
+  rw [← List.reverse_reverse (as := acc)]
+  generalize acc.reverse = acc
+  induction acc with
+  | nil => simp [toListRev]
+  | cons x xs ih => simp [IterM.toListRev.go.aux₁, ih]
+
+theorem IterM.toListRev_eq_match_step [Monad m] [LawfulMonad m] [Iterator α m β] [Finite α m]
+    {it : IterM (α := α) m β} :
+    it.toListRev = (do
+      match ← it.step with
+      | .yield it' out _ => return (← it'.toListRev) ++ [out]
+      | .skip it' _ => it'.toListRev
+      | .done _ => return []) := by
+  simp [IterM.toListRev]
+  rw [toListRev.go]
+  apply bind_congr
+  intro step
+  cases step using PlausibleIterStep.casesOn <;> simp [IterM.toListRev.go.aux₂]
+
+theorem IterM.reverse_toListRev [Monad m] [LawfulMonad m] [Iterator α m β] [Finite α m]
+    [IteratorCollect α m m] [LawfulIteratorCollect α m m]
+    {it : IterM (α := α) m β} :
+    List.reverse <$> it.toListRev = it.toList := by
+  apply Eq.symm
+  induction it using IterM.inductSteps
+  rename_i it ihy ihs
+  rw [toListRev_eq_match_step, toList_eq_match_step, map_eq_pure_bind, bind_assoc]
+  apply bind_congr
+  intro step
+  split <;> simp (discharger := assumption) [ihy, ihs]
+
+theorem IterM.toListRev_eq [Monad m] [LawfulMonad m] [Iterator α m β] [Finite α m]
+    [IteratorCollect α m m] [LawfulIteratorCollect α m m]
+    {it : IterM (α := α) m β} :
+    it.toListRev = List.reverse <$> it.toList := by
+  rw [← IterM.reverse_toListRev]
+  simp
+
+theorem LawfulIteratorCollect.toArray_eq {α β : Type w} {m : Type w → Type w'}
+    [Monad m] [Iterator α m β] [Finite α m] [IteratorCollect α m m]
+    [hl : LawfulIteratorCollect α m m]
+    {it : IterM (α := α) m β} :
+    it.toArray = (letI : IteratorCollect α m m := .defaultImplementation; it.toArray) := by
+  simp only [IterM.toArray, toArrayMapped_eq]
+
+theorem LawfulIteratorCollect.toList_eq {α β : Type w} {m : Type w → Type w'}
+    [Monad m] [Iterator α m β] [Finite α m] [IteratorCollect α m m]
+    [hl : LawfulIteratorCollect α m m]
+    {it : IterM (α := α) m β} :
+    it.toList = (letI : IteratorCollect α m m := .defaultImplementation; it.toList) := by
+  simp [IterM.toList, toArray_eq]
+
+end Std.Iterators

src/Init/Data/Iterators/Lemmas/Consumers/Monadic/Loop.lean

@@ -0,0 +1,239 @@
+/-
+Copyright (c) 2025 Lean FRO, LLC. All rights reserved.
+Released under Apache 2.0 license as described in the file LICENSE.
+Authors: Paul Reichert
+-/
+module
+
+prelude
+import Init.Data.Iterators.Lemmas.Consumers.Monadic.Collect
+import all Init.Data.Iterators.Consumers.Monadic.Loop
+
+namespace Std.Iterators
+
+theorem IterM.DefaultConsumers.forIn_eq_match_step {α β : Type w} {m : Type w → Type w'}
+    [Iterator α m β]
+    {n : Type w → Type w''} [Monad n]
+    {lift : ∀ γ, m γ → n γ} {γ : Type w}
+    {plausible_forInStep : β → γ → ForInStep γ → Prop}
+    {wf : IteratorLoop.WellFounded α m plausible_forInStep}
+    {it : IterM (α := α) m β} {init : γ}
+    {f : (b : β) → (c : γ) → n (Subtype (plausible_forInStep b c))} :
+    IterM.DefaultConsumers.forIn lift γ plausible_forInStep wf it init f = (do
+      match ← lift _ it.step with
+      | .yield it' out _ =>
+        match ← f out init with
+        | ⟨.yield c, _⟩ =>
+          IterM.DefaultConsumers.forIn lift _ plausible_forInStep wf it' c
+            fun out acc => f out acc
+        | ⟨.done c, _⟩ => return c
+      | .skip it' _ =>
+        IterM.DefaultConsumers.forIn lift _ plausible_forInStep wf it' init
+          fun out acc => f out acc
+      | .done _ => return init) := by
+  rw [forIn]
+  apply bind_congr
+  intro step
+  cases step using PlausibleIterStep.casesOn <;> rfl
+
+theorem IterM.forIn_eq {α β : Type w} {m : Type w → Type w'} [Iterator α m β] [Finite α m]
+    {n : Type w → Type w''} [Monad n] [IteratorLoop α m n] [hl : LawfulIteratorLoop α m n]
+    [MonadLiftT m n] {γ : Type w} {it : IterM (α := α) m β} {init : γ}
+    {f : β → γ → n (ForInStep γ)} :
+    ForIn.forIn it init f = IterM.DefaultConsumers.forIn (fun _ => monadLift) γ (fun _ _ _ => True)
+        IteratorLoop.wellFounded_of_finite it init (fun out acc => (⟨·, .intro⟩) <$> f out acc) := by
+  cases hl.lawful; rfl
+
+theorem IterM.forIn_eq_match_step {α β : Type w} {m : Type w → Type w'} [Iterator α m β]
+    [Finite α m] {n : Type w → Type w''} [Monad n] [LawfulMonad n]
+    [IteratorLoop α m n] [LawfulIteratorLoop α m n]
+    [MonadLiftT m n] {γ : Type w} {it : IterM (α := α) m β} {init : γ}
+    {f : β → γ → n (ForInStep γ)} :
+    ForIn.forIn it init f = (do
+      match ← it.step with
+      | .yield it' out _ =>
+        match ← f out init with
+        | .yield c => ForIn.forIn it' c f
+        | .done c => return c
+      | .skip it' _ => ForIn.forIn it' init f
+      | .done _ => return init) := by
+  rw [IterM.forIn_eq, DefaultConsumers.forIn_eq_match_step]
+  apply bind_congr
+  intro step
+  cases step using PlausibleIterStep.casesOn
+  · simp only [map_eq_pure_bind, bind_assoc]
+    apply bind_congr
+    intro forInStep
+    cases forInStep <;> simp [IterM.forIn_eq]
+  · simp [IterM.forIn_eq]
+  · simp
+
+theorem IterM.forM_eq_forIn {α β : Type w} {m : Type w → Type w'} [Iterator α m β]
+    [Finite α m] {n : Type w → Type w''} [Monad n] [LawfulMonad n]
+    [IteratorLoop α m n] [LawfulIteratorLoop α m n]
+    [MonadLiftT m n] {it : IterM (α := α) m β}
+    {f : β → n PUnit} :
+    ForM.forM it f = ForIn.forIn it PUnit.unit (fun out _ => do f out; return .yield .unit) :=
+  rfl
+
+theorem IterM.forM_eq_match_step {α β : Type w} {m : Type w → Type w'} [Iterator α m β]
+    [Finite α m] {n : Type w → Type w''} [Monad n] [LawfulMonad n]
+    [IteratorLoop α m n] [LawfulIteratorLoop α m n]
+    [MonadLiftT m n] {it : IterM (α := α) m β}
+    {f : β → n PUnit} :
+    ForM.forM it f = (do
+      match ← it.step with
+      | .yield it' out _ =>
+        f out
+        ForM.forM it' f
+      | .skip it' _ => ForM.forM it' f
+      | .done _ => return) := by
+  rw [forM_eq_forIn, forIn_eq_match_step]
+  apply bind_congr
+  intro step
+  cases step using PlausibleIterStep.casesOn <;> simp [forM_eq_forIn]
+
+theorem IterM.foldM_eq_forIn {α β γ : Type w} {m : Type w → Type w'} [Iterator α m β] [Finite α m]
+    {n : Type w → Type w''} [Monad n] [IteratorLoop α m n] [MonadLiftT m n] {f : γ → β → n γ}
+    {init : γ} {it : IterM (α := α) m β} :
+    it.foldM (init := init) f = ForIn.forIn it init (fun x acc => ForInStep.yield <$> f acc x) :=
+  (rfl)
+
+theorem IterM.forIn_yield_eq_foldM {α β γ δ : Type w} {m : Type w → Type w'} [Iterator α m β]
+    [Finite α m] {n : Type w → Type w''} [Monad n] [LawfulMonad n] [IteratorLoop α m n]
+    [LawfulIteratorLoop α m n] [MonadLiftT m n] {f : β → γ → n δ} {g : β → γ → δ → γ} {init : γ}
+    {it : IterM (α := α) m β} :
+    ForIn.forIn it init (fun c b => (fun d => .yield (g c b d)) <$> f c b) =
+      it.foldM (fun b c => g c b <$> f c b) init := by
+  simp [IterM.foldM_eq_forIn]
+
+theorem IterM.foldM_eq_match_step {α β γ : Type w} {m : Type w → Type w'} [Iterator α m β] [Finite α m]
+    {n : Type w → Type w''} [Monad n] [LawfulMonad n] [IteratorLoop α m n] [LawfulIteratorLoop α m n]
+    [MonadLiftT m n] {f : γ → β → n γ} {init : γ} {it : IterM (α := α) m β} :
+    it.foldM (init := init) f = (do
+      match ← it.step with
+      | .yield it' out _ => it'.foldM (init := ← f init out) f
+      | .skip it' _ => it'.foldM (init := init) f
+      | .done _ => return init) := by
+  rw [IterM.foldM_eq_forIn, IterM.forIn_eq_match_step]
+  apply bind_congr
+  intro step
+  cases step using PlausibleIterStep.casesOn <;> simp [foldM_eq_forIn]
+
+theorem IterM.fold_eq_forIn {α β γ : Type w} {m : Type w → Type w'} [Iterator α m β]
+    [Finite α m] [Monad m]
+    [IteratorLoop α m m] {f : γ → β → γ} {init : γ} {it : IterM (α := α) m β} :
+    it.fold (init := init) f =
+      ForIn.forIn (m := m) it init (fun x acc => pure (ForInStep.yield (f acc x))) := by
+  rfl
+
+theorem IterM.fold_eq_foldM {α β γ : Type w} {m : Type w → Type w'} [Iterator α m β]
+    [Finite α m] [Monad m] [LawfulMonad m] [IteratorLoop α m m] {f : γ → β → γ} {init : γ}
+    {it : IterM (α := α) m β} :
+    it.fold (init := init) f = it.foldM (init := init) (pure <| f · ·) := by
+  simp [foldM_eq_forIn, fold_eq_forIn]
+
+@[simp]
+theorem IterM.forIn_pure_yield_eq_fold {α β γ : Type w} {m : Type w → Type w'} [Iterator α m β]
+    [Finite α m] [Monad m] [LawfulMonad m] [IteratorLoop α m m]
+    [LawfulIteratorLoop α m m] {f : β → γ → γ} {init : γ}
+    {it : IterM (α := α) m β} :
+    ForIn.forIn it init (fun c b => pure (.yield (f c b))) =
+      it.fold (fun b c => f c b) init := by
+  simp [IterM.fold_eq_forIn]
+
+theorem IterM.fold_eq_match_step {α β γ : Type w} {m : Type w → Type w'} [Iterator α m β] [Finite α m]
+    [Monad m] [LawfulMonad m] [IteratorLoop α m m] [LawfulIteratorLoop α m m]
+    {f : γ → β → γ} {init : γ} {it : IterM (α := α) m β} :
+    it.fold (init := init) f = (do
+      match ← it.step with
+      | .yield it' out _ => it'.fold (init := f init out) f
+      | .skip it' _ => it'.fold (init := init) f
+      | .done _ => return init) := by
+  rw [fold_eq_foldM, foldM_eq_match_step]
+  simp only [fold_eq_foldM]
+  apply bind_congr
+  intro step
+  cases step using PlausibleIterStep.casesOn <;> simp
+
+theorem IterM.toList_eq_fold {α β : Type w} {m : Type w → Type w'} [Iterator α m β]
+    [Finite α m] [Monad m] [LawfulMonad m] [IteratorLoop α m m] [LawfulIteratorLoop α m m]
+    [IteratorCollect α m m] [LawfulIteratorCollect α m m]
+    {it : IterM (α := α) m β} :
+    it.toList = it.fold (init := []) (fun l out => l ++ [out]) := by
+  suffices h : ∀ l' : List β, (l' ++ ·) <$> it.toList =
+      it.fold (init := l') (fun l out => l ++ [out]) by
+    specialize h []
+    simpa using h
+  induction it using IterM.inductSteps with | step it ihy ihs =>
+  intro l'
+  rw [IterM.toList_eq_match_step, IterM.fold_eq_match_step]
+  simp only [map_eq_pure_bind, bind_assoc]
+  apply bind_congr
+  intro step
+  cases step using PlausibleIterStep.casesOn
+  · rename_i it' out h
+    specialize ihy h (l' ++ [out])
+    simpa using ihy
+  · rename_i it' h
+    simp [ihs h]
+  · simp
+
+theorem IterM.drain_eq_fold {α β : Type w} {m : Type w → Type w'} [Iterator α m β] [Finite α m]
+    [Monad m] [IteratorLoop α m m] {it : IterM (α := α) m β} :
+    it.drain = it.fold (init := PUnit.unit) (fun _ _ => .unit) :=
+  (rfl)
+
+theorem IterM.drain_eq_foldM {α β : Type w} {m : Type w → Type w'} [Iterator α m β] [Finite α m]
+    [Monad m] [LawfulMonad m] [IteratorLoop α m m] {it : IterM (α := α) m β} :
+    it.drain = it.foldM (init := PUnit.unit) (fun _ _ => pure .unit) := by
+  simp [IterM.drain_eq_fold, IterM.fold_eq_foldM]
+
+theorem IterM.drain_eq_forIn {α β : Type w} {m : Type w → Type w'}  [Iterator α m β] [Finite α m]
+    [Monad m] [IteratorLoop α m m] {it : IterM (α := α) m β} :
+    it.drain = ForIn.forIn (m := m) it PUnit.unit (fun _ _ => pure (ForInStep.yield .unit)) := by
+  simp [IterM.drain_eq_fold, IterM.fold_eq_forIn]
+
+theorem IterM.drain_eq_match_step {α β : Type w} {m : Type w → Type w'} [Iterator α m β] [Finite α m]
+    [Monad m] [LawfulMonad m] [IteratorLoop α m m] [LawfulIteratorLoop α m m]
+    {it : IterM (α := α) m β} :
+    it.drain = (do
+      match ← it.step with
+      | .yield it' _ _ => it'.drain
+      | .skip it' _ => it'.drain
+      | .done _ => return .unit) := by
+  rw [IterM.drain_eq_fold, IterM.fold_eq_match_step]
+  simp [IterM.drain_eq_fold]
+
+theorem IterM.drain_eq_map_toList {α β : Type w} {m : Type w → Type w'} [Iterator α m β]
+    [Finite α m] [Monad m] [LawfulMonad m] [IteratorLoop α m m] [LawfulIteratorLoop α m m]
+    [IteratorCollect α m m] [LawfulIteratorCollect α m m]
+    {it : IterM (α := α) m β} :
+    it.drain = (fun _ => .unit) <$> it.toList := by
+  induction it using IterM.inductSteps with | step it ihy ihs =>
+  rw [IterM.drain_eq_match_step, IterM.toList_eq_match_step]
+  simp only [map_eq_pure_bind, bind_assoc]
+  apply bind_congr
+  intro step
+  cases step using PlausibleIterStep.casesOn
+  · rename_i it' out h
+    simp [ihy h]
+  · rename_i it' h
+    simp [ihs h]
+  · simp
+
+theorem IterM.drain_eq_map_toListRev {α β : Type w} {m : Type w → Type w'} [Iterator α m β]
+    [Finite α m] [Monad m] [LawfulMonad m] [IteratorLoop α m m] [LawfulIteratorLoop α m m]
+    [IteratorCollect α m m] [LawfulIteratorCollect α m m]
+    {it : IterM (α := α) m β} :
+    it.drain = (fun _ => .unit) <$> it.toListRev := by
+  simp [IterM.drain_eq_map_toList, IterM.toListRev_eq]
+
+theorem IterM.drain_eq_map_toArray {α β : Type w} {m : Type w → Type w'} [Iterator α m β]
+    [Finite α m] [Monad m] [LawfulMonad m] [IteratorLoop α m m] [LawfulIteratorLoop α m m]
+    [IteratorCollect α m m] [LawfulIteratorCollect α m m]
+    {it : IterM (α := α) m β} :
+    it.drain = (fun _ => .unit) <$> it.toList := by
+  simp [IterM.drain_eq_map_toList]
+
+end Std.Iterators

src/Init/Data/Iterators/Lemmas/Monadic/Basic.lean

@@ -3,8 +3,10 @@ Copyright (c) 2025 Lean FRO, LLC. All rights reserved.
 Released under Apache 2.0 license as described in the file LICENSE.
 Authors: Paul Reichert
 -/
+module
+
 prelude
-import Std.Data.Iterators.Basic
+import Init.Data.Iterators.Basic
 
 namespace Std.Iterators
 

src/Init/Data/Iterators/PostconditionMonad.lean

@@ -3,6 +3,8 @@ Copyright (c) 2025 Lean FRO, LLC. All rights reserved.
 Released under Apache 2.0 license as described in the file LICENSE.
 Authors: Paul Reichert
 -/
+module
+
 prelude
 import Init.Control.Lawful.Basic
 import Init.Data.Subtype
@@ -48,6 +50,7 @@ def PostconditionT.lift {α : Type w} {m : Type w → Type w'} [Functor m] (x :
     PostconditionT m α :=
   ⟨fun _ => True, (⟨·, .intro⟩) <$> x⟩
 
+@[always_inline, inline]
 protected def PostconditionT.pure {m : Type w → Type w'} [Pure m] {α : Type w}
     (a : α) : PostconditionT m α :=
   ⟨fun y => a = y, pure <| ⟨a, rfl⟩⟩
@@ -117,16 +120,20 @@ instance {m : Type w → Type w'} [Monad m] : Monad (PostconditionT m) where
   pure := PostconditionT.pure
   bind := PostconditionT.bind
 
-@[simp]
-theorem PostconditionT.computation_pure {m : Type w → Type w'} [Monad m] {α : Type w}
-    {x : α} :
-    (pure x : PostconditionT m α).operation = pure ⟨x, rfl⟩ :=
+theorem PostconditionT.pure_eq_pure {m : Type w → Type w'} [Monad m] {α} {a : α} :
+    pure a = PostconditionT.pure (m := m) a :=
   rfl
 
 @[simp]
 theorem PostconditionT.property_pure {m : Type w → Type w'} [Monad m] {α : Type w}
     {x : α} :
-    (pure x : PostconditionT m α).Property = (x = ·) :=
+    (pure x : PostconditionT m α).Property = (x = ·) := by
+  rfl
+
+@[simp]
+theorem PostconditionT.operation_pure {m : Type w → Type w'} [Monad m] {α : Type w}
+    {x : α} :
+    (pure x : PostconditionT m α).operation = pure ⟨x, property_pure (m := m) ▸ rfl⟩ := by
   rfl
 
 theorem PostconditionT.ext {m : Type w → Type w'} [Monad m] [LawfulMonad m]
@@ -209,12 +216,19 @@ theorem PostconditionT.property_map {m : Type w → Type w'} [Functor m] {α : T
 @[simp]
 theorem PostconditionT.operation_map {m : Type w → Type w'} [Functor m] {α : Type w} {β : Type w}
     {x : PostconditionT m α} {f : α → β} :
-    (x.map f).operation = (fun a => ⟨_, a, rfl⟩) <$> x.operation :=
+    (x.map f).operation =
+      (fun a => ⟨_, (property_map (m := m)).mpr ⟨a.1, rfl, a.2⟩⟩) <$> x.operation := by
   rfl
 
 @[simp]
-theorem PostconditionT.operation_lift {m : Type w →Type w'} [Functor m] {α : Type w}
-    {x : m α} : (lift x : PostconditionT m α).operation = (⟨·, True.intro⟩) <$> x :=
+theorem PostconditionT.property_lift {m : Type w → Type w'} [Functor m] {α : Type w}
+    {x : m α} : (lift x : PostconditionT m α).Property = (fun _ => True) := by
+  rfl
+
+@[simp]
+theorem PostconditionT.operation_lift {m : Type w → Type w'} [Functor m] {α : Type w}
+    {x : m α} : (lift x : PostconditionT m α).operation =
+      (⟨·, property_lift (m := m) ▸ True.intro⟩) <$> x := by
   rfl
 
 end Std.Iterators

src/Init/Data/List/Basic.lean

@@ -673,7 +673,7 @@ instance : Std.Associative (α := List α) (· ++ ·) := ⟨append_assoc⟩
 theorem append_cons (as : List α) (b : α) (bs : List α) : as ++ b :: bs = as ++ [b] ++ bs := by
   simp
 
-@[simp] theorem concat_eq_append {as : List α} {a : α} : as.concat a = as ++ [a] := by
+@[simp, grind =] theorem concat_eq_append {as : List α} {a : α} : as.concat a = as ++ [a] := by
   induction as <;> simp [concat, *]
 
 theorem reverseAux_eq_append {as bs : List α} : reverseAux as bs = reverseAux as [] ++ bs := by

src/Init/Data/List/Count.lean

@@ -64,8 +64,8 @@ theorem length_eq_countP_add_countP (p : α → Bool) {l : List α} : length l =
       · rfl
       · simp [h]
 
-@[grind =]
-theorem countP_eq_length_filter {l : List α} : countP p l = length (filter p l) := by
+@[grind _=_]  -- This to quite aggressive, as it introduces `filter` based reasoning whenever we see `countP`.
+theorem countP_eq_length_filter {l : List α} : countP p l = (filter p l).length := by
   induction l with
   | nil => rfl
   | cons x l ih =>
@@ -82,7 +82,7 @@ theorem countP_le_length : countP p l ≤ l.length := by
   simp only [countP_eq_length_filter]
   apply length_filter_le
 
-@[simp] theorem countP_append {l₁ l₂ : List α} : countP p (l₁ ++ l₂) = countP p l₁ + countP p l₂ := by
+@[simp, grind =] theorem countP_append {l₁ l₂ : List α} : countP p (l₁ ++ l₂) = countP p l₁ + countP p l₂ := by
   simp only [countP_eq_length_filter, filter_append, length_append]
 
 @[simp] theorem countP_pos_iff {p} : 0 < countP p l ↔ ∃ a ∈ l, p a := by
@@ -120,10 +120,24 @@ theorem Sublist.countP_le (s : l₁ <+ l₂) : countP p l₁ ≤ countP p l₂ :
   simp only [countP_eq_length_filter]
   apply s.filter _ |>.length_le
 
+grind_pattern Sublist.countP_le => l₁ <+ l₂, countP p l₁
+grind_pattern Sublist.countP_le => l₁ <+ l₂, countP p l₂
+
 theorem IsPrefix.countP_le (s : l₁ <+: l₂) : countP p l₁ ≤ countP p l₂ := s.sublist.countP_le
+
+grind_pattern IsPrefix.countP_le => l₁ <+: l₂, countP p l₁
+grind_pattern IsPrefix.countP_le => l₁ <+: l₂, countP p l₂
+
 theorem IsSuffix.countP_le (s : l₁ <:+ l₂) : countP p l₁ ≤ countP p l₂ := s.sublist.countP_le
+
+grind_pattern IsSuffix.countP_le => l₁ <:+ l₂, countP p l₁
+grind_pattern IsSuffix.countP_le => l₁ <:+ l₂, countP p l₂
+
 theorem IsInfix.countP_le (s : l₁ <:+: l₂) : countP p l₁ ≤ countP p l₂ := s.sublist.countP_le
 
+grind_pattern IsInfix.countP_le => l₁ <:+: l₂, countP p l₁
+grind_pattern IsInfix.countP_le => l₁ <:+: l₂, countP p l₂
+
 -- See `Init.Data.List.Nat.Count` for `Sublist.le_countP : countP p l₂ - (l₂.length - l₁.length) ≤ countP p l₁`.
 
 @[grind]
@@ -174,7 +188,7 @@ theorem countP_flatMap {p : β → Bool} {l : List α} {f : α → List β} :
     countP p (l.flatMap f) = sum (map (countP p ∘ f) l) := by
   rw [List.flatMap, countP_flatten, map_map]
 
-@[simp] theorem countP_reverse {l : List α} : countP p l.reverse = countP p l := by
+@[simp, grind =] theorem countP_reverse {l : List α} : countP p l.reverse = countP p l := by
   simp [countP_eq_length_filter, filter_reverse]
 
 theorem countP_mono_left (h : ∀ x ∈ l, p x → q x) : countP p l ≤ countP q l := by
@@ -203,18 +217,22 @@ section count
 
 variable [BEq α]
 
-@[simp] theorem count_nil {a : α} : count a [] = 0 := rfl
+@[simp, grind =] theorem count_nil {a : α} : count a [] = 0 := rfl
 
 @[grind]
 theorem count_cons {a b : α} {l : List α} :
     count a (b :: l) = count a l + if b == a then 1 else 0 := by
   simp [count, countP_cons]
 
-@[grind =] theorem count_eq_countP {a : α} {l : List α} : count a l = countP (· == a) l := rfl
+theorem count_eq_countP {a : α} {l : List α} : count a l = countP (· == a) l := rfl
 theorem count_eq_countP' {a : α} : count a = countP (· == a) := by
   funext l
   apply count_eq_countP
 
+@[grind =]
+theorem count_eq_length_filter {a : α} {l : List α} : count a l = (filter (· == a) l).length := by
+  simp [count, countP_eq_length_filter]
+
 @[grind]
 theorem count_tail : ∀ {l : List α} {a : α},
       l.tail.count a = l.count a - if l.head? == some a then 1 else 0
@@ -223,12 +241,28 @@ theorem count_tail : ∀ {l : List α} {a : α},
 
 theorem count_le_length {a : α} {l : List α} : count a l ≤ l.length := countP_le_length
 
+grind_pattern count_le_length => count a l
+
 theorem Sublist.count_le (a : α) (h : l₁ <+ l₂) : count a l₁ ≤ count a l₂ := h.countP_le
 
+grind_pattern Sublist.count_le => l₁ <+ l₂, count a l₁
+grind_pattern Sublist.count_le => l₁ <+ l₂, count a l₂
+
 theorem IsPrefix.count_le (a : α) (h : l₁ <+: l₂) : count a l₁ ≤ count a l₂ := h.sublist.count_le a
+
+grind_pattern IsPrefix.count_le => l₁ <+: l₂, count a l₁
+grind_pattern IsPrefix.count_le => l₁ <+: l₂, count a l₂
+
 theorem IsSuffix.count_le (a : α) (h : l₁ <:+ l₂) : count a l₁ ≤ count a l₂ := h.sublist.count_le a
+
+grind_pattern IsSuffix.count_le => l₁ <:+ l₂, count a l₁
+grind_pattern IsSuffix.count_le => l₁ <:+ l₂, count a l₂
+
 theorem IsInfix.count_le (a : α) (h : l₁ <:+: l₂) : count a l₁ ≤ count a l₂ := h.sublist.count_le a
 
+grind_pattern IsInfix.count_le => l₁ <:+: l₂, count a l₁
+grind_pattern IsInfix.count_le => l₁ <:+: l₂, count a l₂
+
 -- See `Init.Data.List.Nat.Count` for `Sublist.le_count : count a l₂ - (l₂.length - l₁.length) ≤ countP a l₁`.
 
 theorem count_tail_le {a : α} {l : List α} : count a l.tail ≤ count a l :=
@@ -245,10 +279,11 @@ theorem count_singleton {a b : α} : count a [b] = if b == a then 1 else 0 := by
 @[simp, grind =] theorem count_append {a : α} {l₁ l₂ : List α} : count a (l₁ ++ l₂) = count a l₁ + count a l₂ :=
   countP_append
 
+@[grind =]
 theorem count_flatten {a : α} {l : List (List α)} : count a l.flatten = (l.map (count a)).sum := by
   simp only [count_eq_countP, countP_flatten, count_eq_countP']
 
-@[simp] theorem count_reverse {a : α} {l : List α} : count a l.reverse = count a l := by
+@[simp, grind =] theorem count_reverse {a : α} {l : List α} : count a l.reverse = count a l := by
   simp only [count_eq_countP, countP_eq_length_filter, filter_reverse, length_reverse]
 
 @[grind]

src/Init/Data/List/FinRange.lean

@@ -62,7 +62,7 @@ end List
 
 namespace Fin
 
-theorem foldlM_eq_foldlM_finRange [Monad m] (f : α → Fin n → m α) (x : α) :
+@[grind =] theorem foldlM_eq_foldlM_finRange [Monad m] (f : α → Fin n → m α) (x : α) :
     foldlM n f x = (List.finRange n).foldlM f x := by
   induction n generalizing x with
   | zero => simp
@@ -72,21 +72,21 @@ theorem foldlM_eq_foldlM_finRange [Monad m] (f : α → Fin n → m α) (x : α)
     funext y
     simp [ih, List.foldlM_map]
 
-theorem foldrM_eq_foldrM_finRange [Monad m] [LawfulMonad m] (f : Fin n → α → m α) (x : α) :
+@[grind =] theorem foldrM_eq_foldrM_finRange [Monad m] [LawfulMonad m] (f : Fin n → α → m α) (x : α) :
     foldrM n f x = (List.finRange n).foldrM f x := by
   induction n generalizing x with
   | zero => simp
   | succ n ih =>
     simp [foldrM_succ, List.finRange_succ, ih, List.foldrM_map]
 
-theorem foldl_eq_finRange_foldl (f : α → Fin n → α) (x : α) :
+@[grind =] theorem foldl_eq_finRange_foldl (f : α → Fin n → α) (x : α) :
     foldl n f x = (List.finRange n).foldl f x := by
   induction n generalizing x with
   | zero => simp
   | succ n ih =>
     simp [foldl_succ, List.finRange_succ, ih, List.foldl_map]
 
-theorem foldr_eq_finRange_foldr (f : Fin n → α → α) (x : α) :
+@[grind =] theorem foldr_eq_finRange_foldr (f : Fin n → α → α) (x : α) :
     foldr n f x = (List.finRange n).foldr f x := by
   induction n generalizing x with
   | zero => simp

src/Init/Data/List/Lemmas.lean

@@ -109,9 +109,11 @@ abbrev length_eq_zero := @length_eq_zero_iff
 theorem eq_nil_iff_length_eq_zero : l = [] ↔ length l = 0 :=
   length_eq_zero_iff.symm
 
-@[grind →] theorem length_pos_of_mem {a : α} : ∀ {l : List α}, a ∈ l → 0 < length l
+theorem length_pos_of_mem {a : α} : ∀ {l : List α}, a ∈ l → 0 < length l
   | _::_, _ => Nat.zero_lt_succ _
 
+grind_pattern length_pos_of_mem => a ∈ l, length l
+
 theorem exists_mem_of_length_pos : ∀ {l : List α}, 0 < length l → ∃ a, a ∈ l
   | _::_, _ => ⟨_, .head ..⟩
 
@@ -2740,11 +2742,11 @@ def foldlRecOn {motive : β → Sort _} : ∀ (l : List α) (op : β → α →
     foldlRecOn tl op (hl b hb hd mem_cons_self)
       fun y hy x hx => hl y hy x (mem_cons_of_mem hd hx)
 
-@[simp] theorem foldlRecOn_nil {motive : β → Sort _} {op : β → α → β} (hb : motive b)
+@[simp, grind =] theorem foldlRecOn_nil {motive : β → Sort _} {op : β → α → β} (hb : motive b)
     (hl : ∀ (b : β) (_ : motive b) (a : α) (_ : a ∈ []), motive (op b a)) :
     foldlRecOn [] op hb hl = hb := rfl
 
-@[simp] theorem foldlRecOn_cons {motive : β → Sort _} {op : β → α → β} (hb : motive b)
+@[simp, grind =] theorem foldlRecOn_cons {motive : β → Sort _} {op : β → α → β} (hb : motive b)
     (hl : ∀ (b : β) (_ : motive b) (a : α) (_ : a ∈ x :: l), motive (op b a)) :
     foldlRecOn (x :: l) op hb hl =
       foldlRecOn l op (hl b hb x mem_cons_self)
@@ -2775,11 +2777,11 @@ def foldrRecOn {motive : β → Sort _} : ∀ (l : List α) (op : α → β →
     hl (foldr op b l)
       (foldrRecOn l op hb fun b c a m => hl b c a (mem_cons_of_mem x m)) x mem_cons_self
 
-@[simp] theorem foldrRecOn_nil {motive : β → Sort _} {op : α → β → β} (hb : motive b)
+@[simp, grind =] theorem foldrRecOn_nil {motive : β → Sort _} {op : α → β → β} (hb : motive b)
     (hl : ∀ (b : β) (_ : motive b) (a : α) (_ : a ∈ []), motive (op a b)) :
     foldrRecOn [] op hb hl = hb := rfl
 
-@[simp] theorem foldrRecOn_cons {motive : β → Sort _} {op : α → β → β} (hb : motive b)
+@[simp, grind =] theorem foldrRecOn_cons {motive : β → Sort _} {op : α → β → β} (hb : motive b)
     (hl : ∀ (b : β) (_ : motive b) (a : α) (_ : a ∈ x :: l), motive (op a b)) :
     foldrRecOn (x :: l) op hb hl =
       hl _ (foldrRecOn l op hb fun b c a m => hl b c a (mem_cons_of_mem x m))
@@ -2915,13 +2917,13 @@ theorem getLast_filterMap_of_eq_some {f : α → Option β} {l : List α} (w : l
   rw [head_filterMap_of_eq_some (by simp_all)]
   simp_all
 
-theorem getLast?_flatMap {l : List α} {f : α → List β} :
+@[grind =] theorem getLast?_flatMap {l : List α} {f : α → List β} :
     (l.flatMap f).getLast? = l.reverse.findSome? fun a => (f a).getLast? := by
   simp only [← head?_reverse, reverse_flatMap]
   rw [head?_flatMap]
   rfl
 
-theorem getLast?_flatten {L : List (List α)} :
+@[grind =] theorem getLast?_flatten {L : List (List α)} :
     (flatten L).getLast? = L.reverse.findSome? fun l => l.getLast? := by
   simp [← flatMap_id, getLast?_flatMap]
 
@@ -2936,7 +2938,7 @@ theorem getLast?_replicate {a : α} {n : Nat} : (replicate n a).getLast? = if n
 /-! ### leftpad -/
 
 -- We unfold `leftpad` and `rightpad` for verification purposes.
-attribute [simp] leftpad rightpad
+attribute [simp, grind] leftpad rightpad
 
 -- `length_leftpad` and `length_rightpad` are in `Init.Data.List.Nat.Basic`.
 
@@ -3040,6 +3042,9 @@ we do not separately develop much theory about it.
 theorem mem_partition : a ∈ l ↔ a ∈ (partition p l).1 ∨ a ∈ (partition p l).2 := by
   by_cases p a <;> simp_all
 
+grind_pattern mem_partition => a ∈ (partition p l).1
+grind_pattern mem_partition => a ∈ (partition p l).2
+
 /-! ### dropLast
 
 `dropLast` is the specification for `Array.pop`, so theorems about `List.dropLast`
@@ -3111,7 +3116,7 @@ theorem dropLast_concat_getLast : ∀ {l : List α} (h : l ≠ []), dropLast l +
     congr
     exact dropLast_concat_getLast (cons_ne_nil b l)
 
-@[simp] theorem map_dropLast {f : α → β} {l : List α} : l.dropLast.map f = (l.map f).dropLast := by
+@[simp, grind _=_] theorem map_dropLast {f : α → β} {l : List α} : l.dropLast.map f = (l.map f).dropLast := by
   induction l with
   | nil => rfl
   | cons x xs ih => cases xs <;> simp [ih]
@@ -3123,6 +3128,7 @@ theorem dropLast_concat_getLast : ∀ {l : List α} (h : l ≠ []), dropLast l +
     rw [cons_append, dropLast, dropLast_append_of_ne_nil h, cons_append]
     simp [h]
 
+@[grind =]
 theorem dropLast_append {l₁ l₂ : List α} :
     (l₁ ++ l₂).dropLast = if l₂.isEmpty then l₁.dropLast else l₁ ++ l₂.dropLast := by
   split <;> simp_all
@@ -3130,9 +3136,9 @@ theorem dropLast_append {l₁ l₂ : List α} :
 theorem dropLast_append_cons : dropLast (l₁ ++ b :: l₂) = l₁ ++ dropLast (b :: l₂) := by
   simp
 
-@[simp] theorem dropLast_concat : dropLast (l₁ ++ [b]) = l₁ := by simp
+@[simp, grind =] theorem dropLast_concat : dropLast (l₁ ++ [b]) = l₁ := by simp
 
-@[simp] theorem dropLast_replicate {n : Nat} {a : α} : dropLast (replicate n a) = replicate (n - 1) a := by
+@[simp, grind =] theorem dropLast_replicate {n : Nat} {a : α} : dropLast (replicate n a) = replicate (n - 1) a := by
   match n with
   | 0 => simp
   | 1 => simp [replicate_succ]
@@ -3145,7 +3151,7 @@ theorem dropLast_append_cons : dropLast (l₁ ++ b :: l₂) = l₁ ++ dropLast (
     dropLast (a :: replicate n a) = replicate n a := by
   rw [← replicate_succ, dropLast_replicate, Nat.add_sub_cancel]
 
-@[simp] theorem tail_reverse {l : List α} : l.reverse.tail = l.dropLast.reverse := by
+@[simp, grind _=_] theorem tail_reverse {l : List α} : l.reverse.tail = l.dropLast.reverse := by
   apply ext_getElem
   · simp
   · intro i h₁ h₂
@@ -3385,6 +3391,7 @@ theorem replace_append_right [LawfulBEq α] {l₁ l₂ : List α} (h : ¬ a ∈
     (l₁ ++ l₂).replace a b = l₁ ++ l₂.replace a b := by
   simp [replace_append, h]
 
+@[grind _=_]
 theorem replace_take {l : List α} {i : Nat} :
     (l.take i).replace a b = (l.replace a b).take i := by
   induction l generalizing i with
@@ -3551,10 +3558,10 @@ end insert
 
 /-! ### `removeAll` -/
 
-@[simp] theorem removeAll_nil [BEq α] {xs : List α} : xs.removeAll [] = xs := by
+@[simp, grind =] theorem removeAll_nil [BEq α] {xs : List α} : xs.removeAll [] = xs := by
   simp [removeAll]
 
-theorem cons_removeAll [BEq α] {x : α} {xs ys : List α} :
+@[grind =] theorem cons_removeAll [BEq α] {x : α} {xs ys : List α} :
     (x :: xs).removeAll ys =
       if ys.contains x = false then
         x :: xs.removeAll ys
@@ -3562,6 +3569,7 @@ theorem cons_removeAll [BEq α] {x : α} {xs ys : List α} :
         xs.removeAll ys := by
   simp [removeAll, filter_cons]
 
+@[grind =]
 theorem removeAll_cons [BEq α] {xs : List α} {y : α} {ys : List α} :
     xs.removeAll (y :: ys) = (xs.filter fun x => !x == y).removeAll ys := by
   simp [removeAll, Bool.and_comm]
@@ -3581,7 +3589,7 @@ theorem removeAll_cons [BEq α] {xs : List α} {y : α} {ys : List α} :
 
 /-! ### `eraseDupsBy` and `eraseDups` -/
 
-@[simp] theorem eraseDupsBy_nil : ([] : List α).eraseDupsBy r = [] := rfl
+@[simp, grind =] theorem eraseDupsBy_nil : ([] : List α).eraseDupsBy r = [] := rfl
 
 private theorem eraseDupsBy_loop_cons {as bs : List α} {r : α → α → Bool} :
     eraseDupsBy.loop r as bs = bs.reverse ++ eraseDupsBy.loop r (as.filter fun a => !bs.any (r a)) [] := by
@@ -3601,17 +3609,19 @@ private theorem eraseDupsBy_loop_cons {as bs : List α} {r : α → α → Bool}
       simp
 termination_by as.length
 
+@[grind =]
 theorem eraseDupsBy_cons :
     (a :: as).eraseDupsBy r = a :: (as.filter fun b => r b a = false).eraseDupsBy r := by
   simp only [eraseDupsBy, eraseDupsBy.loop, any_nil]
   rw [eraseDupsBy_loop_cons]
   simp
 
-@[simp] theorem eraseDups_nil [BEq α] : ([] : List α).eraseDups = [] := rfl
-theorem eraseDups_cons [BEq α] {a : α} {as : List α} :
+@[simp, grind =] theorem eraseDups_nil [BEq α] : ([] : List α).eraseDups = [] := rfl
+@[grind =] theorem eraseDups_cons [BEq α] {a : α} {as : List α} :
     (a :: as).eraseDups = a :: (as.filter fun b => !b == a).eraseDups := by
   simp [eraseDups, eraseDupsBy_cons]
 
+@[grind =]
 theorem eraseDups_append [BEq α] [LawfulBEq α] {as bs : List α} :
     (as ++ bs).eraseDups = as.eraseDups ++ (bs.removeAll as).eraseDups := by
   match as with

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

@@ -26,6 +26,7 @@ namespace List
 
 /-! ### dropLast -/
 
+@[grind _=_]
 theorem tail_dropLast {l : List α} : tail (dropLast l) = dropLast (tail l) := by
   ext1
   simp only [getElem?_tail, getElem?_dropLast, length_tail]
@@ -35,7 +36,7 @@ theorem tail_dropLast {l : List α} : tail (dropLast l) = dropLast (tail l) := b
   · omega
   · rfl
 
-@[simp] theorem dropLast_reverse {l : List α} : l.reverse.dropLast = l.tail.reverse := by
+@[simp, grind _=_] theorem dropLast_reverse {l : List α} : l.reverse.dropLast = l.tail.reverse := by
   apply ext_getElem
   · simp
   · intro i h₁ h₂
@@ -114,7 +115,7 @@ section intersperse
 
 variable {l : List α} {sep : α} {i : Nat}
 
-@[simp] theorem length_intersperse : (l.intersperse sep).length = 2 * l.length - 1 := by
+@[simp, grind =] theorem length_intersperse : (l.intersperse sep).length = 2 * l.length - 1 := by
   fun_induction intersperse <;> simp only [intersperse, length_cons, length_nil] at *
   rename_i h _
   have := length_pos_iff.mpr h

src/Init/Data/List/Nat/Count.lean

@@ -16,6 +16,7 @@ namespace List
 
 open Nat
 
+@[grind =]
 theorem countP_set {p : α → Bool} {l : List α} {i : Nat} {a : α} (h : i < l.length) :
     (l.set i a).countP p = l.countP p - (if p l[i] then 1 else 0) + (if p a then 1 else 0) := by
   induction l generalizing i with
@@ -29,10 +30,12 @@ theorem countP_set {p : α → Bool} {l : List α} {i : Nat} {a : α} (h : i < l
       have : (if p l[i] = true then 1 else 0) ≤ l.countP p := boole_getElem_le_countP (p := p) h
       omega
 
+@[grind =]
 theorem count_set [BEq α] {a b : α} {l : List α} {i : Nat} (h : i < l.length) :
     (l.set i a).count b = l.count b - (if l[i] == b then 1 else 0) + (if a == b then 1 else 0) := by
   simp [count_eq_countP, countP_set, h]
 
+@[grind =]
 theorem countP_replace [BEq α] [LawfulBEq α] {a b : α} {l : List α} {p : α → Bool} :
     (l.replace a b).countP p =
       if l.contains a then l.countP p + (if p b then 1 else 0) - (if p a then 1 else 0) else l.countP p := by
@@ -55,11 +58,31 @@ theorem countP_replace [BEq α] [LawfulBEq α] {a b : α} {l : List α} {p : α
           omega
       · omega
 
+@[grind =]
 theorem count_replace [BEq α] [LawfulBEq α] {a b c : α} {l : List α} :
     (l.replace a b).count c =
       if l.contains a then l.count c + (if b == c then 1 else 0) - (if a == c then 1 else 0) else l.count c := by
   simp [count_eq_countP, countP_replace]
 
+@[grind =] theorem count_insert [BEq α] [LawfulBEq α] {a b : α} {l : List α} :
+    count a (List.insert b l) = max (count a l) (if b == a then 1 else 0) := by
+  simp only [List.insert, contains_eq_mem, decide_eq_true_eq, beq_iff_eq]
+  split <;> rename_i h
+  · split <;> rename_i h'
+    · rw [Nat.max_def]
+      simp only [beq_iff_eq] at h'
+      split
+      · have := List.count_pos_iff.mpr (h' ▸ h)
+        omega
+      · rfl
+    · simp [h']
+  · rw [count_cons]
+    split <;> rename_i h'
+    · simp only [beq_iff_eq] at h'
+      rw [count_eq_zero.mpr (h' ▸ h)]
+      simp [h']
+    · simp
+
 /--
 The number of elements satisfying a predicate in a sublist is at least the number of elements satisfying the predicate in the list,
 minus the difference in the lengths.
@@ -98,6 +121,8 @@ theorem le_countP_tail {l} : countP p l - 1 ≤ countP p l.tail := by
   simp only [length_tail] at this
   omega
 
+grind_pattern le_countP_tail => countP p l.tail
+
 variable [BEq α]
 
 theorem Sublist.le_count (s : l₁ <+ l₂) (a : α) : count a l₂ - (l₂.length - l₁.length) ≤ count a l₁ :=
@@ -115,4 +140,6 @@ theorem IsInfix.le_count (s : l₁ <:+: l₂) (a : α) : count a l₂ - (l₂.le
 theorem le_count_tail {a : α} {l : List α} : count a l - 1 ≤ count a l.tail :=
   le_countP_tail
 
+grind_pattern le_count_tail => count a l.tail
+
 end List

src/Init/Data/List/Nat/Erase.lean

@@ -187,7 +187,7 @@ theorem set_eraseIdx {xs : List α} {i : Nat} {j : Nat} {a : α} :
       · have t : ¬ n < i := by omega
         simp [t]
 
-@[simp] theorem eraseIdx_length_sub_one {l : List α} :
+@[simp, grind =] theorem eraseIdx_length_sub_one {l : List α} :
     (l.eraseIdx (l.length - 1)) = l.dropLast := by
   apply ext_getElem
   · simp [length_eraseIdx]

src/Init/Data/List/Nat/InsertIdx.lean

@@ -30,19 +30,20 @@ section InsertIdx
 
 variable {a : α}
 
-@[simp]
+@[simp, grind =]
 theorem insertIdx_zero {xs : List α} {x : α} : xs.insertIdx 0 x = x :: xs :=
   rfl
 
-@[simp]
+@[simp, grind =]
 theorem insertIdx_succ_nil {n : Nat} {a : α} : ([] : List α).insertIdx (n + 1) a = [] :=
   rfl
 
-@[simp]
+@[simp, grind =]
 theorem insertIdx_succ_cons {xs : List α} {hd x : α} {i : Nat} :
     (hd :: xs).insertIdx (i + 1) x = hd :: xs.insertIdx i x :=
   rfl
 
+@[grind =]
 theorem length_insertIdx : ∀ {i} {as : List α}, (as.insertIdx i a).length = if i ≤ as.length then as.length + 1 else as.length
   | 0, _ => by simp
   | n + 1, [] => by simp
@@ -56,14 +57,9 @@ theorem length_insertIdx_of_le_length (h : i ≤ length as) (a : α) : (as.inser
 theorem length_insertIdx_of_length_lt (h : length as < i) (a : α) : (as.insertIdx i a).length = as.length := by
   simp [length_insertIdx, h]
 
-@[simp]
-theorem eraseIdx_insertIdx {i : Nat} {l : List α} (a : α) : (l.insertIdx i a).eraseIdx i = l := by
-  rw [eraseIdx_eq_modifyTailIdx, insertIdx, modifyTailIdx_modifyTailIdx_self]
-  exact modifyTailIdx_id _ _
-
 theorem insertIdx_eraseIdx_of_ge :
-    ∀ {i m as},
-      i < length as → i ≤ m → (as.eraseIdx i).insertIdx m a = (as.insertIdx (m + 1) a).eraseIdx i
+    ∀ {i j as},
+      i < length as → i ≤ j → (as.eraseIdx i).insertIdx j a = (as.insertIdx (j + 1) a).eraseIdx i
   | 0, 0, [], has, _ => (Nat.lt_irrefl _ has).elim
   | 0, 0, _ :: as, _, _ => by simp [eraseIdx, insertIdx]
   | 0, _ + 1, _ :: _, _, _ => rfl
@@ -79,6 +75,15 @@ theorem insertIdx_eraseIdx_of_le :
     congrArg (cons a) <|
       insertIdx_eraseIdx_of_le (Nat.lt_of_succ_lt_succ has) (Nat.le_of_succ_le_succ hmn)
 
+@[grind =]
+theorem insertIdx_eraseIdx (h : i < length as) :
+    (as.eraseIdx i).insertIdx j a =
+      if i ≤ j then (as.insertIdx (j + 1) a).eraseIdx i else (as.insertIdx j a).eraseIdx (i + 1) := by
+  split <;> rename_i h'
+  · rw [insertIdx_eraseIdx_of_ge h h']
+  · rw [insertIdx_eraseIdx_of_le h (by omega)]
+
+@[grind =]
 theorem insertIdx_comm (a b : α) :
     ∀ {i j : Nat} {l : List α} (_ : i ≤ j) (_ : j ≤ length l),
       (l.insertIdx i a).insertIdx (j + 1) b = (l.insertIdx j b).insertIdx i a
@@ -110,6 +115,14 @@ theorem insertIdx_of_length_lt {l : List α} {x : α} {i : Nat} (h : l.length <
     · simp only [Nat.succ_lt_succ_iff, length] at h
       simpa using ih h
 
+@[simp, grind =]
+theorem eraseIdx_insertIdx_self {i : Nat} {l : List α} (a : α) : (l.insertIdx i a).eraseIdx i = l := by
+  rw [eraseIdx_eq_modifyTailIdx, insertIdx, modifyTailIdx_modifyTailIdx_self]
+  exact modifyTailIdx_id _ _
+
+@[deprecated eraseIdx_insertIdx_self (since := "2025-06-18")]
+abbrev eraseIdx_insertIdx := @eraseIdx_insertIdx_self
+
 @[simp]
 theorem insertIdx_length_self {l : List α} {x : α} : l.insertIdx l.length x = l ++ [x] := by
   induction l with
@@ -185,6 +198,7 @@ theorem getElem_insertIdx_of_gt {l : List α} {x : α} {i j : Nat} (hn : i < j)
 @[deprecated getElem_insertIdx_of_gt (since := "2025-02-04")]
 abbrev getElem_insertIdx_of_ge := @getElem_insertIdx_of_gt
 
+@[grind =]
 theorem getElem_insertIdx {l : List α} {x : α} {i j : Nat} (h : j < (l.insertIdx i x).length) :
     (l.insertIdx i x)[j] =
       if h₁ : j < i then
@@ -201,6 +215,7 @@ theorem getElem_insertIdx {l : List α} {x : α} {i j : Nat} (h : j < (l.insertI
       rw [getElem_insertIdx_self h]
     · rw [getElem_insertIdx_of_gt (by omega)]
 
+@[grind =]
 theorem getElem?_insertIdx {l : List α} {x : α} {i j : Nat} :
     (l.insertIdx i x)[j]? =
       if j < i then

src/Init/Data/List/Nat/Modify.lean

@@ -17,7 +17,7 @@ namespace List
 
 /-! ### modifyHead -/
 
-@[simp] theorem length_modifyHead {f : α → α} {l : List α} : (l.modifyHead f).length = l.length := by
+@[simp, grind =] theorem length_modifyHead {f : α → α} {l : List α} : (l.modifyHead f).length = l.length := by
   cases l <;> simp [modifyHead]
 
 theorem modifyHead_eq_set [Inhabited α] (f : α → α) (l : List α) :
@@ -26,9 +26,10 @@ theorem modifyHead_eq_set [Inhabited α] (f : α → α) (l : List α) :
 @[simp] theorem modifyHead_eq_nil_iff {f : α → α} {l : List α} :
     l.modifyHead f = [] ↔ l = [] := by cases l <;> simp [modifyHead]
 
-@[simp] theorem modifyHead_modifyHead {l : List α} {f g : α → α} :
+@[simp, grind =] theorem modifyHead_modifyHead {l : List α} {f g : α → α} :
     (l.modifyHead f).modifyHead g = l.modifyHead (g ∘ f) := by cases l <;> simp [modifyHead]
 
+@[grind =]
 theorem getElem_modifyHead {l : List α} {f : α → α} {i} (h : i < (l.modifyHead f).length) :
     (l.modifyHead f)[i] = if h' : i = 0 then f (l[0]'(by simp at h; omega)) else l[i]'(by simpa using h) := by
   cases l with
@@ -41,6 +42,7 @@ theorem getElem_modifyHead {l : List α} {f : α → α} {i} (h : i < (l.modifyH
 @[simp] theorem getElem_modifyHead_succ {l : List α} {f : α → α} {n} (h : n + 1 < (l.modifyHead f).length) :
     (l.modifyHead f)[n + 1] = l[n + 1]'(by simpa using h) := by simp [getElem_modifyHead]
 
+@[grind =]
 theorem getElem?_modifyHead {l : List α} {f : α → α} {i} :
     (l.modifyHead f)[i]? = if i = 0 then l[i]?.map f else l[i]? := by
   cases l with
@@ -53,19 +55,19 @@ theorem getElem?_modifyHead {l : List α} {f : α → α} {i} :
 @[simp] theorem getElem?_modifyHead_succ {l : List α} {f : α → α} {n} :
     (l.modifyHead f)[n + 1]? = l[n + 1]? := by simp [getElem?_modifyHead]
 
-@[simp] theorem head_modifyHead (f : α → α) (l : List α) (h) :
+@[simp, grind =] theorem head_modifyHead (f : α → α) (l : List α) (h) :
     (l.modifyHead f).head h = f (l.head (by simpa using h)) := by
   cases l with
   | nil => simp at h
   | cons hd tl => simp
 
-@[simp] theorem head?_modifyHead {l : List α} {f : α → α} :
+@[simp, grind =] theorem head?_modifyHead {l : List α} {f : α → α} :
     (l.modifyHead f).head? = l.head?.map f := by cases l <;> simp
 
-@[simp] theorem tail_modifyHead {f : α → α} {l : List α} :
+@[simp, grind =] theorem tail_modifyHead {f : α → α} {l : List α} :
     (l.modifyHead f).tail = l.tail := by cases l <;> simp
 
-@[simp] theorem take_modifyHead {f : α → α} {l : List α} {i} :
+@[simp, grind =] theorem take_modifyHead {f : α → α} {l : List α} {i} :
     (l.modifyHead f).take i = (l.take i).modifyHead f := by
   cases l <;> cases i <;> simp
 
@@ -73,6 +75,7 @@ theorem getElem?_modifyHead {l : List α} {f : α → α} {i} :
     (l.modifyHead f).drop i = l.drop i := by
   cases l <;> cases i <;> simp_all
 
+@[grind =]
 theorem eraseIdx_modifyHead_zero {f : α → α} {l : List α} :
     (l.modifyHead f).eraseIdx 0 = l.eraseIdx 0 := by simp
 
@@ -81,7 +84,7 @@ theorem eraseIdx_modifyHead_zero {f : α → α} {l : List α} :
 
 @[simp] theorem modifyHead_id : modifyHead (id : α → α) = id := by funext l; cases l <;> simp
 
-@[simp] theorem modifyHead_dropLast {l : List α} {f : α → α} :
+@[simp, grind _=_] theorem modifyHead_dropLast {l : List α} {f : α → α} :
     l.dropLast.modifyHead f = (l.modifyHead f).dropLast := by
   rcases l with _|⟨a, l⟩
   · simp
@@ -99,7 +102,7 @@ theorem eraseIdx_eq_modifyTailIdx : ∀ i (l : List α), eraseIdx l i = l.modify
   | _+1, [] => rfl
   | _+1, _ :: _ => congrArg (cons _) (eraseIdx_eq_modifyTailIdx _ _)
 
-@[simp] theorem length_modifyTailIdx (f : List α → List α) (H : ∀ l, (f l).length = l.length) :
+@[simp, grind =] theorem length_modifyTailIdx (f : List α → List α) (H : ∀ l, (f l).length = l.length) :
     ∀ (l : List α) i, (l.modifyTailIdx i f).length = l.length
   | _, 0 => H _
   | [], _+1 => rfl
@@ -142,7 +145,7 @@ theorem modifyTailIdx_modifyTailIdx_self {f g : List α → List α} (i : Nat) (
 
 /-! ### modify -/
 
-@[simp] theorem modify_nil (f : α → α) (i) : [].modify i f = [] := by cases i <;> rfl
+@[simp, grind =] theorem modify_nil (f : α → α) (i) : [].modify i f = [] := by cases i <;> rfl
 
 @[simp] theorem modify_zero_cons (f : α → α) (a : α) (l : List α) :
     (a :: l).modify 0 f = f a :: l := rfl
@@ -150,6 +153,15 @@ theorem modifyTailIdx_modifyTailIdx_self {f g : List α → List α} (i : Nat) (
 @[simp] theorem modify_succ_cons (f : α → α) (a : α) (l : List α) (i) :
     (a :: l).modify (i + 1) f = a :: l.modify i f := rfl
 
+@[grind =]
+theorem modify_cons {f : α → α} {a : α} {l : List α} {i : Nat} :
+    (a :: l).modify i f =
+      if i = 0 then f a :: l else a :: l.modify (i - 1) f := by
+  split <;> rename_i h
+  · subst h
+    simp
+  · match i, h with | i + 1, _ => simp
+
 theorem modifyHead_eq_modify_zero (f : α → α) (l : List α) :
     l.modifyHead f = l.modify 0 f := by cases l <;> simp
 
@@ -200,6 +212,7 @@ theorem modify_eq_self {f : α → α} {i} {l : List α} (h : l.length ≤ i) :
     intro h
     omega
 
+@[grind =]
 theorem modify_modify_eq (f g : α → α) (i) (l : List α) :
     (l.modify i f).modify i g = l.modify i (g ∘ f) := by
   apply ext_getElem
@@ -245,7 +258,7 @@ theorem exists_of_modify (f : α → α) {i} {l : List α} (h : i < l.length) :
 @[simp] theorem modify_id (i) (l : List α) : l.modify i id = l := by
   simp [modify]
 
-@[grind =]
+@[grind _=_]
 theorem take_modify (f : α → α) (i j) (l : List α) :
     (l.modify i f).take j = (l.take j).modify i f := by
   induction j generalizing l i with

src/Init/Data/List/Nat/Range.lean

@@ -27,11 +27,12 @@ open Nat
 
 /-! ### range' -/
 
-@[simp] theorem mem_range'_1 : m ∈ range' s n ↔ s ≤ m ∧ m < s + n := by
+@[simp, grind =] theorem mem_range'_1 : m ∈ range' s n ↔ s ≤ m ∧ m < s + n := by
   simp [mem_range']; exact ⟨
     fun ⟨i, h, e⟩ => e ▸ ⟨Nat.le_add_right .., Nat.add_lt_add_left h _⟩,
     fun ⟨h₁, h₂⟩ => ⟨m - s, Nat.sub_lt_left_of_lt_add h₁ h₂, (Nat.add_sub_cancel' h₁).symm⟩⟩
 
+@[grind =]
 theorem getLast?_range' {n : Nat} : (range' s n).getLast? = if n = 0 then none else some (s + n - 1) := by
   induction n generalizing s with
   | zero => simp
@@ -43,7 +44,7 @@ theorem getLast?_range' {n : Nat} : (range' s n).getLast? = if n = 0 then none e
     · rw [if_neg h]
       simp
 
-@[simp] theorem getLast_range' {n : Nat} (h) : (range' s n).getLast h = s + n - 1 := by
+@[simp, grind =] theorem getLast_range' {n : Nat} (h) : (range' s n).getLast h = s + n - 1 := by
   cases n with
   | zero => simp at h
   | succ n => simp [getLast?_range', getLast_eq_iff_getLast?_eq_some]
@@ -158,6 +159,26 @@ theorem erase_range' :
       simp [p]
       omega
 
+@[simp, grind =]
+theorem count_range' {a s n step} (h : 0 < step := by simp) :
+    count a (range' s n step) = if ∃ i, i < n ∧ a = s + step * i then 1 else 0 := by
+  rw [(nodup_range' step h).count]
+  simp only [mem_range']
+
+@[simp, grind =]
+theorem count_range_1' {a s n} :
+    count a (range' s n) = if s ≤ a ∧ a < s + n then 1 else 0 := by
+  rw [count_range' (by simp)]
+  split <;> rename_i h
+  · obtain ⟨i, h, rfl⟩ := h
+    simp [h]
+  · simp at h
+    rw [if_neg]
+    simp only [not_and, Nat.not_lt]
+    intro w
+    specialize h (a - s)
+    omega
+
 /-! ### range -/
 
 theorem reverse_range' : ∀ {s n : Nat}, reverse (range' s n) = map (s + n - 1 - ·) (range n)
@@ -167,7 +188,7 @@ theorem reverse_range' : ∀ {s n : Nat}, reverse (range' s n) = map (s + n - 1
       show s + (n + 1) - 1 = s + n from rfl, map, map_map]
     simp [reverse_range', Nat.sub_right_comm, Nat.sub_sub]
 
-@[simp]
+@[simp, grind =]
 theorem mem_range {m n : Nat} : m ∈ range n ↔ m < n := by
   simp only [range_eq_range', mem_range'_1, Nat.zero_le, true_and, Nat.zero_add]
 
@@ -181,7 +202,7 @@ theorem pairwise_lt_range {n : Nat} : Pairwise (· < ·) (range n) := by
 theorem pairwise_le_range {n : Nat} : Pairwise (· ≤ ·) (range n) :=
   Pairwise.imp Nat.le_of_lt pairwise_lt_range
 
-@[simp] theorem take_range {i n : Nat} : take i (range n) = range (min i n) := by
+@[simp, grind =] theorem take_range {i n : Nat} : take i (range n) = range (min i n) := by
   apply List.ext_getElem
   · simp
   · simp +contextual [getElem_take, Nat.lt_min]
@@ -189,10 +210,11 @@ theorem pairwise_le_range {n : Nat} : Pairwise (· ≤ ·) (range n) :=
 theorem nodup_range {n : Nat} : Nodup (range n) := by
   simp +decide only [range_eq_range', nodup_range']
 
-@[simp] theorem find?_range_eq_some {n : Nat} {i : Nat} {p : Nat → Bool} :
+@[simp, grind] theorem find?_range_eq_some {n : Nat} {i : Nat} {p : Nat → Bool} :
     (range n).find? p = some i ↔ p i ∧ i ∈ range n ∧ ∀ j, j < i → !p j := by
   simp [range_eq_range']
 
+@[grind]
 theorem find?_range_eq_none {n : Nat} {p : Nat → Bool} :
     (range n).find? p = none ↔ ∀ i, i < n → !p i := by
   simp
@@ -200,6 +222,12 @@ theorem find?_range_eq_none {n : Nat} {p : Nat → Bool} :
 theorem erase_range : (range n).erase i = range (min n i) ++ range' (i + 1) (n - (i + 1)) := by
   simp [range_eq_range', erase_range']
 
+@[simp, grind =]
+theorem count_range {a n} :
+    count a (range n) = if a < n then 1 else 0 := by
+  rw [range_eq_range', count_range_1']
+  simp
+
 /-! ### iota -/
 
 section
@@ -348,15 +376,15 @@ end
 
 /-! ### zipIdx -/
 
-@[simp]
+@[simp, grind =]
 theorem zipIdx_singleton {x : α} {k : Nat} : zipIdx [x] k = [(x, k)] :=
   rfl
 
-@[simp] theorem head?_zipIdx {l : List α} {k : Nat} :
+@[simp, grind =] theorem head?_zipIdx {l : List α} {k : Nat} :
     (zipIdx l k).head? = l.head?.map fun a => (a, k) := by
   simp [head?_eq_getElem?]
 
-@[simp] theorem getLast?_zipIdx {l : List α} {k : Nat} :
+@[simp, grind =] theorem getLast?_zipIdx {l : List α} {k : Nat} :
     (zipIdx l k).getLast? = l.getLast?.map fun a => (a, k + l.length - 1) := by
   simp [getLast?_eq_getElem?]
   cases l <;> simp
@@ -379,6 +407,7 @@ to avoid the inequality and the subtraction. -/
 theorem mk_mem_zipIdx_iff_getElem? {i : Nat} {x : α} {l : List α} : (x, i) ∈ zipIdx l ↔ l[i]? = some x := by
   simp [mk_mem_zipIdx_iff_le_and_getElem?_sub]
 
+@[grind =]
 theorem mem_zipIdx_iff_le_and_getElem?_sub {x : α × Nat} {l : List α} {k : Nat} :
     x ∈ zipIdx l k ↔ k ≤ x.2 ∧ l[x.2 - k]? = some x.1 := by
   cases x
@@ -441,6 +470,7 @@ theorem zipIdx_map {l : List α} {k : Nat} {f : α → β} :
     rw [map_cons, zipIdx_cons', zipIdx_cons', map_cons, map_map, IH, map_map]
     rfl
 
+@[grind =]
 theorem zipIdx_append {xs ys : List α} {k : Nat} :
     zipIdx (xs ++ ys) k = zipIdx xs k ++ zipIdx ys (k + xs.length) := by
   induction xs generalizing ys k with

src/Init/Data/List/Nat/Sublist.lean

@@ -118,6 +118,7 @@ theorem suffix_iff_eq_append : l₁ <:+ l₂ ↔ take (length l₂ - length l₁
   ⟨by rintro ⟨r, rfl⟩; simp only [length_append, Nat.add_sub_cancel_right, take_left], fun e =>
     ⟨_, e⟩⟩
 
+@[grind =]
 theorem prefix_take_iff {xs ys : List α} {i : Nat} : xs <+: ys.take i ↔ xs <+: ys ∧ xs.length ≤ i := by
   constructor
   · intro h

src/Init/Data/List/Nat/TakeDrop.lean

@@ -99,6 +99,7 @@ theorem getLast_take {l : List α} (h : l.take i ≠ []) :
   · rw [getElem?_eq_none (by omega), getLast_eq_getElem]
     simp
 
+@[grind =]
 theorem take_take : ∀ {i j} {l : List α}, take i (take j l) = take (min i j) l
   | n, 0, l => by rw [Nat.min_zero, take_zero, take_nil]
   | 0, m, l => by rw [Nat.zero_min, take_zero, take_zero]
@@ -117,19 +118,19 @@ theorem take_set_of_le {a : α} {i j : Nat} {l : List α} (h : j ≤ i) :
 @[deprecated take_set_of_le (since := "2025-02-04")]
 abbrev take_set_of_lt := @take_set_of_le
 
-@[simp] theorem take_replicate {a : α} : ∀ {i n : Nat}, take i (replicate n a) = replicate (min i n) a
+@[simp, grind =] theorem take_replicate {a : α} : ∀ {i n : Nat}, take i (replicate n a) = replicate (min i n) a
   | n, 0 => by simp [Nat.min_zero]
   | 0, m => by simp [Nat.zero_min]
   | succ n, succ m => by simp [replicate_succ, succ_min_succ, take_replicate]
 
-@[simp] theorem drop_replicate {a : α} : ∀ {i n : Nat}, drop i (replicate n a) = replicate (n - i) a
+@[simp, grind =] theorem drop_replicate {a : α} : ∀ {i n : Nat}, drop i (replicate n a) = replicate (n - i) a
   | n, 0 => by simp
   | 0, m => by simp
   | succ n, succ m => by simp [replicate_succ, succ_sub_succ, drop_replicate]
 
 /-- Taking the first `i` elements in `l₁ ++ l₂` is the same as appending the first `i` elements
 of `l₁` to the first `n - l₁.length` elements of `l₂`. -/
-theorem take_append_eq_append_take {l₁ l₂ : List α} {i : Nat} :
+theorem take_append {l₁ l₂ : List α} {i : Nat} :
     take i (l₁ ++ l₂) = take i l₁ ++ take (i - l₁.length) l₂ := by
   induction l₁ generalizing i
   · simp
@@ -140,15 +141,18 @@ theorem take_append_eq_append_take {l₁ l₂ : List α} {i : Nat} :
       congr 1
       omega
 
+@[deprecated take_append (since := "2025-06-16")]
+abbrev take_append_eq_append_take := @take_append
+
 theorem take_append_of_le_length {l₁ l₂ : List α} {i : Nat} (h : i ≤ l₁.length) :
     (l₁ ++ l₂).take i = l₁.take i := by
-  simp [take_append_eq_append_take, Nat.sub_eq_zero_of_le h]
+  simp [take_append, Nat.sub_eq_zero_of_le h]
 
 /-- Taking the first `l₁.length + i` elements in `l₁ ++ l₂` is the same as appending the first
 `i` elements of `l₂` to `l₁`. -/
-theorem take_append {l₁ l₂ : List α} (i : Nat) :
+theorem take_length_add_append {l₁ l₂ : List α} (i : Nat) :
     take (l₁.length + i) (l₁ ++ l₂) = l₁ ++ take i l₂ := by
-  rw [take_append_eq_append_take, take_of_length_le (Nat.le_add_right _ _), Nat.add_sub_cancel_left]
+  rw [take_append, take_of_length_le (Nat.le_add_right _ _), Nat.add_sub_cancel_left]
 
 @[simp]
 theorem take_eq_take_iff :
@@ -162,11 +166,12 @@ theorem take_eq_take_iff :
 @[deprecated take_eq_take_iff (since := "2025-02-16")]
 abbrev take_eq_take := @take_eq_take_iff
 
+@[grind =]
 theorem take_add {l : List α} {i j : Nat} : l.take (i + j) = l.take i ++ (l.drop i).take j := by
   suffices take (i + j) (take i l ++ drop i l) = take i l ++ take j (drop i l) by
     rw [take_append_drop] at this
     assumption
-  rw [take_append_eq_append_take, take_of_length_le, append_right_inj]
+  rw [take_append, take_of_length_le, append_right_inj]
   · simp only [take_eq_take_iff, length_take, length_drop]
     omega
   apply Nat.le_trans (m := i)
@@ -236,7 +241,7 @@ dropping the first `i` elements. Version designed to rewrite from the small list
       exact Nat.add_lt_of_lt_sub (length_drop ▸ h)) := by
   rw [getElem_drop']
 
-@[simp]
+@[simp, grind =]
 theorem getElem?_drop {xs : List α} {i j : Nat} : (xs.drop i)[j]? = xs[i + j]? := by
   ext
   simp only [getElem?_eq_some_iff, getElem_drop]
@@ -285,7 +290,7 @@ theorem getLast?_drop {l : List α} : (l.drop i).getLast? = if l.length ≤ i th
     congr
     omega
 
-@[simp] theorem getLast_drop {l : List α} (h : l.drop i ≠ []) :
+@[simp, grind =] theorem getLast_drop {l : List α} (h : l.drop i ≠ []) :
     (l.drop i).getLast h = l.getLast (ne_nil_of_length_pos (by simp at h; omega)) := by
   simp only [ne_eq, drop_eq_nil_iff] at h
   apply Option.some_inj.1
@@ -306,7 +311,8 @@ theorem drop_length_cons {l : List α} (h : l ≠ []) (a : α) :
 
 /-- Dropping the elements up to `i` in `l₁ ++ l₂` is the same as dropping the elements up to `i`
 in `l₁`, dropping the elements up to `i - l₁.length` in `l₂`, and appending them. -/
-theorem drop_append_eq_append_drop {l₁ l₂ : List α} {i : Nat} :
+@[grind =]
+theorem drop_append {l₁ l₂ : List α} {i : Nat} :
     drop i (l₁ ++ l₂) = drop i l₁ ++ drop (i - l₁.length) l₂ := by
   induction l₁ generalizing i
   · simp
@@ -316,15 +322,18 @@ theorem drop_append_eq_append_drop {l₁ l₂ : List α} {i : Nat} :
       congr 1
       omega
 
+@[deprecated drop_append (since := "2025-06-16")]
+abbrev drop_append_eq_append_drop := @drop_append
+
 theorem drop_append_of_le_length {l₁ l₂ : List α} {i : Nat} (h : i ≤ l₁.length) :
     (l₁ ++ l₂).drop i = l₁.drop i ++ l₂ := by
-  simp [drop_append_eq_append_drop, Nat.sub_eq_zero_of_le h]
+  simp [drop_append, Nat.sub_eq_zero_of_le h]
 
 /-- Dropping the elements up to `l₁.length + i` in `l₁ + l₂` is the same as dropping the elements
 up to `i` in `l₂`. -/
 @[simp]
-theorem drop_append {l₁ l₂ : List α} (i : Nat) : drop (l₁.length + i) (l₁ ++ l₂) = drop i l₂ := by
-  rw [drop_append_eq_append_drop, drop_eq_nil_of_le] <;>
+theorem drop_length_add_append {l₁ l₂ : List α} (i : Nat) : drop (l₁.length + i) (l₁ ++ l₂) = drop i l₂ := by
+  rw [drop_append, drop_eq_nil_of_le] <;>
     simp [Nat.add_sub_cancel_left, Nat.le_add_right]
 
 theorem set_eq_take_append_cons_drop {l : List α} {i : Nat} {a : α} :
@@ -458,7 +467,7 @@ theorem false_of_mem_take_findIdx {xs : List α} {p : α → Bool} (h : x ∈ xs
   obtain ⟨i, h, rfl⟩ := h
   exact not_of_lt_findIdx (by omega)
 
-@[simp] theorem findIdx_take {xs : List α} {i : Nat} {p : α → Bool} :
+@[simp, grind =] theorem findIdx_take {xs : List α} {i : Nat} {p : α → Bool} :
     (xs.take i).findIdx p = min i (xs.findIdx p) := by
   induction xs generalizing i with
   | nil => simp
@@ -470,7 +479,7 @@ theorem false_of_mem_take_findIdx {xs : List α} {p : α → Bool} (h : x ∈ xs
       · simp
       · rw [Nat.add_min_add_right]
 
-@[simp] theorem min_findIdx_findIdx {xs : List α} {p q : α → Bool} :
+@[simp, grind =] theorem min_findIdx_findIdx {xs : List α} {p q : α → Bool} :
     min (xs.findIdx p) (xs.findIdx q) = xs.findIdx (fun a => p a || q a) := by
   induction xs with
   | nil => simp
@@ -512,7 +521,7 @@ theorem dropWhile_eq_drop_findIdx_not {xs : List α} {p : α → Bool} :
 
 /-! ### rotateLeft -/
 
-@[simp] theorem rotateLeft_replicate {n} {a : α} : rotateLeft (replicate m a) n = replicate m a := by
+@[simp, grind =] theorem rotateLeft_replicate {n} {a : α} : rotateLeft (replicate m a) n = replicate m a := by
   cases n with
   | zero => simp
   | succ n =>
@@ -525,7 +534,7 @@ theorem dropWhile_eq_drop_findIdx_not {xs : List α} {p : α → Bool} :
 
 /-! ### rotateRight -/
 
-@[simp] theorem rotateRight_replicate {n} {a : α} : rotateRight (replicate m a) n = replicate m a := by
+@[simp, grind =] theorem rotateRight_replicate {n} {a : α} : rotateRight (replicate m a) n = replicate m a := by
   cases n with
   | zero => simp
   | succ n =>

src/Init/Data/List/Pairwise.lean

@@ -279,7 +279,11 @@ theorem nodup_nil : @Nodup α [] :=
 theorem nodup_cons {a : α} {l : List α} : Nodup (a :: l) ↔ a ∉ l ∧ Nodup l := by
   simp only [Nodup, pairwise_cons, forall_mem_ne]
 
-@[grind →] theorem Nodup.sublist : l₁ <+ l₂ → Nodup l₂ → Nodup l₁ :=
+@[grind =] theorem nodup_append {l₁ l₂ : List α} :
+    (l₁ ++ l₂).Nodup ↔ l₁.Nodup ∧ l₂.Nodup ∧ ∀ a ∈ l₁, ∀ b ∈ l₂, a ≠ b :=
+  pairwise_append
+
+theorem Nodup.sublist : l₁ <+ l₂ → Nodup l₂ → Nodup l₁ :=
   Pairwise.sublist
 
 grind_pattern Nodup.sublist => l₁ <+ l₂, Nodup l₁
@@ -312,4 +316,48 @@ theorem getElem?_inj {xs : List α}
 @[simp, grind =] theorem nodup_replicate {n : Nat} {a : α} :
     (replicate n a).Nodup ↔ n ≤ 1 := by simp [Nodup]
 
+theorem Nodup.count [BEq α] [LawfulBEq α] {a : α} {l : List α} (h : Nodup l) : count a l = if a ∈ l then 1 else 0 := by
+  split <;> rename_i h'
+  · obtain ⟨s, t, rfl⟩ := List.append_of_mem h'
+    rw [nodup_append] at h
+    simp_all
+    rw [count_eq_zero.mpr ?_, count_eq_zero.mpr ?_]
+    · exact h.2.1.1
+    · intro w
+      simpa using h.2.2 _ w
+  · rw [count_eq_zero_of_not_mem h']
+
+grind_pattern Nodup.count => count a l, Nodup l
+
+@[grind =]
+theorem nodup_iff_count [BEq α] [LawfulBEq α] {l : List α} : l.Nodup ↔ ∀ a, count a l ≤ 1 := by
+  induction l with
+  | nil => simp
+  | cons x l ih =>
+    constructor
+    · intro h a
+      simp at h
+      rw [count_cons]
+      split <;> rename_i h'
+      · simp at h'
+        rw [count_eq_zero.mpr ?_]
+        · exact Nat.le_refl _
+        · exact h' ▸ h.1
+      · simp at h'
+        refine ih.mp h.2 a
+    · intro h
+      simp only [count_cons] at h
+      simp only [nodup_cons]
+      constructor
+      · intro w
+        specialize h x
+        simp at h
+        have := count_pos_iff.mpr w
+        replace h := le_of_lt_succ h
+        apply Nat.lt_irrefl _ (Nat.lt_of_lt_of_le this h)
+      · rw [ih]
+        intro a
+        specialize h a
+        exact le_of_add_right_le h
+
 end List

src/Init/Data/List/Perm.lean

@@ -23,8 +23,7 @@ The notation `~` is used for permutation equivalence.
 -/
 
 set_option linter.listVariables true -- Enforce naming conventions for `List`/`Array`/`Vector` variables.
--- TODO: restore after an update-stage0
--- set_option linter.indexVariables true -- Enforce naming conventions for index variables.
+set_option linter.indexVariables true -- Enforce naming conventions for index variables.
 
 open Nat
 
@@ -90,6 +89,9 @@ theorem Perm.mem_iff {a : α} {l₁ l₂ : List α} (p : l₁ ~ l₂) : a ∈ l
   | swap => simp only [mem_cons, or_left_comm]
   | trans _ _ ih₁ ih₂ => simp only [ih₁, ih₂]
 
+grind_pattern Perm.mem_iff => l₁ ~ l₂, a ∈ l₁
+grind_pattern Perm.mem_iff => l₁ ~ l₂, a ∈ l₂
+
 theorem Perm.subset {l₁ l₂ : List α} (p : l₁ ~ l₂) : l₁ ⊆ l₂ := fun _ => p.mem_iff.mp
 
 theorem Perm.append_right {l₁ l₂ : List α} (t₁ : List α) (p : l₁ ~ l₂) : l₁ ++ t₁ ~ l₂ ++ t₁ := by
@@ -106,9 +108,15 @@ theorem Perm.append_left {t₁ t₂ : List α} : ∀ l : List α, t₁ ~ t₂
 theorem Perm.append {l₁ l₂ t₁ t₂ : List α} (p₁ : l₁ ~ l₂) (p₂ : t₁ ~ t₂) : l₁ ++ t₁ ~ l₂ ++ t₂ :=
   (p₁.append_right t₁).trans (p₂.append_left l₂)
 
+grind_pattern Perm.append => l₁ ~ l₂, t₁ ~ t₂, l₁ ++ t₁
+grind_pattern Perm.append => l₁ ~ l₂, t₁ ~ t₂, l₂ ++ t₂
+
 theorem Perm.append_cons (a : α) {l₁ l₂ r₁ r₂ : List α} (p₁ : l₁ ~ l₂) (p₂ : r₁ ~ r₂) :
     l₁ ++ a :: r₁ ~ l₂ ++ a :: r₂ := p₁.append (p₂.cons a)
 
+grind_pattern Perm.append_cons => l₁ ~ l₂, r₁ ~ r₂, l₁ ++ a :: r₁
+grind_pattern Perm.append_cons => l₁ ~ l₂, r₁ ~ r₂, l₂ ++ a :: r₂
+
 @[simp] theorem perm_middle {a : α} : ∀ {l₁ l₂ : List α}, l₁ ++ a :: l₂ ~ a :: (l₁ ++ l₂)
   | [], _ => .refl _
   | b :: _, _ => (Perm.cons _ perm_middle).trans (swap a b _)
@@ -194,9 +202,15 @@ theorem Perm.filterMap (f : α → Option β) {l₁ l₂ : List α} (p : l₁ ~
   | swap x y l₂ => cases hx : f x <;> cases hy : f y <;> simp [hx, hy, filterMap_cons, swap]
   | trans _p₁ _p₂ IH₁ IH₂ => exact IH₁.trans IH₂
 
+grind_pattern Perm.filterMap => l₁ ~ l₂, filterMap f l₁
+grind_pattern Perm.filterMap => l₁ ~ l₂, filterMap f l₂
+
 theorem Perm.map (f : α → β) {l₁ l₂ : List α} (p : l₁ ~ l₂) : map f l₁ ~ map f l₂ :=
   filterMap_eq_map ▸ p.filterMap _
 
+grind_pattern Perm.map => l₁ ~ l₂, map f l₁
+grind_pattern Perm.map => l₁ ~ l₂, map f l₂
+
 theorem Perm.pmap {p : α → Prop} (f : ∀ a, p a → β) {l₁ l₂ : List α} (p : l₁ ~ l₂) {H₁ H₂} :
     pmap f l₁ H₁ ~ pmap f l₂ H₂ := by
   induction p with
@@ -205,12 +219,18 @@ theorem Perm.pmap {p : α → Prop} (f : ∀ a, p a → β) {l₁ l₂ : List α
   | swap x y => simp [swap]
   | trans _p₁ p₂ IH₁ IH₂ => exact IH₁.trans (IH₂ (H₁ := fun a m => H₂ a (p₂.subset m)))
 
+grind_pattern Perm.pmap => l₁ ~ l₂, pmap f l₁ H₁
+grind_pattern Perm.pmap => l₁ ~ l₂, pmap f l₂ H₂
+
 theorem Perm.unattach {α : Type u} {p : α → Prop} {l₁ l₂ : List { x // p x }} (h : l₁ ~ l₂) :
     l₁.unattach.Perm l₂.unattach := h.map _
 
 theorem Perm.filter (p : α → Bool) {l₁ l₂ : List α} (s : l₁ ~ l₂) :
     filter p l₁ ~ filter p l₂ := by rw [← filterMap_eq_filter]; apply s.filterMap
 
+grind_pattern Perm.filter => l₁ ~ l₂, filter p l₁
+grind_pattern Perm.filter => l₁ ~ l₂, filter p l₂
+
 theorem filter_append_perm (p : α → Bool) (l : List α) :
     filter p l ++ filter (fun x => !p x) l ~ l := by
   induction l with
@@ -388,12 +408,16 @@ theorem Perm.erase (a : α) {l₁ l₂ : List α} (p : l₁ ~ l₂) : l₁.erase
     have h₂ : a ∉ l₂ := mt p.mem_iff.2 h₁
     rw [erase_of_not_mem h₁, erase_of_not_mem h₂]; exact p
 
+grind_pattern Perm.erase => l₁ ~ l₂, l₁.erase a
+grind_pattern Perm.erase => l₁ ~ l₂, l₂.erase a
+
 theorem cons_perm_iff_perm_erase {a : α} {l₁ l₂ : List α} :
     a :: l₁ ~ l₂ ↔ a ∈ l₂ ∧ l₁ ~ l₂.erase a := by
   refine ⟨fun h => ?_, fun ⟨m, h⟩ => (h.cons a).trans (perm_cons_erase m).symm⟩
   have : a ∈ l₂ := h.subset mem_cons_self
   exact ⟨this, (h.trans <| perm_cons_erase this).cons_inv⟩
 
+@[grind =]
 theorem perm_iff_count {l₁ l₂ : List α} : l₁ ~ l₂ ↔ ∀ a, count a l₁ = count a l₂ := by
   refine ⟨Perm.count_eq, fun H => ?_⟩
   induction l₁ generalizing l₂ with
@@ -410,6 +434,12 @@ theorem perm_iff_count {l₁ l₂ : List α} : l₁ ~ l₂ ↔ ∀ a, count a l
     rw [(perm_cons_erase this).count_eq] at H
     by_cases h : b = a <;> simpa [h, count_cons, Nat.succ_inj] using H
 
+theorem Perm.count (h : l₁ ~ l₂) (a : α) : count a l₁ = count a l₂ := by
+  rw [perm_iff_count.mp h]
+
+grind_pattern Perm.count => l₁ ~ l₂, count a l₁
+grind_pattern Perm.count => l₁ ~ l₂, count a l₂
+
 theorem isPerm_iff : ∀ {l₁ l₂ : List α}, l₁.isPerm l₂ ↔ l₁ ~ l₂
   | [], [] => by simp [isPerm, isEmpty]
   | [], _ :: _ => by simp [isPerm, isEmpty, Perm.nil_eq]
@@ -425,6 +455,9 @@ protected theorem Perm.insert (a : α) {l₁ l₂ : List α} (p : l₁ ~ l₂) :
     have := p.cons a
     simpa [h, mt p.mem_iff.2 h] using this
 
+grind_pattern Perm.insert => l₁ ~ l₂, l₁.insert a
+grind_pattern Perm.insert => l₁ ~ l₂, l₂.insert a
+
 theorem perm_insert_swap (x y : α) (l : List α) :
     List.insert x (List.insert y l) ~ List.insert y (List.insert x l) := by
   by_cases xl : x ∈ l <;> by_cases yl : y ∈ l <;> simp [xl, yl]
@@ -491,6 +524,9 @@ theorem Perm.nodup {l l' : List α} (hl : l ~ l') (hR : l.Nodup) : l'.Nodup := h
 theorem Perm.nodup_iff {l₁ l₂ : List α} : l₁ ~ l₂ → (Nodup l₁ ↔ Nodup l₂) :=
   Perm.pairwise_iff <| @Ne.symm α
 
+grind_pattern Perm.nodup_iff => l₁ ~ l₂, Nodup l₁
+grind_pattern Perm.nodup_iff => l₁ ~ l₂, Nodup l₂
+
 theorem Perm.flatten {l₁ l₂ : List (List α)} (h : l₁ ~ l₂) : l₁.flatten ~ l₂.flatten := by
   induction h with
   | nil => rfl
@@ -541,20 +577,30 @@ theorem perm_insertIdx {α} (x : α) (l : List α) {i} (h : i ≤ l.length) :
 
 namespace Perm
 
-theorem take {l₁ l₂ : List α} (h : l₁ ~ l₂) {n : Nat} (w : l₁.drop n ~ l₂.drop n) :
-    l₁.take n ~ l₂.take n := by
+theorem take {l₁ l₂ : List α} (h : l₁ ~ l₂) {i : Nat} (w : l₁.drop i ~ l₂.drop i) :
+    l₁.take i ~ l₂.take i := by
   classical
   rw [perm_iff_count] at h w ⊢
-  rw [← take_append_drop n l₁, ← take_append_drop n l₂] at h
+  rw [← take_append_drop i l₁, ← take_append_drop i l₂] at h
   simpa only [count_append, w, Nat.add_right_cancel_iff] using h
 
-theorem drop {l₁ l₂ : List α} (h : l₁ ~ l₂) {n : Nat} (w : l₁.take n ~ l₂.take n) :
-    l₁.drop n ~ l₂.drop n := by
+theorem drop {l₁ l₂ : List α} (h : l₁ ~ l₂) {i : Nat} (w : l₁.take i ~ l₂.take i) :
+    l₁.drop i ~ l₂.drop i := by
   classical
   rw [perm_iff_count] at h w ⊢
-  rw [← take_append_drop n l₁, ← take_append_drop n l₂] at h
+  rw [← take_append_drop i l₁, ← take_append_drop i l₂] at h
   simpa only [count_append, w, Nat.add_left_cancel_iff] using h
 
+theorem sum_nat {l₁ l₂ : List Nat} (h : l₁ ~ l₂) : l₁.sum = l₂.sum := by
+  induction h with
+  | nil => simp
+  | cons _ _ ih => simp [ih]
+  | swap => simpa [List.sum_cons] using Nat.add_left_comm ..
+  | trans _ _ ih₁ ih₂ => simp [ih₁, ih₂]
+
+grind_pattern Perm.sum_nat => l₁ ~ l₂, l₁.sum
+grind_pattern Perm.sum_nat => l₁ ~ l₂, l₂.sum
+
 end Perm
 
 end List

src/Init/Data/List/TakeDrop.lean

@@ -467,7 +467,7 @@ theorem replace_takeWhile [BEq α] [LawfulBEq α] {l : List α} {p : α → Bool
 
 /-! ### splitAt -/
 
-@[simp] theorem splitAt_eq {i : Nat} {l : List α} : splitAt i l = (l.take i, l.drop i) := by
+@[simp, grind =] theorem splitAt_eq {i : Nat} {l : List α} : splitAt i l = (l.take i, l.drop i) := by
   rw [splitAt, splitAt_go, reverse_nil, nil_append]
   split <;> simp_all [take_of_length_le, drop_of_length_le]
 

src/Init/Data/Nat/Basic.lean

@@ -406,6 +406,12 @@ theorem le_of_add_right_le {n m k : Nat} (h : n + k ≤ m) : n ≤ m :=
 theorem le_add_right_of_le {n m k : Nat} (h : n ≤ m) : n ≤ m + k :=
   Nat.le_trans h (le_add_right m k)
 
+theorem le_of_add_left_le {n m k : Nat} (h : k + n ≤ m) : n ≤ m :=
+  Nat.le_trans (le_add_left n k) h
+
+theorem le_add_left_of_le {n m k : Nat} (h : n ≤ m) : n ≤ k + m :=
+  Nat.le_trans h (le_add_left m k)
+
 theorem lt_of_add_one_le {n m : Nat} (h : n + 1 ≤ m) : n < m := h
 
 theorem add_one_le_of_lt {n m : Nat} (h : n < m) : n + 1 ≤ m := h

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

@@ -51,24 +51,24 @@ noncomputable def div2Induction {motive : Nat → Sort u}
       apply hyp
       exact Nat.div_lt_self n_pos (Nat.le_refl _)
 
-@[simp] theorem zero_and (x : Nat) : 0 &&& x = 0 := by
+@[simp, grind =] theorem zero_and (x : Nat) : 0 &&& x = 0 := by
   simp only [HAnd.hAnd, AndOp.and, land]
   unfold bitwise
   simp
 
-@[simp] theorem and_zero (x : Nat) : x &&& 0 = 0 := by
+@[simp, grind =] theorem and_zero (x : Nat) : x &&& 0 = 0 := by
   simp only [HAnd.hAnd, AndOp.and, land]
   unfold bitwise
   simp
 
-@[simp] theorem one_and_eq_mod_two (n : Nat) : 1 &&& n = n % 2 := by
+@[simp, grind =] theorem one_and_eq_mod_two (n : Nat) : 1 &&& n = n % 2 := by
   if n0 : n = 0 then
     subst n0; decide
   else
     simp only [HAnd.hAnd, AndOp.and, land]
     cases mod_two_eq_zero_or_one n with | _ h => simp [bitwise, n0, h]
 
-@[simp] theorem and_one_is_mod (x : Nat) : x &&& 1 = x % 2 := by
+@[simp, grind =] theorem and_one_is_mod (x : Nat) : x &&& 1 = x % 2 := by
   if xz : x = 0 then
     simp [xz, zero_and]
   else
@@ -102,11 +102,12 @@ Depending on use cases either `testBit_add_one` or `testBit_div_two`
 may be more useful as a `simp` lemma, so neither is a global `simp` lemma.
 -/
 -- We turn `testBit_add_one` on as a `local simp` for this file.
-@[local simp]
+@[local simp, grind _=_]
 theorem testBit_add_one (x i : Nat) : testBit x (i + 1) = testBit (x/2) i := by
   unfold testBit
   simp [shiftRight_succ_inside]
 
+@[grind _=_]
 theorem testBit_add (x i n : Nat) : testBit x (i + n) = testBit (x / 2 ^ n) i := by
   revert x
   induction n with
@@ -122,6 +123,7 @@ theorem testBit_div_two (x i : Nat) : testBit (x / 2) i = testBit x (i + 1) := b
 theorem testBit_div_two_pow (x i : Nat) : testBit (x / 2 ^ n) i = testBit x (i + n) :=
   testBit_add .. |>.symm
 
+@[grind =]
 theorem testBit_eq_decide_div_mod_eq {x : Nat} : testBit x i = decide (x / 2^i % 2 = 1) := by
   induction i generalizing x with
   | zero =>
@@ -290,7 +292,7 @@ theorem testBit_two_pow_add_gt {i j : Nat} (j_lt_i : j < i) (x : Nat) :
   | d+1 =>
     simp [Nat.pow_succ, Nat.mul_comm _ 2, Nat.mul_add_mod]
 
-@[simp] theorem testBit_mod_two_pow (x j i : Nat) :
+@[simp, grind =] theorem testBit_mod_two_pow (x j i : Nat) :
     testBit (x % 2^j) i = (decide (i < j) && testBit x i) := by
   induction x using Nat.strongRecOn generalizing j i with
   | ind x hyp =>
@@ -322,6 +324,7 @@ theorem not_decide_mod_two_eq_one (x : Nat)
     : (!decide (x % 2 = 1)) = decide (x % 2 = 0) := by
   cases Nat.mod_two_eq_zero_or_one x <;> (rename_i p; simp [p])
 
+@[grind =]
 theorem testBit_two_pow_sub_succ (h₂ : x < 2 ^ n) (i : Nat) :
     testBit (2^n - (x + 1)) i = (decide (i < n) && ! testBit x i) := by
   induction i generalizing n x with
@@ -357,6 +360,7 @@ theorem testBit_one_eq_true_iff_self_eq_zero {i : Nat} :
     Nat.testBit 1 i = true ↔ i = 0 := by
   cases i <;> simp
 
+@[grind =]
 theorem testBit_two_pow {n m : Nat} : testBit (2 ^ n) m = decide (n = m) := by
   rw [testBit, shiftRight_eq_div_pow]
   by_cases h : n = m
@@ -482,18 +486,20 @@ theorem bitwise_mod_two_pow (of_false_false : f false false = false := by rfl) :
 
 /-! ### and -/
 
-@[simp] theorem testBit_and (x y i : Nat) : (x &&& y).testBit i = (x.testBit i && y.testBit i) := by
+@[simp, grind =] theorem testBit_and (x y i : Nat) : (x &&& y).testBit i = (x.testBit i && y.testBit i) := by
   simp [HAnd.hAnd, AndOp.and, land, testBit_bitwise ]
 
 
-@[simp] protected theorem and_self (x : Nat) : x &&& x = x := by
+@[simp, grind =] protected theorem and_self (x : Nat) : x &&& x = x := by
    apply Nat.eq_of_testBit_eq
    simp
 
+@[grind =]
 protected theorem and_comm (x y : Nat) : x &&& y = y &&& x := by
    apply Nat.eq_of_testBit_eq
    simp [Bool.and_comm]
 
+@[grind _=_]
 protected theorem and_assoc (x y z : Nat) : (x &&& y) &&& z = x &&& (y &&& z) := by
    apply Nat.eq_of_testBit_eq
    simp [Bool.and_assoc]
@@ -537,54 +543,63 @@ abbrev and_pow_two_sub_one_of_lt_two_pow := @and_two_pow_sub_one_of_lt_two_pow
   rw [testBit_and]
   simp
 
+@[grind _=_]
 theorem and_div_two_pow : (a &&& b) / 2 ^ n = a / 2 ^ n &&& b / 2 ^ n :=
   bitwise_div_two_pow
 
+@[grind _=_]
 theorem and_div_two : (a &&& b) / 2 = a / 2 &&& b / 2 :=
   and_div_two_pow (n := 1)
 
+@[grind _=_]
 theorem and_mod_two_pow : (a &&& b) % 2 ^ n = (a % 2 ^ n) &&& (b % 2 ^ n) :=
   bitwise_mod_two_pow
 
 /-! ### lor -/
 
-@[simp] theorem zero_or (x : Nat) : 0 ||| x = x := by
+@[simp, grind =] theorem zero_or (x : Nat) : 0 ||| x = x := by
   simp only [HOr.hOr, OrOp.or, lor]
   unfold bitwise
   simp [@eq_comm _ 0]
 
-@[simp] theorem or_zero (x : Nat) : x ||| 0 = x := by
+@[simp, grind =] theorem or_zero (x : Nat) : x ||| 0 = x := by
   simp only [HOr.hOr, OrOp.or, lor]
   unfold bitwise
   simp [@eq_comm _ 0]
 
-@[simp] theorem testBit_or (x y i : Nat) : (x ||| y).testBit i = (x.testBit i || y.testBit i) := by
+@[simp, grind =] theorem testBit_or (x y i : Nat) : (x ||| y).testBit i = (x.testBit i || y.testBit i) := by
   simp [HOr.hOr, OrOp.or, lor, testBit_bitwise ]
 
-@[simp] protected theorem or_self (x : Nat) : x ||| x = x := by
+@[simp, grind =] protected theorem or_self (x : Nat) : x ||| x = x := by
    apply Nat.eq_of_testBit_eq
    simp
 
+@[grind =]
 protected theorem or_comm (x y : Nat) : x ||| y = y ||| x := by
    apply Nat.eq_of_testBit_eq
    simp [Bool.or_comm]
 
+@[grind _=_]
 protected theorem or_assoc (x y z : Nat) : (x ||| y) ||| z = x ||| (y ||| z) := by
    apply Nat.eq_of_testBit_eq
    simp [Bool.or_assoc]
 
+@[grind _=_]
 theorem and_or_distrib_left (x y z : Nat) : x &&& (y ||| z) = (x &&& y) ||| (x &&& z) := by
    apply Nat.eq_of_testBit_eq
    simp [Bool.and_or_distrib_left]
 
+@[grind _=_]
 theorem and_distrib_right (x y z : Nat) : (x ||| y) &&& z = (x &&& z) ||| (y &&& z) := by
    apply Nat.eq_of_testBit_eq
    simp [Bool.and_or_distrib_right]
 
+@[grind _=_]
 theorem or_and_distrib_left (x y z : Nat) : x ||| (y &&& z) = (x ||| y) &&& (x ||| z) := by
    apply Nat.eq_of_testBit_eq
    simp [Bool.or_and_distrib_left]
 
+@[grind _=_]
 theorem or_and_distrib_right (x y z : Nat) : (x &&& y) ||| z = (x ||| z) &&& (y ||| z) := by
    apply Nat.eq_of_testBit_eq
    simp [Bool.or_and_distrib_right]
@@ -610,37 +625,42 @@ theorem or_lt_two_pow {x y n : Nat} (left : x < 2^n) (right : y < 2^n) : x ||| y
   rw [testBit_or]
   simp
 
+@[grind _=_]
 theorem or_div_two_pow : (a ||| b) / 2 ^ n = a / 2 ^ n ||| b / 2 ^ n :=
   bitwise_div_two_pow
 
+@[grind _=_]
 theorem or_div_two : (a ||| b) / 2 = a / 2 ||| b / 2 :=
   or_div_two_pow (n := 1)
 
+@[grind _=_]
 theorem or_mod_two_pow : (a ||| b) % 2 ^ n = a % 2 ^ n ||| b % 2 ^ n :=
   bitwise_mod_two_pow
 
 /-! ### xor -/
 
-@[simp] theorem testBit_xor (x y i : Nat) :
+@[simp, grind =] theorem testBit_xor (x y i : Nat) :
     (x ^^^ y).testBit i = ((x.testBit i) ^^ (y.testBit i)) := by
   simp [HXor.hXor, Xor.xor, xor, testBit_bitwise ]
 
-@[simp] theorem zero_xor (x : Nat) : 0 ^^^ x = x := by
+@[simp, grind =] theorem zero_xor (x : Nat) : 0 ^^^ x = x := by
    apply Nat.eq_of_testBit_eq
    simp
 
-@[simp] theorem xor_zero (x : Nat) : x ^^^ 0 = x := by
+@[simp, grind =] theorem xor_zero (x : Nat) : x ^^^ 0 = x := by
    apply Nat.eq_of_testBit_eq
    simp
 
-@[simp] protected theorem xor_self (x : Nat) : x ^^^ x = 0 := by
+@[simp, grind =] protected theorem xor_self (x : Nat) : x ^^^ x = 0 := by
    apply Nat.eq_of_testBit_eq
    simp
 
+@[grind =]
 protected theorem xor_comm (x y : Nat) : x ^^^ y = y ^^^ x := by
    apply Nat.eq_of_testBit_eq
    simp [Bool.xor_comm]
 
+@[grind _=_]
 protected theorem xor_assoc (x y z : Nat) : (x ^^^ y) ^^^ z = x ^^^ (y ^^^ z) := by
    apply Nat.eq_of_testBit_eq
    simp
@@ -658,10 +678,12 @@ instance : Std.LawfulCommIdentity (α := Nat) (· ^^^ ·) 0 where
 theorem xor_lt_two_pow {x y n : Nat} (left : x < 2^n) (right : y < 2^n) : x ^^^ y < 2^n :=
   bitwise_lt_two_pow left right
 
+@[grind _=_]
 theorem and_xor_distrib_right {a b c : Nat} : (a ^^^ b) &&& c = (a &&& c) ^^^ (b &&& c) := by
   apply Nat.eq_of_testBit_eq
   simp [Bool.and_xor_distrib_right]
 
+@[grind _=_]
 theorem and_xor_distrib_left {a b c : Nat} : a &&& (b ^^^ c) = (a &&& b) ^^^ (a &&& c) := by
   apply Nat.eq_of_testBit_eq
   simp [Bool.and_xor_distrib_left]
@@ -671,12 +693,15 @@ theorem and_xor_distrib_left {a b c : Nat} : a &&& (b ^^^ c) = (a &&& b) ^^^ (a
   rw [testBit_xor]
   simp
 
+@[grind _=_]
 theorem xor_div_two_pow : (a ^^^ b) / 2 ^ n = a / 2 ^ n ^^^ b / 2 ^ n :=
   bitwise_div_two_pow
 
+@[grind _=_]
 theorem xor_div_two : (a ^^^ b) / 2 = a / 2 ^^^ b / 2 :=
   xor_div_two_pow (n := 1)
 
+@[grind _=_]
 theorem xor_mod_two_pow : (a ^^^ b) % 2 ^ n = a % 2 ^ n ^^^ b % 2 ^ n :=
   bitwise_mod_two_pow
 
@@ -713,6 +738,7 @@ theorem testBit_two_pow_mul_add (a : Nat) {b i : Nat} (b_lt : b < 2^i) (j : Nat)
 @[deprecated testBit_two_pow_mul_add (since := "2025-03-18")]
 abbrev testBit_mul_pow_two_add := @testBit_two_pow_mul_add
 
+@[grind =]
 theorem testBit_two_pow_mul :
     testBit (2 ^ i * a) j = (decide (j ≥ i) && testBit a (j-i)) := by
   have gen := testBit_two_pow_mul_add a (Nat.two_pow_pos i) j
@@ -721,6 +747,11 @@ theorem testBit_two_pow_mul :
   cases Nat.lt_or_ge j i with
   | _ p => simp [p, Nat.not_le_of_lt, Nat.not_lt_of_le]
 
+@[grind =] -- Ideally `grind` could do this just with `testBit_two_pow_mul`.
+theorem testBit_mul_two_pow (x j i : Nat) :
+    (x * 2 ^ i).testBit j = (decide (i ≤ j) && x.testBit (j - i)) := by
+  rw [Nat.mul_comm, testBit_two_pow_mul]
+
 @[deprecated testBit_two_pow_mul (since := "2025-03-18")]
 abbrev testBit_mul_pow_two := @testBit_two_pow_mul
 
@@ -744,21 +775,17 @@ abbrev mul_add_lt_is_or := @two_pow_add_eq_or_of_lt
 
 /-! ### shiftLeft and shiftRight -/
 
-@[simp] theorem testBit_shiftLeft (x : Nat) : testBit (x <<< i) j =
+@[simp, grind =] theorem testBit_shiftLeft (x : Nat) : testBit (x <<< i) j =
     (decide (j ≥ i) && testBit x (j-i)) := by
   simp [shiftLeft_eq, Nat.mul_comm _ (2^_), testBit_two_pow_mul]
 
-@[simp] theorem testBit_shiftRight (x : Nat) : testBit (x >>> i) j = testBit x (i+j) := by
+@[simp, grind =] theorem testBit_shiftRight (x : Nat) : testBit (x >>> i) j = testBit x (i+j) := by
   simp [testBit, ←shiftRight_add]
 
 @[simp] theorem shiftLeft_mod_two_eq_one : x <<< i % 2 = 1 ↔ i = 0 ∧ x % 2 = 1 := by
   rw [mod_two_eq_one_iff_testBit_zero, testBit_shiftLeft]
   simp
 
-theorem testBit_mul_two_pow (x i n : Nat) :
-    (x * 2 ^ n).testBit i = (decide (n ≤ i) && x.testBit (i - n)) := by
-  rw [← testBit_shiftLeft, shiftLeft_eq]
-
 theorem bitwise_mul_two_pow (of_false_false : f false false = false := by rfl) :
     (bitwise f x y) * 2 ^ n = bitwise f (x * 2 ^ n) (y * 2 ^ n) := by
   apply Nat.eq_of_testBit_eq
@@ -768,16 +795,20 @@ theorem bitwise_mul_two_pow (of_false_false : f false false = false := by rfl) :
   · simp [hn]
   · simp [hn, of_false_false]
 
+@[grind _=_]
 theorem shiftLeft_bitwise_distrib {a b : Nat} (of_false_false : f false false = false := by rfl) :
     (bitwise f a b) <<< i = bitwise f (a <<< i) (b <<< i) := by
   simp [shiftLeft_eq, bitwise_mul_two_pow of_false_false]
 
+@[grind _=_]
 theorem shiftLeft_and_distrib {a b : Nat} : (a &&& b) <<< i = a <<< i &&& b <<< i :=
   shiftLeft_bitwise_distrib
 
+@[grind _=_]
 theorem shiftLeft_or_distrib {a b : Nat} : (a ||| b) <<< i = a <<< i ||| b <<< i :=
   shiftLeft_bitwise_distrib
 
+@[grind _=_]
 theorem shiftLeft_xor_distrib {a b : Nat} : (a ^^^ b) <<< i = a <<< i ^^^ b <<< i :=
   shiftLeft_bitwise_distrib
 
@@ -786,16 +817,20 @@ theorem shiftLeft_xor_distrib {a b : Nat} : (a ^^^ b) <<< i = a <<< i ^^^ b <<<
   simp only [testBit, one_and_eq_mod_two, mod_two_bne_zero]
   exact (Bool.beq_eq_decide_eq _ _).symm
 
+@[grind _=_]
 theorem shiftRight_bitwise_distrib {a b : Nat} (of_false_false : f false false = false := by rfl) :
     (bitwise f a b) >>> i = bitwise f (a >>> i) (b >>> i) := by
   simp [shiftRight_eq_div_pow, bitwise_div_two_pow of_false_false]
 
+@[grind _=_]
 theorem shiftRight_and_distrib {a b : Nat} : (a &&& b) >>> i = a >>> i &&& b >>> i :=
   shiftRight_bitwise_distrib
 
+@[grind _=_]
 theorem shiftRight_or_distrib {a b : Nat} : (a ||| b) >>> i = a >>> i ||| b >>> i :=
   shiftRight_bitwise_distrib
 
+@[grind _=_]
 theorem shiftRight_xor_distrib {a b : Nat} : (a ^^^ b) >>> i = a >>> i ^^^ b >>> i :=
   shiftRight_bitwise_distrib
 

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

@@ -210,4 +210,19 @@ theorem mod_mod_eq_mod_mod_mod_of_dvd {a b c : Nat} (hb : b ∣ c) :
   have : b < c := Nat.lt_of_le_of_ne (Nat.le_of_dvd hc hb) hb'
   rw [Nat.mod_mod_of_dvd' hb, Nat.mod_eq_of_lt this, Nat.mod_mod_of_dvd _ hb]
 
+theorem mod_eq_mod_iff {x y z : Nat} :
+    x % z = y % z ↔ ∃ k₁ k₂, x + k₁ * z = y + k₂ * z := by
+  constructor
+  · rw [Nat.mod_def, Nat.mod_def]
+    rw [Nat.sub_eq_iff_eq_add, Nat.add_comm, ← Nat.add_sub_assoc, eq_comm, Nat.sub_eq_iff_eq_add, eq_comm]
+    · intro h
+      refine ⟨(y / z), (x / z), ?_⟩
+      rwa [Nat.mul_comm z, Nat.add_comm _ y, Nat.mul_comm z] at h
+    · exact le_add_left_of_le (mul_div_le y z)
+    · exact mul_div_le y z
+    · exact mul_div_le x z
+  · rintro ⟨k₁, k₂, h⟩
+    replace h := congrArg (· % z) h
+    simpa using h
+
 end Nat

src/Init/Data/Nat/Fold.lean

@@ -205,7 +205,7 @@ theorem allTR_loop_congr {n m : Nat} (w : n = m) (f : (i : Nat) → i < n → Bo
 @[simp] theorem fold_succ {α : Type u} (n : Nat) (f : (i : Nat) → i < n + 1 → α → α) (init : α) :
     fold (n + 1) f init = f n (by omega) (fold n (fun i h => f i (by omega)) init) := by simp [fold]
 
-theorem fold_eq_finRange_foldl {α : Type u} (n : Nat) (f : (i : Nat) → i < n → α → α) (init : α) :
+@[grind =] theorem fold_eq_finRange_foldl {α : Type u} (n : Nat) (f : (i : Nat) → i < n → α → α) (init : α) :
     fold n f init = (List.finRange n).foldl (fun acc ⟨i, h⟩ => f i h acc) init := by
   induction n with
   | zero => simp
@@ -221,7 +221,7 @@ theorem fold_eq_finRange_foldl {α : Type u} (n : Nat) (f : (i : Nat) → i < n
     foldRev (n + 1) f init = foldRev n (fun i h => f i (by omega)) (f n (by omega) init) := by
   simp [foldRev]
 
-theorem foldRev_eq_finRange_foldr {α : Type u} (n : Nat) (f : (i : Nat) → i < n → α → α) (init : α) :
+@[grind =] theorem foldRev_eq_finRange_foldr {α : Type u} (n : Nat) (f : (i : Nat) → i < n → α → α) (init : α) :
     foldRev n f init = (List.finRange n).foldr (fun ⟨i, h⟩ acc => f i h acc) init := by
   induction n generalizing init with
   | zero => simp
@@ -234,7 +234,7 @@ theorem foldRev_eq_finRange_foldr {α : Type u} (n : Nat) (f : (i : Nat) → i <
 @[simp] theorem any_succ {n : Nat} (f : (i : Nat) → i < n + 1 → Bool) :
     any (n + 1) f = (any n (fun i h => f i (by omega)) || f n (by omega)) := by simp [any]
 
-theorem any_eq_finRange_any {n : Nat} (f : (i : Nat) → i < n → Bool) :
+@[grind =] theorem any_eq_finRange_any {n : Nat} (f : (i : Nat) → i < n → Bool) :
     any n f = (List.finRange n).any (fun ⟨i, h⟩ => f i h) := by
   induction n with
   | zero => simp
@@ -247,7 +247,7 @@ theorem any_eq_finRange_any {n : Nat} (f : (i : Nat) → i < n → Bool) :
 @[simp] theorem all_succ {n : Nat} (f : (i : Nat) → i < n + 1 → Bool) :
     all (n + 1) f = (all n (fun i h => f i (by omega)) && f n (by omega)) := by simp [all]
 
-theorem all_eq_finRange_all {n : Nat} (f : (i : Nat) → i < n → Bool) :
+@[grind =] theorem all_eq_finRange_all {n : Nat} (f : (i : Nat) → i < n → Bool) :
     all n f = (List.finRange n).all (fun ⟨i, h⟩ => f i h) := by
   induction n with
   | zero => simp

src/Init/Data/Prod.lean

@@ -43,6 +43,7 @@ theorem map_comp_map (f : α → β) (f' : γ → δ) (g : β → ε) (g' : δ
 Composing a `Prod.map` with another `Prod.map` is equal to
 a single `Prod.map` of composed functions, fully applied.
 -/
+@[grind _=_]
 theorem map_map (f : α → β) (f' : γ → δ) (g : β → ε) (g' : δ → ζ) (x : α × γ) :
     Prod.map g g' (Prod.map f f' x) = Prod.map (g ∘ f) (g' ∘ f') x :=
   rfl
@@ -56,19 +57,19 @@ Examples:
 -/
 @[expose] def swap : α × β → β × α := fun p => (p.2, p.1)
 
-@[simp]
+@[simp, grind =]
 theorem swap_swap : ∀ x : α × β, swap (swap x) = x
   | ⟨_, _⟩ => rfl
 
-@[simp]
+@[simp, grind =]
 theorem fst_swap {p : α × β} : (swap p).1 = p.2 :=
   rfl
 
-@[simp]
+@[simp, grind =]
 theorem snd_swap {p : α × β} : (swap p).2 = p.1 :=
   rfl
 
-@[simp]
+@[simp, grind =]
 theorem swap_prod_mk {a : α} {b : β} : swap (a, b) = (b, a) :=
   rfl
 

src/Init/Data/SInt/Lemmas.lean

@@ -9,8 +9,8 @@ prelude
 import all Init.Data.Nat.Bitwise.Basic
 import all Init.Data.SInt.Basic
 import all Init.Data.BitVec.Basic
+import Init.Data.BitVec.Lemmas
 import Init.Data.BitVec.Bitblast
-import all Init.Data.BitVec.Lemmas
 import Init.Data.Int.LemmasAux
 import all Init.Data.UInt.Basic
 import Init.Data.UInt.Lemmas

src/Init/Data/Sum/Basic.lean

@@ -76,18 +76,18 @@ section get
   | inr b => some b
   | inl _ => none
 
-@[simp] theorem isLeft_inl : (inl x : α ⊕ β).isLeft = true := rfl
-@[simp] theorem isLeft_inr : (inr x : α ⊕ β).isLeft = false := rfl
-@[simp] theorem isRight_inl : (inl x : α ⊕ β).isRight = false := rfl
-@[simp] theorem isRight_inr : (inr x : α ⊕ β).isRight = true := rfl
+@[simp, grind =] theorem isLeft_inl : (inl x : α ⊕ β).isLeft = true := rfl
+@[simp, grind =] theorem isLeft_inr : (inr x : α ⊕ β).isLeft = false := rfl
+@[simp, grind =] theorem isRight_inl : (inl x : α ⊕ β).isRight = false := rfl
+@[simp, grind =] theorem isRight_inr : (inr x : α ⊕ β).isRight = true := rfl
 
-@[simp] theorem getLeft_inl (h : (inl x : α ⊕ β).isLeft) : (inl x).getLeft h = x := rfl
-@[simp] theorem getRight_inr (h : (inr x : α ⊕ β).isRight) : (inr x).getRight h = x := rfl
+@[simp, grind =] theorem getLeft_inl (h : (inl x : α ⊕ β).isLeft) : (inl x).getLeft h = x := rfl
+@[simp, grind =] theorem getRight_inr (h : (inr x : α ⊕ β).isRight) : (inr x).getRight h = x := rfl
 
-@[simp] theorem getLeft?_inl : (inl x : α ⊕ β).getLeft? = some x := rfl
-@[simp] theorem getLeft?_inr : (inr x : α ⊕ β).getLeft? = none := rfl
-@[simp] theorem getRight?_inl : (inl x : α ⊕ β).getRight? = none := rfl
-@[simp] theorem getRight?_inr : (inr x : α ⊕ β).getRight? = some x := rfl
+@[simp, grind =] theorem getLeft?_inl : (inl x : α ⊕ β).getLeft? = some x := rfl
+@[simp, grind =] theorem getLeft?_inr : (inr x : α ⊕ β).getLeft? = none := rfl
+@[simp, grind =] theorem getRight?_inl : (inl x : α ⊕ β).getRight? = none := rfl
+@[simp, grind =] theorem getRight?_inr : (inr x : α ⊕ β).getRight? = some x := rfl
 
 end get
 
@@ -98,10 +98,10 @@ constructor is present.
 @[expose] protected def elim {α β γ} (f : α → γ) (g : β → γ) : α ⊕ β → γ :=
   fun x => Sum.casesOn x f g
 
-@[simp] theorem elim_inl (f : α → γ) (g : β → γ) (x : α) :
+@[simp, grind =] theorem elim_inl (f : α → γ) (g : β → γ) (x : α) :
     Sum.elim f g (inl x) = f x := rfl
 
-@[simp] theorem elim_inr (f : α → γ) (g : β → γ) (x : β) :
+@[simp, grind =] theorem elim_inr (f : α → γ) (g : β → γ) (x : β) :
     Sum.elim f g (inr x) = g x := rfl
 
 /--
@@ -112,9 +112,9 @@ This function maps `α ⊕ β` to `α' ⊕ β'`, sending `α` to `α'` and `β`
 @[expose] protected def map (f : α → α') (g : β → β') : α ⊕ β → α' ⊕ β' :=
   Sum.elim (inl ∘ f) (inr ∘ g)
 
-@[simp] theorem map_inl (f : α → α') (g : β → β') (x : α) : (inl x).map f g = inl (f x) := rfl
+@[simp, grind =] theorem map_inl (f : α → α') (g : β → β') (x : α) : (inl x).map f g = inl (f x) := rfl
 
-@[simp] theorem map_inr (f : α → α') (g : β → β') (x : β) : (inr x).map f g = inr (g x) := rfl
+@[simp, grind =] theorem map_inr (f : α → α') (g : β → β') (x : β) : (inr x).map f g = inr (g x) := rfl
 
 /--
 Swaps the factors of a sum type.
@@ -123,9 +123,9 @@ The constructor `Sum.inl` is replaced with `Sum.inr`, and vice versa.
 -/
 @[expose] def swap : α ⊕ β → β ⊕ α := Sum.elim inr inl
 
-@[simp] theorem swap_inl : swap (inl x : α ⊕ β) = inr x := rfl
+@[simp, grind =] theorem swap_inl : swap (inl x : α ⊕ β) = inr x := rfl
 
-@[simp] theorem swap_inr : swap (inr x : α ⊕ β) = inl x := rfl
+@[simp, grind =] theorem swap_inr : swap (inr x : α ⊕ β) = inl x := rfl
 
 section LiftRel
 
@@ -137,14 +137,14 @@ inductive LiftRel (r : α → γ → Prop) (s : β → δ → Prop) : α ⊕ β
   /-- `inr b` and `inr d` are related via `LiftRel r s` if `b` and `d` are related via `s`. -/
   | protected inr {b d} : s b d → LiftRel r s (inr b) (inr d)
 
-@[simp] theorem liftRel_inl_inl : LiftRel r s (inl a) (inl c) ↔ r a c :=
+@[simp, grind =] theorem liftRel_inl_inl : LiftRel r s (inl a) (inl c) ↔ r a c :=
   ⟨fun h => by cases h; assumption, LiftRel.inl⟩
 
-@[simp] theorem not_liftRel_inl_inr : ¬LiftRel r s (inl a) (inr d) := nofun
+@[simp, grind] theorem not_liftRel_inl_inr : ¬LiftRel r s (inl a) (inr d) := nofun
 
-@[simp] theorem not_liftRel_inr_inl : ¬LiftRel r s (inr b) (inl c) := nofun
+@[simp, grind] theorem not_liftRel_inr_inl : ¬LiftRel r s (inr b) (inl c) := nofun
 
-@[simp] theorem liftRel_inr_inr : LiftRel r s (inr b) (inr d) ↔ s b d :=
+@[simp, grind =] theorem liftRel_inr_inr : LiftRel r s (inr b) (inr d) ↔ s b d :=
   ⟨fun h => by cases h; assumption, LiftRel.inr⟩
 
 instance {r : α → γ → Prop} {s : β → δ → Prop}
@@ -171,13 +171,13 @@ inductive Lex (r : α → α → Prop) (s : β → β → Prop) : α ⊕ β →
 
 attribute [simp] Lex.sep
 
-@[simp] theorem lex_inl_inl : Lex r s (inl a₁) (inl a₂) ↔ r a₁ a₂ :=
+@[simp, grind =] theorem lex_inl_inl : Lex r s (inl a₁) (inl a₂) ↔ r a₁ a₂ :=
   ⟨fun h => by cases h; assumption, Lex.inl⟩
 
-@[simp] theorem lex_inr_inr : Lex r s (inr b₁) (inr b₂) ↔ s b₁ b₂ :=
+@[simp, grind =] theorem lex_inr_inr : Lex r s (inr b₁) (inr b₂) ↔ s b₁ b₂ :=
   ⟨fun h => by cases h; assumption, Lex.inr⟩
 
-@[simp] theorem lex_inr_inl : ¬Lex r s (inr b) (inl a) := nofun
+@[simp, grind] theorem lex_inr_inl : ¬Lex r s (inr b) (inl a) := nofun
 
 instance instDecidableRelSumLex [DecidableRel r] [DecidableRel s] : DecidableRel (Lex r s)
   | inl _, inl _ => decidable_of_iff' _ lex_inl_inl

src/Init/Data/Sum/Lemmas.lean

@@ -42,15 +42,15 @@ theorem forall_sum {γ : α ⊕ β → Sort _} {p : (∀ ab, γ ab) → Prop} :
 
 section get
 
-@[simp] theorem inl_getLeft : ∀ (x : α ⊕ β) (h : x.isLeft), inl (x.getLeft h) = x
+@[simp, grind =] theorem inl_getLeft : ∀ (x : α ⊕ β) (h : x.isLeft), inl (x.getLeft h) = x
   | inl _, _ => rfl
-@[simp] theorem inr_getRight : ∀ (x : α ⊕ β) (h : x.isRight), inr (x.getRight h) = x
+@[simp, grind =] theorem inr_getRight : ∀ (x : α ⊕ β) (h : x.isRight), inr (x.getRight h) = x
   | inr _, _ => rfl
 
-@[simp] theorem getLeft?_eq_none_iff {x : α ⊕ β} : x.getLeft? = none ↔ x.isRight := by
+@[simp, grind =] theorem getLeft?_eq_none_iff {x : α ⊕ β} : x.getLeft? = none ↔ x.isRight := by
   cases x <;> simp only [getLeft?, isRight, eq_self_iff_true, reduceCtorEq]
 
-@[simp] theorem getRight?_eq_none_iff {x : α ⊕ β} : x.getRight? = none ↔ x.isLeft := by
+@[simp, grind =] theorem getRight?_eq_none_iff {x : α ⊕ β} : x.getRight? = none ↔ x.isLeft := by
   cases x <;> simp only [getRight?, isLeft, eq_self_iff_true, reduceCtorEq]
 
 theorem eq_left_getLeft_of_isLeft : ∀ {x : α ⊕ β} (h : x.isLeft), x = inl (x.getLeft h)
@@ -71,16 +71,20 @@ theorem eq_right_getRight_of_isRight : ∀ {x : α ⊕ β} (h : x.isRight), x =
 @[simp] theorem getRight?_eq_some_iff : x.getRight? = some b ↔ x = inr b := by
   cases x <;> simp only [getRight?, Option.some.injEq, inr.injEq, reduceCtorEq]
 
-@[simp] theorem bnot_isLeft (x : α ⊕ β) : !x.isLeft = x.isRight := by cases x <;> rfl
+@[simp] theorem bnot_isLeft (x : α ⊕ β) : (!x.isLeft) = x.isRight := by cases x <;> rfl
 
 @[simp] theorem isLeft_eq_false {x : α ⊕ β} : x.isLeft = false ↔ x.isRight := by cases x <;> simp
 
+grind_pattern isLeft_eq_false => x.isLeft
+
 theorem not_isLeft {x : α ⊕ β} : ¬x.isLeft ↔ x.isRight := by simp
 
-@[simp] theorem bnot_isRight (x : α ⊕ β) : !x.isRight = x.isLeft := by cases x <;> rfl
+@[simp, grind =] theorem bnot_isRight (x : α ⊕ β) : (!x.isRight) = x.isLeft := by cases x <;> rfl
 
 @[simp] theorem isRight_eq_false {x : α ⊕ β} : x.isRight = false ↔ x.isLeft := by cases x <;> simp
 
+grind_pattern isRight_eq_false => x.isRight
+
 theorem not_isRight {x : α ⊕ β} : ¬x.isRight ↔ x.isLeft := by simp
 
 theorem isLeft_iff : x.isLeft ↔ ∃ y, x = Sum.inl y := by cases x <;> simp
@@ -122,7 +126,7 @@ theorem elim_eq_iff {u u' : α → γ} {v v' : β → γ} :
 
 /-! ### `Sum.map` -/
 
-@[simp] theorem map_map (f' : α' → α'') (g' : β' → β'') (f : α → α') (g : β → β') :
+@[simp, grind _=_] theorem map_map (f' : α' → α'') (g' : β' → β'') (f : α → α') (g : β → β') :
     ∀ x : Sum α β, (x.map f g).map f' g' = x.map (f' ∘ f) (g' ∘ g)
   | inl _ => rfl
   | inr _ => rfl
@@ -134,6 +138,7 @@ theorem elim_eq_iff {u u' : α → γ} {v v' : β → γ} :
 @[simp] theorem map_id_id : Sum.map (@id α) (@id β) = id :=
   funext fun x => Sum.recOn x (fun _ => rfl) fun _ => rfl
 
+@[grind _=_]
 theorem elim_map {f₁ : α → β} {f₂ : β → ε} {g₁ : γ → δ} {g₂ : δ → ε} {x} :
     Sum.elim f₂ g₂ (Sum.map f₁ g₁ x) = Sum.elim (f₂ ∘ f₁) (g₂ ∘ g₁) x := by
   cases x <;> rfl
@@ -142,34 +147,34 @@ theorem elim_comp_map {f₁ : α → β} {f₂ : β → ε} {g₁ : γ → δ} {
     Sum.elim f₂ g₂ ∘ Sum.map f₁ g₁ = Sum.elim (f₂ ∘ f₁) (g₂ ∘ g₁) :=
   funext fun _ => elim_map
 
-@[simp] theorem isLeft_map (f : α → β) (g : γ → δ) (x : α ⊕ γ) :
+@[simp, grind =] theorem isLeft_map (f : α → β) (g : γ → δ) (x : α ⊕ γ) :
     isLeft (x.map f g) = isLeft x := by
   cases x <;> rfl
 
-@[simp] theorem isRight_map (f : α → β) (g : γ → δ) (x : α ⊕ γ) :
+@[simp, grind =] theorem isRight_map (f : α → β) (g : γ → δ) (x : α ⊕ γ) :
     isRight (x.map f g) = isRight x := by
   cases x <;> rfl
 
-@[simp] theorem getLeft?_map (f : α → β) (g : γ → δ) (x : α ⊕ γ) :
+@[simp, grind =] theorem getLeft?_map (f : α → β) (g : γ → δ) (x : α ⊕ γ) :
     (x.map f g).getLeft? = x.getLeft?.map f := by
   cases x <;> rfl
 
-@[simp] theorem getRight?_map (f : α → β) (g : γ → δ) (x : α ⊕ γ) :
+@[simp, grind =] theorem getRight?_map (f : α → β) (g : γ → δ) (x : α ⊕ γ) :
     (x.map f g).getRight? = x.getRight?.map g := by cases x <;> rfl
 
 /-! ### `Sum.swap` -/
 
-@[simp] theorem swap_swap (x : α ⊕ β) : swap (swap x) = x := by cases x <;> rfl
+@[simp, grind =] theorem swap_swap (x : α ⊕ β) : swap (swap x) = x := by cases x <;> rfl
 
 @[simp] theorem swap_swap_eq : swap ∘ swap = @id (α ⊕ β) := funext <| swap_swap
 
-@[simp] theorem isLeft_swap (x : α ⊕ β) : x.swap.isLeft = x.isRight := by cases x <;> rfl
+@[simp, grind =] theorem isLeft_swap (x : α ⊕ β) : x.swap.isLeft = x.isRight := by cases x <;> rfl
 
-@[simp] theorem isRight_swap (x : α ⊕ β) : x.swap.isRight = x.isLeft := by cases x <;> rfl
+@[simp, grind =] theorem isRight_swap (x : α ⊕ β) : x.swap.isRight = x.isLeft := by cases x <;> rfl
 
-@[simp] theorem getLeft?_swap (x : α ⊕ β) : x.swap.getLeft? = x.getRight? := by cases x <;> rfl
+@[simp, grind =] theorem getLeft?_swap (x : α ⊕ β) : x.swap.getLeft? = x.getRight? := by cases x <;> rfl
 
-@[simp] theorem getRight?_swap (x : α ⊕ β) : x.swap.getRight? = x.getLeft? := by cases x <;> rfl
+@[simp, grind =] theorem getRight?_swap (x : α ⊕ β) : x.swap.getRight? = x.getLeft? := by cases x <;> rfl
 
 section LiftRel
 
@@ -192,7 +197,7 @@ protected theorem LiftRel.swap (h : LiftRel r s x y) : LiftRel s r x.swap y.swap
   · exact LiftRel.inr ‹_›
   · exact LiftRel.inl ‹_›
 
-@[simp] theorem liftRel_swap_iff : LiftRel s r x.swap y.swap ↔ LiftRel r s x y :=
+@[simp, grind =] theorem liftRel_swap_iff : LiftRel s r x.swap y.swap ↔ LiftRel r s x y :=
   ⟨fun h => by rw [← swap_swap x, ← swap_swap y]; exact h.swap, LiftRel.swap⟩
 
 end LiftRel
@@ -243,6 +248,7 @@ theorem lex_wf (ha : WellFounded r) (hb : WellFounded s) : WellFounded (Lex r s)
 
 end Lex
 
+@[grind =]
 theorem elim_const_const (c : γ) :
     Sum.elim (const _ c : α → γ) (const _ c : β → γ) = const _ c := by
   apply funext

src/Init/Data/UInt/Lemmas.lean

@@ -10,10 +10,9 @@ import all Init.Data.UInt.Basic
 import all Init.Data.UInt.BasicAux
 import Init.Data.Fin.Lemmas
 import all Init.Data.Fin.Bitwise
-import all Init.Data.BitVec.Basic
 import all Init.Data.BitVec.BasicAux
+import all Init.Data.BitVec.Basic
 import Init.Data.BitVec.Lemmas
-import Init.Data.BitVec.Bitblast
 import Init.Data.Nat.Div.Lemmas
 import Init.System.Platform
 

src/Init/Data/Vector/Count.lean

@@ -40,6 +40,7 @@ theorem countP_push {a : α} {xs : Vector α n} : countP p (xs.push a) = countP
   rcases xs with ⟨xs, rfl⟩
   simp [Array.countP_push]
 
+@[grind =]
 theorem countP_singleton {a : α} : countP p #v[a] = if p a then 1 else 0 := by
   simp
 
@@ -51,7 +52,7 @@ theorem countP_le_size {xs : Vector α n} : countP p xs ≤ n := by
   rcases xs with ⟨xs, rfl⟩
   simp [Array.countP_le_size (p := p)]
 
-@[simp] theorem countP_append {xs : Vector α n} {ys : Vector α m} : countP p (xs ++ ys) = countP p xs + countP p ys := by
+@[simp, grind =] theorem countP_append {xs : Vector α n} {ys : Vector α m} : countP p (xs ++ ys) = countP p xs + countP p ys := by
   cases xs
   cases ys
   simp
@@ -116,7 +117,7 @@ theorem countP_flatMap {p : β → Bool} {xs : Vector α n} {f : α → Vector
   rcases xs with ⟨xs, rfl⟩
   simp [Array.countP_flatMap, Function.comp_def]
 
-@[simp] theorem countP_reverse {xs : Vector α n} : countP p xs.reverse = countP p xs := by
+@[simp, grind =] theorem countP_reverse {xs : Vector α n} : countP p xs.reverse = countP p xs := by
   rcases xs with ⟨xs, rfl⟩
   simp
 
@@ -136,7 +137,7 @@ section count
 
 variable [BEq α]
 
-@[simp] theorem count_empty {a : α} : count a #v[] = 0 := rfl
+@[simp, grind =] theorem count_empty {a : α} : count a #v[] = 0 := rfl
 
 theorem count_push {a b : α} {xs : Vector α n} :
     count a (xs.push b) = count a xs + if b == a then 1 else 0 := by
@@ -151,23 +152,25 @@ theorem count_eq_countP' {a : α} : count (n := n) a = countP (· == a) := by
 
 theorem count_le_size {a : α} {xs : Vector α n} : count a xs ≤ n := countP_le_size
 
+grind_pattern count_le_size => count a xs
+
 theorem count_le_count_push {a b : α} {xs : Vector α n} : count a xs ≤ count a (xs.push b) := by
   rcases xs with ⟨xs, rfl⟩
   simp [Array.count_push]
 
-@[simp] theorem count_singleton {a b : α} : count a #v[b] = if b == a then 1 else 0 := by
+@[simp, grind =] theorem count_singleton {a b : α} : count a #v[b] = if b == a then 1 else 0 := by
   simp [count_eq_countP]
 
-@[simp] theorem count_append {a : α} {xs : Vector α n} {ys : Vector α m} :
+@[simp, grind =] theorem count_append {a : α} {xs : Vector α n} {ys : Vector α m} :
     count a (xs ++ ys) = count a xs + count a ys :=
   countP_append ..
 
-@[simp] theorem count_flatten {a : α} {xss : Vector (Vector α m) n} :
+@[simp, grind =] theorem count_flatten {a : α} {xss : Vector (Vector α m) n} :
     count a xss.flatten = (xss.map (count a)).sum := by
   rcases xss with ⟨xss, rfl⟩
   simp [Array.count_flatten, Function.comp_def]
 
-@[simp] theorem count_reverse {a : α} {xs : Vector α n} : count a xs.reverse = count a xs := by
+@[simp, grind =] theorem count_reverse {a : α} {xs : Vector α n} : count a xs.reverse = count a xs := by
   rcases xs with ⟨xs, rfl⟩
   simp
 

src/Init/Data/Vector/Extract.lean

@@ -28,19 +28,19 @@ set_option linter.indexVariables false
   rcases xs with ⟨as, rfl⟩
   simp [h]
 
-@[simp]
+@[simp, grind =]
 theorem extract_push {xs : Vector α n} {b : α} {start stop : Nat} (h : stop ≤ n) :
     (xs.push b).extract start stop = (xs.extract start stop).cast (by omega) := by
   rcases xs with ⟨xs, rfl⟩
   simp [h]
 
-@[simp]
+@[simp, grind =]
 theorem extract_eq_pop {xs : Vector α n} {stop : Nat} (h : stop = n - 1) :
     xs.extract 0 stop = xs.pop.cast (by omega) := by
   rcases xs with ⟨xs, rfl⟩
   simp [h]
 
-@[simp]
+@[simp, grind _=_]
 theorem extract_append_extract {xs : Vector α n} {i j k : Nat} :
     xs.extract i j ++ xs.extract j k =
       (xs.extract (min i j) (max j k)).cast (by omega) := by
@@ -79,11 +79,12 @@ theorem getElem?_extract_of_succ {xs : Vector α n} {j : Nat} :
   · rw [if_neg (by omega)]
     simp_all
 
-@[simp] theorem extract_extract {xs : Vector α n} {i j k l : Nat} :
+@[simp, grind =] theorem extract_extract {xs : Vector α n} {i j k l : Nat} :
     (xs.extract i j).extract k l = (xs.extract (i + k) (min (i + l) j)).cast (by omega) := by
   rcases xs with ⟨xs, rfl⟩
   simp
 
+@[grind =]
 theorem extract_set {xs : Vector α n} {i j k : Nat} (h : k < n) {a : α} :
     (xs.set k a).extract i j =
       if _ : k < i then
@@ -97,12 +98,13 @@ theorem extract_set {xs : Vector α n} {i j k : Nat} (h : k < n) {a : α} :
   · simp
   · split <;> simp
 
+@[grind =]
 theorem set_extract {xs : Vector α n} {i j k : Nat} (h : k < min j n - i) {a : α} :
     (xs.extract i j).set k a = (xs.set (i + k) a).extract i j := by
   rcases xs with ⟨xs, rfl⟩
   simp [Array.set_extract]
 
-@[simp]
+@[simp, grind =]
 theorem extract_append {xs : Vector α n} {ys : Vector α m} {i j : Nat} :
     (xs ++ ys).extract i j =
       (xs.extract i j ++ ys.extract (i - n) (j - n)).cast (by omega) := by
@@ -128,12 +130,12 @@ theorem extract_append_left {xs : Vector α n} {ys : Vector α m} :
   congr 1
   omega
 
-@[simp] theorem map_extract {xs : Vector α n} {i j : Nat} :
+@[simp, grind =] theorem map_extract {xs : Vector α n} {i j : Nat} :
     (xs.extract i j).map f = (xs.map f).extract i j := by
   rcases xs with ⟨xs, rfl⟩
   simp
 
-@[simp] theorem extract_replicate {a : α} {n i j : Nat} :
+@[simp, grind =] theorem extract_replicate {a : α} {n i j : Nat} :
     (replicate n a).extract i j = replicate (min j n - i) a := by
   ext i h
   simp
@@ -161,6 +163,7 @@ theorem set_eq_push_extract_append_extract {xs : Vector α n} {i : Nat} (h : i <
   rcases xs with ⟨as, rfl⟩
   simp [Array.set_eq_push_extract_append_extract, h]
 
+@[grind =]
 theorem extract_reverse {xs : Vector α n} {i j : Nat} :
     xs.reverse.extract i j = (xs.extract (n - j) (n - i)).reverse.cast (by omega) := by
   ext i h
@@ -168,6 +171,7 @@ theorem extract_reverse {xs : Vector α n} {i j : Nat} :
   congr 1
   omega
 
+@[grind =]
 theorem reverse_extract {xs : Vector α n} {i j : Nat} :
     (xs.extract i j).reverse = (xs.reverse.extract (n - j) (n - i)).cast (by omega) := by
   rcases xs with ⟨xs, rfl⟩

src/Init/Data/Vector/InsertIdx.lean

@@ -30,15 +30,20 @@ section InsertIdx
 
 variable {a : α}
 
-@[simp]
+@[simp, grind =]
 theorem insertIdx_zero {xs : Vector α n} {x : α} : xs.insertIdx 0 x = (#v[x] ++ xs).cast (by omega) := by
   cases xs
   simp
 
-theorem eraseIdx_insertIdx {i : Nat} {xs : Vector α n} {h : i ≤ n} :
+theorem eraseIdx_insertIdx_self {i : Nat} {xs : Vector α n} {h : i ≤ n} :
     (xs.insertIdx i a).eraseIdx i = xs := by
   rcases xs with ⟨xs, rfl⟩
-  simp_all [Array.eraseIdx_insertIdx]
+  simp_all [Array.eraseIdx_insertIdx_self]
+
+@[deprecated eraseIdx_insertIdx_self (since := "2025-06-15")]
+theorem eraseIdx_insertIdx {i : Nat} {xs : Vector α n} {h : i ≤ n} :
+    (xs.insertIdx i a).eraseIdx i = xs := by
+  simp [eraseIdx_insertIdx_self]
 
 theorem insertIdx_eraseIdx_of_ge {xs : Vector α n}
     (w₁ : i < n) (w₂ : j ≤ n - 1) (h : i ≤ j) :
@@ -54,6 +59,18 @@ theorem insertIdx_eraseIdx_of_le {xs : Vector α n}
   rcases xs with ⟨as, rfl⟩
   simpa using Array.insertIdx_eraseIdx_of_le (by simpa) (by simpa) (by simpa)
 
+@[grind =]
+theorem insertIdx_eraseIdx {as : Vector α n} (h₁ : i < n) (h₂ : j ≤ n - 1) :
+    (as.eraseIdx i).insertIdx j a =
+      if h : i ≤ j then
+        ((as.insertIdx (j + 1) a).eraseIdx i).cast (by omega)
+      else
+        ((as.insertIdx j a).eraseIdx (i + 1) (by simp_all)).cast (by omega) := by
+  split <;> rename_i h'
+  · rw [insertIdx_eraseIdx_of_ge] <;> omega
+  · rw [insertIdx_eraseIdx_of_le] <;> omega
+
+@[grind =]
 theorem insertIdx_comm (a b : α) {i j : Nat} {xs : Vector α n} (_ : i ≤ j) (_ : j ≤ n) :
     (xs.insertIdx i a).insertIdx (j + 1) b =
       (xs.insertIdx j b).insertIdx i a := by
@@ -70,6 +87,7 @@ theorem insertIdx_size_self {xs : Vector α n} {x : α} : xs.insertIdx n x = xs.
   rcases xs with ⟨as, rfl⟩
   simp
 
+@[grind =]
 theorem getElem_insertIdx {xs : Vector α n} {x : α} {i k : Nat} (w : i ≤ n) (h : k < n + 1) :
     (xs.insertIdx i x)[k] =
       if h₁ : k < i then
@@ -98,6 +116,7 @@ theorem getElem_insertIdx_of_gt {xs : Vector α n} {x : α} {i k : Nat} (w : k
   simp [Array.getElem_insertIdx, w, h]
   rw [dif_neg (by omega), dif_neg (by omega)]
 
+@[grind =]
 theorem getElem?_insertIdx {xs : Vector α n} {x : α} {i k : Nat} (h : i ≤ n) :
     (xs.insertIdx i x)[k]? =
       if k < i then

src/Init/Data/Vector/Range.lean

@@ -112,14 +112,25 @@ theorem range'_eq_append_iff : range' s (n + m) = xs ++ ys ↔ xs = range' s n
   · rintro ⟨h₁, h₂⟩
     exact ⟨n, by omega, by simp_all⟩
 
-@[simp] theorem find?_range'_eq_some {s n : Nat} {i : Nat} {p : Nat → Bool} :
+@[simp, grind =] theorem find?_range'_eq_some {s n : Nat} {i : Nat} {p : Nat → Bool} :
     (range' s n).find? p = some i ↔ p i ∧ i ∈ range' s n ∧ ∀ j, s ≤ j → j < i → !p j := by
   simp [range'_eq_mk_range']
 
-@[simp] theorem find?_range'_eq_none {s n : Nat} {p : Nat → Bool} :
+@[simp, grind =] theorem find?_range'_eq_none {s n : Nat} {p : Nat → Bool} :
     (range' s n).find? p = none ↔ ∀ i, s ≤ i → i < s + n → !p i := by
   simp [range'_eq_mk_range']
 
+@[simp, grind =]
+theorem count_range' {a s n step} (h : 0 < step := by simp) :
+    count a (range' s n step) = if ∃ i, i < n ∧ a = s + step * i then 1 else 0 := by
+  rw [range'_eq_mk_range', count_mk, ← Array.count_range' h]
+
+@[simp, grind =]
+theorem count_range_1' {a s n} :
+    count a (range' s n) = if s ≤ a ∧ a < s + n then 1 else 0 := by
+  rw [range'_eq_mk_range', count_mk, ← Array.count_range_1']
+
+
 /-! ### range -/
 
 @[simp, grind =] theorem getElem_range {i : Nat} (hi : i < n) : (Vector.range n)[i] = i := by
@@ -171,9 +182,15 @@ theorem self_mem_range_succ {n : Nat} : n ∈ range (n + 1) := by simp
     (range n).find? p = none ↔ ∀ i, i < n → !p i := by
   simp [range_eq_range']
 
+@[simp, grind =]
+theorem count_range {a n} :
+    count a (range n) = if a < n then 1 else 0 := by
+  rw [range_eq_range', count_range_1']
+  simp
+
 /-! ### zipIdx -/
 
-@[simp]
+@[simp, grind =]
 theorem getElem?_zipIdx {xs : Vector α n} {i j} : (zipIdx xs i)[j]? = xs[j]?.map fun a => (a, i + j) := by
   simp [getElem?_def]
 
@@ -216,7 +233,7 @@ theorem zipIdx_eq_map_add {xs : Vector α n} {i : Nat} :
   simp only [zipIdx_mk, map_mk, eq_mk]
   rw [Array.zipIdx_eq_map_add]
 
-@[simp]
+@[simp, grind =]
 theorem zipIdx_singleton {x : α} {k : Nat} : zipIdx (#v[x]) k = #v[(x, k)] :=
   rfl
 
@@ -265,6 +282,7 @@ theorem zipIdx_map {f : α → β} {xs : Vector α n} {k : Nat} :
   rcases xs with ⟨xs, rfl⟩
   simp [Array.zipIdx_map]
 
+@[grind =]
 theorem zipIdx_append {xs : Vector α n} {ys : Vector α m} {k : Nat} :
     zipIdx (xs ++ ys) k = zipIdx xs k ++ zipIdx ys (k + n) := by
   rcases xs with ⟨xs, rfl⟩

src/Init/Grind.lean

@@ -14,7 +14,7 @@ import Init.Grind.Propagator
 import Init.Grind.Util
 import Init.Grind.Offset
 import Init.Grind.PP
-import Init.Grind.CommRing
+import Init.Grind.Ring
 import Init.Grind.Module
 import Init.Grind.Ordered
 import Init.Grind.Ext

src/Init/Grind/CommRing.lean

@@ -1,16 +0,0 @@
-/-
-Copyright (c) 2025 Lean FRO, LLC. or its affiliates. All Rights Reserved.
-Released under Apache 2.0 license as described in the file LICENSE.
-Authors: Kim Morrison
--/
-module
-
-prelude
-import Init.Grind.CommRing.Basic
-import Init.Grind.CommRing.Int
-import Init.Grind.CommRing.UInt
-import Init.Grind.CommRing.SInt
-import Init.Grind.CommRing.Fin
-import Init.Grind.CommRing.BitVec
-import Init.Grind.CommRing.Poly
-import Init.Grind.CommRing.Field

src/Init/Grind/Module/Basic.lean

@@ -11,6 +11,9 @@ import Init.Grind.ToInt
 
 namespace Lean.Grind
 
+class AddRightCancel (M : Type u) [Add M] where
+  add_right_cancel : ∀ a b c : M, a + c = b + c → a = b
+
 class NatModule (M : Type u) extends Zero M, Add M, HMul Nat M M where
   add_zero : ∀ a : M, a + 0 = a
   add_comm : ∀ a b : M, a + b = b + a
@@ -37,6 +40,15 @@ class IntModule (M : Type u) extends Zero M, Add M, Neg M, Sub M, HMul Int M M w
   neg_add_cancel : ∀ a : M, -a + a = 0
   sub_eq_add_neg : ∀ a b : M, a - b = a + -b
 
+namespace NatModule
+
+variable {M : Type u} [NatModule M]
+
+theorem zero_add (a : M) : 0 + a = a := by
+  rw [add_comm, add_zero]
+
+end NatModule
+
 namespace IntModule
 
 attribute [instance 100] IntModule.toZero IntModule.toAdd IntModule.toNeg IntModule.toSub IntModule.toHMul
@@ -51,6 +63,12 @@ instance toNatModule (M : Type u) [i : IntModule M] : NatModule M :=
 
 variable {M : Type u} [IntModule M]
 
+instance (priority := 100) (M : Type u) [IntModule M] : SMul Nat M where
+  smul a x := (a : Int) * x
+
+instance (priority := 100) (M : Type u) [IntModule M] : SMul Int M where
+  smul a x := a * x
+
 theorem zero_add (a : M) : 0 + a = a := by
   rw [add_comm, add_zero]
 
@@ -98,6 +116,12 @@ theorem sub_eq_iff {a b c : M} : a - b = c ↔ a = c + b := by
 theorem sub_eq_zero_iff {a b : M} : a - b = 0 ↔ a = b := by
   simp [sub_eq_iff, zero_add]
 
+theorem add_sub_cancel {a b : M} : a + b - b = a := by
+  rw [sub_eq_add_neg, add_assoc, add_neg_cancel, add_zero]
+
+theorem sub_add_cancel {a b : M} : a - b + b = a := by
+  rw [sub_eq_add_neg, add_assoc, neg_add_cancel, add_zero]
+
 theorem neg_hmul (n : Int) (a : M) : (-n) * a = - (n * a) := by
   apply (add_left_inj (n * a)).mp
   rw [← add_hmul, Int.add_left_neg, zero_hmul, neg_add_cancel]
@@ -106,6 +130,12 @@ theorem hmul_neg (n : Int) (a : M) : n * (-a) = - (n * a) := by
   apply (add_left_inj (n * a)).mp
   rw [← hmul_add, neg_add_cancel, neg_add_cancel, hmul_zero]
 
+theorem hmul_sub (k : Int) (a b : M) : k * (a - b) = k * a - k * b := by
+  rw [sub_eq_add_neg, hmul_add, hmul_neg, ← sub_eq_add_neg]
+
+theorem sub_hmul (k₁ k₂ : Int) (a : M) : (k₁ - k₂) * a = k₁ * a - k₂ * a := by
+  rw [Int.sub_eq_add_neg, add_hmul, neg_hmul, ← sub_eq_add_neg]
+
 end IntModule
 
 /--

src/Init/Grind/Norm.lean

@@ -12,7 +12,7 @@ import Init.Classical
 import Init.ByCases
 import Init.Data.Int.Linear
 import Init.Data.Int.Pow
-import Init.Grind.CommRing.Field
+import Init.Grind.Ring.Field
 
 namespace Lean.Grind
 /-!
@@ -178,6 +178,7 @@ init_grind_norm
   Nat.add_eq Nat.sub_eq Nat.mul_eq Nat.zero_eq Nat.le_eq
   Nat.div_zero Nat.mod_zero Nat.div_one Nat.mod_one
   Nat.sub_sub Nat.pow_zero Nat.pow_one Nat.sub_self
+  Nat.one_pow
   -- Int
   Int.lt_eq
   Int.emod_neg Int.ediv_neg
@@ -186,7 +187,7 @@ init_grind_norm
   Int.negSucc_eq
   natCast_eq natCast_div natCast_mod
   natCast_add natCast_mul
-
+  Int.one_pow
   Int.pow_zero Int.pow_one
   -- GT GE
   ge_eq gt_eq

src/Init/Grind/Ordered/Field.lean

@@ -6,7 +6,7 @@ Authors: Kim Morrison
 module
 
 prelude
-import Init.Grind.CommRing.Field
+import Init.Grind.Ring.Field
 import Init.Grind.Ordered.Ring
 
 namespace Lean.Grind

src/Init/Grind/Ordered/Int.lean

@@ -7,7 +7,7 @@ module
 
 prelude
 import Init.Grind.Ordered.Ring
-import Init.Grind.CommRing.Int
+import Init.GrindInstances.Ring.Int
 import Init.Omega
 
 /-!
@@ -24,7 +24,7 @@ instance : Preorder Int where
 instance : IntModule.IsOrdered Int where
   neg_le_iff := by omega
   add_le_left := by omega
-  hmul_pos k a ha := ⟨fun hk => Int.mul_pos hk ha, fun h => Int.pos_of_mul_pos_left h ha⟩
+  hmul_pos_iff k a ha := ⟨fun h => Int.pos_of_mul_pos_left h ha, fun hk => Int.mul_pos hk ha⟩
   hmul_nonneg hk ha := Int.mul_nonneg hk ha
 
 instance : Ring.IsOrdered Int where

src/Init/Grind/Ordered/Linarith.lean

@@ -7,6 +7,7 @@ module
 prelude
 import Init.Grind.Ordered.Module
 import Init.Grind.Ordered.Ring
+import Init.Grind.Ring.Field
 import all Init.Data.Ord
 import all Init.Data.AC
 import Init.Data.RArray
@@ -83,6 +84,11 @@ theorem Poly.denote'_go_eq_denote {α} [IntModule α] (ctx : Context α) (p : Po
 theorem Poly.denote'_eq_denote {α} [IntModule α] (ctx : Context α) (p : Poly) : p.denote' ctx = p.denote ctx := by
   unfold denote' <;> split <;> simp [denote, denote'_go_eq_denote] <;> ac_rfl
 
+def Poly.coeff (p : Poly) (x : Var) : Int :=
+  match p with
+  | .add a y p => bif x == y then a else coeff p x
+  | .nil => 0
+
 def Poly.insert (k : Int) (v : Var) (p : Poly) : Poly :=
   match p with
   | .nil => .add k v .nil
@@ -280,15 +286,9 @@ theorem le_lt_combine {α} [IntModule α] [Preorder α] [IntModule.IsOrdered α]
     : le_lt_combine_cert p₁ p₂ p₃ → p₁.denote' ctx ≤ 0 → p₂.denote' ctx < 0 → p₃.denote' ctx < 0 := by
   simp [-Int.natAbs_pos, -Int.ofNat_pos, le_lt_combine_cert]; intro hp _ h₁ h₂; subst p₃; simp
   replace h₁ := hmul_nonpos (coe_natAbs_nonneg p₂.leadCoeff) h₁
-  replace h₂ := hmul_neg (↑p₁.leadCoeff.natAbs) h₂ |>.mp hp
+  replace h₂ := hmul_neg_iff (↑p₁.leadCoeff.natAbs) h₂ |>.mpr hp
   exact le_add_lt h₁ h₂
 
-theorem le_eq_combine {α} [IntModule α] [Preorder α] [IntModule.IsOrdered α] (ctx : Context α) (p₁ p₂ p₃ : Poly)
-    : le_le_combine_cert p₁ p₂ p₃ → p₁.denote' ctx ≤ 0 → p₂.denote' ctx = 0 → p₃.denote' ctx ≤ 0 := by
-  simp [le_le_combine_cert]; intro _ h₁ h₂; subst p₃; simp [h₂]
-  replace h₁ := hmul_nonpos (coe_natAbs_nonneg p₂.leadCoeff) h₁
-  assumption
-
 def lt_lt_combine_cert (p₁ p₂ p₃ : Poly) : Bool :=
   let a₁ := p₁.leadCoeff.natAbs
   let a₂ := p₂.leadCoeff.natAbs
@@ -297,25 +297,10 @@ def lt_lt_combine_cert (p₁ p₂ p₃ : Poly) : Bool :=
 theorem lt_lt_combine {α} [IntModule α] [Preorder α] [IntModule.IsOrdered α] (ctx : Context α) (p₁ p₂ p₃ : Poly)
     : lt_lt_combine_cert p₁ p₂ p₃ → p₁.denote' ctx < 0 → p₂.denote' ctx < 0 → p₃.denote' ctx < 0 := by
   simp [-Int.natAbs_pos, -Int.ofNat_pos, lt_lt_combine_cert]; intro hp₁ hp₂ _ h₁ h₂; subst p₃; simp
-  replace h₁ := hmul_neg (↑p₂.leadCoeff.natAbs) h₁ |>.mp hp₁
-  replace h₂ := hmul_neg (↑p₁.leadCoeff.natAbs) h₂ |>.mp hp₂
+  replace h₁ := hmul_neg_iff (↑p₂.leadCoeff.natAbs) h₁ |>.mpr hp₁
+  replace h₂ := hmul_neg_iff (↑p₁.leadCoeff.natAbs) h₂ |>.mpr hp₂
   exact lt_add_lt h₁ h₂
 
-def lt_eq_combine_cert (p₁ p₂ p₃ : Poly) : Bool :=
-  let a₁ := p₁.leadCoeff.natAbs
-  let a₂ := p₂.leadCoeff.natAbs
-  a₂ > (0 : Int) && p₃ == (p₁.mul a₂ |>.combine (p₂.mul a₁))
-
-theorem lt_eq_combine {α} [IntModule α] [Preorder α] [IntModule.IsOrdered α] (ctx : Context α) (p₁ p₂ p₃ : Poly)
-    : lt_eq_combine_cert p₁ p₂ p₃ → p₁.denote' ctx < 0 → p₂.denote' ctx = 0 → p₃.denote' ctx < 0 := by
-  simp [-Int.natAbs_pos, -Int.ofNat_pos, lt_eq_combine_cert]; intro hp₁ _ h₁ h₂; subst p₃; simp [h₂]
-  replace h₁ := hmul_neg (↑p₂.leadCoeff.natAbs) h₁ |>.mp hp₁
-  assumption
-
-theorem eq_eq_combine {α} [IntModule α] (ctx : Context α) (p₁ p₂ p₃ : Poly)
-    : le_le_combine_cert p₁ p₂ p₃ → p₁.denote' ctx = 0 → p₂.denote' ctx = 0 → p₃.denote' ctx = 0 := by
-  simp [le_le_combine_cert]; intro _ h₁ h₂; subst p₃; simp [h₁, h₂]
-
 def diseq_split_cert (p₁ p₂ : Poly) : Bool :=
   p₂ == p₁.mul (-1)
 
@@ -335,30 +320,6 @@ theorem diseq_split_resolve {α} [IntModule α] [LinearOrder α] [IntModule.IsOr
   intro h₁ h₂ h₃
   exact (diseq_split ctx p₁ p₂ h₁ h₂).resolve_left h₃
 
-def eq_diseq_combine_cert (p₁ p₂ p₃ : Poly) : Bool :=
-  let a₁ := p₁.leadCoeff.natAbs
-  let a₂ := p₂.leadCoeff.natAbs
-  a₁ ≠ 0 && p₃ == (p₁.mul a₂ |>.combine (p₂.mul a₁))
-
-theorem eq_diseq_combine {α} [IntModule α] [NoNatZeroDivisors α] (ctx : Context α) (p₁ p₂ p₃ : Poly)
-    : eq_diseq_combine_cert p₁ p₂ p₃ → p₁.denote' ctx = 0 → p₂.denote' ctx ≠ 0 → p₃.denote' ctx ≠ 0 := by
-  simp [- Int.natAbs_eq_zero, -Int.natCast_eq_zero, eq_diseq_combine_cert]; intro hne _ h₁ h₂; subst p₃
-  simp [h₁, h₂]; intro h
-  have := no_nat_zero_divisors (p₁.leadCoeff.natAbs) (p₂.denote ctx) hne h
-  contradiction
-
-def eq_diseq_combine_cert' (p₁ p₂ p₃ : Poly) (k : Int) : Bool :=
-  p₃ == (p₁.mul k |>.combine p₂)
-
-/-
-Special case of `eq_diseq_combine` where leading coefficient `c₁` of `p₁` is `-k*c₂`, where
-`c₂` is the leading coefficient of `p₂`.
--/
-theorem eq_diseq_combine' {α} [IntModule α] (ctx : Context α) (p₁ p₂ p₃ : Poly) (k : Int)
-    : eq_diseq_combine_cert' p₁ p₂ p₃ k → p₁.denote' ctx = 0 → p₂.denote' ctx ≠ 0 → p₃.denote' ctx ≠ 0 := by
-  simp [eq_diseq_combine_cert']; intro _ h₁ h₂; subst p₃
-  simp [h₁, h₂]
-
 /-!
 Helper theorems for internalizing facts into the linear arithmetic procedure
 -/
@@ -464,17 +425,57 @@ theorem zero_lt_one {α} [Ring α] [Preorder α] [Ring.IsOrdered α] (ctx : Cont
   simp [zero_lt_one_cert]; intro _ h; subst p; simp [Poly.denote, h, One.one, neg_hmul]
   rw [neg_lt_iff, neg_zero]; apply Ring.IsOrdered.zero_lt_one
 
+def zero_ne_one_cert (p : Poly) : Bool :=
+  p == .add 1 0 .nil
+
+theorem zero_ne_one_of_ord_ring {α} [Ring α] [Preorder α] [Ring.IsOrdered α] (ctx : Context α) (p : Poly)
+    : zero_ne_one_cert p → (0 : Var).denote ctx = One.one → p.denote' ctx ≠ 0 := by
+  simp [zero_ne_one_cert]; intro _ h; subst p; simp [Poly.denote, h, One.one]
+  intro h; have := Ring.IsOrdered.zero_lt_one (R := α); simp [h, Preorder.lt_irrefl] at this
+
+theorem zero_ne_one_of_field {α} [Field α] (ctx : Context α) (p : Poly)
+    : zero_ne_one_cert p → (0 : Var).denote ctx = One.one → p.denote' ctx ≠ 0 := by
+  simp [zero_ne_one_cert]; intro _ h; subst p; simp [Poly.denote, h, One.one]
+  intro h; have := Field.zero_ne_one (α := α); simp [h] at this
+
+theorem zero_ne_one_of_char0 {α} [Ring α] [IsCharP α 0] (ctx : Context α) (p : Poly)
+    : zero_ne_one_cert p → (0 : Var).denote ctx = One.one → p.denote' ctx ≠ 0 := by
+  simp [zero_ne_one_cert]; intro _ h; subst p; simp [Poly.denote, h, One.one]
+  intro h; have := IsCharP.intCast_eq_zero_iff (α := α) 0 1; simp [Ring.intCast_one] at this
+  contradiction
+
+def zero_ne_one_of_charC_cert (c : Nat) (p : Poly) : Bool :=
+  (c:Int) > 1 && p == .add 1 0 .nil
+
+theorem zero_ne_one_of_charC {α c} [Ring α] [IsCharP α c] (ctx : Context α) (p : Poly)
+    : zero_ne_one_of_charC_cert c p → (0 : Var).denote ctx = One.one → p.denote' ctx ≠ 0 := by
+  simp [zero_ne_one_of_charC_cert]; intro hc _ h; subst p; simp [Poly.denote, h, One.one]
+  intro h; have h' := IsCharP.intCast_eq_zero_iff (α := α) c 1; simp [Ring.intCast_one] at h'
+  replace h' := h'.mp h
+  have := Int.emod_eq_of_lt (by decide) hc
+  simp [this] at h'
+
 /-!
 Coefficient normalization
 -/
 
-def coeff_cert (p₁ p₂ : Poly) (k : Nat) :=
-  k > 0 && p₁ == p₂.mul k
+def eq_neg_cert (p₁ p₂ : Poly) :=
+  p₂ == p₁.mul (-1)
+
+theorem eq_neg {α} [IntModule α] (ctx : Context α) (p₁ p₂ : Poly)
+    : eq_neg_cert p₁ p₂ → p₁.denote' ctx = 0 → p₂.denote' ctx = 0 := by
+  simp [eq_neg_cert]; intros; simp [*]
+
+def eq_coeff_cert (p₁ p₂ : Poly) (k : Nat) :=
+  k != 0 && p₁ == p₂.mul k
 
 theorem eq_coeff {α} [IntModule α] [NoNatZeroDivisors α] (ctx : Context α) (p₁ p₂ : Poly) (k : Nat)
-    : coeff_cert p₁ p₂ k → p₁.denote' ctx = 0 → p₂.denote' ctx = 0 := by
-  simp [coeff_cert]; intro h _; subst p₁; simp
-  exact no_nat_zero_divisors k (p₂.denote ctx) (Nat.ne_zero_of_lt h)
+    : eq_coeff_cert p₁ p₂ k → p₁.denote' ctx = 0 → p₂.denote' ctx = 0 := by
+  simp [eq_coeff_cert]; intro h _; subst p₁; simp [*]
+  exact no_nat_zero_divisors k (p₂.denote ctx) h
+
+def coeff_cert (p₁ p₂ : Poly) (k : Nat) :=
+  k > 0 && p₁ == p₂.mul k
 
 theorem le_coeff {α} [IntModule α] [LinearOrder α] [IntModule.IsOrdered α] (ctx : Context α) (p₁ p₂ : Poly) (k : Nat)
     : coeff_cert p₁ p₂ k → p₁.denote' ctx ≤ 0 → p₂.denote' ctx ≤ 0 := by
@@ -482,7 +483,7 @@ theorem le_coeff {α} [IntModule α] [LinearOrder α] [IntModule.IsOrdered α] (
   have : ↑k > (0 : Int) := Int.natCast_pos.mpr h
   intro h₁; apply Classical.byContradiction
   intro h₂; replace h₂ := LinearOrder.lt_of_not_le h₂
-  replace h₂ := IsOrdered.hmul_pos (↑k) h₂ |>.mp this
+  replace h₂ := IsOrdered.hmul_pos_iff (↑k) h₂ |>.mpr this
   exact Preorder.lt_irrefl 0 (Preorder.lt_of_lt_of_le h₂ h₁)
 
 theorem lt_coeff {α} [IntModule α] [LinearOrder α] [IntModule.IsOrdered α] (ctx : Context α) (p₁ p₂ : Poly) (k : Nat)
@@ -499,4 +500,65 @@ theorem diseq_neg {α} [IntModule α] (ctx : Context α) (p p' : Poly) : p' == p
   intro h; replace h := congrArg (- ·) h; simp [neg_neg, neg_zero] at h
   contradiction
 
+/-!
+Substitution
+-/
+
+def eq_diseq_subst_cert (k₁ k₂ : Int) (p₁ p₂ p₃ : Poly) : Bool :=
+  k₁.natAbs ≠ 0 && p₃ == (p₁.mul k₂ |>.combine (p₂.mul k₁))
+
+theorem eq_diseq_subst {α} [IntModule α] [NoNatZeroDivisors α] (ctx : Context α) (k₁ k₂ : Int) (p₁ p₂ p₃ : Poly)
+    : eq_diseq_subst_cert k₁ k₂ p₁ p₂ p₃ → p₁.denote' ctx = 0 → p₂.denote' ctx ≠ 0 → p₃.denote' ctx ≠ 0 := by
+  simp [eq_diseq_subst_cert, - Int.natAbs_eq_zero, -Int.natCast_eq_zero]; intro hne _ h₁ h₂; subst p₃
+  simp [h₁, h₂]; intro h₃
+  have :  k₁.natAbs * Poly.denote ctx p₂ = 0 := by
+    have : (k₁.natAbs : Int) * Poly.denote ctx p₂ = 0 := by
+      cases Int.natAbs_eq_iff.mp (Eq.refl k₁.natAbs)
+      next h => rw [← h]; assumption
+      next h => replace h := congrArg (- ·) h; simp at h; rw [← h, IntModule.neg_hmul, h₃, IntModule.neg_zero]
+    exact this
+  have := no_nat_zero_divisors (k₁.natAbs) (p₂.denote ctx) hne this
+  contradiction
+
+def eq_diseq_subst1_cert (k : Int) (p₁ p₂ p₃ : Poly) : Bool :=
+  p₃ == (p₁.mul k |>.combine p₂)
+
+/-
+Special case of `diseq_eq_subst` where leading coefficient `c₁` of `p₁` is `-k*c₂`, where
+`c₂` is the leading coefficient of `p₂`.
+-/
+theorem eq_diseq_subst1 {α} [IntModule α] (ctx : Context α) (k : Int) (p₁ p₂ p₃ : Poly)
+    : eq_diseq_subst1_cert k p₁ p₂ p₃ → p₁.denote' ctx = 0 → p₂.denote' ctx ≠ 0 → p₃.denote' ctx ≠ 0 := by
+  simp [eq_diseq_subst1_cert]; intro _ h₁ h₂; subst p₃
+  simp [h₁, h₂]
+
+def eq_le_subst_cert (x : Var) (p₁ p₂ p₃ : Poly) :=
+  let a := p₁.coeff x
+  let b := p₂.coeff x
+  a ≥ 0 && p₃ == (p₂.mul a |>.combine (p₁.mul (-b)))
+
+theorem eq_le_subst {α} [IntModule α] [Preorder α] [IntModule.IsOrdered α] (ctx : Context α) (x : Var) (p₁ p₂ p₃ : Poly)
+    : eq_le_subst_cert x p₁ p₂ p₃ → p₁.denote' ctx = 0 → p₂.denote' ctx ≤ 0 → p₃.denote' ctx ≤ 0 := by
+  simp [eq_le_subst_cert]; intro h _ h₁ h₂; subst p₃; simp [h₁]
+  exact hmul_nonpos h h₂
+
+def eq_lt_subst_cert (x : Var) (p₁ p₂ p₃ : Poly) :=
+  let a := p₁.coeff x
+  let b := p₂.coeff x
+  a > 0 && p₃ == (p₂.mul a |>.combine (p₁.mul (-b)))
+
+theorem eq_lt_subst {α} [IntModule α] [Preorder α] [IntModule.IsOrdered α] (ctx : Context α) (x : Var) (p₁ p₂ p₃ : Poly)
+    : eq_lt_subst_cert x p₁ p₂ p₃ → p₁.denote' ctx = 0 → p₂.denote' ctx < 0 → p₃.denote' ctx < 0 := by
+  simp [eq_lt_subst_cert]; intro h _ h₁ h₂; subst p₃; simp [h₁]
+  exact IsOrdered.hmul_neg_iff (p₁.coeff x) h₂ |>.mpr h
+
+def eq_eq_subst_cert (x : Var) (p₁ p₂ p₃ : Poly) :=
+  let a := p₁.coeff x
+  let b := p₂.coeff x
+  p₃ == (p₂.mul a |>.combine (p₁.mul (-b)))
+
+theorem eq_eq_subst {α} [IntModule α] (ctx : Context α) (x : Var) (p₁ p₂ p₃ : Poly)
+    : eq_eq_subst_cert x p₁ p₂ p₃ → p₁.denote' ctx = 0 → p₂.denote' ctx = 0 → p₃.denote' ctx = 0 := by
+  simp [eq_eq_subst_cert]; intro _ h₁ h₂; subst p₃; simp [h₁, h₂]
+
 end Lean.Grind.Linarith

src/Init/Grind/Ordered/Module.lean

@@ -12,14 +12,131 @@ import Init.Grind.Ordered.Order
 
 namespace Lean.Grind
 
+class NatModule.IsOrdered (M : Type u) [Preorder M] [NatModule M] where
+  add_le_left_iff : ∀ {a b : M} (c : M), a ≤ b ↔ a + c ≤ b + c
+  hmul_lt_hmul_iff : ∀ (k : Nat) {a b : M}, a < b → (k * a < k * b ↔ 0 < k)
+  hmul_le_hmul : ∀ {k : Nat} {a b : M}, a ≤ b → k * a ≤ k * b
+
+-- This class is actually redundant; it is available automatically when we have an
+-- `IntModule` satisfying `NatModule.IsOrdered`.
+-- Replace with a custom constructor?
 class IntModule.IsOrdered (M : Type u) [Preorder M] [IntModule M] where
   neg_le_iff : ∀ a b : M, -a ≤ b ↔ -b ≤ a
   add_le_left : ∀ {a b : M}, a ≤ b → (c : M) → a + c ≤ b + c
-  hmul_pos : ∀ (k : Int) {a : M}, 0 < a → (0 < k ↔ 0 < k * a)
+  hmul_pos_iff : ∀ (k : Int) {a : M}, 0 < a → (0 < k * a ↔ 0 < k)
   hmul_nonneg : ∀ {k : Int} {a : M}, 0 ≤ k → 0 ≤ a → 0 ≤ k * a
 
+namespace NatModule.IsOrdered
+
+section
+
+variable {M : Type u} [Preorder M] [NatModule M] [NatModule.IsOrdered M]
+
+theorem add_le_right_iff {a b : M} (c : M) : a ≤ b ↔ c + a ≤ c + b := by
+  rw [add_comm c a, add_comm c b, add_le_left_iff]
+
+theorem add_le_left {a b : M} (h : a ≤ b) (c : M) : a + c ≤ b + c :=
+  (add_le_left_iff c).mp h
+
+theorem add_le_right {a b : M} (c : M) (h : a ≤ b) : c + a ≤ c + b :=
+  (add_le_right_iff c).mp h
+
+theorem add_lt_left {a b : M} (h : a < b) (c : M) : a + c < b + c := by
+  simp only [Preorder.lt_iff_le_not_le] at h ⊢
+  constructor
+  · exact add_le_left h.1 _
+  · intro w
+    apply h.2
+    exact (add_le_left_iff c).mpr w
+
+theorem add_lt_right {a b : M} (c : M) (h : a < b) : c + a < c + b := by
+  rw [add_comm c a, add_comm c b]
+  exact add_lt_left h c
+
+theorem add_lt_left_iff {a b : M} (c : M) : a < b ↔ a + c < b + c := by
+  constructor
+  · exact fun h => add_lt_left h c
+  · intro w
+    simp only [Preorder.lt_iff_le_not_le] at w ⊢
+    constructor
+    · exact (add_le_left_iff c).mpr w.1
+    · intro h
+      exact w.2 ((add_le_left_iff c).mp h)
+
+theorem add_lt_right_iff {a b : M} (c : M) : a < b ↔ c + a < c + b := by
+  rw [add_comm c a, add_comm c b, add_lt_left_iff]
+
+theorem hmul_pos_iff {k : Nat} {a : M} (h : 0 < a) : 0 < k * a ↔ 0 < k:= by
+  rw [← hmul_lt_hmul_iff k h, hmul_zero]
+
+theorem hmul_nonneg {k : Nat} {a : M} (h : 0 ≤ a) : 0 ≤ k * a := by
+  have := hmul_le_hmul (k := k) h
+  rwa [hmul_zero] at this
+
+theorem hmul_le_hmul_of_le_of_le_of_nonneg
+    {k₁ k₂ : Nat} {x y : M} (hk : k₁ ≤ k₂) (h : x ≤ y) (w : 0 ≤ x) :
+    k₁ * x ≤ k₂ * y := by
+  apply Preorder.le_trans
+  · change k₁ * x ≤ k₂ * x
+    obtain ⟨k', rfl⟩ := Nat.exists_eq_add_of_le hk
+    rw [add_hmul]
+    conv => lhs; rw [← add_zero (k₁ * x)]
+    rw [← add_le_right_iff]
+    exact hmul_nonneg w
+  · exact hmul_le_hmul h
+
+theorem add_le_add {a b c d : M} (hab : a ≤ b) (hcd : c ≤ d) : a + c ≤ b + d :=
+  Preorder.le_trans (add_le_right a hcd) (add_le_left hab d)
+
+end
+
+section
+
+variable {M : Type u} [Preorder M] [IntModule M] [NatModule.IsOrdered M]
+
+theorem neg_le_iff {a b : M} : -a ≤ b ↔ -b ≤ a := by
+  rw [NatModule.IsOrdered.add_le_left_iff a, IntModule.neg_add_cancel]
+  conv => rhs; rw [NatModule.IsOrdered.add_le_left_iff b, IntModule.neg_add_cancel]
+  rw [add_comm]
+
+end
+
+end NatModule.IsOrdered
+
 namespace IntModule.IsOrdered
 
+section
+
+variable {M : Type u} [Preorder M] [IntModule M] [NatModule.IsOrdered M]
+
+open NatModule.IsOrdered in
+instance : IntModule.IsOrdered M where
+  neg_le_iff a b := NatModule.IsOrdered.neg_le_iff
+  add_le_left := NatModule.IsOrdered.add_le_left
+  hmul_pos_iff k x :=
+    match k with
+    | (k + 1 : Nat) => by
+      intro h
+      have := hmul_lt_hmul_iff (k := k + 1) h
+      simpa [NatModule.hmul_zero] using hmul_lt_hmul_iff (k := k + 1) h
+    | (0 : Nat) => by simp [zero_hmul]; intro h; exact Preorder.lt_irrefl 0
+    | -(k + 1 : Nat) => by
+      intro h
+      have : ¬ (k : Int) + 1 < 0 := by omega
+      simp [this]; clear this
+      rw [neg_hmul]
+      rw [Preorder.lt_iff_le_not_le]
+      simp
+      intro h'
+      rw [NatModule.IsOrdered.neg_le_iff, neg_zero]
+      simpa [NatModule.hmul_zero] using hmul_le_hmul (k := k + 1) (Preorder.le_of_lt h)
+  hmul_nonneg {k a} h :=
+    match k, h with
+    | (k : Nat), _ => by
+      simpa using NatModule.IsOrdered.hmul_nonneg
+
+end
+
 variable {M : Type u} [Preorder M] [IntModule M] [IntModule.IsOrdered M]
 
 theorem le_neg_iff {a b : M} : a ≤ -b ↔ b ≤ -a := by
@@ -41,7 +158,7 @@ theorem neg_pos_iff {a : M} : 0 < -a ↔ a < 0 := by
   rw [lt_neg_iff, neg_zero]
 
 theorem add_lt_left {a b : M} (h : a < b) (c : M) : a + c < b + c := by
-  simp [Preorder.lt_iff_le_not_le] at h ⊢
+  simp only [Preorder.lt_iff_le_not_le] at h ⊢
   constructor
   · exact add_le_left h.1 _
   · intro w
@@ -58,12 +175,76 @@ theorem add_lt_right (a : M) {b c : M} (h : b < c) : a + b < a + c := by
   rw [add_comm a b, add_comm a c]
   exact add_lt_left h a
 
-theorem hmul_neg (k : Int) {a : M} (h : a < 0) : 0 < k ↔ k * a < 0 := by
-  simpa [IntModule.hmul_neg, neg_pos_iff] using hmul_pos k (neg_pos_iff.mpr h)
+theorem add_le_left_iff {a b : M} (c : M) : a ≤ b ↔ a + c ≤ b + c := by
+  constructor
+  · intro w
+    exact add_le_left w c
+  · intro w
+    have := add_le_left w (-c)
+    rwa [add_assoc, add_neg_cancel, add_zero, add_assoc, add_neg_cancel, add_zero] at this
+
+theorem add_le_right_iff {a b : M} (c : M) : a ≤ b ↔ c + a ≤ c + b := by
+  constructor
+  · intro w
+    exact add_le_right c w
+  · intro w
+    have := add_le_right (-c) w
+    rwa [← add_assoc, neg_add_cancel, zero_add, ← add_assoc, neg_add_cancel, zero_add] at this
+
+theorem add_lt_left_iff {a b : M} (c : M) : a < b ↔ a + c < b + c := by
+  constructor
+  · intro w
+    exact add_lt_left w c
+  · intro w
+    have := add_lt_left w (-c)
+    rwa [add_assoc, add_neg_cancel, add_zero, add_assoc, add_neg_cancel, add_zero] at this
+
+theorem add_lt_right_iff {a b : M} (c : M) : a < b ↔ c + a < c + b := by
+  constructor
+  · intro w
+    exact add_lt_right c w
+  · intro w
+    have := add_lt_right (-c) w
+    rwa [← add_assoc, neg_add_cancel, zero_add, ← add_assoc, neg_add_cancel, zero_add] at this
+
+theorem sub_nonneg_iff {a b : M} : 0 ≤ a - b ↔ b ≤ a := by
+  rw [add_le_left_iff b, zero_add, sub_add_cancel]
+
+theorem sub_pos_iff {a b : M} : 0 < a - b ↔ b < a := by
+  rw [add_lt_left_iff b, zero_add, sub_add_cancel]
+
+theorem hmul_neg_iff (k : Int) {a : M} (h : a < 0) : k * a < 0 ↔ 0 < k := by
+  simpa [IntModule.hmul_neg, neg_pos_iff] using hmul_pos_iff k (neg_pos_iff.mpr h)
 
 theorem hmul_nonpos {k : Int} {a : M} (hk : 0 ≤ k) (ha : a ≤ 0) : k * a ≤ 0 := by
   simpa [IntModule.hmul_neg, neg_nonneg_iff] using hmul_nonneg hk (neg_nonneg_iff.mpr ha)
 
+theorem hmul_le_hmul {a b : M} {k : Int} (hk : 0 ≤ k) (h : a ≤ b) : k * a ≤ k * b := by
+  simpa [hmul_sub, sub_nonneg_iff] using hmul_nonneg hk (sub_nonneg_iff.mpr h)
+
+theorem hmul_lt_hmul_iff (k : Int) {a b : M} (h : a < b) : k * a < k * b ↔ 0 < k := by
+  simpa [hmul_sub, sub_pos_iff] using hmul_pos_iff k (sub_pos_iff.mpr h)
+
+theorem hmul_le_hmul_of_le_of_le_of_nonneg_of_nonneg
+    {k₁ k₂ : Int} {x y : M} (hk : k₁ ≤ k₂) (h : x ≤ y) (w : 0 ≤ k₁) (w' : 0 ≤ x) :
+    k₁ * x ≤ k₂ * y := by
+  apply Preorder.le_trans
+  · have : 0 ≤ k₁ * (y - x) := hmul_nonneg w (sub_nonneg_iff.mpr h)
+    rwa [IntModule.hmul_sub, sub_nonneg_iff] at this
+  · have : 0 ≤ (k₂ - k₁) * y := hmul_nonneg (Int.sub_nonneg.mpr hk) (Preorder.le_trans w' h)
+    rwa [IntModule.sub_hmul, sub_nonneg_iff] at this
+
+theorem add_le_add {a b c d : M} (hab : a ≤ b) (hcd : c ≤ d) : a + c ≤ b + d :=
+  Preorder.le_trans (add_le_right a hcd) (add_le_left hab d)
+
+instance : NatModule.IsOrdered M where
+  add_le_left_iff := add_le_left_iff
+  hmul_lt_hmul_iff k {a b} h := by
+    simpa using hmul_lt_hmul_iff k h
+  hmul_le_hmul {k a b} h := by
+    simpa using hmul_le_hmul (Int.natCast_nonneg k) h
+
+
 end IntModule.IsOrdered
 
 end Lean.Grind

src/Init/Grind/Ordered/Ring.lean

@@ -6,7 +6,7 @@ Authors: Kim Morrison
 module
 
 prelude
-import Init.Grind.CommRing.Basic
+import Init.Grind.Ring.Basic
 import Init.Grind.Ordered.Module
 
 namespace Lean.Grind
@@ -24,6 +24,52 @@ class Ring.IsOrdered (R : Type u) [Ring R] [Preorder R] extends IntModule.IsOrde
 namespace Ring.IsOrdered
 
 variable {R : Type u} [Ring R]
+
+section Preorder
+
+variable [Preorder R] [Ring.IsOrdered R]
+
+theorem neg_one_lt_zero : (-1 : R) < 0 := by
+  have h := zero_lt_one (R := R)
+  have := IntModule.IsOrdered.add_lt_left h (-1)
+  rw [Semiring.zero_add, Ring.add_neg_cancel] at this
+  assumption
+
+theorem ofNat_nonneg (x : Nat) : (OfNat.ofNat x : R) ≥ 0 := by
+  induction x
+  next => simp [OfNat.ofNat, Zero.zero]; apply Preorder.le_refl
+  next n ih =>
+    have := Ring.IsOrdered.zero_lt_one (R := R)
+    rw [Semiring.ofNat_succ]
+    replace ih := IntModule.IsOrdered.add_le_left ih 1
+    rw [Semiring.zero_add] at ih
+    have := Preorder.lt_of_lt_of_le this ih
+    exact Preorder.le_of_lt this
+
+instance [Ring α] [Preorder α] [Ring.IsOrdered α] : IsCharP α 0 where
+  ofNat_eq_zero_iff := by
+    intro x
+    simp only [Nat.mod_zero]; constructor
+    next =>
+      intro h
+      cases x
+      next => rfl
+      next x =>
+        rw [Semiring.ofNat_succ] at h
+        replace h := congrArg (· - 1) h; simp at h
+        rw [Ring.sub_eq_add_neg, Semiring.add_assoc, Ring.add_neg_cancel,
+            Ring.sub_eq_add_neg, Semiring.zero_add, Semiring.add_zero] at h
+        have h₁ : (OfNat.ofNat x : α) < 0 := by
+          have := Ring.IsOrdered.neg_one_lt_zero (R := α)
+          rw [h]; assumption
+        have h₂ := Ring.IsOrdered.ofNat_nonneg (R := α) x
+        have : (0 : α) < 0 := Preorder.lt_of_le_of_lt h₂ h₁
+        simp
+        exact (Preorder.lt_irrefl 0) this
+    next => intro h; rw [OfNat.ofNat, h]; rfl
+
+end Preorder
+
 section PartialOrder
 
 variable [PartialOrder R] [Ring.IsOrdered R]

src/Init/Grind/Ring.lean

@@ -0,0 +1,13 @@
+/-
+Copyright (c) 2025 Lean FRO, LLC. or its affiliates. All Rights Reserved.
+Released under Apache 2.0 license as described in the file LICENSE.
+Authors: Kim Morrison
+-/
+module
+
+prelude
+import Init.Grind.Ring.Basic
+import Init.Grind.Ring.Poly
+import Init.Grind.Ring.Field
+import Init.Grind.Ring.Envelope
+import Init.Grind.Ring.OfSemiring

src/Init/Grind/Ring/Envelope.lean

@@ -0,0 +1,337 @@
+/-
+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, Kim Morrison
+-/
+module
+
+prelude
+import Init.Grind.Ring.Basic
+import all Init.Data.AC
+
+namespace Lean.Grind.Ring
+
+namespace OfSemiring
+variable (α : Type u)
+attribute [local instance] Semiring.natCast Ring.intCast
+variable [Semiring α]
+
+-- Helper instance for `ac_rfl`
+local instance : Std.Associative (· + · : α → α → α) where
+  assoc := Semiring.add_assoc
+local instance : Std.Commutative (· + · : α → α → α) where
+  comm := Semiring.add_comm
+local instance : Std.Associative (· * · : α → α → α) where
+  assoc := Semiring.mul_assoc
+
+@[local simp] private theorem exists_true : ∃ (_ : α), True := ⟨0, trivial⟩
+
+@[local simp] def r : (α × α) → (α × α) → Prop
+  | (a, b), (c, d) => ∃ k, a + d + k = b + c + k
+
+def Q := Quot (r α)
+
+variable {α}
+
+theorem r_rfl (a : α × α) : r α a a := by
+  cases a; refine ⟨0, ?_⟩; simp [Semiring.add_comm]
+
+theorem r_sym {a b : α × α} : r α a b → r α b a := by
+  cases a; cases b; simp [r]; intro h w; refine ⟨h, ?_⟩; simp [w, Semiring.add_comm]
+
+theorem r_trans {a b c : α × α} : r α a b → r α b c → r α a c := by
+  cases a; cases b; cases c;
+  next a₁ a₂ b₁ b₂ c₁ c₂ =>
+  simp [r]
+  intro k₁ h₁ k₂ h₂
+  refine ⟨(k₁ + k₂ + b₁ + b₂), ?_⟩
+  replace h₁ := congrArg (· + (b₁ + c₂ + k₂)) h₁; simp at h₁
+  have haux₁ : a₁ + b₂ + k₁ + (b₁ + c₂ + k₂) = (a₁ + c₂) + (k₁ + k₂ + b₁ + b₂) := by ac_rfl
+  have haux₂ : a₂ + b₁ + k₁ + (b₁ + c₂ + k₂) = (a₂ + c₁) + (k₁ + k₂ + b₁ + b₂) := by rw [h₂]; ac_rfl
+  rw [haux₁, haux₂] at h₁
+  exact h₁
+
+theorem mul_helper {α} [Semiring α]
+    {a₁ b₁ a₂ b₂ a₃ b₃ a₄ b₄ k₁ k₂ : α}
+    (h₁ : a₁ + b₃ + k₁ = b₁ + a₃ + k₁)
+    (h₂ : a₂ + b₄ + k₂ = b₂ + a₄ + k₂)
+    : ∃ k, (a₁ * a₂ + b₁ * b₂) + (a₃ * b₄ + b₃ * a₄) + k = (a₁ * b₂ + b₁ * a₂) + (a₃ * a₄ + b₃ * b₄) + k := by
+  refine ⟨b₃ * a₂ + k₁ * a₂ + a₃ * b₄ + a₃ * k₂ + k₁ * b₂ + b₃ * k₂, ?_⟩
+  have h := congrArg (· * a₂) h₁
+  simp [Semiring.right_distrib] at h
+  have : a₁ * a₂ + b₁ * b₂ + (a₃ * b₄ + b₃ * a₄) + (b₃ * a₂ + k₁ * a₂ + a₃ * b₄ + a₃ * k₂ + k₁ * b₂ + b₃ * k₂) =
+         a₁ * a₂ + b₃ * a₂ + k₁ * a₂ + (b₁ * b₂ + a₃ * b₄ + b₃ * a₄ + a₃ * b₄ + a₃ * k₂ + k₁ * b₂ + b₃ * k₂) := by ac_rfl
+  rw [this, h]
+  clear this h
+  have h := congrArg (a₃ * ·) h₂
+  simp [Semiring.left_distrib] at h
+  have : b₁ * a₂ + a₃ * a₂ + k₁ * a₂ + (b₁ * b₂ + a₃ * b₄ + b₃ * a₄ + a₃ * b₄ + a₃ * k₂ + k₁ * b₂ + b₃ * k₂) =
+         a₃ * a₂ + a₃ * b₄ + a₃ * k₂ + (b₁ * a₂ + k₁ * a₂ + b₁ * b₂ + b₃ * a₄ + a₃ * b₄ + k₁ * b₂ + b₃ * k₂) := by ac_rfl
+  rw [this, h]
+  clear this h
+  have h := congrArg (· * b₂) h₁
+  simp [Semiring.right_distrib] at h
+  have : a₃ * b₂ + a₃ * a₄ + a₃ * k₂ + (b₁ * a₂ + k₁ * a₂ + b₁ * b₂ + b₃ * a₄ + a₃ * b₄ + k₁ * b₂ + b₃ * k₂) =
+         b₁ * b₂ + a₃ * b₂ + k₁ * b₂ + (a₃ * a₄ + a₃ * k₂ + b₁ * a₂ + k₁ * a₂ + b₃ * a₄ + a₃ * b₄ + b₃ * k₂) := by ac_rfl
+  rw [this, ← h]
+  clear this h
+  have h := congrArg (b₃ * ·) h₂
+  simp [Semiring.left_distrib] at h
+  have : a₁ * b₂ + b₃ * b₂ + k₁ * b₂ + (a₃ * a₄ + a₃ * k₂ + b₁ * a₂ + k₁ * a₂ + b₃ * a₄ + a₃ * b₄ + b₃ * k₂) =
+         b₃ * b₂ + b₃ * a₄ + b₃ * k₂ + (a₁ * b₂ + k₁ * b₂ + a₃ * a₄ + a₃ * k₂ + b₁ * a₂ + k₁ * a₂ + a₃ * b₄) := by ac_rfl
+  rw [this, ← h]
+  clear this h
+  ac_rfl
+
+def Q.mk (p : α × α) : Q α :=
+  Quot.mk (r α) p
+
+def Q.liftOn₂ (q₁ q₂ : Q α)
+    (f : α × α → α × α → β)
+    (h : ∀ {a₁ b₁ a₂ b₂}, r α a₁ a₂ → r α b₁ b₂ → f a₁ b₁ = f a₂ b₂)
+    : β := by
+  apply Quot.lift (fun (a₁ : α × α) => Quot.lift (f a₁)
+    (fun (a b : α × α) => @h a₁ a a₁ b (r_rfl a₁)) q₂) _ q₁
+  intros
+  induction q₂ using Quot.ind
+  apply h; assumption; apply r_rfl
+
+attribute [local simp] Q.mk Q.liftOn₂
+
+@[local simp] def natCast (n : Nat) : Q α :=
+  Q.mk (n, 0)
+
+@[local simp] def intCast (n : Int) : Q α :=
+  if n < 0 then Q.mk (0, n.natAbs) else Q.mk (n.natAbs, 0)
+
+@[local simp] def sub (q₁ q₂ : Q α) : Q α :=
+  Q.liftOn₂ q₁ q₂ (fun (a, b) (c, d) => Q.mk (a + d, c + b))
+    (by intro (a₁, b₁) (a₂, b₂) (a₃, b₃) (a₄, b₄)
+        simp; intro k₁ h₁ k₂ h₂; apply Quot.sound; simp
+        refine ⟨k₁ + k₂, ?_⟩
+        have : a₁ + b₂ + (a₄ + b₃) + (k₁ + k₂) = a₁ + b₃ + k₁ + (b₂ + a₄ + k₂) := by ac_rfl
+        rw [this, h₁, ← h₂]
+        ac_rfl)
+
+@[local simp] def add (q₁ q₂ : Q α) : Q α :=
+  Q.liftOn₂ q₁ q₂ (fun (a, b) (c, d) => Q.mk (a + c, b + d))
+    (by intro (a₁, b₁) (a₂, b₂) (a₃, b₃) (a₄, b₄)
+        simp; intro k₁ h₁ k₂ h₂; apply Quot.sound; simp
+        refine ⟨k₁ + k₂, ?_⟩
+        have : a₁ + a₂ + (b₃ + b₄) + (k₁ + k₂) = a₁ + b₃ + k₁ + (a₂ + b₄ + k₂) := by ac_rfl
+        rw [this, h₁, h₂]
+        ac_rfl)
+
+@[local simp] def mul (q₁ q₂ : Q α) : Q α :=
+  Q.liftOn₂ q₁ q₂ (fun (a, b) (c, d) => Q.mk (a*c + b*d, a*d + b*c))
+    (by intro (a₁, b₁) (a₂, b₂) (a₃, b₃) (a₄, b₄)
+        simp; intro k₁ h₁ k₂ h₂; apply Quot.sound; simp
+        apply mul_helper h₁ h₂)
+
+@[local simp] def neg (q : Q α) : Q α :=
+  q.liftOn (fun (a, b) => Q.mk (b, a))
+    (by intro (a₁, b₁) (a₂, b₂)
+        simp; intro k h; apply Quot.sound; simp
+        exact ⟨k, h.symm⟩)
+
+attribute [local simp]
+  Quot.liftOn Semiring.add_zero Semiring.zero_add Semiring.mul_one Semiring.one_mul
+  Semiring.natCast_zero Semiring.natCast_one Semiring.mul_zero Semiring.zero_mul
+
+theorem neg_add_cancel (a : Q α) : add (neg a) a = natCast 0 := by
+  induction a using Quot.ind
+  next a =>
+  cases a; simp
+  apply Quot.sound; simp; refine ⟨0, ?_⟩; ac_rfl
+
+theorem add_comm (a b : Q α) : add a b = add b a := by
+  induction a using Quot.ind
+  induction b using Quot.ind
+  next a b =>
+  cases a; cases b; simp; apply Quot.sound; simp; refine ⟨0, ?_⟩; ac_rfl
+
+theorem add_zero (a : Q α) : add a (natCast 0) = a := by
+  induction a using Quot.ind
+  next a => cases a; simp
+
+theorem add_assoc (a b c : Q α) : add (add a b) c = add a (add b c) := by
+  induction a using Quot.ind
+  induction b using Quot.ind
+  induction c using Quot.ind
+  next a b c =>
+  cases a; cases b; cases c; simp; apply Quot.sound; simp; refine ⟨0, ?_⟩; ac_rfl
+
+theorem sub_eq_add_neg (a b : Q α) : sub a b = add a (neg b) := by
+  induction a using Quot.ind
+  induction b using Quot.ind
+  next a b =>
+  cases a; cases b; simp; apply Quot.sound; simp; refine ⟨0, ?_⟩; ac_rfl
+
+theorem intCast_neg (i : Int) : intCast (α := α) (-i) = neg (intCast i) := by
+  simp; split <;> split <;> simp
+  next => omega
+  next =>
+    apply Quot.sound; simp; refine ⟨0, ?_⟩; simp at *
+    have : i = 0 := by apply Int.le_antisymm <;> assumption
+    simp [this]
+
+theorem intCast_ofNat (n : Nat) : intCast (α := α) (OfNat.ofNat (α := Int) n) = natCast n := by
+  rfl
+
+theorem ofNat_succ (a : Nat) : natCast (α := α) (a + 1) = add (natCast a) (natCast 1) := by
+  simp; apply Quot.sound; simp [Semiring.natCast_add]
+
+theorem mul_assoc (a b c : Q α) : mul (mul a b) c = mul a (mul b c) := by
+  induction a using Quot.ind
+  induction b using Quot.ind
+  induction c using Quot.ind
+  next a b c =>
+  cases a; cases b; cases c; simp; apply Quot.sound
+  simp [Semiring.left_distrib, Semiring.right_distrib]; refine ⟨0, ?_⟩; ac_rfl
+
+theorem mul_one (a : Q α) : mul a (natCast 1) = a := by
+  induction a using Quot.ind
+  next a => cases a; simp
+
+theorem one_mul (a : Q α) : mul (natCast 1) a = a := by
+  induction a using Quot.ind
+  next a => cases a; simp
+
+theorem zero_mul (a : Q α) : mul (natCast 0) a = natCast 0 := by
+  induction a using Quot.ind
+  next a => cases a; simp
+
+theorem mul_zero (a : Q α) : mul a (natCast 0) = natCast 0 := by
+  induction a using Quot.ind
+  next a => cases a; simp
+
+theorem left_distrib (a b c : Q α) : mul a (add b c) = add (mul a b) (mul a c) := by
+  induction a using Quot.ind
+  induction b using Quot.ind
+  induction c using Quot.ind
+  next a b c =>
+  cases a; cases b; cases c; simp; apply Quot.sound
+  simp [Semiring.left_distrib, Semiring.right_distrib]; refine ⟨0, ?_⟩; ac_rfl
+
+theorem right_distrib (a b c : Q α) : mul (add a b) c = add (mul a c) (mul b c) := by
+  induction a using Quot.ind
+  induction b using Quot.ind
+  induction c using Quot.ind
+  next a b c =>
+  cases a; cases b; cases c; simp; apply Quot.sound
+  simp [Semiring.left_distrib, Semiring.right_distrib]; refine ⟨0, ?_⟩; ac_rfl
+
+def hPow (a : Q α) (n : Nat)  : Q α :=
+  match n with
+  | 0 => natCast 1
+  | n+1 => mul (hPow a n) a
+
+private theorem pow_zero (a : Q α) : hPow a 0 = natCast 1 := rfl
+
+private theorem pow_succ (a : Q α) (n : Nat) : hPow a (n+1) = mul (hPow a n) a := rfl
+
+def ofSemiring : Ring (Q α) := {
+  ofNat   := fun n => ⟨natCast n⟩
+  natCast := ⟨natCast⟩
+  intCast := ⟨intCast⟩
+  add, sub, mul, neg, hPow
+  add_comm, add_assoc, add_zero
+  neg_add_cancel, sub_eq_add_neg
+  mul_one, one_mul, zero_mul, mul_zero, mul_assoc,
+  left_distrib, right_distrib, pow_zero, pow_succ,
+  intCast_neg, ofNat_succ
+}
+
+attribute [local instance] ofSemiring
+
+@[local simp] def toQ (a : α) : Q α :=
+  Q.mk (a, 0)
+
+/-! Embedding theorems -/
+
+theorem toQ_add (a b : α) : toQ (a + b) = toQ a + toQ b := by
+  simp; apply Quot.sound; simp
+
+theorem toQ_mul (a b : α) : toQ (a * b) = toQ a * toQ b := by
+  simp; apply Quot.sound; simp
+
+theorem toQ_natCast (n : Nat) : toQ (natCast (α := α) n) = natCast n := by
+  simp; apply Quot.sound; simp [natCast]; refine ⟨0, ?_⟩; rfl
+
+theorem toQ_ofNat (n : Nat) : toQ (OfNat.ofNat (α := α) n) = OfNat.ofNat (α := Q α) n := by
+  simp; apply Quot.sound; rw [Semiring.ofNat_eq_natCast]; simp
+
+theorem toQ_pow (a : α) (n : Nat) : toQ (a ^ n) = toQ a ^ n := by
+  induction n
+  next => simp; apply Quot.sound; simp [Semiring.pow_zero]
+  next n ih => simp [-toQ, Semiring.pow_succ, toQ_mul, ih]
+
+/-!
+Helper definitions and theorems for proving `toQ` is injective when
+`CommSemiring` has the right_cancel property
+-/
+
+private def rel (h : Equivalence (r α)) (q₁ q₂ : Q α) : Prop :=
+  Q.liftOn₂ q₁ q₂
+    (fun a₁ a₂ => r α a₁ a₂)
+    (by intro a₁ b₁ a₂ b₂ h₁ h₂
+        simp [-r]; constructor
+        next => intro h₃; exact h.trans (h.symm h₁) (h.trans h₃ h₂)
+        next => intro h₃; exact h.trans h₁ (h.trans h₃ (h.symm h₂)))
+
+private theorem rel_rfl (h : Equivalence (r α)) (q : Q α) : rel h q q := by
+  induction q using Quot.ind
+  simp [rel, Semiring.add_comm]
+
+private theorem helper (h : Equivalence (r α)) (q₁ q₂ : Q α) : q₁ = q₂ → rel h q₁ q₂ := by
+  intro h; subst q₁; apply rel_rfl h
+
+theorem Q.exact : Q.mk a = Q.mk b → r α a b := by
+  apply helper
+  constructor; exact r_rfl; exact r_sym; exact r_trans
+
+-- If the CommSemiring has the `AddRightCancel` property then `toQ` is injective
+theorem toQ_inj [AddRightCancel α] {a b : α} : toQ a = toQ b → a = b := by
+  simp; intro h₁
+  replace h₁ := Q.exact h₁
+  simp at h₁
+  obtain ⟨k, h₁⟩ := h₁
+  exact AddRightCancel.add_right_cancel a b k h₁
+
+end OfSemiring
+end Lean.Grind.Ring
+
+open Lean.Grind.Ring
+
+namespace Lean.Grind.CommRing
+
+namespace OfCommSemiring
+
+variable (α : Type u) [CommSemiring α]
+
+local instance : Std.Associative (· + · : α → α → α) where
+  assoc := Semiring.add_assoc
+local instance : Std.Commutative (· + · : α → α → α) where
+  comm := Semiring.add_comm
+local instance : Std.Associative (· * · : α → α → α) where
+  assoc := Semiring.mul_assoc
+local instance : Std.Commutative (· * · : α → α → α) where
+  comm := CommSemiring.mul_comm
+
+variable {α}
+
+attribute [local simp] OfSemiring.Q.mk OfSemiring.Q.liftOn₂ Semiring.add_zero
+
+theorem mul_comm (a b : OfSemiring.Q α) : OfSemiring.mul a b = OfSemiring.mul b a := by
+  induction a using Quot.ind
+  induction b using Quot.ind
+  next a b =>
+  cases a; cases b; apply Quot.sound; refine ⟨0, ?_⟩; simp; ac_rfl
+
+def ofCommSemiring : CommRing (OfSemiring.Q α) :=
+  { OfSemiring.ofSemiring with
+    mul_comm := mul_comm }
+
+end OfCommSemiring
+
+end Lean.Grind.CommRing

src/Init/Grind/Ring/Field.lean

@@ -6,7 +6,7 @@ Authors: Kim Morrison
 module
 
 prelude
-import Init.Grind.CommRing.Basic
+import Init.Grind.Ring.Basic
 
 namespace Lean.Grind
 

src/Init/Grind/Ring/OfSemiring.lean

@@ -0,0 +1,65 @@
+/-
+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
+-/
+module
+
+prelude
+import Init.Grind.Ring.Envelope
+import Init.Data.Hashable
+import Init.Data.RArray
+
+namespace Lean.Grind.Ring.OfSemiring
+/-!
+Helper definitions and theorems for converting `Semiring` expressions into `Ring` ones.
+We use them to implement `grind`
+-/
+abbrev Var := Nat
+inductive Expr where
+  | num  (v : Nat)
+  | var  (i : Var)
+  | add  (a b : Expr)
+  | mul (a b : Expr)
+  | pow (a : Expr) (k : Nat)
+  deriving Inhabited, BEq, Hashable
+
+abbrev Context (α : Type u) := RArray α
+
+def Var.denote {α} (ctx : Context α) (v : Var) : α :=
+  ctx.get v
+
+def Expr.denote {α} [Semiring α] (ctx : Context α) : Expr → α
+  | .num k    => OfNat.ofNat (α := α) k
+  | .var v    => v.denote ctx
+  | .add a b  => denote ctx a + denote ctx b
+  | .mul a b  => denote ctx a * denote ctx b
+  | .pow a k  => denote ctx a ^ k
+
+attribute [local instance] ofSemiring
+
+def Expr.denoteAsRing {α} [Semiring α] (ctx : Context α) : Expr → Q α
+  | .num k    => OfNat.ofNat (α := Q α) k
+  | .var v    => toQ (v.denote ctx)
+  | .add a b  => denoteAsRing ctx a + denoteAsRing ctx b
+  | .mul a b  => denoteAsRing ctx a * denoteAsRing ctx b
+  | .pow a k  => denoteAsRing ctx a ^ k
+
+attribute [local simp] toQ_add toQ_mul toQ_ofNat toQ_pow
+
+theorem Expr.denoteAsRing_eq {α} [Semiring α] (ctx : Context α) (e : Expr) : e.denoteAsRing ctx = toQ (e.denote ctx) := by
+  induction e <;> simp [denote, denoteAsRing, *]
+
+theorem of_eq {α} [Semiring α] (ctx : Context α) (lhs rhs : Expr)
+    : lhs.denote ctx = rhs.denote ctx → lhs.denoteAsRing ctx = rhs.denoteAsRing ctx := by
+  intro h; replace h := congrArg toQ h
+  simpa [← Expr.denoteAsRing_eq] using h
+
+theorem of_diseq {α} [Semiring α] [AddRightCancel α] (ctx : Context α) (lhs rhs : Expr)
+    : lhs.denote ctx ≠ rhs.denote ctx → lhs.denoteAsRing ctx ≠ rhs.denoteAsRing ctx := by
+  intro h₁ h₂
+  simp [Expr.denoteAsRing_eq] at h₂
+  replace h₂ := toQ_inj h₂
+  contradiction
+
+end Lean.Grind.Ring.OfSemiring

src/Init/Grind/Ring/Poly.lean

@@ -10,8 +10,8 @@ import Init.Data.Nat.Lemmas
 import Init.Data.Hashable
 import all Init.Data.Ord
 import Init.Data.RArray
-import Init.Grind.CommRing.Basic
-import Init.Grind.CommRing.Field
+import Init.Grind.Ring.Basic
+import Init.Grind.Ring.Field
 import Init.Grind.Ordered.Ring
 
 namespace Lean.Grind

src/Init/Grind/Tactics.lean

@@ -98,14 +98,14 @@ structure Config where
   /-- If `trace` is `true`, `grind` records used E-matching theorems and case-splits. -/
   trace : Bool := false
   /-- Maximum number of case-splits in a proof search branch. It does not include splits performed during normalization. -/
-  splits : Nat := 8
+  splits : Nat := 9
   /-- Maximum number of E-matching (aka heuristic theorem instantiation) rounds before each case split. -/
   ematch : Nat := 5
   /--
   Maximum term generation.
   The input goal terms have generation 0. When we instantiate a theorem using a term from generation `n`,
   the new terms have generation `n+1`. Thus, this parameter limits the length of an instantiation chain. -/
-  gen : Nat := 5
+  gen : Nat := 8
   /-- Maximum number of theorem instances generated using E-matching in a proof search tree branch. -/
   instances : Nat := 1000
   /-- If `matchEqs` is `true`, `grind` uses `match`-equations as E-matching theorems. -/

src/Init/Grind/ToInt.lean

@@ -6,13 +6,7 @@ Authors: Kim Morrison
 module
 
 prelude
-
-import Init.Data.Int.DivMod.Basic
-import Init.Data.Int.Lemmas
-import Init.Data.Int.Order
-import Init.Data.Fin.Lemmas
-import Init.Data.UInt.Lemmas
-import Init.Data.SInt.Lemmas
+import Init.Data.Int.DivMod.Lemmas
 
 /-!
 # Typeclasses for types that can be embedded into an interval of `Int`.
@@ -150,364 +144,4 @@ def ToInt.Sub.of_sub_eq_add_neg {α : Type u} [_root_.Add α] [_root_.Neg α] [_
     rw [sub_eq_add_neg, ToInt.Add.toInt_add, ToInt.Neg.toInt_neg, Int.sub_eq_add_neg]
     conv => rhs; rw [ToInt.wrap_add, ToInt.wrap_toInt]
 
-/-! ## Instances for concrete types-/
-
-instance : ToInt Int none none where
-  toInt := id
-  toInt_inj := by simp
-  le_toInt := by simp
-  toInt_lt := by simp
-
-@[simp] theorem toInt_int (x : Int) : ToInt.toInt x = x := rfl
-
-instance : ToInt.Add Int none none where
-  toInt_add := by simp
-
-instance : ToInt.Neg Int none none where
-  toInt_neg x := by simp
-
-instance : ToInt.Sub Int none none where
-  toInt_sub x y := by simp
-
-instance : ToInt.Mod Int none none where
-  toInt_mod x y := by simp
-
-instance : ToInt.LE Int none none where
-  le_iff x y := by simp
-
-instance : ToInt.LT Int none none where
-  lt_iff x y := by simp
-
-instance : ToInt Nat (some 0) none where
-  toInt := Nat.cast
-  toInt_inj x y := Int.ofNat_inj.mp
-  le_toInt {lo x} w := by simp at w; subst w; exact Int.natCast_nonneg x
-  toInt_lt := by simp
-
-@[simp] theorem toInt_nat (x : Nat) : ToInt.toInt x = (x : Int) := rfl
-
-instance : ToInt.Add Nat (some 0) none where
-  toInt_add := by simp
-
-instance : ToInt.Mod Nat (some 0) none where
-  toInt_mod x y := by simp
-
-instance : ToInt.LE Nat (some 0) none where
-  le_iff x y := by simp
-
-instance : ToInt.LT Nat (some 0) none where
-  lt_iff x y := by simp
-
--- Mathlib will add a `ToInt ℕ+ (some 1) none` instance.
-
-instance : ToInt (Fin n) (some 0) (some n) where
-  toInt x := x.val
-  toInt_inj x y w := Fin.eq_of_val_eq (Int.ofNat_inj.mp w)
-  le_toInt {lo x} w := by simp only [Option.some.injEq] at w; subst w; exact Int.natCast_nonneg x
-  toInt_lt {hi x} w := by simp only [Option.some.injEq] at w; subst w; exact Int.ofNat_lt.mpr x.isLt
-
-@[simp] theorem toInt_fin (x : Fin n) : ToInt.toInt x = (x.val : Int) := rfl
-
-instance : ToInt.Add (Fin n) (some 0) (some n) where
-  toInt_add x y := by rfl
-
-instance [NeZero n] : ToInt.Zero (Fin n) (some 0) (some n) where
-  toInt_zero := by rfl
-
--- The `ToInt.Neg` and `ToInt.Sub` instances are generated automatically from the `IntModule (Fin n)` instance.
-
-instance : ToInt.Mod (Fin n) (some 0) (some n) where
-  toInt_mod x y := by
-    simp only [toInt_fin, Fin.mod_val, Int.natCast_emod]
-
-instance : ToInt.LE (Fin n) (some 0) (some n) where
-  le_iff x y := by simpa using Fin.le_def
-
-instance : ToInt.LT (Fin n) (some 0) (some n) where
-  lt_iff x y := by simpa using Fin.lt_def
-
-instance : ToInt UInt8 (some 0) (some (2^8)) where
-  toInt x := (x.toNat : Int)
-  toInt_inj x y w := UInt8.toNat_inj.mp (Int.ofNat_inj.mp w)
-  le_toInt {lo x} w := by simp at w; subst w; exact Int.natCast_nonneg x.toNat
-  toInt_lt {hi x} w := by simp at w; subst w; exact Int.lt_toNat.mp (UInt8.toNat_lt x)
-
-@[simp] theorem toInt_uint8 (x : UInt8) : ToInt.toInt x = (x.toNat : Int) := rfl
-
-instance : ToInt.Add UInt8 (some 0) (some (2^8)) where
-  toInt_add x y := by simp
-
-instance : ToInt.Zero UInt8 (some 0) (some (2^8)) where
-  toInt_zero := by simp
-
-instance : ToInt.Mod UInt8 (some 0) (some (2^8)) where
-  toInt_mod x y := by simp
-
-instance : ToInt.LE UInt8 (some 0) (some (2^8)) where
-  le_iff x y := by simpa using UInt8.le_iff_toBitVec_le
-
-instance : ToInt.LT UInt8 (some 0) (some (2^8)) where
-  lt_iff x y := by simpa using UInt8.lt_iff_toBitVec_lt
-
-instance : ToInt UInt16 (some 0) (some (2^16)) where
-  toInt x := (x.toNat : Int)
-  toInt_inj x y w := UInt16.toNat_inj.mp (Int.ofNat_inj.mp w)
-  le_toInt {lo x} w := by simp at w; subst w; exact Int.natCast_nonneg x.toNat
-  toInt_lt {hi x} w := by simp at w; subst w; exact Int.lt_toNat.mp (UInt16.toNat_lt x)
-
-@[simp] theorem toInt_uint16 (x : UInt16) : ToInt.toInt x = (x.toNat : Int) := rfl
-
-instance : ToInt.Add UInt16 (some 0) (some (2^16)) where
-  toInt_add x y := by simp
-
-instance : ToInt.Zero UInt16 (some 0) (some (2^16)) where
-  toInt_zero := by simp
-
-instance : ToInt.Mod UInt16 (some 0) (some (2^16)) where
-  toInt_mod x y := by simp
-
-instance : ToInt.LE UInt16 (some 0) (some (2^16)) where
-  le_iff x y := by simpa using UInt16.le_iff_toBitVec_le
-
-instance : ToInt.LT UInt16 (some 0) (some (2^16)) where
-  lt_iff x y := by simpa using UInt16.lt_iff_toBitVec_lt
-
-instance : ToInt UInt32 (some 0) (some (2^32)) where
-  toInt x := (x.toNat : Int)
-  toInt_inj x y w := UInt32.toNat_inj.mp (Int.ofNat_inj.mp w)
-  le_toInt {lo x} w := by simp at w; subst w; exact Int.natCast_nonneg x.toNat
-  toInt_lt {hi x} w := by simp at w; subst w; exact Int.lt_toNat.mp (UInt32.toNat_lt x)
-
-@[simp] theorem toInt_uint32 (x : UInt32) : ToInt.toInt x = (x.toNat : Int) := rfl
-
-instance : ToInt.Add UInt32 (some 0) (some (2^32)) where
-  toInt_add x y := by simp
-
-instance : ToInt.Zero UInt32 (some 0) (some (2^32)) where
-  toInt_zero := by simp
-
-instance : ToInt.Mod UInt32 (some 0) (some (2^32)) where
-  toInt_mod x y := by simp
-
-instance : ToInt.LE UInt32 (some 0) (some (2^32)) where
-  le_iff x y := by simpa using UInt32.le_iff_toBitVec_le
-
-instance : ToInt.LT UInt32 (some 0) (some (2^32)) where
-  lt_iff x y := by simpa using UInt32.lt_iff_toBitVec_lt
-
-instance : ToInt UInt64 (some 0) (some (2^64)) where
-  toInt x := (x.toNat : Int)
-  toInt_inj x y w := UInt64.toNat_inj.mp (Int.ofNat_inj.mp w)
-  le_toInt {lo x} w := by simp at w; subst w; exact Int.natCast_nonneg x.toNat
-  toInt_lt {hi x} w := by simp at w; subst w; exact Int.lt_toNat.mp (UInt64.toNat_lt x)
-
-@[simp] theorem toInt_uint64 (x : UInt64) : ToInt.toInt x = (x.toNat : Int) := rfl
-
-instance : ToInt.Add UInt64 (some 0) (some (2^64)) where
-  toInt_add x y := by simp
-
-instance : ToInt.Zero UInt64 (some 0) (some (2^64)) where
-  toInt_zero := by simp
-
-instance : ToInt.Mod UInt64 (some 0) (some (2^64)) where
-  toInt_mod x y := by simp
-
-instance : ToInt.LE UInt64 (some 0) (some (2^64)) where
-  le_iff x y := by simpa using UInt64.le_iff_toBitVec_le
-
-instance : ToInt.LT UInt64 (some 0) (some (2^64)) where
-  lt_iff x y := by simpa using UInt64.lt_iff_toBitVec_lt
-
-instance : ToInt USize (some 0) (some (2^System.Platform.numBits)) where
-  toInt x := (x.toNat : Int)
-  toInt_inj x y w := USize.toNat_inj.mp (Int.ofNat_inj.mp w)
-  le_toInt {lo x} w := by simp at w; subst w; exact Int.natCast_nonneg x.toNat
-  toInt_lt {hi x} w := by
-    simp at w; subst w
-    rw [show (2 : Int) ^ System.Platform.numBits = (2 ^ System.Platform.numBits : Nat) by simp,
-      Int.ofNat_lt]
-    exact USize.toNat_lt_two_pow_numBits x
-
-@[simp] theorem toInt_usize (x : USize) : ToInt.toInt x = (x.toNat : Int) := rfl
-
-instance : ToInt.Add USize (some 0) (some (2^System.Platform.numBits)) where
-  toInt_add x y := by simp
-
-instance : ToInt.Zero USize (some 0) (some (2^System.Platform.numBits)) where
-  toInt_zero := by simp
-
-instance : ToInt.Mod USize (some 0) (some (2^System.Platform.numBits)) where
-  toInt_mod x y := by simp
-
-instance : ToInt.LE USize (some 0) (some (2^System.Platform.numBits)) where
-  le_iff x y := by simpa using USize.le_iff_toBitVec_le
-
-instance : ToInt.LT USize (some 0) (some (2^System.Platform.numBits)) where
-  lt_iff x y := by simpa using USize.lt_iff_toBitVec_lt
-
-instance : ToInt Int8 (some (-2^7)) (some (2^7)) where
-  toInt x := x.toInt
-  toInt_inj x y w := Int8.toInt_inj.mp w
-  le_toInt {lo x} w := by simp at w; subst w; exact Int8.le_toInt x
-  toInt_lt {hi x} w := by simp at w; subst w; exact Int8.toInt_lt x
-
-@[simp] theorem toInt_int8 (x : Int8) : ToInt.toInt x = (x.toInt : Int) := rfl
-
-instance : ToInt.Add Int8 (some (-2^7)) (some (2^7)) where
-  toInt_add x y := by
-    simp [Int.bmod_eq_emod]
-    split <;> · simp; omega
-
-instance : ToInt.Zero Int8 (some (-2^7)) (some (2^7)) where
-  toInt_zero := by
-    --  simp -- FIXME: succeeds, but generates a `(kernel) application type mismatch` error!
-    change (0 : Int8).toInt = _
-    rw [Int8.toInt_zero]
-    decide
-
--- Note that we can not define `ToInt.Mod` instances for `Int8`,
--- because the condition does not hold unless `0 ≤ x.toInt ∨ y.toInt ∣ x.toInt ∨ y = 0`.
-
-instance : ToInt.LE Int8 (some (-2^7)) (some (2^7)) where
-  le_iff x y := by simpa using Int8.le_iff_toInt_le
-
-instance : ToInt.LT Int8 (some (-2^7)) (some (2^7)) where
-  lt_iff x y := by simpa using Int8.lt_iff_toInt_lt
-
-instance : ToInt Int16 (some (-2^15)) (some (2^15)) where
-  toInt x := x.toInt
-  toInt_inj x y w := Int16.toInt_inj.mp w
-  le_toInt {lo x} w := by simp at w; subst w; exact Int16.le_toInt x
-  toInt_lt {hi x} w := by simp at w; subst w; exact Int16.toInt_lt x
-
-@[simp] theorem toInt_int16 (x : Int16) : ToInt.toInt x = (x.toInt : Int) := rfl
-
-instance : ToInt.Add Int16 (some (-2^15)) (some (2^15)) where
-  toInt_add x y := by
-    simp [Int.bmod_eq_emod]
-    split <;> · simp; omega
-
-instance : ToInt.Zero Int16 (some (-2^15)) (some (2^15)) where
-  toInt_zero := by
-    -- simp -- FIXME: succeeds, but generates a `(kernel) application type mismatch` error!
-    change (0 : Int16).toInt = _
-    rw [Int16.toInt_zero]
-    decide
-
-instance : ToInt.LE Int16 (some (-2^15)) (some (2^15)) where
-  le_iff x y := by simpa using Int16.le_iff_toInt_le
-
-instance : ToInt.LT Int16 (some (-2^15)) (some (2^15)) where
-  lt_iff x y := by simpa using Int16.lt_iff_toInt_lt
-
-instance : ToInt Int32 (some (-2^31)) (some (2^31)) where
-  toInt x := x.toInt
-  toInt_inj x y w := Int32.toInt_inj.mp w
-  le_toInt {lo x} w := by simp at w; subst w; exact Int32.le_toInt x
-  toInt_lt {hi x} w := by simp at w; subst w; exact Int32.toInt_lt x
-
-@[simp] theorem toInt_int32 (x : Int32) : ToInt.toInt x = (x.toInt : Int) := rfl
-
-instance : ToInt.Add Int32 (some (-2^31)) (some (2^31)) where
-  toInt_add x y := by
-    simp [Int.bmod_eq_emod]
-    split <;> · simp; omega
-
-instance : ToInt.Zero Int32 (some (-2^31)) (some (2^31)) where
-  toInt_zero := by
-    -- simp -- FIXME: succeeds, but generates a `(kernel) application type mismatch` error!
-    change (0 : Int32).toInt = _
-    rw [Int32.toInt_zero]
-    decide
-
-instance : ToInt.LE Int32 (some (-2^31)) (some (2^31)) where
-  le_iff x y := by simpa using Int32.le_iff_toInt_le
-
-instance : ToInt.LT Int32 (some (-2^31)) (some (2^31)) where
-  lt_iff x y := by simpa using Int32.lt_iff_toInt_lt
-
-instance : ToInt Int64 (some (-2^63)) (some (2^63)) where
-  toInt x := x.toInt
-  toInt_inj x y w := Int64.toInt_inj.mp w
-  le_toInt {lo x} w := by simp at w; subst w; exact Int64.le_toInt x
-  toInt_lt {hi x} w := by simp at w; subst w; exact Int64.toInt_lt x
-
-@[simp] theorem toInt_int64 (x : Int64) : ToInt.toInt x = (x.toInt : Int) := rfl
-
-instance : ToInt.Add Int64 (some (-2^63)) (some (2^63)) where
-  toInt_add x y := by
-    simp [Int.bmod_eq_emod]
-    split <;> · simp; omega
-
-instance : ToInt.Zero Int64 (some (-2^63)) (some (2^63)) where
-  toInt_zero := by
-    -- simp -- FIXME: succeeds, but generates a `(kernel) application type mismatch` error!
-    change (0 : Int64).toInt = _
-    rw [Int64.toInt_zero]
-    decide
-
-instance : ToInt.LE Int64 (some (-2^63)) (some (2^63)) where
-  le_iff x y := by simpa using Int64.le_iff_toInt_le
-
-instance : ToInt.LT Int64 (some (-2^63)) (some (2^63)) where
-  lt_iff x y := by simpa using Int64.lt_iff_toInt_lt
-
-instance : ToInt (BitVec v) (some 0) (some (2^v)) where
-  toInt x := (x.toNat : Int)
-  toInt_inj x y w :=
-    BitVec.eq_of_toNat_eq (Int.ofNat_inj.mp w)
-  le_toInt {lo x} w := by simp at w; subst w; exact Int.natCast_nonneg x.toNat
-  toInt_lt {hi x} w := by
-    simp at w; subst w;
-    simpa using Int.ofNat_lt.mpr (BitVec.isLt x)
-
-@[simp] theorem toInt_bitVec (x : BitVec v) : ToInt.toInt x = (x.toNat : Int) := rfl
-
-instance : ToInt.Add (BitVec v) (some 0) (some (2^v)) where
-  toInt_add x y := by simp
-
-instance : ToInt.Zero (BitVec v) (some 0) (some (2^v)) where
-  toInt_zero := by simp
-
-instance : ToInt.Mod (BitVec v) (some 0) (some (2^v)) where
-  toInt_mod x y := by simp
-
-instance : ToInt.LE (BitVec v) (some 0) (some (2^v)) where
-  le_iff x y := by simpa using BitVec.le_def
-
-instance : ToInt.LT (BitVec v) (some 0) (some (2^v)) where
-  lt_iff x y := by simpa using BitVec.lt_def
-
-instance : ToInt ISize (some (-2^(System.Platform.numBits-1))) (some (2^(System.Platform.numBits-1))) where
-  toInt x := x.toInt
-  toInt_inj x y w := ISize.toInt_inj.mp w
-  le_toInt {lo x} w := by simp at w; subst w; exact ISize.two_pow_numBits_le_toInt x
-  toInt_lt {hi x} w := by simp at w; subst w; exact ISize.toInt_lt_two_pow_numBits x
-
-@[simp] theorem toInt_isize (x : ISize) : ToInt.toInt x = x.toInt := rfl
-
-instance : ToInt.Add ISize (some (-2^(System.Platform.numBits-1))) (some (2^(System.Platform.numBits-1))) where
-  toInt_add x y := by
-    rw [toInt_isize, ISize.toInt_add, ToInt.wrap_eq_bmod (Int.pow_nonneg (by decide))]
-    have p₁ : (2 : Int) * 2 ^ (System.Platform.numBits - 1) = 2 ^ System.Platform.numBits := by
-      have := System.Platform.numBits_pos
-      have : System.Platform.numBits - 1 + 1 = System.Platform.numBits := by omega
-      simp [← Int.pow_succ', this]
-    have p₂ : ((2 : Int) ^ System.Platform.numBits).toNat = 2 ^ System.Platform.numBits := by
-      rw [Int.toNat_pow_of_nonneg (by decide)]
-      simp
-    simp [p₁, p₂]
-
-instance : ToInt.Zero ISize (some (-2^(System.Platform.numBits-1))) (some (2^(System.Platform.numBits-1))) where
-  toInt_zero := by
-    rw [toInt_isize]
-    rw [ISize.toInt_zero, ToInt.wrap_eq_bmod (Int.pow_nonneg (by decide))]
-    simp
-
-instance instToIntLEISize : ToInt.LE ISize (some (-2^(System.Platform.numBits-1))) (some (2^(System.Platform.numBits-1))) where
-  le_iff x y := by simpa using ISize.le_iff_toInt_le
-
-instance instToIntLTISize : ToInt.LT ISize (some (-2^(System.Platform.numBits-1))) (some (2^(System.Platform.numBits-1))) where
-  lt_iff x y := by simpa using ISize.lt_iff_toInt_lt
-
 end Lean.Grind

src/Init/GrindInstances.lean

@@ -0,0 +1,11 @@
+/-
+Copyright (c) 2025 Lean FRO, LLC. or its affiliates. All Rights Reserved.
+Released under Apache 2.0 license as described in the file LICENSE.
+Authors: Kim Morrison
+-/
+module
+
+prelude
+import Init.GrindInstances.ToInt
+import Init.GrindInstances.Ring
+import Init.GrindInstances.Nat

src/Init/GrindInstances/Nat.lean

@@ -0,0 +1,16 @@
+/-
+Copyright (c) 2025 Lean FRO, LLC. or its affiliates. All Rights Reserved.
+Released under Apache 2.0 license as described in the file LICENSE.
+Authors: Kim Morrison
+-/
+module
+prelude
+
+import Init.Grind.Module.Basic
+
+namespace Lean.Grind
+
+instance : AddRightCancel Nat where
+  add_right_cancel _ _ _ := Nat.add_right_cancel
+
+end Lean.Grind

src/Init/GrindInstances/Ring.lean

@@ -0,0 +1,13 @@
+/-
+Copyright (c) 2025 Lean FRO, LLC. or its affiliates. All Rights Reserved.
+Released under Apache 2.0 license as described in the file LICENSE.
+Authors: Kim Morrison
+-/
+module
+
+prelude
+import Init.GrindInstances.Ring.Int
+import Init.GrindInstances.Ring.UInt
+import Init.GrindInstances.Ring.SInt
+import Init.GrindInstances.Ring.Fin
+import Init.GrindInstances.Ring.BitVec

src/Init/GrindInstances/Ring/BitVec.lean

@@ -6,9 +6,9 @@ Authors: Kim Morrison
 module
 
 prelude
-import Init.Grind.CommRing.Basic
+import Init.Grind.Ring.Basic
+import Init.GrindInstances.ToInt
 import all Init.Data.BitVec.Basic
-import Init.Data.BitVec.Lemmas
 
 namespace Lean.Grind
 

src/Init/GrindInstances/Ring/Fin.lean

@@ -7,7 +7,8 @@ module
 
 prelude
 import all Init.Data.Zero
-import Init.Grind.CommRing.Basic
+import Init.Grind.Ring.Basic
+import Init.GrindInstances.ToInt
 import Init.Data.Fin.Lemmas
 
 namespace Lean.Grind

src/Init/GrindInstances/Ring/Int.lean

@@ -6,7 +6,7 @@ Authors: Kim Morrison
 module
 
 prelude
-import Init.Grind.CommRing.Basic
+import Init.Grind.Ring.Basic
 import Init.Data.Int.Lemmas
 
 namespace Lean.Grind

src/Init/GrindInstances/Ring/SInt.lean

@@ -6,7 +6,8 @@ Authors: Kim Morrison
 module
 
 prelude
-import Init.Grind.CommRing.Basic
+import Init.Grind.Ring.Basic
+import Init.GrindInstances.ToInt
 import all Init.Data.BitVec.Basic
 import all Init.Data.SInt.Basic
 import Init.Data.SInt.Lemmas