fix grind tests

This PR add `@[grind]` annotations for HashMap and variants.

CMakeLists.txt

@@ -5,7 +5,7 @@ option(USE_MIMALLOC "use mimalloc" ON)
 # store all variables passed on the command line into CL_ARGS so we can pass them to the stage builds
 # https://stackoverflow.com/a/48555098/161659
 # MUST be done before call to 'project'
-# Use standard release build (discarding LEAN_CXX_EXTRA_FLAGS etc.) for stage0 by default since it is assumed to be "good", but still pass through CMake platform arguments (compiler, toolchain file, ..).
+# Use standard release build (discarding LEAN_EXTRA_CXX_FLAGS etc.) for stage0 by default since it is assumed to be "good", but still pass through CMake platform arguments (compiler, toolchain file, ..).
 # Use `STAGE0_` prefix to pass variables to stage0 explicitly.
 get_cmake_property(vars CACHE_VARIABLES)
 foreach(var ${vars})
@@ -39,10 +39,14 @@ endif()
 
 # Don't do anything with cadical on wasm
 if (NOT ${CMAKE_SYSTEM_NAME} MATCHES "Emscripten")
-  # On CI Linux, we source cadical from Nix instead; see flake.nix
   find_program(CADICAL cadical)
   if(NOT CADICAL)
     set(CADICAL_CXX c++)
+    if (CADICAL_USE_CUSTOM_CXX)
+      set(CADICAL_CXX ${CMAKE_CXX_COMPILER})
+      set(CADICAL_CXXFLAGS "${LEAN_EXTRA_CXX_FLAGS}")
+      set(CADICAL_LDFLAGS "-Wl,-rpath=\\$$ORIGIN/../lib")
+    endif()
     find_program(CCACHE ccache)
     if(CCACHE)
       set(CADICAL_CXX "${CCACHE} ${CADICAL_CXX}")
@@ -57,8 +61,11 @@ if (NOT ${CMAKE_SYSTEM_NAME} MATCHES "Emscripten")
       GIT_REPOSITORY https://github.com/arminbiere/cadical
       GIT_TAG rel-2.1.2
       CONFIGURE_COMMAND ""
-      # https://github.com/arminbiere/cadical/blob/master/BUILD.md#manual-build
-      BUILD_COMMAND $(MAKE) -f ${CMAKE_SOURCE_DIR}/src/cadical.mk CMAKE_EXECUTABLE_SUFFIX=${CMAKE_EXECUTABLE_SUFFIX} CXX=${CADICAL_CXX} CXXFLAGS=${CADICAL_CXXFLAGS}
+      BUILD_COMMAND $(MAKE) -f ${CMAKE_SOURCE_DIR}/src/cadical.mk
+        CMAKE_EXECUTABLE_SUFFIX=${CMAKE_EXECUTABLE_SUFFIX}
+        CXX=${CADICAL_CXX}
+        CXXFLAGS=${CADICAL_CXXFLAGS}
+        LDFLAGS=${CADICAL_LDFLAGS}
       BUILD_IN_SOURCE ON
       INSTALL_COMMAND "")
     set(CADICAL ${CMAKE_BINARY_DIR}/cadical/cadical${CMAKE_EXECUTABLE_SUFFIX} CACHE FILEPATH "path to cadical binary" FORCE)

CODEOWNERS

@@ -7,8 +7,9 @@
 /.github/ @kim-em
 /RELEASES.md @kim-em
 /src/kernel/ @leodemoura
+/src/library/compiler/ @zwarich
 /src/lake/ @tydeu
-/src/Lean/Compiler/ @leodemoura
+/src/Lean/Compiler/ @leodemoura @zwarich
 /src/Lean/Data/Lsp/ @mhuisi
 /src/Lean/Elab/Deriving/ @kim-em
 /src/Lean/Elab/Tactic/ @kim-em

doc/dev/release_checklist.md

@@ -144,6 +144,10 @@ We'll use `v4.7.0-rc1` as the intended release version in this example.
     - Run `script/release_steps.py v4.7.0-rc1 <repo>` (e.g. replacing `<repo>` with `batteries`), which will walk you through the following steps:
       - Create a new branch off `master`/`main` (as specified in the `branch` field), called `bump_to_v4.7.0-rc1`.
       - Merge `origin/bump/v4.7.0` if relevant (i.e. `bump-branch: true` appears in `release_repos.yml`).
+      - Otherwise, you *may* need to merge `origin/nightly-testing`.
+      - Note that for `verso` and `reference-manual` development happens on `nightly-testing`, so
+        we will merge that branch into `bump_to_v4.7.0-rc1`, but it is essential in the GitHub interface that we do a rebase merge,
+        in order to preserve the history.
       - Update the contents of `lean-toolchain` to `leanprover/lean4:v4.7.0-rc1`.
       - In the `lakefile.toml` or `lakefile.lean`, if there are dependencies on `nightly-testing`, `bump/v4.7.0`, or specific version tags, update them to the new tag.
         If they depend on `main` or `master`, don't change this; you've just updated the dependency, so `lake update` will take care of modifying the manifest.
@@ -151,7 +155,7 @@ We'll use `v4.7.0-rc1` as the intended release version in this example.
       - Run `lake build && if lake check-test; then lake test; fi` to check things are working.
       - Commit the changes as `chore: bump toolchain to v4.7.0-rc1` and push.
       - Create a PR with title "chore: bump toolchain to v4.7.0-rc1".
-    - Merge the PR once CI completes.
+    - Merge the PR once CI completes. (Recall: for `verso` and `reference-manual` you will need to do a rebase merge.)
     - Re-running `script/release_checklist.py` will then create the tag `v4.7.0-rc1` from `master`/`main` and push it (unless `toolchain-tag: false` in the `release_repos.yml` file)
   - We do this for the same list of repositories as for stable releases, see above for notes about special cases.
     As above, there are dependencies between these, and so the process above is iterative.

script/merge_remote.py

@@ -47,10 +47,10 @@ def run_command(command, check=True, capture_output=True):
 
 
 def clone_repo(repo, temp_dir):
-    """Clone the repository to a temporary directory using shallow clone."""
-    print(f"Shallow cloning {repo}...")
-    # Keep the shallow clone for efficiency
-    clone_result = run_command(f"gh repo clone {repo} {temp_dir} -- --depth=1", check=False)
+    """Clone the repository to a temporary directory."""
+    print(f"Cloning {repo}...")
+    # Remove shallow clone for better merge detection
+    clone_result = run_command(f"gh repo clone {repo} {temp_dir}", check=False)
     if clone_result.returncode != 0:
         print(f"Failed to clone repository {repo}.")
         print(f"Error: {clone_result.stderr}")
@@ -95,26 +95,16 @@ def check_and_merge(repo, branch, tag, temp_dir):
     if checkout_result.returncode != 0:
         return False
 
-    # Try merging the tag in a dry-run to check if it can be merged cleanly
-    print(f"Checking if {tag} can be merged cleanly into {branch}...")
-    merge_check = run_command(f"git merge --no-commit --no-ff {tag}", check=False)
+    # Try merging the tag directly
+    print(f"Merging {tag} into {branch}...")
+    merge_result = run_command(f"git merge {tag} --no-edit", check=False)
     
-    if merge_check.returncode != 0:
+    if merge_result.returncode != 0:
         print(f"Cannot merge {tag} cleanly into {branch}.")
         print("Merge conflicts would occur. Aborting merge.")
         run_command("git merge --abort")
         return False
     
-    # Abort the test merge
-    run_command("git reset --hard HEAD")
-    
-    # Now perform the actual merge and push to remote
-    print(f"Merging {tag} into {branch}...")
-    merge_result = run_command(f"git merge {tag} --no-edit")
-    if merge_result.returncode != 0:
-        print(f"Failed to merge {tag} into {branch}.")
-        return False
-    
     print(f"Pushing changes to remote...")
     push_result = run_command(f"git push origin {branch}")
     if push_result.returncode != 0:

script/prepare-llvm-linux.sh

@@ -55,7 +55,8 @@ $CP $GLIBC/lib/libc_nonshared.a stage1/lib/glibc
 $CP $GLIBC/lib/libpthread_nonshared.a stage1/lib/glibc
 for f in $GLIBC/lib/{ld,lib{c,dl,m,rt,pthread}}-*; do b=$(basename $f); cp $f stage1/lib/glibc/${b%-*}.so; done
 OPTIONS=()
-echo -n " -DLEAN_STANDALONE=ON"
+# We build cadical using the custom toolchain on Linux to avoid glibc versioning issues
+echo -n " -DLEAN_STANDALONE=ON -DCADICAL_USE_CUSTOM_CXX=ON"
 echo -n " -DCMAKE_CXX_COMPILER=$PWD/llvm-host/bin/clang++ -DLEAN_CXX_STDLIB='-Wl,-Bstatic -lc++ -lc++abi -Wl,-Bdynamic'"
 echo -n " -DLEAN_EXTRA_CXX_FLAGS='--sysroot $PWD/llvm -idirafter $GLIBC_DEV/include ${EXTRA_FLAGS:-}'"
 # use target compiler directly when not cross-compiling
@@ -67,8 +68,9 @@ fi
 # use `-nostdinc` to make sure headers are not visible by default (in particular, not to `#include_next` in the clang headers),
 # but do not change sysroot so users can still link against system libs
 echo -n " -DLEANC_INTERNAL_FLAGS='--sysroot ROOT -nostdinc -isystem ROOT/include/clang' -DLEANC_CC=ROOT/bin/clang"
-# ld.so is usually included by the libc.so linker script but we discard those
-echo -n " -DLEANC_INTERNAL_LINKER_FLAGS='--sysroot ROOT -L ROOT/lib -L ROOT/lib/glibc ROOT/lib/glibc/libc_nonshared.a ROOT/lib/glibc/libpthread_nonshared.a -Wl,--as-needed -Wl,-Bstatic -lgmp -lunwind -luv -Wl,-Bdynamic ROOT/lib/glibc/ld.so -Wl,--no-as-needed -fuse-ld=lld'"
+# ld.so is usually included by the libc.so linker script but we discard those. Make sure it is linked to only after `libc.so` like in the original
+# linker script so that no libc symbols are bound to it instead.
+echo -n " -DLEANC_INTERNAL_LINKER_FLAGS='--sysroot ROOT -L ROOT/lib -L ROOT/lib/glibc -lc -lc_nonshared -Wl,--as-needed -l:ld.so -Wl,--no-as-needed -lpthread_nonshared -Wl,--as-needed -Wl,-Bstatic -lgmp -lunwind -luv -Wl,-Bdynamic -Wl,--no-as-needed -fuse-ld=lld'"
 # when not using the above flags, link GMP dynamically/as usual
 echo -n " -DLEAN_EXTRA_LINKER_FLAGS='-Wl,--as-needed -lgmp -luv -lpthread -ldl -lrt -Wl,--no-as-needed'"
 # do not set `LEAN_CC` for tests

script/release_checklist.py

@@ -7,6 +7,7 @@ import base64
 import subprocess
 import sys
 import os
+import re # Import re module
 # Import run_command from merge_remote.py
 from merge_remote import run_command
 
@@ -58,13 +59,29 @@ def release_page_exists(repo_url, tag_name, github_token):
     response = requests.get(api_url, headers=headers)
     return response.status_code == 200
 
-def get_release_notes(repo_url, tag_name, github_token):
-    api_url = repo_url.replace("https://github.com/", "https://api.github.com/repos/") + f"/releases/tags/{tag_name}"
-    headers = {'Authorization': f'token {github_token}'} if github_token else {}
-    response = requests.get(api_url, headers=headers)
-    if response.status_code == 200:
-        return response.json().get("body", "").strip()
-    return None
+def get_release_notes(tag_name):
+    """Fetch release notes page title from lean-lang.org."""
+    # Strip -rcX suffix if present for the URL
+    base_tag = tag_name.split('-')[0]
+    reference_url = f"https://lean-lang.org/doc/reference/latest/releases/{base_tag}/"
+    try:
+        response = requests.get(reference_url)
+        response.raise_for_status() # Raise HTTPError for bad responses (4xx or 5xx)
+        
+        # Extract title using regex
+        match = re.search(r"<title>(.*?)</title>", response.text, re.IGNORECASE | re.DOTALL)
+        if match:
+            return match.group(1).strip()
+        else:
+            print(f"  ⚠️ Could not find <title> tag in {reference_url}")
+            return None
+            
+    except requests.exceptions.RequestException as e:
+        print(f"  ❌ Error fetching release notes from {reference_url}: {e}")
+        return None
+    except Exception as e:
+        print(f"  ❌ An unexpected error occurred while processing release notes: {e}")
+        return None
 
 def get_branch_content(repo_url, branch, file_path, github_token):
     api_url = repo_url.replace("https://github.com/", "https://api.github.com/repos/") + f"/contents/{file_path}?ref={branch}"
@@ -255,6 +272,7 @@ def main():
     branch_name = f"releases/v{version_major}.{version_minor}.0"
     if not branch_exists(lean_repo_url, branch_name, github_token):
         print(f"  ❌ Branch {branch_name} does not exist")
+        print(f"  🟡 After creating the branch, we'll need to check CMake version settings.")
         lean4_success = False
     else:
         print(f"  ✅ Branch {branch_name} exists")
@@ -274,14 +292,22 @@ def main():
         lean4_success = False
     else:
         print(f"  ✅ Release page for {toolchain} exists")
-        release_notes = get_release_notes(lean_repo_url, toolchain, github_token)
-        if not (release_notes and toolchain in release_notes.splitlines()[0].strip()):
-            previous_minor_version = version_minor - 1
-            previous_release = f"v{version_major}.{previous_minor_version}.0"
-            print(f"  ❌ Release notes not published. Please run `script/release_notes.py --since {previous_release}` on branch `{branch_name}`.")
-            lean4_success = False
-        else:
-            print(f"  ✅ Release notes look good.")
+        
+    # Check the actual release notes page title
+    actual_title = get_release_notes(toolchain)
+    expected_title_prefix = f"Lean {toolchain.lstrip('v')}" # e.g., "Lean 4.19.0" or "Lean 4.19.0-rc1"
+
+    if actual_title is None:
+        # Error already printed by get_release_notes
+        lean4_success = False
+    elif not actual_title.startswith(expected_title_prefix):
+        # Construct URL for the error message (using the base tag)
+        base_tag = toolchain.split('-')[0]
+        check_url = f"https://lean-lang.org/doc/reference/latest/releases/{base_tag}/"
+        print(f"  ❌ Release notes page title mismatch. Expected prefix '{expected_title_prefix}', got '{actual_title}'. Check {check_url}")
+        lean4_success = False
+    else:
+        print(f"  ✅ Release notes page title looks good ('{actual_title}').")
 
     repo_status["lean4"] = lean4_success
 
@@ -360,10 +386,24 @@ def main():
         if check_stable and not is_release_candidate(toolchain):
             if not is_merged_into_stable(url, toolchain, "stable", github_token, verbose):
                 org_repo = extract_org_repo_from_url(url)
-                print(f"  ❌ Tag {toolchain} is not merged into stable")
-                print(f"     Run `script/merge_remote.py {org_repo} stable {toolchain}` to merge it")
-                repo_status[name] = False
-                continue
+                if args.dry_run:
+                    print(f"  ❌ Tag {toolchain} is not merged into stable")
+                    print(f"     Run `script/merge_remote.py {org_repo} stable {toolchain}` to merge it")
+                    repo_status[name] = False
+                    continue
+                else:
+                    print(f"  … Tag {toolchain} is not merged into stable. Running `script/merge_remote.py {org_repo} stable {toolchain}`...")
+                    
+                    # Run the script to merge the tag
+                    subprocess.run(["script/merge_remote.py", org_repo, "stable", toolchain])
+                    
+                    # Check again if the tag is merged now
+                    if not is_merged_into_stable(url, toolchain, "stable", github_token, verbose):
+                        print(f"  ❌ Manual intervention required.")
+                        repo_status[name] = False
+                        continue
+            
+            # This will print in all successful cases - whether tag was merged initially or was merged successfully
             print(f"  ✅ Tag {toolchain} is merged into stable")
 
         if check_bump:

script/release_repos.yml

@@ -21,12 +21,19 @@ repositories:
     branch: master
     dependencies: []
 
+  - name: lean4-cli
+    url: https://github.com/leanprover/lean4-cli
+    toolchain-tag: true
+    stable-branch: false
+    branch: main
+    dependencies: []
+
   - name: doc-gen4
     url: https://github.com/leanprover/doc-gen4
     toolchain-tag: true
     stable-branch: false
     branch: main
-    dependencies: []
+    dependencies: [lean4-cli]
 
   - name: verso
     url: https://github.com/leanprover/verso
@@ -42,20 +49,13 @@ repositories:
     branch: main
     dependencies: [verso]
 
-  - name: lean4-cli
-    url: https://github.com/leanprover/lean4-cli
-    toolchain-tag: true
-    stable-branch: false
-    branch: main
-    dependencies: []
-
   - name: ProofWidgets4
     url: https://github.com/leanprover-community/ProofWidgets4
     toolchain-tag: false
     stable-branch: false
     branch: main
     dependencies:
-      - Batteries
+      - batteries
 
   - name: aesop
     url: https://github.com/leanprover-community/aesop
@@ -63,7 +63,7 @@ repositories:
     stable-branch: true
     branch: master
     dependencies:
-      - Batteries
+      - batteries
 
   - name: import-graph
     url: https://github.com/leanprover-community/import-graph
@@ -71,8 +71,8 @@ repositories:
     stable-branch: false
     branch: main
     dependencies:
-      - Cli
-      - Batteries
+      - lean4-cli
+      - batteries
 
   - name: plausible
     url: https://github.com/leanprover-community/plausible
@@ -88,10 +88,11 @@ repositories:
     branch: master
     bump-branch: true
     dependencies:
-      - Aesop
+      - aesop
       - ProofWidgets4
       - lean4checker
-      - Batteries
+      - batteries
+      - lean4-cli
       - doc-gen4
       - import-graph
       - plausible
@@ -102,4 +103,4 @@ repositories:
     stable-branch: true
     branch: master
     dependencies:
-      - Mathlib
+      - mathlib4

script/release_steps.py

@@ -68,7 +68,7 @@ def generate_script(repo, version, config):
     ]
 
     # Special cases for specific repositories
-    if repo_name == "REPL":
+    if repo_name == "repl":
         script_lines.extend([
             "lake update",
             "cd test/Mathlib",
@@ -79,7 +79,7 @@ def generate_script(repo, version, config):
             "./test.sh"
         ])
     elif dependencies:
-        script_lines.append('echo "Please update the dependencies in lakefile.{lean,toml}"')
+        script_lines.append('perl -pi -e \'s/"v4\\.[0-9]+(\\.[0-9]+)?(-rc[0-9]+)?"/"' + version + '"/g\' lakefile.*')
         script_lines.append("lake update")
 
     script_lines.append("")
@@ -89,13 +89,20 @@ def generate_script(repo, version, config):
         ""
     ])
 
-    if re.search(r'rc\d+$', version) and repo_name in ["Batteries", "Mathlib"]:
+    if re.search(r'rc\d+$', version) and repo_name in ["batteries", "mathlib4"]:
         script_lines.extend([
             "echo 'This repo has nightly-testing infrastructure'",
             f"git merge origin/bump/{version.split('-rc')[0]}",
             "echo 'Please resolve any conflicts.'",
             ""
         ])
+    if re.search(r'rc\d+$', version) and repo_name in ["verso", "reference-manual"]:
+        script_lines.extend([
+            "echo 'This repo does development on nightly-testing: remember to rebase merge the PR.'",
+            f"git merge origin/nightly-testing",
+            "echo 'Please resolve any conflicts.'",
+            ""
+        ])
     if repo_name != "Mathlib":
         script_lines.extend([
             "lake build && if lake check-test; then lake test; fi",
@@ -104,7 +111,7 @@ def generate_script(repo, version, config):
 
     script_lines.extend([
         'gh pr create --title "chore: bump toolchain to ' + version + '" --body ""',
-        "echo 'Please review the PR and merge it.'",
+        "echo 'Please review the PR and merge or rebase it.'",
         ""
     ])
 

src/CMakeLists.txt

@@ -10,7 +10,7 @@ endif()
 include(ExternalProject)
 project(LEAN CXX C)
 set(LEAN_VERSION_MAJOR 4)
-set(LEAN_VERSION_MINOR 20)
+set(LEAN_VERSION_MINOR 21)
 set(LEAN_VERSION_PATCH 0)
 set(LEAN_VERSION_IS_RELEASE 0)  # This number is 1 in the release revision, and 0 otherwise.
 set(LEAN_SPECIAL_VERSION_DESC "" CACHE STRING "Additional version description like 'nightly-2018-03-11'")
@@ -511,7 +511,10 @@ if(${CMAKE_SYSTEM_NAME} MATCHES "Windows")
   # import libraries created by the stdlib.make targets
   string(APPEND LEANC_SHARED_LINKER_FLAGS " -lInit_shared -lleanshared_1 -lleanshared")
 elseif("${CMAKE_SYSTEM_NAME}" MATCHES "Darwin")
-  string(APPEND LEANC_SHARED_LINKER_FLAGS " -Wl,-undefined,dynamic_lookup")
+  # The second flag is necessary to even *load* dylibs without resolved symbols, as can happen
+  # if a Lake `extern_lib` depends on a symbols defined by the Lean library but is loaded even
+  # before definition.
+  string(APPEND LEANC_SHARED_LINKER_FLAGS " -Wl,-undefined,dynamic_lookup -Wl,-no_fixup_chains")
 endif()
 # Linux ignores undefined symbols in shared libraries by default
 

src/Init/Data/Array/Attach.lean

@@ -56,15 +56,15 @@ well-founded recursion mechanism to prove that the function terminates.
 -/
 @[inline] def attach (xs : Array α) : Array {x // x ∈ xs} := xs.attachWith _ fun _ => id
 
-@[simp] theorem _root_.List.attachWith_toArray {l : List α} {P : α → Prop} {H : ∀ x ∈ l.toArray, P x} :
+@[simp, grind =] theorem _root_.List.attachWith_toArray {l : List α} {P : α → Prop} {H : ∀ x ∈ l.toArray, P x} :
     l.toArray.attachWith P H = (l.attachWith P (by simpa using H)).toArray := by
   simp [attachWith]
 
-@[simp] theorem _root_.List.attach_toArray {l : List α} :
+@[simp, grind =] theorem _root_.List.attach_toArray {l : List α} :
     l.toArray.attach = (l.attachWith (· ∈ l.toArray) (by simp)).toArray := by
   simp [attach]
 
-@[simp] theorem _root_.List.pmap_toArray {l : List α} {P : α → Prop} {f : ∀ a, P a → β} {H : ∀ a ∈ l.toArray, P a} :
+@[simp, grind =] theorem _root_.List.pmap_toArray {l : List α} {P : α → Prop} {f : ∀ a, P a → β} {H : ∀ a ∈ l.toArray, P a} :
     l.toArray.pmap f H = (l.pmap f (by simpa using H)).toArray := by
   simp [pmap]
 
@@ -590,7 +590,7 @@ def unattach {α : Type _} {p : α → Prop} (xs : Array { x // p x }) : Array
   unfold unattach
   simp
 
-@[simp] theorem _root_.List.unattach_toArray {p : α → Prop} {xs : List { x // p x }} :
+@[simp, grind =] theorem _root_.List.unattach_toArray {p : α → Prop} {xs : List { x // p x }} :
     xs.toArray.unattach = xs.unattach.toArray := by
   simp only [unattach, List.map_toArray, List.unattach]
 

src/Init/Data/Array/Basic.lean

@@ -88,11 +88,11 @@ theorem ext' {xs ys : Array α} (h : xs.toList = ys.toList) : xs = ys := by
 @[simp] theorem toArrayAux_eq {as : List α} {acc : Array α} : (as.toArrayAux acc).toList = acc.toList ++ as := by
   induction as generalizing acc <;> simp [*, List.toArrayAux, Array.push, List.append_assoc, List.concat_eq_append]
 
-@[simp] theorem toArray_toList {xs : Array α} : xs.toList.toArray = xs := rfl
+@[simp, grind =] theorem toArray_toList {xs : Array α} : xs.toList.toArray = xs := rfl
 
-@[simp] theorem getElem_toList {xs : Array α} {i : Nat} (h : i < xs.size) : xs.toList[i] = xs[i] := rfl
+@[simp, grind =] theorem getElem_toList {xs : Array α} {i : Nat} (h : i < xs.size) : xs.toList[i] = xs[i] := rfl
 
-@[simp] theorem getElem?_toList {xs : Array α} {i : Nat} : xs.toList[i]? = xs[i]? := by
+@[simp, grind =] theorem getElem?_toList {xs : Array α} {i : Nat} : xs.toList[i]? = xs[i]? := by
   simp [getElem?_def]
 
 /-- `a ∈ as` is a predicate which asserts that `a` is in the array `as`. -/
@@ -107,7 +107,7 @@ instance : Membership α (Array α) where
 theorem mem_def {a : α} {as : Array α} : a ∈ as ↔ a ∈ as.toList :=
   ⟨fun | .mk h => h, Array.Mem.mk⟩
 
-@[simp] theorem mem_toArray {a : α} {l : List α} : a ∈ l.toArray ↔ a ∈ l := by
+@[simp, grind =] theorem mem_toArray {a : α} {l : List α} : a ∈ l.toArray ↔ a ∈ l := by
   simp [mem_def]
 
 @[simp, grind] theorem getElem_mem {xs : Array α} {i : Nat} (h : i < xs.size) : xs[i] ∈ xs := by
@@ -127,18 +127,18 @@ theorem toList_toArray {as : List α} : as.toArray.toList = as := rfl
 @[deprecated toList_toArray (since := "2025-02-17")]
 abbrev _root_.Array.toList_toArray := @List.toList_toArray
 
-@[simp] theorem size_toArray {as : List α} : as.toArray.size = as.length := by simp [Array.size]
+@[simp, grind] theorem size_toArray {as : List α} : as.toArray.size = as.length := by simp [Array.size]
 
 @[deprecated size_toArray (since := "2025-02-17")]
 abbrev _root_.Array.size_toArray := @List.size_toArray
 
-@[simp] theorem getElem_toArray {xs : List α} {i : Nat} (h : i < xs.toArray.size) :
+@[simp, grind =] theorem getElem_toArray {xs : List α} {i : Nat} (h : i < xs.toArray.size) :
     xs.toArray[i] = xs[i]'(by simpa using h) := rfl
 
-@[simp] theorem getElem?_toArray {xs : List α} {i : Nat} : xs.toArray[i]? = xs[i]? := by
+@[simp, grind =] theorem getElem?_toArray {xs : List α} {i : Nat} : xs.toArray[i]? = xs[i]? := by
   simp [getElem?_def]
 
-@[simp] theorem getElem!_toArray [Inhabited α] {xs : List α} {i : Nat} :
+@[simp, grind =] theorem getElem!_toArray [Inhabited α] {xs : List α} {i : Nat} :
     xs.toArray[i]! = xs[i]! := by
   simp [getElem!_def]
 
@@ -2158,13 +2158,15 @@ Examples:
 
 /-! ### Repr and ToString -/
 
+protected def Array.repr {α : Type u} [Repr α] (xs : Array α) : Std.Format :=
+  let _ : Std.ToFormat α := ⟨repr⟩
+  if xs.size == 0 then
+    "#[]"
+  else
+    Std.Format.bracketFill "#[" (Std.Format.joinSep (toList xs) ("," ++ Std.Format.line)) "]"
+
 instance {α : Type u} [Repr α] : Repr (Array α) where
-  reprPrec xs _ :=
-    let _ : Std.ToFormat α := ⟨repr⟩
-    if xs.size == 0 then
-      "#[]"
-    else
-      Std.Format.bracketFill "#[" (Std.Format.joinSep (toList xs) ("," ++ Std.Format.line)) "]"
+  reprPrec xs _ := Array.repr xs
 
 instance [ToString α] : ToString (Array α) where
   toString xs := "#" ++ toString xs.toList

src/Init/Data/Array/Bootstrap.lean

@@ -55,12 +55,12 @@ theorem foldlM_toList.aux [Monad m]
     rfl
   · rw [List.drop_of_length_le (Nat.ge_of_not_lt ‹_›)]; rfl
 
-@[simp] theorem foldlM_toList [Monad m]
+@[simp, grind =] theorem foldlM_toList [Monad m]
     {f : β → α → m β} {init : β} {xs : Array α} :
     xs.toList.foldlM f init = xs.foldlM f init := by
   simp [foldlM, foldlM_toList.aux]
 
-@[simp] theorem foldl_toList (f : β → α → β) {init : β} {xs : Array α} :
+@[simp, grind =] theorem foldl_toList (f : β → α → β) {init : β} {xs : Array α} :
     xs.toList.foldl f init = xs.foldl f init :=
   List.foldl_eq_foldlM .. ▸ foldlM_toList ..
 
@@ -79,32 +79,32 @@ theorem foldrM_eq_reverse_foldlM_toList [Monad m] {f : α → β → m β} {init
   match xs, this with | _, .inl rfl => rfl | xs, .inr h => ?_
   simp [foldrM, h, ← foldrM_eq_reverse_foldlM_toList.aux, List.take_length]
 
-@[simp] theorem foldrM_toList [Monad m]
+@[simp, grind =] theorem foldrM_toList [Monad m]
     {f : α → β → m β} {init : β} {xs : Array α} :
     xs.toList.foldrM f init = xs.foldrM f init := by
   rw [foldrM_eq_reverse_foldlM_toList, List.foldlM_reverse]
 
-@[simp] theorem foldr_toList (f : α → β → β) {init : β} {xs : Array α} :
+@[simp, grind =] theorem foldr_toList (f : α → β → β) {init : β} {xs : Array α} :
     xs.toList.foldr f init = xs.foldr f init :=
   List.foldr_eq_foldrM .. ▸ foldrM_toList ..
 
-@[simp] theorem push_toList {xs : Array α} {a : α} : (xs.push a).toList = xs.toList ++ [a] := by
+@[simp, grind =] theorem push_toList {xs : Array α} {a : α} : (xs.push a).toList = xs.toList ++ [a] := by
   simp [push, List.concat_eq_append]
 
-@[simp] theorem toListAppend_eq {xs : Array α} {l : List α} : xs.toListAppend l = xs.toList ++ l := by
+@[simp, grind =] theorem toListAppend_eq {xs : Array α} {l : List α} : xs.toListAppend l = xs.toList ++ l := by
   simp [toListAppend, ← foldr_toList]
 
-@[simp] theorem toListImpl_eq {xs : Array α} : xs.toListImpl = xs.toList := by
+@[simp, grind =] theorem toListImpl_eq {xs : Array α} : xs.toListImpl = xs.toList := by
   simp [toListImpl, ← foldr_toList]
 
-@[simp] theorem toList_pop {xs : Array α} : xs.pop.toList = xs.toList.dropLast := rfl
+@[simp, grind =] theorem toList_pop {xs : Array α} : xs.pop.toList = xs.toList.dropLast := rfl
 
 @[deprecated toList_pop (since := "2025-02-17")]
 abbrev pop_toList := @Array.toList_pop
 
 @[simp] theorem append_eq_append {xs ys : Array α} : xs.append ys = xs ++ ys := rfl
 
-@[simp] theorem toList_append {xs ys : Array α} :
+@[simp, grind =] theorem toList_append {xs ys : Array α} :
     (xs ++ ys).toList = xs.toList ++ ys.toList := by
   rw [← append_eq_append]; unfold Array.append
   rw [← foldl_toList]
@@ -112,13 +112,13 @@ abbrev pop_toList := @Array.toList_pop
 
 @[simp] theorem toList_empty : (#[] : Array α).toList = [] := rfl
 
-@[simp, grind] theorem append_empty {xs : Array α} : xs ++ #[] = xs := by
+@[simp, grind =] theorem append_empty {xs : Array α} : xs ++ #[] = xs := by
   apply ext'; simp only [toList_append, toList_empty, List.append_nil]
 
 @[deprecated append_empty (since := "2025-01-13")]
 abbrev append_nil := @append_empty
 
-@[simp, grind] theorem empty_append {xs : Array α} : #[] ++ xs = xs := by
+@[simp, grind =] theorem empty_append {xs : Array α} : #[] ++ xs = xs := by
   apply ext'; simp only [toList_append, toList_empty, List.nil_append]
 
 @[deprecated empty_append (since := "2025-01-13")]
@@ -129,7 +129,7 @@ abbrev nil_append := @empty_append
 
 @[simp] theorem appendList_eq_append {xs : Array α} {l : List α} : xs.appendList l = xs ++ l := rfl
 
-@[simp] theorem toList_appendList {xs : Array α} {l : List α} :
+@[simp, grind =] theorem toList_appendList {xs : Array α} {l : List α} :
     (xs ++ l).toList = xs.toList ++ l := by
   rw [← appendList_eq_append]; unfold Array.appendList
   induction l generalizing xs <;> simp [*]

src/Init/Data/Array/Count.lean

@@ -25,7 +25,7 @@ section countP
 
 variable {p q : α → Bool}
 
-@[simp] theorem _root_.List.countP_toArray {l : List α} : countP p l.toArray = l.countP p := by
+@[simp, grind =] theorem _root_.List.countP_toArray {l : List α} : countP p l.toArray = l.countP p := by
   simp [countP]
   induction l with
   | nil => rfl
@@ -33,7 +33,7 @@ variable {p q : α → Bool}
     simp only [List.foldr_cons, ih, List.countP_cons]
     split <;> simp_all
 
-@[simp] theorem countP_toList {xs : Array α} : xs.toList.countP p = countP p xs := by
+@[simp, grind =] theorem countP_toList {xs : Array α} : xs.toList.countP p = countP p xs := by
   cases xs
   simp
 
@@ -164,10 +164,10 @@ section count
 
 variable [BEq α]
 
-@[simp] theorem _root_.List.count_toArray {l : List α} {a : α} : count a l.toArray = l.count a := by
+@[simp, grind =] theorem _root_.List.count_toArray {l : List α} {a : α} : count a l.toArray = l.count a := by
   simp [count, List.count_eq_countP]
 
-@[simp] theorem count_toList {xs : Array α} {a : α} : xs.toList.count a = xs.count a := by
+@[simp, grind =] theorem count_toList {xs : Array α} {a : α} : xs.toList.count a = xs.count a := by
   cases xs
   simp
 

src/Init/Data/Array/DecidableEq.lean

@@ -68,7 +68,7 @@ theorem isEqv_eq_decide (xs ys : Array α) (r) :
       Bool.not_eq_true]
     simpa [isEqv_iff_rel] using h'
 
-@[simp] theorem isEqv_toList [BEq α] (xs ys : Array α) : (xs.toList.isEqv ys.toList r) = (xs.isEqv ys r) := by
+@[simp, grind =] theorem isEqv_toList [BEq α] (xs ys : Array α) : (xs.toList.isEqv ys.toList r) = (xs.isEqv ys r) := by
   simp [isEqv_eq_decide, List.isEqv_eq_decide]
 
 theorem eq_of_isEqv [DecidableEq α] (xs ys : Array α) (h : Array.isEqv xs ys (fun x y => x = y)) : xs = ys := by
@@ -99,17 +99,17 @@ theorem beq_eq_decide [BEq α] (xs ys : Array α) :
       decide (∀ (i : Nat) (h' : i < xs.size), xs[i] == ys[i]'(h ▸ h')) else false := by
   simp [BEq.beq, isEqv_eq_decide]
 
-@[simp] theorem beq_toList [BEq α] (xs ys : Array α) : (xs.toList == ys.toList) = (xs == ys) := by
+@[simp, grind =] theorem beq_toList [BEq α] (xs ys : Array α) : (xs.toList == ys.toList) = (xs == ys) := by
   simp [beq_eq_decide, List.beq_eq_decide]
 
 end Array
 
 namespace List
 
-@[simp] theorem isEqv_toArray [BEq α] (as bs : List α) : (as.toArray.isEqv bs.toArray r) = (as.isEqv bs r) := by
+@[simp, grind =] theorem isEqv_toArray [BEq α] (as bs : List α) : (as.toArray.isEqv bs.toArray r) = (as.isEqv bs r) := by
   simp [isEqv_eq_decide, Array.isEqv_eq_decide]
 
-@[simp] theorem beq_toArray [BEq α] (as bs : List α) : (as.toArray == bs.toArray) = (as == bs) := by
+@[simp, grind =] theorem beq_toArray [BEq α] (as bs : List α) : (as.toArray == bs.toArray) = (as == bs) := by
   simp [beq_eq_decide, Array.beq_eq_decide]
 
 end List

src/Init/Data/Array/Lemmas.lean

@@ -39,10 +39,10 @@ namespace Array
 @[simp] theorem toList_eq_nil_iff {xs : Array α} : xs.toList = [] ↔ xs = #[] := by
   cases xs <;> simp
 
-@[simp] theorem mem_toList_iff {a : α} {xs : Array α} : a ∈ xs.toList ↔ a ∈ xs := by
+@[simp, grind =] theorem mem_toList_iff {a : α} {xs : Array α} : a ∈ xs.toList ↔ a ∈ xs := by
   cases xs <;> simp
 
-@[simp] theorem length_toList {xs : Array α} : xs.toList.length = xs.size := rfl
+@[simp, grind =] theorem length_toList {xs : Array α} : xs.toList.length = xs.size := rfl
 
 theorem eq_toArray : xs = List.toArray as ↔ xs.toList = as := by
   cases xs
@@ -78,6 +78,7 @@ theorem ne_empty_of_size_pos (h : 0 < xs.size) : xs ≠ #[] := by
   cases xs
   simpa using List.ne_nil_of_length_pos h
 
+@[grind]
 theorem size_eq_zero_iff : xs.size = 0 ↔ xs = #[] :=
   ⟨eq_empty_of_size_eq_zero, fun h => h ▸ rfl⟩
 
@@ -527,7 +528,7 @@ theorem forall_getElem {xs : Array α} {p : α → Prop} :
   rcases xs with ⟨xs⟩
   simp
 
-@[simp] theorem isEmpty_toList {xs : Array α} : xs.toList.isEmpty = xs.isEmpty := by
+@[simp, grind =] theorem isEmpty_toList {xs : Array α} : xs.toList.isEmpty = xs.isEmpty := by
   rcases xs with ⟨_ | _⟩ <;> simp
 
 theorem isEmpty_eq_false_iff_exists_mem {xs : Array α} :
@@ -592,7 +593,7 @@ theorem anyM_loop_cons [Monad m] {p : α → m Bool} {a : α} {as : List α} {st
   · rw [dif_neg]
     omega
 
-@[simp] theorem anyM_toList [Monad m] {p : α → m Bool} {as : Array α} :
+@[simp, grind =] theorem anyM_toList [Monad m] {p : α → m Bool} {as : Array α} :
     as.toList.anyM p = as.anyM p :=
   match as with
   | ⟨[]⟩  => by simp [anyM, anyM.loop]
@@ -651,7 +652,7 @@ theorem any_iff_exists {p : α → Bool} {as : Array α} {start stop} :
   rw [Bool.eq_false_iff, Ne, any_eq_true]
   simp
 
-@[simp] theorem any_toList {p : α → Bool} {as : Array α} : as.toList.any p = as.any p := by
+@[simp, grind =] theorem any_toList {p : α → Bool} {as : Array α} : as.toList.any p = as.any p := by
   rw [Bool.eq_iff_iff, any_eq_true, List.any_eq_true]
   simp only [List.mem_iff_getElem, getElem_toList]
   exact ⟨fun ⟨_, ⟨i, w, rfl⟩, h⟩ => ⟨i, w, h⟩, fun ⟨i, w, h⟩ => ⟨_, ⟨i, w, rfl⟩, h⟩⟩
@@ -661,7 +662,7 @@ theorem allM_eq_not_anyM_not [Monad m] [LawfulMonad m] {p : α → m Bool} {as :
   dsimp [allM, anyM]
   simp
 
-@[simp] theorem allM_toList [Monad m] [LawfulMonad m] {p : α → m Bool} {as : Array α} :
+@[simp, grind =] theorem allM_toList [Monad m] [LawfulMonad m] {p : α → m Bool} {as : Array α} :
     as.toList.allM p = as.allM p := by
   rw [allM_eq_not_anyM_not]
   rw [← anyM_toList]
@@ -690,7 +691,7 @@ theorem all_iff_forall {p : α → Bool} {as : Array α} {start stop} :
   rw [Bool.eq_false_iff, Ne, all_eq_true]
   simp
 
-@[simp] theorem all_toList {p : α → Bool} {as : Array α} : as.toList.all p = as.all p := by
+@[simp, grind =] theorem all_toList {p : α → Bool} {as : Array α} : as.toList.all p = as.all p := by
   rw [Bool.eq_iff_iff, all_eq_true, List.all_eq_true]
   simp only [List.mem_iff_getElem, getElem_toList]
   constructor
@@ -730,18 +731,18 @@ theorem all_eq_true_iff_forall_mem {xs : Array α} : xs.all p ↔ ∀ x, x ∈ x
   subst h
   rw [all_toList]
 
-theorem _root_.List.anyM_toArray [Monad m] [LawfulMonad m] {p : α → m Bool} {l : List α} :
+@[grind] theorem _root_.List.anyM_toArray [Monad m] [LawfulMonad m] {p : α → m Bool} {l : List α} :
     l.toArray.anyM p = l.anyM p := by
   rw [← anyM_toList]
 
-theorem _root_.List.any_toArray {p : α → Bool} {l : List α} : l.toArray.any p = l.any p := by
+@[grind] theorem _root_.List.any_toArray {p : α → Bool} {l : List α} : l.toArray.any p = l.any p := by
   rw [any_toList]
 
-theorem _root_.List.allM_toArray [Monad m] [LawfulMonad m] {p : α → m Bool} {l : List α} :
+@[grind] theorem _root_.List.allM_toArray [Monad m] [LawfulMonad m] {p : α → m Bool} {l : List α} :
     l.toArray.allM p = l.allM p := by
   rw [← allM_toList]
 
-theorem _root_.List.all_toArray {p : α → Bool} {l : List α} : l.toArray.all p = l.all p := by
+@[grind] theorem _root_.List.all_toArray {p : α → Bool} {l : List α} : l.toArray.all p = l.all p := by
   rw [all_toList]
 
 /-- Variant of `any_eq_true` in terms of membership rather than an array index. -/
@@ -807,7 +808,7 @@ theorem decide_forall_mem {xs : Array α} {p : α → Prop} [DecidablePred p] :
     decide (∀ x, x ∈ xs → p x) = xs.all p := by
   simp [all_eq']
 
-@[simp] theorem _root_.List.contains_toArray [BEq α] {l : List α} {a : α} :
+@[simp, grind =] theorem _root_.List.contains_toArray [BEq α] {l : List α} {a : α} :
     l.toArray.contains a = l.contains a := by
   simp [Array.contains, List.any_beq]
 
@@ -1205,7 +1206,7 @@ where
     induction l generalizing xs <;> simp [*]
   simp [H]
 
-@[simp] theorem _root_.List.map_toArray {f : α → β} {l : List α} :
+@[simp, grind =] theorem _root_.List.map_toArray {f : α → β} {l : List α} :
     l.toArray.map f = (l.map f).toArray := by
   apply ext'
   simp
@@ -1428,7 +1429,7 @@ theorem filter_congr {xs ys : Array α} (h : xs = ys)
   induction xs with simp
   | cons => split <;> simp [*]
 
-theorem toList_filter {p : α → Bool} {xs : Array α} :
+@[grind] theorem toList_filter {p : α → Bool} {xs : Array α} :
     (xs.filter p).toList = xs.toList.filter p := by
   simp
 
@@ -1437,7 +1438,7 @@ theorem toList_filter {p : α → Bool} {xs : Array α} :
   apply ext'
   simp [h]
 
-theorem _root_.List.filter_toArray {p : α → Bool} {l : List α} :
+@[grind] theorem _root_.List.filter_toArray {p : α → Bool} {l : List α} :
     l.toArray.filter p = (l.filter p).toArray := by
   simp
 
@@ -1602,7 +1603,7 @@ theorem filterMap_congr {as bs : Array α} (h : as = bs)
   · simp_all [Id.run, List.filterMap_cons]
     split <;> simp_all
 
-theorem toList_filterMap {f : α → Option β} {xs : Array α} :
+@[grind] theorem toList_filterMap {f : α → Option β} {xs : Array α} :
     (xs.filterMap f).toList = xs.toList.filterMap f := by
   simp [toList_filterMap']
 
@@ -1612,7 +1613,7 @@ theorem toList_filterMap {f : α → Option β} {xs : Array α} :
   apply ext'
   simp [h]
 
-theorem _root_.List.filterMap_toArray {f : α → Option β} {l : List α} :
+@[grind] theorem _root_.List.filterMap_toArray {f : α → Option β} {l : List α} :
     l.toArray.filterMap f = (l.filterMap f).toArray := by
   simp
 
@@ -2097,7 +2098,7 @@ theorem append_eq_map_iff {f : α → β} :
 
 @[simp, grind] theorem flatten_empty : (#[] : Array (Array α)).flatten = #[] := by simp [flatten]; rfl
 
-@[simp] theorem toList_flatten {xss : Array (Array α)} :
+@[simp, grind] theorem toList_flatten {xss : Array (Array α)} :
     xss.flatten.toList = (xss.toList.map toList).flatten := by
   dsimp [flatten]
   simp only [← foldl_toList]
@@ -2124,7 +2125,7 @@ theorem append_eq_map_iff {f : α → β} :
   apply ext'
   simp
 
-@[simp] theorem size_flatten {xss : Array (Array α)} : xss.flatten.size = (xss.map size).sum := by
+@[simp, grind] theorem size_flatten {xss : Array (Array α)} : xss.flatten.size = (xss.map size).sum := by
   cases xss using array₂_induction
   simp [Function.comp_def]
 
@@ -2307,7 +2308,7 @@ theorem flatMap_toList {xs : Array α} {f : α → List β} :
   rcases xs with ⟨l⟩
   simp
 
-@[simp] theorem toList_flatMap {xs : Array α} {f : α → Array β} :
+@[simp, grind =] theorem toList_flatMap {xs : Array α} {f : α → Array β} :
     (xs.flatMap f).toList = xs.toList.flatMap fun a => (f a).toList := by
   rcases xs with ⟨l⟩
   simp
@@ -2322,7 +2323,7 @@ theorem flatMap_toArray_cons {β} {f : α → Array β} {a : α} {as : List α}
   intro cs
   induction as generalizing cs <;> simp_all
 
-@[simp] theorem flatMap_toArray {β} {f : α → Array β} {as : List α} :
+@[simp, grind =] theorem flatMap_toArray {β} {f : α → Array β} {as : List α} :
     as.toArray.flatMap f = (as.flatMap (fun a => (f a).toList)).toArray := by
   induction as with
   | nil => simp
@@ -2652,6 +2653,7 @@ abbrev sum_mkArray_nat := @sum_replicate_nat
 
 /-! ### Preliminaries about `swap` needed for `reverse`. -/
 
+@[grind]
 theorem getElem?_swap {xs : Array α} {i j : Nat} (hi hj) {k : Nat} : (xs.swap i j hi hj)[k]? =
     if j = k then some xs[i] else if i = k then some xs[j] else xs[k]? := by
   simp [swap_def, getElem?_set]
@@ -2710,15 +2712,15 @@ theorem getElem?_swap {xs : Array α} {i j : Nat} (hi hj) {k : Nat} : (xs.swap i
         true_and, Nat.not_lt] at h
       rw [List.getElem?_eq_none_iff.2 ‹_›, List.getElem?_eq_none_iff.2 (xs.toList.length_reverse ▸ ‹_›)]
 
-@[simp] theorem _root_.List.reverse_toArray {l : List α} : l.toArray.reverse = l.reverse.toArray := by
+@[simp, grind =] theorem _root_.List.reverse_toArray {l : List α} : l.toArray.reverse = l.reverse.toArray := by
   apply ext'
   simp only [toList_reverse]
 
-@[simp, grind] theorem reverse_push {xs : Array α} {a : α} : (xs.push a).reverse = #[a] ++ xs.reverse := by
+@[simp, grind =] theorem reverse_push {xs : Array α} {a : α} : (xs.push a).reverse = #[a] ++ xs.reverse := by
   cases xs
   simp
 
-@[simp, grind] theorem mem_reverse {x : α} {xs : Array α} : x ∈ xs.reverse ↔ x ∈ xs := by
+@[simp, grind =] theorem mem_reverse {x : α} {xs : Array α} : x ∈ xs.reverse ↔ x ∈ xs := by
   cases xs
   simp
 
@@ -2882,7 +2884,7 @@ theorem size_extract_loop {xs ys : Array α} {size start : Nat} :
       have h := Nat.le_of_not_gt h
       rw [extract_loop_of_ge (h:=h), Nat.sub_eq_zero_of_le h, Nat.min_zero, Nat.add_zero]
 
-@[simp, grind] theorem size_extract {xs : Array α} {start stop : Nat} :
+@[simp, grind =] theorem size_extract {xs : Array α} {start stop : Nat} :
     (xs.extract start stop).size = min stop xs.size - start := by
   simp only [extract, Nat.sub_eq, emptyWithCapacity_eq]
   rw [size_extract_loop, size_empty, Nat.zero_add, Nat.sub_min_sub_right, Nat.min_assoc,
@@ -2948,7 +2950,7 @@ theorem getElem_extract_aux {xs : Array α} {start stop : Nat} (h : i < (xs.extr
   rw [size_extract] at h; apply Nat.add_lt_of_lt_sub'; apply Nat.lt_of_lt_of_le h
   apply Nat.sub_le_sub_right; apply Nat.min_le_right
 
-@[simp] theorem getElem_extract {xs : Array α} {start stop : Nat}
+@[simp, grind =] theorem getElem_extract {xs : Array α} {start stop : Nat}
     (h : i < (xs.extract start stop).size) :
     (xs.extract start stop)[i] = xs[start + i]'(getElem_extract_aux h) :=
   show (extract.loop xs (min stop xs.size - start) start #[])[i]
@@ -3003,7 +3005,7 @@ theorem extract_empty_of_size_le_start {xs : Array α} {start stop : Nat} (h : x
   · simp
   · simp at h₁
 
-@[simp] theorem _root_.List.extract_toArray {l : List α} {start stop : Nat} :
+@[simp, grind =] theorem _root_.List.extract_toArray {l : List α} {start stop : Nat} :
     l.toArray.extract start stop = (l.extract start stop).toArray := by
   apply ext'
   simp
@@ -3742,25 +3744,25 @@ theorem contains_iff_mem [BEq α] [LawfulBEq α] {xs : Array α} {a : α} :
     xs.contains a ↔ a ∈ xs := by
   simp
 
-@[simp, grind]
+@[simp, grind =]
 theorem contains_toList [BEq α] {xs : Array α} {x : α} :
     xs.toList.contains x = xs.contains x := by
   rcases xs with ⟨xs⟩
   simp
 
-@[simp, grind]
+@[simp, grind =]
 theorem contains_map [BEq β] {xs : Array α} {x : β} {f : α → β} :
     (xs.map f).contains x = xs.any (fun a => x == f a) := by
   rcases xs with ⟨xs⟩
   simp
 
-@[simp, grind]
+@[simp, grind =]
 theorem contains_filter [BEq α] {xs : Array α} {x : α} {p : α → Bool} :
     (xs.filter p).contains x = xs.any (fun a => x == a && p a) := by
   rcases xs with ⟨xs⟩
   simp
 
-@[simp, grind]
+@[simp, grind =]
 theorem contains_filterMap [BEq β] {xs : Array α} {x : β} {f : α → Option β} :
     (xs.filterMap f).contains x = xs.any (fun a => (f a).any fun b => x == b) := by
   rcases xs with ⟨xs⟩
@@ -3773,19 +3775,19 @@ theorem contains_append [BEq α] {xs ys : Array α} {x : α} :
   rcases ys with ⟨ys⟩
   simp
 
-@[simp, grind]
+@[simp, grind =]
 theorem contains_flatten [BEq α] {xs : Array (Array α)} {x : α} :
     (xs.flatten).contains x = xs.any fun xs => xs.contains x := by
   rcases xs with ⟨xs⟩
   simp [Function.comp_def]
 
-@[simp, grind]
+@[simp, grind =]
 theorem contains_reverse [BEq α] {xs : Array α} {x : α} :
     (xs.reverse).contains x = xs.contains x := by
   rcases xs with ⟨xs⟩
   simp
 
-@[simp, grind]
+@[simp, grind =]
 theorem contains_flatMap [BEq β] {xs : Array α} {f : α → Array β} {x : β} :
     (xs.flatMap f).contains x = xs.any fun a => (f a).contains x := by
   rcases xs with ⟨xs⟩
@@ -3798,7 +3800,7 @@ theorem pop_append {xs ys : Array α} :
     (xs ++ ys).pop = if ys.isEmpty then xs.pop else xs ++ ys.pop := by
   split <;> simp_all
 
-@[simp] theorem pop_replicate {n : Nat} {a : α} : (replicate n a).pop = replicate (n - 1) a := by
+@[simp, grind =] theorem pop_replicate {n : Nat} {a : α} : (replicate n a).pop = replicate (n - 1) a := by
   ext <;> simp
 
 @[deprecated pop_replicate (since := "2025-03-18")]
@@ -4096,6 +4098,7 @@ theorem getElem_swap' {xs : Array α} {i j : Nat} {hi hj} {k : Nat} (hk : k < xs
   · simp_all only [getElem_swap_left]
   · split <;> simp_all
 
+@[grind]
 theorem getElem_swap {xs : Array α} {i j : Nat} (hi hj) {k : Nat} (hk : k < (xs.swap i j hi hj).size) :
     (xs.swap i j hi hj)[k] = if k = i then xs[j] else if k = j then xs[i] else xs[k]'(by simp_all) := by
   apply getElem_swap'
@@ -4361,7 +4364,10 @@ theorem foldl_toList_eq_map {l : List α} {acc : Array β} {G : α → β} :
 
 /-! # uset -/
 
-attribute [simp] uset
+-- For verification purposes, we use `simp` to replace `uset` with `set`.
+@[simp, grind =] theorem uset_eq_set {xs : Array α} {v : α} {i : USize} (h : i.toNat < xs.size) :
+    uset xs i v h = set xs i.toNat v h := by
+  simp [uset]
 
 theorem size_uset {xs : Array α} {v : α} {i : USize} (h : i.toNat < xs.size) :
     (uset xs i v h).size = xs.size := by
@@ -4378,7 +4384,7 @@ theorem getElem!_eq_getD [Inhabited α] {xs : Array α} {i} : xs[i]! = xs.getD i
 
 /-! # mem -/
 
-@[simp] theorem mem_toList {a : α} {xs : Array α} : a ∈ xs.toList ↔ a ∈ xs := mem_def.symm
+@[simp, grind =] theorem mem_toList {a : α} {xs : Array α} : a ∈ xs.toList ↔ a ∈ xs := mem_def.symm
 
 @[deprecated not_mem_empty (since := "2025-03-25")]
 theorem not_mem_nil (a : α) : ¬ a ∈ #[] := nofun
@@ -4421,12 +4427,12 @@ theorem getElem?_push_eq {xs : Array α} {x : α} : (xs.push x)[xs.size]? = some
 
 /-! ### forIn -/
 
-@[simp] theorem forIn_toList [Monad m] {xs : Array α} {b : β} {f : α → β → m (ForInStep β)} :
+@[simp, grind =] theorem forIn_toList [Monad m] {xs : Array α} {b : β} {f : α → β → m (ForInStep β)} :
     forIn xs.toList b f = forIn xs b f := by
   cases xs
   simp
 
-@[simp] theorem forIn'_toList [Monad m] {xs : Array α} {b : β} {f : (a : α) → a ∈ xs.toList → β → m (ForInStep β)} :
+@[simp, grind =] theorem forIn'_toList [Monad m] {xs : Array α} {b : β} {f : (a : α) → a ∈ xs.toList → β → m (ForInStep β)} :
     forIn' xs.toList b f = forIn' xs b (fun a m b => f a (mem_toList.mpr m) b) := by
   cases xs
   simp
@@ -4439,7 +4445,7 @@ abbrev contains_def [DecidableEq α] {a : α} {xs : Array α} : xs.contains a
 
 /-! ### isPrefixOf -/
 
-@[simp] theorem isPrefixOf_toList [BEq α] {xs ys : Array α} :
+@[simp, grind =] theorem isPrefixOf_toList [BEq α] {xs ys : Array α} :
     xs.toList.isPrefixOf ys.toList = xs.isPrefixOf ys := by
   cases xs
   cases ys
@@ -4480,32 +4486,32 @@ abbrev contains_def [DecidableEq α] {a : α} {xs : Array α} : xs.contains a
 
 /-! ### findSomeM?, findM?, findSome?, find? -/
 
-@[simp] theorem findSomeM?_toList [Monad m] [LawfulMonad m] {p : α → m (Option β)} {xs : Array α} :
+@[simp, grind =] theorem findSomeM?_toList [Monad m] [LawfulMonad m] {p : α → m (Option β)} {xs : Array α} :
     xs.toList.findSomeM? p = xs.findSomeM? p := by
   cases xs
   simp
 
-@[simp] theorem findM?_toList [Monad m] [LawfulMonad m] {p : α → m Bool} {xs : Array α} :
+@[simp, grind =] theorem findM?_toList [Monad m] [LawfulMonad m] {p : α → m Bool} {xs : Array α} :
     xs.toList.findM? p = xs.findM? p := by
   cases xs
   simp
 
-@[simp] theorem findSome?_toList {p : α → Option β} {xs : Array α} :
+@[simp, grind =] theorem findSome?_toList {p : α → Option β} {xs : Array α} :
     xs.toList.findSome? p = xs.findSome? p := by
   cases xs
   simp
 
-@[simp] theorem find?_toList {p : α → Bool} {xs : Array α} :
+@[simp, grind =] theorem find?_toList {p : α → Bool} {xs : Array α} :
     xs.toList.find? p = xs.find? p := by
   cases xs
   simp
 
-@[simp] theorem finIdxOf?_toList [BEq α] {a : α} {xs : Array α} :
+@[simp, grind =] theorem finIdxOf?_toList [BEq α] {a : α} {xs : Array α} :
     xs.toList.finIdxOf? a = (xs.finIdxOf? a).map (Fin.cast (by simp)) := by
   cases xs
   simp
 
-@[simp] theorem findFinIdx?_toList {p : α → Bool} {xs : Array α} :
+@[simp, grind =] theorem findFinIdx?_toList {p : α → Bool} {xs : Array α} :
     xs.toList.findFinIdx? p = (xs.findFinIdx? p).map (Fin.cast (by simp)) := by
   cases xs
   simp
@@ -4524,10 +4530,10 @@ Our goal is to have `simp` "pull `List.toArray` outwards" as much as possible.
 
 theorem toListRev_toArray {l : List α} : l.toArray.toListRev = l.reverse := by simp
 
-@[simp] theorem take_toArray {l : List α} {i : Nat} : l.toArray.take i = (l.take i).toArray := by
+@[simp, grind =] theorem take_toArray {l : List α} {i : Nat} : l.toArray.take i = (l.take i).toArray := by
   apply Array.ext <;> simp
 
-@[simp] theorem mapM_toArray [Monad m] [LawfulMonad m] {f : α → m β} {l : List α} :
+@[simp, grind =] theorem mapM_toArray [Monad m] [LawfulMonad m] {f : α → m β} {l : List α} :
     l.toArray.mapM f = List.toArray <$> l.mapM f := by
   simp only [← mapM'_eq_mapM, mapM_eq_foldlM]
   suffices ∀ xs : Array β,
@@ -4544,12 +4550,12 @@ theorem toListRev_toArray {l : List α} : l.toArray.toListRev = l.reverse := by
 theorem uset_toArray {l : List α} {i : USize} {a : α} {h : i.toNat < l.toArray.size} :
     l.toArray.uset i a h = (l.set i.toNat a).toArray := by simp
 
-@[simp] theorem modify_toArray {f : α → α} {l : List α} {i : Nat} :
+@[simp, grind =] theorem modify_toArray {f : α → α} {l : List α} {i : Nat} :
     l.toArray.modify i f = (l.modify i f).toArray := by
   apply ext'
   simp
 
-@[simp] theorem flatten_toArray {L : List (List α)} :
+@[simp, grind =] theorem flatten_toArray {L : List (List α)} :
     (L.toArray.map List.toArray).flatten = L.flatten.toArray := by
   apply ext'
   simp [Function.comp_def]
@@ -4624,11 +4630,11 @@ end Array
 
 namespace List
 
-@[simp] theorem unzip_toArray {as : List (α × β)} :
+@[simp, grind =] theorem unzip_toArray {as : List (α × β)} :
     as.toArray.unzip = Prod.map List.toArray List.toArray as.unzip := by
   ext1 <;> simp
 
-@[simp] theorem firstM_toArray [Alternative m] {as : List α} {f : α → m β} :
+@[simp, grind =] theorem firstM_toArray [Alternative m] {as : List α} {f : α → m β} :
     as.toArray.firstM f = as.firstM f := by
   unfold Array.firstM
   suffices ∀ i, i ≤ as.length → firstM.go f as.toArray (as.length - i) = firstM f (as.drop (as.length - i)) by

src/Init/Data/Array/Lex/Lemmas.lean

@@ -16,11 +16,11 @@ namespace Array
 
 /-! ### Lexicographic ordering -/
 
-@[simp] theorem _root_.List.lt_toArray [LT α] {l₁ l₂ : List α} : l₁.toArray < l₂.toArray ↔ l₁ < l₂ := Iff.rfl
-@[simp] theorem _root_.List.le_toArray [LT α] {l₁ l₂ : List α} : l₁.toArray ≤ l₂.toArray ↔ l₁ ≤ l₂ := Iff.rfl
+@[simp, grind =] theorem _root_.List.lt_toArray [LT α] {l₁ l₂ : List α} : l₁.toArray < l₂.toArray ↔ l₁ < l₂ := Iff.rfl
+@[simp, grind =] theorem _root_.List.le_toArray [LT α] {l₁ l₂ : List α} : l₁.toArray ≤ l₂.toArray ↔ l₁ ≤ l₂ := Iff.rfl
 
-@[simp] theorem lt_toList [LT α] {xs ys : Array α} : xs.toList < ys.toList ↔ xs < ys := Iff.rfl
-@[simp] theorem le_toList [LT α] {xs ys : Array α} : xs.toList ≤ ys.toList ↔ xs ≤ ys := Iff.rfl
+@[simp, grind =] theorem lt_toList [LT α] {xs ys : Array α} : xs.toList < ys.toList ↔ xs < ys := Iff.rfl
+@[simp, grind =] theorem le_toList [LT α] {xs ys : Array α} : xs.toList ≤ ys.toList ↔ xs ≤ ys := Iff.rfl
 
 protected theorem not_lt_iff_ge [LT α] {l₁ l₂ : List α} : ¬ l₁ < l₂ ↔ l₂ ≤ l₁ := Iff.rfl
 protected theorem not_le_iff_gt [DecidableEq α] [LT α] [DecidableLT α] {l₁ l₂ : List α} :
@@ -47,7 +47,7 @@ private theorem cons_lex_cons [BEq α] {lt : α → α → Bool} {a b : α} {xs
     cases a == b <;> simp
   · simp
 
-@[simp] theorem _root_.List.lex_toArray [BEq α] {lt : α → α → Bool} {l₁ l₂ : List α} :
+@[simp, grind =] theorem _root_.List.lex_toArray [BEq α] {lt : α → α → Bool} {l₁ l₂ : List α} :
     l₁.toArray.lex l₂.toArray lt = l₁.lex l₂ lt := by
   induction l₁ generalizing l₂ with
   | nil => cases l₂ <;> simp [lex, Id.run]
@@ -57,7 +57,7 @@ private theorem cons_lex_cons [BEq α] {lt : α → α → Bool} {a b : α} {xs
     | cons y l₂ =>
       rw [List.toArray_cons, List.toArray_cons y, cons_lex_cons, List.lex, ih]
 
-@[simp] theorem lex_toList [BEq α] {lt : α → α → Bool} {xs ys : Array α} :
+@[simp, grind =] theorem lex_toList [BEq α] {lt : α → α → Bool} {xs ys : Array α} :
     xs.toList.lex ys.toList lt = xs.lex ys lt := by
   cases xs <;> cases ys <;> simp
 

src/Init/Data/Array/MapIdx.lean

@@ -111,11 +111,11 @@ end Array
 
 namespace List
 
-@[simp] theorem mapFinIdx_toArray {l : List α} {f : (i : Nat) → α → (h : i < l.length) → β} :
+@[simp, grind =] theorem mapFinIdx_toArray {l : List α} {f : (i : Nat) → α → (h : i < l.length) → β} :
     l.toArray.mapFinIdx f = (l.mapFinIdx f).toArray := by
   ext <;> simp
 
-@[simp] theorem mapIdx_toArray {f : Nat → α → β} {l : List α} :
+@[simp, grind =] theorem mapIdx_toArray {f : Nat → α → β} {l : List α} :
     l.toArray.mapIdx f = (l.mapIdx f).toArray := by
   ext <;> simp
 
@@ -132,7 +132,7 @@ namespace Array
 @[deprecated getElem_zipIdx (since := "2025-01-21")]
 abbrev getElem_zipWithIndex := @getElem_zipIdx
 
-@[simp] theorem zipIdx_toArray {l : List α} {k : Nat} :
+@[simp, grind =] theorem zipIdx_toArray {l : List α} {k : Nat} :
     l.toArray.zipIdx k = (l.zipIdx k).toArray := by
   ext i hi₁ hi₂ <;> simp [Nat.add_comm]
 
@@ -454,7 +454,7 @@ end Array
 
 namespace List
 
-theorem mapFinIdxM_toArray [Monad m] [LawfulMonad m] {l : List α}
+@[grind] theorem mapFinIdxM_toArray [Monad m] [LawfulMonad m] {l : List α}
     {f : (i : Nat) → α → (h : i < l.length) → m β} :
     l.toArray.mapFinIdxM f = toArray <$> l.mapFinIdxM f := by
   let rec go (i : Nat) (acc : Array β) (inv : i + acc.size = l.length) :
@@ -475,7 +475,7 @@ theorem mapFinIdxM_toArray [Monad m] [LawfulMonad m] {l : List α}
   simp only [Array.mapFinIdxM, mapFinIdxM]
   exact go _ #[] _
 
-theorem mapIdxM_toArray [Monad m] [LawfulMonad m] {l : List α}
+@[grind] theorem mapIdxM_toArray [Monad m] [LawfulMonad m] {l : List α}
     {f : Nat → α → m β} :
     l.toArray.mapIdxM f = toArray <$> l.mapIdxM f := by
   let rec go (bs : List α) (acc : Array β) (inv : bs.length + acc.size = l.length) :

src/Init/Data/Array/Monadic.lean

@@ -264,7 +264,7 @@ end Array
 
 namespace List
 
-theorem filterM_toArray [Monad m] [LawfulMonad m] {l : List α} {p : α → m Bool} :
+@[grind =] theorem filterM_toArray [Monad m] [LawfulMonad m] {l : List α} {p : α → m Bool} :
     l.toArray.filterM p = toArray <$> l.filterM p := by
   simp only [Array.filterM, filterM, foldlM_toArray, bind_pure_comp, Functor.map_map]
   conv => lhs; rw [← reverse_nil]
@@ -284,7 +284,7 @@ theorem filterM_toArray [Monad m] [LawfulMonad m] {l : List α} {p : α → m Bo
   subst w
   rw [filterM_toArray]
 
-theorem filterRevM_toArray [Monad m] [LawfulMonad m] {l : List α} {p : α → m Bool} :
+@[grind =] theorem filterRevM_toArray [Monad m] [LawfulMonad m] {l : List α} {p : α → m Bool} :
     l.toArray.filterRevM p = toArray <$> l.filterRevM p := by
   simp [Array.filterRevM, filterRevM]
   rw [← foldlM_reverse, ← foldlM_toArray, ← Array.filterM, filterM_toArray]
@@ -296,7 +296,7 @@ theorem filterRevM_toArray [Monad m] [LawfulMonad m] {l : List α} {p : α → m
   subst w
   rw [filterRevM_toArray]
 
-theorem filterMapM_toArray [Monad m] [LawfulMonad m] {l : List α} {f : α → m (Option β)} :
+@[grind =] theorem filterMapM_toArray [Monad m] [LawfulMonad m] {l : List α} {f : α → m (Option β)} :
     l.toArray.filterMapM f = toArray <$> l.filterMapM f := by
   simp [Array.filterMapM, filterMapM]
   conv => lhs; rw [← reverse_nil]
@@ -314,7 +314,7 @@ theorem filterMapM_toArray [Monad m] [LawfulMonad m] {l : List α} {f : α → m
   subst w
   rw [filterMapM_toArray]
 
-@[simp] theorem flatMapM_toArray [Monad m] [LawfulMonad m] {l : List α} {f : α → m (Array β)} :
+@[simp, grind =] theorem flatMapM_toArray [Monad m] [LawfulMonad m] {l : List α} {f : α → m (Array β)} :
     l.toArray.flatMapM f = toArray <$> l.flatMapM (fun a => Array.toList <$> f a) := by
   simp only [Array.flatMapM, bind_pure_comp, foldlM_toArray, flatMapM]
   conv => lhs; arg 2; change [].reverse.flatten.toArray

src/Init/Data/Array/Subarray.lean

@@ -464,8 +464,12 @@ instance : Append (Subarray α) where
    let a := x.toArray ++ y.toArray
    a.toSubarray 0 a.size
 
+/-- `Subarray` representation. -/
+protected def Subarray.repr [Repr α] (s : Subarray α) : Std.Format :=
+  repr s.toArray ++ ".toSubarray"
+
 instance [Repr α] : Repr (Subarray α) where
-  reprPrec s  _ := repr s.toArray ++ ".toSubarray"
+  reprPrec s  _ := Subarray.repr s
 
 instance [ToString α] : ToString (Subarray α) where
   toString s := toString s.toArray

src/Init/Data/BitVec/Basic.lean

@@ -199,7 +199,13 @@ protected def toHex {n : Nat} (x : BitVec n) : String :=
   let t := (List.replicate ((n+3) / 4 - s.length) '0').asString
   t ++ s
 
-instance : Repr (BitVec n) where reprPrec a _ := "0x" ++ (a.toHex : Std.Format) ++ "#" ++ repr n
+/-- `BitVec` representation. -/
+protected def BitVec.repr (a : BitVec n) : Std.Format :=
+  "0x" ++ (a.toHex : Std.Format) ++ "#" ++ repr n
+
+instance : Repr (BitVec n) where
+  reprPrec a _ := BitVec.repr a
+
 instance : ToString (BitVec n) where toString a := toString (repr a)
 
 end repr_toString

src/Init/Data/BitVec/Bitblast.lean

@@ -1501,7 +1501,6 @@ theorem sdiv_intMin {x : BitVec w} :
   by_cases h : x = intMin w
   · subst h
     simp
-    omega
   · simp only [sdiv_eq, msb_intMin, show 0 < w by omega, h]
     have := Nat.two_pow_pos (w-1)
     by_cases hx : x.msb

src/Init/Data/BitVec/Lemmas.lean

@@ -518,6 +518,10 @@ theorem getElem_ofBool {b : Bool} {h : i < 1}: (ofBool b)[i] = b := by
   · rintro rfl
     simp
 
+/-- `0#w = 1#w` iff the width is zero. -/
+@[simp] theorem zero_eq_one_iff (w : Nat) : (0#w = 1#w) ↔ (w = 0) := by
+  rw [← one_eq_zero_iff, eq_comm]
+
 /-! ### msb -/
 
 @[simp] theorem msb_zero : (0#w).msb = false := by simp [BitVec.msb, getMsbD]
@@ -5312,6 +5316,14 @@ theorem msb_eq_toNat {x : BitVec w}:
     x.msb = decide (x.toNat ≥ 2 ^ (w - 1)) := by
   simp only [msb_eq_decide, ge_iff_le]
 
+/-- Negating a bitvector created from a natural number equals
+creating a bitvector from the the negative of that number.
+-/
+theorem neg_ofNat_eq_ofInt_neg {w : Nat} {x : Nat} :
+    - BitVec.ofNat w x = BitVec.ofInt w (- x) := by
+  apply BitVec.eq_of_toInt_eq
+  simp [BitVec.toInt_neg, BitVec.toInt_ofNat]
+
 /-! ### abs -/
 
 theorem abs_eq (x : BitVec w) : x.abs = if x.msb then -x else x := by rfl

src/Init/Data/Fin/Lemmas.lean

@@ -174,13 +174,13 @@ theorem mk_le_of_le_val {b : Fin n} {a : Nat} (h : a ≤ b) :
 
 @[simp] theorem mk_zero : (⟨0, Nat.succ_pos n⟩ : Fin (n + 1)) = 0 := rfl
 
-@[simp] theorem zero_le (a : Fin (n + 1)) : 0 ≤ a := Nat.zero_le a.val
+@[simp] theorem zero_le [NeZero n] (a : Fin n) : 0 ≤ a := Nat.zero_le a.val
 
 theorem zero_lt_one : (0 : Fin (n + 2)) < 1 := Nat.zero_lt_one
 
-@[simp] theorem not_lt_zero (a : Fin (n + 1)) : ¬a < 0 := nofun
+@[simp] theorem not_lt_zero [NeZero n] (a : Fin n) : ¬a < 0 := nofun
 
-theorem pos_iff_ne_zero {a : Fin (n + 1)} : 0 < a ↔ a ≠ 0 := by
+theorem pos_iff_ne_zero [NeZero n] {a : Fin n} : 0 < a ↔ a ≠ 0 := by
   rw [lt_def, val_zero, Nat.pos_iff_ne_zero, ← val_ne_iff]; rfl
 
 theorem eq_zero_or_eq_succ {n : Nat} : ∀ i : Fin (n + 1), i = 0 ∨ ∃ j : Fin n, i = j.succ
@@ -506,17 +506,17 @@ theorem castSucc_inj {a b : Fin n} : a.castSucc = b.castSucc ↔ a = b := by sim
 
 theorem castSucc_lt_last (a : Fin n) : a.castSucc < last n := a.is_lt
 
-@[simp] theorem castSucc_zero : castSucc (0 : Fin (n + 1)) = 0 := rfl
+@[simp] theorem castSucc_zero [NeZero n] : castSucc (0 : Fin n) = 0 := rfl
 
 @[simp] theorem castSucc_one {n : Nat} : castSucc (1 : Fin (n + 2)) = 1 := rfl
 
 /-- `castSucc i` is positive when `i` is positive -/
-theorem castSucc_pos {i : Fin (n + 1)} (h : 0 < i) : 0 < i.castSucc := by
+theorem castSucc_pos [NeZero n] {i : Fin n} (h : 0 < i) : 0 < i.castSucc := by
   simpa [lt_def] using h
 
-@[simp] theorem castSucc_eq_zero_iff {a : Fin (n + 1)} : a.castSucc = 0 ↔ a = 0 := by simp [Fin.ext_iff]
+@[simp] theorem castSucc_eq_zero_iff [NeZero n] {a : Fin n} : a.castSucc = 0 ↔ a = 0 := by simp [Fin.ext_iff]
 
-theorem castSucc_ne_zero_iff {a : Fin (n + 1)} : a.castSucc ≠ 0 ↔ a ≠ 0 :=
+theorem castSucc_ne_zero_iff [NeZero n] {a : Fin n} : a.castSucc ≠ 0 ↔ a ≠ 0 :=
   not_congr <| castSucc_eq_zero_iff
 
 theorem castSucc_fin_succ (n : Nat) (j : Fin n) :
@@ -1002,10 +1002,12 @@ theorem val_mul {n : Nat} : ∀ a b : Fin n, (a * b).val = a.val * b.val % n
 theorem coe_mul {n : Nat} : ∀ a b : Fin n, ((a * b : Fin n) : Nat) = a * b % n
   | ⟨_, _⟩, ⟨_, _⟩ => rfl
 
-protected theorem mul_one (k : Fin (n + 1)) : k * 1 = k := by
-  match n with
-  | 0 => exact Subsingleton.elim (α := Fin 1) ..
-  | n+1 => simp [Fin.ext_iff, mul_def, Nat.mod_eq_of_lt (is_lt k)]
+protected theorem mul_one [i : NeZero n] (k : Fin n) : k * 1 = k := by
+  match n, i with
+  | n + 1, _ =>
+    match n with
+    | 0 => exact Subsingleton.elim (α := Fin 1) ..
+    | n+1 => simp [Fin.ext_iff, mul_def, Nat.mod_eq_of_lt (is_lt k)]
 
 protected theorem mul_comm (a b : Fin n) : a * b = b * a :=
   Fin.ext <| by rw [mul_def, mul_def, Nat.mul_comm]
@@ -1018,15 +1020,17 @@ protected theorem mul_assoc (a b c : Fin n) : a * b * c = a * (b * c) := by
   simp only [← Nat.mul_mod, Nat.mul_assoc]
 instance : Std.Associative (α := Fin n) (· * ·) := ⟨Fin.mul_assoc⟩
 
-protected theorem one_mul (k : Fin (n + 1)) : (1 : Fin (n + 1)) * k = k := by
+protected theorem one_mul [NeZero n] (k : Fin n) : (1 : Fin n) * k = k := by
   rw [Fin.mul_comm, Fin.mul_one]
-instance : Std.LawfulIdentity (α := Fin (n + 1)) (· * ·) 1 where
+
+instance [NeZero n] : Std.LawfulIdentity (α := Fin n) (· * ·) 1 where
   left_id := Fin.one_mul
   right_id := Fin.mul_one
 
-protected theorem mul_zero (k : Fin (n + 1)) : k * 0 = 0 := by simp [Fin.ext_iff, mul_def]
+protected theorem mul_zero [NeZero n] (k : Fin n) : k * 0 = 0 := by
+  simp [Fin.ext_iff, mul_def]
 
-protected theorem zero_mul (k : Fin (n + 1)) : (0 : Fin (n + 1)) * k = 0 := by
+protected theorem zero_mul [NeZero n] (k : Fin n) : (0 : Fin n) * k = 0 := by
   simp [Fin.ext_iff, mul_def]
 
 end Fin

src/Init/Data/Float.lean

@@ -291,8 +291,11 @@ implementation.
 instance : Inhabited Float where
   default := UInt64.toFloat 0
 
+protected def Float.repr (n : Float) (prec : Nat) : Std.Format :=
+  if n < UInt64.toFloat 0 then Repr.addAppParen (toString n) prec else toString n
+
 instance : Repr Float where
-  reprPrec n prec := if n < UInt64.toFloat 0 then Repr.addAppParen (toString n) prec else toString n
+  reprPrec := Float.repr
 
 instance : ReprAtom Float  := ⟨⟩
 

src/Init/Data/Float32.lean

@@ -292,8 +292,11 @@ implementation.
 instance : Inhabited Float32 where
   default := UInt64.toFloat32 0
 
+protected def Float32.repr (n : Float32) (prec : Nat) : Std.Format :=
+  if n < UInt64.toFloat32 0 then Repr.addAppParen (toString n) prec else toString n
+
 instance : Repr Float32 where
-  reprPrec n prec := if n < UInt64.toFloat32 0 then Repr.addAppParen (toString n) prec else toString n
+  reprPrec := Float32.repr
 
 instance : ReprAtom Float32  := ⟨⟩
 

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

@@ -44,7 +44,7 @@ Integer division that uses the E-rounding convention. Usually accessed via the `
 Division by zero is defined to be zero, rather than an error.
 
 In the E-rounding convention (Euclidean division), `Int.emod x y` satisfies `0 ≤ Int.emod x y < Int.natAbs y`
-for `y ≠ 0` and `Int.ediv` is the unique function satisfying `Int.emod x y + (Int.edivx y) * y = x`
+for `y ≠ 0` and `Int.ediv` is the unique function satisfying `Int.emod x y + (Int.ediv x y) * y = x`
 for `y ≠ 0`.
 
 This means that `Int.ediv x y` is `⌊x / y⌋` when `y > 0` and `⌈x / y⌉` when `y < 0`.
@@ -76,7 +76,7 @@ def ediv : (@& Int) → (@& Int) → Int
 Integer modulus that uses the E-rounding convention. Usually accessed via the `%` operator.
 
 In the E-rounding convention (Euclidean division), `Int.emod x y` satisfies `0 ≤ Int.emod x y < Int.natAbs y`
-for `y ≠ 0` and `Int.ediv` is the unique function satisfying `Int.emod x y + (Int.edivx y) * y = x`
+for `y ≠ 0` and `Int.ediv` is the unique function satisfying `Int.emod x y + (Int.ediv x y) * y = x`
 for `y ≠ 0`.
 
 This function is overridden by the compiler with an efficient implementation. This definition is

src/Init/Data/List/Lemmas.lean

@@ -92,7 +92,9 @@ open Nat
 
 /-! ### length -/
 
-@[grind →] theorem eq_nil_of_length_eq_zero (_ : length l = 0) : l = [] := match l with | [] => rfl
+-- Note: this is not a good `grind` candidate,
+-- as in some circumstances it results in many case splits.
+theorem eq_nil_of_length_eq_zero (_ : length l = 0) : l = [] := match l with | [] => rfl
 
 theorem ne_nil_of_length_eq_add_one (_ : length l = n + 1) : l ≠ [] := fun _ => nomatch l
 
@@ -239,15 +241,17 @@ theorem getElem!_eq_getElem?_getD [Inhabited α] {l : List α} {i : Nat} :
 
 @[simp, grind =] theorem getElem?_nil {i : Nat} : ([] : List α)[i]? = none := rfl
 
+@[grind =]
 theorem getElem_cons {l : List α} (w : i < (a :: l).length) :
     (a :: l)[i] =
       if h : i = 0 then a else l[i-1]'(match i, h with | i+1, _ => succ_lt_succ_iff.mp w) := by
   cases i <;> simp
 
-@[grind =] theorem getElem?_cons_zero {l : List α} : (a::l)[0]? = some a := rfl
+theorem getElem?_cons_zero {l : List α} : (a::l)[0]? = some a := rfl
 
-@[simp, grind =] theorem getElem?_cons_succ {l : List α} : (a::l)[i+1]? = l[i]? := rfl
+@[simp] theorem getElem?_cons_succ {l : List α} : (a::l)[i+1]? = l[i]? := rfl
 
+@[grind =]
 theorem getElem?_cons : (a :: l)[i]? = if i = 0 then some a else l[i-1]? := by
   cases i <;> simp [getElem?_cons_zero]
 
@@ -313,7 +317,7 @@ theorem getElem_zero {l : List α} (h : 0 < l.length) : l[0] = l.head (length_po
   match l, h with
   | _ :: _, _ => rfl
 
-@[ext, grind ext] theorem ext_getElem? {l₁ l₂ : List α} (h : ∀ i : Nat, l₁[i]? = l₂[i]?) : l₁ = l₂ :=
+@[ext] theorem ext_getElem? {l₁ l₂ : List α} (h : ∀ i : Nat, l₁[i]? = l₂[i]?) : l₁ = l₂ :=
   match l₁, l₂, h with
   | [], [], _ => rfl
   | _ :: _, [], h => by simpa using h 0

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

@@ -27,7 +27,7 @@ open Nat
 
 /-! ### take -/
 
-@[simp] theorem length_take : ∀ {i : Nat} {l : List α}, (take i l).length = min i l.length
+@[simp, grind =] theorem length_take : ∀ {i : Nat} {l : List α}, (take i l).length = min i l.length
   | 0, l => by simp [Nat.zero_min]
   | succ n, [] => by simp [Nat.min_zero]
   | succ n, _ :: l => by simp [Nat.succ_min_succ, length_take]
@@ -47,7 +47,7 @@ theorem getElem_take' {xs : List α} {i j : Nat} (hi : i < xs.length) (hj : i <
 
 /-- The `i`-th element of a list coincides with the `i`-th element of any of its prefixes of
 length `> i`. Version designed to rewrite from the small list to the big list. -/
-@[simp] theorem getElem_take {xs : List α} {j i : Nat} {h : i < (xs.take j).length} :
+@[simp, grind =] theorem getElem_take {xs : List α} {j i : Nat} {h : i < (xs.take j).length} :
     (xs.take j)[i] =
     xs[i]'(Nat.lt_of_lt_of_le h (length_take_le' _ _)) := by
   rw [length_take, Nat.lt_min] at h; rw [getElem_take' (xs := xs) _ h.1]
@@ -56,7 +56,7 @@ theorem getElem?_take_eq_none {l : List α} {i j : Nat} (h : i ≤ j) :
     (l.take i)[j]? = none :=
   getElem?_eq_none <| Nat.le_trans (length_take_le _ _) h
 
-theorem getElem?_take {l : List α} {i j : Nat} :
+@[grind =]theorem getElem?_take {l : List α} {i j : Nat} :
     (l.take i)[j]? = if j < i then l[j]? else none := by
   split
   · next h => exact getElem?_take_of_lt h
@@ -232,7 +232,7 @@ theorem getElem_drop' {xs : List α} {i j : Nat} (h : i + j < xs.length) :
 
 /-- The `i + j`-th element of a list coincides with the `j`-th element of the list obtained by
 dropping the first `i` elements. Version designed to rewrite from the small list to the big list. -/
-@[simp] theorem getElem_drop {xs : List α} {i : Nat} {j : Nat} {h : j < (xs.drop i).length} :
+@[simp, grind =] theorem getElem_drop {xs : List α} {i : Nat} {j : Nat} {h : j < (xs.drop i).length} :
     (xs.drop i)[j] = xs[i + j]'(by
       rw [Nat.add_comm]
       exact Nat.add_lt_of_lt_sub (length_drop ▸ h)) := by

src/Init/Data/List/TakeDrop.lean

@@ -40,7 +40,7 @@ theorem drop_one : ∀ {l : List α}, l.drop 1 = l.tail
   | _ + 1, [] => rfl
   | _ + 1, x :: _ => congrArg (cons x) (take_append_drop ..)
 
-@[simp] theorem length_drop : ∀ {i : Nat} {l : List α}, (drop i l).length = l.length - i
+@[simp, grind =] theorem length_drop : ∀ {i : Nat} {l : List α}, (drop i l).length = l.length - i
   | 0, _ => rfl
   | succ i, [] => Eq.symm (Nat.zero_sub (succ i))
   | succ i, x :: l => calc

src/Init/Data/List/ToArray.lean

@@ -66,7 +66,7 @@ theorem toArray_cons (a : α) (l : List α) : (a :: l).toArray = #[a] ++ l.toArr
   apply ext'
   simp
 
-@[simp] theorem push_toArray (l : List α) (a : α) : l.toArray.push a = (l ++ [a]).toArray := by
+@[simp, grind =] theorem push_toArray (l : List α) (a : α) : l.toArray.push a = (l ++ [a]).toArray := by
   apply ext'
   simp
 
@@ -75,37 +75,37 @@ theorem toArray_cons (a : α) (l : List α) : (a :: l).toArray = #[a] ++ l.toArr
   funext a
   simp
 
-@[simp] theorem isEmpty_toArray (l : List α) : l.toArray.isEmpty = l.isEmpty := by
+@[simp, grind =] theorem isEmpty_toArray (l : List α) : l.toArray.isEmpty = l.isEmpty := by
   cases l <;> simp [Array.isEmpty]
 
 @[simp] theorem toArray_singleton (a : α) : (List.singleton a).toArray = Array.singleton a := rfl
 
-@[simp] theorem back!_toArray [Inhabited α] (l : List α) : l.toArray.back! = l.getLast! := by
+@[simp, grind =] theorem back!_toArray [Inhabited α] (l : List α) : l.toArray.back! = l.getLast! := by
   simp only [back!, size_toArray, getElem!_toArray, getLast!_eq_getElem!]
 
-@[simp] theorem back?_toArray (l : List α) : l.toArray.back? = l.getLast? := by
+@[simp, grind =] theorem back?_toArray (l : List α) : l.toArray.back? = l.getLast? := by
   simp [back?, List.getLast?_eq_getElem?]
 
-@[simp] theorem back_toArray (l : List α) (h) :
+@[simp, grind =] theorem back_toArray (l : List α) (h) :
     l.toArray.back = l.getLast (by simp at h; exact ne_nil_of_length_pos h) := by
   simp [back, List.getLast_eq_getElem]
 
-@[simp] theorem _root_.Array.getLast!_toList [Inhabited α] (xs : Array α) :
+@[simp, grind =] theorem _root_.Array.getLast!_toList [Inhabited α] (xs : Array α) :
     xs.toList.getLast! = xs.back! := by
   rcases xs with ⟨xs⟩
   simp
 
-@[simp] theorem _root_.Array.getLast?_toList (xs : Array α) :
+@[simp, grind =] theorem _root_.Array.getLast?_toList (xs : Array α) :
     xs.toList.getLast? = xs.back? := by
   rcases xs with ⟨xs⟩
   simp
 
-@[simp] theorem _root_.Array.getLast_toList (xs : Array α) (h) :
+@[simp, grind =] theorem _root_.Array.getLast_toList (xs : Array α) (h) :
     xs.toList.getLast h = xs.back (by simpa [ne_nil_iff_length_pos] using h) := by
   rcases xs with ⟨xs⟩
   simp
 
-@[simp] theorem set_toArray (l : List α) (i : Nat) (a : α) (h : i < l.length) :
+@[simp, grind =] theorem set_toArray (l : List α) (i : Nat) (a : α) (h : i < l.length) :
     (l.toArray.set i a) = (l.set i a).toArray := rfl
 
 @[simp] theorem forIn'_loop_toArray [Monad m] (l : List α) (f : (a : α) → a ∈ l.toArray → β → m (ForInStep β)) (i : Nat)
@@ -126,30 +126,30 @@ theorem toArray_cons (a : α) (l : List α) : (a :: l).toArray = #[a] ++ l.toArr
     simp only [t]
     congr
 
-@[simp] theorem forIn'_toArray [Monad m] (l : List α) (b : β) (f : (a : α) → a ∈ l.toArray → β → m (ForInStep β)) :
+@[simp, grind =] theorem forIn'_toArray [Monad m] (l : List α) (b : β) (f : (a : α) → a ∈ l.toArray → β → m (ForInStep β)) :
     forIn' l.toArray b f = forIn' l b (fun a m b => f a (mem_toArray.mpr m) b) := by
   change Array.forIn' _ _ _ = List.forIn' _ _ _
   rw [Array.forIn', forIn'_loop_toArray]
   simp
 
-@[simp] theorem forIn_toArray [Monad m] (l : List α) (b : β) (f : α → β → m (ForInStep β)) :
+@[simp, grind =] theorem forIn_toArray [Monad m] (l : List α) (b : β) (f : α → β → m (ForInStep β)) :
     forIn l.toArray b f = forIn l b f := by
   simpa using forIn'_toArray l b fun a m b => f a b
 
-theorem foldrM_toArray [Monad m] (f : α → β → m β) (init : β) (l : List α) :
+@[grind =] theorem foldrM_toArray [Monad m] (f : α → β → m β) (init : β) (l : List α) :
     l.toArray.foldrM f init = l.foldrM f init := by
   rw [foldrM_eq_reverse_foldlM_toList]
   simp
 
-theorem foldlM_toArray [Monad m] (f : β → α → m β) (init : β) (l : List α) :
+@[grind =] theorem foldlM_toArray [Monad m] (f : β → α → m β) (init : β) (l : List α) :
     l.toArray.foldlM f init = l.foldlM f init := by
   rw [foldlM_toList]
 
-theorem foldr_toArray (f : α → β → β) (init : β) (l : List α) :
+@[grind =] theorem foldr_toArray (f : α → β → β) (init : β) (l : List α) :
     l.toArray.foldr f init = l.foldr f init := by
   rw [foldr_toList]
 
-theorem foldl_toArray (f : β → α → β) (init : β) (l : List α) :
+@[grind =] theorem foldl_toArray (f : β → α → β) (init : β) (l : List α) :
     l.toArray.foldl f init = l.foldl f init := by
   rw [foldl_toList]
 
@@ -176,7 +176,7 @@ theorem foldl_toArray (f : β → α → β) (init : β) (l : List α) :
   simp only [size_toArray, foldlM_toArray']
   induction l <;> simp_all
 
-@[simp]
+@[simp, grind =]
 theorem forM_toArray [Monad m] (l : List α) (f : α → m PUnit) :
     (forM l.toArray f) = l.forM f :=
   forM_toArray' l f rfl
@@ -195,15 +195,15 @@ theorem forM_toArray [Monad m] (l : List α) (f : α → m PUnit) :
   subst h
   rw [foldl_toList]
 
-@[simp] theorem sum_toArray [Add α] [Zero α] (l : List α) : l.toArray.sum = l.sum := by
+@[simp, grind =] theorem sum_toArray [Add α] [Zero α] (l : List α) : l.toArray.sum = l.sum := by
   simp [Array.sum, List.sum]
 
-@[simp] theorem append_toArray (l₁ l₂ : List α) :
+@[simp, grind =] theorem append_toArray (l₁ l₂ : List α) :
     l₁.toArray ++ l₂.toArray = (l₁ ++ l₂).toArray := by
   apply ext'
   simp
 
-@[simp] theorem push_append_toArray {as : Array α} {a : α} {bs : List α} : as.push a ++ bs.toArray = as ++ (a ::bs).toArray := by
+@[simp] theorem push_append_toArray {as : Array α} {a : α} {bs : List α} : as.push a ++ bs.toArray = as ++ (a :: bs).toArray := by
   cases as
   simp
 
@@ -213,7 +213,7 @@ theorem forM_toArray [Monad m] (l : List α) (f : α → m PUnit) :
 @[simp] theorem foldr_push {l : List α} {as : Array α} : l.foldr (fun a bs => push bs a) as = as ++ l.reverse.toArray := by
   rw [foldr_eq_foldl_reverse, foldl_push]
 
-@[simp] theorem findSomeM?_toArray [Monad m] [LawfulMonad m] (f : α → m (Option β)) (l : List α) :
+@[simp, grind =] theorem findSomeM?_toArray [Monad m] [LawfulMonad m] (f : α → m (Option β)) (l : List α) :
     l.toArray.findSomeM? f = l.findSomeM? f := by
   rw [Array.findSomeM?]
   simp only [bind_pure_comp, map_pure, forIn_toArray]
@@ -246,7 +246,7 @@ theorem findRevM?_toArray [Monad m] [LawfulMonad m] (f : α → m Bool) (l : Lis
     l.toArray.findRevM? f = l.reverse.findM? f := by
   rw [Array.findRevM?, findSomeRevM?_toArray, findM?_eq_findSomeM?]
 
-@[simp] theorem findM?_toArray [Monad m] [LawfulMonad m] (f : α → m Bool) (l : List α) :
+@[simp, grind =] theorem findM?_toArray [Monad m] [LawfulMonad m] (f : α → m Bool) (l : List α) :
     l.toArray.findM? f = l.findM? f := by
   rw [Array.findM?]
   simp only [bind_pure_comp, map_pure, forIn_toArray]
@@ -257,11 +257,11 @@ theorem findRevM?_toArray [Monad m] [LawfulMonad m] (f : α → m Bool) (l : Lis
     congr
     ext1 (_|_) <;> simp [ih]
 
-@[simp] theorem findSome?_toArray (f : α → Option β) (l : List α) :
+@[simp, grind =] theorem findSome?_toArray (f : α → Option β) (l : List α) :
     l.toArray.findSome? f = l.findSome? f := by
   rw [Array.findSome?, ← findSomeM?_id, findSomeM?_toArray, Id.run]
 
-@[simp] theorem find?_toArray (f : α → Bool) (l : List α) :
+@[simp, grind =] theorem find?_toArray (f : α → Bool) (l : List α) :
     l.toArray.find? f = l.find? f := by
   rw [Array.find?]
   simp only [Id.run, Id, Id.pure_eq, Id.bind_eq, forIn_toArray]
@@ -297,12 +297,12 @@ private theorem findFinIdx?_loop_toArray (w : l' = l.drop j) :
     simp
 termination_by l.length - j
 
-@[simp] theorem findFinIdx?_toArray (p : α → Bool) (l : List α) :
+@[simp, grind =] theorem findFinIdx?_toArray (p : α → Bool) (l : List α) :
     l.toArray.findFinIdx? p = l.findFinIdx? p := by
   rw [Array.findFinIdx?, findFinIdx?, findFinIdx?_loop_toArray]
   simp
 
-@[simp] theorem findIdx?_toArray (p : α → Bool) (l : List α) :
+@[simp, grind =] theorem findIdx?_toArray (p : α → Bool) (l : List α) :
     l.toArray.findIdx? p = l.findIdx? p := by
   rw [Array.findIdx?_eq_map_findFinIdx?_val, findIdx?_eq_map_findFinIdx?_val]
   simp
@@ -334,21 +334,21 @@ private theorem idxAuxOf_toArray [BEq α] (a : α) (l : List α) (j : Nat) (w :
     simp
 termination_by l.length - j
 
-@[simp] theorem finIdxOf?_toArray [BEq α] (a : α) (l : List α) :
+@[simp, grind =] theorem finIdxOf?_toArray [BEq α] (a : α) (l : List α) :
     l.toArray.finIdxOf? a = l.finIdxOf? a := by
   rw [Array.finIdxOf?, finIdxOf?, findFinIdx?]
   simp [idxAuxOf_toArray]
 
-@[simp] theorem idxOf?_toArray [BEq α] (a : α) (l : List α) :
+@[simp, grind =] theorem idxOf?_toArray [BEq α] (a : α) (l : List α) :
     l.toArray.idxOf? a = l.idxOf? a := by
   rw [Array.idxOf?, idxOf?]
   simp [finIdxOf?, findIdx?_eq_map_findFinIdx?_val]
 
-@[simp] theorem findIdx_toArray {as : List α} {p : α → Bool} :
+@[simp, grind =] theorem findIdx_toArray {as : List α} {p : α → Bool} :
     as.toArray.findIdx p = as.findIdx p := by
   rw [Array.findIdx, findIdx?_toArray, findIdx_eq_getD_findIdx?]
 
-@[simp] theorem idxOf_toArray [BEq α] {as : List α} {a : α} :
+@[simp, grind =] theorem idxOf_toArray [BEq α] {as : List α} {a : α} :
     as.toArray.idxOf a = as.idxOf a := by
   rw [Array.idxOf, findIdx_toArray, idxOf]
 
@@ -383,7 +383,7 @@ theorem isPrefixOfAux_toArray_zero [BEq α] (l₁ l₂ : List α) (hle : l₁.le
   | a::l₁, b::l₂ =>
     simp [isPrefixOf_cons₂, isPrefixOfAux_toArray_succ', isPrefixOfAux_toArray_zero]
 
-@[simp] theorem isPrefixOf_toArray [BEq α] (l₁ l₂ : List α) :
+@[simp, grind =] theorem isPrefixOf_toArray [BEq α] (l₁ l₂ : List α) :
     l₁.toArray.isPrefixOf l₂.toArray = l₁.isPrefixOf l₂ := by
   rw [Array.isPrefixOf]
   split <;> rename_i h
@@ -429,12 +429,12 @@ theorem zipWithAux_toArray_zero (f : α → β → γ) (as : List α) (bs : List
   | a :: as, b :: bs =>
     simp [zipWith_cons_cons, zipWithAux_toArray_succ', zipWithAux_toArray_zero, push_append_toArray]
 
-@[simp] theorem zipWith_toArray (as : List α) (bs : List β) (f : α → β → γ) :
+@[simp, grind =] theorem zipWith_toArray (as : List α) (bs : List β) (f : α → β → γ) :
     Array.zipWith f as.toArray bs.toArray = (List.zipWith f as bs).toArray := by
   rw [Array.zipWith]
   simp [zipWithAux_toArray_zero]
 
-@[simp] theorem zip_toArray (as : List α) (bs : List β) :
+@[simp, grind =] theorem zip_toArray (as : List α) (bs : List β) :
     Array.zip as.toArray bs.toArray = (List.zip as bs).toArray := by
   simp [Array.zip, zipWith_toArray, zip]
 
@@ -472,16 +472,16 @@ theorem zipWithAll_go_toArray (as : List α) (bs : List β) (f : Option α → O
   termination_by max as.length bs.length - i
   decreasing_by simp_wf; decreasing_trivial_pre_omega
 
-@[simp] theorem zipWithAll_toArray (f : Option α → Option β → γ) (as : List α) (bs : List β) :
+@[simp, grind =] theorem zipWithAll_toArray (f : Option α → Option β → γ) (as : List α) (bs : List β) :
     Array.zipWithAll f as.toArray bs.toArray = (List.zipWithAll f as bs).toArray := by
   simp [Array.zipWithAll, zipWithAll_go_toArray]
 
-@[simp] theorem toArray_appendList (l₁ l₂ : List α) :
+@[simp, grind =] theorem toArray_appendList (l₁ l₂ : List α) :
     l₁.toArray ++ l₂ = (l₁ ++ l₂).toArray := by
   apply ext'
   simp
 
-@[simp] theorem pop_toArray (l : List α) : l.toArray.pop = l.dropLast.toArray := by
+@[simp, grind =] theorem pop_toArray (l : List α) : l.toArray.pop = l.dropLast.toArray := by
   apply ext'
   simp
 
@@ -513,7 +513,7 @@ theorem takeWhile_go_toArray (p : α → Bool) (l : List α) (i : Nat) :
         split <;> simp_all
       · simp_all [drop_eq_nil_of_le]
 
-@[simp] theorem takeWhile_toArray (p : α → Bool) (l : List α) :
+@[simp, grind =] theorem takeWhile_toArray (p : α → Bool) (l : List α) :
     l.toArray.takeWhile p = (l.takeWhile p).toArray := by
   simp [Array.takeWhile, takeWhile_go_toArray]
 
@@ -528,11 +528,11 @@ private theorem popWhile_toArray_aux (p : α → Bool) (l : List α) :
     · rfl
     · simp
 
-@[simp] theorem popWhile_toArray (p : α → Bool) (l : List α) :
+@[simp, grind =] theorem popWhile_toArray (p : α → Bool) (l : List α) :
     l.toArray.popWhile p = (l.reverse.dropWhile p).reverse.toArray := by
   simp [← popWhile_toArray_aux]
 
-@[simp] theorem setIfInBounds_toArray (l : List α) (i : Nat) (a : α) :
+@[simp, grind =] theorem setIfInBounds_toArray (l : List α) (i : Nat) (a : α) :
     l.toArray.setIfInBounds i a  = (l.set i a).toArray := by
   apply ext'
   simp only [setIfInBounds]
@@ -540,7 +540,7 @@ private theorem popWhile_toArray_aux (p : α → Bool) (l : List α) :
   · simp
   · simp_all [List.set_eq_of_length_le]
 
-@[simp] theorem toArray_replicate (n : Nat) (v : α) :
+@[simp, grind =] theorem toArray_replicate (n : Nat) (v : α) :
     (List.replicate n v).toArray = Array.replicate n v := rfl
 
 theorem _root_.Array.replicate_eq_toArray_replicate :
@@ -550,7 +550,7 @@ theorem _root_.Array.replicate_eq_toArray_replicate :
 @[deprecated _root_.Array.replicate_eq_toArray_replicate (since := "2025-03-18")]
 abbrev _root_.Array.mkArray_eq_toArray_replicate := @_root_.Array.replicate_eq_toArray_replicate
 
-@[simp] theorem flatMap_empty {β} (f : α → Array β) : (#[] : Array α).flatMap f = #[] := rfl
+@[simp, grind =] theorem flatMap_empty {β} (f : α → Array β) : (#[] : Array α).flatMap f = #[] := rfl
 
 theorem flatMap_toArray_cons {β} (f : α → Array β) (a : α) (as : List α) :
     (a :: as).toArray.flatMap f = f a ++ as.toArray.flatMap f := by
@@ -562,7 +562,7 @@ theorem flatMap_toArray_cons {β} (f : α → Array β) (a : α) (as : List α)
   intro xs
   induction as generalizing xs <;> simp_all
 
-@[simp] theorem flatMap_toArray {β} (f : α → Array β) (as : List α) :
+@[simp, grind =] theorem flatMap_toArray {β} (f : α → Array β) (as : List α) :
     as.toArray.flatMap f = (as.flatMap (fun a => (f a).toList)).toArray := by
   induction as with
   | nil => simp
@@ -570,12 +570,12 @@ theorem flatMap_toArray_cons {β} (f : α → Array β) (a : α) (as : List α)
     apply ext'
     simp [ih, flatMap_toArray_cons]
 
-@[simp] theorem swap_toArray (l : List α) (i j : Nat) {hi hj}:
+@[simp, grind =] theorem swap_toArray (l : List α) (i j : Nat) {hi hj}:
     l.toArray.swap i j hi hj = ((l.set i l[j]).set j l[i]).toArray := by
   apply ext'
   simp
 
-@[simp] theorem eraseIdx_toArray (l : List α) (i : Nat) (h : i < l.toArray.size) :
+@[simp, grind =] theorem eraseIdx_toArray (l : List α) (i : Nat) (h : i < l.toArray.size) :
     l.toArray.eraseIdx i h = (l.eraseIdx i).toArray := by
   rw [Array.eraseIdx]
   split <;> rename_i h'
@@ -593,19 +593,19 @@ decreasing_by
   simp
   omega
 
-@[simp] theorem eraseIdxIfInBounds_toArray (l : List α) (i : Nat) :
+@[simp, grind =] theorem eraseIdxIfInBounds_toArray (l : List α) (i : Nat) :
     l.toArray.eraseIdxIfInBounds i = (l.eraseIdx i).toArray := by
   rw [Array.eraseIdxIfInBounds]
   split
   · simp
   · simp_all [eraseIdx_eq_self.2]
 
-@[simp] theorem eraseP_toArray {as : List α} {p : α → Bool} :
+@[simp, grind =] theorem eraseP_toArray {as : List α} {p : α → Bool} :
     as.toArray.eraseP p = (as.eraseP p).toArray := by
   rw [Array.eraseP, List.eraseP_eq_eraseIdx, findFinIdx?_toArray]
   split <;> simp [*, findIdx?_eq_map_findFinIdx?_val]
 
-@[simp] theorem erase_toArray [BEq α] {as : List α} {a : α} :
+@[simp, grind =] theorem erase_toArray [BEq α] {as : List α} {a : α} :
     as.toArray.erase a = (as.erase a).toArray := by
   rw [Array.erase, finIdxOf?_toArray, List.erase_eq_eraseIdx]
   rw [idxOf?_eq_map_finIdxOf?_val]
@@ -635,7 +635,7 @@ private theorem insertIdx_loop_toArray (i : Nat) (l : List α) (j : Nat) (hj : j
     subst this
     simp
 
-@[simp] theorem insertIdx_toArray (l : List α) (i : Nat) (a : α) (h : i ≤ l.toArray.size):
+@[simp, grind =] theorem insertIdx_toArray (l : List α) (i : Nat) (a : α) (h : i ≤ l.toArray.size):
     l.toArray.insertIdx i a = (l.insertIdx i a).toArray := by
   rw [Array.insertIdx]
   rw [insertIdx_loop_toArray (h := h)]
@@ -658,7 +658,7 @@ private theorem insertIdx_loop_toArray (i : Nat) (l : List α) (j : Nat) (hj : j
         congr
         omega
 
-@[simp] theorem insertIdxIfInBounds_toArray (l : List α) (i : Nat) (a : α) :
+@[simp, grind =] theorem insertIdxIfInBounds_toArray (l : List α) (i : Nat) (a : α) :
     l.toArray.insertIdxIfInBounds i a = (l.insertIdx i a).toArray := by
   rw [Array.insertIdxIfInBounds]
   split <;> rename_i h'
@@ -666,7 +666,7 @@ private theorem insertIdx_loop_toArray (i : Nat) (l : List α) (j : Nat) (hj : j
   · simp only [size_toArray, Nat.not_le] at h'
     rw [List.insertIdx_of_length_lt (h := h')]
 
-@[simp]
+@[simp, grind =]
 theorem replace_toArray [BEq α] [LawfulBEq α] (l : List α) (a b : α) :
     l.toArray.replace a b = (l.replace a b).toArray := by
   rw [Array.replace]
@@ -700,11 +700,11 @@ theorem replace_toArray [BEq α] [LawfulBEq α] (l : List α) (a b : α) :
               exact ⟨i, by omega, h.1⟩
           · rfl
 
-@[simp] theorem leftpad_toArray (n : Nat) (a : α) (l : List α) :
+@[simp, grind =] theorem leftpad_toArray (n : Nat) (a : α) (l : List α) :
     Array.leftpad n a l.toArray = (leftpad n a l).toArray := by
   simp [leftpad, Array.leftpad, ← toArray_replicate]
 
-@[simp] theorem rightpad_toArray (n : Nat) (a : α) (l : List α) :
+@[simp, grind =] theorem rightpad_toArray (n : Nat) (a : α) (l : List α) :
     Array.rightpad n a l.toArray = (rightpad n a l).toArray := by
   simp [rightpad, Array.rightpad, ← toArray_replicate]
 

src/Init/Data/Option/Attach.lean

@@ -138,7 +138,7 @@ theorem toList_attach (o : Option α) :
     o.attach.toList = o.toList.attach.map fun ⟨x, h⟩ => ⟨x, by simpa using h⟩ := by
   cases o <;> simp
 
-@[simp] theorem attach_toList (o : Option α) :
+@[simp, grind =] theorem attach_toList (o : Option α) :
     o.toList.attach = (o.attach.map fun ⟨a, h⟩ => ⟨a, by simpa using h⟩).toList := by
   cases o <;> simp
 
@@ -195,7 +195,7 @@ theorem attach_filter {o : Option α} {p : α → Bool} :
   | some a =>
     simp only [filter_some, attach_some]
     ext
-    simp only [attach_eq_some_iff, ite_none_right_eq_some, some.injEq, some_bind,
+    simp only [attach_eq_some_iff, ite_none_right_eq_some, some.injEq, bind_some,
       dite_none_right_eq_some]
     constructor
     · rintro ⟨h, w⟩

src/Init/Data/Option/Basic.lean

@@ -13,11 +13,20 @@ namespace Option
 deriving instance DecidableEq for Option
 deriving instance BEq for Option
 
+@[simp, grind] theorem getD_none : getD none a = a := rfl
+@[simp, grind] theorem getD_some : getD (some a) b = a := rfl
+
+@[simp, grind] theorem map_none (f : α → β) : none.map f = none := rfl
+@[simp, grind] theorem map_some (a) (f : α → β) : (some a).map f = some (f a) := rfl
+
 /-- Lifts an optional value to any `Alternative`, sending `none` to `failure`. -/
 def getM [Alternative m] : Option α → m α
   | none     => failure
   | some a   => pure a
 
+@[simp, grind] theorem getM_none [Alternative m] : getM none = (failure : m α) := rfl
+@[simp, grind] theorem getM_some [Alternative m] {a : α} : getM (some a) = (pure a : m α) := rfl
+
 /-- Returns `true` on `some x` and `false` on `none`. -/
 @[inline] def isSome : Option α → Bool
   | some _ => true
@@ -75,6 +84,14 @@ Examples:
   | none,   _ => none
   | some a, f => f a
 
+@[simp, grind] theorem bind_none (f : α → Option β) : none.bind f = none := rfl
+@[simp, grind] theorem bind_some (a) (f : α → Option β) : (some a).bind f = f a := rfl
+
+@[deprecated bind_none (since := "2025-05-03")]
+abbrev none_bind := @bind_none
+@[deprecated bind_some (since := "2025-05-03")]
+abbrev some_bind := @bind_some
+
 /--
 Runs the monadic action `f` on `o`'s value, if any, and returns the result, or  `none` if there is
 no value.
@@ -102,6 +119,9 @@ This function only requires `m` to be an applicative functor. An alias `Option.m
   | none => pure none
   | some x => some <$> f x
 
+@[simp, grind] theorem mapM_none [Applicative m] (f : α → m β) : none.mapM f = pure none := rfl
+@[simp, grind] theorem mapM_some [Applicative m] (x) (f : α → m β) : (some x).mapM f = some <$> f x := rfl
+
 /--
 Applies a function in some applicative functor to an optional value, returning `none` with no
 effects if the value is missing.
@@ -111,6 +131,10 @@ This is an alias for `Option.mapM`, which already works for applicative functors
 @[inline] protected def mapA [Applicative m] (f : α → m β) : Option α → m (Option β) :=
   Option.mapM f
 
+/-- For verification purposes, we replace `mapA` with `mapM`. -/
+@[simp, grind] theorem mapA_eq_mapM [Applicative m] {f : α → m β} : Option.mapA f o = Option.mapM f o := rfl
+
+@[simp, grind]
 theorem map_id : (Option.map id : Option α → Option α) = id :=
   funext (fun o => match o with | none => rfl | some _ => rfl)
 
@@ -142,6 +166,9 @@ Examples:
   | some a => p a
   | none   => true
 
+@[simp, grind] theorem all_none : Option.all p none = true := rfl
+@[simp, grind] theorem all_some : Option.all p (some x) = p x := rfl
+
 /--
 Checks whether an optional value is not `none` and satisfies a Boolean predicate.
 
@@ -154,6 +181,9 @@ Examples:
   | some a => p a
   | none   => false
 
+@[simp, grind] theorem any_none : Option.any p none = false := rfl
+@[simp, grind] theorem any_some : Option.any p (some x) = p x := rfl
+
 /--
 Implementation of `OrElse`'s `<|>` syntax for `Option`. If the first argument is `some a`, returns
 `some a`, otherwise evaluates and returns the second argument.
@@ -164,6 +194,9 @@ See also `or` for a version that is strict in the second argument.
   | some a, _ => some a
   | none,   b => b ()
 
+@[simp, grind] theorem orElse_some : (some a).orElse b = some a := rfl
+@[simp, grind] theorem orElse_none : none.orElse b = b () := rfl
+
 instance : OrElse (Option α) where
   orElse := Option.orElse
 
@@ -230,15 +263,6 @@ def merge (fn : α → α → α) : Option α → Option α → Option α
   | none  , some y => some y
   | some x, some y => some <| fn x y
 
-@[simp, grind] theorem getD_none : getD none a = a := rfl
-@[simp, grind] theorem getD_some : getD (some a) b = a := rfl
-
-@[simp, grind] theorem map_none (f : α → β) : none.map f = none := rfl
-@[simp, grind] theorem map_some (a) (f : α → β) : (some a).map f = some (f a) := rfl
-
-@[simp, grind] theorem none_bind (f : α → Option β) : none.bind f = none := rfl
-@[simp, grind] theorem some_bind (a) (f : α → Option β) : (some a).bind f = f a := rfl
-
 /--
 A case analysis function for `Option`.
 
@@ -262,9 +286,9 @@ Extracts the value from an option that can be proven to be `some`.
 @[inline] def get {α : Type u} : (o : Option α) → isSome o → α
   | some x, _ => x
 
-@[simp] theorem some_get : ∀ {x : Option α} (h : isSome x), some (x.get h) = x
+@[simp, grind] theorem some_get : ∀ {x : Option α} (h : isSome x), some (x.get h) = x
 | some _, _ => rfl
-@[simp] theorem get_some (x : α) (h : isSome (some x)) : (some x).get h = x := rfl
+@[simp, grind] theorem get_some (x : α) (h : isSome (some x)) : (some x).get h = x := rfl
 
 /--
 Returns `none` if a value doesn't satisfy a Boolean predicate, or the value itself otherwise.
@@ -342,6 +366,9 @@ Examples:
 -/
 @[simp, inline] def join (x : Option (Option α)) : Option α := x.bind id
 
+@[simp, grind] theorem join_none : (none : Option (Option α)).join = none := rfl
+@[simp, grind] theorem join_some : (some o).join = o := rfl
+
 /--
 Converts an optional monadic computation into a monadic computation of an optional value.
 
@@ -363,7 +390,10 @@ some "world"
 -/
 @[inline] def sequence [Applicative m] {α : Type u} : Option (m α) → m (Option α)
   | none => pure none
-  | some fn => some <$> fn
+  | some f => some <$> f
+
+@[simp, grind] theorem sequence_none [Applicative m] : (none : Option (m α)).sequence = pure none := rfl
+@[simp, grind] theorem sequence_some [Applicative m] (f : m (Option α)) : (some f).sequence = some <$> f := rfl
 
 /--
 A monadic case analysis function for `Option`.
@@ -388,6 +418,9 @@ This is the monadic analogue of `Option.getD`.
   | some a => pure a
   | none => y
 
+@[simp, grind] theorem getDM_none [Pure m] (y : m α) : (none : Option α).getDM y = y := rfl
+@[simp, grind] theorem getDM_some [Pure m] (a : α) (y : m α) : (some a).getDM y = pure a := rfl
+
 instance (α) [BEq α] [ReflBEq α] : ReflBEq (Option α) where
   rfl {x} :=
     match x with
@@ -400,12 +433,6 @@ instance (α) [BEq α] [LawfulBEq α] : LawfulBEq (Option α) where
     | some x, some y => rw [LawfulBEq.eq_of_beq (α := α) h]
     | none, none => rfl
 
-@[simp, grind] theorem all_none : Option.all p none = true := rfl
-@[simp, grind] theorem all_some : Option.all p (some x) = p x := rfl
-
-@[simp, grind] theorem any_none : Option.any p none = false := rfl
-@[simp, grind] theorem any_some : Option.any p (some x) = p x := rfl
-
 /--
 The minimum of two optional values, with `none` treated as the least element. This function is
 usually accessed through the `Min (Option α)` instance, rather than directly.
@@ -428,10 +455,10 @@ protected def min [Min α] : Option α → Option α → Option α
 
 instance [Min α] : Min (Option α) where min := Option.min
 
-@[simp] theorem min_some_some [Min α] {a b : α} : min (some a) (some b) = some (min a b) := rfl
-@[simp] theorem min_some_none [Min α] {a : α} : min (some a) none = none := rfl
-@[simp] theorem min_none_some [Min α] {b : α} : min none (some b) = none := rfl
-@[simp] theorem min_none_none [Min α] : min (none : Option α) none = none := rfl
+@[simp, grind] theorem min_some_some [Min α] {a b : α} : min (some a) (some b) = some (min a b) := rfl
+@[simp, grind] theorem min_some_none [Min α] {a : α} : min (some a) none = none := rfl
+@[simp, grind] theorem min_none_some [Min α] {b : α} : min none (some b) = none := rfl
+@[simp, grind] theorem min_none_none [Min α] : min (none : Option α) none = none := rfl
 
 /--
 The maximum of two optional values.
@@ -453,10 +480,10 @@ protected def max [Max α] : Option α → Option α → Option α
 
 instance [Max α] : Max (Option α) where max := Option.max
 
-@[simp] theorem max_some_some [Max α] {a b : α} : max (some a) (some b) = some (max a b) := rfl
-@[simp] theorem max_some_none [Max α] {a : α} : max (some a) none = some a := rfl
-@[simp] theorem max_none_some [Max α] {b : α} : max none (some b) = some b := rfl
-@[simp] theorem max_none_none [Max α] : max (none : Option α) none = none := rfl
+@[simp, grind] theorem max_some_some [Max α] {a b : α} : max (some a) (some b) = some (max a b) := rfl
+@[simp, grind] theorem max_some_none [Max α] {a : α} : max (some a) none = some a := rfl
+@[simp, grind] theorem max_none_some [Max α] {b : α} : max none (some b) = some b := rfl
+@[simp, grind] theorem max_none_none [Max α] : max (none : Option α) none = none := rfl
 
 
 end Option
@@ -481,6 +508,7 @@ instance : Alternative Option where
   failure := Option.none
   orElse  := Option.orElse
 
+-- This is a duplicate of `Option.getM`; one may be deprecated in the future.
 def liftOption [Alternative m] : Option α → m α
   | some a => pure a
   | none   => failure

src/Init/Data/Option/Instances.lean

@@ -12,7 +12,7 @@ universe u v
 
 namespace Option
 
-theorem eq_of_eq_some {α : Type u} : ∀ {x y : Option α}, (∀z, x = some z ↔ y = some z) → x = y
+theorem eq_of_eq_some {α : Type u} : ∀ {x y : Option α}, (∀ z, x = some z ↔ y = some z) → x = y
   | none,   none,   _ => rfl
   | none,   some z, h => Option.noConfusion ((h z).2 rfl)
   | some z, none,   h => Option.noConfusion ((h z).1 rfl)

src/Init/Data/Option/Lemmas.lean

@@ -91,8 +91,6 @@ theorem eq_some_unique {o : Option α} {a b : α} (ha : o = some a) (hb : o = so
   | some _, _, H => ((H _).1 rfl).symm
   | _, some _, H => (H _).2 rfl
 
-set_option Elab.async false
-
 theorem eq_none_iff_forall_ne_some : o = none ↔ ∀ a, o ≠ some a := by
   cases o <;> simp
 
@@ -174,15 +172,15 @@ theorem forall_ne_none {p : Option α → Prop} : (∀ x (_ : x ≠ none), p x)
 @[deprecated forall_ne_none (since := "2025-04-04")]
 abbrev ball_ne_none := @forall_ne_none
 
-@[simp] theorem pure_def : pure = @some α := rfl
+@[simp, grind] theorem pure_def : pure = @some α := rfl
 
-@[simp] theorem bind_eq_bind : bind = @Option.bind α β := rfl
+@[simp, grind] theorem bind_eq_bind : bind = @Option.bind α β := rfl
 
-@[simp] theorem orElse_eq_orElse : HOrElse.hOrElse = @Option.orElse α := rfl
+@[simp, grind] theorem orElse_eq_orElse : HOrElse.hOrElse = @Option.orElse α := rfl
 
-@[simp] theorem bind_some (x : Option α) : x.bind some = x := by cases x <;> rfl
+@[simp, grind] theorem bind_fun_some (x : Option α) : x.bind some = x := by cases x <;> rfl
 
-@[simp] theorem bind_none (x : Option α) : x.bind (fun _ => none (α := β)) = none := by
+@[simp] theorem bind_fun_none (x : Option α) : x.bind (fun _ => none (α := β)) = none := by
   cases x <;> rfl
 
 theorem bind_eq_some_iff : x.bind f = some b ↔ ∃ a, x = some a ∧ f a = some b := by
@@ -201,7 +199,7 @@ theorem bind_eq_none' {o : Option α} {f : α → Option β} :
     o.bind f = none ↔ ∀ b a, o = some a → f a ≠ some b := by
   cases o <;> simp [eq_none_iff_forall_ne_some]
 
-theorem mem_bind_iff {o : Option α} {f : α → Option β} :
+@[grind] theorem mem_bind_iff {o : Option α} {f : α → Option β} :
     b ∈ o.bind f ↔ ∃ a, a ∈ o ∧ b ∈ f a := by
   cases o <;> simp
 
@@ -209,6 +207,7 @@ theorem bind_comm {f : α → β → Option γ} (a : Option α) (b : Option β)
     (a.bind fun x => b.bind (f x)) = b.bind fun y => a.bind fun x => f x y := by
   cases a <;> cases b <;> rfl
 
+@[grind]
 theorem bind_assoc (x : Option α) (f : α → Option β) (g : β → Option γ) :
     (x.bind f).bind g = x.bind fun y => (f y).bind g := by cases x <;> rfl
 
@@ -216,10 +215,16 @@ theorem bind_congr {α β} {o : Option α} {f g : α → Option β} :
     (h : ∀ a, o = some a → f a = g a) → o.bind f = o.bind g := by
   cases o <;> simp
 
+@[grind]
 theorem isSome_bind {α β : Type _} (x : Option α) (f : α → Option β) :
     (x.bind f).isSome = x.any (fun x => (f x).isSome) := by
   cases x <;> rfl
 
+@[grind]
+theorem isNone_bind {α β : Type _} (x : Option α) (f : α → Option β) :
+    (x.bind f).isNone = x.all (fun x => (f x).isNone) := by
+  cases x <;> rfl
+
 theorem isSome_of_isSome_bind {α β : Type _} {x : Option α} {f : α → Option β}
     (h : (x.bind f).isSome) : x.isSome := by
   cases x <;> trivial
@@ -228,7 +233,7 @@ theorem isSome_apply_of_isSome_bind {α β : Type _} {x : Option α} {f : α →
     (h : (x.bind f).isSome) : (f (x.get (isSome_of_isSome_bind h))).isSome := by
   cases x <;> trivial
 
-@[simp] theorem get_bind {α β : Type _} {x : Option α} {f : α → Option β} (h : (x.bind f).isSome) :
+@[simp, grind] theorem get_bind {α β : Type _} {x : Option α} {f : α → Option β} (h : (x.bind f).isSome) :
     (x.bind f).get h = (f (x.get (isSome_of_isSome_bind h))).get
       (isSome_apply_of_isSome_bind h) := by
   cases x <;> trivial
@@ -251,9 +256,9 @@ theorem join_eq_none_iff : o.join = none ↔ o = none ∨ o = some none :=
 @[deprecated join_eq_none_iff (since := "2025-04-10")]
 abbrev join_eq_none := @join_eq_none_iff
 
-theorem bind_id_eq_join {x : Option (Option α)} : x.bind id = x.join := rfl
+@[grind] theorem bind_id_eq_join {x : Option (Option α)} : x.bind id = x.join := rfl
 
-@[simp] theorem map_eq_map : Functor.map f = Option.map f := rfl
+@[simp, grind] theorem map_eq_map : Functor.map f = Option.map f := rfl
 
 @[deprecated map_none (since := "2025-04-10")]
 abbrev map_none' := @map_none
@@ -295,28 +300,28 @@ theorem map_congr {x : Option α} (h : ∀ a, x = some a → f a = g a) :
     x.map f = x.map g := by
   cases x <;> simp only [map_none, map_some, h]
 
-@[simp] theorem map_id_fun {α : Type u} : Option.map (id : α → α) = id := by
+@[simp, grind] theorem map_id_fun {α : Type u} : Option.map (id : α → α) = id := by
   funext; simp [map_id]
 
 theorem map_id' {x : Option α} : (x.map fun a => a) = x := congrFun map_id x
 
-@[simp] theorem map_id_fun' {α : Type u} : Option.map (fun (a : α) => a) = id := by
+@[simp, grind] theorem map_id_fun' {α : Type u} : Option.map (fun (a : α) => a) = id := by
   funext; simp [map_id']
 
-theorem get_map {f : α → β} {o : Option α} {h : (o.map f).isSome} :
+@[simp, grind] theorem get_map {f : α → β} {o : Option α} {h : (o.map f).isSome} :
     (o.map f).get h = f (o.get (by simpa using h)) := by
   cases o with
   | none => simp at h
   | some a => simp
 
-@[simp] theorem map_map (h : β → γ) (g : α → β) (x : Option α) :
+@[simp, grind _=_] theorem map_map (h : β → γ) (g : α → β) (x : Option α) :
     (x.map g).map h = x.map (h ∘ g) := by
   cases x <;> simp only [map_none, map_some, ·∘·]
 
 theorem comp_map (h : β → γ) (g : α → β) (x : Option α) : x.map (h ∘ g) = (x.map g).map h :=
   (map_map ..).symm
 
-@[simp] theorem map_comp_map (f : α → β) (g : β → γ) :
+@[simp, grind _=_] theorem map_comp_map (f : α → β) (g : β → γ) :
     Option.map g ∘ Option.map f = Option.map (g ∘ f) := by funext x; simp
 
 theorem mem_map_of_mem (g : α → β) (h : a ∈ x) : g a ∈ Option.map g x := h.symm ▸ map_some ..
@@ -373,6 +378,7 @@ abbrev filter_eq_none := @filter_eq_none_iff
 @[deprecated filter_eq_some_iff (since := "2025-04-10")]
 abbrev filter_eq_some := @filter_eq_some_iff
 
+@[grind]
 theorem mem_filter_iff {p : α → Bool} {a : α} {o : Option α} :
     a ∈ o.filter p ↔ a ∈ o ∧ p a := by
   simp
@@ -381,12 +387,12 @@ theorem filter_eq_bind (x : Option α) (p : α → Bool) :
     x.filter p = x.bind (Option.guard p) := by
   cases x <;> rfl
 
-@[simp] theorem all_guard (a : α) :
+@[simp, grind] theorem all_guard (a : α) :
     Option.all q (guard p a) = (!p a || q a) := by
   simp only [guard]
   split <;> simp_all
 
-@[simp] theorem any_guard (a : α) : Option.any q (guard p a) = (p a && q a) := by
+@[simp, grind] theorem any_guard (a : α) : Option.any q (guard p a) = (p a && q a) := by
   simp only [guard]
   split <;> simp_all
 
@@ -425,33 +431,41 @@ theorem any_eq_false_iff_get (p : α → Bool) (x : Option α) :
 theorem isSome_of_any {x : Option α} {p : α → Bool} (h : x.any p) : x.isSome := by
   cases x <;> trivial
 
+@[grind]
 theorem any_map {α β : Type _} {x : Option α} {f : α → β} {p : β → Bool} :
     (x.map f).any p = x.any (fun a => p (f a)) := by
   cases x <;> rfl
 
+@[grind]
+theorem all_map {α β : Type _} {x : Option α} {f : α → β} {p : β → Bool} :
+    (x.map f).all p = x.all (fun a => p (f a)) := by
+  cases x <;> rfl
+
 theorem bind_map_comm {α β} {x : Option (Option α)} {f : α → β} :
     x.bind (Option.map f) = (x.map (Option.map f)).bind id := by cases x <;> simp
 
-theorem bind_map {f : α → β} {g : β → Option γ} {x : Option α} :
+@[grind] theorem bind_map {f : α → β} {g : β → Option γ} {x : Option α} :
     (x.map f).bind g = x.bind (g ∘ f) := by cases x <;> simp
 
-@[simp] theorem map_bind {f : α → Option β} {g : β → γ} {x : Option α} :
+@[simp, grind] theorem map_bind {f : α → Option β} {g : β → γ} {x : Option α} :
     (x.bind f).map g = x.bind (Option.map g ∘ f) := by cases x <;> simp
 
-theorem join_map_eq_map_join {f : α → β} {x : Option (Option α)} :
+@[grind] theorem join_map_eq_map_join {f : α → β} {x : Option (Option α)} :
     (x.map (Option.map f)).join = x.join.map f := by cases x <;> simp
 
-theorem join_join {x : Option (Option (Option α))} : x.join.join = (x.map join).join := by
+@[grind _=_] theorem join_join {x : Option (Option (Option α))} : x.join.join = (x.map join).join := by
   cases x <;> simp
 
 theorem mem_of_mem_join {a : α} {x : Option (Option α)} (h : a ∈ x.join) : some a ∈ x :=
   h.symm ▸ join_eq_some_iff.1 h
 
-@[simp, grind] theorem some_orElse (a : α) (f) : (some a).orElse f = some a := rfl
+@[deprecated orElse_some (since := "2025-05-03")]
+theorem some_orElse (a : α) (f) : (some a).orElse f = some a := rfl
 
-@[simp, grind] theorem none_orElse (f : Unit → Option α) : none.orElse f = f () := rfl
+@[deprecated orElse_none (since := "2025-05-03")]
+theorem none_orElse (f : Unit → Option α) : none.orElse f = f () := rfl
 
-@[simp] theorem orElse_none (x : Option α) : x.orElse (fun _ => none) = x := by cases x <;> rfl
+@[simp] theorem orElse_fun_none (x : Option α) : x.orElse (fun _ => none) = x := by cases x <;> rfl
 
 theorem orElse_eq_some_iff (o : Option α) (f) (x : α) :
     (o.orElse f) = some x ↔ o = some x ∨ o = none ∧ f () = some x := by
@@ -460,7 +474,7 @@ theorem orElse_eq_some_iff (o : Option α) (f) (x : α) :
 theorem orElse_eq_none_iff (o : Option α) (f) : (o.orElse f) = none ↔ o = none ∧ f () = none := by
   cases o <;> simp
 
-theorem map_orElse {x : Option α} {y} :
+@[grind] theorem map_orElse {x : Option α} {y} :
     (x.orElse y).map f = (x.map f).orElse (fun _ => (y ()).map f) := by
   cases x <;> simp
 
@@ -504,7 +518,7 @@ theorem guard_comp {p : α → Bool} {f : β → α} :
   ext1 b
   simp [guard]
 
-theorem bind_guard (x : Option α) (p : α → Bool) :
+@[grind] theorem bind_guard (x : Option α) (p : α → Bool) :
     x.bind (Option.guard p) = x.filter p := by
   simp only [Option.filter_eq_bind, decide_eq_true_eq]
 
@@ -513,6 +527,7 @@ theorem guard_eq_map (p : α → Bool) :
   funext x
   simp [Option.guard]
 
+@[grind]
 theorem guard_def (p : α → Bool) :
     Option.guard p = fun x => if p x then some x else none := rfl
 
@@ -599,9 +614,11 @@ abbrev choice_isSome_iff_nonempty := @isSome_choice_iff_nonempty
 end choice
 
 @[simp, grind] theorem toList_some (a : α) : (some a).toList = [a] := rfl
-
 @[simp, grind] theorem toList_none (α : Type _) : (none : Option α).toList = [] := rfl
 
+@[simp, grind] theorem toArray_some (a : α) : (some a).toArray = #[a] := rfl
+@[simp, grind] theorem toArray_none (α : Type _) : (none : Option α).toArray = #[] := rfl
+
 -- See `Init.Data.Option.List` for lemmas about `toList`.
 
 @[simp, grind] theorem some_or : (some a).or o = some a := rfl
@@ -610,10 +627,15 @@ end choice
 theorem or_eq_right_of_none {o o' : Option α} (h : o = none) : o.or o' = o' := by
   cases h; simp
 
-@[deprecated some_or (since := "2024-11-03")] theorem or_some : (some a).or o = some a := rfl
-
 /-- This will be renamed to `or_some` once the existing deprecated lemma is removed. -/
-@[simp, grind] theorem or_some' {o : Option α} : o.or (some a) = some (o.getD a) := by
+@[simp, grind] theorem or_some {o : Option α} : o.or (some a) = some (o.getD a) := by
+  cases o <;> rfl
+
+@[deprecated or_some (since := "2025-05-03")]
+abbrev or_some' := @or_some
+
+@[simp, grind]
+theorem or_none : or o none = o := by
   cases o <;> rfl
 
 theorem or_eq_bif : or o o' = bif o.isSome then o else o' := by
@@ -637,14 +659,10 @@ abbrev or_eq_none := @or_eq_none_iff
 @[deprecated or_eq_some_iff (since := "2025-04-10")]
 abbrev or_eq_some := @or_eq_some_iff
 
-theorem or_assoc : or (or o₁ o₂) o₃ = or o₁ (or o₂ o₃) := by
+@[grind] theorem or_assoc : or (or o₁ o₂) o₃ = or o₁ (or o₂ o₃) := by
   cases o₁ <;> cases o₂ <;> rfl
 instance : Std.Associative (or (α := α)) := ⟨@or_assoc _⟩
 
-@[simp, grind]
-theorem or_none : or o none = o := by
-  cases o <;> rfl
-
 theorem or_eq_left_of_none {o o' : Option α} (h : o' = none) : o.or o' = o := by
   cases h; simp
 
@@ -685,10 +703,14 @@ section beq
 
 variable [BEq α]
 
-@[simp] theorem none_beq_none : ((none : Option α) == none) = true := rfl
-@[simp] theorem none_beq_some (a : α) : ((none : Option α) == some a) = false := rfl
-@[simp] theorem some_beq_none (a : α) : ((some a : Option α) == none) = false := rfl
-@[simp] theorem some_beq_some {a b : α} : (some a == some b) = (a == b) := rfl
+@[simp, grind] theorem none_beq_none : ((none : Option α) == none) = true := rfl
+@[simp, grind] theorem none_beq_some (a : α) : ((none : Option α) == some a) = false := rfl
+@[simp, grind] theorem some_beq_none (a : α) : ((some a : Option α) == none) = false := rfl
+@[simp, grind] theorem some_beq_some {a b : α} : (some a == some b) = (a == b) := rfl
+
+/-- We simplify away `isEqSome` in terms of `==`. -/
+@[simp, grind] theorem isEqSome_eq_beq_some {o : Option α} : isEqSome o y = (o == some y) := by
+  cases o <;> simp [isEqSome]
 
 @[simp] theorem reflBEq_iff : ReflBEq (Option α) ↔ ReflBEq α := by
   constructor
@@ -802,14 +824,14 @@ theorem mem_ite_none_right {x : α} {_ : Decidable p} {l : Option α} :
 
 end ite
 
-theorem isSome_filter {α : Type _} {x : Option α} {f : α → Bool} :
+@[grind] theorem isSome_filter {α : Type _} {x : Option α} {f : α → Bool} :
     (x.filter f).isSome = x.any f := by
   cases x
   · rfl
   · rw [Bool.eq_iff_iff]
     simp only [Option.any_some, Option.filter, Option.isSome_ite]
 
-@[simp] theorem get_filter {α : Type _} {x : Option α} {f : α → Bool} (h : (x.filter f).isSome) :
+@[simp, grind] theorem get_filter {α : Type _} {x : Option α} {f : α → Bool} (h : (x.filter f).isSome) :
     (x.filter f).get h = x.get (isSome_of_isSome_filter f x h) := by
   cases x
   · contradiction
@@ -821,16 +843,16 @@ theorem isSome_filter {α : Type _} {x : Option α} {f : α → Bool} :
 @[simp, grind] theorem pbind_none : pbind none f = none := rfl
 @[simp, grind] theorem pbind_some : pbind (some a) f = f a rfl := rfl
 
-@[simp] theorem map_pbind {o : Option α} {f : (a : α) → o = some a → Option β}
+@[simp, grind] theorem map_pbind {o : Option α} {f : (a : α) → o = some a → Option β}
     {g : β → γ} : (o.pbind f).map g = o.pbind (fun a h => (f a h).map g) := by
   cases o <;> rfl
 
-@[simp] theorem pbind_map {α β γ : Type _} (o : Option α)
+@[simp, grind] theorem pbind_map {α β γ : Type _} (o : Option α)
     (f : α → β) (g : (x : β) → o.map f = some x → Option γ) :
     (o.map f).pbind g = o.pbind (fun x h => g (f x) (h ▸ rfl)) := by
   cases o <;> rfl
 
-@[simp] theorem pbind_eq_bind {α β : Type _} (o : Option α)
+@[simp, grind] theorem pbind_eq_bind {α β : Type _} (o : Option α)
     (f : α → Option β) : o.pbind (fun x _ => f x) = o.bind f := by
   cases o <;> rfl
 
@@ -890,16 +912,16 @@ theorem pbind_eq_some_iff {o : Option α} {f : (a : α) → o = some a → Optio
     · rintro ⟨h, rfl⟩
       rfl
 
-@[simp]
+@[simp, grind]
 theorem pmap_eq_map (p : α → Prop) (f : α → β) (o : Option α) (H) :
     @pmap _ _ p (fun a _ => f a) o H = Option.map f o := by
   cases o <;> simp
 
-theorem map_pmap {p : α → Prop} (g : β → γ) (f : ∀ a, p a → β) (o H) :
+@[grind] theorem map_pmap {p : α → Prop} (g : β → γ) (f : ∀ a, p a → β) (o H) :
     Option.map g (pmap f o H) = pmap (fun a h => g (f a h)) o H := by
   cases o <;> simp
 
-theorem pmap_map (o : Option α) (f : α → β) {p : β → Prop} (g : ∀ b, p b → γ) (H) :
+@[grind] theorem pmap_map (o : Option α) (f : α → β) {p : β → Prop} (g : ∀ b, p b → γ) (H) :
     pmap g (o.map f) H =
       pmap (fun a h => g (f a) h) o (fun a m => H (f a) (map_eq_some_iff.2 ⟨_, m, rfl⟩)) := by
   cases o <;> simp
@@ -938,10 +960,10 @@ theorem pmap_congr {α : Type u} {β : Type v}
 @[simp, grind] theorem pelim_none : pelim none b f = b := rfl
 @[simp, grind] theorem pelim_some : pelim (some a) b f = f a rfl := rfl
 
-@[simp] theorem pelim_eq_elim : pelim o b (fun a _ => f a) = o.elim b f := by
+@[simp, grind] theorem pelim_eq_elim : pelim o b (fun a _ => f a) = o.elim b f := by
   cases o <;> simp
 
-@[simp] theorem elim_pmap {p : α → Prop} (f : (a : α) → p a → β) (o : Option α)
+@[simp, grind] theorem elim_pmap {p : α → Prop} (f : (a : α) → p a → β) (o : Option α)
     (H : ∀ (a : α), o = some a → p a) (g : γ) (g' : β → γ) :
     (o.pmap f H).elim g g' =
        o.pelim g (fun a h => g' (f a (H a h))) := by
@@ -978,7 +1000,7 @@ theorem isSome_of_isSome_pfilter {α : Type _} {o : Option α} {p : (a : α) →
     (h : (o.pfilter p).isSome) : o.isSome :=
   (isSome_pfilter_iff_get.mp h).1
 
-@[simp] theorem get_pfilter {α : Type _} {o : Option α} {p : (a : α) → o = some a → Bool}
+@[simp, grind] theorem get_pfilter {α : Type _} {o : Option α} {p : (a : α) → o = some a → Bool}
     (h : (o.pfilter p).isSome) :
     (o.pfilter p).get h = o.get (isSome_of_isSome_pfilter h) := by
   cases o <;> simp
@@ -996,7 +1018,7 @@ theorem pfilter_eq_some_iff {α : Type _} {o : Option α} {p : (a : α) → o =
   · rintro ⟨⟨h, rfl⟩, h'⟩
     exact ⟨⟨o.get h, ⟨h, rfl⟩, h'⟩, rfl⟩
 
-@[simp] theorem pfilter_eq_filter {α : Type _} {o : Option α} {p : α → Bool} :
+@[simp, grind] theorem pfilter_eq_filter {α : Type _} {o : Option α} {p : α → Bool} :
     o.pfilter (fun a _ => p a) = o.filter p := by
   cases o with
   | none => rfl
@@ -1012,13 +1034,13 @@ theorem pfilter_eq_pbind_ite {α : Type _} {o : Option α}
 
 /-! ### LT and LE -/
 
-@[simp] theorem not_lt_none [LT α] {a : Option α} : ¬ a < none := by cases a <;> simp [LT.lt, Option.lt]
-@[simp] theorem none_lt_some [LT α] {a : α} : none < some a := by simp [LT.lt, Option.lt]
-@[simp] theorem some_lt_some [LT α] {a b : α} : some a < some b ↔ a < b := by simp [LT.lt, Option.lt]
+@[simp, grind] theorem not_lt_none [LT α] {a : Option α} : ¬ a < none := by cases a <;> simp [LT.lt, Option.lt]
+@[simp, grind] theorem none_lt_some [LT α] {a : α} : none < some a := by simp [LT.lt, Option.lt]
+@[simp, grind] theorem some_lt_some [LT α] {a b : α} : some a < some b ↔ a < b := by simp [LT.lt, Option.lt]
 
-@[simp] theorem none_le [LE α] {a : Option α} : none ≤ a := by cases a <;> simp [LE.le, Option.le]
-@[simp] theorem not_some_le_none [LE α] {a : α} : ¬ some a ≤ none := by simp [LE.le, Option.le]
-@[simp] theorem some_le_some [LE α] {a b : α} : some a ≤ some b ↔ a ≤ b := by simp [LE.le, Option.le]
+@[simp, grind] theorem none_le [LE α] {a : Option α} : none ≤ a := by cases a <;> simp [LE.le, Option.le]
+@[simp, grind] theorem not_some_le_none [LE α] {a : α} : ¬ some a ≤ none := by simp [LE.le, Option.le]
+@[simp, grind] theorem some_le_some [LE α] {a b : α} : some a ≤ some b ↔ a ≤ b := by simp [LE.le, Option.le]
 
 /-! ### min and max -/
 

src/Init/Data/Option/List.lean

@@ -10,62 +10,38 @@ import Init.Data.List.Lemmas
 
 namespace Option
 
-@[simp] theorem mem_toList {a : α} {o : Option α} : a ∈ o.toList ↔ o = some a := by
+@[simp, grind] theorem mem_toList {a : α} {o : Option α} : a ∈ o.toList ↔ o = some a := by
   cases o <;> simp [eq_comm]
 
-@[simp] theorem forIn'_none [Monad m] (b : β) (f : (a : α) → a ∈ none → β → m (ForInStep β)) :
-    forIn' none b f = pure b := by
-  rfl
-
-@[simp] theorem forIn'_some [Monad m] [LawfulMonad m] (a : α) (b : β) (f : (a' : α) → a' ∈ some a → β → m (ForInStep β)) :
-    forIn' (some a) b f = bind (f a rfl b) (fun r => pure (ForInStep.value r)) := by
-  simp only [forIn', bind_pure_comp]
-  rw [map_eq_pure_bind]
-  congr
-  funext x
-  split <;> rfl
-
-@[simp] theorem forIn_none [Monad m] (b : β) (f : α → β → m (ForInStep β)) :
-    forIn none b f = pure b := by
-  rfl
-
-@[simp] theorem forIn_some [Monad m] [LawfulMonad m] (a : α) (b : β) (f : α → β → m (ForInStep β)) :
-    forIn (some a) b f = bind (f a b) (fun r => pure (ForInStep.value r)) := by
-  simp only [forIn, forIn', bind_pure_comp]
-  rw [map_eq_pure_bind]
-  congr
-  funext x
-  split <;> rfl
-
-@[simp] theorem forIn'_toList [Monad m] (o : Option α) (b : β) (f : (a : α) → a ∈ o.toList → β → m (ForInStep β)) :
+@[simp, grind] theorem forIn'_toList [Monad m] (o : Option α) (b : β) (f : (a : α) → a ∈ o.toList → β → m (ForInStep β)) :
     forIn' o.toList b f = forIn' o b fun a m b => f a (by simpa using m) b := by
   cases o <;> rfl
 
-@[simp] theorem forIn_toList [Monad m] (o : Option α) (b : β) (f : α → β → m (ForInStep β)) :
+@[simp, grind] theorem forIn_toList [Monad m] (o : Option α) (b : β) (f : α → β → m (ForInStep β)) :
     forIn o.toList b f = forIn o b f := by
   cases o <;> rfl
 
-@[simp] theorem foldlM_toList [Monad m] [LawfulMonad m] (o : Option β) (a : α) (f : α → β → m α) :
+@[simp, grind] theorem foldlM_toList [Monad m] [LawfulMonad m] (o : Option β) (a : α) (f : α → β → m α) :
     o.toList.foldlM f a = o.elim (pure a) (fun b => f a b) := by
   cases o <;> simp
 
-@[simp] theorem foldrM_toList [Monad m] [LawfulMonad m] (o : Option β) (a : α) (f : β → α → m α) :
+@[simp, grind] theorem foldrM_toList [Monad m] [LawfulMonad m] (o : Option β) (a : α) (f : β → α → m α) :
     o.toList.foldrM f a = o.elim (pure a) (fun b => f b a) := by
   cases o <;> simp
 
-@[simp] theorem foldl_toList (o : Option β) (a : α) (f : α → β → α) :
+@[simp, grind] theorem foldl_toList (o : Option β) (a : α) (f : α → β → α) :
     o.toList.foldl f a = o.elim a (fun b => f a b) := by
   cases o <;> simp
 
-@[simp] theorem foldr_toList (o : Option β) (a : α) (f : β → α → α) :
+@[simp, grind] theorem foldr_toList (o : Option β) (a : α) (f : β → α → α) :
     o.toList.foldr f a = o.elim a (fun b => f b a) := by
   cases o <;> simp
 
-@[simp]
+@[simp, grind]
 theorem pairwise_toList {P : α → α → Prop} {o : Option α} : o.toList.Pairwise P := by
   cases o <;> simp
 
-@[simp]
+@[simp, grind]
 theorem head?_toList {o : Option α} : o.toList.head? = o := by
   cases o <;> simp
 

src/Init/Data/Option/Monadic.lean

@@ -12,16 +12,47 @@ import Init.Control.Lawful.Basic
 
 namespace Option
 
-@[simp] theorem forM_none [Monad m] (f : α → m PUnit) :
-    none.forM f = pure .unit := rfl
+@[simp, grind] theorem bindM_none [Monad m] (f : α → m (Option β)) : none.bindM f = pure none := rfl
+@[simp, grind] theorem bindM_some [Monad m] [LawfulMonad m] (a) (f : α → m (Option β)) : (some a).bindM f = f a := by
+  simp [Option.bindM]
 
-@[simp] theorem forM_some [Monad m] (f : α → m PUnit) (a : α) :
-    (some a).forM f = f a := rfl
+-- We simplify `Option.forM` to `forM`.
+@[simp] theorem forM_eq_forM [Monad m] : @Option.forM m α _ = forM := rfl
 
-@[simp] theorem forM_map [Monad m] [LawfulMonad m] (o : Option α) (g : α → β) (f : β → m PUnit) :
-    (o.map g).forM f = o.forM (fun a => f (g a)) := by
+@[simp, grind] theorem forM_none [Monad m] (f : α → m PUnit) :
+    forM none f = pure .unit := rfl
+
+@[simp, grind] theorem forM_some [Monad m] (f : α → m PUnit) (a : α) :
+    forM (some a) f = f a := rfl
+
+@[simp, grind] theorem forM_map [Monad m] [LawfulMonad m] (o : Option α) (g : α → β) (f : β → m PUnit) :
+    forM (o.map g) f = forM o (fun a => f (g a)) := by
   cases o <;> simp
 
+@[simp, grind] theorem forIn'_none [Monad m] (b : β) (f : (a : α) → a ∈ none → β → m (ForInStep β)) :
+    forIn' none b f = pure b := by
+  rfl
+
+@[simp, grind] theorem forIn'_some [Monad m] [LawfulMonad m] (a : α) (b : β) (f : (a' : α) → a' ∈ some a → β → m (ForInStep β)) :
+    forIn' (some a) b f = bind (f a rfl b) (fun r => pure (ForInStep.value r)) := by
+  simp only [forIn', bind_pure_comp]
+  rw [map_eq_pure_bind]
+  congr
+  funext x
+  split <;> rfl
+
+@[simp, grind] theorem forIn_none [Monad m] (b : β) (f : α → β → m (ForInStep β)) :
+    forIn none b f = pure b := by
+  rfl
+
+@[simp, grind] theorem forIn_some [Monad m] [LawfulMonad m] (a : α) (b : β) (f : α → β → m (ForInStep β)) :
+    forIn (some a) b f = bind (f a b) (fun r => pure (ForInStep.value r)) := by
+  simp only [forIn, forIn', bind_pure_comp]
+  rw [map_eq_pure_bind]
+  congr
+  funext x
+  split <;> rfl
+
 @[congr] theorem forIn'_congr [Monad m] [LawfulMonad m] {as bs : Option α} (w : as = bs)
     {b b' : β} (hb : b = b')
     {f : (a' : α) → a' ∈ as → β → m (ForInStep β)}
@@ -60,7 +91,7 @@ theorem forIn'_eq_pelim [Monad m] [LawfulMonad m]
       o.pelim b (fun a h => f a h b) := by
   cases o <;> simp
 
-@[simp] theorem forIn'_map [Monad m] [LawfulMonad m]
+@[simp, grind] theorem forIn'_map [Monad m] [LawfulMonad m]
     (o : Option α) (g : α → β) (f : (b : β) → b ∈ o.map g → γ → m (ForInStep γ)) :
     forIn' (o.map g) init f = forIn' o init fun a h y => f (g a) (mem_map_of_mem g h) y := by
   cases o <;> simp
@@ -89,11 +120,9 @@ theorem forIn_eq_elim [Monad m] [LawfulMonad m]
       o.elim b (fun a => f a b) := by
   cases o <;> simp
 
-@[simp] theorem forIn_map [Monad m] [LawfulMonad m]
+@[simp, grind] theorem forIn_map [Monad m] [LawfulMonad m]
     (o : Option α) (g : α → β) (f : β → γ → m (ForInStep γ)) :
     forIn (o.map g) init f = forIn o init fun a y => f (g a) y := by
   cases o <;> simp
 
-@[simp] theorem mapA_eq_mapM : @Option.mapA = @Option.mapM := rfl
-
 end Option

src/Init/Data/Repr.lean

@@ -55,10 +55,12 @@ This instance allows us to use `Empty` as a type parameter without causing insta
 instance : Repr Empty where
   reprPrec := nofun
 
+protected def Bool.repr : Bool → Nat → Format
+  | true, _  => "true"
+  | false, _ => "false"
+
 instance : Repr Bool where
-  reprPrec
-    | true, _  => "true"
-    | false, _ => "false"
+  reprPrec := Bool.repr
 
 def Repr.addAppParen (f : Format) (prec : Nat) : Format :=
   if prec >= max_prec then
@@ -66,10 +68,12 @@ def Repr.addAppParen (f : Format) (prec : Nat) : Format :=
   else
     f
 
+protected def Decidable.repr : Decidable p → Nat → Format
+  | .isTrue _, prec  => Repr.addAppParen "isTrue _" prec
+  | .isFalse _, prec => Repr.addAppParen "isFalse _" prec
+
 instance : Repr (Decidable p) where
-  reprPrec
-    | Decidable.isTrue _, prec  => Repr.addAppParen "isTrue _" prec
-    | Decidable.isFalse _, prec => Repr.addAppParen "isFalse _" prec
+  reprPrec := Decidable.repr
 
 instance : Repr PUnit.{u+1} where
   reprPrec _ _ := "PUnit.unit"
@@ -109,8 +113,11 @@ export ReprTuple (reprTuple)
 instance [Repr α] : ReprTuple α where
   reprTuple a xs := repr a :: xs
 
+protected def Prod.reprTuple [Repr α] [ReprTuple β] : α × β → List Format → List Format
+  | (a, b), xs => reprTuple b (repr a :: xs)
+
 instance [Repr α] [ReprTuple β] : ReprTuple (α × β) where
-  reprTuple | (a, b), xs => reprTuple b (repr a :: xs)
+  reprTuple := Prod.reprTuple
 
 protected def Prod.repr [Repr α] [ReprTuple β] : α × β → Nat → Format
   | (a, b), _ => Format.bracket "(" (Format.joinSep (reprTuple b [repr a]).reverse ("," ++ Format.line)) ")"
@@ -118,8 +125,11 @@ protected def Prod.repr [Repr α] [ReprTuple β] : α × β → Nat → Format
 instance [Repr α] [ReprTuple β] : Repr (α × β) where
   reprPrec := Prod.repr
 
+protected def Sigma.repr {β : α → Type v} [Repr α] [(x : α) → Repr (β x)] : Sigma β → Nat → Format
+  | ⟨a, b⟩, _ => Format.bracket "⟨" (repr a ++ ", " ++ repr b) "⟩"
+
 instance {β : α → Type v} [Repr α] [(x : α) → Repr (β x)] : Repr (Sigma β) where
-  reprPrec | ⟨a, b⟩, _ => Format.bracket "⟨" (repr a ++ ", " ++ repr b) "⟩"
+  reprPrec := Sigma.repr
 
 instance {p : α → Prop} [Repr α] : Repr (Subtype p) where
   reprPrec s prec := reprPrec s.val prec

src/Init/Data/Vector/Attach.lean

@@ -69,7 +69,8 @@ Unsafe implementation of `attachWith`, taking advantage of the fact that the rep
 
 @[simp] theorem toList_attachWith {xs : Vector α n} {P : α → Prop} {H : ∀ x ∈ xs, P x} :
    (xs.attachWith P H).toList = xs.toList.attachWith P (by simpa using H) := by
-  simp [attachWith]
+  rcases xs with ⟨xs, rfl⟩
+  simp
 
 @[simp] theorem toList_attach {xs : Vector α n} :
     xs.attach.toList = xs.toList.attachWith (· ∈ xs) (by simp) := by
@@ -77,7 +78,8 @@ Unsafe implementation of `attachWith`, taking advantage of the fact that the rep
 
 @[simp] theorem toList_pmap {xs : Vector α n} {P : α → Prop} {f : ∀ a, P a → β} {H : ∀ a ∈ xs, P a} :
     (xs.pmap f H).toList = xs.toList.pmap f (fun a m => H a (by simpa using m)) := by
-  simp [pmap]
+  rcases xs with ⟨xs, rfl⟩
+  simp
 
 /-- Implementation of `pmap` using the zero-copy version of `attach`. -/
 @[inline] private def pmapImpl {P : α → Prop} (f : ∀ a, P a → β) (xs : Vector α n) (H : ∀ a ∈ xs, P a) :
@@ -492,7 +494,8 @@ def unattach {α : Type _} {p : α → Prop} (xs : Vector { x // p x } n) : Vect
 
 @[simp] theorem toList_unattach {p : α → Prop} {xs : Vector { x // p x } n} :
     xs.unattach.toList = xs.toList.unattach := by
-  simp [unattach]
+  rcases xs with ⟨xs, rfl⟩
+  simp
 
 @[simp] theorem unattach_attach {xs : Vector α n} : xs.attach.unattach = xs := by
   rcases xs with ⟨xs, rfl⟩

src/Init/Data/Vector/Basic.lean

@@ -24,12 +24,14 @@ set_option linter.listVariables true -- Enforce naming conventions for `List`/`A
 set_option linter.indexVariables true -- Enforce naming conventions for index variables.
 
 /-- `Vector α n` is an `Array α` with size `n`. -/
-structure Vector (α : Type u) (n : Nat) extends Array α where
+structure Vector (α : Type u) (n : Nat) where
+  /-- The underlying array. -/
+  toArray : Array α
   /-- Array size. -/
   size_toArray : toArray.size = n
 deriving Repr, DecidableEq
 
-attribute [simp] Vector.size_toArray
+attribute [simp, grind] Vector.size_toArray
 
 /--
 Converts an array to a vector. The resulting vector's size is the array's size.
@@ -38,6 +40,9 @@ abbrev Array.toVector (xs : Array α) : Vector α xs.size := .mk xs rfl
 
 namespace Vector
 
+/-- The size of a vector. -/
+abbrev size {α n} (_ : Vector α n) : Nat := n
+
 /-- Syntax for `Vector α n` -/
 syntax (name := «term#v[_,]») "#v[" withoutPosition(term,*,?) "]" : term
 
@@ -48,6 +53,9 @@ macro_rules
 recommended_spelling "empty" for "#v[]" in [Vector.mk, «term#v[_,]»]
 recommended_spelling "singleton" for "#v[x]" in [Vector.mk, «term#v[_,]»]
 
+/-- Convert a vector to a list. -/
+def toList (xs : Vector α n) : List α := xs.toArray.toList
+
 /-- Custom eliminator for `Vector α n` through `Array α` -/
 @[elab_as_elim]
 def elimAsArray {motive : Vector α n → Sort u}
@@ -469,6 +477,16 @@ to avoid having to have the predicate live in `p : α → m (ULift Bool)`.
 @[inline] def replace [BEq α] (xs : Vector α n) (a b : α) : Vector α n :=
   ⟨xs.toArray.replace a b, by simp⟩
 
+/--
+Computes the sum of the elements of a vector.
+
+Examples:
+ * `#v[a, b, c].sum = a + (b + (c + 0))`
+ * `#v[1, 2, 5].sum = 8`
+-/
+@[inline] def sum [Add α] [Zero α] (xs : Vector α n) : α :=
+  xs.toArray.sum
+
 /--
 Pad a vector on the left with a given element.
 

src/Init/Data/Vector/Count.lean

@@ -66,8 +66,8 @@ theorem countP_le_size {xs : Vector α n} : countP p xs ≤ n := by
   cases xs
   simp
 
-@[simp] theorem countP_eq_size {p} : countP p xs = xs.size ↔ ∀ a ∈ xs, p a := by
-  cases xs
+@[simp] theorem countP_eq_size {p} {xs : Vector α n} : countP p xs = n ↔ ∀ a ∈ xs, p a := by
+  rcases xs with ⟨xs, rfl⟩
   simp
 
 @[simp] theorem countP_cast (p : α → Bool) (xs : Vector α n) : countP p (xs.cast h) = countP p xs := by
@@ -213,7 +213,7 @@ theorem not_mem_of_count_eq_zero {a : α} {xs : Vector α n} (h : count a xs = 0
 theorem count_eq_zero {xs : Vector α n} : count a xs = 0 ↔ a ∉ xs :=
   ⟨not_mem_of_count_eq_zero, count_eq_zero_of_not_mem⟩
 
-theorem count_eq_size {xs : Vector α n} : count a xs = xs.size ↔ ∀ b ∈ xs, a = b := by
+theorem count_eq_size {xs : Vector α n} : count a xs = n ↔ ∀ b ∈ xs, a = b := by
   rcases xs with ⟨xs, rfl⟩
   simp [Array.count_eq_size]
 

src/Init/Data/Vector/DecidableEq.lean

@@ -58,7 +58,7 @@ theorem beq_eq_decide [BEq α] (xs ys : Vector α n) :
     (mk xs ha == mk ys hb) = (xs == ys) := by
   simp [BEq.beq]
 
-@[simp] theorem beq_toArray [BEq α] (xs ys : Vector α n) : (xs.toArray == ys.toArray) = (xs == ys) := by
+@[simp, grind =] theorem beq_toArray [BEq α] (xs ys : Vector α n) : (xs.toArray == ys.toArray) = (xs == ys) := by
   simp [beq_eq_decide, Array.beq_eq_decide]
 
 @[simp] theorem beq_toList [BEq α] (xs ys : Vector α n) : (xs.toList == ys.toList) = (xs == ys) := by

src/Init/Data/Vector/Extract.lean

@@ -88,7 +88,7 @@ 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
         xs.extract i j
-      else if _ : k < min j xs.size then
+      else if _ : k < min j n then
         (xs.extract i j).set (k - i) a (by omega)
       else xs.extract i j := by
   rcases xs with ⟨xs, rfl⟩

src/Init/Data/Vector/Find.lean

@@ -196,20 +196,6 @@ theorem get_find?_mem {xs : Vector α n} (h) : (xs.find? p).get h ∈ xs := by
   cases xs
   simp [Array.get_find?_mem]
 
-@[simp] theorem find?_filter {xs : Vector α n} (p q : α → Bool) :
-    (xs.filter p).find? q = xs.find? (fun a => p a ∧ q a) := by
-  cases xs; simp
-
-@[simp] theorem getElem?_zero_filter {p : α → Bool} {xs : Vector α n} :
-    (xs.filter p)[0]? = xs.find? p := by
-  cases xs; simp [← List.head?_eq_getElem?]
-
-@[simp] theorem getElem_zero_filter {p : α → Bool} {xs : Vector α n} (h) :
-    (xs.filter p)[0] =
-      (xs.find? p).get (by cases xs; simpa [← Array.countP_eq_size_filter] using h) := by
-  cases xs
-  simp [List.getElem_zero_eq_head]
-
 @[simp] theorem find?_map {f : β → α} {xs : Vector β n} :
     find? p (xs.map f) = (xs.find? (p ∘ f)).map f := by
   cases xs; simp
@@ -323,7 +309,7 @@ theorem findFinIdx?_push {xs : Vector α n} {a : α} {p : α → Bool} :
 theorem findFinIdx?_append {xs : Vector α n₁} {ys : Vector α n₂} {p : α → Bool} :
     (xs ++ ys).findFinIdx? p =
       ((xs.findFinIdx? p).map (Fin.castLE (by simp))).or
-        ((ys.findFinIdx? p).map (Fin.natAdd xs.size) |>.map (Fin.cast (by simp))) := by
+        ((ys.findFinIdx? p).map (Fin.natAdd n₁)) := by
   rcases xs with ⟨xs, rfl⟩
   rcases ys with ⟨ys, rfl⟩
   simp [Array.findFinIdx?_append, Option.map_or, Function.comp_def]

src/Init/Data/Vector/InsertIdx.lean

@@ -104,7 +104,7 @@ theorem getElem?_insertIdx {xs : Vector α n} {x : α} {i k : Nat} (h : i ≤ n)
         xs[k]?
       else
         if k = i then
-          if k ≤ xs.size then some x else none
+          if k ≤ n then some x else none
         else
           xs[k-1]? := by
   rcases xs with ⟨xs, rfl⟩

src/Init/Data/Vector/Lemmas.lean

@@ -63,9 +63,6 @@ theorem toArray_mk {xs : Array α} (h : xs.size = n) : (Vector.mk xs h).toArray
     (Vector.mk xs h == Vector.mk ys h') = (xs == ys) := by
   simp [instBEq, isEqv, Array.instBEq, Array.isEqv, h, h']
 
-@[simp] theorem allDiff_mk [BEq α] {xs : Array α} (h : xs.size = n) :
-    (Vector.mk xs h).allDiff = xs.allDiff := rfl
-
 @[simp] theorem mk_append_mk {xs ys : Array α} (h : xs.size = n) (h' : ys.size = m) :
     Vector.mk xs h ++ Vector.mk ys h' = Vector.mk (xs ++ ys) (by simp [h, h']) := rfl
 
@@ -253,6 +250,9 @@ abbrev zipWithIndex_mk := @zipIdx_mk
 @[simp] theorem replace_mk [BEq α] {xs : Array α} (h : xs.size = n) {a b} :
     (Vector.mk xs h).replace a b = Vector.mk (xs.replace a b) (by simp [h]) := rfl
 
+@[simp] theorem sum_mk [Add α] [Zero α] {xs : Array α} (h : xs.size = n) :
+    (Vector.mk xs h).sum = xs.sum := rfl
+
 @[simp] theorem eq_mk : xs = Vector.mk as h ↔ xs.toArray = as := by
   cases xs
   simp
@@ -263,57 +263,59 @@ abbrev zipWithIndex_mk := @zipIdx_mk
 
 /-! ### toArray lemmas -/
 
-@[simp] theorem getElem_toArray {α n} {xs : Vector α n} {i : Nat} (h : i < xs.toArray.size) :
+@[simp, grind] theorem getElem_toArray {α n} {xs : Vector α n} {i : Nat} (h : i < xs.toArray.size) :
     xs.toArray[i] = xs[i]'(by simpa using h) := by
   cases xs
   simp
 
-@[simp] theorem getElem?_toArray {α n} {xs : Vector α n} {i : Nat} :
+@[simp, grind] theorem getElem?_toArray {α n} {xs : Vector α n} {i : Nat} :
     xs.toArray[i]? = xs[i]? := by
   cases xs
   simp
 
-@[simp] theorem toArray_append {xs : Vector α m} {ys : Vector α n} :
+@[simp, grind _=_] theorem toArray_append {xs : Vector α m} {ys : Vector α n} :
     (xs ++ ys).toArray = xs.toArray ++ ys.toArray := rfl
 
-@[simp] theorem toArray_drop {xs : Vector α n} {i} :
-    (xs.drop i).toArray = xs.toArray.extract i xs.size := rfl
+set_option linter.indexVariables false in
+@[simp, grind] theorem toArray_drop {xs : Vector α n} {i} :
+    (xs.drop i).toArray = xs.toArray.extract i n := by
+  simp [drop]
 
-@[simp] theorem toArray_empty : (#v[] : Vector α 0).toArray = #[] := rfl
+@[simp, grind] theorem toArray_empty : (#v[] : Vector α 0).toArray = #[] := rfl
 
-@[simp] theorem toArray_emptyWithCapacity {cap} :
+@[simp, grind] theorem toArray_emptyWithCapacity {cap} :
     (Vector.emptyWithCapacity (α := α) cap).toArray = Array.emptyWithCapacity cap := rfl
 
 @[deprecated toArray_emptyWithCapacity (since := "2025-03-12")]
 abbrev toArray_mkEmpty := @toArray_emptyWithCapacity
 
-@[simp] theorem toArray_eraseIdx {xs : Vector α n} {i} (h) :
+@[simp, grind] theorem toArray_eraseIdx {xs : Vector α n} {i} (h) :
     (xs.eraseIdx i h).toArray = xs.toArray.eraseIdx i (by simp [h]) := rfl
 
-@[simp] theorem toArray_eraseIdx! {xs : Vector α n} {i} (hi : i < n) :
+@[simp, grind] theorem toArray_eraseIdx! {xs : Vector α n} {i} (hi : i < n) :
     (xs.eraseIdx! i).toArray = xs.toArray.eraseIdx! i := by
   cases xs; simp_all [Array.eraseIdx!]
 
-@[simp] theorem toArray_insertIdx {xs : Vector α n} {i x} (h) :
+@[simp, grind] theorem toArray_insertIdx {xs : Vector α n} {i x} (h) :
     (xs.insertIdx i x h).toArray = xs.toArray.insertIdx i x (by simp [h]) := rfl
 
-@[simp] theorem toArray_insertIdx! {xs : Vector α n} {i x} (hi : i ≤ n) :
+@[simp, grind] theorem toArray_insertIdx! {xs : Vector α n} {i x} (hi : i ≤ n) :
     (xs.insertIdx! i x).toArray = xs.toArray.insertIdx! i x := by
   cases xs; simp_all [Array.insertIdx!]
 
-@[simp] theorem toArray_cast {xs : Vector α n} (h : n = m) :
+@[simp, grind] theorem toArray_cast {xs : Vector α n} (h : n = m) :
     (xs.cast h).toArray = xs.toArray := rfl
 
-@[simp] theorem toArray_extract {xs : Vector α n} {start stop} :
+@[simp, grind] theorem toArray_extract {xs : Vector α n} {start stop} :
     (xs.extract start stop).toArray = xs.toArray.extract start stop := rfl
 
-@[simp] theorem toArray_map {f : α → β} {xs : Vector α n} :
+@[simp, grind] theorem toArray_map {f : α → β} {xs : Vector α n} :
     (xs.map f).toArray = xs.toArray.map f := rfl
 
-@[simp] theorem toArray_mapIdx {f : Nat → α → β} {xs : Vector α n} :
+@[simp, grind] theorem toArray_mapIdx {f : Nat → α → β} {xs : Vector α n} :
     (xs.mapIdx f).toArray = xs.toArray.mapIdx f := rfl
 
-@[simp] theorem toArray_mapFinIdx {f : (i : Nat) → α → (h : i < n) → β} {xs : Vector α n} :
+@[simp, grind] theorem toArray_mapFinIdx {f : (i : Nat) → α → (h : i < n) → β} {xs : Vector α n} :
     (xs.mapFinIdx f).toArray =
       xs.toArray.mapFinIdx (fun i a h => f i a (by simpa [xs.size_toArray] using h)) :=
   rfl
@@ -331,145 +333,145 @@ theorem toArray_mapM_go [Monad m] [LawfulMonad m] {f : α → m β} {xs : Vector
     rfl
   · simp
 
-@[simp] theorem toArray_mapM [Monad m] [LawfulMonad m] {f : α → m β} {xs : Vector α n} :
+@[simp, grind] theorem toArray_mapM [Monad m] [LawfulMonad m] {f : α → m β} {xs : Vector α n} :
     toArray <$> xs.mapM f = xs.toArray.mapM f := by
   rcases xs with ⟨xs, rfl⟩
   unfold mapM
   rw [toArray_mapM_go]
   rfl
 
-@[simp] theorem toArray_ofFn {f : Fin n → α} : (Vector.ofFn f).toArray = Array.ofFn f := rfl
+@[simp, grind] theorem toArray_ofFn {f : Fin n → α} : (Vector.ofFn f).toArray = Array.ofFn f := rfl
 
-@[simp] theorem toArray_pop {xs : Vector α n} : xs.pop.toArray = xs.toArray.pop := rfl
+@[simp, grind] theorem toArray_pop {xs : Vector α n} : xs.pop.toArray = xs.toArray.pop := rfl
 
-@[simp] theorem toArray_push {xs : Vector α n} {x} : (xs.push x).toArray = xs.toArray.push x := rfl
+@[simp, grind] theorem toArray_push {xs : Vector α n} {x} : (xs.push x).toArray = xs.toArray.push x := rfl
 
-@[simp] theorem toArray_beq_toArray [BEq α] {xs : Vector α n} {ys : Vector α n} :
+@[simp, grind] theorem toArray_beq_toArray [BEq α] {xs : Vector α n} {ys : Vector α n} :
     (xs.toArray == ys.toArray) = (xs == ys) := by
   simp [instBEq, isEqv, Array.instBEq, Array.isEqv, xs.2, ys.2]
 
-@[simp] theorem toArray_range : (Vector.range n).toArray = Array.range n := rfl
+@[simp, grind] theorem toArray_range : (Vector.range n).toArray = Array.range n := rfl
 
-@[simp] theorem toArray_reverse (xs : Vector α n) : xs.reverse.toArray = xs.toArray.reverse := rfl
+@[simp, grind] theorem toArray_reverse (xs : Vector α n) : xs.reverse.toArray = xs.toArray.reverse := rfl
 
-@[simp] theorem toArray_set {xs : Vector α n} {i x} (h) :
+@[simp, grind] theorem toArray_set {xs : Vector α n} {i x} (h) :
     (xs.set i x).toArray = xs.toArray.set i x (by simpa using h):= rfl
 
-@[simp] theorem toArray_set! {xs : Vector α n} {i x} :
+@[simp, grind] theorem toArray_set! {xs : Vector α n} {i x} :
     (xs.set! i x).toArray = xs.toArray.set! i x := rfl
 
-@[simp] theorem toArray_setIfInBounds {xs : Vector α n} {i x} :
+@[simp, grind] theorem toArray_setIfInBounds {xs : Vector α n} {i x} :
     (xs.setIfInBounds i x).toArray = xs.toArray.setIfInBounds i x := rfl
 
-@[simp] theorem toArray_singleton {x : α} : (Vector.singleton x).toArray = #[x] := rfl
+@[simp, grind] theorem toArray_singleton {x : α} : (Vector.singleton x).toArray = #[x] := rfl
 
-@[simp] theorem toArray_swap {xs : Vector α n} {i j} (hi hj) : (xs.swap i j).toArray =
+@[simp, grind] theorem toArray_swap {xs : Vector α n} {i j} (hi hj) : (xs.swap i j).toArray =
     xs.toArray.swap i j (by simp [hi, hj]) (by simp [hi, hj]) := rfl
 
-@[simp] theorem toArray_swapIfInBounds {xs : Vector α n} {i j} :
+@[simp, grind] theorem toArray_swapIfInBounds {xs : Vector α n} {i j} :
     (xs.swapIfInBounds i j).toArray = xs.toArray.swapIfInBounds i j := rfl
 
-@[simp] theorem toArray_swapAt {xs : Vector α n} {i x} (h) :
+theorem toArray_swapAt {xs : Vector α n} {i x} (h) :
     ((xs.swapAt i x).fst, (xs.swapAt i x).snd.toArray) =
       ((xs.toArray.swapAt i x (by simpa using h)).fst,
         (xs.toArray.swapAt i x (by simpa using h)).snd) := rfl
 
-@[simp] theorem toArray_swapAt! {xs : Vector α n} {i x} :
+theorem toArray_swapAt! {xs : Vector α n} {i x} :
     ((xs.swapAt! i x).fst, (xs.swapAt! i x).snd.toArray) =
       ((xs.toArray.swapAt! i x).fst, (xs.toArray.swapAt! i x).snd) := rfl
 
-@[simp] theorem toArray_take {xs : Vector α n} {i} : (xs.take i).toArray = xs.toArray.take i := rfl
+@[simp, grind] theorem toArray_take {xs : Vector α n} {i} : (xs.take i).toArray = xs.toArray.take i := rfl
 
-@[simp] theorem toArray_zipIdx {xs : Vector α n} (k : Nat := 0) :
+@[simp, grind] theorem toArray_zipIdx {xs : Vector α n} (k : Nat := 0) :
     (xs.zipIdx k).toArray = xs.toArray.zipIdx k := rfl
 
-@[simp] theorem toArray_zipWith {f : α → β → γ} {as : Vector α n} {bs : Vector β n} :
+@[simp, grind] theorem toArray_zipWith {f : α → β → γ} {as : Vector α n} {bs : Vector β n} :
     (Vector.zipWith f as bs).toArray = Array.zipWith f as.toArray bs.toArray := rfl
 
-@[simp] theorem anyM_toArray [Monad m] {p : α → m Bool} {xs : Vector α n} :
+@[simp, grind] theorem anyM_toArray [Monad m] {p : α → m Bool} {xs : Vector α n} :
     xs.toArray.anyM p = xs.anyM p := by
   cases xs
   simp
 
-@[simp] theorem allM_toArray [Monad m] {p : α → m Bool} {xs : Vector α n} :
+@[simp, grind] theorem allM_toArray [Monad m] {p : α → m Bool} {xs : Vector α n} :
     xs.toArray.allM p = xs.allM p := by
   cases xs
   simp
 
-@[simp] theorem any_toArray {p : α → Bool} {xs : Vector α n} :
+@[simp, grind] theorem any_toArray {p : α → Bool} {xs : Vector α n} :
     xs.toArray.any p = xs.any p := by
   cases xs
   simp
 
-@[simp] theorem all_toArray {p : α → Bool} {xs : Vector α n} :
+@[simp, grind] theorem all_toArray {p : α → Bool} {xs : Vector α n} :
     xs.toArray.all p = xs.all p := by
   cases xs
   simp
 
-@[simp] theorem countP_toArray {p : α → Bool} {xs : Vector α n} :
+@[simp, grind] theorem countP_toArray {p : α → Bool} {xs : Vector α n} :
     xs.toArray.countP p = xs.countP p := by
   cases xs
   simp
 
-@[simp] theorem count_toArray [BEq α] {a : α} {xs : Vector α n} :
+@[simp, grind] theorem count_toArray [BEq α] {a : α} {xs : Vector α n} :
     xs.toArray.count a = xs.count a := by
   cases xs
   simp
 
-@[simp] theorem replace_toArray [BEq α] {xs : Vector α n} {a b} :
+@[simp, grind] theorem replace_toArray [BEq α] {xs : Vector α n} {a b} :
     xs.toArray.replace a b = (xs.replace a b).toArray := rfl
 
-@[simp] theorem find?_toArray {p : α → Bool} {xs : Vector α n} :
+@[simp, grind] theorem find?_toArray {p : α → Bool} {xs : Vector α n} :
     xs.toArray.find? p = xs.find? p := by
   cases xs
   simp
 
-@[simp] theorem findSome?_toArray {f : α → Option β} {xs : Vector α n} :
+@[simp, grind] theorem findSome?_toArray {f : α → Option β} {xs : Vector α n} :
     xs.toArray.findSome? f = xs.findSome? f := by
   cases xs
   simp
 
-@[simp] theorem findRev?_toArray {p : α → Bool} {xs : Vector α n} :
+@[simp, grind] theorem findRev?_toArray {p : α → Bool} {xs : Vector α n} :
     xs.toArray.findRev? p = xs.findRev? p := by
   cases xs
   simp
 
-@[simp] theorem findSomeRev?_toArray {f : α → Option β} {xs : Vector α n} :
+@[simp, grind] theorem findSomeRev?_toArray {f : α → Option β} {xs : Vector α n} :
     xs.toArray.findSomeRev? f = xs.findSomeRev? f := by
   cases xs
   simp
 
-@[simp] theorem findM?_toArray [Monad m] {p : α → m Bool} {xs : Vector α n} :
+@[simp, grind] theorem findM?_toArray [Monad m] {p : α → m Bool} {xs : Vector α n} :
     xs.toArray.findM? p = xs.findM? p := by
   cases xs
   simp
 
-@[simp] theorem findSomeM?_toArray [Monad m] {f : α → m (Option β)} {xs : Vector α n} :
+@[simp, grind] theorem findSomeM?_toArray [Monad m] {f : α → m (Option β)} {xs : Vector α n} :
     xs.toArray.findSomeM? f = xs.findSomeM? f := by
   cases xs
   simp
 
-@[simp] theorem findRevM?_toArray [Monad m] {p : α → m Bool} {xs : Vector α n} :
+@[simp, grind] theorem findRevM?_toArray [Monad m] {p : α → m Bool} {xs : Vector α n} :
     xs.toArray.findRevM? p = xs.findRevM? p := by
   rcases xs with ⟨xs, rfl⟩
   simp
 
-@[simp] theorem findSomeRevM?_toArray [Monad m] {f : α → m (Option β)} {xs : Vector α n} :
+@[simp, grind] theorem findSomeRevM?_toArray [Monad m] {f : α → m (Option β)} {xs : Vector α n} :
     xs.toArray.findSomeRevM? f = xs.findSomeRevM? f := by
   rcases xs with ⟨xs, rfl⟩
   simp
 
-@[simp] theorem finIdxOf?_toArray [BEq α] {a : α} {xs : Vector α n} :
+@[simp, grind] theorem finIdxOf?_toArray [BEq α] {a : α} {xs : Vector α n} :
     xs.toArray.finIdxOf? a = (xs.finIdxOf? a).map (Fin.cast xs.size_toArray.symm) := by
   rcases xs with ⟨xs, rfl⟩
   simp
 
-@[simp] theorem findFinIdx?_toArray {p : α → Bool} {xs : Vector α n} :
+@[simp, grind] theorem findFinIdx?_toArray {p : α → Bool} {xs : Vector α n} :
     xs.toArray.findFinIdx? p = (xs.findFinIdx? p).map (Fin.cast xs.size_toArray.symm) := by
   rcases xs with ⟨xs, rfl⟩
   simp
 
-@[simp] theorem toArray_replicate : (replicate n a).toArray = Array.replicate n a := rfl
+@[simp, grind] theorem toArray_replicate : (replicate n a).toArray = Array.replicate n a := rfl
 
 @[deprecated toArray_replicate (since := "2025-03-18")]
 abbrev toArray_mkVector := @toArray_replicate
@@ -483,7 +485,7 @@ abbrev toArray_mkVector := @toArray_replicate
 `Vector.ext` is an extensionality theorem.
 Vectors `a` and `b` are equal to each other if their elements are equal for each valid index.
 -/
-@[ext, grind ext]
+@[ext]
 protected theorem ext {xs ys : Vector α n} (h : (i : Nat) → (_ : i < n) → xs[i] = ys[i]) : xs = ys := by
   apply Vector.toArray_inj.1
   apply Array.ext
@@ -498,7 +500,13 @@ protected theorem ext {xs ys : Vector α n} (h : (i : Nat) → (_ : i < n) → x
 
 /-! ### toList -/
 
-theorem toArray_toList {xs : Vector α n} : xs.toArray.toList = xs.toList := rfl
+@[simp, grind] theorem length_toList {xs : Vector α n} : xs.toList.length = n := by
+  rcases xs with ⟨xs, rfl⟩
+  simp [toList]
+
+@[grind =_] theorem toList_toArray {xs : Vector α n} : xs.toArray.toList = xs.toList := rfl
+
+@[simp, grind] theorem toList_mk : (Vector.mk xs h).toList = xs.toList := rfl
 
 @[simp] theorem getElem_toList {xs : Vector α n} {i : Nat} (h : i < xs.toList.length) :
     xs.toList[i] = xs[i]'(by simpa using h) := by
@@ -511,11 +519,11 @@ theorem toArray_toList {xs : Vector α n} : xs.toArray.toList = xs.toList := rfl
   simp
 
 theorem toList_append {xs : Vector α m} {ys : Vector α n} :
-    (xs ++ ys).toList = xs.toList ++ ys.toList := by simp
+    (xs ++ ys).toList = xs.toList ++ ys.toList := by simp [toList]
 
 @[simp] theorem toList_drop {xs : Vector α n} {i} :
     (xs.drop i).toList = xs.toList.drop i := by
-  simp [List.take_of_length_le]
+  simp [toList, List.take_of_length_le]
 
 theorem toList_empty : (#v[] : Vector α 0).toList = [] := rfl
 
@@ -526,14 +534,14 @@ theorem toList_emptyWithCapacity {cap} :
 abbrev toList_mkEmpty := @toList_emptyWithCapacity
 
 theorem toList_eraseIdx {xs : Vector α n} {i} (h) :
-    (xs.eraseIdx i h).toList = xs.toList.eraseIdx i := by simp
+    (xs.eraseIdx i h).toList = xs.toList.eraseIdx i := by simp [toList]
 
 @[simp] theorem toList_eraseIdx! {xs : Vector α n} {i} (hi : i < n) :
     (xs.eraseIdx! i).toList = xs.toList.eraseIdx i := by
   cases xs; simp_all [Array.eraseIdx!]
 
 theorem toList_insertIdx {xs : Vector α n} {i x} (h) :
-    (xs.insertIdx i x h).toList = xs.toList.insertIdx i x := by simp
+    (xs.insertIdx i x h).toList = xs.toList.insertIdx i x := by simp [toList]
 
 theorem toList_insertIdx! {xs : Vector α n} {i x} (hi : i ≤ n) :
     (xs.insertIdx! i x).toList = xs.toList.insertIdx i x := by
@@ -544,39 +552,39 @@ theorem toList_cast {xs : Vector α n} (h : n = m) :
 
 theorem toList_extract {xs : Vector α n} {start stop} :
     (xs.extract start stop).toList = (xs.toList.drop start).take (stop - start) := by
-  simp
+  simp [toList]
 
 theorem toList_map {f : α → β} {xs : Vector α n} :
-    (xs.map f).toList = xs.toList.map f := by simp
+    (xs.map f).toList = xs.toList.map f := by simp [toList]
 
 theorem toList_mapIdx {f : Nat → α → β} {xs : Vector α n} :
-    (xs.mapIdx f).toList = xs.toList.mapIdx f := by simp
+    (xs.mapIdx f).toList = xs.toList.mapIdx f := by simp [toList]
 
 theorem toList_mapFinIdx {f : (i : Nat) → α → (h : i < n) → β} {xs : Vector α n} :
     (xs.mapFinIdx f).toList =
       xs.toList.mapFinIdx (fun i a h => f i a (by simpa [xs.size_toArray] using h)) := by
-  simp
+  simp [toList]
 
-theorem toList_ofFn {f : Fin n → α} : (Vector.ofFn f).toList = List.ofFn f := by simp
+theorem toList_ofFn {f : Fin n → α} : (Vector.ofFn f).toList = List.ofFn f := by simp [toList]
 
-theorem toList_pop {xs : Vector α n} : xs.pop.toList = xs.toList.dropLast := rfl
+theorem toList_pop {xs : Vector α n} : xs.pop.toList = xs.toList.dropLast := by simp [toList]
 
-theorem toList_push {xs : Vector α n} {x} : (xs.push x).toList = xs.toList ++ [x] := by simp
+theorem toList_push {xs : Vector α n} {x} : (xs.push x).toList = xs.toList ++ [x] := by simp [toList]
 
 @[simp] theorem toList_beq_toList [BEq α] {xs : Vector α n} {ys : Vector α n} :
     (xs.toList == ys.toList) = (xs == ys) := by
-  simp [instBEq, isEqv, Array.instBEq, Array.isEqv, xs.2, ys.2]
+  simp [toList]
 
-theorem toList_range : (Vector.range n).toList = List.range n := by simp
+theorem toList_range : (Vector.range n).toList = List.range n := by simp [toList]
 
-theorem toList_reverse {xs : Vector α n} : xs.reverse.toList = xs.toList.reverse := by simp
+theorem toList_reverse {xs : Vector α n} : xs.reverse.toList = xs.toList.reverse := by simp [toList]
 
 theorem toList_set {xs : Vector α n} {i x} (h) :
     (xs.set i x).toList = xs.toList.set i x := rfl
 
 @[simp] theorem toList_setIfInBounds {xs : Vector α n} {i x} :
     (xs.setIfInBounds i x).toList = xs.toList.set i x := by
-  simp [Vector.setIfInBounds]
+  simp [toList, Vector.setIfInBounds]
 
 theorem toList_singleton {x : α} : (Vector.singleton x).toList = [x] := rfl
 
@@ -584,7 +592,7 @@ theorem toList_swap {xs : Vector α n} {i j} (hi hj) :
     (xs.swap i j).toList = (xs.toList.set i xs[j]).set j xs[i] := rfl
 
 @[simp] theorem toList_take {xs : Vector α n} {i} : (xs.take i).toList = xs.toList.take i := by
-  simp [List.take_of_length_le]
+  simp [toList, List.take_of_length_le]
 
 @[simp] theorem toList_zipWith {f : α → β → γ} {as : Vector α n} {bs : Vector β n} :
     (Vector.zipWith f as bs).toList = List.zipWith f as.toList bs.toList := by
@@ -664,16 +672,14 @@ theorem toList_inj {xs ys : Vector α n} : xs.toList = ys.toList ↔ xs = ys :=
 
 @[simp] theorem toList_eq_nil_iff {xs : Vector α n} : xs.toList = [] ↔ n = 0 := by
   rcases xs with ⟨xs, h⟩
-  simp only [Array.toList_eq_nil_iff]
+  simp only [toList, Array.toList_eq_nil_iff]
   exact ⟨by rintro rfl; simp_all, by rintro rfl; simpa using h⟩
 
 @[deprecated toList_eq_nil_iff (since := "2025-04-04")]
 abbrev toList_eq_empty_iff {α n} (xs) := @toList_eq_nil_iff α n xs
 
 @[simp] theorem mem_toList_iff {a : α} {xs : Vector α n} : a ∈ xs.toList ↔ a ∈ xs := by
-  simp
-
-theorem length_toList {α n} (xs : Vector α n) : xs.toList.length = n := by simp
+  simp [toList]
 
 /-! ### empty -/
 
@@ -1320,7 +1326,7 @@ theorem getElem?_setIfInBounds_self {xs : Vector α n} {x : α} :
 @[simp] theorem getElem?_setIfInBounds_ne {xs : Vector α n} {x : α} (h : i ≠ j) :
     (xs.setIfInBounds i x)[j]? = xs[j]? := by simp [getElem?_setIfInBounds, h]
 
-theorem setIfInBounds_eq_of_size_le {xs : Vector α n} {i : Nat} (h : xs.size ≤ i) {a : α} :
+theorem setIfInBounds_eq_of_size_le {xs : Vector α n} {i : Nat} (h : n ≤ i) {a : α} :
     xs.setIfInBounds i a = xs := by
   rcases xs with ⟨xs, rfl⟩
   simp [Array.setIfInBounds_eq_of_size_le (by simpa using h)]
@@ -1864,7 +1870,7 @@ set_option linter.listVariables false in
   induction l generalizing i with
   | nil => simp at hi
   | cons xs l ih =>
-    simp only [List.map_cons, List.map_map, List.flatten_cons]
+    simp only [List.map_cons, List.map_map, List.flatten_cons, toList_toArray]
     by_cases h : i < m
     · rw [List.getElem_append_left (by simpa)]
       have h₁ : i / m = 0 := Nat.div_eq_of_lt h
@@ -1872,13 +1878,13 @@ set_option linter.listVariables false in
       simp [h₁, h₂]
     · have h₁ : xs.toList.length ≤ i := by simp; omega
       rw [List.getElem_append_right h₁]
-      simp only [Array.length_toList, size_toArray]
+      simp only [length_toList]
       specialize ih (i := i - m) (by simp_all [Nat.add_one_mul]; omega)
       have h₂ : i / m = (i - m) / m + 1 := by
         conv => lhs; rw [show i = i - m + m by omega]
         rw [Nat.add_div_right]
         exact Nat.pos_of_lt_mul_left hi
-      simp only [Array.length_toList, size_toArray] at h₁
+      simp only [length_toList] at h₁
       have h₃ : (i - m) % m = i % m := (Nat.mod_eq_sub_mod h₁).symm
       simp_all
 
@@ -2215,7 +2221,7 @@ theorem flatMap_replicate {f : α → Vector β m} : (replicate n a).flatMap f =
 abbrev flatMap_mkVector := @flatMap_replicate
 
 @[simp] theorem sum_replicate_nat {n : Nat} {a : Nat} : (replicate n a).sum = n * a := by
-  simp [toArray_replicate]
+  simp [sum, toArray_replicate]
 
 @[deprecated sum_replicate_nat (since := "2025-03-18")]
 abbrev sum_mkVector := @sum_replicate_nat
@@ -2233,10 +2239,6 @@ theorem reverse_empty : reverse (#v[] : Vector α 0) = #v[] := rfl
   cases as
   simp
 
-@[simp] theorem isEmpty_reverse {xs : Vector α n} : xs.reverse.isEmpty = xs.isEmpty := by
-  rcases xs with ⟨xs, rfl⟩
-  simp
-
 @[simp, grind] theorem getElem_reverse {xs : Vector α n} {i : Nat} (hi : i < n) :
     (xs.reverse)[i] = xs[n - 1 - i] := by
   rcases xs with ⟨xs, rfl⟩
@@ -2448,14 +2450,16 @@ theorem foldr_map {f : α₁ → α₂} {g : α₂ → β → β} {xs : Vector
     (xs.map f).foldr g init = xs.foldr (fun x y => g (f x) y) init := by
   cases xs; simp [Array.foldr_map']
 
+@[deprecated "Deprecated without replacement; `filterMap` is not part of the `Vector` API." (since := "2025-05-09")]
 theorem foldl_filterMap {f : α → Option β} {g : γ → β → γ} {xs : Vector α n} {init : γ} :
-    (xs.filterMap f).foldl g init = xs.foldl (fun x y => match f y with | some b => g x b | none => x) init := by
+    (xs.toArray.filterMap f).foldl g init = xs.foldl (fun x y => match f y with | some b => g x b | none => x) init := by
   rcases xs with ⟨xs, rfl⟩
   simp [Array.foldl_filterMap']
   rfl
 
+@[deprecated "Deprecated without replacement; `filterMap` is not part of the `Vector` API." (since := "2025-05-09")]
 theorem foldr_filterMap {f : α → Option β} {g : β → γ → γ} {xs : Vector α n} {init : γ} :
-    (xs.filterMap f).foldr g init = xs.foldr (fun x y => match f x with | some b => g b y | none => y) init := by
+    (xs.toArray.filterMap f).foldr g init = xs.foldr (fun x y => match f x with | some b => g b y | none => y) init := by
   cases xs; simp [Array.foldr_filterMap']
   rfl
 
@@ -2555,12 +2559,12 @@ theorem foldr_rel {xs : Vector α n} {f g : α → β → β} {a b : β} {r : β
   simpa using Array.foldr_rel h (by simpa using h')
 
 @[simp] theorem foldl_add_const {xs : Vector α n} {a b : Nat} :
-    xs.foldl (fun x _ => x + a) b = b + a * xs.size := by
+    xs.foldl (fun x _ => x + a) b = b + a * n := by
   rcases xs with ⟨xs, rfl⟩
   simp
 
 @[simp] theorem foldr_add_const {xs : Vector α n} {a b : Nat} :
-    xs.foldr (fun _ x => x + a) b = b + a * xs.size := by
+    xs.foldr (fun _ x => x + a) b = b + a * n := by
   rcases xs with ⟨xs, rfl⟩
   simp
 
@@ -2697,15 +2701,15 @@ theorem contains_map [BEq β] {xs : Vector α n} {x : β} {f : α → β} :
   rcases xs with ⟨xs⟩
   simp
 
-@[simp, grind]
+@[deprecated "Deprecated without replacement; `filter` is not part of the `Vector` API." (since := "2025-05-09")]
 theorem contains_filter [BEq α] {xs : Vector α n} {x : α} {p : α → Bool} :
-    (xs.filter p).contains x = xs.any (fun a => x == a && p a) := by
+    (xs.toArray.filter p).contains x = xs.any (fun a => x == a && p a) := by
   rcases xs with ⟨xs, rfl⟩
   simp
 
-@[simp, grind]
+@[deprecated "Deprecated without replacement; `filterMap` is not part of the `Vector` API." (since := "2025-05-09")]
 theorem contains_filterMap [BEq β] {xs : Vector α n} {x : β} {f : α → Option β} :
-    (xs.filterMap f).contains x = xs.any (fun a => (f a).any fun b => x == b) := by
+    (xs.toArray.filterMap f).contains x = xs.any (fun a => (f a).any fun b => x == b) := by
   rcases xs with ⟨xs, rfl⟩
   simp
 
@@ -2835,24 +2839,28 @@ theorem any_eq_not_all_not {xs : Vector α n} {p : α → Bool} : xs.any p = !xs
   rcases xs with ⟨xs, rfl⟩
   simp
 
-@[simp] theorem any_filter {xs : Vector α n} {p q : α → Bool} :
-    (xs.filter p).any q = xs.any fun a => p a && q a := by
+@[deprecated "Deprecated without replacement; `filter` is not part of the `Vector` API." (since := "2025-05-09")]
+theorem any_filter {xs : Vector α n} {p q : α → Bool} :
+    (xs.toArray.filter p).any q = xs.any fun a => p a && q a := by
   rcases xs with ⟨xs, rfl⟩
   simp
 
-@[simp] theorem all_filter {xs : Vector α n} {p q : α → Bool} :
-    (xs.filter p).all q = xs.all fun a => !(p a) || q a := by
+@[deprecated "Deprecated without replacement; `filter` is not part of the `Vector` API." (since := "2025-05-09")]
+theorem all_filter {xs : Vector α n} {p q : α → Bool} :
+    (xs.toArray.filter p).all q = xs.all fun a => !(p a) || q a := by
   rcases xs with ⟨xs, rfl⟩
   simp
 
-@[simp] theorem any_filterMap {xs : Vector α n} {f : α → Option β} {p : β → Bool} :
-    (xs.filterMap f).any p = xs.any fun a => match f a with | some b => p b | none => false := by
+@[deprecated "Deprecated without replacement; `filterMap` is not part of the `Vector` API." (since := "2025-05-09")]
+theorem any_filterMap {xs : Vector α n} {f : α → Option β} {p : β → Bool} :
+    (xs.toArray.filterMap f).any p = xs.any fun a => match f a with | some b => p b | none => false := by
   rcases xs with ⟨xs, rfl⟩
   simp
   rfl
 
-@[simp] theorem all_filterMap {xs : Vector α n} {f : α → Option β} {p : β → Bool} :
-    (xs.filterMap f).all p = xs.all fun a => match f a with | some b => p b | none => true := by
+@[deprecated "Deprecated without replacement; `filterMap` is not part of the `Vector` API." (since := "2025-05-09")]
+theorem all_filterMap {xs : Vector α n} {f : α → Option β} {p : β → Bool} :
+    (xs.toArray.filterMap f).all p = xs.all fun a => match f a with | some b => p b | none => true := by
   rcases xs with ⟨xs, rfl⟩
   simp
   rfl
@@ -3051,7 +3059,7 @@ set_option linter.indexVariables false in
   ext i
   by_cases h : i < n
   · simp [h]
-  · replace h : i = xs.size - 1 := by rw [size_toArray]; omega
+  · replace h : i = n := by omega
     subst h
     simp [back]
 
@@ -3082,7 +3090,7 @@ set_option linter.indexVariables false in
 
 /-! ### swap -/
 
-theorem getElem_swap {xs : Vector α n} {i j : Nat} (hi hj) {k : Nat} (hk : k < n) :
+@[grind] theorem getElem_swap {xs : Vector α n} {i j : Nat} (hi hj) {k : Nat} (hk : k < n) :
     (xs.swap i j hi hj)[k] = if k = i then xs[j] else if k = j then xs[i] else xs[k] := by
   cases xs
   simp_all [Array.getElem_swap]
@@ -3099,6 +3107,13 @@ theorem getElem_swap {xs : Vector α n} {i j : Nat} (hi hj) {k : Nat} (hk : k <
       (hi' : k ≠ i) (hj' : k ≠ j) : (xs.swap i j hi hj)[k] = xs[k] := by
   simp_all [getElem_swap]
 
+@[grind]
+theorem getElem?_swap {xs : Vector α n} {i j : Nat} (hi hj) {k : Nat} : (xs.swap i j hi hj)[k]? =
+    if j = k then some xs[i] else if i = k then some xs[j] else xs[k]? := by
+  rcases xs with ⟨xs, rfl⟩
+  simp [Array.getElem?_swap]
+
+
 @[simp] theorem swap_swap {xs : Vector α n} {i j : Nat} (hi hj) :
     (xs.swap i j hi hj).swap i j hi hj = xs := by
   cases xs
@@ -3112,14 +3127,14 @@ theorem swap_comm {xs : Vector α n} {i j : Nat} (hi hj) :
 
 /-! ### take -/
 
-@[simp] theorem getElem_take {xs : Vector α n} {j : Nat} (hi : i < min j n) :
+@[simp, grind =] theorem getElem_take {xs : Vector α n} {j : Nat} (hi : i < min j n) :
     (xs.take j)[i] = xs[i] := by
   cases xs
   simp
 
 /-! ### drop -/
 
-@[simp] theorem getElem_drop {xs : Vector α n} {j : Nat} (hi : i < n - j) :
+@[simp, grind =] theorem getElem_drop {xs : Vector α n} {j : Nat} (hi : i < n - j) :
     (xs.drop j)[i] = xs[j + i] := by
   cases xs
   simp

src/Init/Data/Vector/Lex.lean

@@ -18,8 +18,8 @@ namespace Vector
 
 /-! ### Lexicographic ordering -/
 
-@[simp] theorem lt_toArray [LT α] {xs ys : Vector α n} : xs.toArray < ys.toArray ↔ xs < ys := Iff.rfl
-@[simp] theorem le_toArray [LT α] {xs ys : Vector α n} : xs.toArray ≤ ys.toArray ↔ xs ≤ ys := Iff.rfl
+@[simp, grind =] theorem lt_toArray [LT α] {xs ys : Vector α n} : xs.toArray < ys.toArray ↔ xs < ys := Iff.rfl
+@[simp, grind =] theorem le_toArray [LT α] {xs ys : Vector α n} : xs.toArray ≤ ys.toArray ↔ xs ≤ ys := Iff.rfl
 
 @[simp] theorem lt_toList [LT α] {xs ys : Vector α n} : xs.toList < ys.toList ↔ xs < ys := Iff.rfl
 @[simp] theorem le_toList [LT α] {xs ys : Vector α n} : xs.toList ≤ ys.toList ↔ xs ≤ ys := Iff.rfl
@@ -40,7 +40,7 @@ protected theorem not_le_iff_gt [DecidableEq α] [LT α] [DecidableLT α] {xs ys
   simp [Vector.lex, Array.lex, n₁, n₂]
   rfl
 
-@[simp] theorem lex_toArray [BEq α] {lt : α → α → Bool} {xs ys : Vector α n} :
+@[simp, grind =] theorem lex_toArray [BEq α] {lt : α → α → Bool} {xs ys : Vector α n} :
     xs.toArray.lex ys.toArray lt = xs.lex ys lt := by
   cases xs
   cases ys

src/Init/Data/Vector/MapIdx.lean

@@ -134,7 +134,7 @@ theorem mapFinIdx_append {xs : Vector α n} {ys : Vector α m} {f : (i : Nat)
 @[simp]
 theorem mapFinIdx_push {xs : Vector α n} {a : α} {f : (i : Nat) → α → (h : i < n + 1) → β} :
     mapFinIdx (xs.push a) f =
-      (mapFinIdx xs (fun i a h => f i a (by omega))).push (f xs.size a (by simp)) := by
+      (mapFinIdx xs (fun i a h => f i a (by omega))).push (f n a (by simp)) := by
   simp [← append_singleton, mapFinIdx_append]
 
 theorem mapFinIdx_singleton {a : α} {f : (i : Nat) → α → (h : i < 1) → β} :
@@ -255,14 +255,14 @@ theorem mapIdx_eq_zipIdx_map {xs : Vector α n} {f : Nat → α → β} :
 abbrev mapIdx_eq_zipWithIndex_map := @mapIdx_eq_zipIdx_map
 
 theorem mapIdx_append {xs : Vector α n} {ys : Vector α m} :
-    (xs ++ ys).mapIdx f = xs.mapIdx f ++ ys.mapIdx fun i => f (i + xs.size) := by
+    (xs ++ ys).mapIdx f = xs.mapIdx f ++ ys.mapIdx fun i => f (i + n) := by
   rcases xs with ⟨xs, rfl⟩
   rcases ys with ⟨ys, rfl⟩
   simp [Array.mapIdx_append]
 
 @[simp]
 theorem mapIdx_push {xs : Vector α n} {a : α} :
-    mapIdx f (xs.push a) = (mapIdx f xs).push (f xs.size a) := by
+    mapIdx f (xs.push a) = (mapIdx f xs).push (f n a) := by
   simp [← append_singleton, mapIdx_append]
 
 theorem mapIdx_singleton {a : α} : mapIdx f #v[a] = #v[f 0 a] := by
@@ -284,7 +284,7 @@ theorem exists_of_mem_mapIdx {b : β} {xs : Vector α n}
 
 theorem mapIdx_eq_push_iff {xs : Vector α (n + 1)} {b : β} :
     mapIdx f xs = ys.push b ↔
-      ∃ (a : α) (zs : Vector α n), xs = zs.push a ∧ mapIdx f zs = ys ∧ f zs.size a = b := by
+      ∃ (a : α) (zs : Vector α n), xs = zs.push a ∧ mapIdx f zs = ys ∧ f n a = b := by
   rw [mapIdx_eq_mapFinIdx, mapFinIdx_eq_push_iff]
   simp only [mapFinIdx_eq_mapIdx, exists_and_left, exists_prop]
   constructor
@@ -302,7 +302,7 @@ theorem mapIdx_eq_append_iff {xs : Vector α (n + m)} {f : Nat → α → β} {y
     mapIdx f xs = ys ++ zs ↔
       ∃ (ys' : Vector α n) (zs' : Vector α m), xs = ys' ++ zs' ∧
         ys'.mapIdx f = ys ∧
-        zs'.mapIdx (fun i => f (i + ys'.size)) = zs := by
+        zs'.mapIdx (fun i => f (i + n)) = zs := by
   rcases xs with ⟨xs, h⟩
   rcases ys with ⟨ys, rfl⟩
   rcases zs with ⟨zs, rfl⟩
@@ -342,12 +342,12 @@ theorem mapIdx_eq_mapIdx_iff {xs : Vector α n} :
   simp
 
 @[simp] theorem back?_mapIdx {xs : Vector α n} {f : Nat → α → β} :
-    (mapIdx f xs).back? = (xs.back?).map (f (xs.size - 1)) := by
+    (mapIdx f xs).back? = (xs.back?).map (f (n - 1)) := by
   rcases xs with ⟨xs, rfl⟩
   simp
 
 @[simp] theorem back_mapIdx [NeZero n] {xs : Vector α n} {f : Nat → α → β} :
-    (mapIdx f xs).back = f (xs.size - 1) (xs.back) := by
+    (mapIdx f xs).back = f (n - 1) (xs.back) := by
   rcases xs with ⟨xs, rfl⟩
   simp
 
@@ -364,7 +364,7 @@ theorem mapIdx_eq_replicate_iff {xs : Vector α n} {f : Nat → α → β} {b :
 abbrev mapIdx_eq_mkVector_iff := @mapIdx_eq_replicate_iff
 
 @[simp] theorem mapIdx_reverse {xs : Vector α n} {f : Nat → α → β} :
-    xs.reverse.mapIdx f = (mapIdx (fun i => f (xs.size - 1 - i)) xs).reverse := by
+    xs.reverse.mapIdx f = (mapIdx (fun i => f (n - 1 - i)) xs).reverse := by
   rcases xs with ⟨xs, rfl⟩
   simp [Array.mapIdx_reverse]
 

src/Init/Data/Vector/Monadic.lean

@@ -70,32 +70,6 @@ theorem foldrM_map [Monad m] [LawfulMonad m] {f : β₁ → β₂} {g : β₂
   rcases xs with ⟨xs, rfl⟩
   simp [Array.foldrM_map]
 
-theorem foldlM_filterMap [Monad m] [LawfulMonad m] {f : α → Option β} {g : γ → β → m γ} {xs : Vector α n} {init : γ} :
-    (xs.filterMap f).foldlM g init =
-      xs.foldlM (fun x y => match f y with | some b => g x b | none => pure x) init := by
-  rcases xs with ⟨xs, rfl⟩
-  simp [Array.foldlM_filterMap]
-  rfl
-
-theorem foldrM_filterMap [Monad m] [LawfulMonad m] {f : α → Option β} {g : β → γ → m γ} {xs : Vector α n} {init : γ} :
-    (xs.filterMap f).foldrM g init =
-      xs.foldrM (fun x y => match f x with | some b => g b y | none => pure y) init := by
-  rcases xs with ⟨xs, rfl⟩
-  simp [Array.foldrM_filterMap]
-  rfl
-
-theorem foldlM_filter [Monad m] [LawfulMonad m] {p : α → Bool} {g : β → α → m β} {xs : Vector α n} {init : β} :
-    (xs.filter p).foldlM g init =
-      xs.foldlM (fun x y => if p y then g x y else pure x) init := by
-  rcases xs with ⟨xs, rfl⟩
-  simp [Array.foldlM_filter]
-
-theorem foldrM_filter [Monad m] [LawfulMonad m] {p : α → Bool} {g : α → β → m β} {xs : Vector α n} {init : β} :
-    (xs.filter p).foldrM g init =
-      xs.foldrM (fun x y => if p x then g x y else pure y) init := by
-  rcases xs with ⟨xs, rfl⟩
-  simp [Array.foldrM_filter]
-
 @[simp] theorem foldlM_attachWith [Monad m]
     {xs : Vector α n} {q : α → Prop} (H : ∀ a, a ∈ xs → q a) {f : β → { x // q x} → m β} {b} :
     (xs.attachWith q H).foldlM f b = xs.attach.foldlM (fun b ⟨a, h⟩ => f b ⟨a, H _ h⟩) b := by

src/Init/Data/Vector/Range.lean

@@ -140,7 +140,7 @@ theorem range_add {n m : Nat} : range (n + m) = range n ++ (range m).map (n + ·
   simpa [range_eq_range', Nat.add_comm] using (range'_append_1 (s := 0)).symm
 
 theorem reverse_range' {s n : Nat} : reverse (range' s n) = map (s + n - 1 - ·) (range n) := by
-  simp [← toList_inj, List.reverse_range']
+  simp [← toArray_inj, Array.reverse_range']
 
 @[simp]
 theorem mem_range {m n : Nat} : m ∈ range n ↔ m < n := by

src/Init/Data/Vector/Zip.lean

@@ -243,7 +243,7 @@ theorem map_prod_right_eq_zip {xs : Vector α n} {f : α → β} :
 
 theorem zip_eq_append_iff {as : Vector α (n + m)} {bs : Vector β (n + m)} {xs : Vector (α × β) n} {ys : Vector (α × β) m} :
     zip as bs = xs ++ ys ↔
-      ∃ as₁ as₂ bs₁ bs₂, as₁.size = bs₁.size ∧ as = as₁ ++ as₂ ∧ bs = bs₁ ++ bs₂ ∧ xs = zip as₁ bs₁ ∧ ys = zip as₂ bs₂ := by
+      ∃ as₁ as₂ bs₁ bs₂, as = as₁ ++ as₂ ∧ bs = bs₁ ++ bs₂ ∧ xs = zip as₁ bs₁ ∧ ys = zip as₂ bs₂ := by
   simp [zip_eq_zipWith, zipWith_eq_append_iff]
 
 @[simp] theorem zip_replicate {a : α} {b : β} {n : Nat} :

src/Init/Ext.lean

@@ -81,7 +81,6 @@ end Lean
 
 attribute [ext] Prod PProd Sigma PSigma
 attribute [ext] funext propext Subtype.eq Array.ext
-attribute [grind ext] Array.ext
 
 @[ext] protected theorem PUnit.ext (x y : PUnit) : x = y := rfl
 protected theorem Unit.ext (x y : Unit) : x = y := rfl

src/Init/Notation.lean

@@ -621,9 +621,6 @@ This is the same as `#eval show MetaM Unit from do discard doSeq`.
 -/
 syntax (name := runMeta) "run_meta " doSeq : command
 
-set_option linter.missingDocs false in
-syntax guardMsgsFilterSeverity := &"info" <|> &"warning" <|> &"error" <|> &"all"
-
 /--
 `#reduce <expression>` reduces the expression `<expression>` to its normal form. This
 involves applying reduction rules until no further reduction is possible.
@@ -640,15 +637,27 @@ of expressions.
 -/
 syntax (name := reduceCmd) "#reduce " (atomic("(" &"proofs" " := " &"true" ")"))? (atomic("(" &"types" " := " &"true" ")"))? term : command
 
+set_option linter.missingDocs false in
+syntax guardMsgsFilterAction := &"check" <|> &"drop" <|> &"pass"
+
+set_option linter.missingDocs false in
+syntax guardMsgsFilterSeverity := &"trace" <|> &"info" <|> &"warning" <|> &"error" <|> &"all"
+
 /--
 A message filter specification for `#guard_msgs`.
-- `info`, `warning`, `error`: capture messages with the given severity level.
-- `all`: capture all messages (the default).
-- `drop info`, `drop warning`, `drop error`: drop messages with the given severity level.
-- `drop all`: drop every message.
-These filters are processed in left-to-right order.
+- `info`, `warning`, `error`: capture (non-trace) messages with the given severity level.
+- `trace`: captures trace messages
+- `all`: capture all messages.
+
+The filters can be prefixed with
+- `check` (the default): capture and check the message
+- `drop`: drop the message
+- `pass`: let the message pass through
+
+If no filter is specified, `check all` is assumed.  Otherwise, these filters are processed in
+left-to-right order, with an implicit `pass all` at the end.
 -/
-syntax guardMsgsFilter := &"drop"? guardMsgsFilterSeverity
+syntax guardMsgsFilter := guardMsgsFilterAction ? guardMsgsFilterSeverity
 
 set_option linter.missingDocs false in
 syntax guardMsgsWhitespaceArg := &"exact" <|> &"normalized" <|> &"lax"
@@ -719,13 +728,20 @@ In general, `#guard_msgs` accepts a comma-separated list of configuration clause
 ```
 #guard_msgs (configElt,*) in cmd
 ```
-By default, the configuration list is `(all, whitespace := normalized, ordering := exact)`.
+By default, the configuration list is `(check all, whitespace := normalized, ordering := exact)`.
 
-Message filters (processed in left-to-right order):
-- `info`, `warning`, `error`: capture messages with the given severity level.
-- `all`: capture all messages (the default).
-- `drop info`, `drop warning`, `drop error`: drop messages with the given severity level.
-- `drop all`: drop every message.
+Message filters select messages by severity:
+- `info`, `warning`, `error`: (non-trace) messages with the given severity level.
+- `trace`: trace messages
+- `all`: all messages.
+
+The filters can be prefixed with the action to take:
+- `check` (the default): capture and check the message
+- `drop`: drop the message
+- `pass`: let the message pass through
+
+If no filter is specified, `check all` is assumed.  Otherwise, these filters are processed in
+left-to-right order, with an implicit `pass all` at the end.
 
 Whitespace handling (after trimming leading and trailing whitespace):
 - `whitespace := exact` requires an exact whitespace match.

src/Lean/AddDecl.lean

@@ -93,9 +93,13 @@ def addDecl (decl : Declaration) : CoreM Unit := do
   let mut exportedKind? := none
   let (name, info, kind) ← match decl with
     | .thmDecl thm =>
-      if (← getEnv).header.isModule && !isSimpleRflProof thm.value &&
-          -- TODO: this is horrible...
-          !looksLikeRelevantTheoremProofType thm.type then
+      let exportProof := !(← getEnv).header.isModule ||
+        -- We should preserve rfl theorems but also we should not override a decision to hide by the
+        -- MutualDef elaborator via `withoutExporting`
+        (← getEnv).isExporting && isSimpleRflProof thm.value ||
+        -- TODO: this is horrible...
+        looksLikeRelevantTheoremProofType thm.type
+      if !exportProof then
         exportedInfo? := some <| .axiomInfo { thm with isUnsafe := false }
         exportedKind? := some .axiom
       pure (thm.name, .thmInfo thm, .thm)

src/Lean/Compiler/IR.lean

@@ -22,6 +22,7 @@ import Lean.Compiler.IR.ElimDeadBranches
 import Lean.Compiler.IR.EmitC
 import Lean.Compiler.IR.CtorLayout
 import Lean.Compiler.IR.Sorry
+import Lean.Compiler.IR.ToIR
 
 -- The following imports are not required by the compiler. They are here to ensure that there
 -- are no orphaned modules.

src/Lean/Compiler/IR/ToIR.lean

@@ -0,0 +1,412 @@
+/-
+Copyright (c) 2024 Lean FRO, LLC. All rights reserved.
+Released under Apache 2.0 license as described in the file LICENSE.
+Authors: Cameron Zwarich
+-/
+prelude
+import Lean.Compiler.LCNF.Basic
+import Lean.Compiler.LCNF.CompilerM
+import Lean.Compiler.LCNF.PhaseExt
+import Lean.Compiler.IR.Basic
+import Lean.Compiler.IR.CompilerM
+import Lean.Compiler.IR.CtorLayout
+import Lean.CoreM
+import Lean.Environment
+
+namespace Lean.IR
+
+open Lean.Compiler (LCNF.AltCore LCNF.Arg LCNF.Code LCNF.Decl LCNF.DeclValue LCNF.LCtx LCNF.LetDecl
+                    LCNF.LetValue LCNF.LitValue LCNF.Param LCNF.getMonoDecl?)
+
+namespace ToIR
+
+inductive FVarClassification where
+  | var (id : VarId)
+  | joinPoint (id : JoinPointId)
+  | erased
+
+structure BuilderState where
+  fvars : Std.HashMap FVarId FVarClassification := {}
+  nextId : Nat := 1
+
+abbrev M := StateRefT BuilderState CoreM
+
+def M.run (x : M α) : CoreM α := do
+  x.run' {}
+
+def bindVar (fvarId : FVarId) : M VarId := do
+  modifyGet fun s =>
+    let varId := { idx := s.nextId }
+    ⟨varId, { s with fvars := s.fvars.insertIfNew fvarId (.var varId),
+                     nextId := s.nextId + 1 }⟩
+
+def bindVarToVarId (fvarId : FVarId) (varId : VarId) : M Unit := do
+  modify fun s => { s with fvars := s.fvars.insertIfNew fvarId (.var varId) }
+
+def newVar : M VarId := do
+  modifyGet fun s =>
+    let varId := { idx := s.nextId }
+    ⟨varId, { s with nextId := s.nextId + 1 }⟩
+
+def bindJoinPoint (fvarId : FVarId) : M JoinPointId := do
+  modifyGet fun s =>
+    let joinPointId := { idx := s.nextId }
+    ⟨joinPointId, { s with fvars := s.fvars.insertIfNew fvarId (.joinPoint joinPointId),
+                           nextId := s.nextId + 1 }⟩
+
+def bindErased (fvarId : FVarId) : M Unit := do
+  modify fun s => { s with fvars := s.fvars.insertIfNew fvarId .erased }
+
+def findDecl (n : Name) : M (Option Decl) :=
+  return findEnvDecl (← Lean.getEnv) n
+
+def addDecl (d : Decl) : M Unit :=
+  Lean.modifyEnv fun env => declMapExt.addEntry (env.addExtraName d.name) d
+
+def lowerLitValue (v : LCNF.LitValue) : LitVal :=
+  match v with
+  | .natVal n => .num n
+  | .strVal s => .str s
+
+-- TODO: This should be cached.
+def lowerEnumToScalarType (name : Name) : M (Option IRType) := do
+  let env ← Lean.getEnv
+  let some (.inductInfo inductiveVal) := env.find? name | return none
+  let ctorNames := inductiveVal.ctors
+  let numCtors := ctorNames.length
+  for ctorName in ctorNames do
+    let some (.ctorInfo ctorVal) := env.find? ctorName | panic! "expected valid constructor name"
+    if ctorVal.type.isForall then return none
+  return if numCtors == 1 then
+    none
+  else if numCtors < Nat.pow 2 8 then
+    some .uint8
+  else if numCtors < Nat.pow 2 16 then
+    some .uint16
+  else if numCtors < Nat.pow 2 32 then
+    some .uint32
+  else
+    none
+
+def lowerType (e : Lean.Expr) : M IRType := do
+  match e with
+  | .const name .. =>
+    match name with
+    | ``UInt8 | ``Bool => return .uint8
+    | ``UInt16 => return .uint16
+    | ``UInt32 => return .uint32
+    | ``UInt64 => return .uint64
+    | ``USize => return .usize
+    | ``Float => return .float
+    | ``Float32 => return .float32
+    | ``lcErased => return .irrelevant
+    | _ =>
+      if let some scalarType ← lowerEnumToScalarType name then
+        return scalarType
+      else
+        return .object
+  | .app f _ =>
+    if let .const name _ := f.headBeta then
+      if let some scalarType ← lowerEnumToScalarType name then
+        return scalarType
+      else
+        return .object
+    else
+      return .object
+  | .forallE .. => return .object
+  | _ => panic! "invalid type"
+
+-- TODO: This should be cached.
+def getCtorInfo (name : Name) : M (CtorInfo × (Array CtorFieldInfo)) := do
+  match getCtorLayout (← Lean.getEnv) name with
+  | .ok ctorLayout =>
+    return ⟨{
+      name,
+      cidx := ctorLayout.cidx,
+      size := ctorLayout.numObjs,
+      usize := ctorLayout.numUSize,
+      ssize := ctorLayout.scalarSize
+    }, ctorLayout.fieldInfo.toArray⟩
+  | .error .. => panic! "unrecognized constructor"
+
+def lowerArg (a : LCNF.Arg) : M Arg := do
+  match a with
+  | .fvar fvarId =>
+    match (← get).fvars[fvarId]? with
+    | some (.var varId) => return .var varId
+    | some .erased => return .irrelevant
+    | some (.joinPoint ..) | none => panic! "unexpected value"
+  | .erased | .type .. => return .irrelevant
+
+inductive TranslatedProj where
+  | expr (e : Expr)
+  | erased
+  deriving Inhabited
+
+def lowerProj (base : VarId) (ctorInfo : CtorInfo) (field : CtorFieldInfo)
+    : TranslatedProj × IRType :=
+  match field with
+  | .object i => ⟨.expr (.proj i base), .object⟩
+  | .usize i => ⟨.expr (.uproj i base), .usize⟩
+  | .scalar _ offset irType => ⟨.expr (.sproj (ctorInfo.size + ctorInfo.usize) offset base), irType⟩
+  | .irrelevant => ⟨.erased, .irrelevant⟩
+
+def lowerParam (p : LCNF.Param) : M Param := do
+  let x ← bindVar p.fvarId
+  let ty ← lowerType p.type
+  return { x, borrow := p.borrow, ty }
+
+mutual
+partial def lowerCode (c : LCNF.Code) : M FnBody := do
+  match c with
+  | .let decl k => lowerLet decl k
+  | .jp decl k =>
+    let joinPoint ← bindJoinPoint decl.fvarId
+    let params ← decl.params.mapM lowerParam
+    let body ← lowerCode decl.value
+    return .jdecl joinPoint params body (← lowerCode k)
+  | .jmp fvarId args =>
+    match (← get).fvars[fvarId]? with
+    | some (.joinPoint joinPointId) =>
+      return .jmp joinPointId (← args.mapM lowerArg)
+    | some (.var ..) | some .erased | none => panic! "unexpected value"
+  | .cases cases =>
+    match (← get).fvars[cases.discr]? with
+    | some (.var varId) =>
+      return .case cases.typeName
+                  varId
+                  (← lowerType cases.resultType)
+                  (← cases.alts.mapM (lowerAlt varId))
+    | some (.joinPoint ..) | some .erased | none => panic! "unexpected value"
+  | .return fvarId =>
+    let arg := match (← get).fvars[fvarId]? with
+    | some (.var varId) => .var varId
+    | some .erased => .irrelevant
+    | some (.joinPoint ..) | none => panic! "unexpected value"
+    return .ret arg
+  | .unreach .. => return .unreachable
+  | .fun .. => panic! "all local functions should be λ-lifted"
+
+partial def lowerLet (decl : LCNF.LetDecl) (k : LCNF.Code) : M FnBody := do
+  -- temporary fix: the old compiler inlines these too much as regular `let`s
+  let rec mkVar (v : VarId) : M FnBody := do
+    bindVarToVarId decl.fvarId v
+    lowerCode k
+  let rec mkExpr (e : Expr) : M FnBody := do
+    let var ← bindVar decl.fvarId
+    let type ← match e with
+    | .ctor .. | .pap .. | .proj .. => pure <| .object
+    | _ => lowerType decl.type
+    return .vdecl var type e (← lowerCode k)
+  let rec mkErased (_ : Unit) : M FnBody := do
+    bindErased decl.fvarId
+    lowerCode k
+  let rec mkPartialApp (e : Expr) (restArgs : Array Arg) : M FnBody := do
+    let var ← bindVar decl.fvarId
+    let tmpVar ← newVar
+    let type ← match e with
+    | .ctor .. | .pap .. | .proj .. => pure <| .object
+    | _ => lowerType decl.type
+    return .vdecl tmpVar .object e (.vdecl var type (.ap tmpVar restArgs) (← lowerCode k))
+  let rec tryIrDecl? (name : Name) (args : Array Arg) : M (Option FnBody) := do
+    if let some decl ← LCNF.getMonoDecl? name then
+      let numArgs := args.size
+      let numParams := decl.params.size
+      if numArgs < numParams then
+        return some (← mkExpr (.pap name args))
+      else if numArgs == numParams then
+        return some (← mkExpr (.fap name args))
+      else
+        let firstArgs := args.extract 0 numParams
+        let restArgs := args.extract numParams numArgs
+        return some (← mkPartialApp (.fap name firstArgs) restArgs)
+    else
+      return none
+
+  match decl.value with
+  | .value litValue =>
+    mkExpr (.lit (lowerLitValue litValue))
+  | .proj typeName i fvarId =>
+    match (← get).fvars[fvarId]? with
+    | some (.var varId) =>
+      -- TODO: have better pattern matching here
+      let some (.inductInfo { ctors, .. }) := (← Lean.getEnv).find? typeName
+        | panic! "projection of non-inductive type"
+      let ctorName := ctors[0]!
+      let ⟨ctorInfo, fields⟩ ← getCtorInfo ctorName
+      let ⟨result, type⟩ := lowerProj varId ctorInfo fields[i]!
+      match result with
+      | .expr e =>
+        let var ← bindVar decl.fvarId
+        return .vdecl var type e (← lowerCode k)
+      | .erased =>
+        bindErased decl.fvarId
+        lowerCode k
+    | some .erased =>
+      bindErased decl.fvarId
+      lowerCode k
+    | some (.joinPoint ..) | none => panic! "unexpected value"
+  | .const ``Nat.succ _ args =>
+    let irArgs ← args.mapM lowerArg
+    let var ← bindVar decl.fvarId
+    let tmpVar ← newVar
+    let k := (.vdecl var .object (.fap ``Nat.add #[irArgs[0]!, (.var tmpVar)]) (← lowerCode k))
+    return .vdecl tmpVar .object (.lit (.num 1)) k
+  | .const name _ args =>
+    let irArgs ← args.mapM lowerArg
+    if let some code ← tryIrDecl? name irArgs then
+      return code
+    else
+      let env ← Lean.getEnv
+      match env.find? name with
+      | some (.ctorInfo ctorVal) =>
+        if isExtern env name then
+          if let some code ← tryIrDecl? name irArgs then
+            return code
+          else
+            mkExpr (.fap name irArgs)
+        else
+          let ⟨ctorInfo, fields⟩ ← getCtorInfo name
+          let args := args.extract (start := ctorVal.numParams)
+          let objArgs : Array Arg ← do
+            let mut result : Array Arg := #[]
+            for i in [0:fields.size] do
+              match args[i]! with
+              | .fvar fvarId =>
+                if let some (.var varId) := (← get).fvars[fvarId]? then
+                  if fields[i]! matches .object .. then
+                    result := result.push (.var varId)
+              | .type _ | .erased =>
+                if fields[i]! matches .object .. then
+                  result := result.push .irrelevant
+            pure result
+          let objVar ← bindVar decl.fvarId
+          let rec lowerNonObjectFields (_ : Unit) : M FnBody :=
+            let rec loop (usizeCount : Nat) (i : Nat) : M FnBody := do
+              match args[i]? with
+              | some (.fvar fvarId) =>
+                match (← get).fvars[fvarId]? with
+                | some (.var varId) =>
+                  match fields[i]! with
+                  | .usize .. =>
+                    let k ← loop (usizeCount + 1) (i + 1)
+                    return .uset objVar (ctorInfo.size + usizeCount) varId k
+                  | .scalar _ offset argType =>
+                    let k ← loop usizeCount (i + 1)
+                    return .sset objVar (ctorInfo.size + ctorInfo.usize) offset varId argType k
+                  | .object .. | .irrelevant => loop usizeCount (i + 1)
+                | _ => loop usizeCount (i + 1)
+              | some (.type _) | some .erased => loop usizeCount (i + 1)
+              | none => lowerCode k
+            loop 0 0
+          return .vdecl objVar .object (.ctor ctorInfo objArgs) (← lowerNonObjectFields ())
+      | some (.axiomInfo ..) =>
+        if name == ``Quot.lcInv then
+          match irArgs[2]! with
+          | .var varId => mkVar varId
+          | .irrelevant => mkErased ()
+        else if name == ``lcUnreachable then
+          return .unreachable
+        else if let some irDecl ← findDecl name then
+          let numArgs := irArgs.size
+          let numParams := irDecl.params.size
+          if numArgs < numParams then
+            mkExpr (.pap name irArgs)
+          else if numArgs == numParams then
+            mkExpr (.fap name irArgs)
+          else
+            let firstArgs := irArgs.extract 0 numParams
+            let restArgs := irArgs.extract numParams irArgs.size
+            mkPartialApp (.fap name firstArgs) restArgs
+        else
+          throwError f!"axiom '{name}' not supported by code generator; consider marking definition as 'noncomputable'"
+      | some (.quotInfo ..) =>
+        if name == ``Quot.mk then
+          match irArgs[2]! with
+          | .var varId => mkVar varId
+          | .irrelevant => mkErased ()
+        else
+          throwError f!"quot {name} unsupported by code generator"
+      | some (.defnInfo ..) | some (.opaqueInfo ..) =>
+        if let some code ← tryIrDecl? name irArgs then
+          return code
+        else
+          mkExpr (.fap name irArgs)
+      | some (.recInfo ..) =>
+        throwError f!"code generator does not support recursor '{name}' yet, consider using 'match ... with' and/or structural recursion"
+      | some (.inductInfo ..) => panic! "induct unsupported by code generator"
+      | some (.thmInfo ..) => panic! "thm unsupported by code generator"
+      | none => panic! "reference to unbound name"
+  | .fvar fvarId args =>
+    match (← get).fvars[fvarId]? with
+    | some (.var id) =>
+      let irArgs ← args.mapM lowerArg
+      mkExpr (.ap id irArgs)
+    | some .erased => mkErased ()
+    | some (.joinPoint ..) | none => panic! "unexpected value"
+  | .erased => mkErased ()
+
+partial def lowerAlt (discr : VarId) (a : LCNF.AltCore LCNF.Code) : M (AltCore FnBody) := do
+  match a with
+  | .alt ctorName params code =>
+    let ⟨ctorInfo, fields⟩ ← getCtorInfo ctorName
+    let lowerParams (params : Array LCNF.Param) (fields : Array CtorFieldInfo) : M FnBody := do
+      let rec loop (i : Nat) : M FnBody := do
+        match params[i]?, fields[i]? with
+        | some param, some field =>
+          let ⟨result, type⟩ := lowerProj discr ctorInfo field
+          match result with
+          | .expr e =>
+            return .vdecl (← bindVar param.fvarId)
+                          type
+                          e
+                          (← loop (i + 1))
+          | .erased =>
+            bindErased param.fvarId
+            loop (i + 1)
+        | none, none => lowerCode code
+        | _, _ => panic! "mismatched fields and params"
+      loop 0
+    let body ← lowerParams params fields
+    return .ctor ctorInfo body
+  | .default code =>
+    return .default (← lowerCode code)
+end
+
+def lowerResultType (type : Lean.Expr) (arity : Nat) : M IRType :=
+  lowerType (resultTypeForArity type arity)
+where resultTypeForArity (type : Lean.Expr) (arity : Nat) : Lean.Expr :=
+  if arity == 0 then
+    type
+  else
+    match type with
+    | .forallE _ _ b _ => resultTypeForArity b (arity - 1)
+    | .const ``lcErased _ => mkConst ``lcErased
+    | _ => panic! "invalid arity"
+
+def lowerDecl (d : LCNF.Decl) : M (Option Decl) := do
+  let params ← d.params.mapM lowerParam
+  let resultType ← lowerResultType d.type d.params.size
+  match d.value with
+  | .code code =>
+    let body ← lowerCode code
+    pure <| some <| .fdecl d.name params resultType body {}
+  | .extern externAttrData =>
+    if externAttrData.entries.isEmpty then
+      -- TODO: This matches the behavior of the old compiler, but we should
+      -- find a better way to handle this.
+      addDecl (mkDummyExternDecl d.name params resultType)
+      pure <| none
+    else
+      pure <| some <| .extern d.name params resultType externAttrData
+
+end ToIR
+
+def toIR (decls: Array LCNF.Decl) : CoreM (Array Decl) := do
+  let mut irDecls := #[]
+  for decl in decls do
+    if let some irDecl ← ToIR.lowerDecl decl |>.run then
+      irDecls := irDecls.push irDecl
+  return irDecls
+
+end Lean.IR

src/Lean/Compiler/LCNF/Closure.lean

@@ -29,6 +29,10 @@ structure Context where
   Remark: the lambda lifting pass abstracts all `let`/`fun`-declarations.
   -/
   abstract : FVarId → Bool
+  /--
+  Indicates whether we are processing terms beneath a binder.
+  -/
+  isUnderBinder : Bool
 
 /--
 State for the `ClosureM` monad.
@@ -93,7 +97,11 @@ mutual
   -/
   partial def collectCode (c : Code) : ClosureM Unit := do
     match c with
-    | .let decl k => collectType decl.type; collectLetValue decl.value; collectCode k
+    | .let decl k =>
+      collectType decl.type
+      withReader (fun ctx => { ctx with isUnderBinder := ctx.isUnderBinder || decl.type.isForall })
+        do collectLetValue decl.value
+      collectCode k
     | .fun decl k | .jp decl k => collectFunDecl decl; collectCode k
     | .cases c =>
       collectType c.resultType
@@ -110,7 +118,8 @@ mutual
   partial def collectFunDecl (decl : FunDecl) : ClosureM Unit := do
     collectType decl.type
     collectParams decl.params
-    collectCode decl.value
+    withReader (fun ctx => { ctx with isUnderBinder := true }) do
+      collectCode decl.value
 
   /--
   Process the given free variable.
@@ -119,10 +128,11 @@ mutual
   partial def collectFVar (fvarId : FVarId) : ClosureM Unit := do
     unless (← get).visited.contains fvarId do
       markVisited fvarId
-      if (← read).inScope fvarId then
+      let ctx ← read
+      if ctx.inScope fvarId then
         /- We only collect the variables in the scope of the function application being specialized. -/
         if let some funDecl ← findFunDecl? fvarId then
-          if (← read).abstract funDecl.fvarId then
+          if ctx.isUnderBinder || ctx.abstract funDecl.fvarId then
             modify fun s => { s with params := s.params.push <| { funDecl with borrow := false } }
           else
             collectFunDecl funDecl
@@ -132,7 +142,7 @@ mutual
           modify fun s => { s with params := s.params.push param }
         else if let some letDecl ← findLetDecl? fvarId then
           collectType letDecl.type
-          if (← read).abstract letDecl.fvarId then
+          if ctx.isUnderBinder || ctx.abstract letDecl.fvarId then
             modify fun s => { s with params := s.params.push <| { letDecl with borrow := false } }
           else
             collectLetValue letDecl.value
@@ -147,9 +157,16 @@ mutual
 end
 
 def run (x : ClosureM α) (inScope : FVarId → Bool) (abstract : FVarId → Bool := fun _ => true) : CompilerM (α × Array Param × Array CodeDecl) := do
-  let (a, s) ← x { inScope, abstract } |>.run {}
-  return (a, s.params, s.decls)
+  let (a, s) ← x { inScope, abstract, isUnderBinder := false } |>.run {}
+  -- If we've abstracted an fvar into a param, exclude its definition. Note that this still allows
+  -- for other decls the removed decl depends upon to be included, but they will be removed later
+  -- for having no users.
+  let mut paramFVars : FVarIdSet := {}
+  for param in s.params do
+    paramFVars := paramFVars.insert param.fvarId
+  let filteredDecls := s.decls.filter fun decl => !(paramFVars.contains decl.fvarId)
+  return (a, s.params, filteredDecls)
 
 end Closure
 
-end Lean.Compiler.LCNF
+end Lean.Compiler.LCNF

src/Lean/Compiler/LCNF/Main.lean

@@ -6,6 +6,10 @@ Authors: Leonardo de Moura
 prelude
 import Lean.Compiler.Options
 import Lean.Compiler.ExternAttr
+import Lean.Compiler.IR
+import Lean.Compiler.IR.Basic
+import Lean.Compiler.IR.Checker
+import Lean.Compiler.IR.ToIR
 import Lean.Compiler.LCNF.PassManager
 import Lean.Compiler.LCNF.Passes
 import Lean.Compiler.LCNF.PrettyPrinter
@@ -62,7 +66,7 @@ def checkpoint (stepName : Name) (decls : Array Decl) : CompilerM Unit := do
 
 namespace PassManager
 
-def run (declNames : Array Name) : CompilerM (Array Decl) := withAtLeastMaxRecDepth 8192 do
+def run (declNames : Array Name) : CompilerM (Array IR.Decl) := withAtLeastMaxRecDepth 8192 do
   /-
   Note: we need to increase the recursion depth because we currently do to save phase1
   declarations in .olean files. Then, we have to recursively compile all dependencies,
@@ -83,11 +87,25 @@ def run (declNames : Array Name) : CompilerM (Array Decl) := withAtLeastMaxRecDe
       -- We display the declaration saved in the environment because the names have been normalized
       let some decl' ← getDeclAt? decl.name .mono | unreachable!
       Lean.addTrace `Compiler.result m!"size: {decl.size}\n{← ppDecl' decl'}"
-  return decls
+  let opts ← getOptions
+  -- If the new compiler is disabled, then all of the saved IR was built with the old compiler,
+  -- which causes IR type mismatches with IR generated by the new compiler.
+  if !(compiler.enableNew.get opts) then
+    return #[]
+  let irDecls ← IR.toIR decls
+  let env ← getEnv
+  let ⟨log, res⟩ := IR.compile env opts irDecls
+  for msg in log do
+    addTrace `Compiler.IR m!"{msg}"
+  match res with
+  | .ok env =>
+    setEnv env
+    return irDecls
+  | .error s => throwError s
 
 end PassManager
 
-def compile (declNames : Array Name) : CoreM (Array Decl) :=
+def compile (declNames : Array Name) : CoreM (Array IR.Decl) :=
   CompilerM.run <| PassManager.run declNames
 
 def showDecl (phase : Phase) (declName : Name) : CoreM Format := do

src/Lean/Compiler/LCNF/Util.lean

@@ -77,7 +77,7 @@ def getCtorArity? (declName : Name) : CoreM (Option Nat) := do
 /--
 List of types that have builtin runtime support
 -/
-def builtinRuntimeTypes : List Name := [
+def builtinRuntimeTypes : Array Name := #[
   ``String,
   ``UInt8, ``UInt16, ``UInt32, ``UInt64, ``USize,
   ``Float, ``Float32,

src/Lean/CoreM.lean

@@ -612,20 +612,21 @@ where doCompile := do
     return
   let opts ← getOptions
   if compiler.enableNew.get opts then
-    compileDeclsNew decls
-
-  let res ← withTraceNode `compiler (fun _ => return m!"compiling old: {decls}") do
-    return compileDeclsOld (← getEnv) opts decls
-  match res with
-  | Except.ok env   => setEnv env
-  | Except.error (.other msg) =>
-    if logErrors then
-      if let some decl := ref? then
-        checkUnsupported decl -- Generate nicer error message for unsupported recursors and axioms
-      throwError msg
-  | Except.error ex =>
-    if logErrors then
-      throwKernelException ex
+    try compileDeclsNew decls catch e =>
+      if logErrors then throw e else return ()
+  else
+    let res ← withTraceNode `compiler (fun _ => return m!"compiling old: {decls}") do
+      return compileDeclsOld (← getEnv) opts decls
+    match res with
+    | Except.ok env   => setEnv env
+    | Except.error (.other msg) =>
+      if logErrors then
+        if let some decl := ref? then
+          checkUnsupported decl -- Generate nicer error message for unsupported recursors and axioms
+        throwError msg
+    | Except.error ex =>
+      if logErrors then
+        throwKernelException ex
 
 def compileDecl (decl : Declaration) (logErrors := true) : CoreM Unit := do
   compileDecls (Compiler.getDeclNamesForCodeGen decl) decl logErrors

src/Lean/Data/Json/FromToJson.lean

@@ -47,54 +47,97 @@ instance : ToJson String := ⟨fun s => s⟩
 instance : FromJson System.FilePath := ⟨fun j => System.FilePath.mk <$> Json.getStr? j⟩
 instance : ToJson System.FilePath := ⟨fun p => p.toString⟩
 
-instance [FromJson α] : FromJson (Array α) where
-  fromJson?
-    | Json.arr a => a.mapM fromJson?
-    | j          => throw s!"expected JSON array, got '{j}'"
+protected def _root_.Array.fromJson? [FromJson α] : Json → Except String (Array α)
+  | Json.arr a => a.mapM fromJson?
+  | j          => throw s!"expected JSON array, got '{j}'"
 
-instance [ToJson α] : ToJson (Array α) :=
-  ⟨fun a => Json.arr (a.map toJson)⟩
+instance [FromJson α] : FromJson (Array α) where
+  fromJson? := Array.fromJson?
+
+protected def _root_.Array.toJson [ToJson α] (a : Array α) : Json :=
+  Json.arr (a.map toJson)
+
+instance [ToJson α] : ToJson (Array α) where
+  toJson := Array.toJson
+
+protected def _root_.List.fromJson? [FromJson α] (j : Json) : Except String (List α) :=
+  (fromJson? j (α := Array α)).map Array.toList
 
 instance [FromJson α] : FromJson (List α) where
-  fromJson? j := (fromJson? j (α := Array α)).map Array.toList
+  fromJson? := List.fromJson?
+
+protected def _root_.List.toJson [ToJson α] (a : List α) : Json :=
+  toJson a.toArray
 
 instance [ToJson α] : ToJson (List α) where
-  toJson xs := toJson xs.toArray
+  toJson := List.toJson
+
+protected def _root_.Option.fromJson? [FromJson α] : Json → Except String (Option α)
+  | Json.null => Except.ok none
+  | j         => some <$> fromJson? j
 
 instance [FromJson α] : FromJson (Option α) where
-  fromJson?
-    | Json.null => Except.ok none
-    | j         => some <$> fromJson? j
+  fromJson? := Option.fromJson?
 
-instance [ToJson α] : ToJson (Option α) :=
-  ⟨fun
-    | none   => Json.null
-    | some a => toJson a⟩
+protected def _root_.Option.toJson [ToJson α] : Option α → Json
+  | none   => Json.null
+  | some a => toJson a
+
+instance [ToJson α] : ToJson (Option α) where
+  toJson := Option.toJson
+
+protected def _root_.Prod.fromJson? {α : Type u} {β : Type v} [FromJson α] [FromJson β] : Json → Except String (α × β)
+  | Json.arr #[ja, jb] => do
+    let ⟨a⟩ : ULift.{v} α := ← (fromJson? ja).map ULift.up
+    let ⟨b⟩ : ULift.{u} β := ← (fromJson? jb).map ULift.up
+    return (a, b)
+  | j => throw s!"expected pair, got '{j}'"
 
 instance {α : Type u} {β : Type v} [FromJson α] [FromJson β] : FromJson (α × β) where
-  fromJson?
-    | Json.arr #[ja, jb] => do
-      let ⟨a⟩ : ULift.{v} α := ← (fromJson? ja).map ULift.up
-      let ⟨b⟩ : ULift.{u} β := ← (fromJson? jb).map ULift.up
-      return (a, b)
-    | j => throw s!"expected pair, got '{j}'"
+  fromJson? := Prod.fromJson?
+
+protected def _root_.Prod.toJson [ToJson α] [ToJson β] : α × β → Json
+  | (a, b) => Json.arr #[toJson a, toJson b]
 
 instance [ToJson α] [ToJson β] : ToJson (α × β) where
-  toJson := fun (a, b) => Json.arr #[toJson a, toJson b]
+  toJson := Prod.toJson
+
+protected def Name.fromJson? (j : Json) : Except String Name := do
+  let s ← j.getStr?
+  if s == "[anonymous]" then
+    return Name.anonymous
+  else
+    let n := s.toName
+    if n.isAnonymous then throw s!"expected a `Name`, got '{j}'"
+    return n
 
 instance : FromJson Name where
-  fromJson? j := do
-    let s ← j.getStr?
-    if s == "[anonymous]" then
-      return Name.anonymous
-    else
-      let n := s.toName
-      if n.isAnonymous then throw s!"expected a `Name`, got '{j}'"
-      return n
+  fromJson? := Name.fromJson?
 
 instance : ToJson Name where
   toJson n := toString n
 
+protected def NameMap.fromJson? [FromJson α] : Json → Except String (NameMap α)
+  | .obj obj => obj.foldM (init := {}) fun m k v => do
+    if k == "[anonymous]" then
+      return m.insert .anonymous (← fromJson? v)
+    else
+      let n := k.toName
+      if n.isAnonymous then
+        throw s!"expected a `Name`, got '{k}'"
+      else
+        return m.insert n (← fromJson? v)
+  | j => throw s!"expected a `NameMap`, got '{j}'"
+
+instance [FromJson α] : FromJson (NameMap α) where
+  fromJson? := NameMap.fromJson?
+
+protected def NameMap.toJson [ToJson α] (m : NameMap α) : Json :=
+  Json.obj <| m.fold (fun n k v => n.insert compare k.toString (toJson v)) .leaf
+
+instance [ToJson α] : ToJson (NameMap α) where
+  toJson := NameMap.toJson
+
 /-- Note that `USize`s and `UInt64`s are stored as strings because JavaScript
 cannot represent 64-bit numbers. -/
 def bignumFromJson? (j : Json) : Except String Nat := do
@@ -106,58 +149,77 @@ def bignumFromJson? (j : Json) : Except String Nat := do
 def bignumToJson (n : Nat) : Json :=
   toString n
 
+protected def _root_.USize.fromJson? (j : Json) : Except String USize := do
+  let n ← bignumFromJson? j
+  if n ≥ USize.size then
+    throw "value '{j}' is too large for `USize`"
+  return USize.ofNat n
+
 instance : FromJson USize where
-  fromJson? j := do
-    let n ← bignumFromJson? j
-    if n ≥ USize.size then
-      throw "value '{j}' is too large for `USize`"
-    return USize.ofNat n
+  fromJson? := USize.fromJson?
 
 instance : ToJson USize where
   toJson v := bignumToJson (USize.toNat v)
 
+protected def _root_.UInt64.fromJson? (j : Json) : Except String UInt64 := do
+  let n ← bignumFromJson? j
+  if n ≥ UInt64.size then
+    throw "value '{j}' is too large for `UInt64`"
+  return UInt64.ofNat n
+
 instance : FromJson UInt64 where
-  fromJson? j := do
-    let n ← bignumFromJson? j
-    if n ≥ UInt64.size then
-      throw "value '{j}' is too large for `UInt64`"
-    return UInt64.ofNat n
+  fromJson? := UInt64.fromJson?
 
 instance : ToJson UInt64 where
   toJson v := bignumToJson (UInt64.toNat v)
 
+protected def _root_.Float.toJson (x : Float) : Json :=
+  match JsonNumber.fromFloat? x with
+  | Sum.inl e => Json.str e
+  | Sum.inr n => Json.num n
+
 instance : ToJson Float where
-  toJson x :=
-    match JsonNumber.fromFloat? x with
-    | Sum.inl e => Json.str e
-    | Sum.inr n => Json.num n
+  toJson := Float.toJson
+
+protected def _root_.Float.fromJson? : Json → Except String Float
+  | (Json.str "Infinity") => Except.ok (1.0 / 0.0)
+  | (Json.str "-Infinity") => Except.ok (-1.0 / 0.0)
+  | (Json.str "NaN") => Except.ok (0.0 / 0.0)
+  | (Json.num jn) => Except.ok jn.toFloat
+  | _ => Except.error "Expected a number or a string 'Infinity', '-Infinity', 'NaN'."
 
 instance : FromJson Float where
-  fromJson? := fun
-    | (Json.str "Infinity") => Except.ok (1.0 / 0.0)
-    | (Json.str "-Infinity") => Except.ok (-1.0 / 0.0)
-    | (Json.str "NaN") => Except.ok (0.0 / 0.0)
-    | (Json.num jn) => Except.ok jn.toFloat
-    | _ => Except.error "Expected a number or a string 'Infinity', '-Infinity', 'NaN'."
+  fromJson? := Float.fromJson?
+
+protected def RBMap.toJson [ToJson α] (m : RBMap String α cmp) : Json :=
+  Json.obj <| RBNode.map (fun _ => toJson) <| m.val
 
 instance [ToJson α] : ToJson (RBMap String α cmp) where
-  toJson m := Json.obj <| RBNode.map (fun _ => toJson) <| m.val
+  toJson := RBMap.toJson
+
+protected def RBMap.fromJson? [FromJson α] (j : Json) : Except String (RBMap String α cmp) := do
+  let o ← j.getObj?
+  o.foldM (fun x k v => x.insert k <$> fromJson? v) ∅
 
 instance {cmp} [FromJson α] : FromJson (RBMap String α cmp) where
-  fromJson? j := do
-    let o ← j.getObj?
-    o.foldM (fun x k v => x.insert k <$> fromJson? v) ∅
+  fromJson? := RBMap.fromJson?
 
 namespace Json
 
-instance : FromJson Structured := ⟨fun
-  | arr a => return Structured.arr a
-  | obj o => return Structured.obj o
-  | j     => throw s!"expected structured object, got '{j}'"⟩
+protected def Structured.fromJson? : Json → Except String Structured
+  | .arr a => return Structured.arr a
+  | .obj o => return Structured.obj o
+  | j     => throw s!"expected structured object, got '{j}'"
 
-instance : ToJson Structured := ⟨fun
-  | Structured.arr a => arr a
-  | Structured.obj o => obj o⟩
+instance : FromJson Structured where
+  fromJson? := Structured.fromJson?
+
+protected def Structured.toJson : Structured → Json
+  | .arr a => .arr a
+  | .obj o => .obj o
+
+instance : ToJson Structured where
+  toJson := Structured.toJson
 
 def toStructured? [ToJson α] (v : α) : Except String Structured :=
   fromJson? (toJson v)

src/Lean/Data/NameMap.lean

@@ -18,6 +18,8 @@ def NameMap (α : Type) := RBMap Name α Name.quickCmp
 namespace NameMap
 variable {α : Type}
 
+instance [Repr α] : Repr (NameMap α) := inferInstanceAs (Repr (RBMap Name α Name.quickCmp))
+
 instance (α : Type) : EmptyCollection (NameMap α) := ⟨mkNameMap α⟩
 
 instance (α : Type) : Inhabited (NameMap α) where

src/Lean/Elab/BuiltinCommand.lean

@@ -25,25 +25,34 @@ namespace Lean.Elab.Command
     modifyEnv fun env => addMainModuleDoc env ⟨doc, range⟩
   | _ => throwErrorAt stx "unexpected module doc string{indentD stx[1]}"
 
-private def addScope (isNewNamespace : Bool) (isNoncomputable : Bool) (header : String) (newNamespace : Name) : CommandElabM Unit := do
+private def addScope (isNewNamespace : Bool) (header : String) (newNamespace : Name)
+    (isNoncomputable : Bool := false) (attrs : List (TSyntax ``Parser.Term.attrInstance) := []) :
+    CommandElabM Unit := do
   modify fun s => { s with
     env    := s.env.registerNamespace newNamespace,
-    scopes := { s.scopes.head! with header := header, currNamespace := newNamespace, isNoncomputable := s.scopes.head!.isNoncomputable || isNoncomputable } :: s.scopes
+    scopes := { s.scopes.head! with
+      header := header, currNamespace := newNamespace
+      isNoncomputable := s.scopes.head!.isNoncomputable || isNoncomputable
+      attrs := s.scopes.head!.attrs ++ attrs
+    } :: s.scopes
   }
   pushScope
   if isNewNamespace then
     activateScoped newNamespace
 
-private def addScopes (isNewNamespace : Bool) (isNoncomputable : Bool) : Name → CommandElabM Unit
+private def addScopes (header : Name) (isNewNamespace : Bool) (isNoncomputable : Bool := false)
+    (attrs : List (TSyntax ``Parser.Term.attrInstance) := []) : CommandElabM Unit :=
+  go header
+where go
   | .anonymous => pure ()
   | .str p header => do
-    addScopes isNewNamespace isNoncomputable p
+    go p
     let currNamespace ← getCurrNamespace
-    addScope isNewNamespace isNoncomputable header (if isNewNamespace then Name.mkStr currNamespace header else currNamespace)
+    addScope isNewNamespace header (if isNewNamespace then Name.mkStr currNamespace header else currNamespace) isNoncomputable attrs
   | _ => throwError "invalid scope"
 
 private def addNamespace (header : Name) : CommandElabM Unit :=
-  addScopes (isNewNamespace := true) (isNoncomputable := false) header
+  addScopes (isNewNamespace := true) (isNoncomputable := false) (attrs := []) header
 
 def withNamespace {α} (ns : Name) (elabFn : CommandElabM α) : CommandElabM α := do
   addNamespace ns
@@ -76,14 +85,16 @@ private def checkEndHeader : Name → List Scope → Option Name
 
 @[builtin_command_elab «section»] def elabSection : CommandElab := fun stx => do
   match stx with
-  | `(section $header:ident) => addScopes (isNewNamespace := false) (isNoncomputable := false) header.getId
-  | `(section)               => addScope (isNewNamespace := false) (isNoncomputable := false) "" (← getCurrNamespace)
-  | _                        => throwUnsupportedSyntax
-
-@[builtin_command_elab noncomputableSection] def elabNonComputableSection : CommandElab := fun stx => do
-  match stx with
-  | `(noncomputable section $header:ident) => addScopes (isNewNamespace := false) (isNoncomputable := true) header.getId
-  | `(noncomputable section)               => addScope (isNewNamespace := false) (isNoncomputable := true) "" (← getCurrNamespace)
+  | `($[@[expose%$expTk]]? $[noncomputable%$ncTk]? section $(header?)?) =>
+    -- TODO: allow more attributes?
+    let attrs ← if expTk.isSome then
+      pure [← `(Parser.Term.attrInstance| expose)]
+    else
+      pure []
+    if let some header := header? then
+      addScopes (isNewNamespace := false) (isNoncomputable := ncTk.isSome) (attrs := attrs) header.getId
+    else
+      addScope (isNewNamespace := false) (isNoncomputable := ncTk.isSome) (attrs := attrs) "" (← getCurrNamespace)
   | _                        => throwUnsupportedSyntax
 
 @[builtin_command_elab «end»] def elabEnd : CommandElab := fun stx => do
@@ -448,7 +459,7 @@ def failIfSucceeds (x : CommandElabM Unit) : CommandElabM Unit := do
   let mut msg : Array MessageData := #[]
   -- Noncomputable
   if scope.isNoncomputable then
-    msg := msg.push <| ← `(command| noncomputable section)
+    msg := msg.push <| ← `(Parser.Command.section| noncomputable section)
   -- Namespace
   if !scope.currNamespace.isAnonymous then
     msg := msg.push <| ← `(command| namespace $(mkIdent scope.currNamespace))

src/Lean/Elab/Command.lean

@@ -74,6 +74,11 @@ structure Scope where
   so all sections and namespaces nested within a `noncomputable` section also have this flag set.
   -/
   isNoncomputable : Bool := false
+  /--
+  Attributes that should be applied to all matching declaration in the section. Inherited from
+  parent scopes.
+  -/
+  attrs : List (TSyntax ``Parser.Term.attrInstance) := []
   deriving Inhabited
 
 structure State where

src/Lean/Elab/Frontend.lean

@@ -145,6 +145,7 @@ def runFrontend
     (errorOnKinds : Array Name := #[])
     (plugins : Array System.FilePath := #[])
     (printStats : Bool := false)
+    (setupFileName? : Option System.FilePath := none)
     : IO (Option Environment) := do
   let startTime := (← IO.monoNanosNow).toFloat / 1000000000
   let inputCtx := Parser.mkInputContext input fileName
@@ -152,8 +153,28 @@ def runFrontend
   -- default to async elaboration; see also `Elab.async` docs
   let opts := Elab.async.setIfNotSet opts true
   let ctx := { inputCtx with }
+  let setup stx := do
+    if let some file := setupFileName? then
+      let setup ← ModuleSetup.load file
+      liftM <| setup.dynlibs.forM Lean.loadDynlib
+      return .ok {
+        trustLevel
+        mainModuleName := setup.name
+        isModule := setup.isModule
+        imports := setup.imports
+        plugins := plugins ++ setup.plugins
+        modules := setup.modules
+        -- override cmdline options with header options
+        opts := opts.mergeBy (fun _ _ hOpt => hOpt) setup.options.toOptions
+      }
+    else
+      return .ok {
+        imports := stx.imports
+        isModule := stx.isModule
+        mainModuleName, opts, trustLevel, plugins
+      }
   let processor := Language.Lean.process
-  let snap ← processor (fun _ => pure <| .ok { mainModuleName, opts, trustLevel, plugins }) none ctx
+  let snap ← processor setup none ctx
   let snaps := Language.toSnapshotTree snap
   let severityOverrides := errorOnKinds.foldl (·.insert · .error) {}
 

src/Lean/Elab/GuardMsgs.lean

@@ -31,10 +31,13 @@ private def messageToStringWithoutPos (msg : Message) : BaseIO String := do
   unless msg.caption == "" do
     str := msg.caption ++ ":\n" ++ str
   if !("\n".isPrefixOf str) then str := " " ++ str
-  match msg.severity with
-  | MessageSeverity.information => str := "info:" ++ str
-  | MessageSeverity.warning     => str := "warning:" ++ str
-  | MessageSeverity.error       => str := "error:" ++ str
+  if msg.isTrace then
+    str := "trace:" ++ str
+  else
+    match msg.severity with
+    | MessageSeverity.information => str := "info:" ++ str
+    | MessageSeverity.warning     => str := "warning:" ++ str
+    | MessageSeverity.error       => str := "error:" ++ str
   if str.isEmpty || str.back != '\n' then
     str := str ++ "\n"
   return str
@@ -46,7 +49,7 @@ inductive SpecResult
   /-- Drop the message and delete it. -/
   | drop
   /-- Do not capture the message. -/
-  | passthrough
+  | pass
 
 /-- The method to use when normalizing whitespace, after trimming. -/
 inductive WhitespaceMode
@@ -64,6 +67,25 @@ inductive MessageOrdering
   /-- Sort the produced messages. -/
   | sorted
 
+def parseGuardMsgsFilterAction (action? : Option (TSyntax ``guardMsgsFilterAction)) :
+    CommandElabM SpecResult := do
+  if let some action := action? then
+    match action with
+    | `(guardMsgsFilterAction| check) => pure .check
+    | `(guardMsgsFilterAction| drop)  => pure .drop
+    | `(guardMsgsFilterAction| pass)  => pure .pass
+    | _ => throwUnsupportedSyntax
+  else
+    pure .check
+
+def parseGuardMsgsFilterSeverity : TSyntax ``guardMsgsFilterSeverity → CommandElabM (Message → Bool)
+  | `(guardMsgsFilterSeverity| trace) => pure fun msg => msg.isTrace
+  | `(guardMsgsFilterSeverity| info)  => pure fun msg => !msg.isTrace && msg.severity == .information
+  | `(guardMsgsFilterSeverity| warning) => pure fun msg => !msg.isTrace && msg.severity == .warning
+  | `(guardMsgsFilterSeverity| error) => pure fun msg => !msg.isTrace && msg.severity == .error
+  | `(guardMsgsFilterSeverity| all)   => pure fun _ => true
+  | _ => throwUnsupportedSyntax
+
 /-- Parses a `guardMsgsSpec`.
 - No specification: check everything.
 - With a specification: interpret the spec, and if nothing applies pass it through. -/
@@ -79,24 +101,23 @@ def parseGuardMsgsSpec (spec? : Option (TSyntax ``guardMsgsSpec)) :
   let mut whitespace : WhitespaceMode := .normalized
   let mut ordering : MessageOrdering := .exact
   let mut p? : Option (Message → SpecResult) := none
-  let pushP (s : MessageSeverity) (drop : Bool) (p? : Option (Message → SpecResult))
+  let pushP (action : SpecResult) (msgP : Message → Bool) (p? : Option (Message → SpecResult))
       (msg : Message) : SpecResult :=
-    let p := p?.getD fun _ => .passthrough
-    if msg.severity == s then if drop then .drop else .check
-    else p msg
+    if msgP msg then
+      action
+    else
+      (p?.getD fun _ => .pass) msg
   for elt in elts.reverse do
     match elt with
-    | `(guardMsgsSpecElt| $[drop%$drop?]? info)     => p? := pushP .information drop?.isSome p?
-    | `(guardMsgsSpecElt| $[drop%$drop?]? warning)  => p? := pushP .warning drop?.isSome p?
-    | `(guardMsgsSpecElt| $[drop%$drop?]? error)    => p? := pushP .error drop?.isSome p?
-    | `(guardMsgsSpecElt| $[drop%$drop?]? all)      => p? := some fun _ => if drop?.isSome then .drop else .check
+    | `(guardMsgsSpecElt| $[$action?]? $sev)        => p? := pushP (← parseGuardMsgsFilterAction action?) (← parseGuardMsgsFilterSeverity sev) p?
     | `(guardMsgsSpecElt| whitespace := exact)      => whitespace := .exact
     | `(guardMsgsSpecElt| whitespace := normalized) => whitespace := .normalized
     | `(guardMsgsSpecElt| whitespace := lax)        => whitespace := .lax
     | `(guardMsgsSpecElt| ordering := exact)        => ordering := .exact
     | `(guardMsgsSpecElt| ordering := sorted)       => ordering := .sorted
     | _ => throwUnsupportedSyntax
-  return (whitespace, ordering, p?.getD fun _ => .check)
+  let defaultP := fun _ => .check
+  return (whitespace, ordering, p?.getD defaultP)
 
 /-- An info tree node corresponding to a failed `#guard_msgs` invocation,
 used for code action support. -/
@@ -157,7 +178,7 @@ def MessageOrdering.apply (mode : MessageOrdering) (msgs : List String) : List S
       match specFn msg with
       | .check       => toCheck := toCheck.add msg
       | .drop        => pure ()
-      | .passthrough => toPassthrough := toPassthrough.add msg
+      | pass => toPassthrough := toPassthrough.add msg
     let strings ← toCheck.toList.mapM (messageToStringWithoutPos ·)
     let strings := ordering.apply strings
     let res := "---\n".intercalate strings |>.trim

src/Lean/Elab/Import.lean

@@ -10,7 +10,15 @@ import Lean.CoreM
 
 namespace Lean.Elab
 
-def headerToImports : TSyntax ``Parser.Module.header → Array Import
+abbrev HeaderSyntax := TSyntax ``Parser.Module.header
+
+def HeaderSyntax.startPos (header : HeaderSyntax) : String.Pos :=
+  header.raw.getPos?.getD 0
+
+def HeaderSyntax.isModule (header : HeaderSyntax) : Bool :=
+  !header.raw[0].isNone
+
+def HeaderSyntax.imports : HeaderSyntax → Array Import
   | `(Parser.Module.header| $[module%$moduleTk]? $[prelude%$preludeTk]? $importsStx*) =>
     let imports := if preludeTk.isNone then #[{ module := `Init : Import }] else #[]
     imports ++ importsStx.map fun
@@ -19,17 +27,14 @@ def headerToImports : TSyntax ``Parser.Module.header → Array Import
       | _ => unreachable!
   | _ => unreachable!
 
-/--
-Elaborates the given header syntax into an environment.
+abbrev headerToImports := @HeaderSyntax.imports
 
-If `mainModule` is not given, `Environment.setMainModule` should be called manually. This is a
-backwards compatibility measure not compatible with the module system.
--/
-def processHeader (header : TSyntax ``Parser.Module.header) (opts : Options) (messages : MessageLog)
-    (inputCtx : Parser.InputContext) (trustLevel : UInt32 := 0)
-    (plugins : Array System.FilePath := #[]) (leakEnv := false) (mainModule := Name.anonymous)
+def processHeaderCore
+    (startPos : String.Pos) (imports : Array Import) (isModule : Bool)
+    (opts : Options) (messages : MessageLog) (inputCtx : Parser.InputContext)
+    (trustLevel : UInt32 := 0) (plugins : Array System.FilePath := #[]) (leakEnv := false)
+    (mainModule := Name.anonymous) (arts : NameMap ModuleArtifacts := {})
     : IO (Environment × MessageLog) := do
-  let isModule := !header.raw[0].isNone
   let level := if isModule then
     if Elab.inServer.get opts then
       .server
@@ -38,7 +43,6 @@ def processHeader (header : TSyntax ``Parser.Module.header) (opts : Options) (me
   else
     .private
   let (env, messages) ← try
-    let imports := headerToImports header
     for i in imports do
       if !isModule && i.importAll then
         throw <| .userError "cannot use `import all` without `module`"
@@ -47,15 +51,30 @@ def processHeader (header : TSyntax ``Parser.Module.header) (opts : Options) (me
       if !isModule && !i.isExported then
         throw <| .userError "cannot use `private import` without `module`"
     let env ←
-      importModules (leakEnv := leakEnv) (loadExts := true) (level := level) imports opts trustLevel plugins
+      importModules (leakEnv := leakEnv) (loadExts := true) (level := level)
+        imports opts trustLevel plugins arts
     pure (env, messages)
   catch e =>
     let env ← mkEmptyEnvironment
-    let spos := header.raw.getPos?.getD 0
-    let pos  := inputCtx.fileMap.toPosition spos
+    let pos := inputCtx.fileMap.toPosition startPos
     pure (env, messages.add { fileName := inputCtx.fileName, data := toString e, pos := pos })
   return (env.setMainModule mainModule, messages)
 
+/--
+Elaborates the given header syntax into an environment.
+
+If `mainModule` is not given, `Environment.setMainModule` should be called manually. This is a
+backwards compatibility measure not compatible with the module system.
+-/
+@[inline] def processHeader
+    (header : HeaderSyntax)
+    (opts : Options) (messages : MessageLog) (inputCtx : Parser.InputContext)
+    (trustLevel : UInt32 := 0) (plugins : Array System.FilePath := #[]) (leakEnv := false)
+    (mainModule := Name.anonymous)
+    : IO (Environment × MessageLog) := do
+  processHeaderCore header.startPos header.imports header.isModule
+    opts messages inputCtx trustLevel plugins leakEnv mainModule
+
 def parseImports (input : String) (fileName : Option String := none) : IO (Array Import × Position × MessageLog) := do
   let fileName := fileName.getD "<input>"
   let inputCtx := Parser.mkInputContext input fileName

src/Lean/Elab/MutualDef.lean

@@ -25,6 +25,16 @@ open Language
 builtin_initialize
   registerTraceClass `Meta.instantiateMVars
 
+private builtin_initialize exposeAttr : TagAttribute ←
+  registerTagAttribute
+    `expose
+    "(module system) Make bodies of definitions available to importing modules."
+    (validate := fun c => do
+      if let some info := (← getEnv).setExporting false |>.findAsync? c then
+        if info.kind == .defn then
+          return
+      throwError "Invalid use of `expose` attribute, it can only be used on definitions")
+
 def instantiateMVarsProfiling (e : Expr) : MetaM Expr := do
   profileitM Exception s!"instantiate metavars" (← getOptions) do
   withTraceNode `Meta.instantiateMVars (fun _ => pure e) do
@@ -89,8 +99,15 @@ private def check (prevHeaders : Array DefViewElabHeader) (newHeader : DefViewEl
   else
     pure ()
 
-private def registerFailedToInferDefTypeInfo (type : Expr) (ref : Syntax) : TermElabM Unit :=
-  registerCustomErrorIfMVar type ref "failed to infer definition type"
+private def registerFailedToInferDefTypeInfo (type : Expr) (ref : Syntax) (view : DefView) : TermElabM Unit :=
+  let msg := if view.kind.isExample then
+    m!"failed to infer type of example"
+  else if view.kind matches .instance then
+    -- TODO: instances are sometime named. We should probably include the name if available.
+    m!"failed to infer type of instance"
+  else
+    m!"failed to infer type of `{view.declId}`"
+  registerCustomErrorIfMVar type ref msg
 
 /--
   Return `some [b, c]` if the given `views` are representing a declaration of the form
@@ -106,14 +123,17 @@ private def isMultiConstant? (views : Array DefView) : Option (List Name) :=
   else
     none
 
-private def getPendingMVarErrorMessage (views : Array DefView) : String :=
+private def getPendingMVarErrorMessage (views : Array DefView) : MessageData :=
   match isMultiConstant? views with
   | some ids =>
     let idsStr := ", ".intercalate <| ids.map fun id => s!"`{id}`"
     let paramsStr := ", ".intercalate <| ids.map fun id => s!"`({id} : _)`"
-    s!"\nrecall that you cannot declare multiple constants in a single declaration. The identifier(s) {idsStr} are being interpreted as parameters {paramsStr}"
+    MessageData.note m!"Recall that you cannot declare multiple constants in a single declaration. The identifier(s) {idsStr} are being interpreted as parameters {paramsStr}."
   | none =>
-    "\nwhen the resulting type of a declaration is explicitly provided, all holes (e.g., `_`) in the header are resolved before the declaration body is processed"
+    if views.all fun view => view.kind.isTheorem then
+      MessageData.note "All holes (e.g., `_`) in the header of a theorem are resolved before the proof is processed; information from the proof cannot be used to infer what these values should be"
+    else
+      MessageData.note "When the resulting type of a declaration is explicitly provided, all holes (e.g., `_`) in the header are resolved before the declaration body is processed"
 
 /--
 Convert terms of the form `OfNat <type> (OfNat.ofNat Nat <num> ..)` into `OfNat <type> <num>`.
@@ -188,13 +208,13 @@ private def elabHeaders (views : Array DefView) (expandedDeclIds : Array ExpandD
             let mut type ← match view.type? with
               | some typeStx =>
                 let type ← elabType typeStx
-                registerFailedToInferDefTypeInfo type typeStx
+                registerFailedToInferDefTypeInfo type typeStx view
                 pure type
               | none =>
                 let hole := mkHole refForElabFunType
                 let type ← elabType hole
                 trace[Elab.definition] ">> type: {type}\n{type.mvarId!}"
-                registerFailedToInferDefTypeInfo type refForElabFunType
+                registerFailedToInferDefTypeInfo type refForElabFunType view
                 pure type
             Term.synthesizeSyntheticMVarsNoPostponing
             if view.isInstance then
@@ -366,9 +386,11 @@ Runs `k` with a restricted local context where only section variables from `vars
 * are instance-implicit variables that only reference section variables included by these rules AND
   are not listed in `sc.omittedVars` (via `omit`; note that `omit` also subtracts from
   `sc.includedVars`).
+
+If `check` is false, no exceptions will be produced.
 -/
 private def withHeaderSecVars {α} (vars : Array Expr) (sc : Command.Scope) (headers : Array DefViewElabHeader)
-    (k : Array Expr → TermElabM α) : TermElabM α := do
+    (k : Array Expr → TermElabM α) (check := true) : TermElabM α := do
   let mut revSectionFVars : Std.HashMap FVarId Name := {}
   for (uid, var) in (← read).sectionFVars do
     revSectionFVars := revSectionFVars.insert var.fvarId! uid
@@ -386,10 +408,11 @@ where
           modify (·.add var.fvarId!)
     -- transitively referenced
     get >>= (·.addDependencies) >>= set
-    for var in (← get).fvarIds do
-      if let some uid := revSectionFVars[var]? then
-        if sc.omittedVars.contains uid then
-          throwError "cannot omit referenced section variable '{Expr.fvar var}'"
+    if check then
+      for var in (← get).fvarIds do
+        if let some uid := revSectionFVars[var]? then
+          if sc.omittedVars.contains uid then
+            throwError "cannot omit referenced section variable '{Expr.fvar var}'"
     -- instances (`addDependencies` unnecessary as by definition they may only reference variables
     -- already included)
     for var in vars do
@@ -1044,27 +1067,39 @@ where
       Term.expandDeclId (← getCurrNamespace) (← getLevelNames) view.declId view.modifiers
     let headers ← elabHeaders views expandedDeclIds bodyPromises tacPromises
     let headers ← levelMVarToParamHeaders views headers
+    -- If the decl looks like a `rfl` theorem, we elaborate is synchronously as we need to wait for
+    -- the type before we can decide whether the theorem body should be exported and then waiting
+    -- for the body as well should not add any significant overhead.
+    let isRflLike := headers.all (·.value matches `(declVal| := rfl))
     -- elaborate body in parallel when all stars align
     if let (#[view], #[declId]) := (views, expandedDeclIds) then
-      if Elab.async.get (← getOptions) && view.kind.isTheorem &&
+      if Elab.async.get (← getOptions) && view.kind.isTheorem && !isRflLike &&
           !deprecated.oldSectionVars.get (← getOptions) &&
           -- holes in theorem types is not a fatal error, but it does make parallelism impossible
           !headers[0]!.type.hasMVar then
         elabAsync headers[0]! view declId
-      else elabSync headers
-    else elabSync headers
+      else elabSync headers isRflLike
+    else elabSync headers isRflLike
     for view in views, declId in expandedDeclIds do
       -- NOTE: this should be the full `ref`, and thus needs to be done after any snapshotting
       -- that depends only on a part of the ref
       addDeclarationRangesForBuiltin declId.declName view.modifiers.stx view.ref
-  elabSync headers := do
-    finishElab headers
+  elabSync headers isRflLike := do
+    -- If the reflexivity holds publically as well (we're still inside `withExporting` here), export
+    -- the body even if it is a theorem so that it is recognized as a rfl theorem even without
+    -- `import all`.
+    let rflPublic ← pure isRflLike <&&> pure (← getEnv).header.isModule <&&>
+      forallTelescopeReducing headers[0]!.type fun _ type => do
+        let some (_, lhs, rhs) := type.eq? | pure false
+        try
+          isDefEq lhs rhs
+        catch _ => pure false
+    withExporting (isExporting := rflPublic) do
+      finishElab headers
     processDeriving headers
   elabAsync header view declId := do
     let env ← getEnv
-    -- HACK: should be replaced by new `[dsimp]` attribute
-    let isRflLike := header.value matches `(declVal| := rfl)
-    let async ← env.addConstAsync declId.declName .thm (exportedKind := if isRflLike then .thm else .axiom)
+    let async ← env.addConstAsync declId.declName .thm (exportedKind := .axiom)
     setEnv async.mainEnv
 
     -- TODO: parallelize header elaboration as well? Would have to refactor auto implicits catch,
@@ -1103,7 +1138,8 @@ where
         (cancelTk? := cancelTk) fun _ => do profileitM Exception "elaboration" (← getOptions) do
       setEnv async.asyncEnv
       try
-        finishElab #[header]
+        withoutExporting do
+          finishElab #[header]
       finally
         reportDiag
         -- must introduce node to fill `infoHole` with multiple info trees
@@ -1121,7 +1157,7 @@ where
     Core.logSnapshotTask { stx? := none, task := (← BaseIO.asTask (act ())), cancelTk? := cancelTk }
     applyAttributesAt declId.declName view.modifiers.attrs .afterTypeChecking
     applyAttributesAt declId.declName view.modifiers.attrs .afterCompilation
-  finishElab headers := withFunLocalDecls headers fun funFVars => withoutExporting do
+  finishElab headers := withFunLocalDecls headers fun funFVars => do
     for view in views, funFVar in funFVars do
       addLocalVarInfo view.declId funFVar
     let values ← try
@@ -1135,7 +1171,10 @@ where
     let letRecsToLift ← getLetRecsToLift
     let letRecsToLift ← letRecsToLift.mapM instantiateMVarsAtLetRecToLift
     checkLetRecsToLiftTypes funFVars letRecsToLift
-    (if headers.all (·.kind.isTheorem) && !deprecated.oldSectionVars.get (← getOptions) then withHeaderSecVars vars sc headers else withUsed vars headers values letRecsToLift) fun vars => do
+    (if headers.all (·.kind.isTheorem) && !deprecated.oldSectionVars.get (← getOptions) then
+       -- do not repeat checks already done in `elabFunValues`
+       withHeaderSecVars (check := false) vars sc headers
+     else withUsed vars headers values letRecsToLift) fun vars => do
       let preDefs ← MutualClosure.main vars headers funFVars values letRecsToLift
       checkAllDeclNamesDistinct preDefs
       for preDef in preDefs do
@@ -1165,7 +1204,7 @@ is error-free and contains no syntactical `sorry`s.
 -/
 private def logGoalsAccomplishedSnapshotTask (views : Array DefView)
     (defsParsedSnap : DefsParsedSnapshot) : TermElabM Unit := do
-  if Lean.Elab.inServer.get (← getOptions) then
+  if ! Lean.Elab.inServer.get (← getOptions) then
     -- Skip 'goals accomplished' task if we are on the command line.
     -- These messages are only used in the language server.
     return

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

@@ -225,11 +225,11 @@ where
           throwError m!"Value for Int64 was not 64 bit but {value.w} bit"
       | _ =>
         match var with
-        | .app (.const (.str p s) []) arg =>
+        | .app (.const (.str p s) levels) arg =>
           if s == Normalize.enumToBitVecSuffix then
             let .inductInfo inductiveInfo ← getConstInfo p | unreachable!
             let ctors := inductiveInfo.ctors
-            let enumVal := mkConst ctors[value.bv.toNat]!
+            let enumVal := mkConst ctors[value.bv.toNat]! levels
             return (arg, enumVal)
           else
             return (var, toExpr value.bv)
@@ -365,11 +365,12 @@ def reflectBV (g : MVarId) : M ReflectionResult := g.withContext do
     else
       unusedHypotheses := unusedHypotheses.insert hyp
   if h : sats.size = 0 then
-    let mut error := "None of the hypotheses are in the supported BitVec fragment.\n"
-    error := error ++ "There are two potential fixes for this:\n"
+    let mut error := "None of the hypotheses are in the supported BitVec fragment after applying preprocessing.\n"
+    error := error ++ "There are three potential reasons for this:\n"
     error := error ++ "1. If you are using custom BitVec constructs simplify them to built-in ones.\n"
     error := error ++ "2. If your problem is using only built-in ones it might currently be out of reach.\n"
-    error := error ++ "   Consider expressing it in terms of different operations that are better supported."
+    error := error ++ "   Consider expressing it in terms of different operations that are better supported.\n"
+    error := error ++ "3. The original goal was reduced to False and is thus invalid."
     throwError error
   else
     let sat := sats[1:].foldl (init := sats[0]) SatAtBVLogical.and

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

@@ -56,7 +56,8 @@ where
     let cfg ← PreProcessM.getConfig
 
     if cfg.structures || cfg.enums then
-      g := (← typeAnalysisPass.run g).get!
+      let some g' ← typeAnalysisPass.run g | return none
+      g := g'
 
     /-
     There is a tension between the structures and enums pass at play:

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

@@ -54,11 +54,13 @@ def getEnumToBitVecFor (declName : Name) : MetaM Name := do
     let domainSize := inductiveInfo.ctors.length
     let bvSize := getBitVecSize domainSize
     let bvType := mkApp (mkConst ``BitVec) (toExpr bvSize)
-    let declType := mkConst declName
+    let levelParamNames := inductiveInfo.levelParams
+    let levelParams := inductiveInfo.levelParams.map mkLevelParam
+    let declType := mkConst declName levelParams
     let translator ←
       withLocalDeclD `x declType fun x => do
         let motive := mkLambda .anonymous .default declType bvType
-        let recOn := mkApp2 (mkConst (mkRecOnName declName) [1]) motive x
+        let recOn := mkApp2 (mkConst (mkRecOnName declName) (1 :: levelParams)) motive x
         let translator :=
           Nat.fold
             domainSize
@@ -68,7 +70,7 @@ def getEnumToBitVecFor (declName : Name) : MetaM Name := do
     addDecl <| .defnDecl {
       name := enumToBitVecName
       type := (← mkArrow declType bvType)
-      levelParams := []
+      levelParams := levelParamNames
       value := translator
       hints := .regular (getMaxHeight env translator + 1)
       safety := .safe
@@ -81,15 +83,15 @@ Create a `cond` chain in `Sort u` of the form:
 bif input = discrs 0 then values[0] else bif input = discrs 1 then values 1 else ...
 ```
 -/
-private def mkCondChain {w : Nat} (u : Level) (input : Expr) (retType : Expr)
+private def mkCondChain {w : Nat} (input : Expr) (retType : Expr)
     (discrs : Nat → BitVec w) (values : List Expr) (acc : Expr) : MetaM Expr := do
-  let instBEq ← synthInstance (mkApp (mkConst ``BEq [0]) (mkApp (mkConst ``BitVec) (toExpr w)))
-  return go u input retType instBEq discrs values 0 acc
+  let instBEq ← synthInstance (mkApp (mkConst ``BEq [0]) (toTypeExpr <| BitVec w))
+  go input retType instBEq discrs values 0 acc
 where
-  go {w : Nat} (u : Level) (input : Expr) (retType : Expr) (instBEq : Expr)
-    (discrs : Nat → BitVec w) (values : List Expr) (counter : Nat) (acc : Expr) : Expr :=
+  go {w : Nat} (input : Expr) (retType : Expr) (instBEq : Expr)
+    (discrs : Nat → BitVec w) (values : List Expr) (counter : Nat) (acc : Expr) : MetaM Expr := do
   match values with
-  | [] => acc
+  | [] => return acc
   | value :: values =>
     let eq :=
       mkApp4
@@ -98,16 +100,16 @@ where
         instBEq
         input
         (toExpr <| discrs counter)
-    let acc := mkApp4 (mkConst ``cond [u]) retType eq value acc
-    go u input retType instBEq discrs values (counter + 1) acc
+    let acc ← mkAppM ``cond #[eq, value, acc]
+    go input retType instBEq discrs values (counter + 1) acc
 
 /--
 Build `declName.recOn.{0} (motive := motive) value (f context[0]) (f context[1]) ...`
 -/
-private def enumCases (declName : Name) (motive : Expr) (value : Expr) (context : List α)
-    (f : α → MetaM Expr) : MetaM Expr := do
-  let recOn := mkApp2 (mkConst (mkRecOnName declName) [0]) motive value
-  List.foldlM (init := recOn) (fun acc a => mkApp acc <$> f a) context
+private def enumCases (declName : Name) (motive : Expr)
+    (value : Expr) (context : List α) (f : α → MetaM Expr) : MetaM Expr := do
+  let args ← context.toArray.mapM (fun c => do return some (← f c))
+  mkAppOptM (mkRecOnName declName) (#[some motive, some value] ++ args)
 
 /--
 Assuming that `declName` is an enum inductive, construct a proof of
@@ -120,25 +122,22 @@ def getEqIffEnumToBitVecEqFor (declName : Name) : MetaM Name := do
     We prove the lemma by constructing an inverse to `enumToBitVec` and use the fact that all
     invertible functions respect equality.
     -/
-    let enumToBitVec := mkConst (← getEnumToBitVecFor declName)
     let .inductInfo inductiveInfo ← getConstInfo declName | unreachable!
+    let levelParamNames := inductiveInfo.levelParams
+    let levelParams := inductiveInfo.levelParams.map mkLevelParam
+    let enumToBitVec := mkConst (← getEnumToBitVecFor declName) levelParams
     let ctors := inductiveInfo.ctors
     let domainSize := ctors.length
     let bvSize := getBitVecSize domainSize
     let bvType := mkApp (mkConst ``BitVec) (toExpr bvSize)
-    let declType := mkConst declName
+    let declType := mkConst declName levelParams
 
     -- ∀ (x y : declName), x = y ↔ enumToBitVec x = enumToBitVec y
     let type ←
       withLocalDeclD `x declType fun x =>
       withLocalDeclD `y declType fun y => do
-        let lhs := mkApp3 (mkConst ``Eq [1]) declType x y
-        let rhs :=
-          mkApp3
-            (mkConst ``Eq [1])
-            bvType
-            (mkApp enumToBitVec x)
-            (mkApp enumToBitVec y)
+        let lhs ← mkEq x y
+        let rhs ← mkEq (mkApp enumToBitVec x) (mkApp enumToBitVec y)
         let statement := mkApp2 (mkConst ``Iff) lhs rhs
 
         mkForallFVars #[x, y] statement
@@ -146,8 +145,8 @@ def getEqIffEnumToBitVecEqFor (declName : Name) : MetaM Name := do
     -- the inverse of enumToBitVec
     let inverseValue ←
       withLocalDeclD `x bvType fun x => do
-        let ctors := ctors.map mkConst
-        let inv ← mkCondChain 1 x declType (BitVec.ofNat bvSize) ctors ctors.head!
+        let ctors := ctors.map (mkConst · levelParams)
+        let inv ← mkCondChain x declType (BitVec.ofNat bvSize) ctors ctors.head!
         mkLambdaFVars #[x] inv
 
     let value ←
@@ -156,27 +155,19 @@ def getEqIffEnumToBitVecEqFor (declName : Name) : MetaM Name := do
           withLocalDeclD `x declType fun x => do
             let toBvToEnum e := mkApp inv (mkApp enumToBitVec e)
             let motive ←
-              withLocalDeclD `y declType fun y =>
-                mkLambdaFVars #[y] <| mkApp3 (mkConst ``Eq [1]) declType (toBvToEnum y) y
+              withLocalDeclD `y declType fun y => do
+                mkLambdaFVars #[y] (← mkEq (toBvToEnum y) y)
 
-            let case ctor := do
-              return mkApp2 (mkConst ``Eq.refl [1]) declType (toBvToEnum (mkConst ctor))
+            let case ctor := mkEqRefl (toBvToEnum (mkConst ctor levelParams))
             let proof ← enumCases declName motive x ctors case
             mkLambdaFVars #[x] proof
 
-        let value :=
-          mkApp5
-            (mkConst ``BitVec.eq_iff_eq_of_inv [1])
-            declType
-            (toExpr bvSize)
-            enumToBitVec
-            inv
-            invProof
+        let value ← mkAppM ``BitVec.eq_iff_eq_of_inv #[enumToBitVec, inv, invProof]
         mkLetFVars #[inv] value
 
     addDecl <| .thmDecl {
       name := eqIffEnumToBitVecEqName
-      levelParams := []
+      levelParams := levelParamNames
       type := type
       value := value
     }
@@ -190,13 +181,15 @@ constructors of `declName`.
 def getEnumToBitVecLeFor (declName : Name) : MetaM Name := do
   let enumToBitVecLeName := Name.str declName enumToBitVecLeSuffix
   realizeConst declName enumToBitVecLeName do
-    let enumToBitVec := mkConst (← getEnumToBitVecFor declName)
     let .inductInfo inductiveInfo ← getConstInfo declName | unreachable!
+    let levelParamNames := inductiveInfo.levelParams
+    let levelParams := inductiveInfo.levelParams.map mkLevelParam
+    let enumToBitVec := mkConst (← getEnumToBitVecFor declName) levelParams
     let ctors := inductiveInfo.ctors
     let domainSize := ctors.length
     let bvSize := getBitVecSize domainSize
     let bvType := mkApp (mkConst ``BitVec) (toExpr bvSize)
-    let declType := mkConst declName
+    let declType := mkConst declName levelParams
     let maxValue := toExpr (BitVec.ofNat bvSize (domainSize - 1))
     let instLe ← synthInstance (mkApp (mkConst ``LE [0]) bvType)
     let mkStatement e := mkApp4 (mkConst ``LE.le [0]) bvType instLe (mkApp enumToBitVec e) maxValue
@@ -207,14 +200,14 @@ def getEnumToBitVecLeFor (declName : Name) : MetaM Name := do
         let statement := mkStatement x
         let motive ← mkLambdaFVars #[x] statement
         let case ctor := do
-          let statement := mkStatement (mkConst ctor)
+          let statement := mkStatement (mkConst ctor levelParams)
           mkDecideProof statement
         let cases ← enumCases declName motive x ctors case
         return (← mkForallFVars #[x] statement, ← mkLambdaFVars #[x] cases)
 
     addDecl <| .thmDecl {
       name := enumToBitVecLeName
-      levelParams := []
+      levelParams := levelParamNames
       type := type
       value := value
     }
@@ -239,30 +232,32 @@ private partial def getMatchEqCondForAux (declName : Name) (kind : MatchKind) :
 where
   handleSimpleEnum (declName : Name) (thmName : Name) (inductiveInfo : InductiveVal)
       (ctors : Array ConstructorVal) : MetaM Declaration := do
-    let uName := `u
-    let u := .param uName
+    let matchConstInfo ← getConstInfo declName
+    let levelParamNames := matchConstInfo.levelParams
+    let u := mkLevelParam levelParamNames.getLast!
+    let levelParams := levelParamNames.map mkLevelParam
+    let .forallE _ (.forallE _ discrType ..) .. := matchConstInfo.type | unreachable!
     let (type, value) ←
       withLocalDeclD `a (.sort u) fun a => do
-      withLocalDeclD `x (mkConst inductiveInfo.name) fun x => do
+      withLocalDeclD `x discrType  fun x => do
         let hType ← mkArrow (mkConst ``Unit) a
         let hBinders := ctors.foldl (init := #[]) (fun acc _ => acc.push (`h, hType))
         withLocalDeclsDND hBinders fun hs => do
-          let args := #[mkLambda `x .default (mkConst inductiveInfo.name) a , x] ++ hs
-          let lhs := mkAppN (mkConst declName [u]) args
-          let enumToBitVec := mkConst (← getEnumToBitVecFor inductiveInfo.name)
+          let args := #[mkLambda `x .default discrType a , x] ++ hs
+          let lhs := mkAppN (mkConst declName levelParams) args
+          let enumToBitVec ← getEnumToBitVecFor inductiveInfo.name
           let domainSize := inductiveInfo.ctors.length
           let bvSize := getBitVecSize domainSize
           let appliedHs := hs.toList.map (mkApp · (mkConst ``Unit.unit))
           let getBitVec i := BitVec.ofNat bvSize ctors[i]!.cidx
-          let rhs ← mkCondChain u (mkApp enumToBitVec x) a getBitVec appliedHs appliedHs[0]!
-          let type := mkApp3 (mkConst ``Eq [u]) a lhs rhs
+          let rhs ← mkCondChain (← mkAppM enumToBitVec #[x]) a getBitVec appliedHs appliedHs[0]!
+          let type ← mkEq lhs rhs
           let motive ← mkLambdaFVars #[x] type
           let sortedHs :=
             hs
              |>.mapIdx (fun i h => (ctors[i]!.cidx, h))
              |>.qsort (·.1 < ·.1)
-          let case h := do
-            return mkApp2 (mkConst ``Eq.refl [u]) a (mkApp h.2 (mkConst ``Unit.unit))
+          let case h := mkEqRefl (mkApp h.2 (mkConst ``Unit.unit))
           let cases ← enumCases inductiveInfo.name motive x sortedHs.toList case
 
           let fvars := #[a, x] ++ hs
@@ -270,25 +265,28 @@ where
 
     return .thmDecl {
       name := thmName
-      levelParams := [uName]
+      levelParams := levelParamNames
       type := type
       value := value
     }
 
   handleEnumWithDefault (declName : Name) (thmName : Name) (inductiveInfo : InductiveVal)
       (ctors : Array ConstructorVal) : MetaM Declaration := do
-    let uName := `u
-    let u := .param uName
+    let matchConstInfo ← getConstInfo declName
+    let levelParamNames := matchConstInfo.levelParams
+    let u := mkLevelParam levelParamNames.getLast!
+    let levelParams := levelParamNames.map mkLevelParam
+    let .forallE _ (.forallE _ discrType ..) .. := matchConstInfo.type | unreachable!
     let (type, value) ←
       withLocalDeclD `a (.sort u) fun a => do
-      withLocalDeclD `x (mkConst inductiveInfo.name) fun x => do
+      withLocalDeclD `x discrType fun x => do
         let hType ← mkArrow (mkConst ``Unit) a
         let mut hBinders := ctors.foldl (init := #[]) (fun acc _ => acc.push (`h, hType))
-        hBinders := hBinders.push <| (`h, ← mkArrow (mkConst inductiveInfo.name) a)
+        hBinders := hBinders.push <| (`h, ← mkArrow discrType a)
         withLocalDeclsDND hBinders fun hs => do
-          let args := #[mkLambda `x .default (mkConst inductiveInfo.name) a , x] ++ hs
-          let lhs := mkAppN (mkConst declName [u]) args
-          let enumToBitVec := mkConst (← getEnumToBitVecFor inductiveInfo.name)
+          let args := #[mkLambda `x .default discrType a , x] ++ hs
+          let lhs := mkAppN (mkConst declName levelParams) args
+          let enumToBitVec ← getEnumToBitVecFor inductiveInfo.name
           let domainSize := inductiveInfo.ctors.length
           let bvSize := getBitVecSize domainSize
           let hdefault := hs.back!
@@ -296,8 +294,8 @@ where
           let appliedDefault := mkApp hdefault x
           let appliedConcrete := concrete.toList.map (mkApp · (mkConst ``Unit.unit))
           let getBitVec i := BitVec.ofNat bvSize ctors[i]!.cidx
-          let rhs ← mkCondChain u (mkApp enumToBitVec x) a getBitVec appliedConcrete appliedDefault
-          let type := mkApp3 (mkConst ``Eq [u]) a lhs rhs
+          let rhs ← mkCondChain (← mkAppM enumToBitVec #[x]) a getBitVec appliedConcrete appliedDefault
+          let type ← mkEq lhs rhs
           let motive ← mkLambdaFVars #[x] type
           let sortedConcreteHs :=
             concrete
@@ -305,25 +303,27 @@ where
              |>.qsort (·.1 < ·.1)
              |>.toList
 
-          let rec intersperseDefault hs idx acc :=
+          let discrParams := discrType.constLevels!
+          let rec intersperseDefault hs idx acc := do
             if idx == inductiveInfo.numCtors then
-              acc.reverse
+              return acc.reverse
             else
               match hs with
               | [] =>
-                let new := (idx, mkApp hdefault (mkConst (inductiveInfo.ctors[idx]!)))
+                let ctor := mkConst inductiveInfo.ctors[idx]! discrParams
+                let new := (idx, mkApp hdefault ctor)
                 intersperseDefault hs (idx + 1) (new :: acc)
               | hs@((cidx, h) :: tail) =>
                 if cidx == idx then
                   let new := (idx, mkApp h (mkConst ``Unit.unit))
                   intersperseDefault tail (idx + 1) (new :: acc)
                 else
-                  let new := (idx, mkApp hdefault (mkConst (inductiveInfo.ctors[idx]!)))
+                  let ctor := mkConst inductiveInfo.ctors[idx]! discrParams
+                  let new := (idx, mkApp hdefault ctor)
                   intersperseDefault hs (idx + 1) (new :: acc)
 
-          let caseProofs := intersperseDefault sortedConcreteHs 0 []
-          let case h := do
-            return mkApp2 (mkConst ``Eq.refl [u]) a h.2
+          let caseProofs ← intersperseDefault sortedConcreteHs 0 []
+          let case h := mkEqRefl h.2
           let cases ← enumCases inductiveInfo.name motive x caseProofs case
 
           let fvars := #[a, x] ++ hs
@@ -331,7 +331,7 @@ where
 
     return .thmDecl {
       name := thmName
-      levelParams := [uName]
+      levelParams := levelParamNames
       type := type
       value := value
     }
@@ -379,7 +379,7 @@ It will check if `x` is a constructor and if that is the case constant fold it t
 `BitVec` value.
 -/
 def enumToBitVecCtor : Simp.Simproc := fun e => do
-  let .app (.const fn []) (.const arg []) := e | return .continue
+  let .app (.const fn ..) (.const arg ..) := e | return .continue
   let .str p s := fn | return .continue
   if s != enumToBitVecSuffix then return .continue
   if !(← isEnumType p) then return .continue
@@ -413,7 +413,6 @@ partial def enumsPass : Pass where
 
       let mut simprocs : Simprocs := {}
       let mut relevantLemmas : SimpTheoremsArray := #[]
-      relevantLemmas ← relevantLemmas.addTheorem (.decl ``ne_eq) (mkConst ``ne_eq)
       for type in interestingEnums do
         let lemma ← getEqIffEnumToBitVecEqFor type
         relevantLemmas ← relevantLemmas.addTheorem (.decl lemma) (mkConst lemma)
@@ -436,6 +435,7 @@ partial def enumsPass : Pass where
       -- structures. Thus we must also re run lemmas that handle structure projections in the
       -- presence of control flow.
       let cfg ← PreProcessM.getConfig
+      relevantLemmas ← addDefaultTypeAnalysisLemmas relevantLemmas
       if cfg.structures then
         (simprocs, relevantLemmas) ← addStructureSimpLemmas simprocs relevantLemmas
 
@@ -464,7 +464,7 @@ where
   postprocess (goal : MVarId) : StateRefT PostProcessState MetaM MVarId :=
     goal.withContext do
       let filter e :=
-        if let .app (.const (.str _ s) []) _ := e then
+        if let .app (.const (.str _ s) ..) _ := e then
           s == enumToBitVecSuffix && !e.hasLooseBVars
         else
           false
@@ -477,9 +477,8 @@ where
         hypotheses for it.
         -/
         if (← get).seen.contains e then return ()
-        let .app (.const (.str enumType _) []) val := e | unreachable!
-        let lemma := mkConst (← getEnumToBitVecLeFor enumType)
-        let value := mkApp lemma val
+        let .app (.const (.str enumType _) ..) val := e | unreachable!
+        let value ← mkAppM (← getEnumToBitVecLeFor enumType) #[val]
         let type ← inferType value
         let hyp := { userName := .anonymous, type, value }
         modify fun s => { s with hyps := s.hyps.push hyp, seen := s.seen.insert e }

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

@@ -19,6 +19,231 @@ namespace Frontend.Normalize
 open Lean.Meta
 open Std.Tactic.BVDecide.Normalize
 
+section SimpleUnifiers
+
+builtin_simproc [bv_normalize] bv_and ((_ : BitVec _) &&& (_ : BitVec _)) := fun e => do
+  let_expr HAnd.hAnd ty _ _ _ lhs rhs := e | return .continue
+  let_expr BitVec wExpr := ty | return .continue
+  if lhs == rhs then
+    return .visit { expr := lhs, proof? := some <| mkApp2 (mkConst ``BitVec.and_self) wExpr lhs }
+  else
+    let some w ← getNatValue? wExpr | return .continue
+    let tryIt (notSide other : Expr) : Bool :=
+      let_expr Complement.complement _ _ notSide := notSide | false
+      notSide == other
+
+    if tryIt lhs rhs then
+      let proof := mkApp2 (mkConst ``BitVec.and_contra') wExpr rhs
+      return .visit { expr := toExpr 0#w, proof? := some proof }
+    else if tryIt rhs lhs then
+      let proof := mkApp2 (mkConst ``BitVec.and_contra) wExpr lhs
+      return .visit { expr := toExpr 0#w, proof? := some proof }
+    else
+      return .continue
+
+builtin_simproc [bv_normalize] bv_add ((_ : BitVec _) + (_ : BitVec _)) := fun e => do
+  let_expr HAdd.hAdd ty _ _ _ lhs rhs := e | return .continue
+  let_expr BitVec wExpr := ty | return .continue
+  let some w ← getNatValue? wExpr | return .continue
+  if lhs == rhs then
+    let expr ← mkMul lhs (toExpr 2#w)
+    return .visit { expr , proof? := some <| mkApp2 (mkConst ``BitVec.add_same) wExpr lhs }
+  else
+    let notAdd : MetaM (Option Simp.Step) := do
+      let_expr Complement.complement _ _ lhs := lhs | return none
+      if lhs != rhs then return none
+      let proof := mkApp2 (mkConst ``BitVec.not_add) wExpr rhs
+      return some <| .visit { expr := toExpr (-1#w) , proof? := some proof }
+
+    let addNot : MetaM (Option Simp.Step) := do
+      let_expr Complement.complement _ _ rhs := rhs | return none
+      if lhs != rhs then return none
+      let proof := mkApp2 (mkConst ``BitVec.add_not) wExpr lhs
+      return some <| .visit { expr := toExpr (-1#w) , proof? := some proof }
+
+    let addNeg : MetaM (Option Simp.Step) := do
+      let_expr HAdd.hAdd _ _ _ _ rlhs rrhs := rhs | return none
+      let some ⟨w', rrhsVal⟩ ← getBitVecValue? rrhs | return none
+      if rrhsVal != 1#w' then return none
+      let_expr Complement.complement _ _ rlhs := rlhs | return none
+      if rlhs != lhs then return none
+      let proof := mkApp2 (mkConst ``BitVec.add_neg) wExpr lhs
+      return some <| .visit { expr := toExpr 0#w, proof? := some proof }
+
+    let negAdd : MetaM (Option Simp.Step) := do
+      let_expr HAdd.hAdd _ _ _ _ llhs lrhs := lhs | return none
+      let some ⟨w', lrhsVal⟩ ← getBitVecValue? lrhs | return none
+      if lrhsVal != 1#w' then return none
+      let_expr Complement.complement _ _ llhs := llhs | return none
+      if llhs != rhs then return none
+      let proof := mkApp2 (mkConst ``Std.Tactic.BVDecide.Normalize.BitVec.neg_add) wExpr rhs
+      return some <| .visit { expr := toExpr 0#w, proof? := some proof }
+
+    let addNegMul : MetaM (Option Simp.Step) := do
+      let some ⟨w', rhsVal⟩ ← getBitVecValue? rhs | return none
+      if rhsVal != 1#w' then return none
+      let_expr Complement.complement _ _ lhs := lhs | return none
+      let_expr HAdd.hAdd _ _ _ _ llhs lrhs := lhs | return none
+      if llhs.isAppOf ``HMul.hMul then
+        let_expr HMul.hMul _ _ _ _ lllhs llrhs := llhs | return none
+        if lllhs == lrhs then
+          let newRhs ← mkAppM ``Complement.complement #[llrhs]
+          let expr ← mkMul lllhs newRhs
+          let proof := mkApp3 (mkConst ``BitVec.add_neg_mul'') wExpr lllhs llrhs
+          return some <| .visit { expr := expr, proof? := some proof }
+        else if llrhs == lrhs then
+          let newLhs ← mkAppM ``Complement.complement #[lllhs]
+          let expr ← mkMul newLhs llrhs
+          let proof := mkApp3 (mkConst ``BitVec.add_neg_mul''') wExpr llrhs lllhs
+          return some <| .visit { expr := expr, proof? := some proof }
+        else
+          return none
+      else if lrhs.isAppOf ``HMul.hMul then
+        let_expr HMul.hMul _ _ _ _ lrlhs lrrhs := lrhs | return none
+        if llhs == lrlhs then
+          let newRhs ← mkAppM ``Complement.complement #[lrrhs]
+          let expr ← mkMul lrlhs newRhs
+          let proof := mkApp3 (mkConst ``BitVec.add_neg_mul) wExpr lrlhs lrrhs
+          return some <| .visit { expr := expr, proof? := some proof }
+        else if llhs == lrrhs then
+          let newLhs ← mkAppM ``Complement.complement #[lrlhs]
+          let expr ← mkMul newLhs lrrhs
+          let proof := mkApp3 (mkConst ``BitVec.add_neg_mul') wExpr lrrhs lrlhs
+          return some <| .visit { expr := expr, proof? := some proof }
+        else
+          return none
+      else
+        return none
+
+    let addShiftLeft : MetaM (Option Simp.Step) := do
+      let_expr HShiftLeft.hShiftLeft _ _ _ _ rlhs rrhs := rhs | return none
+      if lhs != rrhs then return none
+      let expr ← mkAppM ``HOr.hOr #[lhs, rhs]
+      let proof := mkApp3 (mkConst ``BitVec.add_shiftLeft_eq_or_shiftLeft) wExpr lhs rlhs
+      return some <| .visit { expr := expr, proof? := some proof }
+
+    let shiftLeftAdd : MetaM (Option Simp.Step) := do
+      let_expr HShiftLeft.hShiftLeft _ _ _ _ llhs lrhs := lhs | return none
+      if rhs != lrhs then return none
+      let expr ← mkAppM ``HOr.hOr #[lhs, rhs]
+      let proof := mkApp3 (mkConst ``BitVec.shiftLeft_add_eq_shiftLeft_or) wExpr rhs llhs
+      return some <| .visit { expr := expr, proof? := some proof }
+
+    if let some step ← notAdd then return step
+    else if let some step ← addNot then return step
+    else if let some step ← addNeg then return step
+    else if let some step ← negAdd then return step
+    else if let some step ← addNegMul then return step
+    else if let some step ← addShiftLeft then return step
+    else if let some step ← shiftLeftAdd then return step
+    else return .continue
+
+builtin_simproc [bv_normalize] shiftRight_self ((_ : BitVec _) >>> (_ : BitVec _)) := fun e => do
+  let_expr HShiftRight.hShiftRight ty _ _ _ lhs rhs := e | return .continue
+  let_expr BitVec wExpr := ty | return .continue
+  let some w ← getNatValue? wExpr | return .continue
+  if lhs != rhs then return .continue
+  let proof := mkApp2 (mkConst ``Std.Tactic.BVDecide.Normalize.BitVec.ushiftRight_self) wExpr lhs
+  return .visit { expr := toExpr 0#w, proof? := some proof }
+
+builtin_simproc [bv_normalize] extract_full (BitVec.extractLsb' _ _ _) := fun e => do
+  let_expr BitVec.extractLsb' wExpr startExpr lenExpr targetExpr := e | return .continue
+  let some w ← getNatValue? wExpr | return .continue
+  let some start ← getNatValue? startExpr | return .continue
+  let some len ← getNatValue? lenExpr | return .continue
+  if start != 0 then return .continue
+  if len != w then return .continue
+  let proof := mkApp2 (mkConst ``BitVec.extractLsb'_eq_self) wExpr targetExpr
+  return .visit { expr := targetExpr, proof? := some proof }
+
+def eqSelfProc : Simp.Simproc := fun e => do
+  let_expr Eq ty lhs rhs := e | return .continue
+  if lhs != rhs then return .continue
+  let proof := mkApp2 (mkConst ``eq_self [1]) ty lhs
+  return .visit { expr := mkConst ``True, proof? := some proof }
+
+builtin_simproc [bv_normalize] bv_eq_self ((_ : BitVec _) = (_ : BitVec _)) := eqSelfProc
+builtin_simproc [bv_normalize] bool_eq_self ((_ : Bool) = (_ : Bool)) := eqSelfProc
+
+builtin_simproc [bv_normalize] bool_and ((_ : Bool) && (_ : Bool)) := fun e => do
+  let_expr Bool.and lhs rhs := e | return .continue
+  if lhs == rhs then
+    return .visit { expr := lhs, proof? := some (mkApp (mkConst ``Bool.and_self) lhs) }
+  else
+    let andNotSelf : MetaM (Option Simp.Step) := do
+      let_expr Bool.not rhs := rhs | return none
+      if lhs != rhs then return none
+      let proof := mkApp (mkConst ``Bool.and_not_self) lhs
+      return some <| .visit { expr := toExpr false, proof? := some proof }
+
+    let notAndSelf : MetaM (Option Simp.Step) := do
+      let_expr Bool.not lhs := lhs | return none
+      if lhs != rhs then return none
+      let proof := mkApp (mkConst ``Bool.not_and_self) lhs
+      return some <| .visit { expr := toExpr false, proof? := some proof }
+
+    let andSelfLeft : MetaM (Option Simp.Step) := do
+      let_expr Bool.and rlhs rrhs := rhs | return none
+      if lhs != rlhs then return none
+      let expr := mkApp2 (mkConst ``Bool.and) lhs rrhs
+      let proof := mkApp2 (mkConst ``Bool.and_self_left) lhs rrhs
+      return some <| .visit { expr := expr, proof? := some proof }
+
+    let andSelfRight : MetaM (Option Simp.Step) := do
+      let_expr Bool.and llhs lrhs := lhs | return none
+      if rhs != lrhs then return none
+      let expr := mkApp2 (mkConst ``Bool.and) llhs rhs
+      let proof := mkApp2 (mkConst ``Bool.and_self_right) llhs rhs
+      return some <| .visit { expr := expr, proof? := some proof }
+
+    if let some step ← andNotSelf then return step
+    else if let some step ← notAndSelf then return step
+    else if let some step ← andSelfLeft then return step
+    else if let some step ← andSelfRight then return step
+    else return .continue
+
+builtin_simproc [bv_normalize] bv_beq_self ((_ : BitVec _) == (_ : BitVec _)) := fun e => do
+  let_expr BEq.beq _ _ lhs rhs := e | return .continue
+  if lhs != rhs then return .continue
+  return .visit { expr := toExpr true, proof? := some (← mkAppM ``beq_self_eq_true #[lhs]) }
+
+builtin_simproc [bv_normalize] bool_beq ((_ : Bool) == (_ : Bool)) := fun e => do
+  let_expr BEq.beq _ _ lhs rhs := e | return .continue
+  if lhs == rhs then
+    return .visit { expr := toExpr true, proof? := some (← mkAppM ``beq_self_eq_true #[lhs]) }
+  else
+    let notSelf : MetaM (Option Simp.Step) := do
+      let_expr Bool.not rhs := rhs | return none
+      if lhs != rhs then return none
+      let proof := mkApp (mkConst ``Bool.beq_not_self) lhs
+      return some <| .visit { expr := toExpr false, proof? := some proof }
+
+    let selfNot : MetaM (Option Simp.Step) := do
+      let_expr Bool.not lhs := lhs | return none
+      if lhs != rhs then return none
+      let proof := mkApp (mkConst ``Bool.not_beq_self) lhs
+      return some <| .visit { expr := toExpr false, proof? := some proof }
+
+    let selfLeft : MetaM (Option Simp.Step) := do
+      let_expr BEq.beq _ _ rlhs rrhs := rhs | return none
+      if lhs != rlhs then return none
+      let proof := mkApp2 (mkConst ``Bool.beq_self_left) lhs rrhs
+      return some <| .visit { expr := rrhs, proof? := some proof }
+
+    let selfRight : MetaM (Option Simp.Step) := do
+      let_expr BEq.beq _ _ llhs lrhs := lhs | return none
+      if rhs != lrhs then return none
+      let proof := mkApp2 (mkConst ``Bool.beq_self_right) llhs rhs
+      return some <| .visit { expr := llhs, proof? := some proof }
+
+    if let some step ← notSelf then return step
+    else if let some step ← selfNot then return step
+    else if let some step ← selfLeft then return step
+    else if let some step ← selfRight then return step
+    else return .continue
+
+end SimpleUnifiers
+
 builtin_simproc ↓ [bv_normalize] reduceCond (cond _ _ _) := fun e => do
   let_expr f@cond α c tb eb := e | return .continue
   let r ← Simp.simp c

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

@@ -6,6 +6,7 @@ Authors: Henrik Böving
 prelude
 import Lean.Elab.Tactic.BVDecide.Frontend.Normalize.Basic
 import Lean.Elab.Tactic.BVDecide.Frontend.Normalize.ApplyControlFlow
+import Lean.Elab.Tactic.BVDecide.Frontend.Normalize.TypeAnalysis
 import Lean.Meta.Tactic.Cases
 import Lean.Meta.Tactic.Simp
 import Lean.Meta.Injective
@@ -78,8 +79,8 @@ where
     goal.withContext do
       let mut simprocs : Simprocs := {}
       let mut relevantLemmas : SimpTheoremsArray := #[]
-      relevantLemmas ← relevantLemmas.addTheorem (.decl ``ne_eq) (← mkConstWithLevelParams ``ne_eq)
       (simprocs, relevantLemmas) ← addStructureSimpLemmas simprocs relevantLemmas
+      relevantLemmas ← addDefaultTypeAnalysisLemmas relevantLemmas
       let cfg ← PreProcessM.getConfig
       let simpCtx ← Simp.mkContext
         (config := {

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

@@ -5,6 +5,7 @@ Authors: Henrik Böving
 -/
 prelude
 import Init.Data.SInt.Basic
+import Std.Tactic.BVDecide.Normalize.BitVec
 import Lean.Elab.Tactic.BVDecide.Frontend.Normalize.Basic
 
 /-!
@@ -38,7 +39,7 @@ def isSupportedMatch (declName : Name) : MetaM (Option MatchKind) := do
     -- Check that motive is `EnumInductive → Sort u`
     let motive := xs[0]!
     let motiveType ← inferType motive
-    let some (.const domTypeName [], (.sort (.param ..))) := motiveType.arrow? | return none
+    let some (.const domTypeName .., (.sort (.param ..))) := motiveType.arrow? | return none
     if domTypeName != discrTypeName then return none
 
     -- Check that resulting type is `motive discr`
@@ -78,7 +79,7 @@ def isSupportedMatch (declName : Name) : MetaM (Option MatchKind) := do
       let mut handledCtors := Array.mkEmpty (xs.size - 3)
       for i in [0:numConcreteCases] do
         let argType ← inferType xs[i + 2]!
-        let some (.const ``Unit [], (.app m (.const c []))) := argType.arrow? | return none
+        let some (.const ``Unit [], (.app m (.const c ..))) := argType.arrow? | return none
         if m != motive then return none
         let .ctorInfo ctorInfo ← getConstInfo c | return none
         handledCtors := handledCtors.push ctorInfo
@@ -104,7 +105,7 @@ where
     let mut handledCtors := Array.mkEmpty numCtors
     for i in [0:numCtors] do
       let argType ← inferType xs[i + 2]!
-      let some (.const ``Unit [], (.app m (.const c []))) := argType.arrow? | return none
+      let some (.const ``Unit [], (.app m (.const c ..))) := argType.arrow? | return none
       if m != motive then return none
       let .ctorInfo ctorInfo ← getConstInfo c | return none
       handledCtors := handledCtors.push ctorInfo
@@ -139,7 +140,7 @@ where
         -- remaining arguments are of the form `(h_n Unit.unit)`
         for i in [0:inductiveInfo.numCtors] do
           let .app fn (.const ``Unit.unit []) := args[i + 2]! | return false
-          let some (_, .app _ (.const relevantCtor [])) := (← inferType fn).arrow? | unreachable!
+          let some (_, .app _ (.const relevantCtor ..)) := (← inferType fn).arrow? | unreachable!
           let some ctorIdx := ctors.findIdx? (·.name == relevantCtor) | unreachable!
           if fn != params[ctorIdx + 2]! then return false
 
@@ -157,9 +158,9 @@ where
         - `(h_n InductiveEnum.ctor)` if the constructor is handled as part of the default case
         -/
         for i in [0:inductiveInfo.numCtors] do
-          let .app fn (.const argName []) := args[i + 2]! | return false
+          let .app fn (.const argName ..) := args[i + 2]! | return false
           if argName == ``Unit.unit then
-            let some (_, .app _ (.const relevantCtor [])) := (← inferType fn).arrow? | unreachable!
+            let some (_, .app _ (.const relevantCtor ..)) := (← inferType fn).arrow? | unreachable!
             let some ctorIdx := ctors.findIdx? (·.name == relevantCtor) | unreachable!
             if fn != params[ctorIdx + 2]! then return false
           else
@@ -177,6 +178,19 @@ def builtinTypes : Array Name :=
 @[inline]
 def isBuiltIn (n : Name) : Bool := builtinTypes.contains n
 
+def addDefaultTypeAnalysisLemmas (lemmas : SimpTheoremsArray) : PreProcessM SimpTheoremsArray := do
+  let mut lemmas := lemmas
+
+  let relevantNames := #[
+    ``ne_eq,
+    ``dif_eq_if,
+    ``Std.Tactic.BVDecide.Normalize.BitVec.getElem_eq_getLsbD,
+  ]
+  for name in relevantNames do
+    lemmas ← lemmas.addTheorem (.decl name) (mkConst name)
+
+  return lemmas
+
 partial def typeAnalysisPass : Pass where
   name := `typeAnalysis
   run' goal := do

src/Lean/Elab/Tactic/Basic.lean

@@ -11,10 +11,10 @@ namespace Lean.Elab
 open Meta
 
 /-- Assign `mvarId := sorry` -/
-def admitGoal (mvarId : MVarId) : MetaM Unit :=
+def admitGoal (mvarId : MVarId) (synthetic : Bool := true): MetaM Unit :=
   mvarId.withContext do
     let mvarType ← inferType (mkMVar mvarId)
-    mvarId.assign (← mkLabeledSorry mvarType (synthetic := true) (unique := true))
+    mvarId.assign (← mkLabeledSorry mvarType (synthetic := synthetic) (unique := true))
 
 def goalsToMessageData (goals : List MVarId) : MessageData :=
   MessageData.joinSep (goals.map MessageData.ofGoal) m!"\n\n"

src/Lean/Elab/Tactic/ElabTerm.lean

@@ -293,7 +293,7 @@ def evalApplyLikeTactic (tac : MVarId → Expr → MetaM (List MVarId)) (e : Syn
 
 @[builtin_tactic Lean.Parser.Tactic.apply] def evalApply : Tactic := fun stx =>
   match stx with
-  | `(tactic| apply $e) => evalApplyLikeTactic (·.apply) e
+  | `(tactic| apply $e) => evalApplyLikeTactic (·.apply (term? := some m!"`{e}`")) e
   | _ => throwUnsupportedSyntax
 
 @[builtin_tactic Lean.Parser.Tactic.constructor] def evalConstructor : Tactic := fun _ =>
@@ -342,7 +342,7 @@ def elabAsFVar (stx : Syntax) (userName? : Option Name := none) : TacticM FVarId
       let fvarId ← withoutModifyingState <| withNewMCtxDepth <| withoutRecover do
         let type ← elabTerm typeStx none (mayPostpone := true)
         let fvarId? ← (← getLCtx).findDeclRevM? fun localDecl => do
-          if (← isDefEq type localDecl.type) then return localDecl.fvarId else return none
+          if !localDecl.isImplementationDetail && (← isDefEq type localDecl.type) then return localDecl.fvarId else return none
         match fvarId? with
         | none => throwError "failed to find a hypothesis with type{indentExpr type}"
         | some fvarId => return fvarId

src/Lean/Elab/Tactic/Induction.lean

@@ -135,10 +135,11 @@ structure Result where
   complexArgs : Array Expr
 
 /--
-  Construct the an eliminator/recursor application. `targets` contains the explicit and implicit targets for
-  the eliminator. For example, the indices of builtin recursors are considered implicit targets.
-  Remark: the method `addImplicitTargets` may be used to compute the sequence of implicit and explicit targets
-  from the explicit ones.
+  Construct the an eliminator/recursor application. `targets` contains the explicit and implicit
+  targets for the eliminator, not yet generalized.
+  For example, the indices of builtin recursors are considered implicit targets.
+  Remark: the method `addImplicitTargets` may be used to compute the sequence of implicit and
+  explicit targets from the explicit ones.
 -/
 partial def mkElimApp (elimInfo : ElimInfo) (targets : Array Expr) (tag : Name) : TermElabM Result := do
   let rec loop : M Unit := do
@@ -213,24 +214,37 @@ partial def mkElimApp (elimInfo : ElimInfo) (targets : Array Expr) (tag : Name)
 /--
 Given a goal `... targets ... |- C[targets, complexArgs]` associated with `mvarId`,
 where `complexArgs` are the the complex (i.e. non-target) arguments to the motive in the conclusion
-of the eliminator, construct `motiveArg := fun targets xs => C[targets, xs]`
+of the eliminator, construct `motiveArg := fun targets rs => C[targets, rs]`
+
+This checks if the type of the complex arguments match what's expected by the motive, and
+ignores them otherwise. This limits the ability of `cases` to use unfolding function
+principles with dependent types, because after generalization of the targets, the types do
+no longer match. This can likely be improved.
 -/
 def setMotiveArg (mvarId : MVarId) (motiveArg : MVarId) (targets : Array FVarId) (complexArgs : Array Expr := #[]) : MetaM Unit := do
   let type ← inferType (mkMVar mvarId)
+
+  let motiveType ← inferType (mkMVar motiveArg)
+  let exptComplexArgTypes ← arrowDomainsN complexArgs.size (← instantiateForall motiveType (targets.map mkFVar))
+
   let mut absType := type
-  for complexArg in complexArgs.reverse do
-    let complexTypeArg ← inferType complexArg
-    let absType' ← kabstract absType complexArg
-    let absType' := .lam (← mkFreshUserName `x) complexTypeArg absType' .default
-    if (← isTypeCorrect absType') then
-      absType := absType'
+  for complexArg in complexArgs.reverse, exptComplexArgType in exptComplexArgTypes.reverse do
+    trace[Elab.induction] "setMotiveArg: trying to abstract over {complexArg}, expected type {exptComplexArgType}"
+    let complexArgType ← inferType complexArg
+    if (← isDefEq complexArgType exptComplexArgType) then
+      let absType' ← kabstract absType complexArg
+      let absType' := .lam (← mkFreshUserName `x) complexArgType absType' .default
+      if (← isTypeCorrect absType') then
+        absType := absType'
+      else
+        trace[Elab.induction] "Not abstracing goal over {complexArg}, resulting term is not type correct:{indentExpr absType'} }"
+        absType := .lam (← mkFreshUserName `x) complexArgType absType .default
     else
-      trace[Elab.induction] "Not abstracing goal over {complexArg}, resulting term is not type correct:{indentExpr absType'} }"
-      absType := .lam (← mkFreshUserName `x) complexTypeArg absType .default
+      trace[Elab.induction] "Not abstracing goal over {complexArg}, its type {complexArgType} does not match the expected {exptComplexArgType}"
+      absType := .lam (← mkFreshUserName `x) exptComplexArgType absType .default
 
   let motive ← mkLambdaFVars (targets.map mkFVar) absType
   let motiverInferredType ← inferType motive
-  let motiveType ← inferType (mkMVar motiveArg)
   unless (← isDefEqGuarded motiverInferredType motiveType) do
     throwError "type mismatch when assigning motive{indentExpr motive}\n{← mkHasTypeButIsExpectedMsg motiverInferredType motiveType}"
   motiveArg.assign motive
@@ -261,7 +275,7 @@ private def checkAltNames (alts : Array Alt) (altsSyntax : Array Syntax) : Tacti
           if unhandledAlts.isEmpty then
             m!"invalid alternative name '{altName}', no unhandled alternatives"
           else
-            let unhandledAltsMessages := unhandledAlts.map (m!"{·.name}")
+            let unhandledAltsMessages := unhandledAlts.map (m!"'{·.name}'")
             let unhandledAlts := MessageData.orList unhandledAltsMessages.toList
             m!"invalid alternative name '{altName}', expected {unhandledAlts}"
         throwErrorAt altStx msg

src/Lean/Elab/Tactic/LibrarySearch.lean

@@ -48,7 +48,7 @@ def exact? (ref : Syntax) (required : Option (Array (TSyntax `term))) (requireCl
           addExactSuggestion ref (← instantiateMVars (mkMVar mvar)).headBeta
             (checkState? := initialState) (addSubgoalsMsg := true) (tacticErrorAsInfo := true)
       if suggestions.isEmpty then logError "apply? didn't find any relevant lemmas"
-      admitGoal goal
+      admitGoal goal (synthetic := false)
 
 @[builtin_tactic Lean.Parser.Tactic.exact?]
 def evalExact : Tactic := fun stx => do

src/Lean/Environment.lean

@@ -11,6 +11,7 @@ import Init.System.Promise
 import Lean.ImportingFlag
 import Lean.Data.NameTrie
 import Lean.Data.SMap
+import Lean.Setup
 import Lean.Declaration
 import Lean.LocalContext
 import Lean.Util.Path
@@ -93,18 +94,6 @@ instance : GetElem? (Array α) ModuleIdx α (fun a i => i.toNat < a.size) where
 
 abbrev ConstMap := SMap Name ConstantInfo
 
-structure Import where
-  module        : Name
-  /-- `import all`; whether to import and expose all data saved by the module. -/
-  importAll : Bool := false
-  /-- Whether to activate this import when the current module itself is imported. -/
-  isExported    : Bool := true
-  deriving Repr, Inhabited
-
-instance : Coe Name Import := ⟨({module := ·})⟩
-
-instance : ToString Import := ⟨fun imp => toString imp.module⟩
-
 /--
   A compacted region holds multiple Lean objects in a contiguous memory region, which can be read/written to/from disk.
   Objects inside the region do not have reference counters and cannot be freed individually. The contents of .olean
@@ -1663,10 +1652,14 @@ def mkModuleData (env : Environment) (level : OLeanLevel := .private) : IO Modul
   let kenv := env.toKernelEnv
   let env := env.setExporting (level != .private)
   let constNames := kenv.constants.foldStage2 (fun names name _ => names.push name) #[]
-  -- not all kernel constants may be exported
-  let constants := constNames.filterMap fun n =>
-    env.find? n <|>
-    guard (looksLikeOldCodegenName n) *> kenv.find? n
+  -- not all kernel constants may be exported at `level < .private`
+  let constants := if level == .private then
+    -- (this branch makes very sure all kernel constants are exported eventually)
+    kenv.constants.foldStage2 (fun cs _ c => cs.push c) #[]
+  else
+    constNames.filterMap fun n =>
+      env.find? n <|>
+      guard (looksLikeOldCodegenName n) *> kenv.find? n
   let constNames := constants.map (·.name)
   return { env.header with
     extraConstNames := env.checked.get.extraConstNames.toArray
@@ -1794,7 +1787,35 @@ abbrev ImportStateM := StateRefT ImportState IO
 @[inline] nonrec def ImportStateM.run (x : ImportStateM α) (s : ImportState := {}) : IO (α × ImportState) :=
   x.run s
 
-partial def importModulesCore (imports : Array Import) (forceImportAll := true) :
+def ModuleArtifacts.oleanParts (arts : ModuleArtifacts) : Array System.FilePath := Id.run do
+  let mut fnames := #[]
+  -- Opportunistically load all available parts.
+  -- Producer (e.g., Lake) should limit parts to the proper import level.
+  if let some mFile := arts.olean? then
+    fnames := fnames.push mFile
+    if let some sFile := arts.oleanServer? then
+      fnames := fnames.push sFile
+      if let some pFile := arts.oleanPrivate? then
+        fnames := fnames.push pFile
+  return fnames
+
+private def findOLeanParts (mod : Name) : IO (Array System.FilePath) := do
+  let mFile ← findOLean mod
+  unless (← mFile.pathExists) do
+    throw <| IO.userError s!"object file '{mFile}' of module {mod} does not exist"
+  let mut fnames := #[mFile]
+  -- Opportunistically load all available parts.
+  -- Necessary because the import level may be upgraded a later import.
+  let sFile := OLeanLevel.server.adjustFileName mFile
+  if (← sFile.pathExists) then
+    fnames := fnames.push sFile
+    let pFile := OLeanLevel.private.adjustFileName mFile
+    if (← pFile.pathExists) then
+      fnames := fnames.push pFile
+  return fnames
+
+partial def importModulesCore
+    (imports : Array Import) (forceImportAll := true) (arts : NameMap ModuleArtifacts := {}) :
     ImportStateM Unit := go
 where go := do
   for i in imports do
@@ -1811,19 +1832,14 @@ where go := do
           if let some mod := mod.mainModule? then
             importModulesCore (forceImportAll := true) mod.imports
       continue
-    let mFile ← findOLean i.module
-    unless (← mFile.pathExists) do
-      throw <| IO.userError s!"object file '{mFile}' of module {i.module} does not exist"
-    let mut fnames := #[mFile]
-    -- opportunistically load all available parts in case `importPrivate` is upgraded by a later
-    -- import
-    -- TODO: use Lake data to retrieve ultimate import level immediately
-    let sFile := OLeanLevel.server.adjustFileName mFile
-    if (← sFile.pathExists) then
-      fnames := fnames.push sFile
-      let pFile := OLeanLevel.private.adjustFileName mFile
-      if (← pFile.pathExists) then
-        fnames := fnames.push pFile
+    let fnames ←
+      if let some arts := arts.find? i.module then
+        let fnames := arts.oleanParts
+        if fnames.isEmpty then
+          findOLeanParts i.module
+        else pure fnames
+      else
+        findOLeanParts i.module
     let parts ← readModuleDataParts fnames
     -- `imports` is identical for each part
     let some (baseMod, _) := parts[0]? | unreachable!
@@ -1995,13 +2011,14 @@ as if no `module` annotations were present in the imports.
 -/
 def importModules (imports : Array Import) (opts : Options) (trustLevel : UInt32 := 0)
     (plugins : Array System.FilePath := #[]) (leakEnv := false) (loadExts := false)
-    (level := OLeanLevel.private) : IO Environment := profileitIO "import" opts do
+    (level := OLeanLevel.private) (arts : NameMap ModuleArtifacts := {})
+    : IO Environment := profileitIO "import" opts do
   for imp in imports do
     if imp.module matches .anonymous then
       throw <| IO.userError "import failed, trying to import module with anonymous name"
   withImporting do
     plugins.forM Lean.loadPlugin
-    let (_, s) ← importModulesCore (forceImportAll := level == .private) imports |>.run
+    let (_, s) ← importModulesCore (forceImportAll := level == .private) imports arts |>.run
     finalizeImport (leakEnv := leakEnv) (loadExts := loadExts) (level := level)
       s imports opts trustLevel
 

src/Lean/Language/Lean.lean

@@ -283,10 +283,16 @@ simple uses, these can be computed eagerly without looking at the imports.
 structure SetupImportsResult where
   /-- Module name of the file being processed. -/
   mainModuleName : Name
+  /-- Whether the file is participating in the module system. -/
+  isModule : Bool := false
+  /-- Direct imports of the file being processed. -/
+  imports : Array Import
   /-- Options provided outside of the file content, e.g. on the cmdline or in the lakefile. -/
   opts : Options
   /-- Kernel trust level. -/
   trustLevel : UInt32 := 0
+  /-- Pre-resolved artifacts of related modules (e.g., this module's transitive imports). -/
+  modules : NameMap ModuleArtifacts := {}
   /-- Lean plugins to load as part of the environment setup. -/
   plugins : Array System.FilePath := #[]
 
@@ -367,7 +373,7 @@ General notes:
   the `sync` parameter on `parseCmd` and spawn an elaboration task when we leave it.
 -/
 partial def process
-    (setupImports : TSyntax ``Parser.Module.header → ProcessingT IO (Except HeaderProcessedSnapshot SetupImportsResult))
+    (setupImports : HeaderSyntax → ProcessingT IO (Except HeaderProcessedSnapshot SetupImportsResult))
     (old? : Option InitialSnapshot) : ProcessingM InitialSnapshot := do
   parseHeader old? |>.run (old?.map (·.ictx))
 where
@@ -453,7 +459,7 @@ where
         }
       }
 
-  processHeader (stx : TSyntax ``Parser.Module.header) (parserState : Parser.ModuleParserState) :
+  processHeader (stx : HeaderSyntax) (parserState : Parser.ModuleParserState) :
       LeanProcessingM (SnapshotTask HeaderProcessedSnapshot) := do
     let ctx ← read
     SnapshotTask.ofIO stx none (some ⟨0, ctx.input.endPos⟩) <|
@@ -471,9 +477,9 @@ where
       if !stx.raw[0].isNone && !experimental.module.get opts then
         throw <| IO.Error.userError "`module` keyword is experimental and not enabled here"
       -- allows `headerEnv` to be leaked, which would live until the end of the process anyway
-      let (headerEnv, msgLog) ← Elab.processHeader (leakEnv := true)
-        (mainModule := setup.mainModuleName) stx opts .empty ctx.toInputContext setup.trustLevel
-        setup.plugins
+      let (headerEnv, msgLog) ← Elab.processHeaderCore (leakEnv := true)
+        stx.startPos setup.imports setup.isModule setup.opts .empty ctx.toInputContext
+        setup.trustLevel setup.plugins setup.mainModuleName setup.modules
       let stopTime := (← IO.monoNanosNow).toFloat / 1000000000
       let diagnostics := (← Snapshot.Diagnostics.ofMessageLog msgLog)
       if msgLog.hasErrors then

src/Lean/Message.lean

@@ -107,11 +107,12 @@ Lazy message data production, with access to the context as given by
 a surrounding `MessageData.withContext` (which is expected to exist).
 -/
 def lazy (f : PPContext → BaseIO MessageData)
-    (hasSyntheticSorry : MetavarContext → Bool := fun _ => false) : MessageData :=
+    (hasSyntheticSorry : MetavarContext → Bool := fun _ => false)
+    (onMissingContext : Unit → BaseIO MessageData :=
+      fun _ => pure (.ofFormat "(invalid MessageData.lazy, missing context)")) : MessageData :=
   .ofLazy (hasSyntheticSorry := hasSyntheticSorry) fun ctx? => do
     let msg ← match ctx? with
-      | .none =>
-        pure (.ofFormat "(invalid MessageData.lazy, missing context)") -- see `addMessageContext`
+      | .none => onMissingContext ()
       | .some ctx => f ctx
     return Dynamic.mk msg
 
@@ -146,6 +147,13 @@ def kind : MessageData → Name
   | tagged n _              => n
   | _                       => .anonymous
 
+def isTrace : MessageData → Bool
+  | withContext _ msg       => msg.isTrace
+  | withNamingContext _ msg => msg.isTrace
+  | tagged _ msg            => msg.isTrace
+  | .trace _ _ _            => true
+  | _                       => false
+
 /-- An empty message. -/
 def nil : MessageData :=
   ofFormat Format.nil
@@ -313,22 +321,45 @@ def ofList : List MessageData → MessageData
 def ofArray (msgs : Array MessageData) : MessageData :=
   ofList msgs.toList
 
-/-- Puts `MessageData` into a comma-separated list with `"or"` at the back (no Oxford comma).
-Best used on non-empty lists; returns `"– none –"` for an empty list.  -/
+/--
+Puts `MessageData` into a comma-separated list with `"or"` at the back (with the serial comma).
+
+Best used on non-empty lists; returns `"– none –"` for an empty list.
+-/
 def orList (xs : List MessageData) : MessageData :=
   match xs with
   | [] => "– none –"
-  | [x] => "'" ++ x ++ "'"
-  | _ => joinSep (xs.dropLast.map (fun x => "'" ++ x ++ "'")) ", " ++ " or '" ++ xs.getLast! ++ "'"
+  | [x] => x
+  | [x₀, x₁] => x₀ ++ " or " ++ x₁
+  | _ => joinSep xs.dropLast ", " ++ ", or " ++ xs.getLast!
 
-/-- Puts `MessageData` into a comma-separated list with `"and"` at the back (no Oxford comma).
-Best used on non-empty lists; returns `"– none –"` for an empty list.  -/
+/--
+Puts `MessageData` into a comma-separated list with `"and"` at the back (with the serial comma).
+
+Best used on non-empty lists; returns `"– none –"` for an empty list.
+-/
 def andList (xs : List MessageData) : MessageData :=
   match xs with
   | [] => "– none –"
   | [x] => x
-  | _ => joinSep xs.dropLast ", " ++ " and " ++ xs.getLast!
+  | [x₀, x₁] => x₀ ++ " and " ++ x₁
+  | _ => joinSep xs.dropLast ", " ++ ", and " ++ xs.getLast!
 
+/--
+Produces a labeled note that can be appended to an error message.
+-/
+def note (note : MessageData) : MessageData :=
+  -- Note: we do not use the built-in string coercion because it can prevent proper line breaks
+  .tagged `note <| .compose (.ofFormat .line) <| .compose (.ofFormat .line) <|
+    .compose "Note: " note
+
+/--
+Produces a labeled hint without an associated code action (non-monadic variant of
+`MessageData.hint`).
+-/
+def hint' (hint : MessageData) : MessageData :=
+  .tagged `hint <| .compose (.ofFormat .line) <| .compose (.ofFormat .line) <|
+    .compose "Hint: " hint
 
 instance : Coe (List MessageData) MessageData := ⟨ofList⟩
 instance : Coe (List Expr) MessageData := ⟨fun es => ofList <| es.map ofExpr⟩
@@ -400,6 +431,9 @@ namespace Message
 @[inherit_doc MessageData.kind] abbrev kind (msg : Message) :=
   msg.data.kind
 
+def isTrace (msg : Message) : Bool :=
+  msg.data.isTrace
+
 /-- Serializes the message, converting its data into a string and saving its kind. -/
 @[inline] def serialize (msg : Message) : BaseIO SerialMessage := do
   return {msg with kind := msg.kind, data := ← msg.data.toString}
@@ -505,6 +539,38 @@ def indentD (msg : MessageData) : MessageData :=
 def indentExpr (e : Expr) : MessageData :=
   indentD e
 
+/--
+Returns the character length of the message when rendered.
+
+Note: this is a potentially expensive operation that is only relevant to message data that are
+actually rendered. Consider using this function in lazy message data to avoid unnecessary
+computation for messages that are not displayed.
+-/
+private def MessageData.formatLength (ctx : PPContext) (msg : MessageData) : BaseIO Nat := do
+  let { env, mctx, lctx, opts, ..} := ctx
+  let fmt ← msg.format (some { env, mctx, lctx, opts })
+  return fmt.pretty.length
+
+
+/--
+Renders an expression `e` inline in a message unless it will exceed `maxInlineLength` characters, in
+which case the expression is indented on a new line.
+
+Note that the output of this function is formatted with preceding and trailing space included. Thus,
+in `m₁ ++ inlineExpr e ++ m₂`, `m₁` should not end with a space or new line, nor should `m₂` begin
+with one.
+-/
+def inlineExpr (e : Expr) (maxInlineLength := 30) : MessageData :=
+  .lazy
+    (fun ctx => do
+      let msg := MessageData.ofExpr e
+      if (← msg.formatLength ctx) > maxInlineLength then
+        return indentD msg ++ "\n"
+      else
+        return " " ++ msg ++ " ")
+    (fun mctx => instantiateMVarsCore mctx e |>.1.hasSyntheticSorry)
+    (fun () => return " " ++ MessageData.ofExpr e ++ " ")
+
 /-- Atom quotes -/
 def aquote (msg : MessageData) : MessageData :=
   "「" ++ msg ++ "」"
@@ -607,4 +673,9 @@ def toMessageData (e : Kernel.Exception) (opts : Options) : MessageData :=
   | interrupted                         => "(kernel) interrupted"
 
 end Kernel.Exception
+
+/-- Helper functions for creating a `MessageData` with the given header and elements. -/
+def toTraceElem [ToMessageData α] (e : α) (cls : Name := Name.mkSimple "_") : MessageData :=
+  .trace { cls } (toMessageData e) #[]
+
 end Lean

src/Lean/Meta.lean

@@ -52,3 +52,5 @@ import Lean.Meta.CheckTactic
 import Lean.Meta.Canonicalizer
 import Lean.Meta.Diagnostics
 import Lean.Meta.BinderNameHint
+import Lean.Meta.TryThis
+import Lean.Meta.Hint

src/Lean/Meta/AbstractMVars.lean

@@ -15,7 +15,8 @@ structure State where
   mctx           : MetavarContext
   nextParamIdx   : Nat := 0
   paramNames     : Array Name := #[]
-  fvars          : Array Expr  := #[]
+  fvars          : Array Expr := #[]
+  mvars          : Array Expr := #[]
   lmap           : Std.HashMap LMVarId Level := {}
   emap           : Std.HashMap MVarId Expr  := {}
   abstractLevels : Bool -- whether to abstract level mvars
@@ -100,8 +101,9 @@ partial def abstractExprMVars (e : Expr) : M Expr := do
               pure decl.userName
             modify fun s => {
               s with
-              emap  := s.emap.insert mvarId fvar,
-              fvars := s.fvars.push fvar,
+              emap  := s.emap.insert mvarId fvar
+              fvars := s.fvars.push fvar
+              mvars := s.mvars.push e
               lctx  := s.lctx.mkLocalDecl fvarId userName type }
             return fvar
 
@@ -111,7 +113,7 @@ end AbstractMVars
   Abstract (current depth) metavariables occurring in `e`.
   The result contains
   - An array of universe level parameters that replaced universe metavariables occurring in `e`.
-  - The number of (expr) metavariables abstracted.
+  - The metavariables that have been abstracted.
   - And an expression of the form `fun (m_1 : A_1) ... (m_k : A_k) => e'`, where
     `k` equal to the number of (expr) metavariables abstracted, and `e'` is `e` after we
     replace the metavariables.
@@ -126,7 +128,10 @@ end AbstractMVars
 
   If `levels := false`, then level metavariables are not abstracted.
 
-  Application: we use this method to cache the results of type class resolution. -/
+  Application: we use this method to cache the results of type class resolution.
+
+  Application: tactic `MVarId.abstractMVars`
+  -/
 def abstractMVars (e : Expr) (levels : Bool := true): MetaM AbstractMVarsResult := do
   let e ← instantiateMVars e
   let (e, s) := AbstractMVars.abstractExprMVars e
@@ -134,7 +139,7 @@ def abstractMVars (e : Expr) (levels : Bool := true): MetaM AbstractMVarsResult
   setNGen s.ngen
   setMCtx s.mctx
   let e := s.lctx.mkLambda s.fvars e
-  pure { paramNames := s.paramNames, numMVars := s.fvars.size, expr := e }
+  pure { paramNames := s.paramNames, mvars := s.mvars, expr := e }
 
 def openAbstractMVarsResult (a : AbstractMVarsResult) : MetaM (Array Expr × Array BinderInfo × Expr) := do
   let us ← a.paramNames.mapM fun _ => mkFreshLevelMVar

src/Lean/Meta/Basic.lean

@@ -317,10 +317,13 @@ structure SynthInstanceCacheKey where
 /-- Resulting type for `abstractMVars` -/
 structure AbstractMVarsResult where
   paramNames : Array Name
-  numMVars   : Nat
+  mvars      : Array Expr
   expr       : Expr
   deriving Inhabited, BEq
 
+def AbstractMVarsResult.numMVars (r : AbstractMVarsResult) : Nat :=
+  r.mvars.size
+
 abbrev SynthInstanceCache := PersistentHashMap SynthInstanceCacheKey (Option AbstractMVarsResult)
 
 -- Key for `InferType` and `WHNF` caches

src/Lean/Meta/Check.lean

@@ -84,6 +84,17 @@ where
       | _, .mdata _ b' =>
         let (a, b') ← visit a b'
         return (a, b.updateMData! b')
+      | .const nm _, .const nm' _ =>
+        if nm != nm' then
+          return (a, b)
+        else
+          return (a.setPPUniverses true, b.setPPUniverses true)
+      | .proj _ i a', .proj _ j b' =>
+        if i != j then
+          return (a, b)
+        else
+          let (a', b') ← visit a' b'
+          return (a.updateProj! a', b.updateProj! b')
       | .app .., .app .. =>
         if a.getAppNumArgs != b.getAppNumArgs then
           return (a, b)
@@ -198,7 +209,7 @@ def throwAppTypeMismatch (f a : Expr) : MetaM α := do
   unless binfo.isExplicit do
     e := e.setAppPPExplicit
   let aType ← inferType a
-  throwError "application type mismatch{indentExpr e}\nargument{indentExpr a}\n{← mkHasTypeButIsExpectedMsg aType expectedType}"
+  throwError "Application type mismatch: In the application{indentExpr e}\nthe final argument{indentExpr a}\n{← mkHasTypeButIsExpectedMsg aType expectedType}"
 
 def checkApp (f a : Expr) : MetaM Unit := do
   let fType ← inferType f

src/Lean/Meta/Hint.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: Joseph Rotella
+-/
+
+prelude
+
+import Lean.CoreM
+import Lean.Data.Lsp.Utf16
+import Lean.Message
+import Lean.Meta.TryThis
+import Lean.Util.Diff
+import Lean.Widget.Types
+import Lean.PrettyPrinter
+
+namespace Lean.Meta.Hint
+
+open Elab Tactic PrettyPrinter TryThis
+
+/--
+A widget for rendering code action suggestions in error messages. Generally, this widget should not
+be used directly; instead, use `MessageData.hint`. Note that this widget is intended only for use
+within message data; it may not display line breaks properly if rendered as a panel widget.
+
+The props to this widget are of the following form:
+```json
+{
+  "diff": [
+    {"type": "unchanged", "text": "h"},
+    {"type": "deletion", "text": "ello"},
+    {"type": "insertion", "text": "i"}
+  ]
+}
+```
+
+Note: we cannot add the `builtin_widget_module` attribute here because that would require importing
+`Lean.Widget.UserWidget`, which in turn imports much of `Lean.Elab` -- the module where we want to
+be able to use this widget. Instead, we register the attribute post-hoc when we declare the regular
+"Try This" widget in `Lean.Meta.Tactic.TryThis`.
+-/
+def tryThisDiffWidget : Widget.Module where
+  javascript := "
+import * as React from 'react';
+import { EditorContext, EnvPosContext } from '@leanprover/infoview';
+const e = React.createElement;
+export default function ({ diff, range, suggestion }) {
+  const pos = React.useContext(EnvPosContext)
+  const editorConnection = React.useContext(EditorContext)
+  const insStyle = { className: 'information' }
+  const delStyle = {
+    style: { color: 'var(--vscode-errorForeground)', textDecoration: 'line-through' }
+  }
+  const defStyle = {
+    style: { color: 'var(--vscode-textLink-foreground)' }
+  }
+  function onClick() {
+    editorConnection.api.applyEdit({
+      changes: { [pos.uri]: [{ range, newText: suggestion }] }
+    })
+  }
+
+  const spans = diff.map (comp =>
+    comp.type === 'deletion' ? e('span', delStyle, comp.text) :
+    comp.type === 'insertion' ? e('span', insStyle, comp.text) :
+      e('span', defStyle, comp.text)
+  )
+  const fullDiff = e('span',
+    { onClick, title: 'Apply suggestion', className: 'link pointer dim font-code', },
+    spans)
+  return fullDiff
+}"
+
+/--
+Converts an array of diff actions into corresponding JSON interpretable by `tryThisDiffWidget`.
+-/
+private def mkDiffJson (ds : Array (Diff.Action × Char)) :=
+  -- Avoid cluttering the DOM by grouping "runs" of the same action
+  let unified : List (Diff.Action × List Char) := ds.foldr (init := []) fun
+    | (act, c), [] => [(act, [c])]
+    | (act, c), (act', cs) :: acc =>
+      if act == act' then
+        (act, c :: cs) :: acc
+      else
+        (act, [c]) :: (act', cs) :: acc
+  toJson <| unified.map fun
+    | (.insert, s) => json% { type: "insertion", text: $(String.mk s) }
+    | (.delete, s) => json% { type: "deletion", text: $(String.mk s) }
+    | (.skip  , s) => json% { type: "unchanged", text: $(String.mk s) }
+
+/--
+Converts an array of diff actions into a Unicode string that visually depicts the diff.
+
+Note that this function does not return the string that results from applying the diff to some
+input; rather, it returns a string representation of the actions that the diff itself comprises, such as `b̵a̵c̲h̲e̲e̲rs̲`.
+
+-/
+private def mkDiffString (ds : Array (Diff.Action × Char)) : String :=
+  let rangeStrs := ds.map fun
+    | (.insert, s) => String.mk [s, '\u0332'] -- U+0332 Combining Low Line
+    | (.delete, s) => String.mk [s, '\u0335'] -- U+0335 Combining Short Stroke Overlay
+    | (.skip  , s) => String.mk [s]
+  rangeStrs.foldl (· ++ ·) ""
+
+/--
+A code action suggestion associated with a hint in a message.
+
+Refer to `TryThis.Suggestion`; this extends that structure with a `span?` field, allowing a single
+hint to suggest modifications at different locations. If `span?` is not specified, then the `ref`
+for the containing `Suggestions` value is used.
+-/
+structure Suggestion extends TryThis.Suggestion where
+  span? : Option Syntax := none
+
+instance : Coe TryThis.SuggestionText Suggestion where
+  coe t := { suggestion := t }
+
+instance : ToMessageData Suggestion where
+  toMessageData s := toMessageData s.toSuggestion
+
+/--
+A collection of code action suggestions to be included in a hint in a diagnostic message.
+
+Contains the following fields:
+* `ref`: the syntax location for the code action suggestions. Will be overridden by the `span?`
+  field on any suggestions that specify it.
+* `suggestions`: the suggestions to display.
+* `codeActionPrefix?`: if specified, text to display in place of "Try this: " in the code action
+  label
+-/
+structure Suggestions where
+  ref : Syntax
+  suggestions : Array Suggestion
+  codeActionPrefix? : Option String := none
+
+/--
+Creates message data corresponding to a `HintSuggestions` collection and adds the corresponding info
+leaf.
+-/
+def Suggestions.toHintMessage (suggestions : Suggestions) : CoreM MessageData := do
+  let { ref, codeActionPrefix?, suggestions } := suggestions
+  let mut msg := m!""
+  for suggestion in suggestions do
+    if let some range := (suggestion.span?.getD ref).getRange? then
+      let { info, suggestions := suggestionArr, range := lspRange } ← processSuggestions ref range
+        #[suggestion.toSuggestion] codeActionPrefix?
+      pushInfoLeaf info
+      let suggestionText := suggestionArr[0]!.2.1
+      let map ← getFileMap
+      let rangeContents := Substring.mk map.source range.start range.stop |>.toString
+      let split (s : String) := s.toList.toArray
+      let edits := Diff.diff (split rangeContents) (split suggestionText)
+      let diff := mkDiffJson edits
+      let json := json% {
+        diff: $diff,
+        suggestion: $suggestionText,
+        range: $lspRange
+      }
+      let preInfo := suggestion.preInfo?.getD ""
+      let postInfo := suggestion.postInfo?.getD ""
+      let widget := MessageData.ofWidget {
+          id := ``tryThisDiffWidget
+          javascriptHash := tryThisDiffWidget.javascriptHash
+          props := return json
+        } (suggestion.messageData?.getD (mkDiffString edits))
+      let widgetMsg := m!"{preInfo}{widget}{postInfo}"
+      let suggestionMsg := if suggestions.size == 1 then m!"\n{widgetMsg}" else m!"\n• {widgetMsg}"
+      msg := msg ++ MessageData.nestD suggestionMsg
+  return msg
+
+/--
+Appends a hint `hint` to `msg`. If `suggestions?` is non-`none`, will also append an inline
+suggestion widget.
+-/
+def _root_.Lean.MessageData.hint (hint : MessageData) (suggestions? : Option Suggestions := none)
+    : CoreM MessageData := do
+  let mut hintMsg := m!"\n\nHint: {hint}"
+  if let some suggestions := suggestions? then
+    hintMsg := hintMsg ++ (← suggestions.toHintMessage)
+  return .tagged `hint hintMsg

src/Lean/Meta/Match/MatchEqs.lean

@@ -98,9 +98,68 @@ def unfoldNamedPattern (e : Expr) : MetaM Expr := do
 
   1. Eliminates arguments for named parameters and the associated equation proofs.
 
-  2. Equality parameters associated with the `h : discr` notation are replaced with `rfl` proofs.
-     Recall that this kind of parameter always occurs after the parameters correspoting to pattern variables.
-     `numNonEqParams` is the size of the prefix.
+  2. Instantiate the `Unit` parameter of an otherwise argumentless alternative.
+
+  It does not handle the equality parameters associated with the `h : discr` notation.
+
+  The continuation `k` takes four arguments `ys args mask type`.
+  - `ys` are variables for the hypotheses that have not been eliminated.
+  - `args` are the arguments for the alternative `alt` that has type `altType`. `ys.size <= args.size`
+  - `mask[i]` is true if the hypotheses has not been eliminated. `mask.size == args.size`.
+  - `type` is the resulting type for `altType`.
+
+  We use the `mask` to build the splitter proof. See `mkSplitterProof`.
+
+  This can be used to use the alternative of a match expression in its splitter.
+-/
+partial def forallAltVarsTelescope (altType : Expr) (altNumParams numDiscrEqs : Nat)
+  (k : (patVars : Array Expr) → (args : Array Expr) → (mask : Array Bool) → (type : Expr) → MetaM α) : MetaM α := do
+  go #[] #[] #[] 0 altType
+where
+  go (ys : Array Expr) (args : Array Expr) (mask : Array Bool) (i : Nat) (type : Expr) : MetaM α := do
+    let type ← whnfForall type
+    if i < altNumParams - numDiscrEqs then
+      let Expr.forallE n d b .. := type
+        | throwError "expecting {altNumParams} parameters, excluding {numDiscrEqs} equalities, but found type{indentExpr altType}"
+
+      -- Handle the special case of `Unit` parameters.
+      if i = 0 && altNumParams - numDiscrEqs = 1 && d.isConstOf ``Unit && !b.hasLooseBVars then
+        return ← k #[] #[mkConst ``Unit.unit] #[false] b
+
+      let d ← Match.unfoldNamedPattern d
+      withLocalDeclD n d fun y => do
+        let typeNew := b.instantiate1 y
+        if let some (_, lhs, rhs) ← matchEq? d then
+          if lhs.isFVar && ys.contains lhs && args.contains lhs && isNamedPatternProof typeNew y then
+              let some j  := ys.finIdxOf? lhs | unreachable!
+              let ys      := ys.eraseIdx j
+              let some k  := args.idxOf? lhs | unreachable!
+              let mask    := mask.set! k false
+              let args    := args.map fun arg => if arg == lhs then rhs else arg
+              let arg     ← mkEqRefl rhs
+              let typeNew := typeNew.replaceFVar lhs rhs
+              return ← withReplaceFVarId lhs.fvarId! rhs do
+              withReplaceFVarId y.fvarId! arg do
+                go ys (args.push arg) (mask.push false) (i+1) typeNew
+        go (ys.push y) (args.push y) (mask.push true) (i+1) typeNew
+    else
+      let type ← Match.unfoldNamedPattern type
+      k ys args mask type
+
+  isNamedPatternProof (type : Expr) (h : Expr) : Bool :=
+    Option.isSome <| type.find? fun e =>
+      if let some e := Match.isNamedPattern? e then
+        e.appArg! == h
+      else
+        false
+
+
+/--
+  Extension of `forallAltTelescope` that continues further:
+
+  Equality parameters associated with the `h : discr` notation are replaced with `rfl` proofs.
+  Recall that this kind of parameter always occurs after the parameters corresponding to pattern
+  variables.
 
   The continuation `k` takes four arguments `ys args mask type`.
   - `ys` are variables for the hypotheses that have not been eliminated.
@@ -116,57 +175,45 @@ def unfoldNamedPattern (e : Expr) : MetaM Expr := do
 partial def forallAltTelescope (altType : Expr) (altNumParams numDiscrEqs : Nat)
     (k : (ys : Array Expr) → (eqs : Array Expr) → (args : Array Expr) → (mask : Array Bool) → (type : Expr) → MetaM α)
     : MetaM α := do
-  go #[] #[] #[] #[] 0 altType
+  forallAltVarsTelescope altType altNumParams numDiscrEqs fun ys args mask altType => do
+    go ys #[] args mask 0 altType
 where
   go (ys : Array Expr) (eqs : Array Expr) (args : Array Expr) (mask : Array Bool) (i : Nat) (type : Expr) : MetaM α := do
     let type ← whnfForall type
-    if i < altNumParams then
+    if i < numDiscrEqs then
       let Expr.forallE n d b .. := type
         | throwError "expecting {altNumParams} parameters, including {numDiscrEqs} equalities, but found type{indentExpr altType}"
-      if i < altNumParams - numDiscrEqs then
-        let d ← unfoldNamedPattern d
-        withLocalDeclD n d fun y => do
-          let typeNew := b.instantiate1 y
-          if let some (_, lhs, rhs) ← matchEq? d then
-            if lhs.isFVar && ys.contains lhs && args.contains lhs && isNamedPatternProof typeNew y then
-               let some j  := ys.finIdxOf? lhs | unreachable!
-               let ys      := ys.eraseIdx j
-               let some k  := args.idxOf? lhs | unreachable!
-               let mask    := mask.set! k false
-               let args    := args.map fun arg => if arg == lhs then rhs else arg
-               let arg     ← mkEqRefl rhs
-               let typeNew := typeNew.replaceFVar lhs rhs
-               return ← withReplaceFVarId lhs.fvarId! rhs do
-                withReplaceFVarId y.fvarId! arg do
-                  go ys eqs (args.push arg) (mask.push false) (i+1) typeNew
-          go (ys.push y) eqs (args.push y) (mask.push true) (i+1) typeNew
+      let arg ← if let some (_, _, rhs) ← matchEq? d then
+        mkEqRefl rhs
+      else if let some (_, _, _, rhs) ← matchHEq? d then
+        mkHEqRefl rhs
       else
-        let arg ← if let some (_, _, rhs) ← matchEq? d then
-          mkEqRefl rhs
-        else if let some (_, _, _, rhs) ← matchHEq? d then
-          mkHEqRefl rhs
-        else
-          throwError "unexpected match alternative type{indentExpr altType}"
-        withLocalDeclD n d fun eq => do
-          let typeNew := b.instantiate1 eq
-          go ys (eqs.push eq) (args.push arg) (mask.push false) (i+1) typeNew
+        throwError "unexpected match alternative type{indentExpr altType}"
+      withLocalDeclD n d fun eq => do
+        let typeNew := b.instantiate1 eq
+        go ys (eqs.push eq) (args.push arg) (mask.push false) (i+1) typeNew
     else
       let type ← unfoldNamedPattern type
-      /- Recall that alternatives that do not have variables have a `Unit` parameter to ensure
-         they are not eagerly evaluated. -/
-      if ys.size == 1 then
-        if (← inferType ys[0]!).isConstOf ``Unit && !(← dependsOn type ys[0]!.fvarId!) then
-          let rhs := mkConst ``Unit.unit
-          return ← withReplaceFVarId ys[0]!.fvarId! rhs do
-          return (← k #[] #[] #[rhs] #[false] type)
       k ys eqs args mask type
 
-  isNamedPatternProof (type : Expr) (h : Expr) : Bool :=
-    Option.isSome <| type.find? fun e =>
-      if let some e := isNamedPattern? e then
-        e.appArg! == h
-      else
-        false
+/--
+Given an application of an matcher arm `alt` that is expecting the `numDiscrEqs`, and
+an array of `discr = pattern` equalities (one for each discriminant), apply those that
+are expected by the alternative.
+-/
+partial def mkAppDiscrEqs (alt : Expr) (heqs : Array Expr) (numDiscrEqs : Nat) : MetaM Expr := do
+  go alt (← inferType alt) 0
+where
+  go e ty i := do
+    if i < numDiscrEqs then
+      let Expr.forallE n d b .. := ty
+        | throwError "expecting {numDiscrEqs} equalities, but found type{indentExpr alt}"
+      for heq in heqs do
+        if (← isDefEq (← inferType heq) d) then
+          return ← go (mkApp e heq) (b.instantiate1 heq) (i+1)
+      throwError "Could not find equation {n} : {d} among {heqs}"
+    else
+      return e
 
 namespace SimpH
 
@@ -328,21 +375,33 @@ private def unfoldElimOffset (mvarId : MVarId) : MetaM MVarId := do
   mvarId.deltaTarget (· == ``Nat.elimOffset)
 
 /--
-  Helper method for proving a conditional equational theorem associated with an alternative of
-  the `match`-eliminator `matchDeclName`. `type` contains the type of the theorem. -/
-partial def proveCondEqThm (matchDeclName : Name) (type : Expr) : MetaM Expr := withLCtx {} {} do
+Helper method for proving a conditional equational theorem associated with an alternative of
+the `match`-eliminator `matchDeclName`. `type` contains the type of the theorem.
+
+The `heqPos`/`heqNum` arguments indicate that these hypotheses are `Eq`/`HEq` hypotheses
+to substitute first; this is used for the generalized match equations.
+-/
+partial def proveCondEqThm (matchDeclName : Name) (type : Expr)
+  (heqPos : Nat := 0) (heqNum : Nat := 0) : MetaM Expr := withLCtx {} {} do
   let type ← instantiateMVars type
-  forallTelescope type fun ys target => do
-    let mvar0  ← mkFreshExprSyntheticOpaqueMVar target
-    trace[Meta.Match.matchEqs] "proveCondEqThm {mvar0.mvarId!}"
-    let mvarId ← mvar0.mvarId!.deltaTarget (· == matchDeclName)
-    withDefault <| go mvarId 0
-    mkLambdaFVars ys (← instantiateMVars mvar0)
+  let mvar0  ← mkFreshExprSyntheticOpaqueMVar type
+  trace[Meta.Match.matchEqs] "proveCondEqThm {mvar0.mvarId!}"
+  let mut mvarId := mvar0.mvarId!
+  if heqNum > 0 then
+    mvarId := (← mvarId.introN heqPos).2
+    for _ in [:heqNum] do
+      let (h, mvarId') ← mvarId.intro1
+      mvarId ← subst mvarId' h
+    trace[Meta.Match.matchEqs] "proveCondEqThm after subst{mvarId}"
+  mvarId := (← mvarId.intros).2
+  mvarId ← mvarId.deltaTarget (· == matchDeclName)
+  mvarId ← mvarId.heqOfEq
+  go mvarId 0
+  instantiateMVars mvar0
 where
   go (mvarId : MVarId) (depth : Nat) : MetaM Unit := withIncRecDepth do
     trace[Meta.Match.matchEqs] "proveCondEqThm.go {mvarId}"
-    let mvarId' ← mvarId.modifyTargetEqLHS whnfCore
-    let mvarId := mvarId'
+    let mvarId ← mvarId.modifyTargetEqLHS whnfCore
     let subgoals ←
       (do mvarId.refl; return #[])
       <|>
@@ -716,6 +775,7 @@ where go baseName splitterName := withConfig (fun c => { c with etaStruct := .no
             hs := hs.push h
         trace[Meta.Match.matchEqs] "hs: {hs}"
         let splitterAltType ← mkForallFVars ys (← hs.foldrM (init := (← mkForallFVars eqs altResultType)) (mkArrow · ·))
+        let splitterAltType ← unfoldNamedPattern splitterAltType
         let splitterAltNumParam := hs.size + ys.size
         -- Create a proposition for representing terms that do not match `patterns`
         let mut notAlt := mkConst ``False
@@ -767,21 +827,121 @@ where go baseName splitterName := withConfig (fun c => { c with etaStruct := .no
       let result := { eqnNames, splitterName, splitterAltNumParams }
       registerMatchEqns matchDeclName result
 
+def congrEqnThmSuffixBase := "congr_eq"
+def congrEqnThmSuffixBasePrefix := congrEqnThmSuffixBase ++ "_"
+def congrEqn1ThmSuffix := congrEqnThmSuffixBasePrefix ++ "1"
+example : congrEqn1ThmSuffix = "congr_eq_1" := rfl
+
+/-- Returns `true` if `s` is of the form `congr_eq_<idx>` -/
+def iscongrEqnReservedNameSuffix (s : String) : Bool :=
+  congrEqnThmSuffixBasePrefix.isPrefixOf s && (s.drop congrEqnThmSuffixBasePrefix.length).isNat
+
+/- We generate the equations and splitter on demand, and do not save them on .olean files. -/
+builtin_initialize matchCongrEqnsExt : EnvExtension (PHashMap Name (Array Name)) ←
+  -- Using `local` allows us to use the extension in `realizeConst` without specifying `replay?`.
+  -- The resulting state can still be accessed on the generated declarations using `findStateAsync`;
+  -- see below
+  registerEnvExtension (pure {}) (asyncMode := .local)
+
+def registerMatchcongrEqns (matchDeclName : Name) (eqnNames : Array Name) : CoreM Unit := do
+  modifyEnv fun env => matchCongrEqnsExt.modifyState env fun map =>
+    map.insert matchDeclName eqnNames
+
+/--
+Generate the congruence equations for the given match auxiliary declaration.
+The congruence equations have a completely unrestriced left-hand side (arbitrary discriminants),
+and take propositional equations relating the discriminants to the patterns as arguments. In this
+sense they combine a congruence lemma with the regular equation lemma.
+Since the motive depends on the discriminants, they are `HEq` equations.
+
+The code duplicates a fair bit of the logic above, and has to repeat the calculation of the
+`notAlts`. One could avoid that and generate the generalized equations eagerly above, but they are
+not always needed, so for now we live with the code duplication.
+-/
+def genMatchCongrEqns (matchDeclName : Name) : MetaM (Array Name) := do
+  let baseName := mkPrivateName (← getEnv) matchDeclName
+  let firstEqnName := .str baseName congrEqn1ThmSuffix
+  realizeConst matchDeclName firstEqnName (go baseName)
+  return matchCongrEqnsExt.findStateAsync (← getEnv) firstEqnName |>.find! matchDeclName
+where go baseName := withConfig (fun c => { c with etaStruct := .none }) do
+  withConfig (fun c => { c with etaStruct := .none }) do
+  let constInfo ← getConstInfo matchDeclName
+  let us := constInfo.levelParams.map mkLevelParam
+  let some matchInfo ← getMatcherInfo? matchDeclName | throwError "'{matchDeclName}' is not a matcher function"
+  let numDiscrEqs := matchInfo.getNumDiscrEqs
+  forallTelescopeReducing constInfo.type fun xs _matchResultType => do
+    let mut eqnNames := #[]
+    let params := xs[:matchInfo.numParams]
+    let motive := xs[matchInfo.getMotivePos]!
+    let alts   := xs[xs.size - matchInfo.numAlts:]
+    let firstDiscrIdx := matchInfo.numParams + 1
+    let discrs := xs[firstDiscrIdx : firstDiscrIdx + matchInfo.numDiscrs]
+    let mut notAlts := #[]
+    let mut idx := 1
+    for i in [:alts.size] do
+      let altNumParams := matchInfo.altNumParams[i]!
+      let thmName := (Name.str baseName congrEqnThmSuffixBase).appendIndexAfter idx
+      eqnNames := eqnNames.push thmName
+      let notAlt ← do
+        let alt := alts[i]!
+        Match.forallAltVarsTelescope (← inferType alt) altNumParams numDiscrEqs fun altVars args _mask altResultType => do
+        let patterns ← forallTelescope altResultType fun _ t => pure t.getAppArgs
+        let mut heqsTypes := #[]
+        assert! patterns.size == discrs.size
+        for discr in discrs, pattern in patterns do
+          let heqType ← mkEqHEq discr pattern
+          heqsTypes := heqsTypes.push ((`heq).appendIndexAfter (heqsTypes.size + 1), heqType)
+        withLocalDeclsDND heqsTypes fun heqs => do
+          let rhs ← Match.mkAppDiscrEqs (mkAppN alt args) heqs numDiscrEqs
+          let mut hs := #[]
+          for notAlt in notAlts do
+            let h ← instantiateForall notAlt patterns
+            if let some h ← Match.simpH? h patterns.size then
+              hs := hs.push h
+          trace[Meta.Match.matchEqs] "hs: {hs}"
+          let mut notAlt := mkConst ``False
+          for discr in discrs.toArray.reverse, pattern in patterns.reverse do
+            notAlt ← mkArrow (← mkEqHEq discr pattern) notAlt
+          notAlt ← mkForallFVars (discrs ++ altVars) notAlt
+          let lhs := mkAppN (mkConst constInfo.name us) (params ++ #[motive] ++ discrs ++ alts)
+          let thmType ← mkHEq lhs rhs
+          let thmType ← hs.foldrM (init := thmType) (mkArrow · ·)
+          let thmType ← mkForallFVars (params ++ #[motive] ++ discrs ++ alts ++ altVars ++ heqs) thmType
+          let thmType ← Match.unfoldNamedPattern thmType
+          -- Here we prove the theorem from scratch. One could likely also use the (non-generalized)
+          -- match equation theorem after subst'ing the `heqs`.
+          let thmVal ← Match.proveCondEqThm matchDeclName thmType
+            (heqPos := params.size + 1 + discrs.size + alts.size + altVars.size) (heqNum := heqs.size)
+          unless (← getEnv).contains thmName do
+            addDecl <| Declaration.thmDecl {
+              name        := thmName
+              levelParams := constInfo.levelParams
+              type        := thmType
+              value       := thmVal
+            }
+          return notAlt
+      notAlts := notAlts.push notAlt
+      idx := idx + 1
+    registerMatchcongrEqns matchDeclName eqnNames
+
 builtin_initialize registerTraceClass `Meta.Match.matchEqs
 
-private def isMatchEqName? (env : Environment) (n : Name) : Option Name := do
+private def isMatchEqName? (env : Environment) (n : Name) : Option (Name × Bool) := do
   let .str p s := n | failure
-  guard <| isEqnReservedNameSuffix s || s == "splitter"
+  guard <| isEqnReservedNameSuffix s || s == "splitter" || iscongrEqnReservedNameSuffix s
   let p ← privateToUserName? p
   guard <| isMatcherCore env p
-  return p
+  return (p, iscongrEqnReservedNameSuffix s)
 
 builtin_initialize registerReservedNamePredicate (isMatchEqName? · · |>.isSome)
 
 builtin_initialize registerReservedNameAction fun name => do
-  let some p := isMatchEqName? (← getEnv) name |
+  let some (p, isGenEq) := isMatchEqName? (← getEnv) name |
     return false
-  let _ ← MetaM.run' <| getEquationsFor p
+  if isGenEq then
+    let _ ← MetaM.run' <| genMatchCongrEqns p
+  else
+    let _ ← MetaM.run' <| getEquationsFor p
   return true
 
 end Lean.Meta.Match

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

@@ -190,8 +190,8 @@ private def forallAltTelescope'
     {α} (origAltType : Expr) (numParams numDiscrEqs : Nat)
     (k : Array Expr → Array Expr → n α) : n α := do
   map2MetaM (fun k =>
-    Match.forallAltTelescope origAltType (numParams - numDiscrEqs) 0
-      fun ys _eqs args _mask _bodyType => k ys args
+    Match.forallAltVarsTelescope origAltType numParams numDiscrEqs
+      fun ys args _mask _bodyType => k ys args
   ) k
 
 /--
@@ -222,7 +222,7 @@ def transform
     (addEqualities : Bool := false)
     (onParams : Expr → n Expr := pure)
     (onMotive : Array Expr → Expr → n Expr := fun _ e => pure e)
-    (onAlt : Expr → Expr → n Expr := fun _ e => pure e)
+    (onAlt : Nat → Expr → Expr → n Expr := fun _ _ e => pure e)
     (onRemaining : Array Expr → n (Array Expr) := pure) :
     n MatcherApp := do
 
@@ -282,8 +282,8 @@ def transform
     let aux1 := mkApp aux1 motive'
     let aux1 := mkAppN aux1 discrs'
     unless (← isTypeCorrect aux1) do
-      logError m!"failed to transform matcher, type error when constructing new pre-splitter motive:{indentExpr aux1}"
-      check aux1
+      mapError (f := (m!"failed to transform matcher, type error when constructing new pre-splitter motive:{indentExpr aux1}\n{indentD ·}")) do
+        check aux1
     let origAltTypes ← inferArgumentTypesN matcherApp.alts.size aux1
 
     -- We replace the matcher with the splitter
@@ -294,12 +294,13 @@ def transform
     let aux2 := mkApp aux2 motive'
     let aux2 := mkAppN aux2 discrs'
     unless (← isTypeCorrect aux2) do
-      logError m!"failed to transform matcher, type error when constructing splitter motive:{indentExpr aux2}"
-      check aux2
+      mapError (f := (m!"failed to transform matcher, type error when constructing splitter motive:{indentExpr aux2}\n{indentD ·}")) do
+        check aux2
     let altTypes ← inferArgumentTypesN matcherApp.alts.size aux2
 
     let mut alts' := #[]
-    for alt in matcherApp.alts,
+    for altIdx in [:matcherApp.alts.size],
+        alt in matcherApp.alts,
         numParams in matcherApp.altNumParams,
         splitterNumParams in matchEqns.splitterAltNumParams,
         origAltType in origAltTypes,
@@ -313,7 +314,7 @@ def transform
             forallBoundedTelescope altType extraEqualities fun ys4 altType => do
               let alt ← try instantiateLambda alt (args ++ ys3)
                         catch _ => throwError "unexpected matcher application, insufficient number of parameters in alternative"
-              let alt' ← onAlt altType alt
+              let alt' ← onAlt altIdx altType alt
               mkLambdaFVars (ys ++ ys2 ++ ys3 ++ ys4) alt'
       alts' := alts'.push alt'
 
@@ -339,7 +340,8 @@ def transform
     let altTypes ← inferArgumentTypesN matcherApp.alts.size aux
 
     let mut alts' := #[]
-    for alt in matcherApp.alts,
+    for altIdx in [:matcherApp.alts.size],
+        alt in matcherApp.alts,
         numParams in matcherApp.altNumParams,
         altType in altTypes do
       let alt' ← forallBoundedTelescope altType numParams fun xs altType => do
@@ -348,7 +350,7 @@ def transform
           let names ← lambdaTelescope alt fun xs _ => xs.mapM (·.fvarId!.getUserName)
           withUserNames xs names do
             let alt ← instantiateLambda alt xs
-            let alt' ← onAlt altType alt
+            let alt' ← onAlt altIdx altType alt
             mkLambdaFVars (xs ++ ys4) alt'
       alts' := alts'.push alt'
 
@@ -422,7 +424,7 @@ def inferMatchType (matcherApp : MatcherApp) : MetaM MatcherApp := do
       }
       mkArrowN extraParams typeMatcherApp.toExpr
     )
-    (onAlt := fun expAltType alt => do
+    (onAlt := fun _altIdx expAltType alt => do
       let altType ← inferType alt
       let eq ← mkEq expAltType altType
       let proof ← mkFreshExprSyntheticOpaqueMVar eq

src/Lean/Meta/SynthInstance.lean

@@ -771,7 +771,7 @@ private def cacheResult (cacheKey : SynthInstanceCacheKey) (abstResult? : Option
     if abstResult.numMVars == 0 && abstResult.paramNames.isEmpty then
       -- See `applyCachedAbstractResult?` If new metavariables have **not** been introduced,
       -- we don't need to perform extra checks again when reusing result.
-      modify fun s => { s with cache.synthInstance := s.cache.synthInstance.insert cacheKey (some { expr := result, paramNames := #[], numMVars := 0 }) }
+      modify fun s => { s with cache.synthInstance := s.cache.synthInstance.insert cacheKey (some { expr := result, paramNames := #[], mvars := #[] }) }
     else
       modify fun s => { s with cache.synthInstance := s.cache.synthInstance.insert cacheKey (some abstResult) }
 

src/Lean/Meta/Tactic/Apply.lean

@@ -23,11 +23,16 @@ def getExpectedNumArgs (e : Expr) : MetaM Nat := do
   let (numArgs, _) ← getExpectedNumArgsAux e
   pure numArgs
 
-private def throwApplyError {α} (mvarId : MVarId) (eType : Expr) (targetType : Expr) : MetaM α := do
-  let explanation := MessageData.ofLazyM (es := #[eType, targetType]) do
-    let (eType, targetType) ← addPPExplicitToExposeDiff eType targetType
-    return m!"{indentExpr eType}\nwith{indentExpr targetType}"
-  throwTacticEx `apply mvarId m!"failed to unify{explanation}"
+private def throwApplyError {α} (mvarId : MVarId)
+    (eType : Expr) (conclusionType? : Option Expr) (targetType : Expr)
+    (term? : Option MessageData) : MetaM α := do
+  throwTacticEx `apply mvarId <| MessageData.ofLazyM (es := #[eType, targetType]) do
+    let conclusionType := conclusionType?.getD eType
+    let note := if conclusionType?.isSome then .note m!"The full type of {term?.getD "the term"} is{indentExpr eType}" else m!""
+    let (conclusionType, targetType) ← addPPExplicitToExposeDiff conclusionType targetType
+    let conclusion := if conclusionType?.isNone then "type" else "conclusion"
+    return m!"could not unify the {conclusion} of {term?.getD "the term"}{indentExpr conclusionType}\n\
+      with the goal{indentExpr targetType}{note}"
 
 def synthAppInstances (tacticName : Name) (mvarId : MVarId) (mvarsNew : Array Expr) (binderInfos : Array BinderInfo)
     (synthAssignedInstances : Bool) (allowSynthFailures : Bool) : MetaM Unit := do
@@ -159,7 +164,8 @@ private def isDefEqApply (cfg : ApplyConfig) (a b : Expr) : MetaM Bool := do
 /--
 Close the given goal using `apply e`.
 -/
-def _root_.Lean.MVarId.apply (mvarId : MVarId) (e : Expr) (cfg : ApplyConfig := {}) : MetaM (List MVarId) :=
+def _root_.Lean.MVarId.apply (mvarId : MVarId) (e : Expr) (cfg : ApplyConfig := {})
+    (term? : Option MessageData := none) : MetaM (List MVarId) :=
   mvarId.withContext do
     mvarId.checkNotAssigned `apply
     let targetType ← mvarId.getType
@@ -201,8 +207,13 @@ def _root_.Lean.MVarId.apply (mvarId : MVarId) (e : Expr) (cfg : ApplyConfig :=
           s.restore
           go (i+1)
       else
-        let (_, _, eType) ← forallMetaTelescopeReducing eType (some rangeNumArgs.start)
-        throwApplyError mvarId eType targetType
+
+        let conclusionType? ← if rangeNumArgs.start = 0 then
+          pure none
+        else
+          let (_, _, r) ← forallMetaTelescopeReducing eType (some rangeNumArgs.start)
+          pure (some r)
+        throwApplyError mvarId eType conclusionType? targetType term?
       termination_by rangeNumArgs.stop - i
     let (newMVars, binderInfos) ← go rangeNumArgs.start
     postprocessAppMVars `apply mvarId newMVars binderInfos cfg.synthAssignedInstances cfg.allowSynthFailures
@@ -218,7 +229,7 @@ def _root_.Lean.MVarId.apply (mvarId : MVarId) (e : Expr) (cfg : ApplyConfig :=
 
 /-- Short-hand for applying a constant to the goal. -/
 def _root_.Lean.MVarId.applyConst (mvar : MVarId) (c : Name) (cfg : ApplyConfig := {}) : MetaM (List MVarId) := do
-  mvar.apply (← mkConstWithFreshMVarLevels c) cfg
+  mvar.apply (← mkConstWithFreshMVarLevels c) cfg (term? := m!"'{.ofConstName c}'")
 
 end Meta
 

src/Lean/Meta/Tactic/FunInd.lean

@@ -203,8 +203,6 @@ something goes wrong, one still gets a useful induction principle, just maybe wi
 not fully simplified.
 -/
 
-set_option autoImplicit false
-
 namespace Lean.Tactic.FunInd
 
 open Lean Elab Meta
@@ -327,7 +325,7 @@ partial def foldAndCollect (oldIH newIH : FVarId) (isRecCall : Expr → Option E
             -- statement and the inferred alt types
             let dummyGoal := mkConst ``True []
             mkArrow eTypeAbst dummyGoal)
-          (onAlt := fun altType alt => do
+          (onAlt := fun _altIdx altType alt => do
             lambdaTelescope1 alt fun oldIH' alt => do
               forallBoundedTelescope altType (some 1) fun newIH' _goal' => do
                 let #[newIH'] := newIH' | unreachable!
@@ -345,7 +343,7 @@ partial def foldAndCollect (oldIH newIH : FVarId) (isRecCall : Expr → Option E
           (onMotive := fun _motiveArgs motiveBody => do
             let some (_extra, body) := motiveBody.arrow? | throwError "motive not an arrow"
             M.eval (foldAndCollect oldIH newIH isRecCall body))
-          (onAlt := fun altType alt => do
+          (onAlt := fun _altIdx altType alt => do
             lambdaTelescope1 alt fun oldIH' alt => do
             -- We don't have suitable newIH around here, but we don't care since
             -- we just want to fold calls. So lets create a fake one.
@@ -607,8 +605,7 @@ def rwIfWith (hc : Expr) (e : Expr) : MetaM Simp.Result := do
         expr := f
         proof? := (mkAppN (mkConst ``if_neg us) #[c, h, hc, α, t, f])
       }
-    else
-      return { expr := e}
+    return { expr := e}
   | dite@dite α c h t f =>
     let us := dite.constLevels!
     if (← isDefEq c (← inferType hc)) then
@@ -621,10 +618,22 @@ def rwIfWith (hc : Expr) (e : Expr) : MetaM Simp.Result := do
         expr := f.beta #[hc]
         proof? := (mkAppN (mkConst ``dif_neg us) #[c, h, hc, α, t, f])
       }
-    else
-      return { expr := e }
+    return { expr := e }
+  | cond@cond α c t f =>
+    let us := cond.constLevels!
+    if (← isDefEq (← inferType hc) (← mkEq c (mkConst ``Bool.true))) then
+      return {
+        expr := t
+        proof? := (mkAppN (mkConst ``Bool.cond_pos us) #[α, c, t, f, hc])
+      }
+    if (← isDefEq (← inferType hc) (← mkEq c (mkConst ``Bool.false))) then
+      return {
+        expr := f
+        proof? := (mkAppN (mkConst ``Bool.cond_neg us) #[α, c, t, f, hc])
+      }
+    return { expr := e }
   | _ =>
-      return { expr := e }
+    return { expr := e }
 
 def rwLetWith (h : Expr) (e : Expr) : MetaM Simp.Result := do
   if e.isLet then
@@ -650,7 +659,7 @@ def rwFun (names : Array Name) (e : Expr) : MetaM Simp.Result := do
     else
       return { expr := e }
 
-def rwMatcher (e : Expr) : MetaM Simp.Result := do
+def rwMatcher (altIdx : Nat) (e : Expr) : MetaM Simp.Result := do
   if e.isAppOf ``PSum.casesOn || e.isAppOf ``PSigma.casesOn then
     let mut e := e
     while true do
@@ -664,10 +673,67 @@ def rwMatcher (e : Expr) : MetaM Simp.Result := do
           break
     return { expr := e }
   else
-    Split.simpMatch e
+    unless (← isMatcherApp e) do
+      return { expr := e }
+    let matcherDeclName := e.getAppFn.constName!
+    let eqns ← Match.genMatchCongrEqns matcherDeclName
+    unless altIdx < eqns.size do
+      trace[Tactic.FunInd] "When trying to reduce arm {altIdx}, only {eqns.size} equations for {.ofConstName matcherDeclName}"
+      return { expr := e }
+    let eqnThm := eqns[altIdx]!
+    try
+      withTraceNode `Meta.FunInd (pure m!"{exceptEmoji ·} rewriting with {.ofConstName eqnThm} in{indentExpr e}") do
+      let eqProof := mkAppN (mkConst eqnThm e.getAppFn.constLevels!) e.getAppArgs
+      let (hyps, _, eqType) ← forallMetaTelescope (← inferType eqProof)
+      trace[Meta.FunInd] "eqProof has type{indentExpr eqType}"
+      let proof := mkAppN eqProof hyps
+      let hyps := hyps.map (·.mvarId!)
+      let (isHeq, lhs, rhs) ← do
+        if let some (_, lhs, _, rhs) := eqType.heq? then pure (true, lhs, rhs) else
+        if let some (_, lhs, rhs) := eqType.eq? then pure (false, lhs, rhs) else
+        throwError m!"Type of {.ofConstName eqnThm} is not an equality"
+      if !(← isDefEq e lhs) then
+        throwError m!"Left-hand side {lhs} of {.ofConstName eqnThm} does not apply to {e}"
+      /-
+      Here we instantiate the hypotheses of the congruence equation theorem
+      There are two sets of hypotheses to instantiate:
+      - `Eq` or `HEq` that relate the discriminants to the patterns
+        Solving these should instantiate the pattern variables.
+      - Overlap hypotheses (`isEqnThmHypothesis`)
+      With more book keeping we could maybe do this very precisely, knowing exactly
+      which facts provided by the splitter should go where, but it's tedious.
+      So for now let's use heuristics and try `assumption` and `rfl`.
+      -/
+      for h in hyps do
+        unless (← h.isAssigned) do
+          let hType ← h.getType
+          if Simp.isEqnThmHypothesis hType then
+            -- Using unrestricted h.substVars here does not work well; it could
+            -- even introduce a dependency on the `oldIH` we want to eliminate
+            h.assumption <|> throwError "Failed to discharge {h}"
+          else if hType.isEq then
+            h.assumption <|> h.refl <|> throwError m!"Failed to resolve {h}"
+          else if hType.isHEq then
+            h.assumption <|> h.hrefl <|> throwError m!"Failed to resolve {h}"
+      let unassignedHyps ← hyps.filterM fun h => return !(← h.isAssigned)
+      unless unassignedHyps.isEmpty do
+        throwError m!"Not all hypotheses of {.ofConstName eqnThm} could be discharged: {unassignedHyps}"
+      let rhs ← instantiateMVars rhs
+      let proof ← instantiateMVars proof
+      let proof ← if isHeq then
+          try mkEqOfHEq proof
+          catch e => throwError m!"Could not un-HEq {proof}:{indentD e.toMessageData} "
+        else
+          pure proof
+      return {
+        expr := rhs
+        proof? := proof
+      }
+    catch ex =>
+      trace[Meta.FunInd] "Failed to apply {.ofConstName eqnThm}:{indentD ex.toMessageData}"
+      return { expr := e }
 
 /--
-
 Builds an expression of type `goal` by replicating the expression `e` into its tail-call-positions,
 where it calls `buildInductionCase`. Collects the cases of the final induction hypothesis
 as `MVars` as it goes.
@@ -709,16 +775,39 @@ partial def buildInductionBody (toErase toClear : Array FVarId) (goal : Expr)
     return mkApp5 (mkConst ``dite [u]) goal c' h' t' f'
   | cond _α c t f =>
     let c' ← foldAndCollect oldIH newIH isRecCall c
-    let t' ← withLocalDecl `h .default (← mkEq c' (toExpr true)) fun h => M2.branch do
-      let t' ← buildInductionBody toErase toClear goal oldIH newIH isRecCall t
+    let t' ← withLocalDecl `h .default (← mkEq c' (mkConst ``Bool.true)) fun h => M2.branch do
+      let t' ← withRewrittenMotiveArg goal (rwIfWith h) fun goal' =>
+        buildInductionBody toErase toClear goal' oldIH newIH isRecCall t
+      mkLambdaFVars #[h] t'
+    let f' ← withLocalDecl `h .default (← mkEq c' (mkConst ``Bool.false)) fun h => M2.branch do
+      let t' ← withRewrittenMotiveArg goal (rwIfWith h) fun goal' =>
+        buildInductionBody toErase toClear goal' oldIH newIH isRecCall f
       mkLambdaFVars #[h] t'
-    let f' ← withLocalDecl `h .default (← mkEq c' (toExpr false)) fun h => M2.branch do
-      let f' ← buildInductionBody toErase toClear goal oldIH newIH isRecCall f
-      mkLambdaFVars #[h] f'
     let u ← getLevel goal
     return mkApp4 (mkConst ``Bool.dcond [u]) goal c' t' f'
   | _ =>
 
+
+  -- Check for unreachable cases. We look for the kind of expressions that `by contradiction`
+  -- produces
+  match_expr e with
+  | False.elim _ h => do
+    return ← mkFalseElim goal h
+  | absurd _ _ h₁ h₂ => do
+    return ← mkAbsurd goal h₁ h₂
+  | _ => pure ()
+  if e.isApp && e.getAppFn.isConst && isNoConfusion (← getEnv) e.getAppFn.constName! then
+    let arity := (← inferType e.getAppFn).getNumHeadForalls -- crucially not reducing the noConfusionType in the type
+    let h := e.getArg! (arity - 1)
+    let hType ← inferType h
+    -- The following duplicates a bit of code from the contradiction tactic, maybe worth extracting
+    -- into a common helper at some point
+    if let some (_, lhs, rhs) ← matchEq? hType then
+      if let some lhsCtor ← matchConstructorApp? lhs then
+      if let some rhsCtor ← matchConstructorApp? rhs then
+      if lhsCtor.name != rhsCtor.name then
+        return (← mkNoConfusion goal h)
+
   -- we look in to `PProd.mk`, as it occurs in the mutual structural recursion construction
   match_expr goal with
   | And goal₁ goal₂ => match_expr e with
@@ -746,13 +835,13 @@ partial def buildInductionBody (toErase toClear : Array FVarId) (goal : Expr)
         (addEqualities := true)
         (onParams := (foldAndCollect oldIH newIH isRecCall ·))
         (onMotive := fun xs _body => pure (absMotiveBody.beta (maskArray mask xs)))
-        (onAlt := fun expAltType alt => M2.branch do
+        (onAlt := fun altIdx expAltType alt => M2.branch do
           lambdaTelescope1 alt fun oldIH' alt => do
             forallBoundedTelescope expAltType (some 1) fun newIH' goal' => do
               let #[newIH'] := newIH' | unreachable!
               let toErase' := toErase ++ #[oldIH', newIH'.fvarId!]
               let toClear' := toClear ++ matcherApp.discrs.filterMap (·.fvarId?)
-              let alt' ← withRewrittenMotiveArg goal' rwMatcher fun goal'' => do
+              let alt' ← withRewrittenMotiveArg goal' (rwMatcher altIdx) fun goal'' => do
                 -- logInfo m!"rwMatcher after {matcherApp.matcherName} on{indentExpr goal'}\nyields{indentExpr goal''}"
                 buildInductionBody toErase' toClear' goal'' oldIH' newIH'.fvarId! isRecCall alt
               mkLambdaFVars #[newIH'] alt')
@@ -769,8 +858,8 @@ partial def buildInductionBody (toErase toClear : Array FVarId) (goal : Expr)
         (addEqualities := true)
         (onParams := (foldAndCollect oldIH newIH isRecCall ·))
         (onMotive := fun xs _body => pure (absMotiveBody.beta (maskArray mask xs)))
-        (onAlt := fun expAltType alt => M2.branch do
-          withRewrittenMotiveArg expAltType Split.simpMatch fun expAltType' =>
+        (onAlt := fun altIdx expAltType alt => M2.branch do
+          withRewrittenMotiveArg expAltType (rwMatcher altIdx) fun expAltType' =>
             buildInductionBody toErase toClear expAltType' oldIH newIH isRecCall alt)
       return matcherApp'.toExpr
 

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

@@ -16,6 +16,7 @@ import Lean.Meta.Tactic.Grind.Arith.CommRing.EqCnstr
 import Lean.Meta.Tactic.Grind.Arith.CommRing.Proof
 import Lean.Meta.Tactic.Grind.Arith.CommRing.DenoteExpr
 import Lean.Meta.Tactic.Grind.Arith.CommRing.Inv
+import Lean.Meta.Tactic.Grind.Arith.CommRing.PP
 
 namespace Lean
 
@@ -26,6 +27,7 @@ builtin_initialize registerTraceClass `grind.ring.assert.unsat (inherited := tru
 builtin_initialize registerTraceClass `grind.ring.assert.trivial (inherited := true)
 builtin_initialize registerTraceClass `grind.ring.assert.queue (inherited := true)
 builtin_initialize registerTraceClass `grind.ring.assert.basis (inherited := true)
+builtin_initialize registerTraceClass `grind.ring.assert.store (inherited := true)
 builtin_initialize registerTraceClass `grind.ring.assert.discard (inherited := true)
 builtin_initialize registerTraceClass `grind.ring.simp
 builtin_initialize registerTraceClass `grind.ring.superpose
@@ -35,5 +37,6 @@ builtin_initialize registerTraceClass `grind.debug.ring.simp
 builtin_initialize registerTraceClass `grind.debug.ring.proof
 builtin_initialize registerTraceClass `grind.debug.ring.check
 builtin_initialize registerTraceClass `grind.debug.ring.impEq
+builtin_initialize registerTraceClass `grind.debug.ring.simpBasis
 
 end Lean

src/Lean/Meta/Tactic/Grind/Arith/CommRing/DenoteExpr.lean

@@ -12,7 +12,9 @@ namespace Lean.Meta.Grind.Arith.CommRing
 Helper functions for converting reified terms back into their denotations.
 -/
 
-private def denoteNum (k : Int) : RingM Expr := do
+variable [Monad M] [MonadGetRing M]
+
+private def denoteNum (k : Int) : M Expr := do
   let ring ← getRing
   let n := mkRawNatLit k.natAbs
   let ofNatInst := mkApp3 (mkConst ``Grind.CommRing.ofNat [ring.u]) ring.type ring.commRingInst n
@@ -22,44 +24,44 @@ private def denoteNum (k : Int) : RingM Expr := do
   else
     return n
 
-def _root_.Lean.Grind.CommRing.Power.denoteExpr (pw : Power) : RingM Expr := do
+def _root_.Lean.Grind.CommRing.Power.denoteExpr (pw : Power) : M Expr := do
   let x := (← getRing).vars[pw.x]!
   if pw.k == 1 then
     return x
   else
     return mkApp2 (← getRing).powFn x (toExpr pw.k)
 
-def _root_.Lean.Grind.CommRing.Mon.denoteExpr (m : Mon) : RingM Expr := do
+def _root_.Lean.Grind.CommRing.Mon.denoteExpr (m : Mon) : M Expr := do
   match m with
   | .unit => denoteNum 1
   | .mult pw m => go m (← pw.denoteExpr)
 where
-  go (m : Mon) (acc : Expr) : RingM Expr := do
+  go (m : Mon) (acc : Expr) : M Expr := do
     match m with
     | .unit => return acc
     | .mult pw m => go m (mkApp2 (← getRing).mulFn acc (← pw.denoteExpr))
 
-def _root_.Lean.Grind.CommRing.Poly.denoteExpr (p : Poly) : RingM Expr := do
+def _root_.Lean.Grind.CommRing.Poly.denoteExpr (p : Poly) : M Expr := do
   match p with
   | .num k => denoteNum k
   | .add k m p => go p (← denoteTerm k m)
 where
-  denoteTerm (k : Int) (m : Mon) : RingM Expr := do
+  denoteTerm (k : Int) (m : Mon) : M Expr := do
     if k == 1 then
       m.denoteExpr
     else
       return mkApp2 (← getRing).mulFn (← denoteNum k) (← m.denoteExpr)
 
-  go (p : Poly) (acc : Expr) : RingM Expr := do
+  go (p : Poly) (acc : Expr) : M Expr := do
     match p with
     | .num 0 => return acc
     | .num k => return mkApp2 (← getRing).addFn acc (← denoteNum k)
     | .add k m p => go p (mkApp2 (← getRing).addFn acc (← denoteTerm k m))
 
-def _root_.Lean.Grind.CommRing.Expr.denoteExpr (e : RingExpr) : RingM Expr := do
+def _root_.Lean.Grind.CommRing.Expr.denoteExpr (e : RingExpr) : M Expr := do
   go e
 where
-  go : RingExpr → RingM Expr
+  go : RingExpr → M Expr
   | .num k => denoteNum k
   | .var x => return (← getRing).vars[x]!
   | .add a b => return mkApp2 (← getRing).addFn (← go a) (← go b)
@@ -68,13 +70,17 @@ where
   | .pow a k => return mkApp2 (← getRing).powFn (← go a) (toExpr k)
   | .neg a => return mkApp (← getRing).negFn (← go a)
 
-def EqCnstr.denoteExpr (c : EqCnstr) : RingM Expr := do
+private def mkEq (a b : Expr) : M Expr := do
+  let r ← getRing
+  return mkApp3 (mkConst ``Eq [r.u.succ]) r.type a b
+
+def EqCnstr.denoteExpr (c : EqCnstr) : M Expr := do
   mkEq (← c.p.denoteExpr) (← denoteNum 0)
 
-def PolyDerivation.denoteExpr (d : PolyDerivation) : RingM Expr := do
+def PolyDerivation.denoteExpr (d : PolyDerivation) : M Expr := do
   d.p.denoteExpr
 
-def DiseqCnstr.denoteExpr (c : DiseqCnstr) : RingM Expr := do
+def DiseqCnstr.denoteExpr (c : DiseqCnstr) : M Expr := do
   return mkNot (← mkEq (← c.d.denoteExpr) (← denoteNum 0))
 
 end Lean.Meta.Grind.Arith.CommRing

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

@@ -89,16 +89,26 @@ def PolyDerivation.simplify (d : PolyDerivation) : RingM PolyDerivation := do
   return d
 
 /-- Simplifies `c₁` using `c₂`. -/
-def EqCnstr.simplifyWith (c₁ c₂ : EqCnstr) : RingM EqCnstr := do
-  let some r := c₁.p.simp? c₂.p (← nonzeroChar?) | return c₁
+def EqCnstr.simplifyWithCore (c₁ c₂ : EqCnstr) : RingM (Option EqCnstr) := do
+  let some r := c₁.p.simp? c₂.p (← nonzeroChar?) | return none
   let c := { c₁ with
     p := r.p
     h := .simp r.k₁ c₁ r.k₂ r.m₂ c₂
   }
   incSteps
   trace_goal[grind.ring.simp] "{← c.p.denoteExpr}"
+  return some c
+
+/-- Simplifies `c₁` using `c₂`. -/
+def EqCnstr.simplifyWith (c₁ c₂ : EqCnstr) : RingM EqCnstr := do
+  let some c ← c₁.simplifyWithCore c₂ | return c₁
   return c
 
+/-- Simplifies `c₁` using `c₂` exhaustively. -/
+partial def EqCnstr.simplifyWithExhaustively (c₁ c₂ : EqCnstr) : RingM EqCnstr := do
+  let some c ← c₁.simplifyWithCore c₂ | return c₁
+  c.simplifyWithExhaustively c₂
+
 /-- Simplify the given equation constraint using the current basis. -/
 def EqCnstr.simplify (c : EqCnstr) : RingM EqCnstr := do
   let mut c := c
@@ -150,22 +160,6 @@ def addToBasisCore (c : EqCnstr) : RingM Unit := do
     recheck := true
   }
 
-def EqCnstr.simplifyBasis (c : EqCnstr) : RingM Unit := do
-  let .add _ m _ := c.p | return ()
-  let .mult pw _ := m | return ()
-  let x := pw.x
-  let cs := (← getRing).varToBasis[x]!
-  if cs.isEmpty then return ()
-  modifyRing fun s => { s with varToBasis := s.varToBasis.set x {} }
-  for c' in cs do
-    let .add _ m' _ := c'.p | pure ()
-    if m.divides m' then
-      let c'' ← c'.simplifyWith c
-      unless (← c''.checkConstant) do
-        addToBasisCore c''
-    else
-      addToBasisCore c'
-
 def EqCnstr.addToQueue (c : EqCnstr) : RingM Unit := do
   if (← checkMaxSteps) then return ()
   trace_goal[grind.ring.assert.queue] "{← c.denoteExpr}"
@@ -218,6 +212,29 @@ def EqCnstr.toMonic (c : EqCnstr) : RingM EqCnstr := do
     return { c with p := c.p.mulConst (-1), h := .mul (-1) c }
   return c
 
+def EqCnstr.simplifyBasis (c : EqCnstr) : RingM Unit := do
+  trace[grind.debug.ring.simpBasis] "using: {← c.denoteExpr}"
+  let .add _ m _ := c.p | return ()
+  let rec go (m' : Mon) : RingM Unit := do
+    match m' with
+    | .unit => return ()
+    | .mult pw m' => goVar m pw.x; go m'
+  go m
+where
+  goVar (m : Mon) (x : Var) : RingM Unit := do
+    let cs := (← getRing).varToBasis[x]!
+    if cs.isEmpty then return ()
+    modifyRing fun s => { s with varToBasis := s.varToBasis.set x {} }
+    for c' in cs do
+      trace[grind.debug.ring.simpBasis] "target: {← c'.denoteExpr}"
+      let .add _ m' _ := c'.p | pure ()
+      if m.divides m' then
+        let c'' ← c'.simplifyWithExhaustively c
+        trace[grind.debug.ring.simpBasis] "simplified: {← c''.denoteExpr}"
+        addToQueue c''
+      else
+        addToBasisCore c'
+
 def EqCnstr.addToBasisAfterSimp (c : EqCnstr) : RingM Unit := do
   let c ← c.toMonic
   c.simplifyBasis

src/Lean/Meta/Tactic/Grind/Arith/CommRing/PP.lean

@@ -0,0 +1,56 @@
+/-
+Copyright (c) 2025 Amazon.com, Inc. or its affiliates. All Rights Reserved.
+Released under Apache 2.0 license as described in the file LICENSE.
+Authors: Leonardo de Moura
+-/
+prelude
+import Lean.Meta.Tactic.Grind.Arith.CommRing.DenoteExpr
+
+namespace Lean.Meta.Grind.Arith.CommRing
+
+instance : MonadGetRing (ReaderT Ring MetaM) where
+  getRing := read
+
+private def M := ReaderT Goal (StateT (Array MessageData) MetaM)
+
+private def toOption (cls : Name) (header : Thunk MessageData) (msgs : Array MessageData) : Option MessageData :=
+  if msgs.isEmpty then
+    none
+  else
+    some (.trace {cls} header.get msgs)
+
+private def push (msgs : Array MessageData) (msg? : Option MessageData) : Array MessageData :=
+  if let some msg := msg? then msgs.push msg else msgs
+
+def ppBasis? : ReaderT Ring MetaM (Option MessageData) := do
+  let mut basis := #[]
+  for cs in (← getRing).varToBasis do
+    for c in cs do
+      basis := basis.push (toTraceElem (← c.denoteExpr))
+  return toOption `basis "Basis" basis
+
+def ppDiseqs? : ReaderT Ring MetaM (Option MessageData) := do
+  let mut diseqs := #[]
+  for d in (← getRing).diseqs do
+    diseqs := diseqs.push (toTraceElem (← d.denoteExpr))
+  return toOption `diseqs "Disequalities" diseqs
+
+def ppRing? : ReaderT Ring MetaM (Option MessageData) := do
+  let msgs := #[]
+  let msgs := push msgs (← ppBasis?)
+  let msgs := push msgs (← ppDiseqs?)
+  return toOption `ring m!"Ring `{(← getRing).type}`" msgs
+
+def pp? (goal : Goal) : MetaM (Option MessageData) := do
+  let mut msgs := #[]
+  for ring in goal.arith.ring.rings do
+    let some msg ← ppRing? ring | pure ()
+    msgs := msgs.push msg
+  if msgs.isEmpty then
+    return none
+  else if h : msgs.size = 1 then
+    return some msgs[0]
+  else
+    return some (.trace { cls := `ring } "Rings" msgs)
+
+end Lean.Meta.Grind.Arith.CommRing

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

@@ -36,6 +36,15 @@ structure RingM.Context where
   -/
   checkCoeffDvd : Bool := false
 
+class MonadGetRing (m : Type → Type) where
+  getRing : m Ring
+
+export MonadGetRing (getRing)
+
+@[always_inline]
+instance (m n) [MonadLift m n] [MonadGetRing m] : MonadGetRing n where
+  getRing    := liftM (getRing : m Ring)
+
 /-- We don't want to keep carrying the `RingId` around. -/
 abbrev RingM := ReaderT RingM.Context GoalM
 
@@ -45,7 +54,7 @@ abbrev RingM.run (ringId : Nat) (x : RingM α) : GoalM α :=
 abbrev getRingId : RingM Nat :=
   return (← read).ringId
 
-def getRing : RingM Ring := do
+protected def RingM.getRing : RingM Ring := do
   let s ← get'
   let ringId ← getRingId
   if h : ringId < s.rings.size then
@@ -53,6 +62,9 @@ def getRing : RingM Ring := do
   else
     throwError "`grind` internal error, invalid ringId"
 
+instance : MonadGetRing RingM where
+  getRing := RingM.getRing
+
 @[inline] def modifyRing (f : Ring → Ring) : RingM Unit := do
   let ringId ← getRingId
   modify' fun s => { s with rings := s.rings.modify ringId f }
@@ -75,14 +87,14 @@ def setTermRingId (e : Expr) : RingM Unit := do
   modify' fun s => { s with exprToRingId := s.exprToRingId.insert { expr := e } ringId }
 
 /-- Returns `some c` if the current ring has a nonzero characteristic `c`. -/
-def nonzeroChar? : RingM (Option Nat) := do
+def nonzeroChar? [Monad m] [MonadGetRing m] : m (Option Nat) := do
   if let some (_, c) := (← getRing).charInst? then
     if c != 0 then
       return some c
   return none
 
 /-- Returns `some (charInst, c)` if the current ring has a nonzero characteristic `c`. -/
-def nonzeroCharInst? : RingM (Option (Expr × Nat)) := do
+def nonzeroCharInst? [Monad m] [MonadGetRing m] : m (Option (Expr × Nat)) := do
   if let some (inst, c) := (← getRing).charInst? then
     if c != 0 then
       return some (inst, c)

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

@@ -92,23 +92,25 @@ def mkModel (goal : Goal) : MetaM (Array (Expr × Rat)) := do
   let mut used : Std.HashSet Int := {}
   let mut nextVal : Int := 0
   let mut model := {}
-  let nodes := goal.getENodes
   -- Assign on expressions associated with cutsat terms or interpreted terms
-  for node in nodes do
+  for e in goal.exprs do
+    let node ← goal.getENode e
     if isSameExpr node.root node.self then
     if (← isIntNatENode node) then
       if let some v ← getAssignment? goal node.self then
         if v.den == 1 then used := used.insert v.num
         model := assignEqc goal node.self v model
   -- Assign cast terms
-  for node in nodes do
+  for e in goal.exprs do
+    let node ← goal.getENode e
     let i := node.self
     let some n := natCast? i | pure ()
     if model[n]?.isNone then
       let some v := model[i]? | pure ()
       model := assignEqc goal n v model
   -- Assign the remaining ones with values not used by cutsat
-  for node in nodes do
+  for e in goal.exprs do
+    let node ← goal.getENode e
     if isSameExpr node.root node.self then
     if (← isIntNatENode node) then
     if model[node.self]?.isNone then

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

@@ -37,6 +37,12 @@ where
       proof?  := proofNew?
     }
 
+/--
+Returns `true` if the parent is relevant for congruence closure.
+-/
+private def isCongrRelevant (parent : Expr) : Bool :=
+  parent.isApp || parent.isArrow
+
 /--
 Removes `root` parents from the congruence table.
 This is an auxiliary function performed while merging equivalence classes.
@@ -45,7 +51,7 @@ private def removeParents (root : Expr) : GoalM ParentSet := do
   let parents ← getParents root
   for parent in parents do
     -- Recall that we may have `Expr.forallE` in `parents` because of `ForallProp.lean`
-    if (← pure parent.isApp <&&> isCongrRoot parent) then
+    if (← pure (isCongrRelevant parent) <&&> isCongrRoot parent) then
       trace_goal[grind.debug.parent] "remove: {parent}"
       modify fun s => { s with congrTable := s.congrTable.erase { e := parent } }
   return parents
@@ -56,7 +62,7 @@ This is an auxiliary function performed while merging equivalence classes.
 -/
 private def reinsertParents (parents : ParentSet) : GoalM Unit := do
   for parent in parents do
-    if (← pure parent.isApp <&&> isCongrRoot parent) then
+    if (← pure (isCongrRelevant parent) <&&> isCongrRoot parent) then
       trace_goal[grind.debug.parent] "reinsert: {parent}"
       addCongrTable parent
 
@@ -90,75 +96,116 @@ private partial def updateMT (root : Expr) : GoalM Unit := do
       updateMT parent
 
 /--
-Helper function for combining `ENode.offset?` fields and propagating equalities
-to the offset constraint module.
+Equalities or disequalities to be propagated to a theory solver **after**
+two equivalence classes have been merged.
+
+Some solvers (e.g. `cutsat`) require the core data structures to satisfy
+their invariants.  During the merge operations some of these invariants do not hold.
+Thus, we first *record* the facts that must be propagated in a `PendingTheoryPropagation` value,
+complete the merge, and only then perform the propagation.
+
+We now use this workflow for *all* theory solvers, even when a particular
+solver does not rely on these invariants.  This keeps the core
+solver-agnostic and lets us modify solvers without further adjustments.
 -/
-private def propagateOffsetEq (rhsRoot lhsRoot : ENode) : GoalM Unit := do
+inductive PendingTheoryPropagation where
+  | /-- Nothing to propagate. -/
+    none
+  | /-- Propagate the equality `lhs = rhs`. -/
+    eq (lhs rhs : Expr)
+  |
+    /--
+    Propagate the literal equality `lhs = lit`.
+    This is needed because some solvers do not internalize literal values.
+    Remark: we may remove this optimization in the future because it adds complexity
+    for a small performance gain.
+    -/
+    eqLit (lhs lit : Expr)
+  | /-- Propagate the disequalities in `ps`. -/
+    diseqs (ps : ParentSet)
+
+/--
+Helper function for combining `ENode.offset?` fields and detecting what needs
+to be propagated to the offset constraint module.
+-/
+private def checkOffsetEq (rhsRoot lhsRoot : ENode) : GoalM PendingTheoryPropagation := do
   match lhsRoot.offset? with
   | some lhsOffset =>
     if let some rhsOffset := rhsRoot.offset? then
-      Arith.Offset.processNewEq lhsOffset rhsOffset
+      return .eq lhsOffset rhsOffset
     else if isNatNum rhsRoot.self then
-      Arith.Offset.processNewEqLit lhsOffset rhsRoot.self
+      return .eqLit lhsOffset rhsRoot.self
     else
       -- We have to retrieve the node because other fields have been updated
       let rhsRoot ← getENode rhsRoot.self
       setENode rhsRoot.self { rhsRoot with offset? := lhsOffset }
+      return .none
   | none =>
     if isNatNum lhsRoot.self then
-    if let some rhsOffset := rhsRoot.offset? then
-      Arith.Offset.processNewEqLit rhsOffset lhsRoot.self
+      if let some rhsOffset := rhsRoot.offset? then
+        return .eqLit rhsOffset lhsRoot.self
+    return .none
+
+def propagateOffset : PendingTheoryPropagation → GoalM Unit
+  | .eq lhs rhs => Arith.Offset.processNewEq lhs rhs
+  | .eqLit lhs lit => Arith.Offset.processNewEqLit lhs lit
+  | _ => return ()
 
 /--
-Helper function for combining `ENode.cutsat?` fields and propagating equalities
-to the cutsat module.
-It returns a set of parents that should be traversed for disequality propagation.
+Helper function for combining `ENode.cutsat?` fields and detecting what needs
+to be propagated to the cutsat module.
 -/
-private def propagateCutsatEq (rhsRoot lhsRoot : ENode) : GoalM ParentSet := do
+private def checkCutsatEq (rhsRoot lhsRoot : ENode) : GoalM PendingTheoryPropagation := do
   match lhsRoot.cutsat? with
   | some lhsCutsat =>
     if let some rhsCutsat := rhsRoot.cutsat? then
-      Arith.Cutsat.processNewEq lhsCutsat rhsCutsat
-      return {}
+      return .eq lhsCutsat rhsCutsat
     else if isNum rhsRoot.self then
-      Arith.Cutsat.processNewEqLit lhsCutsat rhsRoot.self
-      return {}
+      return .eqLit lhsCutsat rhsRoot.self
     else
       -- We have to retrieve the node because other fields have been updated
       let rhsRoot ← getENode rhsRoot.self
       setENode rhsRoot.self { rhsRoot with cutsat? := lhsCutsat }
-      getParents rhsRoot.self
+      return .diseqs (← getParents rhsRoot.self)
   | none =>
     if let some rhsCutsat := rhsRoot.cutsat? then
       if isNum lhsRoot.self then
-        Arith.Cutsat.processNewEqLit rhsCutsat lhsRoot.self
-        return {}
+        return .eqLit rhsCutsat lhsRoot.self
       else
-        getParents lhsRoot.self
+        return .diseqs (← getParents lhsRoot.self)
     else
-      return {}
+      return .none
+
+def propagateCutsat : PendingTheoryPropagation → GoalM Unit
+  | .eq lhs rhs => Arith.Cutsat.processNewEq lhs rhs
+  | .eqLit lhs lit => Arith.Cutsat.processNewEqLit lhs lit
+  | .diseqs ps => propagateCutsatDiseqs ps
+  | .none => return ()
 
 /--
-Helper function for combining `ENode.ring?` fields and propagating equalities
-to the commutative ring module.
-It returns a set of parents that should be traversed for disequality propagation.
+Helper function for combining `ENode.ring?` fields and detecting what needs to be
+progagated to the commutative ring module.
 -/
-private def propagateCommRingEq (rhsRoot lhsRoot : ENode) : GoalM ParentSet := do
+private def checkCommRingEq (rhsRoot lhsRoot : ENode) : GoalM PendingTheoryPropagation := do
   match lhsRoot.ring? with
   | some lhsRing =>
     if let some rhsRing := rhsRoot.ring? then
-      Arith.CommRing.processNewEq lhsRing rhsRing
-      return {}
+      return .eq lhsRing rhsRing
     else
       -- We have to retrieve the node because other fields have been updated
       let rhsRoot ← getENode rhsRoot.self
       setENode rhsRoot.self { rhsRoot with ring? := lhsRing }
-      getParents rhsRoot.self
+      return .diseqs (← getParents rhsRoot.self)
   | none =>
     if rhsRoot.ring?.isSome then
-      getParents lhsRoot.self
+      return .diseqs (← getParents lhsRoot.self)
     else
-      return {}
+      return .none
+
+def propagateCommRing : PendingTheoryPropagation → GoalM Unit
+  | .eq lhs rhs => Arith.CommRing.processNewEq lhs rhs
+  | .diseqs ps => propagateCommRingDiseqs ps
+  | _ => return ()
 
 /--
 Tries to apply beta-reductiong using the parent applications of the functions in `fns` with
@@ -262,9 +309,9 @@ where
     }
     propagateBeta lams₁ fns₁
     propagateBeta lams₂ fns₂
-    propagateOffsetEq rhsRoot lhsRoot
-    let parentsToPropagateCutsatDiseqs ← propagateCutsatEq rhsRoot lhsRoot
-    let parentsToPropagateRingDiseqs ← propagateCommRingEq rhsRoot lhsRoot
+    let offsetTodo ← checkOffsetEq rhsRoot lhsRoot
+    let cutsatTodo ← checkCutsatEq rhsRoot lhsRoot
+    let ringTodo ← checkCommRingEq rhsRoot lhsRoot
     resetParentsOf lhsRoot.self
     copyParentsTo parents rhsNode.root
     unless (← isInconsistent) do
@@ -274,8 +321,9 @@ where
         propagateUp parent
       for e in toPropagateDown do
         propagateDown e
-      propagateCutsatDiseqs parentsToPropagateCutsatDiseqs
-      propagateCommRingDiseqs parentsToPropagateRingDiseqs
+      propagateOffset offsetTodo
+      propagateCutsat cutsatTodo
+      propagateCommRing ringTodo
   updateRoots (lhs : Expr) (rootNew : Expr) : GoalM Unit := do
     traverseEqc lhs fun n =>
       setENode n.self { n with root := rootNew }

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

@@ -300,7 +300,7 @@ private partial def instantiateTheorem (c : Choice) : M Unit := withDefault do w
       let report : M Unit := do
         reportIssue! "type error constructing proof for {← thm.origin.pp}\nwhen assigning metavariable {mvars[i]} with {indentExpr v}\n{← mkHasTypeButIsExpectedMsg vType mvarIdType}"
       unless (← withDefault <| isDefEq mvarIdType vType) do
-        let some heq ← withoutReportingMVarIssues <| proveEq? vType mvarIdType
+        let some heq ← withoutReportingMVarIssues <| proveEq? vType mvarIdType (abstract := true)
           | report
             return ()
         /-

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

@@ -37,13 +37,13 @@ def propagateForallPropUp (e : Expr) : GoalM Unit := do
 where
   propagateImpliesUp (a b : Expr) : GoalM Unit := do
     unless (← alreadyInternalized b) do return ()
-    if (← isEqFalse a) then
+    if (← isEqFalse a <&&> isProp b) then
       -- a = False → (a → b) = True
       pushEqTrue e <| mkApp3 (mkConst ``Grind.imp_eq_of_eq_false_left) a b (← mkEqFalseProof a)
-    else if (← isEqTrue a) then
+    else if (← isEqTrue a <&&> isProp b) then
       -- a = True → (a → b) = b
       pushEq e b <| mkApp3 (mkConst ``Grind.imp_eq_of_eq_true_left) a b (← mkEqTrueProof a)
-    else if (← isEqTrue b) then
+    else if (← isEqTrue b <&&> isProp a) then
       -- b = True → (a → b) = True
       pushEqTrue e <| mkApp3 (mkConst ``Grind.imp_eq_of_eq_true_right) a b (← mkEqTrueProof b)
     else if (← isEqFalse b <&&> isEqTrue e <&&> isProp a) then